1 Objetivo

Este documento analiza la relación lineal entre la cobertura vegetal y la temperatura del suelo. Primero se estudian los datos originales y luego se construye un conjunto sintético de 1.000 observaciones con correlación positiva para fines didácticos.

Nota metodológica: el archivo original presenta una correlación negativa. El conjunto ampliado es simulado y no debe presentarse como una medición experimental real.

Sistema silvopastoril

2 Preparación del entorno

# Instale estos paquetes una sola vez si no están disponibles:
# install.packages(c("tidyverse", "broom", "ggpubr", "knitr"))

library(tidyverse)
library(broom)
library(ggpubr)
library(knitr)

# No se recomienda rm(list = ls()) dentro de R Markdown, porque puede borrar
# objetos necesarios durante la ejecución interactiva del documento.

3 Lectura y validación de los datos originales

archivo_original <- "Temperatura_suelo.csv"

if (!file.exists(archivo_original)) {
  stop("No se encontró el archivo: ", archivo_original,
       ". Guarde el CSV en la misma carpeta del archivo Rmd.")
}

suelo_original <- readr::read_delim(
  archivo_original,
  delim = ";",
  trim_ws = TRUE,
  show_col_types = FALSE
) %>%
  mutate(across(c(Cobertura, Temperatura), as.numeric)) %>%
  drop_na(Cobertura, Temperatura)

columnas_requeridas <- c("Cobertura", "Temperatura")
if (!all(columnas_requeridas %in% names(suelo_original))) {
  stop("El archivo debe contener las columnas Cobertura y Temperatura.")
}

if (nrow(suelo_original) < 3) {
  stop("Se requieren al menos tres observaciones completas.")
}

kable(head(suelo_original), digits = 2,
      caption = "Primeras observaciones del conjunto original")

Primeras observaciones del conjunto original
Cobertura	Temperatura
56	33.8
58	32.1
62	30.4
67	27.1
71	28.3
75	23.6

4 Análisis exploratorio de los datos originales

resumen_original <- suelo_original %>%
  summarise(
    n = n(),
    cobertura_media = mean(Cobertura),
    temperatura_media = mean(Temperatura),
    cobertura_sd = sd(Cobertura),
    temperatura_sd = sd(Temperatura)
  )

kable(resumen_original, digits = 2)

n	cobertura_media	temperatura_media	cobertura_sd	temperatura_sd
10	72.4	26.32	11.81	4.95

prueba_cor_original <- cor.test(
  suelo_original$Cobertura,
  suelo_original$Temperatura,
  method = "pearson"
)

r_original <- unname(prueba_cor_original$estimate)
p_original <- prueba_cor_original$p.value

cat("Coeficiente de Pearson:", round(r_original, 3), "\n")

## Coeficiente de Pearson: -0.962

cat("Valor p:", format.pval(p_original, digits = 3), "\n")

## Valor p: 8.4e-06

ggplot(suelo_original, aes(x = Cobertura, y = Temperatura)) +
  geom_point(size = 3, color = "#2166AC", alpha = 0.85) +
  geom_smooth(method = "lm", formula = y ~ x,
              se = TRUE, color = "#B2182B") +
  annotate(
    "label",
    x = Inf, y = Inf,
    label = paste0("r = ", round(r_original, 3)),
    hjust = 1.1, vjust = 1.3
  ) +
  labs(
    title = "Datos originales",
    subtitle = "Relación entre cobertura vegetal y temperatura del suelo",
    x = "Cobertura vegetal (%)",
    y = "Temperatura del suelo (°C)",
    caption = "Autor: Luis Fernando Delgado Muñoz"
  ) +
  theme_bw(base_size = 12)

5 Modelo lineal con los datos originales

modelo_original <- lm(Temperatura ~ Cobertura, data = suelo_original)

tidy(modelo_original, conf.int = TRUE) %>%
  kable(digits = 4, caption = "Coeficientes del modelo original")

Coeficientes del modelo original
term	estimate	std.error	statistic	p.value	conf.low	conf.high
(Intercept)	55.5236	2.9510	18.8155	0	48.7187	62.3285
Cobertura	-0.4034	0.0403	-10.0140	0	-0.4962	-0.3105

glance(modelo_original) %>%
  select(r.squared, adj.r.squared, sigma, statistic, p.value, df.residual) %>%
  kable(digits = 4, caption = "Indicadores de ajuste del modelo original")

Indicadores de ajuste del modelo original
r.squared	adj.r.squared	sigma	statistic	p.value	df.residual
0.9261	0.9169	1.4266	100.2809	0	8

La ecuación estimada es:

