Dynamic min max values for inputslider R

shiny
1

I am trying to to get min max values for a slider in R shiny. Here iswhat I have below. Based on the inputs I want to create breaks.This works when I use static values for the slider but when I use dynamic way I get this error :

non-numeric argument to binary operator

'from' must be of length 1


library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(DT)

sidebar <- dashboardSidebar(
  sidebarMenu(id = "tab",
              menuItem("1", tabName = "1")
  )
)
body <-   ## Body content
  dashboardBody(box(width = 12,fluidRow(

    uiOutput("interaction_slider"),
    DT::dataTableOutput("op")
  )))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {
  df <- data.frame(month = c("mazda 3", "mazda cx5", "mazda 6","mazda miata","honda 
                             civic","honda accord"),
                   april = c(9, 8, 11,14,16,1),
                   may = c(3,4,15,12,11, 19),
                   june = c(2,11,9,7,14,1))
  
  output$interaction_slider <- renderUI({
    maxkaw <- function(data) sapply(df, max, na.rm = TRUE)
    minkaw <-function(data) sapply(df, min, na.rm = TRUE)
    
    print(maxkaw)
    
    #  DOESNT WORK
    
    sliderInput("slider","Select Range:", min   = minkaw,
                max   = maxkaw,
                value = c(minkaw,maxkaw))
  })
  
  #WORKS
#   sliderInput("slider","Select Range:", min   = 2,
#               max   = 25,
#               value = c(4,7))
# })
  brks <- reactive({
    seq(input$slider[1], input$slider[2], length.out = 10) 
  })
  
  clrs <- reactive({ round(seq(255, 175, length.out = length(brks()) - 1), 0) %>%
  {paste0("rgb(",.,",", ., ",255)")}})
  
  df_format<- reactive ({datatable(df,options = list(searching = FALSE, pageLength = 15, lengthChange = FALSE)) %>%
      formatStyle(names(df), 
                  backgroundColor = styleInterval(c(brks()), c('white', clrs() ,'white'))
      )
  })
  
  output$op <-renderDataTable({
    df_format()
  })
}

shinyApp(ui = ui, server = server)
2

The immediate problem is that seq() is receiving something other than a single value for its from parameter — here supplied as input$slider[1]/100. You need to trace what exactly input$slider[1] delivers and why it's not as expected. I suspect the problem lies in what you're doing with minkaw and maxkaw, but since the code isn't runnable as provided, it's difficult to say for sure what's wrong.

You might take a look at our FAQ on Shiny debugging and Shiny reprex-ing:

2 Likes
3

Thank you. I just added a reproducible example.

4

Thanks, that's helpful! One tip: it's a good idea to make your reprex-es as small as possible, so for sorting out this problem with your slider there's no need to include all the code that formats the output table, for example.

OK, so there are quite a few problems with the logic that's determining the slider values. I'd encourage you to consider getting this part working in R outside of shiny, where it's easier to debug things, since the issues aren't really shiny-related — it seems to be basic R syntax that's tripping you up here.

I don't know how you want these slider values calculated, so I'll just run through what the code does right now:

    maxkaw <- function(data) sapply(df, max, na.rm = TRUE)
    minkaw <-function(data) sapply(df, min, na.rm = TRUE)

This bit defines two functions. The first problem is that each function accepts a parameter called data, but doesn't actually use the parameter in the function body — instead, the function uses df. This will sort of work, because R will go looking for something called df in the environment that the function was called from and eventually find the data frame named df that you defined, but it's very fragile.

So let's assume we rewrite these functions as:

    maxkaw <- function(data) sapply(data, max, na.rm = TRUE)
    minkaw <-function(data) sapply(data, min, na.rm = TRUE)

Now what they do is accept a data frame and attempt to find the min (or max) of every column, then return some sort of multi-valued data structure with all those mins and maxes. However, if you call these functions on your data frame df, you'll find that they fail since one of df's columns is non-numeric, so it won't work with min()/max().

Since your slider can only have one min and one max, I'm not sure why the code is finding the mins and maxes of all columns of the data frame? I suspect you intend to be doing something else here, like finding the min or max of only a single column?

    sliderInput("slider","Select Range:", min   = minkaw,
                max   = maxkaw,
                value = c(minkaw,maxkaw))

Here, the minkaw() and maxkaw() functions have been called without parentheses — doing this just returns the function code itself, which is not something that sliderInput() knows what to do with. Maybe you meant to call, e.g., min = minkaw(df)? If so, you first need to make sure that minkaw(df) returns a single numeric value, which is what the min argument to sliderInput() is expecting.

2 Likes
5

In case you were trying to set up your slider based on the minimum and maximum across all the numeric variables in the data frame, here's a simple example of how that might work:

library(shiny)

shinyApp(
  ui = fluidPage(
    uiOutput("interaction_slider"),
    verbatimTextOutput("breaks")
  ),
  
  server = function(input, output, session) {
    
    df <- data.frame(
      month = month.name[1:6],
      var1 = c(9, 8, 11, 14, 16, 1),
      var2 = c(3, 4, 15, 12, 11, 19),
      var3 = c(2, 11, 9, 7, 14, 1)
    )
    
    range_numvars <- function(data) {
      numvars <- unlist(lapply(data, is.numeric))
      num_data <- data[, numvars]
      # This will fail if data has no numeric variables!
      range(num_data)
    }
    
    output$interaction_slider <- renderUI({
      sliderInput(
        "slider",
        "Select Range:",
        min   = range_numvars(df)[1],
        max   = range_numvars(df)[2],
        value = c(min, max)
      )
    })
    
    brks <- reactive({
      req(input$slider)
      seq(input$slider[1], input$slider[2], length.out = 10)
    })
    
    output$breaks <- brks
  }
)
1 Like