Коли крива складається з відрізків ліній, то всі внутрішні точки цих сегментів є точками перегину, що не цікаво. Натомість криву слід вважати апроксимованою вершинами цих відрізків. Прокручуючи кусочно двічі диференційовану криву через ці сегменти, ми можемо потім обчислити кривизну. Точка перегину, строго кажучи, - це місце, де кривизна дорівнює нулю.
У прикладі є довгі розтяжки, де кривизна майже дорівнює нулю. Це говорить про те, що зазначені точки повинні наближатись до кінців таких ділянок з низькою кривизною.
Таким чином, ефективний алгоритм буде спланувати вершини, обчислити кривизну по щільному набору проміжних точок, визначити діапазони кривизни майже нуля (використовуючи деяку розумну оцінку того, що означає бути "поруч"), і позначити кінцеві точки цих діапазонів. .
Ось робочий Rкод для ілюстрації цих ідей. Почнемо з рядкового рядка, вираженого як послідовність координат:
xy <- matrix(c(5,20, 3,18, 2,19, 1.5,16, 5.5,9, 4.5,8, 3.5,12, 2.5,11, 3.5,3,
2,3, 2,6, 0,6, 2.5,-4, 4,-5, 6.5,-2, 7.5,-2.5, 7.7,-3.5, 6.5,-8), ncol=2, byrow=TRUE)
Розкладіть координати x і y окремо для досягнення параметризації кривої. (Параметр буде викликаний time.)
n <- dim(xy)[1]
fx <- splinefun(1:n, xy[,1], method="natural")
fy <- splinefun(1:n, xy[,2], method="natural")
Інтерполюйте сплайни для побудови та обчислення:
time <- seq(1,n,length.out=511)
uv <- sapply(time, function(t) c(fx(t), fy(t)))
Нам потрібна функція для обчислення кривизни параметризованої кривої. Потрібно оцінити перший та другий похідні сплайну. Для багатьох сплайнів (наприклад, кубічних сплайнів) це легкий алгебраїчний розрахунок. Rнадає перші три похідні автоматично. (В інших середовищах можна порахувати похідні чисельно.)
curvature <- function(t, fx, fy) {
# t is an argument to spline functions fx and fy.
xp <- fx(t,1); yp <- fy(t,1) # First derivatives
xpp <- fx(t,2); ypp <- fy(t,2) # Second derivatives
v <- sqrt(xp^2 + yp^2) # Speed
(xp*ypp - yp*xpp) / v^3 # (Signed) curvature
# (Left turns have positive curvature; right turns, negative.)
}
kappa <- abs(curvature(time, fx, fy)) # Absolute curvature of the data
Я пропоную оцінити поріг нульової кривизни з точки зору міри кривої. Принаймні, це хороший вихідний пункт; його слід регулювати відповідно до обертовості кривої (тобто збільшувати для довших кривих). Пізніше це буде використано для фарбування ділянок відповідно до кривизни.
curvature.zero <- 2*pi / max(range(xy[,1]), range(xy[,2])) # A small threshold
i.col <- 1 + floor(127 * curvature.zero/(curvature.zero + kappa))
palette(terrain.colors(max(i.col))) # Colors
Тепер, коли вершини були сплайновані та обчислена кривизна, залишається лише знайти точки перегину . Щоб показати їх, ми можемо побудувати вершини, побудувати сплайн та позначити на ньому точки перегину.
plot(xy, asp=1, xlab="x",ylab="y", type="n")
tmp <- sapply(2:length(kappa), function(i) lines(rbind(uv[,i-1],uv[,i]), lwd=2, col=i.col[i]))
points(t(sapply(time[diff(kappa < curvature.zero/2) != 0],
function(t) c(fx(t), fy(t)))), pch=19, col="Black")
points(xy)
Відкриті точки - це оригінальні вершини, xyа чорні точки - точки перегину, автоматично ідентифіковані за допомогою цього алгоритму. Оскільки кривину неможливо надійно обчислити в кінцевих точках кривої, ці точки не позначені спеціально.
