Árboles con datos

En stenopelmatus.csv tenemos metadatos que enriquecen el árbol: Color (rojo/naranja/negro), presencia de alas y Región. Integraremos esa información al árbol ML y, además, mostraremos un heatmap de regiones usando matriz_WW_NW_regiones_colorES.csv.

Árbol base (visto en la sección anterior)

Tenemos que ampliar el rango en X en ambas direcciones, principalmente a la derecha donde colocaremos el heatmap (y que no se corte).

## Paquetes
library(ggtree)
library(treeio)
library(ape)
library(tidyverse)

# Archivo ML (NEWICK)
f_raxml <- "../docs/raxml_cox1_Stenopelmatus.tre"

# Lectura con ape
ml_phylo <- ape::read.tree(f_raxml)

# geom_tiplab() agregra nombres de terminales
# size controla el tamaño del texto
ml_p <- ggtree(ml_phylo) 

# Cargar la tabla
df_stenopelmatus <- read.csv("../docs/stenopelmatus.csv") %>%
    rename(label = Sample) # renombrar las columna Sample por label

#Unir árbol + informacion extra 
ml_p <- ml_p %<+% df_stenopelmatus

# Transforma en un data.frame
ml_df <- ml_p$data

# Rango en X (distancia/tiempo)
# xr → te dice de dónde a dónde llega el árbol en horizontal.
xr <- range(ml_df$x, na.rm = TRUE)

# obtener el numero de terminales
ntips_s <- ml_df %>%
    filter(isTip == "TRUE") %>%
    nrow()

# Aire extra en X (2% del rango) para no cortar etiquetas
pad_x <- 0.2 * diff(xr) 

# Paleta por categoría funcional (ajústala si quieres)
pal <- c(
  "Stenopelmatus_apterous"     = "#56ae6c",
  "Stenopelmatus_micropterous" = "#a24f99",
  "Stenopelmatus_macropterous" = "#af953c",
  "Ammopelmatus_apterous"     = "#6971c9",
  "Outgroup"        = "#ba4a4f"
)

ml_p_adj <- ml_p +
  geom_treescale(y = -3.5, width = 0.02) + # escala sustituciones por sitio.
    ## modificamos los limites de x hacia la izquirda y derecha
  scale_x_continuous(limits = c(xr[1] - (pad_x + 0.03), xr[2] + pad_x + 0.34),
                     expand = c(0, 0)) +   # Limites exactos sin padding automático
  scale_y_continuous(limits = c(-5, ntips_s + 3),
                     expand = c(0, 0)) +
  coord_cartesian(clip = "off") +          # Permitir etiquetas largas fuera del panel
  theme(plot.margin = margin(5.5, 25, 5.5, 5.5)) + # Más aire a la derecha
  # Negro: >80
  geom_point2(aes(subset = !isTip & as.numeric(label) > 80),
              size = 2.5, shape = 16, color = "black") +
  # Gris: 50–80
  geom_point2(aes(subset = !isTip & as.numeric(label) >= 50 & as.numeric(label) <= 80),
              size = 2.5, shape = 16, color = "grey40") +
  # Blanco: <50
  geom_point2(aes(subset = !isTip & as.numeric(label) < 50),
              size = 2.5, shape = 21, fill = "white", color = "black") +
  geom_tiplab(
    aes(fill = Species, label = label),  # fill por especie
    color = "grey15",
    geom = "label",                      # cajita detrás del texto
    label.size = 0,                      # sin borde en la cajita
    label.padding = unit(0.12, "lines"), # relleno interno de la cajita
    size = 2.6,
    offset = 0.003,
    show.legend = TRUE,
    align = TRUE,
    linetype = "dotted", 
    linesize = 0.3
  ) +
  scale_fill_manual(
    values = pal,
    na.value = "black",
    # orden explícito de los grupos
    breaks = c("Ammopelmatus_apterous",
               "Stenopelmatus_apterous", 
               "Stenopelmatus_macropterous",
               "Stenopelmatus_micropterous",
               "Outgroup"),
    labels = c(Ammopelmatus_apterous = expression(bolditalic("A. apterous")),
               Stenopelmatus_apterous = expression(bolditalic("S. apterous")),
               Stenopelmatus_macropterous = expression(bolditalic("S. macropterous")),
               Stenopelmatus_micropterous = expression(bolditalic("S. micropterous")),
               Outgroup = expression(bold("Outgroup")))) +
  guides(fill = guide_legend(order = 1,
    title = "Species",
    # símbolo cuadrado, sin letra y un poco más pequeño para que el gap sea menor
    override.aes = list(shape = 15, size = 4, label = NULL, colour = NA, stroke = 0),
    label.hjust = 0, title.hjust = 0)) +
  theme(
    legend.position      = c(0.02, 0.98),
    legend.justification = c("left", "top"),
    legend.background    = element_rect(fill = "white", color = "white"),
              # menos espacio entre key y texto
    legend.title         = element_text(size = 10, face = "bold"),
    legend.text          = element_text(size = 9, margin = margin(l = 0))
  )


ml_p_adj

Anotar alas con un ícono formato `.png`

En esta sección añadiremos un ícono de alas a las puntas que tienen presencia de alas.

# --- Cargar solo si faltan ---
library(ggimage)     # Para dibujar imágenes (PNG) como capas en ggplot
library(stringr)     # Para detectar patrones en nombres de columnas (str_detect)
library(ggnewscale)  # (Cargada por si se requiere separar escalas de 'colour' más adelante)

