├── man ├── .Rhistory ├── figures │ └── logo.png ├── michaux_1989.Rd ├── gauthier_1986.Rd ├── day_2016.Rd ├── trim_marginal_whitespace.Rd ├── check_cladisticMatrix.Rd ├── find_linked_edges.Rd ├── date_nodes.Rd ├── is.cladisticMatrix.Rd ├── print.costMatrix.Rd ├── check_taxonGroups.Rd ├── is.costMatrix.Rd ├── make_labels.Rd ├── check_costMatrix.Rd ├── check_timeBins.Rd ├── is.stateGraph.Rd ├── find_descendant_edges.Rd ├── check_stateGraph.Rd ├── find_mrca.Rd ├── count_cherries.Rd ├── print.taxonGroups.Rd ├── print.timeBins.Rd ├── permute_combinations_with_replacement.Rd ├── print.cladisticMatrix.Rd ├── is.taxonGroups.Rd ├── partition_time_bins.Rd ├── split_out_subgraphs.Rd ├── match_tree_edges.Rd ├── find_minimum_spanning_edges.Rd ├── write_nexus_matrix.Rd ├── permute_graph_splits.Rd ├── bin_changes.Rd ├── align_matrix_block.Rd ├── locate_bracket_positions.Rd ├── plot_changes_on_tree.Rd ├── calculate_MPD.Rd ├── fix_root_time.Rd ├── permute_connected_graphs.Rd ├── compactify_cladistic_matrix.Rd ├── permute_all_treeshape_labellings.Rd ├── write_tnt_matrix.Rd ├── is.timeBins.Rd ├── find_unique_trees.Rd ├── calculate_kardashian_index.Rd ├── permute_all_uncertainties.Rd ├── drop_time_tip.Rd ├── permute_all_polymorphisms.Rd ├── find_time_bin_midpoints.Rd ├── prune_cladistic_matrix.Rd ├── bin_edge_lengths.Rd ├── safe_taxonomic_reduction.Rd ├── trim_matrix.Rd ├── print.stateGraph.Rd ├── permute_restricted_compositions.Rd ├── permute_treeshapes.Rd ├── calculate_WMPD.Rd ├── convert_adjacency_matrix_to_costmatrix.Rd ├── is_graph_connected.Rd ├── map_dollo_changes.Rd ├── bin_character_completeness.Rd ├── Claddis-package.Rd ├── permute_costmatrices.Rd ├── build_cladistic_matrix.Rd ├── plot_rates_character.Rd ├── plot_rates_time.Rd └── fix_costmatrix.Rd ├── .Rbuildignore ├── data ├── day_2016.RData ├── michaux_1989.RData ├── gauthier_1986.RData └── .Rhistory ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── tests └── testthat │ ├── test_find_linked_edges.R │ ├── test_find_mrca.R │ └── test_bin_changes.R ├── R ├── is.cladisticMatrix.R ├── is.costMatrix.R ├── is.stateGraph.R ├── find_linked_edges.R ├── make_labels.r ├── is.taxonGroups.R ├── count_cherries.R ├── check_cladisticMatrix.R ├── find_mrca.R ├── print.timeBins.r ├── find_descendant_edges.R ├── trim_marginal_whitespace.r ├── is.timeBins.R ├── calculate_kardashian_index.R ├── print.taxonGroups.r ├── calculate_MPD.R ├── drop_time_tip.R ├── bin_changes.R ├── fix_root_time.R ├── find_time_bin_midpoints.R ├── permute_all_uncertainties.r ├── permute_all_polymorphisms.r ├── find_minimum_spanning_edges.R ├── permute_combinations_with_replacement.r ├── align_matrix_block.R ├── print.costMatrix.r ├── date_nodes.R ├── plot_changes_on_tree.R ├── find_unique_trees.r ├── Claddis-package.R ├── check_taxonGroups.R └── calculate_WMPD.R ├── inst └── CITATION ├── workshops └── napc2024 │ └── data │ ├── lungfish_tree.tre │ └── lungfish_ages.txt ├── README.md └── DESCRIPTION /man/.Rhistory: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | .travis.yml 2 | .github 3 | workshops 4 | ^\.github$ 5 | -------------------------------------------------------------------------------- /data/day_2016.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemetlloyd/Claddis/HEAD/data/day_2016.RData -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemetlloyd/Claddis/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /data/michaux_1989.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemetlloyd/Claddis/HEAD/data/michaux_1989.RData -------------------------------------------------------------------------------- /data/gauthier_1986.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemetlloyd/Claddis/HEAD/data/gauthier_1986.RData -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.DS_Store 2 | .DS_Store 3 | .gitignore_global.swp 4 | .Rapp.history 5 | R/.Rhistory 6 | *.html 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | man/.DS_Store 2 | *.DS_Store 3 | .DS_Store 4 | .gitignore_global.swp 5 | .Rapp.history 6 | R/.Rhistory 7 | -------------------------------------------------------------------------------- /tests/testthat/test_find_linked_edges.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Claddis) 3 | 4 | test_that("find_linked_edges returns correct matrix", { 5 | expect_equal(find_linked_edges(tree = ape::read.tree(text = "(A,(B,(C,D)));")), matrix(data = c(0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0), ncol = 6, byrow = TRUE, dimnames = list(1:6, 1:6))) 6 | }) 7 | 8 | # Undo any set.seed usage: 9 | set.seed(Sys.time()) 10 | -------------------------------------------------------------------------------- /tests/testthat/test_find_mrca.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Claddis) 3 | 4 | test_that("find_mrca returns correct node numbers", { 5 | expect_equal(find_mrca(descendant_names = c("B", "C", "D"), tree = ape::read.tree(text = "(A,(B,(C,D)));")), 6) 6 | expect_equal(find_mrca(descendant_names = c("A", "D"), tree = ape::read.tree(text = "(A,(B,(C,D)));")), 5) 7 | expect_equal(find_mrca(descendant_names = c("C", "D"), tree = ape::read.tree(text = "(A,(B,(C,D)));")), 7) 8 | }) 9 | 10 | # Undo any set.seed usage: 11 | set.seed(Sys.time()) 12 | -------------------------------------------------------------------------------- /man/michaux_1989.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Claddis-package.R 3 | \docType{data} 4 | \name{michaux_1989} 5 | \alias{michaux_1989} 6 | \title{Character-taxon matrix from Michaux 1989} 7 | \format{ 8 | A character-taxon matrix in the format imported by 9 | \link{read_nexus_matrix}. 10 | } 11 | \description{ 12 | The character-taxon matrix from Michaux (1989). 13 | } 14 | \references{ 15 | Michaux, B., 1989. Cladograms can reconstruct phylogenies: an example from the fossil record. \emph{Alcheringa}, \bold{13}, 21-36. 16 | } 17 | \keyword{datasets} 18 | -------------------------------------------------------------------------------- /data/.Rhistory: -------------------------------------------------------------------------------- 1 | load("/Users/gral/Documents/Publications/in prep/Claddis/Claddis/data/Gauthier1986.RData") 2 | objects 3 | objects() 4 | setwd("~/Documents/Publications/in prep/Claddis/Claddis/data") 5 | save(Gauthier.1986, file="Gauthier1986") 6 | save(Gauthier.1986, file="Gauthier1986.RData") 7 | load('~/Documents/Publications/in prep/Claddis/Claddis/data/Gauthier1986.RData') 8 | objects() 9 | Gauthier.198 10 | Gauthier.1986 11 | Gauthier1986<-Gauthier.1986 12 | save(Gauthier1986, file="Gauthier1986.RData") 13 | load('~/Documents/Publications/in prep/Claddis/Claddis/data/Gauthier1986.RData') 14 | objects() 15 | Gauthier1986 16 | -------------------------------------------------------------------------------- /tests/testthat/test_bin_changes.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Claddis) 3 | 4 | time_bins <- matrix(data = c(4, 3, 3, 2, 2, 1), ncol = 2, byrow = TRUE, dimnames = list(LETTERS[1:3], c("fad", "lad"))) 5 | class(time_bins) <- "timeBins" 6 | 7 | test_that("bin_changes returns correct bin counts", { 8 | expect_equal(bin_changes(change_times = c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5), time_bins = time_bins), c("A" = 3, "B" = 3, "C" = 3)) 9 | expect_equal(bin_changes(change_times = c(1, 1.5, 2, 2.5, 3, 3.5, 4), time_bins = time_bins), c("A" = 2, "B" = 2, "C" = 2)) 10 | }) 11 | 12 | # Undo any set.seed usage: 13 | set.seed(Sys.time()) 14 | -------------------------------------------------------------------------------- /man/gauthier_1986.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Claddis-package.R 3 | \docType{data} 4 | \name{gauthier_1986} 5 | \alias{gauthier_1986} 6 | \title{Character-taxon matrix from Gauthier 1986} 7 | \format{ 8 | A character-taxon matrix in the format imported by \link{read_nexus_matrix}. 9 | } 10 | \description{ 11 | The character-taxon matrix from Gauthier (1986). 12 | } 13 | \references{ 14 | Gauthier, J. A., 1986. Saurischian monophyly and the origin of birds. In Padian, K. (ed.) \emph{The Origin of Birds and the Evolution of Flight}. Towne and Bacon, San Francisco, CA, United States, 1-55. 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/day_2016.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Claddis-package.R 3 | \docType{data} 4 | \name{day_2016} 5 | \alias{day_2016} 6 | \title{Character-taxon matrix from Day et al. 2016} 7 | \format{ 8 | A character-taxon matrix in the format imported by \link{read_nexus_matrix}. 9 | } 10 | \description{ 11 | The character-taxon matrix from Day et al. (2016). 12 | } 13 | \references{ 14 | Day, M. O., Rubidge, B. S. and Abdala, F., 2016. A new mid-Permian burnetiamorph therapsid from the Main Karoo Basin of South Africa and a phylogenetic review of Burnetiamorpha. \emph{Acta Palaeontologica Polonica}, \bold{61}, 701-719. 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/trim_marginal_whitespace.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/trim_marginal_whitespace.r 3 | \name{trim_marginal_whitespace} 4 | \alias{trim_marginal_whitespace} 5 | \title{Trims marginal whitespace} 6 | \usage{ 7 | trim_marginal_whitespace(x) 8 | } 9 | \arguments{ 10 | \item{x}{A character string} 11 | } 12 | \value{ 13 | A vector of character string(s) with any leading or trailing whitespace removed. 14 | } 15 | \description{ 16 | Trims any marginal whitespace from a vector of character string(s). 17 | } 18 | \details{ 19 | Trims any marginal whitespace (spaces or tabs) from a vector of character string(s). 20 | } 21 | \examples{ 22 | 23 | # Example string: 24 | x <- " \td s f\t s " 25 | 26 | # Trim only marginal whitespace: 27 | trim_marginal_whitespace(x) 28 | 29 | } 30 | \author{ 31 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 32 | } 33 | -------------------------------------------------------------------------------- /man/check_cladisticMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_cladisticMatrix.R 3 | \name{check_cladisticMatrix} 4 | \alias{check_cladisticMatrix} 5 | \title{Check cladisticMatrix object for errors} 6 | \usage{ 7 | check_cladisticMatrix(cladistic_matrix) 8 | } 9 | \arguments{ 10 | \item{cladistic_matrix}{An object of class \code{cladisticMatrix}.} 11 | } 12 | \value{ 13 | An error message or empty vector if no errors found. 14 | } 15 | \description{ 16 | Internal function to check cladisticMatrix object for errors. 17 | } 18 | \details{ 19 | Internal Claddis function. Nothing to see here. Carry on. 20 | } 21 | \examples{ 22 | 23 | # Check that this is a valid cladisticMatrix object (will return error message as class 24 | # is not set): 25 | check_cladisticMatrix(cladistic_matrix = day_2016) 26 | 27 | } 28 | \author{ 29 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 30 | } 31 | -------------------------------------------------------------------------------- /man/find_linked_edges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_linked_edges.R 3 | \name{find_linked_edges} 4 | \alias{find_linked_edges} 5 | \title{Find linked edges for a tree} 6 | \usage{ 7 | find_linked_edges(tree) 8 | } 9 | \arguments{ 10 | \item{tree}{A tree (phylo object).} 11 | } 12 | \value{ 13 | Returns a matrix where links are scored 1 and everything else 0. The diagonal is left as zero. 14 | } 15 | \description{ 16 | Given a tree finds edges that are linked to each other. 17 | } 18 | \details{ 19 | Finds all edges that link (share a node) with each edge of a tree. 20 | 21 | This is intended as an internal function, but may be of use to someone else. 22 | } 23 | \examples{ 24 | 25 | # Create a simple four-taxon tree: 26 | tree <- ape::read.tree(text = "(A,(B,(C,D)));") 27 | 28 | # Find linked (1) edges matrix for tree: 29 | find_linked_edges(tree) 30 | } 31 | \author{ 32 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 33 | } 34 | -------------------------------------------------------------------------------- /man/date_nodes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/date_nodes.R 3 | \name{date_nodes} 4 | \alias{date_nodes} 5 | \title{Returns node ages for a time-scaled tree} 6 | \usage{ 7 | date_nodes(time_tree) 8 | } 9 | \arguments{ 10 | \item{time_tree}{A tree (phylo object) with branch lengths representing time and a value for \code{$root.time}.} 11 | } 12 | \description{ 13 | Given a tree with branch-lengths scaled to time and a value for \code{$root.time} will return a vector of node ages. 14 | } 15 | \details{ 16 | Returns a vector of node ages (terminal and internal) labelled by their node number. 17 | } 18 | \examples{ 19 | 20 | # Create simple four-taxon tree with edge lengths all 21 | # set to 1 Ma: 22 | time_tree <- ape::read.tree(text = "(A:1,(B:1,(C:1,D:1):1):1);") 23 | 24 | # Set root.time as 10 Ma: 25 | time_tree$root.time <- 10 26 | 27 | # Get node ages: 28 | date_nodes(time_tree = time_tree) 29 | } 30 | \author{ 31 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 32 | } 33 | -------------------------------------------------------------------------------- /man/is.cladisticMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is.cladisticMatrix.R 3 | \name{is.cladisticMatrix} 4 | \alias{is.cladisticMatrix} 5 | \title{Cladistic matrix class} 6 | \usage{ 7 | is.cladisticMatrix(x) 8 | } 9 | \arguments{ 10 | \item{x}{A cladisticMatrix object.} 11 | } 12 | \value{ 13 | \code{is.cladisticMatrix} returns either TRUE or FALSE. 14 | } 15 | \description{ 16 | Functions to deal with the cladistic matrix class. 17 | } 18 | \details{ 19 | Claddis uses various classes to define specific types of data, here the use of cladistic data (the main input of the package) is assigned the class "cladisticMatrix". 20 | 21 | \code{is.cladisticMatrix} checks whether an object is or is not a valid cladisticMatrix object. 22 | } 23 | \examples{ 24 | 25 | # Check that this is a valid cladisticMatrix object (will succeed as format and 26 | # class are correct): 27 | is.cladisticMatrix(x = day_2016) 28 | 29 | } 30 | \author{ 31 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 32 | } 33 | -------------------------------------------------------------------------------- /man/print.costMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.costMatrix.r 3 | \name{print.costMatrix} 4 | \alias{print.costMatrix} 5 | \title{Compact display of a costmatrix} 6 | \usage{ 7 | \method{print}{costMatrix}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{"costMatrix"}.} 11 | 12 | \item{...}{Further arguments passed to or from other methods.} 13 | } 14 | \value{ 15 | Nothing is directly returned, instead a text summary describing a \code{"costMatrix"} object is printed to the console. 16 | } 17 | \description{ 18 | Displays a compact summary of a costMatrix object. 19 | } 20 | \details{ 21 | Displays some basic summary information on a costmatrix object. 22 | } 23 | \examples{ 24 | 25 | # Make an unordered costmatrix: 26 | example_costmatrix <- make_costmatrix( 27 | min_state = 0, 28 | max_state = 2, 29 | character_type = "unordered" 30 | ) 31 | 32 | # Show print.costMatrix version: 33 | print.costMatrix(x = example_costmatrix) 34 | 35 | } 36 | \author{ 37 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 38 | } 39 | -------------------------------------------------------------------------------- /man/check_taxonGroups.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_taxonGroups.R 3 | \name{check_taxonGroups} 4 | \alias{check_taxonGroups} 5 | \title{Check taxonGroups object for errors} 6 | \usage{ 7 | check_taxonGroups(taxon_groups) 8 | } 9 | \arguments{ 10 | \item{taxon_groups}{An object of class \code{taxonGroups}.} 11 | } 12 | \value{ 13 | An error message or empty vector if no errors found. 14 | } 15 | \description{ 16 | Internal function to check taxonGroups object for errors. 17 | } 18 | \details{ 19 | Internal Claddis function. Nothing to see here. Carry on. 20 | } 21 | \examples{ 22 | 23 | # Create a taxon groups object: 24 | taxon_groups <- list( 25 | Group_A = c("Species_1", "Species_2", "Species_3"), 26 | Group_B = c("Species_3", "Species_4"), 27 | Group_C = c("Species_5", "Species_6", "Species_7", "Species_8") 28 | ) 29 | 30 | # Check that this is a valid taxonGroups object (will return error message as class 31 | # is not set): 32 | check_taxonGroups(taxon_groups = taxon_groups) 33 | 34 | } 35 | \author{ 36 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 37 | } 38 | -------------------------------------------------------------------------------- /man/is.costMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is.costMatrix.R 3 | \name{is.costMatrix} 4 | \alias{is.costMatrix} 5 | \title{Costmatrix class} 6 | \usage{ 7 | is.costMatrix(x) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{costMatrix}.} 11 | } 12 | \value{ 13 | \code{is.costMatrix} returns either TRUE or FALSE. 14 | } 15 | \description{ 16 | Functions to deal with the costmatrix class. 17 | } 18 | \details{ 19 | Claddis uses various classes to define specific types of data, here the use of costmatrices (to specify the parsimony costs of transitions between character states) are assigned the class "costMatrix". 20 | 21 | \code{is.costMatrix} checks whether an object is or is not a valid costMatrix object. 22 | } 23 | \examples{ 24 | 25 | # Make an unordered costmatrix: 26 | costmatrix <- make_costmatrix( 27 | min_state = 0, 28 | max_state = 2, 29 | character_type = "unordered" 30 | ) 31 | 32 | # Check that this is a valid costMatrix object: 33 | is.costMatrix(x = costmatrix) 34 | 35 | } 36 | \author{ 37 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 38 | } 39 | -------------------------------------------------------------------------------- /man/make_labels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/make_labels.r 3 | \name{make_labels} 4 | \alias{make_labels} 5 | \title{Make unique text labels} 6 | \usage{ 7 | make_labels(N) 8 | } 9 | \arguments{ 10 | \item{N}{The number of labels required,} 11 | } 12 | \value{ 13 | A character vector of N unique labels. 14 | } 15 | \description{ 16 | Given a requisite number, generates that many unique text labels. 17 | } 18 | \details{ 19 | Where a list of unique text labels are required (i.e., where simple numbering will not suffice) it can be useful to have a simple function that generates the required amount. 20 | 21 | In practice, this is simple in R when N is 26 or less as the \code{LETTERS} object can be used for this purpose. For example, to get ten unique labels: 22 | 23 | \code{LETTERS[1:10]} 24 | 25 | This function works in a similar way but will add a second, third etc. letter where the value of N requires it. 26 | } 27 | \examples{ 28 | 29 | # Make 40 unique text labels: 30 | make_labels(N = 40) 31 | 32 | } 33 | \author{ 34 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 35 | } 36 | -------------------------------------------------------------------------------- /man/check_costMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_costMatrix.R 3 | \name{check_costMatrix} 4 | \alias{check_costMatrix} 5 | \title{Check a costMatrix object for errors} 6 | \usage{ 7 | check_costMatrix(costmatrix) 8 | } 9 | \arguments{ 10 | \item{costmatrix}{A costMatrix object.} 11 | } 12 | \value{ 13 | An error message or empty vector if no errors found. 14 | } 15 | \description{ 16 | Internal function to check a costMatrix object for errors. 17 | } 18 | \details{ 19 | Costmatrix objects are more complex than what will typically be shown to the user. This function checks this hidden structure and reports any errors it finds. 20 | 21 | These checks include rules 1-7 from Hoyal Cuthill and lloyd (i prep.). 22 | } 23 | \examples{ 24 | 25 | # Make an unordered costmatrix: 26 | costmatrix <- make_costmatrix( 27 | min_state = 0, 28 | max_state = 2, 29 | character_type = "unordered" 30 | ) 31 | 32 | # Check that this is a valid costMatrix object (should return empty vector): 33 | check_costMatrix(costmatrix = costmatrix) 34 | 35 | } 36 | \author{ 37 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 38 | } 39 | -------------------------------------------------------------------------------- /man/check_timeBins.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_timeBins.R 3 | \name{check_timeBins} 4 | \alias{check_timeBins} 5 | \title{Check timeBins object for errors} 6 | \usage{ 7 | check_timeBins(time_bins) 8 | } 9 | \arguments{ 10 | \item{time_bins}{A timeBins object.} 11 | } 12 | \value{ 13 | An error message or empty vector if no errors found. 14 | } 15 | \description{ 16 | Internal function to check timeBins object for errors. 17 | } 18 | \details{ 19 | Internal Claddis function. Nothing to see here. Carry on. 20 | } 21 | \examples{ 22 | 23 | # Create a time bins object: 24 | time_bins <- matrix( 25 | data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 26 | ncol = 2, 27 | byrow = TRUE, 28 | dimnames = list( 29 | c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 30 | c("fad", "lad") 31 | ) 32 | ) 33 | 34 | # Check that this is a valid timeBins object (will return error message as class 35 | # is not set): 36 | check_timeBins(time_bins = time_bins) 37 | 38 | } 39 | \author{ 40 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 41 | } 42 | -------------------------------------------------------------------------------- /R/is.cladisticMatrix.R: -------------------------------------------------------------------------------- 1 | #' Cladistic matrix class 2 | #' 3 | #' @description 4 | #' 5 | #' Functions to deal with the cladistic matrix class. 6 | #' 7 | #' @param x A cladisticMatrix object. 8 | #' 9 | #' @details 10 | #' 11 | #' Claddis uses various classes to define specific types of data, here the use of cladistic data (the main input of the package) is assigned the class "cladisticMatrix". 12 | #' 13 | #' \code{is.cladisticMatrix} checks whether an object is or is not a valid cladisticMatrix object. 14 | #' 15 | #' @return \code{is.cladisticMatrix} returns either TRUE or FALSE. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Check that this is a valid cladisticMatrix object (will succeed as format and 22 | #' # class are correct): 23 | #' is.cladisticMatrix(x = day_2016) 24 | #' 25 | #' @export is.cladisticMatrix 26 | is.cladisticMatrix <- function(x) { 27 | 28 | # Get any error messages for cladistic_matrix: 29 | messages <- check_cladisticMatrix(cladistic_matrix = x) 30 | 31 | # Return logical indicating whether object is a valid cladisticMatrix object or not: 32 | ifelse(test = length(x = messages) > 0, yes = FALSE, no = TRUE) 33 | } 34 | -------------------------------------------------------------------------------- /man/is.stateGraph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is.stateGraph.R 3 | \name{is.stateGraph} 4 | \alias{is.stateGraph} 5 | \title{Stategraph class} 6 | \usage{ 7 | is.stateGraph(x) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{stateGraph}.} 11 | } 12 | \value{ 13 | \code{is.stateGraph} returns either TRUE or FALSE. 14 | } 15 | \description{ 16 | Functions to deal with the stategraph class. 17 | } 18 | \details{ 19 | Claddis uses various classes to define specific types of data, here the use of a character stategraph (to specify the parsimony costs of transitions between character states) are assigned the class "stateGraph". 20 | 21 | \code{is.stateGraph} checks whether an object is or is not a valid stateGraph object. 22 | } 23 | \examples{ 24 | 25 | # Make an unordered costmatrix: 26 | costmatrix <- make_costmatrix( 27 | min_state = 0, 28 | max_state = 2, 29 | character_type = "unordered" 30 | ) 31 | 32 | # Convert costmatrix to stategraph: 33 | stategraph <- convert_costmatrix_to_stategraph(costmatrix = costmatrix) 34 | 35 | # Check that this is a valid costMatrix object: 36 | is.stateGraph(x = stategraph) 37 | 38 | } 39 | \author{ 40 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 41 | } 42 | -------------------------------------------------------------------------------- /man/find_descendant_edges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_descendant_edges.R 3 | \name{find_descendant_edges} 4 | \alias{find_descendant_edges} 5 | \title{Gets descendant edges of an internal node} 6 | \usage{ 7 | find_descendant_edges(n, tree) 8 | } 9 | \arguments{ 10 | \item{n}{An integer corresponding to the internal node for which the descendant edges are sought.} 11 | 12 | \item{tree}{A tree as a phylo object.} 13 | } 14 | \description{ 15 | Returns all descendant edges of an internal node for a phylo object. 16 | } 17 | \details{ 18 | Returns a vector of integers corresponding to row numbers in \code{$edge} or cells in \code{$edge.length} of the descendant edges of the internal node supplied. 19 | } 20 | \examples{ 21 | 22 | # Create simple four-taxon tree: 23 | tree <- ape::read.tree(text = "(A,(B,(C,D)));") 24 | 25 | # Plot tree: 26 | plot(tree) 27 | 28 | # Show nodelabels: 29 | nodelabels() 30 | 31 | # Show edgelabels (note that edges 5 and 6 32 | # are descendants of node 7): 33 | edgelabels() 34 | 35 | # Use find_descendant_edges to show that edges 36 | # 5 and 6 are descendants of node 7: 37 | find_descendant_edges(n = 7, tree = tree) 38 | } 39 | \author{ 40 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 41 | } 42 | -------------------------------------------------------------------------------- /man/check_stateGraph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_stateGraph.R 3 | \name{check_stateGraph} 4 | \alias{check_stateGraph} 5 | \title{Check a stateGraph object for errors} 6 | \usage{ 7 | check_stateGraph(stategraph) 8 | } 9 | \arguments{ 10 | \item{stategraph}{A stateGraph object.} 11 | } 12 | \value{ 13 | An error message or empty vector if no errors found. 14 | } 15 | \description{ 16 | Internal function to check a stateGraph object for errors. 17 | } 18 | \details{ 19 | Stategraph objects are more complex than what will typically be shown to the user. This function checks this hidden structure and reports any errors it finds. 20 | 21 | These checks include rules 1-7 from Hoyal Cuthill and Lloyd (i prep.). 22 | } 23 | \examples{ 24 | 25 | # Make an unordered costmatrix: 26 | costmatrix <- make_costmatrix( 27 | min_state = 0, 28 | max_state = 2, 29 | character_type = "unordered" 30 | ) 31 | 32 | # Convert costmatrix to stategraph: 33 | stategraph <- convert_costmatrix_to_stategraph(costmatrix = costmatrix) 34 | 35 | # Check that this is a valid stateGraph object (should return empty vector): 36 | check_stateGraph(stategraph = stategraph) 37 | 38 | } 39 | \author{ 40 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 41 | } 42 | -------------------------------------------------------------------------------- /man/find_mrca.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_mrca.R 3 | \name{find_mrca} 4 | \alias{find_mrca} 5 | \title{Find ancestor} 6 | \usage{ 7 | find_mrca(descendant_names, tree) 8 | } 9 | \arguments{ 10 | \item{descendant_names}{A vector of mode character representing the tip names for which an ancestor is sought.} 11 | 12 | \item{tree}{The tree as a phylo object.} 13 | } 14 | \value{ 15 | \item{ancestor_node}{The ancestral node number.} 16 | } 17 | \description{ 18 | Finds the last common ancestor (node) of a set of two or more descendant tips. 19 | } 20 | \details{ 21 | Intended for use as an internal function for \link{trim_matrix}, but potentially of more general use. 22 | } 23 | \examples{ 24 | 25 | # Create a simple four-taxon tree: 26 | tree <- ape::read.tree(text = "(A,(B,(C,D)));") 27 | 28 | # Plot the tree: 29 | ape::plot.phylo(tree) 30 | 31 | # Add nodelabels and show that the most recent common 32 | # ancestor of B, C, and D is node 6: 33 | ape::nodelabels() 34 | 35 | # Use find_mrca to show that the most recent common 36 | # ancestor of B, C, and D is node 6: 37 | find_mrca( 38 | descendant_names = c("B", "C", "D"), 39 | tree = tree 40 | ) 41 | } 42 | \author{ 43 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 44 | } 45 | -------------------------------------------------------------------------------- /man/count_cherries.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/count_cherries.R 3 | \name{count_cherries} 4 | \alias{count_cherries} 5 | \title{Counts the number of cherries in a tree} 6 | \usage{ 7 | count_cherries(tree) 8 | } 9 | \arguments{ 10 | \item{tree}{A tree (phylo or multiPhylo object).} 11 | } 12 | \value{ 13 | Returns a vector of cherry counts for each tree retaining the order in which they were supplied. 14 | } 15 | \description{ 16 | Given a set of phylogenetic tree(s) returns the number of cherries in each one. 17 | } 18 | \details{ 19 | Cherries are components of a phylogenetic tree defined as internal nodes with exactly two terminal descendants. 20 | 21 | This function simply counts the number present in a given tree. 22 | 23 | Note that any fully dichotomous phylogenetic tree must have at least one cherry. 24 | } 25 | \examples{ 26 | 27 | # Create simple two-cherry tree: 28 | tree <- ape::read.tree(text = "((A,B),(C,D));") 29 | 30 | # Show count of cherries is two: 31 | count_cherries(tree = tree) 32 | 33 | # Create a star tree: 34 | tree <- ape::read.tree(text = "(A,B,C,D);") 35 | 36 | # Show count of cherries is zero: 37 | count_cherries(tree = tree) 38 | 39 | } 40 | \author{ 41 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 42 | } 43 | -------------------------------------------------------------------------------- /R/is.costMatrix.R: -------------------------------------------------------------------------------- 1 | #' Costmatrix class 2 | #' 3 | #' @description 4 | #' 5 | #' Functions to deal with the costmatrix class. 6 | #' 7 | #' @param x An object of class \code{costMatrix}. 8 | #' 9 | #' @details 10 | #' 11 | #' Claddis uses various classes to define specific types of data, here the use of costmatrices (to specify the parsimony costs of transitions between character states) are assigned the class "costMatrix". 12 | #' 13 | #' \code{is.costMatrix} checks whether an object is or is not a valid costMatrix object. 14 | #' 15 | #' @return \code{is.costMatrix} returns either TRUE or FALSE. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Make an unordered costmatrix: 22 | #' costmatrix <- make_costmatrix( 23 | #' min_state = 0, 24 | #' max_state = 2, 25 | #' character_type = "unordered" 26 | #' ) 27 | #' 28 | #' # Check that this is a valid costMatrix object: 29 | #' is.costMatrix(x = costmatrix) 30 | #' 31 | #' @export is.costMatrix 32 | is.costMatrix <- function(x) { 33 | 34 | # Get any error messages for costmatrix: 35 | messages <- check_costMatrix(costmatrix = x) 36 | 37 | # Return logical indicating whether object is a valid costmatrix object or not: 38 | ifelse(test = length(x = messages) > 0, yes = FALSE, no = TRUE) 39 | } 40 | -------------------------------------------------------------------------------- /man/print.taxonGroups.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.taxonGroups.r 3 | \name{print.taxonGroups} 4 | \alias{print.taxonGroups} 5 | \title{Compact display of taxon groups} 6 | \usage{ 7 | \method{print}{taxonGroups}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{"taxonGroups"}.} 11 | 12 | \item{...}{Further arguments passed to or from other methods.} 13 | } 14 | \value{ 15 | Nothing is directly returned, instead a text summary describing a \code{"taxonGroups"} object is printed to the console. 16 | } 17 | \description{ 18 | Displays a compact summary of a taxonGroups object. 19 | } 20 | \details{ 21 | Displays some basic summary information on a taxon groups object, including number of groups and their names and partial contents. 22 | } 23 | \examples{ 24 | 25 | # Create a taxon groups object: 26 | taxon_groups <- list( 27 | Group_A = c("Species_1", "Species_2", "Species_3"), 28 | Group_B = c("Species_3", "Species_4"), 29 | Group_C = c("Species_5", "Species_6", "Species_7", "Species_8") 30 | ) 31 | 32 | # Set class as taxonGroups: 33 | class(taxon_groups) <- "taxonGroups" 34 | 35 | # Show print.taxonGroups version of each included data sets: 36 | print.taxonGroups(x = taxon_groups) 37 | } 38 | \author{ 39 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 40 | } 41 | -------------------------------------------------------------------------------- /man/print.timeBins.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.timeBins.r 3 | \name{print.timeBins} 4 | \alias{print.timeBins} 5 | \title{Compact display of time bins} 6 | \usage{ 7 | \method{print}{timeBins}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{"timeBins"}.} 11 | 12 | \item{...}{Further arguments passed to or from other methods.} 13 | } 14 | \value{ 15 | Nothing is directly returned, instead a text summary describing a \code{"timeBins"} object is printed to the console. 16 | } 17 | \description{ 18 | Displays a compact summary of a timeBins object. 19 | } 20 | \details{ 21 | Displays some basic summary information on a time bins object, including number of bins and their names and timespans. 22 | } 23 | \examples{ 24 | 25 | # Create a time bins object: 26 | time_bins <- matrix( 27 | data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 28 | ncol = 2, 29 | byrow = TRUE, 30 | dimnames = list( 31 | c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 32 | c("fad", "lad") 33 | ) 34 | ) 35 | 36 | # Set class as timeBins: 37 | class(time_bins) <- "timeBins" 38 | 39 | # Show print.timeBins version of each included data sets: 40 | print.timeBins(x = time_bins) 41 | } 42 | \author{ 43 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 44 | } 45 | -------------------------------------------------------------------------------- /man/permute_combinations_with_replacement.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_combinations_with_replacement.r 3 | \name{permute_combinations_with_replacement} 4 | \alias{permute_combinations_with_replacement} 5 | \title{Permute all combinations of x of size m with replacement} 6 | \usage{ 7 | permute_combinations_with_replacement(x, m) 8 | } 9 | \arguments{ 10 | \item{x}{A character vector.} 11 | 12 | \item{m}{A positive integer indicating the size of the set desired.} 13 | } 14 | \value{ 15 | A matrix of m columns where each row is a unique combination of x. 16 | } 17 | \description{ 18 | Given a vector x, permutes all possible groups of size m ignoring order and allowing any item in x to appear multiple times. 19 | } 20 | \details{ 21 | This is a simple combinatoric function used internally in Claddis where all possible combinations of \code{x} that are size \code{m} are permuted. Note that this ignores order (i.e., the sets \\{A,B\\} and \\{B,A\\} are considered identical) and replacements (or multiples) of an element of \code{x} are allowed (i.e., the sets \\{A,A\\} and \\{B,B\\} are both valid). 22 | } 23 | \examples{ 24 | 25 | # Permute all the ways the letters A-C can form a set of size 3: 26 | permute_combinations_with_replacement(x = LETTERS[1:3], m = 3) 27 | 28 | } 29 | \author{ 30 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 31 | } 32 | -------------------------------------------------------------------------------- /R/is.stateGraph.R: -------------------------------------------------------------------------------- 1 | #' Stategraph class 2 | #' 3 | #' @description 4 | #' 5 | #' Functions to deal with the stategraph class. 6 | #' 7 | #' @param x An object of class \code{stateGraph}. 8 | #' 9 | #' @details 10 | #' 11 | #' Claddis uses various classes to define specific types of data, here the use of a character stategraph (to specify the parsimony costs of transitions between character states) are assigned the class "stateGraph". 12 | #' 13 | #' \code{is.stateGraph} checks whether an object is or is not a valid stateGraph object. 14 | #' 15 | #' @return \code{is.stateGraph} returns either TRUE or FALSE. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Make an unordered costmatrix: 22 | #' costmatrix <- make_costmatrix( 23 | #' min_state = 0, 24 | #' max_state = 2, 25 | #' character_type = "unordered" 26 | #' ) 27 | #' 28 | #' # Convert costmatrix to stategraph: 29 | #' stategraph <- convert_costmatrix_to_stategraph(costmatrix = costmatrix) 30 | #' 31 | #' # Check that this is a valid costMatrix object: 32 | #' is.stateGraph(x = stategraph) 33 | #' 34 | #' @export is.stateGraph 35 | is.stateGraph <- function(x) { 36 | 37 | # Get any error messages for stategraph: 38 | messages <- check_stateGraph(stategraph = x) 39 | 40 | # Return logical indicating whether object is a valid stategraph object or not: 41 | ifelse(test = length(x = messages) > 0, yes = FALSE, no = TRUE) 42 | } 43 | -------------------------------------------------------------------------------- /man/print.cladisticMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.cladisticMatrix.r 3 | \name{print.cladisticMatrix} 4 | \alias{print.cladisticMatrix} 5 | \title{Compact display of a cladistic matrix} 6 | \usage{ 7 | \method{print}{cladisticMatrix}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{"cladisticMatrix"}.} 11 | 12 | \item{...}{Further arguments passed to or from other methods.} 13 | } 14 | \value{ 15 | Nothing is directly returned, instead a text summary describing the dimensions and nature of an object of class \code{"cladisticMatrix"} is printed to the console. 16 | } 17 | \description{ 18 | Displays a compact summary of the dimensions and nature of a cladistic matrix object. 19 | } 20 | \details{ 21 | Displays some basic summary information on a cladistic matrix object, including number and type of characters, information about ordering, and whether variable weights are used. 22 | } 23 | \examples{ 24 | 25 | # Show print.cladisticMatrix version of each included data sets: 26 | print.cladisticMatrix(x = day_2016) 27 | print.cladisticMatrix(x = gauthier_1986) 28 | print.cladisticMatrix(x = michaux_1989) 29 | 30 | } 31 | \seealso{ 32 | \link{build_cladistic_matrix}, \link{compactify_cladistic_matrix}, \link{prune_cladistic_matrix}, \link{read_nexus_matrix}, \link{safe_taxonomic_reduction}, \link{write_nexus_matrix}, \link{write_tnt_matrix} 33 | } 34 | \author{ 35 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 36 | } 37 | -------------------------------------------------------------------------------- /man/is.taxonGroups.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is.taxonGroups.R 3 | \name{is.taxonGroups} 4 | \alias{is.taxonGroups} 5 | \title{Taxon groups class} 6 | \usage{ 7 | is.taxonGroups(x) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{taxonGroups}.} 11 | } 12 | \value{ 13 | \code{is.taxonGroups} returns either TRUE or FALSE. 14 | } 15 | \description{ 16 | Functions to deal with the taxon groups class. 17 | } 18 | \details{ 19 | Claddis uses various classes to define specific types of data, here the use of taxon groups (to delineate different groups of taxa, e.g., clades, time bins, geographic regions etc.) ae assigned the class "taxonGroups". 20 | 21 | \code{is.taxonGroups} checks whether an object is or is not a valid taxonGroups object. 22 | } 23 | \examples{ 24 | 25 | # Create a taxon groups object: 26 | taxon_groups <- list( 27 | Group_A = c("Species_1", "Species_2", "Species_3"), 28 | Group_B = c("Species_3", "Species_4"), 29 | Group_C = c("Species_5", "Species_6", "Species_7", "Species_8") 30 | ) 31 | 32 | # Check that this is a valid taxonGroups object (will fail as class is not set): 33 | is.taxonGroups(x = taxon_groups) 34 | 35 | # Set class as taxonGroups: 36 | class(taxon_groups) <- "taxonGroups" 37 | 38 | # Check that this is a valid taxonGroups object (will succeed as format and 39 | # class are correct): 40 | is.taxonGroups(x = taxon_groups) 41 | 42 | } 43 | \author{ 44 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 45 | } 46 | -------------------------------------------------------------------------------- /man/partition_time_bins.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/partition_time_bins.R 3 | \name{partition_time_bins} 4 | \alias{partition_time_bins} 5 | \title{Time bin partitioner} 6 | \usage{ 7 | partition_time_bins(n_time_bins, partition_sizes_to_include = "all") 8 | } 9 | \arguments{ 10 | \item{n_time_bins}{The number of time bins.} 11 | 12 | \item{partition_sizes_to_include}{Either "all" (the default) or a vector of requested partition sizes.} 13 | } 14 | \value{ 15 | Returns a list of lists of vectors ready for use in \link{test_rates}. 16 | } 17 | \description{ 18 | Generates all possible contiguous partitions of N time bins. 19 | } 20 | \details{ 21 | This function is designed for use with the \link{test_rates} function and generates all possible contiguous partitions of N time bins. This allows use of an information criterion like AIC to pick a "best" partition, weighing fit and partition number simultaneously. 22 | 23 | You can also ask for only partitions of a specific number using the \code{partition_sizes_to_include} option. For example, \code{partition_sizes_to_include = c(1, 2, 3)} will only return partitions of 1, 2, or 3 sets of elements. 24 | } 25 | \examples{ 26 | 27 | # Get all partitions for four time bins: 28 | partition_time_bins(n_time_bins = 4) 29 | 30 | # Get all partitions for five time bins of size 2: 31 | partition_time_bins(n_time_bins = 5, partition_sizes_to_include = 2) 32 | } 33 | \author{ 34 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 35 | } 36 | -------------------------------------------------------------------------------- /man/split_out_subgraphs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/split_out_subgraphs.R 3 | \name{split_out_subgraphs} 4 | \alias{split_out_subgraphs} 5 | \title{Split adjacency matrix into subgraphs} 6 | \usage{ 7 | split_out_subgraphs(adjacency_matrix) 8 | } 9 | \arguments{ 10 | \item{adjacency_matrix}{An adjacency matrix where the diagonal is zeroes and the off-diagonal either ones (if the two vertices are directly connected) or zeroes (if not directly connected).} 11 | } 12 | \value{ 13 | A list of all connected subgraphs represented as adjacency matri(ces). 14 | } 15 | \description{ 16 | Given a graph represented by an adjacency matrix splits into all connected subgraphs. 17 | } 18 | \details{ 19 | This functions take any undirected graph (connected or unconnected) represented as an adjacency matrix and identifies all connected subgraphs and returns these as a list of adjacency matr(ices). 20 | } 21 | \examples{ 22 | 23 | # Create an adjacency matrix representing an unconnected graph: 24 | adjacency_matrix <- matrix( 25 | data = c( 26 | 0, 0, 0, 1, 1, 0, 27 | 0, 0, 1, 0, 0, 1, 28 | 0, 1, 0, 0, 0, 1, 29 | 1, 0, 0, 0, 0, 0, 30 | 1, 0, 0, 0, 0, 0, 31 | 0, 1, 1, 0, 0, 0 32 | ), 33 | ncol = 6, 34 | byrow = TRUE, 35 | dimnames = list(LETTERS[1:6], LETTERS[1:6]) 36 | ) 37 | 38 | # Check graph is connected: 39 | split_out_subgraphs(adjacency_matrix = adjacency_matrix) 40 | 41 | } 42 | \author{ 43 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 44 | } 45 | -------------------------------------------------------------------------------- /man/match_tree_edges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/match_tree_edges.R 3 | \name{match_tree_edges} 4 | \alias{match_tree_edges} 5 | \title{Edge matching function} 6 | \usage{ 7 | match_tree_edges(original_tree, pruned_tree) 8 | } 9 | \arguments{ 10 | \item{original_tree}{A tree in phylo format.} 11 | 12 | \item{pruned_tree}{A tree in phylo format that represents a pruned version of \code{original_tree}.} 13 | } 14 | \value{ 15 | \item{matching_edges}{A list of the matching edges.} 16 | \item{matching_nodes}{A matrix of matching node numbers.} 17 | \item{removed_edges}{A vector of the removed edges.} 18 | } 19 | \description{ 20 | Given two trees where one is a pruned version of the other gives matching edges and nodes of pruned tree to original tree. 21 | } 22 | \details{ 23 | Finds matching edge(s) and node(s) for a pruned tree in the original tree from which it was created. This is intended as an internal function, but may be of use to someone. 24 | } 25 | \examples{ 26 | 27 | # Create a random 10-taxon tree: 28 | original_tree <- ape::rtree(n = 10) 29 | 30 | # Remove three leaves: 31 | pruned_tree <- ape::drop.tip(phy = original_tree, tip = c("t1", "t3", "t8")) 32 | 33 | # Find matching edges: 34 | X <- match_tree_edges(original_tree, pruned_tree) 35 | 36 | # Show matching edges: 37 | X$matching_edges 38 | 39 | # Show matching nodes: 40 | X$matching_nodes 41 | 42 | # Show removed edges: 43 | X$removed_edges 44 | } 45 | \author{ 46 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 47 | } 48 | -------------------------------------------------------------------------------- /R/find_linked_edges.R: -------------------------------------------------------------------------------- 1 | #' Find linked edges for a tree 2 | #' 3 | #' @description 4 | #' 5 | #' Given a tree finds edges that are linked to each other. 6 | #' 7 | #' @param tree A tree (phylo object). 8 | #' 9 | #' @details 10 | #' 11 | #' Finds all edges that link (share a node) with each edge of a tree. 12 | #' 13 | #' This is intended as an internal function, but may be of use to someone else. 14 | #' 15 | #' @return Returns a matrix where links are scored 1 and everything else 0. The diagonal is left as zero. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Create a simple four-taxon tree: 22 | #' tree <- ape::read.tree(text = "(A,(B,(C,D)));") 23 | #' 24 | #' # Find linked (1) edges matrix for tree: 25 | #' find_linked_edges(tree) 26 | #' @export find_linked_edges 27 | find_linked_edges <- function(tree) { 28 | 29 | # Create matrix of linked edges (all starting as unlinked, 0): 30 | edge_link_matrix <- matrix(0, nrow = nrow(tree$edge), ncol = nrow(tree$edge), dimnames = list(1:nrow(tree$edge), 1:nrow(tree$edge))) 31 | 32 | # For each edge: 33 | for (i in 1:nrow(tree$edge)) { 34 | 35 | # Find linked edges: 36 | links <- setdiff(x = union(which(x = apply(tree$edge == tree$edge[i, 1], 1, sum) == 1), which(x = apply(tree$edge == tree$edge[i, 2], 1, sum) == 1)), y = i) 37 | 38 | # Code 1 (linked) for linked edges in matrix: 39 | edge_link_matrix[i, links] <- edge_link_matrix[links, i] <- 1 40 | } 41 | 42 | # Return edge links matrix: 43 | edge_link_matrix 44 | } 45 | -------------------------------------------------------------------------------- /man/find_minimum_spanning_edges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_minimum_spanning_edges.R 3 | \name{find_minimum_spanning_edges} 4 | \alias{find_minimum_spanning_edges} 5 | \title{Get edges of minimum spanning tree} 6 | \usage{ 7 | find_minimum_spanning_edges(distance_matrix) 8 | } 9 | \arguments{ 10 | \item{distance_matrix}{A square matrix of distances between objects.} 11 | } 12 | \value{ 13 | A vector of named edges (X->Y) with their distances. The sum of this vector is the length of the minimum spanning tree. 14 | } 15 | \description{ 16 | Returns edges of a minimum spanning tree given a distance matrix. 17 | } 18 | \details{ 19 | This function is a wrapper for \link[ape]{mst} in the \link[ape]{ape} package, but returns a vector of edges rather than a square matrix of links. 20 | } 21 | \examples{ 22 | 23 | # Create a simple square matrix of distances: 24 | distance_matrix <- matrix(c(0, 1, 2, 3, 1, 0, 1, 2, 2, 1, 0, 1, 3, 2, 1, 0), 25 | nrow = 4, 26 | dimnames = list(LETTERS[1:4], LETTERS[1:4]) 27 | ) 28 | 29 | # Show matrix to confirm that the off diagonal has the shortest 30 | # distances: 31 | distance_matrix 32 | 33 | # Use find_minimum_spanning_edges to get the edges for the minimum spanning 34 | # tree: 35 | find_minimum_spanning_edges(distance_matrix) 36 | 37 | # Use sum of find_minimum_spanning_edges to get the length of the minimum 38 | # spanning tree: 39 | sum(find_minimum_spanning_edges(distance_matrix)) 40 | } 41 | \author{ 42 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 43 | } 44 | -------------------------------------------------------------------------------- /man/write_nexus_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_nexus_matrix.R 3 | \name{write_nexus_matrix} 4 | \alias{write_nexus_matrix} 5 | \title{Writes out a morphological #NEXUS data file} 6 | \usage{ 7 | write_nexus_matrix(cladistic_matrix, file_name) 8 | } 9 | \arguments{ 10 | \item{cladistic_matrix}{The cladistic matrix in the format imported by \link{read_nexus_matrix}.} 11 | 12 | \item{file_name}{The file name to write to. Should end in \code{.nex}.} 13 | } 14 | \description{ 15 | Writes out a morphological data file in #NEXUS format. 16 | } 17 | \details{ 18 | Writes out a #NEXUS (Maddison et al. 1997) data file representing the distribution of characters in a set of taxa. Data must be in the format created by importing data with \link{read_nexus_matrix}. 19 | } 20 | \examples{ 21 | 22 | # Write out Michaux 1989 to current working directory: 23 | write_nexus_matrix(cladistic_matrix = michaux_1989, file_name = "michaux_1989.nex") 24 | 25 | # Remove file when finished: 26 | file.remove(file1 = "michaux_1989.nex") 27 | } 28 | \references{ 29 | Maddison, D. R., Swofford, D. L. and Maddison, W. P., 1997. NEXUS: an extensible file format for systematic information. \emph{Systematic Biology}, \bold{46}, 590-621. 30 | } 31 | \seealso{ 32 | \link{write_tnt_matrix} 33 | 34 | \link{build_cladistic_matrix}, \link{compactify_cladistic_matrix}, \link{prune_cladistic_matrix}, \link{read_nexus_matrix}, \link{safe_taxonomic_reduction}, \link{write_tnt_matrix} 35 | } 36 | \author{ 37 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 38 | } 39 | -------------------------------------------------------------------------------- /R/make_labels.r: -------------------------------------------------------------------------------- 1 | #' Make unique text labels 2 | #' 3 | #' @description 4 | #' 5 | #' Given a requisite number, generates that many unique text labels. 6 | #' 7 | #' @param N The number of labels required, 8 | #' 9 | #' @details 10 | #' 11 | #' Where a list of unique text labels are required (i.e., where simple numbering will not suffice) it can be useful to have a simple function that generates the required amount. 12 | #' 13 | #' In practice, this is simple in R when N is 26 or less as the \code{LETTERS} object can be used for this purpose. For example, to get ten unique labels: 14 | #' 15 | #' \code{LETTERS[1:10]} 16 | #' 17 | #' This function works in a similar way but will add a second, third etc. letter where the value of N requires it. 18 | #' 19 | #' @return A character vector of N unique labels. 20 | #' 21 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 22 | #' 23 | #' @examples 24 | #' 25 | #' # Make 40 unique text labels: 26 | #' make_labels(N = 40) 27 | #' 28 | #' @export make_labels 29 | make_labels <- function(N) { 30 | 31 | # Make starting exponent: 32 | exponent <- 1 33 | 34 | # If necessary increase exponent to meet the demands of N: 35 | while (N > (26 ^ exponent)) exponent <- exponent + 1 36 | 37 | # Generate a list of letters using the exponent value: 38 | letters_list <- lapply( 39 | X = as.list(x = 1:exponent), 40 | FUN = function(i) LETTERS 41 | ) 42 | 43 | # Return a character vector of unique labels: 44 | apply( 45 | X = expand.grid(letters_list), 46 | MARGIN = 1, 47 | FUN = paste, 48 | collapse = "" 49 | )[1:N] 50 | } 51 | -------------------------------------------------------------------------------- /man/permute_graph_splits.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_graph_splits.r 3 | \name{permute_graph_splits} 4 | \alias{permute_graph_splits} 5 | \title{Permute all ways to split a graph} 6 | \usage{ 7 | permute_graph_splits(adjacency_matrix) 8 | } 9 | \arguments{ 10 | \item{adjacency_matrix}{A labelled adjacency matrix where the diagonal is zeroes and the off-diagonal either ones (if the two vertices are directly connected) or zeroes (if not directly connected). Labels must match across row names and column names,} 11 | } 12 | \value{ 13 | A vector of splits where connected vert(ices) are listed with "+" joining them and disconnected vert(ices) are separated by "|". 14 | } 15 | \description{ 16 | Given a graph represented by an adjacency matrix, permutes all ways this graph could be split apart. 17 | } 18 | \details{ 19 | This function takes a connected graph and considers all the ways it \emph{could} be split by removing every possible combination of edges (inclusive of none and all). 20 | } 21 | \examples{ 22 | 23 | # Create a connected graph matrix: 24 | adjacency_matrix <- matrix( 25 | data = c( 26 | 0, 1, 0, 0, 1, 0, 27 | 1, 0, 1, 0, 1, 0, 28 | 0, 1, 0, 1, 0, 0, 29 | 0, 0, 1, 0, 1, 1, 30 | 1, 1, 0, 1, 0, 0, 31 | 0, 0, 0, 1, 0, 0 32 | ), 33 | ncol = 6, 34 | byrow = TRUE, 35 | dimnames = list( 36 | LETTERS[1:6], 37 | LETTERS[1:6] 38 | ) 39 | ) 40 | 41 | # Check graph is connectedPermute all ways to split graph (remove edges): 42 | permute_graph_splits(adjacency_matrix = adjacency_matrix) 43 | 44 | } 45 | \author{ 46 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 47 | } 48 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check.yaml 10 | 11 | permissions: read-all 12 | 13 | jobs: 14 | R-CMD-check: 15 | runs-on: ${{ matrix.config.os }} 16 | 17 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 18 | 19 | strategy: 20 | fail-fast: false 21 | matrix: 22 | config: 23 | - {os: macos-latest, r: 'release'} 24 | - {os: windows-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 26 | - {os: ubuntu-latest, r: 'release'} 27 | - {os: ubuntu-latest, r: 'oldrel-1'} 28 | 29 | env: 30 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 31 | R_KEEP_PKG_SOURCE: yes 32 | 33 | steps: 34 | - uses: actions/checkout@v4 35 | 36 | - uses: r-lib/actions/setup-pandoc@v2 37 | 38 | - uses: r-lib/actions/setup-r@v2 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | http-user-agent: ${{ matrix.config.http-user-agent }} 42 | use-public-rspm: true 43 | 44 | - uses: r-lib/actions/setup-r-dependencies@v2 45 | with: 46 | extra-packages: any::rcmdcheck 47 | needs: check 48 | 49 | - uses: r-lib/actions/check-r-package@v2 50 | with: 51 | upload-snapshots: true 52 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 53 | -------------------------------------------------------------------------------- /R/is.taxonGroups.R: -------------------------------------------------------------------------------- 1 | #' Taxon groups class 2 | #' 3 | #' @description 4 | #' 5 | #' Functions to deal with the taxon groups class. 6 | #' 7 | #' @param x An object of class \code{taxonGroups}. 8 | #' 9 | #' @details 10 | #' 11 | #' Claddis uses various classes to define specific types of data, here the use of taxon groups (to delineate different groups of taxa, e.g., clades, time bins, geographic regions etc.) ae assigned the class "taxonGroups". 12 | #' 13 | #' \code{is.taxonGroups} checks whether an object is or is not a valid taxonGroups object. 14 | #' 15 | #' @return \code{is.taxonGroups} returns either TRUE or FALSE. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Create a taxon groups object: 22 | #' taxon_groups <- list( 23 | #' Group_A = c("Species_1", "Species_2", "Species_3"), 24 | #' Group_B = c("Species_3", "Species_4"), 25 | #' Group_C = c("Species_5", "Species_6", "Species_7", "Species_8") 26 | #' ) 27 | #' 28 | #' # Check that this is a valid taxonGroups object (will fail as class is not set): 29 | #' is.taxonGroups(x = taxon_groups) 30 | #' 31 | #' # Set class as taxonGroups: 32 | #' class(taxon_groups) <- "taxonGroups" 33 | #' 34 | #' # Check that this is a valid taxonGroups object (will succeed as format and 35 | #' # class are correct): 36 | #' is.taxonGroups(x = taxon_groups) 37 | #' 38 | #' @export is.taxonGroups 39 | is.taxonGroups <- function(x) { 40 | 41 | # Get any error messages for taxon_groups: 42 | messages <- check_taxonGroups(taxon_groups = x) 43 | 44 | # Return logical indicating whether object is a valid taxonGroups object or not: 45 | ifelse(test = length(x = messages) > 0, yes = FALSE, no = TRUE) 46 | } 47 | -------------------------------------------------------------------------------- /man/bin_changes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bin_changes.R 3 | \name{bin_changes} 4 | \alias{bin_changes} 5 | \title{Counts the changes in a series of time bins} 6 | \usage{ 7 | bin_changes(change_times, time_bins) 8 | } 9 | \arguments{ 10 | \item{change_times}{A vector of ages in millions of years at which character changes are hypothesised to have occurred.} 11 | 12 | \item{time_bins}{An object of class \code{timeBins}.} 13 | } 14 | \value{ 15 | A vector giving the number of changes for each time bin. Names indicate the maximum and minimum (bottom and top) values for each time bin. 16 | } 17 | \description{ 18 | Given a vector of dates for a series of time bins and another for the times when a character change occurred will return the total number of changes in each bin. 19 | } 20 | \details{ 21 | Calculates the total number of evolutionary changes in a series of time bins. This is intended as an internal function for rate calculations, but could be used for other purposes (e.g., counting any point events in a series of time bins). 22 | } 23 | \examples{ 24 | 25 | # Create a random dataset of 100 changes (between 100 and 0 Ma): 26 | change_times <- stats::runif(n = 100, min = 0, max = 100) 27 | 28 | # Create 10 equal-length time bins: 29 | time_bins <- matrix(data = c(seq(from = 100, to = 10, length.out = 10), 30 | seq(from = 90, to = 0, length.out = 10)), ncol = 2, 31 | dimnames = list(LETTERS[1:10], c("fad", "lad"))) 32 | 33 | # Set class as timeBins: 34 | class(time_bins) <- "timeBins" 35 | 36 | # Get N changes for each bin: 37 | bin_changes(change_times = change_times, time_bins = time_bins) 38 | } 39 | \author{ 40 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 41 | } 42 | -------------------------------------------------------------------------------- /R/count_cherries.R: -------------------------------------------------------------------------------- 1 | #' Counts the number of cherries in a tree 2 | #' 3 | #' @description 4 | #' 5 | #' Given a set of phylogenetic tree(s) returns the number of cherries in each one. 6 | #' 7 | #' @param tree A tree (phylo or multiPhylo object). 8 | #' 9 | #' @details 10 | #' 11 | #' Cherries are components of a phylogenetic tree defined as internal nodes with exactly two terminal descendants. 12 | #' 13 | #' This function simply counts the number present in a given tree. 14 | #' 15 | #' Note that any fully dichotomous phylogenetic tree must have at least one cherry. 16 | #' 17 | #' @return Returns a vector of cherry counts for each tree retaining the order in which they were supplied. 18 | #' 19 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 20 | #' 21 | #' @examples 22 | #' 23 | #' # Create simple two-cherry tree: 24 | #' tree <- ape::read.tree(text = "((A,B),(C,D));") 25 | #' 26 | #' # Show count of cherries is two: 27 | #' count_cherries(tree = tree) 28 | #' 29 | #' # Create a star tree: 30 | #' tree <- ape::read.tree(text = "(A,B,C,D);") 31 | #' 32 | #' # Show count of cherries is zero: 33 | #' count_cherries(tree = tree) 34 | #' 35 | #' @export count_cherries 36 | count_cherries <- function(tree) { 37 | 38 | # If a single tree return scalar of pre-terminal nodes with two descendants (i.e., cherries): 39 | if (inherits(x = tree, what = "phylo")) return(value = sum(x = rle(x = sort(x = tree$edge[match(x = 1:ape::Ntip(tree), table = tree$edge[, 2]), 1]))$lengths == 2)) 40 | 41 | # If multiple trees return vector of pre-terminal nodes with two descendants (i.e., cherries): 42 | if (inherits(x = tree, what = "multiPhylo")) return(unlist(lapply(X = tree, FUN = function(x) value = sum(x = rle(x = sort(x = x$edge[match(x = 1:ape::Ntip(x), table = x$edge[, 2]), 1]))$lengths == 2)))) 43 | } 44 | -------------------------------------------------------------------------------- /man/align_matrix_block.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/align_matrix_block.R 3 | \name{align_matrix_block} 4 | \alias{align_matrix_block} 5 | \title{Aligns a phylogenetic matrix block} 6 | \usage{ 7 | align_matrix_block(matrix_block) 8 | } 9 | \arguments{ 10 | \item{matrix_block}{The matrix block as raw input text.} 11 | } 12 | \value{ 13 | Nothing is returned, instead the aligned block is sent to the clipboard ready for pasting into a text editor. 14 | } 15 | \description{ 16 | Given a block of taxa and characters aligns text so each character block begins at same point. 17 | } 18 | \details{ 19 | The function serves to help build NEXUS files by neatly aligning raw text blocks of taxa and characters. Or in simple terms it takes input that looks like this: 20 | 21 | \preformatted{Allosaurus 012100?1011 22 | Abelisaurus 0100???0000 23 | Tyrannosaurus 01012012010 24 | Yi 10101?0????} 25 | 26 | And turns it into something that looks like this: 27 | 28 | \preformatted{Allosaurus 012100?1011 29 | Abelisaurus 0100???0000 30 | Tyrannosaurus 01012012010 31 | Yi 10101?0????} 32 | 33 | I use this in building the NEXUS files on my site, \href{http://www.graemetlloyd.com/matr.html}{graemetlloyd.com}. 34 | } 35 | \examples{ 36 | 37 | # Build example block from above: 38 | x <- paste(c( 39 | "Allosaurus 012100?1011", 40 | "Abelisaurus 0100???0000", 41 | "Tyrannosaurus 01012012010", 42 | "Yi 10101?0????" 43 | ), collapse = "\n") 44 | 45 | # Look at block pre-alignment: 46 | x 47 | 48 | # Align block and place on clipboard: 49 | \dontrun{ 50 | align_matrix_block(x) 51 | } 52 | 53 | # To test the response open a text editor and paste the 54 | # contents of the clipboard. 55 | } 56 | \author{ 57 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 58 | } 59 | -------------------------------------------------------------------------------- /R/check_cladisticMatrix.R: -------------------------------------------------------------------------------- 1 | #' Check cladisticMatrix object for errors 2 | #' 3 | #' @description 4 | #' 5 | #' Internal function to check cladisticMatrix object for errors. 6 | #' 7 | #' @param cladistic_matrix An object of class \code{cladisticMatrix}. 8 | #' 9 | #' @details 10 | #' 11 | #' Internal Claddis function. Nothing to see here. Carry on. 12 | #' 13 | #' @return An error message or empty vector if no errors found. 14 | #' 15 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 16 | #' 17 | #' @examples 18 | #' 19 | #' # Check that this is a valid cladisticMatrix object (will return error message as class 20 | #' # is not set): 21 | #' check_cladisticMatrix(cladistic_matrix = day_2016) 22 | #' 23 | #' @export check_cladisticMatrix 24 | check_cladisticMatrix <- function(cladistic_matrix) { 25 | 26 | # TO DO: 27 | # 28 | # Make this class hierarchical? E.g., add matrixBlock class. Also, maybe add just a taxon names part to output. 29 | 30 | # Check cladistic_matrix has class cladisticMatrix and add error message to output if true: 31 | if (!inherits(x = cladistic_matrix, what = "cladisticMatrix")) return("cladistic_matrix must be an object of class \"cladisticMatrix\".") 32 | 33 | # Check cladistic_matrix are in form of list add error message to output if false: 34 | if (!is.list(x = cladistic_matrix)) return("cladistic_matrix must be in the form of a list.") 35 | 36 | # Check there are at least two elements to cladistic_matrix: 37 | if (length(x = cladistic_matrix) < 2) return("cladistic_matrix must have at least two elements.") 38 | 39 | # Check first element is called topper: 40 | if (names(cladistic_matrix)[1] != "topper") return("cladistic_matrix must have at first element called \"topper\".") 41 | 42 | # WAY MORE STUFF HERE 43 | 44 | # Return empty vector: 45 | vector(mode = "character") 46 | } 47 | -------------------------------------------------------------------------------- /man/locate_bracket_positions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/locate_bracket_positions.r 3 | \name{locate_bracket_positions} 4 | \alias{locate_bracket_positions} 5 | \title{Locates matching positions for sets of brackets in a text string} 6 | \usage{ 7 | locate_bracket_positions(input_string, bracket_type = "()") 8 | } 9 | \arguments{ 10 | \item{input_string}{An input string containing matching brackets, such as a Newick string or character state tree.} 11 | 12 | \item{bracket_type}{The type of bracket to use. Must be one of parentheses \code{()}, curly braces \code{{}}, or square brackets \code{[]}.} 13 | } 14 | \value{ 15 | A two-column matrix indicating opening and closing bracket positions within \code{input_string}. 16 | } 17 | \description{ 18 | Given a text string will return the positions of each matching pair of opening and closing brackets. 19 | } 20 | \details{ 21 | This function is designed to deal with Newick strings and character state trees - ways of encoding information using nested parentheses. Although it is intended for internal use it seems sufficiently general to share as part of the package. 22 | 23 | The function works by traversing the string from left to right and noting the position of each opening parenthesis and then storing the corresponding position for its' matching closing parenthesis. 24 | 25 | It currently only works for a single string, but coud be built into a for loop or apply function if multiple strings are desired. 26 | } 27 | \examples{ 28 | 29 | # Locate the positions of a set of parentheses in a character state tree: 30 | locate_bracket_positions( 31 | input_string = "(((5)4)3,(2)1)0", 32 | bracket_type = "()" 33 | ) 34 | 35 | } 36 | \seealso{ 37 | \link{convert_state_tree_to_adjacency_matrix} 38 | } 39 | \author{ 40 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 41 | } 42 | -------------------------------------------------------------------------------- /man/plot_changes_on_tree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_changes_on_tree.R 3 | \name{plot_changes_on_tree} 4 | \alias{plot_changes_on_tree} 5 | \title{Plots character changes on branches} 6 | \usage{ 7 | plot_changes_on_tree(character_changes, time_tree, label_size = 0.5) 8 | } 9 | \arguments{ 10 | \item{character_changes}{A matrix of character changes.} 11 | 12 | \item{time_tree}{Tree on which character changes occur.} 13 | 14 | \item{label_size}{The size of the text for the barnch labels. Default is 0.5.} 15 | } 16 | \value{ 17 | A plot of character changes on a tree. 18 | } 19 | \description{ 20 | Plots character changes in boxes on branches. 21 | } 22 | \details{ 23 | Takes the \code{character_changes} output from \link{test_rates} and plots it on the tree used to generate it. 24 | } 25 | \examples{ 26 | 27 | # Set random seed: 28 | set.seed(17) 29 | 30 | # Get first MPT for the Michaux data set: 31 | time_tree <- ape::read.tree(text = paste0("(Ancilla:31.6,(Turrancilla:102.7,", 32 | "(Ancillista:1,Amalda:63.5):1):1);")) 33 | 34 | # Set root time for tree: 35 | time_tree$root.time <- 103.7 36 | 37 | # Generate two equal length time bins: 38 | time_bins <- matrix(data = c(seq(time_tree$root.time, 0, length.out = 3)[1:2], 39 | seq(time_tree$root.time, 0, length.out = 3)[2:3]), ncol = 2, dimnames = list(LETTERS[1:2], 40 | c("fad", "lad"))) 41 | 42 | # Set class as timeBins: 43 | class(time_bins) <- "timeBins" 44 | 45 | # Get discrete character rates (includes changes): 46 | out <- test_rates( 47 | time_tree = time_tree, 48 | cladistic_matrix = michaux_1989, 49 | time_bins = time_bins, 50 | branch_partitions = list(list(1)), 51 | alpha = 0.01 52 | ) 53 | 54 | # Plot character changes on the tree: 55 | plot_changes_on_tree( 56 | character_changes = out$inferred_character_changes, 57 | time_tree = time_tree 58 | ) 59 | } 60 | \author{ 61 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 62 | } 63 | -------------------------------------------------------------------------------- /man/calculate_MPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_MPD.R 3 | \name{calculate_MPD} 4 | \alias{calculate_MPD} 5 | \title{Calculate mean pairwise distances} 6 | \usage{ 7 | calculate_MPD(distances, taxon_groups) 8 | } 9 | \arguments{ 10 | \item{distances}{An object of class \code{distanceMatrices}.} 11 | 12 | \item{taxon_groups}{An object of class \code{taxonGroups}.} 13 | } 14 | \value{ 15 | A labelled vector of weighted mean pairwise distances. 16 | } 17 | \description{ 18 | Given distanceMatrices and taxonGroups objects calculates their mean pairwise distances. 19 | } 20 | \details{ 21 | Not all measures of disparity (morphological distance) require an ordination space. For example, the pariwise distances between taxa are themselves a disparity metric. This function takes the output from \link{calculate_morphological_distances} and a set of taxon groups and returns the mean pairwise distance for each of those groups. 22 | } 23 | \examples{ 24 | 25 | # Get morphological distances for the Day et al. (2016) data set: 26 | distances <- calculate_morphological_distances( 27 | cladistic_matrix = day_2016, 28 | distance_metric = "mord", 29 | distance_transformation = "none" 30 | ) 31 | 32 | # Build simple taxonomic groups for Day et al. (2016) data set: 33 | taxon_groups <- list(nonBurnetiamorpha = c("Biarmosuchus_tener", "Hipposaurus_boonstrai", 34 | "Bullacephalus_jacksoni", "Pachydectes_elsi", "Niuksenitia_sukhonensis", "Ictidorhinus_martinsi", 35 | "RC_20", "Herpetoskylax_hopsoni"), Burnetiamorpha = c("Lemurosaurus_pricei", "Lobalopex_mordax", 36 | "Lophorhinus_willodenensis", "Proburnetia_viatkensis", "Lende_chiweta", 37 | "Paraburnetia_sneeubergensis", "Burnetia_mirabilis", "BP_1_7098")) 38 | 39 | # Set class as taxonGroups: 40 | class(taxon_groups) <- "taxonGroups" 41 | 42 | # Calculate mean pairwise distances: 43 | calculate_MPD(distances, taxon_groups) 44 | 45 | } 46 | \author{ 47 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 48 | } 49 | -------------------------------------------------------------------------------- /man/fix_root_time.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fix_root_time.R 3 | \name{fix_root_time} 4 | \alias{fix_root_time} 5 | \title{Fixes root.time after taxa have been pruned from a tree} 6 | \usage{ 7 | fix_root_time(original_tree, pruned_tree) 8 | } 9 | \arguments{ 10 | \item{original_tree}{A tree in phylo format.} 11 | 12 | \item{pruned_tree}{A tree in phylo format that represents a pruned version of \code{original_tree}.} 13 | } 14 | \value{ 15 | Returns a tree (phylo object) with a fixed \code{$root.time}. 16 | } 17 | \description{ 18 | Fixes root.time after taxa have been pruned from a tree using ape::drop.tip 19 | } 20 | \details{ 21 | (NB: This function is designed to only cope with trees containing at least three tips.) 22 | 23 | When removing taxa from a time-scaled tree using \link[ape]{drop.tip} in \link[ape]{ape} \code{$root.time} is left unchanged. This can cause downstream problems if not fixed and that is what this function does. 24 | 25 | Note that \code{fix_root_time} in the \code{paleotree} package performs the same function, but is not called here to reduce the number of libraries on which \code{Claddis} is dependent. Interested users should also refer to the \code{dropPaleoTip} function in \code{paleotree}. 26 | } 27 | \examples{ 28 | 29 | # Create a simple four-taxon tree with branch lengths: 30 | tree <- ape::read.tree(text = "(A:1,(B:1,(C:1,D:1):1):1);") 31 | 32 | # Set root age as 20 Ma: 33 | tree$root.time <- 20 34 | 35 | # Now prune taxon A: 36 | pruned_tree <- ape::drop.tip(phy = tree, tip = "A") 37 | 38 | # Show that drop.tip has not updated the tree's root time: 39 | pruned_tree$root.time 40 | 41 | # Use the function to fix the root time: 42 | pruned_tree <- fix_root_time(original_tree = tree, pruned_tree = pruned_tree) 43 | 44 | # Show that the root time is now fixed (19 Ma): 45 | pruned_tree$root.time 46 | } 47 | \seealso{ 48 | \link{drop_time_tip} 49 | } 50 | \author{ 51 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 52 | } 53 | -------------------------------------------------------------------------------- /man/permute_connected_graphs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_connected_graphs.r 3 | \name{permute_connected_graphs} 4 | \alias{permute_connected_graphs} 5 | \title{Permute all connected graphs} 6 | \usage{ 7 | permute_connected_graphs(n_vertices) 8 | } 9 | \arguments{ 10 | \item{n_vertices}{The number of vertices to connect.} 11 | } 12 | \value{ 13 | A list of graphs (matrices of dummy labelled edges). 14 | } 15 | \description{ 16 | Given a vertex count, permutes all connected graphs. 17 | } 18 | \details{ 19 | For the two vertex case there is only a single connected graph: 20 | 21 | \preformatted{A---B} 22 | 23 | (The labels A and B here simply indicate the two vertices and are not a true labelling.) 24 | 25 | If we add a third vertex, there are two connected graphs: 26 | 27 | \preformatted{A---B 28 | \ / 29 | C} 30 | 31 | And: 32 | 33 | \preformatted{A---B---C} 34 | 35 | This function permutes all such connected graphs for a given vertex count. 36 | 37 | Note that the output is in the form of a matrix of edges. For the three vertex case above these would be: 38 | 39 | \preformatted{ [,1] [,2] 40 | [1,] "A" "B" 41 | [2,] "A" "C" 42 | [3,] "B" "C"} 43 | 44 | And: 45 | 46 | \preformatted{ [,1] [,2] 47 | [1,] "A" "B" 48 | [2,] "B" "C"} 49 | 50 | Again, it is important to note that the labels A, B, and C here are purely "dummy" labels and should not be considered a graph labelling. To use the second graph as an example there are multiple labellings of this graph: 51 | 52 | \preformatted{A---B---C} 53 | 54 | And: 55 | 56 | \preformatted{B---A---C} 57 | 58 | And: 59 | 60 | \preformatted{A---C---B} 61 | 62 | However, these are all isomorphisms of the same unlabelled graph. Only the unique graphs themselves are returned here. 63 | } 64 | \examples{ 65 | 66 | # Generate all connected graphs of four vertices: 67 | permute_connected_graphs(n_vertices = 4) 68 | 69 | } 70 | \author{ 71 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 72 | } 73 | -------------------------------------------------------------------------------- /man/compactify_cladistic_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/compactify_cladistic_matrix.R 3 | \name{compactify_cladistic_matrix} 4 | \alias{compactify_cladistic_matrix} 5 | \title{Collapses matrix to unique character state distributions} 6 | \usage{ 7 | compactify_cladistic_matrix(cladistic_matrix, message = TRUE) 8 | } 9 | \arguments{ 10 | \item{cladistic_matrix}{The cladistic matrix in the format imported by \link{read_nexus_matrix}.} 11 | 12 | \item{message}{Logical indicating whether or not a message should be printed to the screen if the matrix cannot be compactified.} 13 | } 14 | \description{ 15 | Collapses a cladistic matrix to just unique character state distributions and taxon names. 16 | } 17 | \details{ 18 | Important: not recommended for general use. 19 | 20 | This function is intended to make a matrix with redundant character state distributions smaller by collapsing these to single characters and upweighting them accordingly. It is intended purely for use with MRP matrices, but may have some very restricted uses elsewhere. 21 | 22 | The function also deletes any characters weighted zero from the matrix and will merge duplicate taxon names into unique character strings. 23 | } 24 | \examples{ 25 | 26 | # Examine the matrix pre-compactification: 27 | michaux_1989$matrix_1$matrix 28 | 29 | # Examine the weights pre-compactification: 30 | michaux_1989$matrix_1$character_weights 31 | 32 | # Compactify the matrix: 33 | michaux_1989compact <- compactify_cladistic_matrix(michaux_1989) 34 | 35 | # Examine the matrix post-compactification: 36 | michaux_1989compact$matrix_1$matrix 37 | 38 | # Examine the weights post-compactification: 39 | michaux_1989compact$matrix_1$character_weights 40 | 41 | } 42 | \seealso{ 43 | \link{build_cladistic_matrix}, \link{prune_cladistic_matrix}, \link{read_nexus_matrix}, \link{safe_taxonomic_reduction}, \link{write_nexus_matrix}, \link{write_tnt_matrix} 44 | } 45 | \author{ 46 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 47 | } 48 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite package 'Claddis' in a publication use:") 2 | 3 | bibentry(bibtype = "Article", 4 | title = "Estimating morphological diversity and tempo with discrete character-taxon matrices: implementation, challenges, progress, and future directions", 5 | author = c(as.person("Graeme T. Lloyd")), 6 | journal = "Biological Journal of the Linnean Society", 7 | year = "2016", 8 | volume = "118", 9 | pages = "131-151", 10 | doi = "10.1111/bij.12746", 11 | textVersion = "Lloyd, Graeme T. (2016). Estimating morphological diversity and tempo with discrete character-taxon matrices: implementation, challenges, progress, and future directions. Biological Journal of the Linnean Society, 118, 131-151.") 12 | 13 | bibentry(bibtype = "Article", 14 | title = "Journeys through discrete-character morphospace: synthesizing phylogeny, tempo, and disparity", 15 | author = c(as.person("Graeme T. Lloyd")), 16 | journal = "Palaeontology", 17 | year = "2018", 18 | volume = "61", 19 | pages = "637-645", 20 | doi = "10.1111/pala.12380", 21 | textVersion = "Lloyd, Graeme T. (2018). Journeys through discrete-character morphospace: synthesizing phylogeny, tempo, and disparity. Palaeontology, 61, 637-645.") 22 | 23 | bibentry(bibtype = "Article", 24 | title = "Biases with the Generalized Euclidean Distance measure in disparity analyses with high levels of missing data", 25 | author = c(as.person("Oscar E. R. Lehmann"), as.person("Martin D. Ezcurra"), as.person("Richard J. Butler"), as.person("Graeme T. Lloyd")), 26 | journal = "Palaeontology", 27 | year = "2019", 28 | volume = "62", 29 | pages = "837-849", 30 | doi = "10.1111/pala.12430", 31 | textVersion = "Lehmann, Oscar E. R., Ezcurra, Martin D., Butler, Richard J. and Lloyd, Graeme T. (2019). Biases with the Generalized Euclidean Distance measure in disparity analyses with high levels of missing data. Palaeontology, 62, 837-849.") 32 | 33 | citFooter("As Claddis is evolving rapidly, you may want to also cite its version number (found with 'library(help = Claddis)').") 34 | -------------------------------------------------------------------------------- /man/permute_all_treeshape_labellings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_all_treeshape_labellings.r 3 | \name{permute_all_treeshape_labellings} 4 | \alias{permute_all_treeshape_labellings} 5 | \title{Label treeshapes} 6 | \usage{ 7 | permute_all_treeshape_labellings(treeshapes, labels) 8 | } 9 | \arguments{ 10 | \item{treeshapes}{A vector of treeshape(s) in the same format as \link{permute_treeshapes}.} 11 | 12 | \item{labels}{A character vector of tip labels to use for labelling.} 13 | } 14 | \value{ 15 | A list of the same length as \code{treeshapes} composed of character vectors of labelled phylogenetic trees in the Newick format (Felsenstein 2004). 16 | } 17 | \description{ 18 | Given a treeshape and set of labels, permutes all possible labelled phylogenetic trees. 19 | } 20 | \details{ 21 | A treeshape is an unlabelled phylogenetic tree and as such can be labelled to produce a phylogenetic tree. This function takes a treeshape and a set of labels and generates (permutes) all possible labellings, i.e., all phylogenetic trees which a treeshape represents. 22 | 23 | Note that the star tree always allows only a single labelling, whereas any more resolved treeshape will have multiple labellings. 24 | 25 | Here treeshapes are encoded in the same pseudo-Newick format as the \link{permute_treeshapes} function, e.g.: 26 | 27 | (((3),1),(1,(2))); 28 | 29 | (Where each pair of parentheses represents an internal node, each number the number of tips, each comma separates sets of tips, and the semicolon denotes the root clade.) 30 | } 31 | \examples{ 32 | 33 | # Label some six-tip treeshapes with the letters A-F: 34 | permute_all_treeshape_labellings( 35 | treeshapes = c( 36 | "(6);", 37 | "((3),(3));", 38 | "(1,(1,(1,(1,(2)))));" 39 | ), 40 | labels = LETTERS[1:6] 41 | ) 42 | 43 | } 44 | \references{ 45 | Felsenstein, J., 2004. \emph{Inferring Phylogenies}. Sinauer Associates, Inc., Sunderland. 46 | } 47 | \author{ 48 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 49 | } 50 | -------------------------------------------------------------------------------- /R/find_mrca.R: -------------------------------------------------------------------------------- 1 | #' Find ancestor 2 | #' 3 | #' @description 4 | #' 5 | #' Finds the last common ancestor (node) of a set of two or more descendant tips. 6 | #' 7 | #' @param descendant_names A vector of mode character representing the tip names for which an ancestor is sought. 8 | #' @param tree The tree as a phylo object. 9 | #' 10 | #' @details 11 | #' 12 | #' Intended for use as an internal function for \link{trim_matrix}, but potentially of more general use. 13 | #' 14 | #' @return \item{ancestor_node}{The ancestral node number.} 15 | #' 16 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 17 | #' 18 | #' @examples 19 | #' 20 | #' # Create a simple four-taxon tree: 21 | #' tree <- ape::read.tree(text = "(A,(B,(C,D)));") 22 | #' 23 | #' # Plot the tree: 24 | #' ape::plot.phylo(tree) 25 | #' 26 | #' # Add nodelabels and show that the most recent common 27 | #' # ancestor of B, C, and D is node 6: 28 | #' ape::nodelabels() 29 | #' 30 | #' # Use find_mrca to show that the most recent common 31 | #' # ancestor of B, C, and D is node 6: 32 | #' find_mrca( 33 | #' descendant_names = c("B", "C", "D"), 34 | #' tree = tree 35 | #' ) 36 | #' @export find_mrca 37 | find_mrca <- function(descendant_names, tree) { 38 | 39 | # Get tip numbers: 40 | tip_numbers <- match(descendant_names, tree$tip.label) 41 | 42 | # Get ancestral nodes in order: 43 | ancestor_node <- sort(x = unique(x = tree$edge[, 1][match(tip_numbers, tree$edge[, 2])])) 44 | 45 | # Keep going until a single ancestral node is converged upon: 46 | while (length(x = ancestor_node) > 1) { 47 | 48 | # Get node with highest number (definitely not ancestor): 49 | highest_node <- ancestor_node[length(x = ancestor_node)] 50 | 51 | # Remove this node from the list: 52 | ancestor_node <- ancestor_node[-length(x = ancestor_node)] 53 | 54 | # Find its ancestor and add to unique list: 55 | ancestor_node <- sort(x = unique(x = c(ancestor_node, tree$edge[match(highest_node, tree$edge[, 2]), 1]))) 56 | } 57 | 58 | # Return ancestral node: 59 | ancestor_node 60 | } 61 | -------------------------------------------------------------------------------- /R/print.timeBins.r: -------------------------------------------------------------------------------- 1 | #' Compact display of time bins 2 | #' 3 | #' @description 4 | #' 5 | #' Displays a compact summary of a timeBins object. 6 | #' 7 | #' @param x An object of class \code{"timeBins"}. 8 | #' @param ... Further arguments passed to or from other methods. 9 | #' 10 | #' @details 11 | #' 12 | #' Displays some basic summary information on a time bins object, including number of bins and their names and timespans. 13 | #' 14 | #' @return 15 | #' 16 | #' Nothing is directly returned, instead a text summary describing a \code{"timeBins"} object is printed to the console. 17 | #' 18 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 19 | #' 20 | #' @examples 21 | #' 22 | #' # Create a time bins object: 23 | #' time_bins <- matrix( 24 | #' data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 25 | #' ncol = 2, 26 | #' byrow = TRUE, 27 | #' dimnames = list( 28 | #' c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 29 | #' c("fad", "lad") 30 | #' ) 31 | #' ) 32 | #' 33 | #' # Set class as timeBins: 34 | #' class(time_bins) <- "timeBins" 35 | #' 36 | #' # Show print.timeBins version of each included data sets: 37 | #' print.timeBins(x = time_bins) 38 | #' @export print.timeBins 39 | print.timeBins <- function(x, ...) { 40 | 41 | # Check time_bins has class timeBins and stop and warn user if not: 42 | if (!inherits(x = x, what = "timeBins")) stop("x must be an object of class \"timeBins\".") 43 | 44 | # If not a valid timeBins object then stop and provide feedback to user on what is wrong: 45 | if (!is.timeBins(x = x)) stop(check_timeBins(time_bins = x)[1]) 46 | 47 | # Return summary information about object: 48 | cat(paste0("timeBins object composed of ", nrow(x = x), " bins:"), "\n ", paste0(unname(obj = unlist(x = apply(X = cbind(rownames(x = x), x), MARGIN = 1, FUN = function(y) paste0(y[1], paste0(rep(x = " ", times = max(nchar(x = rownames(x = x))) - nchar(x = y[1]) + 1), collapse = ""), " (", y[2], "-", y[3], " Ma)")))), collapse = "\n ")) 49 | } 50 | -------------------------------------------------------------------------------- /workshops/napc2024/data/lungfish_tree.tre: -------------------------------------------------------------------------------- 1 | (Psarolepis_romeri,(Diabolepis_speratus,((Dipnorhynchus_kiandrensis,(Archaeonectes_pertusus,(Uranolophus_wyomingensis,(Speonesydrion_iani,(Jarvikia_arctica,(((Adololopas_moyasmithae,((Adelargo_schultzei,Chirodipterus_australis),(Chirodipterus_rhenanus,(Chirodipterus_wildungensis,Dipterus_cf_valenciennesi)))),(Barwickia_downunda,Dipterus_valenciennesi)),(Pillararhynchus_longi,(((Gogodipterus_paddyensis,((Tarachomylax_oepiki,(Amadeodipterus_kencampbelli,Stomiahykus_thlaodus)),(Iowadipterus_halli,((Delatitia_breviceps,(Phaneropleuron_andersoni,((Orlovichthys_limnatis,(Howidipterus_donnae,(((Andreyevichthys_epitomus,Oervigia_nordica),(Grossipterus_crassus,(Fleurantia_denticulata,((Robinsondipterus_longi,(Asthenorhynchus_meemannae,(Holodipterus_elderae,Holodipterus_gogoensis))),((Griphognathus_minutidens,(Griphognathus_sculpta,Griphognathus_whitei)),(Rhynchodipterus_elginensis,(Jessenia_concentrica,Soederberghia_groenlandica))))))),(Pentlandia_macroptera,Scaumenacia_curta)))),(Holodipterus_santacrucensis,((Ganopristodus_splendens,(Megapleuron_zangerli,(Sagenodus_inaequalis,(((Eoctenodus_microsoma,Tranodis_castrensis),(Ctenodus_romeri,Straitonia_waterstoni)),((Parasagenodus_sibiricus,(Gnathorhiza_serrata,((Beltanodus_ambilobensis,(Namatozodia_pitikanta,(Ariguna_formosa,(((Aphelodus_anapes,Ceratodus_formosa),((Asiatoceratodus_sharovi,Gosfordia_truncata),(Neoceratodus_forsteri,(Mioceratodus_gregoryi,(Lepidosiren_paradoxa,Protopterus_annectens))))),(Archaeoceratodus_avus,Tellerodus_sturi))))),(Microceratodus_angolensis,(Palaeophichthys_parvulus,(Ptychoceratodus_serratus,(Paraceratodus_germaini,(Arganodus_atlantis,Ferganoceratodus_jurassicus)))))))),(Ceratodus_latissimus,Metaceratodus_wollastoni)))))),(Nielsenia_nordica,Conchopoma_gadiforme)))))),(Rhinodipterus_secans,Rhinodipterus_ulrichi))))),(Palaeodaphus_insignis,Sunwapta_grandiceps)),(Melanognathus_canadensis,Sorbitorhynchus_deleaskitus))))))))),(Westollrhynchus_lehmanni,(Ichnomylax_kurnai,(Dipnorhynchus_sussmilchi,(Chirodipterus_onawwayensis,(Dipnorhynch_cathlesae,Dipnorhynchus_kurikae)))))))); 2 | -------------------------------------------------------------------------------- /R/find_descendant_edges.R: -------------------------------------------------------------------------------- 1 | #' Gets descendant edges of an internal node 2 | #' 3 | #' @description 4 | #' 5 | #' Returns all descendant edges of an internal node for a phylo object. 6 | #' 7 | #' @param n An integer corresponding to the internal node for which the descendant edges are sought. 8 | #' @param tree A tree as a phylo object. 9 | #' 10 | #' @details 11 | #' 12 | #' Returns a vector of integers corresponding to row numbers in \code{$edge} or cells in \code{$edge.length} of the descendant edges of the internal node supplied. 13 | #' 14 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 15 | #' 16 | #' @examples 17 | #' 18 | #' # Create simple four-taxon tree: 19 | #' tree <- ape::read.tree(text = "(A,(B,(C,D)));") 20 | #' 21 | #' # Plot tree: 22 | #' plot(tree) 23 | #' 24 | #' # Show nodelabels: 25 | #' nodelabels() 26 | #' 27 | #' # Show edgelabels (note that edges 5 and 6 28 | #' # are descendants of node 7): 29 | #' edgelabels() 30 | #' 31 | #' # Use find_descendant_edges to show that edges 32 | #' # 5 and 6 are descendants of node 7: 33 | #' find_descendant_edges(n = 7, tree = tree) 34 | #' @export find_descendant_edges 35 | find_descendant_edges <- function(n, tree) { 36 | 37 | # Find number of tips: 38 | n_tips <- ape::Ntip(phy = tree) 39 | 40 | # Find number of terminals (i.e. stopping point): 41 | n_terminals <- length(x = strap::FindDescendants(n = n, tree = tree)) 42 | 43 | # Create vector to store internal nodes: 44 | nodes <- n 45 | 46 | # Create vector to store edge numbers (i.e. row numbers for tree$edge): 47 | edges <- grep(n, tree$edge[, 1]) 48 | 49 | # Keep going until all descendant edges are found: 50 | while (length(x = which(x = tree$edge[edges, 2] <= n_tips)) < n_terminals) { 51 | 52 | # Get internal nodes found so far: 53 | nodes <- tree$edge[edges, 2][which(x = tree$edge[edges, 2] > n_tips)] 54 | 55 | # For each node add any new descendant edges: 56 | for (i in nodes) edges <- sort(x = unique(x = c(edges, which(x = tree$edge[, 1] == i)))) 57 | } 58 | 59 | # Return edges vector: 60 | edges 61 | } 62 | -------------------------------------------------------------------------------- /man/write_tnt_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_tnt_matrix.R 3 | \name{write_tnt_matrix} 4 | \alias{write_tnt_matrix} 5 | \title{Writes out a morphological TNT data file} 6 | \usage{ 7 | write_tnt_matrix(cladistic_matrix, file_name, add_analysis_block = FALSE) 8 | } 9 | \arguments{ 10 | \item{cladistic_matrix}{A cladistic matrix in the format imported by \link{read_nexus_matrix}.} 11 | 12 | \item{file_name}{The file name to write to. Should end in \code{.tnt}.} 13 | 14 | \item{add_analysis_block}{Whether or not to add analysis block (i.e., tree search commands).} 15 | } 16 | \description{ 17 | Writes out a morphological data file in Hennig86/TNT format. 18 | } 19 | \details{ 20 | Writes out a TNT (Goloboff et al. 2008; Goloboff and Catalano 2016) data file representing the distribution of discrete morphological characters in a set of taxa. Data must be in the format created by importing data with \link{read_nexus_matrix}. 21 | 22 | Note that the format can currently deal with continuous characters, sequence (DNA) data, and combinations of these and discrete morphology, but not yet the morphometric format introduced in Goloboff and Catalano (2016). 23 | } 24 | \examples{ 25 | 26 | # Write out Michaux 1989 to current working directory: 27 | write_tnt_matrix(cladistic_matrix = michaux_1989, file_name = "michaux_1989.tnt") 28 | 29 | # Remove file when finished: 30 | file.remove(file1 = "michaux_1989.tnt") 31 | } 32 | \references{ 33 | Goloboff, P. A. and Catalano, S. A., 2016. TNT version 1.5, including a full implementation of phylogenetic morphometrics. \emph{Cladistics}, \bold{32}, 221-238. 34 | 35 | Goloboff, P., Farris, J. and Nixon, K., 2008. TNT, a free program for phylogenetic analysis. \emph{Cladistics}, \bold{24}, 774-786. 36 | } 37 | \seealso{ 38 | \link{write_nexus_matrix} 39 | 40 | \link{build_cladistic_matrix}, \link{compactify_cladistic_matrix}, \link{prune_cladistic_matrix}, \link{read_nexus_matrix}, \link{safe_taxonomic_reduction}, \link{write_nexus_matrix} 41 | } 42 | \author{ 43 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 44 | } 45 | -------------------------------------------------------------------------------- /man/is.timeBins.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is.timeBins.R 3 | \name{is.timeBins} 4 | \alias{is.timeBins} 5 | \title{Time bins class} 6 | \usage{ 7 | is.timeBins(x) 8 | } 9 | \arguments{ 10 | \item{x}{A timeBins object.} 11 | } 12 | \value{ 13 | \code{is.timeBins} returns either TRUE or FALSE. 14 | } 15 | \description{ 16 | Functions to deal with the time bins class. 17 | } 18 | \details{ 19 | Claddis uses various classes to define specific types of data, here the use of time bins (to bin any temporal data) ae assigned the class "timeBins" and should look something like this: 20 | 21 | \preformatted{ fad lad 22 | Cenomanian 99.6 93.5 23 | Turonian 93.5 89.3 24 | Coniacian 89.3 85.8 25 | Santonian 85.8 83.5 26 | Campanian 83.5 70.6 27 | Maastrichtian 70.6 65.5} 28 | 29 | I.e., a matrix with two columns (fad = first appearance date and lad = last appearance date) with rows corresponding to named time bins and individual values ages in millions of years ago (Ma). The object should also have class \code{timeBins} (see example below for how to generate a valid object). Note also that the convention in Claddis is to have time bins be ordered from oldest to youngest. 30 | 31 | \code{is.timeBins} checks whether an object is or is not a valid timeBins object. 32 | } 33 | \examples{ 34 | 35 | # Create a time bins object: 36 | time_bins <- matrix( 37 | data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 38 | ncol = 2, 39 | byrow = TRUE, 40 | dimnames = list( 41 | c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 42 | c("fad", "lad") 43 | ) 44 | ) 45 | 46 | # Check that this is a valid timeBins object (will fail as class is not set): 47 | is.timeBins(x = time_bins) 48 | 49 | # Set class as timeBins: 50 | class(time_bins) <- "timeBins" 51 | 52 | # Check that this is a valid timeBins object (will succeed as format and 53 | # class are correct): 54 | is.timeBins(x = time_bins) 55 | 56 | } 57 | \author{ 58 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 59 | } 60 | -------------------------------------------------------------------------------- /man/find_unique_trees.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_unique_trees.r 3 | \name{find_unique_trees} 4 | \alias{find_unique_trees} 5 | \title{Finds only the unique topologies amongst a set} 6 | \usage{ 7 | find_unique_trees(trees) 8 | } 9 | \arguments{ 10 | \item{trees}{An object of class \code{multiPhylo}.} 11 | } 12 | \value{ 13 | An object of class \code{"multiPhylo"}. 14 | } 15 | \description{ 16 | Given a set of trees with the same tip labels, returns just the unique topologies present. 17 | } 18 | \details{ 19 | Where labelled topologies are generated randomly or modified by (e.g.) removing a tip, it may be useful to isolate just those that are truly unique. The \code{ape} package already has a function for this (\link[ape]{unique.multiPhylo}), but it can be slow when the number of trees is large. This function is thus intended as a faster version. 20 | 21 | The function works by breaking down a tree into its' component bipartitions and treating the combination of these as the definition of the tree. It thus escapes problems due to the principle of free rotation. Specifically, these two trees are actually identical: 22 | 23 | \preformatted{A B C D E 24 | \/ \ \/ 25 | \ \ / 26 | \ \/ 27 | \ / 28 | \ / 29 | \/ 30 | 31 | B A D E C 32 | \/ \/ / 33 | \ \ / 34 | \ \/ 35 | \ / 36 | \ / 37 | \/} 38 | 39 | This becomes clearer if we decompose them into their bipartitions: 40 | 41 | AB, DE, CDE, ABCDE 42 | 43 | These correspond to the descendants of each internal node (branching point) and the last one is actually ignored (the root node) as it will be present in any tree. 44 | } 45 | \examples{ 46 | 47 | # Make a set of three identical trees (differing only in "rotation" of nodes): 48 | trees <- ape::read.tree(text = c( 49 | "((A,B),(C,(D,E)));", 50 | "((C,(D,E)),(A,B));", 51 | "((B,A),(C,(E,D)));") 52 | ) 53 | 54 | # Show that there is only one unique tree: 55 | find_unique_trees(trees = trees) 56 | 57 | } 58 | \seealso{ 59 | \link[ape]{unique.multiPhylo} 60 | } 61 | \author{ 62 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 63 | } 64 | -------------------------------------------------------------------------------- /man/calculate_kardashian_index.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_kardashian_index.R 3 | \name{calculate_kardashian_index} 4 | \alias{calculate_kardashian_index} 5 | \title{Calculates a researcher's Kardashian Index} 6 | \usage{ 7 | calculate_kardashian_index(twitter_followers, total_citations) 8 | } 9 | \arguments{ 10 | \item{twitter_followers}{The number of twitter followers the researcher has.} 11 | 12 | \item{total_citations}{The total number of citations across the researcher's publications (e.g., as garnered from a Google Scholar profile).} 13 | } 14 | \value{ 15 | A scalar representing the ratio of expected Twitter followers (based on number of citations) to actual Twitter followers. Values greater than one indicate more Twitter followers than expected, those below one, fewer. According to Hall (2014), values above 5 are "Science Kardashians". 16 | } 17 | \description{ 18 | Given counts of a researcher's Twitter followers and citations, returns their Kardashian Index. 19 | } 20 | \details{ 21 | This function implements the Kardashian Index of Hall (2014) and interested readers should consult that paper for more background. 22 | } 23 | \examples{ 24 | 25 | # Calculate the Kardashian Index of Sam Giles (@GilesPalaeoLab) 26 | # as of 10/5/21: 27 | calculate_kardashian_index( 28 | twitter_followers = 6534, 29 | total_citations = 550 30 | ) 31 | 32 | # Calculate the Kardashian Index of Christopher Jackson (@seis_matters) 33 | # as of 10/5/21: 34 | calculate_kardashian_index( 35 | twitter_followers = 26000, 36 | total_citations = 6265 37 | ) 38 | 39 | # Calculate the Kardashian Index of Graeme T. Lloyd (@GraemeTLloyd) 40 | # as of 10/5/21: 41 | calculate_kardashian_index( 42 | twitter_followers = 2133, 43 | total_citations = 2780 44 | ) 45 | 46 | # Calculate the Kardashian Index of Katie Mack (@AstroKatie) 47 | # as of 10/5/21: 48 | calculate_kardashian_index( 49 | twitter_followers = 394900, 50 | total_citations = 1131 51 | ) 52 | 53 | } 54 | \references{ 55 | Hall, N., 2014. The Kardashian index: a measure of discrepant social media profile for scientists. \emph{Genome Biology}, \bold{15}, 424. 56 | } 57 | \author{ 58 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 59 | } 60 | -------------------------------------------------------------------------------- /man/permute_all_uncertainties.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_all_uncertainties.r 3 | \name{permute_all_uncertainties} 4 | \alias{permute_all_uncertainties} 5 | \title{Permute all possible uncertainties for a given set of states} 6 | \usage{ 7 | permute_all_uncertainties(single_states) 8 | } 9 | \arguments{ 10 | \item{single_states}{A vector of single states (e.g., 0, 1, 2 etc.).} 11 | } 12 | \value{ 13 | A vector of all possible uncertainty states. 14 | } 15 | \description{ 16 | Given a set of discrete states, will permute all possible uncertainity combinations of those states. 17 | } 18 | \details{ 19 | This function solves a simple phylogenetic combinatorics problem - what are all the possible outcomes for a character to be in given uncertainties are allowed? 20 | 21 | For example, for three states (0, 1, 2) there are four possible uncertainties: 0/1, 0/2, 1/2 and 0/1/2. 22 | 23 | If the user is instead only interested in the size of this state space, this is simply given by 2^N - N - 1, where N is the number of single states. Thus, the first several outcomes are: 24 | 25 | \preformatted{---------------------------------- 26 | | N states | N possible outcomes | 27 | ---------------------------------- 28 | | 2 | 1 | 29 | | 3 | 4 | 30 | | 4 | 11 | 31 | | 5 | 26 | 32 | | 6 | 57 | 33 | | 7 | 120 | 34 | | 8 | 247 | 35 | | 9 | 502 | 36 | | 10 | 1,013 | 37 | | 11 | 2,036 | 38 | | 12 | 4,083 | 39 | | 13 | 8,178 | 40 | | 14 | 16,369 | 41 | ----------------------------------} 42 | 43 | Note that this function is really designed for internal use, but may have value to some users and so is available "visibly" here. 44 | } 45 | \examples{ 46 | 47 | # Get all possible states for the character 0, 1, and 2: 48 | permute_all_uncertainties(single_states = 0:2) 49 | 50 | } 51 | \seealso{ 52 | \link{make_costmatrix} and \link{permute_all_polymorphisms} 53 | } 54 | \author{ 55 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 56 | } 57 | -------------------------------------------------------------------------------- /man/drop_time_tip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/drop_time_tip.R 3 | \name{drop_time_tip} 4 | \alias{drop_time_tip} 5 | \title{Drop tips from a time-scaled tree} 6 | \usage{ 7 | drop_time_tip(time_tree, tip_names, ...) 8 | } 9 | \arguments{ 10 | \item{time_tree}{A time-scaled tree in phylo format where branch lengths are durations and where a \code{$root.time} value indicates the root age.} 11 | 12 | \item{tip_names}{A vector of tip names to be pruned from the tree.} 13 | 14 | \item{...}{Additional options to be passed to \code{ape::drop.tip}.} 15 | } 16 | \value{ 17 | Returns a tree (phylo object) with pruned tips and corrected \code{$root.time}. 18 | } 19 | \description{ 20 | Drop tips from a time-scaled tree and update root.time accordingly 21 | } 22 | \details{ 23 | (NB: This function is designed to only cope with trees containing at least three tips.) 24 | 25 | Usually ape formatted trees are pruned with the \link[ape]{drop.tip} function in \link[ape]{ape}. However, trees time-scaled using either the \code{paleotree} or \code{strap} packages have an additional important component, the root age (\code{$root.time}) that may need updating when tips are removed. (See \link{fix_root_time}.) Thus this function is a modified version of \link[ape]{drop.tip} that also performs the \link{fix_root_time} step. 26 | 27 | Note that \code{dropPaleoTip} in the \code{paleotree} package performs the exact same function, but is not called here to reduce the number of dependencies for \code{Claddis}. 28 | } 29 | \examples{ 30 | 31 | # Create a simple four-taxon tree with branch lengths: 32 | tree <- ape::read.tree(text = "(A:1,(B:1,(C:1,D:1):1):1);") 33 | 34 | # Set root age as 20 Ma: 35 | tree$root.time <- 20 36 | 37 | # Now prune taxon A: 38 | pruned_tree <- ape::drop.tip(phy = tree, tip = "A") 39 | 40 | # Show that drop.tip has not updated the tree's root time: 41 | pruned_tree$root.time 42 | 43 | # Use the function to fix the root time: 44 | pruned_tree <- drop_time_tip(time_tree = tree, tip_names = "A") 45 | 46 | # Show that the root time is now fixed (19 Ma): 47 | pruned_tree$root.time 48 | 49 | } 50 | \seealso{ 51 | \link{fix_root_time} 52 | } 53 | \author{ 54 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 55 | } 56 | -------------------------------------------------------------------------------- /man/permute_all_polymorphisms.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_all_polymorphisms.r 3 | \name{permute_all_polymorphisms} 4 | \alias{permute_all_polymorphisms} 5 | \title{Permute all possible polymorphisms for a given set of states} 6 | \usage{ 7 | permute_all_polymorphisms(single_states) 8 | } 9 | \arguments{ 10 | \item{single_states}{A vector of single states (e.g., 0, 1, 2 etc.).} 11 | } 12 | \value{ 13 | A vector of all possible polymorphic states. 14 | } 15 | \description{ 16 | Given a set of discrete states, will permute all possible polymorphic combinations of those states. 17 | } 18 | \details{ 19 | This function solves a simple phylogenetic combinatorics problem - what are all the possible outcomes for a character to be in given polymorphisms (of any size) are allowed? 20 | 21 | For example, for three states (0, 1, 2) there are four possible polymorphisms: 0&1, 0&2, 1&2 and 0&1&2. 22 | 23 | If the user is instead only interested in the size of this state space, this is simply given by 2^N - N - 1, where N is the number of single states. Thus, the first several outcomes are: 24 | 25 | \preformatted{---------------------------------- 26 | | N states | N possible outcomes | 27 | ---------------------------------- 28 | | 2 | 1 | 29 | | 3 | 4 | 30 | | 4 | 11 | 31 | | 5 | 26 | 32 | | 6 | 57 | 33 | | 7 | 120 | 34 | | 8 | 247 | 35 | | 9 | 502 | 36 | | 10 | 1,013 | 37 | | 11 | 2,036 | 38 | | 12 | 4,083 | 39 | | 13 | 8,178 | 40 | | 14 | 16,369 | 41 | ----------------------------------} 42 | 43 | Note that this function is really designed for internal use, but may have value to some users and so is available "visibly" here. 44 | } 45 | \examples{ 46 | 47 | # Get all possible states for the character 0, 1, and 2: 48 | permute_all_polymorphisms(single_states = 0:2) 49 | 50 | } 51 | \seealso{ 52 | \link{make_costmatrix} and \link{permute_all_uncertainties} 53 | } 54 | \author{ 55 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 56 | } 57 | -------------------------------------------------------------------------------- /man/find_time_bin_midpoints.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/find_time_bin_midpoints.R 3 | \name{find_time_bin_midpoints} 4 | \alias{find_time_bin_midpoints} 5 | \title{Find time bin midpoints} 6 | \usage{ 7 | find_time_bin_midpoints(time_bins) 8 | } 9 | \arguments{ 10 | \item{time_bins}{A timeBins object.} 11 | } 12 | \value{ 13 | A vector of time bin midpoint values. 14 | } 15 | \description{ 16 | Find the midpoint values for each bin from a timeBins object 17 | } 18 | \details{ 19 | Frequently the midpoints of a series of time bins (defined by a beginning and ending) will be required, for example, when plotting binned data as a time series. Although the calculation involved is trivial (i.e., start date + end date / 2) this is a sufficiently common operation it is made into a formal function here. 20 | 21 | Note that this function is designed to work specifically with objects of class "timeBins" - a format specific to Claddis that looks something like this: 22 | 23 | \preformatted{ fad lad 24 | Cenomanian 99.6 93.5 25 | Turonian 93.5 89.3 26 | Coniacian 89.3 85.8 27 | Santonian 85.8 83.5 28 | Campanian 83.5 70.6 29 | Maastrichtian 70.6 65.5} 30 | 31 | I.e., a matrix with two columns (fad = first appearance date and lad = last appearance date) with rows corresponding to named time bins and indiviual values ages in millions of years ago (Ma). The object should also have class \code{timeBins} (see example below for hot to generate such an object). Note also that the convention here is to have time bins be ordered from oldest to youngest. 32 | } 33 | \examples{ 34 | 35 | # Create a time bins object: 36 | time_bins <- matrix( 37 | data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 38 | ncol = 2, 39 | byrow = TRUE, 40 | dimnames = list( 41 | c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 42 | c("fad", "lad") 43 | ) 44 | ) 45 | 46 | # Set class as timeBins: 47 | class(time_bins) <- "timeBins" 48 | 49 | # Return midpoints for each time bin in sequence: 50 | find_time_bin_midpoints(time_bins = time_bins) 51 | 52 | } 53 | \author{ 54 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 55 | } 56 | -------------------------------------------------------------------------------- /man/prune_cladistic_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/prune_cladistic_matrix.R 3 | \name{prune_cladistic_matrix} 4 | \alias{prune_cladistic_matrix} 5 | \title{Prunes a character matrix of characters or taxa} 6 | \usage{ 7 | prune_cladistic_matrix( 8 | cladistic_matrix, 9 | blocks2prune = c(), 10 | characters2prune = c(), 11 | taxa2prune = c(), 12 | remove_invariant = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{cladistic_matrix}{The cladistic matrix in the format imported by \link{read_nexus_matrix}.} 17 | 18 | \item{blocks2prune}{A vector of number(s) of any blocks to prune.} 19 | 20 | \item{characters2prune}{A vector of character numbers to prune.} 21 | 22 | \item{taxa2prune}{A vector of taxon names to prune (these must be present in \code{rownames(x = cladistic_matrix$matrix}).} 23 | 24 | \item{remove_invariant}{A logical for whether invariant characters should (TRUE) or should not (FALSE, default) be pruned.} 25 | } 26 | \description{ 27 | Prunes a character matrix of characters, taxa, or both. 28 | } 29 | \details{ 30 | Removing characters or taxa from a matrix imported using \link{read_nexus_matrix} is not simple due to associated vectors for ordering, character weights etc. To save repetitively pruning each part this function takes the matrix as input and vector(s) of either block numbers, character numbers, taxon names, or any combination thereof and returns a matrix with these items removed. Minimum and maximum values (used by \link{calculate_morphological_distances}) are also updated and the user has the option to remove constant characters this way as well (e.g, to reduce the memory required for a DNA matrix). 31 | } 32 | \examples{ 33 | 34 | # Remove the outgroup taxon and characters 11 and 53 from gauthier_1986: 35 | prunedmatrix <- prune_cladistic_matrix( 36 | cladistic_matrix = 37 | gauthier_1986, characters2prune = c(11, 53), taxa2prune = 38 | c("Outgroup") 39 | ) 40 | 41 | # Show priuned matrix: 42 | prunedmatrix$matrix_1$matrix 43 | } 44 | \seealso{ 45 | \link{build_cladistic_matrix}, \link{compactify_cladistic_matrix}, \link{read_nexus_matrix}, \link{safe_taxonomic_reduction}, \link{write_nexus_matrix}, \link{write_tnt_matrix} 46 | } 47 | \author{ 48 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 49 | } 50 | -------------------------------------------------------------------------------- /man/bin_edge_lengths.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bin_edge_lengths.R 3 | \name{bin_edge_lengths} 4 | \alias{bin_edge_lengths} 5 | \title{Edge-lengths present in time-bins} 6 | \usage{ 7 | bin_edge_lengths(time_tree, time_bins, pruned_tree = NULL) 8 | } 9 | \arguments{ 10 | \item{time_tree}{A time-scaled tree in phylo format with a \code{$root.time} value.} 11 | 12 | \item{time_bins}{An object of class \code{timeBins}.} 13 | 14 | \item{pruned_tree}{A time-scaled tree in phylo format with a \code{$root.time} value that is a subset of \code{time_tree}.} 15 | } 16 | \value{ 17 | \item{binned_edge_lengths}{A vector giving the summed values in millions of years for each time bin. Names indicate the maximum and minimum values for each time bin.} 18 | \item{binned_terminal_edge_lengths}{As above, but counting terminal edges only.} 19 | \item{binned_internal_edge_lengths}{As above, but counting internal edges only.} 20 | } 21 | \description{ 22 | Given a time-scaled tree and set of time bin boundaries will sum the edge-lengths present in each bin. 23 | } 24 | \details{ 25 | Calculates the total edge duration of a time-scaled tree present in a series of time bins. This is intended as an internal function for rate calculations, but may be of use to someone. 26 | 27 | The option of using a \code{pruned_tree} allows the user to correctly classify internal and terminal branches in a subtree of the larger tree. So for example, if taxa A and B are sisters then after pruning B the subtree branch leading to A is composed of an internal and a terminal branch on the complete tree. 28 | } 29 | \examples{ 30 | 31 | # Create a random 10-taxon tree: 32 | time_tree <- ape::rtree(n = 10) 33 | 34 | # Add root age: 35 | time_tree$root.time <- max(diag(ape::vcv(time_tree))) 36 | 37 | # Create time bins: 38 | time_bins <- matrix(data = c(seq(from = time_tree$root.time, to = 0, 39 | length.out = 11)[1:10], seq(from = time_tree$root.time, to = 0, 40 | length.out = 11)[2:11]), ncol = 2, dimnames = list(LETTERS[1:10], 41 | c("fad", "lad"))) 42 | 43 | # Set class: 44 | class(time_bins) <- "timeBins" 45 | 46 | # Get edge lengths for each bin: 47 | bin_edge_lengths(time_tree = time_tree, time_bins = time_bins) 48 | } 49 | \author{ 50 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 51 | } 52 | -------------------------------------------------------------------------------- /man/safe_taxonomic_reduction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/safe_taxonomic_reduction.R 3 | \name{safe_taxonomic_reduction} 4 | \alias{safe_taxonomic_reduction} 5 | \title{Safe Taxonomic Reduction} 6 | \usage{ 7 | safe_taxonomic_reduction(cladistic_matrix) 8 | } 9 | \arguments{ 10 | \item{cladistic_matrix}{A character-taxon matrix in the format imported by \link{read_nexus_matrix}.} 11 | } 12 | \value{ 13 | \item{str_taxa}{A matrix listing the taxa that can be removed (\code{junior}), the taxa which they are equivalent to (\code{senior}) and the rule under which they can be safely removed (\code{rule}).} 14 | \item{reduced_matrix}{A character-taxon matrix excluding the taxa that can be safely removed.} 15 | \item{removed_matrix}{A character-taxon matrix of the taxa that can be safely removed.} 16 | } 17 | \description{ 18 | Performs Safe Taxonomic Reduction (STR) on a character-taxon matrix. 19 | } 20 | \details{ 21 | Performs Safe Taxonomic Reduction (Wilkinson 1995). 22 | 23 | If no taxa can be safely removed will print the text "No taxa can be safely removed", and the \code{str_taxa} and \code{removed_matrix} will have no rows. 24 | 25 | NB: If your data contains inapplicable characters these will be treated as missing data, but this is inappropriate. Thus the user is advised to double check that any removed taxa make sense in the light of inapplicable states. (As far as I am aware this same behaviour occurs in the TAXEQ3 software.) 26 | } 27 | \examples{ 28 | 29 | # Performs STR on the Gauthier 1986 dataset used in Wilkinson (1995): 30 | str_data <- safe_taxonomic_reduction(cladistic_matrix = gauthier_1986) 31 | 32 | # View deleted taxa: 33 | str_data$str_taxa 34 | 35 | # View reduced matrix: 36 | str_data$reduced_matrix 37 | 38 | # View removed matrix: 39 | str_data$removed_matrix 40 | } 41 | \references{ 42 | Wilkinson, M., 1995. Coping with abundant missing entries in phylogenetic inference using parsimony. \emph{Systematic Biology}, \bold{44}, 501-514. 43 | } 44 | \seealso{ 45 | \link{build_cladistic_matrix}, \link{compactify_cladistic_matrix}, \link{prune_cladistic_matrix}, \link{safe_taxonomic_reinsertion}, \link{read_nexus_matrix}, \link{write_nexus_matrix}, \link{write_tnt_matrix} 46 | } 47 | \author{ 48 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 49 | } 50 | -------------------------------------------------------------------------------- /R/trim_marginal_whitespace.r: -------------------------------------------------------------------------------- 1 | #' Trims marginal whitespace 2 | #' 3 | #' @description 4 | #' 5 | #' Trims any marginal whitespace from a vector of character string(s). 6 | #' 7 | #' @param x A character string 8 | #' 9 | #' @details 10 | #' 11 | #' Trims any marginal whitespace (spaces or tabs) from a vector of character string(s). 12 | #' 13 | #' @return 14 | #' 15 | #' A vector of character string(s) with any leading or trailing whitespace removed. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Example string: 22 | #' x <- " \td s f\t s " 23 | #' 24 | #' # Trim only marginal whitespace: 25 | #' trim_marginal_whitespace(x) 26 | #' 27 | #' @export trim_marginal_whitespace 28 | trim_marginal_whitespace <- function(x) { 29 | 30 | # Make function to work on a scalar (single string): 31 | trim_scalar <- function(x) { 32 | 33 | # As long as the string has positive length: 34 | if (nchar(x = x) > 0) { 35 | 36 | # Split string into individual characters/whitespace: 37 | split_string <- strsplit(x = x, split = "")[[1]] 38 | 39 | # Find positions of any whitespace: 40 | position_is_whitespace <- apply(X = rbind(split_string == " ", split_string == "\t"), MARGIN = 2, FUN = any) 41 | 42 | # If everything is whitespace: 43 | if (all(position_is_whitespace)) { 44 | 45 | # Return empty string: 46 | return("") 47 | 48 | # If at least one character is not whitespace: 49 | } else { 50 | 51 | # Find first non-whitesapce position: 52 | first_non_whitespace_position <- min(which(position_is_whitespace == FALSE)) 53 | 54 | # Find last non-whitesapce position: 55 | last_non_whitespace_position <- max(which(position_is_whitespace == FALSE)) 56 | 57 | # Return trimmed string: 58 | return(value = paste(split_string[first_non_whitespace_position:last_non_whitespace_position], collapse = "")) 59 | } 60 | 61 | # If string has no length: 62 | } else { 63 | 64 | # Return string as is: 65 | return(value = x) 66 | } 67 | } 68 | 69 | # Return output with marginal whitesapce pruned: 70 | unlist(x = lapply(X = as.list(x = x), FUN = trim_scalar)) 71 | } 72 | 73 | -------------------------------------------------------------------------------- /man/trim_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/trim_matrix.R 3 | \name{trim_matrix} 4 | \alias{trim_matrix} 5 | \title{Trims a morphological distance matrix} 6 | \usage{ 7 | trim_matrix(distance_matrix, tree = NULL) 8 | } 9 | \arguments{ 10 | \item{distance_matrix}{A distance matrix in the format created by \link{calculate_morphological_distances}.} 11 | 12 | \item{tree}{If the distance matrix includes ancestors this should be the tree (phylo object) used to estimate their states.} 13 | } 14 | \value{ 15 | \item{distance_matrix}{A complete distance matrix with all cells filled. If there were no empty cells will return original.} 16 | \item{tree}{A tree (if supplied) with the removed taxa (see below) pruned. If no taxa are dropped will return the same tree as inputted. If no tree is supplied this is set to NULL.} 17 | \item{removed_taxa}{A character vector listing the taxa removed. If none are removed this will be set to NULL.} 18 | } 19 | \description{ 20 | Trims a morphological distance matrix by removing objects that cause empty cells. 21 | } 22 | \details{ 23 | Trims a morphological distance matrix by removing nodes (terminal or internal) that cause empty cells allowing it to be passed to an ordination function such as \link{cmdscale}. 24 | 25 | Some distances are not calculable from cladistic matrices if there are taxa that have no coded characters in common. This algorithm iteratively removes the taxa responsible for the most empty cells until the matrix is complete (no empty cells). 26 | 27 | If the matrix includes estimated ancestral states the user should also provide the tree used (as the \code{tree} argument). The function will then also remove the tips from the tree and where reconstructed ancestors also cause empty cells will prune the minimum number of descendants of that node. The function will then renumber the nodes in the distance matrix so they match the pruned tree. 28 | } 29 | \examples{ 30 | 31 | # Get morphological distances for Michaux (1989) data set: 32 | distances <- calculate_morphological_distances(cladistic_matrix = michaux_1989) 33 | 34 | # Attempt to trim max.distance_matrix: 35 | trim_matrix(distance_matrix = distances$distance_matrix) 36 | } 37 | \seealso{ 38 | \link{calculate_morphological_distances} 39 | } 40 | \author{ 41 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 42 | } 43 | -------------------------------------------------------------------------------- /R/is.timeBins.R: -------------------------------------------------------------------------------- 1 | #' Time bins class 2 | #' 3 | #' @description 4 | #' 5 | #' Functions to deal with the time bins class. 6 | #' 7 | #' @param x A timeBins object. 8 | #' 9 | #' @details 10 | #' 11 | #' Claddis uses various classes to define specific types of data, here the use of time bins (to bin any temporal data) ae assigned the class "timeBins" and should look something like this: 12 | #' 13 | #' \preformatted{ fad lad 14 | #' Cenomanian 99.6 93.5 15 | #' Turonian 93.5 89.3 16 | #' Coniacian 89.3 85.8 17 | #' Santonian 85.8 83.5 18 | #' Campanian 83.5 70.6 19 | #' Maastrichtian 70.6 65.5} 20 | #' 21 | #' I.e., a matrix with two columns (fad = first appearance date and lad = last appearance date) with rows corresponding to named time bins and individual values ages in millions of years ago (Ma). The object should also have class \code{timeBins} (see example below for how to generate a valid object). Note also that the convention in Claddis is to have time bins be ordered from oldest to youngest. 22 | #' 23 | #' \code{is.timeBins} checks whether an object is or is not a valid timeBins object. 24 | #' 25 | #' @return \code{is.timeBins} returns either TRUE or FALSE. 26 | #' 27 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 28 | #' 29 | #' @examples 30 | #' 31 | #' # Create a time bins object: 32 | #' time_bins <- matrix( 33 | #' data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 34 | #' ncol = 2, 35 | #' byrow = TRUE, 36 | #' dimnames = list( 37 | #' c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 38 | #' c("fad", "lad") 39 | #' ) 40 | #' ) 41 | #' 42 | #' # Check that this is a valid timeBins object (will fail as class is not set): 43 | #' is.timeBins(x = time_bins) 44 | #' 45 | #' # Set class as timeBins: 46 | #' class(time_bins) <- "timeBins" 47 | #' 48 | #' # Check that this is a valid timeBins object (will succeed as format and 49 | #' # class are correct): 50 | #' is.timeBins(x = time_bins) 51 | #' 52 | #' @export is.timeBins 53 | is.timeBins <- function(x) { 54 | 55 | # Get any error messages for time_bins: 56 | messages <- check_timeBins(time_bins = x) 57 | 58 | # Return logical indicating whether object is a valid timeBins object or not: 59 | ifelse(test = length(x = messages) > 0, yes = FALSE, no = TRUE) 60 | } 61 | -------------------------------------------------------------------------------- /man/print.stateGraph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.stateGraph.r 3 | \name{print.stateGraph} 4 | \alias{print.stateGraph} 5 | \title{Compact display of a stategraph} 6 | \usage{ 7 | \method{print}{stateGraph}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{"stateGraph"}.} 11 | 12 | \item{...}{Further arguments passed to or from other methods.} 13 | } 14 | \value{ 15 | Nothing is directly returned, instead a text summary describing a \code{"stateGraph"} object is printed to the console. 16 | } 17 | \description{ 18 | Displays a compact summary of a stateGraph object. 19 | } 20 | \details{ 21 | Displays some basic summary information on a stateGraph object. 22 | } 23 | \examples{ 24 | 25 | # Make an example stategraph: 26 | example_stategraph <- list( 27 | n_vertices = 6, 28 | n_arcs = 12, 29 | n_states = 6, 30 | single_states = as.character(x = 0:5), 31 | type = "custom", 32 | arcs = data.frame( 33 | from = as.character(x = c(0, 1, 0, 2, 2, 5, 1, 4, 5, 4, 3, 4)), 34 | to = as.character(x = c(1, 0, 2, 0, 5, 2, 4, 1, 4, 5, 4, 3)), 35 | weight = c(1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1) 36 | ), 37 | vertices = data.frame( 38 | label = as.character(x = 0:5), 39 | in_degree = c(2, 2, 2, 1, 3, 2), 40 | out_degree = c(2, 2, 2, 1, 3, 2), 41 | eccentricity = c(3, 2, 3, 3, 2, 2), 42 | periphery = c(1, 0, 1, 1, 0, 0), 43 | centre = c(0, 1, 0, 0, 1, 1) 44 | ), 45 | radius = 2, 46 | diameter = 3, 47 | adjacency_matrix = matrix( 48 | data = c( 49 | 0, 1, 1, 0, 0, 0, 50 | 1, 0, 0, 0, 1, 0, 51 | 1, 0, 0, 0, 0, 1, 52 | 0, 0, 0, 0, 1, 0, 53 | 0, 1, 0, 1, 0, 1, 54 | 0, 0, 1, 0, 1, 0 55 | ), 56 | nrow = 6, 57 | byrow = TRUE, 58 | dimnames = list(0:5, 0:5) 59 | ), 60 | directed = FALSE, 61 | includes_polymorphisms = FALSE, 62 | polymorphism_costs = "additive", 63 | polymorphism_geometry = "simplex", 64 | polymorphism_distance = "euclidean", 65 | includes_uncertainties = FALSE, 66 | pruned = FALSE, 67 | dollo_penalty = 999, 68 | base_age = 100, 69 | weight = 1 70 | ) 71 | 72 | # Set class as stateGraph: 73 | class(x = example_stategraph) <- "stateGraph" 74 | 75 | # Show print.stateGraph version: 76 | print.stateGraph(x = example_stategraph) 77 | 78 | } 79 | \author{ 80 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 81 | } 82 | -------------------------------------------------------------------------------- /R/calculate_kardashian_index.R: -------------------------------------------------------------------------------- 1 | #' Calculates a researcher's Kardashian Index 2 | #' 3 | #' @description 4 | #' 5 | #' Given counts of a researcher's Twitter followers and citations, returns their Kardashian Index. 6 | #' 7 | #' @param twitter_followers The number of twitter followers the researcher has. 8 | #' @param total_citations The total number of citations across the researcher's publications (e.g., as garnered from a Google Scholar profile). 9 | #' 10 | #' @details 11 | #' 12 | #' This function implements the Kardashian Index of Hall (2014) and interested readers should consult that paper for more background. 13 | #' 14 | #' @return 15 | #' 16 | #' A scalar representing the ratio of expected Twitter followers (based on number of citations) to actual Twitter followers. Values greater than one indicate more Twitter followers than expected, those below one, fewer. According to Hall (2014), values above 5 are "Science Kardashians". 17 | #' 18 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 19 | #' 20 | #' @references 21 | #' 22 | #' Hall, N., 2014. The Kardashian index: a measure of discrepant social media profile for scientists. \emph{Genome Biology}, \bold{15}, 424. 23 | #' 24 | #' @examples 25 | #' 26 | #' # Calculate the Kardashian Index of Sam Giles (@GilesPalaeoLab) 27 | #' # as of 10/5/21: 28 | #' calculate_kardashian_index( 29 | #' twitter_followers = 6534, 30 | #' total_citations = 550 31 | #' ) 32 | #' 33 | #' # Calculate the Kardashian Index of Christopher Jackson (@seis_matters) 34 | #' # as of 10/5/21: 35 | #' calculate_kardashian_index( 36 | #' twitter_followers = 26000, 37 | #' total_citations = 6265 38 | #' ) 39 | #' 40 | #' # Calculate the Kardashian Index of Graeme T. Lloyd (@GraemeTLloyd) 41 | #' # as of 10/5/21: 42 | #' calculate_kardashian_index( 43 | #' twitter_followers = 2133, 44 | #' total_citations = 2780 45 | #' ) 46 | #' 47 | #' # Calculate the Kardashian Index of Katie Mack (@AstroKatie) 48 | #' # as of 10/5/21: 49 | #' calculate_kardashian_index( 50 | #' twitter_followers = 394900, 51 | #' total_citations = 1131 52 | #' ) 53 | #' 54 | #' @export calculate_kardashian_index 55 | calculate_kardashian_index <- function(twitter_followers, total_citations) { 56 | 57 | # Set F_a as number of twitter followers: 58 | F_a <- twitter_followers 59 | 60 | # Calculate F_c using equation 1 of Hall (2014): 61 | F_c <- 43 * (total_citations ^ 0.32) 62 | 63 | # Retrurn Kardashian Index (equation 2 of Hall 2014): 64 | F_a / F_c 65 | } 66 | -------------------------------------------------------------------------------- /R/print.taxonGroups.r: -------------------------------------------------------------------------------- 1 | #' Compact display of taxon groups 2 | #' 3 | #' @description 4 | #' 5 | #' Displays a compact summary of a taxonGroups object. 6 | #' 7 | #' @param x An object of class \code{"taxonGroups"}. 8 | #' @param ... Further arguments passed to or from other methods. 9 | #' 10 | #' @details 11 | #' 12 | #' Displays some basic summary information on a taxon groups object, including number of groups and their names and partial contents. 13 | #' 14 | #' @return 15 | #' 16 | #' Nothing is directly returned, instead a text summary describing a \code{"taxonGroups"} object is printed to the console. 17 | #' 18 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 19 | #' 20 | #' @examples 21 | #' 22 | #' # Create a taxon groups object: 23 | #' taxon_groups <- list( 24 | #' Group_A = c("Species_1", "Species_2", "Species_3"), 25 | #' Group_B = c("Species_3", "Species_4"), 26 | #' Group_C = c("Species_5", "Species_6", "Species_7", "Species_8") 27 | #' ) 28 | #' 29 | #' # Set class as taxonGroups: 30 | #' class(taxon_groups) <- "taxonGroups" 31 | #' 32 | #' # Show print.taxonGroups version of each included data sets: 33 | #' print.taxonGroups(x = taxon_groups) 34 | #' @export print.taxonGroups 35 | print.taxonGroups <- function(x, ...) { 36 | 37 | # Check x has class taxonGroups and stop and warn user if not: 38 | if (!inherits(x = x, what = "taxonGroups")) stop("x must be an object of class \"taxonGroups\".") 39 | 40 | # If not a valid taxonGroups object then stop and provide feedback to user on what is wrong: 41 | if (!is.taxonGroups(x = x)) stop(check_taxonGroups(taxon_groups = x)[1]) 42 | 43 | # Sub function to formt taxon names output: 44 | format_taxon_names <- function(x) { 45 | if (length(x) == 0) return("") 46 | if (length(x) == 1) return(paste0(": ", x, collapse = "")) 47 | if (length(x) == 2) return(paste0(": ", x[1], ", ", x[2], collapse = "")) 48 | if (length(x) == 3) return(paste0(": ", x[1], ", ", x[2], ", ", x[3], collapse = "")) 49 | if (length(x) > 3) return(paste0(": ", x[1], ", ", x[2], ", ", x[3], ", ...", collapse = "")) 50 | } 51 | 52 | # Return summary information about object: 53 | cat(paste0("taxonGroups object composed of ", length(x = x), " groups:"), "\n", unlist(x = lapply(X = as.list(x = names(x = x)), function(y) paste0(" ", y, paste0(rep(x = " ", times = max(x = nchar(x = names(x = x))) - nchar(x = y) + 1), collapse = ""), "(", length(x = x[[y]]), " taxa", format_taxon_names(x = x[[y]]), ")\n")))) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /R/calculate_MPD.R: -------------------------------------------------------------------------------- 1 | #' Calculate mean pairwise distances 2 | #' 3 | #' @description 4 | #' 5 | #' Given distanceMatrices and taxonGroups objects calculates their mean pairwise distances. 6 | #' 7 | #' @param distances An object of class \code{distanceMatrices}. 8 | #' @param taxon_groups An object of class \code{taxonGroups}. 9 | #' 10 | #' @details 11 | #' 12 | #' Not all measures of disparity (morphological distance) require an ordination space. For example, the pariwise distances between taxa are themselves a disparity metric. This function takes the output from \link{calculate_morphological_distances} and a set of taxon groups and returns the mean pairwise distance for each of those groups. 13 | #' 14 | #' @return 15 | #' 16 | #' A labelled vector of weighted mean pairwise distances. 17 | #' 18 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 19 | #' 20 | #' @examples 21 | #' 22 | #' # Get morphological distances for the Day et al. (2016) data set: 23 | #' distances <- calculate_morphological_distances( 24 | #' cladistic_matrix = day_2016, 25 | #' distance_metric = "mord", 26 | #' distance_transformation = "none" 27 | #' ) 28 | #' 29 | #' # Build simple taxonomic groups for Day et al. (2016) data set: 30 | #' taxon_groups <- list(nonBurnetiamorpha = c("Biarmosuchus_tener", "Hipposaurus_boonstrai", 31 | #' "Bullacephalus_jacksoni", "Pachydectes_elsi", "Niuksenitia_sukhonensis", "Ictidorhinus_martinsi", 32 | #' "RC_20", "Herpetoskylax_hopsoni"), Burnetiamorpha = c("Lemurosaurus_pricei", "Lobalopex_mordax", 33 | #' "Lophorhinus_willodenensis", "Proburnetia_viatkensis", "Lende_chiweta", 34 | #' "Paraburnetia_sneeubergensis", "Burnetia_mirabilis", "BP_1_7098")) 35 | #' 36 | #' # Set class as taxonGroups: 37 | #' class(taxon_groups) <- "taxonGroups" 38 | #' 39 | #' # Calculate mean pairwise distances: 40 | #' calculate_MPD(distances, taxon_groups) 41 | #' 42 | #' @export calculate_MPD 43 | calculate_MPD <- function(distances, taxon_groups) { 44 | 45 | # If not a valid taxonGroups object then stop and provide feedback to user on what is wrong: 46 | if (!is.taxonGroups(x = taxon_groups)) stop(check_taxonGroups(taxon_groups = taxon_groups)[1]) 47 | 48 | # Calculate and return mean pairwise distance for each taxon group: 49 | unlist( 50 | x = lapply( 51 | X = taxon_groups, 52 | FUN = function(x) { 53 | mean( 54 | x = distances$distance_matrix[x, x][lower.tri(x = distances$distance_matrix[x, x])], 55 | na.rm = TRUE 56 | ) 57 | 58 | } 59 | ) 60 | ) 61 | } 62 | -------------------------------------------------------------------------------- /R/drop_time_tip.R: -------------------------------------------------------------------------------- 1 | #' Drop tips from a time-scaled tree 2 | #' 3 | #' @description 4 | #' 5 | #' Drop tips from a time-scaled tree and update root.time accordingly 6 | #' 7 | #' @param time_tree A time-scaled tree in phylo format where branch lengths are durations and where a \code{$root.time} value indicates the root age. 8 | #' @param tip_names A vector of tip names to be pruned from the tree. 9 | #' @param ... Additional options to be passed to \code{ape::drop.tip}. 10 | #' 11 | #' @details 12 | #' 13 | #' (NB: This function is designed to only cope with trees containing at least three tips.) 14 | #' 15 | #' Usually ape formatted trees are pruned with the \link[ape]{drop.tip} function in \link[ape]{ape}. However, trees time-scaled using either the \code{paleotree} or \code{strap} packages have an additional important component, the root age (\code{$root.time}) that may need updating when tips are removed. (See \link{fix_root_time}.) Thus this function is a modified version of \link[ape]{drop.tip} that also performs the \link{fix_root_time} step. 16 | #' 17 | #' Note that \code{dropPaleoTip} in the \code{paleotree} package performs the exact same function, but is not called here to reduce the number of dependencies for \code{Claddis}. 18 | #' 19 | #' @return Returns a tree (phylo object) with pruned tips and corrected \code{$root.time}. 20 | #' 21 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 22 | #' 23 | #' @seealso 24 | #' 25 | #' \link{fix_root_time} 26 | #' 27 | #' @examples 28 | #' 29 | #' # Create a simple four-taxon tree with branch lengths: 30 | #' tree <- ape::read.tree(text = "(A:1,(B:1,(C:1,D:1):1):1);") 31 | #' 32 | #' # Set root age as 20 Ma: 33 | #' tree$root.time <- 20 34 | #' 35 | #' # Now prune taxon A: 36 | #' pruned_tree <- ape::drop.tip(phy = tree, tip = "A") 37 | #' 38 | #' # Show that drop.tip has not updated the tree's root time: 39 | #' pruned_tree$root.time 40 | #' 41 | #' # Use the function to fix the root time: 42 | #' pruned_tree <- drop_time_tip(time_tree = tree, tip_names = "A") 43 | #' 44 | #' # Show that the root time is now fixed (19 Ma): 45 | #' pruned_tree$root.time 46 | #' 47 | #' @export drop_time_tip 48 | drop_time_tip <- function(time_tree, tip_names, ...) { 49 | 50 | # Add some top-level conditional checks in future (including checking that root.time is even there). 51 | 52 | # First generate pruned time tree: 53 | pruned_time_tree <- ape::drop.tip(phy = time_tree, tip = tip_names, ...) 54 | 55 | # Return tree with tips oruend and root rescaled: 56 | fix_root_time(original_tree = time_tree, pruned_tree = pruned_time_tree) 57 | } 58 | -------------------------------------------------------------------------------- /man/permute_restricted_compositions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_restricted_compositions.r 3 | \name{permute_restricted_compositions} 4 | \alias{permute_restricted_compositions} 5 | \title{Permute all ways to place n items into m bins} 6 | \usage{ 7 | permute_restricted_compositions(n, m_labels, allow_zero = FALSE) 8 | } 9 | \arguments{ 10 | \item{n}{A positive integer.} 11 | 12 | \item{m_labels}{A character vector of labels for m.} 13 | 14 | \item{allow_zero}{A logical indicating whether or not each bin should (\code{TRUE}) or should not (\code{FALSE}) be allowed to be zero.} 15 | } 16 | \value{ 17 | A matrix where each row is a unique restricted composition of n and each column is a labelled bin. 18 | } 19 | \description{ 20 | Given a positive integer, n, and a number of bins (m), permutes all possible compositions. 21 | } 22 | \details{ 23 | Every way that an integer (\code{n}) can be divided up into \code{m} bins can be permuted using a restricted version of the mathematical concept of compositions. In practice this function is designed to distribute the states for \code{n} tips across \code{m} states (e.g., with \link{permute_tipstates}), but many other uses are conceivable and hence this is included here as a general function. 24 | 25 | This algorithm reuses code from the \code{multicool} (Curran et al. 2021) and \code{partitions} (Hankin 2006) packages. 26 | 27 | The number of restricted compositions is given by the k-dimensional extension of triangular numbers (Baumann 2019): 28 | 29 | \itemize{ 30 | \item{If \code{allow_zero = TRUE}, the binomial coefficient, n choose k, where n = \code{n + m} - 1 and k = \code{m}.} 31 | \item{If \code{allow_zero = FALSE}, the binomial coefficient, n choose k, where n = \code{n} - 1 and k = \code{m}.} 32 | } 33 | } 34 | \examples{ 35 | 36 | # Permute all the ways eight can be assigned to four bins (A, C, G, T), 37 | # with each bin assigned at least one: 38 | permute_restricted_compositions( 39 | n = 8, 40 | m_labels = c("A", "C", "G", "T"), 41 | allow_zero = FALSE 42 | ) 43 | 44 | } 45 | \references{ 46 | Baumann, M. H., 2019. Die k-dimensionale Champagnerpyramide. Mathematische Semesterberichte, 66, 89-100. 47 | 48 | Curran, J., Williams, A., Kelleher, J. and Barber, D., 2021. multicool: Permutations of Multisets in Cool-Lex Order. R package version 0.1-12. https://CRAN.R-project.org/package=multicool. 49 | 50 | Hankin, R. K. S., 2006. Additive integer partitions in R. \emph{Journal of Statistical Software, Code Snippets}, \bold{16}, 1. 51 | } 52 | \author{ 53 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 54 | } 55 | -------------------------------------------------------------------------------- /R/bin_changes.R: -------------------------------------------------------------------------------- 1 | #' Counts the changes in a series of time bins 2 | #' 3 | #' @description 4 | #' 5 | #' Given a vector of dates for a series of time bins and another for the times when a character change occurred will return the total number of changes in each bin. 6 | #' 7 | #' @param change_times A vector of ages in millions of years at which character changes are hypothesised to have occurred. 8 | #' @param time_bins An object of class \code{timeBins}. 9 | #' 10 | #' @details 11 | #' 12 | #' Calculates the total number of evolutionary changes in a series of time bins. This is intended as an internal function for rate calculations, but could be used for other purposes (e.g., counting any point events in a series of time bins). 13 | #' 14 | #' @return 15 | #' 16 | #' A vector giving the number of changes for each time bin. Names indicate the maximum and minimum (bottom and top) values for each time bin. 17 | #' 18 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 19 | #' 20 | #' @examples 21 | #' 22 | #' # Create a random dataset of 100 changes (between 100 and 0 Ma): 23 | #' change_times <- stats::runif(n = 100, min = 0, max = 100) 24 | #' 25 | #' # Create 10 equal-length time bins: 26 | #' time_bins <- matrix(data = c(seq(from = 100, to = 10, length.out = 10), 27 | #' seq(from = 90, to = 0, length.out = 10)), ncol = 2, 28 | #' dimnames = list(LETTERS[1:10], c("fad", "lad"))) 29 | #' 30 | #' # Set class as timeBins: 31 | #' class(time_bins) <- "timeBins" 32 | #' 33 | #' # Get N changes for each bin: 34 | #' bin_changes(change_times = change_times, time_bins = time_bins) 35 | #' @export bin_changes 36 | bin_changes <- function(change_times, time_bins) { 37 | 38 | # EXPLAIN HOW TIMES ON BOUDNARIES WORK AND CHECK TOTAL COUNTS MAKE SENSE AT THE END 39 | # MAYBE SWITCH TO LAPPLY INSTEAD OF FOR LOOP 40 | # ADD BOUNDARY TIME OPTION? I.E., WHICH BIN SHOULD THEY BE ASSIGNED TO? 41 | 42 | # Check time_bins is in a valid format and stop and warn user if not: 43 | if (!is.timeBins(x = time_bins)) stop(check_timeBins(time_bins = time_bins)) 44 | 45 | # Create all-zero vector to store ouput in: 46 | binned_changes <- rep(x = 0, times = nrow(x = time_bins)) 47 | 48 | # For each time bin: 49 | for (i in 1:nrow(x = time_bins)) { 50 | 51 | # Find out which edges (if any) are present in the bin: 52 | binned_changes[i] <- length(x = intersect(which(x = change_times > time_bins[i, "lad"]), which(x = change_times <= time_bins[i, "fad"]))) 53 | } 54 | 55 | # Add time bin names to binned changes: 56 | names(binned_changes) <- rownames(time_bins) 57 | 58 | # Return edge lengths in bins: 59 | binned_changes 60 | } 61 | -------------------------------------------------------------------------------- /R/fix_root_time.R: -------------------------------------------------------------------------------- 1 | #' Fixes root.time after taxa have been pruned from a tree 2 | #' 3 | #' @description 4 | #' 5 | #' Fixes root.time after taxa have been pruned from a tree using ape::drop.tip 6 | #' 7 | #' @param original_tree A tree in phylo format. 8 | #' @param pruned_tree A tree in phylo format that represents a pruned version of \code{original_tree}. 9 | #' 10 | #' @details 11 | #' 12 | #' (NB: This function is designed to only cope with trees containing at least three tips.) 13 | #' 14 | #' When removing taxa from a time-scaled tree using \link[ape]{drop.tip} in \link[ape]{ape} \code{$root.time} is left unchanged. This can cause downstream problems if not fixed and that is what this function does. 15 | #' 16 | #' Note that \code{fix_root_time} in the \code{paleotree} package performs the same function, but is not called here to reduce the number of libraries on which \code{Claddis} is dependent. Interested users should also refer to the \code{dropPaleoTip} function in \code{paleotree}. 17 | #' 18 | #' @return Returns a tree (phylo object) with a fixed \code{$root.time}. 19 | #' 20 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 21 | #' 22 | #' @seealso 23 | #' 24 | #' \link{drop_time_tip} 25 | #' 26 | #' @examples 27 | #' 28 | #' # Create a simple four-taxon tree with branch lengths: 29 | #' tree <- ape::read.tree(text = "(A:1,(B:1,(C:1,D:1):1):1);") 30 | #' 31 | #' # Set root age as 20 Ma: 32 | #' tree$root.time <- 20 33 | #' 34 | #' # Now prune taxon A: 35 | #' pruned_tree <- ape::drop.tip(phy = tree, tip = "A") 36 | #' 37 | #' # Show that drop.tip has not updated the tree's root time: 38 | #' pruned_tree$root.time 39 | #' 40 | #' # Use the function to fix the root time: 41 | #' pruned_tree <- fix_root_time(original_tree = tree, pruned_tree = pruned_tree) 42 | #' 43 | #' # Show that the root time is now fixed (19 Ma): 44 | #' pruned_tree$root.time 45 | #' @export fix_root_time 46 | fix_root_time <- function(original_tree, pruned_tree) { 47 | 48 | # Conditional if pruned tree too small: 49 | if (ape::Ntip(phy = pruned_tree) < 3) stop("pruned_tree includes too few (<3) taxa to be used.") 50 | 51 | # Conditional in case where pruned tree taxa are not a subset of the original tree taxa: 52 | if (length(x = setdiff(x = pruned_tree$tip.label, y = original_tree$tip.label)) > 0) stop("pruned_tree cannot include taxa not present in original_tree.") 53 | 54 | # Update $root.time for pruned_tree: 55 | pruned_tree$root.time <- original_tree$root.time - mean(diag(x = ape::vcv(phy = original_tree))[names(diag(x = ape::vcv(phy = pruned_tree)))] - diag(x = ape::vcv(pruned_tree))) 56 | 57 | # Return updated pruned tree: 58 | pruned_tree 59 | } 60 | -------------------------------------------------------------------------------- /man/permute_treeshapes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_treeshapes.r 3 | \name{permute_treeshapes} 4 | \alias{permute_treeshapes} 5 | \title{Permute all treeshapes of N tips} 6 | \usage{ 7 | permute_treeshapes(n_tips, sort_by_resolution = TRUE) 8 | } 9 | \arguments{ 10 | \item{n_tips}{The number of tips required. Note that it may be very slow or not run at all if this value is too large.} 11 | 12 | \item{sort_by_resolution}{Whether or not to sort the output by number of internal nodes (from 1 to N - 1). Defaults to \code{TRUE}.} 13 | } 14 | \value{ 15 | If \code{sort_by_resolution = TRUE} then returns a list of length N - 1, where each element is a character vector of treeshapes in Newick-style number format with that many internal nodes. I.e., the first value will always be the star tree. If \code{sort_by_resolution = FALSE} then will just be a character vector of treeshapes in Newick-style number format. 16 | } 17 | \description{ 18 | Given a number of tips, permutes all rooted unlabelled multifurcating trees (i.e., treeshapes). 19 | } 20 | \details{ 21 | A treeshape is essentially an unlabelled phylogenetic tree. Like other phylogenetic trees it has a root and tips, but (as you might expect) because it is unlabelled the tips have no specific identity. Thus the only information it contains is its' "shape" - the number of internal nodes and their descendants. This function permutes all \emph{unique} treeshapes and allows for multifurcations. 22 | 23 | Note that unique means it excludes alternative rotations of individual branch points. For example, the trees ((2),1); and (1,(2)); are identical in information content and this function would only permute one of them. 24 | 25 | The algorithm used here is based on the partitions approach from Felsenstein (2004), although to the best of my knowledge nobody else has formally created an algorithm to do this. (Felsenstein also lays out the expected number of such treeshapes for each value of N in his Table 3.4.) 26 | 27 | Here treeshapes are encoded and output in a pseudo-Newick style format where labels are replaced with the number of tips, e.g.: 28 | 29 | (((3),1),(1,(2))); 30 | 31 | Thus each pair of parentheses represents an internal node, each number the number of tips, each comma separates sets of tips, and the semicolon denotes the root clade. 32 | } 33 | \examples{ 34 | 35 | # Permute all treeshapes of six tips sorted by resolution: 36 | permute_treeshapes(n_tips = 6) 37 | 38 | } 39 | \references{ 40 | Felsenstein, J., 2004. \emph{Inferring Phylogenies}. Sinauer Associates, Inc., Sunderland. 41 | } 42 | \author{ 43 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 44 | } 45 | -------------------------------------------------------------------------------- /R/find_time_bin_midpoints.R: -------------------------------------------------------------------------------- 1 | #' Find time bin midpoints 2 | #' 3 | #' @description 4 | #' 5 | #' Find the midpoint values for each bin from a timeBins object 6 | #' 7 | #' @param time_bins A timeBins object. 8 | #' 9 | #' @details 10 | #' 11 | #' Frequently the midpoints of a series of time bins (defined by a beginning and ending) will be required, for example, when plotting binned data as a time series. Although the calculation involved is trivial (i.e., start date + end date / 2) this is a sufficiently common operation it is made into a formal function here. 12 | #' 13 | #' Note that this function is designed to work specifically with objects of class "timeBins" - a format specific to Claddis that looks something like this: 14 | #' 15 | #' \preformatted{ fad lad 16 | #' Cenomanian 99.6 93.5 17 | #' Turonian 93.5 89.3 18 | #' Coniacian 89.3 85.8 19 | #' Santonian 85.8 83.5 20 | #' Campanian 83.5 70.6 21 | #' Maastrichtian 70.6 65.5} 22 | #' 23 | #' I.e., a matrix with two columns (fad = first appearance date and lad = last appearance date) with rows corresponding to named time bins and indiviual values ages in millions of years ago (Ma). The object should also have class \code{timeBins} (see example below for hot to generate such an object). Note also that the convention here is to have time bins be ordered from oldest to youngest. 24 | #' 25 | #' @return A vector of time bin midpoint values. 26 | #' 27 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 28 | #' 29 | #' @examples 30 | #' 31 | #' # Create a time bins object: 32 | #' time_bins <- matrix( 33 | #' data = c(99.6, 93.5, 93.5, 89.3, 89.3, 85.8, 85.8, 83.5, 83.5, 70.6, 70.6, 65.5), 34 | #' ncol = 2, 35 | #' byrow = TRUE, 36 | #' dimnames = list( 37 | #' c("Cenomanian", "Turonian", "Coniacian", "Santonian", "Campanian", "Maastrichtian"), 38 | #' c("fad", "lad") 39 | #' ) 40 | #' ) 41 | #' 42 | #' # Set class as timeBins: 43 | #' class(time_bins) <- "timeBins" 44 | #' 45 | #' # Return midpoints for each time bin in sequence: 46 | #' find_time_bin_midpoints(time_bins = time_bins) 47 | #' 48 | #' @export find_time_bin_midpoints 49 | find_time_bin_midpoints <- function(time_bins) { 50 | 51 | # Check time_bins has class timeBins and stop and warn user if not: 52 | if (!inherits(x = time_bins, what = "timeBins")) stop("time_bins must be an object of class \"timeBins\".") 53 | 54 | # If not a valid timeBins object then stop and provide feedback to user on what is wrong: 55 | if (!is.timeBins(time_bins)) stop(check_timeBins(time_bins = time_bins)[1]) 56 | 57 | # Return time bin midpoints: 58 | apply(X = time_bins, MARGIN = 1, FUN = mean) 59 | } 60 | -------------------------------------------------------------------------------- /R/permute_all_uncertainties.r: -------------------------------------------------------------------------------- 1 | #' Permute all possible uncertainties for a given set of states 2 | #' 3 | #' @description 4 | #' 5 | #' Given a set of discrete states, will permute all possible uncertainity combinations of those states. 6 | #' 7 | #' @param single_states A vector of single states (e.g., 0, 1, 2 etc.). 8 | #' 9 | #' @details 10 | #' 11 | #' This function solves a simple phylogenetic combinatorics problem - what are all the possible outcomes for a character to be in given uncertainties are allowed? 12 | #' 13 | #' For example, for three states (0, 1, 2) there are four possible uncertainties: 0/1, 0/2, 1/2 and 0/1/2. 14 | #' 15 | #' If the user is instead only interested in the size of this state space, this is simply given by 2^N - N - 1, where N is the number of single states. Thus, the first several outcomes are: 16 | #' 17 | #' \preformatted{---------------------------------- 18 | #' | N states | N possible outcomes | 19 | #' ---------------------------------- 20 | #' | 2 | 1 | 21 | #' | 3 | 4 | 22 | #' | 4 | 11 | 23 | #' | 5 | 26 | 24 | #' | 6 | 57 | 25 | #' | 7 | 120 | 26 | #' | 8 | 247 | 27 | #' | 9 | 502 | 28 | #' | 10 | 1,013 | 29 | #' | 11 | 2,036 | 30 | #' | 12 | 4,083 | 31 | #' | 13 | 8,178 | 32 | #' | 14 | 16,369 | 33 | #' ----------------------------------} 34 | #' 35 | #' Note that this function is really designed for internal use, but may have value to some users and so is available "visibly" here. 36 | #' 37 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 38 | #' 39 | #' @return 40 | #' 41 | #' A vector of all possible uncertainty states. 42 | #' 43 | #' @seealso 44 | #' 45 | #' \link{make_costmatrix} and \link{permute_all_polymorphisms} 46 | #' 47 | #' @examples 48 | #' 49 | #' # Get all possible states for the character 0, 1, and 2: 50 | #' permute_all_uncertainties(single_states = 0:2) 51 | #' 52 | #' @export permute_all_uncertainties 53 | permute_all_uncertainties <- function(single_states) { 54 | n_states <- length(x = single_states) 55 | if (n_states < 2) stop("single_states must contain at last two values or no uncertainties are possible.") 56 | unlist( 57 | x = lapply( 58 | X = as.list(x = 2:n_states), 59 | FUN = function(x) { 60 | apply( 61 | X = combn(x = sort(x = single_states), m = x), 62 | MARGIN = 2, 63 | FUN = function(y) paste(x = y, collapse = "/") 64 | ) 65 | } 66 | ) 67 | ) 68 | } 69 | -------------------------------------------------------------------------------- /man/calculate_WMPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_WMPD.R 3 | \name{calculate_WMPD} 4 | \alias{calculate_WMPD} 5 | \title{Calculate weighted mean pairwise distances} 6 | \usage{ 7 | calculate_WMPD(distances, taxon_groups) 8 | } 9 | \arguments{ 10 | \item{distances}{An object of class \code{distanceMatrices}.} 11 | 12 | \item{taxon_groups}{An object of class \code{taxonGroups}.} 13 | } 14 | \value{ 15 | A labelled vector of weighted mean pairwise distances. 16 | } 17 | \description{ 18 | Given distanceMatrices and taxonGroups objects calculates their weighted mean pairwise distances. 19 | } 20 | \details{ 21 | Not all measures of disparity (morphological distance) require an ordination space. For example, the pariwise distances between taxa are themselves a disparity metric. However, due to variable amounts of missing data each pairwise distance should not necessarily be considered equal. Specifically, it could be argued that for a group of taxa the mean distance should be weighted by the number of characters that distance is based on, or more specifically the sum of the weights of those characters (e.g., Close et al. 2015). 22 | 23 | This function takes the output from \link{calculate_morphological_distances} and a set of taxon groups and returns the weighted mean pairwise distance for those groups. 24 | } 25 | \examples{ 26 | 27 | # Get morphological distances for the Day et al. (2016) data set: 28 | distances <- calculate_morphological_distances( 29 | cladistic_matrix = day_2016, 30 | distance_metric = "mord", 31 | distance_transformation = "none" 32 | ) 33 | 34 | # Build simple taxonomic groups for Day et al. (2016) data set: 35 | taxon_groups <- list(nonBurnetiamorpha = c("Biarmosuchus_tener", "Hipposaurus_boonstrai", 36 | "Bullacephalus_jacksoni", "Pachydectes_elsi", "Niuksenitia_sukhonensis", "Ictidorhinus_martinsi", 37 | "RC_20", "Herpetoskylax_hopsoni"), Burnetiamorpha = c("Lemurosaurus_pricei", "Lobalopex_mordax", 38 | "Lophorhinus_willodenensis", "Proburnetia_viatkensis", "Lende_chiweta", 39 | "Paraburnetia_sneeubergensis", "Burnetia_mirabilis", "BP_1_7098")) 40 | 41 | # Set class as taxonGroups: 42 | class(taxon_groups) <- "taxonGroups" 43 | 44 | # Calculate mean pairiwise distances: 45 | calculate_MPD(distances, taxon_groups) 46 | 47 | # Now calculate weighted mean pairwise distances: 48 | calculate_WMPD(distances, taxon_groups) 49 | 50 | } 51 | \references{ 52 | Close, R. A., Friedman, M., Lloyd, G. T. and Benson, R. B. J., 2015. Evidence for a mid-Jurassic adaptive radiation in mammals. \emph{Current Biology}, \bold{25}, 2137-2142. 53 | } 54 | \author{ 55 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 56 | } 57 | -------------------------------------------------------------------------------- /R/permute_all_polymorphisms.r: -------------------------------------------------------------------------------- 1 | #' Permute all possible polymorphisms for a given set of states 2 | #' 3 | #' @description 4 | #' 5 | #' Given a set of discrete states, will permute all possible polymorphic combinations of those states. 6 | #' 7 | #' @param single_states A vector of single states (e.g., 0, 1, 2 etc.). 8 | #' 9 | #' @details 10 | #' 11 | #' This function solves a simple phylogenetic combinatorics problem - what are all the possible outcomes for a character to be in given polymorphisms (of any size) are allowed? 12 | #' 13 | #' For example, for three states (0, 1, 2) there are four possible polymorphisms: 0&1, 0&2, 1&2 and 0&1&2. 14 | #' 15 | #' If the user is instead only interested in the size of this state space, this is simply given by 2^N - N - 1, where N is the number of single states. Thus, the first several outcomes are: 16 | #' 17 | #' \preformatted{---------------------------------- 18 | #' | N states | N possible outcomes | 19 | #' ---------------------------------- 20 | #' | 2 | 1 | 21 | #' | 3 | 4 | 22 | #' | 4 | 11 | 23 | #' | 5 | 26 | 24 | #' | 6 | 57 | 25 | #' | 7 | 120 | 26 | #' | 8 | 247 | 27 | #' | 9 | 502 | 28 | #' | 10 | 1,013 | 29 | #' | 11 | 2,036 | 30 | #' | 12 | 4,083 | 31 | #' | 13 | 8,178 | 32 | #' | 14 | 16,369 | 33 | #' ----------------------------------} 34 | #' 35 | #' Note that this function is really designed for internal use, but may have value to some users and so is available "visibly" here. 36 | #' 37 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 38 | #' 39 | #' @return 40 | #' 41 | #' A vector of all possible polymorphic states. 42 | #' 43 | #' @seealso 44 | #' 45 | #' \link{make_costmatrix} and \link{permute_all_uncertainties} 46 | #' 47 | #' @examples 48 | #' 49 | #' # Get all possible states for the character 0, 1, and 2: 50 | #' permute_all_polymorphisms(single_states = 0:2) 51 | #' 52 | #' @export permute_all_polymorphisms 53 | permute_all_polymorphisms <- function(single_states) { 54 | n_states <- length(x = single_states) 55 | if (n_states < 2) stop("single_states must contain at last two values or no polymorphisms are possible.") 56 | unlist( 57 | x = lapply( 58 | X = as.list(x = 2:n_states), 59 | FUN = function(x) { 60 | apply( 61 | X = combn(x = sort(x = single_states), m = x), 62 | MARGIN = 2, 63 | FUN = function(y) paste(x = y, collapse = "&") 64 | ) 65 | } 66 | ) 67 | ) 68 | } 69 | -------------------------------------------------------------------------------- /R/find_minimum_spanning_edges.R: -------------------------------------------------------------------------------- 1 | #' Get edges of minimum spanning tree 2 | #' 3 | #' @description 4 | #' 5 | #' Returns edges of a minimum spanning tree given a distance matrix. 6 | #' 7 | #' @param distance_matrix A square matrix of distances between objects. 8 | #' 9 | #' @details 10 | #' 11 | #' This function is a wrapper for \link[ape]{mst} in the \link[ape]{ape} package, but returns a vector of edges rather than a square matrix of links. 12 | #' 13 | #' @return A vector of named edges (X->Y) with their distances. The sum of this vector is the length of the minimum spanning tree. 14 | #' 15 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 16 | #' 17 | #' @examples 18 | #' 19 | #' # Create a simple square matrix of distances: 20 | #' distance_matrix <- matrix(c(0, 1, 2, 3, 1, 0, 1, 2, 2, 1, 0, 1, 3, 2, 1, 0), 21 | #' nrow = 4, 22 | #' dimnames = list(LETTERS[1:4], LETTERS[1:4]) 23 | #' ) 24 | #' 25 | #' # Show matrix to confirm that the off diagonal has the shortest 26 | #' # distances: 27 | #' distance_matrix 28 | #' 29 | #' # Use find_minimum_spanning_edges to get the edges for the minimum spanning 30 | #' # tree: 31 | #' find_minimum_spanning_edges(distance_matrix) 32 | #' 33 | #' # Use sum of find_minimum_spanning_edges to get the length of the minimum 34 | #' # spanning tree: 35 | #' sum(find_minimum_spanning_edges(distance_matrix)) 36 | #' @export find_minimum_spanning_edges 37 | find_minimum_spanning_edges <- function(distance_matrix) { 38 | 39 | # Convert to matrix and set up links matrix: 40 | distance_matrix <- as.matrix(distance_matrix) 41 | 42 | # Get links matrix for minimum spanning tree: 43 | links_matrix <- ape::mst(distance_matrix) 44 | 45 | # Create empty matrix to store edges for minimum spanning tree: 46 | minimum_spanning_tree_edges <- matrix(nrow = 0, ncol = 2, dimnames = list(c(), c("From", "To"))) 47 | 48 | # For each row: 49 | for (i in 1:(nrow(links_matrix) - 1)) { 50 | 51 | # For each column: 52 | for (j in (i + 1):ncol(links_matrix)) { 53 | 54 | # If there is a link then record it: 55 | if (links_matrix[i, j] == 1) { 56 | minimum_spanning_tree_edges <- rbind( 57 | minimum_spanning_tree_edges, 58 | c( 59 | rownames(x = links_matrix)[i], 60 | colnames(x = links_matrix)[j] 61 | ) 62 | ) 63 | } 64 | } 65 | } 66 | 67 | # Get distances: 68 | distances <- diag(x = distance_matrix[minimum_spanning_tree_edges[, "From"], minimum_spanning_tree_edges[, "To"]]) 69 | 70 | # Add names to distances: 71 | names(distances) <- apply(minimum_spanning_tree_edges, 1, paste, collapse = "->") 72 | 73 | # Return distances for minimum spanning tree: 74 | distances 75 | } 76 | -------------------------------------------------------------------------------- /man/convert_adjacency_matrix_to_costmatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert_adjacency_matrix_to_costmatrix.r 3 | \name{convert_adjacency_matrix_to_costmatrix} 4 | \alias{convert_adjacency_matrix_to_costmatrix} 5 | \title{Converts an adjacency matrix to a costmatrix} 6 | \usage{ 7 | convert_adjacency_matrix_to_costmatrix(adjacency_matrix) 8 | } 9 | \arguments{ 10 | \item{adjacency_matrix}{A labelled square matrix with zeroes denoting non-adjacencies and ones denoting adjacencies.} 11 | } 12 | \value{ 13 | An object of class \code{costMatrix}. 14 | } 15 | \description{ 16 | Takes an adjacency matrix as input and returns the corresponding costmatrix. 17 | } 18 | \details{ 19 | This function is intended for internal use, but as it also generalizes to solving a general graph theory problem - generating a distance matrix corresponding to each shortest path between vertices of a connected graph represented as an adjacency matrix - it is made available explicitly here. 20 | 21 | The process is best understood with an example. Imagine we have a graph like this: 22 | 23 | \preformatted{ 0-1-2 24 | | 25 | 3} 26 | 27 | I.e., we have four labelled vertices, 0-3, and three edges (connections) between them: 28 | 29 | \preformatted{ 0-1 30 | 1-2 31 | 0-3} 32 | 33 | Note: here we assume symmetry, 0-1 = 1-0. 34 | 35 | Graphs like this can be explicitly captured as adjacency matrices, where a one denotes two vertices are "adjacent" (connected by an edge) and a zero that they are not. 36 | 37 | \preformatted{ _________________ 38 | | 0 | 1 | 2 | 3 | 39 | --------------------- 40 | | 0 | 0 | 1 | 0 | 1 | 41 | --------------------- 42 | | 1 | 1 | 0 | 1 | 0 | 43 | --------------------- 44 | | 2 | 0 | 1 | 0 | 0 | 45 | --------------------- 46 | | 3 | 1 | 0 | 0 | 0 | 47 | ---------------------} 48 | 49 | But what such matrices do not tell us is how far every vertex-to-vertex path is in terms of edge counts. E.g., the path length from vertex 3 to vertex 2. 50 | 51 | This function simply takes the adjacency matrix and returns the corresponding costmatrix, corresponding to every minimum vertex-to-vertex path length. 52 | } 53 | \examples{ 54 | 55 | # Build the example adjacency matrix for the graph above: 56 | adjacency_matrix <- matrix( 57 | data = c( 58 | 0, 1, 0, 1, 59 | 1, 0, 1, 0, 60 | 0, 1, 0, 0, 61 | 1, 0, 0, 0 62 | ), 63 | nrow = 4, 64 | ncol = 4, 65 | dimnames = list(0:3, 0:3) 66 | ) 67 | 68 | # Convert this to a costmatrix: 69 | convert_adjacency_matrix_to_costmatrix( 70 | adjacency_matrix = adjacency_matrix 71 | ) 72 | 73 | } 74 | \seealso{ 75 | \link{convert_state_tree_to_adjacency_matrix}, \link{locate_bracket_positions} 76 | } 77 | \author{ 78 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 79 | } 80 | -------------------------------------------------------------------------------- /man/is_graph_connected.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is_graph_connected.R 3 | \name{is_graph_connected} 4 | \alias{is_graph_connected} 5 | \title{Is a graph connected?} 6 | \usage{ 7 | is_graph_connected(adjacency_matrix) 8 | } 9 | \arguments{ 10 | \item{adjacency_matrix}{An adjacency matrix where the diagonal is zeroes and the off-diagonal either ones (if the two vertices are directly connected) or zeroes (if not directly connected).} 11 | } 12 | \value{ 13 | A logical (TRUE or FALSE). 14 | } 15 | \description{ 16 | Is a graph represented by an adjacenecy matrix connected? 17 | } 18 | \details{ 19 | Any undirected graph can be represented as an adjacency matrix and the properties of this matrix can be used to determine whether or not the graph is connected (i.e., a path between any two vertices exists) or not. 20 | 21 | For example, the following graph: 22 | 23 | \preformatted{6---4---5 24 | | |\ 25 | | | 1 26 | | |/ 27 | 3---2} 28 | 29 | Has the adjacency matrix: 30 | 31 | \preformatted{ _________________________ 32 | | 1 | 2 | 3 | 4 | 5 | 6 | 33 | ----------------------------- 34 | | 1 | 0 | 1 | 0 | 0 | 1 | 0 | 35 | ----------------------------- 36 | | 2 | 1 | 0 | 1 | 0 | 1 | 0 | 37 | ----------------------------- 38 | | 3 | 0 | 1 | 0 | 1 | 0 | 0 | 39 | ----------------------------- 40 | | 4 | 0 | 0 | 1 | 0 | 1 | 1 | 41 | ----------------------------- 42 | | 5 | 1 | 1 | 0 | 1 | 0 | 0 | 43 | ----------------------------- 44 | | 6 | 0 | 0 | 0 | 1 | 0 | 0 | 45 | -----------------------------} 46 | 47 | This functions run through the following checks in order to confirm the connectivity of the graph: 48 | 49 | \enumerate{ 50 | \item As the graph has more than one vertex then further checks are required (a single vertex graph is considered connected). 51 | \item As no vertice has degree zero (no links) then the graph \emph{may} be connected (further checks are required). 52 | \item As there are more than two vertices the graph may be disconnected (further checks are required). 53 | \item As no missing paths are found (that would separate the graph into one or more disconnected subgraphs) then the graph must be connected. 54 | } 55 | 56 | This ordering means more complex queries are not triggered unless simpler tests do not provide a definitive answer. 57 | } 58 | \examples{ 59 | 60 | # Create the connected graph matrix: 61 | x <- matrix( 62 | data = c( 63 | 0, 1, 0, 0, 1, 0, 64 | 1, 0, 1, 0, 1, 0, 65 | 0, 1, 0, 1, 0, 0, 66 | 0, 0, 1, 0, 1, 1, 67 | 1, 1, 0, 1, 0, 0, 68 | 0, 0, 0, 1, 0, 0 69 | ), 70 | ncol = 6, 71 | byrow = TRUE 72 | ) 73 | 74 | # Check graph is connected: 75 | is_graph_connected(adjacency_matrix = x) 76 | 77 | } 78 | \author{ 79 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 80 | } 81 | -------------------------------------------------------------------------------- /man/map_dollo_changes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/map_dollo_changes.R 3 | \name{map_dollo_changes} 4 | \alias{map_dollo_changes} 5 | \title{Stochastic Character Map For Dollo Character} 6 | \usage{ 7 | map_dollo_changes(time_tree, tip_states) 8 | } 9 | \arguments{ 10 | \item{time_tree}{A tree in phylo format with positive branch lengths and a value for \code{$root.time}.} 11 | 12 | \item{tip_states}{A named vector of tip states (must be 0 or 1), where the names match \code{tree$tip.label}.} 13 | } 14 | \value{ 15 | \item{changes}{A matrix of all changes (gains and losses).} 16 | \item{stochastic_character_map}{The stochastic character map.} 17 | } 18 | \description{ 19 | Given a tree with binary tip states produces a stochastic Dollo character map. 20 | } 21 | \details{ 22 | The non-ideal solution from Tarver et al. (2018) to the problem of generating a stochastic character map for a Dollo character (i.e., a single gain of the derived state, 1) with any number of losses (1 -> 0). 23 | 24 | The function operates as follows: 25 | 26 | 1) Establishes the least inclusive clade exhibiting the derived state (1). 27 | 2) Assumes a single gain occurred with equal probability along the branch subtending this clade. 28 | 3) Prunes the inclusive clade to generate a subtree with a strong root prior of the derived state (1). 29 | 4) Calls \code{make.simmap} from the \code{phytools} package to generate a stochastic character map using a model where only losses are possible. 30 | 5) Outputs both the stochastic character map (time spent in each state on each branch) and a matrix of state changes. 31 | 32 | NB: As the map is stochastic the answer will be different each time the function is run and multiple replicates are strongly advised in order to characterise this uncertainty. 33 | } 34 | \examples{ 35 | 36 | # Build example ten-tip tree: 37 | time_tree <- ape::read.tree(text = paste0("(A:1,(B:1,((C:1,(D:1,(E:1,F:1):1):1):1,", 38 | "((G:1,H:1):1,(I:1,J:1):1):1):1):1);")) 39 | 40 | # Arbitrarily add a root.time value of 100 Ma: 41 | time_tree$root.time <- 100 42 | 43 | # Build example tip state values: 44 | tip_states <- c(A = 0, B = 0, C = 1, D = 1, E = 0, F = 1, G = 1, H = 1, I = 0, J = 1) 45 | 46 | # Run map_dollo_changes on data and store output: 47 | out <- map_dollo_changes(time_tree, tip_states) 48 | 49 | # View matrix of changes: 50 | out$changes 51 | 52 | # View stochastic character map (time spent in each state on each branch): 53 | out$stochastic_character_map 54 | } 55 | \references{ 56 | Tarver, J. E., Taylor, R. S., Puttick, M. N., Lloyd, G. T., Pett, W., Fromm, B., Schirrmeister, B. E., Pisani, D., Peterson, K. J. and Donoghue, P. C. J., 2018. Well-annotated microRNAomes do not evidence pervasive miRNA loss. \emph{Genome Biology and Evolution}, \bold{6}, 1457-1470. 57 | } 58 | \author{ 59 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 60 | } 61 | -------------------------------------------------------------------------------- /R/permute_combinations_with_replacement.r: -------------------------------------------------------------------------------- 1 | #' Permute all combinations of x of size m with replacement 2 | #' 3 | #' @description 4 | #' 5 | #' Given a vector x, permutes all possible groups of size m ignoring order and allowing any item in x to appear multiple times. 6 | #' 7 | #' @param x A character vector. 8 | #' @param m A positive integer indicating the size of the set desired. 9 | #' 10 | #' @details 11 | #' 12 | #' This is a simple combinatoric function used internally in Claddis where all possible combinations of \code{x} that are size \code{m} are permuted. Note that this ignores order (i.e., the sets \\{A,B\\} and \\{B,A\\} are considered identical) and replacements (or multiples) of an element of \code{x} are allowed (i.e., the sets \\{A,A\\} and \\{B,B\\} are both valid). 13 | #' 14 | #' @return A matrix of m columns where each row is a unique combination of x. 15 | #' 16 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 17 | #' 18 | #' @examples 19 | #' 20 | #' # Permute all the ways the letters A-C can form a set of size 3: 21 | #' permute_combinations_with_replacement(x = LETTERS[1:3], m = 3) 22 | #' 23 | #' @export permute_combinations_with_replacement 24 | permute_combinations_with_replacement <- function(x, m) { 25 | 26 | # Get length of x (n): 27 | n <- length(x = x) 28 | 29 | # Subfunction to get indices for combinations: 30 | combination_indices <- function(n, m) { 31 | if (m == 1) return(value = matrix(data = 1:n, ncol = 1)) 32 | if (m > 1) { 33 | x <- do.call( 34 | what = rbind, 35 | args = sapply(X = 1:n, FUN = function(i) cbind(i, i:n), simplify = FALSE) 36 | ) 37 | if (m > 2) { 38 | while(ncol(x = x) < m) { 39 | x <- do.call( 40 | what = rbind, 41 | args = apply( 42 | X = x, 43 | MARGIN = 1, 44 | FUN = function(i) { 45 | size_i <- length(x = i) 46 | j <- as.list(x = i) 47 | j[[(length(x = j) + 1)]] <- i[size_i]:n 48 | do.call(what = cbind, args = j) 49 | } 50 | ) 51 | ) 52 | } 53 | } 54 | x <- unname(obj = x) 55 | return(value = x) 56 | } 57 | } 58 | 59 | # If there are multiple elements in x: 60 | if (n > 1) { 61 | 62 | # Now form all combinations of the elements of x: 63 | combinations <- apply( 64 | X = combination_indices(n = n, m = m), 65 | MARGIN = 1, 66 | FUN = function(i) x[i], 67 | simplify = FALSE 68 | ) 69 | 70 | # Make into matrix: 71 | combinations <- do.call(what = rbind, args = combinations) 72 | 73 | # If there is only one elemnt in x: 74 | } else { 75 | 76 | # Make a simple matrix of x repeated m times: 77 | combinations <- matrix(data = rep(x = x, times = m), ncol = m) 78 | } 79 | 80 | # Return combinations to user: 81 | combinations 82 | } 83 | -------------------------------------------------------------------------------- /R/align_matrix_block.R: -------------------------------------------------------------------------------- 1 | #' Aligns a phylogenetic matrix block 2 | #' 3 | #' @description 4 | #' 5 | #' Given a block of taxa and characters aligns text so each character block begins at same point. 6 | #' 7 | #' @param matrix_block The matrix block as raw input text. 8 | #' 9 | #' @details 10 | #' 11 | #' The function serves to help build NEXUS files by neatly aligning raw text blocks of taxa and characters. Or in simple terms it takes input that looks like this: 12 | #' 13 | #' \preformatted{Allosaurus 012100?1011 14 | #' Abelisaurus 0100???0000 15 | #' Tyrannosaurus 01012012010 16 | #' Yi 10101?0????} 17 | #' 18 | #' And turns it into something that looks like this: 19 | #' 20 | #' \preformatted{Allosaurus 012100?1011 21 | #' Abelisaurus 0100???0000 22 | #' Tyrannosaurus 01012012010 23 | #' Yi 10101?0????} 24 | #' 25 | #' I use this in building the NEXUS files on my site, \href{http://www.graemetlloyd.com/matr.html}{graemetlloyd.com}. 26 | #' 27 | #' @return 28 | #' 29 | #' Nothing is returned, instead the aligned block is sent to the clipboard ready for pasting into a text editor. 30 | #' 31 | #' @author 32 | #' 33 | #' Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 34 | #' 35 | #' @examples 36 | #' 37 | #' # Build example block from above: 38 | #' x <- paste(c( 39 | #' "Allosaurus 012100?1011", 40 | #' "Abelisaurus 0100???0000", 41 | #' "Tyrannosaurus 01012012010", 42 | #' "Yi 10101?0????" 43 | #' ), collapse = "\n") 44 | #' 45 | #' # Look at block pre-alignment: 46 | #' x 47 | #' 48 | #' # Align block and place on clipboard: 49 | #' \dontrun{ 50 | #' align_matrix_block(x) 51 | #' } 52 | #' 53 | #' # To test the response open a text editor and paste the 54 | #' # contents of the clipboard. 55 | #' @export align_matrix_block 56 | align_matrix_block <- function(matrix_block) { 57 | 58 | # Need to convert supplied block of text into list of taxon and character vectors: 59 | matrix_block <- lapply(X = as.list(x = strsplit(matrix_block, "\n")[[1]]), function(x) { 60 | 61 | # Split each line by whitespace: 62 | x <- unlist(x = strsplit(x, " ")) 63 | 64 | # Return vector of name plus characters: 65 | x[c(1, length(x = x))] 66 | }) 67 | 68 | # what is the most number of spaces to add: 69 | block_length <- max(unlist(x = lapply(X = matrix_block, function(x) nchar(x = x[1])))) + 2 70 | 71 | # Add spaces to names to align block: 72 | matrix_block <- lapply(X = matrix_block, function(x) { 73 | 74 | # Isolate taxon name: 75 | taxon_name <- strsplit(x[1], "")[[1]] 76 | 77 | # Paste line together with correct number of spaces separating taxon name and characters: 78 | x[1] <- paste(c(taxon_name, rep(" ", block_length - length(x = taxon_name))), collapse = "") 79 | 80 | # Return aligned text: 81 | x 82 | }) 83 | 84 | # Write output to clipboard ready to paste in a text (NEXUS) file: 85 | clipr::write_clip(paste(unlist(x = lapply(X = matrix_block, paste, collapse = "")), collapse = "\n")) 86 | } 87 | -------------------------------------------------------------------------------- /R/print.costMatrix.r: -------------------------------------------------------------------------------- 1 | #' Compact display of a costmatrix 2 | #' 3 | #' @description 4 | #' 5 | #' Displays a compact summary of a costMatrix object. 6 | #' 7 | #' @param x An object of class \code{"costMatrix"}. 8 | #' @param ... Further arguments passed to or from other methods. 9 | #' 10 | #' @details 11 | #' 12 | #' Displays some basic summary information on a costmatrix object. 13 | #' 14 | #' @return 15 | #' 16 | #' Nothing is directly returned, instead a text summary describing a \code{"costMatrix"} object is printed to the console. 17 | #' 18 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 19 | #' 20 | #' @examples 21 | #' 22 | #' # Make an unordered costmatrix: 23 | #' example_costmatrix <- make_costmatrix( 24 | #' min_state = 0, 25 | #' max_state = 2, 26 | #' character_type = "unordered" 27 | #' ) 28 | #' 29 | #' # Show print.costMatrix version: 30 | #' print.costMatrix(x = example_costmatrix) 31 | #' 32 | #' @export print.costMatrix 33 | print.costMatrix <- function(x, ...) { 34 | 35 | # ANOTHER USEFUL THING TO STATE IS WHETHER MATRIX CAN BE REPRESENTED AS AN ADJACENCY MATRIX? 36 | # NEED FUNCTION TO CONVERT COSTMATRIX TO Q-MATRIX PARAMETERS? NOT ALL DOABLE, BUT SEEMS USEFUL IF APPLYING LIKELIHOOD ELSEWHERE IN CLADDIS 37 | # NEED SOMETHING FOR PRUNED MATRICES? 38 | 39 | # Check x has class costMatrix and stop and warn user if not: 40 | if (!inherits(x = x, what = "costMatrix")) stop("x must be an object of class \"costMatrix\".") 41 | 42 | # If not a valid costMatrix object then stop and provide feedback to user on what is wrong: 43 | if (!is.costMatrix(x = x)) stop(check_costMatrix(costmatrix = x)[1]) 44 | 45 | # Return summary information about object: 46 | cat( 47 | paste0( 48 | x$symmetry, 49 | " ", 50 | x$type, 51 | " costMatrix object containing ", 52 | x$n_states, 53 | " unique states", 54 | ifelse( 55 | test = all(c(x$includes_polymorphisms, x$includes_uncertainties)), 56 | yes = paste0( 57 | " (plus ", 58 | length(x = grep(pattern = "&", x = colnames(x = x$costmatrix))), 59 | " polymorphic and ", 60 | length(x = grep(pattern = "/", x = colnames(x = x$costmatrix))), 61 | " uncertain states)" 62 | ), 63 | no = "" 64 | ), 65 | ifelse( 66 | test = all(c(x$includes_polymorphisms, !x$includes_uncertainties)), 67 | yes = paste0( 68 | " (plus ", 69 | length(x = grep(pattern = "&", x = colnames(x = x$costmatrix))), 70 | " polymorphic states)" 71 | ), 72 | no = "" 73 | ), 74 | ifelse( 75 | test = all(c(!x$includes_polymorphisms, x$includes_uncertainties)), 76 | yes = paste0( 77 | " (plus ", 78 | length(x = grep(pattern = "/", x = colnames(x = x$costmatrix))), 79 | " uncertain states)" 80 | ), 81 | no = "" 82 | ), 83 | "." 84 | ) 85 | ) 86 | } 87 | -------------------------------------------------------------------------------- /man/bin_character_completeness.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bin_character_completeness.R 3 | \name{bin_character_completeness} 4 | \alias{bin_character_completeness} 5 | \title{Phylogenetic character completeness in time-bins} 6 | \usage{ 7 | bin_character_completeness( 8 | cladistic_matrix, 9 | time_tree, 10 | time_bins, 11 | plot = FALSE, 12 | confidence.interval = 0.95 13 | ) 14 | } 15 | \arguments{ 16 | \item{cladistic_matrix}{A cladistic matrix in the form imported by \link{read_nexus_matrix}.} 17 | 18 | \item{time_tree}{A time-scaled phylogenetic tree containing all the taxa in \code{cladistic_matrix}.} 19 | 20 | \item{time_bins}{An object of class \code{timeBins}.} 21 | 22 | \item{plot}{An optional choice to plot the results (default is \code{FALSE}).} 23 | 24 | \item{confidence.interval}{The confidence interval to be used as a proportion (0 to 1). Default is 0.95 (i.e., 95\%).} 25 | } 26 | \value{ 27 | A list summarising the mean, upper and lower confidence interval, and per character proportional character completeness in each time bin. 28 | } 29 | \description{ 30 | Given a cladistic matrix, time-scaled tree, and set of time bin boundaries will return the proportional character completeness in each bin. 31 | } 32 | \details{ 33 | Character completeness metrics have been used as an additional metric for comparing fossil record quality across time, space, and taxa. However, these only usually refer to point samples of fossils in bins, and not our ability to infer information along the branches of a phylogenetic tree. 34 | 35 | This function returns the proportional phylogenetic character completeness for a set of time bins. 36 | } 37 | \examples{ 38 | 39 | # Create a random tree for the Day et al. 2016 data set: 40 | day_2016tree <- ape::rtree(n = nrow(day_2016$matrix_1$matrix)) 41 | day_2016tree$tip.label <- rownames(x = day_2016$matrix_1$matrix) 42 | day_2016tree$root.time <- max(diag(x = ape::vcv(phy = day_2016tree))) 43 | 44 | # Build ten equal-length time bins spanning the tree: 45 | time_bins <- matrix(data = c(seq(from = day_2016tree$root.time, 46 | to = day_2016tree$root.time - max(diag(x = ape::vcv(phy = day_2016tree))), 47 | length.out = 11)[1:10], seq(from = day_2016tree$root.time, 48 | to = day_2016tree$root.time - max(diag(x = ape::vcv(phy = day_2016tree))), 49 | length.out = 11)[2:11]), ncol = 2, dimnames = list(LETTERS[1:10], c("fad", "lad"))) 50 | 51 | # Set class as timeBins: 52 | class(time_bins) <- "timeBins" 53 | 54 | # Get proportional phylogenetic character completeness in ten equal-length 55 | # time bins: 56 | bin_character_completeness( 57 | cladistic_matrix = day_2016, 58 | time_tree = day_2016tree, 59 | time_bins = time_bins 60 | ) 61 | 62 | # Same, but with a plot: 63 | bin_character_completeness( 64 | cladistic_matrix = day_2016, 65 | time_tree = day_2016tree, 66 | time_bins = time_bins, 67 | plot = TRUE 68 | ) 69 | } 70 | \author{ 71 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 72 | } 73 | -------------------------------------------------------------------------------- /R/date_nodes.R: -------------------------------------------------------------------------------- 1 | #' Returns node ages for a time-scaled tree 2 | #' 3 | #' @description 4 | #' 5 | #' Given a tree with branch-lengths scaled to time and a value for \code{$root.time} will return a vector of node ages. 6 | #' 7 | #' @param time_tree A tree (phylo object) with branch lengths representing time and a value for \code{$root.time}. 8 | #' 9 | #' @details 10 | #' 11 | #' Returns a vector of node ages (terminal and internal) labelled by their node number. 12 | #' 13 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 14 | #' 15 | #' @examples 16 | #' 17 | #' # Create simple four-taxon tree with edge lengths all 18 | #' # set to 1 Ma: 19 | #' time_tree <- ape::read.tree(text = "(A:1,(B:1,(C:1,D:1):1):1);") 20 | #' 21 | #' # Set root.time as 10 Ma: 22 | #' time_tree$root.time <- 10 23 | #' 24 | #' # Get node ages: 25 | #' date_nodes(time_tree = time_tree) 26 | #' @export date_nodes 27 | date_nodes <- function(time_tree) { 28 | 29 | # Need input checks 30 | 31 | # Get N tips: 32 | n_tips <- ape::Ntip(phy = time_tree) 33 | 34 | # Get N nodes: 35 | n_nodes <- ape::Nnode(phy = time_tree) 36 | 37 | # Store root node number: 38 | root_node <- n_tips + 1 39 | 40 | # If tree is a complete polytomy: 41 | if (time_tree$Nnode == 1) { 42 | 43 | # Create paths for just tips: 44 | paths <- as.list(x = 1:n_tips) 45 | 46 | # Add root to each path: 47 | for (i in 1:length(x = paths)) paths[[i]] <- c(paths[[i]], n_tips + 1) 48 | 49 | # If tree is not a complete polytomy: 50 | } else { 51 | 52 | # Create initial paths list with end nodes (terminal and internal, excluding the root): 53 | paths <- split(c(1:n_tips, (n_tips + 2):(n_tips + n_nodes)), f = 1:(n_tips + time_tree$Nnode - 1)) 54 | 55 | # Strip names: 56 | names(paths) <- NULL 57 | 58 | # For each path: 59 | for (i in 1:length(x = paths)) { 60 | 61 | # Set counter as 1: 62 | j <- 1 63 | 64 | # Identify current node: 65 | current_node <- paths[[i]][j] 66 | 67 | # While current node is not the root (path has not terminated): 68 | while (current_node != root_node) { 69 | 70 | # Update current node and add to path: 71 | current_node <- paths[[i]][j + 1] <- time_tree$edge[match(current_node, time_tree$edge[, 2]), 1] 72 | 73 | # Update counter: 74 | j <- j + 1 75 | } 76 | } 77 | } 78 | 79 | # Create vector to store node ages: 80 | date_nodes <- vector(mode = "numeric", length = n_tips + time_tree$Nnode) 81 | 82 | # For each path: 83 | for (i in 1:length(x = paths)) { 84 | 85 | # Store path lengths from root: 86 | date_nodes[paths[[i]][1]] <- sum(time_tree$edge.length[match(paths[[i]][1:(length(x = paths[[i]]) - 1)], time_tree$edge[, 2])]) 87 | } 88 | 89 | # Subtract path lengths from root time: 90 | date_nodes <- time_tree$root.time - date_nodes 91 | 92 | # Add node numbers: 93 | names(date_nodes) <- 1:(n_tips + time_tree$Nnode) 94 | 95 | # Return node ages: 96 | return(date_nodes) 97 | } 98 | -------------------------------------------------------------------------------- /R/plot_changes_on_tree.R: -------------------------------------------------------------------------------- 1 | #' Plots character changes on branches 2 | #' 3 | #' @description 4 | #' 5 | #' Plots character changes in boxes on branches. 6 | #' 7 | #' @param character_changes A matrix of character changes. 8 | #' @param time_tree Tree on which character changes occur. 9 | #' @param label_size The size of the text for the barnch labels. Default is 0.5. 10 | #' 11 | #' @details 12 | #' 13 | #' Takes the \code{character_changes} output from \link{test_rates} and plots it on the tree used to generate it. 14 | #' 15 | #' @return A plot of character changes on a tree. 16 | #' 17 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 18 | #' 19 | #' @examples 20 | #' 21 | #' # Set random seed: 22 | #' set.seed(17) 23 | #' 24 | #' # Get first MPT for the Michaux data set: 25 | #' time_tree <- ape::read.tree(text = paste0("(Ancilla:31.6,(Turrancilla:102.7,", 26 | #' "(Ancillista:1,Amalda:63.5):1):1);")) 27 | #' 28 | #' # Set root time for tree: 29 | #' time_tree$root.time <- 103.7 30 | #' 31 | #' # Generate two equal length time bins: 32 | #' time_bins <- matrix(data = c(seq(time_tree$root.time, 0, length.out = 3)[1:2], 33 | #' seq(time_tree$root.time, 0, length.out = 3)[2:3]), ncol = 2, dimnames = list(LETTERS[1:2], 34 | #' c("fad", "lad"))) 35 | #' 36 | #' # Set class as timeBins: 37 | #' class(time_bins) <- "timeBins" 38 | #' 39 | #' # Get discrete character rates (includes changes): 40 | #' out <- test_rates( 41 | #' time_tree = time_tree, 42 | #' cladistic_matrix = michaux_1989, 43 | #' time_bins = time_bins, 44 | #' branch_partitions = list(list(1)), 45 | #' alpha = 0.01 46 | #' ) 47 | #' 48 | #' # Plot character changes on the tree: 49 | #' plot_changes_on_tree( 50 | #' character_changes = out$inferred_character_changes, 51 | #' time_tree = time_tree 52 | #' ) 53 | #' @export plot_changes_on_tree 54 | plot_changes_on_tree <- function(character_changes, time_tree, label_size = 0.5) { 55 | 56 | # Update tree edge lengths to number of character changes: 57 | time_tree$edge.length <- rle(sort(x = c(character_changes[, "edge"], 1:nrow(time_tree$edge))))$lengths - 0.5 58 | 59 | # Create empty edge labels vector: 60 | edge_labels <- rep(NA, nrow(time_tree$edge)) 61 | 62 | # For each edge: 63 | for (i in 1:nrow(time_tree$edge)) { 64 | 65 | # Get rows for where changes occur: 66 | change_rows <- which(x = character_changes[, "edge"] == i) 67 | 68 | # If there are changes on edge: 69 | if (length(x = change_rows) > 0) { 70 | 71 | # Compile all changes into edge label: 72 | edge_labels[i] <- paste(paste(character_changes[change_rows, "character"], ": ", character_changes[change_rows, "from"], " -> ", character_changes[change_rows, "to"], sep = ""), collapse = "\n") 73 | } 74 | } 75 | 76 | # ADD DOT DOT DOT..... 77 | 78 | # Plot tree: 79 | plot(time_tree, direction = "upwards") 80 | 81 | # Add edge labels for changes: 82 | edgelabels(text = edge_labels, bg = "white", cex = label_size) 83 | 84 | # NEED TO LADDERISE LEFT IF WRITING ON RIGHT OF BRANCHES... 85 | } 86 | -------------------------------------------------------------------------------- /R/find_unique_trees.r: -------------------------------------------------------------------------------- 1 | #' Finds only the unique topologies amongst a set 2 | #' 3 | #' @description 4 | #' 5 | #' Given a set of trees with the same tip labels, returns just the unique topologies present. 6 | #' 7 | #' @param trees An object of class \code{multiPhylo}. 8 | #' 9 | #' @details 10 | #' 11 | #' Where labelled topologies are generated randomly or modified by (e.g.) removing a tip, it may be useful to isolate just those that are truly unique. The \code{ape} package already has a function for this (\link[ape]{unique.multiPhylo}), but it can be slow when the number of trees is large. This function is thus intended as a faster version. 12 | #' 13 | #' The function works by breaking down a tree into its' component bipartitions and treating the combination of these as the definition of the tree. It thus escapes problems due to the principle of free rotation. Specifically, these two trees are actually identical: 14 | #' 15 | #' \preformatted{A B C D E 16 | #' \/ \ \/ 17 | #' \ \ / 18 | #' \ \/ 19 | #' \ / 20 | #' \ / 21 | #' \/ 22 | #' 23 | #' B A D E C 24 | #' \/ \/ / 25 | #' \ \ / 26 | #' \ \/ 27 | #' \ / 28 | #' \ / 29 | #' \/} 30 | #' 31 | #' This becomes clearer if we decompose them into their bipartitions: 32 | #' 33 | #' AB, DE, CDE, ABCDE 34 | #' 35 | #' These correspond to the descendants of each internal node (branching point) and the last one is actually ignored (the root node) as it will be present in any tree. 36 | #' 37 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 38 | #' 39 | #' @return 40 | #' 41 | #' An object of class \code{"multiPhylo"}. 42 | #' 43 | #' @seealso 44 | #' 45 | #' \link[ape]{unique.multiPhylo} 46 | #' 47 | #' @examples 48 | #' 49 | #' # Make a set of three identical trees (differing only in "rotation" of nodes): 50 | #' trees <- ape::read.tree(text = c( 51 | #' "((A,B),(C,(D,E)));", 52 | #' "((C,(D,E)),(A,B));", 53 | #' "((B,A),(C,(E,D)));") 54 | #' ) 55 | #' 56 | #' # Show that there is only one unique tree: 57 | #' find_unique_trees(trees = trees) 58 | #' 59 | #' @export find_unique_trees 60 | find_unique_trees <- function(trees) { 61 | 62 | # Checks to add: 63 | # - trees should be multiPhylo 64 | # - trees should have same tip labels 65 | 66 | # Get number of tips (assumes all trees have same tips): 67 | n_tips <- ape::Ntip(trees[[1]]) 68 | 69 | # Return just unique topologies: 70 | trees[!duplicated( 71 | x = unlist( 72 | x = lapply( 73 | X = trees, 74 | FUN = function(tree) { 75 | paste(sort( 76 | x = unlist(x = lapply( 77 | X = as.list(x = n_tips + 2:tree$Nnode), 78 | FUN = function(node) { 79 | paste(sort(x = tree$tip.label[strap::FindDescendants( 80 | n = node, 81 | tree = tree 82 | )]), collapse = "%%") 83 | } 84 | )) 85 | ), collapse = "&&") 86 | } 87 | ) 88 | ) 89 | )] 90 | } 91 | -------------------------------------------------------------------------------- /man/Claddis-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Claddis-package.R 3 | \docType{package} 4 | \name{Claddis-package} 5 | \alias{Claddis-package} 6 | \alias{Claddis} 7 | \title{Measuring Morphological Diversity and Evolutionary Tempo 8 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 9 | Measures morphological diversity from discrete character data and estimates evolutionary tempo on phylogenetic trees.} 10 | \description{ 11 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 12 | 13 | Measures morphological diversity from discrete character data and estimates evolutionary tempo on phylogenetic trees. Imports morphological data from #NEXUS (Maddison et al. (1997) \doi{10.1093/sysbio/46.4.590}) format with read_nexus_matrix(), and writes to both #NEXUS and TNT format (Goloboff et al. (2008) \doi{10.1111/j.1096-0031.2008.00217.x}). Main functions are test_rates(), which implements AIC and likelihood ratio tests for discrete character rates introduced across Lloyd et al. (2012) \doi{10.1111/j.1558-5646.2011.01460.x}, Brusatte et al. (2014) \doi{10.1016/j.cub.2014.08.034}, Close et al. (2015) \doi{10.1016/j.cub.2015.06.047}, and Lloyd (2016) \doi{10.1111/bij.12746}, and calculate_morphological_distances(), which implements multiple discrete character distance metrics from Gower (1971) \doi{10.2307/2528823}, Wills (1998) \doi{10.1006/bijl.1998.0255}, Lloyd (2016) \doi{10.1111/bij.12746}, and Hopkins and St John (2018) \doi{10.1098/rspb.2018.1784}. This also includes the GED correction from Lehmann et al. (2019) \doi{10.1111/pala.12430}. Multiple functions implement morphospace plots: plot_chronophylomorphospace() implements Sakamoto and Ruta (2012) \doi{10.1371/journal.pone.0039752}, plot_morphospace() implements Wills et al. (1994) \doi{10.1017/S009483730001263X}, plot_changes_on_tree() implements Wang and Lloyd (2016) \doi{10.1098/rspb.2016.0214}, and plot_morphospace_stack() implements Foote (1993) \doi{10.1017/S0094837300015864}. Other functions include safe_taxonomic_reduction(), which implements Wilkinson (1995) \doi{10.1093/sysbio/44.4.501}, map_dollo_changes() implements the Dollo stochastic character mapping of Tarver et al. (2018) \doi{10.1093/gbe/evy096}, and estimate_ancestral_states() implements the ancestral state options of Lloyd (2018) \doi{10.1111/pala.12380}. calculate_tree_length() and reconstruct_ancestral_states() implements the generalised algorithms from Swofford and Maddison (1992; no doi). 14 | } 15 | \examples{ 16 | 17 | # Get morphological distances for Michaux (1989) data set: 18 | distances <- calculate_morphological_distances(cladistic_matrix = michaux_1989) 19 | 20 | # Show distances: 21 | distances 22 | } 23 | \references{ 24 | Lloyd, G. T., 2016. Estimating morphological diversity and tempo with discrete character-taxon matrices: implementation, challenges, progress, and future directions. \emph{Biological Journal of the Linnean Society}, \bold{118}, 131-151. 25 | } 26 | \author{ 27 | Graeme T. Lloyd 28 | } 29 | -------------------------------------------------------------------------------- /R/Claddis-package.R: -------------------------------------------------------------------------------- 1 | # devtools::build_win(version = "R-devel") 2 | 3 | #' Measuring Morphological Diversity and Evolutionary Tempo 4 | #' \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 5 | #' Measures morphological diversity from discrete character data and estimates evolutionary tempo on phylogenetic trees. 6 | #' 7 | #' @name Claddis-package 8 | #' 9 | #' @aliases Claddis 10 | #' 11 | #' @docType package 12 | #' 13 | #' @author Graeme T. Lloyd 14 | #' 15 | #' @references 16 | #' 17 | #' Lloyd, G. T., 2016. Estimating morphological diversity and tempo with discrete character-taxon matrices: implementation, challenges, progress, and future directions. \emph{Biological Journal of the Linnean Society}, \bold{118}, 131-151. 18 | #' 19 | #' @examples 20 | #' 21 | #' # Get morphological distances for Michaux (1989) data set: 22 | #' distances <- calculate_morphological_distances(cladistic_matrix = michaux_1989) 23 | #' 24 | #' # Show distances: 25 | #' distances 26 | #' @exportPattern "^[[:alpha:]]+" 27 | #' @import ape 28 | #' @import phytools 29 | #' @import strap 30 | 31 | 32 | #' @importFrom clipr write_clip 33 | #' @importFrom geoscale geoscalePlot 34 | #' @importFrom graphics layout legend lines par plot points polygon text 35 | #' @importFrom grDevices adjustcolor chull hcl.colors rgb 36 | #' @importFrom methods hasArg 37 | # @importFrom rgl plot3d lines3d points3d text3d view3d # Still breaks Claddis so moved to suggests for now 38 | #' @importFrom stats as.dist dist dpois pchisq runif var 39 | #' @importFrom utils combn 40 | NULL 41 | 42 | #' Character-taxon matrix from Day et al. 2016 43 | #' 44 | #' The character-taxon matrix from Day et al. (2016). 45 | #' 46 | #' @name day_2016 47 | #' @docType data 48 | #' @format A character-taxon matrix in the format imported by \link{read_nexus_matrix}. 49 | #' @references Day, M. O., Rubidge, B. S. and Abdala, F., 2016. A new mid-Permian burnetiamorph therapsid from the Main Karoo Basin of South Africa and a phylogenetic review of Burnetiamorpha. \emph{Acta Palaeontologica Polonica}, \bold{61}, 701-719. 50 | #' @keywords datasets 51 | NULL 52 | 53 | #' Character-taxon matrix from Gauthier 1986 54 | #' 55 | #' The character-taxon matrix from Gauthier (1986). 56 | #' 57 | #' @name gauthier_1986 58 | #' @docType data 59 | #' @format A character-taxon matrix in the format imported by \link{read_nexus_matrix}. 60 | #' @references Gauthier, J. A., 1986. Saurischian monophyly and the origin of birds. In Padian, K. (ed.) \emph{The Origin of Birds and the Evolution of Flight}. Towne and Bacon, San Francisco, CA, United States, 1-55. 61 | #' @keywords datasets 62 | NULL 63 | 64 | #' Character-taxon matrix from Michaux 1989 65 | #' 66 | #' The character-taxon matrix from Michaux (1989). 67 | #' 68 | #' @name michaux_1989 69 | #' @docType data 70 | #' @format A character-taxon matrix in the format imported by 71 | #' \link{read_nexus_matrix}. 72 | #' @references Michaux, B., 1989. Cladograms can reconstruct phylogenies: an example from the fossil record. \emph{Alcheringa}, \bold{13}, 21-36. 73 | #' @keywords datasets 74 | NULL 75 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Claddis 2 | 3 | Claddis is an R package designed to import cladistic-type data sets (#NEXUS format) into R and perform disparity analysis and rate tests. 4 | 5 | # Package status 6 | 7 | 8 | [![R-CMD-check](https://github.com/graemetlloyd/Claddis/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/graemetlloyd/Claddis/actions/workflows/R-CMD-check.yaml) 9 | 10 | ### CRAN [![minimal R version](https://img.shields.io/badge/R%3E%3D-3.5.0-6666ff.svg)](https://cran.r-project.org/) [![cran version](https://www.r-pkg.org/badges/version/Claddis)](https://cran.r-project.org/package=Claddis) [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/grand-total/Claddis)](https://github.com/r-hub/cranlogs.app) ![](http://cranlogs.r-pkg.org/badges/Claddis) 11 | 12 | 13 | # Version 14 | 15 | Claddis is on [CRAN](https://cran.r-project.org/package=Claddis) (version 0.6.3) but is also being developed on GitHub. To get the absolute latest version you can use: 16 | 17 | ```r 18 | if(!require(devtools)) install.packages("devtools", dependencies = TRUE) 19 | devtools::install_github("graemetlloyd/Claddis", ref = "master") 20 | ``` 21 | 22 | However, installing a development version of a package is only recommended for expert users. 23 | 24 | Please also consult the CHANGELOG file for all updates (including new functions, features and bug fixes) to Claddis. 25 | 26 | # Installation 27 | 28 | You can install Claddis in R via CRAN with: 29 | 30 | ```r 31 | install.packages("Claddis", dependencies = TRUE) 32 | ``` 33 | 34 | Or from GitHub with: 35 | 36 | ```r 37 | if(!require(devtools)) install.packages("devtools", dependencies = TRUE) 38 | devtools::install_github("graemetlloyd/Claddis", ref = "CRAN") 39 | ``` 40 | 41 | And load it into memory using: 42 | 43 | ```r 44 | library(Claddis) 45 | ``` 46 | 47 | # Help 48 | 49 | Basic help can be found with: 50 | 51 | ```r 52 | ?Claddis 53 | ``` 54 | 55 | And clicking on the Index link at the base of the help file will reveal links to every available function. 56 | 57 | # Tutorials 58 | 59 | Note that I have previously linked to tutorials for the package here, but substantial reworking of the core code means these will no longer work and so currently the example code in each function's help file is the best substitute for this. New tutorials will eventually be produced and shared here. 60 | 61 | Users should also be aware of the [dispRity](https://cran.r-project.org/package=dispRity) R package, that can form the end of a Claddis disparity pipeline. 62 | 63 | # Citation 64 | 65 | The first formal paper describing Claddis was published as Lloyd (2016): 66 | 67 | Lloyd, G. T., 2016. Estimating morphological diversity and tempo with discrete character-taxon matrices: implementation, challenges, progress, and future directions. *Biological Journal of the Linnean Society*, **118**, 131-151. 68 | 69 | The effects of ancestral state estimation choices on phylomorphospaces was discussed in Lloyd (2018): 70 | 71 | Lloyd, G. T., 2018. Journeys through discrete-character morphospace: synthesizing phylogeny, tempo, and disparity. *Palaeontology*, **61**, 637-645. 72 | -------------------------------------------------------------------------------- /R/check_taxonGroups.R: -------------------------------------------------------------------------------- 1 | #' Check taxonGroups object for errors 2 | #' 3 | #' @description 4 | #' 5 | #' Internal function to check taxonGroups object for errors. 6 | #' 7 | #' @param taxon_groups An object of class \code{taxonGroups}. 8 | #' 9 | #' @details 10 | #' 11 | #' Internal Claddis function. Nothing to see here. Carry on. 12 | #' 13 | #' @return An error message or empty vector if no errors found. 14 | #' 15 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 16 | #' 17 | #' @examples 18 | #' 19 | #' # Create a taxon groups object: 20 | #' taxon_groups <- list( 21 | #' Group_A = c("Species_1", "Species_2", "Species_3"), 22 | #' Group_B = c("Species_3", "Species_4"), 23 | #' Group_C = c("Species_5", "Species_6", "Species_7", "Species_8") 24 | #' ) 25 | #' 26 | #' # Check that this is a valid taxonGroups object (will return error message as class 27 | #' # is not set): 28 | #' check_taxonGroups(taxon_groups = taxon_groups) 29 | #' 30 | #' @export check_taxonGroups 31 | check_taxonGroups <- function(taxon_groups) { 32 | 33 | # Check taxon_groups has class taxonGroups and add error message to output if true: 34 | if (!inherits(x = taxon_groups, what = "taxonGroups")) return("taxon_groups must be an object of class \"taxonGroups\".") 35 | 36 | # Check taxon_groups are in form of list add error message to output if false: 37 | if (!is.list(x = taxon_groups)) return("taxon_groups must be in the form of a list.") 38 | 39 | # Check taxon_groups has at least one group: 40 | if (length(x = taxon_groups) == 0) return("taxon_groups must have at least one element.") 41 | 42 | # Check taxon_groups collectively contains at least one taxon: 43 | if (all(x = !unlist(x = lapply(X = taxon_groups, FUN = function(x) length(x = x))) > 0)) return("taxon_groups must have at least one element containing taxa.") 44 | 45 | # Check group names are set: 46 | if (is.null(x = names(x = taxon_groups))) return("taxon_groups must have names set for each group.") 47 | 48 | # Check group names are all unique: 49 | if (any(x = duplicated(x = names(x = taxon_groups)))) return("taxon_groups must have unique group names.") 50 | 51 | # Check group names are not empty strings: 52 | if (any(x = nchar(x = names(x = taxon_groups)) == 0)) return("taxon_groups must have group names of positive length.") 53 | 54 | # Check taxa are in form of vectors: 55 | if (any(x = !unlist(x = lapply(X = taxon_groups, FUN = function(x) is.vector(x = x))))) return("taxon_groups must be composed of vectors of taxon names.") 56 | 57 | # Check taxa are vaid character formats: 58 | if (any(!unlist(x = lapply(X = taxon_groups, FUN = function(x) is.character(x = x))))) return("taxon_groups must be composed of character vectors.") 59 | 60 | # Check no taxa are duplicated within groups: 61 | if (any(x = unlist(x = lapply(X = taxon_groups, FUN = function(x) duplicated(x = x))))) return("taxon_groups must not contain duplicated taxa within groups.") 62 | 63 | # Check no taxa are empty strings: 64 | if (any(unlist(x = lapply(X = taxon_groups, FUN = function(x) nchar(x = x))) == 0)) return("taxon_groups must contain taxon anmes of positive length.") 65 | 66 | # Return empty vector: 67 | vector(mode = "character") 68 | } 69 | -------------------------------------------------------------------------------- /man/permute_costmatrices.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permute_costmatrices.r 3 | \name{permute_costmatrices} 4 | \alias{permute_costmatrices} 5 | \title{Permute costmatrices} 6 | \usage{ 7 | permute_costmatrices(states = c("0", "1"), costs = c(1:3), symmetry = "both") 8 | } 9 | \arguments{ 10 | \item{states}{A vector of character states, e.g., "0", "1", "2".} 11 | 12 | \item{costs}{A vector of numeric costs, e.g., 1, 2, Inf.} 13 | 14 | \item{symmetry}{Must be one of \code{"symmetric"}, \code{"asymmetric"} or \code{"both"}.} 15 | } 16 | \value{ 17 | A list of unique costmatrices containing every possible combination of costs. 18 | } 19 | \description{ 20 | Given vectors of states and costs, permutes all possible costmatrices. 21 | } 22 | \details{ 23 | Costmatrices define the cost of each state-to-state transition, but they are restricted in what these costs can be (see \link{check_costMatrix}). Nevertheless, strictly speaking there are infinite possible costmatrices - even where costs are restricted to integer values (as TNT does; Goloboff et al. 2008; Goloboff and Catalano 2016), i.e., "stepmatrices" (Swofford and Maddison 1992). Thus this function operates on a finite system by requiring the user to specify a restricted set of states and individual cost values, with the function permuting every possible combination of finite costs. Note that not \emph{every} permutation will be returned as not all of these will be valid costmatrices (see \link{check_costMatrix} and \link{fix_costmatrix}). Others will not be returned because their cost \emph{ratio} can be considered redundant. For example, for a binary character (states "0", and "1") the following two costmatrices would be mutually redundant as the ratio of their costs is identical: 24 | 25 | \preformatted{ A B 26 | A 0 1 27 | B 2 0 28 | 29 | A B 30 | A 0 2 31 | B 4 0} 32 | 33 | (If the user does want to consider these kinds of alternatives then a better solution is to simply weight the first matrix by two, or any other value, in any downstream analys(es).) 34 | 35 | For the function to work costs must be unique positive values. This includes infinity (\code{Inf} in R). Infinite costs can be used to denote a particular transition is impossible and allows defining (e.g.) irreversible characters, or those that force a particular root value. 36 | } 37 | \examples{ 38 | 39 | # Permute all the ways to assign the costs 1 and 2 for a three state 40 | # character: 41 | permute_costmatrices( 42 | states = c("0", "1", "2"), 43 | costs = c(1, 2), 44 | symmetry = "both" 45 | ) 46 | 47 | } 48 | \references{ 49 | Goloboff, P. A. and Catalano, S. A., 2016. TNT version 1.5, including a full implementation of phylogenetic morphometrics/ \emph{Cladistics}, \bold{32}. 221-238 50 | 51 | Goloboff, P., Farris, J. and Nixon, K., 2008. TNT, a free program for phylogenetic analysis. \emph{Cladistics}, \bold{24}, 774-786. 52 | 53 | Swofford, D. L. and Maddison, W. P., 1992. Parsimony, character-state reconstructions, and evolutionary inferences. \emph{In} R. L. Mayden (ed.) Systematics, Historical Ecology, and North American Freshwater Fishes. Stanford University Press, Stanford, p187-223. 54 | } 55 | \author{ 56 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 57 | } 58 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: Claddis 2 | Type: Package 3 | Title: Measuring Morphological Diversity and Evolutionary Tempo 4 | Version: 0.7.0 5 | Date: 2024-09-01 6 | Authors@R: c( 7 | person(given = "Graeme T.", family = "Lloyd", 8 | email = "graemetlloyd@gmail.com", role = c("aut", "cre", "cph")), 9 | person(given = "Thomas", family = "Guillerme", role = c("aut", "cph")), 10 | person(given = "Jen", family = "Hoyal Cuthill", role = c("aut", "cph")), 11 | person(given = "Emma", family = "Sherratt", role = c("aut", "cph")), 12 | person(given = "Steve C.", family = "Wang", role = c("aut", "cph")) 13 | ) 14 | Maintainer: Graeme T. Lloyd 15 | Depends: 16 | ape, 17 | phytools, 18 | strap, 19 | R (>= 3.5.0) 20 | Imports: 21 | clipr, 22 | geoscale, 23 | graphics, 24 | grDevices, 25 | methods, 26 | multicool, 27 | partitions, 28 | stats, 29 | utils 30 | Suggests: 31 | rgl, 32 | testthat 33 | Description: Measures morphological diversity from discrete character data and 34 | estimates evolutionary tempo on phylogenetic trees. Imports morphological 35 | data from #NEXUS (Maddison et al. (1997) ) 36 | format with read_nexus_matrix(), and writes to both #NEXUS and TNT format 37 | (Goloboff et al. (2008) ). Main 38 | functions are test_rates(), which implements AIC and likelihood 39 | ratio tests for discrete character rates introduced across Lloyd et al. 40 | (2012) , Brusatte et al. (2014) 41 | , Close et al. (2015) 42 | , and Lloyd (2016) , 43 | and calculate_morphological_distances(), which implements multiple discrete 44 | character distance metrics from Gower (1971) , Wills 45 | (1998) , Lloyd (2016) , 46 | and Hopkins and St John (2018) . This also 47 | includes the GED correction from Lehmann et al. (2019) 48 | . Multiple functions implement morphospace plots: 49 | plot_chronophylomorphospace() implements Sakamoto and Ruta (2012) 50 | , plot_morphospace() implements Wills et 51 | al. (1994) , plot_changes_on_tree() 52 | implements Wang and Lloyd (2016) , and 53 | plot_morphospace_stack() implements Foote (1993) 54 | . Other functions include 55 | safe_taxonomic_reduction(), which implements Wilkinson (1995) 56 | , map_dollo_changes() implements 57 | the Dollo stochastic character mapping of Tarver et al. (2018) 58 | , and estimate_ancestral_states() implements 59 | the ancestral state options of Lloyd (2018) . 60 | calculate_tree_length() and reconstruct_ancestral_states() implements 61 | the generalised algorithms from Swofford and Maddison (1992; no doi). 62 | Encoding: UTF-8 63 | License: GPL (>=2) 64 | LazyData: yes 65 | ByteCompile: yes 66 | RoxygenNote: 7.3.1 67 | -------------------------------------------------------------------------------- /man/build_cladistic_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/build_cladistic_matrix.R 3 | \name{build_cladistic_matrix} 4 | \alias{build_cladistic_matrix} 5 | \title{Creates a morphological data file from a matrix} 6 | \usage{ 7 | build_cladistic_matrix( 8 | character_taxon_matrix, 9 | header = "", 10 | character_weights = NULL, 11 | ordering = NULL, 12 | symbols = NULL, 13 | equalise.weights = FALSE, 14 | ignore_duplicate_taxa = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{character_taxon_matrix}{A Character-Taxon (columns-rows) matrix, with taxon names as rownames.} 19 | 20 | \item{header}{A scalar indicating any header text (defaults to an empty string: "").} 21 | 22 | \item{character_weights}{A vector specifying the weights used (if not specified defaults to 1).} 23 | 24 | \item{ordering}{A vector indicating whether characters are ordered (\code{"ordered"}) or unordered (\code{"unordered"}) (if no specified defaults to ordered).} 25 | 26 | \item{symbols}{The symbols to use if writing to a file (defaults to the numbers 0:9 then the letters A to V).} 27 | 28 | \item{equalise.weights}{Optional that overrides the weights specified above make all characters truly equally weighted.} 29 | 30 | \item{ignore_duplicate_taxa}{Logical indicating whether or not to ignore (allow; TRUE) duplicate taxa or not (FALSE; default).} 31 | } 32 | \value{ 33 | \item{topper}{Contains any header text or costmatrices and pertains to the entire file.} 34 | \item{matrix_N}{One or more matrix blocks (numbered 1 to N) with associated information pertaining only to that matrix block. This includes the block name (if specificed, NA if not), the block datatype (one of "CONTINUOUS", "DNA", "NUCLEOTIDE", "PROTEIN", "RESTRICTION", "RNA", or "STANDARD"), the actual matrix (taxa as rows, names stored as rownames and characters as columns), the ordering type of each character (\code{"ordered"}, \code{"unordered"} etc.), the character weights, the minimum and maximum values (used by Claddis' distance functions), and the original characters (symbols, missing, and gap values) used for writing out the data.} 35 | } 36 | \description{ 37 | Creates a morphological data file from a character-taxon matrix. 38 | } 39 | \details{ 40 | Claddis generally assumes that matrices will be imported into R from the #NEXUS format, but in some cases (e.g., when using simulated data) it might be desirable to build a matrix within R. This function allows the user to convert such a matrix into the format required by other Claddis functions as long as it only contains a single block. 41 | 42 | NB: Currently the function cannot deal directly with costmatrices or continuous characters. 43 | } 44 | \examples{ 45 | 46 | # Create random 10-by-50 matrix: 47 | character_taxon_matrix <- matrix(sample(c("0", "1", "0&1", NA, ""), 48 | 500, 49 | replace = TRUE 50 | ), 51 | nrow = 10, dimnames = 52 | list(apply(matrix(sample(LETTERS, 40, 53 | replace = TRUE 54 | ), nrow = 10), 1, paste, 55 | collapse = "" 56 | ), c()) 57 | ) 58 | 59 | # Reformat for use elsewhere in Claddis: 60 | build_cladistic_matrix(character_taxon_matrix) 61 | } 62 | \seealso{ 63 | \link{compactify_cladistic_matrix}, \link{prune_cladistic_matrix}, \link{read_nexus_matrix}, \link{safe_taxonomic_reduction}, \link{write_nexus_matrix}, \link{write_tnt_matrix} 64 | } 65 | \author{ 66 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 67 | } 68 | -------------------------------------------------------------------------------- /R/calculate_WMPD.R: -------------------------------------------------------------------------------- 1 | #' Calculate weighted mean pairwise distances 2 | #' 3 | #' @description 4 | #' 5 | #' Given distanceMatrices and taxonGroups objects calculates their weighted mean pairwise distances. 6 | #' 7 | #' @param distances An object of class \code{distanceMatrices}. 8 | #' @param taxon_groups An object of class \code{taxonGroups}. 9 | #' 10 | #' @details 11 | #' 12 | #' Not all measures of disparity (morphological distance) require an ordination space. For example, the pariwise distances between taxa are themselves a disparity metric. However, due to variable amounts of missing data each pairwise distance should not necessarily be considered equal. Specifically, it could be argued that for a group of taxa the mean distance should be weighted by the number of characters that distance is based on, or more specifically the sum of the weights of those characters (e.g., Close et al. 2015). 13 | #' 14 | #' This function takes the output from \link{calculate_morphological_distances} and a set of taxon groups and returns the weighted mean pairwise distance for those groups. 15 | #' 16 | #' @return 17 | #' 18 | #' A labelled vector of weighted mean pairwise distances. 19 | #' 20 | #' @author Graeme T. Lloyd \email{graemetlloyd@@gmail.com} 21 | #' 22 | #' @references 23 | #' 24 | #' Close, R. A., Friedman, M., Lloyd, G. T. and Benson, R. B. J., 2015. Evidence for a mid-Jurassic adaptive radiation in mammals. \emph{Current Biology}, \bold{25}, 2137-2142. 25 | #' 26 | #' @examples 27 | #' 28 | #' # Get morphological distances for the Day et al. (2016) data set: 29 | #' distances <- calculate_morphological_distances( 30 | #' cladistic_matrix = day_2016, 31 | #' distance_metric = "mord", 32 | #' distance_transformation = "none" 33 | #' ) 34 | #' 35 | #' # Build simple taxonomic groups for Day et al. (2016) data set: 36 | #' taxon_groups <- list(nonBurnetiamorpha = c("Biarmosuchus_tener", "Hipposaurus_boonstrai", 37 | #' "Bullacephalus_jacksoni", "Pachydectes_elsi", "Niuksenitia_sukhonensis", "Ictidorhinus_martinsi", 38 | #' "RC_20", "Herpetoskylax_hopsoni"), Burnetiamorpha = c("Lemurosaurus_pricei", "Lobalopex_mordax", 39 | #' "Lophorhinus_willodenensis", "Proburnetia_viatkensis", "Lende_chiweta", 40 | #' "Paraburnetia_sneeubergensis", "Burnetia_mirabilis", "BP_1_7098")) 41 | #' 42 | #' # Set class as taxonGroups: 43 | #' class(taxon_groups) <- "taxonGroups" 44 | #' 45 | #' # Calculate mean pairiwise distances: 46 | #' calculate_MPD(distances, taxon_groups) 47 | #' 48 | #' # Now calculate weighted mean pairwise distances: 49 | #' calculate_WMPD(distances, taxon_groups) 50 | #' 51 | #' @export calculate_WMPD 52 | calculate_WMPD <- function(distances, taxon_groups) { 53 | 54 | # If not a valid taxonGroups object then stop and provide feedback to user on what is wrong: 55 | if (!is.taxonGroups(x = taxon_groups)) stop(check_taxonGroups(taxon_groups = taxon_groups)[1]) 56 | 57 | # Calculate and return weighted mean pairwise distance for each taxon group: 58 | unlist( 59 | x = lapply( 60 | X = taxon_groups, 61 | FUN = function(x) { 62 | sum(x = distances$distance_matrix[x, x][lower.tri(x = distances$distance_matrix[x, x])] * distances$comparable_weights_matrix[x, x][lower.tri(x = distances$comparable_weights_matrix[x, x])], na.rm = TRUE) / sum(x = distances$comparable_weights_matrix[x, x][lower.tri(x = distances$comparable_weights_matrix[x, x])], na.rm = TRUE) 63 | } 64 | ) 65 | ) 66 | } 67 | -------------------------------------------------------------------------------- /workshops/napc2024/data/lungfish_ages.txt: -------------------------------------------------------------------------------- 1 | "FAD","LAD" 2 | "Adololopas_moyasmithae",385.3,374.5 3 | "Adelargo_schultzei",374.5,359.2 4 | "Amadeodipterus_kencampbelli",407,391.8 5 | "Andreyevichthys_epitomus",374.5,359.2 6 | "Aphelodus_anapes",251,245 7 | "Archaeoceratodus_avus",228,216.5 8 | "Archaeonectes_pertusus",385.3,374.5 9 | "Arganodus_atlantis",251,245 10 | "Ariguna_formosa",251,245 11 | "Asiatoceratodus_sharovi",251,245 12 | "Barwickia_downunda",391.8,385.3 13 | "Beltanodus_ambilobensis",251,245 14 | "Ceratodus_formosa",251,245 15 | "Ceratodus_latissimus",228,199.6 16 | "Chirodipterus_australis",385.3,374.5 17 | "Chirodipterus_onawwayensis",391.8,385.3 18 | "Chirodipterus_rhenanus",391.8,385.3 19 | "Chirodipterus_wildungensis",385.3,374.5 20 | "Conchopoma_gadiforme",311.7,306.5 21 | "Ctenodus_romeri",359.2,345.3 22 | "Delatitia_breviceps",359.2,345.3 23 | "Diabolepis_speratus",416,411.2 24 | "Dipnorhynch_cathlesae",407,397.5 25 | "Dipnorhynchus_sussmilchi",407,397.5 26 | "Dipnorhynchus_kiandrensis",407,397.5 27 | "Dipnorhynchus_kurikae",407,397.5 28 | "Dipterus_cf_valenciennesi",385.3,374.5 29 | "Dipterus_valenciennesi",397.5,391.8 30 | "Eoctenodus_microsoma",385.3,374.5 31 | "Ferganoceratodus_jurassicus",161.2,145.5 32 | "Fleurantia_denticulata",385.3,374.5 33 | "Ganopristodus_splendens",345.3,326.4 34 | "Gnathorhiza_serrata",318.1,311.7 35 | "Gogodipterus_paddyensis",385.3,374.5 36 | "Gosfordia_truncata",228,199.6 37 | "Griphognathus_minutidens",385.3,374.5 38 | "Griphognathus_sculpta",385.3,374.5 39 | "Griphognathus_whitei",385.3,374.5 40 | "Grossipterus_crassus",385.3,374.5 41 | "Holodipterus_elderae",385.3,374.5 42 | "Holodipterus_gogoensis",385.3,374.5 43 | "Robinsondipterus_longi",385.3,374.5 44 | "Asthenorhynchus_meemannae",385.3,374.5 45 | "Holodipterus_santacrucensis",385.3,374.5 46 | "Howidipterus_donnae",391.8,385.3 47 | "Ichnomylax_kurnai",407,397.5 48 | "Iowadipterus_halli",391.8,385.3 49 | "Jarvikia_arctica",374.5,359.2 50 | "Jessenia_concentrica",407,397.5 51 | "Lepidosiren_paradoxa",70.6,65.5 52 | "Megapleuron_zangerli",311.7,306.5 53 | "Melanognathus_canadensis",407,397.5 54 | "Metaceratodus_wollastoni",145.5,99.6 55 | "Microceratodus_angolensis",251,245 56 | "Mioceratodus_gregoryi",65.5,23.03 57 | "Namatozodia_pitikanta",251,245 58 | "Neoceratodus_forsteri",112,99.6 59 | "Nielsenia_nordica",374.5,359.2 60 | "Oervigia_nordica",374.5,359.2 61 | "Orlovichthys_limnatis",374.5,359.2 62 | "Palaeodaphus_insignis",385.3,374.5 63 | "Palaeophichthys_parvulus",311.7,306.5 64 | "Paraceratodus_germaini",249.7,247.4 65 | "Parasagenodus_sibiricus",359.2,318.1 66 | "Pentlandia_macroptera",391.8,385.3 67 | "Phaneropleuron_andersoni",374.5,359.2 68 | "Pillararhynchus_longi",385.3,374.5 69 | "Protopterus_annectens",83.5,70.6 70 | "Psarolepis_romeri",418.7,416 71 | "Ptychoceratodus_serratus",251,250.4 72 | "Rhinodipterus_secans",385.3,374.5 73 | "Rhinodipterus_ulrichi",391.8,385.3 74 | "Rhynchodipterus_elginensis",374.5,359.2 75 | "Sagenodus_inaequalis",345.3,326.4 76 | "Scaumenacia_curta",385.3,374.5 77 | "Soederberghia_groenlandica",385.3,374.5 78 | "Sorbitorhynchus_deleaskitus",407,397.5 79 | "Speonesydrion_iani",411.2,407 80 | "Stomiahykus_thlaodus",397.5,391.8 81 | "Straitonia_waterstoni",345.3,326.4 82 | "Sunwapta_grandiceps",374.5,359.2 83 | "Tarachomylax_oepiki",407,397.5 84 | "Tellerodus_sturi",216.5,203.6 85 | "Tranodis_castrensis",326.4,318.1 86 | "Uranolophus_wyomingensis",411.2,407 87 | "Westollrhynchus_lehmanni",411.2,407 88 | -------------------------------------------------------------------------------- /man/plot_rates_character.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_rates_character.R 3 | \name{plot_rates_character} 4 | \alias{plot_rates_character} 5 | \title{Visualize a rate test time series} 6 | \usage{ 7 | plot_rates_character(test_rates_output, model_number, ...) 8 | } 9 | \arguments{ 10 | \item{test_rates_output}{Rate output from \link{test_rates}.} 11 | 12 | \item{model_number}{The number of the model you wish to visualise from the rate output.} 13 | 14 | \item{...}{Other options to be passed to \link{plot}.} 15 | } 16 | \value{ 17 | Nothing is returned, but a plot is produced. 18 | } 19 | \description{ 20 | Given the results from a rates test produces a time series visualization for a specific model. 21 | } 22 | \details{ 23 | The raw output from \link{test_rates} can be difficult to interpret without visualization and this function provides a means for doing that when the desired output is a time series (other functions will be added for other types of rate test). 24 | 25 | The function will only work for a single model, but in practice the user may wish to produce multiple plots in which case they simply need to rn the function multiple times or setup a multipanel window first with \link{layout}, or similar. 26 | 27 | Plots use the \link[geoscale]{geoscale} package to add a geologic time to the x-axis and interested users should consult the documentation there for a full list of options (passed via ...) in the function (see example below). 28 | 29 | Calculated rates (changes per lineage million years) are plotted as filled circles and models are plotted as horizontal lines labelled by rate parameters (lambda 1, lmabda 2 etc.). 30 | } 31 | \examples{ 32 | 33 | \donttest{ 34 | # Make time-scaled first MPT for Day 2016 data set: 35 | time_tree <- ape::read.tree(text = paste0("(Biarmosuchus_tener:0.5,", 36 | "(((Hipposaurus_boonstrai:3.5,(Bullacephalus_jacksoni:0.75,", 37 | "Pachydectes_elsi:0.75):0.75):0.75,(Lemurosaurus_pricei:7.166666667,", 38 | "(Lobalopex_mordax:4.333333333,((Lophorhinus_willodenensis:3.666666667,", 39 | "(Proburnetia_viatkensis:0.8333333333,(Lende_chiweta:2,", 40 | "(Paraburnetia_sneeubergensis:1,Burnetia_mirabilis:2):1):1.833333333)", 41 | ":0.8333333333):0.8333333333,(BP_1_7098:2.25,Niuksenitia_sukhonensis:", 42 | "1.25):1.25):0.8333333333):0.8333333333):3.083333333):1.95,", 43 | "(Ictidorhinus_martinsi:15.9,(RC_20:11.6,(Herpetoskylax_hopsoni:11.3,", 44 | "Lycaenodon_longiceps:0.3):0.3):0.3):0.3):0.3);")) 45 | 46 | # Add root age to tree: 47 | time_tree$root.time <- 269.5 48 | 49 | # Prune continuous block from day 2016: 50 | cladistic_matrix <- prune_cladistic_matrix( 51 | cladistic_matrix = day_2016, 52 | blocks2prune = 1 53 | ) 54 | 55 | # Generate nine two million year time bins: 56 | time_bins <- matrix(data = c(seq(from = 270, to = 252, length.out = 10)[1:9], 57 | seq(from = 270, to = 252, length.out = 10)[2:10]), ncol = 2, 58 | dimnames = list(LETTERS[1:9], c("fad", "lad"))) 59 | 60 | # Set class as timeBins: 61 | class(time_bins) <- "timeBins" 62 | 63 | # Run test rates function for two character partitions: 64 | test_rates_output <- test_rates( 65 | time_tree = time_tree, 66 | cladistic_matrix = cladistic_matrix, 67 | character_partition = list(list(1:34), list(1:17, 18:34)), 68 | time_bins = time_bins 69 | ) 70 | 71 | # Plot 2nd (arbitrary two-partition) character partition model: 72 | plot_rates_character( 73 | test_rates_output = test_rates_output, 74 | model_number = 2 75 | ) 76 | } 77 | } 78 | \author{ 79 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 80 | } 81 | -------------------------------------------------------------------------------- /man/plot_rates_time.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_rates_time.R 3 | \name{plot_rates_time} 4 | \alias{plot_rates_time} 5 | \title{Visualize a rate test time series} 6 | \usage{ 7 | plot_rates_time(test_rates_output, model_number, ...) 8 | } 9 | \arguments{ 10 | \item{test_rates_output}{Rate output from \link{test_rates}.} 11 | 12 | \item{model_number}{The number of the model you wish to visualise from the rate output.} 13 | 14 | \item{...}{Other options to be passed to \link[geoscale]{geoscalePlot}.} 15 | } 16 | \value{ 17 | Nothing is returned, but a plot is produced. 18 | } 19 | \description{ 20 | Given the results from a rates test produces a time series visualization for a specific model. 21 | } 22 | \details{ 23 | The raw output from \link{test_rates} can be difficult to interpret without visualization and this function provides a means for doing that when the desired output is a time series (other functions will be added for other types of rate test). 24 | 25 | The function will only work for a single model, but in practice the user may wish to produce multiple plots in which case they simply need to rn the function multiple times or setup a multipanel window first with \link{layout}, or similar. 26 | 27 | Plots use the \link[geoscale]{geoscale} package to add geologic time to the x-axis and interested users should consult the documentation tere for a full ist of options (passed via ...) in the function (see example below). 28 | 29 | Calculated rates (changes per lineage million years) are plotted as filled circles and models are plotted as horizontal lines labelled by rate parameters (lambda_i). 30 | } 31 | \examples{ 32 | 33 | \donttest{ 34 | # Make time-scaled first MPT for Day 2016 data set: 35 | time_tree <- ape::read.tree(text = paste0("(Biarmosuchus_tener:0.5,", 36 | "(((Hipposaurus_boonstrai:3.5,(Bullacephalus_jacksoni:0.75,", 37 | "Pachydectes_elsi:0.75):0.75):0.75,(Lemurosaurus_pricei:7.166666667,", 38 | "(Lobalopex_mordax:4.333333333,((Lophorhinus_willodenensis:3.666666667,", 39 | "(Proburnetia_viatkensis:0.8333333333,(Lende_chiweta:2,", 40 | "(Paraburnetia_sneeubergensis:1,Burnetia_mirabilis:2):1):1.833333333)", 41 | ":0.8333333333):0.8333333333,(BP_1_7098:2.25,Niuksenitia_sukhonensis:", 42 | "1.25):1.25):0.8333333333):0.8333333333):3.083333333):1.95,", 43 | "(Ictidorhinus_martinsi:15.9,(RC_20:11.6,(Herpetoskylax_hopsoni:11.3,", 44 | "Lycaenodon_longiceps:0.3):0.3):0.3):0.3):0.3);")) 45 | 46 | # Add root age to tree: 47 | time_tree$root.time <- 269.5 48 | 49 | # Prune continuous block from day 2016: 50 | cladistic_matrix <- prune_cladistic_matrix( 51 | cladistic_matrix = day_2016, 52 | blocks2prune = 1 53 | ) 54 | 55 | # Generate nine two million year time bins: 56 | time_bins <- matrix(data = c(seq(from = 270, to = 252, length.out = 10)[1:9], 57 | seq(from = 270, to = 252, length.out = 10)[2:10]), ncol = 2, 58 | dimnames = list(LETTERS[1:9], c("fad", "lad"))) 59 | 60 | # Set class as timeBins: 61 | class(time_bins) <- "timeBins" 62 | 63 | # Run test rates function for each time bin partition: 64 | test_rates_output <- test_rates( 65 | time_tree = time_tree, 66 | cladistic_matrix = cladistic_matrix, 67 | time_partitions = partition_time_bins(n_time_bins = 9), 68 | time_bins = time_bins 69 | ) 70 | 71 | # Plot 97th time bin partition model: 72 | plot_rates_time( 73 | test_rates_output = test_rates_output, 74 | model_number = 97, units = "Stage", cex.ts = 1, cex.age = 1, 75 | abbrev = "Stage" 76 | ) 77 | } 78 | } 79 | \author{ 80 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 81 | } 82 | -------------------------------------------------------------------------------- /man/fix_costmatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fix_costmatrix.R 3 | \name{fix_costmatrix} 4 | \alias{fix_costmatrix} 5 | \title{Fixes a costmatrix that has inconsistent costs} 6 | \usage{ 7 | fix_costmatrix(costmatrix, message = TRUE) 8 | } 9 | \arguments{ 10 | \item{costmatrix}{A costMatrix object.} 11 | 12 | \item{message}{A logical indicating whether messages should be output (defaults to \code{TRUE}).} 13 | } 14 | \value{ 15 | A costMatrix object with self-consistent transition costs. 16 | } 17 | \description{ 18 | Given a costmatrix where transition costs are not self-consistent finds and returns a costmatrix that does. 19 | } 20 | \details{ 21 | A user may wish to consider a complicated set of transition costs between states when modelling discrete character evolution. This can be achieved with a custom costmatrix in Claddis (and elsewhere). However, some caution is urged when using such matrices to ensure that these costs are \emph{self-consistent} (Maddison and Maddison 2003). More specifically, no direct state-to-state transition cost should be greater than is possible with an indirect path via one or more intermediate states. 22 | 23 | This function offers a solution through an algorithm that will iteratively alter a costmatrix until all direct transition costs are self-consistent. It does so by finding the shortest state-to-state path for all possible transitions using the \link{find_shortest_costmatrix_path} function. Because the first solution may itself be inconsistent (as it relied on costs that have since updated) the algorithm is repeated until an equilibrium is reached. (This scenario is unlikely in most real world cases, but may be possible with very large matrices representing many states so was implemented here for safety.) 24 | 25 | Note: infinite costs are allowed in costmatrices but unless they fill entire rows or columns (excluding the diagonal) they will not be self-consistent as there will always be a cheaper indirect cost. 26 | 27 | Note: that both PAUP* (Swofford 2003) TNT (Goloboff et al. 2008; Goloboff and Catalano, 2016) offerthe same correction using the triangle inequality. 28 | 29 | Note: other issues with a costmatrix may arise that are better revealed by using the \link{check_costMatrix} function, which returns informative error messages (with fix suggestions) where issues are found. 30 | } 31 | \examples{ 32 | 33 | # Build a custom costmatrix with non-self consistent path lengths: 34 | costmatrix <- make_costmatrix( 35 | min_state = 0, 36 | max_state = 2, 37 | character_type = "irreversible" 38 | ) 39 | costmatrix$costmatrix[1:9] <- c(0, 2, 4, 1, 0, 3, 5, 3, 0) 40 | costmatrix$symmetry <- "Asymmetric" 41 | costmatrix$type <- "custom" 42 | 43 | # Fix costmatrix: 44 | fixed_costmatrix <- fix_costmatrix(costmatrix = costmatrix) 45 | 46 | # Compare transition costs: 47 | costmatrix$costmatrix 48 | fixed_costmatrix$costmatrix 49 | } 50 | \references{ 51 | Goloboff, P. A. and Catalano, S. A., 2016. TNT version 1.5, including a full implementation of phylogenetic morphometrics. \emph{Cladistics}, \bold{32}, 221-238. 52 | 53 | Goloboff, P., Farris, J. and Nixon, K., 2008. TNT, a free program for phylogenetic analysis. \emph{Cladistics}, \bold{24}, 774-786. 54 | 55 | Maddison, D. R. and Maddison, W. P., 2003. \emph{MacClade 4: Analysis of phylogeny and character evolution}. Version 4.06. Sinauer Associates, Sunderland, Massachusetts. 56 | 57 | Swofford, D. L., 2003. \emph{PAUP*. Phylogenetic Analysis Using Parsimony (*and Other Methods). Version 4}. Sinauer Associates, Sunderland, Massachusetts. 58 | } 59 | \author{ 60 | Graeme T. Lloyd \email{graemetlloyd@gmail.com} 61 | } 62 | --------------------------------------------------------------------------------