Unidad 5: Aprendizaje No Supervisado

Code

library(tidyverse)
library(faraway)
library(kableExtra)
library(CDR)
library(cluster)
library(factoextra)

Introducción: Agrupar vs Clasificar

El análisis clúster (o de conglomerados), reconocimiento de patrones es una actividad requerida en muchos campos. Es una actividad que consiste en agrupar, no confundir con clasificar.

Clasificar: se conocen las categorías, nº de grupos y qué observaciones pertenecen a cada uno
Agrupar: el número de grupos puede o no ser conocido, pero no se sabe qué observaciones pertenecen a cada grupo. El objetivo de agrupar es encontrar una serie de patrones comunes en determinadas muestras, de forma que los elementos de cada grupo sean lo más parecidos entre sí y los más diferentes a elementos otros grupos.

Las decisiones a tomar al hacer un análisis clúster son:

Selección de variables por las que agrupar
Tipo de distancia o medida de similitud
Técnica a emplear para formar grupos
Determinar el número óptimo de clústers (salvo que venga impuesto o se conozca a priori)

Selección de las variables

La selección de las p variables o características, \(X_1, X_2, ...,X_p\) para agrupar los \(n\) elementos (filas) es fundamental para determinar la agrupación final, independientemente de la técnica usada.

Excluir variables relevantes generará una mala agrupación e incluir muchas variables poco relevantes, complicará el proceso. Como la tendencia es evitar la exclusión de variables relevantes, cuando se incluyen demasiadas variables (que además están correlacionadas), se suele recurrir a técnicas de reducción de la dimensionalidad como PCA (principal component analysis).

Eliminar información redundante es una de las cuestiones más importantes a tener en cuenta en el proceso previo al análisis clúster.

Otra decisión a tomar es sobre la estandarización de variables. No hay un consenso o estrategia predeterminada, pero se suele recomendar si las unidades de medida o escalas de las variables distorsionan la influencia de las diferentes variables.

Tipo de distancia/similitud (cuantitativas)

Se define la distancia entre variables cuantitativas como la distancia entre dos elementos \(d(x_r;x_s)\), como una función que asocia un número real a cada dos puntos de \(\Re^p\) y verifica:

\(d(x_r;x_s) >= 0\),
\(d(x_r;x_s) = 0\) si y solo si \(x_r = x_s\),
\(d(x_r;x_s) = d(x_s;x_r)\),
\(d(x_r;x_s) + d(x_j;x_h) >= d(x_r;x_h), \forall x_k \in \Re^p\)

La distancia entre dos puntos siempre es mayor o igual a cero. Esto significa que no puede haber una distancia negativa entre dos puntos; lo más pequeño que puede ser es cero, lo cual nos lleva al siguiente punto:

La distancia entre dos puntos es igual a cero si y solo si ambos puntos son el mismo punto. Si estamos midiendo la distancia entre un punto y él mismo, esa distancia es cero porque no hay espacio entre ellos.

La distancia entre dos puntos es la misma sin importar el orden en que los consideremos. Así, si medimos la distancia del punto A al punto B, obtendremos el mismo resultado que si midieramos la distancia del punto B al punto A.

La suma de las distancias entre dos pares de puntos es siempre mayor o igual que la distancia directa entre dos puntos específicos de esos pares. En otras palabras, si tienes dos pares de puntos y sumas las distancias dentro de cada par, esa suma será siempre mayor o igual que si midieras la distancia directamente de un punto de un par al punto del otro par, independientemente de cómo estén dispuestos esos puntos.

Entre variables cualitativas, la similitud \(s(x_r;x_s)\), es una función que asocia un número real a dos puntos de \(\Re^p\) y verifica:

\(s(x_r;x_s) \leq s_0\), con \(s_0\) número real finito y arbitrario (normalmente 1),
\(s(x_r;x_s) = s_0\), si y solo si \(x_r = x_{s}\),
\(s(x_r;x_s) = s(x_s;x_r)\),
\(|s(x_r;x_s) + s(x_s;x_h)|s(x_r;x_h) \geq s(x_r;x_s)s(x_s;x_h) \forall x_h \in \Re^p\)

En el contexto de clustering, se suele usar la distancia para variables cuantitativas y la similitud para variables cualitativas, aunque es posible calcular distancia para cualitativas y similitud para cuantitativas. Para variables mixtas, se usan otro tipo de técnicas (escalado, distancia de Gower o técnicas combinadas)

Distancia euclídea

\(\begin{equation}d_{e}({\bf x}_r;{\bf{x}}_{s})=\sqrt{\sum_{j=1}^{p}\left( x_{jr}-x_{js}\right) ^{2}}\end{equation}\)

Ignora las unidades de medida de las variables y, en consecuencia, aunque es invariante a los cambios de origen, no lo es a los cambios de escala. También ignora las relaciones entre ellas. Resulta de utilidad con variables cuantitativas incorrelacionadas y medidas en las mismas unidades. El cuadrado de la distancia euclídea también suele utilizarse como distancia.

Code

x_r <- c(2,4,6)
x_s <- c(3,7,4)
de <- sqrt(sum((x_r-x_s)**2))
de

[1] 3.741657

Code

dist(rbind(x_r,x_s), method = "euclidean")

         x_r
x_s 3.741657

Ejemplo práctico: ?TIC2021. Estadísticas de uso TIC en la Unión Europea en 2021

Code

data("TIC2021")
library(factoextra)
tic <- scale(TIC2021)

# similar a dist (rbase) en factoextra
d_euclidea <- get_dist(x = tic, method = "euclidean")
fviz_dist(dist.obj = d_euclidea, lab_size = 10)

Distancia de Manhattan o city block

\(\begin{equation}d_{MAN}({\bf x}_r;{\bf{x}}_{s})=\sum_{j=1}^{p}\left\vert x_{jr}-x_{js}\right\vert\end{equation}\)

Viene afectada por los cambios de escala en alguna de las variables y es menos sensible que la distancia euclídea a los valores extremos. Por ello, es recomendable cuando las variables son cuantitativas, con las mismas unidades de medida, sin relaciones entre ellas y con valores extremos.

Code

abs(x_r - x_s)

[1] 1 3 2

Code

d_man <- sum(abs(x_r - x_s))
d_man

[1] 6

Code

dist(rbind(x_r,x_s), method = "manhattan")

    x_r
x_s   6

Distancia de Minkowski

\(d_{MIN}({\bf x}_r, {\bf x}_s) = \left( \sum_{j=1}^{p} |x_{jr} - x_{js}|^\lambda \right)^{\frac{1}{\lambda}}\)

Code

get_dist(x = rbind(x_r, x_s), method = "minkowski", p = 3)

         x_r
x_s 3.301927

Las distancias euclídea y Manhattan son casos particulares de la distancia de Minkowski, con \(\lambda = 2\) y \(\lambda = 1\) respectivamente.

Distancia de Chebyshev

En el caso anterior, a medida que lambda es mayor, el valor de la distancia converge a 3, que es el máximo valor de distancia de una de las 3 coordenadas. Es precisamente la fórmula de la distancia de Chebyshev: \(\begin{equation}d_{CHE}({\bf x}_r;{\bf{x}}_{s})=\max_{1\leq j\leq p}\sum_{j=1}^{p}\left\vert x_{jr} - x_{js}\right\vert\end{equation}\)

Code

get_dist(x = rbind(x_r, x_s), method = "maximum")

    x_r
x_s   3

Code

get_dist(x = rbind(a = c(2,3,5), b = c(4,5,4)), method = "maximum")

  a
b 2

Distancia de Mahalanobis

\(\begin{equation}d_{MAH}=({\bf x}_r;{\bf{x}}_{s})=(\mathbf{x}_{r}-\mathbf{x}_{s})^{\prime}\mathbf{S}^{-1}(\mathbf{x}_{r}-\mathbf{x}_{s})\end{equation}\)

Es invariante en transformaciones lineales (escalas, cambios de origen,…) Tiene en cuenta las correlaciones lineales entre variables, por lo que corrige el efecto de la redundancia. Para su cálculo, involucra a todos los elementos (desventaja).

Code

# Cargamos el dataset, Seleccionamos las columnas numéricas y reasignamos nombres a las filas
lqsa <- read.csv("https://raw.githubusercontent.com/jesusturpin/curintel2324/main/data/lqsa.csv")
rownames(lqsa) <- lqsa$Nombre
lqsa <- lqsa %>%
  select_if(is.numeric) 

# Escalamos por mín-max y reasignamos nombres a las filas
lqsa_scaled_min_max <- lqsa %>%
  sapply(scales::rescale) %>%
  as.data.frame()
rownames(lqsa_scaled_min_max) <- rownames(lqsa)

# Escalamos por z-score y reasignamos nombres a las filas
lqsa_scaled_z <- lqsa %>%
  sapply(scale) %>%
  as.data.frame()
rownames(lqsa_scaled_z) <- rownames(lqsa)

Code

lqsa$mahal <- stats::mahalanobis(lqsa, colMeans(lqsa), (cov(lqsa)))

lqsa_scaled_min_max$mahal <- stats::mahalanobis(lqsa_scaled_min_max, 
                                                colMeans(lqsa_scaled_min_max),
                                                (cov(lqsa_scaled_min_max)))
lqsa_scaled_z$mahal <- stats::mahalanobis(lqsa_scaled_z, 
                                                colMeans(lqsa_scaled_z),
                                                (cov(lqsa_scaled_z)))
lqsa$p <- pchisq(lqsa$mahal, df = 4, lower.tail = FALSE)
lqsa_scaled_min_max$p <- pchisq(lqsa_scaled_min_max$mahal, df = 4, lower.tail = FALSE)
lqsa_scaled_z$p <- pchisq(lqsa_scaled_z$mahal, df = 4, lower.tail = FALSE)

Code

lqsa %>%
  arrange(desc(mahal)) %>%
  kable(format="markdown")

	Poder	Convivencia	Liante	Atractivo	Locura	mahal	p
Enrique Pastor	17	8	44	5	5	10.714076	0.0299725
Estela Reynolds	2	3	154	28	100	10.210240	0.0370313
Padre Alejandro	5	25	10	25	15	9.637705	0.0469933
Maxi	3	12	158	2	36	9.345544	0.0530196
Antonio Recio	17	4	100	7	77	8.140022	0.0865816
Javi	15	4	56	16	95	8.040966	0.0900890
Raquel	1	11	22	30	20	7.284386	0.1216015
Berta	15	9	14	16	15	6.920490	0.1401501
Vicente	2	24	52	11	18	6.712963	0.1518569
Fermín	2	19	110	11	91	5.968928	0.2014808
Yoli	2	8	100	28	93	4.615736	0.3290439
Clara	2	14	156	2	80	4.493884	0.3432733
Patricio	7	12	110	1	100	4.422281	0.3518627
Ongombo	9	17	36	23	35	4.256756	0.3723715
Doña Fina	5	11	158	2	88	4.206852	0.3787347
Leo	1	5	86	4	66	4.011231	0.4044880
La chusa	3	5	18	16	99	3.816031	0.4314755
Judith	1	6	80	28	76	3.653198	0.4549695
Teodoro	1	4	56	6	74	3.545581	0.4709816
Violeta	3	2	30	12	100	3.543100	0.4713552
Bruno	2	6	24	11	88	3.120299	0.5378994
Alba	2	12	64	5	90	2.856132	0.5821827
Maite	1	3	58	15	70	2.753354	0.5999112
Lola	2	4	70	25	90	2.560962	0.6337539
Los Cuquitos	3	18	90	8	50	2.368316	0.6683604
Nines	3	9	86	2	89	1.951518	0.7446758
Coque	1	4	50	15	88	1.738399	0.7837312
Menchu	4	6	92	3	89	1.629227	0.8035298
Araceli	2	8	36	15	76	1.291607	0.8627980
Amador	3	5	70	20	90	1.190218	0.8797065