# Filtra las muestras que tiene presencia de alas  y define la ruta del PNG a usar
df_wings <- ml_p$data %>%
  filter(Presencia_alas == "si") %>%
  mutate(image = "../docs/wings.png")   # Ruta al icono de alas (PNG)

# Función para que la leyenda muestre el PNG “tintado” con el color de la escala
draw_key_wings <- function(data, params, size){
  img <- magick::image_read("../docs/wings.png")  # Lee el PNG
  col <- if (!is.null(data$colour)) data$colour[1] else "black"  # Color que aplicará la escala
  alp <- if (!is.null(data$alpha))  data$alpha[1]  else 1          # Alpha (si aplica)
  img <- ggimage:::color_image(img, col, alp)                      # Tinta el PNG
  grid::rasterGrob(as.raster(img), width = unit(1,"npc"), height = unit(1,"npc"))  # Devuelve grob
}

# --- 4) Añadir EXACTAMENTE esta capa al plot existente (ml_p_adj) ---
# Agrega la capa de imágenes (alas) y define la escala de 'colour' con su guía/leyenda
ml_p_adj <- ml_p_adj +
  ggimage::geom_image(
    data = df_wings,
    aes(x = 0.25, y = y, image = image, colour = Presencia_alas),  # Mapea 'colour' a has_wings
    size = 0.02, nudge_x = 0.025,                             # Tamaño del ícono y leve empuje en X
    key_glyph = draw_key_wings,                               # Usa el PNG en la leyenda
    show.legend = TRUE
  ) +
  scale_colour_manual(
    name = "Wings",                             # Título de la leyenda
    values = c("si" = "#CD661D"),             # Color con el que se tintará el PNG
    labels = c("si" = "True"), 
    guide  = guide_legend(
      order = 3,                                # Orden relativo de esta leyenda
      label.theme = element_text(face = "bold", margin = margin(l = 6)), # Texto en bold espacio
      label.hjust = 0,
      override.aes = list(size = 0)             # Evita que aparezca un punto genérico
    )
  )

# Imprime el objeto resultante (árbol + íconos de alas)
ml_p_adj

Heatmap de regiones y color de “cara de niño”

Ahora añadiremos un heatmap a la derecha del árbol para mostrar, por cada muestra (filas) y región biogeográfica (columnas), el color asociado (naranja, negro, rojo). Reordenamos las columnas de sur a norte, “reiniciamos” la escala de fill (porque Species ya usa fill) y aplicamos una paleta manual para el heatmap. Al final, fijamos la posición de las leyendas para que no se muevan.

 # lee la matriz de regiones y color de cara de niño
df_mat <- read.csv("../docs/matriz_WW_NW_regiones_colorES.csv") 

rownames(df_mat) <- df_mat$label  # usa la columna 'label' como nombres de fila 

df_mat$label <- NULL  # elimina la columna 'label' ya que ahora es el rowname

# Orden sur → norte de códigos de región (columnas del heatmap)
order_codes <- c(
    "CR",  # Costa Rica
    "G",   # Guatemala
    "CH",  # Chiapas Highlands
    "SMS", # Sierra Madre del Sur
    "PL",  # Pacific Lowlands
    "V",   # Veracruzan
    "TVB", # Transmexican Volcanic Belt
    "SMO", # Sierra Madre Oriental
    "CD",  # Chihuahuan Desert
    "S",   # Sonoran
    "BC",  # Baja Californian
    "USA"  # United States
)

# Conservar solo las columnas que existan y reordenarlas según 'order_codes'
keep <- intersect(order_codes, colnames(df_mat))
df_mat  <- df_mat[, keep, drop = FALSE]

# --- reinicia la escala de fill y agrega el heatmap ---
ml_p_adj_new <- ml_p_adj +
    ggnewscale::new_scale_fill()  # abre una nueva escala 'fill' para el heatmap (separada de 'Species')

ml_p_adj_new <- gheatmap(
    ml_p_adj_new, df_mat, font.size = 3,         # tamaño del texto del heatmap
    colnames_angle = -90, offset = 0.05, family = "bold"  # rota nombres de columnas y separa 0.05 en X
) +
    scale_fill_manual(
        name   = "Color",                        # título de la leyenda del heatmap
        breaks = c("naranja","negro","rojo"),    # niveles presentes en la matriz
        values = c(naranja = "darkorange", negro = "grey20", rojo = "firebrick"), # paleta
        labels = c("naranja" = "Orange",
                   "negro" = "Black",
                   "rojo" = "Red"),
        na.value = "grey95",                     # color para celdas NA
        na.translate = FALSE,                    # oculta el ítem 'NA' en la leyenda
        guide = guide_legend(order = 2,          # orden de esta leyenda (debajo de Species)
                             label.theme = element_text(face = "bold", margin = margin(l = 6)), # texto en negritas y separado
                             keywidth = unit(0.7, "lines"))  # ancho del swatch en la leyenda
    ) +
    # re-aplica la posición de leyendas al final para que no “salten”
    theme(
        legend.position      = c(0.02, 0.98),    # esquina sup-izq dentro del panel
        legend.justification = c("left", "top"),
        legend.background    = element_rect(fill = "white", color = "white"),
        legend.title         = element_text(size = 10, face = "bold"),
        legend.text          = element_text(size = 9, margin = margin(l = 0))
    )

ml_p_adj_new  # imprime el árbol con el heatmap de regiones

Árbol base (visto en la sección anterior)

Anotar alas con un ícono formato .png

Heatmap de regiones y color de “cara de niño”

Anotar alas con un ícono formato `.png`