2020-05-02 01:46:04 +02:00
|
|
|
source("renv/activate.R")
|
2019-11-05 22:22:46 +01:00
|
|
|
|
2019-11-05 21:17:20 +01:00
|
|
|
library(dplyr)
|
|
|
|
|
2020-04-09 19:20:39 +02:00
|
|
|
write_empty_file <- function(file_path, requested_feature){
|
2019-11-13 20:54:24 +01:00
|
|
|
write.csv(data.frame(local_date= character(),
|
2020-03-12 18:18:36 +01:00
|
|
|
location_barnett_hometime= numeric(),
|
|
|
|
location_barnett_disttravelled= numeric(),
|
|
|
|
location_barnett_rog= numeric(),
|
|
|
|
location_barnett_maxdiam= numeric(),
|
|
|
|
location_barnett_maxhomedist= numeric(),
|
|
|
|
location_barnett_siglocsvisited= numeric(),
|
|
|
|
location_barnett_avgflightlen= numeric(),
|
|
|
|
location_barnett_stdflightlen= numeric(),
|
|
|
|
location_barnett_avgflightdur= numeric(),
|
|
|
|
location_barnett_stdflightdur= numeric(),
|
|
|
|
location_barnett_probpause= numeric(),
|
|
|
|
location_barnett_siglocentropy= numeric(),
|
|
|
|
location_barnett_minsmissing= numeric(),
|
|
|
|
location_barnett_circdnrtn= numeric(),
|
|
|
|
location_barnett_wkenddayrtn= numeric()
|
2020-04-09 19:20:39 +02:00
|
|
|
) %>% select(requested_feature), file_path, row.names = F)
|
2019-11-13 20:54:24 +01:00
|
|
|
}
|
|
|
|
|
2019-11-05 21:17:20 +01:00
|
|
|
# Load Ian Barnett's code. Taken from https://scholar.harvard.edu/ibarnett/software/gpsmobility
|
|
|
|
file.sources = list.files(c("src/features/location_barnett"), pattern="*.R$", full.names=TRUE, ignore.case=TRUE)
|
|
|
|
sapply(file.sources,source,.GlobalEnv)
|
|
|
|
|
2019-12-10 01:15:10 +01:00
|
|
|
locations_to_use <- snakemake@params[["locations_to_use"]]
|
2019-11-05 21:17:20 +01:00
|
|
|
accuracy_limit <- snakemake@params[["accuracy_limit"]]
|
|
|
|
timezone <- snakemake@params[["timezone"]]
|
2020-04-09 19:20:39 +02:00
|
|
|
requested_feature <- intersect(unlist(snakemake@params["features"], use.names = F),
|
2020-02-21 16:58:35 +01:00
|
|
|
c("hometime","disttravelled","rog","maxdiam","maxhomedist","siglocsvisited","avgflightlen","stdflightlen","avgflightdur","stdflightdur","probpause","siglocentropy","minsmissing","circdnrtn","wkenddayrtn"))
|
2020-04-09 19:20:39 +02:00
|
|
|
requested_feature <- c("local_date", paste("location_barnett", requested_feature, sep = "_"))
|
2019-11-05 21:17:20 +01:00
|
|
|
|
2019-12-10 01:15:10 +01:00
|
|
|
# By deafult we use all raw locations: fused without resampling and not fused (gps, network)
|
|
|
|
location <- read.csv(snakemake@input[["raw"]], stringsAsFactors = F) %>%
|
2019-11-05 21:17:20 +01:00
|
|
|
select(timestamp, latitude = double_latitude, longitude = double_longitude, altitude = double_altitude, accuracy)
|
|
|
|
|
2019-12-10 01:15:10 +01:00
|
|
|
if(locations_to_use == "ALL_EXCEPT_FUSED"){
|
|
|
|
location <- location %>% filter(provider != "fused")
|
|
|
|
} else if (locations_to_use == "RESAMPLE_FUSED"){
|
|
|
|
location <- read.csv(snakemake@input[["fused"]], stringsAsFactors = F) %>%
|
|
|
|
select(timestamp, latitude = double_latitude, longitude = double_longitude, altitude = double_altitude, accuracy)
|
|
|
|
} else if (locations_to_use != "ALL"){
|
|
|
|
print("Unkown filter, provide one of the following three: ALL, ALL_EXCEPT_FUSED, or RESAMPLE_FUSED")
|
|
|
|
quit(save = "no", status = 1, runLast = FALSE)
|
|
|
|
}
|
|
|
|
|
2019-11-13 20:54:24 +01:00
|
|
|
if (nrow(location) > 1){
|
2019-11-05 21:17:20 +01:00
|
|
|
features <- MobilityFeatures(location, ACCURACY_LIM = accuracy_limit, tz = timezone)
|
2019-11-13 20:54:24 +01:00
|
|
|
if(is.null(features)){
|
2020-04-09 19:20:39 +02:00
|
|
|
write_empty_file(snakemake@output[[1]], requested_feature)
|
2019-11-13 20:54:24 +01:00
|
|
|
} else{
|
|
|
|
# Copy index (dates) as a column
|
|
|
|
outmatrix <- cbind(rownames(features$featavg), features$featavg)
|
|
|
|
outmatrix <- as.data.frame(outmatrix)
|
|
|
|
outmatrix[-1] <- lapply(lapply(outmatrix[-1], as.character), as.numeric)
|
2020-03-12 18:18:36 +01:00
|
|
|
colnames(outmatrix)=c("local_date",tolower(paste("location_barnett", colnames(features$featavg), sep = "_")))
|
2020-04-09 19:20:39 +02:00
|
|
|
write.csv(outmatrix %>% select(requested_feature), snakemake@output[[1]], row.names = F)
|
2019-11-13 20:54:24 +01:00
|
|
|
}
|
|
|
|
|
2019-11-05 21:17:20 +01:00
|
|
|
} else {
|
2020-04-09 19:20:39 +02:00
|
|
|
write_empty_file(snakemake@output[[1]], requested_feature)
|
2020-03-05 20:48:48 +01:00
|
|
|
}
|