R:检测到“主要"信号.使用内核定位并删除或过滤GPS轨迹? [英] R: Detect a "main" Path and remove or filter the GPS trace maybe using a kernel?

问题描述

是否有一种方法可以过滤掉不属于主路径的那些部分?如您在图片中看到的，我想在保留主路径的同时删除划掉的部分.我已经尝试使用Zoo/Rolling中值，但没有成功.我以为我可以为此任务使用某种形式的内核，但我不确定.我还尝试了不同的平滑方法/功能，但是这些方法/功能无法提供理想的结果，反而会使情况更糟.数据中的距离值可以忽略.

一种方法可能是:

1. 获得n个previos点
2. 获取均值/中值轴承
3. 比较n + 1点的方位
4. 如果方位与n个点的均值相差甚远，则将其丢弃.

所以我的寻路算法所犯的错误是要向前"移动.然后以相同的方式返回.这种情况试图识别并过滤掉.

  path< -structure(list(counter = 1:100，lon = c(11.83000844，11.82986091，11.82975536、11.82968137、11.82966589、11.83364579、11.83346388，11.83479848、11.83630055、11.84026754、11.84215965、11.84530872，11.85369492、11.85449806、11.85479096、11.85888555、11.85908087，11.86262424、11.86715538、11.86814045、11.86844252、11.87138302，11.87579809、11.87736704、11.87819829、11.88358436、11.88923677，11.89024638、11.89091832、11.90027148、11.9027736、11.90408114，11.9063466、11.9068819、11.90833199、11.91121547、11.91204623，11.91386018、11.91657306、11.91708085、11.91761264、11.91204623，11.90833199、11.90739525、11.90583785、11.904688、11.90191917，11.90143671、11.90027148、11.89806126、11.89694917、11.89249712，11.88750445、11.88720159、11.88532786、11.87757307、11.87681905，11.86930751、11.86872102、11.8676844、11.86696599、11.569569006，11.85307297、11.85078596、11.85065013、11.85055277、11.85054529，11.85105901、11.8513188、11.85441234、11.85771987、11.85784653，11.85911367、11.85937322、11.85957177、11.85964041、11.85962915，11.8596438、11.85976783、11.86056853、11.86078973、11.86122148，11.86172538、11.86227576、11.86392935、11.86563636、11.562562302，11.86849157、11.86885719、11.86901696、11.86930676、11.87338922，11.87444184、11.87391755、11.87329231、11.8723503、11.87316759，11.87325551、11.87332646、11.87329074)，纬度= c(48.10980039，48.10954023、48.10927434、48.10891122、48.10873965、48.09824039，48.09526792、48.0940306、48.09328273、48.09161348、48.09097173，48.08975325、48.08619985、48.08594538、48.08576984、48.08370241，48.08237208、48.08128785、48.08204915、48.08193609、48.08186387，48.08102563、48.07902278、48.07827614、48.07791392、48.07583181，48.07435852、48.07418376、48.07408811、48.07252594、48.07207418，48.07174377、48.07108668、48.07094458、48.07061937、48.07033965，48.07033089、48.07034706、48.07025797、48.07020637、48.07014061，48.07033089、48.07061937、48.07081572、48.07123129、48.07156883，48.07224388、48.07232886、48.07252594、48.07313464、48.07346191，48.07389275、48.0748072、48.07488497、48.07531827、48.06876325，48.06880849、48.06992189、48.06935392、48.0688597、48.06872843，48.0682826、48.06236784、48.06083756、48.06031525、48.06007589，48.05979028、48.05819348、48.05773109、48.05523588、48.05084893，48.0502925、48.04750087、48.0471574、48.04655424、48.04615637，48.04573796、48.03988503、48.03985935、48.03986151、48.03984645，48.0397989、48.03966795、48.03925767、48.03841738、48.03701502，48.03658961、48.03417456、48.03394195、48.03386125、48.03372952，48.03236277、48.03045774、48.02935764、48.02770804、48.0262546，48.02391112、48.02376389、48.02361916、48.02295931)，dist = c(16.5491019417617，12.387608371535、13.7541383821868、33.4916122880205、6.9703128008864，30.9036305788955、8.61214448946505、25.0174570393888、37.1966950033338，114.428731827878、42.6981252797486、35.484064302826、46.6949888899517，29.3780621124218、11.3743525290235、37.7195808156292、62.6333126726666，28.4692721123006、17.0298455473048、14.3098664643564、17.7499631308564，87.1393427315571、60.3089055364667、41.7849043662927、87.2691684053224，97.1454278187317、53.9239973250175、53.8018772046333、57.751515546603，27.3798478555643、30.6642975040561、48.4553170757953、41.9759520786297，33.3880134641802、37.3807049759314、49.8823206292369、49.7792541871492，61.821997105488、40.2477260156321、32.2363477179296、43.918067054065，89.6254564762497、35.5927710501446、27.6333379571774、42.0554883840467，45.4018421835631、4.07647329598549、52.945234942045、44.2345694983538，63.8855719530995、37.3036925262838、11.4985551858961、47.6500054672646，12.488428646998、13.7372221770588、24.4479793264376、71.2384899552303，52.9595905197645、16.8213670893537、37.0777367654005、20.1344312201034，24.7504557199489、15.9504355215393、4.4986704990778、17.4471004003001，9.04823098759565、25.684547529165、15.2396067965458、13.9748972112566，88.9846859415509、15.1658523003296、18.6262158018174、8.995876566894735，19.8247489326594、20.4813444727095、23.6721190072342、14.4891642200285，10.6402985988761、10.1346051623741、15.3824252473173、17.5975390671566，15.758052106193、11.4810033780958、25.1035007014738、21.3402595089137，28.5373345425722、11.3907620234039、7.18155005801645、13.5078761535753，14.0009018934227、4.09891462242866、9.47515101787348、10.755798004242，23.9344946865876、36.4670348302756、5.53642050027254、18.2898185695699，17.1906059877831、17.5321948763862、16.2784860139608))，row.names = c(NA，-100L)，类别= c("data.table"，"data.frame")) 

