R Shiny Suppress滑块输入的滑块句柄，直到单击

Question

我正在尝试在 Shiny App 中制作一个简单的视觉模拟比例。这些类型的量表是简单的滑块，不会向用户提供任何信息，以免产生偏差（无刻度，无标签）。我设法得到了想要的结果，除了一个：隐藏滑块的句柄，直到用户单击滑块。我知道我可以使用.irs-slider {display: none;} 隐藏句柄，但我想要的是它在用户单击滑块时出现，并出现在用户单击的位置（值）中。

这是我写到现在的：

library(shiny)

server <-function(input, output) {

  output$value <- renderPrint({ input$slider1 })

}


ui <- fixedPage(
  tags$style(type = "text/css", "
      .irs-bar {display: none;}
      .slidecontainer { width: 100%; }
      .irs-bar-edge {display: none;}
      .irs-grid-pol {display: none;}
      .irs-slider {width: 10px; height: 20px; top: 20px;}
      .irs-from, .irs-to, .irs-min, .irs-max { visibility: hidden !important;   }
      .irs-single {visibility: hidden !important; }
  "),

  titlePanel("Title"),
  br(),
  h4("Please respond"),

  fluidRow(
    column(12, align="center",

       sliderInput(
         inputId = "slider1", 
         label = h3("Slider"), 
         min=0, max=100, value=50,
         ticks=FALSE,
         width="100%"
       )
    )
  ),

  br(),

  fluidRow(
  column(4, verbatimTextOutput("value"))
  )

)

shinyApp(ui, server)

Answer 1

这是一个使用 shinyjs 包的解决方案，它提供了将 JavaScript 代码添加到您的应用程序的功能。

我已将.irs-slider.single { opacity: 0;} 添加到 css 块中，以便在页面加载时使句柄透明。 js代码在server部分的runjs中，使用jquery将.irsdiv点击时的句柄不透明度改为1；如果您愿意，您可以将其用作更具体的页面元素，但 .irs-line 似乎对我不起作用。

您还需要在 UI 中的某处添加useShinyjs()。

library(shiny); library(shinyjs)

server <-function(input, output) {

  output$value <- renderPrint({ input$slider1 })
  runjs("$( '.irs').click(function(){$('.irs-slider.single').css('opacity', 1)})")
}


ui <- fixedPage(
  tags$style(type = "text/css", "
             .irs-bar {display: none;}
             .irs-slider.single { opacity: 0;}
             .slidecontainer { width: 100%; }
             .irs-bar-edge {display: none;}
             .irs-grid-pol {display: none;}
             .irs-slider {width: 10px; height: 20px; top: 20px;}
             .irs-from, .irs-to, .irs-min, .irs-max { visibility: hidden !important;   }
             .irs-single {visibility: hidden !important; }
             "),
  useShinyjs(),



  titlePanel("Title"),
  br(),
  h4("Please respond"),

  fluidRow(
    column(12, align="center",

       sliderInput(
         inputId = "slider1", 
         label = h3("Slider"), 
         min=0, max=100, value=50,
         ticks=FALSE,
         width="100%"
       )
    )
  ),

  br(),

  fluidRow(
  column(4, verbatimTextOutput("value"))
  )

)

shinyApp(ui, server)