Entrega Final

Ejercicio: Mapa de aptitud para el cultivo de caña

PUntos a resolver

1. 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.

2. 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.

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.

4. 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.

Solucion punto 1

#mapa de precipitacion mundial mensual
ruta=list.files("C:/Users/andre/OneDrive/Escritorio/Maestria en Ciencia de Datos/Primer Semestre/3_Electiva_Analisis_Infor_Geografia y Esp/Modulo_1 Intro. a la Estad. Espacial/Unidad 2_ Exploracion de Datos Esp/Act/pre",full.names = TRUE,pattern = ".tif$")
prec_year=stack(ruta)
names(prec_year)=month.name

#mapa de temperatura mundial menusales
ruta1=list.files("C:/Users/andre/OneDrive/Escritorio/Maestria en Ciencia de Datos/Primer Semestre/3_Electiva_Analisis_Infor_Geografia y Esp/Modulo_1 Intro. a la Estad. Espacial/Unidad 2_ Exploracion de Datos Esp/Act/temp",full.names = TRUE,pattern = ".tif$")
temp_year=stack(ruta1)
names(temp_year)=month.name

# los mapas con precipitacion optima
prec_year_opt=prec_year>=125 & prec_year<=208

# los mapas con temperatura optima
temp_year_opt=temp_year>=20 & temp_year<=35

# condiciones optimas
aptitud_cana = temp_year_opt & prec_year_opt

#promedio de las condiciones optimas cañas mensuales
prom_aptitud_cana = mean(aptitud_cana)
colors = colorRampPalette(brewer.pal(9, "YlGn"))(100)
plot(prom_aptitud_cana, col = colors, 
     main = "Mapa promedio de aptitud para la caña de azúcar")

Tal como se puede observar en el mapa anterior, las zonas optimas para el cultivo de caña de azucar se encuentran dispersas debajo de la linea del Ecuador, lo cual indica que estas zonas cumplen con las preciptaciones y niveles de temperatura optimos.

Solucion punto 2

world = ne_countries(scale = "medium", returnclass = "sf")

# Convertir world a SpatVector
world_terra = as(world, "SpatVector")

#seleccion de paises 
# convertir el raster a puntos
puntos_aptitud = as.data.frame(rasterToPoints(prom_aptitud_cana), xy=TRUE)

#filtrar puntos con alta aptitud
puntos_alta_aptitud = puntos_aptitud[puntos_aptitud$layer > 0.7, ]

#crear un objeto Spatvector con los puntos de alta aptitud
puntos_vect = vect(puntos_alta_aptitud, geom = c('x','y'), crs = "EPSG:4326")

# Extraer el nombre del país correspondiente para cada punto en 'puntos_vect'
extraer_data =  extract(world_terra, puntos_vect)
puntos_vect$country = extraer_data$admin

# Usar aggregate() para calcular la aptitud media por país
aptitud_media_paises = aggregate(layer ~ country, data = puntos_vect, FUN = mean, na.rm = TRUE)

# Ordenar los países por aptitud media en orden descendente
aptitud_ordenada = aptitud_media_paises[order(-aptitud_media_paises$layer), ]

# Seleccionar los tres países con mayor aptitud
top_3_paises = head(aptitud_ordenada$country, 5)
print(top_3_paises)

## [1] "French Polynesia" "Malaysia"         "Peru"             "Brazil"          
## [5] "Singapore"

Como se puede observar el top 5 de los paises con las mejores condiciones para el cultivo de caña de azucar en su orden son:

1. French Polynesia.
2. Malaysia.
3. Peru.
4. Brazil
5. Singapur.

Tal como se hizo mencion, todos estos paises estan ubicados debajo de la linea del Ecuador, lo que sugiere que por encima de esta son pocos los paises con condiciones optimas de temperatura y precipitaciones al año.