更新09.10.2020

非常感谢您提出的解决方案.每个解决方案都非常有趣，如果可以的话，我将接受所有解决方案.

ekoam的解决方案Nr1 我真的很喜欢，它仅取决于R中的基本软件包！这是一种有趣的方法，但我必须对其进行优化才能将其应用于整个数据集.我将根据轴承的变化划分整个路径，并在过滤器单独的部分上使用此算法，并将它们连接在一起.如果我只追求速度，那将是我会选择的一种方法.

mrhellmann的解决方案Nr2 这是一个非常有趣的方法，它依赖于非常新鲜的专用程序包.与其他2个相比，它还涉及更多的计算，并且在与其他2个相比的竞争中产生的结果不那么平滑.我将试用这些软件包，并且我认为它有很大的潜力！我使用K的值进行游戏，但无法删除尾巴".可以这么说，我想删除该图的内容.

BrianLang的解决方案Nr3 该解决方案在路径突然变化的情况下立即在整个数据集上产生了最佳结果.可以这么说，它在CPU消耗方面有点繁重，但它是最好的，这就是为什么我会选择此解决方案作为对此问题的答案.

非常感谢您一直以来在回答这个问题上所付出的全部努力.

更新09.10.2020 15:19 它基本上在 mrhellmann 和 BrianLang 的提案之间并驾齐驱 mrhellmann 的建议产生了令人窒息的图表，因为它允许其他点出现.当前的差异是7点.

相比之下，提案表格 BrianLang

这是未经优化的整个轨道的样子:

mrhellmann 提供的解决方案大约需要6秒才能获得637分. BrianLang 提供的解决方案也可以在6秒钟内运行.因此，现在在使用软件包和优化方面只存在差异.

解决方案

在下面进行编辑以获取更正确的&完整的答案，另一个则更快.

此解决方案适用于这种情况，但我不确定它是否适用于形状不同的情况.有一些参数可以调整，可能会发现更好的结果.它严重依赖 sf 包和类.

下面的代码将:

