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

Question

I have been working on a Shiny app that uses conditional filters to select tables within several categories and compare the columns contained inside the tables. My filter system seem to be working as expected until I added the input data and noticed the output was not changing after I changed the selections and received these warnings:

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

From this question I understand that "When you perform a boolean comparison between two vectors in R, the "expectation" is that both vectors are of the same length, so that R can compare each corresponding element in turn" but honestly it is still not clear to me how to change my code in Shiny to solve that problem.

Here you can see my code so far:

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)

Here you can see my input:

input(df in the code above)

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

An here is the output if all options were selected (in my code I set a different default selection)

output

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

Thanks for any help and suggestions.

score 2 · Accepted Answer · answered Sep 21 '21 at 00:47

Perhaps this works

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)

-output

1

perfect! it works! thank you! – AFS Sep 21 '21 at 15:54

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

1 Answers1