inst/shinyExamples/regression/server.R

library(shiny)

server <- function(input, output) {
  # For storing which rows have been excluded
  vals <- reactiveValues(
    keeprows = rep(TRUE, nrow(mtcars))
  )
  
  output$plot1 <- renderPlot({
    # Plot the kept and excluded points as two separate data sets
    keep    <- mtcars[ vals$keeprows, , drop = FALSE]
    exclude <- mtcars[!vals$keeprows, , drop = FALSE]
    
    keep$leverage = cooks.distance(lm(mpg~wt, data = keep)) > 4/nrow(keep)
    
    ggplot(keep, aes(wt, mpg)) + geom_point(aes(colour = factor(leverage)), size = 3) +
      geom_smooth(method = lm, fullrange = TRUE, color = "black") +
      geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25, size = 3) +
      coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35)) + 
      theme_bw() +
      scale_color_manual(name = "Influential points", values = c("black","red"))
  })
  
  # Toggle points that are clicked
  observeEvent(input$plot1_click, {
    res <- nearPoints(mtcars, input$plot1_click, allRows = TRUE)
    
    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })
  
  # Toggle points that are brushed, when button is clicked
  observeEvent(input$exclude_toggle, {
    res <- brushedPoints(mtcars, input$plot1_brush, allRows = TRUE)
    
    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })
  
  # Reset all points
  observeEvent(input$exclude_reset, {
    vals$keeprows <- rep(TRUE, nrow(mtcars))
  })
  
}
jr-packages/jrModelling documentation built on Oct. 30, 2020, 5:17 a.m.