• 以所有点作为 sf 对象
• 将每个连接到其(最接近的)数量的最近邻居
• 删除距离路径太远的连接
• 创建网络
• 找到最短路径(原始数据中的点数太少)
• 找回缺失的点

  libary(sf)库(tidyverse)##<-很重，但是很容易加载整个东西库(tidygraph)##我不确定这是否需要图书馆(英文)库(sfnetworks)## https://github.com/luukvdmeer/sfnetworkspath_sf<-st_as_sf(path，coords = c('lon'，'lat')#在我们的点的连接线周围创建一个缓冲区.#稍后用于过滤掉图形的不需要的边缘path_buffer<-path_sf％>％st_combine()％>％st_cast('MULTILINESTRING')％>％st_buffer(dist = .001)## dist = arg将取决于投影CRS.#将每个点连接到其最近的20个邻居，#可能会造成过度杀伤，但它在这里有效.当路径上的点出现问题#间距非常不均匀.一种解决方法是st_sample路径的线串connected20<-st_connect(path_sf，path_sf，ids = st_nn(path_sf，path_sf，k = 20)) 

到目前为止我们所拥有的:

  ggplot()+geom_sf(数据= path_sf)+geom_sf(数据= path_buffer，颜色='绿色'，alpha = .1)+geom_sf(数据=已连接20，alpha = .1) 

现在，我们需要摆脱 path_buffer 之外的连接.

 #删除缓冲区外的多余边缘边<-connected20 [st_within(connected20，path_buffer，稀疏= F)，]％>％st_as_sf() 

ggplot(edges)+ geom_sf(alpha = .2)+ theme_void()

  ##从边缘创建网络净<-as_sfnetwork(边缘，定向= T)##########定向?##使用网络查找从第一个点到最后一个点的最短路径.##这将排除一些原始点，##我们会尽快将其收回.shortest_path<-st_shortest_paths(net，path_sf [1，]，path_sf [nrow(path_sf)，])#可能靠近最短路径，转弯看上去很长short_ish<-path_sf [shortest_path $ vpath [[1]]，] 

short_ish 的图表明可能缺少一些点:

 #使用此命令可重新获得最短路径上的所有点short_buffer<-short_ish％>％st_combine()％>％st_cast('LINESTRING')％>％st_buffer(dist = .001)short_all<-path_sf [st_within(path_sf，short_buffer，sparse = F)，] 

(可能是)最短路径上的几乎所有点:

调整缓冲区距离 dist 和最近邻居的数量 k = 20 可能会给您带来更好的结果.由于某种原因，它错过了叉子前部的几个点，并且可能在叉子处向东移动得太远了.最近邻居函数也可以返回距离.删除长度超过相邻点之间最大距离的连接会有所帮助.

修改:

下面的代码在运行上面的代码后应该会得到更好的跟踪.图像包括原始轨迹，最短路径，最短轨迹上的所有点以及用于获取这些点的缓冲区.起点为绿色，终点为红色.

  ##上面的路径缓冲区，dist = .002而不是.001path_buffer<-path_sf％>％st_combine()％>％st_cast('MULTILINESTRING')％>％st_buffer(dist = .002)###起点，数据的第一个点p1<-净％>％激活('nodes')％&％;％st_as_sf()％>％slice(1)###终点，数据的最后一点p2<-净％>％激活('nodes')％>％st_as_sf()％>％tail(1)#新的短路shortest_path2<-净％>％转换(to_spatial_shortest_paths，p1，p2)#再次缓冲以获取原始的所有点shortest_path_buffer<-shortest_path2％>％激活(边缘)％&％;％st_as_sf()％>％st_cast('MULTILINESTRING')％>％st_combine()％>％st_buffer(dist = .0018)#最短路径，使用原始数据中的所有点all_points_short_path<-path_sf [st_within(path_sf，shortest_path_buffer，sparse = F)，]#绘图ggplot()+geom_sf(数据= p1，大小= 4，颜色='绿色')+geom_sf(数据= p2，大小= 4，颜色='红色')+geom_sf(数据= path_sf，颜色='黑色'，alpha = 0.2)+geom_sf(数据=激活(shortest_path2，'edges')％>％st_as_sf()，color ='orange'，alhpa = .4)+geom_sf(数据=最短路径缓冲区，填充='蓝色'，alpha = .2)+geom_sf(数据= all_points_short_path，颜色='橙色​​'，alpha = .4)+theme_void() 

