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

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

#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 plot B 中，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坐标一起使用。

Answer 2

grid 图形系统（它是 lattice 和 ggplot2 图形包的基础）比R 的基本图形系统。不幸的是，您的两个图都使用基本图形系统。不过幸运的是，出色的 gridBase 包提供了允许在两个系统之间进行转换的功能。

在下面（从您对par(mfrow=c(2,1),...) 的调用开始）中，我用 cmets 标记了我添加的行，表明它们是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"]]))
}