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.
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
.
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 |
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.
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 |