编辑2 可能更快，尽管很难说出一个小数据集的数量.同样，不太可能包括所有正确的点.遗漏了一些原始数据.

  path_sf<-st_as_sf(path，coords = c('lon'，'lat'))#较高的密度较慢，但​​较完整.#高k将被缠绕路径所欺骗，因为不会缓冲不正确的边#为了速度.密度= 200k = 4开始<-path_sf [1，]％&％;％st_geometry()结束<-path_sf [dim(path_sf)[1]，]％&％;％st_geometry()path_sf_samp<-path_sf％>％st_combine()％>％st_cast('LINESTRING')％>％st_line_sample(密度=密度)％>％st_cast('POINT')％>％st_union(start)％>％st_union(end)％>％st_cast('POINT')％&％;％st_as_sf()connected3<-st_connect(path_sf_samp，path_sf_samp，ids = st_nn(path_sf_samp，path_sf_samp，k = k))边缘<-已连接3％>％st_as_sf()净<-as_sfnetwork(边，有向= F)##########有指示?最短路径<-净％>％转换(to_spatial_shortest_paths，开始，结束)shortest_path_buffer<-最短路径％>％激活(边缘)％&％;％st_as_sf()％>％st_cast('MULTILINESTRING')％>％st_combine()％>％st_buffer(dist = .0018)all_points_short_path<-path_sf [st_within(path_sf，shortest_path_buffer，sparse = F)，]ggplot()+geom_sf(数据= path_sf，颜色='黑色'，alpha = 0.2)+geom_sf(数据=激活(shortest_path，'edges')％&％;％st_as_sf()，color ='orange'，alpha = .4)+geom_sf(数据=最短路径缓冲区，填充='蓝色'，alpha = .2)+geom_sf(数据= all_points_short_path，颜色='橙色​​'，alpha = .4)+theme_void() 

Is there a way to filter out those parts which don't belong to the main path? As you can see in the picture i would like to remove the crossed out part while keeping the main path. I already tried using zoo/rolling median but without success. I thought i could use maybe a kernel of some sort for this task but im not sure. I also tried different smooth approaches / functions but those does not provided a desired outcome and rather made things worse. Dist value in the data can be ignored.

One approach could be:

1. Take n previos points
2. get the mean / median bearing
3. compare bearing of n+1 point
4. if bearing is far to different from mean one of n points, discard the point.

So the mistake my path finding algo does is to go "forward" and then back the same way. This situation im trying to identify and filter out.

