时间戳

首页 > 解决方案 > 为什么我的闪亮应用程序中的“过滤器”会因输入长度错误而崩溃？

r - 为什么我的闪亮应用程序中的“过滤器”会因输入长度错误而崩溃？

问题描述

我对编程很陌生，但我必须为大学课程制作一个闪亮的应用程序。

如您所见，我在网上抓取了一个显示不同自行车几何形状的数据表，我想创建一个闪亮的应用程序，我可以在其中比较几何形状。我对自己的进步感到非常满意，但现在我遇到的问题是它总是向我显示错误：“错误：filter()输入问题。x..1输入..1的大小必须为 19 或 1，而不是 0。i 输入..1为!=....161： "

我希望它可以在应用程序中选择一辆自行车，它会自动比较这辆自行车并向我展示 10 辆最相似的自行车。


#table

Canyon <- read_html("https://enduro-mtb.com/canyon-strive-cfr-9-0-ltd-test-2020/")
Rose <- read_html("https://enduro-mtb.com/rose-root-miller-2020-test/")
Ghost <- read_html("https://enduro-mtb.com/ghost-riot-enduro-2021-erster-test/")
Cube <- read_html("https://enduro-mtb.com/cube-stereo-170-sl-29-test-2020/")


Comparison <- tibble(
  Geometry = Canyon %>%
    html_nodes(".geometry strong") %>%
    html_text()%>%
    str_trim(),
  CanyonStrive = Canyon %>%
    html_nodes("td:nth-child(3)") %>%
    html_text()%>%
    str_trim(),
  GhostRiot = Ghost %>%
    html_nodes("td:nth-child(3)") %>%
    html_text()%>%
    str_trim(),
   CubeStereo = Cube %>%
    html_nodes("td:nth-child(3)") %>%
    html_text()%>%
    str_trim(),
   RoseRootMiller = Rose %>%
    html_nodes("td:nth-child(3)") %>%
    html_text()%>%
    str_trim(),
)

ComparisonTable <- Comparison %>%
  mutate_all(~gsub("mm|°|-.*|/.*|\\.", "", .)) %>%
  mutate_all(~gsub(",", ".", .)) %>%
  mutate_all(type.convert, as.is=TRUE) %>% 
  gather("Bikes", "value", 2:ncol(Comparison)) %>% 
  spread(Geometry,value)


Art <- c("Enduro", "Enduro", "AllMountain", "Enduro")


ComparisonTableHallo <- ComparisonTable

ComparisonTableHallo$Art <- Art

# server

server <- function(input, output, session) {
 selectedData1 <- reactive({
      ComparisonTableHallo %>%
      filter(ComparisonTableHallo$Bikes != gsub("[[:space:]]*$","",gsub("- .*",'',input$Bikes))) 
    })
    
     
    
    selectedData2 <- reactive({
      selectedData1() %>%
        select(1:12) %>%
      filter(selectedData1()$Art %in% input$Art) 
    })
    
    selectedData3 <- reactive({
      ComparisonTableHallo  %>%
        select(1:12) %>%
        filter(ComparisonTableHallo$Bikes == gsub("[[:space:]]*$","",gsub("- .*",'',input$Bikes))) 
      
    })
    
    selectedData4 <- reactive({
      rbind(selectedData3(),selectedData2())
      
    })
    
    selectedData5 <- reactive({
      selectedData4() %>%
      select(3:11)
    })
    
    selectedData6 <- reactive({
    as.numeric(knnx.index(selectedData5(), selectedData5()[1, , drop=FALSE], k=2))
    })
    
    selectedData7 <- reactive({
      selectedData4()[selectedData6(),]
    })
    
    selectedData8 <- reactive({
      selectedData7() %>%
        select(3:11)
    })


    # Combine the selected variables into a new data frame
  output$plot1 <- renderPlotly({
    
    validate(
      need(dim(selectedData2())[1]>=2, "Sorry, no ten similar bikes were found. 
           Please change the input filters."
      )
      )

    plot_ly(
      type = 'scatterpolar',
      mode = "closest",
      fill = 'toself'
    ) %>%
      add_trace(
        r = as.matrix(selectedData8()[1,]),
        theta = c("Kettenstrebe", "Lenkwinkel","Oberrohr","Radstand","Reach","Sattelrohr","Sitzwinkel","Stack","Steuerrohr",
                  "Tretlagerabsenkung"),
        showlegend = TRUE,
        mode = "markers",
        name = selectedData7()[1,1]
      ) %>%
      add_trace(
        r = as.matrix(selectedData8()[2,]),
        theta = c("Kettenstrebe","Lenkwinkel","Oberrohr","Radstand","Reach","Sattelrohr","Sitzwinkel","Stack","Steuerrohr",
                  "Tretlagerabsenkung"),
        showlegend = TRUE,
        mode = "markers",
        visible="legendonly",
        name = selectedData7()[2,1]
      ) %>% 
      layout(
        polar = list(
          radialaxis = list(
            visible = T,
            range = c(0,100)
          )
       ),
     
     showlegend=TRUE
      
        
      )
    
  })
  
}

#shiny app

ui <- fluidPage(navbarPage("Bike Comparison",
           tabPanel("Graphic",fluidPage(theme = shinytheme("flatly")),
tags$head(
  tags$style(HTML(".shiny-output-error-validation{color: red;}"))),
pageWithSidebar(
  headerPanel('Apply filters'),
  sidebarPanel(width = 4,
    selectInput('Bike', 'Choose a Bike:',paste(ComparisonTableHallo$Bikes)),
      checkboxGroupInput(inputId = "Art",
                       label = 'Art:', choices = c("Enduro" = "Enduro", "AllMountain" = "AllMountain"
                                                        ), 
                       selected = c("Enduro" = "Enduro","AllMountain" = "AllMountain"),inline=TRUE),
   submitButton("Update filters")
  ),
  mainPanel(
    column(8, plotlyOutput("plot1", width = 800, height=700),
           p("To visualize the graph of the player, click the icon at side of names 
             in the graphic legend. It is worth noting that graphics will be overlapped.",
             style = "font-size:25px")
    
  )
  )
)))
)

shinyApp(ui = ui, server = server)

标签： rinputdplyrgsub

解决方案

在您的 UI 上，您的输入名为Bike，在您的服务器上，您指的是 input$Bikes。要么 Bike 需要更改为 Bikes，要么相反。

编辑：（详细说明）您的错误是告诉您您对函数的参数有问题filter。具体来说，您将长度为 0 的对象传递给函数。您正试图通过自行车。一个空的选择输入会通过""，所以这不是问题。""长度为 1。但是，您从未分配过的输入将通过NULL。它的长度为 0。

推荐阅读