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')
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'