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つの停止に分割-前半をトレーニングとして使用し、後半をテストとして使用

（2）K分割交差検証（たとえば、10倍、または私のケースの他の適切な分割についての提案は大歓迎です）

データを2つに（サンプリングとテスト）単純にサンプリングして使用できます。

# 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,]   

Rパッケージlm.ridgeから使用していMASSます。

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)

2つの質問があります-

（1）テストセットを予測して精度を計算するにはどうすればよいですか（予測と実際の相関として）。

（2）K分割検証を実行するにはどうすればよいですか？１０倍？

このタイプのものにはcaret パッケージ （ビネット、紙）を使用できます。これにより、多数の機械学習モデルをラップしたり、独自にカスタマイズしたモデルを使用したりできます。ここでリッジ回帰に興味があるので、リッジ回帰のカスタムコードにすぎないので、状況にもっと正確に適応することをお勧めします。

データを単純に分割する場合：

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)

これはコメントでのフランクの提案の延長です。ハレル博士は私が間違っていれば訂正してください（訂正を感謝します）。

あなたのデータ：

#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からの通常のペナルティなしの適合、およびペナルティのベクトルまたはリストの場合、ペナルティ付き最尤推定を使用して一連のロジスティックモデルまたは線形モデルに適合し、有効自由度を保存します。赤池情報量基準（AIC）、シュワルツベイジアン情報量基準（BIC）、HurvichおよびTsaiの修正AIC（AIC_c）。オプションで、ペントレースはnlminb関数を使用して、モデル内のさまざまな種類の項にペナルティを課す最適なペナルティファクターまたはファクターの組み合わせを解決できます。rmsパッケージマニュアルから。

calibrate関数は、モデルキャリブレーションをリサンプリングし、ブートストラップまたは交差検証を使用して、間隔にサブセット化された予測に基づいて、予測値と観測値のバイアス修正（オーバーフィッティング修正）推定を取得します。このvalidate関数は、後退ステップダウン変数の削除の有無にかかわらず、回帰モデルの検証を再サンプリングします。B =繰り返しの数。method = "crossvalidation"の場合、省略された観測のグループの数です

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

Predict関数を使用して、予測値と信頼限界を計算できます。これがテスト状況で機能するかどうかはわかりません。

Rパッケージglmnet（vignette）には、cv.glmnet（doc）と呼ばれる、希望どおりの動作をするラッパー関数があります。昨日使ったばかりで、まるで夢のようです。