R Shiny Make slider value dynamic

后端 未结 4 1938
不知归路
不知归路 2021-02-14 09:01

I\'ve got a dropdown selector and a slider scale. I want to render a plot with the drop down selector being the source of data. - I\'ve got this part working

I simply wa

相关标签:
4条回答
  • 2021-02-14 09:54

    I think you're looking for the updateSliderInput function that allows you to programmatically update a shiny input: http://shiny.rstudio.com/reference/shiny/latest/updateSliderInput.html. There are similar functions for other inputs as well.

     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))
     })
    
    0 讨论(0)
  • 2021-02-14 09:55

    Hopefully this post will help someone learning Shiny:

    The information in the answers is useful conceptually and mechanically, but doesn't help the overall question.

    So the most useful feature I found in the UI API is conditionalPanel() here

    This means I could create a slider function for each dataset loaded and get the max value by loading in the data initially in global.R. For those that don't know, objects loaded into global.R can be referenced from ui.R.

    global.R - Loads in a ggplo2 method and test data objects (eset.spike & 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')
        )
      )
    ))
    
    0 讨论(0)
  • 2021-02-14 10:01

    Another alternative can be applying a renderUI approach like it is described in one of the shiny gallery examples:

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

    0 讨论(0)
  • 2021-02-14 10:01

    As @Edik noted the best way to do this would be to use an update.. type function. It looks like updateSliderInput doesnt allow control of the range so you can try using renderUI on the server side:

    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})
      }
    ))
    
    0 讨论(0)
提交回复
热议问题