Actividad 2

ACTIVIDAD 2

Caña de Azúcar: Principales Regiones del Mundo con los Mejores Rendimientos Agrícolas

Introducción

La caña de azúcar es uno de los cultivos más importantes del mundo, desempeñando un papel crucial en la producción de azúcar, bioetanol y otros derivados. Originaria del sudeste asiático, esta planta se ha extendido a diversas regiones tropicales y subtropicales, donde se han logrado impresionantes rendimientos gracias a condiciones climáticas favorables y avances en técnicas agrícolas.

El éxito en el cultivo de caña de azúcar depende en gran medida de la combinación de factores climáticos, la calidad del suelo y las prácticas de manejo.

Para maximizar el rendimiento y la calidad de la caña de azúcar, es crucial que las condiciones climáticas sean adecuadas. Entre los factores principales se incluyen:

Temperatura media entre 22.5 - 28 °C

Precipitación Anual entre 1500 - 3500 mm

Precipitación mensual entre 125 - 290 mm

Se realiza un análisis de las precipitaciones y promedio de temperatura a nivel global con datos suministrados por la pagina worldclim para el periodo de 1970 a 2000

Precipitación Global (mm) - Mensual

library(raster)

## Warning: package 'raster' was built under R version 4.3.3

## Loading required package: sp

prec_files <- list.files(
  "D:/Docs C/Desktop/Sergio/Maestria/wc2.1_10m_prec",
  pattern = "\\.tif$",
  full.names = TRUE
)

prec = stack(prec_files)
names(prec) = month.name
plot(prec)

Temperatura Promedio °C - Mensual

tavg_files = list.files("D:/Docs C/Desktop/Sergio/Maestria/wc2.1_10m_tavg", full.names = TRUE)
tavg = stack(tavg_files)
names(tavg) = month.name
plot(tavg)

Se realiza el calculo anual de la temperatura y precipitación

Temperatura Media (°C) y Precipitación Global (mm) Anual

tavg_anual = sum(tavg)/12

prec_anual = sum(prec)/12

par(mfrow = c(1,2))
plot(tavg_anual)
plot(prec_anual)

Areas con condiciones climaticas optimas en Temperatura y precipitación

optimo_tavg_anual = tavg_anual >= 22.5 & tavg_anual <= 28
optimo_prec = prec_anual >= 125 & prec_anual <= 290


par(mfrow = c(1, 2), mar = c(4, 4, 3, 1))  # Ajustar márgenes para un mejor espacio


plot(optimo_tavg_anual, 
     col = c("#f2f2f2", "#33cc33"),  # Colores suaves para el contraste
     main = "Rangos Óptimos de Temperatura",
     legend = FALSE,
     axes = FALSE)  # Desactivar ejes para claridad visual
box()  # Agregar un borde alrededor del gráfico
legend("topright", 
       legend = c("No Apta", "Apta 22.5-28°C"), 
       fill = c("#f2f2f2", "#33cc33"), 
       border = "black", 
       bty = "n", # Sin borde en la leyenda
       cex = 0.9)  # Tamaño de la leyenda ajustado

# Graficar los rangos óptimos de precipitación
plot(optimo_prec, 
     col = c("#f2f2f2", "#33ccff"),  # Colores suaves para el contraste
     main = "Rangos Óptimos de Precipitación",
     legend = FALSE,
     axes = FALSE)  # Desactivar ejes para claridad visual
box()  # Agregar un borde alrededor del gráfico
legend("topright", 
       legend = c("No Apta", "Apta 125-290mm"), 
       fill = c("#f2f2f2", "#33ccff"), 
       border = "black", 
       bty = "n", # Sin borde en la leyenda
       cex = 0.9)  # Tamaño de la leyenda ajustado

par(mfrow = c(1, 1))

Se Identifican 2 países con áreas de alto potencial para la caña de azúcar, como lo son algunas zonas de Colombia y Venezuela se realiza un corte para estas zonas con el shape global.

