如何可视化PCA变量移除特定样本后的旋转及预测移动方向？

针对你提出的34样本基因表达数据移除4个样本后PCA旋转的问题，以下是具体的R实现方案：

一、可视化变量PCA空间的旋转变化 #

交互式对比（Plotly） #

直接对比原始与移除样本后的PCA变量载荷，用交互式图表直观查看旋转差异：

library(plotly)
library(FactoMineR)

# 假设数据集已加载为data_34（34样本）和data_30（移除4样本后）
# 标准化变量后计算PCA
pca_34 <- PCA(data_34, scale.unit = TRUE, graph = FALSE)
pca_30 <- PCA(data_30, scale.unit = TRUE, graph = FALSE)

# 提取变量载荷并整理格式
loadings_34 <- pca_34$var$coord %>% 
  as.data.frame() %>% 
  mutate(group = "Original (34 samples)", var = rownames(.))
loadings_30 <- pca_30$var$coord %>% 
  as.data.frame() %>% 
  mutate(group = "Removed 4 samples (30 samples)", var = rownames(.))
all_loadings <- rbind(loadings_34, loadings_30)

# 绘制交互式对比图
plot_ly(all_loadings, x = ~PC1, y = ~PC2, color = ~group, text = ~var,
        mode = "markers+text", textposition = "top center") %>%
  layout(title = "PCA Variable Loading Comparison",
         xaxis = list(title = "PC1"), yaxis = list(title = "PC2"),
         legend = list(title = "Dataset"))

Shiny动态切换展示 #

搭建轻量Shiny应用，通过下拉菜单切换数据集，实时刷新PCA载荷图：

library(shiny)
library(FactoMineR)
library(ggplot2)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset", "Select Dataset:",
                  choices = c("Original (34 samples)", "Removed 4 samples (30 samples)"))
    ),
    mainPanel(plotOutput("pca_plot"))
  )
)

server <- function(input, output) {
  output$pca_plot <- renderPlot({
    target_data <- if(input$dataset == "Original (34 samples)") data_34 else data_30
    p .广播站国际Rent�万package fills有可能 Read有对.sl有可能在的话，
    pca_res <- PCA(target_data, scale.unit = TRUE, graph = FALSE)
    loadings <- pca_res$var$coord %>% 
      as.data.frame() %>% 
      mutate(var = rownames(.))
    
    ggplot(loadings, aes(x = PC1, y = PC2, label = var)) +
      geom_point(size = 3) +
      geom_text(hjust = 0.5, vjust = -0.5) +
      labs(title = paste("PCA Loadings -", input$dataset),
           x = "PC1", y = "PC2") +
      theme_minimal()
  })
}

shinyApp(ui, server)

二、推断变量移动方向 #

通过计算两组PCA载荷的坐标差值，直接判定变量在PC轴上的移动方向：

# 计算载荷差值
loadings_diff <- loadings_30[, c("PC1", "PC2")] - loadings_34[, c("PC1", "PC2")]
loadings_diff$var <- rownames(loadings_diff)

# 输出每个变量的移动方向
for(row in 1:nrow(loadings_diff)){
  var_name <- loadings_diff$var[row]
  pc1_dir <- if(loadings_diff$PC1[row] > 0) "沿PC1正方向（从左向右）" else "沿PC1负方向（从右向左）"
  pc2_dir <- if(loadings_diff$PC2[row] > 0) "沿PC2正方向（从下向上）" else "沿PC2负方向（从上向下）"
  cat(sprintf("变量%s：%s，%s\n", var_name, pc1_dir, pc2_dir))
}

例如，如果var1的PC1差值为正，即可判定它沿PC1从左向右移动。

三、构建变量连续移动效果 #

按照参考思路，通过逐步加入被移除样本（或Bootstrap抽样）生成过渡状态，再用gganimate制作动画：

方法1：逐步加入被移除样本 #

library(gganimate)
library(FactoMineR)
library(dplyr)

# 假设被移除的4个样本存储为data_removed
# 生成过渡数据集序列：从30样本到34样本，逐步加入被移除样本
transition_data_list <- list()
transition_data_list[[1]] <- data_30  # 初始状态：30样本
for(i in 1:4){
  transition_data_list[[i+1]] <- rbind(data_30, data_removed[i,, drop = FALSE])
}
transition_data_list[[6]] <- data_34  # 最终状态：原始34样本

# 计算每个过渡状态的PCA载荷
transition_loadings <- lapply(seq_along(transition_data_list), function(step){
  pca_res <- PCA(transition_data_list[[step]], scale.unit = TRUE, graph = FALSE)
  pca_res$var$coord %>% 
    as.data.frame() %>% 
    mutate(var = rownames(.), step = step)
}) %>% bind_rows()

# 制作动画
anim <- ggplot(transition_loadings, aes(x = PC1, y = PC2, label = var)) +
  geom_point(size =  :,学味 Ag偏助经".q
�Ped略+
  geom_text(hjust = 0.5, vjust = -0.5) +
  labs(title = "PCA Variable Movement: Step {frame}",
       x = "PC1", y = "PC2") +
  theme_minimal() +
  transition_states(step, transition_length = 1, state_length = 0.5) +
  ease_aes("linear")

# 渲染动画
animate(anim, nframes = 50, fps = 5)

方法2：Bootstrap抽样生成中间状态 #

如果不需要严格逐步加入样本，可通过Bootstrap从30样本中重复抽样，生成多个中间PCA结果：

# 生成10个Bootstrap样本（从30样本中放回抽样30个）
bootstrap_data_list <- lapply(1:10, function(x){
  data_30[sample(nrow(data_30), nrow(data_30), replace = TRUE), ]
})
# 加入首尾状态（30样本和34样本）
bootstrap_data_list <- c(list(data_30), bootstrap_data_list, list(data_34))

# 计算载荷并制作动画（代码同方法1，替换transition_data_list为bootstrap_data_list即可）

这样就能直观展示变量在PCA空间中的连续旋转过程，清晰观察它们的移动路径。

内容的提问来源于stack exchange，提问作者doctorate