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

R Two graphs with lines going from one to the other

我想在普通图形中绘制一些点,然后 link 这些点指向显示在其下方的地图。我基本上想要的是 (这里我手动添加了 links)

不知何故我应该使用 segmentspdt=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)

您可以在您的地块上创建一个新的绘图区域,然后添加以下行:

#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坐标

grid 图形系统(它是 latticeggplot2 图形包的基础)比 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"]]))
}