rmd

Versteh-Beispiel: Head Data (Everitt, 2010)

Minimal-Versteh-Beispiel head data [Everitt (2010, p. 196)][everitt]

Kopfgröße (head length in mm) der ersten beiden Söhne von 25 Familien. Zwei Variablen. Wie sehen die Komponenten aus? Was kann aus ihnen gelesen werden?

Bei zwei Variablen erklären zwei Komponenten die gesamte, erklärbare Varianz (Kovarianz).

Hauptkomponentenanalyse kann auf Basis der Rohwertmatrix oder auf Basis der Varianz-Kovarianz-Matrix berechnet werden.

library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.3     ✓ purrr   0.3.4
## ✓ tibble  3.1.0     ✓ dplyr   1.0.5
## ✓ tidyr   1.1.3     ✓ stringr 1.4.0
## ✓ readr   1.4.0     ✓ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
ddf <- read.delim("http://md.psych.bio.uni-goettingen.de/mv/data/be/head.txt")
head(ddf)
##   fam hlfs hlss
## 1   1  191  179
## 2   2  195  201
## 3   3  181  185
## 4   4  183  188
## 5   5  176  171
## 6   6  208  192
# we are only interested in first and second son's head size
sizes <- c('hlfs', 'hlss')
# get means of size of head of first and second son
apply(ddf[sizes], 2, mean)
##   hlfs   hlss 
## 185.72 183.84
# covariance matrix
var(ddf[sizes])
##          hlfs      hlss
## hlfs 95.29333  69.66167
## hlss 69.66167 100.80667
# pca based on raw data
# you may notice small differences in sd compared to pca based on covariance matrix
pca.h <- princomp(ddf[sizes])
print(summary(pca.h),digits=3,loadings=TRUE)
## Importance of components:
##                            Comp.1    Comp.2
## Standard deviation     12.6907660 5.2154059
## Proportion of Variance  0.8555135 0.1444865
## Cumulative Proportion   0.8555135 1.0000000
## 
## Loadings:
##      Comp.1 Comp.2
## hlfs  0.693  0.721
## hlss  0.721 -0.693
# pca based on covariance matrix
pca.cov <- princomp(covmat=var(ddf[sizes]))
print(summary(pca.cov),digits=3,loadings=TRUE)
## Importance of components:
##                            Comp.1    Comp.2
## Standard deviation     12.9524588 5.3229513
## Proportion of Variance  0.8555135 0.1444865
## Cumulative Proportion   0.8555135 1.0000000
## 
## Loadings:
##      Comp.1 Comp.2
## hlfs  0.693  0.721
## hlss  0.721 -0.693
# values of family 3
ddf[3,]
##   fam hlfs hlss
## 3   3  181  185
# factor loadings for each component can be found in resultobject$loadings
g1 <- pca.h$loadings[,1]
g2 <- pca.h$loadings[,2]
# get factor scores (individual value of the two components) for family 3
sum(ddf[3,2:3] * g1)
## [1] 258.8064
sum(ddf[3,2:3] * g2)
## [1] 2.289788
# predict family 3 component 1 manually
# multiply difference from mean by factor loading
sum((ddf[3,sizes] - apply(ddf[sizes], 2, mean)) * g1)
## [1] -2.43459
# check against scores provided by princomp
princomp(ddf[sizes], scores=T)$scores[3,]
##    Comp.1    Comp.2 
## -2.434590 -4.206753
# add factor scores to data.frame
ddf <- cbind(ddf, princomp(ddf[sizes], scores=T)$scores)

# a visualization via included plot()
plot(pca.h)

# you may apply what you have found in pca to new data
ddf.new <- data.frame(
    hlfs = c(166, 168, 185),
    hlss = c(157, 170, 190)
    )
predict(pca.h, ddf.new)
##         Comp.1    Comp.2
## [1,] -33.01601  4.382582
## [2,] -22.25767 -3.184331
## [3,]   3.94211 -4.787878
rm(ddf.new)

# what is different using prcomp()

# using principal() of library(psych)
require(psych)
## Loading required package: psych
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
pca.h2 <- principal(ddf[sizes], nfactors=2, rotate="none")
pca.h2
## Principal Components Analysis
## Call: principal(r = ddf[sizes], nfactors = 2, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
##       PC1   PC2 h2 u2 com
## hlfs 0.92 -0.38  1  0 1.3
## hlss 0.92  0.38  1  0 1.3
## 
##                        PC1  PC2
## SS loadings           1.71 0.29
## Proportion Var        0.86 0.14
## Cumulative Var        0.86 1.00
## Proportion Explained  0.86 0.14
## Cumulative Proportion 0.86 1.00
## 
## Mean item complexity =  1.3
## Test of the hypothesis that 2 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0 
##  with the empirical chi square  0  with prob <  NA 
## 
## Fit based upon off diagonal values = 1
# component scores are available
head(pca.h2$scores)
##              PC1        PC2
## [1,]  0.03180061 -1.3449328
## [2,]  1.43791839  0.9972252
## [3,] -0.19893757  0.7876139
## [4,]  0.07335984  0.9110939
## [5,] -1.22967480 -0.3722605
## [6,]  1.67326381 -1.9322253
# we plot the components weight in the scatterplot of the two head sizes
ddf %>% ggplot(aes(x=hlfs, y=hlss, color=pca.h$scores[,1])) + geom_point()

# ddf %>% ggplot(aes(x=hlfs, y=hlss, color=pca.h$scores[,2])) + geom_point()


ddf %>% ggplot(aes(x=pca.h$scores[,1], y=pca.h$scores[,2], color=hlss)) + geom_point()

# ddf %>% ggplot(aes(x=pca.h$scores[,1], y=pca.h$scores[,2], color=hlfs)) + geom_point()

‘Loadings’ zeigt die Gewichte, mit denen die Komponenten-Werte gebildet werden können. ‘Proportion Var’ ist der Anteil an erklärter Varianz, den die jeweilige Komponente erklärt. ‘Cumulative Var’ ist der kumulierte Anteil an der Varianz, der durch alle höheren Komponenten inkl. der aktuellen erkärt wird.

Ein Komponenten-Wert ist eine Linearkombination aus den Rohwerten der Variablen und den Gewichten (loadings) für eine Komponente. Konkret wird oben die Abweichungen einer Beobachtung (Vp) vom Gruppenmittelwert multipliziert mit dem zugehörigen loading. Dies passiert für alle Variablen in der Komponente und wird aufaddiert.

Die Komponenten-Werte können im Quell-Data-Frame mit abgespeichert werden. Dies ist u. U. sinnvoll, wenn man die Anzahl der Variablen verringern möchte und mit den Komponenten weiterrechnen will.

Komponenten-Gewichte (Koeffizienten) können auch auf neue Daten angewendet werden. Dazu müssen die Gewichte von einem Data-Frame generiert worden sein und die Variablen (Columns) müssen gleich benannt sein.