R/classify_costmatrix.R

In Claddis: Measuring Morphological Diversity and Evolutionary Tempo

#' Classify a costmatrix character
#'
#' @description
#'
#' Given a costmatrix, classifies it into one of twelve distinct types.
#'
#' @param costmatrix An object of class \code{costMatrix}.
#'
#' @details
#'
#' Hoyal Cuthill and Lloyd (in press) classified discrete characters into twelve different types. This function applies their classification to a costmatrix object. The twelve different types are defined below alongside an empirical example for each, following Hoyal Cuthill and Lloyd (in review).
#'
#' \bold{Type I - Constant}
#'
#' The simplest character type - only one state
#'
#' Example: Character 18 of Sterli et al. (2013)
#'
#' Costmatrix:
#'
#' \preformatted{    -----
#'     | 0 |
#' ---------
#' | 0 | 0 |
#' ---------}
#'
#' State graph:
#'
#' \preformatted{0}
#'
#' \bold{Type II - Binary symmetric}
#'
#' Exactly two states with equal and finite transition costs between them.
#'
#' Example: Character 1 of Sterli et al. (2013)
#'
#' Costmatrix:
#'
#' \preformatted{    ---------
#'     | 0 | 1 |
#' -------------
#' | 0 | 0 | 1 |
#' -------------
#' | 1 | 1 | 0 |
#' -------------}
#'
#' State graph:
#'
#' \preformatted{  1
#' 0---1}
#'
#' \bold{Type III - Multistate unordered}
#'
#' Three or more states where every state-to-state transition has equal and finite cost.
#'
#' Example: Character 53 of Sterli et al. (2013)
#'
#' Costmatrix:
#'
#' \preformatted{    -------------
#'     | 0 | 1 | 2 |
#' -----------------
#' | 0 | 0 | 1 | 1 |
#' -----------------
#' | 1 | 1 | 0 | 1 |
#' -----------------
#' | 2 | 1 | 1 | 0 |
#' -----------------}
#'
#' State graph:
#'
#' \preformatted{    1
#'    / \
#'  1/   \1
#'  /     \
#' 0-------2
#'     1}
#'
#' \bold{Type IV - linear ordered symmetric}
#'
#' Three or more states arranged as a single path with all connected states having equal and finite transition cost.
#'
#' Example: Character 7 of Sterli et al. (2013)
#'
#' Costmatrix:
#'
#' \preformatted{    -------------
#'     | 0 | 1 | 2 |
#' -----------------
#' | 0 | 0 | 1 | 2 |
#' -----------------
#' | 1 | 1 | 0 | 1 |
#' -----------------
#' | 2 | 2 | 1 | 0 |
#' -----------------}
#'
#' State graph:
#'
#' \preformatted{  1   1
#' 0---1---2}
#'
#' \bold{Type V - Non-linear ordered symmetric}
#'
#' Four or more states arranged into a state graph with at least one branching point (vertex of degree three or greater) with all connected states having equal and finite transition costs.
#'
#' Example: Character 71 of Hooker (2014)
#'
#' Costmatrix:
#'
#' \preformatted{    -------------
#'     | 0 | 1 | 2 | 3 |
#' ---------------------
#' | 0 | 0 | 1 | 2 | 2 |
#' ---------------------
#' | 1 | 1 | 0 | 1 | 1 |
#' ---------------------
#' | 1 | 2 | 1 | 0 | 2 |
#' ---------------------
#' | 1 | 2 | 1 | 2 | 0 |
#' ---------------------}
#'
#' State graph:
#'
#' \preformatted{          2
#'          /
#'        1/
#'    1   /
#' 0-----1
#'        \
#'        1\
#'          \
#'           3}
#'
#' \bold{Type VI - Binary irreversible}
#'
#' Two states where transitions in one direction have infinite cost and the other finite cost.
#'
#' Example: Character 119 of Gunnell et al. (2018)
#'
#' Costmatrix:
#'
#' \preformatted{    ---------
#'     | 0 | 1 |
#' -------------
#' | 0 | 0 | 1 |
#' -------------
#' | 1 | i | 0 |
#' -------------}
#'
#' (i = infinity)
#'
#' State graph:
#'
#' \preformatted{  1
#' 0-->1}
#'
#' \bold{Type VII - Multistate irreversible}
#'
#' Three or more states where transitions in one direction have infinite cost and the other finite cost.
#'
#' Example: Character 21 of Gunnell et al. (2018)
#'
#' Costmatrix:
#'
#' \preformatted{    -------------
#'     | 0 | 1 | 2 |
#' -----------------
#' | 0 | 0 | 1 | 2 |
#' -----------------
#' | 1 | i | 0 | 1 |
#' -----------------
#' | 2 | i | i | 0 |
#' -----------------}
#'
#' (i = infinity)
#'
#' State graph:
#'
#' \preformatted{  1   1
#' 0-->1-->2}
#'
#' \bold{Type VIII - Binary Dollo}
#'
#' Two states where transitions in one direction can be made at most once, with no restriction in the other direction.
#'
#' Example: Character 10 of Paterson et al. (2014)
#'
#' Costmatrix:
#'
#' \preformatted{    ----------
#'     | 0 | 1 |
#' -------------
#' | 0 | 0 | D |
#' -------------
#' | 1 | 1 | 0 |
#' -------------}
#'
#' (D = a Dollo penalty applied to avoid multiple transitions, see Swofford and Olsen 1990)
#'
#' State graph:
#'
#' \preformatted{      1
#'  --- <-- ---
#' | 0 |   | 1 |
#'  --- --> ---
#'       D}
#'
#' \bold{Type IX - Multistate Dollo}
#'
#' Three or more states where transitions in one direction can be made at most once, with no restriction in the other direction.
#'
#' Example: Character 15 of Paterson et al. (2014)
#'
#' Costmatrix:
#'
#' \preformatted{    --------------
#'     | 0 | 1 |  2 |
#' ------------------
#' | 0 | 0 | D | 2D |
#' ------------------
#' | 1 | 1 | 0 |  D |
#' ------------------
#' | 2 | 2 | 1 |  0 |
#' ------------------}
#'
#' (D = a Dollo penalty applied to avoid multiple transitions, see Swofford and Olsen 1990)
#'
#' State graph:
#'
#' \preformatted{      1       1
#'  --- <-- --- <-- ---
#' | 0 |   | 1 |   | 2 |
#'  --- --> --- --> ---
#'       D       D}
#'
#' \bold{Type X - Multistate symmetric}
#'
#' Three or more states where connected states have symmetric finite costs, but where these are not all equal.
#'
#' Example: Character 8 of Sumrall abd Brett (2002)
#'
#' Costmatrix:
#'
#' \preformatted{
#'     -------------------------
#'     | 0 | 1 | 2 | 3 | 4 | 5 |
#' -----------------------------
#' | 0 | 0 | 1 | 2 | 3 | 2 | 3 |
#' -----------------------------
#' | 1 | 1 | 0 | 3 | 2 | 1 | 2 |
#' -----------------------------
#' | 2 | 2 | 3 | 0 | 3 | 2 | 1 |
#' -----------------------------
#' | 3 | 3 | 2 | 3 | 0 | 1 | 2 |
#' -----------------------------
#' | 4 | 2 | 1 | 2 | 1 | 0 | 1 |
#' -----------------------------
#' | 5 | 3 | 2 | 1 | 2 | 1 | 0 |
#' -----------------------------}
#'
#' State graph:
#'
#' \preformatted{   1
#'  2---5   3
#'  |    \  |
#' 2|    1\ |1
#'  |      \|
#'  0---1---4
#'    1   1}
#'
#' \bold{Type XI - Binary asymmetric}
#'
#' Two states where transition costs are finite but non-equal.
#'
#' Example: Character 3 of Gheerbrant et al. (2014)
#'
#' Costmatrix:
#'
#' \preformatted{    ----------
#'     |  0 | 1 |
#' --------------
#' | 0 |  0 | 1 |
#' --------------
#' | 1 | 10 | 0 |
#' --------------}
#'
#' State graph:
#'
#' \preformatted{      10
#'  --- <--- ---
#' | 0 |    | 1 |
#'  --- ---> ---
#'       1}
#'
#' \bold{Type XII - Multistate asymmetric}
#'
#' Three or more states where at least one transition is asymmetric, but the character does not meet the definition of other multistate asymmetric characters (i.e., Type VII and IX).
#'
#' Example: Character 7 of Gheerbrant et al. (2014)
#'
#' Costmatrix:
#'
#' \preformatted{    ---------------
#'     |  0 |  1 | 2 |
#' -------------------
#' | 0 |  0 |  1 | 1 |
#' -------------------
#' | 1 |  1 |  0 | 1 |
#' -------------------
#' | 1 | 10 | 10 | 0 |
#' -------------------}
#'
#' State graph:
#'
#' \preformatted{          10
#'     ______________
#'    /              \
#'   L   1       10   \
#'  --- <-- --- <--- ---
#' | 0 |   | 1 |    | 2 |
#'  --- --> --- ---> ---
#'   \   1        1   ^
#'    \______________/
#'            1}
#'
#' \bold{Other character types}
#'
#' The classification of Hoyal Cuthill and Lloyd (in review) was derived as a means to delineate a mathematical problem. As such it may be of use to consider where some special kinds of character would fall in this classification.
#'
#' \emph{Stratigraphic characters}
#'
#' These would be classified as either Type VI, Type VII, Type XI, or Type XII characters (depending on state count and spacing of stratigraphic units).
#'
#' \emph{Gap-weighted characters}
#'
#' A gap-weighted (Thiele 1993) character would be classified as either Type II or Type IV (depending on state count), but differ in the implicit assumption of whether all states are expected to be sampled. For a gap-weighted character there is no presumption that every state be sampled as the spacing between states is the primary information being considered.
#'
#' \emph{Continuous characters}
#'
#' Continuous characters are necessarily not classifiable here as they are by definition non-discrete (except where translated into a gap-weighted character, above).
#'
#' @return A text string indicating the classification result (e.g., \code{"Type VIII"}).
#'
#' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com}
#'
#' @references
#'
# 'Gheerbrant, E., Amaghzaz, M., Bouya, B., Goussard, F. and Letenneur, C., 2014. \emph{Ocepeia} (Middle Paleocene of Morocco): the oldest skull of an Afrotherian mammal. \emph{PLoS ONE}, \bold{9}, e89739.
#'
#' Gunnell, G. F., Boyer, D. M., Friscia, A. R., Heritage, S., Manthi, F. K., Miller, E. R., Sallam, H. M., Simmons, N. B., Stevens, N. J. and Seiffert, E. R., 2018. Fossil lemurs from Egypt and Kenya suggest an African origin for Madagascar's aye-aye. \emph{Nature Communications}, \bold{9}, 3193.
#'
#' Hooker, J. J., 2014. New postcranial bones of the extinct mammalian family Nyctitheriidae (Paleogene, UK): primitive euarchontans with scansorial locomotion. \emph{Palaeontologia Electronica}, \bold{17.3.47A}, 1-82.
#'
#' Hoyal Cuthill, J. F. and Lloyd, G. T., in press. Measuring homoplasy I: comprehensive measures of maximum and minimum cost under parsimony across discrete cost matrix character types. \emph{Cladistics}, bold{}, .
#'
#' Paterson, A. M., Wallis, G. P., Kennedy, M. and Gray, R. D., 2014. Behavioural evolution in penguins does not reflect phylogeny. \emph{Cladistics}, \bold{30}, 243-259.
#'
#' Sterli, J., Pol, D. and Laurin, M., 2013. Incorporating phylogenetic uncertainty on phylogeny-based palaeontological dating and the timing of turtle diversification. \emph{Cladistics}, \bold{29}, 233-246.
#'
#' Sumrall, C. D. and Brett, C. E., 2002. A revision of \emph{Novacystis hawkesi} Paul and Bolton 1991 (Middle Silurian: Glyptocystitida, Echinodermata) and the phylogeny of early callocystitids. \emph{Journal of Paleontology}, \bold{76}, 733-740.
#'
#' Swofford, D. L. and Olsen, G. J., 1990. Phylogeny reconstruction. In D. M. Hillis and C. Moritz (eds.), \emph{Molecular Systematics}. Sinauer Associates, Sunderland. pp411-501.
#'
#' Thiele, K.. 1993. The Holy Grail of the perfect character: the cladistic treatment of morphometric data. \emph{Cladistics}, \bold{9}, 275-304.
#'
#' @examples
#'
#' # Create a Type I character costmatrix:
#' constant_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state = 0,
#'   character_type = "unordered"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = constant_costmatrix)
#'
#' # Create a Type II character costmatrix:
#' binary_symmetric_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state = 1,
#'   character_type = "unordered"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = binary_symmetric_costmatrix)
#'
#' # Create a Type III character costmatrix:
#' unordered_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 2,
#'   character_type = "unordered"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = unordered_costmatrix)
#'
#' # Create a Type IV character costmatrix:
#' linear_ordered_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 2,
#'   character_type = "ordered"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = linear_ordered_costmatrix)
#'
#' # Create a Type V character costmatrix:
#' nonlinear_ordered_costmatrix <- convert_adjacency_matrix_to_costmatrix(
#'   adjacency_matrix = matrix(
#'     data = c(
#'       0, 1, 0, 0,
#'       1, 0, 1, 1,
#'       0, 1, 0, 0,
#'       0, 1, 0, 0
#'     ),
#'     nrow = 4,
#'     dimnames = list(0:3, 0:3)
#'   )
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = nonlinear_ordered_costmatrix)
#'
#' # Create a Type VI character costmatrix:
#' binary_irreversible_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 1,
#'   character_type = "irreversible"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = binary_irreversible_costmatrix)
#'
#' # Create a Type VII character costmatrix:
#' multistate_irreversible_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 2,
#'   character_type = "irreversible"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = multistate_irreversible_costmatrix)
#'
#' # Create a Type VIII character costmatrix:
#' binary_dollo_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 1,
#'   character_type = "dollo"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = binary_dollo_costmatrix)
#'
#' # Create a Type IX character costmatrix:
#' multistate_dollo_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 2,
#'   character_type = "dollo"
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = multistate_dollo_costmatrix)
#'
#' # Create a Type X character costmatrix:
#' multistate_symmetric_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 5,
#'   character_type = "ordered"
#' )
#' multistate_symmetric_costmatrix$type <- "custom"
#' multistate_symmetric_costmatrix$costmatrix <- matrix(
#'   data = c(
#'     0, 1, 2, 3, 2, 3,
#'     1, 0, 3, 2, 1, 2,
#'     2, 3, 0, 3, 2, 1,
#'     3, 2, 3, 0, 1, 2,
#'     2, 1, 2, 1, 0, 1,
#'     3, 2, 1, 2, 1, 0
#'   ),
#'   nrow = multistate_symmetric_costmatrix$size,
#'   ncol = multistate_symmetric_costmatrix$size,
#'   byrow = TRUE,
#'   dimnames = list(
#'     multistate_symmetric_costmatrix$single_states,
#'     multistate_symmetric_costmatrix$single_states
#'   )
#' )
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = multistate_symmetric_costmatrix)
#'
#' # Create a Type XI character costmatrix:
#' binary_asymmetric_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 1,
#'   character_type = "ordered"
#' )
#' binary_asymmetric_costmatrix$type <- "custom"
#' binary_asymmetric_costmatrix$costmatrix <- matrix(
#'   data = c(
#'     0, 1,
#'     10, 0
#'   ),
#'   nrow = binary_asymmetric_costmatrix$size,
#'   ncol = binary_asymmetric_costmatrix$size,
#'   byrow = TRUE,
#'   dimnames = list(
#'     binary_asymmetric_costmatrix$single_states,
#'     binary_asymmetric_costmatrix$single_states
#'   )
#' )
#' binary_asymmetric_costmatrix$symmetry <- "Asymmetric"
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = binary_asymmetric_costmatrix)
#'
#' # Create a Type XII character costmatrix:
#' multistate_asymmetric_costmatrix <- make_costmatrix(
#'   min_state = 0,
#'   max_state= 2,
#'   character_type = "ordered"
#' )
#' multistate_asymmetric_costmatrix$type <- "custom"
#' multistate_asymmetric_costmatrix$costmatrix <- matrix(
#'   data = c(
#'     0, 1, 1,
#'     1, 0, 1,
#'     10, 10, 0
#'   ),
#'   nrow = multistate_asymmetric_costmatrix$size,
#'   ncol = multistate_asymmetric_costmatrix$size,
#'   byrow = TRUE,
#'   dimnames = list(
#'     multistate_asymmetric_costmatrix$single_states,
#'     multistate_asymmetric_costmatrix$single_states
#'   )
#' )
#' multistate_asymmetric_costmatrix$symmetry <- "Asymmetric"
#'
#' # Classify costmatrix:
#' classify_costmatrix(costmatrix = multistate_asymmetric_costmatrix)
#'
#' @export classify_costmatrix
classify_costmatrix <- function(costmatrix) {
  
  # Add a function to classify all characters for a cladistic matrix?

  # If a constant character return Type I:
  if (costmatrix$n_states == 1) return("Type I")
  
  # If a bianry character:
  if (costmatrix$n_states == 2) {
    
    # If symmetric return Type II:
    if (costmatrix$symmetry == "Symmetric") return("Type II")
    
    # If irreversible return Type VI:
    if (costmatrix$type == "irreversible" || costmatrix$type == "stratigraphy") return("Type VI")
    
    # If Dollo then return Type VIII:
    if (costmatrix$type == "dollo") return("Type VIII")
    
    # Extra check not a custom entered irreversible, return Type VI:
    if (any(costmatrix$costmatrix[costmatrix$single_states, costmatrix$single_states] == Inf)) return("Type VI")
    
    # Only other option is Type XI so return that:
    return("Type XI")
  }
  
  # If a multistate character:
  if (costmatrix$n_states > 2) {
    
    # If trasnition costs are all the same then return Type III:
    if (length(x = unique(x = costmatrix$costmatrix[costmatrix$single_states, costmatrix$single_states][costmatrix$costmatrix[costmatrix$single_states, costmatrix$single_states] > 0])) == 1) return("Type III")

    # If ordered then return Type VIII:
    if (costmatrix$type == "ordered") return("Type IV")

    # If multistate irreversible then return Type VIII:
    if (costmatrix$type == "irreversible") return("Type VII")
    
    # If Dollo then return Type IX:
    if (costmatrix$type == "dollo") return("Type IX")
    
    # If still not identifed then convert to stategraph to allow further checks:
    stategraph <- convert_costmatrix_to_stategraph(costmatrix = costmatrix)
    vertices <- stategraph$vertices[match(costmatrix$single_states, stategraph$vertices$label), ]
    arcs <- stategraph$arcs[which(
      x = apply(
        X = cbind(
          do.call(
            what = cbind,
            args = lapply(
              X = as.list(x = costmatrix$single_states),
              FUN = function(state) stategraph$arcs$from == state
            )
          ),
          do.call(
            what = cbind,
            args = lapply(
              X = as.list(x = costmatrix$single_states),
              FUN = function(state) stategraph$arcs$to == state
            )
          )
        ),
        MARGIN = 1,
        FUN = sum
      ) == 2
    ), ]
    
    # Check for a custom ordered character and return Type IV if meets criteria:
    if (all(x = c(vertices$in_degree, vertices$out_degree) <= 2) && length(x = unique(x = arcs$weight)) == 1 && costmatrix$symmetry == "Symmetric") return("Type IV")
    
    # Check for a custom irreversible character and return Type VII if meets criteria:
    if (all(x = !c(duplicated(x = arcs$from), duplicated(x = arcs$to))) && length(x = unique(x = arcs$weight)) == 1) return("Type VII")
    
    # Check for non-linear ordered and return Type V if found:
    if (any(x = c(vertices$in_degree, vertices$out_degree) > 2) && length(x = unique(x = arcs$weight)) == 1 && costmatrix$symmetry == "Symmetric") return("Type V")

    # Check for custom symmetric and return Type X if found:
    if (length(x = unique(x = arcs$weight)) > 1 && costmatrix$symmetry == "Symmetric") return("Type X")
    
    # Anything remaining with asymmetric costs must be Type XII:
    if (costmatrix$symmetry == "Asymmetric") return("Type XII")
    
    # This should not happen but is left here as an error check:
    stop("Clasification has inexplicably failed!")
  }
}