Code

lqsa_scaled_min_max %>%
  arrange(desc(mahal)) %>%
  kable(format="markdown")

	Poder	Convivencia	Liante	Atractivo	Locura	mahal	p
Enrique Pastor	1.0000	0.2608696	0.2297297	0.1379310	0.0000000	10.714076	0.0299725
Estela Reynolds	0.0625	0.0434783	0.9729730	0.9310345	1.0000000	10.210240	0.0370313
Padre Alejandro	0.2500	1.0000000	0.0000000	0.8275862	0.1052632	9.637705	0.0469933
Maxi	0.1250	0.4347826	1.0000000	0.0344828	0.3263158	9.345544	0.0530196
Antonio Recio	1.0000	0.0869565	0.6081081	0.2068966	0.7578947	8.140022	0.0865816
Javi	0.8750	0.0869565	0.3108108	0.5172414	0.9473684	8.040966	0.0900890
Raquel	0.0000	0.3913043	0.0810811	1.0000000	0.1578947	7.284386	0.1216015
Berta	0.8750	0.3043478	0.0270270	0.5172414	0.1052632	6.920490	0.1401501
Vicente	0.0625	0.9565217	0.2837838	0.3448276	0.1368421	6.712963	0.1518569
Fermín	0.0625	0.7391304	0.6756757	0.3448276	0.9052632	5.968928	0.2014808
Yoli	0.0625	0.2608696	0.6081081	0.9310345	0.9263158	4.615736	0.3290439
Clara	0.0625	0.5217391	0.9864865	0.0344828	0.7894737	4.493884	0.3432733
Patricio	0.3750	0.4347826	0.6756757	0.0000000	1.0000000	4.422281	0.3518627
Ongombo	0.5000	0.6521739	0.1756757	0.7586207	0.3157895	4.256756	0.3723715
Doña Fina	0.2500	0.3913043	1.0000000	0.0344828	0.8736842	4.206852	0.3787347
Leo	0.0000	0.1304348	0.5135135	0.1034483	0.6421053	4.011231	0.4044880
La chusa	0.1250	0.1304348	0.0540541	0.5172414	0.9894737	3.816031	0.4314755
Judith	0.0000	0.1739130	0.4729730	0.9310345	0.7473684	3.653198	0.4549695
Teodoro	0.0000	0.0869565	0.3108108	0.1724138	0.7263158	3.545581	0.4709816
Violeta	0.1250	0.0000000	0.1351351	0.3793103	1.0000000	3.543100	0.4713552
Bruno	0.0625	0.1739130	0.0945946	0.3448276	0.8736842	3.120299	0.5378994
Alba	0.0625	0.4347826	0.3648649	0.1379310	0.8947368	2.856132	0.5821827
Maite	0.0000	0.0434783	0.3243243	0.4827586	0.6842105	2.753354	0.5999112
Lola	0.0625	0.0869565	0.4054054	0.8275862	0.8947368	2.560962	0.6337539
Los Cuquitos	0.1250	0.6956522	0.5405405	0.2413793	0.4736842	2.368316	0.6683604
Nines	0.1250	0.3043478	0.5135135	0.0344828	0.8842105	1.951518	0.7446758
Coque	0.0000	0.0869565	0.2702703	0.4827586	0.8736842	1.738399	0.7837312
Menchu	0.1875	0.1739130	0.5540541	0.0689655	0.8842105	1.629227	0.8035298
Araceli	0.0625	0.2608696	0.1756757	0.4827586	0.7473684	1.291607	0.8627980
Amador	0.1250	0.1304348	0.4054054	0.6551724	0.8947368	1.190218	0.8797065

Code

lqsa_scaled_z %>%
  arrange(desc(mahal)) %>%
  kable(format="markdown")

	Poder	Convivencia	Liante	Atractivo	Locura	mahal	p
