knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "plots/sociality-indices" )
# Install devtools if not already present if (!("devtools" %in% installed.packages()[,"Package"])) install.packages("devtools") # Install newest version of ramboseli devtools::install_github("amboseli/ramboseli") Sys.setenv(TZ = 'UTC') list.of.packages <- list("foreach", "doSNOW", "parallel", "tidyverse", "lubridate", "dbplyr", "purrrlyr", "RPostgreSQL", "zoo", "ramboseli") new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] if (length(new.packages)) install.packages(unlist(new.packages)) lapply(list.of.packages, require, character.only = T)
Sys.setenv(TZ = 'UTC') list.of.packages <- list("foreach", "doSNOW", "parallel", "tidyverse", "lubridate", "dbplyr", "purrrlyr", "RPostgreSQL", "zoo", "ramboseli") new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] if (length(new.packages)) install.packages(unlist(new.packages)) lapply(list.of.packages, require, character.only = T)
Create the SSH tunnel before proceeding! Instructions here.
babase <- DBI::dbConnect( RPostgreSQL::PostgreSQL(), host = "localhost", port = 2222, user = "fac13", dbname = "babase", password = rstudioapi::askForPassword("Database password")) # Get local copy of biograph table biograph_l <- collect(tbl(babase, "biograph"))
# Make a members subset that excludes behavioral observation gaps members_l <- subset_members(babase) # Subset other data sets used for sociality indices focals_l <- subset_focals(babase, members_l) females_l <- subset_females(members_l) # Grooming grooming_l <- subset_interactions(babase, members_l, my_acts = c("G")) # Agonism agonism_l <- subset_interactions(babase, members_l, my_acts = c("A", "AS", "DS", "OS"))
# Make an individual-year-of-life data set for adults iyol <- make_iyol(babase, members_l, focals_l, grooming_l) # Example of how to save / reload a data set # saveRDS(iyol, paste0("data/iyol_", Sys.Date(), ".RDS")) ## Restrict to groups where the animal was present for at least 60 days iyol_sub <- iyol %>% filter(days_present >= 60)
All the sociality index functions will be MUCH faster when called with parallel = TRUE
. Speed will depend on number of cores that your machine has; by default, all available cores are used, but you can fine-tune this. The option for parallel processing seems finicky. If you're getting errors, try again with parallel = FALSE
.
# calculate-sci ----------------------------------------------------------- # Calculate grooming social connectedness index sci <- sci(iyol_sub, members_l, focals_l, females_l, grooming_l, min_res_days = 1, parallel = TRUE) saveRDS(sci, paste0("data/sci_", Sys.Date(), ".RDS")) # directed-sci ------------------------------------------------------------ # Calculate DIRECTED grooming connectedness index sci_dir <- sci(iyol_sub, members_l, focals_l, females_l, grooming_l, min_res_days = 1, parallel = TRUE, directional = TRUE) saveRDS(sci_dir, paste0("data/sci-dir_", Sys.Date(), ".RDS")) # calculate-agi ----------------------------------------------------------- # Calculate directed agonism connectedness index agi <- sci(iyol_sub, members_l, focals_l, females_l, agonism_l, min_res_days = 1, parallel = TRUE, directional = TRUE, ncores = 3) names(agi) <- str_replace(names(agi), pattern = "SCI_", replacement = "AGI_") saveRDS(agi, paste0("data/agi_", Sys.Date(), ".RDS")) # calculate-dsi ----------------------------------------------------------- # Calculate population-level dyadic grooming index # Warning: takes a really long time! dsi_pop <- dyadic_index(iyol_sub, biograph_l, members_l, focals_l, females_l, grooming_l, min_cores_days = 1, within_grp = FALSE, parallel = TRUE, directional = FALSE) saveRDS(dsi_pop, paste0("data/dsi-pop_", Sys.Date(), ".RDS")) # Summarize DSI variables for top partners in each year of life dsi_pop_summary <- dyadic_index_summary(dsi_pop) saveRDS(dsi_pop_summary, paste0("data/dsi-pop_summary_", Sys.Date(), ".RDS"))
# target-date-gc-dsi ------------------------------------------------------ #fGC samples gc <- tbl(babase, in_schema("fecal", "prep")) %>% inner_join(tbl(babase, in_schema("fecal", "results")), by = "sid") %>% collect() %>% left_join(select(members_l, sname, date, grp, sex), by = c("sname", "date")) %>% filter(sex == "F" & gc > 0) %>% drop_na(gc) %>% select(sid, sname, sex, grp, date, gc) gca <- make_target_date_df(gc, babase, members_l) saveRDS(gca, file = paste0("data/gca_", Sys.Date(), ".RDS")) # WARNING: this one takes several days to finish!!!!!! gca_dsi <- dyadic_index(gca, biograph_l, members_l, focals_l, females_l, grooming_l, min_cores_days = 1, within_grp = FALSE, parallel = TRUE, directional = FALSE) saveRDS(gca_dsi, file = paste0("data/gca-dsi_", Sys.Date(), ".RDS")) gca_dsi_summary <- dyadic_index_summary(gca_dsi) saveRDS(gca_dsi_summary, file = paste0("data/gca-dsi-summary_", Sys.Date(), ".RDS")) # target-date-offspring-dob ----------------------------------------------- kids <- tbl(babase, "parents") %>% select(mom, kid) %>% inner_join(select(biograph, kid = sname, kid_birth = birth, kid_sex = sex, kid_statdate = statdate, matgrp), by = "kid") %>% arrange(mom, kid_statdate) %>% collect() %>% rename(date = kid_birth, sname = mom, grp = matgrp) kids$sex <- "F" kid_df <- make_target_date_df(kids, babase, members_l) mom_sci_first_year <- sci(kid_df, members_l, focals_l, females_l, grooming_l, min_res_days = 1, parallel = TRUE)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.