rShiny Looping on ui 过滤条件

rShiny Looping on ui filter conditions

我正在尝试按照以下步骤在 rShiny 中创建一个仪表板

  1. Select一个参数
  2. 针对此参数
  3. 从来源table过滤数据
  4. 为列之一创建此过滤数据的列表
  5. 遍历此列表以显示图表等... 我已经尝试了各种选项来完成这项工作,但 ui 和服务器之间的通信没有按预期进行

我已经创建了一个如下的测试设置

library(shiny)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)

select齿轮数 找到具有该档位数量的汽车 创建这些汽车的列表 使用循环显示每辆车的数据。需要循环,因为稍后可以添加其他输出类型(如图形)

simpUI <- function(id) {
    tagList(tableOutput(NS(id, "dat_output"))
            numericInput(NS(id, "GearNumber"), "Gear Numbers", 3),
            lapply(seq(1, length(v_lst_CarName), by = 1), function(i) {
                v_CarName = v_lst_CarName[i]
                v_obj_CarName = paste0('sp_cars_', v_CarName)
                tableOutput(NS(id, v_obj_CarName))
            }))
}

simpServer <- function(id) {
    moduleServer(id, function(input, output, session) {
        output$dat_output <- renderTable(df_mtcars)
        v_lst_CarName <-
            reactive(df_mtcars[GearNumber == input$GearNumber]$CarName)
        for (v_CarName in v_lst_CarName)
            v_obj_CarName = paste0('sp_cars_', v_CarName)
        output$v_obj_CarName <- renderTable(v_obj_CarName)
    })
}

ui <- fluidPage(fluidRow(simpUI("cars")))

server <- function(input, output, session) {
    simpServer("cars")
}
shinyApp(ui =  ui, server = server)

最好做服务器端处理。试试这个

library(shiny)
library(ggplot2)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)

simpUI <- function(id) {
  ns <- NS(id)
  tagList(tableOutput(ns("dat_output")),
          numericInput(ns("GearNumber"), "Gear Numbers", 3),
          uiOutput(ns("plotxy")),
          tableOutput(ns("v_obj_CarName")),
          verbatimTextOutput(ns("mylist")),
          plotOutput(ns("myplot"))
          )
}

simpServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    output$dat_output <- renderTable(head(df_mtcars))
    mydf <- reactive(df_mtcars[df_mtcars$gear == input$GearNumber,])
    v_lst_CarName <-  eventReactive(mydf(), {paste0("sp_cars_",mydf()$CarName)})
    
    output$plotxy <- renderUI({
      req(mydf())
      tagList(
        selectInput(ns("xvar"), label = "X-axis variable", choices = names(mydf()), selected=names(mydf())[2] ),
        selectInput(ns("yvar"), label = "Y-axis variable", choices = names(mydf()), selected=names(mydf())[5] )
      )
    })
    
    output$v_obj_CarName <- renderTable({mydf()})
    output$mylist <- renderPrint(list(v_lst_CarName() ))
    
    output$myplot <- renderPlot({
      req(input$xvar,input$yvar)
      ggplot(mydf(),aes(x=.data[[input$xvar]], y=.data[[input$yvar]])) + geom_point()
    })
  })
}

ui <- fluidPage(fluidRow(simpUI("cars")))

server <- function(input, output, session) {
  simpServer("cars")
}
shinyApp(ui =  ui, server = server)