Validación cruzada K-fold o hold-out para la regresión de crestas usando R

Estoy trabajando en la validación cruzada de la predicción de mis datos con 200 sujetos y 1000 variables. Estoy interesado en la regresión de crestas ya que el número de variables (que quiero usar) es mayor que el número de muestra. Entonces quiero usar estimadores de contracción. Los siguientes son datos de ejemplo:

 #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

Me gustaría hacer lo siguiente para la validación cruzada:

(1) divida los datos en dos paradas: use la primera mitad como entrenamiento y la segunda mitad como prueba

(2) Validación cruzada K-fold (digamos 10 veces o sugerencia en cualquier otro pliegue apropiado para mi caso son bienvenidos)

Simplemente puedo muestrear los datos en dos (ganancia y prueba) y usarlos:

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

Estoy usando lm.ridgedel MASSpaquete 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)

Tengo dos preguntas -

(1) ¿Cómo puedo predecir el conjunto de prueba y calcular la precisión (como correlación de lo predicho frente a lo real)?

(2) ¿Cómo puedo realizar la validación de K-fold? decir 10 veces?

Puede usar caret paquetes (vignnettes , papel ) para este tipo de cosas, que pueden incluir varios modelos de aprendizaje automático o puede usar sus propios modelos personalizados . Como está interesado en la regresión de crestas, aquí hay solo códigos personalizados para la regresión de crestas, es posible que desee adoptar su situación con mayor precisión.

Para división simple en datos:

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

Para validación de K-fold y otro tipo de CV, incluido el arranque predeterminado

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

Aquí hay una discusión sobre cómo usar la trainfunción. Tenga en cuenta que el método de cresta depende de las elasticnetfunciones del paquete (y su dependencia de lars, debe o debe instalarse). Si no está instalado en el sistema, le preguntará si desea hacerlo.

el tipo de remuestreo utilizado, el bootstrap simple se utiliza por defecto. Para modificar el método de remuestreo, se utiliza una función trainControl

El método de opción controla el tipo de remuestreo y el valor predeterminado es "arranque". Otro método, "repetidocv", se utiliza para especificar la validación cruzada repetida en K (y el argumento repeticiones controla el número de repeticiones). K está controlado por el argumento de número y el valor predeterminado es 10.

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

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

plot(ridgefit)

Para predicciones:

plsClasses <- predict(ridgeFit, newdata = testing)

Esta es una extensión de la sugerencia de Frank en los comentarios. Dr. Harrel, corríjame si me equivoco (aprecio las correcciones).

Tu información:

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

Instale el rmspaquete y cárguelo.

require(rms)

ols La función se utiliza para la estimación del modelo lineal utilizando mínimos cuadrados ordinarios donde se puede especificar el término de penalización.

Como se sugiere a continuación en los comentarios, agregué la petracefunción. Esta función rastrea AIC y BIC vs Penalización.

# 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 No podría usar las 1000 de las variables ya que el programa se queja si el número de variables excede de 100. Además y~., la designación de la fórmula de tipo no funcionó. Vea la forma anterior de hacer el mismo objeto de fórmula de creaciónfrm

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)

"Para un ajuste normalizado no normalizado de lrm o ols y para un vector o una lista de penalizaciones, se ajusta a una serie de modelos logísticos o lineales utilizando la estimación penalizada de máxima verosimilitud, y guarda los grados efectivos de libertad, Akaike Information Criterion (AIC), Schwarz Bayesian Criterio de información (BIC) y AIC corregido de Hurvich y Tsai (AIC_c). Opcionalmente, pentrace puede usar la función nlminb para resolver el factor de penalización óptimo o la combinación de factores que penalizan diferentes tipos de términos en el modelo ". del rmsmanual del paquete.

calibrateLa función es para la Calibración del modelo de remuestreo y utiliza bootstrapping o validación cruzada para obtener estimaciones de corrección de sesgo (sobreajuste corregido) de los valores pronosticados frente a los observados en función de las predicciones de subconjunto en intervalos. La validatefunción realiza el muestreo de validación de un modelo de regresión, con o sin eliminación de variables descendentes hacia atrás. B = número de repeticiones. Para método = "validación cruzada", es el número de grupos de observaciones omitidas

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

Puede usar la Predictfunción para calcular valores pronosticados y límites de confianza. No estoy seguro de que esto funcione en una situación de prueba.

El paquete R glmnet( viñeta ) tiene una función de contenedor que hace exactamente lo que desea, llamado cv.glmnet( doc ). Lo usé ayer, funciona como un sueño.