Вращенная стрелка в базе R - PullRequest
Новая
       19

Вращенная стрелка в базе R

0 голосов
/ 16 мая 2018

В базе 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 и некоторые повернутые окна просмотра кажутся мне излишними.)

enter image description here

1 Ответ

0 голосов
/ 17 мая 2018

После проверки функции 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)

, я получаю то, что хотел:

enter image description here

...