Descripción

En este momento te propongo ver un video en el cual se explica un caso y los datos que se suministran. Una vez hayas observado el video, deberás seguir las instrucciones que se comparten a continuación con el fin de realizar una exploración de datos espaciales:

Utilizando los datos de clima de línea base a nivel global, genere un código en R que permita construir mapas de aptitud en términos climáticos para la caña de azúcar (con base en los rangos óptimos). Grafique los mapas con una escala de colores adecuada. Identifique 2 o 3 países con áreas de alto potencial para la caña de azúcar y realice un corte para estas zonas con el shape global. Grafique los mapas con una escala de colores adecuada. Identificar algunos puntos (2 o 3) al azar en la región del valle del cauca (use google maps) y extraer la información de clima. Grafique las series de tiempo de temperatura y precipitación. Por medio de alguna métrica de similaridad (ejemplo: distancia euclidiana) genere un código en R que permita identificar mapas de similaridad a nivel global para los sitios identificados en 3. Grafique los mapas con una escala de colores adecuada. Compare los mapas generados por ambas aproximaciones y concluya.

1.1 Temperatura global

library(geodata) # Paquete para descargar datos geográficos
## Warning: package 'geodata' was built under R version 4.4.3
library(terra) # Paquete para manejar objetos espaciales (SpatRaster) que genera geodata


tmin_global_monthly <- geodata::worldclim_global(var = "tmin", res = 10, path = tempdir())


tmin_global_annual_C <- mean(tmin_global_monthly) / 10

# Graficar el mapa de temperatura mínima promedio anual global
terra::plot(tmin_global_annual_C,
            main = expression("Temperatura Mínima Promedio Anual Global ("*degree*"C)"), # Título del gráfico con expression
            col = hcl.colors(100, "Inferno", rev = TRUE), # Escala de colores
            plg = list(title = expression("Temperatura ("*degree*"C)"), # Leyenda con expression
                       side = 4, font = 2, line = 2.5, cex = 0.8))

Rangos Óptimos para la Caña de Azúcar

Temperatura Media Anual: Óptima entre 18°C y 32°C. Precipitación Anual: Óptima entre 1500 mm y 3500 mm.

# Descargar datos globales
temperatura_global <- worldclim_global(var = "tavg", res = 5, path = "Datos", version = 2.1)
precipitacion_global <- worldclim_global(var = "prec", res = 5, path = "Datos", version = 2.1)

# Calcular temperatura media anual y precipitación total anual
temp_media <- mean(temperatura_global)
## |---------|---------|---------|---------|=========================================                                          
prec_media <- sum(precipitacion_global)
## |---------|---------|---------|---------|=========================================                                          
# Definir rangos aptos para temperatura y precipitación
rango_t_apto <- (temp_media >= 22.5) & (temp_media <= 28)
rango_p_apto <- (prec_media >= 1500) & (prec_media <= 3500)


# Paleta para temperatura media 
my_palette_t <- colorRampPalette(c("#56B4E9", "#F0E442", "#E69F00")) 

# Graficar temperatura media anual

plot(temp_media, col = my_palette_t(20), main = "Temperatura media anual (°C)",
     legend.args=list(text='°C', side=4, font=2, line=2.5, cex=0.8))
## Warning in plot.window(...): "legend.args" es un parámetro gráfico inválido
## Warning in plot.xy(xy, type, ...): "legend.args" es un parámetro gráfico
## inválido
## Warning in title(...): "legend.args" es un parámetro gráfico inválido

# Paleta para precipitación: verde claro a azul oscuro
my_palette_p <- colorRampPalette(c("#A8E", "#379"))

# Suma anual de precipitación global
prec_media <- sum(precipitacion_global)
## |---------|---------|---------|---------|=========================================                                          
# Graficar precipitación acumulada anual con nueva paleta
plot(prec_media, col = my_palette_p(20), main = "Precipitación acumulada anual (mm)",
     legend.args=list(text='mm', side=4, font=2, line=2.5, cex=0.8))
## Warning in plot.window(...): "legend.args" es un parámetro gráfico inválido
## Warning in plot.xy(xy, type, ...): "legend.args" es un parámetro gráfico
## inválido
## Warning in title(...): "legend.args" es un parámetro gráfico inválido

# Paleta para áreas aptas: gris claro y naranja fuerte
col_aptos <- c("lightgrey", "#FF6")  # naranja fuerte

# Graficar áreas aptas para precipitación
plot(rango_p_apto, col = col_aptos, legend = FALSE,
     main = "Áreas con precipitación entre 1500 mm y 3500 mm")

# Leyenda manual
legend("topright", legend = c("No apto", "Apto"), fill = col_aptos)

# Cargar datos climáticos globales
temperatura_global <- worldclim_global(var = "tavg", res = 5, path = "Datos", version = 2.1)
precipitacion_global <- worldclim_global(var = "prec", res = 5, path = "Datos", version = 2.1)

