在多条线之间插值的最快方法
Fastest approach to interpolate between several lines
我有 14 条不同线的截距和斜率,其中 y = Slope * x + Intercept
。这些线或多或少平行如下。每行代表某个class.
Intercept Slope
1 8.787611 -3.435561
2 6.853230 -2.662021
3 6.660198 -2.584231
4 6.929856 -2.678694
5 6.637965 -2.572499
6 7.132044 -2.744441
7 7.233281 -2.802287
8 7.285169 -2.807539
9 7.207577 -2.772140
10 6.872071 -2.640098
11 6.778350 -2.612107
12 6.994820 -2.706729
13 6.947074 -2.690497
14 7.486870 -2.864093
当新数据以 (x, y)
形式出现时。我想完成两项任务:
1) 找出哪条线最接近点(e.x. '1', '4', or '8')
2) 找到 x = 2.6 处的插值。这意味着如果一个点位于两条线之间,并且对于 x = 2.6
,这些线的值为 0
和 -0.05
,则内插值将与 [-0.05, 0]
成正比点到线的距离。
x y
1 2.545726 0.1512721
2 2.545726 0.1512721
3 2.545843 0.1512721
4 2.545994 0.1512721
5 2.546611 0.1512721
6 2.546769 0.1512721
7 2.546995 0.1416945
8 2.547269 0.1416945
9 2.548765 0.1416945
10 2.548996 0.1416945
我正在考虑编写自己的代码并使用 this Wikipedia page 找到新点与 14 条线的距离,然后选择点上方和下方线的两个最小距离(如果点不是高于或低于所有 14 条线),并按比例进行插值。但是,我很确定这不是最快的方法,因为它没有矢量化。我想知道是否有更快的方法来完成这项任务。
lines <- read.table(textConnection("
Intercept Slope
1 8.787611 -3.435561
2 6.853230 -2.662021
3 6.660198 -2.584231
4 6.929856 -2.678694
5 6.637965 -2.572499
6 7.132044 -2.744441
7 7.233281 -2.802287
8 7.285169 -2.807539
9 7.207577 -2.772140
10 6.872071 -2.640098
11 6.778350 -2.612107
12 6.994820 -2.706729
13 6.947074 -2.690497
14 7.486870 -2.864093"))
points <- read.table(textConnection("
x y
1 2.545726 0.1512721
2 2.545726 0.1512721
3 2.545843 0.1512721
4 2.545994 0.1512721
5 2.546611 0.1512721
6 2.546769 0.1512721
7 2.546995 0.1416945
8 2.547269 0.1416945
9 2.548765 0.1416945
10 2.548996 0.1416945"))
cartDist <- function(lines, x, y) {
with(lines, abs(Slope*x-y+Intercept)/sqrt(Slope^2+1))
}
interp_ys <- sapply(1:nrow(points), function(i) {
x <- points$x[i]
y <- points$y[i]
dists <- cartDist(lines, x, y)
dr <- rank(dists)
wh <- which(dr %in% c(1,2))
ys <- with(lines[wh,], Slope*2.6+Intercept)
sum(((sum(dists[wh]) - dists[wh]) * ys))/sum(dists[wh]) #weighted average
})
plot(NA, ylim=c(-0.01,0.16), xlim=c(2.53,2.61), xlab="x", ylab="y", main="Interpolated points")
for(i in 1:nrow(lines)) {
abline(b=lines$Slope[i], a=lines$Intercept[i], col="gray")
}
points(x=points$x, y=points$y, col="red")
points(x=rep(2.6, nrow(points)), y=interp_ys, col="blue")
segments(x0=rep(2.6, nrow(points)), y0=interp_ys, x1=points$x, y1=points$y, lty=2,col="black")
我有 14 条不同线的截距和斜率,其中 y = Slope * x + Intercept
。这些线或多或少平行如下。每行代表某个class.
Intercept Slope
1 8.787611 -3.435561
2 6.853230 -2.662021
3 6.660198 -2.584231
4 6.929856 -2.678694
5 6.637965 -2.572499
6 7.132044 -2.744441
7 7.233281 -2.802287
8 7.285169 -2.807539
9 7.207577 -2.772140
10 6.872071 -2.640098
11 6.778350 -2.612107
12 6.994820 -2.706729
13 6.947074 -2.690497
14 7.486870 -2.864093
当新数据以 (x, y)
形式出现时。我想完成两项任务:
1) 找出哪条线最接近点(e.x. '1', '4', or '8')
2) 找到 x = 2.6 处的插值。这意味着如果一个点位于两条线之间,并且对于 x = 2.6
,这些线的值为 0
和 -0.05
,则内插值将与 [-0.05, 0]
成正比点到线的距离。
x y
1 2.545726 0.1512721
2 2.545726 0.1512721
3 2.545843 0.1512721
4 2.545994 0.1512721
5 2.546611 0.1512721
6 2.546769 0.1512721
7 2.546995 0.1416945
8 2.547269 0.1416945
9 2.548765 0.1416945
10 2.548996 0.1416945
我正在考虑编写自己的代码并使用 this Wikipedia page 找到新点与 14 条线的距离,然后选择点上方和下方线的两个最小距离(如果点不是高于或低于所有 14 条线),并按比例进行插值。但是,我很确定这不是最快的方法,因为它没有矢量化。我想知道是否有更快的方法来完成这项任务。
lines <- read.table(textConnection("
Intercept Slope
1 8.787611 -3.435561
2 6.853230 -2.662021
3 6.660198 -2.584231
4 6.929856 -2.678694
5 6.637965 -2.572499
6 7.132044 -2.744441
7 7.233281 -2.802287
8 7.285169 -2.807539
9 7.207577 -2.772140
10 6.872071 -2.640098
11 6.778350 -2.612107
12 6.994820 -2.706729
13 6.947074 -2.690497
14 7.486870 -2.864093"))
points <- read.table(textConnection("
x y
1 2.545726 0.1512721
2 2.545726 0.1512721
3 2.545843 0.1512721
4 2.545994 0.1512721
5 2.546611 0.1512721
6 2.546769 0.1512721
7 2.546995 0.1416945
8 2.547269 0.1416945
9 2.548765 0.1416945
10 2.548996 0.1416945"))
cartDist <- function(lines, x, y) {
with(lines, abs(Slope*x-y+Intercept)/sqrt(Slope^2+1))
}
interp_ys <- sapply(1:nrow(points), function(i) {
x <- points$x[i]
y <- points$y[i]
dists <- cartDist(lines, x, y)
dr <- rank(dists)
wh <- which(dr %in% c(1,2))
ys <- with(lines[wh,], Slope*2.6+Intercept)
sum(((sum(dists[wh]) - dists[wh]) * ys))/sum(dists[wh]) #weighted average
})
plot(NA, ylim=c(-0.01,0.16), xlim=c(2.53,2.61), xlab="x", ylab="y", main="Interpolated points")
for(i in 1:nrow(lines)) {
abline(b=lines$Slope[i], a=lines$Intercept[i], col="gray")
}
points(x=points$x, y=points$y, col="red")
points(x=rep(2.6, nrow(points)), y=interp_ys, col="blue")
segments(x0=rep(2.6, nrow(points)), y0=interp_ys, x1=points$x, y1=points$y, lty=2,col="black")