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

두 가지 질문이 있습니다.

(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 함수가 사용됩니다.

옵션 방법은 리샘플링 유형을 제어하며 기본값은 "boot"입니다. 또 다른 방법 인 "repeatedcv"는 ​​반복 된 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)

이것은 주석에서 Frank의 제안을 확장 한 것입니다. Harrel 박사는 내가 틀렸다면 정정하십시오.

귀하의 데이터 :

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

중요 사항 변수의 수가 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의 일반 비 벌금 맞춤 및 벡터 또는 불이익 목록의 경우 불이익을받는 최대 우도 추정을 사용하여 일련의 로지스틱 또는 선형 모델에 적합하고 효과적인 자유도를 절약합니다. AKA (Akaike Information Criterion), Schwarz Bayesian 정보 기준 (BIC), Hurvich 및 Tsai의 수정 된 AIC (AIC_c). 선택적으로 pentrace는 nlminb 함수를 사용하여 모델에서 여러 종류의 항에 페널티를주는 최적의 페널티 요인 또는 요인 조합을 해결할 수 있습니다. " 에서 rms패키지 설명서.

calibrate이 기능은 리샘플링 모델 캘리브레이션 용이며 부트 스트랩 또는 교차 검증을 사용하여 구간에 대한 서브 셋팅 예측을 기반으로 예측 된 값과 관찰 된 값의 바이어스 수정 (과적 합 수정) 추정값을 얻습니다. 이 validate함수는 역 스텝 다운 변수 삭제 유무에 관계없이 회귀 모델의 유효성을 다시 샘플링합니다. B = 반복 횟수. method = "crossvalidation"의 경우 생략 된 관측치 그룹의 수입니다.

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

Predict함수를 사용 하여 예측 값 및 신뢰 한계를 계산할 수 있습니다 . 이것이 테스트 상황에서 작동하는지 확실하지 않습니다.

R package glmnet( vignette )에는 원하는 것을 정확하게 수행하는 래퍼 함수가 있습니다 cv.glmnet( doc ). 방금 어제 사용했는데 꿈처럼 작동합니다.