Merge branch 'main' of github.com:waldronlab/taxPPro

Author: sdgamboa

R/taxPPro.R

@@ -173,7 +173,7 @@ getDataReady <- function(tbl) {
         output <- dataset |>
             tidyr::complete(NCBI_ID, Attribute, fill = list(Score = 0)) |>
             dplyr::arrange(NCBI_ID, Attribute)
-    } else if (attr_type == 'range') { # al numeric are converted to range when imported with the physiologies function
+    } else if (attr_type == 'range') { # all numeric are converted to range when imported with the physiologies function
         set_with_ids <- getSetWithIDs(tbl) |>
             purrr::discard(~ all(is.na(.x)))
         set_without_ids <- getSetWithoutIDs(tbl, set_with_ids = set_with_ids) |>
@@ -265,10 +265,14 @@ getSetWithIDs <- function(tbl) {
             ) |>
             dplyr::group_by(.data$NCBI_ID) |>
             dplyr::slice_max(
-                .data$Confidence_in_curation, n = 1, with_ties = FALSE
+                .data$Confidence_in_curation, n = 1, with_ties = TRUE
             ) |>
             dplyr::mutate(
-                Attribute_value = mean(.data$Attribute_value_min, .data$Attribute_value_max)
+                Attribute_value = mean(cbind(.data$Attribute_value_min, .data$Attribute_value_max))
+            ) |>
+            # dplyr::mutate(Attribute_value = mean(Attribute_value)) |>
+            dplyr::slice_max(
+                .data$Confidence_in_curation, n = 1, with_ties = FALSE
             ) |>
             dplyr::ungroup() |>
             dplyr::select(-Attribute_value_min, -Attribute_value_max) |>
@@ -349,9 +353,13 @@ getSetWithoutIDs <- function(tbl, set_with_ids = NULL) {
             dplyr::mutate(Taxon_name = taxizedb::taxid2name(.data$NCBI_ID, db = 'ncbi')) |>
             dplyr::mutate(Confidence_in_curation =  conf2Fct(.data$Confidence_in_curation)) |>
             dplyr::group_by(.data$NCBI_ID) |>
-            dplyr::slice_max(.data$Confidence_in_curation, n = 1, with_ties = FALSE) |>
+            dplyr::slice_max(.data$Confidence_in_curation, n = 1, with_ties = TRUE) |>
             dplyr::mutate(
-                Attribute_value = mean(.data$Attribute_value_min, .data$Attribute_value_max)
+                Attribute_value = mean(cbind(.data$Attribute_value_min, .data$Attribute_value_max))
+            ) |>
+            # dplyr::mutate(Attribute_value = mean(Attribute_value)) |>
+            dplyr::slice_max(
+                .data$Confidence_in_curation, n = 1, with_ties = FALSE
             ) |>
             dplyr::ungroup() |>
             dplyr::select(-Attribute_value_min, -Attribute_value_max) |>

vignettes/articles/figure_example.Rmd

@@ -0,0 +1,66 @@
+---
+title: "Example numeric"
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+```{r setup, message=FALSE}
+library(taxPPro)
+library(ape)
+library(phytools)
+library(castor)
+library(ggtree)
+```
+
+```{r}
+set.seed(1234)
+tree <- rtree(n = 7, rooted = TRUE)
+tree$node.label <- paste0("n", Ntip(tree) + 1:Nnode(tree))
+plot(tree)
+```
+## Numeric
+
+```{r}
+states <- c(t1 = 37, t2 = NA, t3 = NA, t4 = NA, t5 = 10, t6 = 80, t7 = NA)
+states <- states[match(tree$tip.label, names(states))]
+res <- hsp_squared_change_parsimony(
+    tree = tree, tip_states = states, check_input = FALSE, weighted = TRUE 
+)
+pred <- res$states
+names(pred) <- c(tree$tip.label, tree$node.label)
+```
+
+
+```{r}
+tip_data <- data.frame(
+    label = names(pred),
+    value = floor(pred)
+)
+p <- ggtree(tree) %<+% tip_data
+p +
+    geom_tiplab() +
+    geom_nodelab(nudge_x = -0.07, nudge_y = 0.15) +
+    geom_label(aes(label = value), nudge_x = 0.11)
+```
+
+
+```{r}
+pruned_tree <- keep.tip(tree, c("t1", "t5", "t6"))
+plot(pruned_tree)
+```
+
+```{r}
+ace(x = c(t5 = 10, t1 = 37, t6 = 80 ), phy = pruned_tree)$ace
+```
+
+
+## Session info
+
+```{r}
+sessioninfo::session_info()
+```

vignettes/articles/smaller_example.Rmd

@@ -25,6 +25,7 @@ the t1 tip.
 ```{r}
 set.seed(1234)
 randomTree <- rtree(7, rooted = TRUE)
+
 mat <- matrix(
     data = rep(0.5, Ntip(randomTree) * 2), ncol = 2, dimnames = list(
         rownames = paste0('t', 1:Ntip(randomTree)), colnames = c('A--TRUE', 'A--FALSE')
@@ -147,9 +148,139 @@ mergedPlot
 ```
 
 
+
+
+
+# Example 2
+
+```{r}
+mat <- matrix(
+    data = rep(0.5, Ntip(randomTree) * 2), ncol = 2, dimnames = list(
+        rownames = paste0('t', 1:Ntip(randomTree)), colnames = c('A--TRUE', 'A--FALSE')
+    )
+)
+annotated_tips <- c('t3', 't2')
+for (i in seq_along(randomTree$tip.label)) {
+    if (randomTree$tip.label[i] %in% annotated_tips) {
+        mat[randomTree$tip.label[i], ] <- c(1, 0)
+    }
+}
+mat
+```
+
+
+```{r, fig.width=15, fig.height=10}
+models <- c('ER', 'ARD', 'SYM')
+pis <- c('fitzjohn', 'equal', 'estimated')
+plotList <- vector('list', length(models) * length(pis))
+n <- 1
+for (i in seq_along(models)) {
+    for (j in seq_along(pis)) {
+        fit <- fitMk(tree = randomTree, x = mat, model = models[i], pi = pis[j])
+        ace <- ancr(fit, tips = TRUE)
+        plotList[[n]] <- plotT(
+            randomTree, ace = ace, input_tips = annotated_tips,
+            model = models[i], pi = pis[j]
+        )
+        n <- n + 1
+    }
+}
+mergedPlot <- ggarrange(plotlist = plotList, ncol = 3, nrow = 3)
+mergedPlot
+```
+
+
+
+
+```{r}
+mat <- matrix(
+    data = rep(0.5, Ntip(randomTree) * 2), ncol = 2, dimnames = list(
+        rownames = paste0('t', 1:Ntip(randomTree)), colnames = c('A--TRUE', 'A--FALSE')
+    )
+)
+annotated_tips <- c('t1', 't5')
+for (i in seq_along(randomTree$tip.label)) {
+    if (randomTree$tip.label[i] %in% annotated_tips) {
+        mat[randomTree$tip.label[i], ] <- c(1, 0)
+    }
+}
+mat
+```
+
+
+
+```{r}
+models <- c('ER', 'ARD', 'SYM')
+pis <- c('fitzjohn', 'equal', 'estimated')
+plotList <- vector('list', length(models) * length(pis))
+n <- 1
+for (i in seq_along(models)) {
+    for (j in seq_along(pis)) {
+        fit <- fitMk(tree = randomTree, x = mat, model = models[i], pi = pis[j])
+        ace <- ancr(fit, tips = TRUE)
+        plotList[[n]] <- plotT(
+            randomTree, ace = ace, input_tips = annotated_tips,
+            model = models[i], pi = pis[j]
+        )
+        n <- n + 1
+    }
+}
+mergedPlot <- ggarrange(plotlist = plotList, ncol = 3, nrow = 3)
+```
+```{r, fig.width=15, fig.height=10}
+mergedPlot
+```
+
+
+
+# Example 3
+
+```{r}
+mat <- matrix(
+    data = rep(0.5, Ntip(randomTree) * 2), ncol = 2, dimnames = list(
+        rownames = paste0('t', 1:Ntip(randomTree)), colnames = c('A--TRUE', 'A--FALSE')
+    )
+)
+annotated_tips <- c('t1', 't5')
+for (i in seq_along(randomTree$tip.label)) {
+    if (randomTree$tip.label[i] %in% annotated_tips) {
+        mat[randomTree$tip.label[i], ] <- c(1, 0)
+    } else {
+        mat[randomTree$tip.label[i], ] <- c(0, 1)
+    }
+}
+mat["t4",] <- c(0.5, 0.5)
+mat["t7",] <- c(0.5, 0.5)
+mat["t2",] <- c(0.5, 0.5)
+mat
+```
+
+
+```{r}
+models <- c('ER', 'ARD', 'SYM')
+pis <- c('fitzjohn', 'equal', 'estimated')
+plotList <- vector('list', length(models) * length(pis))
+n <- 1
+for (i in seq_along(models)) {
+    for (j in seq_along(pis)) {
+        fit <- fitMk(tree = randomTree, x = mat, model = models[i], pi = pis[j])
+        ace <- ancr(fit, tips = TRUE)
+        plotList[[n]] <- plotT(
+            randomTree, ace = ace, input_tips = c("t1", "t5", "t3", "t6"),
+            model = models[i], pi = pis[j]
+        )
+        n <- n + 1
+    }
+}
+mergedPlot <- ggarrange(plotlist = plotList, ncol = 3, nrow = 3)
+```
+
+```{r, fig.width=15, fig.height=10}
+mergedPlot
+```
+
 ## Session info
 
 ```{r}
 sessioninfo::session_info()
 ```
-