首页 > 其他分享 >R : PCA 主成分分析

R : PCA 主成分分析

时间:2023-12-18 20:57:57浏览次数:30  
标签:分析 dplyr Adonis 成分 library 可视化 PCA

主成分分析

rm (list = ls ()) 
library(vegan) 
library(tidyverse) 
library(ggalt) 
library(car)
library(ggforce)
library(ggpubr)
library(patchwork) 

# 2. 定义所需的函数。
pairwise.adonis1 <- function(x, factors, p.adjust.m) { #定义了一个名为pairwise.adonis1的函数,该函数接受三个参数:x,factors和p.adjust.m
  x = as.matrix(x)
  co = as.matrix(combn(unique(factors), 2))
  pairs <- F.Model <- R2 <- p.value <- c()
  for (elem in 1:ncol(co)) { 
    ad = adonis(x[factors %in% c(as.character(co[1, elem]), as.character(co[2, elem])), 
                  factors %in% c(as.character(co[1, elem]), as.character(co[2, elem]))] ~ 
                  factors[factors %in% c(as.character(co[1, elem]), as.character(co[2, elem]))], permutations = 999) 
    pairs <- c(pairs, paste(co[1, elem], 'vs', co[2, elem])) 
    F.Model <- c(F.Model, ad$aov.tab[1, 4]) 
    R2 <- c(R2, ad$aov.tab[1, 5]) 
    p.value <- c(p.value, ad$aov.tab[1, 6]) 
  }
  
  # p值调整
  p.adjusted = p.adjust(p.value, method = p.adjust.m) 
  pairw.res = data.frame(pairs, F.Model, R2, p.value, p.adjusted) 
  return(pairw.res)
}

# 3. 读取和处理数据。
setwd("C:\\Users\\Administrator\\Desktop\\PCA") 
otu <- read.table("./otu_table.txt", row.names = 1, sep = "\t", header = TRUE) %>% as.data.frame()
map <- read.table("./metadata3-1.txt", sep = "\t", header = TRUE) 
colnames(map)[1] <- "ID" 
row.names(map) <- map$ID 
idx <- rownames(map) %in% colnames(otu) 
map1 <- map[idx,]
otu <- otu[, rownames(map1)]

# 4. 进行adonis分析并计算统计值。
bray_curtis <- vegan::vegdist(t(otu), method = "bray", na.rm = TRUE)
ado <- adonis(bray_curtis ~ map1$Group, permutations = 999, method = "bray") #进行了Adonis分析。
R2_value <- round(as.data.frame(ado$aov.tab[5])[1, 1], 3)
p_v_value <- as.data.frame(ado$aov.tab[6])[1, 1]
title <- paste("Adonis:R^2 = ", R2_value, " P_value = ", p_v_value, sep = "")

# 5. 绘制PCA图。
#otu_centered <- scale(t(otu), scale = FALSE) # 对数据进行中心化处理
otu_standardized <- scale(t(otu), scale = TRUE) # 对数据进行标准化处理
pca <- prcomp(otu_standardized) # 使用prcomp函数进行了主成分分析(PCA)
#pca <- prcomp(t(otu)) # 使用prcomp函数进行了主成分分析(PCA)
summary_pca <- summary(pca) # 获取PCA的详细结果
points <- as.data.frame(pca$x) %>% dplyr::rename(x = "PC1", y = "PC2") # 将PCA的结果转换为数据框,并重命名了列名.
# pca$x是PCA结果中的坐标,dplyr::rename(x = "PC1", y = "PC2")将列名"PC1"和"PC2"改为"x"和"y"。
eig <- pca$eig
points <- cbind(points, map1[match(rownames(points), map1$ID),]) # 将map1数据框中的元数据添加到了PCA的结果中。

n <- 0.85
colors <- c("d0"="#00BFFF","d0.5"="#00BFFF","d1"="#00BFFF","d3"="#00BFFF","d5"="#00BFFF","d8"="#00BFFF","d10"="#00BFFF","W0"="#FF4500","W0.5"="#FF4500","W1"="#FF4500","W3"="#FF4500","W5"="#FF4500","W8"="#FF4500","W10"="#FF4500")
# 定义了颜色和形状的映射关系,用于后续的可视化。
shapes <- c("d0"=21, "d0.5"=21, "d1"=21, "d3"=21, "d5"=21,"d8"=21,"d10"=21,
            "W0"=21, "W0.5"=21, "W1"=21, "W3"=21, "W5"=21,"W8"=21,"W10"=21)
