Блестящий ползунок по логарифмической шкале

Ответ 1

Я не был уверен точно, что вы хотели в качестве вывода, но я сделал, чтобы возможные значения p были [0, 0.00001, 0.0001, 0.001, 0.01]. Если вы хотите что-то немного другое, надеюсь, этот ответ является достаточно хорошей отправной точкой.

В принципе, сначала я создал массив, который содержит значения чисел (0, 0.0000.1,...), а затем я просто использую специальную функцию обновления из API слайдера, чтобы эти значения зависли ползунок, Это довольно просто, как только вы выясните, как использовать API слайдера. Кроме того, по какой-то причине запуск этого внутри RStudio выглядит странно, но в браузере это прекрасно. Кроме того, обратите внимание, что у меня есть 5 мс задержки, потому что я хочу убедиться, что это выполняется после того, как ползунок инициализируется. Не самое чистое решение, возможно, лучший способ сделать это, но он работает.

library(shiny)

JScode <-
  "$(function() {
    setTimeout(function(){
      var vals = [0];
      var powStart = 5;
      var powStop = 2;
      for (i = powStart; i >= powStop; i--) {
        var val = Math.pow(10, -i);
        val = parseFloat(val.toFixed(8));
        vals.push(val);
      }
      $('#pvalue').data('ionRangeSlider').update({'values':vals})
    }, 5)})"

runApp(shinyApp(
  ui = fluidPage(
    tags$head(tags$script(HTML(JScode))),

    sliderInput("pvalue",
                "PValue:",
                min = 0,
                max = 1e-2,
                value = c(0, 1e-2)
    )
  ),
  server = function(input, output, session) {
  }
))

Ответ 2

Не уверен, что этот поток все еще активен, но на всякий случай хотел добавить более общий способ "логирования" inputSlider, используя атрибут функции prettify для функции ionRangeSlider, вместо того, чтобы перезаписывать значения с тем преимуществом, что вы можете определить min, max, шаг и значение по умолчанию для inputSlider как обычно, а затем все, что происходит на стороне Javascript, - это изменение отображаемых значений (два представленных параметра, один для числового вывода, один для научной нотации):

library(shiny)

# logifySlider javascript function
JS.logify <-
"
// function to logify a sliderInput
function logifySlider (sliderId, sci = false) {
  if (sci) {
    // scientific style
    $('#'+sliderId).data('ionRangeSlider').update({
      'prettify': function (num) { return ('10<sup>'+num+'</sup>'); }
    })
  } else {
    // regular number style
    $('#'+sliderId).data('ionRangeSlider').update({
      'prettify': function (num) { return (Math.pow(10, num)); }
    })
  }
}"

# call logifySlider for each relevant sliderInput
JS.onload <-
"
// execute upon document loading
$(document).ready(function() {
  // wait a few ms to allow other scripts to execute
  setTimeout(function() {
    // include call for each slider
    logifySlider('log_slider', sci = false)
    logifySlider('log_slider2', sci = true)
  }, 5)})
"

ui <- fluidPage(
  tags$head(tags$script(HTML(JS.logify))),
  tags$head(tags$script(HTML(JS.onload))),

  sliderInput("log_slider", "Log Slider (numbers):",
              min = -5, max = 3, value = -4, step = 1),

  sliderInput("log_slider2", "Log Slider (sci. notation):",
              min = -5, max = 3, value = 1, step = 0.5),

  br(),

  textOutput("readout1"),
  textOutput("readout2")
)

server <- function(input, output, session) {
  output$readout1 <- reactive({
    paste0("Selected value (numbers): ", input$log_slider, " = ", 10^input$log_slider)
  })

  output$readout2 <- reactive({
    paste0("Selected value (sci. notation): ", input$log_slider2, " = ", 10^input$log_slider2)
  })
}

shinyApp(ui, server)

Ответ 3

Причина, по которой вопрос не привлек больше внимания, заключается в том, что его трудно ответить. Чтобы сделать то, чего хочет ассер, вам нужно написать javascript и ввести его на веб-страницу. Ниже приведен код, который я адаптировал для правильного форматирования слайдера shiny в качестве дат. Я не пытался модифицировать его для логарифмического, потому что я только узнал достаточно javascript, чтобы возиться с этим script, а затем быстро удалил его из памяти, чтобы освободить место для более важных вещей, таких как сезонное меню пива на панели вниз по блоку,

Anyhoo:

    output$selectUI <-
        renderUI(
            list(sliderInput(inputId = "target", label = "Date",
                                             min = 0, max = diff_months(targetEnd(),targetStart()) - 1,
                                             value = diff_months(targetEnd(),targetStart()) - 1,
                                             animate = animationOptions( loop = T)),
                     singleton(HTML(
                '
            <script type="text/javascript">
            $(document).ready(function() {
            var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
            "July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
            var endDate = new Date(',
                year(Sys.Date()),',', month(Sys.Date())
                ,', 1);
            var slider = $("#dates").slider();
            var labels = slider.domNode.find(".jslider-label span");
            labels.eq(0).text("Jan., 1962");
            labels.eq(1).text([monthNames[endDate.getUTCMonth() +1], endDate.getUTCFullYear()].join(", "));
            // override the default "nice" function.
            slider.nice = function(value) {
alert("hi")
                var ref_date = new Date(1962, 1, 1);
                var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value));
                return [monthNames[slider_date.getUTCMonth()], slider_date.getUTCFullYear()].join(", ");
            }

            $(slider).trigger("slidechange");
            })

    $(document).ready(function() {
                var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
                    "July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
      var slider = $("#target").slider();
            var labels = slider.domNode.find(".jslider-label span");
          labels.eq(0).text([monthNames[', month(targetStart()) +1, '],', year(targetStart()), '].join(", "));
            labels.eq(1).text([monthNames[', month(targetEnd()) + 1, '], ', year(targetEnd()), '].join(", "));


      // override the default "nice" function.
      slider.nice = function(value) {
alert("hi")
        var ref_date = new Date(', year(targetStart()), ', ', month(targetStart()),',1 );
        // each slider step is 4 weeks, translating to 24 * 3600 * 1000 milliseconds
        var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value - 1));

        return [monthNames[slider_date.getUTCMonth()],
                slider_date.getUTCFullYear()].join(", ");
      }

            $(slider).trigger("slidechange");
    })
  </script>
            ')
            )
        )
)

Ответ 4

У меня нет блестящих на данный момент со мной, я немного расширил диапазон, что произойдет, если вы попробуете что-то вроде этого:

sliderInput("pvalue",
            "PValue:",
            min = 1e-02,
            max = 1e+02,
            value = -10^seq(-2, 2)
),

Ваше сообщение упоминается 1е-2, я использовал 1е-02, я проверил, как показано ниже

> 1e-2==1e-02
[1] TRUE