# Calcular temperatura media anual global 
temp_media_global <- mean(temperatura_global)
## |---------|---------|---------|---------|=========================================                                          
# Calcular precipitación acumulada anual global 
prec_media_global <- sum(precipitacion_global)
## |---------|---------|---------|---------|=========================================                                          
# Función para recortar raster y calcular zonas aptas
zonas_aptas_pais <- function(pais_sf, temp_raster, prec_raster) {
  ext_p <- terra::ext(pais_sf)
  temp_crop <- terra::crop(temp_raster, ext_p)
  temp_mask <- terra::mask(temp_crop, terra::vect(pais_sf))
  
  prec_crop <- terra::crop(prec_raster, ext_p)
  prec_mask <- terra::mask(prec_crop, terra::vect(pais_sf))
  
  rango_temp <- (temp_mask >= 22.5) & (temp_mask <= 28)
  rango_prec <- (prec_mask >= 1500) & (prec_mask <= 3500)
  zonas_aptas <- rango_temp & rango_prec
  
  return(list(temp = temp_mask, prec = prec_mask, aptas = zonas_aptas))
}

# Obtener shapes de países
map_paises <- rnaturalearth::ne_countries(scale = "medium", returnclass = "sf")
colombia <- subset(map_paises, admin == "Colombia")
India <- subset(map_paises, admin == "India")

# Aplicar función para ambos países
res_colombia <- zonas_aptas_pais(colombia, temp_media_global, prec_media_global)
res_india <- zonas_aptas_pais(India, temp_media_global, prec_media_global)

# Paletas para graficar
paleta_temp <- colorRampPalette(c("#56B", "#F0E", "#E69"))(20)
paleta_prec <- colorRampPalette(c("#A8E", "#379"))(20)

# Graficar resultados Colombia
plot(res_colombia$temp, col = paleta_temp, main = "Temperatura media en Colombia")
plot(sf::st_geometry(colombia), add = TRUE)

plot(res_colombia$prec, col = paleta_prec, main = "Precipitación total en Colombia")
plot(sf::st_geometry(colombia), add = TRUE)

plot(res_colombia$aptas, col = c("lightgrey", "yellow"), main = "Zonas aptas en Colombia")
legend("topright", legend = c("No apto", "Apto"), fill = c("lightgrey", "yellow"))
plot(sf::st_geometry(colombia), add = TRUE)

# Graficar resultados India
plot(res_india$temp, col = paleta_temp, main = "Temperatura media en India")
plot(sf::st_geometry(India), add = TRUE)

plot(res_india$prec, col = paleta_prec, main = "Precipitación total en India")
plot(sf::st_geometry(India), add = TRUE)

plot(res_india$aptas, col = c("lightgrey", "yellow"), main = "Zonas aptas en India")
legend("topright", legend = c("No apto", "Apto"), fill = c("lightgrey", "yellow"))
plot(sf::st_geometry(India), add = TRUE)

library(terra)
library(dplyr)
library(tidyr)
library(stringr)


# Elegir 3 puntos en el Valle del Cauca (usados desde Google Maps)

puntos <- data.frame(
  nombre = c("Palmira", "Tuluá", "Buenaventura"),
  lon = c(-76.297, -76.195, -77.028),   # Longitudes
  lat = c(3.539, 4.084, 3.876)          # Latitudes
)

# Convertir a objeto espacial
puntos_spat <- vect(puntos, geom = c("lon", "lat"), crs = crs(tavg_global))

Se seleccionaron las regiones de Palmira, Tuluá y Buenaventura

library(tibble)
library(dplyr)
library(tidyr)
library(ggplot2)
library(terra)

# Tus puntos con nombres y coordenadas
puntos <- data.frame(
  nombre = c("Cali", "Palmira", "Buga"),
    lon = c(-76.5320, -76.3030, -76.2979),
  lat = c(3.4516, 3.5396, 3.9009)
)
# Convertir a objeto spatial para terra
puntos_vect <- vect(puntos, geom = c("lon", "lat"), crs = crs(temperatura_global))

# Extraer valores mensuales de temperatura y precipitación
temp_ts <- terra::extract(temperatura_global, puntos_vect)
prec_ts <- terra::extract(precipitacion_global, puntos_vect)

# Procesar temperatura en formato largo
temp_long <- temp_ts %>%
  select(-ID) %>%
  mutate(punto = puntos$nombre) %>%
  pivot_longer(-punto, names_to = "mes", values_to = "temp") %>%
  filter(!is.na(temp))

# Extraer el número del mes desde el nombre original
temp_long$mes <- str_sub(temp_long$mes, -2, -1)   # extrae los dos últimos caracteres
temp_long$mes <- as.numeric(as.character(temp_long$mes))  # convierte a num

# Procesar precipitación en formato largo
prec_long <- prec_ts %>%
  select(-ID) %>%
  mutate(punto = puntos$nombre) %>%
  pivot_longer(-punto, names_to = "mes", values_to = "prec") %>%
  filter(!is.na(prec))

