#==============================================================================================================Data and code from “Mutual mate guarding and limited sexual conflict
in a sex-role reversed shorebird” Contributor: Johannes Krietsch
📍 This script runs relative to the project’s root directory and
describes how I calculated ultimately when birds were “together”.
#==============================================================================================================
# Packages
sapply( c('data.table', 'magrittr', 'sdb', 'ggplot2', 'auksRuak', 'foreach', 'knitr', 'windR'),
require, character.only = TRUE)## data.table magrittr sdb ggplot2 auksRuak foreach knitr windR
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE# Functions
source('./R/0_functions.R')
# Lines to run to create html output
opts_knit$set(root.dir = rprojroot::find_rstudio_root_file())
# rmarkdown::render('./R/3_pair_wise_interactions.R', output_dir = './OUTPUTS/R_COMPILED')
# Projection
PROJ = '+proj=laea +lat_0=90 +lon_0=-156.653428 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs +ellps=WGS84 +towgs84=0,0,0 '
# Data
dp = fread('./DATA/PRODUCTS/PAIR_WISE_DIST_CLOSEST.txt', sep = '\t', header = TRUE, nThread = 20) %>% data.tabledistance_threshold = 30
# pair ID
dp[, pairID := paste0(ID1, '_', ID2)]
### positions before and after
# shift positions
dp[, lat1_before := shift(lat1, type = 'lag'), by = pairID]
dp[, lon1_before := shift(lon1, type = 'lag'), by = pairID]
dp[, lat2_before := shift(lat2, type = 'lag'), by = pairID]
dp[, lon2_before := shift(lon2, type = 'lag'), by = pairID]
dp[, lat1_next := shift(lat1, type = 'lead'), by = pairID]
dp[, lon1_next := shift(lon1, type = 'lead'), by = pairID]
dp[, lat2_next := shift(lat2, type = 'lead'), by = pairID]
dp[, lon2_next := shift(lon2, type = 'lead'), by = pairID]
# distance to position before and after
dp[, rowid := .I]
setkey(dp, rowid)
dp[, distance1_before := sqrt(sum((c(lon1, lat1) - c(lon1_before, lat1_before))^2)), by = rowid]
dp[, distance1_next := sqrt(sum((c(lon1, lat1) - c(lon1_next, lat1_next))^2)), by = rowid]
dp[, distance2_before := sqrt(sum((c(lon2, lat2) - c(lon2_before, lat2_before))^2)), by = rowid]
dp[, distance2_next := sqrt(sum((c(lon2, lat2) - c(lon2_next, lat2_next))^2)), by = rowid]
# interactions
dp[, interaction := distance_pair < c(distance1_before + distance2_before + distance_threshold), by = rowid]
# simple interactions
dp[, interaction_threshold := distance_pair < distance_threshold]
dp[is.na(interaction), interaction := interaction_threshold]
# count bouts of split and merge
dp[, bout := bCounter(interaction), by = pairID]
dp[, bout_seq := seq_len(.N), by = .(pairID, bout)]
dp[, bout_seq_max := max(bout_seq), by = .(pairID, bout)]
dp[, any_interaction_threshold := any(interaction_threshold == TRUE), by = .(pairID, bout)]
dp[any_interaction_threshold == FALSE, interaction := FALSE]
# split points and merging points
dp[, interaction_next := shift(interaction, type = 'lead'), by = pairID]
dp[, interaction_before := shift(interaction, type = 'lag'), by = pairID]
# correct for true splits
dp[interaction == TRUE & interaction_next == FALSE & distance_pair > distance_threshold, interaction := FALSE]
# count bouts of split and merge
dp[, bout := bCounter(interaction), by = pairID]
dp[, bout_seq := seq_len(.N), by = .(pairID, bout)]
dp[, bout_seq_max := max(bout_seq), by = .(pairID, bout)]
# split points and merging points
dp[, interaction_next := shift(interaction, type = 'lead'), by = pairID]
dp[, interaction_before := shift(interaction, type = 'lag'), by = pairID]
dp[, split := interaction_before == TRUE & interaction == FALSE]
dp[, merge := interaction_before == FALSE & interaction == TRUE]
# which ID split?
dp[split == TRUE, IDsplitting := ifelse(distance1_before > distance2_before, 'ID1', 'ID2')]
# which ID approached?
dp[merge == TRUE, IDmerging := ifelse(distance1_before > distance2_before, 'ID1', 'ID2')]
# save data
# fwrite(dp, './DATA/PRODUCTS/PAIR_WISE_INTERACTIONS.txt', quote = TRUE, sep = '\t', row.names = FALSE)
# version information
sessionInfo()## R version 4.2.2 (2022-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19045)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=German_Germany.utf8 LC_CTYPE=German_Germany.utf8 LC_MONETARY=German_Germany.utf8 LC_NUMERIC=C
## [5] LC_TIME=German_Germany.utf8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] windR_1.0.0 knitr_1.42 foreach_1.5.2 auksRuak_0.1.0 ggplot2_3.4.0 sdb_2019.12 magrittr_2.0.3 data.table_1.14.8
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.4 sass_0.4.5 RMySQL_0.10.25 bit64_4.0.5 jsonlite_1.8.4 bslib_0.4.2 expm_0.999-7
## [8] askpass_1.1 sp_1.6-0 gld_2.6.6 lmom_2.9 cellranger_1.1.0 yaml_2.3.7 pillar_1.8.1
## [15] lattice_0.20-45 glue_1.6.2 filenamr_0.1.0 digest_0.6.31 cliExtras_0.1.0 sfext_0.1.0 snakecase_0.11.0
## [22] colorspace_2.1-0 htmltools_0.5.4 Matrix_1.5-1 pkgconfig_2.0.3 ggspatial_1.1.7 raster_3.6-14 purrr_1.0.1
## [29] mvtnorm_1.1-3 scales_1.2.1 rootSolve_1.8.2.3 terra_1.7-3 timechange_0.2.0 tibble_3.1.8 proxy_0.4-27
## [36] generics_0.1.3 cachem_1.0.6 withr_2.5.0 janitor_2.1.0 cli_3.6.0 readxl_1.4.1 evaluate_0.20
## [43] fansi_1.0.4 MASS_7.3-58.1 anytime_0.3.9 class_7.3-20 tools_4.2.2 RMariaDB_1.2.2 hms_1.1.3
## [50] lifecycle_1.0.3 Exact_3.2 stringr_1.5.0 munsell_0.5.0 compiler_4.2.2 jquerylib_0.1.4 e1071_1.7-13
## [57] rlang_1.0.6 classInt_0.4-9 units_0.8-2 grid_4.2.2 iterators_1.0.14 rstudioapi_0.14 rmarkdown_2.20
## [64] boot_1.3-28 DescTools_0.99.47 gtable_0.3.1 codetools_0.2-18 DBI_1.1.3 R6_2.5.1 lubridate_1.9.2
## [71] dplyr_1.1.0 fastmap_1.1.0 rgeos_0.6-1 bit_4.0.5 utf8_1.2.3 rprojroot_2.0.3 KernSmooth_2.23-20
## [78] stringi_1.7.12 Rcpp_1.0.10 vctrs_0.5.2 sf_1.0-13 tidyselect_1.2.0 xfun_0.40