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

【问题标题】：Shiny Modules: Accessing and changing reactiveValues situated inside module`s server function from the outside?闪亮的模块：从外部访问和更改位于模块服务器功能内的反应值？
【发布时间】：2019-05-15 13:50:04
【问题描述】：

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

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

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

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

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

Store internal state in hidden Input
使用 data.table A,B 的按引用逻辑调用（见下文）。有other ways of implementing 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)

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

【问题讨论】：

标签： r module shiny

【解决方案1】：

我没有通读你的整个帖子，因为它似乎包含几个问题，但我会解决主要问题，第一个问题是粗体：如何从外部访问和更改模块内部的响应值？

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

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)

我希望您能理解它更易于阅读、使用和扩展。

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

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

内部状态一般最好不要被其他人修改。有一种广泛使用的范例，称为 getter 和 setter 方法，我将在这里使用它。您不会直接进入另一个模块并更改它的状态 - 这将完全违反模块背后的原则（独立和隔离）。相反，我们可以让一个模块返回一个 getter 方法——在我们的例子中，这意味着返回它的值（就像我在上面对 value 和 changes 列表所做的那样），还有一个 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)

【讨论】：

是的，我希望有类似“set”方法的东西，但不认为可以简单地返回它。我对变量的作用域还是有点迷惑……

【解决方案2】：

既然我说服自己 data.table 也可以将列表存储为元素，我将发布解决方法 2 作为答案。但是，我仍然对访问模块内的 reactiveValues 的更直接方式感兴趣。

在 data.table 中存储列表

test=data.table(x=1:2, y=list(list(a="dsf", b="asf"), list("2dsf")))
test
test[1,y]
test[2,y

解决方法 2：使用 data.table

#Problem: How to change reactiveValues from the outside?
## Using call-by-reference of data.table

library(shiny)
library(data.table)

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, dt){
  ns<-NS(targetModule)
  updateSliderInput(session,ns("sl"),value=oldModule() )

  dt[name==targetModule, count:=attr(oldModule(),"changesCount")-1]

}

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

  observeEvent(input$sl,{

    rv$changesCount[name==id,count:=count+1] 
    rv$triggerupdate=rv$triggerupdate+1
                     })

  output$changesCount=renderText({
    rv$triggerupdate
    rv$changesCount[name==id, count]
    })

  return(reactive({
    ret <- input$sl
    attr(ret,"changesCount")<-rv$changesCount[name==id,count]
    ret
  }))

}



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

  textOutput("module1state"),
  textOutput("module2state"),
  p(),
  p("dt doesn't refresh if not triggered:"),
  tableOutput("dtstate"),
  actionButton("RefreshDtButton", "Show and refresh state of dt"),
  tableOutput("dtstate2")

)

server= function(input, output, session) {
  dt<-data.table(name=c("module1","module2"),
                 count=0)
  module1<-callModule(module,"module1",dt,"module1") #id must be repeated
  module2<-callModule(module,"module2", dt, "module2")

  observeEvent(input$synchButton, synchModule(session,"module2",module1, dt)
               )
  observeEvent(input$RefreshDtButton, output$dtstate2<-renderTable(dt))

  output$module1state=renderPrint(module1() )
  output$module2state=renderPrint(module2() )
  output$dtstate=renderTable(dt) ##No reactivity  without triggering with data.table


}

shinyApp(ui, server)

【讨论】：