子集數據框中基於變焦互動

Question

我建立R中一個閃亮的互動應用程序，要顯示兩個散點圖：

1. 整個數據集（左）
2. 縮放區（右）

左邊的繪圖不應該改變，並且用於爲右邊的繪圖選擇不同的區域。它與示例代碼（http://shiny.rstudio.com/gallery/plot-interaction-zoom.html）中的plot2和plot3類似。

我想顯示這兩個圖的統計數據和線性迴歸，並根據右圖中選擇哪個區域來更新縮放圖的信息。我認爲這樣做的一種方式是使用畫筆對原始數據（df_mtcars）進行子集化並將其保存爲新的數據幀（df_mtcars2）。

我對R還是有點新，並且無法找到關於此的很多信息。我找到了一種類似於ggvis（here）的方法，但有沒有辦法使用ggplot2來完成它？如果有更簡單的方法可以做到這一點，我也接受其他建議。

這裏是我的代碼：

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

爲了讓刷數據，你可以使用brushedPoint功能，其輸出被刷點的行號。然後，您可以直接將ggplot傳送到您的plot2和summary2。這裏有一個例子：

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) 
    }) 
} 

要顯示的線性方程，你也許可以在你的ui.R添加verbatimTextOutput("summary2_lm")，並在server.R輸出線性方程和R2係數：

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)) 
    }) 

的函數來獲取公式和R2作爲字符串的靈感來源於here