R shiny: удалить динамически созданный интерфейс - PullRequest
0 голосов
/ 03 августа 2020

После этого обсуждения , где я добавляю 2 pickerInput виджета с модулем после нажатия actionButton, чтобы разбить набор данных diamonds (ggplot2 пакет) по столбцам и по строкам.

Теперь я пытаюсь удалить пары pickerInput с помощью кнопки. Проблема в том, что, поскольку виджеты вызываются из модуля, как обновить набор данных после удаления средств выбора?

library(shiny)
library(shinyWidgets)
library(ggplot2)

### MODULE ###
module.UI <- function(id, variables){
  ns <- NS(id)
  
  ui = fluidRow(
    column(width =5,
           pickerInput(inputId = ns("picker_variable"),
                       choices = variables,
                       selected = NULL
           )
    ),
    column(width = 5,
           pickerInput(inputId = ns("picker_value"),
                       choices = NULL,
                       selected = NULL
           )
    ),
    column(width = 2,
           actionButton(inputId = ns("rm_button"), label = "Discard")
    )
  )
}

module <- function(input, output, session, data, variables){
  ns <- session$ns
  
  observeEvent(input$picker_variable,{
    updatePickerInput(session,
                      inputId = "picker_value",
                      choices = as.character(unlist(unique(data[, input$picker_variable]))),
                      selected = NULL
    )
  })
  
  # Remove filter #
  observeEvent(input$rm_button, {
    updatePickerInput(session,
                      inputId = "picker_value",
                      choices = NULL,
                      selected = NULL)
    
    updatePickerInput(session,
                      inputId = "picker_variable",
                      choices = NULL,
                      selected =NULL)
    
    removeUI(
      selector = paste0("div:has(> #", ns('picker_variable'))
    )
    removeUI(
      selector = paste0("div:has(> #", ns('picker_value'))
    )
    removeUI(
      selector = paste0("div:has(> #", ns('rm_button'))
    )
  })
  
  return(input)
}


### APP ###
ui <- fluidPage(
  mainPanel(
    tags$div(id = "add_UI_here"),
    actionButton(inputId = "add", label = "Add"),
    actionButton(inputId = "view", label = "View"),
    tableOutput("table_out")
  )
)

list_modules <- list()
current_id <- 1

server <- function(input, output, session) {
  
  observeEvent(input$add, {
    
    new_id <- paste0("module_", current_id)
    
    list_modules[[new_id]] <<-
      callModule(module = module, id = new_id,
                 data = diamonds, variables = c("cut", "color", "clarity"))
    
    insertUI(selector = "#add_UI_here",
             ui = module.UI(new_id, variables = c("cut", "color", "clarity")))
    
    current_id <<- current_id + 1
    
  })
  
  # Output table subset #
  Table <- eventReactive(input$view, {
    vec <- NULL
    filters <- unlist(lapply(seq_len(length(list_modules)), function(i) {
      vec <- c(vec, setNames(list_modules[[i]]$picker_value, rep(list_modules[[i]]$picker_variable, length(list_modules[[i]]$picker_value))))
      return(vec)
    }))
    
    v <- split(unname(filters), names(filters))
    i <- Reduce('&', Map(function(x, y){x %in% y}, diamonds[names(v)], v))
    head(diamonds[i, ], 20)
  })
  
  output$table_out <- renderTable({
    Table()
  })
}

shinyApp(ui = ui, server = server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...