После этого обсуждения , где я добавляю 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)