.Rhistory

matchs <- rbind(matchs,c(pass_start[i], nrow(sub_data), dist_ord))
} else {
matchs <- paste0("stream match in reverse order")
}
}
if(is.null(matchs)) {
matchs <- paste0("stream match partially with route: ", round(mean(inter_subpts_rt),2)*100,"% overlap")
}
}
}
} else {
matchs <- "streams intersect but dont match"
}
} else {
matchs <- "streams do not intersect"
}
} else {
matchs <- "data and route must contain lon and lat columns"
}
return(matchs)
}
library(GPStream)
library(GPStream)
#' Evaluates if 2 streams belongs to the same route. Checks for distance to start and end of route, for completion of track
#' and for staying on the right track
#'
#' @param data dataframe or tibble containing a GPS stream
#' @param route another stream / route to be validated
#' @param tolerance threshold. Default setting on 20 meters
#'
#' @return either coordinates of match section(s) of data or character with explanation of mismatch
#' @export
#'
match_stream <- function(data, route, tolerance = 50){
matchs <- NULL
tolerance_completion <- 0
tolerance_sentido <- .03
if(exists("lat",data) & exists("lon", data) & exists("lat", route) & exists("lon", route)){
data <- data %>% select(lon,lat) %>% differential_stream()
route <- route %>% select(lon,lat) %>% differential_stream()
route$coverage <- route$distance / max(route$distance)
dist_to_degrees <- tolerance * sqrt(abs(data$lon[1] - route$lon[nrow(route)/2])^2 + abs(data$lat[1] - route$lat[nrow(route)/2])^2) /
geosphere::distm(cbind(data$lon[1],data$lat[1]),
cbind(route$lon[nrow(route)/2],route$lat[nrow(route)/2]),
fun = geosphere::distHaversine)
data_sf <- data %>%
sf::st_as_sf(coords = c("lon", "lat"), agr = "constant") %>%
summarise(do_union = FALSE) %>%
sf::st_cast("LINESTRING") %>%
sf::st_buffer(dist = dist_to_degrees)
route_sf <- route %>%
sf::st_as_sf(coords = c("lon", "lat"), agr = "constant") %>%
summarise(do_union = FALSE) %>%
sf::st_cast("LINESTRING") %>%
sf::st_buffer(dist = dist_to_degrees)
if(sf::st_intersects(data_sf, route_sf, sparse=FALSE)){
data_sf_pts <- data %>%
sf::st_as_sf(coords = c("lon", "lat"), agr = "constant") %>%
summarise(do_union = FALSE) %>%
sf::st_cast("POINT") %>%
sf::st_buffer(dist = dist_to_degrees)
route_sf_pts <- route %>%
sf::st_as_sf(coords = c("lon", "lat"), agr = "constant") %>%
summarise(do_union = FALSE) %>%
sf::st_cast("POINT") %>%
sf::st_buffer(dist = dist_to_degrees)
inter_pts_rt <- sf::st_intersects(route_sf_pts, data_sf, sparse=FALSE)
if(sum(inter_pts_rt)>=nrow(route)*(1-tolerance_completion)){
start <- route_sf_pts[1,]
inter_pts_start <- sf::st_intersects(data_sf_pts, start, sparse=FALSE)
pass_start <- which(inter_pts_start == TRUE)
pass_start <- c(1,pass_start[c(0,diff(pass_start))>1])
for(i in 1:length(pass_start)){
sub_data <- data[pass_start[i]:nrow(data_sf_pts),]
sub_data$distance <- cumsum(sub_data$delta_distance)
sub_data <- sub_data %>% filter(distance <= max(route$distance)+tolerance)
if(nrow(sub_data)> 1){
sub_data$coverage <- sub_data$distance / max(sub_data$distance)
sub_data_sf <- sub_data %>%
sf::st_as_sf(coords = c("lon", "lat"), agr = "constant") %>%
summarise(do_union = FALSE) %>%
sf::st_cast("LINESTRING") %>%
sf::st_buffer(dist = dist_to_degrees)
inter_subpts_rt <- sf::st_intersects(route_sf_pts, sub_data_sf, sparse=FALSE)
order_data <- sub_data[round((1:10)*nrow(sub_data)/10),]
order_route <- route[round((1:10)*nrow(route)/10),]
dist_ord <- (mean(diag(geosphere::distm(cbind(order_data$lon,order_data$lat),
cbind(order_route$lon,order_route$lat),
fun = geosphere::distHaversine))))
if(mean(inter_subpts_rt)>=(1-tolerance_sentido)){
if(dist_ord < 300){
matchs <- rbind(matchs,c(pass_start[i], nrow(sub_data), dist_ord))
} else {
matchs <- paste0("stream match in reverse order")
}
}
if(is.null(matchs)) {
matchs <- paste0("stream match partially with route: ", round(mean(inter_subpts_rt),2)*100,"% overlap")
}
}
}
} else {
matchs <- "streams intersect but dont match"
}
} else {
matchs <- "streams do not intersect"
}
} else {
matchs <- "data and route must contain lon and lat columns"
}
return(matchs)
}
pacman::p_load(tidyverse, googlePolylines, GPStream, sf)
dir <- "inst/extdata/"
testfiles <- list.files(dir)
strs <- strava_streams  %>% uniform_stream()
for(fil in testfiles){
stream <- read_stream(paste0(dir,fil))  %>% uniform_stream()
stream$id <- fil
strs <- plyr::rbind.fill(strs, stream)
}
strsuni <- unique(strs$id)
for(str in strsuni){
# for(str2 in strsuni){
if(str != str2){
for(toler in (5:5)*10){
data <- strs %>% filter(id == str)
# route <- strs %>% filter(id == str2)
route <- data_rev
m1 <- match_stream(data, route)
if(grepl("reve",m1)){
ggplot(data, aes(lon,lat)) +
geom_point()+
geom_point(data=route, col = "red", size=0.8) +
ggtitle(m1)
ggsave(paste0("tests/",str2,"-",str,".png"))
}
}
}
# }
}
strsuni <- unique(strs$id)
for(str in strsuni){
for(str2 in strsuni){
if(str != str2){
for(toler in (5:5)*10){
data <- strs %>% filter(id == str)
# route <- strs %>% filter(id == str2)
route <- data_rev
m1 <- match_stream(data, route)
if(grepl("reve",m1)){
ggplot(data, aes(lon,lat)) +
geom_point()+
geom_point(data=route, col = "red", size=0.8) +
ggtitle(m1)
ggsave(paste0("tests/",str2,"-",str,".png"))
}
}
}
}
}
strsuni <- unique(strs$id)
for(str in strsuni){
for(str2 in strsuni){
if(str != str2){
for(toler in (5:5)*10){
data <- strs %>% filter(id == str)
route <- strs %>% filter(id == str2)
# route <- data_rev
m1 <- match_stream(data, route)
if(grepl("reve",m1)){
ggplot(data, aes(lon,lat)) +
geom_point()+
geom_point(data=route, col = "red", size=0.8) +
ggtitle(m1)
ggsave(paste0("tests/",str2,"-",str,".png"))
}
}
}
}
}
zeros <- function(n,m=NULL) {
if(is.null(m)){
m <- n
}
return(matrix(0,n,m))
}
zeros(3)
zeros(3,4)
zeros <- function(n, m=NULL) {
if(is.null(m)) m <- n
return(matrix(0,n,m))
}
zeros(3,4)
zeros(3)
ones <- function(n, m=NULL) {
if(is.null(m)) m <- n
return(matrix(1,n,m))
}
ones(4)
vector <- data$id_window
#' Rolling window segment
#'
#' @param data dataframe or tibble containing a GPS stream
#' @param size split size
#' @param value time or distance of the size
#'
#' @return
#' @export
#'
rolling_window <- function(data, size = 100, value = "distance"){
windowed_data <- NULL
if(value=="distance"){
data$id_window <- round(data$distance)
} else if(value == "time"){
data$id_window <- cumsum(data$delta_time)
}
vector <- data$id_window
vector <- vector[vector<=max(vector)-size]
for(w in vector){
data_wind <- data %>% filter(id_window >= w, id_window < (w + size))
data_wind$id_seg <- paste0("seg",w)
if(nrow(data_wind)>0 ){
subwind <- summarise_stream(data_wind)
windowed_data <- rbind(windowed_data, subwind)
}
}
windowed_data <- unique(windowed_data)
return(windowed_data)
}
agg_stream = function(data, size = 100, value = "distance", windowed = TRUE){
if(windowed){
segments <- rolling_window(data, size, value)
} else {
# if time split segments according to elapsed time, else cumulative distance
if(value == "time"){
data$id_seg <- floor(data$time / size)
} else if(value == "distance"){
data$id_seg <- floor(data$distance / size) #cumulative distance in meters
}
segments <- data %>%
summarise_stream()
}
# return dataframe with segment features
if(value == "time"){
return(segments %>% dplyr::filter(delta_time >= size))
} else if(value == "distance"){
return(segments %>% dplyr::filter(delta_distance >= size))
}
}
#' Summarise segment
#'
#' @param data dataframe or tibble containing a stream segment
#'
#' @return
#' @export
#'
summarise_stream <- function(data){
if(exists("delta_distance",data) &
exists("dplus",data) &
exists("distance",data) &
exists("dminus",data) &
exists("ele",data)){
if(nrow(data)>0){
if(exists("delta_time", data)){
segment <-
data %>%
group_by(id_seg) %>%
summarise(delta_time = sum(delta_time),
delta_distance = sum(delta_distance),
dplus = sum(dplus),
dminus = sum(dminus),
time = mean(time),
distance = mean(distance),
ele = mean(ele),
speed = delta_distance / delta_time)
}
if(!exists("delta_time", data)){
segment <-
data %>%
group_by(id_seg) %>%
summarise(delta_distance = sum(delta_distance),
dplus = sum(dplus),
dminus = sum(dminus),
distance = mean(distance),
ele = mean(ele))
}
}
} else {
message("data must contain delta_distance and dplus and dminus, see ? differential_stream")
}
return(segment)
}
library(GPStream)
#' Summarise segment
#'
#' @param data dataframe or tibble containing a stream segment
#'
#' @return
#' @export
#'
summarise_stream <- function(data){
if(exists("delta_distance",data) &
exists("dplus",data) &
exists("distance",data) &
exists("dminus",data) &
exists("ele",data)){
if(nrow(data)>0){
if(exists("delta_time", data)){
segment <-
data %>%
group_by(id_seg) %>%
summarise(delta_time = sum(delta_time),
delta_distance = sum(delta_distance),
dplus = sum(dplus),
dminus = sum(dminus),
time = mean(time),
distance = mean(distance),
ele = mean(ele),
speed = delta_distance / delta_time)
}
if(!exists("delta_time", data)){
segment <-
data %>%
group_by(id_seg) %>%
summarise(delta_distance = sum(delta_distance),
dplus = sum(dplus),
dminus = sum(dminus),
distance = mean(distance),
ele = mean(ele))
}
}
} else {
message("data must contain delta_distance and dplus and dminus, see ? differential_stream")
}
return(segment)
}
#' Rolling window segment
#'
#' @param data dataframe or tibble containing a GPS stream
#' @param size split size
#' @param value time or distance of the size
#'
#' @return
#' @export
#'
rolling_window <- function(data, size = 100, value = "distance"){
windowed_data <- NULL
if(value=="distance"){
data$id_window <- round(data$distance)
} else if(value == "time"){
data$id_window <- cumsum(data$delta_time)
}
vector <- data$id_window
vector <- vector[vector<=max(vector)-size]
for(w in vector){
data_wind <- data %>% filter(id_window >= w, id_window < (w + size))
data_wind$id_seg <- paste0("seg",w)
if(nrow(data_wind)>0 ){
subwind <- summarise_stream(data_wind)
windowed_data <- rbind(windowed_data, subwind)
}
}
windowed_data <- unique(windowed_data)
return(windowed_data)
}
agg_stream = function(data, size = 100, value = "distance", windowed = TRUE){
if(windowed){
segments <- rolling_window(data, size, value)
} else {
# if time split segments according to elapsed time, else cumulative distance
if(value == "time"){
data$id_seg <- floor(data$time / size)
} else if(value == "distance"){
data$id_seg <- floor(data$distance / size) #cumulative distance in meters
}
segments <- data %>%
summarise_stream()
}
# return dataframe with segment features
if(value == "time"){
return(segments %>% dplyr::filter(delta_time >= size))
} else if(value == "distance"){
return(segments %>% dplyr::filter(delta_distance >= size))
}
}
library(tidyverse)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
library(tidyverse)
library(GPStream)
act_streams <- strava_streams
str(act_streams)
gpx_stream <- read_stream("inst/extdata/gpx_activity.gpx")
str(gpx_stream)
fit_stream <- read_stream("inst/extdata/fit_activity.fit")
str(fit_stream)
clean_stream1 <- act_streams %>% uniform_stream() %>% filter(id == unique(act_streams$id)[1])
clean_stream2 <- gpx_stream %>% uniform_stream()
clean_stream3 <- fit_stream %>% uniform_stream()
str(clean_stream2)
correct_elevation <- clean_stream2 %>% ele_correction(replace = FALSE, z = 14)
ggplot(correct_elevation, aes(x=time)) +
geom_line(aes(y=ele)) +
geom_line(aes(y=ele_DEM), col="red")
smooth_act <- correct_elevation %>% smooth_stream(interpolate = TRUE, alpha = 0.01, replace = TRUE)
ggplot(correct_elevation, aes(lon, lat)) +
geom_point() +
geom_point(data = smooth_act, col="red")
diff_stream <- smooth_act %>% differential_stream()
str(diff_stream)
data <- clean_stream1
route <- clean_stream2
match_stream(data, route)
ggplot(data, aes(lon, lat)) +
geom_point() +
geom_point(data = route, col="red", size = 0.7)
data <- clean_stream1
route <- clean_stream2[nrow(clean_stream2):1,]
match_stream(data, route)
ggplot(data, aes(lon, lat)) +
geom_point() +
geom_point(data = route, col="red", size = 0.7)
data <- clean_stream1
route <- act_streams %>% uniform_stream() %>%
filter(id == unique(act_streams$id)[4])
match_stream(data, route)
ggplot(data, aes(lon, lat)) +
geom_point() +
geom_point(data = route, col="red", size = 0.7)
data <- clean_stream1
route <- act_streams %>% uniform_stream() %>%
filter(id == unique(act_streams$id)[15])
match_stream(data, route)
ggplot(data, aes(lon, lat)) +
geom_point() +
geom_point(data = route, col="red", size = 0.7)
data <- clean_stream1
route <- act_streams %>% uniform_stream() %>%
filter(id == unique(act_streams$id)[20])
match_stream(data, route)
ggplot(data, aes(lon, lat)) +
geom_point() +
geom_point(data = route, col="red", size = 0.7)
clean_stream <-
read_stream("inst/extdata/fit_activity.fit") %>%
uniform_stream() %>%
ele_correction(replace = FALSE) %>%
smooth_stream(interpolate = FALSE, alpha = 0.05, replace = FALSE) %>%
differential_stream()
library(GPStream)
library(GPStream)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
library(tidyverse)
library(GPStream)
act_streams <- strava_streams
str(act_streams)
library(tidyverse)
act_streams <- strava_streams
str(act_streams)
gpx_stream <- read_stream("inst/extdata/gpx_activity.gpx")
str(gpx_stream)
fit_stream <- read_stream("inst/extdata/fit_activity.fit")
fit_stream <- read_stream("inst/extdata/fit_activity.fit")
str(fit_stream)
act_streams <- strava_streams
act_streams <- data(strava_streams)
str(act_streams)
data(cars)
cars
act_streams
strava_streams
data(strava_streams)
strava_streams
data(strava_streams)
act_data <- strava_streams
smooth_act <- correct_elevation %>% smooth_stream(interpolate = TRUE, alpha = 0.05, replace = TRUE)
library(roxygen2)
install.packages("roxygen2")
? maptools
library(maptools)
install.packages("maptools")
? maptools::getKMLcoordinates
library(maptools)
? XML::xpathSApply
? XML::xmlAttrs
? XML::htmlTreeParse
? XML::xmlValue
? XML::htmlTreeParse
? XML::xmlToList
? XML::getNodeSet
? XML::xmlParse
? FITfileR::readFitFile
? FITfileR::records
? R.utils::gunzip
? geosphere::distHaversine
? sp::SpatialPointsDataFrame
? sp::CRS
? elevatr::get_elev_point
? elevatr::get_elev_raster
? raster::extract
library(GPStream)
library(GPStream)