#librerias
library(readxl)
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(ecodist)
library(NbClust)
library(vegan)
## Cargando paquete requerido: permute
## 
## Adjuntando el paquete: 'vegan'
## The following objects are masked from 'package:ecodist':
## 
##     mantel, pco
  1. (2 puntos) Calcula los componentes principales, con las variables que sean adecuadas, para el conjunto de datos mtcars, disponible en R. Evalua si es necesario trabajar con datos escalados o no. Menciona cual es la proporcion de la varianza explicada en los primeros dos componentes principales.
str(mtcars)
## 'data.frame':    32 obs. of  11 variables:
##  $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
##  $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...
##  $ disp: num  160 160 108 258 360 ...
##  $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...
##  $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
##  $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...
##  $ qsec: num  16.5 17 18.6 19.4 17 ...
##  $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...
##  $ am  : num  1 1 1 0 0 0 0 0 0 0 ...
##  $ gear: num  4 4 4 3 3 3 3 4 4 4 ...
##  $ carb: num  4 4 1 1 2 1 4 2 2 4 ...
summary(mtcars)
##       mpg             cyl             disp             hp       
##  Min.   :10.40   Min.   :4.000   Min.   : 71.1   Min.   : 52.0  
##  1st Qu.:15.43   1st Qu.:4.000   1st Qu.:120.8   1st Qu.: 96.5  
##  Median :19.20   Median :6.000   Median :196.3   Median :123.0  
##  Mean   :20.09   Mean   :6.188   Mean   :230.7   Mean   :146.7  
##  3rd Qu.:22.80   3rd Qu.:8.000   3rd Qu.:326.0   3rd Qu.:180.0  
##  Max.   :33.90   Max.   :8.000   Max.   :472.0   Max.   :335.0  
##       drat             wt             qsec             vs        
##  Min.   :2.760   Min.   :1.513   Min.   :14.50   Min.   :0.0000  
##  1st Qu.:3.080   1st Qu.:2.581   1st Qu.:16.89   1st Qu.:0.0000  
##  Median :3.695   Median :3.325   Median :17.71   Median :0.0000  
##  Mean   :3.597   Mean   :3.217   Mean   :17.85   Mean   :0.4375  
##  3rd Qu.:3.920   3rd Qu.:3.610   3rd Qu.:18.90   3rd Qu.:1.0000  
##  Max.   :4.930   Max.   :5.424   Max.   :22.90   Max.   :1.0000  
##        am              gear            carb      
##  Min.   :0.0000   Min.   :3.000   Min.   :1.000  
##  1st Qu.:0.0000   1st Qu.:3.000   1st Qu.:2.000  
##  Median :0.0000   Median :4.000   Median :2.000  
##  Mean   :0.4062   Mean   :3.688   Mean   :2.812  
##  3rd Qu.:1.0000   3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :1.0000   Max.   :5.000   Max.   :8.000
model <- lm(mpg ~ cyl + disp + hp + drat + wt + qsec + vs + am + gear + carb, data = mtcars)
summary(model)
## 
## Call:
## lm(formula = mpg ~ cyl + disp + hp + drat + wt + qsec + vs + 
##     am + gear + carb, data = mtcars)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.4506 -1.6044 -0.1196  1.2193  4.6271 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 12.30337   18.71788   0.657   0.5181  
## cyl         -0.11144    1.04502  -0.107   0.9161  
## disp         0.01334    0.01786   0.747   0.4635  
## hp          -0.02148    0.02177  -0.987   0.3350  
## drat         0.78711    1.63537   0.481   0.6353  
## wt          -3.71530    1.89441  -1.961   0.0633 .
## qsec         0.82104    0.73084   1.123   0.2739  
## vs           0.31776    2.10451   0.151   0.8814  
## am           2.52023    2.05665   1.225   0.2340  
## gear         0.65541    1.49326   0.439   0.6652  
## carb        -0.19942    0.82875  -0.241   0.8122  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.65 on 21 degrees of freedom
## Multiple R-squared:  0.869,  Adjusted R-squared:  0.8066 
## F-statistic: 13.93 on 10 and 21 DF,  p-value: 3.793e-07
estandarizados1=scale(mtcars[,c(-8,-9)])
resultados_estandarizados1=prcomp(estandarizados1)
summary(resultados_estandarizados1)
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.3782 1.4429 0.71008 0.51481 0.42797 0.35184 0.32413
## Proportion of Variance 0.6284 0.2313 0.05602 0.02945 0.02035 0.01375 0.01167
## Cumulative Proportion  0.6284 0.8598 0.91581 0.94525 0.96560 0.97936 0.99103
##                           PC8     PC9
## Standard deviation     0.2419 0.14896
## Proportion of Variance 0.0065 0.00247
## Cumulative Proportion  0.9975 1.00000
score=predict(resultados_estandarizados1,newdata=estandarizados1)
names(score)=c("PC1","PC2")
nuevo_data_set=data.frame(mpg=mtcars$mpg,
                          PC1=score[,"PC1"],PC2=score[,"PC2"])
