file_path <- "PrDom-1-2-3.csv"
dane <- read.table(file_path, header = TRUE, sep = "", quote = "\"", 
                   stringsAsFactors = FALSE, check.names = FALSE)
for(i in 2:6) { # Ponieważ zmienna X1 jest w 2 kolumnie, X5 w 6
  dane[[i]] <- as.numeric(dane[[i]])
}
zmienne_pca <- dane[, c("X1", "X2", "X3", "X4", "X5")]
any(is.na(zmienne_pca)) # Sprawdzamy, czy w zbiorze istnieją braki

## [1] FALSE

print(head(zmienne_pca))

##           X1         X2        X3         X4        X5
## 1 -0.7242971  -3.661861 18.911549  -4.743807 12.482258
## 2 -1.9758087 -43.246440 11.407519 -10.089523 -7.908897
## 3  1.2819385 -14.662131 -7.301334 -14.325853  1.510753
## 4 -1.0471586   1.795444 27.416395 -19.930575 21.463857
## 5  4.9458447   7.627780  3.900292  -5.833269  9.391678
## 6  5.3202624  14.318632 -2.856231 -11.285937 15.665355

Używamy prcomp z center=TRUE (domyślnie, centruje dane) i scale.=FALSE (nie skaluje). To oznacza, że PCA bazuje na macierzy kowariancji wycentrowanych danych.

pca_wynik <- prcomp(zmienne_pca, center = TRUE, scale. = FALSE)

Wyodrębnienie macierzy przekształceń (wektorów własnych)

macierz_przeksztalcen <- pca_wynik$rotation
print(round(macierz_przeksztalcen, 3))

##       PC1    PC2    PC3    PC4    PC5
## X1 -0.023  0.109 -0.105 -0.211  0.965
## X2 -0.225  0.029 -0.946  0.221 -0.064
## X3 -0.690 -0.414  0.258  0.506  0.169
## X4  0.311 -0.903 -0.161 -0.246  0.038
## X5 -0.613 -0.005 -0.021 -0.768 -0.185

wartości własnych

odchylenia_std_pc <- pca_wynik$sdev
wartosci_wlasne <- odchylenia_std_pc^2
print(round(wartosci_wlasne, 3))

## [1] 852.935 275.576 119.304  29.833   7.436

procent_wariancji <- wartosci_wlasne / sum(wartosci_wlasne) * 100
print(round(procent_wariancji, 2))

## [1] 66.37 21.44  9.28  2.32  0.58

print(round(cumsum(procent_wariancji), 2))

## [1]  66.37  87.82  97.10  99.42 100.00

macierz_weryfikacyjna_A <- t(macierz_przeksztalcen) %*% macierz_przeksztalcen
print(round(macierz_weryfikacyjna_A, 3))

##     PC1 PC2 PC3 PC4 PC5
## PC1   1   0   0   0   0
## PC2   0   1   0   0   0
## PC3   0   0   1   0   0
## PC4   0   0   0   1   0
## PC5   0   0   0   0   1

# Dla porównania - macierz jednostkowa 5x5)
print(diag(ncol(macierz_przeksztalcen)))

##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    0    0    0    0
## [2,]    0    1    0    0    0
## [3,]    0    0    1    0    0
## [4,]    0    0    0    1    0
## [5,]    0    0    0    0    1

Jeśli macierz kowariancji składowych głównych będzie miała zera wszędzie poza diagonalą, to wektory są ortogonalne. Natomiast elementy na diagonali powinny odpowiadać wartościom własnym, czyli wariancjom składowych.

macierz_kowariancji_scores <- cov(skladowe_glowne_scores)
print(round(macierz_kowariancji_scores, 3))

##         PC1     PC2     PC3    PC4   PC5
## PC1 852.935   0.000   0.000  0.000 0.000
## PC2   0.000 275.576   0.000  0.000 0.000
## PC3   0.000   0.000 119.304  0.000 0.000
## PC4   0.000   0.000   0.000 29.833 0.000
## PC5   0.000   0.000   0.000  0.000 7.436

print(round(wartosci_wlasne, 3))

## [1] 852.935 275.576 119.304  29.833   7.436

macierz_kowariancji_pierwotnych <- cov(zmienne_pca)
print(round(macierz_kowariancji_pierwotnych))

##     X1  X2  X3   X4   X5
## X1  13  15  -4  -29   16
## X2  15 152 103  -50  115
## X3  -4 103 469  -88  349
## X4 -29 -50 -88  312 -155
## X5  16 115 349 -155  339

x <- c("A", "B", "C", "D", "5")
plot(procent_wariancji, type="l", lwd=1.5, main="Wykres osypiska", 
     xlab="Główna składowa", ylab="Procent wyjaśnionej wariancji")

• PC1 ma najwyższe współczynniki przy X3 (0.690) i X5 (0.613), więc silnie odzwierciedla zmienność tych zmiennych.
• PC2 jest silnie związana z X4 (−0.903), co może sugerować, że PC2 oddziela obserwacje w zależności od tej zmiennej.
• PC5 z kolei jest prawie wyłącznie zależna od X1 (0.965), co czyni ją komponentem „resztkowym”.