R Shiny Dynamic UI - uiOutput returns NULL?

Question

I have been scouring the internet for an answer to my problem, and I have looked here:

https://shiny.rstudio.com/articles/dynamic-ui.html

https://shiny.rstudio.com/articles/req.html

Error in filter_impl(.data, quo) : Result must have length 259, not 399

Shiny renderUI selectInput returned NULL

Dynamic UI in shiny: Can't print results from uiOutput created with renderUI

How to get the value in uioutput in ui.R and send it back to server.R?

https://community.rstudio.com/t/dynamic-ui-cant-print-results-from-uioutput-created-with-renderui/6937

None of these have helped.

Set up:

I have a data set of different industries and financial ratios for those industries. The choice of ratios depend on the choice of industry. In addition, the choice of variables depends on the size of the companies in the industries. For instance, I may only want to look at companies in Industry1 with assets less than $5 billion, and the pertinent ratios for companies of that size in that industry. Hence, the dynamic UI comes from choosing and industry, then choosing the size rank I want to investigate based on the industry. Not all industries will be segmented by size identically, some have 2 size rankings, others can have 4 or 5. Finally, the ratios measure various dimensions of a company's financials such as debt, income, efficiency, etc., hence I should four columns for each dimension with a set of ratios which have a checkbox next to each.

Problem:

The function I have to filter my data.frame by an industry returns a column of size ranks to choose from within renderUI. However, somewhere between the following three steps that output is turned into NULL. Therefore, I cannot filter the ratios I want to choose by industry and size and shiny returns a page with headers and drop down menus but no variables to choose from.

Step 1.

    output$secondSelection = renderUI({
    size_filter_choice = dummyData %>% filter(Industry == input$industry) %>% distinct(Size)
    print("Step 1.")
    print(size_filter_choice)
    selectInput(inputId = "size",label="Sizes",choices = as.list(size_filter_choice[,"Size"]),selectize=FALSE) 
  })

Step 2.

uiOutput("secondSelection")

Step 3.

main_ratio_set <- reactive({

    print("Step 3")
    print(input$size)
    print(input$industry)
    req(input$size)

    user_filter <- dummyData %>% filter(Industry == input$industry & Size == input$size)

    return(user_filter)

  })

  outputOptions(output,"secondSelection",suspendWhenHidden = FALSE)

The print functions return the following:

Listening on http://127.0.0.1:5301

[

1] "Step 1."
   Size
1 Size1
2 Size2
[1] "Step 3"
NULL
[1] "Industry1"

Below is the code with a dummy data set, that comes as close to the problem I am having with this proprietary data. I am running RStudio version 0.98.1103, with R version 3.4.1. Thank you in advance for your help.

library(plyr)
library(dplyr)
library(shiny)
library(shinydashboard)

dummyData <- data.frame(matrix(nrow=0,ncol=4,dimnames=list(c(),c("Ratio","Dimensions","Industry","Size"))))

industry_n <- 5
dims <- 4

for(i in 1:industry_n){
  s = sample(1:5,1)
  for(sz in 1:s){
    for(d in 1:dims){
      ratios <- sample(1:10,1)
      df <- data.frame(Ratio = paste0("Ratio",ratios))
      df <- df %>% mutate(Dimensions = paste0("Dimension",d),
                       Industry = paste0("Industry",i),
                       Size = paste0("Size",sz))
      dummyData <- rbind(dummyData,df)
    }
  }
}


ind_n <- paste0("Industry",1:industry_n)