path<-structure(list(counter = 1:100, lon = c(11.83000844, 11.82986091, 
11.82975536, 11.82968137, 11.82966589, 11.83364579, 11.83346388, 
11.83479848, 11.83630055, 11.84026754, 11.84215965, 11.84530872, 
11.85369492, 11.85449806, 11.85479096, 11.85888555, 11.85908087, 
11.86262424, 11.86715538, 11.86814045, 11.86844252, 11.87138302, 
11.87579809, 11.87736704, 11.87819829, 11.88358436, 11.88923677, 
11.89024638, 11.89091832, 11.90027148, 11.9027736, 11.90408114, 
11.9063466, 11.9068819, 11.90833199, 11.91121547, 11.91204623, 
11.91386018, 11.91657306, 11.91708085, 11.91761264, 11.91204623, 
11.90833199, 11.90739525, 11.90583785, 11.904688, 11.90191917, 
11.90143671, 11.90027148, 11.89806126, 11.89694917, 11.89249712, 
11.88750445, 11.88720159, 11.88532786, 11.87757307, 11.87681905, 
11.86930751, 11.86872102, 11.8676844, 11.86696599, 11.86569006, 
11.85307297, 11.85078596, 11.85065013, 11.85055277, 11.85054529, 
11.85105901, 11.8513188, 11.85441234, 11.85771987, 11.85784653, 
11.85911367, 11.85937322, 11.85957177, 11.85964041, 11.85962915, 
11.8596438, 11.85976783, 11.86056853, 11.86078973, 11.86122148, 
11.86172538, 11.86227576, 11.86392935, 11.86563636, 11.86562302, 
11.86849157, 11.86885719, 11.86901696, 11.86930676, 11.87338922, 
11.87444184, 11.87391755, 11.87329231, 11.8723503, 11.87316759, 
11.87325551, 11.87332646, 11.87329074), lat = c(48.10980039, 
48.10954023, 48.10927434, 48.10891122, 48.10873965, 48.09824039, 
48.09526792, 48.0940306, 48.09328273, 48.09161348, 48.09097173, 
48.08975325, 48.08619985, 48.08594538, 48.08576984, 48.08370241, 
48.08237208, 48.08128785, 48.08204915, 48.08193609, 48.08186387, 
48.08102563, 48.07902278, 48.07827614, 48.07791392, 48.07583181, 
48.07435852, 48.07418376, 48.07408811, 48.07252594, 48.07207418, 
48.07174377, 48.07108668, 48.07094458, 48.07061937, 48.07033965, 
48.07033089, 48.07034706, 48.07025797, 48.07020637, 48.07014061, 
48.07033089, 48.07061937, 48.07081572, 48.07123129, 48.07156883, 
48.07224388, 48.07232886, 48.07252594, 48.07313464, 48.07346191, 
48.07389275, 48.0748072, 48.07488497, 48.07531827, 48.06876325, 
48.06880849, 48.06992189, 48.06935392, 48.0688597, 48.06872843, 
48.0682826, 48.06236784, 48.06083756, 48.06031525, 48.06007589, 
48.05979028, 48.05819348, 48.05773109, 48.05523588, 48.05084893, 
48.0502925, 48.04750087, 48.0471574, 48.04655424, 48.04615637, 
48.04573796, 48.03988503, 48.03985935, 48.03986151, 48.03984645, 
48.0397989, 48.03966795, 48.03925767, 48.03841738, 48.03701502, 
48.03658961, 48.03417456, 48.03394195, 48.03386125, 48.03372952, 
48.03236277, 48.03045774, 48.02935764, 48.02770804, 48.0262546, 
48.02391112, 48.02376389, 48.02361916, 48.02295931), dist = c(16.5491019417617, 
12.387608371535, 13.7541383821868, 33.4916122880205, 6.9703128008864, 
30.9036305788955, 8.61214448946505, 25.0174570393888, 37.1966950033338, 
114.428731827878, 42.6981252797486, 35.484064302826, 46.6949888899517, 
29.3780621124218, 11.3743525290235, 37.7195808156292, 62.6333126726666, 
28.4692721123006, 17.0298455473048, 14.3098664643564, 17.7499631308564, 
87.1393427315571, 60.3089055364667, 41.7849043662927, 87.2691684053224, 
97.1454278187317, 53.9239973250175, 53.8018772046333, 57.751515546603, 
27.3798478555643, 30.6642975040561, 48.4553170757953, 41.9759520786297, 
33.3880134641802, 37.3807049759314, 49.8823206292369, 49.7792541871492, 
61.821997105488, 40.2477260156321, 32.2363477179296, 43.918067054065, 
89.6254564762497, 35.5927710501446, 27.6333379571774, 42.0554883840467, 
45.4018421835631, 4.07647329598549, 52.945234942045, 44.2345694983538, 
63.8855719530995, 37.3036925262838, 11.4985551858961, 47.6500054672646, 
12.488428646998, 13.7372221770588, 24.4479793264376, 71.2384899552303, 
52.9595905197645, 16.8213670893537, 37.0777367654005, 20.1344312201034, 
24.7504557199489, 15.9504355215393, 4.4986704990778, 17.4471004003001, 
9.04823098759565, 25.684547529165, 15.2396067965458, 13.9748972112566, 
88.9846859415509, 15.1658523003296, 18.6262158018174, 8.95876566894735, 
19.8247489326594, 20.4813444727095, 23.6721190072342, 14.4891642200285, 
10.6402985988761, 10.1346051623741, 15.3824252473173, 17.5975390671566, 
15.758052106193, 11.4810033780958, 25.1035007014738, 21.3402595089137, 
28.5373345425722, 11.3907620234039, 7.18155005801645, 13.5078761535753, 
14.0009018934227, 4.09891462242866, 9.47515101787348, 10.755798004242, 
23.9344946865876, 36.4670348302756, 5.53642050027254, 18.2898185695699, 
17.1906059877831, 17.5321948763862, 16.2784860139608)), row.names = c(NA, 
-100L), class = c("data.table", "data.frame"))

