弹出模式中的闪亮模块化输入在关闭时不会被写入响应值 [flexdashboard/shinydashboard]

Posted 2023-03-24

【中文标题】弹出模式中的闪亮模块化输入在关闭时不会被写入响应值 [flexdashboard/shinydashboard]

【英文标题】：Shiny modularized inputs inside pop-up modal aren't being written to reactiveValues when dismissed [flexdashboard/shinydashboard]

【发布时间】：2019-02-02 04:40:18

【问题描述】：

作为一个最小可行的例子，我 modularized 来自这里的基本例子：https://rmarkdown.rstudio.com/flexdashboard/shiny.html#simple_example

代码 sn-p（复制粘贴，在 RStudio 中以 .Rmd 运行应该可以解决问题）：

---
title: "*** example"
output: flexdashboard::flex_dashboard
runtime: shiny
---

```r global, include=FALSE
library(shiny)
library(flexdashboard)  # install.packages("flexdashboard")
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
data(faithful)

# UI modules
sidebarCharts <- function(id) 
  ns <- NS(id)
  tagList(
    p(),
    actionButton(ns("settings"), "Settings", icon = icon("cogs"), width = '100%', class = "btn btn-info"),p(),
    actionButton(ns("refreshMainChart") ,"Refresh", icon("refresh"), width = '100%', class = "btn btn-primary"),p()
    ,textOutput(ns("info"))  # FOR DEBUGGING
  )


mainChartUI <- function(id) 
  ns <- NS(id)
  plotOutput(ns("mainChart"), width = "100%")


# UI module for the 2 buttons in the modal:
modalFooterUI <- function(id) 
  ns <- NS(id)
  tagList(
    modalButton("Cancel", icon("remove")),
    actionButton(ns("modalApply"), "Apply", icon = icon("check"))
  )


server <- function(input, output, session) 

  # Init reactiveValues() to store values & debug info; https://github.com/rstudio/shiny/issues/1588
  rv <- reactiveValues(clicks = 0, applyClicks = 0,
                       bins = 20,
                       bandwidth = 1)

  # DEBUGGING
  output$info <- renderText(
    paste("You clicked the 'Settings' button", rv$clicks, "times. You clicked the 'Apply' button", rv$applyClicks, "times. The bin size is currently set to", rv$bins, "and the bandwidth is currently set to", rv$bandwidth)
  )

  settngsModal <- function(id) 
    ns <- NS(id)
    modalDialog(
      withTags(  # UI elements for the modal go in here
        fluidRow(
          column(4, "Inputs",
                 selectInput(ns("n_breaks"), label = "Number of bins:", choices = c(10, 20, 35, 50), selected = rv$bins, width = '100%')),
          column(4, "Go",
                 sliderInput(ns("bw_adjust"), label = "Bandwidth adjustment:", min = 0.2, max = 2, value = rv$bandwidth, step = 0.2, width = '100%')),
          column(4, "Here")
        )
      ),
    title = "Settings",
    footer = modalFooterUI("inputs"), 
    size = "l",
    easyClose = FALSE,
    fade = TRUE)
  

  # Sidebar 'Settings' modal
  observeEvent(input$settings, 
    showModal(settngsModal("inputs"))  # This opens the modal; settngsModal() defined below
    rv$clicks <- rv$clicks + 1  # FOR DEBUGGING
  )

  observeEvent(input$modalApply, 
    rv$applyClicks <- rv$applyClicks + 1  # FOR DEBUGGING
    rv$bins <- input$n_breaks  # This is where I set the reactiveValues() to those inputted into the modal.
    rv$bandwith <- input$bw_adjust
    removeModal()  # This should dismiss the modal (but it doesn't seem to work)
  )

  output$mainChart <- renderPlot(
    input$refreshMainChart  # Take dependency on the 'Refresh' buton

    hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(rv$bins),  
         xlab = "Duration (minutes)", main = "Geyser Eruption Duration")

    dens <- density(faithful$eruptions, adjust = rv$bandwidth)
    lines(dens, col = "blue")
  )



```

Column .sidebar
-----------------------------------------------------------------------

```r
callModule(server, "main")
sidebarCharts("main")
```

