首页 > 其他分享 >R :贝叶斯Beta线性回归

R :贝叶斯Beta线性回归

时间:2024-12-02 10:25:42浏览次数:3  
标签:Distance group Time1 library 贝叶斯 Beta Time 线性 table

rm(list = ls())
library(readr)      # 读取 CSV 文件
library(dplyr)      # 数据操作
library(tidyr)      # 数据整理
library(brms)       # 贝叶斯回归
library(tibble) 
setwd("C:\\Users\\Administrator\\Desktop\\machine learning\\Bayesian linear regression")
# 数据导入
# 读取矩阵和分组文件
bray_matrix <- read.csv("bray.csv", row.names = 1)
jaccard_matrix <- read.csv("jaccard.csv", row.names = 1)
group_info <- read_delim("group.txt", delim = "\t")

# --- 1. 计算组内稳定性 ---
calculate_stability <- function(matrix_data, group_info) {
  long_data <- matrix_data %>%
    as.matrix() %>%
    as.table() %>%
    as.data.frame() %>%
    setNames(c("Sample1", "Sample2", "Distance")) %>%
    left_join(group_info, by = c("Sample1" = "SampleID")) %>%
    rename(Time1 = Time) %>%  # 使用时间 (Time) 替换基因 (Gene)
    left_join(group_info, by = c("Sample2" = "SampleID")) %>%
    rename(Time2 = Time) %>%  # 使用时间 (Time) 替换基因 (Gene)
    filter(Time1 == Time2, Distance != 0) %>% # 只保留组内非零距离
    mutate(Stability = 1 - Distance)
  
  return(long_data)
}

stability_long <- calculate_stability(bray_matrix, group_info)

# --- 2. 转换距离矩阵为全样本长格式,并引入分组信息 ---
convert_to_long <- function(matrix_data, group_info) {
  long_data <- matrix_data %>%
    as.matrix() %>%
    as.table() %>%
    as.data.frame() %>%
    setNames(c("Sample1", "Sample2", "Distance")) %>%
    left_join(group_info, by = c("Sample1" = "SampleID")) %>%
    rename(Time1 = Time) %>%  # 使用时间 (Time) 替换基因 (Gene)
    left_join(group_info, by = c("Sample2" = "SampleID")) %>%
    rename(Time2 = Time) %>%  # 使用时间 (Time) 替换基因 (Gene)
    filter(Distance != 0) # 移除自己与自己的比较
  return(long_data)
}

bray_long <- convert_to_long(bray_matrix, group_info)
jaccard_long <- convert_to_long(jaccard_matrix, group_info)

# --- 3. 贝叶斯Beta回归分析函数 ---
perform_bayesian_beta_regression <- function(data, response, predictors) {
  formula <- as.formula(paste(response, "~", paste(predictors, collapse = "+")))
  
  # 使用 brms 进行贝叶斯Beta回归
  model <- brm(
    formula, 
    data = data, 
    family = "beta",   # 指定 Beta 分布
    prior = c(
      prior(normal(0, 5), class = "b"),  # 为回归系数设置先验
      prior(student_t(3, 0, 10), class = "Intercept")  # 为截距设置先验
    ),
    chains = 4,  # 链条数量
    iter = 2000, # 迭代次数
    warmup = 1000 # 热身迭代次数
  )
  
  # 提取回归结果
  result <- summary(model)$fixed
  
  # 创建结果表
  result_table <- data.frame(
    Variable = rownames(result),
    Beta = result[, "Estimate"],       # 回归系数
    SE = result[, "Est.Error"],        # 标准误差
    `2.5%` = result[, "l-95% CI"],     # 2.5% 置信区间下限
    `97.5%` = result[, "u-95% CI"],    # 97.5% 置信区间上限
    Rhat = result[, "Rhat"],           # Gelman-Rubin 收敛诊断
    Bulk_ESS = result[, "Bulk_ESS"],   # 样本有效大小 (Bulk ESS)
    Tail_ESS = result[, "Tail_ESS"]    # 尾部有效大小 (Tail ESS)
  )
  return(result_table)
}

# --- 4. 进行回归分析 ---
# (1) 稳定性回归分析
stability_results <- perform_bayesian_beta_regression(stability_long, "Stability", c("Time1"))

# (2) Bray–Curtis 距离回归分析
bray_results <- perform_bayesian_beta_regression(bray_long, "Distance", c("Time1"))

# (3) Jaccard 距离回归分析
jaccard_results <- perform_bayesian_beta_regression(jaccard_long, "Distance", c("Time1"))

# --- 5. 合并结果表 ---
final_table <- bind_rows(
  mutate(stability_results, Metric = "Stability (1 - Bray–Curtis, Within Group)"),
  mutate(bray_results, Metric = "Bray–Curtis distance"),
  mutate(jaccard_results, Metric = "Jaccard Index distance")
) %>%
  select(Metric, everything())

# 打印结果
print(final_table)

write.table(final_table, "Bayesian_Beta_Regression_Time.txt", row.names = TRUE, col.names = TRUE, sep = "\t", quote = FALSE)

######################################################
# --- 6. 根据 Time 计算均值和标准差 ---
calculate_group_stats <- function(data) {
  stats <- data %>%
    group_by(Time1) %>%  # 使用时间 (Time1) 分组
    summarise(
      Mean = mean(Stability, na.rm = TRUE),
      SD = sd(Stability, na.rm = TRUE)
    )
  return(stats)
}

group_stats <- calculate_group_stats(stability_long)

