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

时间：2018-12-14 09:49:45

标签： r module shiny

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

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

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

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

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

  1. Store internal state in hidden Input
  2. 使用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：我不确定是否将解决方法作为解决方案。

2 个答案:

答案 0 :(得分：3)

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

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

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)

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

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

你不知道。至少不是直接。

内部状态通常最好不要被任何其他人修改。有一个广泛使用的范例，称为getters和setters方法，这就是我在这里使用的范例。您无需直接进入另一个模块并更改其状态-这将完全违反模块背后的原理（独立且孤立）。相反，我们可以让一个模块返回一个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)

答案 1 :(得分：0)

现在，我已经说服自己data.table也可以将列表存储为元素，因此我发布了变通方法2作为答案。但是，我仍然对访问模块内部的reactValues的更直接方式感兴趣。

将列表存储在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)
相关问题
最新问题