# [R] text on curve

Jinsong Zhao j@zh@o @end|ng |rom ye@h@net
Tue Sep 22 10:10:54 CEST 2020

```Hi there,

I write a simple function that could place text along a curve. Since I am not familiar with the operation of rotating graphical elements, e.g., text, rectangle, etc., I hope you could give suggestions or hints on how to improve it. Thanks in advance.

# Here is the code:

getCurrentAspect <- function() {
uy <- diff(grconvertY(1:2,"user","inches"))
ux <- diff(grconvertX(1:2,"user","inches"))
uy/ux
}

r.xy <- function(o.x, o.y, theta) {
r.x <- o.x * cos(theta) - o.y * sin(theta)
r.y <- o.x * sin(theta) + o.y * cos(theta)
c(r.x, r.y)
}

text.on.curve <- function(x, y, x.s, str, ...) {

l <- nchar(str)

fun <- approxfun(x, y, rule = 2)

for(i in 1:l) {
w <- strwidth(substr(str, i, i))
h <- strheight(substr(str, i, i))

x.l <- x.s
x.r <- x.s + w
y.l <- fun(x.l)
y.r <- fun(x.r)
theta <- atan((y.r - y.l)/(x.r - x.l) * getCurrentAspect())

lb.xy <- c(x.s, fun(x.s))
rb.xy <- lb.xy + r.xy(w, 0, theta)
lt.xy <- lb.xy + r.xy(0, h, theta)
rt.xy <- lb.xy + r.xy(w, h, theta)
c.xy <- lb.xy + r.xy(w/2, h/2, theta)

while(i > 1 && lt.xy[1] < rt.xy.old[1]) {
x.s <- x.s + 0.05 * w
x.l <- x.s
x.r <- x.s + w
y.l <- fun(x.l)
y.r <- fun(x.r)
theta <- atan((y.r - y.l)/(x.r - x.l) * getCurrentAspect())

lb.xy <- c(x.s, fun(x.s))
rb.xy <- lb.xy + r.xy(w, 0, theta)
lt.xy <- lb.xy + r.xy(0, h, theta)
rt.xy <- lb.xy + r.xy(w, h, theta)
c.xy <- lb.xy + r.xy(w/2, h/2, theta)
}

x.s <- rb.xy[1]
rt.xy.old <- rt.xy

text(c.xy[1], c.xy[2], substr(str, i, i), srt = theta * 180 / pi, ...)
}
}

# A simple demo:

x <- seq(-5, 5, length.out = 100)
y <- x^2
plot(x,y, type = "l")
text.on.curve(x, y, -2 ,"a demo of text on curve", col = "red")

Best,
Jinsong

[[alternative HTML version deleted]]

```