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语言机器学习与临床预测模型