Shiny - Dependency between columns

shiny
1

Hi everyone,

Hope everybody is fine.

In my shiny app, I would like to display a checkbox input with values depends on another checkbox inputs, chosen by th user.

In my exemple, Organisation 2 depends with values chosen by user on Organisation 1.

I think use a uiOutput is a solution on the UI side.

So i try this solution in a minimal reproduction :

library(shiny)

# dataset
dataset_test <- data.frame(Organisation1=c(rep("A",4),rep("B",4),rep("C",4)),Organisation2=c(rep("D",5),rep("E",5),rep("F",2)))

# list
list_organisation_1 <- sort(unique(dataset_test$Organisation1))

ui <- shinyUI(
  navbarPage(
    tabPanel('Dependency test',
             sidebarPanel(
               h5(strong("Organisation")),
               tabsetPanel(tabPanel("Level 1",
                                    checkboxGroupInput("Organisation_1", "", inline=F, list_organisation_1, list_organisation_1),
                                    h6("____________________"),
                                    checkboxInput('selectall_organisation_1', 'All / None', T)),
                           tabPanel("Level 2",
                                    uiOutput("Organisation_2"),
                                    h6("____________________"),
                                    checkboxInput('selectall_organisation_2', 'All / None', T)
                           )
               )
             ),
             mainPanel(
               tableOutput("Resume")
             )
    )
  )
)


server <- function(input, output, session) {

  output$Organisation_2 = renderUI({
    
    subset_Organisation_1 <- subset(dataset_test, dataset_test[,1] %in% input$Organisation_1)
    checkboxGroupInput("Organisation_2", "", inline=F, choices = sort(unique(subset_Organisation_1[,2])), selected= sort(unique(subset_Organisation_1[,2])))
    
  })
  
  
  datasetInput <- reactive({
    
    match_organisation_1 <- (match(dataset_test[,1],input$Organisation_1, nomatch=FALSE) > 0)
    match_organisation_2 <- (match(dataset_test[,2],input$Organisation_2, nomatch=FALSE) > 0)
    
    intersect<- match_organisation_1== TRUE & match_organisation_2 == TRUE
    dataset_test[intersect,]
  })
  
  # All / None Organisation 1
  observeEvent(input$selectall_organisation_1,{
    val <- list_organisation_1
    if(!input$selectall_organisation_1)
      val <- character(0)
    
    updateCheckboxGroupInput(
      session, 'Organisation_1', 
      selected = val
    )
  })
  
  # All / None Organisation 2
  observeEvent(input$selectall_organisation_2,{
    val <- sort(unique(subset(dataset_test, dataset_test[,1] %in% sort(unique(input$Organisation_1)))[,2]))
    if(!input$selectall_organisation_2)
      val <- character(0)

    updateCheckboxGroupInput(
      session, 'Organisation_2',
      selected = val
    )
  })
  
  
  output$Resume <- renderTable({
    dataset <- datasetInput()
    number_rows <- nrow(dataset)
    
    data.frame(
      Information = c("Number of rows :"),
      Value = number_rows
    )
  })
  
  
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Dependencies works but here, i have some problems :

  • I have the feeling i miss an important thing, using renderUI and the reactive part independently.
    Should i change something in order to resolve the following problem :

  • We can see that the nrow value is 0 on the resume part when the app is just generated but once we click on the "level 2" panel, the correct number 12 is generated.

I suppose shiny want to "see" all the values the when the uiOutput is used?

I would like to force shiny to read this "level 2" conserving my tabsetpanel choice.

Thanks a lot, R developers,

2

shiny tries to evaluate lazily... so renderUI wont 'take effect' until the UI is tabbed into.
Because the form of the UI is not required to be dynamic, rather its the particular choices/selections within a constant ui type (checkboxgroupinput) I find it easiest to place a checkboxgroupinput, rather than a uiOutput, and to call the updatecheckboxgroupinput type function. Doing so, easily solves the initialisation issue.

library(shiny)

# dataset
dataset_test <- data.frame(Organisation1=c(rep("A",4),rep("B",4),rep("C",4)),Organisation2=c(rep("D",5),rep("E",5),rep("F",2)))

# list
list_organisation_1 <- sort(unique(dataset_test$Organisation1))

ui <- shinyUI(
  navbarPage(
    tabPanel('Dependency test',
             sidebarPanel(
               h5(strong("Organisation")),
               tabsetPanel(tabPanel("Level 1",
                                    checkboxGroupInput("Organisation_1", "", inline=F, list_organisation_1, list_organisation_1),
                                    h6("____________________"),
                                    checkboxInput('selectall_organisation_1', 'All / None', T)),
                           tabPanel("Level 2",
                                    checkboxGroupInput("Organisation_2", "", inline=F, list_organisation_1, list_organisation_1),
                                    
                                    h6("____________________"),
                                    checkboxInput('selectall_organisation_2', 'All / None', T)
                           )
               )
             ),
             mainPanel(
               tableOutput("Resume")
             )
    )
  )
)


server <- function(input, output, session) {
  
  observeEvent(input$Organisation_1,{
    subset_Organisation_1 <- subset(dataset_test, dataset_test[,1] %in% input$Organisation_1)
    updateCheckboxGroupInput(session=session,
                             inputId = "Organisation_2",
                             choices =  sort(unique(subset_Organisation_1[,2])),
                             selected= sort(unique(subset_Organisation_1[,2])))
  })
  
  
  datasetInput <- reactive({
    o1 <- input$Organisation_1
    o2 <- input$Organisation_2
    print(o2)
    match_organisation_1 <- (match(dataset_test[,1],o1, nomatch=FALSE) > 0)
    match_organisation_2 <- (match(dataset_test[,2],o2, nomatch=FALSE) > 0)
    
    intersect<- match_organisation_1== TRUE & match_organisation_2 == TRUE
    dataset_test[intersect,]
  })
  
  # All / None Organisation 1
  observeEvent(input$selectall_organisation_1,{
    val <- list_organisation_1
    if(!input$selectall_organisation_1)
      val <- character(0)
    
    updateCheckboxGroupInput(
      session, 'Organisation_1', 
      selected = val
    )
  })
  
  # All / None Organisation 2
  observeEvent(input$selectall_organisation_2,{
    val <- sort(unique(subset(dataset_test, 
dataset_test[,1] %in% sort(unique(input$Organisation_1)))[,2]))
    if(!input$selectall_organisation_2)
      val <- character(0)
    
    updateCheckboxGroupInput(
      session, 'Organisation_2',
      selected = val
    )
  })
  
  
  output$Resume <- renderTable({
    dataset <- datasetInput()
    number_rows <- nrow(dataset)
    
    data.frame(
      Information = c("Number of rows :"),
      Value = number_rows
    )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
1 Like
3

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.