runApp(list(
  ui = fluidPage(
    fluidRow(
      column(5,
             selectInput("industry",label="Industry",choices = ind_n,selected="Industry1"),
             uiOutput("secondSelection")
      ),
      fluidRow(
        column(width = wd,
               list(h3("Dimension 1"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim1")))),
        column(width = wd,
               list(h3("Dimension 2"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim2")))),
        column(width = wd,
               list(h3("Dimension 3"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim3")))),
        column(width = wd,
               list(h3("Dimension 4"), 
                    tags$div(align = 'left', 
                             class = 'multicol', 
                             uiOutput("dim4"))))
      )
      )),

server = function(input, output,session) {

  output$secondSelection = renderUI({
    size_filter_choice = dummyData %>% filter(Industry == input$industry) %>% distinct(Size)
    print("Step 1.")
    print(size_filter_choice)
    selectInput(inputId = "size",label="Sizes",choices = as.list(size_filter_choice[,"Size"]),selectize=FALSE) 
  })

  main_ratio_set <- reactive({

    print("Step 3")
    print(input$size)
    print(input$industry)
    req(input$size)

    user_filter <- dummyData %>% filter(Industry == input$industry & Size == input$size)

    return(user_filter)

  })

  outputOptions(output,"secondSelection",suspendWhenHidden = FALSE)

ratio_filter_dim1 = reactive({

  ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension1") %>% distinct(Ratio)
  ratio_select <- as.list(as.character(ratio_select[,"Ratio"]))
  return(ratio_select)
})


output$dim1 = renderUI({
  checkboxGroupInput(inputId = "dim1",label=NULL,choices = ratio_filter_dim1(),inline=F)
})

ratio_filter_dim2 = reactive({
    ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension2") %>% distinct(Ratio)
  ratio_select <- as.character(ratio_select[,"Ratio"])
  return(ratio_select)
})


output$dim2 = renderUI({
  checkboxGroupInput(inputId = "dim2",label=NULL,choices = ratio_filter_dim2(),inline=F)
})

ratio_filter_dim3 = reactive({
  ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension3") %>% distinct(Ratio)
  ratio_select <- as.character(ratio_select[,"Ratio"])
  return(ratio_select)
})


output$dim3 = renderUI({
  checkboxGroupInput(inputId = "dim3",label=NULL,choices = ratio_filter_dim3(),inline=F)
})

ratio_filter_dim4 = reactive({

  ratio_select <- main_ratio_set() %>% filter(Risk.Dimension == "Dimension4") %>% distinct(Ratio)
  ratio_select <- as.character(ratio_select[,"Ratio"])
  return(ratio_select)
})

output$dim4 = renderUI({
  checkboxGroupInput(inputId = "dim4",label=NULL,choices = ratio_filter_dim4(),inline=F)
})
}
))

Answer 1

Build a lookup table or lookup list and use that for your industry, size, and dimension lookup(s) prior to starting the server. I put industry size lookup outside of the server.R file because it doesn't need to be reactive and the ratio_filter_dim_x inside the server.R file because it does need to be reactive.

Also, as a manner of etiquette, please try to make sure your example only throws the fewest errors when posting online and contains the fewest possible lines of code to reproduce the problem.

Here is my fix:

library(plyr)
library(dplyr)
library(shiny)
library(shinydashboard)

dummyData <- data.frame(matrix(nrow=0,ncol=4,dimnames=list(c(),c("Ratio","Dimensions","Industry","Size"))))

industry_n <- 5
dims <- 4

for(i in 1:industry_n){
  s = sample(1:5,1)
  for(sz in 1:s){
    for(d in 1:dims){
      ratios <- sample(1:10,1)
      df <- data.frame(Ratio = paste0("Ratio",ratios))
      df <- df %>% mutate(Dimensions = paste0("Dimension",d),
                          Industry = paste0("Industry",i),
                          Size = paste0("Size",sz))
      dummyData <- rbind(dummyData,df)
    }
  }
}

colnames(dummyData)[which(colnames(dummyData)=="Dimensions")]<- "Risk.Dimension"

ind_n <- paste0("Industry",1:industry_n)
wd=6

# Generating a non-reactive lookup list, could also be a dataframe if so desired

industry_size_lookup_list<- lapply(unique(dummyData$Industry), function(x){unique(dummyData[which(dummyData$Industry == x), "Size"])})
names(industry_size_lookup_list)<- unique(dummyData$Industry)

runApp(list(
  ui = fluidPage(
    fluidRow(
      column(5,
             selectInput("industry",label="Industry",choices = names(industry_size_lookup_list),selected=names(industry_size_lookup_list)[1]),
             uiOutput("secondSelection")
      ),
      fluidRow(
        column(width = wd,
               list(h3("Dimension 1"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim1")))),
        column(width = wd,
               list(h3("Dimension 2"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim2")))),
        column(width = wd,
               list(h3("Dimension 3"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim3")))),
        column(width = wd,
               list(h3("Dimension 4"),
                    tags$div(align = 'left',
                             class = 'multicol',
                             uiOutput("dim4"))))
      )
    )),

  server = function(input, output,session) {

    output$secondSelection<- shiny::renderUI({
      if(!is.null(input$industry)){
        the_valid_choices<- industry_size_lookup_list[[which(names(industry_size_lookup_list)==input$industry)]]
      }
      if(is.null(input$industry)){
        the_valid_choices<- "Please Select An Industry"
      }
      selectInput(inputId = "size",label="Sizes",choices = the_valid_choices,selectize=FALSE, multiple = FALSE)
    })

    main_ratio_set<- shiny::reactive({
      if(!is.null(input$industry)){
        if(!is.null(input$size)){
          tmp<- dummyData[which(dummyData$Industry ==  input$industry & dummyData$Size == input$size),]
        }
      }
    })
    # The reactive lookup list
    ratio_filter_dim_x<- shiny::reactive({
      if(!is.null(main_ratio_set())){
        tmp<- lapply(unique(main_ratio_set()$Risk.Dimension), function(x){as.character(unique(main_ratio_set()[which(main_ratio_set()$Risk.Dimension == x), "Ratio"]))})
        names(tmp)<- unique(main_ratio_set()$Risk.Dimension)
        tmp
      }
    })

    observe({
      if(!is.null(ratio_filter_dim_x())){
        cat("STR of ratio_filter_dim_x", str(ratio_filter_dim_x()), "\n")
        cat("names of ratio_filter_dim_x", names(ratio_filter_dim_x()), "\n")
        }
      })

    # Use modules for the below. See link:
    # https://www.cultureofinsight.com/blog/2018/01/05/2017-11-13-reproducible-shiny-app-development-with-modules/

    output$dim1 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim1",label=NULL,choices = ratio_filter_dim_x()[["Dimension1"]],inline=F)
      }
    })
    output$dim2 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim2",label=NULL,choices = ratio_filter_dim_x()[["Dimension2"]],inline=F)
      }
    })
    output$dim3 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim3",label=NULL,choices = ratio_filter_dim_x()[["Dimension3"]],inline=F)
      }
    })
    output$dim4 = renderUI({
      if(!is.null(ratio_filter_dim_x())){
        shiny::checkboxGroupInput(inputId = "dim4",label=NULL,choices = ratio_filter_dim_x()[["Dimension4"]],inline=F)
      }
    })


  }
))

Hope this helps. It can still be further simplified and streamlined.