Dfyjkt

I'm trying to link a log scaled noUiSliderInput with a linear scaled numericInput without creating an eternal update loop.
Normally I would stop the update lines with this:

input$Histoslider != log10(input$Threshold_box)

This created some issues with decimals, which I can't seem to fix properly.
The main problem seems to be that noUiSliderInput always rounds its output to 2 decimals, causing the rounding problem for the conversion to 10^ and log10 back and forth

Detailed description:

I have an app where the user can set threshold filters in 2 ways:

1: type the number in a numericInput in un-transformed numbers

or

2: by changing the bar on a vertical noUiSliderInput.

The noUiSliderInput however is expressed as log10 numbers, as it is lined up with a plot of the data on log10 scale. so if the plot runs from 10^-1 to 10^4.5, the slider has values running from -1 to 4.5

The numericInput and noUiSliderInputare linked, so change one should update the other.
This created a lot of difficulty with decimals. The numericInput has to be restricted in the app to 2 decimals. So to do that I add some transformation, rounding and transformation back again to get matching numbers.

I can get it to work for a normal sliderInput, but somehow not for a noUiSliderInput, eventhough they should spit out the same format of data.

The reason I have to stick with a noUiSliderInput is because I need a slider on both the x and y axis of the plot.

Try to type 1256 in the numericInput to see an example of the problem

The app:

# install.packages("devtools")
devtools::install_github("dreamRs/shinyWidgets")
library(shiny)
library(shinyWidgets)

# function to see how many decimal places we need
decimalplaces <- function(x) 
 if ((x %% 1) != 0) 
 deci <- nchar(strsplit(sub('0+$', '', as.character(x)), ".", fixed=TRUE)[[1]][[2]])
 if(deci >2) deci <- 2
 return(deci)
 else 
 return(0)
 


# starting values for the sliders
minval <- round(-1, digits = 6)
maxval <- round(4.5, digits = 6)

ui <- fluidPage(
 tags$br(),
 fluidRow(
 column(3,
 div(numericInput("Threshold_box", "Normal value: ", min = 0, max = 100, value = 1, step=0.01), style = "display:inline-block") ),
 column(2, 
 # div(sliderInput( inputId = "Histoslider", label = NULL, min = minval, max = maxval, value = 0, step = 0.000001), style = 'display:inline-block; position:relative')
noUiSliderInput(inputId = "Histoslider", label = NULL, min = minval, max = maxval, tooltips = FALSE, value = 0, step = 0.000001, direction = "rtl", orientation = "vertical", width = "100px", height = "276px")
 )))

server <- function(input, output, session) 
 #setting decimals to 6 as that seemed to work in the end for a normal sliderInput
 values <- reactiveValues( transformDecimal = 2)

observeEvent(input$Threshold_box, 
 if(!is.na(input$Threshold_box)) values$transformDecimal <- decimalplaces(input$Threshold_box)
 if(input$Histoslider != log10(input$Threshold_box)) 
 newval <- log10(input$Threshold_box)
 # updateSliderInput(session, 'Histoslider', value = newval)
 updateNoUiSliderInput(session, 'Histoslider', value = newval)
 , ignoreInit = T)


 observeEvent(input$Histoslider, 
 ## next three lines are to get matching set between a 2 decimal numer and the log value
 sliderFull <- 10^input$Histoslider
 sliderRound <- round(sliderFull, digits = values$transformDecimal)
 sliderLog <- log10(sliderRound)

 updateSliderInput(session, 'Histoslider', value = sliderLog)
 if(sliderLog != log10(input$Threshold_box)) 
 updateNumericInput(session, 'Threshold_box', value = round(10^sliderLog, digits = values$transformDecimal))
 
 , ignoreInit = T)


shinyApp(ui, server)