问如何绘制具有精确起点和终点的曲线箭头？

EN

# helper functions to convert between radians and degrees
deg2rad <- function (deg){
  stopifnot(is.numeric(deg))
  (rad <- (pi/180) * deg)
}

rad2deg <- function (rad){
  stopifnot(is.numeric(rad))
  (deg <- rad/(pi/180))
}

# function to calculate the points on an arc between two points
# position 1: x0, y0
# position 2: x1, y1
# number of points in resulting arc line: n
# degrees of the arc connecting the points (positive is counter-clockwise, 
# negative is clockwise): arcdeg
calcArc <- function(x0 = 1, y0 = 1, x1 = 4, y1 = 6, arcdeg = 30, n = 50){
  
  if(abs(arcdeg)>-359.9 & abs(arcdeg)>359.9){stop("angle of arc (arcdeg) must be between -359.9 and 359.9")}
  
  anglerad <- atan2(y = y1-y0, x = x1-x0) # angle between points
  midpt <- list(x = mean(c(x0,x1)), y = mean(c(y0,y1))) # midpoint coordinates of chord
  arcrad <- deg2rad(deg = arcdeg) # angle of arc in radians
  chordlength <- sqrt((x1-x0)^2 + (y1-y0)^2) # length between points
  r <- abs((chordlength/2) / sin(arcrad/2)) # radius of circle
  
  # angle from midpoint to circle center
  lut <- data.frame(
    lessthan180 = c(TRUE, TRUE, FALSE, FALSE), 
    sign = c(1, -1, 1, -1), 
    rotation = c(90, -90, -90, 90))
  hit <- which(lut$lessthan180 == (abs(arcdeg) < 180) & lut$sign == sign(arcdeg))
  anglecen <- anglerad + deg2rad(lut$rotation[hit])
  
  # length of midpoint to circle center
  midpt2cenpt <- sqrt(r^2 - (chordlength/2)^2) 
  
  # calculate center point
  cenpt <- list(x = midpt$x + midpt2cenpt*cos(anglecen), 
    y = midpt$y + midpt2cenpt*sin(anglecen))
  
  # angle from circle center to arc
  anglecen2arc <- anglecen + ifelse(abs(arcdeg)<180, deg2rad(180), 0)

  # produce vector of arc with n points
  arc <- data.frame(
    rad = seq(
      from = anglecen2arc - arcrad/2,
      to = anglecen2arc + arcrad/2, 
      length.out = n
    )
  )
  arc$x <- cenpt$x + r*cos(arc$rad)
  arc$y <- cenpt$y + r*sin(arc$rad)
  
  return(arc)
}

# function drawing the results of calcArc as a line or arrow.
# makes a conversion in plotting region units in order to maintain a circular arc
addArc <- function(x0 = 1, y0 = 1, x1 = 4, y1 = 6, arcdeg = 30, n = 50, 
  t = "l", col = 1, lty = 1, lwd = 1, 
  arrowlength = NULL, arrowangle = 30, arrowcode = 2,
  result = FALSE,
  ...){
  
  # calculate arc
  arc <- calcArc(x0 = x0, y0 = y0, x1 = x1, y1 = y1, arcdeg = arcdeg, n = n)

  # calculate arc in device units
  FROM = "user"
  TO = "chars"
  
  x0 <- grconvertX(x0, from = FROM, to = TO)
  x1 <- grconvertX(x1, from = FROM, to = TO)
  y0 <- grconvertY(y0, from = FROM, to = TO)
  y1 <- grconvertY(y1, from = FROM, to = TO)
  arc2 <- calcArc(x0 = x0, y0 = y0, x1 = x1, y1 = y1, arcdeg = arcdeg, n = n)
  names(arc2) <- c("rad", "xusr", "yusr")
  
  arc <- cbind(arc, arc2[,c("xusr", "yusr")])
  
  # convert back to user coordinates
  arc$xusr <- grconvertX(arc$xusr, from = TO, to = FROM)
  arc$yusr <- grconvertY(arc$yusr, from = TO, to = FROM)
  
  lines(yusr ~ xusr, data = arc, t = t, 
    col = col, lty = lty, lwd = lwd, ...)
  if(!is.null(arrowlength)){
    arrows(x0 = arc$xusr[n-1], x1 = arc$xusr[n], y0 = arc$yusr[n-1], y1 = arc$yusr[n], 
      length = arrowlength, code = arrowcode, angle = arrowangle, 
      col = col, lty = lty, lwd = lwd, ...)
  }
  
  if(result){return(arc)}
}

plot(1, t = "n", xlim = c(-4, 6), ylim = c(0,10), xlab = "", ylab = "")
points(x = c(0,1), y = c(4,6), pch = 16, cex = 1)
addArc(x0 = 0, x1 = 1, y0 = 4, y1 = 6, arcdeg = 90, col = 4, arrowlength = 0.1, lwd = 2)
addArc(x0 = 0, x1 = 1, y0 = 4, y1 = 6, arcdeg = -90, col = 4, arrowlength = 0.1, lwd = 2)
addArc(x0 = 0, x1 = 1, y0 = 4, y1 = 6, arcdeg = -180, col = 4, arrowlength = 0.1, lwd = 2)
addArc(x0 = 0, x1 = 1, y0 = 4, y1 = 6, arcdeg = -300, col = 4, arrowlength = 0.1, lwd = 2)

df <- data.frame(x = c(0,1,1,0.5,0.5,0, 0), y = c(0,0,1,1,0.5,0.5,0))
dfmid <- data.frame(x = df$x[-nrow(df)] + diff(df$x)/2,
  y = df$y[-nrow(df)] + diff(df$y)/2)
dfmid$arcdeg <- c(270, -90, 270, -270, 270, 270)
dfmid$col <- rainbow(nrow(dfmid))
plot(y ~ x, df, t = "n", xlim = c(-1,2), ylim = c(-1,2))
polygon(x = df$x, y = df$y, col = "grey70", border = NA)
points(y ~ x, dfmid)
for(i in seq(nrow(dfmid)-1)){
  addArc(x0 = dfmid$x[i], y0 = dfmid$y[i], x1 = dfmid$x[i+1], y1 = dfmid$y[i+1], 
    arcdeg = dfmid$arcdeg[i], arrowlength = 0.1, col = dfmid$col[i], 
    lwd = 3, lty = 1, n = 500, t = "l")
}