# ==============================================================================
# * Environment
# ==============================================================================
source("R/00_fxns.R")
library(cowplot)
library(dplyr)
library(data.table)
library(tidyr)
library(knitr)
library(kableExtra)
library(ggplot2)
library(finalfit)
acc_behavL_files = list.files("data/acc_behavL", full.names = TRUE)
acc_behavL_all = lapply(acc_behavL_files, readRDS)
axes = lapply(acc_behavL_files, function(fn) strsplit(basename(fn), "_")[[1]][1]) %>%
unlist()
acc_all = lapply(acc_behavL_all, function(acc_behavL) {
acc_behav = lapply(acc_behavL, `[[`, "acc_behav")
})
gps_all = lapply(acc_behavL_all, function(acc_behavL) {
gps_behav = lapply(acc_behavL, `[[`, "gps_behav")
})
get_activity_info = function(type_all, axes) {
type_activityL = lapply(type_all, function(type_behav) {
type_activity = lapply(type_behav, function(df)
as.data.frame(table(df$activity)))
mapply(cbind, type_activity,
"tagID" = names(type_activity), SIMPLIFY = FALSE) %>%
rbindlist() %>%
spread(Var1, Freq) %>%
as.data.frame()
})
type_activity = mapply(cbind, type_activityL, "axis" = axes, SIMPLIFY = FALSE) %>%
rbindlist()
split(type_activity, type_activity$tagID)
}
acc_info = get_activity_info(acc_all, axes)
gps_info = get_activity_info(gps_all, axes)
names(gps_all) = axes
tagIDs = names(gps_all[[ 1 ]])
gps_all = lapply(axes, function(axis, gps_all) {
mapply(cbind, gps_all[[ axis ]], "axis" = axis, SIMPLIFY = FALSE)
}, gps_all)
gps_unlist = unlist(gps_all, recursive = FALSE)
gps_by_bats = lapply(tagIDs, function(ID, gps_unlist) {
ID_n = grep(ID, names(gps_unlist))
gps_unlist[ ID_n ] %>% rbindlist
}, gps_unlist)
for(df in gps_by_bats) {
ID = unique(df$tagID)
color_group = c("#8C0C53", "#F2CB70")
gps_leg = data.frame(activity = rep(c("Flying", "Not Flying"), 2),
n = 1:4, x = 1:4) %>%
ggplot(aes(x = x, y = n)) +
geom_point(aes(color = activity)) +
scale_color_manual(values = color_group, name = "Classification") +
theme(legend.position = "top",
legend.justification='center',
legend.key.size = unit(0.2, "cm"))
gps_leg = get_legend(gps_leg)
g = ggplot() +
geom_path(data = df, aes(x = location.long, y = location.lat),
size = 0.25, color = "#8C0C53") +
geom_point(data = df, aes(x = location.long, y = location.lat),
color = "#8C0C53",
size = 1, alpha = 1) +
geom_point(data = df[ df$activity %in% "NotFlying", ],
aes(x = location.long, y = location.lat), color = "#F2CB70",
size = 1, alpha = 1) +
theme_classic() +
scale_x_continuous(
labels = label_fill) +
ggtitle(ID) +
xlab("Longitude") +
ylab("Latitude") +
facet_wrap(. ~ axis, nrow = 1)
g = plot_grid( gps_leg, g, ncol = 1, rel_heights = c(.03, 1))
cat("\n\n")
cat("-----------------------------------------------------------------------")
cat("\n")
cat("### GPS classification for ", ID, "using different axes\n")
print(kable(table(df$axis, df$activity)) %>%
kable_styling(full_width = FALSE, position = "left"))
cat('\n')
print(g)
}
Flying | NotFlying | |
---|---|---|
xy | 2057 | 7155 |
xyz | 6074 | 3138 |
xz | 6091 | 3121 |
yz | 6091 | 3121 |
Flying | NotFlying | |
---|---|---|
xy | 5274 | 5532 |
xyz | 8749 | 2057 |
xz | 8749 | 2057 |
yz | 8827 | 1979 |
Flying | NotFlying | |
---|---|---|
xy | 137 | 1543 |
xyz | 1079 | 601 |
xz | 1069 | 611 |
yz | 1069 | 611 |
Flying | NotFlying | |
---|---|---|
xy | 392 | 1585 |
xyz | 889 | 1088 |
xz | 889 | 1088 |
yz | 889 | 1088 |
Flying | NotFlying | |
---|---|---|
xy | 1393 | 2411 |
xyz | 1747 | 2057 |
xz | 1747 | 2057 |
yz | 1747 | 2057 |
Flying | NotFlying | |
---|---|---|
xy | 60 | 280 |
xyz | 12 | 328 |
xz | 12 | 328 |
yz | 12 | 328 |
Flying | NotFlying | |
---|---|---|
xy | 386 | 2460 |
xyz | 1647 | 1199 |
xz | 1647 | 1199 |
yz | 1647 | 1199 |
Flying | NotFlying | |
---|---|---|
xy | 258 | 769 |
xyz | 288 | 739 |
xz | 288 | 739 |
yz | 288 | 739 |
gps_df = lapply(gps_all, rbindlist) %>%rbindlist
gps_df = gps_df %>%
filter(axis %in% c("xyz", "xz", "yz")) %>%
mutate(Flying = ifelse(activity %in% "Flying", 1, 0)) %>%
mutate_at(vars(Flying, axis, tagID), as.factor)
explanatory = c("axis", "tagID")
dependent = "Flying"
table1 = gps_df %>%
as.data.frame() %>%
summary_factorlist(dependent, explanatory,
p=TRUE, na_include=TRUE,
add_dependent_label=TRUE)
table2 = gps_df %>%
finalfit(dependent, explanatory,
dependent_label_prefix = "")
Dependent: Flying | 0 | 1 | p | |
---|---|---|---|---|
axis | xyz | 11207 (33.4) | 20485 (33.3) | 0.735 |
xz | 11200 (33.4) | 20492 (33.3) | ||
yz | 11122 (33.2) | 20570 (33.4) | ||
tagID | K5309 | 9380 (28.0) | 18256 (29.7) | <0.001 |
K5310 | 6093 (18.2) | 26325 (42.8) | ||
K5311 | 1823 (5.4) | 3217 (5.2) | ||
K5312 | 3264 (9.7) | 2667 (4.3) | ||
K5313 | 6171 (18.4) | 5241 (8.5) | ||
K5315 | 984 (2.9) | 36 (0.1) | ||
K5317 | 3597 (10.7) | 4941 (8.0) | ||
K5319 | 2217 (6.6) | 864 (1.4) |
Flying | 0 | 1 | OR (univariable) | OR (multivariable) | |
---|---|---|---|---|---|
axis | xyz | 11207 (35.4) | 20485 (64.6) |
|
|
xz | 11200 (35.3) | 20492 (64.7) | 1.00 (0.97-1.03, p=0.954) | 1.00 (0.97-1.04, p=0.951) | |
yz | 11122 (35.1) | 20570 (64.9) | 1.01 (0.98-1.05, p=0.480) | 1.01 (0.98-1.05, p=0.454) | |
tagID | K5309 | 9380 (33.9) | 18256 (66.1) |
|
|
K5310 | 6093 (18.8) | 26325 (81.2) | 2.22 (2.14-2.30, p<0.001) | 2.22 (2.14-2.30, p<0.001) | |
K5311 | 1823 (36.2) | 3217 (63.8) | 0.91 (0.85-0.97, p=0.002) | 0.91 (0.85-0.97, p=0.002) | |
K5312 | 3264 (55.0) | 2667 (45.0) | 0.42 (0.40-0.44, p<0.001) | 0.42 (0.40-0.44, p<0.001) | |
K5313 | 6171 (54.1) | 5241 (45.9) | 0.44 (0.42-0.46, p<0.001) | 0.44 (0.42-0.46, p<0.001) | |
K5315 | 984 (96.5) | 36 (3.5) | 0.02 (0.01-0.03, p<0.001) | 0.02 (0.01-0.03, p<0.001) | |
K5317 | 3597 (42.1) | 4941 (57.9) | 0.71 (0.67-0.74, p<0.001) | 0.71 (0.67-0.74, p<0.001) | |
K5319 | 2217 (72.0) | 864 (28.0) | 0.20 (0.18-0.22, p<0.001) | 0.20 (0.18-0.22, p<0.001) |
sessionInfo()
## R version 3.6.0 (2019-04-26)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS High Sierra 10.13.6
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] finalfit_1.0.0 kableExtra_1.1.0 knitr_1.26 maptools_0.9-5
## [5] cowplot_1.0.0 readxl_1.3.1 tidyr_1.0.2 viridis_0.5.1
## [9] viridisLite_0.3.0 DT_0.11.5 hrbrthemes_0.6.0 ggsn_0.5.0
## [13] patchwork_1.0.0 ggplot2_3.3.0.9000 sf_0.8-0 htmlwidgets_1.5.1
## [17] leaflet_2.0.2 data.table_1.12.8 dplyr_0.8.4 lubridate_1.7.4
## [21] move_3.2.0 rgdal_1.4-4 raster_2.9-5 sp_1.3-1
## [25] geosphere_1.5-10
##
## loaded via a namespace (and not attached):
## [1] minqa_1.2.4 colorspace_1.4-1 rjson_0.2.20 ellipsis_0.3.0
## [5] class_7.3-15 rstudioapi_0.11 mice_3.5.0 farver_2.0.3
## [9] xml2_1.2.2 codetools_0.2-16 splines_3.6.0 extrafont_0.17
## [13] nloptr_1.2.1 broom_0.5.2 Rttf2pt1_1.3.7 png_0.1-7
## [17] shiny_1.4.0 readr_1.3.1 compiler_3.6.0 httr_1.4.1
## [21] backports_1.1.5 assertthat_0.2.1 Matrix_1.2-17 fastmap_1.0.1
## [25] later_1.0.0 htmltools_0.4.0 tools_3.6.0 ggmap_3.0.0
## [29] gtable_0.3.0 glue_1.3.1 Rcpp_1.0.3 cellranger_1.1.0
## [33] vctrs_0.2.2 nlme_3.1-139 extrafontdb_1.0 crosstalk_1.0.0
## [37] xfun_0.12 stringr_1.4.0 lme4_1.1-21 rvest_0.3.4
## [41] mime_0.9 lifecycle_0.1.0 pan_1.6 MASS_7.3-51.4
## [45] scales_1.1.0 hms_0.5.2 promises_1.1.0 parallel_3.6.0
## [49] yaml_2.2.1 memoise_1.1.0 gridExtra_2.3 gdtools_0.2.1
## [53] rpart_4.1-15 stringi_1.4.5 highr_0.8 e1071_1.7-2
## [57] boot_1.3-22 RgoogleMaps_1.4.3 rlang_0.4.4 pkgconfig_2.0.3
## [61] systemfonts_0.1.1 matrixStats_0.54.0 bitops_1.0-6 evaluate_0.14
## [65] lattice_0.20-38 purrr_0.3.3 labeling_0.3 tidyselect_1.0.0
## [69] plyr_1.8.5 magrittr_1.5 R6_2.4.1 generics_0.0.2
## [73] mitml_0.3-7 DBI_1.0.0 pillar_1.4.3 foreign_0.8-71
## [77] withr_2.1.2 units_0.6-3 survival_2.44-1.1 nnet_7.3-12
## [81] tibble_2.1.3 crayon_1.3.4 jomo_2.6-8 KernSmooth_2.23-15
## [85] rmarkdown_1.17.1 jpeg_0.1-8.1 forcats_0.4.0 digest_0.6.23
## [89] classInt_0.4-2 webshot_0.5.2 xtable_1.8-4 httpuv_1.5.2
## [93] munsell_0.5.0