通过模块化 Shiny R 代码过滤数据：insertUI 和 callModule

Question

通过简化我要解决的问题，我创建了一个可重现的示例。 我正在尝试：

1. 让用户 select 一个他们想要应用过滤器的表
2. 创建一个操作按钮，让用户 select 一个或多个过滤条件：
   • 从选定的表中选择一个数字列
   • 从 slider 限制列的范围
3. 一次重置所有过滤器（尚未为此部分编写代码）

我似乎无法正确解决我的代码。 将不胜感激任何帮助！

library(shiny)

# creating the actionbutton ui function
add.filter.UI = function(id) {

  ns = NS(id)

  div(
    id = ns("break"),

    fluidRow(
      uiOutput(outputId = ns("sel.col")),
      uiOutput(outputId = ns("rng.filter")))
  )

}

# creating the actionbutton server function
add.filter.server = function(input, output, session) {

  ns <- session$ns

  tbl = reactive({ eval(parse(text = input$sel.tbl)) })

  col.nms = reactive({ names(tbl() %>% select_if(is.numeric)) })

  # creating the dynamic select column UI when the action button is clicked
  output$sel.col <- renderUI({
    selectInput(inputId = ns("sel.col"),
                label = "Select a column",
                choices =  col.nms(),
                multiple = F)
  })

  col.df = reactive({ tbl()[, input$sel.col] })

  # creating the dynamic range filter UI when the action button is clicked
  output$rng.filter <- renderUI({
    sliderInput(inputId = ns("rng.filter"),
                label = "Filter the range",
                value = c(min(col.df(), na.rm = T), max(col.df(), na.rm = T)),
                min = min(col.df(), na.rm = T),
                max = max(col.df(), na.rm = T),
                step = (max(col.df(), na.rm = T) - min(col.df(), na.rm = T)) / 1000) # 1,000 breaks
  })

  # applying the column / range filter to the table per filter created from the action button
  eval(parse(text = values[[input$sel.tbl]])) <- eval(parse(text = values[[input$sel.tbl]])) %>%
    rename(Var = one_of(input$sel.col)) %>%
    filter(Var >= min(input$rng.filter), Var <= max(input$rng.filter)) %>%
    rename(!!input$sel.col := Var)

}

# Define UI ----
ui <- fluidPage(

  sidebarLayout(

    sidebarPanel(

      selectInput(inputId = "sel.tbl", label = "Select a table",
                  choices = c("mtcars", "iris"),
                  selected = "mtcars", multiple = F),

      actionButton("add_filter", "Filter", icon = icon("plus"))

    ),

    mainPanel(
      navbarPage(title = "Nav",
                 tabPanel("default",  tableOutput(outputId = "tbl")),
                 tabPanel("filtered", tableOutput(outputId = "tbl.filtered"))

      )
    )

  )

)

# Define server logic ----
server <- function(input, output, session) {

  values = reactiveValues(mtcars = mtcars, iris = iris)

  # setting up the dynamic filter action button
  observeEvent(input$add_filter, {

    insertUI(
      selector = paste0("#filter_", input$add_filter - 1, "-break"),
      where = "afterEnd",
      ui = add.filter.UI(paste0("filter_", input$add_filter))
    )

    callModule(
      module = add.filter.server,
      id = paste0("#filter_", input$add_filter)
    )

  })

  # displaying the raw table
  output$tbl = renderTable(

    eval(parse(text = input$sel.tbl))

  )

  # displaying the filtered table from the action button
  output$tbl.filtered = renderTable(

    eval(parse(text = values[[input$sel.tbl]]))

  )

}

# Run the app ----
shinyApp(ui = ui, server = server)

Answer 1

这是部分答案。 你仍然需要弄清楚你想要filter什么，以及如何处理数据集中的变化，因为从前一个数据集中选择的变量变得无效。 尝试这个

library(shiny)
library(tidyverse)

