底座R中的旋转箭头

Question

在基础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)

我得到了我想要的东西：