Column
-----------------------------------------------------------------------

### Main chart goes here

```r
mainChartUI("main")
```

截图：

这是所需的功能：

在应用启动时，图表应使用存储在 rv 中的默认参数 bin-size 和带宽呈现，reactiveValues() -- 这似乎有效。 当我第一次单击模态时，它应该会出现 bin-size 和带宽的默认参数 -- 这似乎也可以工作。 当我更新任一输入参数 AND 单击“应用”时，它应该关闭模式并随后将 rv reactiveValues() 对象内的相应参数设置为已选中 -- 这不起作用（模式都不会关闭，reactiveValues 也不会更新）。 在rv 中的reactiveValues() 更新为新的之后，图表不应重新渲染，直到用户点击“刷新”actionButton - 这也不起作用，但取决于 (3 ) 上面。

---

我做错了什么？？感觉好像我忽略了一些超级简单的事情。

谢谢！！

【参考方案1】：

问题在于您的模态和服务器函数具有不同的namespace id，因此无法以正常方式相互交谈。

当您使用callModule 调用您的server 函数时，您为您的模块提供"main" 的命名空间ID。当你生成你的 Modal 时，你给它命名空间 id "inputs"。因此，当您尝试使用observeEvent(input$modalApply... 访问服务器中的actionButton 时，它不起作用，因为它正在自己的命名空间（"main"）的inputs$ 中寻找modalApply，但它并不存在.

您需要做的是将模式保持在与调用它的服务器函数相同的命名空间中。您可以通过将 ns 函数从会话直接传递到模态 UI 函数来做到这一点。

不用传入id，然后用ns <- NS(id)重新生成ns，你可以直接用session$ns获取当前会话ns函数，然后将它传递给UI函数供它使用：

observeEvent(input$settings, 
    showModal(settngsModal(session$ns))


...

settngsModal <- function(ns) 
    ...
    footer = modalFooterUI(ns), 
    ...

通过以这种方式传递session$ns，您可以确保模式的 UI 元素将始终与调用它的服务器函数位于相同的命名空间中（因此可以访问）。您可以在此处阅读更多相关信息：http://shiny.rstudio.com/articles/modules.html#using-renderui-within-modules

---

至于您的第二个问题，只需将 renderPlot 中的其余代码包装在 isolate 函数中即可。 isolate 函数使reactive 内的reactive 值的更改不会使表达式无效并导致重新评估。现在，唯一可以导致renderPlot 重新评估的reactive 值是isolate 之外的值：input$refreshMainChart：

output$mainChart <- renderPlot(
    input$refreshMainChart  # Take dependency on the 'Refresh' buton
    isolate(
        hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(rv$bins),  
             xlab = "Duration (minutes)", main = "Geyser Eruption Duration")

        dens <- density(faithful$eruptions, adjust = rv$bandwidth)
        lines(dens, col = "blue")
    )
)

【讨论】：

好的，所以我做了你在第一部分中提到的更改；也就是说，我将settngsModal 中的调用的参数更新为settngsModal(session$ns) observeEvent 以及底层函数参数本身，但现在我收到此错误：警告：粘贴错误：无法强制键入“闭包”到“字符”类型的向量 95：粘贴 94：NS 93：modalFooterUI [#25] 82：settingsModal [#45] 74：observeEventHandler [#64]

由于您是直接传递ns 函数，而不是id 字符串，因此您还必须去掉调用ns <- NS(id) 的部分并确保参数被命名ns，不是id。这有意义吗？

我确实从settngsModal <- function(ns) ... 的第一部分删除了ns <- NS(id)。我是否也应该为 modalFooterUI 和 mainChartUI 删除和更改它？仍然很困惑。

是的，您也需要为modalFooterUI 更改它，因为那是您的modalApply 按钮所在的位置。当您在 settngsModal 函数中调用 modalFooterUI 时，您应该将相同的 ns 函数传递给它，以便模态页脚中的按钮仍然与您的服务器共享相同的命名空间

在重新阅读了您所写的内容以及您在原始答案中提供的链接后，灯泡刚刚在我的脑海中亮起。现在效果很好。非常感谢！！