DarianFlorianVoda / BioShapes

Bachelor Thesis R Package
0 stars 0 forks source link

[NEW Arrow] Triangular arrow: ---|> #50

Closed discoleo closed 2 years ago

discoleo commented 2 years ago

Triangular Arrow

Arrow

#### Arrow Triangle ####
arrowTriangle = function(x, y, d=-0.5, lwd=1, d.head=c(-d,d), d.lines=0,
    h.lwd=lwd, col="red", scale=1, join=0) {
  if(join > 2) stop("Unsupported value for join!");
  slope = compute_slope(x, y);
  ### Head
  arrHead = arrowHeadTriangle(x[2], y[2], slope=slope, d=d, dV = d.head, scale=scale);
  mid     = attr(arrHead, "Mid");
  arrHead = list(arrHead, lwd=h.lwd);
  ### ArrowTail
  if(join == 0 || join == 1) {
    x[2] = mid[1]; y[2] = mid[2];
  }
  arrow = arrowTail(x, y, d.lines=d.lines, lwd=lwd, slope=slope);
  ### Full Arrow
  lst = list(Arrow=arrow, Head=arrHead);
  class(lst) = c("arrow", "list");
  # Plot lines:
  lines(lst, col=col);
  invisible(lst);
}

ArrowHead

# Triangle ArrowHead: ---|>
arrowHeadTriangle = function(x, y, slope, d=-1, dV=c(-d, d), scale=1) {
  p = if(d == 0) matrix(c(x, y), nrow=1, ncol=2)
  else shiftPoint(c(x, y), slope=slope, d = d);
  pV = shiftLine(p, slope=slope, d = dV, scale=scale);
  arrHead = list(
    x = c(pV[1,1], x, pV[2,1], pV[1,1]),
    y = c(pV[1,2], y, pV[2,2], pV[1,2]));
  attr(arrHead, "Mid") = p;
  return(arrHead);
}

Tests

##### Triangle  ArrowHead ####

### Test 1
x = c(0, 6); y = c(1, 6);
d = -1;
plot.base()
a1 = arrowTriangle(x, y, d=d, lwd=2);
a2 = arrowTriangle(c(x[1], 5), c(y[1], y[1]), d=d, lwd=2);
a3 = arrowTriangle(c(x[1], x[1]), c(y[1], 5), d=d, lwd=2);
# Head
h1 = a1$Head[[1]]
h2 = a2$Head[[1]]
h3 = a3$Head[[1]]
# 4 edges: d * c(sqrt(2), sqrt(2), 0, 2);
# => edge 1 is counted twice; edge 4 is not counted;
stopifnot(round(Dsquare(h1, h1$x[2], h1$y[2]) - 6*d^2, 8) == 0)
stopifnot(round(Dsquare(h2, h2$x[2], h2$y[2]) - 6*d^2, 8) == 0)
stopifnot(round(Dsquare(h3, h3$x[2], h3$y[2]) - 6*d^2, 8) == 0)
DarianFlorianVoda commented 2 years ago

Added. Very cool. Thanks.