b0 <- coef(modelo_original)[1]
b1 <- coef(modelo_original)[2]
cat(sprintf("$$\\widehat{Temperatura} = %.3f %+.3f(Cobertura)$$", b0, b1))

\[\widehat{Temperatura} = 55.524 -0.403(Cobertura)\]

suelo_original <- suelo_original %>%
  mutate(
    Prediccion = predict(modelo_original),
    Residuo = residuals(modelo_original)
  )

kable(head(suelo_original), digits = 3,
      caption = "Predicciones y residuos del modelo original")

Predicciones y residuos del modelo original
Cobertura	Temperatura	Prediccion	Residuo
56	33.8	32.935	0.865
58	32.1	32.128	-0.028
62	30.4	30.515	-0.115
67	27.1	28.498	-1.398
71	28.3	26.885	1.415
75	23.6	25.271	-1.671

6 Conjunto sintético de 1.000 registros con correlación positiva

# Semilla fija para obtener los mismos resultados cada vez que se ejecute.
set.seed(2026)

n_sim <- 10000

suelo_positivo <- tibble(
  Cobertura = round(runif(n_sim, min = 5, max = 100), 1),
  # Tendencia positiva: al aumentar la cobertura, aumenta la respuesta.
  # El error aleatorio evita una relación artificialmente perfecta.
  Temperatura = round(16 + 0.18 * Cobertura + rnorm(n_sim, 0, 3.2), 1)
) %>%
  mutate(
    # Se conserva un intervalo físicamente razonable para el ejemplo.
    Temperatura = pmin(pmax(Temperatura, 8), 42)
  )

# Guardar el conjunto sintético para reutilizarlo fuera del R Markdown.
readr::write_delim(suelo_positivo, "Temperatura_suelo_1000_positiva.csv", delim = ";")

kable(head(suelo_positivo), digits = 1,
      caption = "Primeras observaciones del conjunto sintético")

Primeras observaciones del conjunto sintético
Cobertura	Temperatura
71.4	32.1
57.9	29.2
18.3	21.2
32.1	23.0
57.8	22.1
7.4	15.8

prueba_cor_positiva <- cor.test(
  suelo_positivo$Cobertura,
  suelo_positivo$Temperatura,
  method = "pearson"
)

r_positivo <- unname(prueba_cor_positiva$estimate)
cat("Coeficiente de Pearson:", round(r_positivo, 3), "\n")

## Coeficiente de Pearson: 0.839

cat("Valor p:", format.pval(prueba_cor_positiva$p.value, digits = 3), "\n")

## Valor p: <2e-16

ggplot(suelo_positivo, aes(x = Cobertura, y = Temperatura)) +
  geom_point(color = "#1B7837", alpha = 0.35, size = 1.5) +
  geom_smooth(method = "lm", formula = y ~ x,
              se = TRUE, color = "#762A83", linewidth = 1) +
  annotate(
    "label",
    x = Inf, y = Inf,
    label = paste0("n = ", nrow(suelo_positivo),
                   "\nr = ", round(r_positivo, 3)),
    hjust = 1.1, vjust = 1.2
  ) +
  labs(
    title = "Conjunto sintético con tendencia positiva",
    subtitle = "Datos simulados exclusivamente para fines didácticos",
    x = "Cobertura vegetal (%)",
    y = "Temperatura del suelo simulada (°C)",
    caption = "Autor: Luis Fernando Delgado Muñoz"
  ) +
  theme_bw(base_size = 12)

7 Modelo con 10.000 observaciones

modelo_positivo <- lm(Temperatura ~ Cobertura, data = suelo_positivo)

coeficientes_positivos <- tidy(modelo_positivo, conf.int = TRUE)
ajuste_positivo <- glance(modelo_positivo)

kable(coeficientes_positivos, digits = 4,
      caption = "Coeficientes del modelo con tendencia positiva")

Coeficientes del modelo con tendencia positiva
term	estimate	std.error	statistic	p.value	conf.low	conf.high
(Intercept)	15.9674	0.0695	229.8881	0	15.8312	16.1035
Cobertura	0.1813	0.0012	154.3216	0	0.1790	0.1836

ajuste_positivo %>%
  select(r.squared, adj.r.squared, sigma, statistic, p.value, df.residual) %>%
  kable(digits = 4, caption = "Indicadores de ajuste del modelo positivo")

Indicadores de ajuste del modelo positivo
r.squared	adj.r.squared	sigma	statistic	p.value	df.residual
0.7043	0.7043	3.2178	23815.16	0	9998

anova(modelo_positivo) %>%
  broom::tidy() %>%
  kable(digits = 4, caption = "ANOVA del modelo positivo")

ANOVA del modelo positivo
term	df	sumsq	meansq	statistic	p.value
Cobertura	1	246584.5	246584.5282	23815.16	0
Residuals	9998	103520.3	10.3541	NA	NA