UPDATE 09.10.2020

Thank you so much for your proposals of solution. Every solution was very interesting and if i could i would accept all of them.

Solution Nr1 by ekoam I really like that it only depends on base packages within R! It's an interesting approach yet I have to optimize it to be able to apply it to the whole dataset. I would divide the whole path based on bearing change and use this algo on filter separate parts and connect them together. If I would go only for speed, this would be an approach I would have chosen.!

Solution Nr2 by mrhellmann It's a very interesting approach that depends on very fresh specialized packages. It also involves a bit more computation then other 2 and produces not so smooth result in compairesement to other 2. I will play around with those packages and I think there is a lot of potential! I played with the value of K but was not able to remove the "tail" so to say that i wanted to remove accourding to the drawing.

Solution Nr3 by BrianLang This solution produced the best result right away on the whole dataset with a sudden change in path. Its a bit heavy regarding CPU consumption but it works the best right out of the box so to say and that is why I would choose this solution as an answer to this question.

Thank you very much i really appreciate all the time you all invested in answering this question.

Update 09.10.2020 15:19 Its basically neck a neck between the proposal from mrhellmann and BrianLang The propsal from mrhellmann produces lightly smother graph since it lets other points be. The current difference is 7 points.

In comparison the proposal form BrianLang

And this is how the whole track looks without optimization:

The solution provided by mrhellmann requiers around 6 sec to run on 637 points. The solution provided by BrianLang runs in 6 sec also. So now there is only difference in use of packages and possibilty for optimization.

解决方案

Edits below one for a more correct & complete answer, the other for a faster one.

This solution works for this case, but I'm not sure it will work in cases that aren't similarly shaped. There are a few parameters that can be adjusted that might find better results. It relies heavily on the sf package and classes.

The code below will:

• Start with all the points as an sf object
• Connect each to (an adjustable) number of its nearest neighbors
• Remove the connections that are too far off the path
• Create a network
• Find the shortest path (which will have too few points from the original data)
• Get the missing points back

libary(sf)
library(tidyverse) ## <- heavy, but it's easy to load the whole thing
library(tidygraph) ##  I'm not sure this was needed
library(nngeo)
library(sfnetworks) ## https://github.com/luukvdmeer/sfnetworks


