R 闪亮抑制滑块输入的滑块手柄，直到单击

Question

我正在尝试在 Shiny 应用程序中制作一个简单的视觉模拟比例。这些类型的刻度是简单的滑块，不会向用户提供任何信息，以免影响响应（没有刻度，没有标签）。我设法获得了所需的结果，除了一个：隐藏滑块的手柄，直到用户单击滑块。我知道我可以使用

.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代码在服务器部分的

runjs

中，当

.irs

div被点击时，使用jquery将句柄不透明度更改为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)

Answer 2

我已经尝试过你的解决方案，但不幸的是，它不起作用。