下面的应用程序包含一个actionButton Add data，该按钮每次单击都会插入一个UI元素。每个UI元素都是一个框，其中包含一个selectInput Select data和一个actionButton Edit，在单击它们时会打开一个模式。
每个模态包含：
Parameter和Value（此列是可编辑的）。 Apply，该按钮应用对Value所做的任何更改
列。当用户在框x内选择一个数据集时，将创建一个reactValue来将相应的参数存储在data.frame x_paramset（其中x是通过insertUI插入的框的ID）中，并添加一个{{ 1}}列，其值与val相同（请参见下面代码顶部的列表）。然后，我使用renderDataTable添加default列（其中包含numericInput）-该数据表显示在模式内部。
要更新data.frame以应用用户可能在模式中所做的任何更改，我使用了一个watchEvent来监听Value按钮并更新data.frame中的Apply列val，其值在x_paramset列中的numericInputs中。
这里是应用程序（bsModal已被注释掉，并被shinyWidgets :: dropdownButton取代了）：
Value尝试以下操作时遇到错误：
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(DT)
library(tidyverse)
all = list(p1 = list(a = list(id = "a", default = 10)),
p2 = list(x = list(id = "x", default = 20)))
# UI ----------------------------------------------------------------------
ui<-fluidPage(shinyjs::useShinyjs(),
tags$head(
tags$script("
$(document).on('click', '.dropdown-shinyWidgets li button', function () {
$(this).blur()
Shiny.onInputChange('lastClickId',this.id)
Shiny.onInputChange('lastClick',Math.random())
});
")
),
box(title = "Add data",
column(width = 12,
fluidRow(
tags$div(id = 'add')
),
fluidRow(
actionButton("addbox", "Add data")
))
)
)
# SERVER ------------------------------------------------------------------
server <- function(input, output, session) {
rvals = reactiveValues()
getInputs <- function(pattern){
reactives <- names(reactiveValuesToList(input))
name = reactives[grep(pattern,reactives)]
}
observeEvent(input$addbox, {
lr = paste0('box', input$addbox)
insertUI(
selector = '#add',
ui = tags$div(id = lr,
box(title = lr,
selectizeInput(lr, "Choose data:", choices = names(all)),
shinyWidgets::dropdownButton(inputId = paste0(lr, "_settings"),
circle = F, status = "success", icon = icon("gear"), width = "1000px",
tooltip = tooltipOptions(title = "Click to edit"),
tags$h4(paste0("Edit settings for Learner", lr)),
hr(),
DT::dataTableOutput( paste0(lr, "_paramdt") ),
bsButton(paste0(lr, "_apply"), "Apply")
) # end dropdownButton
)
) #end tags$div
) # end inserUI
# create reactive dataset
rvals[[ paste0(lr, "_paramset") ]] <- reactive({
do.call(rbind, all[[ input[[lr]] ]]) %>%
cbind(., lr) %>%
as.data.frame %>%
mutate(val = default)
}) # end reactive
# render DT in modal
output[[ paste0(lr, "_paramdt") ]] <- renderDataTable({
DT <- rvals[[ paste0(lr, "_paramset") ]]() %>%
mutate(
Parameter = id,
Value = as.character(numericInput(paste0(lr,"value",id), label = NULL, value = default))) %>%
select(Parameter:Value)
datatable(DT,
selection = 'none',
#server = F,
escape = F,
options = list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
}) # end renderDT
# Apply changes
observeEvent(input$lastClick, {
# replace old values with new
rvals[[ paste0(lr, "_paramset") ]](rvals[[ paste0(lr, "_paramset") ]]() %>%
mutate(
val = input$box1valuea
)
)
}) # end apply changes observeEvent
}) #end observeEvent
}
shinyApp(ui=ui, server=server)
-此
将模式内的numericInput重置为其默认值，而
我希望用户指定的值在申请时保持不变
更改或关闭模式。Add data >> Edit >> make some change to numericInput >> Apply或
单击两次Add data >> Edit >> Apply >> close modal >> Add data，然后在任一框中单击Add data。我不确定服务器逻辑在哪里出现故障。我知道Shiny不支持“持久使用”模式（https://github.com/rstudio/shiny/issues/1590），但是我想知道是否有解决方法？我也不确定在上述情况下Edit insertUI内部是什么导致应用程序崩溃。您能提供的任何帮助将不胜感激！