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代码位于服务器部分的runjs中，当单击.irs div时，使用jquery将句柄不透明度更改为1；您可以根据需要将其设置为更具体的页面元素，但是.irs-line似乎对我不起作用。

您还需要在用户界面的某处添加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)

R Shiny Suppress滑块的sliderInput直到单击

1 个答案: