计算R中的2D样条曲线

Mar*_*box 10 plot bezier r catmull-rom-curve cubic-spline

我正在尝试计算一个类似Bezier的样条曲线,该曲线通过一系列xy坐标.一个例子就像cscvnMatlab中的函数的以下输出(示例链接):

在此输入图像描述

我相信(不再维护)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]
)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

如您所见,除了结束值之外,它不会通过任何点.

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

小智 12

没有必要grid真的使用.您可以xsplinegraphics包中访问.

从您的代码和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)
Run Code Online (Sandbox Code Playgroud)

你只需要一条额外的线:

xspline(x, y, shape = c(0,rep(-1, 10-2),0), border="red")
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述


MrF*_*ick 10

它可能不是最好的方法,grid当然不是不活跃的.它包含在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()
Run Code Online (Sandbox Code Playgroud)

结果

在此输入图像描述

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

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


Mar*_*box 6

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

Catmull-Rom 样条与三次 B 样条

函数中的负形状值xspline返回 Catmull-Rom 类型样条线,其中样条线穿过 xy 点。正值返回三次 B 型样条线。零值返回尖角。如果给出单个形状值,则该值将用于所有点。端点的形状始终被视为尖角(形状=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)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

提取结果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)])
)
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述