Se realiza un Grafico con los mapas en una escala de colores adecuada.

library(sf)

## Warning: package 'sf' was built under R version 4.3.3

## Linking to GEOS 3.11.2, GDAL 3.8.2, PROJ 9.3.1; sf_use_s2() is TRUE

library(terra)

## Warning: package 'terra' was built under R version 4.3.3

## terra 1.7.83

paisesII <- st_read("D:/Docs C/Desktop/Sergio/Maestria/ne_10m_admin_0_countries/ne_10m_admin_0_countries.shp")

## Reading layer `ne_10m_admin_0_countries' from data source 
##   `D:\Docs C\Desktop\Sergio\Maestria\ne_10m_admin_0_countries\ne_10m_admin_0_countries.shp' 
##   using driver `ESRI Shapefile'
## Simple feature collection with 258 features and 168 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -180 ymin: -90 xmax: 180 ymax: 83.6341
## Geodetic CRS:  WGS 84

# Ajustar márgenes para una visualización adecuada
par(mfrow = c(1, 1), mar = c(5, 5, 4, 1))


potencial_global = sum(optimo_tavg_anual, optimo_prec)

# Graficar el raster con los colores definidos
plot(potencial_global, 
     col = c("#f2f2f2", "#33cc33"),  
     main = "Áreas con Rangos Óptimos de Temperatura y Precipitación",
     legend = FALSE, 
     axes = TRUE)

# Añadir los límites de los países
plot(paisesII, add = TRUE, col = NA, border = "gray30", lwd = 0.5)

## Warning in plot.sf(paisesII, add = TRUE, col = NA, border = "gray30", lwd =
## 0.5): ignoring all but the first attribute

# Añadir leyenda
legend("topright", 
       legend = c("No Apta", "Apta"), 
       fill = c("#f2f2f2", "#33cc33"), 
       border = "black", 
       bty = "n", 
       cex = 0.9)  

# Restablecer márgenes
par(mfrow = c(1, 1))

# Definir la extensión para el área de interés con las nuevas coordenadas
xmin = -80
xmax = -30
ymin = -14
ymax = 15

# Crear la extensión de zoom
zoom_extent = extent(xmin, xmax, ymin, ymax)

# Recortar el área de potencial global a la extensión seleccionada
potencial_zoom = crop(potencial_global, zoom_extent)

# Verificar que los datos de paisesII tienen la proyección correcta
paisesII_valid <- st_make_valid(paisesII)  # Reparar geometrías si es necesario
paisesII_valid <- st_transform(paisesII_valid, crs = st_crs(potencial_global))  # Asegurar que ambos datasets tengan la misma proyección

# Graficar la capa recortada de 'potencial_global'
plot(potencial_zoom, col = c("#D4DCD7", "#33FFA3"), 
     main = "Paises con Rangos Optimos de Temperatura y Precipitacion", 
     legend = FALSE)

# Graficar los límites de los países sin relleno (solo fronteras)
plot(paisesII_valid, add = TRUE, border = "gray30", lwd = 0.5, col = NA)  # No relleno en los países

## Warning in plot.sf(paisesII_valid, add = TRUE, border = "gray30", lwd = 0.5, :
## ignoring all but the first attribute

# Añadir leyenda
legend("topright", legend = c("No Apto", "Apto"), 
       fill = c("#D4DCD7", "#33FFA3"), border = "black", bg = "white")

# Añadir etiquetas a los países
text(paisesII_valid, labels = paisesII_valid$NAME, cex = 0.5, col = "black", pos = 1)

paisesII_select = subset(paisesII, NAME %in% c("Colombia","Venezuela"))
potencial_recortado = mask(potencial_zoom, paisesII_select)

plot(potencial_recortado, col= c("#D4DCD7", "#D4DCD7","#33FFA3"), main = "Paises Seleccionados con \nRangos Optimos de Temperatura y Precipitacion", legend=FALSE)


# Añadir el contorno de los países seleccionados sin relleno
plot(paisesII_select, add = TRUE, border = "gray30", lwd = 0.5, col = NA)