Enrique Pastor	2.5312065	-0.2049357	-0.6604687	-0.8688298	-2.1518274	10.714076	0.0299725
Estela Reynolds	-0.5143628	-1.0138923	1.8447574	1.6084121	0.9883201	10.210240	0.0370313
Padre Alejandro	0.0947510	2.5455170	-1.4348113	1.2852936	-1.8212856	9.637705	0.0469933
Maxi	-0.3113249	0.4422296	1.9358566	-1.1919483	-1.1271477	9.345544	0.0530196
Antonio Recio	2.5312065	-0.8521010	0.6149191	-0.6534174	0.2280739	8.140022	0.0865816
Javi	2.1251306	-0.8521010	-0.3871713	0.3159381	0.8230492	8.040966	0.0900890
Raquel	-0.7174008	0.2804383	-1.1615139	1.8238245	-1.6560147	7.284386	0.1216015
Berta	2.1251306	-0.0431444	-1.3437122	0.3159381	-1.8212856	6.920490	0.1401501
Vicente	-0.5143628	2.3837256	-0.4782704	-0.2225927	-1.7221230	6.712963	0.1518569
Fermín	-0.5143628	1.5747690	0.8426670	-0.2225927	0.6908325	5.968928	0.2014808
Yoli	-0.5143628	-0.2049357	0.6149191	1.6084121	0.7569408	4.615736	0.3290439
Clara	-0.5143628	0.7658123	1.8903070	-1.1919483	0.3272364	4.493884	0.3432733
Patricio	0.5008270	0.4422296	0.8426670	-1.2996544	0.9883201	4.422281	0.3518627
Ongombo	0.9069029	1.2511863	-0.8426670	1.0698813	-1.1602019	4.256756	0.3723715
Doña Fina	0.0947510	0.2804383	1.9358566	-1.1919483	0.5916699	4.206852	0.3787347
Leo	-0.7174008	-0.6903097	0.2960722	-0.9765359	-0.1355222	4.011231	0.4044880
La chusa	-0.3113249	-0.6903097	-1.2526131	0.3159381	0.9552659	3.816031	0.4314755
Judith	-0.7174008	-0.5285184	0.1594235	1.6084121	0.1950197	3.653198	0.4549695
Teodoro	-0.7174008	-0.8521010	-0.3871713	-0.7611236	0.1289113	3.545581	0.4709816
Violeta	-0.3113249	-1.1756837	-0.9793157	-0.1148866	0.9883201	3.543100	0.4713552
Bruno	-0.5143628	-0.5285184	-1.1159644	-0.2225927	0.5916699	3.120299	0.5378994
Alba	-0.5143628	0.4422296	-0.2049730	-0.8688298	0.6577783	2.856132	0.5821827
Maite	-0.7174008	-1.0138923	-0.3416217	0.2082319	-0.0033054	2.753354	0.5999112
Lola	-0.5143628	-0.8521010	-0.0683243	1.2852936	0.6577783	2.560962	0.6337539
Los Cuquitos	-0.3113249	1.4129776	0.3871713	-0.5457113	-0.6643891	2.368316	0.6683604
Nines	-0.3113249	-0.0431444	0.2960722	-1.1919483	0.6247241	1.951518	0.7446758
Coque	-0.7174008	-0.8521010	-0.5238200	0.2082319	0.5916699	1.738399	0.7837312
Menchu	-0.1082869	-0.5285184	0.4327209	-1.0842421	0.6247241	1.629227	0.8035298
Araceli	-0.5143628	-0.2049357	-0.8426670	0.2082319	0.1950197	1.291607	0.8627980
Amador	-0.3113249	-0.6903097	-0.0683243	0.7467628	0.6577783	1.190218	0.8797065

Code

# Alternativa sin stats::mahalanobis (Aplicando la fórmula)
lqsa <- lqsa %>%
  dplyr::select(-mahal, -p)
cov_matrix <- cov(lqsa)
inv_cov_matrix <- solve(cov_matrix)
means <- colMeans(lqsa)

mahal_distances <- apply(lqsa, 1, function(x) {
 diff <- x - means
 t(diff) %*% inv_cov_matrix %*% diff
})

lqsa$mahal_man <- mahal_distances
lqsa %>%
  arrange(desc(mahal_man)) %>%
  kable(format="markdown")

	Poder	Convivencia	Liante	Atractivo	Locura	mahal_man
Enrique Pastor	17	8	44	5	5	10.714076
Estela Reynolds	2	3	154	28	100	10.210240
Padre Alejandro	5	25	10	25	15	9.637705
Maxi	3	12	158	2	36	9.345544
Antonio Recio	17	4	100	7	77	8.140022
Javi	15	4	56	16	95	8.040966
Raquel	1	11	22	30	20	7.284386
Berta	15	9	14	16	15	6.920490
Vicente	2	24	52	11	18	6.712963
Fermín	2	19	110	11	91	5.968928
Yoli	2	8	100	28	93	4.615736
Clara	2	14	156	2	80	4.493884
Patricio	7	12	110	1	100	4.422281
Ongombo	9	17	36	23	35	4.256756
Doña Fina	5	11	158	2	88	4.206852
Leo	1	5	86	4	66	4.011231
La chusa	3	5	18	16	99	3.816031
Judith	1	6	80	28	76	3.653198
Teodoro	1	4	56	6	74	3.545581
Violeta	3	2	30	12	100	3.543100
Bruno	2	6	24	11	88	3.120299
Alba	2	12	64	5	90	2.856132
Maite	1	3	58	15	70	2.753354
Lola	2	4	70	25	90	2.560962
Los Cuquitos	3	18	90	8	50	2.368316
Nines	3	9	86	2	89	1.951518
Coque	1	4	50	15	88	1.738399
Menchu	4	6	92	3	89	1.629227
Araceli	2	8	36	15	76	1.291607
Amador	3	5	70	20	90	1.190218

Code

lqsa <- lqsa %>%
  dplyr::select(-mahal_man)

Code

estela <- colMeans(lqsa["Estela Reynolds", ])

Code

lqsa$dist_estela <- mahalanobis(lqsa, center = estela, cov(lqsa))
lqsa %>%
  arrange(dist_estela) %>%
  kable(format="markdown")

	Poder	Convivencia	Liante	Atractivo	Locura	dist_estela
