R Shiny 收集多个反应输入值并传递给绘图

Question

赏金将在 5 天后到期。 此问题的答案有资格获得+50声望赏金。 Lennon Lee正在从有信誉的来源寻找答案。

我有一个数据框：

df1<-data.frame(ID1=c("A","A","B"),
                ID2=c("A","B","C"),
                Value=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),
        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)

我使用循环根据df1中组的唯一项生成i个颜色输入，并收集co中的颜色输入 ID。 然后我使用reactiveValuesToList来获取所有输入 ID 并将co中的 ID 子集化，并将相应的值传递给条形图scale_fill_manual 。

它的工作原理如下：当有两个唯一项目、两个颜色输入和两个条时： 当存在三个唯一项、三个颜色输入和三个条时：

但是，当我在 ui 中添加fileInput时， reactiveValuesToList中的结果变得混乱，我无法收集scale_fill_manual的确切 ID，例如：

有什么建议可以解决这个问题吗？ 或者有什么简单的方法可以实现我的目的？

Answer 1

一个问题是，在您加载文件之前， file1是NULL 。 当您从input创建t1时，它将包含file1 = NULL 。 因此，您对data.frame的names列有一个有效的名称，但没有相应的值可以放入values中，这就是您看到的有关不同行数的错误的原因。

由于您不想在t1中看到与文件上传相关的input部分（无论是否添加），您可以在任何一种情况下使用x[!grepl("file", names(x))] 。

我还将df1中的所有变量转换为factor ，以便它们可以使用离散的调色板。

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)