Dynamically update the axis range using sliders based on the selected column

shiny
1

Hi together,

I am trying to put together a Shiny app for data exploration. The user should be able to load a dataset (different formats in this example the “diamonds” dataset) and dynamically select the x and y columns used for plotting. This is working so far. I also managed to change between lin and log scaling of the plot axes. Now I want to enable to set the x and y ranges (xlim, ylim) dynamically using sliders. To do so, the code should take the min and max values of the selected columns and update the input sliders automatically as a starting point.

I tried the “updateSliderInput” command but with no success so far. I also searched the forum, but with no success so far. Any help is appreciated.

Thanks Alex

#reprex

library("ggplot2")
dataSel<-c("Full Data")
plotTypes<-c("XY", "Hist", "Box")
AxisScale<-c("lin", "log")
myCols<-c()
ui <- fluidPage(
  titlePanel(h3("Data Viewer")),
  sidebarLayout	(
    sidebarPanel("File to open",
                 style = "background-color: LightSteelBlue",
                 fileInput(inputId = "dataset1", label = "Input File", multiple = F,buttonLabel = "Load"), #not required in the reprex
                 numericInput(inputId = "skipLine", label = "Numbers of lines to be skipped", value = 9),  #not required in the reprex
                 hr(),
                 checkboxInput(inputId = "isFCS", label = "Input is FCS file"), #not required in the reprex
                 hr(),
                 textOutput(outputId = "filepath1"),  #not required in the reprex
                 width = 2),
    mainPanel(
      #fluidPage(
      
      column(4,
             wellPanel(style = "width: 600px",
                       fluidRow(
                         
                         column(4, selectInput("DataSource", h6("Data Source:"), choices = dataSel, selected=NULL),
                                tags$head(tags$style(HTML(".selectize-input {height: 12px; width: 150px; font-size: 10px}"))),
                                style='padding:0px;',
                                selectInput("Xaxis", h6("X Axis:"), "", selected=NULL),
                                selectInput("Yaxis", h6("Y Axis:"), "", selected=NULL),
                                sliderInput("Xrange", h6("X range:"), min = 0, max = 100000, value = c(25, 75000))
                         ),
                         column(4, selectInput("PlotType", h6("Plot Type:"), choices = plotTypes, selected=NULL),
                                selectInput("Xscale", h6("X Scale:"), choices = AxisScale, selected="lin"),
                                selectInput("Yscale", h6("Y Scale:"), choices = AxisScale, selected="lin"),
                                sliderInput("Yrange", h6("Y range:"), min = 0, max = 100000, value = c(25, 75000))
                         ),
                         column(4, selectInput("FilterCol", h6("Select Col to filter:"), choices = myCols, selected=NULL),
                                selectInput("FilterVal", h6("Select value for filter:"), choices = dataSel, selected=NULL),
                                selectInput("PlotCol", h6("Color dots:"), choices = c("red"), selected="red"),
                                column(6, h6("Gates"),style = "padding: 0px;font-size: 10px", 
                                       actionButton("GateApply",label = h6("Apply Gate"),style='padding:2px; font-size:80%')),
                                column(6, h6("-"),
                                       actionButton("GateReset",label = h6("Reset Gate"),style='padding:2px; font-size:80%'),
                                       actionButton("GateStore",label = h6("Store Gate"),style='padding:2px; font-size:80%'))
                         ),
                         style = "padding: 5px;overflow:auto !important;"
                       ),
                       
                       fluidRow(
                         plotOutput("plot1"))
             )
      ))))
server <- function(input, output, session) 
{
  # load dataset
  infile <- reactive({
    data<-as.data.frame(diamonds)       
    
    updateSelectInput(session, inputId = "Xaxis", choices = names(data), selected = names(data)[1])
    updateSelectInput(session, inputId = "Yaxis", choices = names(data), selected = names(data)[2])
    updateSelectInput(session, inputId = "PlotCol", choices = c("red",names(data)), selected = "red")
    updateSelectInput(session, inputId = "FilterCol", choices = c("",names(data)), selected = "")
    
    #### this is one way I tried, but with no success
    updateSliderInput(session, inputId = "Xrange", value = c(min(data$input$Xaxis), max(data$input$Xaxis)), min=min(data$input$Xaxis), max=max(data$input$Xaxis))
    ####
    return(data)
    })
  
  # plot data
  output$plot1<- renderPlot({
    req(infile())
    
    if (input$PlotType == "XY")
    {
      gplot<- ggplot(infile(), aes_(as.name(input$Xaxis), as.name(input$Yaxis))) + geom_point(colour='red') + theme_bw() + labs(x = input$Xaxis, y= input$Yaxis) + coord_cartesian(xlim = c(input$Xrange[1],input$Xrange[2])) 
      if(input$Xscale=="log"){gplot <-gplot +scale_x_log10()}
      if(input$Yscale=="log"){gplot <-gplot +scale_y_log10()}
      return(gplot)
    }
    else if (input$PlotType == "Hist")
    {}
    else if (input$PlotType == "Box")
    {}
  })
}

shinyApp(ui, server)
2

This statement is ambiguous: data$input$Xaxis. You don't need to subset your data with input and then with Xaxis, but with input$Xaxis. Reactivity is not triggering by that statement because of that. Say, let's replace this with data[[input$Xaxis]]

Now every time a user changes Xaxis, an entire reactive is triggered and the control is reset to the original position. Need a separate observer for this.

  # load dataset, place load expression in the first argument
  infile <- eventReactive({}, {
    data<-as.data.frame(diamonds)       
    updateSelectInput(session, inputId = "Xaxis", choices = names(data), selected = names(data)[1])
    updateSelectInput(session, inputId = "Yaxis", choices = names(data), selected = names(data)[2])
    updateSelectInput(session, inputId = "PlotCol", choices = c("red",names(data)), selected = "red")
    updateSelectInput(session, inputId = "FilterCol", choices = c("",names(data)), selected = "")
    return(data)
  }, ignoreNULL = FALSE)
  
  # ignoreNULL is TRUE by default, returning NULL if input$Xaxis is not truthy (e.g. blank)
  observeEvent(req(input$Xaxis), {
    rng <- c(min(infile()[[input$Xaxis]]), max(infile()[[input$Xaxis]]))
    # some checks that selected axis is numeric should be in place
    updateSliderInput(session, inputId = "Xrange", value = rng, min = rng[1], max = rng[2])
  })

There's now an issue of your plot redrawing twice because it depends on both Xaxis and a slider. This can be solved by rearranging your reactives a bit, but that's a different question.

1 Like
3

Dear Kirill
thanks a lot for your help. This solved my problem.
Best wishes
Alex