R Shiny- Output error: longer object length is not a multiple of shorter object length

Question

我一直在开发一个闪亮的应用程序，该应用程序使用条件过滤器对多个类别中的 select 表进行比较，并比较表中包含的列。我的过滤系统似乎按预期工作，直到我添加了输入数据并注意到在我更改 select 离子并收到这些警告后输出没有改变：

Warning in df$var_1 == input$var_1 : longer object length is not a multiple of shorter object length

Warning in df$var_2 == input$var_2 : longer object length is not a multiple of shorter object length

来自this question 我了解到“当您在 R 中的两个向量之间执行布尔比较时，“期望”是两个向量的长度相同，以便 R 可以比较每个对应的元素turn" 但老实说，我仍然不清楚如何在 Shiny 中更改我的代码来解决该问题。

到目前为止，您可以在这里看到我的代码：

library(shiny)
library(dplyr)
library(DT)



df<-test_2_filtros
ui<-(fluidPage(
  headerPanel(title = "Shiny App Conditional Filter Demo"),
  sidebarLayout(
    sidebarPanel(
      selectInput("var_1","Select a category",choices = unique(df$var_1), multiple = TRUE, selected= "red"),
      selectInput("var_2","Select a table",unique(df$var_2), multiple = TRUE, selected= "table1")
    ),
    mainPanel(DT::dataTableOutput("mytable1"))
    
  )
)
)




server<-(function(session,input,output) {
  
  
  observe({
    print(input$var_1)
    x <- df$var_2[df$var_1 == input$var_1]
    updateSelectInput(session,"var_2","Select a table",choices = unique(x), selected= "table1" )
    
  })
  
  
  observe({
    productdata <- df$var_3[df$var_2 == input$var_2]
    
  })
  
  
  result <- reactive({
    
    
    tmp<-filter(df, var_2 %in% unique(x) & var_3 %in% unique(productdata))
    
    tmp%>% 
      dplyr::mutate(n = "Yes")%>%
      mutate(row_num = 1:n()) %>%
      tidyr::pivot_wider(names_from = var_3, values_from = n, values_fill = list(n = "No"))%>%
      select(-row_num)
                         
  })
  output$mytable1 <- DT::renderDataTable({
    mytable<-DT::datatable(result(), filter= 'top',options = list(order=list(1,'asc'), dom='t', pageLength= 100, autoWidth = TRUE),rownames = FALSE)
    
    formatStyle(mytable, columns = NULL, fontWeight = styleEqual(c('No', 'Yes'), c('normal', 'bold')))
    
  
  
  
  
})
  
})

shinyApp(ui, server)

在这里你可以看到我的输入：

输入(上面代码中的df)

var_1	var_2	var_3
red	table1	column1
red	table1	column1
red	table1	column1
blue	table2	column2
blue	table2	column2
blue	table2	column2
green	table3	column3
green	table3	column3
green	table3	column3

如果所有选项都被 selected（在我的代码中我设置了不同的默认值 selection）

，这里是输出

输出

var_1	var_2	column1	column2	column3
red	table1	Yes	No	No
red	table1	Yes	No	No
red	table1	Yes	No	No
blue	table2	No	Yes	No
blue	table2	No	Yes	No
blue	table2	No	Yes	No
green	table3	No	No	Yes
green	table3	No	No	Yes
green	table3	No	No	Yes

感谢您的帮助和建议。

Answer 1

也许这行得通

library(shiny)
library(dplyr)
library(DT)


test_2_filtros <- structure(list(var_1 = c("red", "red", "red", "blue", "blue", 
                                           "blue", "green", "green", "green"), var_2 = c("table1", "table1", 
                                                                                         "table1", "table2", "table2", "table2", "table3", "table3", "table3"
                                           ), var_3 = c("column1", "column1", "column1", "column2", "column2", 
                                                        "column2", "column3", "column3", "column3")), class = "data.frame", row.names = c(NA, 
                                                                                                                                          -9L))
df<-test_2_filtros
ui<-(fluidPage(
  headerPanel(title = "Shiny App Conditional Filter Demo"),
  sidebarLayout(
    sidebarPanel(
      selectInput("var_1","Select a category",choices = unique(df$var_1), multiple = TRUE, selected= "red"),
      selectInput("var_2","Select a table",unique(df$var_2), multiple = TRUE, selected= "table1"),
      selectInput("var_3","Select a product",unique(df$var_3), multiple = TRUE, selected= "column1")
    ),
    mainPanel(DT::dataTableOutput("mytable1"))
    
  )
)
)




server<-(function(session,input,output) {
  
  
  observe({
    req(input$var_1)
    print(input$var_1)
    x <- df$var_2[df$var_1 %in% input$var_1]
    updateSelectInput(session,"var_2","Select a table",choices = unique(x), selected= "table1" )
    
  })
  
  
  observe({
    req(input$var_2)
    productdata <- df$var_3[df$var_2 %in% input$var_2]
    updateSelectInput(session,"var_3","Select a product",choices = unique(productdata), selected= "column1" )
  })
  
  
  result <- reactive({
    
  
    tmp<-dplyr::filter(df, var_2 %in% unique(input$var_2) & var_3 %in% unique(input$var_3))
    
    tmp%>% 
      dplyr::mutate(n = "Yes")%>%
      mutate(row_num = 1:n()) %>%
      tidyr::pivot_wider(names_from = var_3, values_from = n, values_fill = list(n = "No"))%>%
      select(-row_num)
    
  })
  output$mytable1 <- DT::renderDataTable({
    mytable<-DT::datatable(result(), filter= 'top',options = list(order=list(1,'asc'), dom='t', pageLength= 100, autoWidth = TRUE),rownames = FALSE)
    
    formatStyle(mytable, columns = NULL, fontWeight = styleEqual(c('No', 'Yes'), c('normal', 'bold')))
    
    
    
    
    
  })
  
})

shinyApp(ui, server)

-输出

R Shiny- Output error: longer object length is not a multiple of shorter object length

R Shiny- Output error: longer object length is not a multiple of shorter object length

r

conditional-statements

shiny

reactive