`## Loading required package: viridisLite`

We will use the same demo data as per the main introductory vignette. We plot it just to remind us.

```
# remove previously loaded items from the current environment and remove previous graphics.
rm(list=ls())
graphics.off()
# Here, I set the seed each time so that the results are comparable.
# This is useful as it means that anyone that runs your code, *should*
# get the same results as you, although random number generators change
# from time to time.
set.seed(1)
library(SIBER)
#> Loading required package: spatstat
#> Loading required package: spatstat.data
#> Loading required package: spatstat.geom
#> spatstat.geom 3.0-6
#> Loading required package: spatstat.random
#> spatstat.random 3.1-3
#> Loading required package: spatstat.explore
#> Loading required package: nlme
#> spatstat.explore 3.0-6
#> Loading required package: spatstat.model
#> Loading required package: rpart
#> spatstat.model 3.1-2
#> Loading required package: spatstat.linnet
#> spatstat.linnet 3.0-4
#>
#> spatstat 3.0-3
#> For an introduction to spatstat, type 'beginner'
library(ggplot2)
library(magrittr) # to enable piping
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following object is masked from 'package:nlme':
#>
#> collapse
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
# load in the included demonstration dataset
data("demo.siber.data")
#
# create the siber object
<- createSiberObject(demo.siber.data)
siber.example
# Create lists of plotting arguments to be passed onwards to each
# of the three plotting functions.
<- list(col = 1, lty = 1, lwd = 1)
community.hulls.args <- list(n = 100, p.interval = 0.95, lty = 1, lwd = 2)
group.ellipses.args <- list(lty = 2, col = "grey20")
group.hull.args
par(mfrow=c(1,1))
plotSiberObject(siber.example,
ax.pad = 2,
hulls = F, community.hulls.args,
ellipses = T, group.ellipses.args,
group.hulls = T, group.hull.args,
bty = "L",
iso.order = c(1,2),
xlab = expression({delta}^13*C~'\u2030'),
ylab = expression({delta}^15*N~'\u2030')
)#> Warning in title(...): font metrics unknown for Unicode character U+2030
#> Warning in title(...): font metrics unknown for Unicode character U+2030
#> Warning in title(...): conversion failure on '‰' in 'mbcsToSbcs': dot
#> substituted for <e2>
#> Warning in title(...): conversion failure on '‰' in 'mbcsToSbcs': dot
#> substituted for <80>
#> Warning in title(...): conversion failure on '‰' in 'mbcsToSbcs': dot
#> substituted for <b0>
#> Warning in title(...): font metrics unknown for Unicode character U+2030
#> Warning in title(...): font metrics unknown for Unicode character U+2030
#> Warning in title(...): conversion failure on '‰' in 'mbcsToSbcs': dot
#> substituted for <e2>
#> Warning in title(...): conversion failure on '‰' in 'mbcsToSbcs': dot
#> substituted for <80>
#> Warning in title(...): conversion failure on '‰' in 'mbcsToSbcs': dot
#> substituted for <b0>
```

As before, we fit the Bayesian model describing the ellipses.

```
# options for running jags
<- list()
parms $n.iter <- 2 * 10^4 # number of iterations to run the model for
parms$n.burnin <- 1 * 10^3 # discard the first set of values
parms$n.thin <- 10 # thin the posterior by this many
parms$n.chains <- 2 # run this many chains
parms
$save.output = FALSE
parms$save.dir = tempdir()
parms
# define the priors
<- list()
priors $R <- 1 * diag(2)
priors$k <- 2
priors$tau.mu <- 1.0E-3
priors
# fit the ellipses which uses an Inverse Wishart prior
# on the covariance matrix Sigma, and a vague normal prior on the
# means. Fitting is via the JAGS method.
<- siberMVN(siber.example, parms, priors)
ellipses.posterior #> Compiling model graph
#> Resolving undeclared variables
#> Allocating nodes
#> Graph information:
#> Observed stochastic nodes: 30
#> Unobserved stochastic nodes: 3
#> Total graph size: 45
#>
#> Initializing model
#>
#> Compiling model graph
#> Resolving undeclared variables
#> Allocating nodes
#> Graph information:
#> Observed stochastic nodes: 30
#> Unobserved stochastic nodes: 3
#> Total graph size: 45
#>
#> Initializing model
#>
#> Compiling model graph
#> Resolving undeclared variables
#> Allocating nodes
#> Graph information:
#> Observed stochastic nodes: 30
#> Unobserved stochastic nodes: 3
#> Total graph size: 45
#>
#> Initializing model
#>
#> Compiling model graph
#> Resolving undeclared variables
#> Allocating nodes
#> Graph information:
#> Observed stochastic nodes: 30
#> Unobserved stochastic nodes: 3
#> Total graph size: 45
#>
#> Initializing model
#>
#> Compiling model graph
#> Resolving undeclared variables
#> Allocating nodes
#> Graph information:
#> Observed stochastic nodes: 30
#> Unobserved stochastic nodes: 3
#> Total graph size: 45
#>
#> Initializing model
#>
#> Compiling model graph
#> Resolving undeclared variables
#> Allocating nodes
#> Graph information:
#> Observed stochastic nodes: 30
#> Unobserved stochastic nodes: 3
#> Total graph size: 45
#>
#> Initializing model
```

