[原创]基于R语言的核回归(Kernal Regression)与最近邻回归(NNBR)

相似文件 换一批

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

1，核回归(Kernal Regression)，首先定义诸如高斯核函数，Epanechnikov核函数，再基于最优宽窗h，并基于Nadaraya-Waston核估计得到结果，代码如下：
1.1，高斯核函数与Epane核函数

本帖隐藏的内容

1. #  Gaussian Kernal
   
2. #  高斯核
   
3. kernalGaussian <- function(xData)
   
4. {
   
5.   #  得到相应的核函数
   
6.   
   
7.   if(ncol(xData)!=1)
   
8.   {
   
9.     stop('error input data')
   
10.   }
    
11.   
    
12.   stdX <- sd(xData)
    
13.   #  高斯宽带的选择
    
14.   h <- 1.06*stdX*length(xData)^(-1/5)
    
15.   
    
16.   kernalX <- 1/(h*sqrt(2*pi)) * exp(-xData^2/(2*h^2))
    
17.   return(kernalX)
    
18.   
    
19. }
    
20. 
    
21. #  Epanechnikov kernal
    
22. kernalEpanechnikov <- function (xData)
    
23. {
    
24.   if(ncol(xData)!=1)
    
25.   {
    
26.     stop('error input the data')
    
27.   }
    
28.   
    
29.   stdX <- sd(xData)
    
30.   
    
31.   h<-2.34*stdX*length(xData)^(-1/5)
    
32.   
    
33.   xPh<- abs(xData/h)
    
34.   xPh[xPh <=1] <-1
    
35.   xPh[xPh>1] <- 0
    
36.   
    
37.   kernalX <- 0.75/h*(1-(xData/h)^2)*xPh
    
38.   return(kernalX)
    
39.   
    
40. }

复制代码

1.2 两个核函数的检测：

本帖隐藏的内容

1. #  两个核函数的检测
   
2. testData1 <- as.matrix(seq(-10,10,by = 0.5))
   
3. testData2 <- as.matrix(seq(-10,10,length = 100))
   
4. 
   
5. kernalGaussian(testData1)
   
6. 
   
7. kernalEpanechnikov(testData2)
   
8. 
   
9. #  高斯核的数据的作图
   
10. plot(kernalGaussian(testData2))
    
11. 
    
12. #  Epanechnikov核函数的作图
    
13. plot(kernalEpanechnikov(testData2))

复制代码

1.3 以下是著名的Nadaraya-Waston核估计

本帖隐藏的内容

1. #  #########################################################
   
2. #  以下是著名的Nadaraya-Waston核估计
   
3. #  by fantuanxiaot
   
4. kernalRegress <- function(xData , yData , kernalName)
   
5. {
   
6.   if(!is.matrix(xData)||!is.matrix(yData))
   
7.   {
   
8.     stop('error input the empirical data')
   
9.   }
   
10.   
    
11.   #  最终返回针对y的核回归拟合的值
    
12.   nData<-nrow(xData)
    
13.   
    
14.   if(nData!=nrow(yData))
    
15.   {
    
16.     stop('error input the data')
    
17.   }
    
18. 
    
19.   if (!is.character(kernalName) || !length(intersect(c('Gaussian','Epanechnikov'),kernalName)) )
    
20.   {
    
21.     stop('error input the kernal name')
    
22.   }
    
23.   
    
24.   yRegress <- matrix(NaN , nrow = nData , ncol = 1)
    
25.   
    
26.   for (i in c(1:nData))
    
27.   {
    
28.     x <- xData[i]
    
29.     xXt <- matrix(x , nrow = nData, ncol = 1) - xData
    
30.    
    
31.     if (setequal(kernalName , 'Gaussian'))
    
32.     {
    
33.       khX <- kernalGaussian(xXt)
    
34.     } else if (setequal(kernalName , 'Epanechnikov'))
    
35.     {
    
36.       khX <- kernalEpanechnikov(xXt)
    
37.     }
    
38.    
    
39.     yRegress[i] <- sum(yData*khX)/sum(khX)
    
40.    
    
41.   }
    
42.   
    
43.   return(yRegress)
    
44.   
    
45.   
    
46. }
    
47. #  核回归的检测
    
48. x<- as.matrix(rnorm(100,mean = 0,sd = 0.03))
    
49. y<- 0.5*x + as.matrix(rnorm(100,mean = 0,sd = 0.01))
    
50. 
    
51. cbind(y,kernalRegress(x,y,'Gaussian') , kernalRegress(x,y,'Epanechnikov'))
    
52. 
    
53. plot(c(1:100),y,col = 'white')
    
54. lines(c(1:100),y,col = 'blue')
    
55. lines(c(1:100),kernalRegress(x,y,'Gaussian'),col = 'red')
    
56. lines(c(1:100),kernalRegress(x,y,'Epanechnikov'),col = 'green')

复制代码

2，NNBR(最近邻回归)
一篇基本思路的Paper： knnRegress_基于最近邻抽样回归模型的水文水资源预测.pdf (252.38 KB)

2015-8-21 10:00:02 上传

2.1，单变量NBRR源码如下：

本帖隐藏的内容

1. #  单变量的回归
   
2. #  NNBR  knn近邻回归与预测
   
3. 
   
4. 
   
5. #  这里是基于单变量的时间序列
   
6. setwd('D:/MyDriversMatlab/Mfiles13')
   
7. rm(list=ls())
   
8. nnbrRegress<-function (xData , lags , disType)
   
