## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  warning = FALSE,
  message = FALSE,
  fig.width = 7,
  fig.height = 5.5,
  fig.align = "center"
)

## ----setup--------------------------------------------------------------------
if (requireNamespace("perufaunads004", quietly = TRUE)) {
  library(perufaunads004)
}
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
library(ggplot2)
library(knitr)

# Paquetes opcionales para lectura y exportación
# library(readxl)
# library(writexl)

## ----helpers------------------------------------------------------------------
# 1. Normaliza un nombre científico:
#    - Elimina comillas, paréntesis y nombres comunes incrustados
#    - Remueve autorías y epítetos informales ("sp.", "ssp.", "cf.", "aff.")
#    - Convierte a minúsculas, elimina diacríticos/tildes y extrae solo Género + epíteto (binomio)
normalizar_nombre <- function(x) {
  x |>
    as.character() |>
    str_replace_all('["“”\']', " ") |>
    str_replace_all("\\(.*?\\)", " ") |>
    str_replace_all("\\b(sp|spp|ssp|subsp|cf|aff|var)\\.?\\b", " ") |>
    str_replace_all("[^A-Za-zÁÉÍÓÚÜÑáéíóúüñ ]", " ") |>
    str_squish() |>
    str_to_lower() |>
    stringi::stri_trans_general("Latin-ASCII") |>
    word(1, 2)
}

# 2. Descompone y normaliza múltiples sinónimos (separados por ';', '/' o ',')
separar_sinonimos <- function(x) {
  x |>
    as.character() |>
    str_replace_all("[()]", " ") |>
    str_split("[;,/]") |>
    map(~ .x |> normalizar_nombre() |> discard(~ is.na(.x) | .x == ""))
}

# 3. Escala ordinal de severidad de amenaza (de menor a mayor gravedad)
niveles_cat <- c("DD", "NT", "VU", "EN", "CR")
severidad   <- function(x) match(x, niveles_cat)

## ----preparacion-datos--------------------------------------------------------
# Carga de datos integrados (con fallback para entorno de desarrollo local)
if (exists("ds004_fauna") && exists("libro_rojo_especies")) {
  # ya en memoria
} else if (requireNamespace("perufaunads004", quietly = TRUE)) {
  data("ds004_fauna", package = "perufaunads004")
  data("libro_rojo_especies", package = "perufaunads004")
} else if (file.exists("../data/ds004_fauna.rda")) {
  load("../data/ds004_fauna.rda")
  load("../data/libro_rojo_especies.rda")
} else if (file.exists("data/ds004_fauna.rda")) {
  load("data/ds004_fauna.rda")
  load("data/libro_rojo_especies.rda")
}

# Estandarización de la Lista 2014 (DS 004-2014-MINAGRI)
lista_2014 <- ds004_fauna |>
  transmute(
    id_2014        = ds004_id,
    cat_2014       = as.character(ds004_categoria_codigo),
    categoria_2014 = str_to_sentence(str_remove(ds004_categoria, "\\s*\\(.*\\)")),
    grupo_2014     = str_to_sentence(clase),
    nombre_2014    = str_squish(scientific_name),
    comun_2014     = common_name,
    sinonimo_2014  = synonym_scientific_name,
    observacion    = observacion,
    key            = normalizar_nombre(scientific_name),
    key_sin        = separar_sinonimos(synonym_scientific_name)
  )

# Estandarización de la Lista 2018 (Libro Rojo de SERFOR)
lista_2018 <- libro_rojo_especies |>
  transmute(
    id_2018        = libro_rojo_id,
    cat_2018       = as.character(libro_rojo_codigo),
    categoria_2018 = str_squish(libro_rojo_categoria),
    grupo_2018     = str_squish(grupo_taxonomico),
    nombre_2018    = str_squish(scientific_name),
    sinonimo_2018  = sinonimo,
    key            = normalizar_nombre(scientific_name),
    key_sin        = separar_sinonimos(sinonimo)
  )

# Verificación de calidad: claves duplicadas dentro de cada lista
dup_2014 <- lista_2014 |> count(key) |> filter(n > 1)
dup_2018 <- lista_2018 |> count(key) |> filter(n > 1)

