r - 在 R 中计算二维样条曲线

Question

我正在尝试计算通过一系列 xy 坐标的贝塞尔样条曲线。cscvn一个示例类似于Matlab中函数的以下输出（示例链接）：

我相信（不再维护的）grid包用于执行此操作（grid.xspline功能？），但我无法安装该包的存档版本，并且没有找到与我想要的完全一致的任何示例.

这个bezier包看起来也很有希望，但它很慢，我也不能完全正确：

library(bezier)

set.seed(1)
n <- 10
x <- runif(n)
y <- runif(n)
p <- cbind(x,y)
xlim <- c(min(x) - 0.1*diff(range(x)), c(max(x) + 0.1*diff(range(x))))
ylim <- c(min(y) - 0.1*diff(range(y)), c(max(y) + 0.1*diff(range(y))))
plot(p, xlim=xlim, ylim=ylim)
text(p, labels=seq(n), pos=3)

bp <- pointsOnBezier(cbind(x,y), n=100)
lines(bp$points)
arrows(bp$points[nrow(bp$points)-1,1], bp$points[nrow(bp$points)-1,2],
  bp$points[nrow(bp$points),1], bp$points[nrow(bp$points),2]
)

如您所见，它不通过除结束值之外的任何点。

我将非常感谢这里的一些指导！

Answer 1

grid真的没有必要使用。您可以xspline从graphics包中访问。

遵循您的代码和shape来自@mrflick：

set.seed(1)
n <- 10
x <- runif(n)
y <- runif(n)
p <- cbind(x,y)
xlim <- c(min(x) - 0.1*diff(range(x)), c(max(x) + 0.1*diff(range(x))))
ylim <- c(min(y) - 0.1*diff(range(y)), c(max(y) + 0.1*diff(range(y))))
plot(p, xlim=xlim, ylim=ylim)
text(p, labels=seq(n), pos=3)

你只需要多一行：

xspline(x, y, shape = c(0,rep(-1, 10-2),0), border="red")

Answer 2

它可能不是最好的方法，bitgrid肯定不是不活动的。它作为 R 安装的默认包包含在内。它是用于绘制 lattice 和 ggplot 等库的底层图形引擎。您不需要安装它，您应该能够加载它。以下是我如何翻译您的代码以使用grid.xpline

set.seed(1)
n <- 10
x <- runif(n)
y <- runif(n)
xlim <- c(min(x) - 0.1*diff(range(x)), c(max(x) + 0.1*diff(range(x))))
ylim <- c(min(y) - 0.1*diff(range(y)), c(max(y) + 0.1*diff(range(y))))

library(grid)
grid.newpage()
pushViewport(viewport(xscale=xlim, yscale=ylim))
grid.points(x, y, pch=16, size=unit(2, "mm"), 
    default.units="native")
grid.text(seq(n), x,y, just=c("center","bottom"), 
    default.units="native")
grid.xspline(x, y, shape=c(0,rep(-1, 10-2),0), open=TRUE, 
    default.units="native")
popViewport()

这导致

请注意，网格是非常低级的，因此使用起来并不容易，但它确实让您可以更好地控制绘制的内容和位置。

如果您想沿曲线提取点而不是绘制它，请查看?xsplinePoints帮助页面。

Answer 3

感谢所有为此提供帮助的人。我正在总结经验教训以及其他一些方面。

Catmull-Rom 样条与三次 B 样条

函数中的负形状值xspline返回 Catmull-Rom 类型样条，样条通过 xy 点。正值返回三次 B 型样条。零值返回一个尖角。如果给定单个形状值，则将其用于所有点。端点的形状始终被视为尖角（shape=0），其他值不影响在端点处生成的样条曲线：

# Catmull-Rom spline vs. cubic B-spline
plot(p, xlim=extendrange(x, f=0.2), ylim=extendrange(y, f=0.2))
text(p, labels=seq(n), pos=3)
# Catmull-Rom spline (-1)
xspline(p, shape = -1, border="red", lwd=2) 
# Catmull-Rom spline (-0.5)
xspline(p, shape = -0.5, border="orange", lwd=2) 
# cubic B-spline (0.5)
xspline(p, shape = 0.5, border="green", lwd=2) 
# cubic B-spline (1)
xspline(p, shape = 1, border="blue", lwd=2)
legend("bottomright", ncol=2, legend=c(-1,-0.5), title="Catmull-Rom spline", col=c("red", "orange"), lty=1)
legend("topleft", ncol=2, legend=c(1, 0.5), title="cubic B-spline", col=c("blue", "green"), lty=1)

xspline从外部绘图中提取结果

这需要一些搜索，但诀窍是将参数draw=FALSE应用于xspline.

# Extract xy values
plot(p, xlim=extendrange(x, f=0.1), ylim=extendrange(y, f=0.1))
text(p, labels=seq(n), pos=3)
spl <- xspline(x, y, shape = -0.5, draw=FALSE) 
lines(spl)
arrows(x0=(spl$x[length(spl$x)-0.01*length(spl$x)]), y0=(spl$y[length(spl$y)-0.01*length(spl$y)]),
       x1=(spl$x[length(spl$x)]), y1=(spl$y[length(spl$y)])
)