不同分布的QQ图绘制

简介

最近科研论文的审稿意见,需要对数据的拟合情况进行说明。分位数-分位数图(Quantile-Quantile plot,简称 QQ 图)是一种不错的选择。

研究动机

在 R 语言中常用 qqnorm() 绘制 QQ 图的散点图,qqline() 用于在图上添加一条参考直线。可支持与一些常见的理论分布进行比较,例如:正态分布 (“norm”)、指数分布 (“exp”)、伽马分布 (“gamma”)、威布尔分布 (“weibull”)、对数正态分布 (“lnorm”)等。

但是绘制出来的图形可能不是很美观,如下所示:

不同分布的QQ图绘制_第1张图片

本文贡献点

当然小编以前使用 ggplot 绘制过:绘制不同分布的 QQ 图,但内容不包括逆高斯分布以及其他比较“新”的分布。

基于这个痛点,本文小编将根据 QQ 图的定义,通过 ggplot2 复现自己常用的三个分布(正态、伽马和逆高斯分布)的 QQ 图。进行绘制。

题外话:读者可以根据本文思路,拓展到任何自己感兴趣的分布。

教程

理论介绍

介绍:一种用于检查数据是否符合某个理论分布的统计图。

基本思想:比较观察数据的分位数与理论分布的分位数。

判断依据:如果数据符合理论分布,那么 QQ 图上的点将近似落在一条直线上。

绘制步骤

  1. 排序数据: 将观察数据按照大小进行排序。

  2. 计算分位数: 计算每个观察数据点对应的分位数。这可以通过排名除以总数据点的数量来实现。

  3. 计算理论分位数: 使用所选择的理论分布的累积分布函数,计算对应于每个观察数据点的理论分位数。

  4. 绘制 QQ 图: 将观察数据的分位数作为横坐标,理论分位数作为纵坐标,绘制散点图。如果数据符合理论分布,散点图将近似为一条直线。

代码实现

根据上面的理论结果,我们依次进行代码实现。假设数据来自于 gamma 分布。

y <- rgamma(200,10,1)
  1. 排序数据
sorted_data <- sort(y)
  1. 计算样本分位数
sample_quantiles <- (1:length(sorted_data) - 0.5) / length(sorted_data)
  1. 计算理论分位数

首先,对数据进行参数估计,得到估计之后,产生理论分位数。

3.1 参数估计

这里使用极大似然方法估计参数,首先定义对数似然函数:

library(statmod)
fn_ig <- function(par= c(mean, dispersion), data) {
  ll <- -sum(dinvgauss(data, mean= par[1], dispersion= par[2], log= TRUE))   
  return(ll)
}

3.2 参数估计,并计算理论分位数:

pp <- optim(par= c(1,1), fn_ig, data = y)
mq <- pp$par[1]; disp <- pp$par[2] 
theoretical_quantiles <- qinvgauss(sample_quantiles, mean= mq, dispersion= disp)
  1. 绘制 QQ 图

数据整理并绘制

#数据整理
data_ig = data.frame("x" = theoretical_quantiles, "y" = sorted_data)
#绘制
library(ggplot2)
ggplot(data_ig,aes(x=x, y=y)) +
  geom_point(color="#4CA6A3",size=1.2) + 
  geom_abline(intercept = 0, slope = 1,color="#693476",size=1) + 
  # facet_wrap(vars(factor(pc)),scales = "free") + 
  theme_bw() + theme(legend.position = "none") + 
  xlab("Theoretical") + ylab("Sample")

不同分布的QQ图绘制_第2张图片

此时,给出了该数据使用逆高斯分布拟合的情况,结果还算可以!读者可以通过一些检验(Kolmogorov–Smirno等),进行进一步检测。

拓展

根据这个思路,小编写了正态和 Gamma 的结果,并通过一个函数将三种分布的整合在一起。最后绘制出三种分布拟合该数据的结果。

不同分布的QQ图绘制_第3张图片

还计算了三种分布拟合的 ks 检验的 p 值:

不同分布的QQ图绘制_第4张图片

p 值均大于 0.05,接受原假设,即三种分布拟合该数据均可。读者可以将合并的图放到自己论文中,仅需将 y 修改成自己的数据即可!

汇总代码

y <- rgamma(200,10,1)
library(statmod)
fn_ig <- function(par= c(mean, dispersion), data) {
  ll <- -sum(dinvgauss(data, mean= par[1], dispersion= par[2], log= TRUE))   
  return(ll)
}
fn_normal <- function(par = c(mean, sd), data) {
  # 正态分布的对数似然函数
  ll <- -sum(dnorm(data, mean = par[1], sd = par[2], log = TRUE))
  return(ll)
}
fn_gamma <- function(par = c(shape, rate), data) {
  # 伽马分布的对数似然函数
  ll <- -sum(dgamma(data, shape = par[1], rate = par[2], log = TRUE))
  return(ll)
}
qqdat = function(den = "ig", y = diff_y_all, par= c(1, 1)){
  # 排序数据
  sorted_data <- sort(y)
  # 计算样本分位数
  sample_quantiles <- (1:length(sorted_data) - 0.5) / length(sorted_data)
  
  if(den == "ig"){
    # 参数估计
    pp <- optim(par= par, fn_ig, data = y)
    mq <- pp$par[1]; disp <- pp$par[2] 
    # 计算理论分位数
    theoretical_quantiles <- qinvgauss(sample_quantiles, mean= mq, dispersion= disp)
  } else if(den == "norm"){
    pp <- optim(par= par, fn_normal, data = y)
    mq <- pp$par[1]; disp <- pp$par[2] 
    theoretical_quantiles <- qnorm(sample_quantiles, mq, disp)
  } else if(den == "gamma"){
    pp <- optim(par= par, fn_gamma, data = y)
    mq <- pp$par[1]; disp <- pp$par[2] 
    theoretical_quantiles <- qgamma(sample_quantiles, shape = mq, rate = disp)
  }
  
  data_ig = data.frame("x" = theoretical_quantiles, "y" = sorted_data)
  return(list(data_ig,"Para"= c(mq,disp)))
}

# 数据处理
qqplot_den = function(den = "norm",data6 = y,par= c(10, 1)){
  u1 = qqdat(den = den, data6, par= par)
  ig_g = data.frame(u1[[1]])
  
  w1 = ggplot(ig_g,aes(x=x, y=y)) +
    geom_point(color="#4CA6A3",size=1.2) + 
    geom_abline(intercept = 0, slope = 1,color="#693476",size=1) + 
    theme_bw() + theme(legend.position = "none") + 
    xlab("Theoretical") + ylab("Sample")
  
  if(den=="norm"){
    kstest = ks.test(data6, "pnorm", mean = u1$Para[1], u1$Para[2])$p.value
  } else if(den=="ig"){
    library(fitdistrplus)
    kstest = ks.test(data6, "pinvgauss", mean = u1$Para[1], dispersion = u1$Para[2])$p.value
  } else if(den=="gamma"){
    kstest = ks.test(data6, "pgamma", u1$Para[1], u1$Para[2])$p.value
  }
  
  return(list(w1,kstest))
}

w1 = qqplot_den(den = "norm",data6 = y,par= c(10, 1))
w2 = qqplot_den(den = "ig",data6 =  y,par= c(1, 1))
w3 = qqplot_den(den = "gamma",data6 =  y,par= c(1, 1))
cowplot::plot_grid(w1[[1]],w2[[1]],w3[[1]],labels=c("N","IG","G"),nrow=1)
# ggsave("qqplot.pdf", width = 8,height = 4)

你可能感兴趣的:(R数据科学,r语言)