This commit is contained in:
Jakub Adamski 2021-06-20 14:42:03 +02:00
parent 27f93f926e
commit b40fbbb490
8 changed files with 176 additions and 10 deletions

View File

@ -827,12 +827,66 @@ Zagadnienia:
### R
```r
# współczynnik korelacji -1 ujemnie; 0 brak korelacji; 1 dodatnio
cor.test(USArrests$Rape,USArrests$UrbanPop, method="pearson")
# analiza składowych głównych
(pca_1 <- prcomp(~ Murder + Assault + Rape, data = USArrests, scale = TRUE))
summary(pca_1)
# wykres ładunków - wartość bezwzględna
matplot(abs(pca_1$rotation), type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = '|ładunki|', ylim = c(0, 1.05),
xaxt = "n")
axis(1, at = 1:3, labels = rownames(pca_1$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3'), ncol = 3, col = 1:3, lwd = 2)
text(rep(1, 3), abs(pca_1$rotation)[1, ], abs(round(pca_1$rotation[1, ], 2)), pos = 4)
text(rep(2, 3), abs(pca_1$rotation)[2, ], abs(round(pca_1$rotation[2, ], 2)), pos = 1)
text(rep(3, 3), abs(pca_1$rotation)[3, ], abs(round(pca_1$rotation[3, ], 2)), pos = 2)
# wykres osypiska
plot(pca_1)
# średnia
pca_1$sdev^2
mean(pca_1$sdev^2)
# biplot
biplot(pca_1)
# minimalne drzewo
install.packages("ape")
library(ape)
plot(mst(dist(scale(USArrests[, -3]))), x1 = pca_1$x[, 1], x2 = pca_1$x[, 2])
```
### Zagadnienia
- Analiza składowych głównych - jest techniką redukcji wymiaru. Jej celem jest znalezienie niewielkiej liczby składowych głównych, które wyjaśniają w maksymalnym stopniu całkowitą wariancję z próby p zmiennych pierwotnych. S - to estymator nieobciążony.<br/>
![analiza](lab12/analiza.png)
- Ładunki - dokładniejszą interpretację składowych można uzyskać poprzez wyznaczenie tzw. macierzy ładunków czynnikowych (które są współczynnikami korelacji między i-tą zmienną i j-tą składową).<br/>
![ladunki](lab12/ladunki.png)
- Ładunki czynnikowe - podobnie jak współczynniki zawarte w wektorze własnym, odzwierciedlają wpływ poszczególnych zmiennych na daną składową główną.
- Wykres osypiska - wykres wariancji poszczególnych składowych głównych. Możemy odrzucić te dla których wartość jest mniejsza od 80% lub gdy wartości własne skłądowej głównej są mniejsze od średniej<br/>
![osypisko](lab12/osypisko.png)
- Biplot<br/>
![biplot](lab12/biplot.png)
- Można stworzyć minimalne drzewo rozpinające - graf którego wierzchołkami są obserwacje, dwa punkty są połączone jedną ścieżką, a suma krwędzi jest minimalna. Punkty połączone krawędziami powinny być blisko siebie
- Model wielowymiarowy.<br/>
![wielowymiarowy](lab12/wielowymiarowy.png)
- Estymatory<br/>
![estymatory](lab12/estymatory.png)
- Kreska nad zmienną oznacza zazwyczaj średnią (przynajmniej na wikipedii)

Binary file not shown.

After

Width:  |  Height:  |  Size: 107 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 40 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 28 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 29 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 68 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 89 KiB

View File

