简体   繁体   中英

Arc length of piecewise spline using R

I know there are many ways to calculate the arc length of curve, but I am looking for an efficient way to calculate the arc length of a piecewise spline through irregularly spaced points.

The actual curve I'm trying to find the length of is quite complex (contour line) so here is a quick example using a circle where the actual arclength is known to be 2*pi :

# Generate "random" data
set.seed(50)
theta = seq(0, 2*pi, length.out = 50) + runif(50, -0.05, 0.05)
theta =  c(0, theta[theta >=0 & theta <= 2*pi], 2*pi)
data = data.frame(x = cos(theta), y = sin(theta))

# Bezier Curve fit
library("bezier")
bezierArcLength(data, t1=0, t2=1)$arc.length

# Calculate arc length using euclidean distance 
library("dplyr")
data$eucdist = sqrt((data$x - lag(data$x))^2 + (data$y - lag(data$y))^2)
print(paste("Euclidean distance:", sum(data$eucdist[-1])))
print(paste("Actual distance:", 2*pi))

# Output
Bezier distance: 5.864282
Euclidean distance: 6.2779
Actual distance: 6.2831

The closest thing I have found is https://www.rdocumentation.org/packages/pracma/versions/1.9.9/topics/arclength but I would have to parameterise my data to be some function(t) ...spline(data, t)... to use arclength . I tried this, but the fitted spline ran along the middle of the circle rather than along the circumference.

Another alternative I have been (unsuccessfully) trying is fit piecewise splines and determine the length of each spline.

Any help would be much appreciated!

EDIT : Added alternate method using the Bezier package, but the arc length found is even worse than just using the Euclidean method.

In lieu of community answers, I've cobbled together a solution which seems to work for what I was after! I'll leave my code here in case anyone has the same question and comes across this.

# Libraries
library("bezier")
library("pracma")
library("dplyr")
# Very slow for loops, sorry! Didn't write it as an apply function
output = data.frame()
for (i in 1:100) {
  # Generate "random" data
  # set.seed(50)
  theta = seq(0, 2*pi, length.out = 50) + runif(50, -0.1, 0.1)
  theta = sort(theta)
  theta =  c(0, theta[theta >=0 & theta <= 2*pi], 2*pi)
  data = data.frame(x = cos(theta), y = sin(theta))
  # Bezier Curve fit
  b = bezierArcLength(data, t1=0, t2=1)$arc.length
  # Pracma Piecewise cubic
  t = atan2(data$y, data$x)
  t = t + ifelse(t < 0, 2*pi, 0)
  csx <- cubicspline(t, data$x)
  csy <- cubicspline(t, data$y)
  dcsx = csx; dcsx$coefs = t(apply(csx$coefs, 1, polyder))
  dcsy = csy; dcsy$coefs = t(apply(csy$coefs, 1, polyder))
  ds <- function(t) sqrt(ppval(dcsx, t)^2 + ppval(dcsy, t)^2)
  s = integral(ds, t[1], t[length(t)])
  # Calculate arc length using euclidean distance 
  data$eucdist = sqrt((data$x - lag(data$x))^2 + (data$y - lag(data$y))^2)
  e = sum(data$eucdist[-1])
  # Use path distance as parametric variable
  data$d = c(0, cumsum(data$eucdist[-1]))
  csx <- cubicspline(data$d, data$x)
  csy <- cubicspline(data$d, data$y)
  dcsx = csx; dcsx$coefs = t(apply(csx$coefs, 1, polyder))
  dcsy = csy; dcsy$coefs = t(apply(csy$coefs, 1, polyder))
  ds <- function(t) sqrt(ppval(dcsx, t)^2 + ppval(dcsy, t)^2)
  d = integral(ds, data$d[1], data$d[nrow(data)])
  # Actual value
  a = 2*pi
  # Append to result
  output = rbind(
    output, 
    data.frame(bezier=b, cubic.spline=s, cubic.spline.error=(s-a)/a*100,
               euclidean.dist=e, euclidean.dist.error=(e-a)/a*100,
               dist.spline=d, dist.spline.error=(d-a)/a*100))
}
# Summary
apply(output, 2, mean)
# Summary output
          bezier         cubic.spline   cubic.spline.error       euclidean.dist euclidean.dist.error           dist.spline    dist.spline.error 
    5.857931e+00         6.283180e+00        -7.742975e-05         6.274913e+00        -1.316564e-01           6.283085683         -0.001585570 

I still don't quite understand what bezierArcLength does, but I'm very happy with my solution using cubicspline from the pracma package as it is a lot more accurate.

Other solutions are still more than welcome!

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM