2015-05-22 17 views
5

Ich erstelle eine Visualisierung zu illustriere, wie Principal Components-Analyse funktioniert, indem Eigenwerte für einige tatsächlichen Daten (für die Zwecke der Illustration, ich bin subsetting zu 2 Dimensionen).Wie wird eine senkrechte Linie von jedem Punkt in einem Streudiagramm auf einen (Eigen) Vektor gelegt?

Ich möchte eine Kombination dieser beiden Plots von this fantastic PCA tutorial, nur für meine echte Daten.

enter image description here

enter image description here

ich die Vektoren und alle ok plotten können:

Person1 <- c(-3,1,1,-3,0,-1,-1,0,-1,-1,3,4,5,-2,1,2,-2,-1,1,-2,1,-3,4,-6,1,-3,-4,3,3,-5,0,3,0,-3,1,-2,-1,0,-3,3,-4,-4,-7,-5,-2,-2,-1,1,1,2,0,0,2,-2,4,2,1,2,2,7,0,3,2,5,2,6,0,4,0,-2,-1,2,0,-1,-2,-4,-1) 
Person2 <- c(-4,-3,4,-5,-1,-1,-2,2,1,0,3,2,3,-4,2,-1,2,-1,4,-2,6,-2,-1,-2,-1,-1,-3,5,2,-1,3,3,1,-3,1,3,-3,2,-2,4,-4,-6,-4,-7,0,-3,1,-2,0,2,-5,2,-2,-1,4,1,1,0,1,5,1,0,1,1,0,2,0,7,-2,3,-1,-2,-3,0,0,0,0) 
df <- data.frame(cbind(Person1, Person2)) 
g <- ggplot(data = df, mapping = aes(x = Person1, y = Person2)) 
g <- g + geom_point(alpha = 1/3) # alpha b/c of overplotting 
g <- g + geom_smooth(method = "lm") # just for comparsion 
g <- g + coord_fixed() # otherwise, the angles of vectors are off 
corre <- cor(x = df$Person1, y = df$Person2, method = "spearman") # calculate correlation, must be spearman b/c of measurement 
matrix <- matrix(c(1, corre, corre, 1), nrow = 2) # make this into a matrix 
eigen <- eigen(matrix) # calculate eigenvectors and values 
eigen$vectors.scaled <- eigen$vectors %*% diag(sqrt(eigen$values)) 
    # scale eigenvectors to length = square-root 
    # as per http://stats.stackexchange.com/questions/9898/how-to-plot-an-ellipse-from-eigenvalues-and-eigenvectors-in-r 
g <- g + stat_ellipse(type = "norm") 
g <- g + stat_ellipse(type = "t") 
    # add ellipse, though I am not sure which is the adequate type 
    # as per https://github.com/hadley/ggplot2/blob/master/R/stat-ellipse.R 
g <- g + geom_abline(intercept = 0, slope = eigen$vectors.scaled[1,1], colour = "green") # add slope for pc1 
g <- g + geom_abline(intercept = 0, slope = eigen$vectors.scaled[1,2], colour = "red") # add slope for pc2 
g <- g + geom_segment(aes(x = 0, y = 0, xend = max(df), yend = eigen$vectors.scaled[1,1] * max(df)), colour = "green", arrow = arrow(length = unit(0.2, "cm"))) # add arrow for pc1 
g <- g + geom_segment(aes(x = 0, y = 0, xend = max(df), yend = eigen$vectors.scaled[1,2] * max(df)), colour = "red", arrow = arrow(length = unit(0.2, "cm"))) # add arrow for pc1 
g 

enter image description here

So weit, so gut (gut). Wie kann ich verwenden geom_segment, um eine Senkrechte von jedem Datenpunkt auf, sagen wir, die grüne erste Hauptkomponente fallen lassen?

+0

Ich weiß, dass die Visualisierung noch einige (statistische/konzeptionelle) Probleme hat - ich mit denen, auf Kreuz Validated gefragt -> http: // stats.stackexchange.com/questions/153564/whats-wrong-with-this-visualization-of-eigenvalues-vectors-pca – maxheld

+1

Ihr Beispiel scheint übermäßig komplex für nur Segmente senkrecht zu einer Linie zu finden. Ich würde mit dieser Frage als Leitfaden beginnen: http://stackoverflow.com/questions/2639430/graphing-perpendicular-offsets-in-a-least-squares-repression-plot-in-r – MrFlick

Antwort

4

Anpassung einer previous answer, können Sie

perp.segment.coord <- function(x0, y0, a=0,b=1){ 
#finds endpoint for a perpendicular segment from the point (x0,y0) to the line 
# defined by lm.mod as y=a+b*x 
    x1 <- (x0+b*y0-a*b)/(1+b^2) 
    y1 <- a + b*x1 
    list(x0=x0, y0=y0, x1=x1, y1=y1) 
} 


ss<-perp.segment.coord(df$Person1, df$Person2,0,eigen$vectors.scaled[1,1]) 

g + geom_segment(data=as.data.frame(ss), aes(x = x0, y = y0, xend = x1, yend = y1), colour = "blue") 

enter image description here