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。对于该策略的另一个更简单的示例，see here。

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"]]))
}

Answer 2

您可以在绘图上创建一个新的绘图区域，然后添加线条：

#New plot area
par(new=T, mfrow = c(1,1))
plot(0:1, type = "n", xaxt='n', ann=FALSE,  axes=FALSE, frame.plot=TRUE, bty="n")

问题是您需要在绘图和新绘图区域之间进行映射，如果您使用相同的区域，则可以获得一些参考（请参见locator），然后对所有其他点进行插值

例如，在mi中，图B为{1.751671，0.1046729}，第8个点为{1.320507，0.6892523}：

points(c(1.320507, 1.751671), c(0.6892523, 0.1046729), col = "red", type = "l")

更新（图映射）：

X11(7, 7)

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)
usr1 <- par("usr")

#plot the map
par(mar=rep(1,4))
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)
usr2 <- par("usr")


par(new=T, mfrow = c(1,1))
plot(0:1, type = "n", xaxt='n', ann=FALSE,  axes=FALSE, frame.plot=TRUE, bty="n")

# Position of the corners (0, 0) and (1, 1) of the two graphs in the window X11(7, 7)
#ref <- locator()
ref <- list(x = c(1.09261365729382, 1.8750001444129, 1.06363637999312, 1.93636379046146), 
            y = c(0.501704460496285, 0.941477257177598, 
                  -0.0335228967050026, 0.45909081740701))

fdata$x_map <- approxfun(usr1[1:2], ref$x[1:2])(fdata$x)
fdata$y_map <- approxfun(usr1[3:4], ref$y[1:2])(fdata$y)

points(fdata$y_map ~ fdata$x_map ,pch=6)

请记住，地图的插值必须考虑投影，线性投影只能与UTM坐标一起使用。