prec_long$mes <- str_sub(prec_long$mes, -2, -1)
prec_long$mes <- as.numeric(as.character(prec_long$mes))

# Etiquetas para meses
month_labels <- c("Ene", "Feb", "Mar", "Abr", "May", "Jun",
                  "Jul", "Ago", "Sep", "Oct", "Nov", "Dic")

# Dibujar gráficos con base R

colores <- rainbow(length(unique(temp_long$punto)))

# Gráfico temperatura
plot(1, type = "n", xlim = c(1, 12), ylim = range(temp_long$temp, na.rm = TRUE),
     xlab = "Mes", ylab = "°C", xaxt = "n", main = "Temperatura Media Mensual")
axis(1, at = 1:12, labels = month_labels)
puntos_unicos <- unique(temp_long$punto)
for (i in seq_along(puntos_unicos)) {
  datos_punto <- temp_long[temp_long$punto == puntos_unicos[i], ]
  lines(datos_punto$mes, datos_punto$temp, col = colores[i], lwd = 2)
}
legend("topright", legend = puntos_unicos, col = colores, lwd = 2, cex = 0.8)

# Gráfico precipitación
plot(1, type = "n", xlim = c(1, 12), ylim = range(prec_long$prec, na.rm = TRUE),
     xlab = "Mes", ylab = "mm", xaxt = "n", main = "Precipitación Mensual")
axis(1, at = 1:12, labels = month_labels)
puntos_unicos <- unique(prec_long$punto)
for (i in seq_along(puntos_unicos)) {
  datos_punto <- prec_long[prec_long$punto == puntos_unicos[i], ]
  lines(datos_punto$mes, datos_punto$prec, col = colores[i], lwd = 2)
}
legend("topright", legend = puntos_unicos, col = colores, lwd = 2, cex = 0.8)

library(terra)
library(dplyr)
library(rnaturalearth)
library(sf)

# Descargar datos climáticos si no existen
tavg <- geodata::worldclim_global(var = "tavg", res = 10, path = "datos_climaticos")
prec <- geodata::worldclim_global(var = "prec", res = 10, path = "datos_climaticos")

# Convertir temperatura a grados Celsius
tavg_celsius <- tavg / 10

# Unir capas
clima_global <- c(tavg_celsius, prec)
names(clima_global) <- c(paste0("tavg_", 1:12), paste0("prec_", 1:12))

# Puntos de interés en el Valle del Cauca
puntos <- data.frame(
  nombre = c("Cali", "Palmira", "Buga"),
  lon = c(-76.5320, -76.3030, -76.2979),
  lat = c(3.4516, 3.5396, 3.9009)
)
puntos_vect <- vect(puntos, geom = c("lon", "lat"), crs = crs(clima_global))

# Extraer valores climáticos para cada punto
valores_puntos <- terra::extract(clima_global, puntos_vect)[,-1]

# Normalizar temperatura (ya está en °C)
global_vals <- terra::values(clima_global)

# Función para calcular distancia euclidiana a un vector referencia
calc_distancia <- function(ref_vec) {
  dist_vec <- apply(global_vals, 1, function(x) sqrt(sum((x - ref_vec)^2, na.rm=TRUE)))
  dist_rast <- clima_global[[1]]
  terra::values(dist_rast) <- dist_vec
  return(dist_rast)
}

# Calcular mapas de distancia para cada punto
mapas_distancia <- lapply(seq_len(nrow(puntos)), function(i) {
  calc_distancia(as.numeric(valores_puntos[i,]))
})
names(mapas_distancia) <- puntos$nombre

# Obtener shape mundial y convertir a objeto terra
world <- rnaturalearth::ne_countries(scale = "medium", returnclass = "sf")
world_vect <- terra::vect(world)

# Crear raster máscara
mask_rast <- terra::rasterize(world_vect, clima_global[[1]], field = 1)

# Aplicar máscara
mapas_distancia_masked <- lapply(mapas_distancia, function(rast) {
  terra::mask(rast, mask_rast)
})

# Graficar mapas con máscara
for (nombre in names(mapas_distancia_masked)) {
  plot(mapas_distancia_masked[[nombre]],
       main = paste("Similaridad climática -", nombre),
       col = hcl.colors(50, "YlGnBu", rev = TRUE),
       axes = FALSE)
}

Conclusión

En el análisis de este caso de busquedad de regiones con un clima que favoresca el cultivo de cañan en India, donde se observaron varias regiones que presentan las temperaturas y pluviosidad anual similar a las requeridas por el cultivo y manejadas en Colombia. Esto muy probable a que estas regiones se situan en la lina trópical y presentan temperaturas y lluvias. Se identificaron en el analisis global otras regiones como Africa y Australia, y otras islas.

En las busqueda de más areas para implemntacion del cultivo en Colombia, se evidenciaron varias zonas que estan cercas a Cali, se situan con similitudes en las condiciones climaticas. Lo cual permite que una maplia gama de regiones puedan ser opcionales para este cultivo.