最接近估计路径的点

时间:2015-01-07 14:15:51

标签: r performance

与我之前的问题相似:Closest point to a path

我希望能够找到最接近路径的所有中心。然而,路径中缺少一些数据,我想做线性段以在点之间进行插值以估计'一条可能的道路,仍然找到可能接近该估计路径的中心。

set.seed(1)
n <- 10000
x <- 100*cumprod(1 + rnorm(n, 0.0001, 0.002))
y <- 50*cumprod(1 + rnorm(n, 0.0001, 0.002))

# original path
path <- data.frame(cbind(x=x, y=y))

# path with missing points/points every hundred
path.w.missing <- path[seq(1,n,by=100),]


centers <- expand.grid(x=seq(0, 500,by=0.5) + rnorm(1001), 
                       y=seq(0, 500, by=0.2) + rnorm(2501))

centers$id <- seq(nrow(centers))

没有模拟路径中给定点之间的数百万个线性点......我不确定如何做到这一点...

对我来说,它有点像找到一条线和一个单元格的交叉......各种......但也许我距离... ...

非常感谢任何帮助。

3 个答案:

答案 0 :(得分:1)

这会有所帮助:

## create data
set.seed(1)
n <- 10000
x <- 100 * cumprod(1 + rnorm(n, 0.0001, 0.002))
y <- 50 * cumprod(1 + rnorm(n, 0.0001, 0.002))

# original path
path <- data.frame(cbind(x=x, y=y))

# path with missing points/points every hundred
path.w.missing <- path[seq(1,n,by=100),]


## proposed solution
library(raster)

l <- SpatialLines(list(Lines(list(Line(path.w.missing)), "1")))
r <- raster(extent(bbox(l)), res = c(0.5, 0.2))
r <- rasterize(l, r, field = 1)

## xy will be a matrix
xy <- rasterToPoints(r)

plot(r)
points(xy)
points(path.w.missing, col = "red")

enter image description here

答案 1 :(得分:0)

marmap正是您所需要的:

library(marmap)
bcenters <- as.bathy(centers)
out <- path.profile(path.w.missing,bcenters)

       lon      lat   dist.km  depth
2 100.0512 50.04129   0.00000 247451
3 101.2070 50.11430  82.87177 247450
4 101.3687 50.18730  95.33454 247449
5 101.5973 50.26030 112.81665 248453
6 102.6877 50.33330 190.48139 248454
7 103.2105 50.40630 228.37510 248458

id位于depth列中。编码该函数以沿路径检测测深矩阵中的深度。它发现测深矩阵的所有细胞“吼叫”路径(即最靠近路径的细胞)并输出这些细胞的值。通过将centers对象转换为类bathy的矩阵,您的列id就像使用深度一样。因此,path.profile()会在id列中输出距离您的路径最近的单元格depth

在这里,您从path.w.missing对象中的100点开始。 path.profile()让你成为id 的

nrow(out)
795

最接近此路径的单元格。

以下是path.w.missing数据的图表,其中最近的点重叠为红色:

plot(path.w.missing,type="o",cex=.3, lwd=5)
points(out[,1],out[,2], col=rgb(1,0,0,.8), cex=.3)

enter image description here

答案 2 :(得分:-1)

使用smooth.spline函数(拟合平滑样条曲线)

mx=path.w.missing$x
my=path.w.missing$y
s<-smooth.spline(mx,my)
plot(mx,my)
lines(s) #draw the estimated path 

enter image description here

predict(s,1:10) #And now you can generate all the points on the estimated path

> predict(s,1:10)
$x
 [1]  1  2  3  4  5  6  7  8  9 10

$y
 [1] 2.418294 2.904019 3.389744 3.875469 4.361195 4.846920 5.332645 5.818370 6.304095 6.789820

您可以使用线性模型来适应它。

> summary(lm(my~mx))

Call:
lm(formula = my ~ mx)

Residuals:
    Min      1Q  Median      3Q     Max 
-12.772  -8.642   3.112   5.831  17.237 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) -12.60098    3.46583  -3.636 0.000444 ***
mx            0.56579    0.02138  26.469  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 7.896 on 98 degrees of freedom
Multiple R-squared:  0.8773,    Adjusted R-squared:  0.876 
F-statistic: 700.6 on 1 and 98 DF,  p-value: < 2.2e-16

如你所见,p <0.05,所以我和mx可以作为一条线:

my=-12.60098+0.56579*mx

ggplot2可以轻松绘制此行:

 d=data.frame(mx,my)
 library(ggplot2)
 ggplot(d,aes(mx,my))+geom_point()+geom_smooth(method="lm")

enter image description here

假设一条线为Ax+By+C=0且点为(X0,Y0),指向线距:

|AX0+BY0+C|/√(A²+B²)

所以在这种情况下,0.56579 * mx-my-12.60098 = 0,A = 0.56579,B = -1,C = -12.60098,很容易计算出点到线的距离并找到最接近线的点

此外,如果要找到最近点,删除分母√(A²+B²)不会影响排序,因此,优化公式:

|AX0+BY0+C|

结果

> for(i in 1:2503501){
+ temp=abs(centers[[1]][i]*0.56579-centers[[2]][i]-12.60098)
+ if(m>temp){
+ m=temp
+ pos=i
+ }
+ }
> m
[1] 2.523392e-05
> pos
[1] 638133

使用Rcpp加速程序“test.cpp”

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
int closest(NumericVector a, NumericVector b) {
  int length = a.size();
  double temp,m=10000;
  int pos=0;
  for(int i=0;i<length;i++){
    temp=a[i]*0.56579-b[i]-12.60098;
    if(temp>=0){
      if(m>temp){m=temp;pos=i;}      
    }else{
      if(m>-temp){m=-temp;pos=i;}
    }
  }
  return pos+1;
}

结果(Rcpp花费约2秒):

> sourceCpp("test.cpp")
> closest(centers[[1]],centers[[2]])
[1] 974698
> abs(centers[[1]][974698]*0.56579-centers[[2]][974698]-12.60098)
[1] 0.0002597022