diff --git a/R/trees.R b/R/trees.R index ea867cb..7440ec6 100644 --- a/R/trees.R +++ b/R/trees.R @@ -235,11 +235,11 @@ ltp3 <- function() { purrr::modify(as.character) |> as.data.frame() - # genus_tips <- grep('g__', tip_data$tip_label, value = TRUE) + genus_tips <- grep('g__', tip_data$tip_label, value = TRUE) list( - tree = tree, tip_data = tip_data, node_data = node_data - # genus_tips = genus_tips + tree = tree, tip_data = tip_data, node_data = node_data, + genus_tips = genus_tips ) } diff --git a/vignettes/articles/add_singletons.Rmd b/vignettes/articles/add_singletons.Rmd new file mode 100644 index 0000000..5182913 --- /dev/null +++ b/vignettes/articles/add_singletons.Rmd @@ -0,0 +1,116 @@ +--- +title: "add_singletons" +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(phytools) +library(dplyr) +library(tidyr) +library(tibble) +library(purrr) +``` + +```{r} +data('primate.tree') +data('primate.data') +tre <- primate.tree +dat <- primate.data +states_original <- dat |> + rownames_to_column(var = 'tip_label') |> + select(tip_label, Activity_pattern) |> + mutate(presence = 1) |> + pivot_wider( + names_from = 'Activity_pattern', values_from = 'presence', values_fill = 0 + ) |> + column_to_rownames(var = 'tip_label') |> + set_names(c('A', 'B', 'C')) |> + as.matrix() +``` + + +```{r} +tip_number <- which(tre$tip.label == 'Galagoides_demidoff') +x <- bind.tip(tree = tre, tip.label = 'test', edge.length = 1000, where = tip_number) +``` + +```{r} +tip_number <- which(x$tip.label == 'Galagoides_demidoff') +tip_number2 <- which(x$tip.label == 'test') +``` + + +```{r} +x$edge[which(x$edge[,2] == tip_number),] +``` + +```{r} +x$edge[which(x$edge[,2] == tip_number2),] +``` + +```{r} +x$edge.length[which(x$edge[,2] == tip_number)] <- 1e-06 +``` + +```{r} +x$edge.length[which(x$edge[,2] == tip_number2)] <- 1e-06 +``` + +```{r} +x$edge.length +``` + + + + +## Ancestral state reconstruction + +```{r} +m <- states_original +m[] <- 1 / ncol(m) +# m['Galagoides_demidoff', ] <- c(A = 1, B = 0, C = 0) +m <- rbind(m, c(A = 0, B = 0, C = 1)) +rownames(m)[nrow(m)] <- 'test' + +macaca <- grep('^Macaca_', rownames(m)) # ? +galago <- grep('^Galago_', rownames(m)) # B +eulemur <- grep('^Eulemur', rownames(m)) # C + +m[macaca, ] <- c(rep(1,3), rep(0, 6)) +m[galago, ] <- c(rep(0,4), rep(1, 4), rep(0, 4)) +m[eulemur, ] <- c(rep(0,8), rep(1, 4)) + + +``` + + + + + + + +```{r} +myMod <- 'ARD' +myPi <- 'fitzjohn' +fit <- fitMk( + tree = x, x = m, model = myMod, pi = myPi, lik.func = "pruning", + logscale = TRUE +) +ace <- ancr(fit, tips=TRUE) +plot(ace, args.plotTree = list(direction = "upwards")) +``` + +## Session information + + +```{r} +sessioninfo::session_info() +``` + +