在反应元素中更新私有但不更新 UI

Question

我有一个 R6 类，用于组织我的闪亮应用程序。本质上，我想为我正在创建的实验界面连接不同的 R6 类，并希望重用我的代码。作为一个简化的工作示例，请参见下面的代码。

library(R6)
library(stringi)
library(shiny)

df <- data.frame(dp = c("dp1", "dp2", "dp3"), desc = c("problem 1", "problem 2", "problem 3"))

app <- R6::R6Class(classname = "App",
            private = list(
              #unique string id
              ..id = stringi::stri_rand_strings(1, 18),
              #the data to be iterated through
              ..df = df,
              #counter to update text
              ..counter = 1,
              #initiating the dp and desc
              ..dp = 'dp1',
              ..desc = 'problem 1',
              
              #the underlying server, to be created like a normal server
              .server = function(input, output, session){
                output$text <- renderText({ 
                  private$..desc
                })
                
                observeEvent(input$button, {
                  private$..counter <- private$..counter + 1
                  self$update_private()
                  #check the private content since the print is not updating
                  print(private$..counter)
                  print(private$..dp)
                  print(private$..desc)
                })
              }
            ),
            public = list(
              #create names for ui elements
              button = NULL,
              text = NULL,
              initialize = function(){
                
                self$button <- self$get_id("button")
                self$text <- self$get_id("text")
                self$update_private()
              },
              
              #gives ui outputs unique names tied to the user's id
              get_id = function(name, ns = NS(NULL)){
                ns <- NS(ns(private$..id))
                id <- ns(name)
                return(id)
              },
              #automatically updates the private field based on the counter
              update_private = function(){
                if(private$..counter == 1){
                  private$..dp <- "dp1"
                } else if(private$..counter == 2){
                  private$..dp <- "dp2"
                } else{
                  private$..dp <- "dp3"
                }
                private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
              },
              
              ui = function(){
                fluidPage(
                  h1("An Example"),
                  mainPanel(
                  textOutput(self$text)),
                  sidebarPanel(
                  shiny::actionButton(inputId = self$button, 
                                      label = 'Update!', 
                                      width = '100%'
                  ))
                  

                )
              },#end ui
              
              server = function(input, output, session){
                callModule(module = private$.server, id = private$..id)
              }
            )
)

test <- app$new()

ui <- test$ui()

server <- function(input, output, session) {
  test$server()
}
shinyApp(ui = ui, server = server)

我想要什么：当有人单击操作按钮时，反应式 ui 将更新，数据框中所需的文本将被切片并显示。 我得到的是：内部私有数据字段正在更新，但反应式 ui 元素没有。

任何想法可能导致此问题或解决方法？我考虑过在外部尝试使用观察事件，然后使用新的计数器编号重新启动课程。但我似乎也无法弄清楚那个选项。

感谢您的帮助！

Answer 1

对于遇到此问题的任何人...我发现即使私有正在更新，即使渲染在技术上是一个反应式环境，您也需要将您的数据公开存储在反应式字段中。

library(R6)
library(stringi)
library(shiny)

df <- data.frame(dp = c("dp1", "dp2", "dp3"), desc = c("problem 1", "problem 2", "problem 3"))

app <- R6::R6Class(classname = "App",
            private = list(
              #unique string id
              ..id = stringi::stri_rand_strings(1, 18),
              #the data to be iterated through
              ..df = df,
              #counter to update text
              ..counter = 0,
              #initiating the dp and desc
              ..dp = NA,
              ..desc = NA,
              
              #the underlying server, to be created like a normal server
              .server = function(input, output, session){
                
                output$text <- renderText({ 
                  self$desc$text
                })
                
                observeEvent(input$button, {
                  private$..counter <- private$..counter + 1
                  
                  self$update_private()
                  self$desc$text <- private$..desc
                  #check the private content since the print is not updating
                  print(private$..counter)
                  print(private$..dp)
                  print(private$..desc)
                })
              }
            ),
            active = list(
              .counter = function(value){
                if(missing(value)){
                  private$..counter
                }else{
                  private$..counter <- value
                }
              }
            ),
            public = list(
              #create names for ui elements
              button = NULL,
              text = NULL,
              
              
              #Need this to update the text***************
              desc = reactiveValues(text = NA),
              
              initialize = function(counter = self$.counter){
                self$.counter <- counter
                self$button <- self$get_id("button")
                self$text <- self$get_id("text")
                self$update_private()
                self$desc$text <- private$..desc
              },
              
              #gives ui outputs unique names tied to the user's id
              get_id = function(name, ns = NS(NULL)){
                ns <- NS(ns(private$..id))
                id <- ns(name)
                return(id)
              },
              #automatically updates the private field based on the counter
              update_private = function(){
                if(private$..counter == 1){
                  private$..dp <- "dp1"
                } else if(private$..counter == 2){
                  private$..dp <- "dp2"
                } else{
                  private$..dp <- "dp3"
                }
                private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
              },
              
              ui = function(){
                fluidPage(
                  h1("An Example"),
                  mainPanel(
                  textOutput(self$text)),
                  sidebarPanel(
                  shiny::actionButton(inputId = self$button, 
                                      label = 'Update!', 
                                      width = '100%'
                  ))
                  

                )
              },#end ui
              
              server = function(input, output, session){
                counter <- reactiveVal(private$..counter)
                callModule(module = private$.server, id = private$..id)
              }
            )
)

test <- app$new(counter = 1)
ui <- test$ui()


server <- function(input, output, session) {
  test$server()
}
shinyApp(ui = ui, server = server)