En ese sentido, despues de haber elegido el top 5 de paises con las mejores condiciones optimas para el cultivo de caña de azucar procedemos a graficar 2 de estos. Por tal sentido, se escogera el 1 y el 4, con el fin de comparar un paises del occidente y oriente.

# Filtrar el polígono de Malaysia
malasia_poligon = subset(world_terra, world_terra$admin == "Malaysia")

# Convertir el SpatVector a sf
malasia_poligon_sf = st_as_sf(malasia_poligon)

## Obtiene el bounding box del mapa de Papua Nueva Guinea
malasia_poligon_bbox = st_bbox(malasia_poligon_sf)

# Crear un objeto Extent usando las coordenadas del bounding box
malasia_poligon_raster = extent(c(malasia_poligon_bbox["xmin"], malasia_poligon_bbox["xmax"],
                                 malasia_poligon_bbox["ymin"], malasia_poligon_bbox["ymax"]))

#recortar
malasia_raster = crop(prom_aptitud_cana, malasia_poligon_raster)
# Masking
malasia_raster = terra::mask(malasia_raster, malasia_poligon_sf)
plot(malasia_raster, main = "Mapa de aptitud promedio de caña de azúcar de Malaysia ")

#mapview(malasia_raster)

# Filtrar el polígono de Brazil
brasil_poligon = subset(world_terra, world_terra$admin == "Brazil")

# Convertir el SpatVector a sf
brasil_poligon_sf = st_as_sf(brasil_poligon)

## Obtiene el bounding box del mapa de brasil
brasil_poligon_bbox = st_bbox(brasil_poligon_sf)

# Crear un objeto Extent usando las coordenadas del bounding box
brasil_poligon_raster = extent(c(brasil_poligon_bbox["xmin"], brasil_poligon_bbox["xmax"],
                               brasil_poligon_bbox["ymin"], brasil_poligon_bbox["ymax"]))

#recortar con mapa promedio
brasil_raster = crop(prom_aptitud_cana, brasil_poligon_raster)
# Masking
brasil_raster = terra::mask(brasil_raster, brasil_poligon_sf)
plot(brasil_raster, main = "Mapa de aptitud promedio de caña de azúcar de Brasil")

#mapview(brasil_raster)

Solucion Punto 3

# Cali ( -76.5319, 3.4516)
# Palmira (-76.2974, 3.5386)
# Buga ( -76.2972, 3.9023)

##extraer de una coordenada de Cali
Cali=cbind(-76.5319, 3.4516)
prec1 = extract(prec_year,Cali)
temp1 = extract(temp_year, Cali)
aptc1 = extract(aptitud_cana, Cali)

##extraer de una coordenada de Palmira
Palmira=cbind(-76.2974, 3.5386)
prec2 = extract(prec_year,Palmira)
temp2 = extract(temp_year,Palmira)
aptc2 = extract(aptitud_cana,Palmira)

##extraer de una coordenada de Buga
Buga=cbind(-76.2972, 3.9023)
prec3 = extract(prec_year,Buga)
temp3 = extract(temp_year,Buga)
aptc3 = extract(aptitud_cana,Buga)

meses = month.abb

# Crear el DataFrame
df_clima3 = data.frame(
  latitud = rep(c(Cali[,2], Palmira[,2], Buga[,2]), each = 12),
  longitud = rep(c(Cali[,1], Palmira[,1], Buga[,1]), each = 12),
  Mes = rep(meses, 3),  # Repetir los nombres de los meses
  Temperatura = c(temp1[1,], temp2[1,], temp3[1,]),
  Precipitacion = c(prec1[1,], prec2[1,], prec3[1,]),
  Aptitud_cana_p = c(aptc1[1,], aptc2[1,], aptc3[1,]),
  Punto = rep(c("Cali", "Palmira", "Buga"), each = 12))

# Definir los nombres de los meses en español
meses_espanol = c("Enero", "Febrero", "Marzo", "Abril", "Mayo", 
                   "Junio", "Julio", "Agosto", "Septiembre", 
                   "Octubre", "Noviembre", "Diciembre")