tibble(
  Lista = c("2014 (DS 004)", "2018 (Libro Rojo)"),
  `Total Registros` = c(nrow(lista_2014), nrow(lista_2018)),
  `Claves Duplicadas` = c(nrow(dup_2014), nrow(dup_2018))
) |> kable(caption = "Control de integridad de registros y claves.")

## ----emparejamiento-----------------------------------------------------------
# Paso A: Emparejamiento directo por binomio aceptado
directo <- inner_join(
  lista_2014 |> select(-key_sin),
  lista_2018 |> select(-key_sin),
  by = "key"
) |>
  mutate(tipo_match = "nombre aceptado")

# Registros pendientes de emparejamiento
pend_2014 <- lista_2014 |> filter(!key %in% directo$key)
pend_2018 <- lista_2018 |> filter(!key %in% directo$key)

# Tablas largas de sinónimos de especies pendientes
sin_2014 <- pend_2014 |>
  select(key, key_sin) |>
  unnest_longer(key_sin, values_to = "key_alt") |>
  filter(!is.na(key_alt))

sin_2018 <- pend_2018 |>
  select(key, key_sin) |>
  unnest_longer(key_sin, values_to = "key_alt") |>
  filter(!is.na(key_alt))

# Construcción de puente relacional:
# sinónimo 2018 -> nombre 2014  |  sinónimo 2014 -> nombre 2018
puente <- bind_rows(
  sin_2018 |> transmute(key_2014 = key_alt, key_2018 = key),
  sin_2014 |> transmute(key_2014 = key,     key_2018 = key_alt)
) |>
  filter(key_2014 %in% pend_2014$key, key_2018 %in% pend_2018$key) |>
  distinct()

por_sinonimo <- puente |>
  left_join(pend_2014 |> select(-key_sin), by = c("key_2014" = "key")) |>
  left_join(pend_2018 |> select(-key_sin), by = c("key_2018" = "key")) |>
  mutate(key = key_2014, tipo_match = "sinónimo / cambio taxonómico") |>
  select(-key_2014, -key_2018)

# Consolidación final de coincidencias
coincidencias <- bind_rows(directo, por_sinonimo) |>
  mutate(
    cambio = case_when(
      cat_2014 == cat_2018                       ~ "sin cambio",
      severidad(cat_2018) > severidad(cat_2014)  ~ "asciende (mayor amenaza)",
      severidad(cat_2018) < severidad(cat_2014)  ~ "desciende (menor amenaza)",
      TRUE                                       ~ "no comparable"
    ),
    transicion = paste(cat_2014, "->", cat_2018)
  ) |>
  arrange(grupo_2014, nombre_2014)

## ----ver-sinonimos------------------------------------------------------------
por_sinonimo |>
  select(nombre_2014, nombre_2018, grupo_2014, cat_2014, cat_2018, tipo_match) |>
  kable(caption = "Especies emparejadas mediante sinonimia o reasignación taxonómica.")

## ----salidas-entradas---------------------------------------------------------
emparejadas_2014 <- coincidencias$id_2014
emparejadas_2018 <- coincidencias$id_2018

# Especies de 2014 que no figuran en 2018 (7 especies)
especies_retiradas <- lista_2014 |>
  filter(!id_2014 %in% emparejadas_2014) |>
  select(id_2014, nombre_2014, comun_2014, grupo_2014, cat_2014,
         categoria_2014, sinonimo_2014, observacion)

# Especies incorporadas exclusivamente en 2018
especies_nuevas <- lista_2018 |>
  filter(!id_2018 %in% emparejadas_2018) |>
  select(id_2018, nombre_2018, grupo_2018, cat_2018, categoria_2018, sinonimo_2018)

## ----tabla-retiradas----------------------------------------------------------
especies_retiradas |>
  select(id_2014, nombre_2014, grupo_2014, cat_2014, sinonimo_2014, observacion) |>
  kable(caption = "Especies del D.S. 004-2014 no incluidas en el Libro Rojo 2018.")

