Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/68.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
nls在R中省略一个cv图_R - Fatal编程技术网

nls在R中省略一个cv图

nls在R中省略一个cv图,r,R,我试着在非线性回归的交叉验证中去掉一个,然后画出最佳拟合。我觉得我的loocv和plot函数完全错了。谁能澄清我做错了什么 data(Boston, package='MASS') y <- Boston$nox x <- Boston$dis n <- length(x) nla <- n las <- seq(0, .85, length=nla) cvs <- rep(0, nla) for(j in 1:nla) { prs <- rep(0

我试着在非线性回归的交叉验证中去掉一个,然后画出最佳拟合。我觉得我的loocv和plot函数完全错了。谁能澄清我做错了什么

data(Boston, package='MASS')
y <- Boston$nox
x <- Boston$dis
n <- length(x)
nla <- n
las <- seq(0, .85, length=nla)
cvs <- rep(0, nla)
for(j in 1:nla) {
  prs <- rep(0,n)
  for(i in 1:n) {
    yi <- y[-i]
    xi <- x[-i]
    d <- nls(y~ A + B * exp(C * x), start=list(A=0.5, B=0.5, C=-0.5))
    prs[i] <- predict(d, newdata=data.frame(xi=x[i]))
  }
 cvs[j] <- mean( (y - prs)^2 )
}
cvs[j]
plot(y~x, pch=19, col='gray', cex=1.5,xlab='dis', ylab='nox')
d <- nls(y~ A + B * exp(C * x), start=list(A=0.5, B=0.5, C=-0.5))
lines(predict(d)[order(x)]~sort(x), lwd=4, col='black')
数据(波士顿,马萨诸塞州)

y您似乎很接近,但在您的循环中,您仍然调用了完整的数据集
x
y
。据我所知,您只需要一个循环就可以使模型适应每个遗漏一个场景。因此,我看不出需要变量
las
prs
。作为参考,该图显示了适用于完整数据集的nls模型的遗漏均方误差(LOO MSE)和残差均方误差(MSE)

脚本:
require(质量)
数据(波士顿,马萨诸塞州)
Y
require(MASS)
data(Boston, package='MASS')
y <- Boston$nox
x <- Boston$dis
n <- length(x)

cvs <- rep(0, n)
for(j in seq(n)){
  ys <- y[-j]
  xs <- x[-j]
  d <- nls(ys ~ A + B * exp(C * xs), start=list(A=0.5, B=0.5, C=-0.5))
  cvs[j] <- (y[j] - predict(d, data.frame(xs=x[j])))^2
  print(paste0(j, " of ", n, " finished (", round(j/n*100), "%)"))
}

plot(y~x, pch=19, col='gray', cex=1.5, xlab='dis', ylab='nox')
d <- nls(y~ A + B * exp(C * x), start=list(A=0.5, B=0.5, C=-0.5))
lines(predict(d)[order(x)]~sort(x), lwd=4, col='black')
usr <- par("usr")
text(usr[1] + 0.9*(usr[2]-usr[1]), usr[3] + 0.9*(usr[4]-usr[3]), paste("LOO MSE", "=", round(mean(cvs), 5)), pos=2)
text(usr[1] + 0.9*(usr[2]-usr[1]), usr[3] + 0.8*(usr[4]-usr[3]), paste("MSE", "=", round(mean(resid(d)^2), 5)), pos=2)