@ -1,13 +1,125 @@
x1<-rexp(30,5)
x2<-rnorm(30,2,2)
x3<-rnorm(30,10,1)
gen<-c(x1,x2,x3)
#ZAD1
head(USArrests)
pairs(USArrests)
#UrbanPop jest najsłabiej skorelowana z pozostałymi
cor.test(USArrests$Murder,USArrests$UrbanPop, method="pearson")
cor.test(USArrests$Rape,USArrests$UrbanPop, method="pearson")
(pca_1 <- prcomp(~ Murder + Assault + Rape, data = USArrests, scale = TRUE))
summary(pca_1)
head(pca_1$x)
cat("...")
pca_1$rotation
par(mfrow = c(1, 2))
matplot(pca_1$rotation, type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = 'ładunki', ylim = c(-0.9, 1.05),
xaxt = "n")
axis(1, at = 1:3, labels = rownames(pca_1$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3'), ncol = 3, col = 1:3, lwd = 2)
text(rep(1, 3), pca_1$rotation[1, ], round(pca_1$rotation[1, ], 2), pos = 4)
text(rep(2, 3), pca_1$rotation[2, ], round(pca_1$rotation[2, ], 2), pos = 1)
text(rep(3, 3), pca_1$rotation[3, ], round(pca_1$rotation[3, ], 2), pos = 2)
matplot(abs(pca_1$rotation), type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = '|ładunki|', ylim = c(0, 1.05),
xaxt = "n")
axis(1, at = 1:3, labels = rownames(pca_1$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3'), ncol = 3, col = 1:3, lwd = 2)
text(rep(1, 3), abs(pca_1$rotation)[1, ], abs(round(pca_1$rotation[1, ], 2)), pos = 4)
text(rep(2, 3), abs(pca_1$rotation)[2, ], abs(round(pca_1$rotation[2, ], 2)), pos = 1)
text(rep(3, 3), abs(pca_1$rotation)[3, ], abs(round(pca_1$rotation[3, ], 2)), pos = 2)
par(mfrow = c(1, 1))
plot(pca_1)
# trzecie podejście
# wartości własne = wariancje
pca_1$sdev^2
mean(pca_1$sdev^2)
## 1, tak musi być przy skalowaniu
# Pomijamy te składowe główne, których wartości własne są mniejsze od średniej.
# Zatem wybieramy jedną.
biplot(pca_1)
install.packages("ape")
library(ape)
plot(mst(dist(scale(USArrests[, -3]))), x1 = pca_1$x[, 1], x2 = pca_1$x[, 2])
#ZAD2
mtcars_sel <- mtcars[, c(1, 3:7)]
(pca_2 <- prcomp(mtcars_sel, scale = TRUE))
summary(pca_2)
head(pca_2$x)
cat("...")
pca_2$rotation
par(mfrow = c(2, 1))
matplot(pca_2$rotation, type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = 'ładunki', ylim = c(-0.9, 1.05),
xaxt = "n")
axis(1, at = 1:6, labels = rownames(pca_2$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3', 'PC4', 'PC5', 'PC6'), ncol = 6, col = 1:6, lwd = 2)
matplot(abs(pca_2$rotation), type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = '|ładunki|', ylim = c(0, 1.05),
xaxt = "n")
axis(1, at = 1:6, labels = rownames(pca_2$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3', 'PC4', 'PC5', 'PC6'), ncol = 6, col = 1:6, lwd = 2)
par(mfrow = c(1, 1))
plot(pca_2)
# trzecie podejście
# wartości własne = wariancje
pca_2$sdev^2
mean(pca_2$sdev^2)
## 1, tak musi być przy skalowaniu
# Pomijamy te składowe główne, których wartości własne są mniejsze od średniej.
# Zatem wybieramy dwie.
biplot(pca_2)
library(ape)
plot(mst(dist(mtcars_sel)), x1 = pca_2$x[, 1], x2 = pca_2$x[, 2])
(pca_3 <- prcomp(mtcars_sel, scale = FALSE, center = FALSE))
summary(pca_3)
head(pca_3$x)
cat("...")
pca_3$rotation
par(mfrow = c(2, 1))
matplot(pca_3$rotation, type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = '<EFBFBD>adunki', ylim = c(-0.9, 1.15),
xaxt = "n")
axis(1, at = 1:6, labels = rownames(pca_3$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3', 'PC4', 'PC5', 'PC6'), ncol = 6, col = 1:6, lwd = 2)
matplot(abs(pca_3$rotation), type = 'l', lty = 1, lwd = 2,
xlab = 'zmienne', ylab = '|<7C>adunki|', ylim = c(0, 1.1),
xaxt = "n")
axis(1, at = 1:6, labels = rownames(pca_3$rotation))
legend('topleft', legend = c('PC1', 'PC2', 'PC3', 'PC4', 'PC5', 'PC6'), ncol = 6, col = 1:6, lwd = 2)
par(mfrow = c(1, 1))
plot(pca_3)
#1
pca_3$sdev^2
mean(pca_3$sdev^2)
# wykresy gęstości jądrowych przy różnych szerokościach okna
par(mfrow=c(2,2))
plot(density(gen,bw=0.1))
plot(density(gen,bw=0.5))
plot(density(gen,bw=3))
plot(density(gen,bw=5)) #na trzecim