# creating the actionbutton ui function
add.filter.UI = function(id) {
  
  ns = NS(id)
  
  tagList(
    #id = ns("break"),
    
    fluidRow(uiOutput(ns("sel_col")),
             uiOutput(ns("rng_filter"))
    )
  )
  
}

add.filter.server <- function(id,tbl) {
  moduleServer(id, function(input, output, session) {
# creating the actionbutton server function
#add.filter.server = function(input, output, session) {
  
  ns <- session$ns
  values <- reactiveValues(mydf=NULL)
  #tbl = reactive({ eval(parse(text = input$sel.tbl)) })
  
  col.nms = reactive({ names(get(tbl()) %>% select_if(is.numeric)) })
  
  
  # creating the dynamic select column UI when the action button is clicked
  output$sel_col <- renderUI({
    req(col.nms())
    selectInput(inputId = ns("sel.col"),
                label = "Select a column",
                choices =  col.nms(),
                multiple = F)
  })
  
  col.df <- reactive({ 
    req(input$sel.col)
    df <- get(tbl())
    df1 <- as.data.frame(df[,input$sel.col])
    df1
  })
  #observe({print(col.df())})
  
  # creating the dynamic range filter UI when the action button is clicked
  output$rng_filter <- renderUI({
    req(col.df())
    sliderInput(inputId = ns("rng.filter"),
                label = "Filter the range",
                value = c(min(col.df(), na.rm = T), max(col.df(), na.rm = T)),
                min = min(col.df(), na.rm = T),
                max = max(col.df(), na.rm = T),
                step = (max(col.df(), na.rm = T) - min(col.df(), na.rm = T)) / 1000) # 1,000 breaks
  })
  
  # applying the column / range filter to the table per filter created from the action button - needs work
  values$mydf <- get(tbl()) # %>%
  #eval(parse(text = values[[input$sel.tbl]])) <- eval(parse(text = values[[input$sel.tbl]])) %>%
    # rename(Var = one_of(input$sel.col)) # %>%
    # dplyr::filter(Var >= min(input$rng.filter), Var <= max(input$rng.filter)) %>%
    # rename(!!input$sel.col := Var)
  
  return(values)
  
  })
}

# Define UI ----
ui <- fluidPage(
  
  sidebarLayout(
    
    sidebarPanel(
      
      selectInput(inputId = "sel.tbl", label = "Select a table",
                  choices = c("mtcars", "iris"),
                  selected = "mtcars", multiple = F),
      
      actionButton("add_filter", "Filter", icon = icon("plus")),
      tags$div(id = 'placeholder')
      
    ),
    
    mainPanel(
      navbarPage(title = "Nav",
                 tabPanel("default",  tableOutput(outputId = "tbl")),
                 tabPanel("filtered", tableOutput(outputId = "tbl.filtered"))
                 
      )
    )
    
  )
  
)

# Define server logic ----
server <- function(input, output, session) {
  
  values = reactiveValues(mtcars = mtcars, iris = iris, mydf=NULL)
  
  observe({
    if (input$add_filter==0)  values$mydf <- eval(parse(text = values[[input$sel.tbl]]))
  })
  # setting up the dynamic filter action button
  observeEvent(c(input$add_filter,input$sel.tbl), {
    id <- paste0("#filter_", input$add_filter - 1, "-break")
    insertUI(
      selector = '#placeholder',
      #selector = paste0("#filter_", input$add_filter - 1, "-break"),
      where = "afterEnd",
      ui =tags$div(  
        add.filter.UI(paste0("filter_", input$add_filter)),
        id = id
      )
    )
    
    value <- add.filter.server(id = paste0("filter_", input$add_filter), reactive(as.character(input$sel.tbl)))
    values$mydf <- value$mydf
  },ignoreInit = TRUE)
  
  # displaying the raw table
  output$tbl = renderTable(
    
    eval(parse(text = input$sel.tbl))
    
  )
  
  # displaying the filtered table from the action button
  output$tbl.filtered = renderTable(
    values$mydf
    #eval(parse(text = values[[input$sel.tbl]]))
    
  )
  
}

# Run the app ----
shinyApp(ui = ui, server = server)