levels_order <- c("d0", "d0.5", "d1", "d3", "d5", "d8", "d10","W0","W0.5","W1","W3","W5","W8","W10") #定义顺序
points$Group <- factor(points$Group, levels = levels_order)
# 在ggplot中使用这些形状
p1 <- ggplot(points, aes(x = x, y = y, fill = Group, shape = Group)) + 
  geom_point(alpha = .7, size = 6) + 
  scale_shape_manual(values = shapes) + 
  scale_fill_manual(values = colors) +
  labs(x = paste("PC1 (", format(summary_pca$importance[2, 1] * 100, digits = 4), "%)", sep = ""),
       y = paste("PC2 (", format(summary_pca$importance[2, 2] * 100, digits = 4), "%)", sep = ""), title = title) +
  geom_mark_ellipse(aes(fill = Group, label = Group), alpha = 0.1, color = "grey", linetype = 3) +
  theme_bw() +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.text = element_text(color = "black", size = 9),
        axis.title = element_text(size = 20), # 改变坐标轴标题的大小
        legend.text = element_text(size = 14), # 改变图例文字的大小
        legend.key.size = unit(1, "cm")) +# 改变图例图形的大小
  coord_cartesian(xlim = c(-max(abs(points$x)) * 1.1, max(abs(points$x)) * 1.1), ylim = c(-max(abs(points$y)) * 1.1, max(abs(points$y)) * 1.1)) + # 改变x轴和y轴的范围
  geom_vline(xintercept = 0, linetype = "dashed", color = "black") + # 添加垂直虚线
  geom_hline(yintercept = 0, linetype = "dashed", color = "black") # 添加水平虚线

# 显示绘制的图
p1
# 6. 输出pairwise adonis结果。
pair_bray_adonis <- pairwise.adonis1(bray_curtis, map1$Group, p.adjust.m = "bonferroni") #进行了成对的Adonis分析
# 存储为文本文件
write.table(as.data.frame(pair_bray_adonis), "table.txt", sep = "\t", quote = FALSE, row.names = FALSE) #将Adonis分析的结果保存为了一个文本文件。
tab2 <- ggtexttable(pair_bray_adonis, rows = NULL)
p2 <- tab2
p2
ggsave(filename = "PCA_plot3.png", plot = p1, width = 12, height = 10, units = "in", dpi = 600)

1. 初始化和加载库

  • rm(list = ls()):清除R环境中的所有变量,以便开始新的分析。
  • library(...):加载所需的R包。其中,vegan用于生态多样性分析,tidyverse提供了数据处理和可视化的强大工具,ggaltcarggforceggpubrpatchwork用于数据可视化和图形展示。

2. 定义函数 pairwise.adonis1

这个函数用于执行成对的Adonis分析(一种非参数多元方差分析方法)。它接收三个参数:数据矩阵x、因子factors和p值调整方法p.adjust.m。函数内部,它首先将数据转换为矩阵格式,然后对每一对唯一的因子组合进行Adonis分析,最后返回一个包含分析结果的数据框。

3. 数据读取和处理

  • setwd():设置工作目录。
  • read.table():读取OTU表和元数据文件。OTU表包含样本和操作分类单元(OTU)的计数,元数据文件包含样本信息。
  • dplyr::rename()dplyr::filter()等:对数据进行处理,使其适合后续分析。

4. Adonis分析和PCA

  • 使用vegan::vegdist()计算基于Bray-Curtis距离的距离矩阵。
  • 进行Adonis分析,以测试群落组成是否因Group而异。
  • 进行PCA分析,这是一种降维技术,用于探索样本间的关系。

5. 数据可视化

  • 使用ggplot2和相关包创建PCA图,展示样本在主要成分上的分布。
  • 对PCA结果中的点进行美化和标记,以提供更多的可视化信息。

6. 输出结果

  • 执行pairwise.adonis1函数,以获得成对Adonis分析的结果。
  • 将结果保存为文本文件,并使用ggpubr创建一个表格,显示成对Adonis分析的结果。
  • 使用ggsave保存PCA图像。

 

标签:分析,dplyr,Adonis,成分,library,可视化,PCA
From: https://www.cnblogs.com/wzbzk/p/17912215.html

