首先,导入数据并进行排序:

data <- c(26.3, 16.1, 24.0, 4.3, 31.3, 94.0, 49.6, 77.9, 97.6, 17.6, 9.1, 27.3, 16.6, 7.3, 
          16.3, 34.6, 61.9, 3.4, 75.6, 9.4, 46.6, 10.9, 14.3, 25.7, 22.4, 13.0, 56.4, 88.7, 7.1, 64.4, 9.1)
data <- sort(data)

然后,绘制指数分布、威布尔分布和对数正态分布的概率图:

library(fitdistrplus)
library(ggplot2)

# 拟合指数分布
exp_fit <- fitdist(data, 'exp')
exp_curve <- data.frame(x = seq(min(data), max(data), length.out = 100))
exp_curve$y <- dexp(exp_curve$x, rate = exp_fit$estimate[['rate']])
exp_df <- data.frame(x = data, y = dexp(data, rate = exp_fit$estimate[['rate']]))

# 拟合威布尔分布
weibull_fit <- fitdist(data, 'weibull')
weibull_curve <- data.frame(x = seq(min(data), max(data), length.out = 100))
weibull_curve$y <- dweibull(weibull_curve$x, shape = weibull_fit$estimate[['shape']], 
                             scale = weibull_fit$estimate[['scale']])
weibull_df <- data.frame(x = data, y = dweibull(data, shape = weibull_fit$estimate[['shape']], 
                                                scale = weibull_fit$estimate[['scale']]))

# 拟合对数正态分布
lnorm_fit <- fitdist(log(data), 'lnorm')
lnorm_curve <- data.frame(x = seq(min(data), max(data), length.out = 100))
lnorm_curve$y <- dlnorm(lnorm_curve$x, meanlog = lnorm_fit$estimate[['meanlog']], 
                         sdlog = lnorm_fit$estimate[['sdlog']])
lnorm_df <- data.frame(x = data, y = dlnorm(log(data), meanlog = lnorm_fit$estimate[['meanlog']], 
                                            sdlog = lnorm_fit$estimate[['sdlog']]))

# 绘制概率图
ggplot(mapping = aes(x = data)) +
  geom_histogram(binwidth = 10, fill = 'white', color = 'black') +
  geom_line(data = exp_curve, aes(x = x, y = y, color = 'Exp'), size = 1) +
  geom_line(data = weibull_curve, aes(x = x, y = y, color = 'Weibull'), size = 1) +
  geom_line(data = lnorm_curve, aes(x = x, y = y, color = 'Lognormal'), size = 1) +
  geom_point(data = exp_df, aes(x = x, y = y, color = 'Exp'), size = 2) +
  geom_point(data = weibull_df, aes(x = x, y = y, color = 'Weibull'), size = 2) +
  geom_point(data = lnorm_df, aes(x = x, y = y, color = 'Lognormal'), size = 2) +
  scale_color_manual(values = c('Exp' = 'red', 'Weibull' = 'blue', 'Lognormal' = 'green'),
                     guide = guide_legend(title = 'Distribution')) +
  labs(title = 'Probability Density Function', x = 'Survival Time (months)', y = 'Density')

从图中可以看出,对数正态分布和威布尔分布都能够较好地拟合该数据,而指数分布则不太适合。同时,威布尔分布的拟合效果稍好于对数正态分布。因此,我们选择威布尔分布作为拟合该数据的分布。

我们可以使用拟合出来的威布尔分布的参数进行预测,包括形状参数和尺度参数:

weibull_fit$estimate
#>     shape     scale 
#> 2.3609337 4.4212425

根据威布尔分布的公式,我们可以计算出在该分布下的生存率函数和累积分布函数:

# 生存率函数
weibull_surv <- function(t) {
  exp(-(t / weibull_fit$estimate[['scale']]) ^ weibull_fit$estimate[['shape']])
}

# 累积分布函数
weibull_cdf <- function(t) {
  1 - weibull_surv(t)
}

我们可以使用这两个函数来计算在威布尔分布下的生存时间概率密度和累积概率密度:

# 生存时间概率密度
weibull_pdf <- function(t) {
  weibull_fit$estimate[['shape']] * (t / weibull_fit$estimate[['scale']]) ^ (weibull_fit$estimate[['shape']] - 1) * 
    exp(-(t / weibull_fit$estimate[['scale']]) ^ weibull_fit$estimate[['shape']]) / weibull_fit$estimate[['scale']]
}

# 累积概率密度
weibull_cdf_pdf <- function(t) {
  weibull_pdf(t) / (1 - weibull_surv(t))
}

最后,我们可以绘制在威布尔分布下的生存时间概率密度和累积概率密度的图像:

ggplot(mapping = aes(x = data)) +
  geom_histogram(binwidth = 10, fill = 'white', color = 'black') +
  stat_function(fun = weibull_pdf, aes(color = 'PDF'), size = 1) +
  stat_function(fun = weibull_cdf_pdf, aes(color = 'CDF'), size = 1) +
  scale_color_manual(values = c('PDF' = 'red', 'CDF' = 'blue'),
                     guide = guide_legend(title = 'Probability')) +
  labs(title = 'Probability Density Function', x = 'Survival Time (months)', y = 'Density')

31名晚期黑瘤症患者生存时间数据分析:威布尔分布拟合

原文地址: https://www.cveoy.top/t/topic/nUrH 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录