r - 面临访问闪亮模块动态输入值的问题

Question

我在从主闪亮服务器功能中的滑块访问闪亮模块的动态输入值时遇到问题。

在选择 metric2 时 SelectInput 的以下代码中，我应该能够看到具有特定范围和默认值的滑块。这完美无缺。但是滑块的值预计将在主要的闪亮服务器功能中显示为 TextOutput ，这是失败的。

主要闪亮文件：

library(shiny)


source("modules/showLowHighSliders.R")

ui <- fluidPage(
  fluidRow( 
    column(
      3,
      selectizeInput(
        inputId = "metricID",
        selected = NULL,
        multiple = TRUE,
        label = "Select a metric",
        choices = list(
          Type1 = c("metric1", "metric2", "metric3"),
          Type2 = c("metric4","metric5")
        ),
        options = list('plugins' = list('remove_button'))
      )
    ),
    column(2, 
           uiOutput(outputId = "lowerThresholdText"),
           showLowHighSlidersUI("sliders-metric2")
    )
  )
)

server <- function(input, output){

  
  ret <- callModule(module = showLowHighSliders, 
             id = "sliders-metric2", 
             metrics_selected=reactive(input$metricID))

  output$lowerThresholdText <- renderText({
    if(!is.null(input$metricID )){
      if(input$metricID == 'metric2'){
        paste("Lower Value: ", ret() )
        
      }
    }

  })
}

shinyApp(ui, server)

闪亮的模块：showLowHighSliders.R

showLowHighSlidersUI <- function(id) {
  ns <- NS(id)
  fluidPage(
    fluidRow(
      column(12, 
             tagList(
                # uiOutput(ns("lowerThresholdText")),
               uiOutput(ns("lowerThresholdSlider"))
             )
      )
    )
  )
}

# Function for module server logic
showLowHighSliders <- function(input, output, session, metrics_selected) {
  
 reactive({input$mySlider})
  
  output$lowerThresholdSlider <- renderUI({
    #print(metrics_selected())
    if(!is.null(metrics_selected() ) ){
      if('metric2' %in% metrics_selected() ){
        sliderInput(
          inputId = "mySlider",
          label = "",
          min = 0,
          max = 200,
          value = 20
        )
      }
    }
  })
  
  # output$lowerThresholdText <- renderText({
  #   #print(metrics_selected)
  #   if(!is.null(metrics_selected() )){
  #     if('SMA' %in% metrics_selected()){
  #       paste("Lower SMA: ", input$mySlider )
  #     }
  #   }
  #   
  # })
  
}

我也无法访问注释部分中显示的模块本身内的动态输入滑块值。

任何帮助表示赞赏。

标签： rshinyshinymodules

Answer 1

尝试这个

# Function for module server logic
showLowHighSliders <- function(input, output, session, metrics_selected) {
  
  # reactive({input$mySlider})
  ns <- session$ns
  output$lowerThresholdSlider <- renderUI({
    #print(metrics_selected())
    if(!is.null(metrics_selected() ) ){
      if('metric2' %in% metrics_selected() ){
        sliderInput(
          inputId = ns("mySlider"),
          label = "",
          min = 0,
          max = 200,
          value = 20
        )
      }
    }
  })
  
  output$lowerThresholdText <- renderText({
    #print(metrics_selected)
    if(!is.null(metrics_selected() )){
      #if('SMA' %in% metrics_selected()){
        paste("Lower SMA: ", session$input$mySlider )
      #}
    }

  })
  
}