闪亮的模块：从外部访问和更改位于模块服务器功能内部的反应值？

Question

我有一个闪亮的模块，它使用反应值来存储其内部状态。在下面的示例中，这仅用于输出输入更改的数字，但我的实际用例更复杂。

我现在想创建一个函数，该函数可用于将这些模块之一设置为另一个模块的状态，包括内部状态 - 或更一般地说：我想创建一个函数 updateModule，它也可以更新内部状态。

所以我的问题是：如何从外部访问和更改模块的内部反应值？

另一个与我的特殊目的相关的问题是：如何在更新输入时防止内部反应值更新 - 或者如何重置它（回到主要问题？

目前，我知道两种可能的解决方法：

1. 将内部状态存储在隐藏输入中
2. 使用 data.table A、B的按引用调用逻辑（见下文）。还有其他实现 call-by-reference 的方法，但还没有使用它们。

但是，我很想知道是否有更直接的解决方案，也因为我要更新的内部结构是更复杂的列表。

示例代码

#Problem: How to change reactiveValues from the outside?

library(shiny)

moduleUI <- function(id, label=id,min = 0,max = 100,value = 30){
  ns <- NS(id)

  fluidRow(
        column(width=9,
               sliderInput(ns("sl"), label=label, min=min, max=max, value=value)
               ),
        column(width=2,
               textOutput(ns("changesCount") )
               )
        )
}

synchModule<-function(session, targetModule, oldModule){
  ns<-NS(targetModule)
  updateSliderInput(session,ns("sl"),value=oldModule() )

  ##Accessing and changing internal Value of targetModule??

}

module<- function(input, output, session){
  rv<-reactiveValues(changesCount=0)

  observeEvent(input$sl,rv$changesCount<-rv$changesCount+1)

  output$changesCount=renderText(rv$changesCount)

  return(reactive({
    ret <- input$sl
    attr(ret,"changesCount")<-rv$changesCount
    ret
  }))

}



ui=fluidPage(
  moduleUI("module1"),
  moduleUI("module2"),
  actionButton("synchButton", "Set Module 2 to state of Module 1."),

  textOutput("module1state"),
  textOutput("module2state")

)

server= function(input, output, session) {
  module1<-callModule(module,"module1")
  module2<-callModule(module,"module2")

  observeEvent(input$synchButton, synchModule(session,"module2",module1)
               )

  output$module1state=renderPrint(module1() )
  output$module2state=renderPrint(module2() )

}

shinyApp(ui, server)

解决方法 1：使用隐藏的 NumericInput

#Problem: How to change reactiveValues from the outside?
##Workaround using hidden input

library(shiny)
library(shinyjs)

moduleUI <- function(id, label=id,min = 0,max = 100,value = 30){
  ns <- NS(id)

  fluidRow(
        column(width=9,
               sliderInput(ns("sl"), label=label, min=min, max=max, value=value)
               ),
        column(width=2,
               textOutput(ns("changesCount") ),
                          hidden(numericInput(
                            ns("changesCountNumeric"), "If you can see this, you forgot useShinyjs()", 0)
                          )
               )
        )
}

synchModule<-function(session, targetModule, oldModule){
  ns<-NS(targetModule)
  updateSliderInput(session,ns("sl"),value=oldModule() )

  updateNumericInput(session,ns("changesCountNumeric"), 
                     value=attr(oldModule(),"changesCount")-1) #-1 to account for updating slider itself, 

}

module<- function(input, output, session){

  observeEvent(input$sl,
               updateNumericInput(session,"changesCountNumeric", 
                                  value=input$changesCountNumeric+1)
  )

  output$changesCount=renderText(input$changesCountNumeric)

  return(reactive({
    ret <- input$sl
    attr(ret,"changesCount")<-input$changesCountNumeric
    ret
  }))

}



ui=fluidPage(
  useShinyjs(),
  moduleUI("module1"),
  moduleUI("module2"),
  actionButton("synchButton", "Set Module 2 to state of Module 1."),

  textOutput("module1state"),
  textOutput("module2state")

)

server= function(input, output, session) {
  module1<-callModule(module,"module1")
  module2<-callModule(module,"module2")

  observeEvent(input$synchButton, synchModule(session,"module2",module1)
               )

  output$module1state=renderPrint(module1() )
  output$module2state=renderPrint(module2() )

}

shinyApp(ui, server)

Ps：我不确定是否将我的解决方法作为解决方案。

Answer 1

