Tarea05_JARR_MEMV_PCA
Joel Alejandro Rodarte Rivera
2023-05-03
Ejercicio 1
1.- Se tiene la tasa de retorno semanal de 5 acciones bursátiles del NYSE. A) Tratar de reducir la información a menos de 5 dimensiones usando componentes principales. B) Obtener los valores de los componentes principales obtenidos en el a) para: \(\begin{array}{rrrrr}\text { Allied Chemical } & \text { Du Pont } & \text { Union Carbide } & \text { Exxon } & \text { Texaco } \\ -0.030717 & 0.020202 & -0.04086 & -0.03905 & -0.05051 \\ -0.003521 & 0.118812 & 0.089686 & 0.06007 & 0.021276 \\ 0.060071 & 0.079646 & 0.028807 & 0.036666 & 0.026041\end{array}\)
#Problema 1
P1 <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/T6_01.csv')
#Análisis de componentes principales
#Dado todos los valores de retorno de inversión están en la misma unidad, no es necesario estadanrizar resultados
acp_corr <- prcomp(P1)
#Diagrama de codo
plot(acp_corr,type="l")
#Variabilidad acumulada
#Se determina que se cubre >80 variabilidad con tres componentes.
summary(acp_corr)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 0.05996 0.02815 0.02714 0.02255 0.01854
## Proportion of Variance 0.60159 0.13255 0.12322 0.08511 0.05752
## Cumulative Proportion 0.60159 0.73414 0.85737 0.94248 1.00000#Componentes principales y sus eigenvectores
print(acp_corr)## Standard deviations (1, .., p=5):
## [1] 0.05996154 0.02814569 0.02713748 0.02255368 0.01854106
##
## Rotation (n x k) = (5 x 5):
## PC1 PC2 PC3 PC4 PC5
## Allied.Chemical 0.5605914 0.73884565 -0.1260222 0.28373183 -0.20846832
## Du.Pont 0.4698673 -0.09286987 -0.4675066 -0.68793190 0.28069055
## Union.Carbide 0.5473322 -0.65401929 -0.1140581 0.50045312 -0.09603973
## Exxon 0.2908932 -0.11267353 0.6099196 -0.43808002 -0.58203935
## Texaco 0.2842017 0.07103332 0.6168831 0.06227778 0.72784638# Eigenvalores del PCA y datos a obtener sus componentes principales
eigen1 <- matrix(c(0.5605914,0.4698673,0.5473322,0.2908932,0.2842017),ncol = 1,byrow = TRUE)
eigen2 <- matrix(c(0.73884565, -0.09286987,-0.65401929,-0.11267353, 0.07103332 ),ncol = 1,byrow = TRUE)
eigen3 <- matrix(c(-0.1260222, -0.4675066,-0.1140581, 0.6099196,0.6168831 ),ncol = 1,byrow = TRUE)
dato1 <- cmatrix <- matrix(c(-.030717,.020202,-.04086,-.03905,-.05051),ncol = 5,byrow = TRUE)
dato2 <- cmatrix <- matrix(c(-.003521,.118812,-.089686,.06007,.021276),ncol = 5,byrow = TRUE)
dato3 <- cmatrix <- matrix(c(.060071,.079646,.028807,.03666,.026041),ncol = 5,byrow = TRUE)
#cada dato debe tener 3 componentes
#Componentes principales dato 1
Y11 <- dato1 %*% eigen1
Y21 <- dato1 %*% eigen2
Y31 <- dato1 %*% eigen3
paste(Y11,Y21,Y31)## [1] "-0.0558058278582 0.00296395759791 -0.0558892562108"#Componentes principales dato 2
Y12 <- dato2 %*% eigen1
Y22 <- dato2 %*% eigen2
Y32 <- dato2 %*% eigen3
paste(Y12,Y22,Y32)## [1] "0.0282846255322 0.03976384948407 0.0048904199712"#Componentes principales dato 3
Y13 <- dato3 %*% eigen1
Y23 <- dato3 %*% eigen2
Y33 <- dato3 %*% eigen3
paste(Y13,Y23,Y33)## [1] "0.1049303768323 0.01586531676442 -0.0096670765834"Ejercicio 2
2.- Se colectaron datos sobre la contaminación del aire en cierta ciudad. A) Tratar de reducir la información a menos de 5 dimensiones usando componentes principales. B) Obtener los valores de los componentes principales obtenidos en el a) para: \(\begin{array}{rrrrrrr}\text { X1 } & \text { X2 } & \text { X3 } & \text { X4 } & \text { X5 } & \text { X6 } & \text { X7 } \\ 5 & 86 & 7 & 2 & 13 & 18 & 2 \\ 7 & 79 & 7 & 4 & 9 & 25 & 3 \\ 7 & 79 & 5 & 2 & 8 & 6 & 2\end{array}\)
#Problema 2
P2 <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/T6_02.csv')
#Análisis de componentes principales
#Dado todos los valores tienen diferentes unidades, se normalizan los datos.
acp_corr <- prcomp(P2, center = TRUE, scale = TRUE)
#Diagrama de codo
plot(acp_corr,type="l")
#Variabilidad acumulada
#Se determina que se cubre >80 variabilidad con cuatro componentes.
summary(acp_corr)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.5287 1.1773 1.0973 0.8527 0.80838 0.73259 0.39484
## Proportion of Variance 0.3338 0.1980 0.1720 0.1039 0.09335 0.07667 0.02227
## Cumulative Proportion 0.3338 0.5318 0.7038 0.8077 0.90106 0.97773 1.00000#Componentes principales y sus eigenvectores
print(acp_corr)## Standard deviations (1, .., p=7):
## [1] 1.5286539 1.1772853 1.0972994 0.8526937 0.8083790 0.7325905 0.3948404
##
## Rotation (n x k) = (7 x 7):
## PC1 PC2 PC3 PC4 PC5
## wind -0.2368211 0.278445138 -0.6434744 0.172719491 -0.56053441
## solar.radiation 0.2055665 -0.526613869 -0.2244690 0.778136601 0.15613432
## CO 0.5510839 -0.006819502 0.1136089 0.005301798 -0.57342221
## NO 0.3776151 0.434674253 0.4070978 0.290503052 0.05669070
## NO2 0.4980161 0.199767367 -0.1965567 -0.042428178 -0.05021430
## O3 0.3245506 -0.566973655 -0.1598465 -0.507915905 -0.08024349
## HC 0.3194032 0.307882771 -0.5410484 -0.143082348 0.56607057
## PC6 PC7
## wind 0.223579220 0.24146701
## solar.radiation 0.005700851 0.01126548
## CO 0.109538907 -0.58524622
## NO 0.450234781 0.46088973
## NO2 -0.744968707 0.33784371
## O3 0.330583071 0.41707805
## HC 0.266469812 -0.31391372# Eigenvalores del PCA y datos a obtener sus componentes principales
eigen1 <- matrix(c(-0.2368211,0.2055665,0.5510839,0.3776151,0.4980161,0.3245506,0.3194032 ),ncol = 1,byrow = TRUE)
eigen2 <- matrix(c( 0.278445138,-0.526613869,-0.006819502,0.434674253, 0.199767367,-0.566973655,0.307882771 ),ncol = 1,byrow = TRUE)
eigen3 <- matrix(c(-0.6434744,-0.2244690,0.1136089,0.4070978,-0.1965567,-0.1598465, -0.5410484),ncol = 1,byrow = TRUE)
eigen4 <- matrix(c(0.172719491, 0.778136601, 0.005301798, 0.290503052, -0.042428178,-0.507915905, -0.143082348),ncol = 1,byrow = TRUE)
dato1 <- cmatrix <- matrix(c((5-mean(P2$wind))/sd(P2$wind),(86-mean(P2$solar.radiation))/sd(P2$solar.radiation),(7-mean(P2$CO))/sd(P2$CO),(2-mean(P2$NO))/sd(P2$NO),(13-mean(P2$NO2))/sd(P2$NO2),(18-mean(P2$O3))/sd(P2$O3),(2-mean(P2$HC))/sd(P2$HC)),ncol = 7,byrow = TRUE)
dato2 <- cmatrix <- matrix(c((7-mean(P2$wind))/sd(P2$wind),(79-mean(P2$solar.radiation))/sd(P2$solar.radiation),(7-mean(P2$CO))/sd(P2$CO),(4-mean(P2$NO))/sd(P2$NO),(9-mean(P2$NO2))/sd(P2$NO2),(25-mean(P2$O3))/sd(P2$O3),(3-mean(P2$HC))/sd(P2$HC)),ncol = 7,byrow = TRUE)
dato3 <- cmatrix <- matrix(c((7-mean(P2$wind))/sd(P2$wind),(79-mean(P2$solar.radiation))/sd(P2$solar.radiation),(5-mean(P2$CO))/sd(P2$CO),(4-mean(P2$NO))/sd(P2$NO),(8-mean(P2$NO2))/sd(P2$NO2),(6-mean(P2$O3))/sd(P2$O3),(2-mean(P2$HC))/sd(P2$HC)),ncol = 7,byrow = TRUE)
#Componentes principales dato 1
Y11 <- dato1 %*% eigen1
Y21 <- dato1 %*% eigen2
Y31 <- dato1 %*% eigen3
Y41 <- dato1 %*% eigen4
paste(Y11,Y21,Y31,Y41)## [1] "1.9793947008237 -2.08691243262473 1.45234879589276 -0.36336985278354"#Componentes principales dato 2
Y12 <- dato2 %*% eigen1
Y22 <- dato2 %*% eigen2
Y32 <- dato2 %*% eigen3
Y42 <- dato2 %*% eigen4
paste(Y12,Y22,Y32,Y42)## [1] "2.57035369513002 -1.22758317041727 0.72788564864044 -0.720065857076432"#Componentes principales dato 3
Y13 <- dato3 %*% eigen1
Y23 <- dato3 %*% eigen2
Y33 <- dato3 %*% eigen3
Y43 <- dato3 %*% eigen4
paste(Y13,Y23,Y33,Y43)## [1] "-0.0403988277818306 0.214599758553299 1.92983499183577 1.22463215660443"Ejericio 3
3.- Se colectaron datos sobre un proceso de soldadura industrial. A) Tratar de reducir la información a menos de 5 dimensiones usando componentes principales. B) Obtener los valores de los componentes principales obtenidos en el a) para: \(\begin{array}{rrrrrrrrr}\text { X1 } & \text { x2 } & \text { x3 } & \text { x4 } & \text { x5 } & \text { x6 } & \text { x7 } & \text { x8 } & \text { x9 } \\ 58 & 62 & 58 & 34 & 50 & 0.1 & 0.033 & 0.097 & 120 \\ 50 & 62 & 54 & 35 & 49 & 0.1 & 0.036 & 0.099 & 120 \\ 60 & 57 & 54 & 32 & 45 & 0.065 & 0.3 & 0.062 & 120\end{array}\)
P3 <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/T6_03.csv')
#Análisis de componentes principales
#Dado todos los valores tienen diferentes unidades, se normalizan los datos.
acp_corr <- prcomp(P3, center = TRUE, scale = TRUE)
#Diagrama de codo
plot(acp_corr,type="l")
#Variabilidad acumulada
#Se determina que se cubre >80 variabilidad con cuatro componentes.
summary(acp_corr)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.6665 1.3993 1.0881 1.0295 0.93423 0.82898 0.64730
## Proportion of Variance 0.3086 0.2175 0.1316 0.1178 0.09698 0.07636 0.04656
## Cumulative Proportion 0.3086 0.5261 0.6577 0.7754 0.87241 0.94877 0.99532
## PC8 PC9
## Standard deviation 0.19587 0.06117
## Proportion of Variance 0.00426 0.00042
## Cumulative Proportion 0.99958 1.00000#Componentes principales y sus eigenvectores
print(acp_corr)## Standard deviations (1, .., p=9):
## [1] 1.66645388 1.39928047 1.08809122 1.02951339 0.93422673 0.82898472 0.64730284
## [8] 0.19587474 0.06117351
##
## Rotation (n x k) = (9 x 9):
## PC1 PC2 PC3 PC4
## Weld.Segundos -0.1345198 -0.1899610 -0.48433769 -0.427928091
## Squezze.Segundos 0.0021555 0.2087906 0.44364151 0.412070534
## Hold.Segundos 0.1476422 -0.1939002 -0.42684828 0.703374887
## Porcent.of.Current.Amperes 0.1806483 -0.5786670 0.40768324 -0.018638437
## Air.pressure.PSI 0.3641274 -0.1335119 -0.38877663 -0.005678248
## Tip.Milimetros 0.5452233 0.1954299 -0.04153045 -0.002219574
## High.milimetros -0.3996861 -0.1875657 -0.19889516 0.387177323
## Width.Milimetros 0.5444434 0.1946815 -0.04530490 0.014380645
## Pull.1.Newtons -0.2035755 0.6471233 -0.16034423 0.042913280
## PC5 PC6 PC7 PC8
## Weld.Segundos 0.576488934 -0.36318807 0.251703018 2.085984e-02
## Squezze.Segundos 0.746516812 0.09583594 0.145360383 -4.669139e-02
## Hold.Segundos -0.154674029 -0.13061417 0.471499412 1.846939e-02
## Porcent.of.Current.Amperes -0.001339036 -0.24420454 0.009618708 6.368280e-01
## Air.pressure.PSI 0.247865100 0.69810653 -0.249171131 2.956696e-01
## Tip.Milimetros 0.049198115 -0.33163463 -0.207109282 -4.544042e-02
## High.milimetros 0.132273505 -0.24373254 -0.733880899 -4.757236e-05
## Width.Milimetros 0.042492602 -0.33277405 -0.218769890 -1.010254e-01
## Pull.1.Newtons -0.057339740 -0.12139032 0.041107036 7.012861e-01
## PC9
## Weld.Segundos -0.0088996963
## Squezze.Segundos 0.0005615148
## Hold.Segundos 0.0056468085
## Porcent.of.Current.Amperes -0.0260298820
## Air.pressure.PSI -0.0104728848
## Tip.Milimetros 0.7109486584
## High.milimetros 0.0110271900
## Width.Milimetros -0.7020046640
## Pull.1.Newtons -0.0268554549# Eigenvalores del PCA y datos a obtener sus componentes principales
eigen1 <- matrix(c(-0.13451980,.0021555,0.1476422,0.1806483,0.3641274,0.5452233,-0.3996861,0.5444434,-0.2035755),ncol = 1,byrow = TRUE)
eigen2 <- matrix(c(-0.1899610,0.2087906,-0.1939002,-0.5786670,-0.1335119, 0.1954299,-0.1875657, 0.1946815,0.6471233 ),ncol = 1,byrow = TRUE)
eigen3 <- matrix(c(-0.48433769, 0.44364151,-0.42684828,0.40768324,-0.38877663,-0.04153045,-0.19889516, -0.04530490,-0.16034423),ncol = 1,byrow = TRUE)
eigen4 <- matrix(c(-0.427928091,0.412070534,0.703374887,-0.018638437,-0.005678248,-0.002219574,0.387177323,0.014380645, 0.042913280),ncol = 1,byrow = TRUE)
dato1 <- cmatrix <- matrix(c((58-mean(P3$Weld.Segundos))/sd(P3$Weld.Segundos),(62-mean(P3$Squezze.Segundos))/sd(P3$Squezze.Segundos),(58-mean(P3$Squezze.Segundos))/sd(P3$Squezze.Segundos),(34-mean(P3$Porcent.of.Current.Amperes))/sd(P3$Porcent.of.Current.Amperes),(50-mean(P3$Air.pressure.PSI))/sd(P3$Air.pressure.PSI),(.1-mean(P3$Tip.Milimetros))/sd(P3$Tip.Milimetros),(.033-mean(P3$High.milimetros))/sd(P3$High.milimetros),(.097-mean(P3$Width.Milimetros))/sd(P3$Width.Milimetros),(120-mean(P3$Pull.1.Newtons))/sd(P3$Pull.1.Newtons)),ncol = 9,byrow = TRUE)
dato2 <- cmatrix <- matrix(c((50-mean(P3$Weld.Segundos))/sd(P3$Weld.Segundos),(62-mean(P3$Squezze.Segundos))/sd(P3$Squezze.Segundos),(54-mean(P3$Squezze.Segundos))/sd(P3$Squezze.Segundos),(35-mean(P3$Porcent.of.Current.Amperes))/sd(P3$Porcent.of.Current.Amperes),(49-mean(P3$Air.pressure.PSI))/sd(P3$Air.pressure.PSI),(.1-mean(P3$Tip.Milimetros))/sd(P3$Tip.Milimetros),(.036-mean(P3$High.milimetros))/sd(P3$High.milimetros),(.099-mean(P3$Width.Milimetros))/sd(P3$Width.Milimetros),(120-mean(P3$Pull.1.Newtons))/sd(P3$Pull.1.Newtons)),ncol = 9,byrow = TRUE)
dato3 <- cmatrix <- matrix(c((60-mean(P3$Weld.Segundos))/sd(P3$Weld.Segundos),(57-mean(P3$Squezze.Segundos))/sd(P3$Squezze.Segundos),(54-mean(P3$Squezze.Segundos))/sd(P3$Squezze.Segundos),(32-mean(P3$Porcent.of.Current.Amperes))/sd(P3$Porcent.of.Current.Amperes),(45-mean(P3$Air.pressure.PSI))/sd(P3$Air.pressure.PSI),(.065-mean(P3$Tip.Milimetros))/sd(P3$Tip.Milimetros),(.3-mean(P3$High.milimetros))/sd(P3$High.milimetros),(.062-mean(P3$Width.Milimetros))/sd(P3$Width.Milimetros),(120-mean(P3$Pull.1.Newtons))/sd(P3$Pull.1.Newtons)),ncol = 9,byrow = TRUE)
#Componentes principales dato 1
Y11 <- dato1 %*% eigen1
Y21 <- dato1 %*% eigen2
Y31 <- dato1 %*% eigen3
Y41 <- dato1 %*% eigen4
paste(Y11,Y21,Y31,Y41)## [1] "0.570077848454913 1.30358328116247 0.564197619478533 -0.106101962187245"#Componentes principales dato 2
Y12 <- dato2 %*% eigen1
Y22 <- dato2 %*% eigen2
Y32 <- dato2 %*% eigen3
Y42 <- dato2 %*% eigen4
paste(Y12,Y22,Y32,Y42)## [1] "0.8250230899572 2.29447380221438 3.09564963138092 0.234251883484169"#Componentes principales dato 3
Y13 <- dato3 %*% eigen1
Y23 <- dato3 %*% eigen2
Y33 <- dato3 %*% eigen3
Y43 <- dato3 %*% eigen4
paste(Y13,Y23,Y33,Y43)## [1] "-3.41107354334951 -0.0273087780197832 -0.0237889470464974 -1.85534626729432"