## ----resumen-general----------------------------------------------------------
resumen_general <- tibble(
  Indicador = c(
    "Registros D.S. 004-2014",
    "Registros Libro Rojo 2018",
    "Coincidencias totales",
    "  - Coincidencia directa (nombre aceptado)",
    "  - Coincidencia por sinónimo / cambio taxonómico",
    "Sin cambio de categoría de amenaza",
    "Ascienden de categoría (mayor amenaza)",
    "Descienden de categoría (menor amenaza)",
    "Especies retiradas (solo 2014)",
    "Especies nuevas (solo 2018)"
  ),
  `N° Especies` = c(
    nrow(lista_2014),
    nrow(lista_2018),
    nrow(coincidencias),
    sum(coincidencias$tipo_match == "nombre aceptado"),
    sum(coincidencias$tipo_match == "sinónimo / cambio taxonómico"),
    sum(coincidencias$cambio == "sin cambio"),
    sum(coincidencias$cambio == "asciende (mayor amenaza)"),
    sum(coincidencias$cambio == "desciende (menor amenaza)"),
    nrow(especies_retiradas),
    nrow(especies_nuevas)
  )
)

resumen_general |>
  kable(caption = "Resumen cuantitativo global de la comparación entre 2014 y 2018.")

## ----matriz-transicion--------------------------------------------------------
matriz_transicion <- coincidencias |>
  mutate(
    cat_2014 = factor(cat_2014, levels = rev(niveles_cat)),
    cat_2018 = factor(cat_2018, levels = rev(niveles_cat))
  ) |>
  count(cat_2014, cat_2018) |>
  pivot_wider(names_from = cat_2018, values_from = n, values_fill = 0) |>
  arrange(cat_2014)

matriz_transicion |>
  kable(caption = "Matriz de transición: Categoría 2014 (filas) vs. Categoría 2018 (columnas).")

## ----balance-grupo------------------------------------------------------------
balance_grupo <- coincidencias |>
  count(Grupo = grupo_2018, Categoría = cat_2018) |>
  pivot_wider(names_from = Categoría, values_from = n, values_fill = 0) |>
  arrange(Grupo)

balance_grupo |>
  kable(caption = "Distribución de especies categorizadas por grupo taxonómico en 2018.")

## ----grafico-transicion-------------------------------------------------------
p_transicion <- coincidencias |>
  count(cat_2014, cat_2018) |>
  mutate(
    cat_2014 = factor(cat_2014, levels = niveles_cat),
    cat_2018 = factor(cat_2018, levels = niveles_cat)
  ) |>
  ggplot(aes(x = cat_2018, y = cat_2014, fill = n)) +
  geom_tile(color = "white", linewidth = 0.8) +
  geom_text(aes(label = n), fontface = "bold", size = 4.5, color = "black") +
  scale_fill_gradient(low = "#e8f1f5", high = "#1b4965") +
  labs(
    title = "Transición de Categorías de Amenaza de Fauna Silvestre",
    subtitle = "D.S. N° 004-2014-MINAGRI → Libro Rojo de SERFOR (2018)",
    x = "Categoría 2018 (Libro Rojo)",
    y = "Categoría 2014 (D.S. 004-2014-MINAGRI)",
    fill = "N° de Especies"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 13),
    panel.grid = element_blank(),
    legend.position = "right"
  )

print(p_transicion)

## ----grafico-grupos-----------------------------------------------------------
colores_uicn <- c(
  "CR" = "#d90429",
  "EN" = "#f77f00",
  "VU" = "#fcbf49",
  "NT" = "#a7c957",
  "DD" = "#adb5bd"
)

p_grupos <- coincidencias |>
  mutate(
    cat_2018 = factor(cat_2018, levels = c("CR", "EN", "VU", "NT", "DD"))
  ) |>
  ggplot(aes(x = grupo_2018, fill = cat_2018)) +
  geom_bar(position = "stack", color = "white", linewidth = 0.3) +
  scale_fill_manual(values = colores_uicn) +
  labs(
    title = "Especies Amenazadas por Grupo Taxonómico (2018)",
    subtitle = "Clasificación según Libro Rojo de SERFOR",
    x = "Grupo Taxonómico",
    y = "Número de Especies",
    fill = "Categoría"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold"),
    axis.text.x = element_text(angle = 20, hjust = 1)
  )

print(p_grupos)