您非常接近那里，并且在使用 R 中的矩阵时遇到了一个微妙的问题。我从您那里完成final_data并独立获得了正确的结果。然后我仔细查看了您的代码。长话短说，你写的地方

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

如果你写了你会没事的

row_orig_data = t(t(feat_vec) %*% t(trans_data))

取而代之的是（因为您trans_data已将投影在第二个特征向量上的部分归零）。因为你试图将矩阵矩阵，但 R 没有给你一个错误。问题是被视为。尝试会给你一个错误。以下，可能更符合您的意图，也将起作用$2\times1$$2\times10$t(feat_vec[1,])$1\times2$row_orig_data = t(as.matrix(feat_vec[1,],ncol=1,nrow=2) %*% t(trans_data))non-conformable arguments

row_orig_data = t(as.matrix(feat_vec[1,],ncol=1,nrow=2) %*% t(trans_data)[1,])

因为它将矩阵乘以矩阵（请注意，您可以在此处使用原始矩阵）。没有必要这样做，但它在数学上更好，因为它表明您从值。$2\times1$$1\times10$final_data$20=2\times10$row_orig_data$12=2\times1 + 1\times10$

我在下面留下了我的原始答案，因为有人可能会觉得它很有用，而且它确实展示了获得所需的情节。它还表明，通过去掉一些不必要的转置，代码可以更简单一些： so 。$(XY)^T=Y^TX^T$t(t(p) %*% t(q)) = q %*% t

重新编辑，我在下面的图中添加了绿色的主成分线。在您的问题中，您得到的斜率为而不是。$x/y$$y/x$

写

d_in_new_basis = as.matrix(final_data)

然后将您的数据恢复到您需要的原始基础

d_in_original_basis = d_in_new_basis %*% feat_vec

您可以使用将沿第二个组件投影的数据部分归零

d_in_new_basis_approx = d_in_new_basis
d_in_new_basis_approx[,2] = 0

然后你可以像以前一样转换

d_in_original_basis_approx = d_in_new_basis_approx %*% feat_vec

将它们与绿色的主成分线一起绘制在同一个图上，向您展示了近似是如何工作的。

plot(x=d_in_original_basis[,1]+mean(d$x),
     y=d_in_original_basis[,2]+mean(d$y),
     pch=16, xlab="x", ylab="y", xlim=c(0,3.5),ylim=c(0,3.5),
     main="black=original data\nred=original data restored using only a single eigenvector")
points(x=d_in_original_basis_approx[,1]+mean(d$x),
       y=d_in_original_basis_approx[,2]+mean(d$y),
       pch=16,col="red")
points(x=c(mean(d$x)-e$vectors[1,1]*10,mean(d$x)+e$vectors[1,1]*10), c(y=mean(d$y)-e$vectors[2,1]*10,mean(d$y)+e$vectors[2,1]*10), type="l",col="green")

让我们回到你所拥有的。这条线没问题

final_data = data.frame(t(feat_vec %*% row_data_adj))

这里的关键位feat_vec %*% row_data_adj相当于，其中是特征向量矩阵，是数据矩阵，数据为行，是新基中的数据。这就是说，的第一行是（由第一个特征向量加权的行）的总和。的第二行的行由第二个特征向量加权）的总和。$Y=S^TX$$S$$X$$Y$$Y$$X$$Y$$X$

然后你有

trans_data = final_data
trans_data[,2] = 0

没关系：您只是将沿第二个组件投影的数据部分归零。出错的地方是

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

新基中数据的矩阵写，第二行为零，第一个特征向量写，这段代码的业务端归结为。$\hat Y$$Y$$\mathbf{e}_1$t(feat_vec[1,]) %*% t(trans_data)$\mathbf{e}_1 \hat Y$

如上所述（这是我意识到微妙的 R 问题并写下答案的第一部分的地方），从数学上讲，您试图将向量矩阵。这在数学上是行不通的。你应该做的是取的第一行 = Y 的第一行称之为。然后将和相乘。的第列是特征向量个点的第一个坐标加权，这是您想要的。$2\times1$$2\times10$$\hat Y$$Y$$\mathbf{y}_1$$\mathbf{e}_1$$\mathbf{y}_1$$i$$\mathbf{e}_1\mathbf{y}_1$$\mathbf{e}_1$$i$

我认为您的想法是正确的，但偶然发现了 R 的一个令人讨厌的功能。这里再次是您所说的相关代码段：

trans_data = final_data
trans_data[,2] = 0
row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16)

本质上final_data包含原始点相对于由协方差矩阵的特征向量定义的坐标系的坐标。因此，为了重建原始点，必须将每个特征向量与相关的变换坐标相乘，例如

(1) final_data[1,1]*t(feat_vec[1,] + final_data[1,2]*t(feat_vec[2,])

这将产生第一个点的原始坐标。在您的问题中，您将第二个组件正确设置为零，trans_data[,2] = 0. 如果你然后（正如你已经编辑过的那样）计算

(2) row_orig_data = t(t(feat_vec) %*% t(trans_data))

您同时计算所有点的公式 (1)。你的第一种方法

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

计算一些不同的东西并且只起作用，因为 R 会自动删除 的维度属性feat_vec[1,]，因此它不再是行向量，而是被视为列向量。随后的转置再次使其成为行向量，这就是为什么至少计算不会产生错误的原因，但是如果您通过数学运算，您会发现它与 (1) 不同。一般来说，在矩阵乘法中抑制维度属性的下降是一个好主意，这可以通过drop参数来实现，例如feat_vec[1,,drop=FALSE]。

您编辑的解决方案似乎正确，但如果 PCA1 错误，您计算了斜率。斜率由 给出，因此$\Delta y / \Delta x$

s1 = e$vectors[2,1] / e$vectors[1,1] # PC1
s2 = e$vectors[2,2] / e$vectors[1,2] # PC2

完成本练习后，您可以尝试 R 中更简单的方法。执行 PCA 有两个流行的函数：princomp和prcomp. 该princomp函数会像您在练习中所做的那样进行特征值分解。该prcomp函数使用奇异值分解。两种方法几乎总是会给出相同的结果：这个答案解释了R 的差异，而这个答案解释了数学。（感谢TooTone现在将评论整合到这篇文章中。）

在这里，我们使用两者来重现 R 中的练习。首先使用princomp：

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1), 
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# compute PCs
p = princomp(d,center=TRUE,retx=TRUE)

# use loadings and scores to reproduce with only first PC
loadings = t(p$loadings[,1]) 
scores = p$scores[,1] 

reproduce = scores %*% loadings  + colMeans(d)

# plots
plot(reproduce,pch=3,ylim=c(-1,4),xlim=c(-1,4))
abline(h=0,v=0,lty=3)
mtext("Original data restored using only a single eigenvector",side=3,cex=0.7)

biplot(p)

第二次使用prcomp：

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1), 
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# compute PCs
p = prcomp(d,center=TRUE,retx=TRUE)

# use loadings and scores to reproduce with only first PC
loadings = t(p$rotation[,1])
scores = p$x[,1]

reproduce = scores %*% loadings  + colMeans(d)

# plots
plot(reproduce,pch=3,ylim=c(-1,4),xlim=c(-1,4))
abline(h=0,v=0,lty=3)
mtext("Original data restored using only a single eigenvector",side=3,cex=0.7)

biplot(p)

显然，符号颠倒了，但对变异的解释是等价的。