R Shiny collect multiple reactive input value and pass to plot

Question

I have a dataframe:

df1<-data.frame(ID1=c("A","A","B"),
                ID2=c("A","B","C"),
                Value=1:3)

I would like to generate reactive barplot which can show uniqe item of the data whatever the group I choose. the ui:

ui <- fluidPage(
  fluidRow(
    sidebarPanel(
      # fileInput("file1","File"),
      selectInput("select1","Select a group",choices = names(df1)),
      actionButton("submit1","Submit"),
      uiOutput("ui1")
    ),
    mainPanel(
      tableOutput('show_inputs'),
      textOutput("show_inputs_text"),
      plotOutput("plot1")
    )
  )
)

the server:

server <- function(input, output){
  df2<-reactive({df1})
  temptV<-reactive({
    as.matrix(
      unique(
        df2() %>%
          select(input$select1)
      )
    )
  })
  ve<-isolate(list())
  co<-isolate(list())
  observeEvent(input$submit1,{
    for(i in 1:length(temptV())){
      ve[[i]]<-colourpicker::colourInput(
        inputId = paste0("colorID",i),
        label= paste0(temptV()[i])
      )
      co[[i]]<-paste0("colorID",i)
    }
    output$ui1<-renderUI(
      ve
    )
    
    ##check the output of reactiveValuesToList
    t1<-reactive({
      x <- reactiveValuesToList(input)
      data.frame(
        names = names(x),
        values = unlist(x, use.names = FALSE)
      )
    })
    output$show_inputs <- renderTable({
      t1()
    })
    output$show_inputs_text <- renderText({
      unlist(co)
    })
    #plot
    p<-reactive(
      ggplot(df1,aes(x=df1[,input$select1],y=df1[,"Value"],fill=df1[,input$select1]))+
        geom_bar(stat = "identity")+
        scale_fill_manual(values = t1()[t1()$names %in% unlist(co),"values"])
      )
    output$plot1<-renderPlot(
      p()
    )
  })
}

shinyApp(ui = ui,server = server)

I used a loop to generate i number of the colorinput based on the unique items of the group in df1, and I collect the colorinput IDs in co. Then I used the reactiveValuesToList to fetch all input IDs and subset those in co and pass the corresponding values to the bar plot scale_fill_manual.

It works like: When there are two unique item, two colorinput and two bars: When there are three unique item, three colorinput and three bars:

However, when I added fileInput in the ui, the results in reactiveValuesToList became a chaos and I was not able to collect the exact IDs for the scale_fill_manual,like:

Any suggestion to deal with this problem? Or is there any easy way to achieve my purpose?

Answer 1

One issue is that until you load a file, file1 is NULL. When you create t1 from input it will include file1 = NULL. Therefore, you have a valid name for the names column of the data.frame but no corresponding value to put in values which is what's giving the error you see about different numbers of rows.

Since you don't want to see the parts of input related to the file upload in t1(whether or not one is added), you can just remove that in either case with x[!grepl("file", names(x))].

I also converted all the variables in df1 to factor so they will work with a discrete color palette.

library(shiny)

df1<-data.frame(ID1=c("A","A","B"),
                ID2=c("A","B","C"),
                Value=factor(1:3))

ui <- fluidPage(
  fluidRow(
    sidebarPanel(
      fileInput("file1","File"),
      selectInput("select1","Select a group",choices = names(df1)),
      actionButton("submit1","Submit"),
      uiOutput("ui1")
    ),
    mainPanel(
      tableOutput('show_inputs'),
      textOutput("show_inputs_text"),
      plotOutput("plot1")
    )
  )
)

server <- function(input, output){
  df2<-reactive({df1})
  temptV<-reactive({
    as.matrix(
      unique(
        df2() %>%
          select(input$select1)
      )
    )
  })
  ve<-isolate(list())
  co<-isolate(list())
  observeEvent(input$submit1,{
    for(i in 1:length(temptV())){
      ve[[i]]<-colourpicker::colourInput(
        inputId = paste0("colorID",i),
        label= paste0(temptV()[i])
      )
      co[[i]]<-paste0("colorID",i)
    }
    output$ui1<-renderUI(
      ve
    )
    
    ##check the output of reactiveValuesToList
    t1<-reactive({
      x <- reactiveValuesToList(input)
      data.frame(
        names = names(x[!grepl("file", names(x))]),
        values = unlist(x[!grepl("file", names(x))], use.names = FALSE)
      )
    })
    output$show_inputs <- renderTable({
      t1()
    })
    output$show_inputs_text <- renderText({
      unlist(co)
    })
    #plot
    p<-reactive(
      ggplot(df1,aes(x=df1[,input$select1],y=df1[,"Value"],fill=df1[,input$select1]))+
        geom_bar(stat = "identity")+
        scale_fill_manual(values = t1()[t1()$names %in% unlist(co),"values"])
    )
    output$plot1<-renderPlot(
      p()
    )
  })
}

shinyApp(ui = ui,server = server)