Author: Andrew Jackson
Date: 2023-10-19

# KAPOW! example

#### Andrew Jackson

#### 2023-10-19

## About

This example is associated with, but is not guaranteed an exact replica of the analysis contained in Sheppard et al. 2018 (Intragroup competition predicts individual foraging specialisation in a group-living mammal. Ecology Letters. doi). It is included here a demonstration of the “KAPOW” function in SIBER and not as a reproducible example of the above cited paper.

The data comprise multiple stable isotope values obtained on individual mongooses who are nested within packs. We calculate the proportional ellipse by individual in the context of its pack. An ellipse is fit to each individual within a pack; and the outline of all ellipses is then calculated as the union of all the ellipses. Finally, each individuals ellipse is calculated as a proportion of the total for that pack. Plotting is performed using ggplot and statistics generated using SIBER.

## Setup

First load in the packages. This script relies heavily on the `tidyverse` approach to data manipulation and avoids `for loops` wherever possible. Note that we do not explicitly load the `tidyverse` package which is itself a wrapper that loads a cluster of related packages, and instead load the specific packages we require, which in this case is `dplyr` and `purrr`.

    library(dplyr)
    library(purrr)
    library(ggplot2)
    library(SIBER)

## Import Data

Now load in the data:

    # This loads a pre-saved object called mongoose that comprises the
    # dataframe for this analysis.
    data("mongooseData")

    ## Warning in data("mongooseData"): data set 'mongooseData' not found

    # Ordinarily we might typically use code like this to import our data from a
    # csv file.
    # mongoose <- read.csv("mongooseFullData.csv", header = TRUE,
    #                      stringsAsFactors = FALSE)

There are lots of individuals with fewer than 4 observations which is definitely the lower limit to fit these models. There also appears to be at least one individual that appears in more than one pack, so we need to group both individual and pack and then check that there are sufficient samples.

    # min sample size for individual replicates per pack.
    min.n <- 4

    mongoose_2 <- mongoose %>% group_by(indiv.id, pack) %>%
      filter(n() >= min.n) %>% ungroup()

    # convert pack and indiv.id to factor
    mongoose_2 <- mongoose_2 %>% mutate(indiv.id = factor(indiv.id),
                                        pack = factor(pack))

    # count observations
    id_pack_counts <- mongoose %>% count(pack)

    knitr::kable(id_pack_counts)

pack | n
--- | ---
11 | 128
14A | 3
14B | 30
17 | 36
19 | 42
1B | 118
1H | 112
2 | 140
21 | 42
24 | 12
4B | 29
4E | 8
7A | 83

## Visualise the packs ellipses

Split the data into a list by pack and plot the pack’s collective isotopic niche as a grey shaded area, with the constituent invididual ellipses in colour along with the raw data.

    # split by pack
    packs <- mongoose_2 %>% split(.$pack)

    # use purrr::map to apply siberKapow across each pack.
    pack_boundaries <- purrr::map(packs, siberKapow, isoNames = c("c13","n15"),
                                 group = "indiv.id", pEll = 0.95)

    ## Warning: `group_by_()` was deprecated in dplyr 0.7.0.
    ## ℹ Please use `group_by()` instead.
    ## ℹ See vignette('programming') for more help
    ## ℹ The deprecated feature was likely used in the SIBER package.
    ##   Please report the issue to the authors.
    ## This warning is displayed once every 8 hours.
    ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
    ## generated.

    # Define afunction to strip out the boundaries of the union of the
    # ellipses and plot them. This function returns the ggplot2 object
    # but doesnt actually do the plotting which is handled afterwards.
    plotBoundaries <- function(dd, ee){

      # exdtract the boundary points for each KAPOW shape.
      bdry <- data.frame(dd$bdry)

      # the plot object
      p <- ggplot(data = ee, aes(c13, n15, color = indiv.id)) +
      geom_point()  +
      viridis::scale_color_viridis(discrete = TRUE, guide = "legend", name = "Individual") +
        geom_polygon(data = bdry, mapping = aes(x, y, color = NULL), alpha = 0.2) +
        viridis::scale_fill_viridis(discrete = TRUE, guide = FALSE) +
        theme_bw() +
        ggtitle(paste0("Pack: ", as.character(ee$pack[1]) )) +
        geom_polygon(data = dd$ell.coords, aes(X1, X2, group = indiv.id),
                     alpha = 0.2, fill = NA)
      return(p)

    }

    # map this function over packs and return the un-printed ggplot2 objects
    bndry_plots <- purrr::map2(pack_boundaries, packs, plotBoundaries)

    # print them to screen / file
    print(bndry_plots)

    ## Warning: The `guide` argument in `scale_*()` cannot be `FALSE`. This was deprecated in
    ## ggplot2 3.3.4.
    ## ℹ Please use "none" instead.
    ## This warning is displayed once every 8 hours.
    ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
    ## generated.

