Problemas 3.1.
David López
2024-04-18
Ejercicios: Introducción al machine learning con R
#Ejercicio 1. Modelos supervisados. Análisis de regresión múltiple A partir del conjunto de datos swiss del paquete datasets, calculad la matriz de correlación y, a partir de esta, realizad un análisis de regresión múltiple. Razonad los resultados.
#Cargamos los datos
library(datasets)
data("swiss")
head(swiss)## Fertility Agriculture Examination Education Catholic
## Courtelary 80.2 17.0 15 12 9.96
## Delemont 83.1 45.1 6 9 84.84
## Franches-Mnt 92.5 39.7 5 5 93.40
## Moutier 85.8 36.5 12 7 33.77
## Neuveville 76.9 43.5 17 15 5.16
## Porrentruy 76.1 35.3 9 7 90.57
## Infant.Mortality
## Courtelary 22.2
## Delemont 22.2
## Franches-Mnt 20.2
## Moutier 20.3
## Neuveville 20.6
## Porrentruy 26.6summary(swiss)## Fertility Agriculture Examination Education
## Min. :35.00 Min. : 1.20 Min. : 3.00 Min. : 1.00
## 1st Qu.:64.70 1st Qu.:35.90 1st Qu.:12.00 1st Qu.: 6.00
## Median :70.40 Median :54.10 Median :16.00 Median : 8.00
## Mean :70.14 Mean :50.66 Mean :16.49 Mean :10.98
## 3rd Qu.:78.45 3rd Qu.:67.65 3rd Qu.:22.00 3rd Qu.:12.00
## Max. :92.50 Max. :89.70 Max. :37.00 Max. :53.00
## Catholic Infant.Mortality
## Min. : 2.150 Min. :10.80
## 1st Qu.: 5.195 1st Qu.:18.15
## Median : 15.140 Median :20.00
## Mean : 41.144 Mean :19.94
## 3rd Qu.: 93.125 3rd Qu.:21.70
## Max. :100.000 Max. :26.60#Realizamos la matriz de correlación
cor(x=swiss, method="pearson")## Fertility Agriculture Examination Education Catholic
## Fertility 1.0000000 0.35307918 -0.6458827 -0.66378886 0.4636847
## Agriculture 0.3530792 1.00000000 -0.6865422 -0.63952252 0.4010951
## Examination -0.6458827 -0.68654221 1.0000000 0.69841530 -0.5727418
## Education -0.6637889 -0.63952252 0.6984153 1.00000000 -0.1538589
## Catholic 0.4636847 0.40109505 -0.5727418 -0.15385892 1.0000000
## Infant.Mortality 0.4165560 -0.06085861 -0.1140216 -0.09932185 0.1754959
## Infant.Mortality
## Fertility 0.41655603
## Agriculture -0.06085861
## Examination -0.11402160
## Education -0.09932185
## Catholic 0.17549591
## Infant.Mortality 1.00000000#Generamos el modelo de regresión múltiple
mrm_swiss<-lm(swiss$Fertility~swiss$Agriculture+swiss$Examination+swiss$Education+swiss$Catholic+swiss$Infant.Mortality, data=swiss)
summary(mrm_swiss)##
## Call:
## lm(formula = swiss$Fertility ~ swiss$Agriculture + swiss$Examination +
## swiss$Education + swiss$Catholic + swiss$Infant.Mortality,
## data = swiss)
##
## Residuals:
## Min 1Q Median 3Q Max
## -15.2743 -5.2617 0.5032 4.1198 15.3213
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 66.91518 10.70604 6.250 1.91e-07 ***
## swiss$Agriculture -0.17211 0.07030 -2.448 0.01873 *
## swiss$Examination -0.25801 0.25388 -1.016 0.31546
## swiss$Education -0.87094 0.18303 -4.758 2.43e-05 ***
## swiss$Catholic 0.10412 0.03526 2.953 0.00519 **
## swiss$Infant.Mortality 1.07705 0.38172 2.822 0.00734 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.165 on 41 degrees of freedom
## Multiple R-squared: 0.7067, Adjusted R-squared: 0.671
## F-statistic: 19.76 on 5 and 41 DF, p-value: 5.594e-10#Seleccionamos los mejores predictores posibles
step(object=mrm_swiss, direction="both",trace=1)## Start: AIC=190.69
## swiss$Fertility ~ swiss$Agriculture + swiss$Examination + swiss$Education +
## swiss$Catholic + swiss$Infant.Mortality
##
## Df Sum of Sq RSS AIC
## - swiss$Examination 1 53.03 2158.1 189.86
## <none> 2105.0 190.69
## - swiss$Agriculture 1 307.72 2412.8 195.10
## - swiss$Infant.Mortality 1 408.75 2513.8 197.03
## - swiss$Catholic 1 447.71 2552.8 197.75
## - swiss$Education 1 1162.56 3267.6 209.36
##
## Step: AIC=189.86
## swiss$Fertility ~ swiss$Agriculture + swiss$Education + swiss$Catholic +
## swiss$Infant.Mortality
##
## Df Sum of Sq RSS AIC
## <none> 2158.1 189.86
## + swiss$Examination 1 53.03 2105.0 190.69
## - swiss$Agriculture 1 264.18 2422.2 193.29
## - swiss$Infant.Mortality 1 409.81 2567.9 196.03
## - swiss$Catholic 1 956.57 3114.6 205.10
## - swiss$Education 1 2249.97 4408.0 221.43##
## Call:
## lm(formula = swiss$Fertility ~ swiss$Agriculture + swiss$Education +
## swiss$Catholic + swiss$Infant.Mortality, data = swiss)
##
## Coefficients:
## (Intercept) swiss$Agriculture swiss$Education
## 62.1013 -0.1546 -0.9803
## swiss$Catholic swiss$Infant.Mortality
## 0.1247 1.0784#Ejecutamos de nuevo el modelo con los predictores más significativos
mrm_swiss_predictores<-(lm(formula =swiss$Fertility~swiss$Agriculture+swiss$Education+swiss$Catholic+swiss$Infant.Mortality, data=swiss))
summary(mrm_swiss_predictores)##
## Call:
## lm(formula = swiss$Fertility ~ swiss$Agriculture + swiss$Education +
## swiss$Catholic + swiss$Infant.Mortality, data = swiss)
##
## Residuals:
## Min 1Q Median 3Q Max
## -14.6765 -6.0522 0.7514 3.1664 16.1422
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 62.10131 9.60489 6.466 8.49e-08 ***
## swiss$Agriculture -0.15462 0.06819 -2.267 0.02857 *
## swiss$Education -0.98026 0.14814 -6.617 5.14e-08 ***
## swiss$Catholic 0.12467 0.02889 4.315 9.50e-05 ***
## swiss$Infant.Mortality 1.07844 0.38187 2.824 0.00722 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.168 on 42 degrees of freedom
## Multiple R-squared: 0.6993, Adjusted R-squared: 0.6707
## F-statistic: 24.42 on 4 and 42 DF, p-value: 1.717e-10Con esto vemos que hemos sido capaces de generar un modelo de
regresión lineal múltiples para predecir el parámetro fertilidad. Para
esto, se ha hecho la matriz de correlación, de la cuál vemos la
correlación entre las diferentes variables 2 a 2, siendo el valor más
alto para la variable Fertility (aunque en negativo) la
relación entre esta variable y Education.
Posteriormente hacemos un modelo usando todas las variables. A
cotinuación se eligen los mejores predcitores de los 5 posibles y se
observa que estos son: Agriculture, Education,
Catholic y Infant.Mortality, mientras que
Examination no. Finalmente hacemos de nuevo el modelo con los
predictores seleccionados y vemos que el valor de Adjusted
R-squared es 0.6707 y el p-valor es significativo
(1.717e-10<0.05). Esto significa que significa que, como vemos en el
resumen estadístico, todas las variables independientes sincluidas en el
modelo tiene un efecto significativo en la variable dependiente, es
decir, hay evidencia estadística suficiente para afirmar que la relación
entre las variables independientes y la variable dependiente no es
casualidad y que realmente existe una asociación entre ellas.
#Ejercicio 2. Modelos supervisados. Modelo de clasificación SVM A partir del conjunto de datos Pima.tr del paquete MASS que hace referencia a datos de diabetes de pacientes indias, realizad un modelo de clasificación SVM y realizad una clasificación de pacientes para predecir si están en riesgo de padecer diabetes. Para realizar este ejercicio utilizad el paquete kernlab para entrenar el modelo SVM.
#Cargamos los datos
library(MASS)
data(Pima.tr)
head(Pima.tr)## npreg glu bp skin bmi ped age type
## 1 5 86 68 28 30.2 0.364 24 No
## 2 7 195 70 33 25.1 0.163 55 Yes
## 3 5 77 82 41 35.8 0.156 35 No
## 4 0 165 76 43 47.9 0.259 26 No
## 5 0 107 60 25 26.4 0.133 23 No
## 6 5 97 76 27 35.6 0.378 52 Yes#Dividmos los dato en conjunto de entrenamiento y prueba
set.seed(999)
library(caTools)
split <- sample.split(Pima.tr$type, SplitRatio = 0.7)
data_train <- Pima.tr[split, ] #conjunto de datos de entrenamiento
data_test <- Pima.tr[!split, ] #conjunto de datos de prueba
#CArgamos el paquete "kernlab" para para hacer el SVM
library(kernlab)
#Entrenamos un modelo y hacemos la predicciones
model<-ksvm(type ~ ., data=data_train)
predictions<-predict(model, newdata=data_test)
#Cargamos el paquete "caret" para poder hacer la matriz de confusión, que también nos dará la precisión del modelo, entre otros parámetros
library(caret)## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following object is masked from 'package:kernlab':
##
## alpha## Loading required package: latticeconfusion_matrix <- confusionMatrix(predictions, data_test$type)
confusion_matrix## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 37 12
## Yes 3 8
##
## Accuracy : 0.75
## 95% CI : (0.6214, 0.8528)
## No Information Rate : 0.6667
## P-Value [Acc > NIR] : 0.10711
##
## Kappa : 0.3662
##
## Mcnemar's Test P-Value : 0.03887
##
## Sensitivity : 0.9250
## Specificity : 0.4000
## Pos Pred Value : 0.7551
## Neg Pred Value : 0.7273
## Prevalence : 0.6667
## Detection Rate : 0.6167
## Detection Prevalence : 0.8167
## Balanced Accuracy : 0.6625
##
## 'Positive' Class : No
## print("La precisión (o Accuracy) es del 75%")## [1] "La precisión (o Accuracy) es del 75%"#Ejercicio 3. Modelos no supervisados. PCA A partir del conjunto de datos Iris, se pide realizar un análisis de componentes centrado, por ejemplo, en las medidas de longitud y ancho del sépalo y el pétalo.
#Cargamos los datos
data("iris")
head(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa#Consideramos solo las 4 que nos pide el ejercicio, y no incluimos la información de la especie
selecc_datos<-iris[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
estand_data_iris<-scale(selecc_datos)
head(estand_data_iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width
## [1,] -0.8976739 1.01560199 -1.335752 -1.311052
## [2,] -1.1392005 -0.13153881 -1.335752 -1.311052
## [3,] -1.3807271 0.32731751 -1.392399 -1.311052
## [4,] -1.5014904 0.09788935 -1.279104 -1.311052
## [5,] -1.0184372 1.24503015 -1.335752 -1.311052
## [6,] -0.5353840 1.93331463 -1.165809 -1.048667#Aplicamos el PCA
pca_resultado<-prcomp(estand_data_iris, center = TRUE, scale =TRUE)
#Hacemos un resumen de la varianza explicada por cada variable
summary(pca_resultado)## Importance of components:
## PC1 PC2 PC3 PC4
## Standard deviation 1.7084 0.9560 0.38309 0.14393
## Proportion of Variance 0.7296 0.2285 0.03669 0.00518
## Cumulative Proportion 0.7296 0.9581 0.99482 1.00000#Representamos la varianza explicada por cada componente
plot(pca_resultado)
#Finalmente generemos una matriz con los cargos de las variables para cada componente principal
cargos <- pca_resultado$rotation
cargos## PC1 PC2 PC3 PC4
## Sepal.Length 0.5210659 -0.37741762 0.7195664 0.2612863
## Sepal.Width -0.2693474 -0.92329566 -0.2443818 -0.1235096
## Petal.Length 0.5804131 -0.02449161 -0.1421264 -0.8014492
## Petal.Width 0.5648565 -0.06694199 -0.6342727 0.5235971#Ejercicio 4. Agrupamiento jerárquico. Agrupamiento jerárquico aglomerativo Realizad un agrupamiento jerárquico aglomerativo con el paquete de datos birthwt del paquete MASS.
#Cargamos los datos
library(MASS)
data("birthwt")
head(birthwt)## low age lwt race smoke ptl ht ui ftv bwt
## 85 0 19 182 2 0 0 0 1 0 2523
## 86 0 33 155 3 0 0 0 0 3 2551
## 87 0 20 105 1 1 0 0 0 1 2557
## 88 0 21 108 1 1 0 0 1 2 2594
## 89 0 18 107 1 1 0 0 1 0 2600
## 91 0 21 124 3 0 0 0 0 0 2622#Realizamos agrupamiento jerárquico aglomerativo. Primero calculamos la matriz de distancias
dist_matrix<-dist(birthwt)
#Alpicamos la función hclust() para usar el método de agrupamiento aglomerativo
hc_aglomerativo<-hclust(dist_matrix, method = "ward.D2")
#Reprsentamos el dendrograma resultante
plot(hc_aglomerativo, main = "Dendrograma de Agrupamiento Jerárquico Aglomerativo", xlab = "birthwt")
#Elegimos un nivel de corte del dendograma, por ejemplo, dividir en 5 clústeres
nivel_corte<-5
cluster_asignado<-cutree(hc_aglomerativo, k = nivel_corte)
#Mostramos los resultados
resultado<-data.frame(Cluster = cluster_asignado)
print(resultado)## Cluster
## 85 1
## 86 1
## 87 2
## 88 2
## 89 2
## 91 2
## 92 2
## 93 2
## 94 2
## 95 2
## 96 2
## 97 2
## 98 2
## 99 2
## 100 2
## 101 2
## 102 2
## 103 2
## 104 2
## 105 2
## 106 2
## 107 2
## 108 2
## 109 2
## 111 2
## 112 2
## 113 2
## 114 2
## 115 2
## 116 2
## 117 2
## 118 2
## 119 2
## 120 2
## 121 2
## 123 2
## 124 2
## 125 2
## 126 3
## 127 3
## 128 3
## 129 3
## 130 3
## 131 3
## 132 3
## 133 3
## 134 3
## 135 3
## 136 3
## 137 3
## 138 3
## 139 3
## 140 3
## 141 3
## 142 3
## 143 3
## 144 3
## 145 3
## 146 3
## 147 3
## 148 3
## 149 3
## 150 3
## 151 3
## 154 3
## 155 3
## 156 3
## 159 3
## 160 3
## 161 3
## 162 3
## 163 3
## 164 3
## 166 3
## 167 3
## 168 3
## 169 3
## 170 3
## 172 3
## 173 3
## 174 3
## 175 3
## 176 4
## 177 3
## 179 4
## 180 4
## 181 4
## 182 4
## 183 4
## 184 4
## 185 4
## 186 4
## 187 4
## 188 4
## 189 4
## 190 4
## 191 4
## 192 4
## 193 4
## 195 4
## 196 4
## 197 4
## 199 4
## 200 4
## 201 4
## 202 4
## 203 4
## 204 4
## 205 4
## 206 4
## 207 4
## 208 4
## 209 4
## 210 4
## 211 4
## 212 4
## 213 4
## 214 4
## 215 4
## 216 4
## 217 4
## 218 4
## 219 4
## 220 4
## 221 4
## 222 4
## 223 4
## 224 4
## 225 4
## 226 4
## 4 5
## 10 5
## 11 5
## 13 5
## 15 5
## 16 5
## 17 5
## 18 5
## 19 5
## 20 5
## 22 5
## 23 5
## 24 5
## 25 5
## 26 5
## 27 5
## 28 5
## 29 5
## 30 5
## 31 1
## 32 1
## 33 1
## 34 1
## 35 1
## 36 1
## 37 1
## 40 1
## 42 1
## 43 1
## 44 1
## 45 1
## 46 1
## 47 1
## 49 1
## 50 1
## 51 1
## 52 1
## 54 1
## 56 1
## 57 1
## 59 1
## 60 1
## 61 1
## 62 1
## 63 1
## 65 1
## 67 1
## 68 1
## 69 1
## 71 1
## 75 1
## 76 1
## 77 1
## 78 1
## 79 1
## 81 1
## 82 1
## 83 1
## 84 1#Ejercicio 5. Agrupamiento jerárquico. Agrupamiento jerárquico divisivo Realizad un agrupamiento jerárquico divisivo con el paquete de datos birthwt del paquete MASS.
#Cargamos los datos
data("birthwt")
head(birthwt)## low age lwt race smoke ptl ht ui ftv bwt
## 85 0 19 182 2 0 0 0 1 0 2523
## 86 0 33 155 3 0 0 0 0 3 2551
## 87 0 20 105 1 1 0 0 0 1 2557
## 88 0 21 108 1 1 0 0 1 2 2594
## 89 0 18 107 1 1 0 0 1 0 2600
## 91 0 21 124 3 0 0 0 0 0 2622#Realizamos agrupamiento jerárquico aglomerativo. Primero calculamos la matriz de distancias
dist_matrix2<-dist(birthwt)
#Cargamos el paquete "cluster" u usamos la función diana() para usar el método de agrupamiento divisivo
library(cluster)
hc_divisivo<-diana(dist_matrix2) # Método de agrupamiento divisivo
# Representación del dendrograma
plot(hc_divisivo, main = "Dendrograma de Agrupamiento Jerárquico Divisivo", xlab = "birthwt")
#Elegimos un nivel de corte del dendograma, por ejemplo, dividir en 5 clústeres, como antes
nivel_corte2<-5
cluster_asignado2<-cutree(hc_divisivo, k = nivel_corte2)
#Mostramos los resultados
resultado2<-data.frame(Cluster = cluster_asignado2)
print(resultado2)## Cluster
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
## 11 1
## 12 1
## 13 1
## 14 1
## 15 1
## 16 1
## 17 1
## 18 1
## 19 1
## 20 1
## 21 1
## 22 1
## 23 1
## 24 1
## 25 2
## 26 2
## 27 2
## 28 2
## 29 2
## 30 2
## 31 2
## 32 2
## 33 2
## 34 2
## 35 2
## 36 2
## 37 2
## 38 2
## 39 2
## 40 2
## 41 2
## 42 2
## 43 2
## 44 2
## 45 2
## 46 2
## 47 2
## 48 2
## 49 2
## 50 2
## 51 2
## 52 2
## 53 2
## 54 2
## 55 2
## 56 2
## 57 2
## 58 2
## 59 2
## 60 2
## 61 2
## 62 2
## 63 2
## 64 2
## 65 2
## 66 2
## 67 2
## 68 2
## 69 2
## 70 2
## 71 2
## 72 2
## 73 2
## 74 2
## 75 2
## 76 2
## 77 2
## 78 2
## 79 2
## 80 2
## 81 2
## 82 2
## 83 3
## 84 2
## 85 3
## 86 3
## 87 3
## 88 3
## 89 3
## 90 3
## 91 3
## 92 3
## 93 3
## 94 3
## 95 3
## 96 3
## 97 3
## 98 3
## 99 3
## 100 3
## 101 3
## 102 3
## 103 3
## 104 3
## 105 3
## 106 3
## 107 3
## 108 3
## 109 3
## 110 3
## 111 3
## 112 3
## 113 3
## 114 3
## 115 3
## 116 3
## 117 3
## 118 3
## 119 3
## 120 3
## 121 3
## 122 3
## 123 3
## 124 3
## 125 3
## 126 3
## 127 3
## 128 3
## 129 4
## 130 4
## 131 5
## 132 5
## 133 5
## 134 5
## 135 5
## 136 5
## 137 5
## 138 5
## 139 5
## 140 5
## 141 5
## 142 5
## 143 5
## 144 5
## 145 5
## 146 5
## 147 5
## 148 5
## 149 5
## 150 5
## 151 5
## 152 5
## 153 5
## 154 5
## 155 5
## 156 5
## 157 5
## 158 1
## 159 1
## 160 1
## 161 1
## 162 1
## 163 1
## 164 1
## 165 1
## 166 1
## 167 1
## 168 1
## 169 1
## 170 1
## 171 1
## 172 1
## 173 1
## 174 1
## 175 1
## 176 1
## 177 1
## 178 1
## 179 1
## 180 1
## 181 1
## 182 1
## 183 1
## 184 1
## 185 1
## 186 1
## 187 1
## 188 1
## 189 1#Finalmente podemos añadir una representación gráfica de los diferentes clústers
pltree(hc_divisivo,hang=-1,cex=0.6)
rect.hclust(hc_divisivo,k=10,border=2:10)
#Ejercicio 6. Agrupamiento jerárquico. Agrupamiento jerárquico aglomerativo Realizad un agrupamiento jerárquico de tipo aglomerativo para el conjunto de datos Melanoma del paquete MASS.
#Seguimos el mismo procedimiento que en el ejercicio 4
#Cargamos los datos
data("Melanoma")
head(Melanoma)## time status sex age year thickness ulcer
## 1 10 3 1 76 1972 6.76 1
## 2 30 3 1 56 1968 0.65 0
## 3 35 2 1 41 1977 1.34 0
## 4 99 3 0 71 1968 2.90 0
## 5 185 1 1 52 1965 12.08 1
## 6 204 1 1 28 1971 4.84 1#Realizamos agrupamiento jerárquico aglomerativo. Primero calculamos la matriz de distancias
dist_matrix3<-dist(Melanoma)
#Alpicamos la función hclust() para usar el método de agrupamiento aglomerativo
hc_aglomerativo2<-hclust(dist_matrix3, method = "ward.D2")
#Reprsentamos el dendrograma resultante
plot(hc_aglomerativo2, main = "Dendrograma de Agrupamiento Jerárquico Aglomerativo", xlab = "melanoma")
#Elegimos un nivel de corte del dendograma, por ejemplo, dividir en 4 clústeres
nivel_corte3<-4
cluster_asignado3<-cutree(hc_aglomerativo2, k = nivel_corte3)
#Mostramos los resultados
resultado3<-data.frame(Cluster = cluster_asignado3)
print(resultado3)## Cluster
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
## 11 1
## 12 1
## 13 1
## 14 1
## 15 1
## 16 1
## 17 1
## 18 1
## 19 1
## 20 1
## 21 1
## 22 1
## 23 1
## 24 1
## 25 1
## 26 1
## 27 1
## 28 1
## 29 1
## 30 1
## 31 1
## 32 1
## 33 1
## 34 1
## 35 1
## 36 1
## 37 1
## 38 1
## 39 1
## 40 1
## 41 1
## 42 1
## 43 1
## 44 2
## 45 2
## 46 2
## 47 2
## 48 2
## 49 2
## 50 2
## 51 2
## 52 2
## 53 2
## 54 2
## 55 2
## 56 2
## 57 2
## 58 2
## 59 2
## 60 2
## 61 2
## 62 2
## 63 2
## 64 2
## 65 2
## 66 2
## 67 2
## 68 2
## 69 2
## 70 2
## 71 2
## 72 2
## 73 2
## 74 2
## 75 2
## 76 2
## 77 2
## 78 2
## 79 2
## 80 2
## 81 2
## 82 2
## 83 2
## 84 2
## 85 2
## 86 2
## 87 2
## 88 2
## 89 2
## 90 2
## 91 2
## 92 2
## 93 2
## 94 2
## 95 2
## 96 2
## 97 2
## 98 2
## 99 2
## 100 2
## 101 2
## 102 2
## 103 2
## 104 2
## 105 2
## 106 2
## 107 2
## 108 2
## 109 2
## 110 2
## 111 2
## 112 2
## 113 2
## 114 2
## 115 2
## 116 2
## 117 2
## 118 2
## 119 2
## 120 2
## 121 2
## 122 2
## 123 2
## 124 2
## 125 2
## 126 2
## 127 2
## 128 3
## 129 3
## 130 3
## 131 3
## 132 3
## 133 3
## 134 3
## 135 3
## 136 3
## 137 3
## 138 3
## 139 3
## 140 3
## 141 3
## 142 3
## 143 3
## 144 3
## 145 3
## 146 3
## 147 3
## 148 3
## 149 3
## 150 3
## 151 3
## 152 3
## 153 3
## 154 3
## 155 3
## 156 3
## 157 3
## 158 3
## 159 3
## 160 3
## 161 3
## 162 3
## 163 3
## 164 3
## 165 3
## 166 3
## 167 3
## 168 3
## 169 3
## 170 3
## 171 3
## 172 3
## 173 3
## 174 3
## 175 3
## 176 3
## 177 3
## 178 3
## 179 3
## 180 3
## 181 3
## 182 3
## 183 4
## 184 4
## 185 4
## 186 4
## 187 4
## 188 4
## 189 4
## 190 4
## 191 4
## 192 4
## 193 4
## 194 4
## 195 4
## 196 4
## 197 4
## 198 4
## 199 4
## 200 4
## 201 4
## 202 4
## 203 4
## 204 4
## 205 4#Ejercicio 7. Agrupamiento jerárquico. Agrupamiento jerárquico divisivo Realizad un agrupamiento jerárquico de tipo divisivo para el conjunto de datos Melanoma del paquete MASS.
#Seguimos el mismo procedimiento que en el ejercicio 5
#Cargamos los datos
data("Melanoma")
head(Melanoma)## time status sex age year thickness ulcer
## 1 10 3 1 76 1972 6.76 1
## 2 30 3 1 56 1968 0.65 0
## 3 35 2 1 41 1977 1.34 0
## 4 99 3 0 71 1968 2.90 0
## 5 185 1 1 52 1965 12.08 1
## 6 204 1 1 28 1971 4.84 1#Realizamos agrupamiento jerárquico aglomerativo. Primero calculamos la matriz de distancias
dist_matrix4<-dist(Melanoma)
#Cargamos el paquete "cluster" u usamos la función diana() para usar el método de agrupamiento divisivo
library(cluster)
hc_divisivo2<-diana(dist_matrix4) # Método de agrupamiento divisivo
# Representación del dendrograma
plot(hc_divisivo2, main = "Dendrograma de Agrupamiento Jerárquico Divisivo", xlab = "melanoma")
#Elegimos un nivel de corte del dendograma, por ejemplo, dividir en 4 clústeres, como antes
nivel_corte4<-4
cluster_asignado4<-cutree(hc_divisivo2, k = nivel_corte4)
#Mostramos los resultados
resultado4<-data.frame(Cluster = cluster_asignado4)
print(resultado4)## Cluster
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
## 7 1
## 8 1
## 9 1
## 10 1
## 11 1
## 12 1
## 13 1
## 14 1
## 15 1
## 16 1
## 17 1
## 18 1
## 19 1
## 20 1
## 21 1
## 22 1
## 23 1
## 24 1
## 25 1
## 26 1
## 27 1
## 28 1
## 29 1
## 30 1
## 31 1
## 32 1
## 33 1
## 34 1
## 35 1
## 36 1
## 37 1
## 38 1
## 39 1
## 40 1
## 41 1
## 42 2
## 43 2
## 44 2
## 45 2
## 46 2
## 47 2
## 48 2
## 49 2
## 50 2
## 51 2
## 52 2
## 53 2
## 54 2
## 55 2
## 56 2
## 57 2
## 58 2
## 59 2
## 60 2
## 61 2
## 62 2
## 63 2
## 64 2
## 65 2
## 66 2
## 67 2
## 68 2
## 69 2
## 70 2
## 71 2
## 72 2
## 73 2
## 74 2
## 75 2
## 76 2
## 77 2
## 78 2
## 79 2
## 80 2
## 81 2
## 82 2
## 83 2
## 84 2
## 85 2
## 86 2
## 87 2
## 88 2
## 89 2
## 90 2
## 91 2
## 92 2
## 93 2
## 94 2
## 95 2
## 96 2
## 97 2
## 98 2
## 99 2
## 100 2
## 101 2
## 102 2
## 103 2
## 104 2
## 105 2
## 106 2
## 107 2
## 108 2
## 109 2
## 110 2
## 111 2
## 112 2
## 113 2
## 114 2
## 115 2
## 116 2
## 117 2
## 118 2
## 119 2
## 120 2
## 121 2
## 122 2
## 123 2
## 124 2
## 125 2
## 126 2
## 127 2
## 128 2
## 129 2
## 130 2
## 131 2
## 132 2
## 133 2
## 134 2
## 135 2
## 136 2
## 137 2
## 138 2
## 139 2
## 140 3
## 141 3
## 142 3
## 143 3
## 144 3
## 145 3
## 146 3
## 147 3
## 148 3
## 149 3
## 150 3
## 151 3
## 152 3
## 153 3
## 154 3
## 155 3
## 156 3
## 157 3
## 158 3
## 159 3
## 160 3
## 161 3
## 162 3
## 163 3
## 164 3
## 165 3
## 166 3
## 167 3
## 168 3
## 169 3
## 170 3
## 171 3
## 172 3
## 173 3
## 174 3
## 175 3
## 176 3
## 177 3
## 178 3
## 179 3
## 180 3
## 181 3
## 182 3
## 183 4
## 184 4
## 185 4
## 186 4
## 187 4
## 188 4
## 189 4
## 190 4
## 191 4
## 192 4
## 193 4
## 194 4
## 195 4
## 196 4
## 197 4
## 198 4
## 199 4
## 200 4
## 201 4
## 202 4
## 203 4
## 204 4
## 205 4#Finalmente podemos añadir una representación gráfica de los diferentes clústers
pltree(hc_divisivo2,hang=-1,cex=0.6, main = "Dendrograma de Agrupamiento Jerárquico Divisivo", xlab = "melanoma")
rect.hclust(hc_divisivo2,k=10,border=2:10, )
#Ejercicio 8. Agrupamiento no jerárquico Realizad un agrupamiento no jerárquico utilizando el conjunto de datos birthwt del paquete MASS.
#Cargamos los datos
data("birthwt")
head(birthwt)## low age lwt race smoke ptl ht ui ftv bwt
## 85 0 19 182 2 0 0 0 1 0 2523
## 86 0 33 155 3 0 0 0 0 3 2551
## 87 0 20 105 1 1 0 0 0 1 2557
## 88 0 21 108 1 1 0 0 1 2 2594
## 89 0 18 107 1 1 0 0 1 0 2600
## 91 0 21 124 3 0 0 0 0 0 2622#Comprobamos el grado de correlación entre las diferentes variables
corr=cor(birthwt)
corr## low age lwt race smoke ptl
## low 1.00000000 -0.11893928 -0.16962694 0.137792751 0.16140431 0.196087267
## age -0.11893928 1.00000000 0.18007315 -0.172817953 -0.04434618 0.071606386
## lwt -0.16962694 0.18007315 1.00000000 -0.165048544 -0.04417908 -0.140029003
## race 0.13779275 -0.17281795 -0.16504854 1.000000000 -0.33903074 0.007951293
## smoke 0.16140431 -0.04434618 -0.04417908 -0.339030745 1.00000000 0.187557063
## ptl 0.19608727 0.07160639 -0.14002900 0.007951293 0.18755706 1.000000000
## ht 0.15237025 -0.01583700 0.23636040 0.019929917 0.01340704 -0.015399579
## ui 0.16904283 -0.07515558 -0.15276317 0.053602088 0.06215900 0.227585340
## ftv -0.06296026 0.21539394 0.14052746 -0.098336254 -0.02801314 -0.044429660
## bwt -0.78480516 0.09031781 0.18573328 -0.194713487 -0.19044806 -0.154653390
## ht ui ftv bwt
## low 0.15237025 0.16904283 -0.06296026 -0.78480516
## age -0.01583700 -0.07515558 0.21539394 0.09031781
## lwt 0.23636040 -0.15276317 0.14052746 0.18573328
## race 0.01992992 0.05360209 -0.09833625 -0.19471349
## smoke 0.01340704 0.06215900 -0.02801314 -0.19044806
## ptl -0.01539958 0.22758534 -0.04442966 -0.15465339
## ht 1.00000000 -0.10858506 -0.07237255 -0.14598189
## ui -0.10858506 1.00000000 -0.05952341 -0.28392741
## ftv -0.07237255 -0.05952341 1.00000000 0.05831777
## bwt -0.14598189 -0.28392741 0.05831777 1.00000000#Aplicamos k-means con k=3 (3 clústeres)
k<-3
kmeans_resultado2<-kmeans(birthwt, centers = k)
#Visualizamos los resultados
library(ggplot2)
asignaciones<- kmeans_resultado2$cluster
centros<-kmeans_resultado2$centers
#Convertimos los centros calculados en un data frame
centros_df<-as.data.frame(centros)
#Representamos un gráfico de dispersión de los datos con colores para los clústeres
ggplot(birthwt, aes(x = bwt, y = age, color=factor(asignaciones))) +
geom_point() +
geom_point(data = centros_df, aes(x = bwt, y = age),color = "black", size = 3, shape = 4) +
labs(title = "Segmentación de Pacientes por K-Means")
#Ejercicio 9. Agrupamiento no jerárquico Realizad un agrupamiento no jerárquico utilizando la técnica k-means() para el conjunto de datos Melanoma del paquete MASS. Valorad los resultados para distintos números de clústeres y definiendo una determinada variable objetivo. Podéis transformar alguna variable entera de modo categórico, por ejemplo, la referente al estatus.
#Cargamos los datos
data("Melanoma")
head(Melanoma)## time status sex age year thickness ulcer
## 1 10 3 1 76 1972 6.76 1
## 2 30 3 1 56 1968 0.65 0
## 3 35 2 1 41 1977 1.34 0
## 4 99 3 0 71 1968 2.90 0
## 5 185 1 1 52 1965 12.08 1
## 6 204 1 1 28 1971 4.84 1#Comprobamos el grado de correlación entre las diferentes variables
corr2=cor(Melanoma)
corr2## time status sex age year
## time 1.0000000 0.31614601 -0.146499215 -0.30151794 -0.485504359
## status 0.3161460 1.00000000 -0.098967345 0.01596386 0.138166927
## sex -0.1464992 -0.09896735 1.000000000 0.06833741 -0.002645159
## age -0.3015179 0.01596386 0.068337413 1.00000000 0.188229089
## year -0.4855044 0.13816693 -0.002645159 0.18822909 1.000000000
## thickness -0.2354087 -0.20472162 0.185412563 0.21247979 -0.133345424
## ulcer -0.2647575 -0.27032555 0.167979154 0.12606294 -0.033125618
## thickness ulcer
## time -0.2354087 -0.26475748
## status -0.2047216 -0.27032555
## sex 0.1854126 0.16797915
## age 0.2124798 0.12606294
## year -0.1333454 -0.03312562
## thickness 1.0000000 0.42445931
## ulcer 0.4244593 1.00000000#Aplicamos k-means con k=3 (3 clústeres)
k<-3
kmeans_resultado2<-kmeans(Melanoma, centers = k)
#Visualizamos los resultados
library(ggplot2)
asignaciones2<- kmeans_resultado2$cluster
centros2<-kmeans_resultado2$centers
#Convertimos los centros calculados en un data frame
centros_df2<-as.data.frame(centros2)
#Representamos un gráfico de dispersión de los datos con colores para los clústeres
ggplot(Melanoma, aes(x = age, y = thickness, color=factor(asignaciones2))) +
geom_point() +
geom_point(data = centros_df2, aes(x = age, y = thickness),color = "black", size = 3, shape = 4) +
labs(title = "Segmentación de Pacientes por K-Means (3 clústers)")
#Repetimos pero aplicamos k-means con k=4 (2 clústeres)
k2<-2
kmeans_resultado3<-kmeans(Melanoma, centers = k2)
asignaciones3<- kmeans_resultado3$cluster
centros3<-kmeans_resultado3$centers
centros_df3<-as.data.frame(centros3)
ggplot(Melanoma, aes(x = age, y = thickness, color=factor(asignaciones3))) +
geom_point() +
geom_point(data = centros_df3, aes(x = age, y = thickness),color = "black", size = 3, shape = 4) +
labs(title = "Segmentación de Pacientes por K-Means (2 clústers)")
#Repetimos pero aplicamos k-means con k=4 ( clústeres)
k4<-4
kmeans_resultado4<-kmeans(Melanoma, centers = k4)
asignaciones4<- kmeans_resultado4$cluster
centros4<-kmeans_resultado4$centers
centros_df4<-as.data.frame(centros4)
ggplot(Melanoma, aes(x = age, y = thickness, color=factor(asignaciones4))) +
geom_point() +
geom_point(data = centros_df4, aes(x = age, y = thickness),color = "black", size = 3, shape = 4) +
labs(title = "Segmentación de Pacientes por K-Means (4 clústers)")
Al hacer diferentes k (o clusters) para le agrupamiento vamos como un
mismo paciente se clasifica en diferentes clústers. Además no vemos una
separación clara de los clústers, cosa que nos dice que las variables
age y thickness no separan bien esta población.
#Ejercicio 10. ANOVA A partir del conjunto de datos Iris, aplicad la función ANOVA y razonad los resultados obtenidos.
#Cargamos los datos
data("iris")
head(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa#Realizamos un ANOVA
resultado_anova<-aov(Sepal.Length ~ Species, data = iris)
#Resumen del ANOVA
summary(resultado_anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Species 2 63.21 31.606 119.3 <2e-16 ***
## Residuals 147 38.96 0.265
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Realizamos un test de significancia
TukeyHSD(resultado_anova)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Sepal.Length ~ Species, data = iris)
##
## $Species
## diff lwr upr p adj
## versicolor-setosa 0.930 0.6862273 1.1737727 0
## virginica-setosa 1.582 1.3382273 1.8257727 0
## virginica-versicolor 0.652 0.4082273 0.8957727 0