自动添加带有列名称的筛选器,并选择数据中每列的值名称、数据

2023-09-03 14:03:21 作者:怪我太逞强i

我希望根据列名添加/删除筛选器,即,如果我选择2个列名,这些列名应该显示numericRangeInputseletizeInput或基于类的任何其他名称。是否可以使用conditionalPanel

这是我正在尝试的

library(shiny)
nodes = read.csv("data/nodes.csv", header=T, as.is=T)

ui <- shinyUI(
  fluidPage(
    
    actionButton("addNode", "Add Node filter", icon=icon("plus", class=NULL, lib="font-awesome")),
    
    uiOutput("filterPage1")
  )
)

server <- function(input, output){
  i <- 0
  
  observeEvent(input$addNode, {
    i <<- i + 1
    output[[paste("filterPage",i,sep="")]] = renderUI({
      t4 = class(nodes[,names(nodes)[i]])
      print(t4)
      list(
        fluidPage(
          fluidRow(
            conditionalPanel(
              condition = "t4=='character'",
              column(6, selectInput(paste("filteringFactor",i,sep=""), paste0(names(nodes4)[i],':'),
                                    choices=unique(nodes[,names(nodes)[i]]), selected=NULL,
                                    width="100%")),
              column(6, actionButton(paste("removeFactor",i,sep=""), "",
                                     icon=icon("times", class = NULL, lib = "font-awesome"),
                                     onclick = paste0("Shiny.onInputChange('remove', ", i, ")"))),
                
              condition = "t4=='numeric'",
              column(6, sliderInput(paste("filteringFactor",i,sep=""), paste0(names(nodes4)[i],':'),
                                    choices=unique(nodes4[,names(nodes4)[i]]), selected=NULL,
                                    width="100%")),
              column(6, actionButton(paste("removeFactor",i,sep=""), "",
                                     icon=icon("times", class = NULL, lib = "font-awesome"),
                                     onclick = paste0("Shiny.onInputChange('remove', ", i, ")")))
              
            )
            
          )
        ),
        uiOutput(paste("filterPage",i + 1,sep=""))
      )
    })
  })
  
  observeEvent(input$remove, {
    i <- input$remove
    
    output[[paste("filterPage",i,sep="")]] <- renderUI({uiOutput(paste("filterPage",i + 1,sep=""))})
  })
}

shinyApp(ui, server)

推荐答案

我根据我分享的link举例阐述了我的评论(您的评论不可转载):

library(shiny)
library(shinyWidgets)
library(tools)
library(datasets)

d <- data(package = "datasets")
dataset_is <- sapply(gsub(" .*$", "", d$results[,"Item"]), function(x){is(get(x))[1]})
DFs <- names(dataset_is[dataset_is == "data.frame"])

filterParams <- function(vars){
  setNames(lapply(vars, function(x){
    list(inputId = x, title = paste0(tools::toTitleCase(x), ":"), placeholder = "...")
  }), vars)
}

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      selectInput("dataset", label = "Select dataset", choices = DFs),
      tags$h3("Filter data with selectize group"),
      uiOutput("panelProxy"),
      DT::dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  
  selected_dataset <- reactive({
    DF <- get(input$dataset)
    setNames(DF, gsub("\.", "_", names(DF))) # avoid dots in inputId's (JS special character)
  })
  
  vars_r <- reactive({
    input$vars
  })
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = selected_dataset,
    vars = vars_r
  )
  
  output$table <- DT::renderDataTable({
    req(res_mod())
    res_mod()
  })
  
  output$panelProxy <- renderUI({
    available_vars <- names(selected_dataset())
    panel(
      checkboxGroupInput(
        inputId = "vars",
        label = "Variables to use:",
        choices = available_vars,
        selected = available_vars,
        inline = TRUE
      ),
      selectizeGroupUI(
        id = "my-filters",
        params = filterParams(available_vars)
      ),
      status = "primary"
    )
  })
}

shinyApp(ui, server)
没有统计学背景,做数据分析很无厘头