brushedPoints

Published by onesixx on

https://github.com/rstudio/shiny-examples/blob/master/105-plot-interaction-zoom/app.R
library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux

ui <- fluidPage(
  fluidRow(
    column(4, class="well",
      h4("1. Brush and double-click to zoom"),
      plotOutput("plot1", height=300,
        dblclick = "plot1_dblclick",
           brush = brushOpts(id="plot1_brush", resetOnNew=TRUE)
      )
    ),
    column(8, class="well",
      h4("Left plot controls right plot"),
      fluidRow(
        column(6,
          plotOutput("plot2", height=300,
            brush = brushOpts(id="plot2_brush", resetOnNew=TRUE)
          )
        ),
        column(6,
          plotOutput("plot3", height = 300)
        )
      )
    )
  )
)

server <- function(input, output) {
  # -------------------------------------------------------------------
  # Single zoomable plot (on left)
  ranges <- reactiveValues(x=NULL, y=NULL)

  output$plot1 <- renderPlot({
    mtcars %>% ggplot(aes(wt, mpg)) + geom_point() +
                coord_cartesian(xlim=ranges$x,
                                ylim=ranges$y, expand=FALSE)
  })

  # 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 EVENT ----
  observeEvent(input$plot1_dblclick, {
    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
    }
  })

  # -------------------------------------------------------------------
  # Linked plots (middle and right)
  ranges2 <- reactiveValues(x=NULL, y=NULL)

  output$plot2 <- renderPlot({
    mtcars %>% ggplot(aes(wt, mpg)) + geom_point()
  })

  output$plot3 <- renderPlot({
    mtcars %>% ggplot(aes(wt, mpg)) + geom_point() + 
                coord_cartesian(xlim=ranges2$x,
                                ylim=ranges2$y, expand=FALSE)
  })

  #OBSERVE ----
  observe({
    brush <- input$plot2_brush
    if (!is.null(brush)) {
      ranges2$x <- c(brush$xmin, brush$xmax)
      ranges2$y <- c(brush$ymin, brush$ymax)

    } else {
      ranges2$x <- NULL
      ranges2$y <- NULL
    }
  })
}

shinyApp(ui, server)

https://onesixx.com/brush2/

brushedPoints(mtcars, input$plot_brush, xvar="wt", yvar="mpg")

library(ggplot2)
ui <- basicPage(
  plotOutput("plot1", brush = brushOpts(id = "plot_brush", fill = "#ccc"), 
             dblclick = dblclickOpts(id = "plot_dbclick"),
             hover = hoverOpts(id = "plot_hover", delay=500, nullOutside=TRUE), height=250),
   verbatimTextOutput("info1"),
   verbatimTextOutput("info2")
  
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    #mtcars %>% ggplot(aes(x=wt, y=mpg)) + geom_point() + facet_grid(. ~ cyl)
    p <-  ggplot(mtcars, aes(x=wt, y=mpg)) 
    p <-  p + geom_point() 
    #p <-  p+  facet_wrap( ~ mtcars[["gear"]], scales = "free", ncol = 4)
    p <- p + facet_wrap(as.formula(paste("~", "gear")), scales = "free", ncol = 4)
    
    p
  })
  
  
  observeEvent(input$plot_dbclick, {
    output$info1 <- renderPrint({
      print(isolate(input$plot_brush))
    })
  })
  
  
  output$info2 <- renderPrint({
    sixx <- "gg"
    brushedPoints(mtcars, input$plot_brush, xvar="wt", yvar="mpg")
  })
}

shinyApp(ui, server)

Categories: ggplot2

onesixx

Blog Owner

Subscribe
Notify of
guest

0 Comments
Inline Feedbacks
View all comments
0
Would love your thoughts, please comment.x
()
x