# Los gráficos revisan linealidad, homocedasticidad, normalidad aproximada
# de los residuos y observaciones influyentes.
par(mfrow = c(2, 2))
plot(modelo_positivo)

par(mfrow = c(1, 1))

modelo_positivo$residuals |> hist()

8 Predicciones para nuevos valores

nuevos_datos <- tibble(Cobertura = c(20, 40, 60, 80, 100))

predicciones <- bind_cols(
  nuevos_datos,
  as_tibble(predict(
    modelo_positivo,
    newdata = nuevos_datos,
    interval = "prediction",
    level = 0.95
  ))
)

kable(predicciones, digits = 2,
      caption = "Predicciones con intervalo de predicción del 95 %")

Predicciones con intervalo de predicción del 95 %
Cobertura	fit	lwr	upr
20	19.59	13.29	25.90
40	23.22	16.91	29.53
60	26.85	20.54	33.15
80	30.47	24.16	36.78
100	34.10	27.79	40.41

9 Conclusión automática

pendiente <- coef(modelo_positivo)["Cobertura"]
r2 <- summary(modelo_positivo)$r.squared

cat(paste0(
  "En el conjunto sintético, por cada aumento de un punto porcentual en la cobertura, ",
  "la temperatura simulada aumenta en promedio ", round(pendiente, 3),
  " °C. El modelo explica aproximadamente el ", round(100 * r2, 1),
  " % de la variabilidad observada. Esta interpretación describe asociación estadística ",
  "y no demuestra causalidad."
))

En el conjunto sintético, por cada aumento de un punto porcentual en la cobertura, la temperatura simulada aumenta en promedio 0.181 °C. El modelo explica aproximadamente el 70.4 % de la variabilidad observada. Esta interpretación describe asociación estadística y no demuestra causalidad.

10 Información de la sesión

sessionInfo()

## R version 4.6.2 (2026-10-29)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.5 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so;  LAPACK version 3.12.0
## 
## locale:
##  [1] LC_CTYPE=C.UTF-8       LC_NUMERIC=C           LC_TIME=C.UTF-8       
##  [4] LC_COLLATE=C.UTF-8     LC_MONETARY=C.UTF-8    LC_MESSAGES=C.UTF-8   
##  [7] LC_PAPER=C.UTF-8       LC_NAME=C              LC_ADDRESS=C          
## [10] LC_TELEPHONE=C         LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C   
## 
## time zone: UTC
## tzcode source: system (glibc)
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] knitr_1.52      ggpubr_1.0.0    broom_1.0.13    lubridate_1.9.5
##  [5] forcats_1.0.1   stringr_1.6.0   dplyr_1.2.1     purrr_1.2.2    
##  [9] readr_2.2.0     tidyr_1.3.2     tibble_3.3.1    ggplot2_4.0.3  
## [13] tidyverse_2.0.0
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.6       xfun_0.62          bslib_0.12.0       rstatix_1.1.0     
##  [5] lattice_0.23-1     tzdb_0.5.0         vctrs_0.7.3        tools_4.6.2       
##  [9] generics_0.1.4     stats4_4.6.2       parallel_4.6.2     pkgconfig_2.0.3   
## [13] Matrix_1.7-6       RColorBrewer_1.1-3 S7_0.2.2           lifecycle_1.0.5   
## [17] compiler_4.6.2     farver_2.1.2       carData_3.0-6      htmltools_0.5.9   
## [21] sass_0.4.10        yaml_2.3.12        Formula_1.2-6      pillar_1.11.1     
## [25] car_3.1-5          crayon_1.5.3       jquerylib_0.1.4    cachem_1.1.0      
## [29] abind_1.4-8        nlme_3.1-171       tidyselect_1.2.1   digest_0.6.39     
## [33] stringi_1.8.9      labeling_0.4.3     splines_4.6.2      fastmap_1.2.0     
## [37] grid_4.6.2         cli_3.6.6          magrittr_2.0.5     withr_3.0.3       
## [41] scales_1.4.0       backports_1.5.1    bit64_4.8.6        timechange_0.4.0  
## [45] rmarkdown_2.32     bit_4.6.0          otel_0.2.0         ggsignif_0.6.4    
## [49] hms_1.1.4          evaluate_1.0.5     mgcv_1.9-4         rlang_1.3.0       
## [53] glue_1.8.1         rstudioapi_0.19.0  vroom_1.7.1        jsonlite_2.0.0    
## [57] R6_2.6.1

Análisis de regresión lineal: cobertura vegetal y temperatura del suelo

Luis Fernando Delgado Muñoz

06/11/2026