Base R 中的旋转箭头

Question

在 base R（和 sp）中，我希望创建具有预定义形状但以提供的坐标为中心的灵活旋转的箭头。我想出了以下功能：

my_arrow <- function(x,y, rotate=0, col=par("fg"), cex=1) {
    xbase <- c(1.2,0.2,0.2,-1.2, -1.2, 0.2, 0.2)
    ybase <- c(0,1,0.5,0.5,-0.5,-0.5,-1)
    rotM <- matrix(c(cos(rotate*pi/180), sin(rotate*pi/180), -sin(rotate*pi/180), cos(rotate*pi/180)), nrow=2)
    transf <- function(x1,y1) cex * rotM %*% c(x1,y1) + c(x,y)
    ans <- t(mapply(transf, xbase, ybase))
    polygon(x=ans[,1], y=ans[,2], col=col)
}

如果rotation=0，这会产生我想要的箭头，但是当我旋转时它会变形。例如，

plot(1:2, type="p", col="white", xlim=c(-5,5), ylim=c(-10,10))
my_arrow(0,0, rotate=45)

生成下面的图表。

我想我需要应用一些特殊类型的坐标，但我卡住了。有什么想法吗？

（arrows 功能对我不起作用，因为我有另一种形状。使用 gridBase 和一些旋转的视口对我来说听起来有点过分了。）

Answer 1

检查函数shapes::rotatexy后，我自己找到了解决方案：我需要解决宽高比问题。最后，我想出了以下适合我的功能：

my_arrow <- function(x,y, rotate=0, col=par("fg"), border=par("fg"), cex=1) {
    scale_base <- strwidth("O")/2.4
    xbase <- c(1.2,0.2,0.2,-1.2, -1.2, 0.2, 0.2) * scale_base
    ybase <- c(0,1,0.5,0.5,-0.5,-0.5,-1) * scale_base
    rotM <- matrix(c(cos(rotate*pi/180), sin(rotate*pi/180), -sin(rotate*pi/180), cos(rotate*pi/180)), nrow=2)
    transf <- function(x1,y1) cex * rotM %*% c(x1,y1) + c(x,y)
    ans <- t(mapply(transf, xbase, ybase))

    # this is deliberately taken from shapes::rotatexy
    user <- par("usr")
    pin <- par("pin")
    sy <- user[4] - user[3]
    sx <- user[2] - user[1]
    ans[,2] <- y + (ans[,2]-y) * sy/sx * pin[1]/pin[2]

    polygon(x=ans[,1], y=ans[,2], col=col, border=border)
}

所以，当我打电话时：

plot(1:2, type="p", col="white", xlim=c(-5,5), ylim=c(-10,10))
my_arrow(0,0, rotate=45, cex=5)

我得到了我想要的：

Base R 中的旋转箭头

Rotated Arrow in Base R

r

graphics

coordinate-systems