在 R shiny 中呈现的 UI 中创建分类 sliderInput

Question

我正在尝试使用 sliderInput 创建一个闪亮的分类（而不是数字）滑块。感谢 Dean Atali 在这里的回答 ()，我能够创建滑块。

但是，我需要在 server 中创建滑块并通过 renderUI 和 uiOutput 将其传递给 UI。但是，当我将 sliderInput 移动到服务器端的 renderUI 调用时，它不再有效。这里有两个示例：第一个显示分类滑块如何工作（不使用 renderUI/uiOutput 时），第二个显示分类滑块如何不工作（使用 renderUI/uiOutput).

工作示例（在 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
    })
  }
))

无效示例（在 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
      )
    })
  }
))

如何在 server 中生成滑块时让滑块显示类别（而不是数字）？

Answer 1

将包含 JavaScript 的行移动到 renderUI（并将其与输入元素一起包装在 div 中，以便两者都返回到 UI) 似乎可以解决问题，下面是工作示例。我不是 JavaScript 专家，但我认为这是因为在您的情况下，DOM 元素尚不存在，因此未附加 JavaScript 代码 - 但有人如果我在这个假设上错了，请纠正我。

我在下面添加了两段代码，一段带有@agenis 在评论中建议的带有交互式标签的分类滑块，另一段代码稍作调整以使您的示例正常工作。

希望对您有所帮助！

1.交互式分类滑块

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。您的代码的工作版本

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
        )
      )
    })
  }
))

Answer 2

您可以使用包 shinyWidgets 中的函数 sliderTextInput :

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")
      )
    })
  }
))

在 R shiny 中呈现的 UI 中创建分类 sliderInput

Creating a categorical sliderInput within a rendered UI in R shiny

javascript

r

shiny

ion-range-slider