相关文章

  • apk防标记.防报毒处理深入分析;附工具
    背景Google审核日益严格,很多包都会因为各种原因被拒,推广线下包也就成了PlanB但在设备上直接安装apk,又会遇到另一个问题:报毒报毒后,推广成本大大增加,用户安装意愿大大降低.为什么一个apk会被标记成病毒呢.1.为什么apk被报毒就是你的apk里面包含病毒信息,或你的apk已经在......
  • python模拟体育竞技分析
    采用排球比赛规则点击查看代码fromrandomimportrandomdefprintInfo():#打印程序介绍信息print('这个程序模拟两个选手A和B的某种竞技比赛')print('程序运行需要A和B的能力值(以0到1之间的小数表示)')defgetInputs():#获得程序运行参数a=eval......
  • pytorch——豆瓣读书评价分析
    任务目标基于给定数据集,采用三层bp神经网络方法,编写程序并构建分类模型,通过给定特征实现预测的书籍评分的模型。选取数据在各项指标中,我认为书籍的评分和出版社、评论数量还有作者相关,和其他属性的关系并大。所以,对于出版社,我选取了出版社的平均评分和出版社在这个表格中出现......
  • 羚通视频智能分析平台视频监控厨房玩手机、打电话算法识别
    羚通视频智能分析平台是一款基于人工智能技术的监控系统,旨在实现对监控视频中各类违规行为的自动识别和预警。该系统采用深度学习算法,通过对大量标注数据的学习,能够准确地识别出视频中的抽烟、打电话等行为,并实时生成预警信息,提醒相关人员进行处理。特别针对厨房场景......
  • 羚通视频智能分析平台:干燥天气下的安防视频监控与烟火检测
    随着科技的不断发展,人工智能技术已经深入到我们生活的各个角落。其中,羚通视频智能分析平台就是这样一种应用,它能够在干燥天气下,通过安防视频监控和烟火检测,为我们提供更加安全的环境。在干燥的天气条件下,火灾的风险显著增加。因此,羚通视频智能分析平台在这种情况下的安防视频监控......
  • 羚通视频智能分析平台:干燥天气下的安防视频监控与烟火检测
    随着科技的不断发展,人工智能技术已经深入到我们生活的各个角落。其中,羚通视频智能分析平台就是这样一种应用,它能够在干燥天气下,通过安防视频监控和烟火检测,为我们提供更加安全的环境。在干燥的天气条件下,火灾的风险显著增加。因此,羚通视频智能分析平台在这种情况下的安防视频......
  • 零数科技双平台入选2023爱分析·数据要素流通厂商全景报告
    全面近日,国内领先的数字化市场研究咨询机构爱分析正式发布《2023爱分析·数据要素流通厂商全景报告》,零数科技凭借成熟的区块链和隐私计算技术,及系列标杆产品及应用,成功入选数据要素流通代表厂商。图:零数科技入围爱分析数据要素厂商全景地图随着数字经济的崛起,数据成为推动社会生产......
  • 基于网络爬虫技术的网络新闻分析
    前言随着互联网的发展和普及,网络新闻成为人们获取信息的重要途径。然而,由于网络新闻的数量庞大,分析和处理这些新闻变得愈发困难。本文将介绍如何使用网络爬虫技术以及代理IP来进行网络新闻分析。一、网络爬虫技术网络爬虫技术是指通过自动化程序来获取互联网上的信息。在网络新闻分......
  • 羚通视频智能分析平台:安全帽反光衣识别,提升工地安全管理
    在建筑工地、矿山、工厂等高风险环境中,员工的安全是每个管理者最关心的问题。为了确保员工的生命安全,各种安全规定和措施被严格执行,其中,佩戴安全帽和反光衣是最基本的要求。然而,人工巡查的方式效率低下,且难以做到实时监控,这就为羚通视频智能分析平台提供了一个重要的应用场景。羚......
  • 羚通视频智能分析平台:安全帽反光衣识别,提升工地安全管理
    在建筑工地、矿山、工厂等高风险环境中,员工的安全是每个管理者最关心的问题。为了确保员工的生命安全,各种安全规定和措施被严格执行,其中,佩戴安全帽和反光衣是最基本的要求。然而,人工巡查的方式效率低下,且难以做到实时监控,这就为羚通视频智能分析平台提供了一个重要的应用场景。......