R/dec_shannon.R

In diversityArch: Computes Diversity Indices for Archaeological Data

#' @title Shannon diversity decomposition
#'
#' @description Computes Shannon diversity and its decomposition
#'
#' @param x Vector of dimension S (number of species) with the number of individuals observed in each species, or the distribution frequencies of species. NA values are allowed.
#' @param groups Vector of dimension S of factors indicating the group of each species.
#'
#' @return
#' \itemize{
#'   \item \code{shannon}: Shannon's total Entropy.
#'   \item \code{within}: Within groups entropy.
#'   \item \code{between}: Between groups entropy.
#'   \item \code{groups}: A data frame with information about each group: relative frequency, internal entropy and number of species.
#' }
#'
#' @seealso \link{shannon}
#'
#' @references
#' Arnaud Barat, Andreu Sansó, Maite Arilla-Osuna, Ruth Blasco, Iñaki Pérez-Fernández, Gabriel Cifuentes-Alcobenda, Rubén Llorente, Daniel Vivar-Ríos, Ella Assaf, Ran Barkai, Avi Gopher, & Jordi Rosell-Ardèvol (2026) <doi:10.1007/s10816-026-09802-3>.
#'
#' @examples
#' data(Qesem_s)
#' dec_shannon(Qesem_s$HU, Qesem_s$Group)
#'
#' @export
dec_shannon <- function(x, groups){
  stopifnot(
    length(x)==length(as.character(groups)),
    is.factor(groups)
  )
  x <- ifelse(x==0, NA, x)
  xx <- na.omit(data.frame(x, groups))
  stopifnot(
    is.numeric(xx$x),
    all(xx$x > 0)
  )
  p <- xx$x/sum(xx$x)
  l <- levels(xx$groups)
  m <- length(l)
  P <- numeric(m)
  Hg <- numeric(m)
  S <- numeric(m)
  for (i in 1:m){
    P[i] <- sum(p[xx$groups==l[i]])
    Hg[i] <- -sum(p[xx$groups==l[i]]/P[i]*log(p[xx$groups==l[i]]/P[i]))
    S[i] <- sum(xx$groups==l[i])
  }
  g <- data.frame(group=l, Prop=P, Entropy=Hg, S=S)
  rownames(g) <- NULL
  return(list(shannon = -sum(p*log(p)),
              within = sum(P*Hg),
              between = -sum(P*log(P)),
              groups = g))
}