Estela Reynolds	2	3	154	28	100	0.000000
Yoli	2	8	100	28	93	3.054165
Judith	1	6	80	28	76	3.831019
Lola	2	4	70	25	90	5.242030
Amador	3	5	70	20	90	6.932859
Doña Fina	5	11	158	2	88	10.231593
Clara	2	14	156	2	80	11.796588
Maite	1	3	58	15	70	11.965055
Coque	1	4	50	15	88	12.632628
Menchu	4	6	92	3	89	14.196200
Raquel	1	11	22	30	20	14.713192
Maxi	3	12	158	2	36	14.942404
Araceli	2	8	36	15	76	15.104114
Ongombo	9	17	36	23	35	15.564450
Los Cuquitos	3	18	90	8	50	15.798259
Antonio Recio	17	4	100	7	77	15.903477
Fermín	2	19	110	11	91	16.159063
Leo	1	5	86	4	66	16.252623
Nines	3	9	86	2	89	16.909598
Javi	15	4	56	16	95	16.990043
Patricio	7	12	110	1	100	17.749430
Violeta	3	2	30	12	100	18.172660
Teodoro	1	4	56	6	74	18.424501
La chusa	3	5	18	16	99	18.777514
Alba	2	12	64	5	90	20.102895
Bruno	2	6	24	11	88	20.273521
Berta	15	9	14	16	15	21.729462
Vicente	2	24	52	11	18	24.985010
Padre Alejandro	5	25	10	25	15	25.778887
Enrique Pastor	17	8	44	5	5	27.093946

Code

lqsa <- lqsa %>% dplyr::select(-dist_estela)

Coeficiente de correlación de Pearson

\(\begin{equation}d_{P}({\bf x}_r;{\bf{x}}_{s})=1-\frac{\sum_{j=1}^{p}\left( x_{jr}-\overline{x}_{r}\right) \left( x_{js}-\overline{x}_{s}\right) }{\sqrt{\sum_{j=1}^{p}\left( x_{rj}-\overline{x}_{r}\right) ^{2}\sum_{j=1}^{p}\left(x_{sj}-\overline{x}_{s}\right) ^{2}}}\end{equation}\)

Indica el grado de similitud entre -1 y 1 entre dos elementos. Para pasarlo a distancia, la fórmula quedaría:

La interpretación en este sentido es más compleja. Supongamos que las variables son Poder_cap1, Poder_cap2, Poder_cap3, … podríamos comparar la correlación entre dos personajes, si el poder de cada uno aumenta, podríamos ver que hay una correlación positiva, sin embargo si a lo largo de los capítulos uno aumenta y el otro disminuye, la correlación sería negativa. Si no influye la variación de uno sobre el otro, la correlación es cercana a 0.

Code

library(factoextra)
d <- factoextra::get_dist(x = lqsa_scaled_z, method = "pearson")
fviz_dist(dist.obj = d, lab_size = 10)

Tipos de distancia (cualitativas)

Cuando las variables con las que se pretende determinar la similitud entre observaciones son de tipo binario, a pesar de que es posible codificarlas de forma numérica como 1 o 0, no tiene sentido aplicar operaciones aritméticas sobre ellas (media, suma…). Por ejemplo, si la variable sexo se codifica como 1 para mujer y 0 para hombre, carece de significado decir que la media de la variable sexo en un determinado set de datos es 0.5. En situaciones como esta, no se pueden emplear medidas de similitud basadas en distancia euclídea, manhattan, correlación…

SMC (simple matching coefficient)

https://cienciadedatos.net/documentos/37_clustering_y_heatmaps#Medidas_de_distancia

\(SMC = \frac{{M_{00} + M_{11}}}{{M_{00} + M_{01} + M_{10} + M_{11}}}\)

Se crean tablas de contigencia para establecer medidas de similaridad:

Las tablas de contingencia 2x2 son herramientas útiles para analizar la relación entre dos variables cualitativas o categóricas. Cuando se trata de comparar dos elementos (r y s) en términos de presencia o ausencia de alguna característica, una tabla de contingencia 2x2 se ve así:

	Presencia en s	Ausencia en s	Total
Presencia en r	A (M11)	B M(10)	A+B
Ausencia en r	C (M01)	D M(00)	C+D
Total	A+C	B+D	M=A+B+C+D

Donde:

A representa el número de veces que la característica está presente tanto en r como en s.
B representa el número de veces que la característica está presente en r pero ausente en s.
C representa el número de veces que la característica está ausente en r pero presente en s.
D representa el número de veces que la característica está ausente tanto en r como en s.
M es el total general, es decir, la suma de todas las observaciones.

Code

datos <- c("juan\t1\t1\t0\t1\t0\t1\t0\t0\t1\t1\t0\t1",
           "pepe\t0\t1\t0\t0\t0\t1\t0\t0\t1\t1\t0\t1",
           "jose\t1\t1\t0\t1\t1\t1\t0\t1\t1\t1\t0\t1",
           "angela\t0\t0\t1\t0\t0\t0\t1\t0\t1\t1\t0\t1",
           "alberto\t1\t1\t0\t1\t1\t1\t0\t1\t1\t1\t0\t1",
           "jesus\t0\t1\t0\t0\t0\t0\t0\t0\t1\t1\t0\t1",
           "ana\t1\t1\t0\t1\t1\t1\t0\t1\t1\t1\t0\t1",
           "fran\t1\t1\t0\t1\t0\t0\t0\t0\t0\t0\t0\t0",
           "rosa\t0\t0\t0\t0\t0\t0\t0\t0\t0\t0\t0\t0",
           "berni\t0\t1\t0\t0\t0\t1\t0\t0\t0\t0\t1\t0",
           "ruben\t1\t1\t0\t1\t1\t1\t0\t1\t1\t1\t0\t1")

# Separar los datos en filas
datos_separados <- strsplit(datos, "\t")

# Crear el data.frame
df <- as.data.frame(do.call(rbind, datos_separados), stringsAsFactors = FALSE)

