2014-04-25 2 views
0

méthode de validation croisée pour comparer les résidus 19 modèles ajustés en utilisant la sélection directe. J'étais coincé à la dernière étape. Le code est comme ceci:Utiliser seq_along dans la lapply

library(ISLR) 
summary(Hitters) # Use the dataset of Hitters 
Hitters = na.omit(Hitters) 

library(leaps) 

set.seed(11) 
folds = sample(rep(1:10,length=nrow(Hitters))) # used for cross validation later 
table(folds) 
cv.errors = matrix(NA,10,19) 
# store the errors from 10 validations, each contains an error for a model 

# write a prediction function 
predict.regsubsets = function(object,newdata,id,...){ 
    form = as.formula(object$call[[2]]) # extract the formula 
    mat = model.matrix(form,newdata)  # extract the exploratory data 
    coefi = coef(object,id=id)   # coefficients for the ith model 
    return(mat[,names(coefi)]%*%coefi) # manually get the predicted value 
} 
# write a function to extract the Mean of squared root of residuals 
error = function(object,newdata,origin,num,...){ 
    pred = lapply(seq_along(1:num),function(x){predict.regsubsets(object,newdata,id=x)}) 
    sapply(pred,function(x){mean((x-origin)^2)}) 
} 

# this gives error: $ operator is invalid for atomic vectors 
lapply(seq_along(1:10),function(X){ 
    best.fit = regsubsets(Salary~.,data=Hitters[folds!=X,],nvmax=19,method="forward") 
    cv.errors[X,]=error(best.fit,newdata=Hitters[folds==X,],origin=Hitters$Salary[folds==X],num=19) 
}) 

# this works well, except for being slow... 
for(X in 1:10){ 
    best.fit = regsubsets(Salary~.,data=Hitters[folds!=X,],nvmax=19,method="forward") 
    cv.errors[X,]=error(best.fit,newdata=Hitters[folds==X,],origin=Hitters$Salary[folds==X],num=19) 
} 

Merci!

+0

Vous ne savez pas si cela va résoudre votre problème, mais: Avez-vous vraiment besoin d'utiliser 'seq_along' ici? Juste '1: 10' devrait suffire. – Shambho

+0

'seq_along (1:10)' a la valeur 1:10 donc seq_along est redondant. Envisagez d'utiliser le paquet 'cvTools' plutôt que de rouler le vôtre. –

+0

Quelle est votre question ici? Ce n'est pas clair. –

Répondre

0

Cela peut être un problème de portée. Pas essayé, mais les opérations suivantes:

lapply(1:10,function(X){ 
    best.fit = regsubsets(Salary~.,data=Hitters[folds!=X,],nvmax=19,method="forward") 
    cv.errors[X,] <- error(best.fit,newdata=Hitters[folds==X,],origin=Hitters$Salary[folds==X],num=19) 
}) 

Le seul changement est ici le assignment operator.

En outre, pas sûr si cela va résoudre votre problème, mais: Avez-vous vraiment besoin d'utiliser seq_along ici? Juste 1:10 devrait suffire.

Questions connexes