Carl February 2016

Discretizing continuous variable with Shiny

I am trying to create a flexible Shiny interface for discretizing continuous variables. For example, I want the user to look at mtcars$mpg, select n levels, choose the min and max for each of the n levels, and then give a histogram of the new discretized variable. Obviously, cuts is the main function for this in R but the main challenge is creating a flexible enough interface.

Here is what I tried:

server <- function(input, output) {

output$sliders <- renderUI({
    n <- input$levels
    lapply(1:n,function(i) {
      if (i==1) {
# first slider can take on any mpg
      sliderInput(paste0("slider",i),paste0("Select range for level",i),
                  min=min(mtcars$mpg),max=max(mtcars$mpg),value=max(mtcars$mpg))
      } else {
# subsequent sliders limited to values greater than previous slider's selected value 
# here is where my problems are
        sliderInput(paste0("slider",i),paste0("Select range for level",i),
                    min=as.numeric(input[,paste0("slider",i-1)]),max=max(mtcars$mpg),value=NULL)
      }
    })
  })
  output$histo <- renderPlot({
    n <- input$levels

    steps <- c(min(mtcars$mpg))
    for (i in 1:n) {
      steps <- c(steps, input[,paste0("slider",n)])
    }

    dat <- cut(mtcars$mpg,steps)
    hist(dat)

  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("levels", "Number of levels:", 1,min=1,max=10)
    ),
    mainPanel(h1("Discretize mpg"),uiOutput("sliders"),
              renderPlot('histo'))

)
)
shinyApp(ui = ui, server = server)

The issue is that I can't seem to get the subsequent sliderInput to render dynamically based on the value of the previous sliderInput. It is important that each sliderInput be mutally exclusive so I try to force the minimum value of each slider to be the value of the p

Answers


HubertL February 2016

this gets me several slide bars

    library(shiny)
server <- function(input, output) {

        output$sliders <- renderUI({
                n <- input$levels
                lapply(1:n,function(i) {
                        if (i==1) {
                                # first slider can take on any mpg
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=min(mtcars$mpg),max=max(mtcars$mpg),value=max(mtcars$mpg))
                        } else {
                                # subsequent sliders limited to values greater than previous slider's selected value 
                                # here is where my problems are
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=as.numeric(eval(paste0("input$","slider",i-1))),max=max(mtcars$mpg),value=NULL)
                        }
                })
        })
        output$histo <- renderPlot({
                n <- input$levels

                steps <- c(min(mtcars$mpg))
                for (i in 1:n) {
                        steps <- c(steps, eval(paste0("input$","slider",n)))
                }

                dat <- cut(mtcars$mpg,steps)
                hist(dat)

        })
}

ui <- fluidPage(
        sidebarLayout(
                sidebarPanel(
                        numericInput("levels", "Number of levels:", 1,min=1,max=10)
                ),
                mainPanel(h1("Discretize mpg"),uiOutput("sliders"),
                          renderPlot('histo'))

        )
)
shinyApp(ui = ui, server = server)


NicE February 2016

Here's a solution for your output$sliders:

output$sliders <- renderUI({
                n <- input$levels
                lapply(1:n,function(i) {
                        if (i==1) {
                                # first slider can take on any mpg
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=min(mtcars$mpg),max=max(mtcars$mpg),value=input[[paste0("slider",i)]])
                        } else {
                                if(input[[paste0("slider",i-1)]]!=max(mtcars$mpg)){
                                # subsequent sliders limited to values greater than previous slider's selected value 
                                # here is where my problems are
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=as.numeric(input[[paste0("slider",i-1)]]),max=max(mtcars$mpg),value=input[[paste0("slider",i)]])
                                }
                        }
                })
    })

I made a couple changes:

Changed the value of the first slider to min(input$mpg) rather than max(mtcars$mpg), otherwise the second slider does not have a range.

Also changed the value of the other sliders to input[[paste0("slider",i)]] so that they retain their current value whenever another slider is changed.

You have issue in your renderPlot as well, you can't make a histogram out of cuts, you need to feed the hist function data and define cuts using the break argument.

Post Status

Asked in February 2016
Viewed 2,850 times
Voted 7
Answered 2 times

Search




Leave an answer