Responda los ejercicios a continuacion. Para cada uno de ellos, se se˜nala su valor, respecto a una calificacion total de 10 puntos. El examen se entrega vıa correo electr´onico, en el formato que le sea mas comodo. Durante clase, se brindar´an dos horas exclusivamente para la resolucion del examen, pero, podra enviar las respuestas de su examen posteriormente, teniendo como lımite la media noche del dıa domingo 15 de febrero.

#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. (3 puntos) Calcula los componentes principales, con las variables que sean adecuadas, para el conjunto de datos mtcars. 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, ademas de comentar cuales son las variables mas relevantes dentro de cada componente, de los dos primeros componentes.
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.

  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. (3 puntos) Ajusta un escalamiento multidimensional metrico a los datos originales. Representalo graficamente y comenta lo que observas ¿Es posible distinguir algun grupo? No olvides reportar la calidad del ajuste.
setwd("C:/Users/Msi/Downloads")
dat1=read_xlsx("C:/Users/Msi/Downloads/Datos_Maternidad1.xlsx")
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`))
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 al margen del resto de los paises, podriamos a hablar sin realizar un analisis de conglomerados de 3 grandes agrupaciones en relación al anterior ejercicio. En este sentido, al utilizar los datos originales para el escalamiento multidimensional explica la proporcion de la varianza de los componentes con una bondad de ajuste mas adecuado (0.9990415 0.9990415) en comparacion de que se utilizaran los datos estandarizados, por lo tanto podemos hablar con seguridad de que en efecto existen 3 clusters.

  1. (4 puntos). A partir de los datos originales, realiza un analisis de conglomerados, utilizando cluster jerarquicos, conformando tres grupos. 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 el escalmiento previo?.
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)

Conclusiones

El uso de los datos originales aumenta la variabilidad de los cluster obtenidos en el analisis con las ligas (ward, completa y sencilla), alterando la dominancia de ciertos paises considerados “avanzados (Belgica, Finlandia, Nueva Zelanda, ALemania, Australia), los cuales se agrupan con Estados Unidos, Noruega y Suiza. En este sentido se propone utilizar los datos estandarizados para obtener una menor variablidad y menor presencia de paises atipicos.

En este sentido, podemos hablar de 3 clusters, 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 comparten caracteristcas de 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 se consideran potencias.

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.