# text on curve

3 messages
Open this post in threaded view
|

## text on curve

 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]] ______________________________________________ [hidden email] mailing list -- To UNSUBSCRIBE and more, see https://stat.ethz.ch/mailman/listinfo/r-helpPLEASE do read the posting guide http://www.R-project.org/posting-guide.htmland provide commented, minimal, self-contained, reproducible code.