ajuste_3=lm(mpg~PC1+PC2,data=nuevo_data_set,x = TRUE)
summary(ajuste_3)
## 
## Call:
## lm(formula = mpg ~ PC1 + PC2, data = nuevo_data_set, x = TRUE)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7172 -1.4278 -0.0707  1.5738  4.8701 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  20.0906     0.4396  45.700  < 2e-16 ***
## PC1          -4.6891     0.4304 -10.895 9.12e-12 ***
## PC2          -1.3055     0.4036  -3.234  0.00304 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.487 on 29 degrees of freedom
## Multiple R-squared:  0.8407, Adjusted R-squared:  0.8297 
## F-statistic: 76.54 on 2 and 29 DF,  p-value: 2.699e-12
resultados_estandarizados1$sdev^2 / sum(resultados_estandarizados1$sdev^2)
## [1] 0.628437719 0.231344477 0.056023869 0.029447503 0.020350960 0.013754799
## [7] 0.011673547 0.006501528 0.002465598
str(resultados_estandarizados1)
## List of 5
##  $ sdev    : num [1:9] 2.378 1.443 0.71 0.515 0.428 ...
##  $ rotation: num [1:9, 1:9] -0.393 0.403 0.397 0.367 -0.312 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:9] "mpg" "cyl" "disp" "hp" ...
##   .. ..$ : chr [1:9] "PC1" "PC2" "PC3" "PC4" ...
##  $ center  : Named num [1:9] 7.11e-17 -1.47e-17 -9.09e-17 1.04e-17 -2.92e-16 ...
##   ..- attr(*, "names")= chr [1:9] "mpg" "cyl" "disp" "hp" ...
##  $ scale   : Named num [1:9] 6.027 1.786 123.939 68.563 0.535 ...
##   ..- attr(*, "names")= chr [1:9] "mpg" "cyl" "disp" "hp" ...
##  $ x       : num [1:32, 1:9] -0.664 -0.637 -2.3 -0.215 1.587 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:32] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive" ...
##   .. ..$ : chr [1:9] "PC1" "PC2" "PC3" "PC4" ...
##  - attr(*, "class")= chr "prcomp"
#plot
scree_data1 <- data.frame(
  Component = 1:length(resultados_estandarizados1$sdev),
  Variance = resultados_estandarizados1$sdev^2 / sum(resultados_estandarizados1$sdev^2)
)
#plot
ggplot(scree_data1, aes(x = Component, y = Variance)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_line() +
  geom_point() +
  xlab("Componenentes Principales") +
  ylab("Proporción de la varianza") +
  ggtitle("Proporción de la varianza")

biplot(resultados_estandarizados1, scale = 0,
       cex=0.8, xlim = c(-5, 5), ylim = c(-5, 5))

Tal como se muestra anteriormente, se realizó un modelo lineal multiple para explicar la variable millas por galón (miles/US gallon), donde no se obtuvieron variables significativas, sin embargo al utilizar un analisis de componentes principales, se observa quelos datos estandarizados nuevamente en un modelo lineal multiple, se observa que las variables “cilindros” (número) y cilindrada (cu.in) del inglés “displacement”. explican al menos el 85% de la proporción de la varianza, tal como se puede observar en la grafica con las variables que sean adecuadas, para el conjunto de datos mtcars.

En este sentido, es necesario utilizar los datos estandarizados debido a que nos permite mitigar la influencia de la escala de las variables, permitiendo una menor variabilidad de los datos y por lo tanto, una interpretación mas precisa de los resultados del modelo antes presentado.

Este analisis estadistico nos permite desde el punto de vista de un consumidor en los años setentas, que automovil posee un consumo de gasolina mayor en relacion con sus caracteristicas, el cual me atrevo a decir, que hasta la actualidad podemos ver el mismo comportamiento de fabricación de las empresas de automoviles en relacion con su publico deseado. Es decir podemos observar que ciertas marcas de automoviles como toyota y datsun se mantienen como automoviles de uso moderado (en relacion al tamaño del motor y su rendimiento), a diferencia de otras marcas como maserati y ferrari, que pertenecen a automoviles de alta gama con un numero mayor de carburadores y potencia, siendo de mayor interes para aficionados a las carreras.

#2. (2 puntos) Utiliza la funcion creada para las distancias de jaccard y czekanowski, para generar una matriz de distancias que representen las distancias mencionadas, calculadas para n objetos (se espera una matriz n*n)

#Programa una función que implemente las distancias de Jaccard y Czekanowski. Recibirá dos objetos con valores 0,1
mi_dist_matriz <- function(datos, metodo = "jaccard") {
  n <- nrow(datos)
  # Inicializamos una matriz vacía de n x n
  matriz_dist <- matrix(0, nrow = n, ncol = n)
  colnames(matriz_dist) <- rownames(datos)
  rownames(matriz_dist) <- rownames(datos)
  
  for (i in 1:n) {
    for (j in i:n) { # Empezamos en 'i' para calcular solo la mitad (es simétrica)
      if (i == j) {
        matriz_dist[i, j] <- 0
      } else {
        # Extraemos los vectores de los objetos i y j
        v1 <- datos[i, ]
        v2 <- datos[j, ]
        
        # Cálculos de coincidencia
        a <- sum(v1 == 1 & v2 == 1)
        b <- sum(v1 == 1 & v2 == 0)
        c <- sum(v1 == 0 & v2 == 1)
        
        # Selección de métrica
        if (metodo == "jaccard") {
          distancia <- (b + c) / (a + b + c)
        } else if (metodo == "czekanowski") {
          distancia <- (b + c) / (2 * a + b + c)
        }
        
        # Llenamos ambos lados de la matriz (simetría)
        matriz_dist[i, j] <- distancia
        matriz_dist[j, i] <- distancia
      }
    }
  }
  return(as.dist(matriz_dist)) # Lo devolvemos como objeto 'dist' para mayor compatibilidad
}
# Crear datos de ejemplo
mis_objetos <- matrix(c(1, 0, 1, 1, 
                        1, 1, 0, 1, 
                        0, 0, 1, 1), 
                      nrow = 3, byrow = TRUE)
rownames(mis_objetos) <- c("Obj1", "Obj2", "Obj3")

# Calcular distancias
res_jaccard <- mi_dist_matriz(mis_objetos, metodo = "jaccard")
res_czeka   <- mi_dist_matriz(mis_objetos, metodo = "czekanowski")

print(res_jaccard)
##           Obj1      Obj2
## Obj2 0.5000000          
## Obj3 0.3333333 0.7500000
print(res_czeka)
##           Obj1      Obj2
## Obj2 0.3333333          
## Obj3 0.2000000 0.6000000
  1. El conjunto de datos ”DatosMaternidad.xlsx” contiene informacion sobre diversas variables relacionadas con la fecundidad y mortandad infantil, resumidas a nivel paıs. Responde las siguientes preguntas, utilizando dicho conjunto de datos:
  1. (1 punto) Realiza un ajuste de componentes principales, y menciona la cantidad de componentes que que acumulen, por lo menos, el 80% de la varianza. No olvides determinar si es necesario estandarizar los datos.
setwd("C:/Users/Msi/Downloads")
dat1=read_xlsx("C:/Users/Msi/Downloads/Datos_Maternidad1.xlsx")
str(dat1)
## tibble [133 × 9] (S3: tbl_df/tbl/data.frame)
##  $ Country                                : chr [1:133] "Angola" "Burkina Faso" "Burundi" "Cameroon" ...
##  $ Gross National Income per Capita       : chr [1:133] "1730" "1010" "610" "1640" ...
##  $ Human development index                : num [1:133] 0.377 0.33 0.337 0.499 0.363 0.376 0.502 0.396 0.359 0.373 ...
##  $ Health Expenditure per Capita          : chr [1:133] "24" "8" "3" "24" ...
##  $ Average Births per Woman               : num [1:133] 7.2 6.8 6.8 5.2 5.3 6.6 6.29 5.2 5.9 7.1 ...
##  $ Seats in Parliament Held by Women      : chr [1:133] "15.5" "11.7" "18.5" "8.9" ...
##  $ Maternal Deaths per 100,000 Live Births: num [1:133] 1700 1000 1000 730 1100 1100 510 690 850 1100 ...
##  $ Infant Deaths per 1,000 Live Births    : num [1:133] 154 104 114 96 115 117 81 102 116 130 ...
##  $ Annual Births per 1000 Women           : num [1:133] 229 144 50.2 142 150.7 ...
data2_subset =dat1 %>% filter(`Gross National Income per Capita`!="no data",
                        `Seats in Parliament Held by Women`!="no data",
                        `Health Expenditure per Capita` != "no data")
data2_subset  <- data2_subset %>%
  mutate(`Gross National Income per Capita` = as.numeric(`Gross National Income per Capita`), `Health Expenditure per Capita`= as.numeric(`Health Expenditure per Capita`), 
         `Seats in Parliament Held by Women`=as.numeric(`Seats in Parliament Held by Women`))
estandarizados2 <-scale(data2_subset[,c(-1)])
resultados_estandarizados2=prcomp(estandarizados2)
summary(resultados_estandarizados2)
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.3418 1.1413 0.80469 0.50150 0.38241 0.28583 0.23786
## Proportion of Variance 0.6855 0.1628 0.08094 0.03144 0.01828 0.01021 0.00707
## Cumulative Proportion  0.6855 0.8484 0.92929 0.96072 0.97900 0.98922 0.99629
##                            PC8
## Standard deviation     0.17234
## Proportion of Variance 0.00371
## Cumulative Proportion  1.00000
str(estandarizados2)
##  num [1:124, 1:8] -0.71 -0.791 -0.836 -0.72 -0.771 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:8] "Gross National Income per Capita" "Human development index" "Health Expenditure per Capita" "Average Births per Woman" ...
##  - attr(*, "scaled:center")= Named num [1:8] 8059.355 0.682 410.565 3.327 14.145 ...
##   ..- attr(*, "names")= chr [1:8] "Gross National Income per Capita" "Human development index" "Health Expenditure per Capita" "Average Births per Woman" ...
##  - attr(*, "scaled:scale")= Named num [1:8] 8909.736 0.187 793.26 1.801 8.882 ...
##   ..- attr(*, "names")= chr [1:8] "Gross National Income per Capita" "Human development index" "Health Expenditure per Capita" "Average Births per Woman" ...
#plot
scree_data1 <- data.frame(
  Component = 1:length(resultados_estandarizados2$sdev),
  Variance = resultados_estandarizados2$sdev^2 / sum(resultados_estandarizados2$sdev^2)
)
#plot
ggplot(scree_data1, aes(x = Component, y = Variance)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_line() +
  geom_point() +
  xlab("Componenentes Principales") +
  ylab("Proporción de la varianza") +
  ggtitle("Proporción de la varianza")

biplot(resultados_estandarizados2, scale = 0,
       cex=0.5, xlim = c(-7, 7), ylim = c(-7, 7))

Se realizó un analisis de componentes principales,donde se observa que las variables ““Gross National Income (GNI) per Capita (PPP \() 2002" y "Health Expenditure per Capita (US\)) 2000” de los datos estandarizados, explican al menos el 80% de la proporción de la varianza, tal como se puede observar en la grafica 1.

  1. (1 punto) Utiliza los componentes que hayas seleccionado en el inciso anterior, determinando sus valores para la muestra de datos con la que cuentas. Ajusta un escalamiento multidimensional metrico con dichos componentes. Representalo graficamente.
distancias=dist(estandarizados2)
mds_result=cmdscale(distancias, k = 2)
x <- mds_result[,1]
y <- mds_result[,2]
df3= data.frame(data2_subset$Country,x,y)
##plot
plot(x, y, xlab="Coordinate 1", ylab="Coordinate 2",
     main="Escalamiento multidimensional")
text(df3$x, df3$y, labels=df3$data2_subset.Country, pos=4, cex=0.5)

#Bondad de ajuste
mds_result=cmdscale(distancias, k = 2,eig = TRUE)
mds_result$GOF
## [1] 0.8483451 0.8483451
  1. (1 punto) Ajusta un escalamiento multidimensional metrico a los datos originales. Representalo graficamente y menciona si notas diferencias remarcables respecto al grafico del inciso anterior.
distancias1=dist(data2_subset[,-1])
mds_result1=cmdscale(distancias1, k = 2)

x1 <- mds_result1[,1]
y1 <- mds_result1[,2]
df4= data.frame(data2_subset$Country,x1,y1)
plot(x1, y1, xlab="Coordinate 1", ylab="Coordinate 2",
     main="Multidimensional Scaling Results")
     
text(df4$x1, df4$y1, labels=df4$data2_subset.Country, pos=4, cex=0.5)

#Bondad de ajuste
mds_result=cmdscale(distancias1, k = 2,eig = TRUE)
mds_result$GOF
## [1] 0.9990415 0.9990415

A simple vista, el ordanmiento de los datos originales y de los datos filtrados con los componentes principales elegidos son muy similares, en el cual 3 de los paises mas ricos (Estados Unidos, Suiza y Noruega) se mantienen por fuera de los “principales grupos” en ambos ejercicios.

  1. (3 puntos). A partir de los datos originales, realiza un analisis de conglomerados, proponiendo con k-means una cantidad de clusters, para posteriormente emplear un cluster jerarquico para determinar los grupos, de acuerdo a lo propuesto por k-means. Pruebe las ligas Completa, Sencilla y Ward, y elija, de acuerdo a algun ındice, la mejor agrupacion ¿Los grupos obtenidos corresponden a lo notado en los escalmientos previos?.
#Metodo del codo
#El número de clústers
wcss <- numeric()
#Calcular la suma intra clúster
for (i in 1:10) {
  wcss[i] <- sum(kmeans(data2_subset[,-1], centers = i)$withinss)
}
# Graficar
plot(1:10,wcss,type = "b", pch = 19, frame = FALSE,
     xlab = "número de Clústers",ylab = "Suma interna de Cuadrados",
     main = "Método del codo")

Datos estandarizados ¿Los resultados van cambiando? ¿Influye el hecho de que haya datos estandarizados?

all_cluster_results1 = list()

k_values = c(2, 3, 4)

for (run_num in 1:100) {
  for (k in k_values) {
    mi_cluster1 = kmeans(estandarizados2, centers = k)
    
    cluster_sizes1 = mi_cluster1$size
    
    temp_result = data.frame(
      run_number = run_num,
      k_value = k,
      cluster_size1 = cluster_sizes1,
      cluster_id1= 1:length(cluster_sizes1) 
    )
    
    all_cluster_results1 = c(all_cluster_results1, list(temp_result))
  }
}

all_cluster_results_df1 = do.call(rbind, all_cluster_results1)

print("First few rows of all_cluster_results_df:")
## [1] "First few rows of all_cluster_results_df:"
print(head(all_cluster_results_df1))
##   run_number k_value cluster_size1 cluster_id1
## 1          1       2            46           1
## 2          1       2            78           2
## 3          1       3            40           1
## 4          1       3            19           2
## 5          1       3            65           3
## 6          1       4            42           1
print(paste("Total number of results (rows) collected:", nrow(all_cluster_results_df1)))
## [1] "Total number of results (rows) collected: 900"
# Filter for k=3 (assuming k_3_data is already available or refilter)
k_3_data_filtered1 = all_cluster_results_df1 %>% filter(k_value == 3)

# Count the occurrences of each cluster size for each cluster ID
cluster_size_frequency_k3_1 = k_3_data_filtered1 %>% 
  group_by(cluster_id1, cluster_size1) %>% 
  summarise(count = n()) %>% 
  arrange(cluster_id1, cluster_size1) # Order by cluster_id, then by cluster_size ascending
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by cluster_id1 and cluster_size1.
## ℹ Output is grouped by cluster_id1.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(cluster_id1, cluster_size1))` for per-operation
##   grouping (`?dplyr::dplyr_by`) instead.
print("Frecuencia de tamaños de clusters por ID de cluster (k=3), ordenado por tamaño:")
## [1] "Frecuencia de tamaños de clusters por ID de cluster (k=3), ordenado por tamaño:"
print(cluster_size_frequency_k3_1)
## # A tibble: 9 × 3
## # Groups:   cluster_id1 [3]
##   cluster_id1 cluster_size1 count
##         <int>         <int> <int>
## 1           1            19    30
## 2           1            40    30
## 3           1            65    40
## 4           2            19    33
## 5           2            40    34
## 6           2            65    33
## 7           3            19    37
## 8           3            40    36
## 9           3            65    27
# Create the bar plot
plot_frequency_k3_1 = ggplot(cluster_size_frequency_k3_1, aes(x = factor(cluster_size1), y = count, fill = factor(cluster_id1))) +
  geom_bar(stat = "identity", position = "dodge") + 
  facet_wrap(3, scales = "free_x", ncol = 1) + # Separate plots for k=3 and k=4
  labs(
    title = "Frecuencia de Tamaños de Clusters cuando K=3 (n=100)",
    x = "Tamaño del Cluster",
    y = "Frecuencia (Número de Ocurrencias)",
    fill = "ID del Cluster"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

print(plot_frequency_k3_1)

Datos originales

all_cluster_results = list()

k_values = c(2, 3, 4)

for (run_num in 1:100) {
  for (k in k_values) {
    mi_cluster = kmeans(data2_subset[,-1], centers = k)
    
    cluster_sizes = mi_cluster$size
    
    temp_result = data.frame(
      run_number = run_num,
      k_value = k,
      cluster_size = cluster_sizes,
      cluster_id = 1:length(cluster_sizes) 
    )
    
    all_cluster_results = c(all_cluster_results, list(temp_result))
  }
}

all_cluster_results_df = do.call(rbind, all_cluster_results)

print("First few rows of all_cluster_results_df:")
## [1] "First few rows of all_cluster_results_df:"
print(head(all_cluster_results_df))
##   run_number k_value cluster_size cluster_id
## 1          1       2          100          1
## 2          1       2           24          2
## 3          1       3           31          1
## 4          1       3           22          2
## 5          1       3           71          3
## 6          1       4           33          1
print(paste("Total number of results (rows) collected:", nrow(all_cluster_results_df)))
## [1] "Total number of results (rows) collected: 900"
# Filter for k=3 (assuming k_3_data is already available or refilter)
k_3_data_filtered = all_cluster_results_df %>% filter(k_value == 3)

# Count the occurrences of each cluster size for each cluster ID
cluster_size_frequency_k3 = k_3_data_filtered %>% 
  group_by(cluster_id, cluster_size) %>% 
  summarise(count = n()) %>% 
  arrange(cluster_id, cluster_size) # Order by cluster_id, then by cluster_size ascending
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by cluster_id and cluster_size.
## ℹ Output is grouped by cluster_id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(cluster_id, cluster_size))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.
print("Frecuencia de tamaños de clusters por ID de cluster (k=3), ordenado por tamaño:")
## [1] "Frecuencia de tamaños de clusters por ID de cluster (k=3), ordenado por tamaño:"
print(cluster_size_frequency_k3)
## # A tibble: 18 × 3
## # Groups:   cluster_id [3]
##    cluster_id cluster_size count
##         <int>        <int> <int>
##  1          1           18     7
##  2          1           22    25
##  3          1           25     3
##  4          1           31    31
##  5          1           71    28
##  6          1           81     6
##  7          2           18     5
##  8          2           22    34
##  9          2           25     6
## 10          2           31    18
## 11          2           71    32
## 12          2           81     5
## 13          3           18     4
## 14          3           22    25
## 15          3           25     7
## 16          3           31    35
## 17          3           71    24
## 18          3           81     5
# Create the bar plot
plot_frequency_k3 = ggplot(cluster_size_frequency_k3, aes(x = factor(cluster_size), y = count, fill = factor(cluster_id))) +
  geom_bar(stat = "identity", position = "dodge") + 
  facet_wrap(3, scales = "free_x", ncol = 1) + # Separate plots for k=3 and k=4
  labs(
    title = "Frecuencia de Tamaños de Clusters cuando K=3 (n=100)",
    x = "Tamaño del Cluster",
    y = "Frecuencia (Número de Ocurrencias)",
    fill = "ID del Cluster"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))


par(mfrow = c(1, 2)) 
print(plot_frequency_k3)

print(plot_frequency_k3_1)

Clusters Jerarquicos

distancias4=dist(data2_subset[,-1])
hc_result <- hclust(distancias4, method = "single")
hc_result1 <- hclust(distancias4, method = "complete")
hc_result2<- hclust(distancias4, method = "average")
hc_result3 <- hclust(distancias4, method = "ward.D2")
num_clusters <- 3
par(mfrow = c(1, 2))   
plot(hc_result, main = "Dendograma single",xlab = "Estados", ylab = "Altura",labels=data2_subset$Country, cex=0.5)
mi_cluster <- cutree(hc_result, k = num_clusters)
salida=rect.hclust(hc_result, k = num_clusters, border = 2:5)
plot(hc_result1, main = "Dendograma Completa",xlab = "Estados", ylab = "Altura",labels=data2_subset$Country, cex=0.5)
mi_cluster1 <- cutree(hc_result1, k = num_clusters)
salida=rect.hclust(hc_result1, k = num_clusters, border = 2:5)

plot(hc_result2, main = "Dendograma promedio",xlab = "Estados", ylab = "Altura",labels=data2_subset$Country, cex=0.5)
mi_cluster2 <- cutree(hc_result2, k = num_clusters)
salida=rect.hclust(hc_result2, k = num_clusters, border = 2:5)
plot(hc_result3, main = "Dendograma Ward",xlab = "Estados", ylab = "Altura",labels=data2_subset$Country, cex=0.5)
mi_cluster3 <- cutree(hc_result3, k = num_clusters)
salida=rect.hclust(hc_result3, k = num_clusters, border = 2:5)

#num_clusters <- 3
#mi_cluster <- cutree(hc_result, k = num_clusters)
#salida=rect.hclust(hc_result, k = num_clusters, border = 2:5)
#print(mi_cluster)
#table(mi_cluster)
#salida

Evaluar la calidad del cluster

indices = c("kl", "ch", "ccc", "cindex", "db", "silhouette", "duda", "pseudot2", "ratkowsky", "ptbiserial", "gap", "mcclain", "gamma", "gplus", "tau","sdindex", "sdbw")
res <- NbClust(data = estandarizados2[,-1], distance='euclidean', min.nc = 2, max.nc=6, method="ward.D2", index = "alllong")

## *** : The Hubert index is a graphical method of determining the number of clusters.
##                 In the plot of Hubert index, we seek a significant knee that corresponds to a 
##                 significant increase of the value of the measure i.e the significant peak in Hubert
##                 index second differences plot. 
## 

## *** : The D index is a graphical method of determining the number of clusters. 
##                 In the plot of D index, we seek a significant knee (the significant peak in Dindex
##                 second differences plot) that corresponds to a significant increase of the value of
##                 the measure. 
##  
## ******************************************************************* 
## * Among all indices:                                                
## * 6 proposed 2 as the best number of clusters 
## * 10 proposed 3 as the best number of clusters 
## * 4 proposed 4 as the best number of clusters 
## * 1 proposed 5 as the best number of clusters 
## * 3 proposed 6 as the best number of clusters 
## 
##                    ***** Conclusion *****                            
##  
## * According to the majority rule, the best number of clusters is  3 
##  
##  
## *******************************************************************
(res)
## $All.index
##       KL       CH Hartigan     CCC    Scott     Marriot   TrCovW   TraceW
## 2 3.5118 128.8541  48.2852 -0.3845 210.4842 97366976348 7515.986 418.7374
## 3 1.7177 113.1336  32.0225  0.6234 371.2411 59918830200 3244.098 300.0024
## 4 1.7362 105.1806  21.3188  1.8766 478.8926 44710032761 2016.864 237.2218
## 5 2.1593  97.4111  12.7654  2.0670 564.3394 35071809771 1312.722 201.4355
## 6 0.8284  88.0950  13.4145  2.1303 640.3038 27369368829 1000.086 181.9204
##   Friedman  Rubin Cindex     DB Silhouette   Duda Pseudot2  Beale Ratkowsky
## 2  38.9469 2.0562 0.3577 0.9398     0.4504 0.5499  62.1946 3.6880    0.4756
## 3  44.2524 2.8700 0.2960 0.8824     0.4215 0.5947  29.9827 3.0422    0.4618
## 4  49.9911 3.6295 0.3562 1.0038     0.3668 0.6805  29.1151 2.1101    0.4214
## 5  52.9764 4.2743 0.3140 1.2522     0.2894 0.4104  17.2409 6.0555    0.3900
## 6  57.9169 4.7328 0.3202 1.1368     0.2998 0.5610  18.0011 3.4246    0.3617
##       Ball Ptbiserial     Gap   Frey McClain  Gamma    Gplus      Tau   Dunn
## 2 209.3687     0.5924 -0.2464 0.4127  0.4725 0.7072 278.1667 1343.528 0.1567
## 3 100.0008     0.6457 -0.6582 0.5561  0.6619 0.8199 166.3677 1514.724 0.1355
## 4  59.3055     0.6501 -1.0603 1.7691  0.7817 0.8643 118.6081 1510.616 0.1760
## 5  40.2871     0.5345 -1.2073 0.1350  1.4227 0.8281 115.3150 1111.272 0.1491
## 6  30.3201     0.5369 -1.4818 0.6948  1.4333 0.8396 106.1446 1111.512 0.1550
##   Hubert SDindex Dindex   SDbw
## 2 0.0018  1.4440 1.6698 0.7623
## 3 0.0023  1.3922 1.4157 0.5066
## 4 0.0028  1.4749 1.2887 0.4197
## 5 0.0029  2.0589 1.1671 0.3648
## 6 0.0030  1.8853 1.1196 0.2885
## 
## $All.CriticalValues
##   CritValue_Duda CritValue_PseudoT2 Fvalue_Beale CritValue_Gap
## 2         0.7269            28.5479       0.0007        0.4189
## 3         0.6719            21.4850       0.0041        0.4122
## 4         0.7080            25.5700       0.0414        0.1584
## 5         0.4792            13.0421       0.0000        0.2885
## 6         0.5874            16.1572       0.0019        0.3096
## 
## $Best.nc
##                     KL       CH Hartigan    CCC    Scott     Marriot   TrCovW
## Number_clusters 2.0000   2.0000   3.0000 6.0000   3.0000           3    3.000
## Value_Index     3.5118 128.8541  16.2626 2.1303 160.7569 22239348709 4271.888
##                  TraceW Friedman   Rubin Cindex     DB Silhouette Duda PseudoT2
## Number_clusters  3.0000   4.0000  5.0000  3.000 3.0000     2.0000   NA       NA
## Value_Index     55.9545   5.7387 -0.1863  0.296 0.8824     0.4504   NA       NA
##                 Beale Ratkowsky     Ball PtBiserial     Gap Frey McClain  Gamma
## Number_clusters    NA    2.0000   3.0000     4.0000  2.0000    1  2.0000 4.0000
## Value_Index        NA    0.4756 109.3679     0.6501 -0.2464   NA  0.4725 0.8643
##                    Gplus      Tau  Dunn Hubert SDindex Dindex   SDbw
## Number_clusters   6.0000    3.000 4.000      0  3.0000      0 6.0000
## Value_Index     106.1446 1514.724 0.176      0  1.3922      0 0.2885
## 
## $Best.partition
##   [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1
##  [38] 1 1 1 1 1 1 2 1 1 1 2 1 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 2 2 3 2 3 2 2 3
## [112] 2 3 3 3 2 2 2 2 3 3 3 2 3
#Clúster
#K means
k=2
mi_cluster=kmeans(data2_subset[,-1], centers = k)
names(mi_cluster)
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"
mi_cluster$centers
##   Gross National Income per Capita Human development index
## 1                         24460.42                 0.91400
## 2                          4123.10                 0.62601
##   Health Expenditure per Capita Average Births per Woman
## 1                      1739.542                 1.575667
## 2                        91.610                 3.747710
##   Seats in Parliament Held by Women Maternal Deaths per 100,000 Live Births
## 1                          20.96667                                10.45833
## 2                          12.50800                               415.87000
##   Infant Deaths per 1,000 Live Births Annual Births per 1000 Women
## 1                            4.791667                     16.24600
## 2                           57.550000                     83.07723
mi_cluster$size
## [1]  24 100
mi_cluster$cluster
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 1 1 1 2 1 1 1 1 1 1 1
## [112] 2 1 1 1 1 1 2 1 1 1 1 1 1

Conclusiones

Al comparar los gráficos de barras de frecuencia de tamaños de clusters para k=3 entre los datos originales (no escalados) y los datos estandarizados (escalados), se observan las siguientes diferencias:

La estandarización no solo redujo la variabilidad, sino que también alteró los tamaños de clusters que se volvieron dominantes. Por ejemplo, en los datos originales, un cluster podría tener picos de frecuencia en tamaños como 4, 8 y 12, mientras que en los datos escalados, las frecuencias tienden a concentrarse en uno o dos tamaños de clusters dominantes, con menos variabilidad y menor presencia de tamaños ‘atípicos’.

Impacto de la Estandarización:

La estandarización de los datos reduce la Sensibilidad a la Inicialización, haciendo que el algoritmo K-means sea menos sensible a las asignaciones iniciales de centroides y, por lo tanto, más consistente en la formación de clusters.En segundo lugar, genera Clusters Más robustos; es decir los clusters formados con datos escalados muestran una estructura más definida y repetible. Y por último, facilita la Interpretación de los resultados del clustering, de tal manera que mitiga la influencia de la escala de las variables son más consistentes a lo largo de las ejecuciones.

En este sentido, podemos hablar de 3 cluster, donde la mayoria de los paises se agrupan (>70 paises), que podriamos clasificarlos como paises en vias de desarrollo, un segundo grupo con alrededor de 25 paises en promedio, lo cuales de igual manera son paises que comparten caracteristcas del paises del primer mundo, y por ultimo, se encuentran los 3 paises que se mantienen alejados de todos los demas, Estados Unidos, Suiza y Noruega, los 3 comparten como potencias, sin embargo hay que destacar que no se encuentran datos de China o Rusia (ambos paises de gran importancia global), esto se puede ser explicado debido a que la base de datos proviene de un repositorio de la ONU que no posee datos precisos de estas naciones.

Hay que aclarar, que la base datos utilizado recopila datos de mortalidad y natalidad en mujeres de todo el mundo, pero de acuerdo al analisis estadistico nos muestra una similitud del comportamiento de ciertas naciones de acuerdo al salario dentro de las naciones y desarrollo humano, por lo tanto hay que establecer si queremos relacionar el estatus de mortalidad y natalidad con las variables antes descritas que explican el ochenta por ciento de la proporcion de la varianza, es necesario repensar el analisis estadistico.

Es decir, tal como se cree intuitivamente, los paises con menor salario neto y menor desarrollo humano, poseen un alto nivel de mortalidad en recien nacidos y alto nivel de natalidad, en parte por la falta de información respecto al control de embarazo. Sin embargo, se requieren mas variables para explicar este fenomeno. En general, considero, que de igual manera la base datos proviene de los inicios del 2000, hay que reconocer que todas estos comportamientos es posible que hayan cambiado, el cual requiere un analisis aun mas completo.