基于缩放交互的子集数据框

Question

I'm building an interactive shiny app in R and want to display two scatter plots:

1. Entire Dataset (left)
2. Zoomed Region (right)

The left plot shouldn't change and is used to select different regions for the right plot. It is similar to plot2 and plot3 in the example code ( http://shiny.rstudio.com/gallery/plot-interaction-zoom.html ).

I want to display the statistics and linear regression for both plots and have the information for the zoomed plot get updated based on which region is selected in the right plot. One way I thought of doing this was to use the brush to subset the original data (df_mtcars) and save it as a new dataframe (df_mtcars2).

I'm still a bit new to R and wasn't able to find very much information on this. I found a method for doing something similar with ggvis ( here ) but is there a way to do it using ggplot2? I'm also open to other suggestions in case there is an easier way to do this.

Here is my code:

app.R

library(ggplot2)
library(dplyr)

df_mtcars <- mtcars %>%
  select(wt,mpg)

df_mtcars2 <- df_mtcars
#choose selection based on brushed/zoomed data

ui <- fluidPage(
  fluidRow(
    column(width = 12, class = "well",
       h4("Left plot controls right plot"),
       fluidRow(
         column(width = 6,
                h5("Entire Dataset (left)"),
                plotOutput("plot1", height = 350,
                           brush = brushOpts(
                             id = "plot1_brush",
                             resetOnNew = TRUE
                           )
                )
         ),
         column(width = 6,
                h5("Zoomed Region (right)"),
                plotOutput("plot2", height = 350)
         )
       ),
       fluidRow(
         column(width = 6,
                verbatimTextOutput("summary1")),
         column(width = 6, 
                verbatimTextOutput("summary2"))
       )    
    )
  )
)
server <- function(input, output) {

# Linked plots (left and right)
ranges <- reactiveValues(x = NULL, y = NULL)

output$plot1 <- renderPlot({
  ggplot(df_mtcars, aes(wt, mpg)) + geom_point() + 
  geom_smooth(method = "lm", color = "red")
})

output$plot2 <- renderPlot({
  #dataset should be changed to df_mtcars2
  ggplot(df_mtcars2, aes(wt, mpg)) + geom_point() + 
    geom_smooth(method = "lm", color = "blue") +
    # if using df_mtcars2, should get rid of coord_cartesian range (?)
    coord_cartesian(xlim = ranges$x, ylim = ranges$y) 
})

# When a double-click happens, check if there's a brush on the plot.
# If so, zoom to the brush bounds; if not, reset the zoom.
observe({
  brush <- input$plot1_brush
  if (!is.null(brush)) {
    ranges$x <- c(brush$xmin, brush$xmax)
    ranges$y <- c(brush$ymin, brush$ymax)
  } else {
    ranges$x <- NULL
    ranges$y <- NULL
  }
})

output$summary1 <- renderPrint({
  summary(df_mtcars)
  #how to add linear equation and R^2 (?)
})

output$summary2 <- renderPrint({
  summary(df_mtcars2) #should be df_mtcars2
  #how to add linear equation and R^2 (?)
 })
}

Answer 1

To get the brushed data, you can use the brushedPoint function, it outputs the row numbers of the points that are brushed. You can then pass directly to ggplot in your plot2 and in summary2 . Here's an example:

server <- function(input, output) {

  values <- reactiveValues(data=df_mtcars)

  output$plot1 <- renderPlot({
    ggplot(df_mtcars, aes(wt, mpg)) + geom_point() + 
      geom_smooth(method = "lm", color = "red")
  })

  output$plot2 <- renderPlot({
    ggplot(values$data, aes(wt, mpg)) + geom_point() + 
      geom_smooth(method = "lm", color = "blue") 
  })

  observe({
    if (!is.null(input$plot1_brush)) {      
      values$data <- brushedPoints(df_mtcars, input$plot1_brush)
    } else {     
      values$data <- df_mtcars
    }
  })

  output$summary1 <- renderPrint({
    summary(df_mtcars)
  })

  output$summary2 <- renderPrint({
    summary(values$data)
  })
}

To display the linear equation, you can maybe add a verbatimTextOutput("summary2_lm") in your ui.R , and in your server.R output the linear equation and R2 coefficient:

output$summary2_lm <- renderPrint({
    m <- lm(mpg ~ wt, values$data);
    paste("y=",format(coef(m)[1], digits = 2),"x+",format(coef(m)[2], digits = 2)," R2=",format(summary(m)$r.squared, digits = 3))
  })

The function to get the equation and R2 as a string is inspired from here