K-fold o hold-out cross validation per la regressione della cresta usando R

Sto lavorando alla convalida incrociata della previsione dei miei dati con 200 soggetti e 1000 variabili. Sono interessato alla regressione della cresta poiché il numero di variabili (che voglio usare) è maggiore del numero del campione. Quindi voglio usare gli stimatori di contrazione. Di seguito sono riportati i dati di esempio:

 #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

Vorrei fare quanto segue per la convalida incrociata -

(1) dividere i dati in due fasi: utilizzare la prima metà come allenamento e la seconda metà come test

(2) Convalida incrociata di K-fold (diamo il benvenuto con 10 volte o suggerendo qualsiasi altra piega appropriata per il mio caso)

Posso semplicemente campionare i dati in due (acquisizione e test) e usarli:

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

Sto usando lm.ridgedal MASSpacchetto 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)

Ho due domande -

(1) Come posso prevedere il set di test e calcolare l'accuratezza (come correlazione tra previsto e reale)?

(2) Come posso eseguire la convalida di K-fold? dire 10 volte?

Puoi usare il caret pacchetto (vignette , carta ) per questo tipo di cose, che può avvolgere un numero di modelli di apprendimento automatico o puoi usare i tuoi modelli personalizzati . Dato che sei interessato alla regressione della cresta qui ci sono solo codici personalizzati per la regressione della cresta, potresti voler adottare la tua situazione più precisamente.

Per una semplice suddivisione dei dati:

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

Per la convalida K-fold e altri tipi di CV incluso l'avvio predefinito

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

Ecco una discussione su come usare la trainfunzione. Nota che il metodo ridge dipende dalle elasticnetfunzioni del pacchetto (e dalla sua dipendenza da lars, dovrebbe o deve essere installato). Se non installato nel sistema chiederà se si desidera farlo.

il tipo di ricampionamento utilizzato, il bootstrap semplice viene utilizzato per impostazione predefinita. Per modificare il metodo di ricampionamento, viene utilizzata una funzione trainControl

Il metodo di opzione controlla il tipo di ricampionamento e il valore predefinito è "boot". Un altro metodo, "repeatcv", viene utilizzato per specificare la convalida incrociata ripetuta K (e l'argomento repeats controlla il numero di ripetizioni). K è controllato dall'argomento numerico e il valore predefinito è 10.

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

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

plot(ridgefit)

Per previsioni:

plsClasses <- predict(ridgeFit, newdata = testing)

Questa è l'estensione del suggerimento di Frank nei commenti. Dr. Harrel, per favore, correggi se sbaglio (apprezzo correzioni).

I tuoi dati:

#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)

Installa il rmspacchetto e caricalo.

require(rms)

ols La funzione viene utilizzata per la stima del modello lineare utilizzando i minimi quadrati ordinari in cui è possibile specificare il termine di penalità.

Come suggerito di seguito nei commenti ho aggiunto la petracefunzione. Questa funzione traccia AIC e BIC vs Penalty.

# 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="+")))

Nota importante Non potrei usare tutte le 1000 variabili perché il programma si lamenta se il numero di variabili supera 100. Anche la y~.designazione della formula del tipo non ha funzionato. Quindi vedi sopra il modo di fare lo stesso oggetto formula di creazionefrm

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)

"Per un comune adattamento non aperto da lrm o ols e per un vettore o un elenco di penalità, adatta una serie di modelli logistici o lineari che utilizzano la stima della massima probabilità penalizzata e salva i gradi di libertà effettivi, Akaike Information Criterion (AIC), Schwarz Bayesian Information Criterion (BIC) e AIC corretto di Hurvich e Tsai (AIC_c). Opzionalmente pentrace può usare la funzione nlminb per risolvere il fattore di penalità ottimale o la combinazione di fattori che penalizzano diversi tipi di termini nel modello. " dal rmsmanuale del pacchetto.

calibratela funzione è per il ricampionamento della calibrazione del modello e utilizza il bootstrap o la convalida incrociata per ottenere stime con correzione di bias (correzione di overfitting) dei valori previsti rispetto a quelli osservati in base alle previsioni di sottoimpostazione in intervalli. La validatefunzione esegue il ricampionamento della convalida di un modello di regressione, con o senza l'eliminazione della variabile di tipo back-down. B = numero di ripetizioni. Per method = "crossvalidation", è il numero di gruppi di osservazioni omesse

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

È possibile utilizzare la Predictfunzione per calcolare i valori previsti e i limiti di confidenza. Non sono sicuro che funzioni in condizioni di test.

Il pacchetto R glmnet( vignetta ) ha una funzione wrapper che fa esattamente quello che vuoi, chiamato cv.glmnet( doc ). L'ho usato solo ieri, funziona come un sogno.