# Print tables of proportions

The actual data of the proportional ellipses which is printed to the output document and also saved to *.csv file.

    # KAPOW areas for each pack
    total.area <- map(pack_boundaries, spatstat.geom::area)

    # a function to extract ellipse coordinates, calculate areas and return
    # as a vector not a list.
    extractProportions <- function(x){unlist(map(x$owin.coords, spatstat.geom::area))}

    # map our individual ellipse area function over packs
    ellipse.areas <- map(pack_boundaries, . %>% extractProportions)

    # calculate ellipses as proportions of the KAPOW for that pack by mapping
    # over both the individual ellipses and pack totals and dividing.
    ellipse_proportions <- map2(ellipse.areas, total.area, `/`)

    # print(ellipse_proportions)

    # convert to table with a nested map_df call for easier printing.
    # Probably possible to use at_depth() to simplify this, but possibly
    # not as i use map_df() here.
    df_proportions <- map_df(ellipse_proportions,
                             . %>% map_df(data.frame, .id = "individual"),
                             .id = "pack" )

    # rename the ugly variable manually
    df_proportions <- rename(df_proportions, Proportion = ".x..i..")

    # print a nice table
    knitr::kable(df_proportions, digits = 2)

pack | individual | Proportion
--- | --- | ---
11 | DF190 | 0.13
11 | DF200 | 0.87
11 | DF201 | 0.45
11 | DF223 | 0.12
11 | DM165 | 0.26
11 | DM171 | 0.33
11 | DM179 | 0.16
11 | DM180 | 0.29
11 | DM189 | 0.17
11 | DM192 | 0.30
11 | DM193 | 0.09
11 | DM194 | 0.15
11 | DM198 | 0.32
11 | DM204 | 0.19
11 | DM209 | 0.17
11 | DM212 | 0.22
11 | DM213 | 0.27
11 | DM215 | 0.11
11 | DM220 | 0.27
14B | YM024 | 1.00
17 | SF038 | 0.51
17 | SM013 | 0.82
17 | SM039 | 0.81
19 | XM021 | 0.92
19 | XM024 | 0.27
19 | XM025 | 0.59
1B | BF484 | 0.32
1B | BF535 | 0.87
1B | BF561 | 0.04
1B | BF593 | 0.37
1B | BM438 | 0.78
1H | HF125 | 0.21
1H | HF178 | 0.89
1H | HF182 | 0.19
1H | HF220 | 0.18
1H | HF240 | 0.21
1H | HF242 | 0.40
1H | HF248 | 0.23
1H | HF260 | 0.02
1H | HF261 | 0.24
1H | HF276 | 0.39
1H | HF285 | 0.27
1H | HM180 | 0.31
1H | HM216 | 0.09
1H | HM217 | 0.19
1H | HM246 | 0.23
1H | HM275 | 0.33
2 | TF297 | 0.09
2 | TF298 | 0.47
2 | TF299 | 0.02
2 | TF319 | 0.26
2 | TF322 | 0.28
2 | TF334 | 0.24
2 | TF374 | 0.19
2 | TM363 | 0.96
21 | VF139 | 0.43
21 | VF140 | 0.69
21 | VM096 | 0.60
21 | VM136 | 0.46
4B | FF196 | 0.69
4B | FM188 | 0.79
4B | FM191 | 0.35
7A | GM060 | 0.59
7A | GM080 | 0.64
7A | GM117 | 0.81

    # Optional code to save to csv file
    # write.csv(df_proportions, file = "mongoose_kapow_niche_proportions.csv",
    #           row.names = FALSE)