## Warning in plot.sf(paisesII_select, add = TRUE, border = "gray30", lwd = 0.5, :
## ignoring all but the first attribute

# Añadir leyenda
legend("topright", legend = c("No Apto", "Apto"), 
       fill = c("#D4DCD7", "#33FFA3"), border = "black", bg = "white")

# Añadir los nombres de los países sobre el mapa
text(paisesII_select, labels = paisesII_select$NAME, cex = 0.6, col = "black", pos = 3)

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.

install.packages("raster")

## Warning: package 'raster' is in use and will not be installed

library(raster)

xmin=-78.8
xmax=-74.8
ymin=2
ymax=6

valle_extent = extent(xmin, xmax, ymin, ymax)
tavg_anual_valle = crop(tavg_anual, valle_extent)
prec_anual_valle = crop(prec_anual, valle_extent)

pto1 = cbind(-76.174452, 4.203629) #Punto 1
pto2 = cbind(-76.444652, 3.591829) #Punto 2
pto3 = cbind(-76.443003, 3.365636) #Punto 3

pto1_tavg = extract(tavg,pto1)
pto1_prec = extract(prec,pto1)
pto2_tavg = extract(tavg,pto2)
pto2_prec = extract(prec,pto2)
pto3_tavg = extract(tavg,pto3)
pto3_prec = extract(prec,pto3)


par(mfrow = c(1,2))
plot(tavg_anual_valle, main = "Temperatura Media Anual")
points(pto1,col="blue")
points(pto2,col="blue")
points(pto3,col="blue")
plot(paisesII, add = TRUE, col = NA, border = "gray30", lwd = 0.5)

## Warning in plot.sf(paisesII, add = TRUE, col = NA, border = "gray30", lwd =
## 0.5): ignoring all but the first attribute

plot(prec_anual_valle, main = "Precipitacion Anual")
points(pto1,col="blue")
points(pto2,col="blue")
points(pto3,col="blue")
plot(paisesII, add = TRUE, col = NA, border = "gray30", lwd = 0.5)

## Warning in plot.sf(paisesII, add = TRUE, col = NA, border = "gray30", lwd =
## 0.5): ignoring all but the first attribute

# Graficar la primera serie de datos
plot(pto2_prec[1,], 
     type = "b", 
     pch = 19, 
     xlab = "Mes", 
     ylab = "Precipitación (mm)", 
     main = "Precipitación Mensual", 
     col = "#32D66F", 
     ylim = c(min(pto2_prec[1,], pto1_prec[1,], pto3_prec[1,]) - 5, 
              max(pto2_prec[1,], pto1_prec[1,], pto3_prec[1,]) + 5))

# Añadir la segunda serie de datos
lines(pto1_prec[1,], 
      type = "b", 
      pch = 19, 
      col = "#2D97D5")

# Añadir la tercera serie de datos
lines(pto3_prec[1,], 
      type = "b", 
      pch = 19, 
      col = "#D63232")

# Añadir la leyenda
legend("topleft", 
       legend = c("Serie 1", "Serie 2", "Serie 3"), 
       col = c("#32D66F", "#2D97D5", "#D63232"), 
       lty = 1, 
       pch = 19)

# Graficar la primera serie de datos
plot(pto2_tavg[1,], 
     type = "b", 
     pch = 19, 
     xlab = "Mes", 
     ylab = "Temperatura Media (Grados)", 
     main = "Temperatura Media Mensual", 
     col = "#32D66F", 
     ylim = c(min(pto2_tavg[1,], pto1_tavg[1,], pto3_tavg[1,]) - 5, 
              max(pto2_tavg[1,], pto1_tavg[1,], pto3_tavg[1,]) + 5))

# Añadir la segunda serie de datos
lines(pto1_tavg[1,], 
      type = "b", 
      pch = 19, 
      col = "#2D97D5")

# Añadir la tercera serie de datos
lines(pto3_tavg[1,], 
      type = "b", 
      pch = 19, 
      col = "#D63232")

