我正在尝试在比赛期间制作“球员热图”。这样的事情(http://i.imgur.com/pkdQFqH.jpg)。我有一个gpx格式的gps数据,并且能够将文件上传到R.数据如下:
lon lat ele time position sat
1 20.84293 15.82110 23.9 2016-03-28T17:28:19.407Z 1 3
2 20.84315 15.82129 23.9 2016-03-28T17:28:20.407Z 2 3
3 20.84309 15.82118 23.9 2016-03-28T17:28:22.407Z 3 3
4 20.84269 15.82089 23.9 2016-03-28T17:28:23.407Z 4 3
5 20.84277 15.82092 23.9 2016-03-28T17:28:24.407Z 5 3
6 20.84289 15.82102 23.9 2016-03-28T17:28:25.411Z 6 3
7 20.84306 15.82117 23.9 2016-03-28T17:28:27.411Z 7 3
8 20.84308 15.82115 23.9 2016-03-28T17:28:28.411Z 8 3
9 20.84292 15.82108 23.9 2016-03-28T17:28:29.411Z 9 3
10 20.84307 15.82124 23.9 2016-03-28T17:28:30.412Z 10 3
为了制作热图。我决定测量每个点到数据集中所有其他点的距离,并计算所有小于5米的距离或任何数字。然后使用该信息对每个点进行颜色编码。例如在5米以内有更多点的点将是红色,然后是橙色,黄色等。
为了衡量所有点之间的距离,我想出了这个功能:
numberClosePoints=function(df,i,radius){
close_points=c()
while(i<=nrow(df)){ # looping while i <= the number of rows in the data frame
j = 1 # ... initializing j
count = 0 # count of distances for each i
while(j<=nrow(df)){# looping while j is < 5
dist=pointDistance(c(geodf$lon[i],geodf$lat[i]), c(geodf$lon[j],geodf$lat[j]),lonlat=T)
if (dist <= radius | is.nan(dist)){ # Add the is.nan because for some reason the distance between 5 and 5 was NaN and the function stops
count = count + 1
}
j = j + 1 # incrementing j
}
close_points <- c(close_points,count-1)
i = i + 1 # incrementing i
}
return(close_points)
}
它确实很好用。但是,对于较大的数据集,计算的时间会增加。毕竟,我可以等待比赛中没有那么多分数~3600到4000(2小时每秒1次)。
我想知道是否有办法让它更快,或者有更有效的方法来做热图或功能?