# --- 7. PERMANOVA 检验 ---
library(vegan)  # 加载 vegan 包用于 PERMANOVA

perform_permanova <- function(data, response, grouping_var, n_permutations = 999) {
  # 使用距离矩阵进行 PERMANOVA 检验
  distance_matrix <- dist(data[[response]])  # 计算距离矩阵
  permanova_result <- adonis2(distance_matrix ~ data[[grouping_var]], permutations = n_permutations)
  
  return(permanova_result)
}

# 执行 PERMANOVA 检验
permanova_result <- perform_permanova(stability_long, "Stability", "Time1", n_permutations = 999)

# --- 8. 保存均值和标准差到文件 ---
write.table(group_stats, "Stability_Stats_Time.txt", row.names = FALSE, col.names = TRUE, sep = "\t", quote = FALSE)

# --- 9. 保存 PERMANOVA 检验结果到文件 ---
write.table(permanova_result, "permanova_result_time.txt", row.names = FALSE, col.names = TRUE, sep = "\t", quote = FALSE)


# 提取回归结果并查看列名
result <- summary(model)$fixed
print(colnames(result))  # 查看返回结果的列名

 

标签:Distance,group,Time1,library,贝叶斯,Beta,Time,线性,table
From: https://www.cnblogs.com/wzbzk/p/18581126

相关文章

  • 动手学深度学习-2数据预处理、3线性代数
    目录数据预处理 读取数据集处理缺失值 转换为张量格式 小结线性代数标量向量长度、维度和形状 矩阵张量张量算法的基本性质 降维非降维求和 点积(DotProduct)矩阵-向量积 矩阵-矩阵乘法范数范数和目标 小结数据预处理为了能用深度学习来解决现......
  • 数据结构之线性表实验(二)
    【实验目的】1.理解和掌握线性关系数据的链接结构组织;2.设计、分析算法。3.理解封装的思想和意义。【实验内容】一、约瑟夫问题的求解。1.分别用带附加头结点和不带附加头结点的单链表实现,写出实现的代码,可以使用单链表的基本操作函数。2.在1基础上,计算报数间隔多......
  • 线性代数 复习
    1.方程组我们可以使用矩阵来描述方程组,设\(A\)是系数矩阵,\([A|\vecb]\)是它的增广矩阵。方程组的解的情况只有3种:无解,有唯一解,有无数个解。原因是假如方程组有有限个解,那么我们可以考虑它的两个解\(x,y\),它们的加权平均\(\lambdax+(1-\lambda)y\)也是解(\(0<\lambda<1\))并且......
  • 九种常见二维插值方法及双线性插值的理解
    九种常见二维插值方法概述在数据分析、计算机视觉和图形处理等领域,插值是一种重要的技术,用于估算在已知数据点之间的未知值。以下是几种常用的插值方法的详细介绍。1.双线性插值(BilinearInterpolation)双线性插值是一种在二维直线网格上进行插值的技术。它首先在一个方向上......
  • 贝叶斯定理
    P(H∣E)=P(E∣H)⋅P(H)/P(E)P(H∣E) 是后验概率。P(E∣H)是似然性(Likelihood),表示在假设 H为真的情况下,观察到证据 E的概率。P(H)是先验概率。P(E)是证据的概率。H是我们关注的随机变量,E是证据。 举个例子:P(H∣E)表示一封邮件出现“免费”字样时,是垃圾邮件的概率。P......
  • 判定贝叶斯线性回归回归系数是否显著的标准
    在贝叶斯回归中,判断回归系数是否显著通常是通过可信区间(credibleinterval)来进行的。下面是具体的标准和方法:判断回归系数是否显著的标准:可信区间(CredibleInterval)不包含零:标准:如果回归系数的95%可信区间不包含零,那么我们认为这个回归系数在统计上显著。这意味着回归......
  • [笔记]线性基
    线性基的定义:若干\(0,1\)向量的集合\(s\),使得\(\forall\overrightarrow{v}\ins\),不存在\(p_1,p_2\cdotsp_k(\overrightarrow{v_{p_i}}\ne\overrightarrow{v})\),使得\(\oplus_{1\lei\lek}\overrightarrow{v_{p_i}}=\overrightarrowv\)。线性基可以类比于平......
  • Day49 | 动态规划 :线性DP 判断子序列&&两个字符串的删除操作
    Day49|动态规划:线性DP判断子序列&&两个字符串的删除操作动态规划应该如何学习?-CSDN博客动态规划学习:1.思考回溯法(深度优先遍历)怎么写注意要画树形结构图2.转成记忆化搜索看哪些地方是重复计算的,怎么用记忆化搜索给顶替掉这些重复计算3.把记忆化搜索翻译成动态规......
  • R:alpha多样性线性回归
    rm(list=ls())library(dplyr)library(broom)library(ggplot2)#设置工作目录setwd("C:\\Users\\Administrator\\Desktop\\machinelearning\\MultipleLinearRegression")#读取多样性数据diversity_data<-read.table("alpha_diversity.txt"......
  • 基于改进自适应分段线性近似(IAPLA)的微分方程数值解法研究: 从简单动力系统到混沌系统的
    微分方程作为一种数学工具在物理学、金融学等诸多领域的动态系统建模中发挥着关键作用。对这类方程数值解的研究一直是学术界关注的重点。数值方法是一类用于求解难以或无法获得解析解的数学问题的算法集合。这类方法主要处理描述函数在时间或空间维度上演化的微分方程,采用逐步计......