# Añadir la leyenda
legend("topleft", 
       legend = c("Serie 1", "Serie 2", "Serie 3"), 
       col = c("#32D66F", "#2D97D5", "#D63232"), 
       lty = 1, 
       pch = 19)

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.

# Instalar y cargar librerías necesarias
if (!require("raster")) install.packages("raster", dependencies = TRUE)
if (!require("RColorBrewer")) install.packages("RColorBrewer", dependencies = TRUE)

## Loading required package: RColorBrewer

library(raster)
library(RColorBrewer)

# Crear una función para calcular la distancia euclidiana
euclidean_distance <- function(val1, val2) {
  sqrt(sum((val1 - val2)^2))
}

# Cargar los datos de temperatura y precipitación (asegúrate de que tavg y prec estén cargados)
# Aquí usamos tavg y prec como capas globales previamente cargadas
# Debes cargar los datos con tus archivos reales

# Extender los datos de los puntos a lo largo de todo el mapa
pto1_vals <- cbind(pto1_tavg, pto1_prec)
pto2_vals <- cbind(pto2_tavg, pto2_prec)
pto3_vals <- cbind(pto3_tavg, pto3_prec)

# Crear una pila de capas para los cálculos
data_stack <- stack(tavg, prec)

# Aplicar la función de distancia para cada punto
similarity_map_pto1 <- calc(data_stack, function(x) euclidean_distance(x, pto1_vals))
similarity_map_pto2 <- calc(data_stack, function(x) euclidean_distance(x, pto2_vals))
similarity_map_pto3 <- calc(data_stack, function(x) euclidean_distance(x, pto3_vals))

# Promediar las similitudes para generar un mapa combinado
similarity_map_global <- (similarity_map_pto1 + similarity_map_pto2 + similarity_map_pto3) / 3

# Definir una paleta de colores
color_palette <- colorRampPalette(brewer.pal(9, "YlGnBu"))

# Graficar las similitudes
par(mfrow = c(1, 1))
plot(similarity_map_global, col = color_palette(100), main = "Mapa de Similaridad Global")
points(pto1, col = "red", pch = 19)
points(pto2, col = "blue", pch = 19)
points(pto3, col = "green", pch = 19)
plot(paisesII, add = TRUE, col = NA, border = "gray30", lwd = 0.5)

## Warning in plot.sf(paisesII, add = TRUE, col = NA, border = "gray30", lwd =
## 0.5): ignoring all but the first attribute

legend("bottomleft", legend = c("Punto 1", "Punto 2", "Punto 3"), 
       col = c("red", "blue", "green"), pch = 19, bty = "n")

Conclusiones

Los análisis de mapas globales de similaridad climática muestran que las regiones tropicales tienen las condiciones ideales para este cultivo.

En Latinoamérica, países como Colombia, Venezuela, Perú, Brasil y Ecuador presentan extensas zonas aptas debido a sus características climáticas favorables.

En África, varios países dentro de la región tropical también cuentan con condiciones óptimas.

El Valle del Cauca, en Colombia, es una región líder en el cultivo de caña de azúcar.

Al analizar tres puntos específicos dentro de la región, se observa que:

1- Precipitaciones: Los valores anuales y mensuales están dentro del rango óptimo, y los tres puntos presentan tendencias similares en términos de distribución.

2-Temperatura Media Mensual: Oscila entre 21°C y 24°C, un rango adecuado para el crecimiento del cultivo, aunque ligeramente inferior al óptimo ideal.

Las áreas con menor distancia euclidiana en el mapa representan regiones con condiciones climáticas más similares a las ideales para la caña de azúcar.

Estas regiones se concentran en los trópicos, lo que coincide con las principales áreas productoras actuales.

Los puntos analizados dentro del Valle del Cauca presentan buena similaridad climática con las condiciones ideales, reafirmando su posición como una región clave para este cultivo en Colombia.

Compare los mapas generados por ambas aproximaciones y concluya.