Question

我正在测试一个闪亮的应用程序的模块化。以下代码中的一个问题是，在“要分析的名称”下选择新名称时，更新的结果不成立。选择将在几秒钟内自动返回“name1”。非常感谢任何纠正它的建议。感谢。

library(shiny)

subgroupInput <- function(id){  
ns <-NS(id)
tagList(
  selectInput(ns("name"), 
              label = "name to analyze",
              choices = NULL,selected=NULL),

  radioButtons(ns('radio'), 'cutoffType', choices=c('percentile', 'value'), 
               selected = NULL, inline = FALSE),

  conditionalPanel(
    condition = paste0("input['", ns("radio"), "'] == 'percentile'"), 
    sliderInput(ns("cutoff1"), 
                label = "Bottom-trim percentile:",
                min = 0, max = 100, value = 5),

    sliderInput(ns("cutoff2"), 
                label = "Top-trim percentile:",
                min = 0, max = 100, value = 95)        
     ),
  conditionalPanel(
    condition = paste0("input['", ns("radio"), "'] == 'value'"), 
    sliderInput(ns("cutoff3"), 
                label = "Bottom-trim value:",
                min = 0, max = 100, value = -1),
    sliderInput(ns("cutoff4"), 
                label = "Top-trim value:",
                min = 0, max = 100, value = 1)
  )
  )
}

subgroup <- function(input, output, session,default_selected=NULL){  
  ns=session$ns

  model <- reactive({

    data = data.frame(matrix(rep(rnorm(100*100,sd=3)),ncol=100),stringsAsFactors = F)
    colnames(data)=paste0('name',1:100)

    namelist = colnames(data)

    updateSelectInput(session, "name",choices = namelist, selected = default_selected)

    validate(
      shiny::need(input$name,"Select name")
    )

    x = round(data[,input$name])
    updateSliderInput(session, "cutoff3", label="Cufoff value", min=min(x),max=max(x))
    updateSliderInput(session, "cutoff4", label="Cufoff value", min=min(x),max=max(x))


    if(input$radio=="percentile") {
        dt = data[,input$name]
        qt = quantile(dt,c(input$cutoff1,input$cutoff2)/100)
        result <- hist(dt[dt>qt[1] & dt<=qt[2]],main=paste0("Histogram of ",input$name))
      } 
    else if(input$radio=="value"){
        dt = data[,input$name]
        result <- hist(dt[dt>input$cutoff3 & dt<=input$cutoff4],main=paste0("Histogram of ",input$name))
      }

    return(list(plot = result, data = data, inname=input$name))
  })  

  return (model)
}

以上是模块。以下代码拨打电话：

shinyApp(
 ui = fluidPage(
  subgroupInput("test1"),
  plotOutput("plot")
 ),
 server = function(input, output, session){
    test <- shiny::callModule(subgroup,"test1")

  output$plot <- renderPlot({ 
  test()$plot
  })
 }
)

updateSelectInput在闪亮模块中不成立

0 个答案: