R语言机器学习与临床预测模型48--灰色预测模型

本内容为【科研私家菜】R语言机器学习与临床预测模型系列课程

你想要的R语言学习资料都在这里, 快来收藏关注【科研私家菜】


01 什么是灰色预测模型?

灰色预测模型是通过少量的、不完全的信息,建立数学模型做出预测的一种预测方法。是基于客观事物的过去和现在的发展规律,借助于科学的方法对未来的发展趋势和状况进行描述和分析,并形成科学的假设和判断。
灰色预测模型(Grey model, GM)是灰色系统理论的基础和核心内容, 其研究重点在于解决小样本、贫信息的不确定性问题, 且灰色预测模型在众多领域都得到了广泛的运用. GM(1, 1)模型是灰色预测的核心内容, 是最简单、应用最广泛的单变量灰色预测模型。


灰色预测模型可针对数量非常少(比如仅4个),数据完整性和可靠性较低的数据序列进行有效预测,其利用微分方程来充分挖掘数据的本质,建模所需信息少,精度较高,运算简便,易于检验,也不用考虑分布规律或变化趋势等。
灰色预测模型一般只适用于短期预测,只适合指数增长的预测,比如人口数量,航班数量,用水量预测,工业产值预测等。
灰色预测的主要特点是模型使用的不是原始数据序列,而是生成的数据序列。适用于少量数据时使用(比如20个以内),大量数据时不适合。
GM(1,1)模型仅适用于中短期预测,不建议进行长期预测。
GM(1,1)模型有提供级比值检验,后验差比检验,模型残差检验等。
灰色预测模型有以下分类:
①灰色时间序列预测;即用观察到的反映预测对象特征的时间序列来构造灰色预测模型,预测未来某一时刻的特征量,或达到某一特征量的时间。

②畸变预测;即通过灰色模型预测异常值出现的时刻,预测异常值什么时候出现在特定时区内。

③系统预测;通过对系统行为特征指标建立一组相互关联的灰色预测模型,预测系统中众多变量间的相互协调关系的变化。

④拓扑预测;将原始数据作曲线,在曲线上按定值寻找该定值发生的所有时点,并以该定值为框架构成时点数列,然后建立模型预测该定值所发生的时点。





02 灰色预测模型R语言实现


hsyc <- function(y, ro) {
  #这个函数是计算关联度和关联度系数
  #初始化
  (x <- y / y[ ,1])
  #求绝对差序列
  x0 <- x[1, ]
  theta <- t(abs(apply(as.matrix(x[-1, ]), 1, function(t) {t - x0})))
  #相关系数
  nieta <- (apply(theta, 1, min) + ro * rep(max(theta), each = nrow(y)-1)) / 
    (theta + ro * rep(max(theta), each = nrow(y)-1))
  #关联度
  xgd <- apply(nieta, 1, mean)
  
  #传到list
  result <- list("xgxs" = nieta, 'xgd' = xgd)
  print(result)
  
}

f <- hsyc(y, 0.5)
f$xgxs
f$xgd

#测试方程--------------------------------------------
(y <- matrix(c(c(8, 8.8, 16, 18, 24, 32), 
               c(10, 12.12, 19.28, 20.25, 23.4, 30.69)), 
             byrow = TRUE, nrow = 2))
f <- hsyc(y, 0.5)

(y <- matrix(c(c(8, 8.8, 16, 18, 24, 32), 
               c(10, 12.12, 19.28, 20.25, 23.4, 30.69), 
               c(6, 6.35, 6.57, 6.98, 8.35, 8.75)), 
             byrow = TRUE, nrow = 3))
f <- hsyc(y, 0.5)
f$xgxs
f$xgd

(y <- matrix(c(c(8, 8.8, 16, 18, 24, 32), 
               c(10, 12.12, 19.28, 20.25, 23.4, 30.69), 
               c(6, 6.35, 6.57, 6.98, 8.35, 8.75),
               c(1, 2, 3, 4, 5, 6),
               c(4, 5, 6, 7, 8, 9)),
             byrow = TRUE, nrow = 6))
f <- hsyc(y, 0.5)

gmm11 <- function(x) {
  x1 <- cumsum(x)
  x0 <- x
  (b <- matrix(1, ncol = 2, nrow = length(x1)-1))
  
  for (i in seq_along(x1)-1) {
    b[i, 1] <- -(x1[i] + x1[i+1])/2
  }
  b
  (y <- x0[-1])
  
  (b_t_b <- t(b) %*% b)
  (b_t_b_1 <- solve(b_t_b))
  (b_t_y <- t(b) %*% matrix(y))
  (alpha_j <- b_t_b_1 %*% b_t_y)
  #得出预测模型
  (a <- alpha_j[1])
  (nu <- alpha_j[2])
  
  #第五步 残差检验
  #1 计算
  (x_j_1 <- (x0[1] - nu / a) * exp(- a * c(0:(length(x0)-1))) + nu / a)
  #---
  #打印公式
  cat("公式为:\n", "x(k+1) =", x0[1] - alpha_j[2] / alpha_j[1], "* exp(", alpha_j[1] , "* k)", alpha_j[2]/alpha_j[1], "\n")
  #---
  #2 累减
  lj <- function(x) {
    out <- array(dim = length(x))
    x_temp <- c(0, x)
    for(i in seq_along(x)) {
      out[i] <- x_temp[i+1] - x_temp[i]
    }
    as.numeric(out)
  }
  (x_j_0 <- lj(x_j_1))
  
  #3 计算绝对误差序列和相对误差序列
  (theta <- round(abs(x_j_0 - x0), 6))#保留小数点后6位
  (big_theta <- round(theta / x_j_0, 8))
  
  #第六步 进行关联度检验
  (nitheta <- (min(theta) + 0.5 * max(theta)) / (theta + 0.5 *max(theta)))
  # 2 关联度
  (r <- mean(nitheta))
  
  # 第七步 后验差检验
  # 1原始序列标准差
  (s1 <- sd(x0))
  # 2残差标准差
  (s2 <- sd(theta))
  # 3 计算C
  (c <- s2 / s1)
  # 4 计算小误差概率
  #s0没计算出来
  (ei <- abs(theta - mean(theta)))
  #第八步 预测值
  
  x_next <- (x0[1] - nu / a) * (exp(- a * (length(x0)+1)) - exp(- a * length(x0)))
  list(a=a, 
       mu=nu, 
       jdwc=theta,# 绝对误差
       glxs = nitheta, #关联系数
       r=r, #关联度
       c = round(c, 6), #
       ei = ei, #小误差概率
       x_next = x_next #预测值
  )
}

#-------------------------------------------------------
#测试函数
x0 <- c(26.7, 31.5, 32.8, 34.1, 35.8, 37.5)
x0 <- runif(100)
gmm11(x0)


03 精进篇

另,改进优化的灰色预测模型:基于背景值和结构相容性改进的多维灰色预测模型

参考资料:

https://blog.csdn.net/m0_37228052/article/details/123925165
http://www.aas.net.cn/cn/article/doi/10.16383/j.aas.c200780?viewType=HTML


关注R小盐,关注科研私家菜(VX_GZH: SciPrivate),有问题请联系R小盐。让我们一起来学习 R语言机器学习与临床预测模型

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 213,928评论 6 493
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 91,192评论 3 387
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 159,468评论 0 349
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 57,186评论 1 286
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 66,295评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,374评论 1 292
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,403评论 3 412
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 38,186评论 0 269
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,610评论 1 306
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,906评论 2 328
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 39,075评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,755评论 4 337
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,393评论 3 320
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 31,079评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,313评论 1 267
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,934评论 2 365
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,963评论 2 351

推荐阅读更多精彩内容