Question

我有一个下拉选择器和一个滑块刻度。我想渲染一个绘图，下拉选择器是数据源。 - 我已经完成了这部分工作

我只想根据选择的数据集更改滑块的最大值。

有什么建议吗？

server.R

library(shiny)
shinyServer(function(input, output) {

source("profile_plot.R")
load("test.Rdata")

output$distPlot <- renderPlot({
  if(input$selection == "raw") {
    plot_data <- as.matrix(obatch[1:input$probes,1:36])
  } else if(input$selection == "normalised") {
  plot_data <- as.matrix(eset.spike[1:input$probes,1:36])
  } 

  plot_profile(plot_data, treatments = treatment, sep = TRUE)
  })
})

ui.R 库（有光泽）

shinyUI(fluidPage(
  titlePanel("Profile Plot"),

  sidebarLayout(
    sidebarPanel(width=3,
    selectInput("selection", "Choose a dataset:", 
                 choices=c('raw', 'normalised')),
    hr(),
    sliderInput("probes",
              "Number of probes:",
              min = 2,
              max = 3540,
              value = 10)
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

Answer 1

正如@Edik所指出的，最好的方法是使用update..类型函数。看起来updateSliderInput不允许控制范围，因此您可以尝试在服务器端使用renderUI：

library(shiny)
runApp(list(
  ui = bootstrapPage(
    numericInput('n', 'Maximum of slider', 100),
    uiOutput("slider"),
    textOutput("test")
  ),
  server = function(input, output) {
    output$slider <- renderUI({
      sliderInput("myslider", "Slider text", 1,
                  max(input$n, isolate(input$myslider)), 21)
    })

    output$test <- renderText({input$myslider})
  }
))

Answer 2

希望这篇文章能帮助有人学习Shiny：

答案中的信息在概念上和机械上都很有用，但对整个问题没有帮助。

因此，我在UI API中找到的最有用的功能是conditionalPanel() here

这意味着我可以为每个加载的数据集创建一个滑块函数，并通过加载global.R中最初的数据来获取最大值。对于那些不了解的人，可以从global.R引用加载到ui.R的对象。

global.R - 加载ggplo2方法和测试数据对象（eset.spike＆amp; obatch）

source("profile_plot.R")
load("test.Rdata")

server.R -

library(shiny)
library(shinyIncubator)
shinyServer(function(input, output) {
  values <- reactiveValues()

  datasetInput <- reactive({
    switch(input$dataset,
           "Raw Data" = obatch,
           "Normalised Data - Pre QC" = eset.spike)
  })

  sepInput <- reactive({
    switch(input$sep,
           "Yes" = TRUE,
           "No" = FALSE)
  })

  rangeInput <- reactive({
    df <- datasetInput()
    values$range  <- length(df[,1])
    if(input$unit == "Percentile") {
      values$first  <- ceiling((values$range/100) * input$percentile[1])
      values$last   <- ceiling((values$range/100) * input$percentile[2])
    } else {
      values$first  <- 1
      values$last   <- input$probes      
    }
  })

  plotInput <- reactive({
    df     <- datasetInput()
    enable <- sepInput()
    rangeInput()
    p      <- plot_profile(df[values$first:values$last,],
                           treatments=treatment, 
                           sep=enable)
  })

  output$plot <- renderPlot({
    print(plotInput())
  })

  output$downloadData <- downloadHandler(
    filename = function() { paste(input$dataset, '_Data.csv', sep='') },
    content = function(file) {
      write.csv(datasetInput(), file)
    }
  )

  output$downloadRangeData <- downloadHandler(
    filename = function() { paste(input$dataset, '_', values$first, '_', values$last, '_Range.csv', sep='') },
    content = function(file) {
      write.csv(datasetInput()[values$first:values$last,], file)
    }
  )

  output$downloadPlot <- downloadHandler(
    filename = function() { paste(input$dataset, '_ProfilePlot.png', sep='') },
    content = function(file) {
      png(file)
      print(plotInput())
      dev.off()
    }
  )

})

<强> ui.R

library(shiny)
library(shinyIncubator)

shinyUI(pageWithSidebar(
  headerPanel('Profile Plot'),
  sidebarPanel(
    selectInput("dataset", "Choose a dataset:", 
                choices = c("Raw Data", "Normalised Data - Pre QC")),

    selectInput("sep", "Separate by Treatment?:",
                choices = c("Yes", "No")),

    selectInput("unit", "Unit:",
                choices = c("Percentile", "Absolute")),


    wellPanel( 
      conditionalPanel(
        condition = "input.unit == 'Percentile'",
        sliderInput("percentile", 
                    label = "Percentile Range:",
                    min = 1, max = 100, value = c(1, 5))
      ),

      conditionalPanel(
        condition = "input.unit == 'Absolute'",
        conditionalPanel(
          condition = "input.dataset == 'Normalised Data - Pre QC'",
          sliderInput("probes",
                      "Probes:",
                      min = 1,
                      max = length(eset.spike[,1]),
                      value = 30)
        ),

        conditionalPanel(
          condition = "input.dataset == 'Raw Data'",
          sliderInput("probes",
                      "Probes:",
                      min = 1,
                      max = length(obatch[,1]),
                      value = 30)
        )
      )
    )
  ),

  mainPanel(
    plotOutput('plot'), 
    wellPanel(
      downloadButton('downloadData', 'Download Data Set'),
      downloadButton('downloadRangeData', 'Download Current Range'),
      downloadButton('downloadPlot', 'Download Plot')
    )
  )
))

Answer 3

我认为你正在寻找updateSliderInput函数，它允许你以编程方式更新闪亮的输入： http://shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html。其他输入也有类似的功能。

 observe({
     x.dataset.selection = input$selection
     if (x.dataset.selection == "raw") {
        x.num.rows = nrow(obatch)
     } else {
        x.num.rows = nrow(eset.spike)
     }
     # Edit: Turns out updateSliderInput can't do this, 
     # but using a numericInput with 
     # updateNumericInput should do the trick.
     updateSliderInput(session, "probes",
       label = paste("Slider label", x.dataset.selection),
       value = c(1,x.num.rows))
 })

Answer 4

另一个替代方法是应用一个类似于闪亮的图库示例中描述的renderUI方法：

http://shiny.rstudio.com/gallery/dynamic-ui.html

R Shiny使滑块值动态化

4 个答案: