非参数回归-局部回归

#### 一:时间序列图

# 商品房销售价格指数的时间序列图

library(psych)

#绘制时序图

x<-ts(y, frequency =1, start=c(2004),end=c(2016))

plot(x)

 

#1阶差分,并绘制出差分后序列的时序图

y.dif<-diff(x)

plot(y.dif)

 

# 差分序列adf单位根检验

library(urca)

a<-ur.df(y.dif)

b<-summary(a)

taus<-b@cval[1,]

ts<-b@teststat[1:1]

 

# acf pacf 

#绘制序列自相关图和偏自相关图

a<-acf(y.dif,plot=T)

a

b<-pacf(y.dif,plot=T)

b

 

# 采用AR(1)模型

y_l=y.dif[2:12]

x_l=y.dif[1:11]

ols_fit<-lm(y_l~x_l)

summary(ols_fit)

 

#ols下的残差值

residuals(ols_fit)

#ols下的估计值

fitted(ols_fit)

#拟合曲线

plot(y_l~x_l)

abline(ols_fit)

 

### 局部回归模型:

model=loess(y_l~x_l,control = loess.control(surface = "direct"),degree=2)

predictions1<- predict (model,x_l)

 

# 绘图

plot(x_l,y_l,pch=19)

x1<-order(x_l)

nr<-length(x1)

x_arr<-array(1:nr)

y_arr<-array(1:nr)

 

for(iin c(1:nr)){

  temp=x1[i]

  x_arr[i]=x_l[temp]

  y_arr[i]=predictions1[temp]

}

abline(ols_fit,col='red')

lines(x_arr,y_arr,col='blue')

 

 

#### 二: OLS 回归

ols_fit<-lm(y~x)

summary(ols_fit)

#ols下的残差值

residuals(ols_fit)

#ols下的预测值

fitted(ols_fit)

#拟合曲线

plot(y~x)

abline(ols_fit)

 

#### 三 NW核回归

# 采用的是高斯核(Gaussian Kernal),故核函数是正态分布下的密度函数

kernalGaussian <- function(xData)

{

  stdX <- sd(xData)

  #  高斯宽带的选择:每个点处的最优带宽

  h <- 1.06*stdX*length(xData)^(-1/5)

  print(h)

  # 每个点处的核函数

  kernalX <- 1/(h*sqrt(2*pi)) * exp(-xData^2/(2*h^2))

  return(kernalX)

}

 

# Nadaraya-Waston核估计,参数xData , yData必须是矩阵,且长度一样 

kernalRegress <- function(xData , yData)

{

  #  最终返回针对y的核回归拟合的值

  nData<-nrow(xData)

  yRegress <- matrix(NaN , nrow = nData , ncol = 1)

  for (iin c(1:nData))

  {

    x <- xData[i]

    xXt <- matrix(x , nrow = nData, ncol = 1) - xData

    # khx也就是权重

    khX <- kernalGaussian(xXt)

    # yRegress 加权算术平均值:求出x处的平均值

    yRegress[i] <- sum(yData*khX)/sum(khX)

    

  }

  return(yRegress)

}

 

#  核回归的检测

#x,y排序

x1<-order(x)

nr<-length(x)

x_arr<-array(1:10)

y_arr<-array(1:10)

 

for(iin c(1:nr)){

  temp=x1[i]

  x_arr[i]=x[temp]

  y_arr[i]=y[temp]

}

 

# 把x,y变成矩阵

x_matrix<- as.matrix(x_arr)

y_matrix<- as.matrix(y_arr)

 

# 核回归

y_regress<-kernalRegress(x_matrix,y_matrix)

 

# 真实值和预测值

cbind(y_matrix,y_regress)

 

# 画图

plot(x_arr,y_matrix,xlab = "全体居民消费指数", ylab = "商品房销售价格指数")

lines(x_arr,y_regress,col = 'red')

 

# 合并图

plot(x_arr, y_arr, xlab = "全体居民消费指数", ylab = "商品房销售价格指数", col = 1)

lines(x_arr, abline(ols_fit), lty = 1, col = 1)

lines(x_arr,y_regress, lty = 2, col = 2)

letters <- c("OLS model", "NW method")

legend("bottomright", legend = letters, lty = 1:2, col = 1:2, cex = 0.5)

 

转载于:https://www.cnblogs.com/laoketeng/p/11268577.html

  • 2
    点赞
  • 29
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值