path_sf <- st_as_sf(path, coords = c('lon', 'lat')

# create a buffer around a connected line of our points.
#  used later to filter out unwanted edges of graph
path_buffer <- 
  path_sf %>%
   st_combine() %>%
   st_cast('MULTILINESTRING') %>%
   st_buffer(dist = .001)         ## dist = arg will depend on projection CRS.


# Connect each point to its 20 nearest neighbors,
#  probably overkill, but it works here.  Problems occur when points on the path
#  have very uneven spacing. A workaround would be to st_sample a linestring of the path
connected20 <- st_connect(path_sf, path_sf,
                          ids = st_nn(path_sf, path_sf, k = 20))

What we have so far:

ggplot() + 
  geom_sf(data = path_sf) + 
  geom_sf(data = path_buffer, color = 'green', alpha = .1) +
  geom_sf(data = connected20, alpha = .1)

Now we need to get rid of the connections outside path_buffer.

# Remove unwanted edges outside the buffer
edges <- connected20[st_within(connected20,
                               path_buffer,
                               sparse = F),] %>%
  st_as_sf()

ggplot(edges) + geom_sf(alpha = .2) + theme_void()

## Create a network from the edges
net <- as_sfnetwork(edges, directed = T) ########## directed?

## Use network to find shortest path from the first point to the last. 
## This will exclude some original points,
##  we'll get them back soon.
shortest_path <- st_shortest_paths(net,
                                   path_sf[1,],
                                   path_sf[nrow(path_sf),])

# Probably close to the shortest path, the turn looks long
short_ish <- path_sf[shortest_path$vpath[[1]],] 

The plot of short_ish shows that some points are probably missing:

# Use this to regain all points on the shortest path
short_buffer <- short_ish %>%
  st_combine() %>%
  st_cast('LINESTRING') %>%
  st_buffer(dist = .001)

short_all <- path_sf[st_within(path_sf, short_buffer, sparse = F), ]

Almost all the points on (what may be) the shortest path:

Adjusting buffer distances dist, and number of nearest neighbors k = 20 might give you a better result. For some reason this misses a couple of points just south of the fork, and might travel too far east at the fork. The nearest neighbors function can also return distances. Removing connections longer than the greatest distance between neighboring points would help.

Edit:

Code below should get a better track after running code above. Image includes original track, shortest path, all points along the shortest track, and the buffer to obtain those points. Start point in green, end point in red.

## Path buffer as above, dist = .002 instead of .001
path_buffer <- 
  path_sf %>%
  st_combine() %>%
  st_cast('MULTILINESTRING') %>%
  st_buffer(dist = .002)        

### Starting point, 1st point of data
p1 <- net %>% activate('nodes') %>%
  st_as_sf() %>% slice(1)

### Ending point, last point of data
p2 <- net %>% activate('nodes') %>%
  st_as_sf() %>% tail(1)

# New short path
shortest_path2 <- net %>% 
  convert(to_spatial_shortest_paths, p1, p2)
# Buffer again to get all points from original
shortest_path_buffer <- shortest_path2 %>%
  activate(edges) %>% 
  st_as_sf() %>% 
  st_cast('MULTILINESTRING') %>%
  st_combine() %>%
  st_buffer(dist = .0018)

# Shortest path, using all points from original data
all_points_short_path <- path_sf[st_within(path_sf, shortest_path_buffer, sparse = F),]

# Plotting
ggplot() + 
  geom_sf(data = p1, size = 4, color = 'green') + 
  geom_sf(data = p2, size = 4, color = 'red') + 
  geom_sf(data = path_sf, color = 'black', alpha = .2) + 
  geom_sf(data = activate(shortest_path2, 'edges') %>% st_as_sf(), color = 'orange', alhpa = .4) + 
  geom_sf(data = shortest_path_buffer, fill = 'blue', alpha = .2) + 
  geom_sf(data = all_points_short_path, color = 'orange', alpha = .4) +
  theme_void()

Edit 2 Probably faster, though hard to tell how much with a small dataset. Also, less likely to include all correct points. Misses a few points from original data.

path_sf <- st_as_sf(path, coords = c('lon', 'lat'))


# Higher density is slower, but more complete. 
# Higher k will be fooled by winding paths as incorrect edges aren't buffered out
# in the interest of speed.
density = 200
k = 4
  
start <- path_sf[1, ] %>% st_geometry()
end <- path_sf[dim(path_sf)[1],] %>% st_geometry()

path_sf_samp <- path_sf %>%
  st_combine() %>%
  st_cast('LINESTRING') %>%
  st_line_sample(density = density) %>%
  st_cast('POINT') %>%
  st_union(start) %>%
  st_union(end) %>%
  st_cast('POINT')%>%
  st_as_sf()

connected3 <- st_connect(path_sf_samp, path_sf_samp,
                          ids = st_nn(path_sf_samp, path_sf_samp, k = k))

edges <- connected3 %>%
  st_as_sf()

net <- as_sfnetwork(edges, directed = F) ########## directed?

shortest_path <- net %>% 
  convert(to_spatial_shortest_paths, start, end)

shortest_path_buffer <- shortest_path %>%
  activate(edges) %>% 
  st_as_sf() %>% 
  st_cast('MULTILINESTRING') %>%
  st_combine() %>%
  st_buffer(dist = .0018)

all_points_short_path <- path_sf[st_within(path_sf, shortest_path_buffer, sparse = F),]


ggplot() + 
  geom_sf(data = path_sf, color = 'black', alpha = .2) + 
  geom_sf(data = activate(shortest_path, 'edges') %>% st_as_sf(), color = 'orange', alpha = .4) + 
  geom_sf(data = shortest_path_buffer, fill = 'blue', alpha = .2) + 
  geom_sf(data = all_points_short_path, color = 'orange', alpha = .4) +
  theme_void()

这篇关于R:检测到“主要"信号.使用内核定位并删除或过滤GPS轨迹?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！