Search code examples
rggplot2shinycoordinate-systemsbrush

Shiny click/brush not working with non-cartesian coordinates?


I am working on a Shiny app that should let a user select geographical data points on a world map generated by ggplot2 (as in this example).

This works if I use the regular coord_cartesian coordinate system (which distorts the maps) but fails if I use the more appropriate coord_map coordinate system. It seems like the click/brush events do not receive the correct coordinates after the projection. Is there any way I can work around or fix this without reverting back to cartesian coordinates?

You can find a working example below:

library(shiny)
library(ggplot2)
library(dplyr)

map_world <- function(world, mapPoints, xlim, ylim){
  # function to generate ggplot world map
  ggplot() + 
    geom_polygon(data=world, aes(x=long, y=lat, group=group)) +
    geom_point(data=mapPoints, aes(x=Longitude, y=Latitude), color="red") +
    # coord_map messes up the brush select
     coord_map(xlim=xlim, ylim=ylim)
    # coord_cartesian would work but distort the map
    # coord_cartesian(xlim=xlim, ylim=ylim)
}

mapPoints <- data.frame(Longitude=c(-103, -108, -130, -120),
                      Latitude=c(52, 40, 45, 54))
world <- map_data("world")

ui <- fluidPage(
  fluidRow(
    column(width = 6, 
           plotOutput("plot1", height = 300, 
                      click = "plot1_click", brush = "plot1_brush") )
  ),
  fluidRow(
    column(width = 6, 
           h4("Near points"), verbatimTextOutput("click_info") ),
    column(width = 6, 
           h4("Brushed points"), verbatimTextOutput("brush_info") )
  )
)

server <- function(input, output) {
  # output world map
  output$plot1 <- renderPlot({
    map_world(world = world, mapPoints = mapPoints, 
              xlim=c(-180,180), ylim=c(-90,90))
  })
  # output clicked points 
  output$click_info <- renderPrint({
    nearPoints(mapPoints, xvar="Longitude", 
                  yvar="Latitude", input$plot1_click)
  })
  # output brushed points 
  output$brush_info <- renderPrint({
    brushedPoints(mapPoints, xvar="Longitude", 
                  yvar="Latitude", input$plot1_brush)
  })
}

shinyApp(ui, server)

Thanks!


Solution

  • I tried some solutions using ggplot but there is some issue with the scaling that is not being picked up by the plotOutput function. In the help page (http://shiny.rstudio.com/reference/shiny/latest/plotOutput.html), note the following:

    For plotOutput, the coordinates will be sent scaled to the data space, if possible. (At the moment, plots generated by base graphics and ggplot2 support this scaling, although plots generated by lattice and others do not.) If scaling is not possible, the raw pixel coordinates will be sent. For imageOutput, the coordinates will be sent in raw pixel coordinates.

    also,

    With ggplot2 graphics, the code in renderPlot should return a ggplot object; if instead the code prints the ggplot2 object with something like print(p), then the coordinates for interactive graphics will not be properly scaled to the data space.

    I tried moving the ggplot to the server portion of the script, but it didn't work.

    My proposed solution, use base graphics:

    library(shiny)
    library(dplyr)
    library(maps)
    library(mapdata)
    
    
    mapPoints <- data.frame(Longitude=c(-103, -108, -130, -120),
                            Latitude=c(52, 40, 45, 54))
    
    ui <- fluidPage(
      fluidRow(
        column(width = 6, 
               plotOutput("plot1", height = 300, 
                          click = "plot1_click", brush = "plot1_brush") )
      ),
      fluidRow(
        column(width = 6, 
               h4("Near points"), verbatimTextOutput("click_info") ),
        column(width = 6, 
               h4("Brushed points"), verbatimTextOutput("brush_info") )
      )
    )
    
    server <- function(input, output) {
      # output world map
      output$plot1 <- renderPlot({
        map('worldHires')
        points(mapPoints$Longitude, mapPoints$Latitude, 
               col = "red", pch = 16)
      })
      # output clicked points 
      output$click_info <- renderPrint({
        nearPoints(mapPoints, xvar="Longitude", 
                   yvar="Latitude", input$plot1_click)
      })
      # output brushed points 
      output$brush_info <- renderPrint({
        brushedPoints(mapPoints, xvar="Longitude", 
                      yvar="Latitude", input$plot1_brush)
      })
    }
    
    shinyApp(ui, server)