Tôi có một bộ dữ liệu gồm 17 người, xếp hạng 77 báo cáo. Tôi muốn trích xuất các thành phần chính trên một ma trận tương quan chuyển vị của các mối tương quan giữa mọi người (dưới dạng các biến) qua các câu lệnh (như các trường hợp). Tôi biết, kỳ quặc, nó được gọi là nó Q Phương pháp .
Tôi muốn minh họa cách PCA hoạt động trong bối cảnh này, bằng cách trích xuất và trực quan hóa các giá trị / vectơ chỉ cho một cặp dữ liệu. (Bởi vì rất ít người trong ngành học của tôi có PCA, hãy để một mình ứng dụng cho Q, bao gồm cả bản thân tôi).
Tôi muốn hình dung từ hướng dẫn tuyệt vời này , chỉ cho dữ liệu thực sự của tôi .
Hãy để điều này là một tập hợp con của dữ liệu của tôi:
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 comparison
g <- g + coord_fixed() # otherwise, the angles of vectors are off
g
Lưu ý rằng, bằng cách đo lường, dữ liệu này:
- ... có nghĩa là bằng không,
- ... là hoàn toàn đối xứng,
- ... và được chia tỷ lệ bằng nhau trên cả hai biến (không nên có sự khác biệt giữa ma trận tương quan và hiệp phương sai)
Bây giờ, tôi muốn kết hợp hai lô trên .
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
cho
> $values
> [1] 1.6 0.4
>
> $vectors
> [,1] [,2]
> [1,] 0.71 -0.71
> [2,] 0.71 0.71
>
> $vectors.scaled
> [,1] [,2]
> [1,] 0.9 -0.45
> [2,] 0.9 0.45
và, tiếp tục
g <- g + stat_ellipse(type = "norm")
# 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
eigen$slopes[1] <- eigen$vectors[1,1]/eigen$vectors[2,1] # calc slopes as ratios
eigen$slopes[2] <- eigen$vectors[1,1]/eigen$vectors[1,2] # calc slopes as ratios
g <- g + geom_abline(intercept = 0, slope = eigen$slopes[1], colour = "green") # plot pc1
g <- g + geom_abline(intercept = 0, slope = eigen$slopes[2], colour = "red") # plot pc2
g <- g + geom_segment(x = 0, y = 0, xend = eigen$values[1], yend = eigen$slopes[1] * eigen$values[1], colour = "green", arrow = arrow(length = unit(0.2, "cm"))) # add arrow for pc1
g <- g + geom_segment(x = 0, y = 0, xend = eigen$values[2], yend = eigen$slopes[2] * eigen$values[2], colour = "red", arrow = arrow(length = unit(0.2, "cm"))) # add arrow for pc2
# Here come the perpendiculars, from StackExchange answer /programming/30398908/how-to-drop-a-perpendicular-line-from-each-point-in-a-scatterplot-to-an-eigenv ===
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$slopes[1])
g <- g + geom_segment(data=as.data.frame(ss), aes(x = x0, y = y0, xend = x1, yend = y1), colour = "green", linetype = "dotted")
g
Liệu cốt truyện này có minh họa đầy đủ cho việc trích xuất eigenvector / eigenvalue trong PCA không?
- Tôi không chắc hình elip và / hoặc độ dài của vectơ sẽ là gì (hoặc nó không quan trọng?)
- Tôi đoán, rằng các vectơ có độ dốc
1,-1là vì dữ liệu của tôi (bảng xếp hạng? Đối xứng?), Và sẽ khác nhau cho các dữ liệu khác.
Ps.: Điều này dựa trên hướng dẫn ở trên và câu hỏi CrossValidated này .
Pps.: Các đường vuông góc được thả trên vectơ là độ chính xác của câu trả lời StackExchange này
1, -1độ dốc được dự kiến?