9. {
   
10.   #  lags是滞后的阶数P
    
11.   #  outNum是样本外预测的个数
    
12.   #  disType是计算距离的类别
    
13.   if (!is.matrix(xData))
    
14.   {
    
15.     stop('error input the Current Data')
    
16.   }
    
17.   
    
18.   
    
19.   if (ncol(xData)!= 1)
    
20.   {
    
21.     stop('error input data')
    
22.   }
    
23.   
    
24.   if ((nrow(xData) - lags)<1)
    
25.   {
    
26.     stop('error input the Data')
    
27.   }
    
28.   
    
29.   #  当前的数据集合
    
30.   currentData <- xData
    
31.   
    
32.   k <- ceiling(sqrt(nrow(xData) - lags))
    
33.   
    
34.   #  先计算所有的特征向量
    
35.   currentVector <- xData[c(( nrow(xData)-lags+1  ):(nrow(xData)))]
    
36.   currentVector <- t(as.matrix(currentVector))
    
37.   
    
38.   Vectors<-NULL
    
39.   xOut<-NULL
    
40.   #  获取其他的特征向量
    
41.   i<-1
    
42.   while(TRUE)
    
43.   {
    
44.     if ((i+lags - 1) == (nrow(xData)))
    
45.     {
    
46.       break
    
47.     }
    
48.     vectors<- t(as.matrix(xData[(i):(i+lags - 1)]))
    
49.    
    
50.     xOut<-c(xOut,xData[i+lags])
    
51.    
    
52.     Vectors<-rbind(Vectors,vectors)
    
53.    
    
54.     i<-i+1
    
55.   }
    
56.   
    
57.   #  再从中寻找距离最小的K个值
    
58.   nV <- nrow(Vectors)
    
59.   
    
60.   currData <- matrix(rep(currentVector , nV),nrow = nV,byrow = TRUE)
    
61.   Distance <- sqrt( apply((Vectors - currData)^2,1,sum) )
    
62.   #  再计算距离的最小的前k个值
    
63.   #  从大到小的几个下标
    
64.   Index <- order(Distance)
    
65.   Index <- Index[c(1:k)]
    
66.   
    
67.   xOut<-xOut[Index]
    
68.   DistanceOut <- Distance[Index]
    
69.   
    
70.   #  对样本外的结果进行预测
    
71.   #  权重的配置
    
72.   if (disType == 1)
    
73.   {
    
74.     xForecasting <- sum(DistanceOut/sum(DistanceOut)*xOut)
    
75.   } else
    
76.   {
    
77.     xForecasting <- sum((c(k:1)/k)/sum((c(k:1)/k))*xOut)
    
78.   }
    
79.   return(xForecasting)
    
80.   
    
81. }
    
82. data <- as.matrix(cumsum(matrix(rnorm(100),nrow = 100)))
    
83. data
    
84. nnbrRegress(data,8,1)
    
85. nnbrRegress(data,8,2)
    
86. #  各种不同的滞后阶数
    
87. nnbrRegress(data,10,1)
    
88. nnbrRegress(data,10,2)
    
89. #  各种不同的滞后阶数
    
90. nnbrRegress(data,15,1)
    
91. nnbrRegress(data,15,2)
    
92. #  eof

复制代码

2.2，多变量NNBR源码如下：

本帖隐藏的内容

1. #  D:\MyDriversMatlab\Mfiles13
   
2. setwd('D:/MyDriversMatlab/Mfiles13')
   
3. 
   
4. #  基于knn回归的最近邻算法
   
5. rm(list=ls())
   
6. nnbrRegressMultivariate<-function (xData , yData , testData)
   
7. {
   
8.   if(nrow(xData)!=nrow(yData))
   
9.   {
   
10.     stop('error input data')
    
11.   }
    
12.   
    
13.   if (ncol(xData)!=ncol(testData))
    
14.   {
    
15.     stop('error input data')
    
16.   }
    
17.   
    
18.   if (!is.matrix(xData) ||  !is.matrix(yData) || !is.matrix(testData))
    
19.   {
    
20.     stop('error input data')
    
21.   }
    
22.   
    
23.   #  取得特征向量的个数
    
24.   k<-ceiling(sqrt(nrow(xData)))
    
25.   
    
26.   yForecasting<-matrix(NaN , nrow = nrow(testData),ncol = 1)
    
27.   
    
28.   for (i in c(1:nrow(testData)))
    
29.   {
    
30.     x<-testData[i,]
    
31.    
    
32.     xDataRep <-rep(x,nrow(xData))
    
33.     xDataRep <- matrix(xDataRep,nrow = nrow(xData) , byrow = TRUE)
    
34.     #  计算距离
    
35.    
    
36.     Distance <- sqrt(apply((xData - xDataRep)^2,1,sum))
    
37.    
    
38.     Index <- order(Distance)
    
39.     #  选择前k个值
    
40.     Index<-Index[c(1:k)]
    
41.     ys<-(yData[Index])
    
42.     Weight<-(1/Distance)/sum(1/Distance)
    
43.    
    
44.     yForecasting[i] <-sum(ys*Weight)
    
45.    
    
46.   }
    
47.   return(yForecasting)
    
48.   
    
49. }
    
50. 
    
51. 
    
52. xData <- matrix(rnorm(100),ncol = 4)
    
53. yData <- as.matrix(apply(xData,1,mean))
    
54. testData <- matrix(rnorm(40),ncol = 4)
    
55. 
    
56. nnbrRegressMultivariate(xData , yData , testData)

复制代码

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享2 收藏90 回帖

关键词：regression regressio regress nbr RES 高斯

好贴，谢谢分享。

感谢分享，感谢楼主，发帖良苦，令人钦佩。

谢谢分享，很有用的帖子

谢谢楼主分享

不错啊，回复一下看看具体内容

代码不错，收藏了

下来学习一下

水一个，拿币走人