├── revdep ├── failures.md ├── problems.md ├── .gitignore ├── email.yml ├── cran.md └── README.md ├── data ├── allgroups.rda ├── mongoose.rda ├── concdepdemo.rda ├── geese1demo.rda ├── geese2demo.rda ├── sourcesdemo.rda ├── correctionsdemo.rda ├── demo.siber.data.2.rda └── demo.siber.data.rda ├── CRAN-SUBMISSION ├── R ├── SIBER-package.R ├── hullarea.R ├── ellipsoidTransform.R ├── ellipseInOut.R ├── siberEllipses.R ├── genCircle.R ├── siberConvexhull.R ├── posteriorSEA.R ├── communityMetricsML.R ├── plotGroupEllipses.R ├── sigmaSEA.R ├── generateSiberGroup.R ├── bayesianLayman.R ├── kapow.R ├── pointsToEllipsoid.R ├── plotGroupHulls.R ├── extractPosteriorMeans.R ├── ellipseBackTransform.R ├── plotCommunityHulls.R ├── generateSiberCommunity.R ├── allCentroidVectors.R ├── generateSiberData.R ├── groupMetricsML.R ├── siberCentroids.R ├── laymanmetrics.R ├── specificCentroidVectors.R ├── siberKapow.R ├── siberMVN.R ├── bayesianOverlap.R └── maxLikOverlap.R ├── .Rbuildignore ├── SIBER.Rproj ├── tmp ├── import-export-mongoose-data.Rmd ├── test-eig-vectors.R ├── layman-metrics-on-each-group.Rmd ├── StandardEllipseCalc.R ├── test-points-within-ellipsoid.R ├── test-points-within-2d-ellipse.R ├── test-ellipse-sizes.Rmd ├── test-nonnumeric-community-labels.Rmd ├── test-nonnumeric-group-labels.Rmd └── test_column_naming.R ├── man ├── SIBER-package.Rd ├── siberEllipses.Rd ├── hullArea.Rd ├── ellipseInOut.Rd ├── kapow.Rd ├── ellipsoidTransform.Rd ├── genCircle.Rd ├── geese1demo.Rd ├── posteriorSEA.Rd ├── geese2demo.Rd ├── mongoose.Rd ├── groupMetricsML.Rd ├── allgroups.Rd ├── communityMetricsML.Rd ├── siberConvexhull.Rd ├── sourcesdemo.Rd ├── demo.siber.data.Rd ├── demo.siber.data.2.Rd ├── siberCentroids.Rd ├── concdepdemo.Rd ├── correctionsdemo.Rd ├── allCentroidVectors.Rd ├── bayesianLayman.Rd ├── extractPosteriorMeans.Rd ├── pointsToEllipsoid.Rd ├── generateSiberGroup.Rd ├── plotGroupEllipses.Rd ├── siberKapow.Rd ├── laymanMetrics.Rd ├── specificCentroidVectors.Rd ├── sigmaSEA.Rd ├── ellipseBackTransform.Rd ├── createSiberObject.Rd ├── plotGroupHulls.Rd ├── generateSiberCommunity.Rd ├── generateSiberData.Rd ├── plotCommunityHulls.Rd ├── bayesianOverlap.Rd ├── siberMVN.Rd ├── maxLikOverlap.Rd ├── fitEllipse.Rd ├── addEllipse.Rd ├── plotSiberObject.Rd └── siberdensityplot.Rd ├── .gitignore ├── NAMESPACE ├── DESCRIPTION ├── cran-comments.md ├── vignettes ├── Test-convergence.R ├── Customising-Plots-Manually.R ├── Test-convergence.Rmd ├── Plot-posterior-ellipses.R ├── kapow-example.R ├── Plot-SIA-ggplot2.R ├── Customising-Plots-Manually.Rmd ├── siber-comparing-communities.R └── Plot-posterior-ellipses.Rmd ├── inst └── extdata │ ├── test.group.names.csv │ └── test.community.names.csv └── README.md /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /data/allgroups.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/allgroups.rda -------------------------------------------------------------------------------- /data/mongoose.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/mongoose.rda -------------------------------------------------------------------------------- /data/concdepdemo.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/concdepdemo.rda -------------------------------------------------------------------------------- /data/geese1demo.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/geese1demo.rda -------------------------------------------------------------------------------- /data/geese2demo.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/geese2demo.rda -------------------------------------------------------------------------------- /data/sourcesdemo.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/sourcesdemo.rda -------------------------------------------------------------------------------- /data/correctionsdemo.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/correctionsdemo.rda -------------------------------------------------------------------------------- /data/demo.siber.data.2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/demo.siber.data.2.rda -------------------------------------------------------------------------------- /data/demo.siber.data.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AndrewLJackson/SIBER/HEAD/data/demo.siber.data.rda -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 2.1.9 2 | Date: 2023-10-19 09:00:30 UTC 3 | SHA: 70887b91fa00ccbd201be1e1b8123119947459f3 4 | -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /R/SIBER-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | ## usethis namespace: end 6 | NULL 7 | -------------------------------------------------------------------------------- /revdep/email.yml: -------------------------------------------------------------------------------- 1 | release_date: ??? 2 | rel_release_date: ??? 3 | my_news_url: ??? 4 | release_version: ??? 5 | release_details: ??? 6 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^CRAN-RELEASE$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^demot 5 | ^plot 6 | ^tmp 7 | README.md 8 | cran-comments.md 9 | 10 | ^doc$ 11 | ^Meta$ 12 | ^revdep$ 13 | ^CRAN-SUBMISSION$ 14 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 2 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /SIBER.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageRoxygenize: rd,namespace,vignette 19 | -------------------------------------------------------------------------------- /tmp/import-export-mongoose-data.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "R Notebook" 3 | output: html_notebook 4 | --- 5 | 6 | 7 | ## About 8 | import the mongoose data as csv and export to /data as .rda for inclusion in the package 9 | 10 | ```{r} 11 | 12 | library(tidyverse) 13 | library(magrittr) 14 | 15 | # import csv file 16 | mongoose <- read.csv("mongooseFullData.csv", header = TRUE, 17 | stringsAsFactors = FALSE) %>% 18 | select(indiv.id, pack, c13, n15) 19 | 20 | # export only the columns we need 21 | 22 | save(mongoose, 23 | file = "../data/mongoose.rda", 24 | compress = "xz") 25 | 26 | ``` 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /R/hullarea.R: -------------------------------------------------------------------------------- 1 | #' Calculate the area of a convex hull given its coordinates 2 | #' 3 | #' Given the coordinates of a convex hull (i.e. a polygon), this function 4 | #' calculates its area. Not intended for direct use outside of 5 | #' [siberConvexhull()]. 6 | #' 7 | #' @param x a vector of x-axis data 8 | #' @param y a vector of y-axis data 9 | #' 10 | #' @return a scalar representing the area of the convex hull in units of 11 | #' `x * y`; i.e. most commonly in permille squared for isotope data. 12 | #' 13 | 14 | 15 | hullArea <- function (x,y) { 16 | ne <- length(x) 17 | harea <- abs (0.5 * ( (x[1:(ne-1)] %*% y[2:ne]) - ( y[1:(ne-1)] %*% x[2:ne]) ) ) 18 | harea 19 | } -------------------------------------------------------------------------------- /man/SIBER-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SIBER-package.R 3 | \docType{package} 4 | \name{SIBER-package} 5 | \alias{SIBER} 6 | \alias{SIBER-package} 7 | \title{SIBER: Stable Isotope Bayesian Ellipses in R} 8 | \description{ 9 | Fits bi-variate ellipses to stable isotope data using Bayesian inference with the aim being to describe and compare their isotopic niche. 10 | } 11 | \author{ 12 | \strong{Maintainer}: Andrew Jackson \email{jacksoan@tcd.ie} (\href{https://orcid.org/0000-0001-7334-0434}{ORCID}) 13 | 14 | Authors: 15 | \itemize{ 16 | \item Andrew Parnell (\href{https://orcid.org/0000-0001-7956-7939}{ORCID}) 17 | } 18 | 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/siberEllipses.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siberEllipses.R 3 | \name{siberEllipses} 4 | \alias{siberEllipses} 5 | \title{Calculate the Bayesian Standard Ellipse Area for all groups} 6 | \usage{ 7 | siberEllipses(corrected.posteriors) 8 | } 9 | \arguments{ 10 | \item{corrected.posteriors}{the Bayesian ellipses as returned by 11 | \code{\link[=siberMVN]{siberMVN()}}.} 12 | } 13 | \value{ 14 | A matrix of with each column containing the posterior estimates of 15 | the SEA. 16 | } 17 | \description{ 18 | This function loops over each group within each community and calculates the 19 | posterior distribution describing the corresponding Standard Ellipse Area. 20 | } 21 | -------------------------------------------------------------------------------- /R/ellipsoidTransform.R: -------------------------------------------------------------------------------- 1 | #' Apply a normalisation transformation to vectors of data onto ellipsoids 2 | #' 3 | #' Takes a vector `x` and transforms the points onto the same geometry of 4 | #' a normalised ellipse given by the inverse of the covariance matrix 5 | #' `SigSqrt` and the location `mu`. 6 | #' 7 | #' @param x the vector of data points to be transformed 8 | #' @param SigSqrt the inverse of the covariance matrix 9 | #' @param mu the vector of means of the ellipse 10 | #' 11 | #' @return A vector of transformed data points 12 | #' 13 | #' @export 14 | 15 | ellipsoidTransform = function(x, SigSqrt, mu) { 16 | # input error checking is handled upstream in pointsToEllipsoid() 17 | return(solve(SigSqrt,x-mu)) 18 | } -------------------------------------------------------------------------------- /man/hullArea.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/hullarea.R 3 | \name{hullArea} 4 | \alias{hullArea} 5 | \title{Calculate the area of a convex hull given its coordinates} 6 | \usage{ 7 | hullArea(x, y) 8 | } 9 | \arguments{ 10 | \item{x}{a vector of x-axis data} 11 | 12 | \item{y}{a vector of y-axis data} 13 | } 14 | \value{ 15 | a scalar representing the area of the convex hull in units of 16 | \code{x * y}; i.e. most commonly in permille squared for isotope data. 17 | } 18 | \description{ 19 | Given the coordinates of a convex hull (i.e. a polygon), this function 20 | calculates its area. Not intended for direct use outside of 21 | \code{\link[=siberConvexhull]{siberConvexhull()}}. 22 | } 23 | -------------------------------------------------------------------------------- /man/ellipseInOut.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ellipseInOut.R 3 | \name{ellipseInOut} 4 | \alias{ellipseInOut} 5 | \title{Test whether a set of points are inside or outside a defined circle} 6 | \usage{ 7 | ellipseInOut(Z, p = 0.95, r = NULL) 8 | } 9 | \arguments{ 10 | \item{Z}{the \verb{i x d} matrix of data points to be tested.} 11 | 12 | \item{p}{the percentile of the ellipse to be tested.} 13 | 14 | \item{r}{a manually defined radius of the circle to be used. Setting \code{r} 15 | to be anything other than NULL will override the choice of \code{p}.} 16 | } 17 | \value{ 18 | A logical vector indicating whether the point is inside or outside 19 | the circle 20 | } 21 | \description{ 22 | Takes a 23 | } 24 | -------------------------------------------------------------------------------- /man/kapow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/kapow.R 3 | \name{kapow} 4 | \alias{kapow} 5 | \title{KAPOW!} 6 | \usage{ 7 | kapow(cd = 7, ng = 25, n = 50, sc = 10, do.plot = TRUE) 8 | } 9 | \arguments{ 10 | \item{cd}{sets the random seed to this} 11 | 12 | \item{ng}{the number of ellipses to draw} 13 | 14 | \item{n}{the number of data points to simulate per group, but never displayed} 15 | 16 | \item{sc}{the scaling factor the rwishart sigma called by 17 | \code{\link[stats:rWishart]{stats::rWishart()}}} 18 | 19 | \item{do.plot}{a logical indicating whether the plot should be printed 20 | (defaults to TRUE).} 21 | } 22 | \value{ 23 | A ggplot object 24 | } 25 | \description{ 26 | This function packs a punch and makes a pretty figure. 27 | } 28 | -------------------------------------------------------------------------------- /man/ellipsoidTransform.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ellipsoidTransform.R 3 | \name{ellipsoidTransform} 4 | \alias{ellipsoidTransform} 5 | \title{Apply a normalisation transformation to vectors of data onto ellipsoids} 6 | \usage{ 7 | ellipsoidTransform(x, SigSqrt, mu) 8 | } 9 | \arguments{ 10 | \item{x}{the vector of data points to be transformed} 11 | 12 | \item{SigSqrt}{the inverse of the covariance matrix} 13 | 14 | \item{mu}{the vector of means of the ellipse} 15 | } 16 | \value{ 17 | A vector of transformed data points 18 | } 19 | \description{ 20 | Takes a vector \code{x} and transforms the points onto the same geometry of 21 | a normalised ellipse given by the inverse of the covariance matrix 22 | \code{SigSqrt} and the location \code{mu}. 23 | } 24 | -------------------------------------------------------------------------------- /man/genCircle.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/genCircle.R 3 | \name{genCircle} 4 | \alias{genCircle} 5 | \title{Create a sequence of points on a circle} 6 | \usage{ 7 | genCircle(n = 100, r) 8 | } 9 | \arguments{ 10 | \item{n}{the number of points to create around the circle. Defaults to 100.} 11 | 12 | \item{r}{the radius of the circle to create.} 13 | } 14 | \value{ 15 | A 2 x n matrix of x and y coordinates of points on a circle. 16 | } 17 | \description{ 18 | This is a helper function that creates a sequence of points on a circle of 19 | radius \code{r} as a resolution determined by \code{n}. It is not intended 20 | for direct calling, and is used by the ellipse plotting function 21 | \code{\link[=addEllipse]{addEllipse()}}. NB not an exported function. 22 | } 23 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | /*_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # revdep files 39 | revdep/ 40 | 41 | # OS X files 42 | .DS_Store 43 | .DS_Store? 44 | .Rproj.user 45 | doc 46 | Meta 47 | -------------------------------------------------------------------------------- /man/geese1demo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{geese1demo} 5 | \alias{geese1demo} 6 | \title{A single group of the geese data} 7 | \format{ 8 | A 2 column, 9 row matrix containing the plasma data for the first 9 | group of geese. Columns are in the order d13C and d15N. Retained here as 10 | legacy from now defunct package siar. Note that the order of the data has 11 | been swapped since siar in order to present d13C as the first isotope and 12 | hence on the x-axis by default. 13 | } 14 | \usage{ 15 | data(geese1demo) 16 | } 17 | \description{ 18 | A dataset for a single group of geese (as consumers) for two isotope tracers. 19 | Intended for use in a Stable Isotope Mixing Model. 20 | } 21 | \author{ 22 | Rich Inger 23 | } 24 | \keyword{datasets} 25 | -------------------------------------------------------------------------------- /R/ellipseInOut.R: -------------------------------------------------------------------------------- 1 | #' Test whether a set of points are inside or outside a defined circle 2 | #' 3 | #' Takes a 4 | #' 5 | #' @param Z the `i x d` matrix of data points to be tested. 6 | #' @param p the percentile of the ellipse to be tested. 7 | #' @param r a manually defined radius of the circle to be used. Setting `r` 8 | #' to be anything other than NULL will override the choice of `p`. 9 | #' 10 | #' @return A logical vector indicating whether the point is inside or outside 11 | #' the circle 12 | #' 13 | #' @export 14 | 15 | ellipseInOut <- function(Z, p = 0.95, r = NULL){ 16 | 17 | # if r is NULL as per default, calculate it based on p 18 | if(is.null(r)) {r <- stats::qchisq(p, df = ncol(Z))} 19 | 20 | # determine if each point is inside this radius or not 21 | inside <- rowSums(Z ^ 2) < r 22 | 23 | # return this logical vector 24 | return(inside) 25 | 26 | } -------------------------------------------------------------------------------- /man/posteriorSEA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/posteriorSEA.R 3 | \name{posteriorSEA} 4 | \alias{posteriorSEA} 5 | \title{Calculate the SEA based on a posterior distribution of Sigma} 6 | \usage{ 7 | posteriorSEA(post) 8 | } 9 | \arguments{ 10 | \item{post}{a matrix of posterior covariance matrices and mean estimates for 11 | a bivariate ellipse. In SIBER, this is typically one list element of the 12 | object returned by \code{\link[=siberMVN]{siberMVN()}}.} 13 | } 14 | \value{ 15 | A vector of posterior Bayesian Standard Ellipse Areas (SEA_B) 16 | } 17 | \description{ 18 | This function loops over each posterior draw of a single group's Bayesian 19 | bivariate ellipse and calculates the Standard Ellipse Area (SEA) for each 20 | draw, thereby generating a distribution of SEA estimates. Not intended for 21 | direct calling outside of \code{\link[=siberEllipses]{siberEllipses()}}. 22 | } 23 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:----------------------------------------| 5 | |version |R version 4.2.2 (2022-10-31) | 6 | |os |macOS Ventura 13.1 | 7 | |system |aarch64, darwin20 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |Europe/Dublin | 13 | |date |2023-02-15 | 14 | |rstudio |2022.12.0+353 Elsbeth Geranium (desktop) | 15 | |pandoc |NA | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:-------|:-----|:-----|:--| 21 | |SIBER |2.1.6 |2.1.7 |* | 22 | 23 | # Revdeps 24 | 25 | -------------------------------------------------------------------------------- /R/siberEllipses.R: -------------------------------------------------------------------------------- 1 | #' Calculate the Bayesian Standard Ellipse Area for all groups 2 | #' 3 | #' This function loops over each group within each community and calculates the 4 | #' posterior distribution describing the corresponding Standard Ellipse Area. 5 | #' 6 | #' @param corrected.posteriors the Bayesian ellipses as returned by 7 | #' [siberMVN()]. 8 | #' 9 | #' @return A matrix of with each column containing the posterior estimates of 10 | #' the SEA. 11 | #' 12 | #' @export 13 | 14 | siberEllipses <- function (corrected.posteriors) { 15 | 16 | # prep a matrix for storing the results 17 | SEA.B <- matrix(NA, 18 | nrow = nrow(corrected.posteriors[[1]]), 19 | ncol = length(corrected.posteriors)) 20 | 21 | 22 | for (i in 1:length(corrected.posteriors)){ 23 | tmp <- posteriorSEA(corrected.posteriors[[i]]) 24 | SEA.B[, i] <- tmp 25 | 26 | } 27 | 28 | return(SEA.B) 29 | } 30 | -------------------------------------------------------------------------------- /tmp/test-eig-vectors.R: -------------------------------------------------------------------------------- 1 | # script to check the calculation of angle and area using the atan rather than 2 | # asin() method. 3 | 4 | set.seed(1) 5 | 6 | # n random numbers 7 | n <- 20 8 | 9 | # x 10 | x <- rnorm(n, 0, 2) 11 | 12 | # intercept and slope 13 | b <- c(0, 1) 14 | 15 | # y 16 | y <- cbind(rep(1,n), x) %*% b + rnorm(n,0,1) 17 | 18 | # plot 19 | plot(y~x, type = "p") 20 | 21 | # covariance matrix 22 | S <- cov(cbind(x,y)) 23 | 24 | # eigen values and vectors 25 | eig <- eigen(S) 26 | 27 | # SEA 28 | SEA <- pi * prod(eig$values ^ 0.5) 29 | 30 | # angle of y with x axis 31 | theta <- asin(eig$vectors[1,2]) 32 | theta.tan <- atan(eig$vectors[2,1]/eig$vectors[1,1]) 33 | 34 | # SIBER estimates 35 | ss <- sigmaSEA(S) 36 | ss$theta <- sign(S[1, 2]) * asin(abs(eig$vectors[1, 2])) 37 | 38 | cat("Eigen values and vectors\n") 39 | eig 40 | 41 | cat("Hardcoded estimates\n") 42 | SEA 43 | theta 44 | theta.tan 45 | 46 | cat("SIBER estimates\n") 47 | ss$SEA 48 | ss$theta -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(addEllipse) 4 | export(allCentroidVectors) 5 | export(bayesianLayman) 6 | export(bayesianOverlap) 7 | export(communityMetricsML) 8 | export(createSiberObject) 9 | export(ellipseInOut) 10 | export(ellipsoidTransform) 11 | export(extractPosteriorMeans) 12 | export(fitEllipse) 13 | export(generateSiberCommunity) 14 | export(generateSiberData) 15 | export(generateSiberGroup) 16 | export(groupMetricsML) 17 | export(kapow) 18 | export(laymanMetrics) 19 | export(maxLikOverlap) 20 | export(plotCommunityHulls) 21 | export(plotGroupEllipses) 22 | export(plotGroupHulls) 23 | export(plotSiberObject) 24 | export(pointsToEllipsoid) 25 | export(posteriorSEA) 26 | export(siberCentroids) 27 | export(siberConvexhull) 28 | export(siberDensityPlot) 29 | export(siberEllipses) 30 | export(siberKapow) 31 | export(siberMVN) 32 | export(sigmaSEA) 33 | export(specificCentroidVectors) 34 | import(dplyr) 35 | import(ggplot2) 36 | importFrom(magrittr,"%>%") 37 | -------------------------------------------------------------------------------- /man/geese2demo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{geese2demo} 5 | \alias{geese2demo} 6 | \title{A single group of the geese data} 7 | \format{ 8 | A 3 column, 251 row matrix containing the plasma data for the 8 9 | groups of gees as consumers. Columns are in the order Group which is an 10 | integer that determines which of the 8 groups the observation belongs. The 11 | second and third columns are d13C and d15N values derived from the blood 12 | plasma for each observation. Retained here as legacy from now defunct 13 | package siar. Note that the order of the isotope data has been swapped 14 | since siar in order to present d13C as the first isotope and hence on the 15 | x-axis by default. 16 | } 17 | \usage{ 18 | data(geese2demo) 19 | } 20 | \description{ 21 | A dataset for a single group of geese (as consumers) for two isotope tracers. 22 | Intended for use in a Stable Isotope Mixing Model. 23 | } 24 | \author{ 25 | Rich Inger 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/mongoose.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{mongoose} 5 | \alias{mongoose} 6 | \title{A set of isotope observations for mongooses nested within packs} 7 | \format{ 8 | A 4 column, 783 row data.frame object containing unique individual 9 | mongoose identifiers in the first column "indiv.id"; an integer identifier for 10 | the pack to which each individual belongs in "pack"; Delta 13 Carbon values 11 | "c13; and Delta 15 Nitrogen values in "n15". See the paper Sheppard et al 12 | 2018 \doi{10.1111/ele.12933} for more details, although N.B. 13 | the data here are provided as an example, not as a reproducible analysis of 14 | that paper. 15 | } 16 | \usage{ 17 | data(mongoose) 18 | } 19 | \description{ 20 | A dataset of multiple isotopes per individual mongooses nested within packs 21 | where the goal is to understand isotopic niche occupancy of individuals 22 | with respect to their own pack. 23 | } 24 | \author{ 25 | Harry Marshall 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/groupMetricsML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/groupMetricsML.R 3 | \name{groupMetricsML} 4 | \alias{groupMetricsML} 5 | \title{Calculate maximum likelihood based measures of dispersion of bivariate data} 6 | \usage{ 7 | groupMetricsML(siber) 8 | } 9 | \arguments{ 10 | \item{siber}{a siber object as created by createSiberObject.} 11 | } 12 | \value{ 13 | A 3 x m matrix of the 6 Layman metrics of dX_range, dY_range, TA, 14 | CD, MNND and SDNND in rows, where each column is a different group nested 15 | within a community. 16 | } 17 | \description{ 18 | This function loops over each group within each community and calculates the 19 | convex hull total area, Standard Ellipse Area (SEA) and its corresponding 20 | small sample size corrected version SEAc based on the maximum likelihood 21 | estimates of the means and covariance matrices of each group. 22 | } 23 | \examples{ 24 | data(demo.siber.data) 25 | my.siber.data <- createSiberObject(demo.siber.data) 26 | groupMetricsML(my.siber.data) 27 | 28 | } 29 | -------------------------------------------------------------------------------- /R/genCircle.R: -------------------------------------------------------------------------------- 1 | #' Create a sequence of points on a circle 2 | #' 3 | #' This is a helper function that creates a sequence of points on a circle of 4 | #' radius `r` as a resolution determined by `n`. It is not intended 5 | #' for direct calling, and is used by the ellipse plotting function 6 | #' [addEllipse()]. NB not an exported function. 7 | #' 8 | #' @param n the number of points to create around the circle. Defaults to 100. 9 | #' @param r the radius of the circle to create. 10 | #' 11 | #' @return A 2 x n matrix of x and y coordinates of points on a circle. 12 | #' 13 | 14 | # function to generate a circle of data points which 15 | # can be transformed to form an ellipse. Intended for 16 | # generating various SIBER ellipses. 17 | # Not intended for calling on its own. 18 | 19 | genCircle = function(n = 100, r) { 20 | # a uniform series of angles from 0 -> 2*pi 21 | theta = seq(0, 2*pi, length = n) 22 | 23 | # x and y coordinates on the circle 24 | x = r*cos(theta) 25 | y = r*sin(theta) 26 | 27 | # return the coordinates 28 | return(cbind(x,y)) 29 | } -------------------------------------------------------------------------------- /man/allgroups.Rd: -------------------------------------------------------------------------------- 1 | \name{allgroups} 2 | \alias{allgroups} 3 | \docType{data} 4 | \title{ The entire set of Geese isotope data } 5 | \description{ 6 | A 5 column matrix containing isotopic estimates for 251 geese collected at 8 7 | different time points. 8 | The first column indicates the time point group, the second and third are 9 | d15N (Nitrogen) and d13C 10 | (Carbon) isotopic values for the Geese plasma, the third and fourth are 11 | d15N and d13C values for 12 | the Geese cells. Note that these are raw values; they have not undergone 13 | fractionation correction. 14 | } 15 | \usage{data(allgroups)} 16 | \format{ 17 | A data frame with 251 observations on the following 5 variables. 18 | \describe{ 19 | \item{\code{Group}}{Group number / time point} 20 | \item{\code{d15NPl}}{d15N plasma} 21 | \item{\code{d13CPl}}{d13C plasma} 22 | \item{\code{d15NCe}}{d15N cells} 23 | \item{\code{d13CCe}}{d13C cells} 24 | } 25 | } 26 | \examples{ 27 | #see siarmenu() and option 9 for a demo using part of this data 28 | } 29 | \keyword{datasets} 30 | -------------------------------------------------------------------------------- /man/communityMetricsML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/communityMetricsML.R 3 | \name{communityMetricsML} 4 | \alias{communityMetricsML} 5 | \title{Calculate the point estimates of the Layman metrics for each community} 6 | \usage{ 7 | communityMetricsML(siber) 8 | } 9 | \arguments{ 10 | \item{siber}{a siber object as created by \code{\link[=createSiberObject]{createSiberObject()}}.} 11 | } 12 | \value{ 13 | A 6 x m matrix of the 6 Layman metrics of dX_range, dY_range, TA, 14 | CD, MNND and SDNND in rows, for each community by column 15 | } 16 | \description{ 17 | This function loops over each community, determines the centre of mass 18 | (centroid) of each of the groups comprising the community using the basic 19 | \code{\link[base:mean]{base::mean()}} function independently on the marginal x and y vectors, 20 | and calculates the corresponding 6 Layman metrics based on these points. 21 | } 22 | \examples{ 23 | data(demo.siber.data) 24 | my.siber.data <- createSiberObject(demo.siber.data) 25 | communityMetricsML(my.siber.data) 26 | 27 | } 28 | -------------------------------------------------------------------------------- /man/siberConvexhull.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siberConvexhull.R 3 | \name{siberConvexhull} 4 | \alias{siberConvexhull} 5 | \title{Calculate metrics and plotting information for convex hulls} 6 | \usage{ 7 | siberConvexhull(x, y) 8 | } 9 | \arguments{ 10 | \item{x}{a vector of x-axis data} 11 | 12 | \item{y}{a vector of y-axis data} 13 | } 14 | \value{ 15 | A list of length four comprising: 16 | \itemize{ 17 | \item \code{TA} the area of the convex hull. 18 | \item \code{hullX} the x-coordinates of the points describing the convex hull. 19 | \item \code{hullY} the y-coordinates of the points describing the convex hull. 20 | \item \code{ind} the indices of the original data in \code{x} and \code{y} that 21 | form the boundaries of the convex hull. 22 | } 23 | } 24 | \description{ 25 | This function calculates the area of the convex hull describing a set of 26 | bivariate points, and returns other information useful for plotting the hull. 27 | } 28 | \examples{ 29 | x <- stats::rnorm(15) 30 | y <- stats::rnorm(15) 31 | siberConvexhull(x, y) 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/sourcesdemo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{sourcesdemo} 5 | \alias{sourcesdemo} 6 | \title{A set of isotope observations on food sources of brent geese} 7 | \format{ 8 | A 5 column, 4 row data.frame object containing 4 different plants and 9 | their measurements on 2 different isotopes. The first column Sources is a 10 | factor determining the name of the source. The second and third columns are 11 | the mean d13C and mean d15N values for each source respectively. Columns 3 12 | and 5 are the standard deviations of the d13C and d15N values respectively. 13 | Note that the order of the isotope data has been swapped since siar in 14 | order to present d13C as the first isotope and hence on the x-axis by 15 | default. 16 | } 17 | \usage{ 18 | data(sourcesdemo) 19 | } 20 | \description{ 21 | A dataset of isotope observations on 4 food sources of brent geese comprising 22 | their mean and standard deviations. Intended for use in a Stable Isotope 23 | Mixing Model. 24 | } 25 | \author{ 26 | Rich Inger 27 | } 28 | \keyword{datasets} 29 | -------------------------------------------------------------------------------- /man/demo.siber.data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{demo.siber.data} 5 | \alias{demo.siber.data} 6 | \title{Simulated d13C and d15N isotope-space data} 7 | \format{ 8 | An object of class \code{"data.frame"} containing four variables. 9 | The first and second variables are generic isotopes called \code{iso1} 10 | and \code{iso2}. The third variable \code{group} identifies which group 11 | within a community an observation belongs. Group are required to be 12 | integers in sequential order starting at \code{1} and numbering should 13 | restart within each community. The fourth variable \code{community} 14 | identifies which community an observation belongs, and again is required 15 | to be an integer in sequential order staring at \code{1}. 16 | } 17 | \usage{ 18 | data(demo.siber.data) 19 | } 20 | \description{ 21 | Data for two communities, created by \code{\link[=generateSiberData]{generateSiberData()}} used 22 | to generate the vignette and illustrates the main functionality of SIBER. 23 | } 24 | \author{ 25 | Andrew Jackson 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/demo.siber.data.2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{demo.siber.data.2} 5 | \alias{demo.siber.data.2} 6 | \title{Simulated d13C and d15N isotope-space data} 7 | \format{ 8 | An object of class \code{"data.frame"} containing four variables. 9 | The first and second variables are generic isotopes called \code{iso1} 10 | and \code{iso2}. The third variable \code{group} identifies which group 11 | within a community an observation belongs. Group are required to be 12 | integers in sequential order starting at \code{1} and numbering should 13 | restart within each community. The fourth variable \code{community} 14 | identifies which community an observation belongs, and again is required 15 | to be an integer in sequential order staring at \code{1}. 16 | } 17 | \usage{ 18 | data(demo.siber.data.2) 19 | } 20 | \description{ 21 | Data for two communities, created by \code{\link[=generateSiberData]{generateSiberData()}} used 22 | to generate the vignette and illustrates the main functionality of SIBER. 23 | } 24 | \author{ 25 | Andrew Jackson 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/siberCentroids.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siberCentroids.R 3 | \name{siberCentroids} 4 | \alias{siberCentroids} 5 | \title{Calculate the polar form of the vector between pairs of ellipse centroids} 6 | \usage{ 7 | siberCentroids(corrected.posteriors) 8 | } 9 | \arguments{ 10 | \item{corrected.posteriors}{the Bayesian ellipses as returned by 11 | \code{\link[=siberMVN]{siberMVN()}}.} 12 | } 13 | \value{ 14 | A list containing two arrays, one \code{r} contains the pairwise 15 | distances between ellipse centroids in as the first two dimensions, with 16 | the third dimension containing the same for each posterior draw defining 17 | the ellipse. The second array \code{theta} has the same structure and 18 | contains the angle in radians (from 0 to 2*pi) between the pairs. A third 19 | object \code{labels} refers to which community.group combination is in 20 | each of the first two dimensions of the arrays. 21 | } 22 | \description{ 23 | This function loops over each group within each community and calculates the 24 | vector in polar form between the estimated centroids of each ellipse to each 25 | other ellipse. 26 | } 27 | -------------------------------------------------------------------------------- /man/concdepdemo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{concdepdemo} 5 | \alias{concdepdemo} 6 | \title{A set of concentration dependence values for stable isotope analysis} 7 | \format{ 8 | A 5 column, 4 row data.frame object containing the concentration 9 | dependence data for the geese1demo and geese2demo datasets. The first 10 | column Source is a factor determining the name of the source. The second 11 | and third columns are the mean d13C and mean d15N concentration values for 12 | each source respectively. Columns 3 and 5 are the standard deviations but 13 | these are not currently implemented in either simmr or MixSIAR stable 14 | isotope mixing models. Note that the order of the isotope data has been 15 | swapped since siar in order to present d13C as the first isotope and hence 16 | on the x-axis by default. 17 | } 18 | \usage{ 19 | data(concdepdemo) 20 | } 21 | \description{ 22 | A dataset of concentration dependent corrections for 4 food sources of brent 23 | geese. Intended for use in a Stable Isotope Mixing Model. 24 | } 25 | \author{ 26 | Rich Inger 27 | } 28 | \keyword{datasets} 29 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: SIBER 2 | Type: Package 3 | Title: Stable Isotope Bayesian Ellipses in R 4 | Version: 2.1.9 5 | Authors@R: c( 6 | person("Andrew", "Jackson", role = c("aut", "cre"), 7 | email = "jacksoan@tcd.ie", 8 | comment = c(ORCID = "0000-0001-7334-0434")), 9 | person("Andrew", "Parnell", role = "aut", 10 | comment = c(ORCID = "0000-0001-7956-7939")) 11 | ) 12 | Depends: 13 | R (>= 4.0.0) 14 | SystemRequirements: JAGS (>= 4.1) 15 | Imports: 16 | hdrcde, 17 | graphics, 18 | grDevices, 19 | mnormt, 20 | rjags, 21 | spatstat.geom, 22 | spatstat.utils, 23 | stats, 24 | tidyr, 25 | dplyr, 26 | ggplot2, 27 | magrittr, 28 | purrr 29 | Suggests: 30 | coda, 31 | ellipse, 32 | knitr, 33 | rmarkdown, 34 | viridis 35 | Description: Fits bi-variate ellipses to stable isotope data using Bayesian 36 | inference with the aim being to describe and compare their isotopic 37 | niche. 38 | License: GPL (>= 2) 39 | Language: en-GB 40 | LazyLoad: yes 41 | LazyData: true 42 | Encoding: UTF-8 43 | Packaged: 44 | NeedsCompilation: yes 45 | VignetteBuilder: knitr 46 | Roxygen: list(markdown = TRUE) 47 | RoxygenNote: 7.2.3 48 | -------------------------------------------------------------------------------- /man/correctionsdemo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datalist.R 3 | \docType{data} 4 | \name{correctionsdemo} 5 | \alias{correctionsdemo} 6 | \title{A set of trophic discrimination factors for brent geese feeding on their 7 | sources.} 8 | \format{ 9 | A 5 column, 4 row data.frame object containing the trophic 10 | discrimination factors for brent geese consumers relative to 4 of their food 11 | sources (in Ireland). The first column Source is a factor determining the 12 | name of the source. The second and third columns are the mean d13C and mean 13 | d15N TDF values for each source respectively. Columns 3 and 5 are the standard 14 | deviations of the d13C and d15N TDF values respectively. Note that the order of 15 | the isotope data has been swapped since siar in order to present d13C as 16 | the first isotope and hence on the x-axis by default. 17 | } 18 | \usage{ 19 | data(correctionsdemo) 20 | } 21 | \description{ 22 | A dataset of estimated trophic discrimination factors for brent geese. The 23 | data assume the same TDF for each food source. Intended for use in a Stable 24 | Isotope Mixing Model. 25 | } 26 | \author{ 27 | Rich Inger 28 | } 29 | \keyword{datasets} 30 | -------------------------------------------------------------------------------- /man/allCentroidVectors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allCentroidVectors.R 3 | \name{allCentroidVectors} 4 | \alias{allCentroidVectors} 5 | \title{Plot the pairwise distances and angles describing the difference between 6 | centroids of all groups} 7 | \usage{ 8 | allCentroidVectors(centroids, upper = TRUE, do.plot = TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{centroids}{the list containing distance and angle matrices as returned 12 | by \code{\link[=siberCentroids]{siberCentroids()}}.} 13 | 14 | \item{upper}{a logical determining whether to plot the upper or lower 15 | triangle of angles. Defaults to TRUE which is the upper triangle and 16 | returns the angle from the second ellipse to the first by centering on the 17 | first centroid.} 18 | 19 | \item{do.plot}{a logical indicating whether plotting should be done or not. 20 | Defaults to TRUE.} 21 | 22 | \item{...}{additional arguments to pass onwards, not currently implemented.} 23 | } 24 | \value{ 25 | A nice plot. You can get the corresponding matrices used to generate 26 | the plots if you ask for it nicely: the_data <- 27 | plotCentroidVectors(centroids) 28 | } 29 | \description{ 30 | Plots the posterior densities 31 | } 32 | -------------------------------------------------------------------------------- /R/siberConvexhull.R: -------------------------------------------------------------------------------- 1 | #' Calculate metrics and plotting information for convex hulls 2 | #' 3 | #' This function calculates the area of the convex hull describing a set of 4 | #' bivariate points, and returns other information useful for plotting the hull. 5 | #' 6 | #' @param x a vector of x-axis data 7 | #' @param y a vector of y-axis data 8 | #' 9 | #' @return A list of length four comprising: 10 | #' 11 | #' * `TA` the area of the convex hull. 12 | #' 13 | #' * `hullX` the x-coordinates of the points describing the convex hull. 14 | #' 15 | #' * `hullY` the y-coordinates of the points describing the convex hull. 16 | #' 17 | #' * `ind` the indices of the original data in `x` and `y` that 18 | #' form the boundaries of the convex hull. 19 | #' 20 | #' 21 | #' @examples 22 | #' x <- stats::rnorm(15) 23 | #' y <- stats::rnorm(15) 24 | #' siberConvexhull(x, y) 25 | #' 26 | #' @export 27 | 28 | siberConvexhull <- function(x,y){ 29 | 30 | chI <- grDevices::chull(x,y) 31 | chI <- c(chI,chI[1]) 32 | hullX <- x[chI] 33 | hullY <- y[chI] 34 | 35 | TA <- hullArea(hullX,hullY) 36 | 37 | out <- list() 38 | out$TA <- TA 39 | out$xcoords <- hullX 40 | out$ycoords <- hullY 41 | out$ind <- chI 42 | 43 | out 44 | 45 | } -------------------------------------------------------------------------------- /man/bayesianLayman.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bayesianLayman.R 3 | \name{bayesianLayman} 4 | \alias{bayesianLayman} 5 | \title{Calculate Layman metrics on Bayesian posterior samples of a community} 6 | \usage{ 7 | bayesianLayman(mu.post) 8 | } 9 | \arguments{ 10 | \item{mu.post}{a list of length n.communities, with each list element 11 | containing the estimated means of the groups comprising that community. The 12 | typical workflow to generate mu.post follows. The 13 | Bayesian ellipses are fitted using \code{\link[=siberEllipses]{siberEllipses()}}, then the 14 | posterior means (centre of mass of each group) is extracted using 15 | \code{\link[=extractPosteriorMeans]{extractPosteriorMeans()}}. See the example below.} 16 | } 17 | \value{ 18 | A list of length n.communities, with each element containing a 19 | matrix of 6 columns, each representing the Bayesian posterior distribution 20 | of the 6 Layman metrics for each of the posterior draws recorded by the 21 | fitting process (i.e. which determines the number of rows in this matrix). 22 | } 23 | \description{ 24 | This function loops over the posterior distribution of group means within 25 | each community and generates the corresponding Bayesian estimate of the 6 26 | Layman metrics. 27 | } 28 | -------------------------------------------------------------------------------- /man/extractPosteriorMeans.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extractPosteriorMeans.R 3 | \name{extractPosteriorMeans} 4 | \alias{extractPosteriorMeans} 5 | \title{Extract posterior means from call to \code{\link{siberMVN}}} 6 | \usage{ 7 | extractPosteriorMeans(siber, post) 8 | } 9 | \arguments{ 10 | \item{siber}{a siber object as created by \code{\link[=createSiberObject]{createSiberObject()}}.} 11 | 12 | \item{post}{a list containing the posterior estimated parameters fitted to 13 | each group within every community. See \code{\link[=siberMVN]{siberMVN()}} which creates 14 | this object for details.} 15 | } 16 | \value{ 17 | A list of length n.communities with each entry representing a 18 | \code{n.draws * 2 * n.groups} array of rows equal to the number of posterior 19 | samples, 2 columns representing the two means of the multivariate data and 20 | \code{n.groups} the number of groups within the focal community. 21 | } 22 | \description{ 23 | This function extracts the posterior means from a call to 24 | \code{\link[=siberMVN]{siberMVN()}} which can then be used to calculate Bayesian layman 25 | metrics. This function is designed to create an array of posterior means 26 | that is more easily interrogated for plotting and summary statistics. 27 | } 28 | -------------------------------------------------------------------------------- /man/pointsToEllipsoid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pointsToEllipsoid.R 3 | \name{pointsToEllipsoid} 4 | \alias{pointsToEllipsoid} 5 | \title{Test whether a set of points are inside or outside a defined ellipse} 6 | \usage{ 7 | pointsToEllipsoid(X, Sigma, mu) 8 | } 9 | \arguments{ 10 | \item{X}{the \verb{i x d} matrix of data points to be transformed} 11 | 12 | \item{Sigma}{the \verb{d x d} covariance matrix of the ellipsoid} 13 | 14 | \item{mu}{the vector of means of the ellipse of length \code{d}} 15 | } 16 | \value{ 17 | A matrix of transformed data points corresponding to \code{X} 18 | } 19 | \description{ 20 | Takes a \verb{i x d} matrix of points where \code{d} is the dimension of the 21 | space considered, and \code{i} is the number of points and returns 22 | \code{TRUE} or \code{FALSE} for whether each point is inside or outside a 23 | d-dimensional ellipsoid defined by a covariance matrix \code{Sigma} and 24 | vector of means \code{mu}. 25 | } 26 | \examples{ 27 | X <- matrix(runif(200,-2.5, 2.5), ncol = 2, nrow = 100) 28 | SIG <- matrix(c(1,0,0,1), ncol = 2, nrow = 2) 29 | mu <- c(0, 0) 30 | Z <- pointsToEllipsoid(X, SIG, mu) 31 | test <- ellipseInOut(Z, p = 0.95) 32 | plot(X, col = test + 1, xlim = c(-3, 3), ylim = c(-3, 3), asp = 1) 33 | addEllipse(mu, SIG, p.interval = 0.95) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/generateSiberGroup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generateSiberGroup.R 3 | \name{generateSiberGroup} 4 | \alias{generateSiberGroup} 5 | \title{A utility function to simulate a single group of data} 6 | \usage{ 7 | generateSiberGroup(mu.range = c(-1, 1, -1, 1), n.obs = 30, wishSigmaScale = 1) 8 | } 9 | \arguments{ 10 | \item{mu.range}{a vector of length 4, specifying the mix and max x and y 11 | values to sample means from. Group means are sampled from a uniform 12 | distribution within this range. The first two entries are the min and max of 13 | the x-axis, and the second two the min and max of the y-axis.} 14 | 15 | \item{n.obs}{the number of observations to draw per group. Defaults to 30.} 16 | 17 | \item{wishSigmaScale}{is a simple multiplier for the call to 18 | \code{\link[stats:rWishart]{stats::rWishart()}} which scales the diagonal sigma matrix using 19 | \code{wishSigmaScale * diag(2)}.} 20 | } 21 | \value{ 22 | A data.frame object comprising a column of x and y data, a group 23 | identifying column and a community identifying column, all of which are 24 | numeric. 25 | } 26 | \description{ 27 | This function simulates data for a single group by sampling from a normal 28 | distribution with different means for each group within some specified 29 | boundaries. 30 | } 31 | \examples{ 32 | # generateSiberGroup() 33 | 34 | } 35 | -------------------------------------------------------------------------------- /man/plotGroupEllipses.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotGroupEllipses.R 3 | \name{plotGroupEllipses} 4 | \alias{plotGroupEllipses} 5 | \title{Adds ellipses to an existing plot for each of your groups} 6 | \usage{ 7 | plotGroupEllipses(siber, plot.args = list(), iso.order = c(1, 2), ...) 8 | } 9 | \arguments{ 10 | \item{siber}{a siber object as created by createSiberObject} 11 | 12 | \item{plot.args}{a list of plotting arguments for passing to 13 | \code{\link[=addEllipse]{addEllipse()}}. See \code{\link[=addEllipse]{addEllipse()}} for details of the 14 | options, and you can also pass additional arguments such as line widths and 15 | styles. See also the demonstration scripts for examples of use.} 16 | 17 | \item{iso.order}{a vector of length 2, either \code{c(1,2)} or \code{c(2,1)}. 18 | The order determines which of the columns of raw data are plotted on the x 19 | (1) or y (2) axis. N.B. this will be deprecated in a future release, and 20 | plotting order will be achieved at point of data-entry.} 21 | 22 | \item{...}{additional arguments to be passed to \code{\link[=addEllipse]{addEllipse()}}.} 23 | } 24 | \value{ 25 | Ellipses, drawn as lines on an existing figure. 26 | } 27 | \description{ 28 | This function loops over each community and group within, and plots an 29 | ellipse around the data. See demonstration scripts for more examples. 30 | } 31 | -------------------------------------------------------------------------------- /man/siberKapow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siberKapow.R 3 | \name{siberKapow} 4 | \alias{siberKapow} 5 | \title{Calculates the boundary of a union of ellipses} 6 | \usage{ 7 | siberKapow( 8 | dtf, 9 | isoNames = c("iso1", "iso2"), 10 | group = "group", 11 | pEll = stats::pchisq(1, df = 2) 12 | ) 13 | } 14 | \arguments{ 15 | \item{dtf}{a data.frame object comprising bivariate data as a requirement, 16 | and possibly other variables too but these are currently ignored.} 17 | 18 | \item{isoNames}{a character vector of length 2 providing the names of the 19 | variables containing the x and y data respectively.} 20 | 21 | \item{group}{a character vector of length 1 providing the name of the 22 | grouping variable on which to calculate the KAPOW ellipse.} 23 | 24 | \item{pEll}{the probability ellipse to draw for each group. Defaults to the 25 | Standard Ellipse with \code{pEll = stats::pchisq(1, df = 2)}.} 26 | } 27 | \value{ 28 | an object of class \code{spatstat.geom::owin} containing the numerically calculated 29 | ellipses and their union along with the raw ellipse boundaries in both raw 30 | and \code{spatstat.geom::owin} format. 31 | } 32 | \description{ 33 | Intended to calculate the area of an ellipse as a proportion of a group of 34 | ellipses represented by their union, i.e. the total area encompassed by all 35 | ellipses superimposed. 36 | } 37 | -------------------------------------------------------------------------------- /R/posteriorSEA.R: -------------------------------------------------------------------------------- 1 | #' Calculate the SEA based on a posterior distribution of Sigma 2 | #' 3 | #' This function loops over each posterior draw of a single group's Bayesian 4 | #' bivariate ellipse and calculates the Standard Ellipse Area (SEA) for each 5 | #' draw, thereby generating a distribution of SEA estimates. Not intended for 6 | #' direct calling outside of [siberEllipses()]. 7 | #' 8 | #' @param post a matrix of posterior covariance matrices and mean estimates for 9 | #' a bivariate ellipse. In SIBER, this is typically one list element of the 10 | #' object returned by [siberMVN()]. 11 | #' 12 | #' @return A vector of posterior Bayesian Standard Ellipse Areas (SEA_B) 13 | #' 14 | #' @export 15 | #' 16 | 17 | 18 | posteriorSEA <- function (post) { 19 | 20 | # Function to calculate the SEA based on a posterior distribution of Sigma 21 | 22 | 23 | Nobs <- nrow(post) 24 | 25 | SEA.B <- numeric(Nobs) 26 | 27 | # loop over all posterior draws 28 | for (i in 1:Nobs) { 29 | 30 | # extract the covariance matrix parameters 31 | estS <- post[i, 1:4] 32 | 33 | # reshape to matrix of 2x2 34 | dim(estS) <- c(2, 2) 35 | 36 | # calculate the corresponding standard ellipse area 37 | # AJ change from popSEA to sigmaSEA 38 | SEA.B[i] <- sigmaSEA(estS)$SEA 39 | 40 | } # end loop over posterior draws 41 | 42 | 43 | return(SEA.B) 44 | 45 | } 46 | -------------------------------------------------------------------------------- /man/laymanMetrics.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/laymanmetrics.R 3 | \name{laymanMetrics} 4 | \alias{laymanMetrics} 5 | \title{Calculates the 6 Layman metrics on a vector of x and y data} 6 | \usage{ 7 | laymanMetrics(x, y) 8 | } 9 | \arguments{ 10 | \item{x}{a vector of locations in the x-axis direction.} 11 | 12 | \item{y}{a vector of locations in the y-axis direction.} 13 | } 14 | \value{ 15 | A vector of the 6 Layman metrics of dX_range, dY_range, TA, 16 | CD, MNND and SDNND 17 | } 18 | \description{ 19 | This function takes two x and y vectors, and calculates the corresponding 20 | 6 Layman metrics based on these points. Note that for generality, the 21 | original metrics of dC_range and dN_range have been renamed dX_range and 22 | dY_range respectively. These modified names represent the x and y axes in 23 | terms of the order in which the data have been entered, and relate typically 24 | to how one plots the data. These x and y vectors could represent the means 25 | of the group members comprising a community as is preferred under the SIBER 26 | model framework. However, one could use them to calculate the point estimates 27 | of the 6 Layman metrics for an entire group of data. In fact, you are free 28 | to pass this function any set of \code{x} and \code{y} data you wish. 29 | } 30 | \examples{ 31 | x <- stats::runif(10) 32 | y <- stats::runif(10) 33 | laymanMetrics(x, y) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/specificCentroidVectors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/specificCentroidVectors.R 3 | \name{specificCentroidVectors} 4 | \alias{specificCentroidVectors} 5 | \title{Calculate the pairwise distances and angles describing the difference between 6 | centroids of paired groups} 7 | \usage{ 8 | specificCentroidVectors(centroids, do.these, upper = TRUE, do.plot = TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{centroids}{the list containing distance and angle matrices as returned 12 | by \code{\link[=siberCentroids]{siberCentroids()}}.} 13 | 14 | \item{do.these}{a character vector of the pattern used to find paired matches in 15 | the matrix of all comparisons. Usually the group names within any of the 16 | communities.} 17 | 18 | \item{upper}{a logical determining whether to plot the upper or lower 19 | triangle of angles. Defaults to TRUE which is the upper triangle and 20 | returns the angle from the second ellipse to the first by centering on the 21 | first centroid.} 22 | 23 | \item{do.plot}{a logical indicating whether plotting should be done or not. 24 | Defaults to TRUE.} 25 | 26 | \item{...}{additional arguments to pass onwards, not currently implemented.} 27 | } 28 | \value{ 29 | A nice plot. You can get the corresponding matrices used to generate 30 | the plots if you ask for it nicely: thedata <- 31 | plotCentroidVectors(centroids) 32 | } 33 | \description{ 34 | Plots the posterior densities 35 | } 36 | -------------------------------------------------------------------------------- /man/sigmaSEA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sigmaSEA.R 3 | \name{sigmaSEA} 4 | \alias{sigmaSEA} 5 | \title{Calculate metrics corresponding to the Standard Ellipse based on a 6 | covariance matrix} 7 | \usage{ 8 | sigmaSEA(sigma) 9 | } 10 | \arguments{ 11 | \item{sigma}{a 2x2 covariance ellipse.} 12 | } 13 | \value{ 14 | A list comprising the following metrics for summarising the Standard 15 | Ellipse 16 | \itemize{ 17 | \item \code{SEA} the Standard Ellipse Area (not sample size corrected). 18 | \item \code{eccentricity} a measure of the elongation of the ellipse. 19 | \item \code{a} the length of the semi-major axis. 20 | \item \code{b} the length of the semi-minor axis. 21 | } 22 | } 23 | \description{ 24 | This function takes a covariance 2x2 matrix Sigma and returns various 25 | metrics relating to the corresponding Standard Ellipse. The function is 26 | limited to the 2-dimensional case, as many of the ancillary summary 27 | statistics are not defined for higher dimensions (e.g. eccentricity). 28 | } 29 | \section{Note}{ 30 | This function is currently based on the eigenvalue and 31 | eigenvector approach which is more flexible for higher dimensional problems 32 | method for calculating the standard ellipse, and replaces the parametric 33 | method used previously in siar and siber. 34 | } 35 | 36 | \examples{ 37 | # A perfect circle 38 | sigma <- matrix( c(1, 0, 0, 1), 2, 2) 39 | sigmaSEA(sigma) 40 | 41 | } 42 | -------------------------------------------------------------------------------- /R/communityMetricsML.R: -------------------------------------------------------------------------------- 1 | #' Calculate the point estimates of the Layman metrics for each community 2 | #' 3 | #' This function loops over each community, determines the centre of mass 4 | #' (centroid) of each of the groups comprising the community using the basic 5 | #' [base::mean()] function independently on the marginal x and y vectors, 6 | #' and calculates the corresponding 6 Layman metrics based on these points. 7 | #' 8 | #' @param siber a siber object as created by [createSiberObject()]. 9 | #' 10 | #' @return A 6 x m matrix of the 6 Layman metrics of dX_range, dY_range, TA, 11 | #' CD, MNND and SDNND in rows, for each community by column 12 | #' 13 | #' @examples 14 | #' data(demo.siber.data) 15 | #' my.siber.data <- createSiberObject(demo.siber.data) 16 | #' communityMetricsML(my.siber.data) 17 | #' 18 | #' @export 19 | 20 | communityMetricsML <- function(siber) { 21 | 22 | out <- matrix(NA, nrow = 6, ncol = siber$n.communities, 23 | dimnames = list(c("dY_range", "dX_range", 24 | "TA", "CD", "MNND", "SDNND"), 25 | siber$all.communities 26 | ) 27 | ) 28 | 29 | for (i in 1:siber$n.communities){ 30 | 31 | tmp <- laymanMetrics(siber$ML.mu[[i]][1,1,] , 32 | siber$ML.mu[[i]][1,2,]) 33 | 34 | 35 | out[,i] <- tmp$metrics 36 | } 37 | 38 | return(out) 39 | 40 | } 41 | 42 | 43 | -------------------------------------------------------------------------------- /man/ellipseBackTransform.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ellipseBackTransform.R 3 | \name{ellipseBackTransform} 4 | \alias{ellipseBackTransform} 5 | \title{Back-transform a z-score siber ellipse to original location and scale.} 6 | \usage{ 7 | ellipseBackTransform(jags.output, siber, idx.community, idx.group) 8 | } 9 | \arguments{ 10 | \item{jags.output}{a mcmc.list object of posterior samples created by 11 | \code{\link[rjags:rjags-package]{rjags::rjags()}}. In siber this is created typically by \code{\link[=fitEllipse]{fitEllipse()}}} 12 | 13 | \item{siber}{a siber object as created by createSiberObject.} 14 | 15 | \item{idx.community}{an integer specifying which community to back-transform.} 16 | 17 | \item{idx.group}{an integer specifying which group to back-transform.} 18 | } 19 | \value{ 20 | A 6 x n matrix representing the back-transformed posterior 21 | distributions of the bivariate normal distribution for a specified group 22 | within a specified community, where n is the number of 23 | posterior draws in the saved sample. The first four columns are the 24 | covariance matrix Sigma in vector format. This vector converts to the 25 | covariance matrix as \code{matrix(v[1:4], nrow = 2, ncol = 2)}. The 26 | remaining two columns are the back-transformed means. 27 | } 28 | \description{ 29 | Back-transforms a bivariate siber ellipse fitted to z-scored data to the 30 | original location and scale. Not intended for direct call by users. 31 | } 32 | -------------------------------------------------------------------------------- /tmp/layman-metrics-on-each-group.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Layman metrics on each group" 3 | output: html_notebook 4 | --- 5 | 6 | 7 | ```{r setup} 8 | 9 | library(SIBER) 10 | library(tidyverse) 11 | 12 | ``` 13 | 14 | 15 | ```{r example} 16 | 17 | data(demo.siber.data) 18 | 19 | # add a column that uniquely identifies each group 20 | demo.siber.data <- demo.siber.data %>% 21 | mutate(grp_unq = paste(group, community, sep = "_")) 22 | 23 | 24 | # define a function to extract the relevant information from laymanMetrics() 25 | # and return as a data.frame 26 | foo <- function(dd){ 27 | tmp <- laymanMetrics(dd$iso1, dd$iso2) 28 | str(dd) 29 | data.frame(as.list(c(tmp$metrics, TA = tmp$hull$TA))) 30 | } 31 | 32 | # apply function laymanMetrics over each unique group 33 | lay_grp <- demo.siber.data %>% 34 | # split the data into a list with each entry being 35 | split(.$group) %>% 36 | # apply the function `foo` over all the list entries 37 | map( ~foo(.)) %>% 38 | # bind the data.frames together and create a new 39 | # factor column using the key 40 | bind_rows(., .id = "Group_Community") 41 | 42 | # its not a pretty print out but this looks right 43 | print(lay_grp) 44 | 45 | 46 | 47 | # Tried to implement this via group_by() syntax but am failing 48 | # because i cant pass the names (keys) of the grouped subsets which 49 | # then means i cant bind_rows() at the end. 50 | # 51 | # aj <- demo.siber.data %>% group_by(group, community) %>% 52 | # group_map(~foo(.), keep = TRUE) #%>% eval(names(.) <- ) 53 | 54 | ``` 55 | 56 | 57 | -------------------------------------------------------------------------------- /tmp/StandardEllipseCalc.R: -------------------------------------------------------------------------------- 1 | # Some code for Andrew J to calculate standard ellipses 2 | 3 | # Use the mvtnorm package to simulate some data 4 | library(mvtnorm) 5 | 6 | # Generate a load of data 7 | mu = c(1,2) 8 | Sigma = matrix(c(1,0.8,0.8,2),2,2) 9 | n = 200 10 | X = rmvnorm(n,mu,Sigma) 11 | 12 | # Plot the data 13 | plot(X) 14 | 15 | # Now standardise it by calculating Z = Sigma^{-1/2}%*%(X-mu) for each pair. Must be a quicker way of doing this! 16 | # The standardised data should have mean 0 and var matrix I 17 | e = eigen(Sigma) 18 | SigSqrt = e$vectors %*% diag(sqrt(e$values)) %*% t(e$vectors) 19 | myfun = function(x) { 20 | return(solve(SigSqrt,x-mu)) 21 | } 22 | Z = t(apply(X,1,myfun)) 23 | plot(Z) 24 | 25 | # Generate some points uniformly on a circle 26 | gencircle = function(n,r) { 27 | theta = seq(0,2*pi,length=n) 28 | x = r*cos(theta) 29 | y = r*sin(theta) 30 | return(cbind(x,y)) 31 | } 32 | circ = gencircle(100,1) 33 | plot(circ) 34 | 35 | # Now Generate points on disc of radius e.g. sqrt(qchisq(0.95,df=2)) for a percentage 36 | p=0.9 37 | circ = gencircle(100,sqrt(qchisq(p,df=2))) 38 | myfun2 = function(x) { 39 | return(SigSqrt%*%x+mu) 40 | } 41 | standard.ellipse = t(apply(circ,1,myfun2)) 42 | plot(standard.ellipse) 43 | 44 | # Create a nicer plot which includes the original data to check that things are inside 45 | plot(X) 46 | lines(standard.ellipse,col='red',lwd=3) 47 | 48 | # Check that 95% of points are inside it 49 | inside = Z[,1]^2+Z[,2]^2 < qchisq(p,df=2) 50 | points(X[inside,],col='red',pch=19) 51 | prop.inside = sum(inside)/length(inside) 52 | print(prop.inside) 53 | 54 | 55 | -------------------------------------------------------------------------------- /tmp/test-points-within-ellipsoid.R: -------------------------------------------------------------------------------- 1 | # script to check the calculation of angle and area using the atan rather than 2 | # asin() method. 3 | 4 | set.seed(2) 5 | 6 | # n random numbers 7 | n <- 20 8 | 9 | # ------------------------------------------------------------------------------ 10 | # generate mvtnorm numbers 11 | 12 | # means 13 | mu <- c(0,0,0) 14 | 15 | # sigma from an inverse wishart distribution 16 | S <- MCMCpack::riwish(length(mu), diag(length(mu))) 17 | 18 | # multivariate normal Y 19 | Y <- mvtnorm::rmvnorm(n = n, mean = mu, sigma = S) 20 | 21 | pairs(Y, lower.panel = NULL) 22 | 23 | # ------------------------------------------------------------------------------ 24 | 25 | # calculate covariance matrix of the data 26 | S.samp <- cov(Y) 27 | 28 | # sample means 29 | mu.samp <- colMeans(Y) 30 | 31 | # eigen values and vectors of the data 32 | eig <- eigen(S.samp) 33 | 34 | # inverse of sigma 35 | SigSqrt = eig$vectors %*% diag(sqrt(eig$values)) %*% t(eig$vectors) 36 | 37 | # function to rotate and translate any data onto this orientation 38 | myfun = function(x) { 39 | return(solve(SigSqrt, x-mu.samp)) 40 | } 41 | 42 | # ------------------------------------------------------------------------------ 43 | # some points to check for inside or out 44 | test.these <- matrix(c(0, 0, 0, 45 | 4, -10, 0), 46 | ncol = length(mu), 47 | nrow = 2, 48 | byrow = TRUE) 49 | 50 | # transform these points on the ellipse coordinates 51 | Z <- t(apply(test.these,1,myfun)) 52 | 53 | # and test they are within the radius 54 | inside = rowSums(Z ^ 2) < qchisq(0.95,df=2) 55 | 56 | 57 | -------------------------------------------------------------------------------- /man/createSiberObject.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/createSiberObject.R 3 | \name{createSiberObject} 4 | \alias{createSiberObject} 5 | \title{Read in SIBER format data and generate the SIBER object} 6 | \arguments{ 7 | \item{data.in}{Specified In a basic R data.frame or matrix comprising 4 8 | columns. The first two of which are typically isotope tracers, then the 9 | third is a column that indicates the group membership, and the fourth 10 | column indicates the community membership of an observation. Communities 11 | labels should be entered as sequential numbers. As of v2.0.1 group labels 12 | can be entered as strings and/or numbers and need not be sequential.} 13 | } 14 | \value{ 15 | A siber list object, that contains data that helps with various model 16 | fitting and plotting. 17 | \itemize{ 18 | \item \code{original.data} The original data as 19 | passed into this function 20 | \item \code{iso.summary} The max, min, mean and 21 | median of the isotope data useful for plotting 22 | \item \code{sample.sizes} The 23 | number of observations tabulated by group and community 24 | \item \code{raw.data} A list object of length equal to the number of communities 25 | } 26 | } 27 | \description{ 28 | This function takes raw isotope data and creates a SIBER object which 29 | contains information in a structured manner that enables other functions to 30 | loop over groups and communities, fit Bayesian ellipses, and afterwards, 31 | generate various plots, and additional analyses on the posterior 32 | distributions. 33 | } 34 | \examples{ 35 | data(demo.siber.data) 36 | my.siber.data <- createSiberObject(demo.siber.data) 37 | names(my.siber.data) 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/plotGroupHulls.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotGroupHulls.R 3 | \name{plotGroupHulls} 4 | \alias{plotGroupHulls} 5 | \title{Plots illustrative convex hulls for each group within all communities} 6 | \usage{ 7 | plotGroupHulls(siber, plot.args = NULL, iso.order = c(1, 2), ...) 8 | } 9 | \arguments{ 10 | \item{siber}{a siber object as created by createSiberObject} 11 | 12 | \item{plot.args}{a list of plotting arguments for passing to 13 | \code{\link[graphics:lines]{graphics::lines()}}. See \code{\link[graphics:lines]{graphics::lines()}} for 14 | details of the options. See also the demonstration scripts for examples of 15 | use.} 16 | 17 | \item{iso.order}{a vector of length 2, either \code{c(1,2)} or\code{c(2,1)}. 18 | The order determines which of the columns of raw data are plotted on the x 19 | (1) or y (2) axis. N.B. this will be deprecated in a future release, and 20 | plotting order will be achieved at point of data-entry.} 21 | 22 | \item{...}{additional arguments to be passed to \code{\link[=addEllipse]{addEllipse()}}.} 23 | } 24 | \value{ 25 | A series of convex hulls added to an existing plot. 26 | } 27 | \description{ 28 | This function loops over each community and group within, and plots a 29 | convex hull around the data. N.B. use of convex hulls to compare isotopic 30 | niche width among groups within or between communities is not recommended 31 | owing to strong sample size bias. Use of ellipse area is recommended instead. 32 | This feature is provided for illustrative purposes only, and because some 33 | people have expressed a desire for this feature for figure generation. See 34 | demonstration scripts for more examples. 35 | } 36 | -------------------------------------------------------------------------------- /man/generateSiberCommunity.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generateSiberCommunity.R 3 | \name{generateSiberCommunity} 4 | \alias{generateSiberCommunity} 5 | \title{A utility function to simulate a single community comprised of groups} 6 | \usage{ 7 | generateSiberCommunity( 8 | n.groups = 3, 9 | community.id = 1, 10 | n.obs = 30, 11 | mu.range = c(-1, 1, -1, 1), 12 | wishSigmaScale = 1 13 | ) 14 | } 15 | \arguments{ 16 | \item{n.groups}{the an integer specifying the number of groups to simulate. 17 | Defaults to 3.} 18 | 19 | \item{community.id}{an integer identifying the community's ID number. 20 | Defaults to 1.} 21 | 22 | \item{n.obs}{the number of observations to draw per group.} 23 | 24 | \item{mu.range}{a vector of length 4, specifying the mix and max x and y 25 | values to sample means from. Group means are sampled from a uniform 26 | distribution within this range. The first two entries are the min and max of 27 | the x-axis, and the second two the min and max of the y-axis. Defaults to 28 | \code{c(-1, 1, -1, 1)}.} 29 | 30 | \item{wishSigmaScale}{is a simple multiplier for the call to 31 | \code{\link[stats:rWishart]{stats::rWishart()}} which scales the diagonal sigma matrix using 32 | \code{wishSigmaScale * diag(2)} that is ultimately passed on to 33 | \code{generateSiberGroup}.} 34 | } 35 | \value{ 36 | A data.frame object comprising a column of x and y data, a group 37 | identifying column and a community identifying column, all of which are 38 | numeric. 39 | } 40 | \description{ 41 | This function simulates data for a single community by sampling from a normal 42 | distribution with different means for each group within some specified 43 | boundaries. 44 | } 45 | -------------------------------------------------------------------------------- /man/generateSiberData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generateSiberData.R 3 | \name{generateSiberData} 4 | \alias{generateSiberData} 5 | \title{A utility function to simulate isotope data for several communities} 6 | \usage{ 7 | generateSiberData( 8 | n.groups = 3, 9 | n.communities = 2, 10 | n.obs = 30, 11 | mu.range = c(-1, 1, -1, 1), 12 | wishSigmaScale = 1 13 | ) 14 | } 15 | \arguments{ 16 | \item{n.groups}{the an integer specifying the number of groups per community 17 | to simulate. Defaults to 3.} 18 | 19 | \item{n.communities}{the number of communities to simulate data for. Defaults 20 | to 2.} 21 | 22 | \item{n.obs}{the number of observations to draw per group.} 23 | 24 | \item{mu.range}{a vector of length 4, specifying the mix and max x and y 25 | values to sample means from. Group means are sampled from a uniform 26 | distribution within this range. The first two entries are the min and max 27 | of the x-axis, and the second two the min and max of the y-axis. Defaults 28 | to \code{c(-1, 1, -1, 1)}.} 29 | 30 | \item{wishSigmaScale}{is a simple multiplier for the call to 31 | \code{\link[stats:rWishart]{stats::rWishart()}} which scales the diagonal sigma matrix using 32 | \code{wishSigmaScale * diag(2)} that is ultimately passed on to 33 | \code{generateSiberGroup}.} 34 | } 35 | \value{ 36 | A data.frame object comprising a column of x and y data, a group 37 | identifying column and a community identifying column, all of which are 38 | numeric. 39 | } 40 | \description{ 41 | This function simulates data for a specified number of communities. It is a 42 | wrapper function for \code{\link[=generateSiberCommunity]{generateSiberCommunity()}}. 43 | } 44 | \examples{ 45 | generateSiberData() 46 | 47 | } 48 | -------------------------------------------------------------------------------- /R/plotGroupEllipses.R: -------------------------------------------------------------------------------- 1 | #' Adds ellipses to an existing plot for each of your groups 2 | #' 3 | #' This function loops over each community and group within, and plots an 4 | #' ellipse around the data. See demonstration scripts for more examples. 5 | #' 6 | #' @param siber a siber object as created by createSiberObject 7 | #' @param plot.args a list of plotting arguments for passing to 8 | #' [addEllipse()]. See [addEllipse()] for details of the 9 | #' options, and you can also pass additional arguments such as line widths and 10 | #' styles. See also the demonstration scripts for examples of use. 11 | #' @param iso.order a vector of length 2, either `c(1,2)` or `c(2,1)`. 12 | #' The order determines which of the columns of raw data are plotted on the x 13 | #' (1) or y (2) axis. N.B. this will be deprecated in a future release, and 14 | #' plotting order will be achieved at point of data-entry. 15 | #' @param ... additional arguments to be passed to [addEllipse()]. 16 | #' 17 | #' @return Ellipses, drawn as lines on an existing figure. 18 | #' @export 19 | 20 | 21 | 22 | plotGroupEllipses <- function(siber, plot.args = list(), iso.order = c(1,2), 23 | ...) { 24 | 25 | # iso.order is used to relocate and reorientate the covariance matrix 26 | # in the call to addEllipse below. 27 | x <- iso.order[1] 28 | y <- iso.order[2] 29 | 30 | for (i in 1:siber$n.communities){ 31 | 32 | for (j in 1:siber$n.groups[2,i]){ 33 | 34 | do.call('addEllipse', 35 | c(list(mu = siber$ML.mu[[i]][,c(x,y),j], 36 | sigma = siber$ML.cov[[i]][c(x,y),c(x,y),j]), 37 | m = siber$sample.sizes[i,j], 38 | plot.args, 39 | col = siber$group.names[[i]][j], 40 | ...)) 41 | 42 | } # end loop over groups 43 | }# end loop over communities 44 | } # end function -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Update submission 2 | 3 | * this is a minor update to address a request to fix an issue on newer OSX builds that cause an error when rendering the unicode permille symbol 'U+2030'. This have been fixed by switching to the text label "permille" when building the graphics objects that require it. 4 | 5 | 6 | ### Previous NOTES 7 | 8 | * Found the following URLs which should use \doi (with the DOI name only): 9 | File 'mongoose.Rd': 10 | https://doi.org/10.1111/ele.12933 - FIXED 11 | 12 | ## R CMD check --as-cran results 13 | 14 | 0 errors | 0 warnings | 0 notes 15 | 16 | ## Additional Test environments 17 | 18 | * local OS X 13.6 install, R 4.3.1. Apple clang version 14.0.3 (clang-1403.0.22.14.1) 19 | GNU Fortran (GCC) 12.2.0 - OK 20 | * OSX via `devtools::check_mac_release()` 21 | * r-release-macosx-arm64|4.3.0|macosx|macOS 13.3.1 (22E261)|Mac mini|Apple M1||en_US.UTF-8|macOS 11.3|clang-1403.0.22.14.1|GNU Fortran (GCC) 12.2.0 - OK 22 | * win-builder 23 | * R devel - Windows Server 2022 x64 (build 20348) - OK 24 | * R release - OK 25 | * R-hub 26 | * Debian Linux, R-devel, clang, ISO-8859-15 locale - OK 27 | * Ubuntu Linux 20.04.1 LTS, R-release, GCC 28 | * NOTE: checking HTML version of manual ... NOTE 29 | Skipping checking HTML validation: no command 'tidy' found 30 | * Maintainer states that this NOTE appears to arise owing to lack of 3rd party software on the server. These same HTML checks pass on other OS installs. 31 | * Maintainer states that several other R-hub based OS failed testing at vignette building stage owing to lack of available 3rd party installation of JAGS including Fedora Linux and Windows Server 2022. 32 | 33 | 34 | ## Downstream dependencies 35 | 36 | Checked with `revdepcheck` 37 | * Maintainer states: ongoing problems with local gcc installation on Apple M2 chipset prevents this package from running at this time. 38 | 39 | -------------------------------------------------------------------------------- /man/plotCommunityHulls.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotCommunityHulls.R 3 | \name{plotCommunityHulls} 4 | \alias{plotCommunityHulls} 5 | \title{Adds convex hulls to each community to an existing plot} 6 | \usage{ 7 | plotCommunityHulls( 8 | siber, 9 | plot.args = list(col = 1, lty = 2), 10 | iso.order = c(1, 2), 11 | ... 12 | ) 13 | } 14 | \arguments{ 15 | \item{siber}{a siber object as created by createSiberObject.R} 16 | 17 | \item{plot.args}{a list of plotting arguments with the following suggested, 18 | but non-exhaustive inputs. Additional plotting arguments for passing to the 19 | internal call to \code{\link[graphics:plot.default]{graphics::plot()}} can either be specified here, 20 | or as additional arguments under the \code{...} method. 21 | \itemize{ 22 | \item \code{col} the color of the lines of the convex hull. See \code{\link[graphics:lines]{graphics::lines()}} 23 | for more details. 24 | \item \code{lty} the line type of the convex hull.See \code{\link[graphics:lines]{graphics::lines()}} 25 | for more details. 26 | \item \code{lwd} the line width of the convex hulls. See \code{\link[graphics:lines]{graphics::lines()}} 27 | for more details. 28 | }} 29 | 30 | \item{iso.order}{a vector of length 2, either c(1,2) or c(2,1). The order 31 | determines which of the columns of raw data are plotted on the x (1) or y 32 | (2) axis. N.B. this will be deprecated in a future release, and plotting 33 | order will be achieved at point of data-entry.} 34 | 35 | \item{...}{additional arguments for passing to \code{\link[graphics:plot.default]{graphics::plot()}}.} 36 | } 37 | \value{ 38 | Convex hulls, drawn as lines on an existing figure. 39 | } 40 | \description{ 41 | This function loops over each community and plots the convex hull 42 | based on the centres of each of the groups that make up the community. See 43 | the demonstration scripts for example implementation. 44 | } 45 | -------------------------------------------------------------------------------- /R/sigmaSEA.R: -------------------------------------------------------------------------------- 1 | #' Calculate metrics corresponding to the Standard Ellipse based on a 2 | #' covariance matrix 3 | #' 4 | #' This function takes a covariance 2x2 matrix Sigma and returns various 5 | #' metrics relating to the corresponding Standard Ellipse. The function is 6 | #' limited to the 2-dimensional case, as many of the ancillary summary 7 | #' statistics are not defined for higher dimensions (e.g. eccentricity). 8 | #' 9 | #' @section Note: This function is currently based on the eigenvalue and 10 | #' eigenvector approach which is more flexible for higher dimensional problems 11 | #' method for calculating the standard ellipse, and replaces the parametric 12 | #' method used previously in siar and siber. 13 | #' 14 | #' @param sigma a 2x2 covariance ellipse. 15 | #' 16 | #' @return A list comprising the following metrics for summarising the Standard 17 | #' Ellipse 18 | #' 19 | #' * `SEA` the Standard Ellipse Area (not sample size corrected). 20 | #' 21 | #' * `eccentricity` a measure of the elongation of the ellipse. 22 | #' 23 | #' * `a` the length of the semi-major axis. 24 | #' 25 | #' * `b` the length of the semi-minor axis. 26 | #' 27 | #' 28 | #' @examples 29 | #' # A perfect circle 30 | #' sigma <- matrix( c(1, 0, 0, 1), 2, 2) 31 | #' sigmaSEA(sigma) 32 | #' 33 | #' @export 34 | #' 35 | 36 | 37 | sigmaSEA <- function(sigma){ 38 | 39 | eig <- eigen(sigma) 40 | 41 | a <- sqrt(eig$values[1]) 42 | b <- sqrt(eig$values[2]) 43 | 44 | # As of v2.0.4 I have replaced the asin() line with atan which 45 | # returns the angle of correct sign due to the inclusion of the quotient 46 | # of the vectors. 47 | theta <- atan(eig$vectors[2,1] / eig$vectors[1,1]) 48 | 49 | SEA <- pi*a*b 50 | 51 | 52 | out <- list() 53 | out$SEA <- pi*a*b 54 | out$eccentricity <- sqrt(1-((b^2)/(a^2))) 55 | out$a <- a 56 | out$b <- b 57 | out$theta <- theta 58 | 59 | return(out) 60 | } -------------------------------------------------------------------------------- /R/generateSiberGroup.R: -------------------------------------------------------------------------------- 1 | #' A utility function to simulate a single group of data 2 | #' 3 | #' This function simulates data for a single group by sampling from a normal 4 | #' distribution with different means for each group within some specified 5 | #' boundaries. 6 | #' 7 | #' @param mu.range a vector of length 4, specifying the mix and max x and y 8 | #' values to sample means from. Group means are sampled from a uniform 9 | #' distribution within this range. The first two entries are the min and max of 10 | #' the x-axis, and the second two the min and max of the y-axis. 11 | #' @param n.obs the number of observations to draw per group. Defaults to 30. 12 | #' @param wishSigmaScale is a simple multiplier for the call to 13 | #' [stats::rWishart()] which scales the diagonal sigma matrix using 14 | #' `wishSigmaScale * diag(2)`. 15 | #' 16 | #' @return A data.frame object comprising a column of x and y data, a group 17 | #' identifying column and a community identifying column, all of which are 18 | #' numeric. 19 | #' 20 | #' @examples 21 | #' # generateSiberGroup() 22 | #' 23 | #' @export 24 | 25 | 26 | # a function to generate a single group 27 | generateSiberGroup <- function (mu.range = c(-1, 1, -1, 1), n.obs = 30, 28 | wishSigmaScale = 1) { 29 | 30 | # pull a random set of means from the appropriate range 31 | # Code allows for different ranges for each isotope. 32 | mu <- numeric(2) 33 | mu[1] <- stats::runif(1, mu.range[1], mu.range[2]) 34 | mu[2] <- stats::runif(1, mu.range[3], mu.range[4]) 35 | 36 | # pull a precision matrix from the wishart distribution and invert it to 37 | # get the corresponding covariance matrix. 38 | sigma <- solve(matrix(stats::rWishart(1, 2, 39 | wishSigmaScale*diag(2)), 40 | nrow = 2, ncol = 2)) 41 | 42 | # the data are random normal 43 | y <- mnormt::rmnorm(n.obs, mu, sigma) 44 | 45 | # output the simulated data for this group 46 | return(y) 47 | } 48 | -------------------------------------------------------------------------------- /R/bayesianLayman.R: -------------------------------------------------------------------------------- 1 | #' Calculate Layman metrics on Bayesian posterior samples of a community 2 | #' 3 | #' This function loops over the posterior distribution of group means within 4 | #' each community and generates the corresponding Bayesian estimate of the 6 5 | #' Layman metrics. 6 | #' 7 | #' @param mu.post a list of length n.communities, with each list element 8 | #' containing the estimated means of the groups comprising that community. The 9 | #' typical workflow to generate mu.post follows. The 10 | #' Bayesian ellipses are fitted using [siberEllipses()], then the 11 | #' posterior means (centre of mass of each group) is extracted using 12 | #' [extractPosteriorMeans()]. See the example below. 13 | #' 14 | #' @return A list of length n.communities, with each element containing a 15 | #' matrix of 6 columns, each representing the Bayesian posterior distribution 16 | #' of the 6 Layman metrics for each of the posterior draws recorded by the 17 | #' fitting process (i.e. which determines the number of rows in this matrix). 18 | #' 19 | #' @export 20 | 21 | 22 | bayesianLayman <- function(mu.post) { 23 | 24 | 25 | nr <- dim(mu.post[[1]])[1] 26 | 27 | layman.B <- list() 28 | 29 | 30 | # loop over communities 31 | for (k in 1:length(mu.post)) { 32 | 33 | 34 | layman.B[[k]] <- matrix(NA, nrow = nr, ncol = 6) 35 | 36 | 37 | # AJ - IM PRETTY SURE THESE ARE NO LONGER REQUIRED 38 | # some vectors to store layman metrics 39 | # dNr <- numeric(nr) 40 | # dCr <- numeric(nr) 41 | # TA <- numeric(nr) 42 | # CD <- numeric(nr) 43 | # MNND <- numeric(nr) 44 | # SDNND <- numeric(nr) 45 | 46 | 47 | for (i in 1:nr) { 48 | 49 | layman <- laymanMetrics(mu.post[[k]][i,1,], mu.post[[k]][i,2,]) 50 | 51 | layman.B[[k]][i,] <- layman$metrics 52 | 53 | } 54 | 55 | 56 | # add in the column names 57 | colnames(layman.B[[k]]) <- names(layman$metrics) 58 | 59 | } 60 | 61 | return(layman.B) 62 | } 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /R/kapow.R: -------------------------------------------------------------------------------- 1 | #' KAPOW! 2 | #' 3 | #' This function packs a punch and makes a pretty figure. 4 | #' 5 | #' @param cd sets the random seed to this 6 | #' @param ng the number of ellipses to draw 7 | #' @param n the number of data points to simulate per group, but never displayed 8 | #' @param sc the scaling factor the rwishart sigma called by 9 | #' [stats::rWishart()] 10 | #' @param do.plot a logical indicating whether the plot should be printed 11 | #' (defaults to TRUE). 12 | #' 13 | #' @return A ggplot object 14 | #' 15 | #' @import ggplot2 16 | #' @import dplyr 17 | #' @importFrom magrittr "%>%" 18 | #' 19 | #' @export 20 | 21 | kapow <- function(cd = 7, ng = 25, n = 50, sc = 10, do.plot = TRUE) { 22 | 23 | # 7 seem pretty good with the other defaults above. 24 | set.seed(cd) 25 | 26 | Y <- generateSiberCommunity(n.groups = ng, n.obs = n, wishSigmaScale = sc) 27 | 28 | # dplyr version causes NOTE to be generated with 29 | # "no visible binding for global variable ‘group’" 30 | # Y <- Y %>% mutate(group = factor(group)) 31 | Y$group <- factor(Y$group) 32 | 33 | # myScale <- function(x){ (x - mean(x)) / sd(x)} 34 | # Y <- Y %>% group_by(group) %>% mutate(iso1 = myScale(iso1), 35 | # iso2 = myScale(iso2)) 36 | 37 | ellY <- siberKapow(Y, isoNames = c("iso1","iso2"), group = "group") 38 | 39 | p <- ggplot(ellY$ell.coords, 40 | mapping = aes_string(x = 'X1', y = 'X2', color = 'group', fill = 'group')) + 41 | geom_polygon(alpha = 0.1) + 42 | scale_color_discrete(guide = FALSE) + 43 | annotate("text", x = 0, y = 0, label = "KAPOW!", 44 | size = 30, angle = 10, 45 | color = "#F3F315") + 46 | theme_classic() + 47 | theme(axis.text.x = element_blank(), 48 | axis.text.y = element_blank(), 49 | axis.ticks = element_blank(), 50 | axis.title.x = element_blank(), 51 | axis.title.y = element_blank(), 52 | axis.line = element_blank()) + 53 | theme(legend.position="none") 54 | 55 | if (do.plot) print(p) 56 | 57 | return(p) 58 | 59 | } 60 | 61 | -------------------------------------------------------------------------------- /R/pointsToEllipsoid.R: -------------------------------------------------------------------------------- 1 | #' Test whether a set of points are inside or outside a defined ellipse 2 | #' 3 | #' Takes a `i x d` matrix of points where `d` is the dimension of the 4 | #' space considered, and `i` is the number of points and returns 5 | #' `TRUE` or `FALSE` for whether each point is inside or outside a 6 | #' d-dimensional ellipsoid defined by a covariance matrix `Sigma` and 7 | #' vector of means `mu`. 8 | #' 9 | #' @param X the `i x d` matrix of data points to be transformed 10 | #' @param Sigma the `d x d` covariance matrix of the ellipsoid 11 | #' @param mu the vector of means of the ellipse of length `d` 12 | #' 13 | #' @return A matrix of transformed data points corresponding to `X` 14 | #' 15 | #' @examples 16 | #' X <- matrix(runif(200,-2.5, 2.5), ncol = 2, nrow = 100) 17 | #' SIG <- matrix(c(1,0,0,1), ncol = 2, nrow = 2) 18 | #' mu <- c(0, 0) 19 | #' Z <- pointsToEllipsoid(X, SIG, mu) 20 | #' test <- ellipseInOut(Z, p = 0.95) 21 | #' plot(X, col = test + 1, xlim = c(-3, 3), ylim = c(-3, 3), asp = 1) 22 | #' addEllipse(mu, SIG, p.interval = 0.95) 23 | #' 24 | #' @export 25 | 26 | pointsToEllipsoid <- function(X, Sigma, mu){ 27 | 28 | # ---------------------------------------------------------------------------- 29 | # some input checking 30 | 31 | # check Sigma is a square matrix 32 | if(ncol(Sigma) != nrow(Sigma)) stop("Sigma must be a square matrix") 33 | 34 | # check X matches Sigma 35 | if(ncol(X) != ncol(Sigma)) stop("number of columns in X must 36 | be of same dimension as Sigma") 37 | 38 | # check mu matches Sigma 39 | if(length(mu) != ncol(Sigma)) stop("length of mu must 40 | be of same dimension as Sigma") 41 | 42 | # ---------------------------------------------------------------------------- 43 | 44 | # eigen values and vectors of the covariance matrix 45 | eig <- eigen(Sigma) 46 | 47 | # inverse of sigma 48 | SigSqrt = eig$vectors %*% diag(sqrt(eig$values)) %*% t(eig$vectors) 49 | 50 | # transform the points 51 | Z <- t(apply(X, 1, ellipsoidTransform, SigSqrt, mu)) 52 | 53 | return(Z) 54 | 55 | 56 | } -------------------------------------------------------------------------------- /vignettes/Test-convergence.R: -------------------------------------------------------------------------------- 1 | ## ----setup-------------------------------------------------------------------- 2 | 3 | library(SIBER) 4 | library(coda) 5 | 6 | 7 | ## ----basic-model-------------------------------------------------------------- 8 | # load in the included demonstration dataset 9 | data("demo.siber.data") 10 | # 11 | # create the siber object 12 | siber.example <- createSiberObject(demo.siber.data) 13 | 14 | # Calculate summary statistics for each group: TA, SEA and SEAc 15 | group.ML <- groupMetricsML(siber.example) 16 | 17 | # options for running jags 18 | parms <- list() 19 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 20 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 21 | parms$n.thin <- 10 # thin the posterior by this many 22 | parms$n.chains <- 3 # run this many chains 23 | 24 | # set save.output = TRUE 25 | parms$save.output = TRUE 26 | 27 | # you might want to change the directory to your local directory or a 28 | # sub folder in your current working directory. I have to set it to a 29 | # temporary directory that R creates and can use for the purposes of this 30 | # generic vignette that has to run on any computer as the package is 31 | # built and installed. 32 | parms$save.dir = tempdir() 33 | 34 | # define the priors 35 | priors <- list() 36 | priors$R <- 1 * diag(2) 37 | priors$k <- 2 38 | priors$tau.mu <- 1.0E-3 39 | 40 | # fit the ellipses which uses an Inverse Wishart prior 41 | # on the covariance matrix Sigma, and a vague normal prior on the 42 | # means. Fitting is via the JAGS method. 43 | ellipses.posterior <- siberMVN(siber.example, parms, priors) 44 | 45 | 46 | 47 | ## ----test-convergence--------------------------------------------------------- 48 | 49 | # get a list of all the files in the save directory 50 | all.files <- dir(parms$save.dir, full.names = TRUE) 51 | 52 | # find which ones are jags model files 53 | model.files <- all.files[grep("jags_output", all.files)] 54 | 55 | # test convergence for the first one 56 | do.this <- 1 57 | 58 | load(model.files[do.this]) 59 | 60 | gelman.diag(output, multivariate = FALSE) 61 | gelman.plot(output, auto.layout = FALSE) 62 | 63 | 64 | -------------------------------------------------------------------------------- /R/plotGroupHulls.R: -------------------------------------------------------------------------------- 1 | #' Plots illustrative convex hulls for each group within all communities 2 | #' 3 | #' This function loops over each community and group within, and plots a 4 | #' convex hull around the data. N.B. use of convex hulls to compare isotopic 5 | #' niche width among groups within or between communities is not recommended 6 | #' owing to strong sample size bias. Use of ellipse area is recommended instead. 7 | #' This feature is provided for illustrative purposes only, and because some 8 | #' people have expressed a desire for this feature for figure generation. See 9 | #' demonstration scripts for more examples. 10 | #' 11 | #' @param siber a siber object as created by createSiberObject 12 | #' @param plot.args a list of plotting arguments for passing to 13 | #' [graphics::lines()]. See [graphics::lines()] for 14 | #' details of the options. See also the demonstration scripts for examples of 15 | #' use. 16 | #' @param iso.order a vector of length 2, either `c(1,2)` or`c(2,1)`. 17 | #' The order determines which of the columns of raw data are plotted on the x 18 | #' (1) or y (2) axis. N.B. this will be deprecated in a future release, and 19 | #' plotting order will be achieved at point of data-entry. 20 | #' @param ... additional arguments to be passed to [addEllipse()]. 21 | #' 22 | #' @return A series of convex hulls added to an existing plot. 23 | #' @export 24 | 25 | 26 | plotGroupHulls <- function(siber, plot.args = NULL, iso.order = c(1,2), ...) { 27 | 28 | # iso.order used to specify which data goes on which axis. 29 | x <- iso.order[1] 30 | y <- iso.order[2] 31 | 32 | for (i in 1:siber$n.communities){ 33 | 34 | for (j in 1:siber$n.groups[2,i]){ 35 | 36 | # find the indices for the jth group in the kth community 37 | idx <- siber$raw.data[[i]]$group == siber$group.names[[i]][j] 38 | 39 | # calculate the hull around the jth group in the 40 | # ith community 41 | ch <- siberConvexhull( siber$raw.data[[i]][idx, x], 42 | siber$raw.data[[i]][idx, y] 43 | ) 44 | 45 | # add the lines 46 | do.call('lines', c(list(x = ch$xcoords, y = ch$ycoords), plot.args)) 47 | 48 | } 49 | 50 | } 51 | } -------------------------------------------------------------------------------- /man/bayesianOverlap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bayesianOverlap.R 3 | \name{bayesianOverlap} 4 | \alias{bayesianOverlap} 5 | \title{Calculate the overlap between two ellipses based on their posterior 6 | distributions.} 7 | \usage{ 8 | bayesianOverlap( 9 | ellipse1, 10 | ellipse2, 11 | ellipses.posterior, 12 | draws = 10, 13 | p.interval = 0.95, 14 | n = 100, 15 | do.plot = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{ellipse1}{character code of the form \code{"x.y"} where \code{x} is an 20 | integer indexing the community, and \code{y} an integer indexing the group 21 | within that community. This specifies the first of two ellipses whose 22 | overlap will be compared.} 23 | 24 | \item{ellipse2}{same as \code{ellipse1} specifying a second ellipse.} 25 | 26 | \item{ellipses.posterior}{a list of posterior means and covariances fitted 27 | using \code{\link[=siberEllipses]{siberEllipses()}}.} 28 | 29 | \item{draws}{an integer specifying how many of the posterior draws are to be 30 | used to estimate the posterior overlap. Defaults to \code{10} which uses 31 | the first 10 draws. In all cases, the selection will be \code{1:draws} so 32 | independence of the posterior draws is assumed. Setting to \code{NULL} will 33 | use all the draws (WARNING - like to be very slow).} 34 | 35 | \item{p.interval}{the prediction interval used to scale the ellipse as per 36 | \code{\link[=addEllipse]{addEllipse()}}.} 37 | 38 | \item{n}{the number of points on the edge of the ellipse used to define it. 39 | Defaults to \code{100} as per \code{\link[=addEllipse]{addEllipse()}}.} 40 | 41 | \item{do.plot}{logical switch to determine whether the corresponding ellipses 42 | should be plotted or not. A use-case would be in conjunction with a low 43 | numbered \code{draws} so as to visualise a relatively small number of the 44 | posterior ellipses. Defaults to \code{FALSE}.} 45 | } 46 | \value{ 47 | A data.frame comprising three columns: the area of overlap, the area 48 | of the first ellipse and the area of the second ellipse and as many rows as 49 | specified by \code{draws}. 50 | } 51 | \description{ 52 | This function loops over the posterior distribution of the means and 53 | covariances matrices of two specified groups. 54 | } 55 | -------------------------------------------------------------------------------- /R/extractPosteriorMeans.R: -------------------------------------------------------------------------------- 1 | #' Extract posterior means from call to \code{\link{siberMVN}} 2 | #' 3 | #' This function extracts the posterior means from a call to 4 | #' [siberMVN()] which can then be used to calculate Bayesian layman 5 | #' metrics. This function is designed to create an array of posterior means 6 | #' that is more easily interrogated for plotting and summary statistics. 7 | #' 8 | #' @param siber a siber object as created by [createSiberObject()]. 9 | #' 10 | #' @param post a list containing the posterior estimated parameters fitted to 11 | #' each group within every community. See [siberMVN()] which creates 12 | #' this object for details. 13 | #' 14 | #' @return A list of length n.communities with each entry representing a 15 | #' `n.draws * 2 * n.groups` array of rows equal to the number of posterior 16 | #' samples, 2 columns representing the two means of the multivariate data and 17 | #' `n.groups` the number of groups within the focal community. 18 | #' 19 | #' @export 20 | #' 21 | 22 | 23 | extractPosteriorMeans <- function (siber, post) { 24 | 25 | 26 | # community / group naming 27 | tmp.names <- unique(paste(siber$original.data[,"community"], 28 | siber$original.data[,"group"], 29 | sep=".") 30 | ) 31 | 32 | n.samps <- nrow(post[[1]]) 33 | 34 | post.means <- list() 35 | 36 | ct <- 1 # a counter 37 | 38 | for (k in 1:siber$n.communities) { 39 | 40 | # create the (n.samp x 2 x n.groups) array 41 | group.mu <- array(NA, dim=c(n.samps, 2, siber$n.groups[2,k]), 42 | dimnames = list(NULL, 43 | c("mu.x","mu.y"), 44 | paste("group", 45 | 1:siber$n.groups[2,k], 46 | sep = "") 47 | ) 48 | ) 49 | 50 | for (j in 1:siber$n.groups[2,k]) { 51 | 52 | group.mu[,,j] <- post[[ct]][,5:6] 53 | 54 | ct <- ct + 1 # update the counter 55 | 56 | } 57 | 58 | post.means[[k]] <- group.mu 59 | 60 | } 61 | 62 | return(post.means) 63 | 64 | } -------------------------------------------------------------------------------- /R/ellipseBackTransform.R: -------------------------------------------------------------------------------- 1 | #' Back-transform a z-score siber ellipse to original location and scale. 2 | #' 3 | #' Back-transforms a bivariate siber ellipse fitted to z-scored data to the 4 | #' original location and scale. Not intended for direct call by users. 5 | #' 6 | #' @param jags.output a mcmc.list object of posterior samples created by 7 | #' [rjags::rjags()]. In siber this is created typically by [fitEllipse()] 8 | #' 9 | #' @param siber a siber object as created by createSiberObject. 10 | #' 11 | #' @param idx.community an integer specifying which community to back-transform. 12 | #' 13 | #' @param idx.group an integer specifying which group to back-transform. 14 | #' 15 | #' 16 | #' @return A 6 x n matrix representing the back-transformed posterior 17 | #' distributions of the bivariate normal distribution for a specified group 18 | #' within a specified community, where n is the number of 19 | #' posterior draws in the saved sample. The first four columns are the 20 | #' covariance matrix Sigma in vector format. This vector converts to the 21 | #' covariance matrix as `matrix(v[1:4], nrow = 2, ncol = 2)`. The 22 | #'remaining two columns are the back-transformed means. 23 | #' 24 | 25 | ellipseBackTransform <- function (jags.output, siber, idx.community, idx.group) { 26 | 27 | # function to back transform Bayesian estimated covariance matrices. 28 | # This function also collates the posterior draws into a single matrix 29 | # for each group, nested within a community. 30 | 31 | all.draws <- as.matrix(jags.output) 32 | 33 | # first the two diagonal variances 34 | all.draws[,1] <- all.draws[,1] * siber$ML.cov[[idx.community]][1,1,idx.group] 35 | all.draws[,4] <- all.draws[,4] * siber$ML.cov[[idx.community]][2,2,idx.group] 36 | 37 | # then the covariances 38 | all.draws[,2] <- (all.draws[,2] * 39 | siber$ML.cov[[idx.community]][1,1,idx.group] ^ 0.5 * 40 | siber$ML.cov[[idx.community]][2,2,idx.group] ^ 0.5) 41 | all.draws[,3] <- all.draws[,2] 42 | 43 | # now correct the ellipse locations (i.e. their means) 44 | all.draws[,5] <- all.draws[,5] + siber$ML.mu[[idx.community]][1,1,idx.group] 45 | all.draws[,6] <- all.draws[,6] + siber$ML.mu[[idx.community]][1,2,idx.group] 46 | 47 | return(all.draws) 48 | 49 | } # end of function 50 | -------------------------------------------------------------------------------- /man/siberMVN.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siberMVN.R 3 | \name{siberMVN} 4 | \alias{siberMVN} 5 | \title{Fit Bayesian bivariate normal distributions to each group in each community} 6 | \usage{ 7 | siberMVN(siber, parms, priors) 8 | } 9 | \arguments{ 10 | \item{siber}{a siber object as created by \code{\link[=createSiberObject]{createSiberObject()}}} 11 | 12 | \item{parms}{a list containing four items providing details of the 13 | \code{\link[rjags:rjags-package]{rjags::rjags()}} run to be sampled. 14 | \itemize{ 15 | \item \code{n.iter} The number of iterations to sample 16 | \item \code{n.burnin} The number of iterations to discard as a burnin from the 17 | start of sampling. 18 | \item \code{n.thin} The number of samples to thin by. 19 | \item \code{n.chains} The number of chains to fit. 20 | }} 21 | 22 | \item{priors}{a list of three items specifying the priors to be passed to 23 | the jags model. 24 | \itemize{ 25 | \item \code{R} The scaling vector for the diagonal of Inverse Wishart 26 | distribution prior on the covariance matrix Sigma. Typically 27 | set to a 2x2 matrix \code{matrix(c(1, 0, 0, 1), 2, 2)}. 28 | \item \code{k} The degrees of freedom of the Inverse Wishart distribution for 29 | the covariance matrix Sigma. Typically set to the dimensionality of Sigma, 30 | which in this bivariate case is 2. 31 | \item \code{tau} The precision on the normal prior on the means mu. 32 | }} 33 | } 34 | \value{ 35 | A list of length equal to the total number of groups in all 36 | communities. Each entry is named 1.1 1.2... 2.1.. with the first number 37 | designating the community, and the second number the group within that 38 | community. So, 2.3 would be the third group within the second community. 39 | Each list entry is a 6 x n matrix representing the back-transformed posterior 40 | distributions of the bivariate normal distribution, where n is the number of 41 | posterior draws in the saved sample. The first two columns are the back- 42 | transformed means, and the remaining four columns are the covariance matrix 43 | Sigma in vector format. This vector converts to the covariance matrix as 44 | \code{matrix(v[1:4], nrow = 2, ncol = 2)}. 45 | } 46 | \description{ 47 | This function loops over each community and then loops over each group 48 | member, fitting a Bayesian multivariate (bivariate in this case) normal 49 | distribution to each group of data. Not intended for direct calling by users. 50 | } 51 | -------------------------------------------------------------------------------- /R/plotCommunityHulls.R: -------------------------------------------------------------------------------- 1 | #' Adds convex hulls to each community to an existing plot 2 | #' 3 | #' This function loops over each community and plots the convex hull 4 | #' based on the centres of each of the groups that make up the community. See 5 | #' the demonstration scripts for example implementation. 6 | #' 7 | #' @param siber a siber object as created by createSiberObject.R 8 | #' @param plot.args a list of plotting arguments with the following suggested, 9 | #' but non-exhaustive inputs. Additional plotting arguments for passing to the 10 | #' internal call to [graphics::plot()] can either be specified here, 11 | #' or as additional arguments under the `...` method. 12 | #' * `col` the color of the lines of the convex hull. See [graphics::lines()] 13 | #' for more details. 14 | #' * `lty` the line type of the convex hull.See [graphics::lines()] 15 | #' for more details. 16 | #' * `lwd` the line width of the convex hulls. See [graphics::lines()] 17 | #' for more details. 18 | #' @param iso.order a vector of length 2, either c(1,2) or c(2,1). The order 19 | #' determines which of the columns of raw data are plotted on the x (1) or y 20 | #' (2) axis. N.B. this will be deprecated in a future release, and plotting 21 | #' order will be achieved at point of data-entry. 22 | #' @param ... additional arguments for passing to [graphics::plot()]. 23 | #' 24 | #' @return Convex hulls, drawn as lines on an existing figure. 25 | #' @export 26 | 27 | 28 | plotCommunityHulls <- function(siber, 29 | plot.args = list(col = 1, lty = 2), 30 | iso.order = c(1,2), 31 | ...) { 32 | x <- iso.order[1] 33 | y <- iso.order[2] 34 | 35 | for (i in 1:siber$n.communities) { 36 | 37 | # only attempt to draw hulls if there are more than 2 groups 38 | if (siber$n.groups[2,i] > 2) { 39 | ch <- siberConvexhull( siber$ML.mu[[i]][1,x,] , 40 | siber$ML.mu[[i]][1,y,] 41 | ) 42 | 43 | 44 | # use do.call to pass the list containing the plotting arguments 45 | # onwards. Need to add plot.args back in here. If it takes NULL 46 | # then the plotting does not happen 47 | do.call('lines', 48 | c(list(x = ch$xcoords, 49 | y = ch$ycoords), 50 | plot.args) 51 | ) # end of do.call 52 | 53 | } # end of if statement 54 | } # end of loop over communities 55 | } # end of function -------------------------------------------------------------------------------- /man/maxLikOverlap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/maxLikOverlap.R 3 | \name{maxLikOverlap} 4 | \alias{maxLikOverlap} 5 | \title{Calculate the overlap between two ellipses based on the maximum likelihood 6 | fitted ellipses.} 7 | \usage{ 8 | maxLikOverlap( 9 | ellipse1, 10 | ellipse2, 11 | siber.object, 12 | p.interval = 0.95, 13 | n = 100, 14 | do.plot = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{ellipse1}{character code of the form \code{"x.y"} where \code{x} is an 19 | integer indexing the community, and \code{y} an integer indexing the group 20 | within that community. This specifies the first of two ellipses whose 21 | overlap will be compared.} 22 | 23 | \item{ellipse2}{same as \code{ellipse1} specifying a second ellipse.} 24 | 25 | \item{siber.object}{an object created by \code{\link[=createSiberObject]{createSiberObject()}} 26 | which contains the ML estimates for the means and covariance matrices for 27 | each group.} 28 | 29 | \item{p.interval}{the prediction interval used to scale the ellipse as per 30 | \code{\link[=addEllipse]{addEllipse()}}.} 31 | 32 | \item{n}{the number of points on the edge of the ellipse used to define it. 33 | Defaults to \code{100} as per \code{\link[=addEllipse]{addEllipse()}}.} 34 | 35 | \item{do.plot}{logical switch to determine whether the corresponding ellipses 36 | should be plotted or not. A use-case would be in conjunction with a low 37 | numbered \code{draws} so as to visualise a relatively small number of the 38 | posterior ellipses. Defaults to \code{FALSE}.} 39 | } 40 | \value{ 41 | A vector comprising three columns: the area of overlap, the area of 42 | the first ellipse and the area of the second ellipse and as many rows as 43 | specified by \code{draws}. 44 | } 45 | \description{ 46 | This function uses the ML estimated means and covariances matrices of two 47 | specified groups to calculate the area of overlap. 48 | } 49 | \examples{ 50 | # load in the included demonstration dataset data("demo.siber.data") 51 | siber.example <- createSiberObject(demo.siber.data) 52 | 53 | # The first ellipse is referenced using a character string representation 54 | # where in "x.y", "x" is the community, and "y" is the group within that 55 | # community. 56 | ellipse1 <- "1.2" 57 | 58 | # Ellipse two is similarly defined: community 1, group3 59 | ellipse2 <- "1.3" 60 | 61 | # the overlap betweeen the corresponding 95\% prediction ellipses is given by: 62 | ellipse95.overlap <- maxLikOverlap(ellipse1, ellipse2, siber.example, 63 | p.interval = 0.95, n = 100) 64 | 65 | } 66 | -------------------------------------------------------------------------------- /tmp/test-points-within-2d-ellipse.R: -------------------------------------------------------------------------------- 1 | # script to check the calculation of angle and area using the atan rather than 2 | # asin() method. 3 | 4 | # set.seed(3) 5 | 6 | # n random numbers 7 | n <- 100 8 | 9 | # ------------------------------------------------------------------------------ 10 | # generate mvtnorm numbers 11 | 12 | # means 13 | mu <- c(0,0) 14 | 15 | # sigma from an inverse wishart distribution 16 | S <- MCMCpack::riwish(length(mu), diag(length(mu))) 17 | 18 | # multivariate normal Y 19 | Y <- mvtnorm::rmvnorm(n = n, mean = mu, sigma = S) 20 | 21 | plot(Y[,2] ~ Y[,1], type = "n", asp = 1, 22 | xlim = c(-7, 7), 23 | ylim = c(-7, 7)) 24 | 25 | 26 | # ------------------------------------------------------------------------------ 27 | 28 | # sample mean 29 | mu_samp <- colMeans(Y) 30 | 31 | # calculate covariance matrix of the data 32 | S.samp <- cov(Y) 33 | 34 | # add this ellipse to the plot 35 | tmp <- SIBER::addEllipse(colMeans(Y), S.samp, p = 0.95, col = "red", lty = 2) 36 | 37 | # eigen values and vectors of the data 38 | eig <- eigen(S.samp) 39 | 40 | # inverse of sigma 41 | SigSqrt = eig$vectors %*% diag(sqrt(eig$values)) %*% t(eig$vectors) 42 | 43 | # function to rotate and translate any data onto this orientation 44 | myfun = function(x, mu) { 45 | return(solve(SigSqrt,x-mu)) 46 | } 47 | 48 | # how many of these samples are inside the ellipse? 49 | Z.samp <- t(apply(Y, 1, myfun, mu = mu_samp)) 50 | 51 | samp_inside = rowSums(Z.samp ^ 2) < qchisq(0.95, df=2) 52 | 53 | 54 | points(Y[,2] ~ Y[,1], col = (!samp_inside) + 1) 55 | 56 | 57 | # some points to check for inside or out 58 | test.these <- matrix(c(-5, 0, 4, -5, 2, 59 | -5, 0, 3, -2, -4), 60 | ncol = 2, nrow = 5) 61 | 62 | #points(test.these[,2]~test.these[,1], col = "red", pch = "*") 63 | 64 | # transform these points on the ellipse coordinates 65 | Z.test <- t(apply(test.these,1,myfun, mu = mu_samp)) 66 | 67 | # and test they are within the radius 68 | inside = rowSums(Z.test ^ 2) < qchisq(0.95, df=2) 69 | 70 | points(test.these[,2]~test.these[,1], col = (!inside) + 1, pch = "*") 71 | 72 | 73 | # Test whether the SIBER functions match the manually calculated values here 74 | Z_aj <- SIBER::pointsToEllipsoid(X = Y, Sigma = S.samp, mu = mu_samp) 75 | 76 | # are all the transformed points the same? 77 | all(Z_aj == Z.samp) 78 | 79 | # calculate whether the points are inside / out 80 | inside_aj <- SIBER::ellipseInOut(Z = Z_aj, p = 0.95) 81 | 82 | all(inside_aj == samp_inside) 83 | 84 | 85 | # what proportion of our samples are inside 86 | print(sum(samp_inside) / length(samp_inside)) -------------------------------------------------------------------------------- /tmp/test-ellipse-sizes.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Test ellipse sizes" 3 | output: html_notebook 4 | --- 5 | 6 | ```{r load-data} 7 | # remove previously loaded items from the current environment and remove previous graphics. 8 | rm(list=ls()) 9 | graphics.off() 10 | 11 | # Here, I set the seed each time so that the results are comparable. 12 | # This is useful as it means that anyone that runs your code, *should* 13 | # get the same results as you, although random number generators change 14 | # from time to time. 15 | set.seed(1) 16 | 17 | library(SIBER) 18 | 19 | # load in the included demonstration dataset 20 | data("demo.siber.data") 21 | # 22 | # create the siber object 23 | siber.example <- createSiberObject(demo.siber.data) 24 | 25 | 26 | 27 | ``` 28 | 29 | 30 | 31 | ```{r summary-stats} 32 | 33 | par(mfrow=c(1,1)) 34 | 35 | community.hulls.args <- list(col = 1, lty = 1, lwd = 1) 36 | group.ellipses.args <- list(n = 100, p.interval = 0.95, lty = 1, lwd = 2) 37 | group.hull.args <- list(lty = 2, col = "grey20") 38 | 39 | # this time we will make the points a bit smaller by 40 | # cex = 0.5 41 | plotSiberObject(siber.example, 42 | ax.pad = 2, 43 | hulls = F, community.hulls.args, 44 | ellipses = F, group.ellipses.args, 45 | group.hulls = F, group.hull.args, 46 | bty = "L", 47 | iso.order = c(1,2), 48 | xlab=expression({delta}^13*C~'permille'), 49 | ylab=expression({delta}^15*N~'permille'), 50 | cex = 0.5 51 | ) 52 | 53 | 54 | 55 | addEllipse(mu = siber.example$ML.mu[[1]][,,1], 56 | sigma = siber.example$ML.cov[[1]][,,1],p.interval = 0.95) 57 | addEllipse(mu = siber.example$ML.mu[[1]][,,2], 58 | sigma = siber.example$ML.cov[[1]][,,2],p.interval = 0.95) 59 | addEllipse(mu = siber.example$ML.mu[[1]][,,3], 60 | sigma = siber.example$ML.cov[[1]][,,3],p.interval = 0.95) 61 | addEllipse(mu = siber.example$ML.mu[[2]][,,1], 62 | sigma = siber.example$ML.cov[[2]][,,1],p.interval = 0.95) 63 | addEllipse(mu = siber.example$ML.mu[[2]][,,2], 64 | sigma = siber.example$ML.cov[[2]][,,2],p.interval = 0.95) 65 | addEllipse(mu = siber.example$ML.mu[[2]][,,3], 66 | sigma = siber.example$ML.cov[[2]][,,3],p.interval = 0.95) 67 | 68 | 69 | 70 | 71 | # You can add more ellipses by directly calling plot.group.ellipses() 72 | # Add an additional p.interval % prediction ellilpse 73 | plotGroupEllipses(siber.example, n = 100, p.interval = 0.95, 74 | lty = 2, lwd = 2) 75 | 76 | 77 | 78 | 79 | ``` -------------------------------------------------------------------------------- /R/generateSiberCommunity.R: -------------------------------------------------------------------------------- 1 | #' A utility function to simulate a single community comprised of groups 2 | #' 3 | #' This function simulates data for a single community by sampling from a normal 4 | #' distribution with different means for each group within some specified 5 | #' boundaries. 6 | #' 7 | #' @param n.groups the an integer specifying the number of groups to simulate. 8 | #' Defaults to 3. 9 | #' 10 | #' @param community.id an integer identifying the community's ID number. 11 | #' Defaults to 1. 12 | #' 13 | #' @param n.obs the number of observations to draw per group. 14 | #' 15 | #' @param mu.range a vector of length 4, specifying the mix and max x and y 16 | #' values to sample means from. Group means are sampled from a uniform 17 | #' distribution within this range. The first two entries are the min and max of 18 | #' the x-axis, and the second two the min and max of the y-axis. Defaults to 19 | #' `c(-1, 1, -1, 1)`. 20 | #' 21 | #' @param wishSigmaScale is a simple multiplier for the call to 22 | #' [stats::rWishart()] which scales the diagonal sigma matrix using 23 | #' `wishSigmaScale * diag(2)` that is ultimately passed on to 24 | #' `generateSiberGroup`. 25 | #' 26 | #' @return A data.frame object comprising a column of x and y data, a group 27 | #' identifying column and a community identifying column, all of which are 28 | #' numeric. 29 | #' 30 | #' @export 31 | #' 32 | 33 | 34 | # a function to generate a community comprised of a number of groups 35 | generateSiberCommunity <- function (n.groups = 3, community.id = 1, 36 | n.obs = 30, 37 | mu.range = c(-1, 1, -1, 1), 38 | wishSigmaScale = 1) { 39 | 40 | # create some random vectors which will be built as we go 41 | # I dont like this and will pre-define them at full length 42 | # in a later update. 43 | y <- NULL 44 | community <- NULL 45 | group <- NULL 46 | 47 | # loop over each group that comprises the community 48 | for (i in 1:n.groups) { 49 | 50 | # create each group one-by-one 51 | tmp <- generateSiberGroup(mu.range = mu.range, 52 | n.obs = n.obs, 53 | wishSigmaScale = wishSigmaScale) 54 | 55 | # add it on to the previous group 56 | y <- rbind(y, tmp) 57 | 58 | # assign each cluster of data to an appropriate group identifier 59 | group <- c(group, rep(i, n.obs)) 60 | } 61 | 62 | # create the dataframe to be output 63 | out <- data.frame(iso1 = y[,1], 64 | iso2 = y[,2], 65 | group = group, 66 | community = rep(community.id, nrow(y))) 67 | 68 | # return the dataframe 69 | return(out) 70 | 71 | } 72 | -------------------------------------------------------------------------------- /R/allCentroidVectors.R: -------------------------------------------------------------------------------- 1 | #' Plot the pairwise distances and angles describing the difference between 2 | #' centroids of all groups 3 | #' 4 | #' Plots the posterior densities 5 | #' 6 | #' @param centroids the list containing distance and angle matrices as returned 7 | #' by [siberCentroids()]. 8 | #' @param upper a logical determining whether to plot the upper or lower 9 | #' triangle of angles. Defaults to TRUE which is the upper triangle and 10 | #' returns the angle from the second ellipse to the first by centering on the 11 | #' first centroid. 12 | #' @param do.plot a logical indicating whether plotting should be done or not. 13 | #' Defaults to TRUE. 14 | #' @param ... additional arguments to pass onwards, not currently implemented. 15 | #' 16 | #' @return A nice plot. You can get the corresponding matrices used to generate 17 | #' the plots if you ask for it nicely: the_data <- 18 | #' plotCentroidVectors(centroids) 19 | #' 20 | #' @importFrom magrittr %>% 21 | #' 22 | #' @export 23 | # magrittr::`%>%` 24 | 25 | allCentroidVectors <- function (centroids, upper = TRUE, do.plot = TRUE, ...) { 26 | 27 | # appease CRAN checks 28 | comparison <- NULL 29 | 30 | dd <- dim(centroids$r) 31 | 32 | # number of pairwise comparisons 33 | n.comp <- ((dd[1] ^ 2) - dd[1]) / 2 34 | 35 | # prep the matrices for passing to the plotting function 36 | angles <- distances <- matrix(0, dd[3], n.comp) 37 | 38 | new.names <- rep("NA", n.comp) 39 | 40 | # loop and extract the data in to the matrix 41 | # AJ - I NEED TO IMPLEMENT A SWITCH FOR THE LOWER TRIANGLE FOR ANGLES 42 | 43 | ct <- 1 # a counter 44 | 45 | for (i in 1:(dd[1] - 1 )){ 46 | 47 | for (j in (i+1):dd[1]){ 48 | 49 | distances[,ct] <- centroids$r[i,j,] 50 | 51 | if(upper) {angles[,ct] <- centroids$theta[i,j,]} 52 | 53 | if(!upper) {angles[,ct] <- centroids$theta[j,i,]} 54 | 55 | 56 | new.names[ct]<- centroids$labels[i,j] 57 | 58 | ct <- ct + 1 59 | 60 | } 61 | 62 | 63 | 64 | } 65 | 66 | colnames(distances) <- new.names 67 | colnames(angles) <- new.names 68 | 69 | if(do.plot){ 70 | siberDensityPlot(distances) 71 | siberDensityPlot(angles) 72 | } 73 | 74 | # browser() 75 | 76 | # convert from wide to long format 77 | long_data_angles <- tidyr::gather(data.frame(angles), 78 | key = comparison, value = angles) 79 | 80 | long_data_distances <- tidyr::gather(data.frame(distances), 81 | key = comparison, value = distances) 82 | 83 | angles_distances <- long_data_angles 84 | angles_distances$distances <- long_data_distances$distances 85 | 86 | 87 | # return if asked 88 | invisible(angles_distances) 89 | 90 | 91 | } 92 | -------------------------------------------------------------------------------- /man/fitEllipse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fitEllipse.R 3 | \name{fitEllipse} 4 | \alias{fitEllipse} 5 | \title{Fit a multivariate normal distribution to x and y data using jags} 6 | \usage{ 7 | fitEllipse(x, y, parms, priors, id = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{a vector of data representing the x-axis} 11 | 12 | \item{y}{a vector of data representing the y-axis} 13 | 14 | \item{parms}{a list containing four items providing details of the 15 | \code{\link[rjags:rjags-package]{rjags::rjags()}} run to be sampled. 16 | \itemize{ 17 | \item \code{n.iter} The number of iterations to sample 18 | \item \code{n.burnin} The number of iterations to discard as a burnin from the 19 | start of sampling. 20 | \item \code{n.thin} The number of samples to thin by. 21 | \item \code{n.chains} The number of chains to fit. 22 | }} 23 | 24 | \item{priors}{a list of three items specifying the priors to be passed to the 25 | jags model. 26 | \itemize{ 27 | \item \code{R} The scaling vector for the diagonal of 28 | Inverse Wishart distribution prior on the covariance matrix Sigma. 29 | Typically set to a 2x2 matrix \code{matrix(c(1, 0, 0, 1), 2, 2)}. 30 | \item \code{k} The 31 | degrees of freedom of the Inverse Wishart distribution for the covariance 32 | matrix Sigma. Typically set to the dimensionality of Sigma, which in this 33 | bivariate case is 2. 34 | \item \code{tau} The precision on the normal prior on the 35 | means mu. 36 | }} 37 | 38 | \item{id}{a character string to prepend to the raw saved jags model output. 39 | This is typically passed on from the calling function 40 | \code{\link[=siberMVN]{siberMVN()}} and identifies the community and group with an 41 | integer labelling system. Defaults to NULL which will prevent the output 42 | object being saved even if \code{parms$save.output} is set to \code{TRUE}. 43 | The file itself will be saved to the user-specified location via 44 | \code{parms$save.dir}.} 45 | } 46 | \value{ 47 | A mcmc.list object of posterior samples created by jags. 48 | } 49 | \description{ 50 | This function contains and defines the jags model script used to fit a 51 | bivariate normal distribution to a vector of x and y data. Although not 52 | intended for direct calling by users, it presents a quick way to fit a model 53 | to a single group of data. Advanced users should be able to manipulate the 54 | contained jags model to fit more complex models using different likelihoods, 55 | such as multivariate lognormal distributions, multivariate gamma 56 | distributions etc... 57 | } 58 | \examples{ 59 | x <- stats::rnorm(50) 60 | y <- stats::rnorm(50) 61 | parms <- list() 62 | parms$n.iter <- 2 * 10^3 63 | parms$n.burnin <- 500 64 | parms$n.thin <- 2 65 | parms$n.chains <- 2 66 | priors <- list() 67 | priors$R <- 1 * diag(2) 68 | priors$k <- 2 69 | priors$tau.mu <- 1.0E-3 70 | fitEllipse(x, y, parms, priors) 71 | 72 | } 73 | -------------------------------------------------------------------------------- /R/generateSiberData.R: -------------------------------------------------------------------------------- 1 | #' A utility function to simulate isotope data for several communities 2 | #' 3 | #' This function simulates data for a specified number of communities. It is a 4 | #' wrapper function for [generateSiberCommunity()]. 5 | #' 6 | #' @param n.groups the an integer specifying the number of groups per community 7 | #' to simulate. Defaults to 3. 8 | #' @param n.communities the number of communities to simulate data for. Defaults 9 | #' to 2. 10 | #' @param n.obs the number of observations to draw per group. 11 | #' @param mu.range a vector of length 4, specifying the mix and max x and y 12 | #' values to sample means from. Group means are sampled from a uniform 13 | #' distribution within this range. The first two entries are the min and max 14 | #' of the x-axis, and the second two the min and max of the y-axis. Defaults 15 | #' to \code{c(-1, 1, -1, 1)}. 16 | #' @param wishSigmaScale is a simple multiplier for the call to 17 | #' [stats::rWishart()] which scales the diagonal sigma matrix using 18 | #' `wishSigmaScale * diag(2)` that is ultimately passed on to 19 | #' `generateSiberGroup`. 20 | #' 21 | #' @return A data.frame object comprising a column of x and y data, a group 22 | #' identifying column and a community identifying column, all of which are 23 | #' numeric. 24 | #' 25 | #' @examples 26 | #' generateSiberData() 27 | #' 28 | #' @export 29 | 30 | generateSiberData <- function(n.groups = 3, n.communities = 2, n.obs = 30, 31 | mu.range = c(-1, 1, -1, 1), 32 | wishSigmaScale = 1){ 33 | 34 | # calculate the number of observations (rows) to be created 35 | nn <- n.obs * n.groups * n.communities 36 | 37 | # a vector of dummy NA entries to use to populate the dataframe 38 | dummy <- rep(NA, nn) 39 | 40 | # the dataframe that will hold the simulated data 41 | simulated.data <- data.frame(iso1 = dummy, 42 | iso2 = dummy, 43 | group = dummy, 44 | community = dummy) 45 | 46 | # a counter to keep track of how many communities have been created, and to allow 47 | # appropriate indexing of the dataframe "simulated.data" 48 | idx.counter <- 1 49 | 50 | # loop over communities 51 | for (i in 1:n.communities){ 52 | 53 | # create a random community 54 | y <- generateSiberCommunity(n.groups = 3, community.id = i, n.obs = n.obs, 55 | mu.range = mu.range, 56 | wishSigmaScale = wishSigmaScale) 57 | 58 | # add the random community to the dataframe "simulated.data" 59 | simulated.data[idx.counter:(idx.counter+nrow(y)-1), ] <- y 60 | 61 | # update the counter 62 | idx.counter <- idx.counter + nrow(y) 63 | 64 | } 65 | 66 | 67 | # output the dataframe "simulated.data" 68 | return(simulated.data) 69 | 70 | 71 | } 72 | -------------------------------------------------------------------------------- /R/groupMetricsML.R: -------------------------------------------------------------------------------- 1 | #' Calculate maximum likelihood based measures of dispersion of bivariate data 2 | #' 3 | #' This function loops over each group within each community and calculates the 4 | #' convex hull total area, Standard Ellipse Area (SEA) and its corresponding 5 | #' small sample size corrected version SEAc based on the maximum likelihood 6 | #' estimates of the means and covariance matrices of each group. 7 | #' 8 | #' @param siber a siber object as created by createSiberObject. 9 | #' 10 | #' @return A 3 x m matrix of the 6 Layman metrics of dX_range, dY_range, TA, 11 | #' CD, MNND and SDNND in rows, where each column is a different group nested 12 | #' within a community. 13 | #' 14 | #' @examples 15 | #' data(demo.siber.data) 16 | #' my.siber.data <- createSiberObject(demo.siber.data) 17 | #' groupMetricsML(my.siber.data) 18 | #' 19 | #' @export 20 | 21 | groupMetricsML <- function(siber){ 22 | 23 | # prepare a matrix for storing the results. 24 | # Each column is a group. Each row a different metric 25 | 26 | # community / group naming by looping over communites and pasting on the 27 | # correct group names within that community. 28 | tmp.names <- NULL 29 | for (i in 1:siber$n.communities){ 30 | tmp.names <- c(tmp.names, 31 | paste(siber$all.communities[i], 32 | siber$group.names[[i]], sep = ".") 33 | ) 34 | } 35 | 36 | # prepare matrix for storing results. 37 | out <- matrix(NA, nrow = 3, ncol = sum(siber$n.groups[2,]), 38 | dimnames = list(c("TA", "SEA", "SEAc"), tmp.names) 39 | ) 40 | 41 | cnt <- 1 42 | 43 | for (i in 1:siber$n.communities){ 44 | 45 | for (j in 1:siber$n.groups[2,i]){ 46 | 47 | # ------------------------------------------------------------------------ 48 | # Calculate the SEA and SEAc on the jth group in the ith community 49 | tmp.SEA <- sigmaSEA(siber$ML.cov[[i]][,,j]) 50 | 51 | out["SEA", cnt] <- tmp.SEA$SEA 52 | 53 | # extract the sample size for this group 54 | n <- siber$sample.sizes[i,paste(siber$group.names[[i]][j])] 55 | 56 | out["SEAc", cnt] <- tmp.SEA$SEA * (n - 1) / ( n - 2) 57 | 58 | 59 | # ------------------------------------------------------------------------ 60 | # calculate the hull area around the jth group in the 61 | # ith community 62 | # find the indices for the jth group 63 | idx <- siber$raw.data[[i]]$group == siber$group.names[[i]][j] 64 | 65 | ch <- siberConvexhull( siber$raw.data[[i]][idx, 1], 66 | siber$raw.data[[i]][idx, 2]) 67 | 68 | out["TA",cnt] <- ch$TA 69 | 70 | # update the counter to keep track of which column we are in. 71 | cnt <- cnt + 1 72 | 73 | } 74 | 75 | } 76 | return(out) 77 | } -------------------------------------------------------------------------------- /man/addEllipse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/addEllipse.R 3 | \name{addEllipse} 4 | \alias{addEllipse} 5 | \title{Adds an ellipse around some data to an existing plot} 6 | \usage{ 7 | addEllipse( 8 | mu, 9 | sigma, 10 | m = NULL, 11 | n = 100, 12 | p.interval = NULL, 13 | ci.mean = FALSE, 14 | small.sample = FALSE, 15 | do.plot = TRUE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{mu}{a vector of length two specifying the bivariate means} 21 | 22 | \item{sigma}{a 2x2 covariance matrix for the data} 23 | 24 | \item{m}{is the sample size of the dataset on which the ellipse is to be 25 | plotted. This is only informative if calculating the confidence interval of 26 | the bivariate mean, which requires a correction of \code{1/sqrt(m)}. 27 | Defaults to NULL and has no effect.} 28 | 29 | \item{n}{the number of data points to be used to plot the ellipse. More 30 | points makes for a smoother ellipse, especially if it has high 31 | eccentricity. Defaults to \code{n = 100}.} 32 | 33 | \item{p.interval}{the quantile to be used to construct a prediction ellipse 34 | that contains p.interval proportion of the data. By default, 35 | \code{p.interval = NULL} and the Standard Ellipse is drawn which contains 36 | approximately 40\% of the data. Setting \code{p.interval = 0.95} will 37 | result in an ellipse that contains approximately 95\% of the data.} 38 | 39 | \item{ci.mean}{a logical that determines whether the ellipse drawn is a 40 | prediction ellipse of the entire data, or a confidence interval of the 41 | bivariate means. Defaults to \code{FALSE}. If set to \code{TRUE}, then 42 | \code{p.interval} can be used to generate an appropriate \% confidence 43 | interval of the bivariate means.} 44 | 45 | \item{small.sample}{a logical that determines whether or not the small sample 46 | size correction is to be applied (TRUE) or not (FALSE). Defaults to FALSE. 47 | This allows SEAc rather than SEA to be plotted, but the correction can be 48 | applied to any percentile ellipse.} 49 | 50 | \item{do.plot}{A logical that determines whether plotting should occur (TRUE 51 | and default) or not (FALSE). Setting to false is useful if you want to 52 | access the coordinates of the ellipse in order to calculate overlap between 53 | ellipses for example.} 54 | 55 | \item{...}{additional arguments as a list to be passed to \code{\link[graphics:plot.default]{graphics::plot()}}.} 56 | } 57 | \value{ 58 | A \verb{n x 2} matrix comprising the x and y coordinates of the 59 | ellipse. 60 | } 61 | \description{ 62 | This function adds an ellipse based on means and covariance to an existing 63 | plot. The ellipse can be scaled so as to represent any prediction interval of 64 | the data you wish, or alternatively any confidence interval of the bivariate 65 | means. 66 | } 67 | \examples{ 68 | #-- NOT RUN -- 69 | # data(demo.siber.data) 70 | # my.siber.data <- createSiberObject(demo.siber.data) 71 | # communityMetricsML(my.siber.data) 72 | # -- END -- 73 | } 74 | -------------------------------------------------------------------------------- /tmp/test-nonnumeric-community-labels.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Test non-numeric community labels" 3 | author: "Andrew L Jackson" 4 | date: "`r Sys.Date()`" 5 | output: html_notebook 6 | --- 7 | Some test code for checking that the community (and group) labels as strings works. 8 | 9 | ```{r} 10 | library(SIBER) 11 | 12 | library(viridis) 13 | palette(viridis(5)) 14 | 15 | 16 | mydata <- read.csv("../inst/extdata/test.community.names.csv", 17 | header = TRUE) 18 | 19 | test <- createSiberObject(mydata) 20 | 21 | community.hulls.args <- list(col = 1, lty = 1, lwd = 1) 22 | group.ellipses.args <- list(n = 100, p.interval = 0.40, lty = 1, lwd = 2) 23 | group.hull.args <- list(lty = 2, col = "grey20") 24 | 25 | 26 | 27 | par(mfrow=c(1,1)) 28 | plotSiberObject(test, 29 | ax.pad = 2, 30 | hulls = T, community.hulls.args, 31 | ellipses = T, group.ellipses.args, 32 | group.hulls = T, group.hull.args, 33 | bty = "L", 34 | iso.order = c(1,2), 35 | xlab = expression({delta}^13*C~'permille'), 36 | ylab = expression({delta}^15*N~'permille') 37 | ) 38 | 39 | # Calculate sumamry statistics for each group: TA, SEA and SEAc 40 | group.ML <- groupMetricsML(test) 41 | print(group.ML) 42 | 43 | # Calculate the various Layman metrics on each of the communities. 44 | community.ML <- communityMetricsML(test) 45 | print(community.ML) 46 | 47 | ## ------------------------------------------------------------------------ 48 | 49 | # options for running jags 50 | parms <- list() 51 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 52 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 53 | parms$n.thin <- 10 # thin the posterior by this many 54 | parms$n.chains <- 2 # run this many chains 55 | 56 | # define the priors 57 | priors <- list() 58 | priors$R <- 1 * diag(2) 59 | priors$k <- 2 60 | priors$tau.mu <- 1.0E-3 61 | 62 | # fit the ellipses which uses an Inverse Wishart prior 63 | # on the covariance matrix Sigma, and a vague normal prior on the 64 | # means. Fitting is via the JAGS method. 65 | ellipses.posterior <- siberMVN(test, parms, priors) 66 | 67 | 68 | ## ------------------------------------------------------------------------ 69 | 70 | # The posterior estimates of the ellipses for each group can be used to 71 | # calculate the SEA.B for each group. 72 | SEA.B <- siberEllipses(ellipses.posterior) 73 | 74 | siberDensityPlot(SEA.B, xticklabels = colnames(group.ML), 75 | xlab = c("Community | Group"), 76 | ylab = expression("Standard Ellipse Area " ('permille' ^2) ), 77 | bty = "L", 78 | las = 1, 79 | main = "SIBER ellipses on each group", 80 | ylims = c(0, 70) 81 | ) 82 | 83 | # Add red x's for the ML estimated SEA-c 84 | points(1:ncol(SEA.B), group.ML[3,], col="red", pch = "x", lwd = 2) 85 | 86 | 87 | ``` 88 | -------------------------------------------------------------------------------- /R/siberCentroids.R: -------------------------------------------------------------------------------- 1 | #' Calculate the polar form of the vector between pairs of ellipse centroids 2 | #' 3 | #' This function loops over each group within each community and calculates the 4 | #' vector in polar form between the estimated centroids of each ellipse to each 5 | #' other ellipse. 6 | #' 7 | #' @param corrected.posteriors the Bayesian ellipses as returned by 8 | #' [siberMVN()]. 9 | #' 10 | #' @return A list containing two arrays, one `r` contains the pairwise 11 | #' distances between ellipse centroids in as the first two dimensions, with 12 | #' the third dimension containing the same for each posterior draw defining 13 | #' the ellipse. The second array `theta` has the same structure and 14 | #' contains the angle in radians (from 0 to 2*pi) between the pairs. A third 15 | #' object `labels` refers to which community.group combination is in 16 | #' each of the first two dimensions of the arrays. 17 | #' @export 18 | 19 | siberCentroids <- function (corrected.posteriors) { 20 | 21 | # prep a list for storing the results 22 | centroids <- list() 23 | 24 | n.ellipses <- length(corrected.posteriors) 25 | 26 | n.draws <- nrow(corrected.posteriors[[1]]) 27 | 28 | # prep the three matrices 29 | r <- array(0, dim = c(n.ellipses, n.ellipses, n.draws)) 30 | theta <- r 31 | labels <- array("NA", dim = c(n.ellipses, n.ellipses)) 32 | 33 | # loop over pairs of ellipses to calculate the vectors between their centroids 34 | # we can just do one half of the pair-wise matrix for efficiency 35 | for (i in 1:(n.ellipses-1)){ 36 | 37 | for (j in (i+1):(n.ellipses)){ 38 | 39 | # store the labels of the comparisons 40 | labels[i,j] <- paste(names(corrected.posteriors[i]), 41 | names(corrected.posteriors[j]), 42 | sep = "|") 43 | 44 | labels[j,i] <- paste(names(corrected.posteriors[j]), 45 | names(corrected.posteriors[i]), 46 | sep = "|") 47 | 48 | # extract x and y for the ith ellipse 49 | x1 <- corrected.posteriors[[i]][,5] 50 | y1 <- corrected.posteriors[[i]][,6] 51 | 52 | # extract x and y for the jth ellipse 53 | x2 <- corrected.posteriors[[j]][,5] 54 | y2 <- corrected.posteriors[[j]][,6] 55 | 56 | # distances are symmetrical 57 | r[j,i,] <- r[i,j,] <- sqrt( (x1 - x2)^2 + (y1 - y2)^2 ) 58 | 59 | # angles are in opposite directions for each comparison 60 | 61 | # upper triangle for angle with first ellipse moved to the origin 62 | theta[i,j,] <- atan2(y2-y1, x2-x1) 63 | 64 | # lower triangle for angle with second ellipse moved to origin 65 | theta[j,i,] <- atan2(y1-y2, x1-x2) 66 | 67 | } 68 | 69 | } 70 | 71 | # bundle the arrays for output 72 | centroids$r <- r 73 | centroids$theta <- theta 74 | centroids$labels <- labels 75 | 76 | return(centroids) 77 | } 78 | -------------------------------------------------------------------------------- /R/laymanmetrics.R: -------------------------------------------------------------------------------- 1 | #' Calculates the 6 Layman metrics on a vector of x and y data 2 | #' 3 | #' This function takes two x and y vectors, and calculates the corresponding 4 | #' 6 Layman metrics based on these points. Note that for generality, the 5 | #' original metrics of dC_range and dN_range have been renamed dX_range and 6 | #' dY_range respectively. These modified names represent the x and y axes in 7 | #' terms of the order in which the data have been entered, and relate typically 8 | #' to how one plots the data. These x and y vectors could represent the means 9 | #' of the group members comprising a community as is preferred under the SIBER 10 | #' model framework. However, one could use them to calculate the point estimates 11 | #' of the 6 Layman metrics for an entire group of data. In fact, you are free 12 | #' to pass this function any set of `x` and `y` data you wish. 13 | #' 14 | #' 15 | #' @param x a vector of locations in the x-axis direction. 16 | #' @param y a vector of locations in the y-axis direction. 17 | #' 18 | #' @return A vector of the 6 Layman metrics of dX_range, dY_range, TA, 19 | #' CD, MNND and SDNND 20 | #' 21 | #' @examples 22 | #' x <- stats::runif(10) 23 | #' y <- stats::runif(10) 24 | #' laymanMetrics(x, y) 25 | #' 26 | #' @export 27 | 28 | # NOTE - i have changed the name of dN_range to dY_range and 29 | # dC_range to dX_range to make it more generic. 30 | 31 | laymanMetrics <- function(x,y){ 32 | 33 | out <- list() 34 | 35 | metrics <- double(length=6) 36 | names(metrics) <- c("dY_range","dX_range", 37 | "TA","CD","NND","SDNND") 38 | 39 | # -------------------------------------- 40 | # Layman metric # 1 - dN range 41 | metrics[1] <- max(y) - min(y) 42 | 43 | # -------------------------------------- 44 | # Layman metric # 2 - dC range 45 | metrics[2] <- max(x) - min(x) 46 | 47 | # -------------------------------------- 48 | # Layman metric #3 - area of convex hull 49 | # some convex hull stuff 50 | # NOTE - should add a condition ehre that only calls this if there are more 51 | # than 2 groups. 52 | hull <- siberConvexhull(x,y) 53 | 54 | metrics[3] <- hull$TA 55 | 56 | # -------------------------------------- 57 | # Layman metric # 4 - mean distance to centroid CD 58 | mean_y <- mean(y) 59 | mean_x <- mean(x) 60 | 61 | metrics[4] <- mean( ( (mean_x - x)^2 + (mean_y - y)^2 ) ^ 0.5 ) 62 | 63 | # -------------------------------------- 64 | # Layman metric # 5 - mean nearest neighbour distance NND 65 | NNDs <- numeric(length(x)) 66 | for (j in 1:length(x)){ 67 | tmp <- ( (x[j] - x)^2 + (y[j] - y)^2 ) ^ 0.5 68 | tmp[j] <- max(tmp) 69 | NNDs[j] <- min(tmp) 70 | } 71 | 72 | metrics[5] <- mean(NNDs) 73 | 74 | # -------------------------------------- 75 | # Layman metric # 6 - standard deviation of nearest neighbour distance SDNND 76 | metrics[6] <- stats::sd(NNDs) 77 | 78 | # -------------------------------------- 79 | out$metrics <- metrics 80 | out$hull <- hull #output additional information on the hull 81 | 82 | return(out) 83 | 84 | } -------------------------------------------------------------------------------- /inst/extdata/test.group.names.csv: -------------------------------------------------------------------------------- 1 | iso1,iso2,group,community 5.132626337,3.688303346,A,1 5.027934415,4.86449461,A,1 6.043919263,7.318477302,A,1 5.110484276,5.406555477,A,1 4.755094023,3.77654147,A,1 5.35203914,5.617408095,A,1 4.96480273,3.855380519,A,1 5.485278005,5.425605628,A,1 5.310339664,4.98686112,A,1 4.922920527,3.40061299,A,1 4.995183205,3.994522482,A,1 6.079741693,6.703973534,A,1 5.667668213,6.246105804,A,1 5.205787713,5.192862848,A,1 4.964732589,4.183737055,A,1 5.224107993,4.974401533,A,1 4.992166699,4.083743111,A,1 5.925788905,7.077552652,A,1 5.29923779,4.813968073,A,1 5.954730084,6.566349426,A,1 0.186432047,3.60685959,B,1 3.53581808,4.225075007,B,1 0.504743861,4.391172372,B,1 2.624164956,4.545632584,B,1 -0.054902607,4.614149715,B,1 -1.113834017,3.916090414,B,1 0.780661622,5.916003992,B,1 2.23226819,5.004188948,B,1 2.466778349,5.259539064,B,1 3.080695315,2.416390976,B,1 -0.908995482,5.959884781,B,1 3.495390467,2.008932394,B,1 0.342270113,3.99767439,B,1 1.335476776,2.852039795,B,1 1.736848919,1.843641011,B,1 0.207525262,6.615010247,B,1 -1.151851479,4.203319505,B,1 0.600401651,4.212496411,B,1 1.250162161,3.953428173,B,1 0.120473278,5.058224924,B,1 -3.688510878,11.69510182,C,1 -2.906022384,10.93901342,C,1 6.77827967,7.865499873,C,1 0.894642457,10.88325565,C,1 -1.668558317,9.213310114,C,1 -0.94066673,6.163726342,C,1 4.110663246,9.377163909,C,1 1.657192561,7.462571797,C,1 -0.075812522,13.09718642,C,1 -1.388245018,7.460632999,C,1 -1.727593713,5.825064099,C,1 7.045624514,5.655886041,C,1 3.705080392,3.922238305,C,1 6.926990223,6.022669553,C,1 -0.398681454,3.066479872,C,1 -0.186033824,2.893589666,C,1 -2.225552909,11.25626059,C,1 0.116377112,8.889179479,C,1 2.294062806,9.285560188,C,1 4.968259159,-0.782315842,C,1 6.00688289,2.337958172,D,1 8.294047021,2.692525403,D,1 10.90199989,1.43206863,D,1 7.705966491,0.92379691,D,1 10.0504632,3.348141318,D,1 11.78596602,0.266933853,D,1 8.108676329,-0.311553644,D,1 11.55182111,7.901243686,D,1 11.27023748,-1.74532422,D,1 7.706629171,-1.290571585,D,1 7.205830206,3.582226344,D,1 12.3892023,6.000890177,D,1 9.380700364,4.159523124,D,1 11.722788,3.364908249,D,1 7.607627329,2.231744866,D,1 13.18092562,1.788754671,D,1 6.297666993,-0.549545151,D,1 11.83613119,2.684453952,D,1 11.04510384,0.816048666,D,1 10.52970271,4.603357269,D,1 1.476720507,1.171080752,B,2 1.784741146,-0.11561985,B,2 2.08297958,-0.2261449,B,2 1.692399389,-0.797729971,B,2 2.593706835,-1.46970523,B,2 0.929267912,-0.1962235,B,2 0.31619655,0.055579962,B,2 0.348280934,-2.053193351,B,2 -8.849011203,1.709618765,E,2 -8.953236083,-0.462825099,E,2 -7.940819714,-0.40929352,E,2 -8.218187931,0.881776554,E,2 -8.218016576,1.499232226,E,2 -7.790318337,1.280248658,E,2 -7.677389787,-1.072009829,E,2 -7.495402153,0.276722443,E,2 11.45850432,7.617667678,D,2 9.618915736,7.145801589,D,2 11.77297936,7.455546302,D,2 8.971193179,6.237827739,D,2 10.18513688,7.100260793,D,2 11.85945547,5.991249237,D,2 11.00042992,5.213454448,D,2 10.14026527,6.422861357,D,2 10.3086129,0.272440221,A,2 10.47976961,0.61815617,A,2 9.896092767,2.799151988,A,2 10.90443436,1.241479635,A,2 9.470909788,0.258169823,A,2 9.089354342,1.781800376,A,2 10.15331623,2.056178158,A,2 9.04291357,1.818245356,A,2 -------------------------------------------------------------------------------- /R/specificCentroidVectors.R: -------------------------------------------------------------------------------- 1 | #' Calculate the pairwise distances and angles describing the difference between 2 | #' centroids of paired groups 3 | #' 4 | #' Plots the posterior densities 5 | #' 6 | #' @param centroids the list containing distance and angle matrices as returned 7 | #' by [siberCentroids()]. 8 | #' @param do.these a character vector of the pattern used to find paired matches in 9 | #' the matrix of all comparisons. Usually the group names within any of the 10 | #' communities. 11 | #' @param upper a logical determining whether to plot the upper or lower 12 | #' triangle of angles. Defaults to TRUE which is the upper triangle and 13 | #' returns the angle from the second ellipse to the first by centering on the 14 | #' first centroid. 15 | #' @param do.plot a logical indicating whether plotting should be done or not. 16 | #' Defaults to TRUE. 17 | #' @param ... additional arguments to pass onwards, not currently implemented. 18 | #' 19 | #' @return A nice plot. You can get the corresponding matrices used to generate 20 | #' the plots if you ask for it nicely: thedata <- 21 | #' plotCentroidVectors(centroids) 22 | #' @importFrom magrittr %>% 23 | #' 24 | #' @export 25 | # magrittr::`%>%` 26 | 27 | specificCentroidVectors <- function (centroids, do.these, upper = TRUE, 28 | do.plot = TRUE, ...) { 29 | 30 | # appease CRAN checks 31 | comparison <- NULL 32 | 33 | # how big is the data array 34 | dd <- dim(centroids$r) 35 | 36 | # find the names that match 37 | idx <- centroids$labels %in% do.these 38 | 39 | matrix.idx <- matrix(FALSE, dd[1], dd[2]) 40 | matrix.idx[idx] <- TRUE 41 | 42 | 43 | # number of pairwise comparisons 44 | n.comp <- length(do.these) 45 | 46 | # prep the matrices for passing to the plotting function 47 | angles <- distances <- matrix(0, dd[3], n.comp) 48 | 49 | new.names <- rep("NA", n.comp) 50 | 51 | # loop and extract the data in to the matrix 52 | # AJ - I NEED TO IMPLEMENT A SWITCH FOR THE LOWER TRIANGLE FOR ANGLES 53 | 54 | ct <- 1 # a counter 55 | 56 | for (i in 1:dd[1]){ 57 | 58 | for (j in 1:dd[2]){ 59 | 60 | if (matrix.idx[i,j]){ 61 | 62 | distances[,ct] <- centroids$r[i,j,] 63 | 64 | angles[,ct] <- centroids$theta[i,j,] 65 | 66 | new.names[ct]<- centroids$labels[i,j] 67 | 68 | ct <- ct + 1 69 | 70 | } # end of if statement 71 | 72 | 73 | 74 | } # end j loop 75 | } # end i loop 76 | 77 | 78 | # browser() 79 | colnames(distances) <- new.names 80 | colnames(angles) <- new.names 81 | 82 | if(do.plot){ 83 | siberDensityPlot(distances) 84 | siberDensityPlot(angles) 85 | } 86 | 87 | 88 | # convert from wide to long format 89 | long_data_angles <- tidyr::gather(data.frame(angles), 90 | key = comparison, value = angles) 91 | 92 | long_data_distances <- tidyr::gather(data.frame(distances), 93 | key = comparison, value = distances) 94 | 95 | angles_distances <- long_data_angles 96 | angles_distances$distances <- long_data_distances$distances 97 | 98 | 99 | # return if asked 100 | invisible(angles_distances) 101 | 102 | 103 | } 104 | -------------------------------------------------------------------------------- /inst/extdata/test.community.names.csv: -------------------------------------------------------------------------------- 1 | iso1,iso2,group,community 5.132626337,3.688303346,A,west 5.027934415,4.86449461,A,west 6.043919263,7.318477302,A,west 5.110484276,5.406555477,A,west 4.755094023,3.77654147,A,west 5.35203914,5.617408095,A,west 4.96480273,3.855380519,A,west 5.485278005,5.425605628,A,west 5.310339664,4.98686112,A,west 4.922920527,3.40061299,A,west 4.995183205,3.994522482,A,west 6.079741693,6.703973534,A,west 5.667668213,6.246105804,A,west 5.205787713,5.192862848,A,west 4.964732589,4.183737055,A,west 5.224107993,4.974401533,A,west 4.992166699,4.083743111,A,west 5.925788905,7.077552652,A,west 5.29923779,4.813968073,A,west 5.954730084,6.566349426,A,west 0.186432047,3.60685959,B,west 3.53581808,4.225075007,B,west 0.504743861,4.391172372,B,west 2.624164956,4.545632584,B,west -0.054902607,4.614149715,B,west -1.113834017,3.916090414,B,west 0.780661622,5.916003992,B,west 2.23226819,5.004188948,B,west 2.466778349,5.259539064,B,west 3.080695315,2.416390976,B,west -0.908995482,5.959884781,B,west 3.495390467,2.008932394,B,west 0.342270113,3.99767439,B,west 1.335476776,2.852039795,B,west 1.736848919,1.843641011,B,west 0.207525262,6.615010247,B,west -1.151851479,4.203319505,B,west 0.600401651,4.212496411,B,west 1.250162161,3.953428173,B,west 0.120473278,5.058224924,B,west -3.688510878,11.69510182,C,west -2.906022384,10.93901342,C,west 6.77827967,7.865499873,C,west 0.894642457,10.88325565,C,west -1.668558317,9.213310114,C,west -0.94066673,6.163726342,C,west 4.110663246,9.377163909,C,west 1.657192561,7.462571797,C,west -0.075812522,13.09718642,C,west -1.388245018,7.460632999,C,west -1.727593713,5.825064099,C,west 7.045624514,5.655886041,C,west 3.705080392,3.922238305,C,west 6.926990223,6.022669553,C,west -0.398681454,3.066479872,C,west -0.186033824,2.893589666,C,west -2.225552909,11.25626059,C,west 0.116377112,8.889179479,C,west 2.294062806,9.285560188,C,west 4.968259159,-0.782315842,C,west 6.00688289,2.337958172,D,west 8.294047021,2.692525403,D,west 10.90199989,1.43206863,D,west 7.705966491,0.92379691,D,west 10.0504632,3.348141318,D,west 11.78596602,0.266933853,D,west 8.108676329,-0.311553644,D,west 11.55182111,7.901243686,D,west 11.27023748,-1.74532422,D,west 7.706629171,-1.290571585,D,west 7.205830206,3.582226344,D,west 12.3892023,6.000890177,D,west 9.380700364,4.159523124,D,west 11.722788,3.364908249,D,west 7.607627329,2.231744866,D,west 13.18092562,1.788754671,D,west 6.297666993,-0.549545151,D,west 11.83613119,2.684453952,D,west 11.04510384,0.816048666,D,west 10.52970271,4.603357269,D,west 1.476720507,1.171080752,B,east 1.784741146,-0.11561985,B,east 2.08297958,-0.2261449,B,east 1.692399389,-0.797729971,B,east 2.593706835,-1.46970523,B,east 0.929267912,-0.1962235,B,east 0.31619655,0.055579962,B,east 0.348280934,-2.053193351,B,east -8.849011203,1.709618765,E,east -8.953236083,-0.462825099,E,east -7.940819714,-0.40929352,E,east -8.218187931,0.881776554,E,east -8.218016576,1.499232226,E,east -7.790318337,1.280248658,E,east -7.677389787,-1.072009829,E,east -7.495402153,0.276722443,E,east 11.45850432,7.617667678,D,east 9.618915736,7.145801589,D,east 11.77297936,7.455546302,D,east 8.971193179,6.237827739,D,east 10.18513688,7.100260793,D,east 11.85945547,5.991249237,D,east 11.00042992,5.213454448,D,east 10.14026527,6.422861357,D,east 10.3086129,0.272440221,A,east 10.47976961,0.61815617,A,east 9.896092767,2.799151988,A,east 10.90443436,1.241479635,A,east 9.470909788,0.258169823,A,east 9.089354342,1.781800376,A,east 10.15331623,2.056178158,A,east 9.04291357,1.818245356,A,east -------------------------------------------------------------------------------- /tmp/test-nonnumeric-group-labels.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Test non-numeric group labels" 3 | author: "Andrew L Jackson" 4 | date: "`r Sys.Date()`" 5 | output: html_notebook 6 | --- 7 | Some test code for checking that the group labels as strings works. 8 | 9 | ```{r} 10 | library(SIBER) 11 | 12 | mydata <- read.csv(file.path("../inst/extdata/test.group.names.csv"), 13 | header = TRUE) 14 | 15 | test <- createSiberObject(mydata) 16 | 17 | community.hulls.args <- list(col = 1, lty = 1, lwd = 1) 18 | group.ellipses.args <- list(n = 100, p.interval = 0.95, lty = 1, lwd = 2) 19 | group.hull.args <- list(lty = 2, col = "grey20") 20 | 21 | 22 | 23 | par(mfrow=c(1,1)) 24 | plotSiberObject(test, 25 | ax.pad = 2, 26 | hulls = T, community.hulls.args, 27 | ellipses = T, group.ellipses.args, 28 | group.hulls = T, group.hull.args, 29 | bty = "L", 30 | iso.order = c(1,2), 31 | xlab = expression({delta}^13*C~'permille'), 32 | ylab = expression({delta}^15*N~'permille') 33 | ) 34 | 35 | # Calculate sumamry statistics for each group: TA, SEA and SEAc 36 | group.ML <- groupMetricsML(test) 37 | print(group.ML) 38 | 39 | # Calculate the various Layman metrics on each of the communities. 40 | community.ML <- communityMetricsML(test) 41 | print(community.ML) 42 | 43 | ## ------------------------------------------------------------------------ 44 | 45 | # options for running jags 46 | parms <- list() 47 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 48 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 49 | parms$n.thin <- 10 # thin the posterior by this many 50 | parms$n.chains <- 2 # run this many chains 51 | 52 | # define the priors 53 | priors <- list() 54 | priors$R <- 1 * diag(2) 55 | priors$k <- 2 56 | priors$tau.mu <- 1.0E-3 57 | 58 | # fit the ellipses which uses an Inverse Wishart prior 59 | # on the covariance matrix Sigma, and a vague normal prior on the 60 | # means. Fitting is via the JAGS method. 61 | ellipses.posterior <- siberMVN(test, parms, priors) 62 | 63 | 64 | ## ------------------------------------------------------------------------ 65 | 66 | # The posterior estimates of the ellipses for each group can be used to 67 | # calculate the SEA.B for each group. 68 | SEA.B <- siberEllipses(ellipses.posterior) 69 | 70 | siberDensityPlot(SEA.B, xticklabels = colnames(group.ML), 71 | xlab = c("Community | Group"), 72 | ylab = expression("Standard Ellipse Area " ('permille' ^2) ), 73 | bty = "L", 74 | las = 1, 75 | main = "SIBER ellipses on each group", 76 | ylims = c(0, 70) 77 | ) 78 | 79 | # Add red x's for the ML estimated SEA-c 80 | points(1:ncol(SEA.B), group.ML[3,], col="red", pch = "x", lwd = 2) 81 | 82 | 83 | ``` 84 | 85 | ## Test overlap calculations 86 | 87 | Maximum likelihood 88 | 89 | ```{r} 90 | testML <- maxLikOverlap("1.C", "1.D", 91 | test, 92 | p.interval = 0.95) 93 | ``` 94 | 95 | Bayesian overlap 96 | 97 | ```{r} 98 | 99 | testBayes <- bayesianOverlap("1.C", "1.D", 100 | ellipses.posterior, 101 | p.interval = 0.95, 102 | draws = 1000) 103 | 104 | summary(testBayes) 105 | ``` 106 | 107 | 108 | 109 | -------------------------------------------------------------------------------- /vignettes/Customising-Plots-Manually.R: -------------------------------------------------------------------------------- 1 | ## ----echo = FALSE------------------------------------------------------------- 2 | knitr::opts_chunk$set(collapse = TRUE, comment = "#>", 3 | fig.width = 6, fig.height = 5) 4 | 5 | 6 | ## ----echo = TRUE-------------------------------------------------------------- 7 | # remove previously loaded items from the current environment and remove previous graphics. 8 | rm(list=ls()) 9 | graphics.off() 10 | 11 | # Here, I set the seed each time so that the results are comparable. 12 | # This is useful as it means that anyone that runs your code, *should* 13 | # get the same results as you, although random number generators change 14 | # from time to time. 15 | set.seed(1) 16 | 17 | library(SIBER) 18 | 19 | # Load the viridis package and create a new palette with 3 colours, one for 20 | # each of the 3 groups we have in this dataset. 21 | library(viridis) 22 | palette(viridis(3)) 23 | 24 | # load in the included demonstration dataset 25 | data("demo.siber.data") 26 | 27 | 28 | # 29 | # create the siber object 30 | siber.example <- createSiberObject(demo.siber.data) 31 | 32 | 33 | 34 | ## ----echo=TRUE---------------------------------------------------------------- 35 | plotSiberObject(siber.example, 36 | ax.pad = 2, 37 | hulls = FALSE, 38 | ellipses = FALSE, 39 | group.hulls = FALSE, 40 | bty = "L", 41 | iso.order = c(1,2), 42 | xlab = expression({delta}^13*C~'permille'), 43 | ylab = expression({delta}^15*N~'permille'), 44 | points.order = c(24,22) 45 | ) 46 | # Call addEllipse directly on each group to customise the plot fully 47 | 48 | # change c.id and g.id to select the group of data you want 49 | # you could embed this in a loop easily enough if you wanted to 50 | # set up the order of lines and simply loop through them. 51 | c.id <- 1 # specify the community ID 52 | g.id <- 1 # specify the group ID within the community 53 | 54 | # see help file for addEllipse for more information 55 | # NB i am using the group identifier g.id to select the colour 56 | # of the ellipse line so that it matches the one created by 57 | # plotSiberObject(), but you could override this if you wish. 58 | # The function addEllipse returns the coordinates it used for plotting, 59 | # but more than likely you dont need this information. Here I store these in 60 | # a new variable coords for clarity, but you could just as easily call this tmp. 61 | # See help file for addEllipse for more details on the options, but in short: 62 | # the first two entries look up the means and covariance matrix of the data you 63 | # specified using the group and commmunity indices above. 64 | # m = NULL is used as we are not plotting an ellipse around the mean. 65 | # n = 100 just determines how many points are used to draw a smooth ellipse. 66 | # p.interval = 0.95 for a 95% ellipse of the data 67 | # ci.mean = FALSE as we are not plotting an ellipse around the mean. 68 | # col = your choice of colour. 69 | # lty = your choice of line type. 70 | # lwd = your choice of line width. 71 | coords <- addEllipse(siber.example$ML.mu[[c.id]][ , , g.id], 72 | siber.example$ML.cov[[c.id]][ , , g.id], 73 | m = NULL, 74 | n = 100, 75 | p.interval = 0.95, 76 | ci.mean = FALSE, 77 | col = g.id, 78 | lty = 3, 79 | lwd = 2) 80 | 81 | -------------------------------------------------------------------------------- /R/siberKapow.R: -------------------------------------------------------------------------------- 1 | #' Calculates the boundary of a union of ellipses 2 | #' 3 | #' Intended to calculate the area of an ellipse as a proportion of a group of 4 | #' ellipses represented by their union, i.e. the total area encompassed by all 5 | #' ellipses superimposed. 6 | #' 7 | #' @param dtf a data.frame object comprising bivariate data as a requirement, 8 | #' and possibly other variables too but these are currently ignored. 9 | #' @param isoNames a character vector of length 2 providing the names of the 10 | #' variables containing the x and y data respectively. 11 | #' @param group a character vector of length 1 providing the name of the 12 | #' grouping variable on which to calculate the KAPOW ellipse. 13 | #' @param pEll the probability ellipse to draw for each group. Defaults to the 14 | #' Standard Ellipse with `pEll = stats::pchisq(1, df = 2)`. 15 | #' 16 | #' @return an object of class `spatstat.geom::owin` containing the numerically calculated 17 | #' ellipses and their union along with the raw ellipse boundaries in both raw 18 | #' and `spatstat.geom::owin` format. 19 | #' 20 | #' @import ggplot2 21 | #' @import dplyr 22 | #' @importFrom magrittr "%>%" 23 | #' 24 | #' @export 25 | 26 | siberKapow <- function(dtf, isoNames = c("iso1", "iso2"), 27 | group = "group", pEll = stats::pchisq(1, df = 2)){ 28 | 29 | # a function to calculate the boundaries of an individual ellipse 30 | calcBoundaries <- function(dd){ 31 | 32 | mu <- dd %>% select(isoNames) %>% colMeans() 33 | 34 | Sigma <- dd %>% select(isoNames) %>% stats::cov() 35 | 36 | # turn the mean and covariance matrix into a set of xy coordinates 37 | # demarcating the ellipse boundary. SIBER::addellipse() 38 | out <- addEllipse(mu, Sigma, 39 | m = nrow(dd), 40 | n = 360 * 1, 41 | p.interval = pEll, 42 | ci.mean = FALSE, 43 | lty = 3, 44 | lwd = 2, 45 | small.sample = TRUE, 46 | do.plot = FALSE) 47 | 48 | # remove the last, and replicated point as the subsequent 49 | # spatstat functions dont want any replicates. 50 | return(slice(data.frame(out), -n())) 51 | } 52 | 53 | # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 54 | 55 | 56 | # apply our function to each group to calcluate the ellipse boundaries 57 | ellCoords <- dtf %>% ungroup() %>% droplevels() %>% 58 | # group_by_(.dots = "group") %>% 59 | group_by_(.dots = group) %>% 60 | do(calcBoundaries(.data)) 61 | 62 | # split the dataset by the defined grouping parameter 63 | # The piped version causes NOTEs 64 | # "no visible binding for global variable ‘group’" 65 | # ellCoords.list <- ellCoords %>% split(., .[,group]) 66 | # ellCoords.list <- split(ellCoords, ellCoords$group) 67 | ellCoords.list <- split(ellCoords, ellCoords[`group`]) 68 | 69 | # Define a short custom function and then apply it over the list 70 | # using map() 71 | ell2owin <- function(x){spatstat.geom::owin(poly = list(x = x$X1, y = x$X2))} 72 | owin.coords <- purrr::map(ellCoords.list, ell2owin) 73 | 74 | # pass the list of ellipses for each individal to spatstat.geom::union.owin 75 | # using do.call, which i dont really like but it is the only way i have 76 | # found to parse the list correctly into union.owin. That is, I want 77 | # this.list <- list(a,b,c) to be passed as union.owin(a,b,c) 78 | boundaries <- do.call(get("union.owin", asNamespace("spatstat.geom")), 79 | owin.coords) 80 | 81 | # bundle these coordinates into the boundaries object for later recall 82 | boundaries$owin.coords <- owin.coords 83 | boundaries$ell.coords <- ellCoords 84 | names(boundaries$owin.coords) <- names(ellCoords.list) 85 | 86 | return(boundaries) 87 | 88 | } 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | -------------------------------------------------------------------------------- /man/plotSiberObject.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotSiberObject.R 3 | \name{plotSiberObject} 4 | \alias{plotSiberObject} 5 | \title{Creates an isotope scatterplot and provides a wrapper to ellipse and hull plotting} 6 | \usage{ 7 | plotSiberObject( 8 | siber, 9 | iso.order = c(1, 2), 10 | ax.pad = 1, 11 | hulls = TRUE, 12 | community.hulls.args = NULL, 13 | ellipses = TRUE, 14 | group.ellipses.args = NULL, 15 | group.hulls = FALSE, 16 | group.hulls.args = NULL, 17 | bty = "L", 18 | xlab = "Isotope 1", 19 | ylab = "Isotope 2", 20 | las = 1, 21 | x.limits = NULL, 22 | y.limits = NULL, 23 | points.order = 1:25, 24 | ... 25 | ) 26 | } 27 | \arguments{ 28 | \item{siber}{a siber object as created by \code{\link[=createSiberObject]{createSiberObject()}}.} 29 | 30 | \item{iso.order}{a vector of length 2, either \code{c(1,2)} or \code{c(2,1)}. The order 31 | determines which of the columns of raw data are plotted on the x (1) or y 32 | (2) axis. N.B. this will be deprecated in a future release, and plotting 33 | order will be achieved at point of data-entry.} 34 | 35 | \item{ax.pad}{a padding amount to apply to the x-axis either side of the 36 | extremes of the data. Defaults to 1.} 37 | 38 | \item{hulls}{a logical defaulting to \code{TRUE} determining whether or not hulls 39 | based on the means of groups within communities should be drawn. That is, a 40 | community-level convex hull.} 41 | 42 | \item{community.hulls.args}{a list of plotting arguments to pass to 43 | \code{\link[=plotCommunityHulls]{plotCommunityHulls()}}. See \code{\link[=plotCommunityHulls]{plotCommunityHulls()}} for 44 | further details.} 45 | 46 | \item{ellipses}{a logical defaulting to TRUE determining whether or not an 47 | ellipse should be drawn around each group within each community.} 48 | 49 | \item{group.ellipses.args}{a list of plotting arguments to pass to 50 | \code{\link[=plotGroupEllipses]{plotGroupEllipses()}}. See \code{\link[=plotGroupEllipses]{plotGroupEllipses()}} for 51 | further details.} 52 | 53 | \item{group.hulls}{a logical defaulting to FALSE determining whether or not 54 | convex hulls should be drawn around each group within each community.} 55 | 56 | \item{group.hulls.args}{a list of plotting options to pass to 57 | \code{\link[=plotGroupHulls]{plotGroupHulls()}}. See \code{\link[=plotGroupHulls]{plotGroupHulls()}} for further 58 | details.} 59 | 60 | \item{bty}{a string specifying the box type for the plot. See 61 | \code{\link[graphics:par]{graphics::par()}} for details.} 62 | 63 | \item{xlab}{a string for the x-axis label.} 64 | 65 | \item{ylab}{a string for the y-axis label.} 66 | 67 | \item{las}{a scalar determining the rotation of the y-axis labels. Defaults 68 | to horizontal with \code{las = 1}. See \code{\link[graphics:par]{graphics::par()}} for more 69 | details.} 70 | 71 | \item{x.limits}{allows you to specify a two-element vector of lower and upper 72 | x-axis limits. Specifying this argument over-rides the automatic plotting 73 | and ax.pad option. Defaults to NULL.} 74 | 75 | \item{y.limits}{allows you to specify a two-element vector of lower and upper 76 | y-axis limits. Specifying this argument over-rides the automatic plotting 77 | and ax.pad option. Defaults to NULL.} 78 | 79 | \item{points.order}{a vector of integers specifying the order of point types 80 | to use. See \code{\link[graphics:points]{graphics::points()}} for how integers map onto point 81 | types. Defaults to the sequence 1:15 as per \code{\link[graphics:points]{graphics::points()}}. 82 | It must have at least as many entries as there are communities to plot, 83 | else a warning will be issued, and the order will default to the sequence 84 | \code{1:25}.} 85 | 86 | \item{...}{additional arguments to be passed to \code{\link[graphics:plot.default]{graphics::plot()}}.} 87 | } 88 | \value{ 89 | An isotope scatterplot. 90 | } 91 | \description{ 92 | This function takes a SIBER object as created by 93 | \code{\link{createSiberObject}}, and loops over communities and their groups, 94 | creating a scatterplot, and adding ellipses and hulls as desired. Ellipses can be 95 | added to groups, while convex hulls can be added at both the group and 96 | community level (the former for illustrative purposes only, with no 97 | analytical tools in SIBER to fit Bayesian hulls to individual groups. This is 98 | not mathematically possible in a Bayesian framework.). 99 | } 100 | -------------------------------------------------------------------------------- /R/siberMVN.R: -------------------------------------------------------------------------------- 1 | #' Fit Bayesian bivariate normal distributions to each group in each community 2 | #' 3 | #' This function loops over each community and then loops over each group 4 | #' member, fitting a Bayesian multivariate (bivariate in this case) normal 5 | #' distribution to each group of data. Not intended for direct calling by users. 6 | #' 7 | #' @param siber a siber object as created by [createSiberObject()] 8 | #' @param parms a list containing four items providing details of the 9 | #' [rjags::rjags()] run to be sampled. 10 | #' 11 | #' * `n.iter` The number of iterations to sample 12 | #' * `n.burnin` The number of iterations to discard as a burnin from the 13 | #' start of sampling. 14 | #' * `n.thin` The number of samples to thin by. 15 | #' * `n.chains` The number of chains to fit. 16 | #' 17 | #' @param priors a list of three items specifying the priors to be passed to 18 | #' the jags model. 19 | #' 20 | #' * `R` The scaling vector for the diagonal of Inverse Wishart 21 | #' distribution prior on the covariance matrix Sigma. Typically 22 | #' set to a 2x2 matrix `matrix(c(1, 0, 0, 1), 2, 2)`. 23 | #' * `k` The degrees of freedom of the Inverse Wishart distribution for 24 | #' the covariance matrix Sigma. Typically set to the dimensionality of Sigma, 25 | #' which in this bivariate case is 2. 26 | #' * `tau` The precision on the normal prior on the means mu. 27 | #' 28 | #' 29 | #' @return A list of length equal to the total number of groups in all 30 | #' communities. Each entry is named 1.1 1.2... 2.1.. with the first number 31 | #' designating the community, and the second number the group within that 32 | #' community. So, 2.3 would be the third group within the second community. 33 | #' Each list entry is a 6 x n matrix representing the back-transformed posterior 34 | #' distributions of the bivariate normal distribution, where n is the number of 35 | #' posterior draws in the saved sample. The first two columns are the back- 36 | #' transformed means, and the remaining four columns are the covariance matrix 37 | #' Sigma in vector format. This vector converts to the covariance matrix as 38 | #' `matrix(v[1:4], nrow = 2, ncol = 2)`. 39 | #' 40 | #' @export 41 | 42 | siberMVN <- function (siber, parms, priors) 43 | { 44 | 45 | 46 | # NB in all cases, fitting is performed on mean centred, sd standardised 47 | # transformation to the data. Code at the end then back-transforms the 48 | # covariance matrix and location of the ellipse for downstream plotting 49 | # and calculation of the SEA. 50 | 51 | 52 | 53 | 54 | 55 | # create the SIBER ellipse object to be returned by this function 56 | siber.posterior <- list() 57 | 58 | 59 | ct <- 1 # a counter 60 | 61 | # loop over communities 62 | for (k in 1:siber$n.communities) { 63 | 64 | # loop over groups within each community 65 | for (j in 1:siber$n.groups[2,k]) { 66 | 67 | # find the rows that match the jth group in the kth community 68 | grp.j <- siber$zscore.data[[k]][,"group"] == siber$group.names[[k]][j] 69 | 70 | x.zscore <- siber$zscore.data[[k]][grp.j, 1] 71 | y.zscore <- siber$zscore.data[[k]][grp.j, 2] 72 | 73 | # create a label for passing to fitEllipse to help identify 74 | # the model output if it is saved. 75 | id <- paste0("community", k, "_group", j) 76 | 77 | # fit the ellipses to each group in the dataset 78 | model <- fitEllipse(x.zscore, y.zscore, parms, priors, id) 79 | 80 | corrected.posteriors <- ellipseBackTransform(model, siber, k, j) 81 | 82 | 83 | 84 | # THE POSTERIORS HAVE TO BE ADDED INTO THE SIBER OBJECT AND RETURNED 85 | # I NEED TO CHECK TO SEE IF S3 CLASSES MEAN I DONT HAVE TO PASS IN AND OUT 86 | # THE SAME OBJECT EACH TIME WHICH IS WASTEFUL. 87 | siber.posterior[[ct]] <- corrected.posteriors 88 | 89 | ct <- ct + 1 # update the counter 90 | 91 | } 92 | } 93 | 94 | 95 | # give the list objects names for easier retrieval 96 | tmp.names <- unique(paste(siber$original.data[,"community"], 97 | siber$original.data[,"group"], 98 | sep=".") 99 | ) 100 | names(siber.posterior) <- tmp.names 101 | 102 | return(siber.posterior) 103 | } 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /vignettes/Test-convergence.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Test Convergence" 3 | author: "Andrew L Jackson" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Test Convergence} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteDepends{coda} 10 | \usepackage[utf8]{inputenc} 11 | --- 12 | 13 | 14 | In this example we save the raw `jags` model output and test for convergence using the `coda` package. 15 | 16 | ```{r setup} 17 | 18 | library(SIBER) 19 | library(coda) 20 | 21 | ``` 22 | 23 | 24 | Fit a basic SIBER model to the example data bundled with the package, taking care to set `parms$output = TRUE` and to set an appropriate working directory. You might choose to set this as `parms$save.dir = getwd()` to save it to your current working directory or you may choose to specify a specific directory. In this example, I use a temporary R directory to avoid writing to the actual package directory on your machine when you install and build the this package and associated vignette. 25 | 26 | ```{r basic-model} 27 | # load in the included demonstration dataset 28 | data("demo.siber.data") 29 | # 30 | # create the siber object 31 | siber.example <- createSiberObject(demo.siber.data) 32 | 33 | # Calculate summary statistics for each group: TA, SEA and SEAc 34 | group.ML <- groupMetricsML(siber.example) 35 | 36 | # options for running jags 37 | parms <- list() 38 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 39 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 40 | parms$n.thin <- 10 # thin the posterior by this many 41 | parms$n.chains <- 3 # run this many chains 42 | 43 | # set save.output = TRUE 44 | parms$save.output = TRUE 45 | 46 | # you might want to change the directory to your local directory or a 47 | # sub folder in your current working directory. I have to set it to a 48 | # temporary directory that R creates and can use for the purposes of this 49 | # generic vignette that has to run on any computer as the package is 50 | # built and installed. 51 | parms$save.dir = tempdir() 52 | 53 | # define the priors 54 | priors <- list() 55 | priors$R <- 1 * diag(2) 56 | priors$k <- 2 57 | priors$tau.mu <- 1.0E-3 58 | 59 | # fit the ellipses which uses an Inverse Wishart prior 60 | # on the covariance matrix Sigma, and a vague normal prior on the 61 | # means. Fitting is via the JAGS method. 62 | ellipses.posterior <- siberMVN(siber.example, parms, priors) 63 | 64 | 65 | ``` 66 | 67 | Now we want to determine whether our models have converged. There are separate models for each ellipse, and there should be one for each saved in our `parms$save.dir` directory. Note that the `gelman.diag` function does not seem to deal with the multivariate covariance matrix properly. We can calculate the statistic on the marginal parameters of the covariance matrix separately by setting `multivariate = FALSE`. See `?gelman.diag` for more advice and assistance with interpreting this statistic: basically, we are looking for scale reduction factors less than 1.1. These models tend to behave well since we have z-scored the data for each ellipse prior to fitting and so convergence should not be an issue in most cases. 68 | 69 | **_N.B._** the parameter estimates we are performing these convergence tests on are the based on the estimates for the *z-scored* data as fitted by the `jags` model and as saved to file, and so are not the same scale as your actual raw data. In this regard, the means should approximate 0, and the diagonals of the covariance matrix close to 1, with a non-zero off-diagonal. These are back-transformed within SIBER when calculating the subsequent statistics such as SEA or shifts in the bivariate means. 70 | 71 | ```{r test-convergence} 72 | 73 | # get a list of all the files in the save directory 74 | all.files <- dir(parms$save.dir, full.names = TRUE) 75 | 76 | # find which ones are jags model files 77 | model.files <- all.files[grep("jags_output", all.files)] 78 | 79 | # test convergence for the first one 80 | do.this <- 1 81 | 82 | load(model.files[do.this]) 83 | 84 | gelman.diag(output, multivariate = FALSE) 85 | gelman.plot(output, auto.layout = FALSE) 86 | 87 | ``` 88 | 89 | Repeat for whichever or all ellipses you want to test convergence. There are other convergence tests available within the `coda` package and beyond, which you may use with the `mcmc.list` object called `output` that is saved in the various `*.RData` files produced. 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | -------------------------------------------------------------------------------- /R/bayesianOverlap.R: -------------------------------------------------------------------------------- 1 | #' Calculate the overlap between two ellipses based on their posterior 2 | #' distributions. 3 | #' 4 | #' This function loops over the posterior distribution of the means and 5 | #' covariances matrices of two specified groups. 6 | #' 7 | #' @param ellipse1 character code of the form `"x.y"` where `x` is an 8 | #' integer indexing the community, and `y` an integer indexing the group 9 | #' within that community. This specifies the first of two ellipses whose 10 | #' overlap will be compared. 11 | #' 12 | #' @param ellipse2 same as `ellipse1` specifying a second ellipse. 13 | #' 14 | #' @param ellipses.posterior a list of posterior means and covariances fitted 15 | #' using [siberEllipses()]. 16 | #' 17 | #' @param draws an integer specifying how many of the posterior draws are to be 18 | #' used to estimate the posterior overlap. Defaults to `10` which uses 19 | #' the first 10 draws. In all cases, the selection will be `1:draws` so 20 | #' independence of the posterior draws is assumed. Setting to `NULL` will 21 | #' use all the draws (WARNING - like to be very slow). 22 | #' 23 | #' @param p.interval the prediction interval used to scale the ellipse as per 24 | #' [addEllipse()]. 25 | #' 26 | #' @param n the number of points on the edge of the ellipse used to define it. 27 | #' Defaults to `100` as per [addEllipse()]. 28 | #' 29 | #' @param do.plot logical switch to determine whether the corresponding ellipses 30 | #' should be plotted or not. A use-case would be in conjunction with a low 31 | #' numbered `draws` so as to visualise a relatively small number of the 32 | #' posterior ellipses. Defaults to `FALSE`. 33 | #' 34 | #' @return A data.frame comprising three columns: the area of overlap, the area 35 | #' of the first ellipse and the area of the second ellipse and as many rows as 36 | #' specified by `draws`. 37 | #' 38 | #' @export 39 | 40 | 41 | bayesianOverlap <- function(ellipse1, ellipse2, ellipses.posterior, 42 | draws = 10, p.interval = 0.95, n = 100, 43 | do.plot = FALSE) { 44 | 45 | 46 | if (is.null(draws)) draws = nrow(ellipses.posterior[[1]]) 47 | 48 | # prepare the dataframe for collecting results 49 | out <- data.frame(area1 = double(draws), 50 | area2 = double(draws), 51 | overlap = double(draws)) 52 | 53 | 54 | for (i in 1:draws){ 55 | 56 | # -------------------------------------------------------------------------- 57 | # generate the coordinates for the first ellipse 58 | coords.1 <- addEllipse(ellipses.posterior[[ellipse1]][i, 5:6], 59 | matrix(ellipses.posterior[[ellipse1]][i , 1:4], 60 | nrow = 2, ncol = 2), 61 | p.interval = p.interval, 62 | n = n, 63 | do.plot = do.plot, 64 | small.sample = FALSE) 65 | 66 | # calculate the area of this ellipse using the triangle method. 67 | area.1 <- hullArea(coords.1[,1], coords.1[,2]) 68 | 69 | # -------------------------------------------------------------------------- 70 | # generate the coordinates for the second ellipse 71 | coords.2 <- addEllipse(ellipses.posterior[[ellipse2]][i, 5:6], 72 | matrix(ellipses.posterior[[ellipse2]][i, 1:4], 73 | nrow = 2, ncol = 2), 74 | p.interval = p.interval, 75 | n = n, 76 | do.plot = do.plot, 77 | small.sample = FALSE) 78 | 79 | # calculate the area of this ellipse using the triangle method. 80 | area.2 <- hullArea(coords.2[,1], coords.2[,2]) 81 | 82 | # -------------------------------------------------------------------------- 83 | # and then the overlap between the two 84 | # and now we can use the function spatstat.utils::overlap.xypolygon to 85 | # calculate the overlap, which is expressed in units, in this case permil 86 | # squared. 87 | overlap <- abs(spatstat.utils::overlap.xypolygon(list(x = coords.1[,1], 88 | y = coords.1[,2]), 89 | list(x = coords.2[,1], 90 | y = coords.2[,2]) ) ) 91 | 92 | out[i,1:3] <- c(area.1, area.2, overlap) 93 | } 94 | 95 | 96 | return(out) 97 | } 98 | 99 | 100 | 101 | -------------------------------------------------------------------------------- /vignettes/Plot-posterior-ellipses.R: -------------------------------------------------------------------------------- 1 | ## ----setup-------------------------------------------------------------------- 2 | 3 | library(SIBER) 4 | library(dplyr) 5 | library(ggplot2) 6 | library(ellipse) 7 | 8 | 9 | 10 | ## ----basic-model-------------------------------------------------------------- 11 | # load in the included demonstration dataset 12 | data("demo.siber.data") 13 | # 14 | # create the siber object 15 | siber.example <- createSiberObject(demo.siber.data) 16 | 17 | # Calculate summary statistics for each group: TA, SEA and SEAc 18 | group.ML <- groupMetricsML(siber.example) 19 | 20 | # options for running jags 21 | parms <- list() 22 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 23 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 24 | parms$n.thin <- 10 # thin the posterior by this many 25 | parms$n.chains <- 2 # run this many chains 26 | 27 | # define the priors 28 | priors <- list() 29 | priors$R <- 1 * diag(2) 30 | priors$k <- 2 31 | priors$tau.mu <- 1.0E-3 32 | 33 | # fit the ellipses which uses an Inverse Wishart prior 34 | # on the covariance matrix Sigma, and a vague normal prior on the 35 | # means. Fitting is via the JAGS method. 36 | ellipses.posterior <- siberMVN(siber.example, parms, priors) 37 | 38 | # The posterior estimates of the ellipses for each group can be used to 39 | # calculate the SEA.B for each group. 40 | SEA.B <- siberEllipses(ellipses.posterior) 41 | 42 | siberDensityPlot(SEA.B, xticklabels = colnames(group.ML), 43 | xlab = c("Community | Group"), 44 | ylab = expression("Standard Ellipse Area " ('permille' ^2) ), 45 | bty = "L", 46 | las = 1, 47 | main = "SIBER ellipses on each group" 48 | ) 49 | 50 | 51 | ## ----create-ellipse-df-------------------------------------------------------- 52 | 53 | # how many of the posterior draws do you want? 54 | n.posts <- 10 55 | 56 | # decide how big an ellipse you want to draw 57 | p.ell <- 0.95 58 | 59 | # for a standard ellipse use 60 | # p.ell <- pchisq(1,2) 61 | 62 | 63 | 64 | 65 | # a list to store the results 66 | all_ellipses <- list() 67 | 68 | # loop over groups 69 | for (i in 1:length(ellipses.posterior)){ 70 | 71 | # a dummy variable to build in the loop 72 | ell <- NULL 73 | post.id <- NULL 74 | 75 | for ( j in 1:n.posts){ 76 | 77 | # covariance matrix 78 | Sigma <- matrix(ellipses.posterior[[i]][j,1:4], 2, 2) 79 | 80 | # mean 81 | mu <- ellipses.posterior[[i]][j,5:6] 82 | 83 | # ellipse points 84 | 85 | out <- ellipse::ellipse(Sigma, centre = mu , level = p.ell) 86 | 87 | 88 | ell <- rbind(ell, out) 89 | post.id <- c(post.id, rep(j, nrow(out))) 90 | 91 | } 92 | ell <- as.data.frame(ell) 93 | ell$rep <- post.id 94 | all_ellipses[[i]] <- ell 95 | } 96 | 97 | ellipse_df <- bind_rows(all_ellipses, .id = "id") 98 | 99 | 100 | # now we need the group and community names 101 | 102 | # extract them from the ellipses.posterior list 103 | group_comm_names <- names(ellipses.posterior)[as.numeric(ellipse_df$id)] 104 | 105 | # split them and conver to a matrix, NB byrow = T 106 | split_group_comm <- matrix(unlist(strsplit(group_comm_names, "[.]")), 107 | nrow(ellipse_df), 2, byrow = TRUE) 108 | 109 | ellipse_df$community <- split_group_comm[,1] 110 | ellipse_df$group <- split_group_comm[,2] 111 | 112 | ellipse_df <- dplyr::rename(ellipse_df, iso1 = x, iso2 = y) 113 | 114 | 115 | 116 | 117 | ## ----plot-data---------------------------------------------------------------- 118 | first.plot <- ggplot(data = demo.siber.data, aes(iso1, iso2)) + 119 | geom_point(aes(color = factor(group):factor(community)), size = 2)+ 120 | ylab(expression(paste(delta^{15}, "N (permille)")))+ 121 | xlab(expression(paste(delta^{13}, "C (permille)"))) + 122 | theme(text = element_text(size=15)) 123 | print(first.plot) 124 | 125 | 126 | ## ----plot-posts--------------------------------------------------------------- 127 | 128 | second.plot <- first.plot + facet_wrap(~factor(group):factor(community)) 129 | print(second.plot) 130 | 131 | # rename columns of ellipse_df to match the aesthetics 132 | 133 | third.plot <- second.plot + 134 | geom_polygon(data = ellipse_df, 135 | mapping = aes(iso1, iso2, 136 | group = rep, 137 | color = factor(group):factor(community), 138 | fill = NULL), 139 | fill = NA, 140 | alpha = 0.2) 141 | print(third.plot) 142 | 143 | -------------------------------------------------------------------------------- /vignettes/kapow-example.R: -------------------------------------------------------------------------------- 1 | ## ----message=FALSE------------------------------------------------------------ 2 | library(dplyr) 3 | library(purrr) 4 | library(ggplot2) 5 | library(SIBER) 6 | 7 | 8 | ## ----import-data-------------------------------------------------------------- 9 | 10 | # This loads a pre-saved object called mongoose that comprises the 11 | # dataframe for this analysis. 12 | data("mongooseData") 13 | 14 | 15 | # Ordinarily we might typically use code like this to import our data from a 16 | # csv file. 17 | # mongoose <- read.csv("mongooseFullData.csv", header = TRUE, 18 | # stringsAsFactors = FALSE) 19 | 20 | 21 | 22 | ## ----remove-small-n----------------------------------------------------------- 23 | 24 | # min sample size for individual replicates per pack. 25 | min.n <- 4 26 | 27 | mongoose_2 <- mongoose %>% group_by(indiv.id, pack) %>% 28 | filter(n() >= min.n) %>% ungroup() 29 | 30 | # convert pack and indiv.id to factor 31 | mongoose_2 <- mongoose_2 %>% mutate(indiv.id = factor(indiv.id), 32 | pack = factor(pack)) 33 | 34 | # count observations 35 | id_pack_counts <- mongoose %>% count(pack) 36 | 37 | knitr::kable(id_pack_counts) 38 | 39 | 40 | ## ----plot-raw-data, fig.height = 10, eval = FALSE, include = FALSE------------ 41 | # 42 | # p1 <- ggplot(data = mongoose_2, aes(c13, n15, color = indiv.id)) + 43 | # geom_point() + 44 | # viridis::scale_color_viridis(discrete = TRUE, guide = FALSE) + 45 | # facet_wrap(~pack) 46 | # 47 | # print(p1) 48 | # 49 | 50 | ## ----make-packs, results = "hide"--------------------------------------------- 51 | 52 | # split by pack 53 | packs <- mongoose_2 %>% split(.$pack) 54 | 55 | # use purrr::map to apply siberKapow across each pack. 56 | pack_boundaries <- purrr::map(packs, siberKapow, isoNames = c("c13","n15"), 57 | group = "indiv.id", pEll = 0.95) 58 | 59 | 60 | # Define afunction to strip out the boundaries of the union of the 61 | # ellipses and plot them. This function returns the ggplot2 object 62 | # but doesnt actually do the plotting which is handled afterwards. 63 | plotBoundaries <- function(dd, ee){ 64 | 65 | # exdtract the boundary points for each KAPOW shape. 66 | bdry <- data.frame(dd$bdry) 67 | 68 | # the plot object 69 | p <- ggplot(data = ee, aes(c13, n15, color = indiv.id)) + 70 | geom_point() + 71 | viridis::scale_color_viridis(discrete = TRUE, guide = "legend", name = "Individual") + 72 | geom_polygon(data = bdry, mapping = aes(x, y, color = NULL), alpha = 0.2) + 73 | viridis::scale_fill_viridis(discrete = TRUE, guide = FALSE) + 74 | theme_bw() + 75 | ggtitle(paste0("Pack: ", as.character(ee$pack[1]) )) + 76 | geom_polygon(data = dd$ell.coords, aes(X1, X2, group = indiv.id), 77 | alpha = 0.2, fill = NA) 78 | return(p) 79 | 80 | } 81 | 82 | 83 | # map this function over packs and return the un-printed ggplot2 objects 84 | bndry_plots <- purrr::map2(pack_boundaries, packs, plotBoundaries) 85 | 86 | # print them to screen / file 87 | print(bndry_plots) 88 | 89 | 90 | 91 | 92 | ## ----print-areas-------------------------------------------------------------- 93 | 94 | # KAPOW areas for each pack 95 | total.area <- map(pack_boundaries, spatstat.geom::area) 96 | 97 | # a function to extract ellipse coordinates, calculate areas and return 98 | # as a vector not a list. 99 | extractProportions <- function(x){unlist(map(x$owin.coords, spatstat.geom::area))} 100 | 101 | # map our individual ellipse area function over packs 102 | ellipse.areas <- map(pack_boundaries, . %>% extractProportions) 103 | 104 | # calculate ellipses as proportions of the KAPOW for that pack by mapping 105 | # over both the individual ellipses and pack totals and dividing. 106 | ellipse_proportions <- map2(ellipse.areas, total.area, `/`) 107 | 108 | # print(ellipse_proportions) 109 | 110 | # convert to table with a nested map_df call for easier printing. 111 | # Probably possible to use at_depth() to simplify this, but possibly 112 | # not as i use map_df() here. 113 | df_proportions <- map_df(ellipse_proportions, 114 | . %>% map_df(data.frame, .id = "individual"), 115 | .id = "pack" ) 116 | 117 | # rename the ugly variable manually 118 | df_proportions <- rename(df_proportions, Proportion = ".x..i..") 119 | 120 | # print a nice table 121 | knitr::kable(df_proportions, digits = 2) 122 | 123 | # Optional code to save to csv file 124 | # write.csv(df_proportions, file = "mongoose_kapow_niche_proportions.csv", 125 | # row.names = FALSE) 126 | 127 | 128 | -------------------------------------------------------------------------------- /tmp/test_column_naming.R: -------------------------------------------------------------------------------- 1 | rm(list=ls()) 2 | graphics.off() 3 | 4 | # Here, I set the seed each time so that the results are comparable. 5 | # This is useful as it means that anyone that runs your code, *should* 6 | # get the same results as you, although random number generators change 7 | # from time to time. 8 | set.seed(1) 9 | 10 | library("tidyverse") 11 | library("SIBER") 12 | 13 | # ****************************************************************************** 14 | # change this location per your local setup 15 | load("data/demo.siber.data.2.rda") 16 | # ****************************************************************************** 17 | 18 | 19 | siber.example <- createSiberObject(demo.siber.data.2) 20 | 21 | 22 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 23 | ## A plot of the data 24 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 25 | 26 | palette(viridis::viridis(sum(siber.example$n.groups[2,]))) 27 | 28 | # Create lists of plotting arguments to be passed onwards to each 29 | # of the three plotting functions. 30 | community.hulls.args <- list(col = 1, lty = 1, lwd = 1) 31 | group.ellipses.args <- list(n = 100, p.interval = 0.95, lty = 1, lwd = 2) 32 | group.hull.args <- list(lty = 2, col = "grey20") 33 | 34 | 35 | 36 | par(mfrow=c(1,1)) 37 | plotSiberObject(siber.example, 38 | ax.pad = 2, 39 | hulls = F, community.hulls.args, 40 | ellipses = T, group.ellipses.args, 41 | group.hulls = T, group.hull.args, 42 | bty = "L", 43 | iso.order = c(1,2), 44 | xlab = expression({delta}^13*C~'permille'), 45 | ylab = expression({delta}^15*N~'permille') 46 | ) 47 | 48 | 49 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 50 | ## Summaries 51 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 52 | 53 | 54 | # Calculate summary statistics for each group: TA, SEA and SEAc 55 | group.ML <- groupMetricsML(siber.example) 56 | print(group.ML) 57 | 58 | # Calculate the various Layman metrics on each of the communities. 59 | community.ML <- communityMetricsML(siber.example) 60 | print(community.ML) 61 | 62 | 63 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 64 | ## Bayesian ellipses 65 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 66 | 67 | # options for running jags 68 | parms <- list() 69 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 70 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 71 | parms$n.thin <- 10 # thin the posterior by this many 72 | parms$n.chains <- 2 # run this many chains 73 | 74 | # define the priors 75 | priors <- list() 76 | priors$R <- 1 * diag(2) 77 | priors$k <- 2 78 | priors$tau.mu <- 1.0E-3 79 | 80 | # fit the ellipses which uses an Inverse Wishart prior 81 | # on the covariance matrix Sigma, and a vague normal prior on the 82 | # means. Fitting is via the JAGS method. 83 | ellipses.posterior <- siberMVN(siber.example, parms, priors) 84 | 85 | 86 | 87 | 88 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 89 | ## check outputs from siberMVN for correct labelling 90 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 91 | # check the contents of ellipses.posterior as output by siberMVN and restrict 92 | # it to the means of the isotopes for easy comparison to the raw data 93 | t(as.data.frame(lapply(ellipses.posterior, colMeans))[5:6,]) 94 | 95 | # compare the means with those calculated from the raw data 96 | demo.siber.data.2 %>% group_by(community, group) %>% 97 | summarise(mu1 = mean(iso1), mu2 = mean(iso2)) 98 | 99 | # the orders are different, but the values of the means are correct 100 | 101 | 102 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 103 | ## check SEA.B and SEAc estimates 104 | ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 105 | # The posterior estimates of the ellipses for each group can be used to 106 | # calculate the SEA.B for each group. 107 | SEA.B <- siberEllipses(ellipses.posterior) 108 | 109 | # as per the introduction-to-siber vignette under the plotting, these columns 110 | # are labelled in the same order as contained in the group.ML object 111 | colnames(SEA.B) <- colnames(group.ML) 112 | 113 | # we can calculate the mean SEA.B for each 114 | colMeans(SEA.B) 115 | 116 | # which seem to match the SEAc estimates close enough as they should 117 | # certainly the order seems to be right! 118 | group.ML[3,] 119 | -------------------------------------------------------------------------------- /man/siberdensityplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/siberdensityplot.R 3 | \name{siberDensityPlot} 4 | \alias{siberDensityPlot} 5 | \title{Plot credible intervals as shaded boxplots using 6 | \code{\link[hdrcde]{hdr.boxplot}}} 7 | \usage{ 8 | siberDensityPlot( 9 | dat, 10 | probs = c(95, 75, 50), 11 | xlab = "Group", 12 | ylab = "Value", 13 | xticklabels = NULL, 14 | yticklabels = NULL, 15 | clr = matrix(rep(grDevices::gray((9:1)/10), ncol(dat)), nrow = 9, ncol = ncol(dat)), 16 | scl = 1, 17 | xspc = 0.5, 18 | prn = F, 19 | ct = "mode", 20 | ylims = NULL, 21 | lbound = -Inf, 22 | ubound = Inf, 23 | main = "", 24 | ylab.line = 2, 25 | ... 26 | ) 27 | } 28 | \arguments{ 29 | \item{dat}{a matrix of data for which density region boxplots will be 30 | constructed and plotted for each column.} 31 | 32 | \item{probs}{a vector of credible intervals to represent as box edges. 33 | Defaults to \verb{c(95, 75, 50}.} 34 | 35 | \item{xlab}{a string for the x-axis label. Defaults to \code{"Group"}.} 36 | 37 | \item{ylab}{a string of the y-axis label. Defaults to `"Value".} 38 | 39 | \item{xticklabels}{a vector of strings to override the x-axis tick labels.} 40 | 41 | \item{yticklabels}{a vector of strings to override the y-axis tick labels.} 42 | 43 | \item{clr}{a matrix of colours to use for shading each of the box regions. 44 | Defaults to greyscale \code{grDevices::gray((9:1)/10)} replicated for as 45 | many columns as there are in \code{dat}. When specified by the user, rows 46 | contain the colours of each of the confidence regions specified in 47 | \code{probs} and columns represent each of the columns of data in 48 | \code{dat}. In this way, one could have shades of blue, red and yellow for 49 | each of the groups.} 50 | 51 | \item{scl}{a scalar multiplier to scale the box widths. Defaults to 1.} 52 | 53 | \item{xspc}{a scalar determining the amount of spacing between each box. 54 | Defaults to 0.5.} 55 | 56 | \item{prn}{a logical value determining whether summary statistics of each 57 | column should be printed to screen \code{prn = TRUE} or suppressed as per 58 | default \code{prn = FALSE}.} 59 | 60 | \item{ct}{a string of either \code{c("mode", "mean", "median")} which 61 | determines which measure of central tendency will be plotted as a point in 62 | the middle of the boxes. Defaults to \code{"mode"}.} 63 | 64 | \item{ylims}{a vector of length two, specifying the lower and upper limits 65 | for the y-axis. Defaults to \code{NULL} which inspects the data for appropriate 66 | limits.} 67 | 68 | \item{lbound}{a lower boundary to specify on the distribution to avoid the 69 | density kernel estimating values beyond that which can be expected a 70 | priori. Useful for example when plotting dietary proportions which must lie 71 | in the interval \verb{0 <= Y <= 1}. Defaults to \code{-Inf}} 72 | 73 | \item{ubound}{an upper boundary to specify on the distribution to avoid the 74 | density kernel estimating values beyond that which can be expected a 75 | priori. Useful for example when plotting dietary proportions which must lie 76 | in the interval \verb{0 <= Y <= 1}. Defaults to \code{+Inf}.} 77 | 78 | \item{main}{a title for the figure. Defaults to blank.} 79 | 80 | \item{ylab.line}{a postive scalar indicating the line spacing for rendering 81 | the y-axis label. This is included as using the permille symbol has a 82 | tendency to push the axis label off the plotting window margins. See the 83 | \code{line} option in \code{\link[graphics:axis]{graphics::axis()}} for more details as 84 | ylab.line passes to this.} 85 | 86 | \item{...}{further graphical parameters for passing to 87 | \code{\link[graphics:plot.default]{graphics::plot()}}} 88 | } 89 | \value{ 90 | A new figure window. 91 | } 92 | \description{ 93 | This function is essentially \code{\link[hdrcde:hdr.boxplot]{hdrcde::hdr.boxplot()}} but it more 94 | easily works with matrices of data, where each column is a different variable 95 | of interest. It has some limitations though.... 96 | } 97 | \section{Warning}{ 98 | : This function will not currently recognise and plot 99 | multimodal distributions, unlike \code{\link[hdrcde:hdr.boxplot]{hdrcde::hdr.boxplot()}}. You 100 | should take care, and plot basic histograms of each variable (column in the 101 | object you are passing) and check that they are 102 | indeed unimodal as expected. 103 | } 104 | 105 | \examples{ 106 | # A basic default greyscale density plot 107 | Y <- matrix(stats::rnorm(1000), 250, 4) 108 | siberDensityPlot(Y) 109 | 110 | # A more colourful example 111 | my_clrs <- matrix(c("lightblue", "blue", "darkblue", 112 | "red1", "red3", "red4", 113 | "yellow1", "yellow3", "yellow4", 114 | "turquoise", "turquoise3", "turquoise4"), nrow = 3, ncol = 4) 115 | siberDensityPlot(Y, clr = my_clrs) 116 | 117 | } 118 | -------------------------------------------------------------------------------- /vignettes/Plot-SIA-ggplot2.R: -------------------------------------------------------------------------------- 1 | ## ----setup, include=FALSE----------------------------------------------------- 2 | knitr::opts_chunk$set(echo = TRUE, fig.width = 9, fig.height = 6) 3 | 4 | ## ----import-data-------------------------------------------------------------- 5 | 6 | library(SIBER) 7 | library(dplyr) 8 | library(ggplot2) 9 | 10 | # import the data. Replace this line with a read.csv() or similar call 11 | # to you own local file. 12 | data("demo.siber.data") 13 | 14 | # make a copy of our data for use here in this example, and 15 | # set the columns group and community to be factor type using dplyr. 16 | # Additionally rename the isotope data columns and drop the iso1 and iso2 17 | # columns using the .keep option to keep only those that were not used to 18 | # create the new variables, i.e. keep only ones on the left of the "=". 19 | demo_data <- demo.siber.data %>% mutate(group = factor(group), 20 | community = factor(community), 21 | d13C = iso1, 22 | d15N = iso2, 23 | .keep = "unused") 24 | 25 | 26 | ## ----first-gg----------------------------------------------------------------- 27 | 28 | # when plotting colors and shapes, we need to tell ggplot that these are to 29 | # be treated as categorical factor type data, and not numeric. 30 | first.plot <- ggplot(data = demo_data, 31 | aes(x = d13C, 32 | y = d15N)) + 33 | geom_point(aes(color = group, shape = community), size = 5) + 34 | ylab(expression(paste(delta^{15}, "N (permille)"))) + 35 | xlab(expression(paste(delta^{13}, "C (permille)"))) + 36 | theme(text = element_text(size=16)) + 37 | scale_color_viridis_d() 38 | 39 | # And print our plot to screen 40 | print(first.plot) 41 | 42 | 43 | ## ----classic-theme------------------------------------------------------------ 44 | 45 | classic.first.plot <- first.plot + theme_classic() + 46 | theme(text = element_text(size=18)) 47 | 48 | # and print to screen 49 | print(classic.first.plot) 50 | 51 | # options to add to point the axis tick marks inwards 52 | # theme(axis.ticks.length = unit(0.1, "cm")) 53 | 54 | ## ----classic-scatterplot------------------------------------------------------ 55 | 56 | # Summarise By Group (sbg) 57 | sbg <- demo_data %>% 58 | group_by(group, community) %>% 59 | summarise(count = n(), 60 | mC = mean(d13C), 61 | sdC = sd(d13C), 62 | mN = mean(d15N), 63 | sdN = sd(d15N)) 64 | 65 | # make a copy of the first.plot object 66 | # second.plot <- first.plot 67 | 68 | # add the layers using the summary data in sbg 69 | second.plot <- first.plot + 70 | geom_errorbar(data = sbg, 71 | mapping = aes(x = mC, y = mN, 72 | ymin = mN - 1.96*sdN, 73 | ymax = mN + 1.96*sdN), 74 | width = 0) + 75 | geom_errorbarh(data = sbg, 76 | mapping = aes(x = mC, y = mN, 77 | xmin = mC - 1.96*sdC, 78 | xmax = mC + 1.96*sdC), 79 | height = 0) + 80 | geom_point(data = sbg, aes(x = mC, 81 | y = mN, 82 | fill = group), 83 | color = "black", shape = 22, size = 5, 84 | alpha = 0.7, show.legend = FALSE) + 85 | scale_fill_viridis_d() 86 | 87 | 88 | print(second.plot) 89 | 90 | 91 | ## ----nice-ellipses------------------------------------------------------------ 92 | # use our ellipse function to generate the ellipses for plotting 93 | 94 | # decide how big an ellipse you want to draw 95 | p.ell <- 0.95 96 | 97 | # create our plot based on first.plot above adding the stat_ellipse() geometry. 98 | # We specify thee ellipse to be plotted using the polygon geom, with fill and 99 | # edge colour defined by our column "group", using the normal distribution and 100 | # with a quite high level of transparency on the fill so we can see the points 101 | # underneath. In order to get different ellipses plotted by both columns "group" 102 | # and "community" we have to use the interaction() function to ensure both are 103 | # considered in the aes(group = XYZ) specification. Note also the need to 104 | # specify the scale_fill_viridis_d() function as the mapping of colors for 105 | # points and lines is separate to filled objects and we want them to match. 106 | ellipse.plot <- first.plot + 107 | stat_ellipse(aes(group = interaction(group, community), 108 | fill = group, 109 | color = group), 110 | alpha = 0.25, 111 | level = p.ell, 112 | type = "norm", 113 | geom = "polygon") + 114 | scale_fill_viridis_d() 115 | 116 | print(ellipse.plot) 117 | 118 | 119 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | SIBER 2 | ===== 3 | 4 | [![cran version](http://www.r-pkg.org/badges/version/SIBER)](https://CRAN.R-project.org/package=SIBER ) 5 | [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/SIBER?)](https://github.com/r-hub/cranlogs.app) 6 | [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/grand-total/SIBER?color=82b4e8)](https://github.com/r-hub/cranlogs.app) 7 | [![DOI](https://zenodo.org/badge/27975343.svg)](https://zenodo.org/badge/latestdoi/27975343) 8 | 9 | Ellipse and convex hull fitting package to estimate niche width for stable isotope data (and potentially other relevant types of bivariate data). 10 | 11 | [MixSIAR](https://github.com/brianstock/MixSIAR) is intended to encompass all the mixing model functionality in the now defunct SIAR package. Additionally, we have updated the basic mixing model from SIAR and released this as a standalone package for basic mixing model fitting as [simmr](https://CRAN.R-project.org/package=simmr ). 12 | 13 | 14 | ## Installation 15 | 16 | __NOTE__ you will also need to install [JAGS](https://mcmc-jags.sourceforge.io) which is a standalone software that the R package `rjags` provides an interface for SIBER to fit the models. 17 | 18 | The latest stable release package is released on CRAN as v2.1.9. Type `install.packages("SIBER")` in the command line. 19 | 20 | Alternatively, you can install directly from github 21 | 22 | The stable release can be installed by 23 | ```R 24 | # install.packages("devtools") # install if necessary 25 | devtools::install_github("andrewljackson/SIBER@v2.1.9", 26 | build_vignettes = TRUE) 27 | library(SIBER) 28 | ``` 29 | [Release notes](NEWS.md) are available for each version. 30 | 31 | The latest development version is on the master branch. Often this includes some new things that I am working on, but I can't guarantee that the package is stable and it might not install sometimes if I have broken something; usually though I tend to break things on a separate branch and try to keep the master stable as a package even if bits and pieces of the new stuff is not working correctly. 32 | 33 | ```R 34 | # install.packages("devtools") # install if necessary 35 | devtools::install_github("andrewljackson/SIBER@master", 36 | build_vignettes = TRUE) 37 | library(SIBER) 38 | ``` 39 | 40 | 41 | 42 | ## Tutorials 43 | 44 | The package vignettes have been expanded to provide working examples of the two main analysis types along with common sub-analyses. Several vignettes have been developed in response to Frequently Asked Questions. 45 | 46 | ## Frequently Asked Questions (FAQs) 47 | * __How do I make isotope plots in ggplot?__ - see the vignette "Plot-SIA-ggplot2" included in versions >2.1.4 48 | * __Why are my community-level estimates of TA are zero or NA__ - This will arise if you have less than three groups (e.g. species) comprising a community. A triangle with three non-collinear points is the minimum requirement to draw a polygon and so if you have only one or two groups, the area of the TA is zero at best or possibly NA. 49 | * __Error: .onLoad failed in loadNamespace() for 'rjags', details:__ - and similar errors referring to DLLs and dylib etc... This is mostly due to not having the standalone software JAGS installed, or an out of date version that is no longer supported. You can check your latest release and download instructions at [JAGS](https://mcmc-jags.sourceforge.io) 50 | 51 | ## Help, Assistance and Queries 52 | In the first instance, queries about analyses or problems with the software can be posted [here on github](https://github.com/AndrewLJackson/SIBER/issues). Please post a [minimal worked examples](https://www.r-bloggers.com/2013/05/writing-a-minimal-working-example-mwe-in-r/) so that we can recreate the problem and offer solutions. 53 | 54 | Before you contact us, please make sure to check the following: 55 | 56 | + [R](https://cran.r-project.org) is up-to-date: type `version` in your R console window to compare with whats available from CRAN. 57 | + Ensure all your installed pacakges are up-to-date: type `update.packages(ask = FALSE)` and type `yes` in response to questions about installing pacakges from source. 58 | + Ensure you have JAGS installed: see FAQs for details. 59 | 60 | ## Acknowledgements 61 | Some code and much input from my collaborator and co-author [Andrew Parnell](https://www.maynoothuniversity.ie/faculty-science-engineering/our-people/andrew-parnell). Thanks to [Alex Bond](https://alexanderbond.org) for helping identify some problems in model fitting which is now resolved by z-scoring, fitting and back-transforming. Although not affecting every analysis, the potential issue is exemplified in [SIBER-sandbox]( https://github.com/AndrewLJackson/SIBER-sandbox). Thanks to [Edward Doherty](https://github.com/Edward-Doherty) for finding the bug that turned out to be in the creating of z-scores in `createSiberObject`. 62 | 63 | ## Citation 64 | Jackson, A.L., Parnell, A.C., Inger R., & Bearhop, S. 2011. Comparing isotopic niche widths among and within communities: SIBER – Stable Isotope Bayesian Ellipses in R. Journal of Animal Ecology, 80, 595-602. [doi](https://doi.org/10.1111/j.1365-2656.2011.01806.x) 65 | -------------------------------------------------------------------------------- /R/maxLikOverlap.R: -------------------------------------------------------------------------------- 1 | #' Calculate the overlap between two ellipses based on the maximum likelihood 2 | #' fitted ellipses. 3 | #' 4 | #' This function uses the ML estimated means and covariances matrices of two 5 | #' specified groups to calculate the area of overlap. 6 | #' 7 | #' @param ellipse1 character code of the form `"x.y"` where `x` is an 8 | #' integer indexing the community, and `y` an integer indexing the group 9 | #' within that community. This specifies the first of two ellipses whose 10 | #' overlap will be compared. 11 | #' 12 | #' @param ellipse2 same as `ellipse1` specifying a second ellipse. 13 | #' 14 | #' @param siber.object an object created by [createSiberObject()] 15 | #' which contains the ML estimates for the means and covariance matrices for 16 | #' each group. 17 | #' 18 | #' @param p.interval the prediction interval used to scale the ellipse as per 19 | #' [addEllipse()]. 20 | #' 21 | #' @param n the number of points on the edge of the ellipse used to define it. 22 | #' Defaults to `100` as per [addEllipse()]. 23 | #' 24 | #' @param do.plot logical switch to determine whether the corresponding ellipses 25 | #' should be plotted or not. A use-case would be in conjunction with a low 26 | #' numbered `draws` so as to visualise a relatively small number of the 27 | #' posterior ellipses. Defaults to `FALSE`. 28 | #' 29 | #' @return A vector comprising three columns: the area of overlap, the area of 30 | #' the first ellipse and the area of the second ellipse and as many rows as 31 | #' specified by `draws`. 32 | #' 33 | #' @examples 34 | #' # load in the included demonstration dataset data("demo.siber.data") 35 | #' siber.example <- createSiberObject(demo.siber.data) 36 | #' 37 | #' # The first ellipse is referenced using a character string representation 38 | #' # where in "x.y", "x" is the community, and "y" is the group within that 39 | #' # community. 40 | #' ellipse1 <- "1.2" 41 | #' 42 | #' # Ellipse two is similarly defined: community 1, group3 43 | #' ellipse2 <- "1.3" 44 | #' 45 | #' # the overlap betweeen the corresponding 95% prediction ellipses is given by: 46 | #' ellipse95.overlap <- maxLikOverlap(ellipse1, ellipse2, siber.example, 47 | #' p.interval = 0.95, n = 100) 48 | #' 49 | #' @export 50 | 51 | 52 | maxLikOverlap <- function(ellipse1, ellipse2, siber.object, 53 | p.interval = 0.95, n = 100, 54 | do.plot = FALSE) { 55 | 56 | # ---------------------------------------------------------------------------- 57 | # community code for the first ellipse 58 | tmp <- strsplit(ellipse1, "[.]") 59 | c.1 <- tmp[[1]][1] 60 | e.1 <- tmp[[1]][2] 61 | 62 | # see help file for addEllipse for more information. With p.interval = NULL 63 | # and extracting the sample size from siber.examples$sample.sizes, 64 | # I am drawing small sample size corrected, Standard Ellipses around the data. 65 | coords.1 <- addEllipse(siber.object$ML.mu[[c.1]][ , , e.1], 66 | siber.object$ML.cov[[c.1]][ , , e.1], 67 | m = siber.object$sample.sizes[c.1, e.1], 68 | small.sample = TRUE, 69 | n = n, 70 | p.interval = p.interval, 71 | ci.mean = FALSE, 72 | do.plot = FALSE) 73 | 74 | # calculate the area of this ellipse using the triangle method. 75 | area.1 <- hullArea(coords.1[,1], coords.1[,2]) 76 | 77 | # ---------------------------------------------------------------------------- 78 | # community code for the first ellipse 79 | tmp <- strsplit(ellipse2, "[.]") 80 | c.2 <- tmp[[1]][1] 81 | e.2 <- tmp[[1]][2] 82 | 83 | coords.2 <- addEllipse(siber.object$ML.mu[[c.2]][ , , e.2], 84 | siber.object$ML.cov[[c.2]][ , , e.2], 85 | m = siber.object$sample.sizes[c.2, e.2], 86 | small.sample = TRUE, 87 | n = n, 88 | p.interval = p.interval, 89 | ci.mean = FALSE, 90 | do.plot = FALSE) 91 | 92 | # calculate the area of this ellipse using the triangle method. 93 | area.2 <- hullArea(coords.2[,1], coords.2[,2]) 94 | 95 | # ---------------------------------------------------------------------------- 96 | # and then the overlap between the two 97 | # and now we can use the function spatstat.utils::overlap.xypolygon to 98 | # calculate the overlap, which is expressed in units, in this case permil 99 | # squared. 100 | overlap <- abs(spatstat.utils::overlap.xypolygon(list(x = coords.1[,1], 101 | y = coords.1[,2]), 102 | list(x = coords.2[,1], 103 | y = coords.2[,2]) 104 | ) 105 | ) 106 | 107 | out <- c(area.1 = area.1, area.2 = area.2, overlap = overlap) 108 | 109 | return(out) 110 | } 111 | 112 | 113 | 114 | -------------------------------------------------------------------------------- /vignettes/Customising-Plots-Manually.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Customising Plots Manually" 3 | author: "Andrew L Jackson" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Customising Plots Manually} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteDepends{viridis} 10 | \usepackage[utf8]{inputenc} 11 | --- 12 | 13 | ```{r, echo = FALSE} 14 | knitr::opts_chunk$set(collapse = TRUE, comment = "#>", 15 | fig.width = 6, fig.height = 5) 16 | 17 | ``` 18 | 19 | ## Creating a Blank Plot 20 | In the vignette [Introduction to Siber](Introduction-to-SIBER.html) we used the bundled functions `plotSiberObject()` to create plots with ellipses and hulls and saw how we can use `plotGroupEllipses()` to add some customised ellipses. Here we will look in more detail at how we can add customised elements to a blank plot by calling the underlying functions directly. Again we will use the bundled example dataset. 21 | 22 | ```{r, echo = TRUE} 23 | # remove previously loaded items from the current environment and remove previous graphics. 24 | rm(list=ls()) 25 | graphics.off() 26 | 27 | # Here, I set the seed each time so that the results are comparable. 28 | # This is useful as it means that anyone that runs your code, *should* 29 | # get the same results as you, although random number generators change 30 | # from time to time. 31 | set.seed(1) 32 | 33 | library(SIBER) 34 | 35 | # Load the viridis package and create a new palette with 3 colours, one for 36 | # each of the 3 groups we have in this dataset. 37 | library(viridis) 38 | palette(viridis(3)) 39 | 40 | # load in the included demonstration dataset 41 | data("demo.siber.data") 42 | 43 | 44 | # 45 | # create the siber object 46 | siber.example <- createSiberObject(demo.siber.data) 47 | 48 | 49 | ``` 50 | 51 | You don't even have to use `plotSiberObject()` to plot your raw data. You could plot it all yourself directly from your raw data using any points, colours and axes styles that you want. In this example, I override the default points order using the option argument `points.order`. See the help file for the base graphics `points()` function which lists the mapping of the integers `1:25` to the corresponding point type. In this case I use the order `c(24, 22)` which corresponds to open triangles and open squares. 52 | 53 | Next we want to add a single ellipse, fully customised to one of our clusters of data; i.e. one of the groups within a community. Here I define the group and community using two created variables so as you could adapt this run for any group/community combination you wanted, or perhaps more suitably, write a loop to traverse all your data. 54 | 55 | ```{r, echo=TRUE} 56 | plotSiberObject(siber.example, 57 | ax.pad = 2, 58 | hulls = FALSE, 59 | ellipses = FALSE, 60 | group.hulls = FALSE, 61 | bty = "L", 62 | iso.order = c(1,2), 63 | xlab = expression({delta}^13*C~'permille'), 64 | ylab = expression({delta}^15*N~'permille'), 65 | points.order = c(24,22) 66 | ) 67 | # Call addEllipse directly on each group to customise the plot fully 68 | 69 | # change c.id and g.id to select the group of data you want 70 | # you could embed this in a loop easily enough if you wanted to 71 | # set up the order of lines and simply loop through them. 72 | c.id <- 1 # specify the community ID 73 | g.id <- 1 # specify the group ID within the community 74 | 75 | # see help file for addEllipse for more information 76 | # NB i am using the group identifier g.id to select the colour 77 | # of the ellipse line so that it matches the one created by 78 | # plotSiberObject(), but you could override this if you wish. 79 | # The function addEllipse returns the coordinates it used for plotting, 80 | # but more than likely you dont need this information. Here I store these in 81 | # a new variable coords for clarity, but you could just as easily call this tmp. 82 | # See help file for addEllipse for more details on the options, but in short: 83 | # the first two entries look up the means and covariance matrix of the data you 84 | # specified using the group and commmunity indices above. 85 | # m = NULL is used as we are not plotting an ellipse around the mean. 86 | # n = 100 just determines how many points are used to draw a smooth ellipse. 87 | # p.interval = 0.95 for a 95% ellipse of the data 88 | # ci.mean = FALSE as we are not plotting an ellipse around the mean. 89 | # col = your choice of colour. 90 | # lty = your choice of line type. 91 | # lwd = your choice of line width. 92 | coords <- addEllipse(siber.example$ML.mu[[c.id]][ , , g.id], 93 | siber.example$ML.cov[[c.id]][ , , g.id], 94 | m = NULL, 95 | n = 100, 96 | p.interval = 0.95, 97 | ci.mean = FALSE, 98 | col = g.id, 99 | lty = 3, 100 | lwd = 2) 101 | ``` 102 | 103 | As this is just a simple base R graphics window, you can add lines, points and text as you like. You can also call the functions `plotGroupHulls(siber.example)` and `plotCommunityHulls(siber.example)` directly and customise their inputs as per the vignette [Introduction to Siber](Introduction-to-SIBER.html). 104 | 105 | -------------------------------------------------------------------------------- /vignettes/siber-comparing-communities.R: -------------------------------------------------------------------------------- 1 | ## ----echo=FALSE, message = FALSE, fig.width = 7, fig.height = 7--------------- 2 | library(viridis) 3 | palette(viridis(4)) 4 | 5 | ## ----echo=TRUE, message = FALSE, fig.width = 8, fig.height = 6---------------- 6 | 7 | library(SIBER, quietly = TRUE, 8 | verbose = FALSE, 9 | logical.return = FALSE) 10 | 11 | # read in the data 12 | # Replace this line with a call to read.csv() or similar pointing to your 13 | # own dataset. 14 | data("demo.siber.data") 15 | mydata <- demo.siber.data 16 | 17 | # create the siber object 18 | siber.example <- createSiberObject(mydata) 19 | 20 | # Create lists of plotting arguments to be passed onwards to each 21 | # of the three plotting functions. 22 | community.hulls.args <- list(col = 1, lty = 1, lwd = 1) 23 | group.ellipses.args <- list(n = 100, p.interval = 0.95, lty = 1, lwd = 2) 24 | group.hull.args <- list(lty = 2, col = "grey20") 25 | 26 | # plot the raw data 27 | par(mfrow=c(1,1)) 28 | plotSiberObject(siber.example, 29 | ax.pad = 2, 30 | hulls = T, community.hulls.args, 31 | ellipses = F, group.ellipses.args, 32 | group.hulls = F, group.hull.args, 33 | bty = "L", 34 | iso.order = c(1,2), 35 | xlab = expression({delta}^13*C~'permille'), 36 | ylab = expression({delta}^15*N~'permille') 37 | ) 38 | 39 | # add the confidence interval of the means to help locate 40 | # the centre of each data cluster 41 | plotGroupEllipses(siber.example, n = 100, p.interval = 0.95, 42 | ci.mean = T, lty = 1, lwd = 2) 43 | 44 | 45 | 46 | 47 | ## ----echo=TRUE, message = FALSE----------------------------------------------- 48 | 49 | # Fit the Bayesian models 50 | 51 | # options for running jags 52 | parms <- list() 53 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 54 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 55 | parms$n.thin <- 10 # thin the posterior by this many 56 | parms$n.chains <- 2 # run this many chains 57 | 58 | # define the priors 59 | priors <- list() 60 | priors$R <- 1 * diag(2) 61 | priors$k <- 2 62 | priors$tau.mu <- 1.0E-3 63 | 64 | # fit the ellipses which uses an Inverse Wishart prior 65 | # on the covariance matrix Sigma, and a vague normal prior on the 66 | # means. Fitting is via the JAGS method. 67 | ellipses.posterior <- siberMVN(siber.example, parms, priors) 68 | 69 | 70 | ## ----fig.width = 6, fig.height = 6-------------------------------------------- 71 | # extract the posterior means 72 | mu.post <- extractPosteriorMeans(siber.example, ellipses.posterior) 73 | 74 | # calculate the corresponding distribution of layman metrics 75 | layman.B <- bayesianLayman(mu.post) 76 | 77 | 78 | # -------------------------------------- 79 | # Visualise the first community 80 | # -------------------------------------- 81 | 82 | # drop the 3rd column of the posterior which is TA using -3. 83 | siberDensityPlot(layman.B[[1]][ , -3], 84 | xticklabels = colnames(layman.B[[1]][ , -3]), 85 | bty="L", ylim = c(0,20)) 86 | 87 | # add the ML estimates (if you want). Extract the correct means 88 | # from the appropriate array held within the overall array of means. 89 | comm1.layman.ml <- laymanMetrics(siber.example$ML.mu[[1]][1,1,], 90 | siber.example$ML.mu[[1]][1,2,] 91 | ) 92 | 93 | # again drop the 3rd entry which relates to TA 94 | points(1:5, comm1.layman.ml$metrics[-3], 95 | col = "red", pch = "x", lwd = 2) 96 | 97 | 98 | # -------------------------------------- 99 | # Visualise the second community 100 | # -------------------------------------- 101 | siberDensityPlot(layman.B[[2]][ , -3], 102 | xticklabels = colnames(layman.B[[2]][ , -3]), 103 | bty="L", ylim = c(0,20)) 104 | 105 | # add the ML estimates. (if you want) Extract the correct means 106 | # from the appropriate array held within the overall array of means. 107 | comm2.layman.ml <- laymanMetrics(siber.example$ML.mu[[2]][1,1,], 108 | siber.example$ML.mu[[2]][1,2,] 109 | ) 110 | points(1:5, comm2.layman.ml$metrics[-3], 111 | col = "red", pch = "x", lwd = 2) 112 | 113 | 114 | # -------------------------------------- 115 | # Alternatively, pull out TA from both and aggregate them into a 116 | # single matrix using cbind() and plot them together on one graph. 117 | # -------------------------------------- 118 | 119 | # go back to a 1x1 panel plot 120 | par(mfrow=c(1,1)) 121 | 122 | # Now we only plot the TA data. We could address this as either 123 | # layman.B[[1]][, "TA"] 124 | # or 125 | # layman.B[[1]][, 3] 126 | siberDensityPlot(cbind(layman.B[[1]][ , "TA"], 127 | layman.B[[2]][ , "TA"]), 128 | xticklabels = c("Community 1", "Community 2"), 129 | bty="L", ylim = c(0, 90), 130 | las = 1, 131 | ylab = "TA - Convex Hull Area", 132 | xlab = "") 133 | 134 | 135 | ## ----------------------------------------------------------------------------- 136 | 137 | TA1_lt_TA2 <- sum(layman.B[[1]][,"TA"] < 138 | layman.B[[2]][,"TA"]) / 139 | length(layman.B[[1]][,"TA"]) 140 | 141 | print(TA1_lt_TA2) 142 | 143 | 144 | -------------------------------------------------------------------------------- /vignettes/Plot-posterior-ellipses.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Plot Some Posterior Ellipses" 3 | author: "Andrew L Jackson" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Plot Some Posterior Ellipses} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteDepends{ellipse} 10 | \usepackage[utf8]{inputenc} 11 | --- 12 | 13 | 14 | In this example we try to create some plots of the multiple samples of the posterior ellipses using ggplot2. 15 | 16 | ```{r setup} 17 | 18 | library(SIBER) 19 | library(dplyr) 20 | library(ggplot2) 21 | library(ellipse) 22 | 23 | 24 | ``` 25 | 26 | 27 | Fit a basic SIBER model to the example data bundled with the package. 28 | 29 | ```{r basic-model} 30 | # load in the included demonstration dataset 31 | data("demo.siber.data") 32 | # 33 | # create the siber object 34 | siber.example <- createSiberObject(demo.siber.data) 35 | 36 | # Calculate summary statistics for each group: TA, SEA and SEAc 37 | group.ML <- groupMetricsML(siber.example) 38 | 39 | # options for running jags 40 | parms <- list() 41 | parms$n.iter <- 2 * 10^4 # number of iterations to run the model for 42 | parms$n.burnin <- 1 * 10^3 # discard the first set of values 43 | parms$n.thin <- 10 # thin the posterior by this many 44 | parms$n.chains <- 2 # run this many chains 45 | 46 | # define the priors 47 | priors <- list() 48 | priors$R <- 1 * diag(2) 49 | priors$k <- 2 50 | priors$tau.mu <- 1.0E-3 51 | 52 | # fit the ellipses which uses an Inverse Wishart prior 53 | # on the covariance matrix Sigma, and a vague normal prior on the 54 | # means. Fitting is via the JAGS method. 55 | ellipses.posterior <- siberMVN(siber.example, parms, priors) 56 | 57 | # The posterior estimates of the ellipses for each group can be used to 58 | # calculate the SEA.B for each group. 59 | SEA.B <- siberEllipses(ellipses.posterior) 60 | 61 | siberDensityPlot(SEA.B, xticklabels = colnames(group.ML), 62 | xlab = c("Community | Group"), 63 | ylab = expression("Standard Ellipse Area " ('permille' ^2) ), 64 | bty = "L", 65 | las = 1, 66 | main = "SIBER ellipses on each group" 67 | ) 68 | 69 | ``` 70 | 71 | Now we want to create some plots of some sample ellipses from these distributions. We need to create a data.frame object of all the ellipses for each group. In this example we simply take the first 10 posterior draws assuming them to be independent of one another, but you could take a random sample if you prefer. 72 | 73 | ```{r create-ellipse-df} 74 | 75 | # how many of the posterior draws do you want? 76 | n.posts <- 10 77 | 78 | # decide how big an ellipse you want to draw 79 | p.ell <- 0.95 80 | 81 | # for a standard ellipse use 82 | # p.ell <- pchisq(1,2) 83 | 84 | 85 | 86 | 87 | # a list to store the results 88 | all_ellipses <- list() 89 | 90 | # loop over groups 91 | for (i in 1:length(ellipses.posterior)){ 92 | 93 | # a dummy variable to build in the loop 94 | ell <- NULL 95 | post.id <- NULL 96 | 97 | for ( j in 1:n.posts){ 98 | 99 | # covariance matrix 100 | Sigma <- matrix(ellipses.posterior[[i]][j,1:4], 2, 2) 101 | 102 | # mean 103 | mu <- ellipses.posterior[[i]][j,5:6] 104 | 105 | # ellipse points 106 | 107 | out <- ellipse::ellipse(Sigma, centre = mu , level = p.ell) 108 | 109 | 110 | ell <- rbind(ell, out) 111 | post.id <- c(post.id, rep(j, nrow(out))) 112 | 113 | } 114 | ell <- as.data.frame(ell) 115 | ell$rep <- post.id 116 | all_ellipses[[i]] <- ell 117 | } 118 | 119 | ellipse_df <- bind_rows(all_ellipses, .id = "id") 120 | 121 | 122 | # now we need the group and community names 123 | 124 | # extract them from the ellipses.posterior list 125 | group_comm_names <- names(ellipses.posterior)[as.numeric(ellipse_df$id)] 126 | 127 | # split them and conver to a matrix, NB byrow = T 128 | split_group_comm <- matrix(unlist(strsplit(group_comm_names, "[.]")), 129 | nrow(ellipse_df), 2, byrow = TRUE) 130 | 131 | ellipse_df$community <- split_group_comm[,1] 132 | ellipse_df$group <- split_group_comm[,2] 133 | 134 | ellipse_df <- dplyr::rename(ellipse_df, iso1 = x, iso2 = y) 135 | 136 | 137 | 138 | ``` 139 | 140 | 141 | Now to create the plots. First plot all the raw data as we want. 142 | 143 | ```{r plot-data} 144 | first.plot <- ggplot(data = demo.siber.data, aes(iso1, iso2)) + 145 | geom_point(aes(color = factor(group):factor(community)), size = 2)+ 146 | ylab(expression(paste(delta^{15}, "N (permille)")))+ 147 | xlab(expression(paste(delta^{13}, "C (permille)"))) + 148 | theme(text = element_text(size=15)) 149 | print(first.plot) 150 | 151 | ``` 152 | 153 | Now we can try to add the posterior ellipses on top and facet by group 154 | 155 | ```{r plot-posts} 156 | 157 | second.plot <- first.plot + facet_wrap(~factor(group):factor(community)) 158 | print(second.plot) 159 | 160 | # rename columns of ellipse_df to match the aesthetics 161 | 162 | third.plot <- second.plot + 163 | geom_polygon(data = ellipse_df, 164 | mapping = aes(iso1, iso2, 165 | group = rep, 166 | color = factor(group):factor(community), 167 | fill = NULL), 168 | fill = NA, 169 | alpha = 0.2) 170 | print(third.plot) 171 | ``` 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | --------------------------------------------------------------------------------