时间戳

首页 > 解决方案 > 闪亮的模块：在创建模块UI而不是将其传递给模块的服务器函数时已经存储参数（附加参数）？

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

问题描述

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

现在我的问题是：初始化 UI 时是否有可能传递此默认值，即使用sliderCheckboxInput()? 由于默认值是最小值和最大值之类的属性，因此它在逻辑上属于它，并且它也更适合我的其余设置。

例子：

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)

标签： rmoduleshiny

解决方案

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

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")
  }
)

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

isolate(input$text_in)

因为 ui 总是在服务器之前构建的。如果所有内容都包含在内，事情会变得更加复杂，renderUI但对您来说似乎并非如此。

推荐阅读