Creating a categorical sliderInput within a rendered UI in R shiny

问题

I'm trying to create a categorical (as opposed to numeric) slider in shiny using sliderInput. Thanks to Dean Atali's answer here (Shiny slider on logarithmic scale), I'm able to create the slider.

However, I need to create the slider in server and pass it to the UI via renderUI and uiOutput. But, when I move the sliderInput into a renderUI call on the server-side, it no longer works. Here are two examples: the first one showing how the categorical slider works (when not using renderUI/uiOutput), and the second one showing how the categorical slider does not work (when using renderUI/uiOutput).

WORKING EXAMPLE (slider created in the UI)

library(shiny)
JScode <-
  "$(function() {
setTimeout(function(){
var names = ['Unrated', 'Emerging', '&nbsp;',  'Formative', '&nbsp;', '&nbsp;', 'Developed', '&nbsp;'];
var vals = [];
for (i = 0; i < names.length; i++) {
var val = names[i];
vals.push(val);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 7)})"

runApp(shinyApp(
  ui = fluidPage(
    tags$head(tags$script(HTML(JScode))),
    textOutput('texty'),
    sliderInput("pvalue",
                "PValue:",
                min = 0,
                max = 7,
                value = 0
    )
  ),
  server = function(input, output, session) {

    output$texty <- renderText({
      input$pvalue
    })
  }
))

Non-working example (slider created in server)

library(shiny)
JScode <-
  "$(function() {
setTimeout(function(){
var names = ['Unrated', 'Emerging', '&nbsp;',  'Formative', '&nbsp;', '&nbsp;', 'Developed', '&nbsp;'];
var vals = [];
for (i = 0; i < names.length; i++) {
  var val = names[i];
  vals.push(val);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 7)})"

runApp(shinyApp(
  ui = fluidPage(
    tags$head(tags$script(HTML(JScode))),
    textOutput('texty'),
    uiOutput('uu')
  ),
  server = function(input, output, session) {

    output$texty <- renderText({
      input$pvalue
    })
    output$uu <- renderUI({
      sliderInput("pvalue",
                  "PValue:",
                  min = 0,
                  max = 7,
                  value = 0
      )
    })
  }
))

How do I make the slider show the categories (rather than numbers) when the slider is generated in server?

回答1:

Moving the line where you include the JavaScript to the renderUI (and wrapping it in a div together with the input element so both are returned to the UI) seems to do the trick, working example below. I am no JavaScript expert, but I assume the reason for this is is that in your case, the DOM element does not exist yet and thus the JavaScript code is not attached - but someone please correct me if I am wrong in this assumption.

I added two pieces of code below, one with a categorical slider with interactive labels as suggested by @agenis in the comments, and another with your code slightly adjusted to make your example work.

Hope this helps!

---

1. Interactive categorical slider

library(shiny)

runApp(shinyApp(
  ui = fluidPage(
    numericInput('nlabs','number of labels:', min=3,max=10,value=3),
    checkboxInput('rev','Reverse?',value=FALSE),
    textOutput('texty'),
    uiOutput('uu')
  ),
  server = function(input, output, session) {

    output$texty <- renderText({
      input$pvalue
    })

    output$uu <- renderUI({

      # Create labels
      my_labs = sort(LETTERS[1:input$nlabs],decreasing = input$rev)
      my_labs = paste(sapply(my_labs,function(x){paste0("'",x,"'")}),collapse=",")
      # Create the JS code
      JScode <-paste0(
        "$(function() {
setTimeout(function(){
var names = [",
        my_labs,
        "];
var vals = [];
for (i = 0; i < names.length; i++) {
var val = names[i];
vals.push(val);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 7)})")

      # Return the div with the JS Code and the sliderInput.
      div(
        tags$head(tags$script(HTML(JScode))),
        sliderInput("pvalue",
                    "PValue:",
                    min = 0,
                    max = 7,
                    value = 0
        )
      )
    })
  }
))

---

2. Working version of your code

library(shiny)
JScode <-
  "$(function() {
setTimeout(function(){
var names = ['Unrated', 'Emerging', '&nbsp;',  'Formative', '&nbsp;', '&nbsp;', 'Developed', '&nbsp;'];
var vals = [];
for (i = 0; i < names.length; i++) {
var val = names[i];
vals.push(val);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 7)})"

runApp(shinyApp(
  ui = fluidPage(
    textOutput('texty'),
    uiOutput('uu')
  ),
  server = function(input, output, session) {

    output$texty <- renderText({
      input$pvalue
    })
    output$uu <- renderUI({
      div(
        tags$head(tags$script(HTML(JScode))),
        sliderInput("pvalue",
                    "PValue:",
                    min = 0,
                    max = 7,
                    value = 0
        )
      )
    })
  }
))

回答2:

You can use function sliderTextInput from package shinyWidgets :

library(shiny)
library(shinyWidgets)

runApp(shinyApp(
  ui = fluidPage(
    textOutput(outputId = 'texty'),
    uiOutput(outputId = 'uu')
  ),
  server = function(input, output, session) {

    output$texty <- renderText({
      input$pvalue
    })
    output$uu <- renderUI({
      sliderTextInput(
        inputId = "pvalue",
        label = "PValue:",
        grid = TRUE,
        choices = c("Unrated", "Emerging", "Formative", "Developed")
      )
    })
  }
))

来源：https://stackoverflow.com/questions/49490395/creating-a-categorical-sliderinput-within-a-rendered-ui-in-r-shiny