# Actualizar data frame para incluir los meses en español
df_clima3$Mes = meses_espanol

# Convertir la columna 'mes' a un factor con el orden correcto
df_clima3$Mes <- factor(df_clima3$Mes, levels = meses_espanol, ordered = TRUE)

# Graficar las lineas (Temperatura)
fig <- plot_ly(df_clima3, 
               x = ~Mes, 
               y = ~Temperatura,
               color = ~Punto,
               type = 'scatter', 
               mode = 'lines + markers', 
               name = ~Punto) 
fig = fig %>%
  add_trace(y = rep(20,36),  
            x = df_clima3$Mes,
            mode = 'lines',
            name = '20 Grados',
            showlegend = FALSE)  
fig %>%
  layout(title = "Tiempo de Temperatura en el Valle del Cauca (Buga - Cali - Palmira)",
         xaxis = list(title = "Mes"),
         yaxis = list(title = "Temperatura promedio (°C)"))

# Graficar las lineas (Precipitacion)
fig <- plot_ly(df_clima3, 
               x = ~Mes, 
               y = ~Precipitacion,
               color = ~Punto,
               type = 'scatter', 
               mode = 'lines + markers', 
               name = ~Punto) 
fig = fig %>%
  add_trace(y = rep(128,36),  
            x = df_clima3$Mes,
            mode = 'lines',
            name = '128 mm',
            showlegend = FALSE)  
fig %>%
  layout(title = "Precipitación en el Valle del Cauca (Buga - Cali - Palmira)",
         xaxis = list(title = "Mes"),
         yaxis = list(title = "Preciitación promedio (mm)"))

El análisis de las series temporales de temperatura y precipitación revela que el punto dos cumple de manera más consistente con los requerimientos climáticos del cultivo de caña de azúcar. Sus temperaturas se encuentran por encima de los umbrales mínimos y sus precipitaciones superan o se aproximan a los valores mínimos mensuales en ocho meses del año, lo que indica una mayor disponibilidad hídrica y, por ende, un menor estrés hídrico para la planta

# Definir paletas de colores para temperatura y precipitación
paleta_temp <- colorNumeric(palette = "viridis", domain = df_clima3$Temperatura)
paleta_prec <- colorNumeric(palette = "plasma", domain = df_clima3$Precipitacion)

# Crear un mapa interactivo temperatura
map_temp = leaflet(df_clima3) %>%
  setView(lng = mean(df_clima3$longitud), lat = mean(df_clima3$latitud), zoom = 6) %>%
  addTiles()  # Añadir el fondo de mapa base

# Título del mapa de temperatura
map_temp <- map_temp %>%
  addControl("Mapa de Temperatura", position = "topright")  

# Añadir marcadores para cada punto
map_temp = map_temp %>%
  addCircleMarkers(~longitud, ~latitud, 
                   color = ~paleta_temp(Temperatura), 
                   radius = 5,
                   label = ~paste("Punto:", Punto, "<br>Mes:", Mes, "<br>Temperatura:", Temperatura),
                   clusterOptions = markerClusterOptions())

# Agregar líneas de tiempo por punto
for (punto in unique(df_clima3$Punto)) {
  temp_data = df_clima3 %>% filter(Punto == punto)
  
  # Agregar la línea de temperatura
  map_temp =  map_temp %>%
    addPolylines(data = temp_data,
                 lng = ~longitud,
                 lat = ~latitud,
                 color = "red", 
                 weight = 2,
                 group = "Temperatura")}



# Crear un mapa interactivo
map_prec = leaflet(df_clima3) %>%
  setView(lng = mean(df_clima3$longitud), lat = mean(df_clima3$latitud), zoom = 6) %>%
  addTiles()  # Añadir el fondo de mapa base

# Título del mapa de precipitación
map_prec <- map_prec %>%
  addControl("Mapa de Precipitación", position = "topright")  

