0

下面的应用程序包含一个 actionButton Add data，每次单击它时都会插入一个 UI 元素。每个 UI 元素都是一个框，其中包含一个 selectInput和一个在单击时打开模式Select data的 actionButton 。Edit

每个模态包含：

  1. 具有两列的数据表：Parameter和Value（此列是可编辑的）。
  2. 一个 actionButton Apply，它应用对列所做的任何更改Value 。

当用户选择框 x 内的数据集时，会创建一个 reactiveValue 以将相应的参数存储在 data.frame 中x_paramset（其中 x 是通过 insertUI 插入的框的 id）并添加一个val具有相同值的列default（参见列表在下面的代码顶部）。然后我使用 renderDataTable 添加Value列（其中包含 numericInput） - 此数据表显示在模式中。

为了更新 data.frame 以应用用户可能在模式中所做的任何更改，我使用了一个 observeEvent 来监听Apply按钮并使用val列中 numericInputsx_paramset内的值更新 data.frame 中的Value列。

这是应用程序（bsModal 已被注释掉并替换为 shinyWidgets::dropdownButton）：

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)

当我尝试以下操作时遇到错误：

  1. Add data >> Edit >> make some change to numericInput >> Apply- 这会将模式内的 numericInput 重置为其默认值，而我希望用户指定的值在应用更改或关闭模式时保持不变。
  2. 当我尝试时应用程序崩溃： Add data >> Edit >> Apply >> close modal >> Add data或单击Add data两次，然后单击Edit任一框。

我不确定我的服务器逻辑在哪里失败。我知道 Shiny 不支持“持久使用”模式（https://github.com/rstudio/shiny/issues/1590），但我想知道是否有解决方法？我也不确定insertUI observeEvent在上述情况下是什么导致应用程序崩溃。您能提供的任何帮助将不胜感激！

4

0 回答 0