documentation/sociality-indices.md

In amboseli/ramboseli: Utility functions for the babase database

Sociality Indices

NOTE: Work in progress... proceed with caution!

Setup Workspace

# 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)

Create the SSH tunnel before proceeding! Instructions here.

Create connection to babase and pull data into data frames in your current R environment.

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"))

Subset the input data

# 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

# 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)

A note on parallel processing.

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.

Sociality Indices for Years of Life

# 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"))

Sociality Indices for Target Dates

# 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)

amboseli/ramboseli documentation built on March 18, 2021, 12:03 a.m.