# Asignar nombres a las columnas
names(df) <- c("Id", "exm1", "pr1", "aban1", "calif", "exm2", "pr2", "aban2", "calif2", "exm3", "pr3", "aban3", "calif3")
rownames(df) <- df$Id
df <- df[,-1]
df <- as.data.frame(df)
df <- df %>%
  mutate_all(as.numeric)
# Mostrar el data.frame
df %>%
  kable(format="markdown")

	exm1	pr1	aban1	calif	exm2	pr2	aban2	calif2	exm3	pr3	aban3	calif3
juan	1	1	0	1	0	1	0	0	1	1	0	1
pepe	0	1	0	0	0	1	0	0	1	1	0	1
jose	1	1	0	1	1	1	0	1	1	1	0	1
angela	0	0	1	0	0	0	1	0	1	1	0	1
alberto	1	1	0	1	1	1	0	1	1	1	0	1
jesus	0	1	0	0	0	0	0	0	1	1	0	1
ana	1	1	0	1	1	1	0	1	1	1	0	1
fran	1	1	0	1	0	0	0	0	0	0	0	0
rosa	0	0	0	0	0	0	0	0	0	0	0	0
berni	0	1	0	0	0	1	0	0	0	0	1	0
ruben	1	1	0	1	1	1	0	1	1	1	0	1

Code

A_juan_ruben <- 7 # Presencia en juan y ruben
B_juan_ruben <- 0 # Presencia en juan, ausencia en ruben
C_juan_ruben <- 2 # Ausencia en Juan, presencia en ruben
D_juan_ruben <- 3 # Ausencia en ambos

SMC_juan_ruben <- (A_juan_ruben + D_juan_ruben) / (A_juan_ruben + B_juan_ruben
                                                   + C_juan_ruben +
                                                     D_juan_ruben )
SMC_juan_ruben

[1] 0.8333333

Code

# Function to calculate SMC
calculate_smc <- function(df) {
  n <- nrow(df)
  smc_matrix <- matrix(0, n, n)
  rownames(smc_matrix) <- colnames(smc_matrix) <- rownames(df)
  
  for (i in 1:(n-1)) {
    for (j in (i+1):n) {
      # Calculate matches (both 1 and 0)
      matches <- sum(df[i, ] == df[j, ])
      # Total number of attributes
      total_attributes <- ncol(df)
      # Calculate SMC
      smc <- matches / total_attributes
      smc_matrix[i, j] <- smc
      smc_matrix[j, i] <- smc # The matrix is symmetric
    }
  }
  diag(smc_matrix) <- 1 # Set diagonal to 1 for self-comparison
  return(smc_matrix)
}

# Calculate the SMC matrix
smc_matrix <- calculate_smc(df)
smc_matrix

             juan      pepe      jose    angela   alberto     jesus       ana
juan    1.0000000 0.8333333 0.8333333 0.5000000 0.8333333 0.7500000 0.8333333
pepe    0.8333333 1.0000000 0.6666667 0.6666667 0.6666667 0.9166667 0.6666667
jose    0.8333333 0.6666667 1.0000000 0.3333333 1.0000000 0.5833333 1.0000000
angela  0.5000000 0.6666667 0.3333333 1.0000000 0.3333333 0.7500000 0.3333333
alberto 0.8333333 0.6666667 1.0000000 0.3333333 1.0000000 0.5833333 1.0000000
jesus   0.7500000 0.9166667 0.5833333 0.7500000 0.5833333 1.0000000 0.5833333
ana     0.8333333 0.6666667 1.0000000 0.3333333 1.0000000 0.5833333 1.0000000
fran    0.6666667 0.5000000 0.5000000 0.3333333 0.5000000 0.5833333 0.5000000
rosa    0.4166667 0.5833333 0.2500000 0.5833333 0.2500000 0.6666667 0.2500000
berni   0.5000000 0.6666667 0.3333333 0.3333333 0.3333333 0.5833333 0.3333333
ruben   0.8333333 0.6666667 1.0000000 0.3333333 1.0000000 0.5833333 1.0000000
             fran      rosa     berni     ruben
juan    0.6666667 0.4166667 0.5000000 0.8333333
pepe    0.5000000 0.5833333 0.6666667 0.6666667
jose    0.5000000 0.2500000 0.3333333 1.0000000
angela  0.3333333 0.5833333 0.3333333 0.3333333
alberto 0.5000000 0.2500000 0.3333333 1.0000000
jesus   0.5833333 0.6666667 0.5833333 0.5833333
ana     0.5000000 0.2500000 0.3333333 1.0000000
fran    1.0000000 0.7500000 0.6666667 0.5000000
rosa    0.7500000 1.0000000 0.7500000 0.2500000
berni   0.6666667 0.7500000 1.0000000 0.3333333
ruben   0.5000000 0.2500000 0.3333333 1.0000000

Índice de Jaccard

Similar al SMC, pero no tiene en cuenta el término M00

\(J = \frac{{M_{11}}}{{M_{01} + M_{10} + M_{11}}}\)

Code

A_juan_ruben <- 7 # Presencia en juan y ruben
B_juan_ruben <- 0 # Presencia en juan, ausencia en ruben
C_juan_ruben <- 2 # Ausencia en Juan, presencia en ruben
#D_juan_ruben <- 3 # Ausencia en ambos No se tiene en cuenta en Jaccard

J_juan_ruben <- (A_juan_ruben) / (A_juan_ruben + B_juan_ruben
                                                   + C_juan_ruben)
J_juan_ruben

[1] 0.7777778

Code

