CODEWITHSUNDEEP
rplot
Henry David Thorough
Henry David Thorough

Reputation: 900

Shorten Arrows/Lines/Segments Between Coordinates

I am drawing arrows from one set of points to another with arrows(). I'd like to shorten the arrows by a common length so that they don't overlap with the label. However, it's not obvious how one does that, given that arrows() takes coordinates as input.

For instance, here's an example.

x <- stats::runif(12); y <- stats::rnorm(12)
i <- order(x, y); x <- x[i]; y <- y[i]
plot(x,y, main = "Stack Example", type = 'n')
text(x = x, y = y, LETTERS[1:length(x)], cex = 2, col = sample(colors(), 12))
s <- seq(length(x)-1)  # one shorter than data
arrows(x[s], y[s], x[s+1], y[s+1])

How do I shorten the arrows so they don't overlap with the labels?

UPDATE

These are all great answers. In an attempt to come up with something that doesn't presume that points connect in a chain, I wrote the following function, which moves x0y0 (a dataframe where column 1 is x and column 2 is y) closer to xy (same format as x0y0) by absolute distance d. 

movePoints <- function(x0y0, xy, d){
  total.dist <- apply(cbind(x0y0, xy), 1,
             function(x) stats::dist(rbind(x[1:2], x[3:4])))
  p <- d / total.dist
  p <- 1 - p
  x0y0[,1] <- xy[,1] + p*(x0y0[,1] - xy[,1])
  x0y0[,2] <- xy[,2] + p*(x0y0[,2] - xy[,2])
  return(x0y0)
}

Upvotes: 4

Views: 802

Answers (2)

Robert Krzyzanowski
Robert Krzyzanowski

Reputation: 9344

I don't think there is a built-in solution, but if you can guarantee that your points are spaced far enough (otherwise drawing arrows would be difficult anyway!) then you can "shrink" the points the arrows are drawn on by the length of the radius of an imaginary circle circumscribing each letter.

Note that, however, since the scale of the x and y axes are different, we have to be careful to normalize the x and y values before transformation. The reduce_length parameter below is the estimated % of the total viewport that a typical letter occupies. You can tweak with this if you want a little more space around the letters. Also be careful to not pick bad colors that make the letter invisible.

Finally, the imperfections are because of different dimensions for different letters. To really address this, we would need a map of letters to micro x and y adjustments.

x <- stats::runif(12); y <- stats::rnorm(12)
i <- order(x, y); x <- x[i]; y <- y[i]
initx <- x; inity <- y
plot(x,y, main = "Stack Example", type = 'n')
text(x = x, y = y, LETTERS[1:length(x)], cex = 2, col = sample(colors()[13:100], 12))
spaced_arrows <- function(x, y, reduce_length = 0.048) {
  s <- seq(length(x)-1)  # one shorter than data
  xscale <- max(x) - min(x)
  yscale <- max(y) - min(y)
  x <- x / xscale
  y <- y / yscale
  # shrink the line around its midpoint, normalizing for differences
  # in scale of x and y
  lapply(s, function(i) {
    dist <- sqrt((x[i+1] - x[i])^2   + (y[i+1] - y[i])^2)
    # calculate our normalized unit vector, accounting for scale
    # differences in x and y
    tmp <- reduce_length * (x[i+1] - x[i]) / dist
    x[i] <- x[i] + tmp
    x[i+1] <- x[i+1] - tmp

    tmp <- reduce_length * (y[i+1] - y[i]) / dist
    y[i] <- y[i] + tmp
    y[i+1] <- y[i+1] - tmp

    newdist <- sqrt((x[i+1] - x[i])^2 + (y[i+1] - y[i])^2)
    if (newdist > reduce_length * 1.5) # don't show too short arrows
      # we have to rescale back to the original dimensions
      arrows(xscale*x[i], yscale*y[i], xscale*x[i+1], yscale*y[i+1])
  })
  TRUE
}
spaced_arrows(x, y)

enter image description here enter image description here enter image description here enter image description here enter image description here

Upvotes: 5

IRTFM
IRTFM

Reputation: 263451

I was seeing that some of the arrows were reversed in @RobertKrzyzanowski's answer when the letters were close so I reduced the factor. I also vectorized the function using hte diff() function:

 plot(x,y, main = "Stack Example", type = 'n')
 text(x = x, y = y, LETTERS[1:length(x)], cex = 2)
 gap_arrows <- function(x, fact = 0.075) {
      dist <- sqrt( diff(x)^2 + diff(y)^2)
      x0 <- x[-length(x)] + (tmp <- fact * (diff(x)) / dist)
      x1 <- x[-1] - tmp
      y0 <- y[-length(y)] + (tmp <- fact * diff(y) / dist)
      y1 <- y[-1] - tmp
      arrows(x0,y0,x1,y1)
    }

 gap_arrows2(x)

I don't really think this is a finished answer, but perhaps useful? I think using a factor ratehr than an absolute reduction creates some shortening when the line is near horizontal that I don't understand. The G-G transition seems odd (too short) in this data:

> dput(x)
c(0.058478488586843, 0.152887222822756, 0.171698493883014, 0.197744736680761, 
0.260856857057661, 0.397151953307912, 0.54208036721684, 0.546826156554744, 
0.633055359823629, 0.662317642010748, 0.803418542025611, 0.83192756283097
)
> dput(y)
c(-0.256092192198247, -0.961856634130129, 0.0412329219929399, 
0.235386572284857, 1.84386200523221, -0.651949901695459, -0.490557443700668, 
1.44455085842335, -0.422496832339625, 0.451504053079215, -0.0713080861235987, 
0.0779608495637108)

Upvotes: 0

Related Questions