Statistik 7: Übung

Datensatz USstates vom package “HSAUR3”
Beschreibung des Datensets mit command:

?USstates

-Führt mit den Datensatz “USstates” vom package “HSAUR3” eine PCA aus und visualisiert das Resultat mit einem Biplot.

Lösung Übung 7

[Lösungstext folgt]

# Packete laden
library("pacman")
p_load("tidyverse", "vegan", "factoextra")

# Daten laden
p_load("HSAUR3")
data(USstates)
?USstates
str(USstates)

'data.frame':   10 obs. of  7 variables:
 $ Population     : num  3615 21198 2861 2341 812 ...
 $ Income         : num  3624 5114 4628 3098 4281 ...
 $ Illiteracy     : num  2.1 1.1 0.5 2.4 0.7 0.8 0.6 1 0.5 0.6
 $ Life.Expectancy: num  69 71.7 72.6 68.1 71.2 ...
 $ Homicide       : num  15.1 10.3 2.3 12.5 3.3 7.4 4.2 6.1 1.7 5.5
 $ Graduates      : num  41.3 62.6 59 41 57.6 53.2 60 50.2 52.3 57.1
 $ Freezing       : num  20 20 140 50 174 124 44 126 172 168

summary(USstates)

   Population        Income       Illiteracy    Life.Expectancy
 Min.   :  472   Min.   :3098   Min.   :0.500   Min.   :68.09  
 1st Qu.: 1180   1st Qu.:3972   1st Qu.:0.600   1st Qu.:70.53  
 Median : 2601   Median :4365   Median :0.750   Median :71.44  
 Mean   : 5686   Mean   :4249   Mean   :1.030   Mean   :70.97  
 3rd Qu.: 8955   3rd Qu.:4611   3rd Qu.:1.075   3rd Qu.:71.99  
 Max.   :21198   Max.   :5114   Max.   :2.400   Max.   :72.56  
    Homicide        Graduates        Freezing    
 Min.   : 1.700   Min.   :41.00   Min.   : 20.0  
 1st Qu.: 3.525   1st Qu.:50.73   1st Qu.: 45.5  
 Median : 5.800   Median :55.15   Median :125.0  
 Mean   : 6.840   Mean   :53.43   Mean   :103.8  
 3rd Qu.: 9.575   3rd Qu.:58.65   3rd Qu.:161.0  
 Max.   :15.100   Max.   :62.60   Max.   :174.0

# PCA durchführen
pca_1 <- prcomp(USstates, scale = TRUE)
summary(pca_1)

Importance of components:
                          PC1    PC2     PC3     PC4     PC5     PC6     PC7
Standard deviation     2.1024 1.3894 0.64719 0.34264 0.25132 0.18292 0.12781
Proportion of Variance 0.6315 0.2758 0.05984 0.01677 0.00902 0.00478 0.00233
Cumulative Proportion  0.6315 0.9073 0.96709 0.98386 0.99289 0.99767 1.00000

screeplot(pca_1, bstick = TRUE)

Wie wir in der Summary und im Screeplot sehen, wird ein sehr grosser Anteil der Varianz (63.2 %) durch die erste Achse erklärt. Die zweite Achse erklärt noch einen Anteil von 27.6 % während der dritten Achse nur noch 6.0 % Anteil der Varianz erklärt. Wir beschränken uns deshalb darauf, die ersten beiden Achsen zu visualisieren.

# Visualisierung
fviz_pca_biplot(pca_1, repel = TRUE, 
                col.var = "blue",  col.ind = "black") +
    ggtitle(NULL) +
  theme_classic()