R help - Sep 2020 - 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]]

Hi Jinsong,
This is similar to the "arctext" function in plotrix. I don't want
to
do all the trig right now, but I would suggest placing the characters
on the curve and then offsetting them a constant amount at right
angles to the slope of the curve at each letter. I would first try
having a "minspace" argument to deal with crowding at small radii and
you would probably have to start at the middle and work out to each
end. A tough problem and you have made a good start on it.  Check the
fragment below for a suggestion on how to avoid calling "substr"
repeatedly.

# get a vector of the characters in str
   # rather than call substr all the time
   strbits<-unlist(strsplit(str,""))

   for(i in 1:l) {
      w <- strwidth(strbits[i])
      h <- strheight(strbits[i])

Jim

On Tue, Sep 22, 2020 at 6:11 PM Jinsong Zhao <jszhao at yeah.net>
wrote:
>
> 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]]
>
> ______________________________________________
> R-help at r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.

> On Sep 22, 2020, at 1:10 AM, Jinsong Zhao <jszhao at yeah.net> wrote:
> 
> 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:
> 

[code deleted]

For this kind of operation you might want to use tikz. 

R has the ability to produce tikz directives and to insert raw tikz into a
'tikzDevice'.

If you search rseek.org for 'tikz' you will get plenty of good hits. 

The tikz/pgf manual has examples of flowing text, IIRC.

HTH,

Chuck

p.s. this is a plain text list. Do not submit html.