Using javascript to alter noUIslider tags in R Shiny error when performing Math.pow(10,x) when x = 0

问题

In an earlier SO question here I have come to a point where I have a noUiSliderInput that gets it's labels updated to a scientific notation format with the help of javascript.

The remaining problem is that the noUiSliderInput jumps to 10 when the input is 0 and it therefore should jump to 1. (10^0 is 1, not 10). I suspect a problem with Math.pow(10,x) is the cause but I am not sure

UPDATE: The initial problem of the slider jumping to the maximum value has been fixed by changing the javascript code, which now takes values from shiny as input for the min, max and value of the slider. I have changed the code of the app here in the question to represent the current situation.

#END UPDATE#

The behavior is simulated here with the use of a second sliderInput and numericInput boxes that causes all three values needed for the noUiSliderInput to cahange

In my real app the noUiSliderInput is linked to a plot, and whatever data column the user chooses to plot. So, whatever data the user chooses to plot will require the noUiSliderInput to update it's range. The slider is also linked to a datatable with earlier created settings (a datatable of threshold values for some of the columns in the data), and when the user clicks a datatable entry, it will update the drop down that selects which data is to be plotted (and thus the noUiSliderInput range), as well as at what height the threshold (noUiSliderInput value) should be based on the value in the datatable.

This fires three changes at once, range (i.e. min & max of noUiSliderInput), as well as value of the noUiSliderInput.

I managed to get a dummy app that simulates this behavior working, except the value of the noUiSliderInput gets updated wrong by the current javascript it seems.

The schematic looks like this roughly

Where you can see that clicking on the table will send a value to the noUiSliderInput value, and a parameter name to the parameter selectInput, which then gets the data, sends it to the plot, and send the min, max: range to the noUiSliderInput. It is build this way because the user can also select parameters (columns) from the selectInput directly (many of which are not in the table of thresholds)

App so far:

library(shiny)
library(shinyWidgets)
library(shinyjs)

js <- function(Min, Max, Start){
  sprintf(paste(
    "var slider = document.getElementById('Histoslider').noUiSlider;",
    "slider.updateOptions({",
    "  start: %s,",
    "  range: {min: %s, max: %s},",
    "  format: wNumb({", 
    "    encoder: function(x){return parseFloat(Math.pow(10,x));}", 
    "  })", 
    "});",
    "var pipsValues = $('.noUi-value');",
    "pipsValues.each(function(){$(this).html('10<sup>'+$(this).attr('data-value')+'</sup>')});",
    sep = "\n"
  ), Start, Min, Max)
}

ui <- fluidPage(
  useShinyjs(),
  tags$br(),
  fluidRow(
    column(4,
           uiOutput('TestSliderOut'), 
           actionButton(inputId = "UpdateSlider", label = 'Update')
    ),
    column(6, 
           sliderInput("slider2", label = NULL, min = -5, max = 20, value= c(1, 5), step = 1),
           numericInput(inputId = 'SlMin', label = 'Min', value = 1, min = -5, max = 20),
           numericInput(inputId = 'SlMax', label = 'Max', value = 5, min = -5, max = 20),
           numericInput(inputId = 'SlVal', label = 'Val', value = 3, min = -5, max = 20),
           br(),
           h5('Update counter'),
           verbatimTextOutput(outputId = "updates"),
           h5('slider value'),
           verbatimTextOutput(outputId = 'ouputval')
    )
  )
)



server <- function(input, output, session) {

  values <- reactiveValues( Counter = 0)

  output$TestSliderOut <- renderUI({
    noUiSliderInput(
      inputId = "Histoslider", label = "Slider vertical:",
      min = -2, max = 4, step = 0.01,
      value = 0, margin = 100, 
      pips = list(mode="range", density=2),
      orientation = "vertical", 
      width = "300px", height = "300px",   direction = "rtl", 
      behaviour = "tap"
    )
  })

  observeEvent(input$slider2, {
    ## simulates the change of multipe parameters of the slider: min, max, value
    newvalue <- (input$slider2[2]-input$slider2[1])/2+input$slider2[1]
    updateNumericInput(session, inputId = 'SlMin', value = input$slider2[1])
    updateNumericInput(session, inputId = 'SlMax', value = input$slider2[2])
    updateNumericInput(session, inputId = 'SlVal', value = newvalue)

  })

  observe({
    updateNoUiSliderInput(session, inputId = 'Histoslider', range = c(input$SlMin, input$SlMax), value = input$SlVal)
    shinyjs::delay(1, {  ## delay the javascript so that it runs after the slider has updated its values
      runjs(js(input$SlMin, input$SlMax, input$SlVal))     })
  })

  output$updates <- renderPrint(values$Counter)


  output$ouputval <- renderPrint(input$Histoslider)

  observeEvent(input$SlMin, { values$nouiMin <- input$SlMin })
  observeEvent(input$SlMax, { values$nouiMax <- input$SlMax })
  observeEvent(input$SlVal, { values$nouiVal <- input$SlVal })

  observeEvent(input$Histoslider, {
    print('changing code')
    runjs(js(values$nouiMin, values$nouiMax, values$nouiVal))     ## fires ones on first build of the slider
  }, once = TRUE)

}

shinyApp(ui, server)

回答1:

Hmm that does look strange. It seems to work by using the set method (set the value of the slider) instead of updating the start option:

js <- function(Min, Max, Start){
  sprintf(paste(
    "var slider = document.getElementById('Histoslider').noUiSlider;",
    "slider.updateOptions({",
    "  range: {min: %s, max: %s},",
    "  format: wNumb({", 
    "    decimals: 2,",
    "    encoder: function(x){return parseFloat(Math.pow(10,x));}", 
    "  })", 
    "});",
    "slider.set(%s);",
    "var pipsValues = $('.noUi-value');",
    "pipsValues.each(function(){$(this).html('10<sup>'+$(this).attr('data-value')+'</sup>')});",
    sep = "\n"
  ), Min, Max, Start)
}

Note that the updateNoUiSliderInput in your code is useless, because the slider is updated by the JS code. So replace

  observe({
    updateNoUiSliderInput(session, inputId = 'Histoslider', range = c(input$SlMin, input$SlMax), value = input$SlVal)
    shinyjs::delay(1, {  ## delay the javascript so that it runs after the slider has updated its values
      runjs(js(input$SlMin, input$SlMax, input$SlVal))     })
  })

with

  observeEvent(list(input$SlMin, input$SlMax, input$SlVal), {
      runjs(js(input$SlMin, input$SlMax, input$SlVal))     
  }, ignoreInit = TRUE)

来源：https://stackoverflow.com/questions/54618717/using-javascript-to-alter-nouislider-tags-in-r-shiny-error-when-performing-math

标签

javascript

Shiny

nouislider