Keep UI formatting when updating slider value

shiny
1

Dear Rstudio community,

I am creating an app where users can simulate bacterial population dynamics and immediately plot the results. The user can set several variables, such as initial population sizes and resources. Because these values become very large, I allow the user to set the log10 transformed value (or the exponent x in 10^x).

Online I found a way to change the way the numbers are displayed on my sliderInput, such that it shows the values as 10^x when the app is loaded.

The problem now arises when I want to allow users to set the slider to a particular value using updateSliderInput (this value is normally calculated through some additional functionality, for the reprex I used a random number generator). Unfortunately I don't know enough Javascript to deduce how I can "rerun" the expSlider function during runtime (rather than upon loading). So as soon as the user sets the new value, the display on the sliderInput changes to show the exponent x, rather than the nice 10^x display.

I would be very grateful for some pointers how to fix this, including alternative solutions to formatting the numbers on the sliderInput!


library(shiny)

#############################
calculate_C0 <- function(){
  C0 = 10^runif(1, min = 5, max = 20)
  return(C0)
}

#############################
# expSlider javascript function
JS.expify <-
  "
// function to exponentiate a sliderInput
function expSlider (sliderId, sci = false) {
  $('#'+sliderId).data('ionRangeSlider').update({
  'prettify': function (num) { return ('10<sup>'+num+'</sup>'); }
  })
}"

# call expSlider 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
expSlider('logC0', sci = true)
}, 5)})
"

###########################################################
ui <- fluidPage(withMathJax(),
                tags$head(tags$script(HTML(JS.expify))),
                tags$head(tags$script(HTML(JS.onload))),
                sliderInput("logC0", label = "Initial resource concentration \\(C_0\\)",
                            min = 5, max = 20, value = 12, step = 0.5, width = "50%"),
                htmlOutput("C0_widget_out"),
                br(),
                br(),
                actionButton("C0_widget_setval", "Set this value")
                
) #fluidpage

###########################################################
server <- function(input, output, session) {
  
  ## C0 widget ----
  suggested_C0 <- reactive({
    suggested_C0  <- calculate_C0()
    return(suggested_C0)
  })
  
  output$C0_widget_out <- reactive({ 
    HTML('Suggested C0: 10<sup>', round(log10(suggested_C0()), digits = 1),'</sup>' )
  })
  
  observeEvent(input$C0_widget_setval, {
    # Control the value of C0
    updateSliderInput(session, "logC0", value = log10(suggested_C0()))
  })
  
}

###########################################################
shinyApp(ui = ui, server = server)
2

Hi @JSHuisman. You may define the click event of C0_widget_setval button to change back the number display of logC0 after clicking.

library(shiny)

#############################
calculate_C0 <- function(){
  C0 = 10^runif(1, min = 5, max = 20)
  return(C0)
}

#############################
# expSlider javascript function
JS.expify <-
  "
// function to exponentiate a sliderInput
function expSlider (sliderId, sci = false) {
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return ('10<sup>'+num+'</sup>'); }
})
}"

# call expSlider 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
expSlider('logC0', sci = true)
}, 5);
$('#C0_widget_setval').click(function() {
$('#logC0').data('ionRangeSlider').update({
'prettify': function(num) {return num;}
})
})})
"

###########################################################
ui <- fluidPage(withMathJax(),
                tags$head(tags$script(HTML(JS.expify))),
                tags$head(tags$script(HTML(JS.onload))),
                sliderInput("logC0", label = "Initial resource concentration \\(C_0\\)",
                            min = 5, max = 20, value = 12, step = 0.5, width = "50%"),
                htmlOutput("C0_widget_out"),
                br(),
                br(),
                actionButton("C0_widget_setval", "Set this value")
                
) #fluidpage

###########################################################
server <- function(input, output, session) {
  
  ## C0 widget ----
  suggested_C0 <- reactive({
    suggested_C0  <- calculate_C0()
    return(suggested_C0)
  })
  
  output$C0_widget_out <- reactive({ 
    HTML('Suggested C0: 10<sup>', round(log10(suggested_C0()), digits = 1),'</sup>' )
  })
  
  observeEvent(input$C0_widget_setval, {
    # Control the value of C0
    updateSliderInput(session, "logC0", value = log10(suggested_C0()))
  })
  
}

###########################################################
shinyApp(ui = ui, server = server)
1 Like
3

Thank you for taking a look @raytong!

Your solution works for me if I wrap it in a slight delay:

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
expSlider('logC0', sci = true)
}, 5);
$('#C0_widget_setval').click(function() {
setTimeout(function() {
// include call for each slider
expSlider('logC0', sci = true)
}, 100);
})
})
"

Without the delay the slider layout seems to be updated faster than the value (using updateSliderInput) after a user clicks the "Set value" button.

4

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.