Identify points within a rectangle in a scatterplo

2019-09-11 00:59发布

I have a small R script that loads in a comma-separated file with data and displays it as a scatterplot. I can also identify individual points of interest in the scatterplot by hovering over them with the mouse. This is cool but what I also want is to draw a rectangle over an area in the scatterplot, and get a list with the IDs of the data points within that rectangle. (The final goal of this is a shiny app).

I.e. how can I make it so that I can a) draw a rectangle, b) get the points within that rectangle and c) display that list for the end-user in a form that can be copied and pasted?

Here is a working example (using mtcars instead of y csv-file):

library(ggvis)
mtc <- mtcars
mtc$id <- 1:nrow(mtc)

all_values <- function(x) {
  if(is.null(x)) return(NULL)
  row <- mtc[mtc$id == x$id, ]
  paste0(names(row), ": ", format(row), collapse = "<br />")
}

mtc %>% ggvis(x = ~wt, y = ~mpg, key := ~id) %>%
  layer_points() %>%
  add_tooltip(all_values, "hover")

标签: r shiny ggvis
2条回答
迷人小祖宗
2楼-- · 2019-09-11 01:07

What you are (probably) looking for are the plot_brush-functions of the shiny-package (you find an example here at the Shiny Gallery).

The following will provide 2 apps, that are built on top of each other to answer your 3 questions:

1 Drawing a rectangle with plot_brush

This can be achieved with this code:

library(shiny)

server <- function(input, output) {
  # render the plot
  output$plot1 <- renderPlot({
    plot(mtcars$mpg, mtcars$disp)
  })

  # set the options for the brush technique
  output$plotui <- renderUI({
    plotOutput("plot1", height=300,
               brush = brushOpts(id = "plot_brush")
    )
  })
}

ui <- fluidPage(
  # render the plot
  uiOutput("plotui")
)

# run the app
shinyApp(ui = ui, server = server)

Shiny App

2 & 3 Identifying the points and printing a datatable

Using and extending part 1 we identify the points and load them into a data.frame called res and then load them into a datatable (using the 'DT'-package):

library(shiny)
library(DT)

server <- function(input, output) {
  # render the plot
  output$plot1 <- renderPlot({
    plot(mtcars$mpg, mtcars$disp)
  })

  # set the options for the brush technique
  output$plotui <- renderUI({
    plotOutput("plot1", height=300,
               brush = brushOpts(id = "plot_brush")
    )
  })

  # for part 2 and 3
  output$plot_brushed_points <- renderDataTable({
    df <- mtcars
    # this function gets the data for you
    res <- brushedPoints(df, input$plot_brush, "mpg","disp") 
    # mpg = name of x variable, disp = name of y variable

    # puts the results in a datatable format
    datatable(res)
  })
}

ui <- fluidPage(
  # render the plot
  uiOutput("plotui"),
  # renders the datatable
  dataTableOutput("plot_brushed_points")
)

# run the app
shinyApp(ui = ui, server = server)

This gives something like this: Final App

This question on Stackoverflow will point you in the right direction for the mouseover.

查看更多
贼婆χ
3楼-- · 2019-09-11 01:23

Here's a simple example using the locator() function:

# function
loc.box <- function(x,y){
  print("choose bottom left corner")
  p1 <- locator(1)
  print("choose top right corner")
  p2 <- locator(1)
  rect(p1$x, p1$y, p2$x, p2$y, border=3, col=rgb(0,1,0,0.1))
  incl <- which(
    x >= p1$x &
    x <= p2$x &
    y >= p1$y &
    y <= p2$y
  )
  return(incl)
}

# data
set.seed(1)
n <- 100
x <- runif(n)
y <- runif(n)

# plot and select
op <- par(ps=9, mar=c(4,4,1,1))
plot(x, y, pch=20, cex=0.3)
text(x, y, labels=seq(x), pos=3)
par(op)
res <- loc.box(x,y)
res
# [1]  2  8 14 19 23 26 31 36 40 42 51 53 63 75

enter image description here

查看更多
登录 后发表回答