DarianFlorianVoda / BioShapes

Bachelor Thesis R Package
0 stars 0 forks source link

Arrow for Measurements: --->| #49

Closed discoleo closed 2 years ago

discoleo commented 2 years ago

Arrow for Measurements

Function for Arrow

#### Arrow for Measurements ####
arrowMeasure = function(x, y, d=-0.5, lwd=1, d.head=c(-d,d), dT=d.head, d.lines=0,
    h.lwd=lwd, col="red", scale=1, join=0) {
  slope = compute_slope(x, y);
  ### Head
  arrHead = arrowHeadMeasure(x[2], y[2], slope=slope, d=d, dV = d.head, dT=dT, scale=scale);
  arrHead$lwd = h.lwd;
  ### ArrowTail
  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

# T ArrowHead: ---|
arrowHeadT = function(x, y, slope, d=-1, dV=c(d, -d), scale=1) {
  p  = cbind(x, y);
  if(length(dV) == 1) dV = c(0, dV);
  pV = shiftLine(p, slope=slope, d = dV, scale=scale);
  arrHead = list(
    x = c(pV[1,1], pV[2,1]),
    y = c(pV[1,2], pV[2,2]));
  return(arrHead);
}

# Measurement ArrowHead: --->|
arrowHeadMeasure = function(x, y, slope, d=-1, dV=c(d, -d), dT=dV, scale=1) {
  arrHead = arrowHeadSimple(x, y, slope=slope, d=d, dV=dV, scale=scale);
  arrHead = list(arrHead, arrowHeadT(x, y, slope=slope, dV=dT, scale=scale));
  return(arrHead);
}

Tests

##### Measurement ArrowHead #####
plot.base()
x = c(0, 6); y = c(1, 6);
arrowMeasure(x, y, d=-1, lwd=2);
arrowMeasure(c(x[1], 5), c(y[1], y[1]), d=-1, lwd=2);
arrowMeasure(c(x[1], x[1]), c(y[1], 5), d=-1, lwd=2);

###
dT = c(-1); dV = c(-1,1) / 2;
plot.base()
x = c(0, 6); y = c(1, 6);
arrowMeasure(x, y, d=-1, d.head=dV, dT=dT, lwd=2);
arrowMeasure(c(x[1], 5), c(y[1], y[1]), d=-1, d.head=dV, dT=dT, lwd=2);
arrowMeasure(c(x[1], x[1]), c(y[1], 5), d=-1, d.head=dV, dT=dT, lwd=2);
DarianFlorianVoda commented 2 years ago

Interesting type of arrow. Included. Thanks!