diff --git a/podsumowanie/README.md b/podsumowanie/README.md index b3b7244..767ac2d 100644 --- a/podsumowanie/README.md +++ b/podsumowanie/README.md @@ -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.
+![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ą).
+![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
+![osypisko](lab12/osypisko.png) + +- Biplot
+![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.
+![wielowymiarowy](lab12/wielowymiarowy.png) + +- Estymatory
+![estymatory](lab12/estymatory.png) + +- Kreska nad zmienną oznacza zazwyczaj średnią (przynajmniej na wikipedii) diff --git a/podsumowanie/lab12/analiza.png b/podsumowanie/lab12/analiza.png new file mode 100644 index 0000000..b4f88d2 Binary files /dev/null and b/podsumowanie/lab12/analiza.png differ diff --git a/podsumowanie/lab12/biplot.png b/podsumowanie/lab12/biplot.png new file mode 100644 index 0000000..fd480ab Binary files /dev/null and b/podsumowanie/lab12/biplot.png differ diff --git a/podsumowanie/lab12/estymatory.png b/podsumowanie/lab12/estymatory.png new file mode 100644 index 0000000..881683b Binary files /dev/null and b/podsumowanie/lab12/estymatory.png differ diff --git a/podsumowanie/lab12/ladunki.png b/podsumowanie/lab12/ladunki.png new file mode 100644 index 0000000..c024d56 Binary files /dev/null and b/podsumowanie/lab12/ladunki.png differ diff --git a/podsumowanie/lab12/osypisko.png b/podsumowanie/lab12/osypisko.png new file mode 100644 index 0000000..02cf323 Binary files /dev/null and b/podsumowanie/lab12/osypisko.png differ diff --git a/podsumowanie/lab12/wielowymiarowy.png b/podsumowanie/lab12/wielowymiarowy.png new file mode 100644 index 0000000..cbc7c6f Binary files /dev/null and b/podsumowanie/lab12/wielowymiarowy.png differ diff --git a/testowe/pomocnicze.R b/testowe/pomocnicze.R index f1c3c29..337e5c7 100644 --- a/testowe/pomocnicze.R +++ b/testowe/pomocnicze.R @@ -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 = '�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 = '|�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 \ No newline at end of file