R两个图表,线条从一个到另一个

Question

我想在法线图中绘制一些点,并将这些点链接到它下面显示的地图.我想要的基本是(这里我手动添加了链接):

不知怎的,我应该用segments它pdt=T来写边距,但我不确定我需要做什么数学变换才能为进入地图的分段末端设置正确的坐标.

我宁愿使用传统的plot功能而不是 ggplot2

这里是用于绘制示例的源(警告可能需要一些时间来加载打开的街道地图):

library(OpenStreetMap)
#Random point to plot in the graph
fdata=cbind.data.frame(runif(12),runif(12),c(rep("A",4),rep("B",4),rep("C",4)))
colnames(fdata)=c("x","y","city")

#random coordinate to plot in the map
cities=cbind.data.frame(runif(3,4.8,5),runif(3,50.95,51),c("A","B","C"))
colnames(cities)=c("long","lat","name")

#city to color correspondance
color=1:length(cities$name)
names(color)=cities$name


maxlat=max(cities$lat)
maxlong=max(cities$long)
minlat=min(cities$lat)
minlong=min(cities$long)

#get some open street map
map = openmap(c(lat=maxlat+0.02,long=minlong-0.04 ) ,
              c(lat=minlat-0.02,long=maxlong+.04) ,
              minNumTiles=9,type="osm")
longlat=openproj(map) #Change coordinate projection


par(mfrow=c(2,1),mar=c(0,5,4,6))

plot( fdata$y ~ fdata$x ,xaxt="n",ylab="Comp.2",xlab="",col=color[fdata$city],pch=20)
axis(3)
mtext(side=3,"-Comp.1",line=3)
par(mar=rep(1,4))

#plot the map
plot(longlat,removeMargin=F)
points(cities$lat ~ cities$long, col= color[cities$name],cex=1,pch=20)
text(cities$long,cities$lat-0.005,labels=cities$name)

Answer 1

网格图形系统（作为lattice和ggplot2图形包的基础）比R的基本图形系统更适合这种操作。不幸的是，您的两个图都使用基本图形系统。不过幸运的是，出色的gridBase软件包提供了允许人们在两个系统之间进行转换的功能。

在下面（以您对 的调用开始par(mfrow=c(2,1),...)）中，我用注释标记了我添加的行，表明它们是My addition。有关此策略的另一个更简单的实际示例，请参阅此处。

library(grid)      ## <-- My addition
library(gridBase)  ## <-- My addition

par(mfrow=c(2,1),mar=c(0,5,4,6))
plot(fdata$y ~ fdata$x, xaxt = "n", ylab = "Comp.2", xlab = "",
     col = color[fdata$city],pch=20)
vps1 <- do.call(vpStack, baseViewports()) ## <-- My addition
axis(3)
mtext(side = 3,"-Comp.1",line=3)
par(mar = rep(1,4))

#plot the map
plot(longlat,removeMargin=F)
vps2 <- do.call(vpStack, baseViewports()) ## <-- My addition
points(cities$lat ~ cities$long, col= color[cities$name],cex=1,pch=20)
text(cities$long,cities$lat-0.005,labels=cities$name)

## My addition from here on out...    

## A function that draws a line segment between two points (each a
## length two vector of x-y coordinates), the first point in the top
## plot and the second in the bottom plot.
drawBetween <- function(ptA, ptB, gp = gpar()) {
    ## Find coordinates of ptA in "Normalized Parent Coordinates"
    pushViewport(vps1)
    X1 <- convertX(unit(ptA[1],"native"), "npc")
    Y1 <- convertY(unit(ptA[2],"native"), "npc")
    popViewport(3)
    ## Find coordinates of ptB in "Normalized Parent Coordinates"
    pushViewport(vps2)
    X2 <- convertX(unit(ptB[1],"native"), "npc")
    Y2 <- convertY(unit(ptB[2],"native"), "npc")
    popViewport(3)
    ## Plot line between the two points
    grid.move.to(x = X1, y = Y1, vp = vps1)
    grid.line.to(x = X2, y = Y2, vp = vps2, gp = gp)
}

## Try the function out on one pair of points
ptA <- fdata[1, c("x", "y")]
ptB <- cities[1, c("long", "lat")]
drawBetween(ptA, ptB, gp = gpar(col = "gold"))

## Using a loop, draw lines from each point in `fdata` to its
## corresponding city in `cities`
for(i in seq_len(nrow(fdata))) {
    ptA <- fdata[i, c("x", "y")]
    ptB <- cities[match(fdata[i,"city"], cities$name), c("long", "lat")]
    drawBetween(ptA, ptB, gp = gpar(col = color[fdata[i,"city"]]))
}