# Calcular la matriz de similitud, usando el coeficiente de Jaccard 
J <- proxy::simil(as.matrix(df), method = "Jaccard")
# Convertir a matriz de similitud
 distancia_jaccard <- 1-J
 distancia_jaccard

             juan      pepe      jose    angela   alberto     jesus       ana
pepe    0.2857143                                                            
jose    0.2222222 0.4444444                                                  
angela  0.6666667 0.5714286 0.7272727                                        
alberto 0.2222222 0.4444444 0.0000000 0.7272727                              
jesus   0.4285714 0.2000000 0.5555556 0.5000000 0.5555556                    
ana     0.2222222 0.4444444 0.0000000 0.7272727 0.0000000 0.5555556          
fran    0.5714286 0.8571429 0.6666667 1.0000000 0.6666667 0.8333333 0.6666667
rosa    1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000
berni   0.7500000 0.6666667 0.8000000 1.0000000 0.8000000 0.8333333 0.8000000
ruben   0.2222222 0.4444444 0.0000000 0.7272727 0.0000000 0.5555556 0.0000000
             fran      rosa     berni
pepe                                 
jose                                 
angela                               
alberto                              
jesus                                
ana                                  
fran                                 
rosa    1.0000000                    
berni   0.8000000 1.0000000          
ruben   0.6666667 1.0000000 0.8000000

Variables cuantitativas y cualitativas (Gower)

Se usa la medida de similaridad de Gower si las variables mezclan variables cuantitativas, cualitativas y/o cualitativas dicotómicas.

Explicacion fórmula de Gower

Code

#library(cluster)
#daisy(df, metric = "gower")

Dataset ejercicios:

Code

ss <- sample(1:50, 15)
df <- USArrests[ss,]
df.scaled <- scale(df)

Code

df.scaled

                   Murder    Assault    UrbanPop       Rape
North Carolina  1.0952927  1.4523361 -1.44775564 -0.7386810
Kansas         -0.6315201 -0.9537729 -0.04885065 -0.5479889
Minnesota      -1.4455891 -1.4198211 -0.04885065 -0.8591181
New York        0.6265864  0.5527548  1.28343982  0.2649617
California      0.1085425  0.7911980  1.61651243  1.7202435
Alaska          0.3552301  0.6502997 -1.24791207  2.1116642
Indiana        -0.3354951 -0.9754496 -0.11546517 -0.2468961
Ohio           -0.3108263 -0.8995813  0.55068006 -0.2067504
Florida         1.6873429  1.4306594  0.88375268  0.8470744
Idaho          -1.4702578 -0.8995813 -0.84822493 -0.9293731
South Carolina  1.4406553  0.8237130 -1.24791207 -0.0963497
Missouri        0.1085425 -0.2709582  0.21760744  0.4757266
Maryland        0.6759239  1.0513179  0.01776387  0.4355809
Montana        -0.6315201 -1.0188029 -0.91483945 -0.7085717
Rhode Island   -1.2729078 -0.3143115  1.35005434 -1.5215223
attr(,"scaled:center")
   Murder   Assault  UrbanPop      Rape 
  8.56000 203.00000  66.73333  23.46000 
attr(,"scaled:scale")
   Murder   Assault  UrbanPop      Rape 
 4.053711 92.265146 15.011741  9.963706

¿Qué distancia y qué tipo de escalado escoger?

Cuando nos interesa analizar como dos datos evolucionan en paralelo, buscaremos fórmulas de correlación. Por ejemplo, si analizamos datos de ventas por producto de un perfil de clientes, nos interesa agrupar a clientes que compran x producto, independientemente del volumen.

Si nos interesa agrupar por volumen, en este caso, fórmulas como la distancia euclídea son más apropiadas. En ocasiones, la distancia euclídea, no se ajusta a la realidad del problema, por ejemplo, con datos geográficos.

Cuando tenemos una gran cantidad de variables y no se conoce a priori el peso de las variables cualitativas vs cuantitativas, no podemos usar one hot encoding y operar como si las cualitativas fuesen cuantitativas. Tendremos diferentes alternativas:

Recategorizar todas las variables a cualitativas binarias, usando técnicas de binning
Realizar diferentes análisis con grupos de variables homogéneas
Utilizar la distancia de Gower

Respecto al escalado de variables cuantitativas, como norma general, si los datos son aproximadamente simétricos y siguen una distribución normal, se utilizará z-score, y si no lo son, se utilizará min-max. Hay otros tipos de escalado o transformaciones que podrían ser útiles según la distribución.

La distancia de Mahalanobis no requiere escalado y además elimina la información redundante, por lo que es apropiada cuando la distribución tiene muchas variables correlacionadas. Sin embargo es computacionalmente costosa, ya que requiere el cálculo de la matriz inversa de la covarianza.

Paquetes de R para el cálculo de las distancias y visualización

stats::dist: Solo datos numéricos
factoextra::dist: Solo datos numéricos. Permite obtener distancias basadas en correlaciones
cluster::daisy: Maneja más tipos de variables. Cuando se usan tipos distintos, se calcula el coeficiente de Gower.
factoextra::fviz_dist: Mapas de calor para matrices de distancia

Técnicas de clustering

Jerárquicas (HCA)

Agrupar objetos basándose en la similaridad, no se requiere especificar el número de clústers.

Aglomerativas

Cada observación es considerada un clúster en sí misma (hoja). Los clústeres más similares se van uniendo hasta que solo queda uno (raiz)

Divisivas

Proceso inverso al anterior. Empezando con la raiz, todo es un único clúster. Los clúster más heterogéneos se van dividiendo hasta que todas las observaciones están en su propio clúster.

La estructura resultante en ambos casos es en árbol, conocido como dendograma.

