Xác thực chéo K-Fold hoặc Hold-out cho hồi quy sườn bằng R

Tôi đang làm việc để xác thực chéo dự đoán dữ liệu của mình với 200 đối tượng và 1000 biến. Tôi quan tâm đến hồi quy sườn vì số lượng biến (tôi muốn sử dụng) lớn hơn số lượng mẫu. Vì vậy, tôi muốn sử dụng ước tính co ngót. Sau đây là dữ liệu ví dụ:

 #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

Tôi muốn làm theo để xác nhận chéo -

(1) chia dữ liệu thành hai nửa - sử dụng nửa đầu là đào tạo và nửa sau làm thử nghiệm

(2) Xác thực chéo K-gấp (giả sử 10 lần hoặc đề xuất về bất kỳ lần gấp thích hợp nào khác cho trường hợp của tôi đều được chào đón)

Tôi chỉ có thể lấy mẫu dữ liệu thành hai (đạt và kiểm tra) và sử dụng chúng:

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

Tôi đang sử dụng lm.ridgetừ MASSgói 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)

Tôi có hai câu hỏi -

(1) Làm cách nào tôi có thể dự đoán tập kiểm tra và tính chính xác (như tương quan của dự đoán so với thực tế)?

(2) Làm thế nào tôi có thể thực hiện xác nhận K-Fold? nói 10 lần?

Bạn có thể sử dụng caret gói (họa tiết , giấy ) cho loại điều này, có thể bao bọc một số mô hình học máy hoặc bạn có thể sử dụng các mô hình tùy chỉnh của riêng bạn . Vì bạn quan tâm đến hồi quy đỉnh, đây chỉ là mã tùy chỉnh cho hồi quy sườn, bạn có thể muốn áp dụng cho tình huống của mình chính xác hơn.

Để phân chia dữ liệu đơn giản:

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

Để xác thực K-Fold và loại CV khác bao gồm khởi động mặc định

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

Dưới đây là thảo luận về cách sử dụng trainchức năng. Lưu ý phương pháp sườn phụ thuộc vào các elasticnethàm gói (và sự phụ thuộc của nó vào lars, nên hoặc cần phải được cài đặt). Nếu không được cài đặt trong hệ thống sẽ hỏi bạn có muốn làm như vậy không.

Kiểu lấy mẫu được sử dụng, Bootstrap đơn giản được sử dụng theo mặc định. Để sửa đổi phương thức lấy mẫu lại, một hàm trainControl được sử dụng

Phương thức tùy chọn kiểm soát kiểu lấy mẫu lại và mặc định là "khởi động". Một phương thức khác, "repeatcv", được sử dụng để chỉ định xác thực chéo chéo của K kèm theo (và đối số lặp lại kiểm soát số lần lặp lại). K được điều khiển bởi đối số số và mặc định là 10.

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

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

plot(ridgefit)

Để dự đoán:

plsClasses <- predict(ridgeFit, newdata = testing)

Đây là phần mở rộng của đề xuất của Frank trong các ý kiến. Tiến sĩ Harrel xin vui lòng sửa nếu tôi sai (đánh giá cao sửa chữa).

Dữ liệu của bạ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)

Cài đặt rmsgói và tải nó.

require(rms)

ols Hàm được sử dụng cho Ước tính mô hình tuyến tính bằng cách sử dụng bình phương tối thiểu thông thường trong đó có thể chỉ định thời hạn phạt.

Như đề xuất dưới đây trong ý kiến ​​tôi thêm petracechức năng. Chức năng này theo dõi AIC và 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="+")))

Lưu ý quan trọng Tôi không thể sử dụng tất cả 1000 biến vì chương trình phàn nàn nếu số lượng biến vượt quá 100. Ngoài ra, y~.chỉ định công thức loại không hoạt động. Vì vậy, xem cách làm trên cùng tạo đối tượng công thứcfrm

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)

"Đối với một mức độ không phù hợp thông thường từ lrm hoặc ols và cho một vectơ hoặc danh sách các hình phạt, phù hợp với một loạt các mô hình logistic hoặc tuyến tính bằng cách sử dụng ước tính khả năng tối đa bị phạt và tiết kiệm mức độ tự do hiệu quả, Tiêu chí thông tin Akaike (AIC), Schwarz Bayesian Tiêu chí thông tin (BIC) và AIC (AIC_c) đã được sửa của Hurvich và Tsai. Tùy chọn ngũ giác có thể sử dụng hàm nlminb để giải quyết cho yếu tố hình phạt tối ưu hoặc kết hợp các yếu tố xử phạt các loại điều khoản khác nhau trong mô hình. " từ rmshướng dẫn gói.

calibratechức năng dành cho việc hiệu chỉnh lại mô hình hiệu chỉnh và sử dụng tính năng khởi động hoặc xác thực chéo để có được ước tính điều chỉnh sai lệch (quá mức) được dự đoán so với các giá trị được quan sát dựa trên các dự đoán được đặt vào các khoảng. Các validatechức năng không resampling xác nhận của một mô hình hồi quy, có hoặc không lùi bước xuống xóa biến. B = số lần lặp lại. Đối với phương thức = "xác định giá trị chéo", là số lượng các nhóm quan sát bị bỏ qua

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

Bạn có thể sử dụng Predicthàm để tính các giá trị dự đoán và giới hạn độ tin cậy. Tôi không chắc chắn tôi làm việc này trong tình huống thử nghiệm.

Gói R glmnet( họa tiết ) có chức năng bao bọc thực hiện chính xác những gì bạn muốn, được gọi là cv.glmnet( doc ). Tôi chỉ sử dụng nó ngày hôm qua, nó hoạt động như một giấc mơ.