闪亮模块中的 updateSelectizeInput

Question

我想使用响应值来加载控件 selectizeInput 小部件。我可以使用一个简单的闪亮应用程序来做到这一点，但是当我尝试在模块中重新组织它时，我似乎无法复制它。

在下面的代码中，我有一个带有输入小部件和按钮的简单应用程序。按下按钮后，我希望 selectizeInput() 小部件使用存储在反应变量中的值进行更新。

library(shiny)

# GLOBAL VAR TO BE LOADED after pressing the button
# -------------
STORED <- reactiveValues(choices = c("a", "b", "c")
                         , selected = c("c"))

# UI
# -------------
ui <- fixedPage(
  wellPanel(
    # input widget
    selectInput("widget1"
                , "label"
                ,choices = c("WRONG A","WRONG B","WRONG C")
                ,selected="WRONG A"
                )

    # update button
    , actionButton("plotBtn"
                   , "update"
                   , class = "btn-primary")
  )
)

# SERVER
# -------------
server <- function(input, output, session) {

  observeEvent(input$plotBtn,{
    message("update button was pressed")

    updateSelectInput(session
                      ,"widget1"
                      ,choices = STORED$choices
                      , selected = STORED$selected
    )
  })
}

# APP
shinyApp(ui, server)

按下按钮后，小部件会正确更新并选择“c”，并正确导入选项。但是，当我尝试将其编写为闪亮的模块时，按钮不起作用。

图书馆（闪亮）

# INIT VARS TO BE LOADED AFTER PRESSING THE BUTTON
# ------------------------------------------------------------------------------
STORED <- reactiveValues(choices = c("a", "b", "c")
                         , selected = c("c"))

# MODULE SELECTIZEINPUT
# ------------------------------------------------------------------------------
input_widgetUI <- function(id) {
  ns <- NS(id)

  selectizeInput(ns("input_widget")
                 , label = "label"
                 , choices = c("WRONG A","WRONG B","WRONG C")
                 , selected = "WRONG A"
  )

}

# MODULE BUTTON
# ------------------------------------------------------------------------------
plotBtnUI <- function(id){

  ns <- NS(id)

  fluidPage(actionButton(ns("plotBtn"), "update", class = "btn-primary"))
}

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

  ns <- session$ns

  print("Loading plotBtn()")

  observeEvent(input$plotBtn, {

    message("update button was pressed")

    updateSelectizeInput(session
                         , ns("widget1")
                         , choices = STORED$choices
                         , selected= STORED$selected
                         )

  })
}


# #############################################################################
# SHINY APP
# #############################################################################
ui <- fixedPage(
  wellPanel(
    input_widgetUI("widget1")
    , plotBtnUI("button")
  )
)

server <- function(input, output, session) {
  callModule(plotBtn, "button")
}


shinyApp(ui, server)

我相信我可能使用了错误的 ID。非常欢迎任何建议！谢谢

Answer 1

您希望在同一个 UI 函数中拥有 selectizeInput 和 actionButton。否则，每个人都会有不同的命名空间。在这种情况下，您也不需要服务器部分中的ns 函数。只有在渲染动态 UI 对象时才需要它

这是您的代码的工作版本

STORED <- reactiveValues(choices = c("a", "b", "c")
                         , selected = c("c"))

# MODULE SELECTIZEINPUT
# ------------------------------------------------------------------------------
input_widgetUI <- function(id) {
  ns <- NS(id)
  tagList(
  selectizeInput(ns("input_widget")
                 , label = "label"
                 , choices = c("WRONG A","WRONG B","WRONG C")
                 , selected = "WRONG A"
  ),
  actionButton(ns("plotBtn"), "update", class = "btn-primary")  
  )

}


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

  ns <- session$ns

  print("Loading plotBtn()")

  observeEvent(input$plotBtn, {

    message("update button was pressed")
    updateSelectizeInput(session = getDefaultReactiveDomain()
                         , inputId = "input_widget"
                         , choices = STORED$choices
                         , selected= STORED$selected
    )

  })
}


# #############################################################################
# SHINY APP
# #############################################################################
ui <- fixedPage(
  wellPanel(
    input_widgetUI("widget1")
  )
)
server <- function(input, output, session) {
  callModule(plotBtn, "widget1")
}
shinyApp(ui, server)

Answer 2

这个解决方案更接近我所寻找的。它仍然允许将按钮和输入小部件保留在不同的模块中（例如，将按钮放在不同的选项卡上）。

library(shiny)
options(shiny.reactlog=TRUE)

# INIT GLOBAL VARS
# --------------------------------------------------------------------
STORED <- reactiveValues(choices = c("WRONG A","WRONG B","WRONG C")
                         , selected = "WRONG A")

# MODULE SELECTIZEINPUT
#----------------------------------------------------------------------
input_widgetUI <- function(id) {

  ns <- NS(id)

  tagList(
    selectizeInput(ns("input_widget")
                   , label = "label"
                   , choices = NULL
                   , selected = NULL
    )
  )
}

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

  #ns <- session$ns

  observe({

    updateSelectizeInput(session
                        , "input_widget"
                        , choices = STORED$choices
                        , selected= STORED$selected
                        , server=TRUE
                        )
  })

}

# MODULE BUTTON
# ---------------------------------------------------------------------
plotBtnUI <- function(id){

  ns <- NS(id)

  fluidPage(actionButton(ns("plotBtn"), "update", class = "btn-primary"))
}

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

   #ns <- session$ns

   print("Loading plotBtn()")

   observeEvent(input$plotBtn, {

     message("update button was pressed")

     # VARS TO BE LOADED AFTER PRESSING THE BUTTON
     STORED$choices <- c("a", "b", "c")
     STORED$selected <- c("c")

   })
}


# ######################################################################
# SHINY APP
# ######################################################################
ui <- fixedPage(
  tagList(
      input_widgetUI("widget1")
    , plotBtnUI("button")
  )
)

server <- function(input, output, session) {
  callModule(input_widgetSERVER, "widget1")
  callModule(plotBtnSERVER, "button")
}
# launch the app
shinyApp(ui, server)