Objetivo

Ordenar y preparar los datos históricos de temperatura promedio mensual global, obtenidos de ā€œNASA Goddard Institute for Space Studies (GISS) – GISTEMPā€.

Visitar en: https://data.giss.nasa.gov/gistemp/

# Para limpiar los objetos del Ɣrea de trabajo
rm(list = ls())
# Para limpiar la consola
cat('\f')

Código

Iniciamos definiendo un directorio de trabajo

location <- ("C:/UTEC/Clases x Senestre/2024-2/Mitigación y adaptación al cambio climÔtico/Evaluaciones/Eva 1")
# Establecemos la dirección de trabajo}
setwd(location)
# Verificamos el directorio de trabajo actual
getwd()
## [1] "C:/UTEC/Clases x Senestre/2024-2/Mitigación y adaptación al cambio climÔtico/Evaluaciones/Eva 1"

Mediante una función llamaremos a los paquetes y en caso de ser necesario se instalarÔ el faltante

paquetes <- c("readr","dplyr","tidyr","ggplot2","terra","readxl","mice","zoo")
# Instalamos los paquetes que aun no estƔn en el sistema
installed_packages <- paquetes %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
  install.packages(paquetes[!installed_packages])
}
# Cargamos los paquetes a utilizar
invisible(lapply(paquetes, library, character.only = TRUE))

Cargamos los documento y los guardamos en dataframe

DF_Temp<-read_csv(file = "Datos históricos de temperatura global.csv")
## Rows: 145 Columns: 19
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): Aug, Sep, Oct, Nov, Dec, J-D, D-N, DJF, JJA, SON
## dbl  (9): Year, Jan, Feb, Mar, Apr, May, Jun, Jul, MAM
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
DF_CO2<-read_csv(file = "Concentraciones de CO2.csv")
## Rows: 797 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (8): Year, Month, decimal date, Average, deseasonalized, ndays, sdev, unc
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Borraremos las columnas no deseadas y nos quedaremos solo con las columnas de los meses

# Borrar columnas no deseadas
Temp_limpia <- subset(DF_Temp, select = -c(14:19))
CO2 <- subset(DF_CO2, select = -c(3,5:8))
# Otra opción
# Temp[, 14:19] <- NULL

Reemplazaremos aquellas celdas que tienen ā€œ***ā€ por NA y haremos que las demĆ”s columnas tengan tengan un tipo de variable numĆ©rico

Temp_limpia <- Temp_limpia %>%
  mutate(across(Aug:Dec, ~ na_if(., "***"))) %>%
  mutate(across(Aug:Dec, as.double))

Transformamos el dataframe de temperatura para obtener los valores de temp. promedio mensual en una sola columna

Temp <- Temp_limpia %>%
  pivot_longer(
    cols = Jan:Dec,            # Especifica las columnas de los meses
    names_to = "Month",          # Nombre de la nueva columna para los meses
    values_to = "Average"     # Nombre de la nueva columna para los valores
  )

Verificamos la cantidad de datos NA que tiene nuestro dataframe

apply(Temp, MARGIN = 2, function(x) sum(is.na(x)))
##    Year   Month Average 
##       0       0       5
apply(CO2, MARGIN = 2, function(x) sum(is.na(x)))
##    Year   Month Average 
##       0       0       0

Antes de realizar el grƔfico, veremos donde se ubican nuestros datos faltantes. Y asƭ decidir el tratamiento que se le darƔ a los NA

# Con esta función ubicaremos los NA
find_na_positions <- function(Temp) {
  na_list <- lapply(Temp, function(x) which(is.na(x)))
  return(na_list)
}
# Aplicamos la función al dataframe
find_na_positions(Temp)
## $Year
## integer(0)
## 
## $Month
## integer(0)
## 
## $Average
## [1] 1736 1737 1738 1739 1740

Para fines de este caso eliminaremos los NA del dataframe, porque hacen referencia a los meses de Ago:Dec del 2024

# Eliminación de filas con NA
Temp <- Temp[complete.cases(Temp), ]

Nuestro dataframe de Temp ya no tiene valores faltantes, pero la columna de meses estƔ representado en carƔcteres, lo modificaremos para que sea igual al dataframe de CO2

# Modificación de la columna Month
Temp$Month <- as.numeric(factor(Temp$Month, levels = month.abb))

Se calcula el promedio movil para cada variable

Temp$"Moving average" <- rollmean(Temp$Average, k = 12, fill = NA, align = "right")
CO2$"Moving average" <- rollmean(CO2$Average, k = 12, fill = NA, align = "right")

Realizamos la grƔfica de temperatura

# Agregamos una columna fecha a nuestro dataframe que incluya el mes y el aƱo
Temp <- Temp %>%
  mutate(Month = as.numeric(Month),  # Convertir a numƩrico
         Month = sprintf("%02d", Month),  # Asegurarse de que tenga dos dĆ­gitos
         Fecha = as.Date(paste(Year, Month, "01", sep = "-")))  # Crear la columna Fecha

