R/dist_bray.R

In MarianaLag/Mlag: Tools Related to the Spatial Analysis of Genetic Marker Data

#' Estimation of jaccard distance
#' 
#' This function returns a measure of genetic distance based upon
#'  the AMOVA distance metric.  
#' @param x Either a \code{data.frame} with both stratum and \code{locus} 
#'  objects in them (for strata distance) OR a vector of \code{locus} 
#'  objects and this will calculate distance based upon individual
#'  genetic distances.
#' @param stratum The name of the stratum variable in \code{x}
#' @return A matrix of Jaccard distance
#' 
#' @author Rodney J. Dyer \email{rjdyer@@vcu.edu}
#' @export
#' @examples  
#' AA <- locus( c("A","A") )
#' AB <- locus( c("A","B") )
#' AC <- locus( c("A","C") )
#' BB <- locus( c("B","B") )
#' BC <- locus( c("B","C") )
#' CC <- locus( c("C","C") )
#' loci <- c(AA,AA,AB,AA,BB,BC,CC,BB,BB,CC)
#' df <- data.frame( Population=c(rep("A",5),rep("B",5) ), TPI=loci )
#' D <- dist_bray(df)
dist_bray <- function( x, stratum="Population" ) {
  
  # Special case where x is passed a locus object, this 
  #   will assume that we are talking about individual Bray Curtis distance
  if( is(x,"locus") ) {
    x <- data.frame(Locus=x,Population=1:length(x))
    stratum <- "Population"
  }
  
  if( !is( x, "data.frame") )
    stop("You need to pass a data.frame to dist_bray() to work.")
  
  if( !(stratum %in% names(x)))
    stop("You need to specify the correct stratum for dist_bray() to work.")
  
  locus_names <- column_class( x, "locus")
  K <- length( locus_names )
  if( K==0)
    stop("You need to pass objects of type 'locus' to use for dist_bray().")
  else if( K > 1 )
    message("Bray distance will be assumed to be entirely additive across loci.")
 
  
  f <- to_mv_freq(x,stratum)
  K <- nrow(f)
  nloc <- ncol(f)
  ret <- matrix(0,K,K)
  rownames(ret) <- colnames(ret) <- rownames(f)
  for( i in 1:K){
    for( j in 1:i){
      if( i != j){
        ret[i,j] <- ret[j,i] <- sum(apply(f[ c(i,j), ], 2, min)) / nloc
      }
    }
  }
  
  return(ret)
}