Una agencia de planificación territorial en una región montañosa de España, específicamente en la cordillera Cantábrica, desea desarrollar un plan de manejo sostenible del territorio que equilibre la conservación del medio ambiente con el desarrollo económico local. Como experto de machine learning se le solicita lo siguiente:
Implementar técnicas de clustering (k-means, agrupamiento jerárquico) para identificar grupos naturales de áreas dentro de la región que compartan características similares.
Caracterizar los grupos identificados, describiendo sus principales características en términos de las variables cualitativas.
Etapa 1: Dominio del problema
El dataset proporcionado incluye la siguiente descripción de variables:
latitud y longitud: Coordenadas geográficas en grados decimales.
elevacion: Altura sobre el nivel del mar en metros.
pendiente: Inclinación del terreno en grados.
orientacion: Dirección de la pendiente (puntos cardinales).
tipo_suelo: Clasificación del suelo según su composición.
cobertura_vegetal: Tipo de vegetación o uso del suelo predominante.
temperatura_media: Temperatura promedio anual en grados Celsius.
indice_ndvi: Índice de Vegetación de Diferencia Normalizada, que mide la salud de la vegetación.
riesgo_erosion: Clasificación del riesgo de erosión del suelo.
A partir de la información proporcionada, se responde lo siguiente:
¿Qué exactamente deseamos hacer?
Identificar grupos de áreas dentro de la región de la coordillera.
¿Es factible alcanzar lo que buscamos con los datos disponibles?
Si, las variables proporcionadas aparentemente parecen ser suficientes para alcanzar el agrupamiento.
¿Cómo podemos lograrlo?
Aplicar técnicas no supervisadas de agrupamiento tanto jerárquico como particional.
Se adquieren los datos desde un archivo externo. Luego, para el proceso de agrupamiento, se seleccionan las variables numéricas elevacion, pendiente, precipitacion_anual, temperatura_media, indice_ndvi. Para análisis posterior al proceso de agrupamiento se usarán latitud, longitud y las variables cualitativas orientacion, tipo_suelo, cobertura_vegetal, riesgo_erosion. Las variables seleccionadas se transforman mediante escalado de variables.
Code
#Cargar datosdataset_original <-read_csv("Datos/datos_cantabrico_clusters.csv")#Preparar datos para clustering seleccionando variables numéricas y escalándolas datos_coordillera <- dataset_original %>% dplyr::select(elevacion, pendiente, precipitacion_anual, temperatura_media, indice_ndvi) %>%scale()
Etapa 4: Modelado
Agrupamiento particional
Para el modelado se considerarán varios valores de k para el algoritmo k-means. Esta es una forma para encontrar el agrupamiento óptimo de los datos.
Code
# Función para evaluar diferentes valores de k y distanciasevalua_kmeans <-function(data, k_rango) { results <-expand.grid(k = k_rango) results$silhouette <-NAfor(i in1:nrow(results)) { k <- results$k[i] km <-kmeans(data, centers = k, nstart =25) results$silhouette[i] <-mean(silhouette(km$cluster, dist(data))[, 3]) }return(results)}
Agrupamiento jerárquico
Ahora aplicamos agrupamiento jerárquico con los tres criterios de enlace: simple, completo, promedio.
Code
# Calculamos la matriz de distancia euclideadist_matrix <-dist(datos_coordillera, method ="euclidean")# Aplicamos agrupamiento jerárquico con los tres criterios de enlace estudiadoshc_simple <-hclust(dist_matrix, method ="single")hc_completo<-hclust(dist_matrix, method ="complete")hc_promedio <-hclust(dist_matrix, method ="average")
Etapa 5: Validación
Validación de método k-means
Se evalúan diversos valores de k:
Code
# Definir rangos de k y distancias a evaluark_rango <-2:50#Evaluar combinacioneseval_results <-evalua_kmeans(datos_coordillera, k_rango)eval_results
La tabla muestra los valores del valor de la Silueta. A partir de eso, aplicamos el método elbows (codo) para observar el comportamiento de los diversos parámetros considerando el valor de esta métrica de calidad del agrupamiento.
Code
# Visualizar resultadosggplot(eval_results, aes(x = k, y = silhouette)) +geom_line() +geom_point() +labs(title ="Silueta para cada valor de k (grupos)",x ="Número de grupos k",y ="Promedio de Silueta")
Una vez explorado y visualizado el rendimiento del algoritmo con diversos valores de k (el codo parece producirse en 5 y 10), seleccionamos el mejor basado en el método del codo.
Code
mejor_k <- eval_results %>%slice(which.max(silhouette)) %>%ungroup() %>%slice(which.max(silhouette))print(paste("El mejor k es", mejor_k$k, "con distancia", mejor_k$distance, "con silueta", mejor_k$silhouette))
[1] "El mejor k es 5 con distancia con silueta 0.727042855601676"
Ahora, se aplica k-means con los mejores parámetros:
Code
# Para reproducibilidad.set.seed(1987) # ejecutamos k means con mejor kmejor_kmeans <-kmeans(datos_coordillera, centers = mejor_k$k)#Mostrar resumen del mejor resultado de kmeansmejor_kmeans
#Añadir cluster al dataset originaldataset_original$cluster <-as.factor(mejor_kmeans$cluster)
Se observa que hay 191, 202, 204, 200, 203 puntos de datos que pertenecen a cada uno de los cinco grupos. De igual modo se observan los valores de cada uno de los cinco centroides.
Ahora mostramos los grupos de forma espacial en un mapa:
Code
# Crear una paleta de colores para los clusterspal <-colorFactor(palette ="Set1", domain = dataset_original$cluster)# Crear el mapa Leafletmapa_leaflet <-leaflet(dataset_original) %>%addProviderTiles(providers$OpenStreetMap) %>%# Añadir el mapa base de OpenStreetMapaddCircleMarkers(~longitud, ~latitud,color =~pal(cluster),radius =5,stroke =FALSE,fillOpacity =0.7,popup =~paste("Grupo:", cluster, "<br>","Elevación:", round(elevacion, 2), "m<br>","Pendiente:", round(pendiente, 2), "m<br>","Precipitación:", round(precipitacion_anual, 2), "m<br>","Temp. media:", round(temperatura_media, 2), "m<br>", "NDVI:", round(indice_ndvi, 2)) ) %>%addLegend("bottomright",pal = pal,values =~cluster,title ="Grupos",opacity =1 ) %>%setView(lng =-5, lat =43.1, zoom =7) # Centrar en la cordillera Cantábrica# Mostrar el mapamapa_leaflet
Caracterizar los grupos identificados.
Finalmente, caracterizamos los grupos considerando las variables cualitativas orientacion, tipo_suelo, cobertura_vegetal, riesgo_erosion.
Code
# Caracterizar los gruposcaracterizacion <- dataset_original %>%group_by(cluster) %>%summarise(count =n(),orientacion =list(table(orientacion)),tipo_suelo =list(table(tipo_suelo)),cobertura_vegetal =list(table(cobertura_vegetal)),riesgo_erosion =list(table(riesgo_erosion)) )# Mostrar la caracterización de cada grupoprint(caracterizacion)
# Función para imprimir tablas de distribución de variables categóricasprint_distribucion <-function(distribution, cluster, variable) {cat(paste("\nCluster:", cluster, "- Variable:", variable, "\n"))print(distribution)}# Imprimir las tablas de distribución de cada variable categórica por clusterfor (i in1:nrow(caracterizacion)) { cluster <- caracterizacion$cluster[i]print_distribucion(caracterizacion$orientacion[[i]], cluster, "Orientacion")print_distribucion(caracterizacion$tipo_suelo[[i]], cluster, "Tipo de Suelo")print_distribucion(caracterizacion$cobertura_vegetal[[i]], cluster, "Cobertura Vegetal")print_distribucion(caracterizacion$riesgo_erosion[[i]], cluster, "Riesgo de Erosion")}
Cluster: 1 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
27 27 23 29 20 20 27 18
Cluster: 1 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
39 41 33 36 42
Cluster: 1 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
39 38 24 44 46
Cluster: 1 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
72 59 60
Cluster: 2 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
34 20 26 25 15 30 26 26
Cluster: 2 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
44 39 45 46 28
Cluster: 2 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
47 25 46 36 48
Cluster: 2 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
78 65 59
Cluster: 3 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
28 34 24 21 21 27 26 23
Cluster: 3 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
34 53 47 40 30
Cluster: 3 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
46 31 46 42 39
Cluster: 3 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
69 67 68
Cluster: 4 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
20 30 22 25 37 22 24 20
Cluster: 4 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
41 41 39 59 20
Cluster: 4 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
45 33 43 35 44
Cluster: 4 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
67 65 68
Cluster: 5 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
21 25 30 26 29 23 22 27
Cluster: 5 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
48 34 45 40 36
Cluster: 5 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
46 34 49 37 37
Cluster: 5 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
67 59 77
Observamos que:
Grupo 1: Se caracteriza por una mayor presencia de suelos orgánicos y una distribución equilibrada en términos de orientación. La cobertura vegetal muestra una mezcla de Bosque, Urbano y Matorral, con un riesgo de erosión que no varía mucho entre Bajo, Medio y Alto.
Grupo 2: Se destaca por su alta proporción de suelos Arcillosos, Limosos y Orgánicos, además de una alta incidencia de riesgo de erosión Alto. La cobertura vegetal está dominada por Bosque, Urbano y Matorral, y la orientación varía pero con predominancia en Este.
Grupo 3: Se diferencia por una mayor proporción de suelos Arenosos y una cobertura vegetal diversa con una buena representación de Bosque y Matorral. El riesgo de erosión está bien equilibrado.
Grupo 4: Se destaca por su alta proporción de suelos Rocosos y Arenosos, con una cobertura vegetal dominada por Urbano y Pradera. El riesgo de erosión es alto en este grupo, indicando áreas potencialmente más vulnerables a la erosión.
Grupo 5: Se caracteriza por su alta proporción de suelos Arcillosos y Limosos, y una cobertura vegetal que incluye una buena cantidad de Bosque y Matorral. El riesgo de erosión es predominantemente Medio, con una distribución más equilibrada comparado con otros grupos.
Validación de método jerárquico
Ahora evaluamos el rendimiento de los tres criterios considerando puntos de corte que generen entre 2 y 50 grupos.
Code
# Funicón para calcular le promedio del silueta para el rango de k grupos.calc_avg_sil <-function(k, hc_method) { cut <-cutree(hc_method, k = k) sil <-silhouette(cut, dist_matrix)return(mean(sil[, 3]))}# Calcula el promedio de siuelta para cada criterio de enlacek_rango <-2:50sil_simple <-sapply(k_rango, calc_avg_sil, hc_method = hc_simple)sil_completo <-sapply(k_rango, calc_avg_sil, hc_method = hc_completo)sil_promedio <-sapply(k_rango, calc_avg_sil, hc_method = hc_promedio)# Combina resultados resultssil_df <-data.frame(k = k_rango,Simple = sil_simple,Completo = sil_completo,Promedio = sil_promedio)
Mostramos el rendimiento:
Code
# Plot de Silueta ggplot(sil_df, aes(x = k)) +geom_line(aes(y = Simple, color ="Simple")) +geom_line(aes(y = Completo, color ="Completo")) +geom_line(aes(y = Promedio, color ="Promedio")) +labs(x ="Número de grupos (k)", y ="Promedio de Silueta",title ="Análisis de rendimiento de métodos jerárquicos",color ="Criterio de enlace") +theme_minimal() +theme(legend.position ="bottom")
Ahora determinamos cuál de los tres criterios es que le mejor agrupamiento ofrece.
Code
# Encontrar el mejor kmejor_enlace <-c("Simple", "Completo", "Promedio")[which.max(c(max(sil_simple), max(sil_completo), max(sil_promedio)))]mejor_k <- k_rango[which.max(sil_df[[mejor_enlace]])]cat("Mejor criterio de enlace:", mejor_enlace, "\n")
El mejor rendimiento se alcanza con agrupamiento con k=5 y criterio de enlace simple, lo que proporciona una silueta de 0.72, indicando que las estructuras grupales encontradas son sólidas.
Code
# Definir la altura de punto de corte.cut_simple <-cutree(hc_simple, k = mejor_k)#Añadir cluster al dataset originaldataset_original$cluster_dendro <-as.factor(cut_simple)# Función para crear y plotear un dendrograma coloreadoplot_dendrograma_coloreado <-function(hc, cut, title) {# Convertir el objeto hclust a un objeto dendrogram dend <-as.dendrogram(hc)# Colorear las ramas dend <-color_branches(dend, k = mejor_k)# Crear una paleta de colores distintivos col_palette <-rainbow_hcl(mejor_k)# Colorear las etiquetas de las hojas dend <-color_labels(dend, col = col_palette[cut])# Crear el plotplot(dend, main = title, ylab ="Altura/Distancia", xlab ="Observaciones",sub =paste("Número de clusters:", mejor_k))# Añadir rectángulos para los clustersrect.dendrogram(dend, k = mejor_k, border = col_palette, lwd =2)# Añadir una leyendalegend("topright", legend =paste("Grupo", 1:mejor_k), fill = col_palette, border = col_palette,title ="Grupos")}# Plotear el dendrograma coloreadoplot_dendrograma_coloreado(hc_simple, cut_simple, "Dendrograma con enlace simple")
Caracterizar los grupos identificados.
Finalmente, caracterizamos los grupos considerando las variables orientacion, tipo_suelo, cobertura_vegetal, riesgo_erosion.
Code
# Caracterizar los gruposcaracterizacion <- dataset_original %>%group_by(cluster_dendro) %>%summarise(count =n(),orientacion =list(table(orientacion)),tipo_suelo =list(table(tipo_suelo)),cobertura_vegetal =list(table(cobertura_vegetal)),riesgo_erosion =list(table(riesgo_erosion)) )# Mostrar la caracterización de cada grupoprint(caracterizacion)
# Función para imprimir tablas de distribución de variables categóricasprint_distribucion <-function(distribution, cluster_dendro, variable) {cat(paste("\nCluster:", cluster_dendro, "- Variable:", variable, "\n"))print(distribution)}# Imprimir las tablas de distribución de cada variable categórica por clusterfor (i in1:nrow(caracterizacion)) { cluster <- caracterizacion$cluster_dendro[i]print_distribucion(caracterizacion$orientacion[[i]], cluster, "Orientacion")print_distribucion(caracterizacion$tipo_suelo[[i]], cluster, "Tipo de Suelo")print_distribucion(caracterizacion$cobertura_vegetal[[i]], cluster, "Cobertura Vegetal")print_distribucion(caracterizacion$riesgo_erosion[[i]], cluster, "Riesgo de Erosion")}
Cluster: 1 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
20 30 22 25 37 22 24 20
Cluster: 1 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
41 41 39 59 20
Cluster: 1 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
45 33 43 35 44
Cluster: 1 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
67 65 68
Cluster: 2 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
28 34 24 21 21 27 26 23
Cluster: 2 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
34 53 47 40 30
Cluster: 2 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
46 31 46 42 39
Cluster: 2 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
69 67 68
Cluster: 3 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
34 20 26 25 15 30 26 26
Cluster: 3 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
44 39 45 46 28
Cluster: 3 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
47 25 46 36 48
Cluster: 3 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
78 65 59
Cluster: 4 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
27 27 23 29 20 20 27 18
Cluster: 4 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
39 41 33 36 42
Cluster: 4 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
39 38 24 44 46
Cluster: 4 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
72 59 60
Cluster: 5 - Variable: Orientacion
orientacion
E N NE NW S SE SW W
21 25 30 26 29 23 22 27
Cluster: 5 - Variable: Tipo de Suelo
tipo_suelo
Arcilloso Arenoso Limoso Orgánico Rocoso
48 34 45 40 36
Cluster: 5 - Variable: Cobertura Vegetal
cobertura_vegetal
Bosque Cultivo Matorral Pradera Urbano
46 34 49 37 37
Cluster: 5 - Variable: Riesgo de Erosion
riesgo_erosion
Alto Bajo Medio
67 59 77
Observamos que:
Grupo 1: Se caracteriza por una distribución mayoritariamente dirigida al sur, con una mayor presencia de suelos orgánicos. La cobertura vegetal muestra una mezcla de Bosque y Urbano, con un riesgo de erosión que no varía mucho entre Bajo, Medio y Alto..
Grupo 2: Se destaca por su alta proporción de suelos Arenosos y Limosos, además de un riesgo de erosión equilibrado. La cobertura vegetal está dominada por Bosque y Matorral, y la orientación varía pero con predominancia en Norte..
Grupo 3: Se diferencia por una mayor proporción de suelos Orgánicos, Limosos y Arcillosos. Una cobertura vegetal diversa con una buena representación de Bosque , Urbano y Matorral. El riesgo de erosión es Alto.
Grupo 4: Se destaca por su alta proporción de suelos Rocosos y Arcilloso, con una cobertura vegetal dominada por Urbano y Pradera. El riesgo de erosión es alto en este grupo, indicando áreas potencialmente más vulnerables a la erosión..
Grupo 5: Se caracteriza por su alta proporción de suelos Arcillosos con una cobertura vegetal que incluye una buena cantidad de Bosque y Matorral. El riesgo de erosión es predominantemente Medio, con una distribución más equilibrada comparado con otros grupos.