Pág. 68 Practical Guide To Cluster Analysis in R

Preparar los datos: Lectura del csv y escalado

Code

lqsa <- read.csv("https://raw.githubusercontent.com/jesusturpin/curintel2324/main/data/lqsa.csv")
nombres <- lqsa$Nombre
lqsa <- lqsa %>%
  select_if(is.numeric) %>%
  sapply(scale)
rownames(lqsa) <- nombres

Computar distancia

Code

lqsa.dist <- dist(lqsa, method = "euclidean")

Encadenamiento (linkage)

Debemos elegir entre varios métodos: ward.D, ward.D2, , complete, , mcquitty, median o

single: Método de encadenamiento simple o vecino más cercano. La distancia entre un elemento y un clúster es la menor distancia entre el elemento y cada elemento del clúster.
complete: Método de encadenamiento completo o vecino más lejano. La distancia máxima entre un elemento y un clúster es la mayor de las distancias del elemento y cada elemento del clúster.
average: Método de la distancia media. Se usa la distancia media entre el elemento y cada elemento del clúster. Se usa con frecuencia.
centroid: Método de la distancia entre centroides. El centroide es el punto medio de todos los puntos de un grupo. Tiene la limitación de que si uno de los grupos tiene pocos elementos respecto al otro, se pierden las propiedades de los grupos pequeños.
mediana: Supone que la distancia entre un elemento o grupo y otro viene dada por la mediana del triángulo formado por sus centroides
Método de Ward: Agrupa en cada etapa los dos clústeres que producen el menor incremento de la varianza
Método de Ward2: Una variación para mejorar la computación, aunque puede resultar ligeramente diferente cuando los árboles son muy grandes.
McQuitty:
Método flexible de Lance y Williams:

Generalmente, los más usados son completo y Ward.

Cluster y Dendograma

Code

lqsa.hc <- hclust(d = lqsa.dist, method = "ward.D2")

Code

fviz_dend(lqsa.hc, cex = 0.45)

Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
of ggplot2 3.3.4.
ℹ The deprecated feature was likely used in the factoextra package.
  Please report the issue at <https://github.com/kassambara/factoextra/issues>.

Verificando el árbol a través de la correlación entre distancia cofenética y distancia original.

La altura de la gráfica indica la distancia cofenética entre clústers. Un buen análisis clúster procurará maximizar esa distancia. Para identificar los grupos, cortamos el dendograma a una “cierta altura”.

Code

# Computar la distancia cofenética:
lqsa.cof <- cophenetic(lqsa.hc)

Code

# Correlación entre distancia
cor(lqsa.dist, lqsa.cof)

[1] 0.7462707

Code

# repitiendo el proceso cambiando el método de encadenamiento:
lqsa.hc2 <- hclust(lqsa.dist, method = "average")
cor(lqsa.dist, cophenetic(lqsa.hc2))

[1] 0.8348181

El método “average”, tiene una mejor correlación entre la distancia original y la distancia entre clústers. Por lo tanto, representa mejor la distancia original.

Cortar el dendograma en diferentes grupos

Uno de los problemas del análisis clúster es saber cuántos grupos debemos tener o lo que es lo mismo en el clustering jerárquico, dónde tenemos que cortar el dendograma.

Code

# Cortando por k = 3
lqsa.grp <- cutree(lqsa.hc2, k = 3)
lqsa.grp

        Ongombo         Violeta            Javi Estela Reynolds        La chusa 
              1               2               3               2               2 
        Vicente  Enrique Pastor          Amador       Doña Fina           Berta 
              1               3               2               2               3 
         Judith            Lola           Nines           Clara             Leo 
              2               2               2               2               2 
           Maxi    Los Cuquitos Padre Alejandro            Yoli           Coque 
              2               2               1               2               2 
         Menchu            Alba          Raquel   Antonio Recio           Bruno 
              2               2               1               3               2 
          Maite          Fermín         Araceli        Patricio         Teodoro 
              2               2               2               2               2

Code

# Número de miembros en cada grupo
table(lqsa.grp)

lqsa.grp
 1  2  3 
 4 22  4

Code

# Imprimir los miembros del grupo 1 y 3
rownames(lqsa)[lqsa.grp == 1]

[1] "Ongombo"         "Vicente"         "Padre Alejandro" "Raquel"

Code

rownames(lqsa)[lqsa.grp == 3]

[1] "Javi"           "Enrique Pastor" "Berta"          "Antonio Recio"

Code

# Mostrando el dendograma con 3 grupos por colores
fviz_dend(lqsa.hc2, k = 3, # Cut in four groups
cex = 0.5, # label size
k_colors = c("#2E9FDF", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE, # color labels by groups
rect = TRUE # Add rectangle around groups
)

Code

# Diagrama de dispersión, mostrando grupos y con etiquetas

fviz_cluster(list(data = lqsa, cluster = lqsa.grp),
palette = c("#2E9FDF", "#E7B800", "#FC4E07"),
ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())

El paquete cluster

Code

library(cluster)
#AGglomerative NESting (cluster jerárquico aglomerativo)
lqsa.agnes <- agnes(x = lqsa,
           stand = TRUE, # Estandarizar datos
           metric = "euclidean",
           method = "ward"
           ) 
fviz_dend(lqsa.agnes, cex = 0.6, k = 3)

Code

lqsa.diana <- diana(x = lqsa, # data matrix
                    stand = TRUE, # standardize the data
                    metric = "euclidean") # metric for distance matrix
fviz_dend(lqsa.diana, cex = 0.6, k = 3)

La técnica aglomerativa es ideal para identificar clusters pequeños, mientras que las técnicas divisivas lo son para grandes clústeres.