r语言 - 闪亮模块：在创建模块 UI 时已经存储参数(附加参数)，而不是将其传递给模块的服务器函数？

Question

我创建了一个模块sliderCheckbox，它将sliderInput和checkBoxInput捆绑在一起以禁用滑块输入-基本上可以声明"我不知道"，这对于类似调查的输入是必要的。当滑块被禁用时，我希望它返回一个默认值——通常是初始值，但不一定。

现在我的问题是：在初始化UI时，是否有可能传递这个默认值，即sliderCheckboxInput()由于默认值是一个类似于minimum和maximum的属性，因此它在逻辑上属于该属性，而且它也更适合我的其他设置。

示例：

library(shiny)
library(shinyjs)
sliderCheckboxInput <- function(id,description="",
min = 0,
max = 100,
value = 30,
default= NULL ##HERE I would want the default value to be set
cb_title = "I don't know"){
ns <- NS(id)
fluidRow(
column(width=9,
sliderInput(ns("sl"),
paste0(description, collapse=""),
min = min,
max = max,
value = value)
),
column(width=2,
checkboxInput(ns("active"),
cb_title, value=FALSE )
)
)
}
sliderCheckbox<- function(input, output, session,
default=NA) { #Problem: set default when initialising module
oldvalue<- reactiveVal()
observeEvent(input$active, {
if (input$active){
oldvalue(input$sl)
disable("sl")
updateSliderInput(session, "sl", value=default)
}else {
updateSliderInput(session, "sl", value=oldvalue())
enable("sl")
}
toggleState("sl", !input$active)
})
onclick("sl",
if(input$active) updateCheckboxInput(session, "active", value=FALSE)
)
return ( reactive({
if (input$active){
default
}else {
input$sl
}
}))
}

ui <- fluidPage(
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderCheckboxInput("bins", "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
bins_nr <- callModule(sliderCheckbox, "bins", default=44)
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x    <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = bins_nr() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui, server)

Answer 1

您可以使用隐藏的textInput将值从ui发送到服务器

library(shiny)
library(shinyjs)
sendValueToServer <- function(id, value) {
hidden(textInput(
id, "If you can see this, you forgot useShinyjs()", value
))
}
myModuleUI <- function(id, param) {
ns <- NS(id)
tagList(
sendValueToServer(ns("param_id"), param),
textOutput(ns("text_out"))
)
}
myModule <- function(input, output, session) {
param <- isolate(input$param_id)
output$text_out <- renderText({
param
})
}
shinyApp(
ui = fluidPage(
useShinyjs(),
myModuleUI("id", "test")
),
server = function(input, output, session) {
callModule(myModule, "id")
}
)

使用shine的JavaScript API可能有更直接的方法来实现这一点，但这是一个"纯R"解决方案，对于大多数用例来说应该足够了。请注意，您可以在初始化时使用的输入值

isolate(input$text_in)

因为ui总是在服务器之前构建的。如果所有东西都被封装到renderUI中，事情会变得更加复杂，但对您来说似乎不是这样。

Answer 2

聚会有些晚了，但我认为更整洁的方法是使用session$userData。这对主服务器功能和模块的服务器功能都可用。

因此，在主服务器中，在callModule创建模块服务器之前：

session$userData[["module_id"]]$defaultValue <- myDefaultValue

然后在模块服务器功能结束时：

return ( reactive({
if (input$active){
session$userData[["module_id"]]$defaultValue
} else {
input$sl
}
})
)

这让我觉得比使用隐藏输入更整洁、更健壮、更通用。