Now we can extract the centroid data and plot the vector data.

```
# extract the centroids from the fitted model object
<- siberCentroids(ellipses.posterior)
centroids
# calculate pairwise polar vectors among all groups
# this is not actually used in this example
<- allCentroidVectors(centroids, do.plot = FALSE) angles_distances
```

The posterior distributions of the angles can then be visualise as a polar histograms, since the data wrap between \(-\pi\) and \(\pi\). For some reason, I cant get the gridline associate with \(\pi\) to appear.

```
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# function to do the histograms on each group
<- function(df){
my.hist <- hist(df$angles,
test breaks = seq(from = -pi, to = pi, length = 60),
plot = FALSE)
<- data.frame(counts = test$counts, mids = test$mids, dens = test$density,
X counts.stdzd = test$counts / max(test$counts))
return(X)
}# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# calculate the points for each group's ellipse
<- angles_distances %>% group_by(comparison) %>%
hist.by.groups do(my.hist(.))
<- ggplot(data = hist.by.groups, aes(x = mids, y = counts.stdzd)) +
all.roses geom_bar(stat = "identity") +
coord_polar(start = pi / 2, direction = -1) +
facet_wrap( ~ comparison) +
theme(axis.ticks.y = element_blank(),
axis.text.y = element_blank()) +
scale_x_continuous( breaks = c(-pi, -pi/2, 0, pi/2, pi),
labels = c("","-\u03C0/2","0","\u03C0/2", "\u03C0"))
print(all.roses)
```

Try some fancy 2-d density plots. These boxes represent the density of the tips of the polar vectors describing the relative position between pairs of individuals. The median vector is shown as an arrow, with the 2-dimensional heatmaps showing where the tip is likely to be. To do this, we have to convert our polar coordinates to cartesian space using the formulae: \((x,y) = (r\cos(\theta),r\sin(\theta))\).

The names for each comparison are not the prettiest or most
informative. Here the “X” is superfluous and has appeared via the dplyr
code above. The panel label ‘X1.1.1.2’ reads as community 1 group 1,
compared with community 1 group 2. You could relabel the groups in the
field `cart_positions$comparison`

below.

```
<- dplyr::summarise(group_by(angles_distances, comparison),
median_vectors medAngle = median(angles), medDist = median(distances))
<- data.frame(comparison = median_vectors$comparison,
origins x = 0, y = 0)
<- with(median_vectors, data.frame(comparison = comparison,
ends x = medDist * cos(medAngle),
y = medDist * sin(medAngle)))
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# generate the start and end points of the medians for the arrows
<- dplyr::bind_rows(origins, ends)
for_arrows
# rename the comparison label for nice plot labels below
# aa <- unlist(strsplit(as.character(for_arrows$comparison), "[.]"))
# aa <- aa[seq(3,length(aa),5)]
# for_arrows$comparison2 <- factor(aa)
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# create the cartesian points for the estimated tips of the arrows
<- with(angles_distances, data.frame(x = distances * cos(angles),
cart_positions y = distances * sin(angles),
comparison = comparison ))
# rename as above
# bb <- unlist(strsplit(as.character(angles_distances$comparison), "[.]"))
# bb <- bb[seq(3,length(bb),5)]
# cart_positions$comparison2 <- factor(bb)
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
# plot it
ggplot(cart_positions, aes(x,y) ) +
geom_bin2d(bins = 20) +
scale_fill_gradient(low = "white", high = "black") +
coord_cartesian(xlim = c(-20, +20), ylim = c(-20, +20)) +
facet_wrap( ~ comparison, scales = "fixed") +
theme_classic() +
geom_path(data = for_arrows,
arrow = arrow(type = "open", length = unit(0.2, "cm")),
col = "red", alpha = 0.6) +
ylab(expression(paste(delta^{15}, "N (\u2030)"))) +
xlab(expression(paste(delta^{13}, "C (\u2030)"))) +
theme(text = element_text(size=15))
```