# Añadir marcadores para cada punto
map_prec = map_prec %>%
  addCircleMarkers(~longitud, ~latitud, 
                   color = ~paleta_prec(Precipitacion), 
                   radius = 5,
                   label = ~paste("Punto:", Punto, "<br>Mes:", Mes, "<br>Precipitación:", Precipitacion),
                   clusterOptions = markerClusterOptions())

# Agregar líneas de tiempo por punto
for (punto in unique(df_clima3$Punto)) {
  prec_data = df_clima3 %>% filter(Punto == punto)
  
  # Agregar la línea de precipitacion
  map_prec =  map_prec %>%
    addPolylines(data = prec_data,
                 lng = ~longitud,
                 lat = ~latitud,
                 color = "blue", 
                 weight = 2,
                 group = "Precipitación")}

# Sincronizar los dos mapas
mapjoin <- leafsync::sync(map_temp, map_prec)

# Mostrar los mapas sincronizados
mapjoin

Solucion Punto 4

Se estandarizaron los datos del DataFrame para generar una matriz de distancias euclidianas. Esta matriz cuantifica la similitud entre puntos, permitiendo identificar patrones de agrupamiento. Posteriormente, se visualizó esta información en un mapa, superponiendo los valores de similitud para una interpretación geográfica más rica.

# Convertir la variable Aptitud_cana a numérica (0 y 1)
df_clima3 <- df_clima3 %>%
  mutate(
    Aptitud_cana_num = as.numeric(Aptitud_cana_p))

#Normalizar las variables para evitar escalas diferentes en los cálculos de distancia
df_clima3 = df_clima3 %>%
  mutate(
    Temp_norm = scale(Temperatura),
    Prec_norm = scale(Precipitacion),
    Aptitud_norm = scale(Aptitud_cana_num))

# Calcular la distancia euclidiana entre los puntos
distancia = dist(df_clima3 %>% select(Temp_norm, Prec_norm, Aptitud_norm))

# Convertir la matriz de distancia en una tabla de distancias
distancia_matriz = as.matrix(distancia)
rownames(distancia_matriz) = df_clima3$Punto
colnames(distancia_matriz) = df_clima3$Punto

# Obtener el valor medio de similitud (menor distancia) para cada punto
similaridad_media <- apply(distancia_matriz, 1, function(x) mean(x[x != 0]))

# Unir las coordenadas con el valor de similitud
df_puntos = df_clima3 %>%
  group_by(Punto) %>%
  summarise(Latitud = first(latitud),
            Longitud = first(longitud)) %>%
  mutate(Similitud = similaridad_media[Punto])

# Crear un mapa de leaflet coloreado por similitud
paleta = colorNumeric(palette = "magma", domain = df_puntos$Similitud)

mapa = leaflet(df_puntos) %>%
  addTiles() %>%
  addCircleMarkers(
    ~Longitud, ~Latitud,
    radius = 10,
    color = ~paleta(Similitud),
    stroke = FALSE,
    fillOpacity = 0.8,
    popup = ~paste0("Punto: ", Punto, "<br>",
                    "Similitud: ", round(Similitud, 2))
  ) %>%
  addLegend(pal = paleta, values = ~Similitud, title = "Similitud")

# Mostrar el mapa
mapa

Conclusion

El mapa de series de tiempo nos proporciona un análisis dinámico de las variables climáticas en cada punto, permitiendo identificar patrones estacionales y tendencias a largo plazo. Por su parte, el mapa de distancias euclidianas nos ofrece una representación estática de la similitud climática entre los puntos, basada en una métrica de distancia que considera múltiples variables. La combinación de estos dos enfoques nos permite concluir que el punto 2 no solo presenta condiciones climáticas promedio favorables para el cultivo de caña de azúcar, sino que también exhibe una menor variabilidad interanual, lo que reduce el riesgo asociado a eventos climáticos extremos.