Interactive graphs

Ottavia M. Epifania



The code

appExamples/interactive-graphs.R

ui = sidebarLayout(
  sidebarPanel(
  selectInput(inputId = "dataset",
                               label = "",
                               choices = list("rock" = 1,
                                              "pressure" = 2,
                                              "cars" = 3,
                                              "I want to use my data!!" =4)),
 conditionalPanel(condition = "input.dataset == '4'",
                  fileInput("example","", accept = c("csv"))),
actionButton("load", "Upload data"),
conditionalPanel(condition = "input.load >= '1'",  
                     uiOutput("var1"),                
                     uiOutput("var2"),                 
                     actionButton("select", "Select & Display") 
                   )
  ), 
mainPanel(
  plotOutput("graph",
          click = clickOpts(id = "plot_click"), 
          brush = brushOpts(id = "plot_brush") 
        ),
fluidRow(
        column(4, verbatimTextOutput("points")),
        column(4,verbatimTextOutput("brush"))
        )
)
)
server = function(input, output) {
  values <- reactiveValues()
    dataInput <- reactive({
      if(input$dataset == 1){
        data <- rock
      } else if (input$dataset == 2 ){
        data <- pressure
      } else if (input$dataset == 3) {
        data <- cars
      } else if (input$dataset == 4) {
        data <- read.csv(input$example$datapath)
      }
    })
observeEvent(input$load, {
      values$data <- data.frame(dataInput())
      if (any(sapply(values$data, is.character)) == TRUE) {
        values$data[, sapply(values$data, is.character) == T] = lapply(values$data[, sapply(values$data, is.character) == T], as.factor)
      } else {
        values$data = values$data
      }
    })
output$var1 <- renderUI({    
      nam <- colnames(values$data) 
      selectInput("var1", label = "Select x:", 
                  choices = c(nam), multiple = F,
                  selected = nam[1])
    })
output$var2 <- renderUI({
      nam2 <- colnames(values$data) 
      selectInput("var2", label = "Select y:",
                  choices = c(nam2), multiple = F,
                  selected = nam2[1])
    })
newdata <- observeEvent(input$select, 
                            { # wait for you to decide before acting
                              # Besides, you're creating a new (smaller) object
                              values$df <- values$data[c(input$var1, input$var2)]
                            })
output$graph <- renderPlot({
      validate(need(input$select > 0, "Waiting for data") )                         
      df = values$df
      plot(df[, c(1:2)]) # use it normally
    })
output$points <- renderPrint({
      df <- values$df #
      pointID <- nearPoints(df, 
                            input$plot_click, 
                            xvar = names(df)[colnames(df) == input$var1], 
                            yvar = names(df)[colnames(df) == input$var2], 
                            addDist = FALSE)
      validate(need(nrow(pointID) != 0, "Click on a point"))
      pointID
    })
output$brush <- renderPrint({
      df <- values$df 
      brushID <- brushedPoints(df,
                               input$plot_brush,
                               xvar = names(df)[colnames(df) == input$var1],
                               yvar = names(df)[colnames(df) == input$var2])
      validate(need(nrow(brushID) != 0, "Highlight Area"))
      brushID
    })
}