R Shiny сделать значение слайдера динамическим

у меня есть выпадающий селектор и шкалы слайдера. Я хочу отобразить график с выпадающим селектором, являющимся источником данных. - У меня эта часть работает!--3-->

Я просто хочу, чтобы максимальное значение слайдера изменилось на основе выбранного набора данных.

какие предложения?

сервер.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)
  })
})

пользовательский интерфейс.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")
    )
  )
))
8
r shiny shiny-server

4 ответов

как отметил @ 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})
  }
))
4

надеюсь, этот пост поможет кому-то учить блестящие:

информация в ответах полезна концептуально и механически, но не помогает общему вопросу.

поэтому самая полезная функция, которую я нашел в UI API, -conditionalPanel() здесь

это означает, что я могу создать функцию слайдера для каждого загруженного набора данных и получить максимальное значение, загрузив данные изначально в global.R. Для тех, кто не знает, объекты, загруженные в global.R можно ссылаться из ui.R.

глобальные.R - нагрузки в методе ggplo2 и объектах тестовых данных (eset.spike & obatch)

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

сервер.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()
    }
  )

})

пользовательский интерфейс.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')
    )
  )
))
4

Я думаю, вы ищете функцию 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))
 })
2

Другой альтернативой может быть применение подхода renderUI, как описано в одном из примеров блестящей галереи:

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

2