使用R进行K折或保留交叉验证以进行岭回归

我正在对200个主题和1000个变量的数据预测进行交叉验证。我对岭回归很感兴趣，因为变量数（我想使用）大于样本数。所以我想使用收缩估计量。以下是示例数据：

 #random population of 200 subjects with 1000 variables 
    M <- matrix(rep(0,200*100),200,1000)
    for (i in 1:200) {
    set.seed(i)
      M[i,] <- ifelse(runif(1000)<0.5,-1,1)
    }
    rownames(M) <- 1:200

    #random yvars 
    set.seed(1234)
    u <- rnorm(1000)
    g <- as.vector(crossprod(t(M),u))
    h2 <- 0.5 
    set.seed(234)
    y <- g + rnorm(200,mean=0,sd=sqrt((1-h2)/h2*var(g)))

    myd <- data.frame(y=y, M)
myd[1:10,1:10]

y X1 X2 X3 X4 X5 X6 X7 X8 X9
1   -7.443403 -1 -1  1  1 -1  1  1  1  1
2  -63.731438 -1  1  1 -1  1  1 -1  1 -1
3  -48.705165 -1  1 -1 -1  1  1 -1 -1  1
4   15.883502  1 -1 -1 -1  1 -1  1  1  1
5   19.087484 -1  1  1 -1 -1  1  1  1  1
6   44.066119  1  1 -1 -1  1  1  1  1  1
7  -26.871182  1 -1 -1 -1 -1  1 -1  1 -1
8  -63.120595 -1 -1  1  1 -1  1 -1  1  1
9   48.330940 -1 -1 -1 -1 -1 -1 -1 -1  1
10 -18.433047  1 -1 -1  1 -1 -1 -1 -1  1

我想做以下交叉验证-

（1）将数据分成两部分-使用上半部分作为训练，使用下半部分作为测试

（2）K折交叉验证（例如，建议10折或对我的情况建议其他合适的折数建议）

我可以简单地将数据采样为两个（获取和测试）并使用它们：

# using holdout (50% of the data) cross validation 
training.id <- sample(1:nrow(myd), round(nrow(myd)/2,0), replace = FALSE)
test.id <- setdiff(1:nrow(myd), training.id)

 myd_train <- myd[training.id,]
 myd_test  <- myd[test.id,]   

我使用lm.ridge的MASS[R包。

library(MASS)
out.ridge=lm.ridge(y~., data=myd_train, lambda=seq(0, 100,0.001))
plot(out.ridge)
select(out.ridge)

lam=0.001
abline(v=lam)

out.ridge1 =lm.ridge(y~., data=myd_train, lambda=lam)
hist(out.ridge1$coef)
    out.ridge1$ym
hist(out.ridge1$xm)

我有两个问题-

（1）如何预测测试集并计算准确性（预测值与实际值之间的相关性）？

（2）如何执行K折验证？说十倍？

你可以用caret 包 （小插图，纸张）用于这种类型的东西，它可以包装许多机器学习模型，也可以使用自己的自定义模型。当您对ridge回归感兴趣时，这里只是ridge回归的自定义代码，您可能希望更精确地适应您的情况。

对于简单的数据分割：

set.seed(107)
# stratified random split of the data
inTrain <- createDataPartition(y = myd$y, p = .5,list = FALSE)
training <- myd[ inTrain,]
testing <- myd[-inTrain,]

用于K折验证和其他类型的CV，包括默认启动

ridgeFit1 <- train(y ~ ., data = training,method = 'ridge', 
preProc = c("center", "scale"), metric = "ROC")
plot(ridgeFit1)

这里是关于如何使用train函数的讨论。请注意，ridge方法取决于软件包的elasticnet功能（及其对的依赖lars，应该或需要安装）。如果未安装在系统中，则会询问您是否要这样做。

重采样的类型，默认情况下使用简单的引导程序。要修改重采样方法，请使用trainControl函数

选项方法控制重采样的类型，默认为“启动”。另一种方法“ repeatedcv”用于指定重复的K倍交叉验证（并且参数repeats控制重复次数）。K由number参数控制，默认为10。

 ctrl <- trainControl(method = "repeatedcv", repeats = 5)

 ridgeFit <- train(y ~ ., data = training,method = 'ridge',
preProc = c("center", "scale"),trControl = ctrl, metric = "ROC")

plot(ridgefit)

对于预测：

plsClasses <- predict(ridgeFit, newdata = testing)

这是弗兰克在评论中建议的扩展。如果我错了，Harrel博士请纠正（纠正错误）。

您的数据：

#random population of 200 subjects with 1000 variables 
    M <- matrix(rep(0,200*100),200,1000)
    for (i in 1:200) {
    set.seed(i)
      M[i,] <- ifelse(runif(1000)<0.5,-1,1)
    }
    rownames(M) <- 1:200

    #random yvars 
    set.seed(1234)
    u <- rnorm(1000)
    g <- as.vector(crossprod(t(M),u))
    h2 <- 0.5 
    set.seed(234)
    y <- g + rnorm(200,mean=0,sd=sqrt((1-h2)/h2*var(g)))

    myd <- data.frame(y=y, M)

安装rms软件包并加载它。

require(rms)

ols 函数用于使用普通最小二乘法进行线性模型估计，其中可以指定惩罚项。

如以下注释中所建议，我添加了petrace功能。此函数跟踪AIC和BIC与惩罚。

# using holdout (50% of the data) cross validation 
training.id <- sample(1:nrow(myd), round(nrow(myd)/2,0), replace = FALSE)
test.id <- setdiff(1:nrow(myd), training.id)

 myd_train <- myd[training.id,]
 myd_test  <- myd[test.id,] 

frm <- as.formula(paste("y~",paste(names(myd_train)[2:100],collapse="+")))

重要说明：如果变量数超过100，我将无法使用所有1000个变量，因为程序会抱怨。同样，y~.不能指定类型公式。所以看上面做公式对象的方法frm

f <- ols(frm, data = myd_train, method="qr", x=TRUE, y=TRUE)


p <- pentrace(f, seq(.2,1,by=.05))

Error in array(x, c(length(x), 1L), if (!is.null(names(x))) list(names(x),  : 
'data' must be of a vector type, was 'NULL'

 plot(p)

“对于来自lrm或ols的普通非罚式拟合以及对于罚分矢量或罚金列表，使用罚分最大似然估计对一系列逻辑或线性模型进行拟合，并节省了有效自由度，Akaike信息准则（AIC），施瓦兹贝叶斯信息标准（BIC），Hurvich和Tsai的校正后的AIC（AIC_c）。可选地，pentrace可以使用nlminb函数来求解最优惩罚因子或对模型中各种术语进行惩罚的因子组合。” 从rms包装手册中。

calibrate该功能用于重采样模型校准，并使用自举或交叉验证基于将子集的预测子集化为间隔，从而获得预测值与观察值的偏差校正（过拟合校正）估计。该validate函数可以对回归模型进行重采样验证，无论是否具有向后逐步降低变量删除功能。B =重复次数。对于method =“ crossvalidation”，是省略观察的组数

cal <- calibrate(f, method = "cross validation", B=20)  
plot(cal)

您可以使用Predict函数来计算预测值和置信度限制。我不确定这在测试情况下是否有效。

R包glmnet（vignette）具有一个包装函数，该函数完全可以实现您想要的功能，称为cv.glmnet（doc）。我昨天才用它，它像梦一样运作。