ggplot() +
  # Línea para la variación de la temperatura mensual usando
  geom_line(data = Temp, aes(x = Fecha, y = Average, color = "Promedio mensual"), linewidth = 1, alpha = 0.7) +
  # LĆ­nea para el promedio movil usando la columna
  geom_line(data = Temp, aes(x = Fecha, y = `Moving average`, color = "Promedio móvil"), linewidth = 1) +
  
  # Etiquetas y tĆ­tulos
  labs(x = "Año", y = "Anomalía de temperatura (°C)",
       title = "Estimaciones del promedio de temperatura global",
       color = "Leyenda") +
  
  # Configuración de breaks del eje x para que empiece en 1880 y tenga intervalos de 10 años
  scale_x_date(breaks = seq(as.Date("1880-01-01"), as.Date("2020-01-01"), by = "10 years"),
               date_labels = "%Y",
               limits = as.Date(c("1880-01-01", NA))) +
  
  # Definición los colores manualmente para las líneas
  scale_color_manual(values = c("Promedio mensual" = "blue", "Promedio móvil" = "red")) +
  
  # Tema minimalista y ajustes de estilo
  theme_minimal() +
  theme(
    panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5),  # Borde alrededor del grƔfico
    legend.position = "inside",  
    legend.justification = c("right", "bottom"),  
    legend.direction = "horizontal",  
    legend.title = element_text(size = 10),  
    legend.text = element_text(size = 9),  
    legend.title.position = "top"
  )

Realizamos la grƔfica de CO2

CO2 <- CO2 %>%
  mutate(Month = as.numeric(Month),  # Convertir a numƩrico
         Month = sprintf("%02d", Month),  # Asegurarse de que tenga dos dĆ­gitos
         Fecha = as.Date(paste(Year, Month, "01", sep = "-")))  # Crear la columna Fecha

ggplot() +
  # Línea para la variación de la concentración de CO2 mensual
  geom_line(data = CO2, aes(x = Fecha, y = Average, color = "Concentración de CO2"), linewidth = 1, alpha = 0.7) +
  # LĆ­nea para el promedio movil usando la columna
  geom_line(data = CO2, aes(x = Fecha, y = `Moving average`, color = "Promedio móvil"), linewidth = 1) +
  
  # Configuración los labels
  labs(x = "Año", y = "Fracción molar de CO2 (ppm)",
       title = "Media mensual goblal de CO2",
       color = "Leyenda") +
  
  # Configuración de breaks del eje X
  scale_x_date(breaks = seq(as.Date("1958-01-01"), as.Date("2024-01-01"), by = "10 years"),
               date_labels = "%Y",
               limits = as.Date(c("1958-01-01", NA))) +
  
  # Definición los colores manualmente para las líneas
  scale_color_manual(values = c("Concentración de CO2" = "blue", "Promedio móvil" = "red")) +
  
  # Tema minimalista
  theme_minimal() +
  theme(
    panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5),  
    legend.position = "inside",  
    legend.justification = c("right", "bottom"),
    legend.direction = "horizontal",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    legend.title.position = "top"
  )

Realizamos el filtrado de fechas para tener dataframes de igual extensión

Temp_filtrado <- Temp %>%
  filter(Fecha >= as.Date("1958-03-01"))

# Unimos los dataframes y seleccionar solo las columnas deseadas en una sola lĆ­nea
Temp_y_CO2 <- merge(Temp_filtrado, CO2, by = c("Year", "Month", "Fecha"), suffixes = c("_Temp", "_CO2")) %>%
  select(Year, Month, Fecha, Average_Temp, Average_CO2)

Realizamos el grafico de correlación

# Calcular el modelo lineal para obtener el R²
modelo <- lm(Average_Temp ~ Average_CO2, data = Temp_y_CO2)
r_squared <- summary(modelo)$r.squared

# Crear el grƔfico
ggplot(Temp_y_CO2, aes(x = Average_CO2, y = Average_Temp)) +
  # Cruces azules mƔs pequeƱas pero gruesas
  geom_point(aes(color = "Datos"), shape = 4, size = 0.8, stroke = 2, alpha = 0.5) + 
  # Línea de regresión con leyenda
  geom_smooth(aes(color = "Línea de Regresión"), method = "lm", se = FALSE, linewidth = 1) +  
  
  # Añadir R² en el caption
  labs(x = "Concentración de CO2 (ppm)", 
       y = "Variación de temperatura (°C)",
       title = "Correlación entre Concentración de CO2 y Variación de Temperatura",
       color = "Leyenda") +  # AƱadir leyenda
  
  # Configuración del eje X
  scale_x_continuous(breaks = seq(310, 430, by = 10), limits = c(310, 430)) +  
  # Configuración del eje Y
  scale_y_continuous(breaks = seq(-0.25, 1.5, by = 0.25), limits = c(-0.35, 1.5)) +  
  
  # Colores manuales para la leyenda
  scale_color_manual(values = c("Datos" = "blue", "Línea de Regresión" = "red")) +  

  # Añadir una anotación de texto para mostrar el valor de R²
  annotate("text", x = 420, y = 0.65, label = paste("R² =", round(r_squared, 3)), color = "black", size = 3.5, hjust = 0) +

  # Tema minimalista
  theme_minimal() +  
  theme(
    panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5),  # Bordes del grƔfico
    legend.position = "inside",  
    legend.justification = c("left", "top"),
    legend.direction = "horizontal",
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    legend.title.position = "top"
  )
## `geom_smooth()` using formula = 'y ~ x'