Перехресне підтвердження K-згину або витримки для регресії хребта з використанням R

Я працюю над перехресною валідацією прогнозування моїх даних з 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-кратного? сказати в 10 разів?

Ви можете використовувати 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функції. Зауважте, що метод хребта залежить від elasticnetфункцій пакету (та його залежності від lars, потрібно чи потрібно встановити). Якщо система не встановлена, вона запитає, чи бажаєте ви це зробити.

тип використовуваного перекомпонування, простий завантажувальний засіб використовується за замовчуванням. Для зміни методу перекомпонування використовується функція trainControl

Опційний метод керує типом переустановки та за замовчуванням для "завантаження". Інший метод, "repeatcv", використовується для визначення повторної перехресної валідації K-кратної (і аргумент повторення контролює кількість повторень). K контролюється аргументом числа і за замовчуванням до 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="+")))

Важлива примітка: Я не міг використовувати всі 1000 змінних, оскільки програма скаржиться, якщо кількість змінних перевищує 100. Також 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 Information Criterion (AIC), Schwarz Bayesian Інформаційний критерій (BIC) та виправлений AIC Hurvich та Tsai (AIC_c). Пентрас може використовувати функцію nlminb для вирішення оптимального коефіцієнта штрафу або комбінації факторів, що штрафують різні види термінів у моделі. " з rmsпосібника з упаковки.

calibrateфункція призначена для перестановки калібрування моделі та використання завантажувальної або перехресної перевірки, щоб отримати коригування зміщення (коригування передоплавки) прогнозованих та спостережуваних значень на основі передбачення передбачень на інтервали. Ця validateфункція виконує переустановку валідації регресійної моделі з вилученням змінної чи видаленням назад. B = кількість повторень. Для методу = "перекваліфікація" - це кількість груп пропущених спостережень

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

Ви можете використовувати Predictфункцію для обчислення прогнозованих значень та меж довіри. Я не впевнений, що це працює в тестовій ситуації.

Пакет R glmnet( віньєтка ) має функцію обгортки, яка робить саме те, що ви хочете, називається cv.glmnet( doc ). Я тільки вчора використовував це, це працює як сон.