superponer - Dibuje puntos fuera de la cuadrícula como flechas apuntando a datos con ggplot2 en R

superponer graficas en r ggplot

Question

Estoy generando mapas con datos a escala mundial, y luego acercándome a ciertas regiones. En la vista ampliada, me gustaría mostrar que hay otros puntos de datos fuera del cuadro delimitador, colocando puntas de flecha que apuntan desde el centro del cuadro hasta donde el punto de datos está en el mundo exterior.

Nota: No necesito que sea una ruta de "gran círculo", solo vectores XY en la proyección de Mercator, porque imagino que esto también será útil para los gráficos "normales".

Como ejemplo, aquí está el mapa mundial que muestra la extensión de los datos:

Y aquí está la vista ampliada, con flechas magenta agregadas manualmente para mostrar lo que me gustaría generar.

A continuación se muestra el código y los datos que estoy utilizando para generar estos dos gráficos básicos. Lo que necesito es una forma de generar las puntas de flecha.

require(ggplot2)

te = structure(list(lat = c(33.7399, 32.8571, 50.2214, 36.96263, 33.5835, 
33.54557, 47.76147, 48, 59.40289, 35.93411, 32.87962, 38.3241, 
50.03844, 37.44, 50.07774, 50.26668, 36.5944), lng = c(-118.37608, 
-117.25746, -5.3865, -122.00809, -117.86159, -117.79805, -124.45055, 
-126, -146.35157, -122.931472, -117.25285, -123.07331, -5.26339, 
25.4, -5.709894, -3.86828, -121.96201)), .Names = c("lat", "lng"
), class = "data.frame", row.names = c(NA, -17L))

all_states = map_data("world")

# world version:
wp = ggplot() + 
      geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray",
                   fill = "gray") +
      coord_cartesian(ylim = c(0, 80), xlim = c(-155, 45)) + 
      geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5,alpha = 0.6)

print(wp)

#states plot
sp = ggplot() +
      geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray", fill = "gray") +
      coord_cartesian(ylim = c(30, 52), xlim = c(-128, -114)) + 
      geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5, alpha = 0.6) 

print(sp)

Answer 1

Aquí está mi intento. Esto es lo más cerca que tengo. Utilicé gcIntermediate() para calcular la distancia más corta entre el punto central de su mapa de EE. UU. Y los puntos de datos que permanecen fuera del bbox. Por lo tanto, las posiciones de flecha pueden no ser algo que quieres. Mi esperanza es que alguien más ofrezca una mejor solución basada en este intento.

Primero arreglé su df (es decir, te) con el punto central en el mapa ampliado de EE. UU. Luego elegí los puntos de datos que no están en la casilla del mapa de los Estados Unidos. Luego, agregue dos columnas para indicar el punto central del mapa de los Estados Unidos. Renombra dos columnas y calcula la distancia más corta con gcIntermediate.

library(dplyr)
library(ggplot2)
library(geosphere)

filter(te, !between(lng, -128, -114) | !between(lat, 30, 52)) %>%
mutate(start_long = (-128 - 114) / 2,
       start_lat = (30 + 52) / 2) %>%
rename(end_lat = lat, end_long = lng) %>%
do(fortify(as(gcIntermediate(.[,c("start_long", "start_lat")],
                             .[,c("end_long", "end_lat")],
                             100,
                             breakAtDateLine = FALSE,
                             addStartEnd = TRUE,
                             sp = TRUE), "SpatialLinesDataFrame"))) -> foo

foo contiene 100 puntos de datos para dibujar la línea respectiva. Elegí puntos de datos que permanecen cerca del límite de bbox. Buscaba específicamente dos puntos de datos para cada línea para poder usar geom_segment() más adelante. Admito que jugué un poco con la condición del filtro. Al final, no subcontraté datos usando lat en este caso.

filter(foo, between(long, -128, -126.5) | between(long, -115.5, -114)) %>%
group_by(group) %>%
slice(c(1,n())) -> mydf

En el siguiente paso, reorganicé el marco de datos basado en este enlace.

mutate(mydf, end_long = lag(long), end_lat = lag(lat)) %>%
slice(n()) -> mydf2

Finalmente dibujé el mapa con flechas. Espero que esto te proporcione algún tipo de base. También espero que otros usuarios de SO proporcionen mejores soluciones.

ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group),
             colour = "gray", fill = "gray" ) +
coord_cartesian(ylim = c(30, 52), xlim = c(-128,-114)) +
geom_point(data = te, aes(x = lng,y = lat), color = "blue", size = 5,alpha = 0.6) +
geom_segment(data = mydf2, aes(x = end_long, xend = long,
                               y = end_lat, yend = lat, group = group),
                               arrow = arrow(length = unit(0.2, "cm"), ends = "last"))

Answer 2

Esta solución utiliza los paquetes sp y rgeos para manipular los datos espaciales, el punto principal son las líneas que se cruzan y un polígono de caja para obtener los puntos de borde de las flechas. Luego, si dibuja flechas con geom_segment y ancho cero, la línea es invisible y solo queda la punta de la flecha.

Esta función calcula las intersecciones del cuadro de línea:

boxint <- function(xlim, ylim, xp, yp){
    ## build box as SpatialPolygons
    box = cbind(xlim[c(1,2,2,1,1)],
        ylim[c(1,1,2,2,1)])
    box <- sp::SpatialPolygons(list(sp::Polygons(list(sp::Polygon(box)),ID=1)))

    ## get centre of box
    x0=mean(xlim)
    y0=mean(ylim)

    ## construct line segments to points
    sl = sp::SpatialLines(
        lapply(1:length(xp),
               function(i){
                   sp::Lines(list(sp::Line(cbind(c(x0,xp[i]),c(y0,yp[i])))),ID=i)
               }
               )
        )
    ## intersect lines segments with boxes to make points
    pts = rgeos::gIntersection(sl, as(box, "SpatialLines"))
    as.data.frame(sp::coordinates(pts), row.names=1:length(xp))
}

Y esto devuelve el geom con flechas:

wherelse <- function(xlim, ylim, points){
    ## get points outside bounding box
    outsides = points[!(
        points$lng>=xlim[1] &
            points$lng <= xlim[2] &
                points$lat >= ylim[1] &
                    points$lat <= ylim[2]),]
    npts = nrow(outsides)
    ## get centre point of box
    x = rep(mean(xlim),npts)
    y = rep(mean(ylim),npts)

    ## compute box-point intersections
    pts = boxint(xlim, ylim, outsides$lng, outsides$lat)
    pts$x0=x
    pts$y0=y
    ## create arrow segments as invisible lines with visible arrowheads
    ggplot2::geom_segment(data=pts, aes(x=x0,y=y0,xend=x,yend=y),
       lwd=0, arrow=grid::arrow(length=unit(0.5,"cm"),
       type="closed"),col="magenta")
}

Así que tu ejemplo, la trama básica es:

sp = ggplot() + 
  geom_polygon(
   data=all_states, 
    aes(x=long, y=lat, group = group),colour="gray",fill="gray" ) + 
    coord_cartesian(ylim=c(30, 52), xlim=c(-128,-114)) + 
    geom_point(data=te,aes(x=lng,y=lat),color="blue",size=5,alpha=0.6)

y luego agrega las flechas con:

sp + wherelse(c(-128,-114), c(30,52), te)

¡No estoy seguro si hay una opción para dibujar flechas exactamente como las quieres!