我没有通读你的整篇文章，因为它似乎包含几个问题，但我将解决主要问题，第一个粗体的问题：如何从外部访问和更改模块内部的reactiveValues？

首先，为了得到我提出的解决方案，我想提供一种不同的方式来从模块返回信息。您可以返回一个列表，而不是使用值和该值的属性，这更容易使用。这是稍微修改的应用程序：

library(shiny)

moduleUI <- function(id, label=id,min = 0,max = 100,value = 30){
  ns <- NS(id)

  fluidRow(
    column(width=9,
           sliderInput(ns("sl"), label=label, min=min, max=max, value=value)
    ),
    column(width=2,
           textOutput(ns("changesCount") )
    )
  )
}

synchModule<-function(session, targetModule, oldModule){
  ns<-NS(targetModule)
  updateSliderInput(session,ns("sl"),value=oldModule$value() )

  ##Accessing and changing internal Value of targetModule??

}

module<- function(input, output, session){
  rv<-reactiveValues(changesCount=0)

  observeEvent(input$sl,rv$changesCount<-rv$changesCount+1)

  output$changesCount=renderText(rv$changesCount)

  return(list(
    value = reactive({ input$sl }),
    changes = reactive({ rv$changes }),
    print = reactive({ paste0("Num: ", input$sl, "; changes: ", rv$changesCount) })
  ))

}



ui=fluidPage(
  moduleUI("module1"),
  moduleUI("module2"),
  actionButton("synchButton", "Set Module 2 to state of Module 1."),

  textOutput("module1state"),
  textOutput("module2state")

)

server= function(input, output, session) {
  module1<-callModule(module,"module1")
  module2<-callModule(module,"module2")

  observeEvent(input$synchButton, 
               synchModule(session,"module2",module1)
  )

  output$module1state=renderPrint(module1$print() )
  output$module2state=renderPrint(module2$print() )

}

shinyApp(ui, server)

我希望您能体会到它更易于阅读、使用和扩展。

现在，您的主要问题是：如何访问和更改模块的内部反应值？

你没有。至少不是直接的。

内部状态通常最好不要被其他人修改。有一种广泛使用的范式，称为 getter 和 setter 方法，我将在这里使用它。您不会直接进入另一个模块并更改其状态 - 这将完全违反模块背后的原则（独立和隔离）。相反，我们可以让一个模块返回一个 getter 方法——在我们的例子中，这意味着返回它的值（就像我上面对valueandchanges列表所做的那样），还有一个 setter 方法——这将是一个其他人可以按顺序调用的函数设置模块内的值。

如果这还没有 100% 有意义，那么我的意思的要点是：将此“setter”添加到模块的返回列表中：

setState = function(value, count) {
  updateSliderInput(session, "sl", value = value)
  rv$changesCount <- count - 1
}

现在我们不再需要进入一个模块并直接改变它的状态，我们可以简单地调用setState()! 这是完整的修改代码：

library(shiny)

moduleUI <- function(id, label=id,min = 0,max = 100,value = 30){
  ns <- NS(id)

  fluidRow(
    column(width=9,
           sliderInput(ns("sl"), label=label, min=min, max=max, value=value)
    ),
    column(width=2,
           textOutput(ns("changesCount") )
    )
  )
}

synchModule<-function(session, targetModule, oldModule){
  oldModule$setState(targetModule$value(), targetModule$count())
}

module<- function(input, output, session){
  rv<-reactiveValues(changesCount=0)

  observeEvent(input$sl,rv$changesCount<-rv$changesCount+1)

  output$changesCount=renderText(rv$changesCount)

  return(list(
    value = reactive({ input$sl }),
    count = reactive({ rv$changesCount }),
    print = reactive({ paste0("Num: ", input$sl, "; changes: ", rv$changesCount) }),
    setState = function(value, count) {
      updateSliderInput(session, "sl", value = value)
      rv$changesCount <- count - 1
    }
  ))

}



ui=fluidPage(
  moduleUI("module1"),
  moduleUI("module2"),
  actionButton("synchButton", "Set Module 2 to state of Module 1."),

  textOutput("module1state"),
  textOutput("module2state")

)

server= function(input, output, session) {
  module1<-callModule(module,"module1")
  module2<-callModule(module,"module2")

  observeEvent(input$synchButton, 
               synchModule(session,module1,module2)
  )

  output$module1state=renderPrint(module1$print() )
  output$module2state=renderPrint(module2$print() )

}

shinyApp(ui, server)