#Maria Alejandra Molina Berbeo
#1022386325
#Trabajo componentes principales
#creación de datos
set.seed(2020)
L<-sort.int(rnorm(100,5,0.5),50)
a<-sort.int(rnorm(100,15,1),50)
b<-sort.int(rnorm(100,20,2),50)
b<-sort.int(rnorm(100,20,2),50)
Lab<-data.frame(L,a,b)
pr<-prcomp(Lab,sacale=T);pr
## Warning: In prcomp.default(Lab, sacale = T) :
## extra argument 'sacale' will be disregarded
## Standard deviations (1, .., p=3):
## [1] 2.2888753 0.7057773 0.3124025
##
## Rotation (n x k) = (3 x 3):
## PC1 PC2 PC3
## L -0.1950299 0.2237295 -0.95493897
## a -0.4158099 0.8629463 0.28709890
## b -0.8882936 -0.4530659 0.07527136
comp1<-pr$x[,1]#asà se extraen los componentes, mi nueva variable Indice de Color
val.p<-(pr$sdev)^2;val.p #valores propios, pero se les debe elevar a la 2 porque son desviaciones no varianzas
## [1] 5.23895021 0.49812154 0.09759531
#el primer componente es mayor a uno por lo cual es el que recoge la mayor variabilidad
vec.p<-pr$rotation;vec.p #vectores propios
## PC1 PC2 PC3
## L -0.1950299 0.2237295 -0.95493897
## a -0.4158099 0.8629463 0.28709890
## b -0.8882936 -0.4530659 0.07527136
#ecuaciones
ecu<-pr$rotation;ecu
## PC1 PC2 PC3
## L -0.1950299 0.2237295 -0.95493897
## a -0.4158099 0.8629463 0.28709890
## b -0.8882936 -0.4530659 0.07527136
#PC1:0.17L+0.39a+0.89b
summary(pr)
## Importance of components:
## PC1 PC2 PC3
## Standard deviation 2.2889 0.70578 0.31240
## Proportion of Variance 0.8979 0.08537 0.01673
## Cumulative Proportion 0.8979 0.98327 1.00000
biplot(pr)
#el primer componente explica el 93% de la variabildiad
plot(pr)
#gráfico corregido, antes eran desviaciones, ahora son varianzas
varianza.explciada<-plot(cumsum(100*val.p/sum(val.p)),xlab = "componentes",
ylab = "% varianza explciada",ylim = c(0,100),type = "b")
################################################
rg<-gl(4,25,100, labels = c("0","200","400","600","800"))
exp<-data.frame(Lab,rg);exp
## L a b rg
## 1 4.200842 11.94332 17.77979 0
## 2 4.141538 13.26641 18.54634 0
## 3 4.450988 12.80965 17.53536 0
## 4 4.434797 13.10431 16.81640 0
## 5 3.601733 13.07171 17.76830 0
## 6 4.335864 13.05337 17.82191 0
## 7 4.547930 13.27122 18.06025 0
## 8 4.648004 13.02356 16.16251 0
## 9 4.110950 12.73515 17.54358 0
## 10 4.409961 14.48391 14.88834 0
## 11 4.573439 13.90856 18.69835 0
## 12 4.610203 14.27276 15.90947 0
## 13 4.636982 13.82966 18.64472 0
## 14 4.638872 13.28059 18.25310 0
## 15 4.628149 13.70026 18.70938 0
## 16 4.593748 14.17527 17.78675 0
## 17 4.030318 13.80041 17.93346 0
## 18 3.480618 13.72361 17.57633 0
## 19 3.855513 14.28654 18.49375 0
## 20 4.487793 14.00874 17.34275 0
## 21 4.233519 13.95107 18.04958 0
## 22 4.055472 13.82325 15.86059 0
## 23 4.840828 14.41449 17.07584 0
## 24 4.716539 13.40627 15.98076 0
## 25 4.661303 13.71015 19.13890 0
## 26 4.663120 14.23931 19.11039 200
## 27 4.734269 14.14509 18.99178 200
## 28 4.885311 14.48734 18.98948 200
## 29 4.814644 14.31730 18.75694 200
## 30 4.849498 14.04684 18.72507 200
## 31 4.747470 13.87215 18.71344 200
## 32 4.814208 14.39444 18.98251 200
## 33 4.719851 13.55080 19.04807 200
## 34 4.857201 14.07158 19.41912 200
## 35 4.897239 13.95532 19.57396 200
## 36 4.963426 14.65286 19.34651 200
## 37 4.906977 14.66182 19.18317 200
## 38 4.905605 13.56788 19.37038 200
## 39 4.987681 13.86429 19.15478 200
## 40 4.926283 13.70881 19.51231 200
## 41 4.938370 14.67720 19.54620 200
## 42 4.891363 14.68772 19.48764 200
## 43 5.038007 14.72399 19.54510 200
## 44 5.023077 14.87682 19.69186 200
## 45 5.011090 14.80436 19.64058 200
## 46 5.029152 14.73779 19.73336 200
## 47 5.055216 14.90240 19.70531 200
## 48 5.046483 14.78392 19.68459 200
## 49 5.058683 14.87655 19.75651 200
## 50 5.059377 14.92513 19.78362 200
## 51 5.060613 14.96032 19.86016 400
## 52 5.088605 15.09943 20.84165 400
## 53 5.099375 15.21130 21.13222 400
## 54 5.084131 15.01693 19.87182 400
## 55 5.238025 15.29892 20.28616 400
## 56 5.121829 15.18820 20.45221 400
## 57 5.174437 15.10342 20.46520 400
## 58 5.223594 15.05045 20.06293 400
## 59 5.145314 14.99430 23.30300 400
## 60 5.159110 15.26651 20.13091 400
## 61 5.150774 15.18789 22.21242 400
## 62 5.125379 15.01510 21.44618 400
## 63 5.188486 15.23626 20.20608 400
## 64 5.126537 15.18810 20.21189 400
## 65 5.243458 15.74666 21.36024 400
## 66 5.184322 16.23582 21.01308 400
## 67 5.194059 15.32828 25.20389 400
## 68 5.461460 15.75164 20.25925 400
## 69 5.477618 15.38352 21.01757 400
## 70 6.600816 15.84669 21.69641 400
## 71 5.397920 16.24403 22.01250 400
## 72 5.823003 15.75441 20.08443 400
## 73 5.954519 15.61036 20.38469 400
## 74 5.289417 15.77222 20.76706 400
## 75 5.300680 15.66156 19.94427 400
## 76 5.244397 15.64805 20.93756 600
## 77 5.330022 16.26944 24.13508 600
## 78 5.454251 15.36744 23.68342 600
## 79 6.217687 16.05001 24.43576 600
## 80 5.547673 16.50827 24.65460 600
## 81 5.314166 15.34543 23.79314 600
## 82 5.468359 15.84852 21.61949 600
## 83 6.157077 15.29953 23.44519 600
## 84 5.648921 15.62662 22.28378 600
## 85 5.417134 16.43535 22.87595 600
## 86 6.137341 15.46367 21.14447 600
## 87 5.549091 15.92679 23.04297 600
## 88 5.546976 16.54511 22.36441 600
## 89 5.923084 15.66099 22.37177 600
## 90 5.260516 15.88430 21.80431 600
## 91 6.087183 16.20064 21.27104 600
## 92 5.851998 16.00653 20.89031 600
## 93 5.900022 15.76147 20.03640 600
## 94 5.622618 15.87009 20.21718 600
## 95 5.598186 17.41414 21.60999 600
## 96 5.454630 17.16594 21.91700 600
## 97 5.879566 16.78468 23.55786 600
## 98 5.340862 16.76014 20.08772 600
## 99 5.469561 17.66220 21.39647 600
## 100 5.360287 17.19144 21.83335 600
#analisis 1, analisis anova para cada Lab#
par(mfrow=c(1,3))
boxplot(exp$L~exp$rg, main="L")
boxplot(exp$a~exp$rg, main="a")
boxplot(exp$b~exp$rg, main="b")
#modelo de L , a y b#
mod.L<-aov(exp$L~exp$rg);mod.L
## Call:
## aov(formula = exp$L ~ exp$rg)
##
## Terms:
## exp$rg Residuals
## Sum of Squares 22.695386 8.311763
## Deg. of Freedom 3 96
##
## Residual standard error: 0.2942463
## Estimated effects may be unbalanced
summary(mod.L)
## Df Sum Sq Mean Sq F value Pr(>F)
## exp$rg 3 22.695 7.565 87.38 <2e-16 ***
## Residuals 96 8.312 0.087
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
mod.a<-aov(exp$a~exp$rg);mod.a
## Call:
## aov(formula = exp$a ~ exp$rg)
##
## Terms:
## exp$rg Residuals
## Sum of Squares 99.31596 27.87794
## Deg. of Freedom 3 96
##
## Residual standard error: 0.5388833
## Estimated effects may be unbalanced
summary(mod.a)
## Df Sum Sq Mean Sq F value Pr(>F)
## exp$rg 3 99.32 33.11 114 <2e-16 ***
## Residuals 96 27.88 0.29
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
mod.b<-aov(exp$b~exp$rg);mod.b
## Call:
## aov(formula = exp$b ~ exp$rg)
##
## Terms:
## exp$rg Residuals
## Sum of Squares 309.1129 110.3181
## Deg. of Freedom 3 96
##
## Residual standard error: 1.071983
## Estimated effects may be unbalanced
summary(mod.b)
## Df Sum Sq Mean Sq F value Pr(>F)
## exp$rg 3 309.1 103.04 89.66 <2e-16 ***
## Residuals 96 110.3 1.15
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
mc<-cor(Lab);mc
## L a b
## L 1.0000000 0.7791728 0.7379866
## a 0.7791728 1.0000000 0.7468362
## b 0.7379866 0.7468362 1.0000000