[交流] 【求助】留一法交互验证如何做？

Originally posted by snoopyzhao at 2011-01-14 11:01:18:
前面我好象贴过一个 R 语言的用 CV 来对线性回归模型进行检验的程序，呵呵……

Originally posted by evenleesm1316 at 2011-01-16 22:26:34:


请具体请教是啥子软件啊？可以把帖子的链接给下不？我没有找到

[ Last edited by evenleesm1316 on 2011-1-16 at 22:35 ]

lmcv <- function(obj, ng = NULL, random = FALSE) {
#
# The Leave-One-Out (LOO) and/or Leave-Group-Out (LGO) Cross-Validation in R for (Multiple) Linear Regression.
#
# Input:
#   obj: the model of MLR
#   ng: number of group, if missing, do LOO
#   random: logical, if TRUE, do random CV
#
# Output:
#   q.squared: cross-validation relation coefficient.
#   SDEP: Standard Deviation of Error of Predictions
#   newsq: variance in Y explained only for LOO CV
#
# Usage:
#   loo <- cv.lm(obj)
#   lgo <- cv.lm(obj, ng = 5)
#
    data <- data.frame(y = obj$model[,1], x = obj$model[, -1])
    col.names <- colnames(data)
    N <- nrow(data)
    if (random == TRUE) data <- data[sample(1:N),]
    if (missing(ng)) ng <- N # LOO CV
    ytest <- numeric(N)
    ypred <- numeric(N)
    newrsq <- numeric(ng)
    g <- N %/% ng
    for (i in 1:ng) {
        if (g == 1) {
            index <- i
        }
        else {
            index <- c(i, ng * seq(1, (g - 1)) + i)
            if (N %% ng != 0 & i <= N %% ng) index <- c(index, (g * ng + i))
        }
        ytest[index] <- data[index,1]
        newtrain <- data[-index, ]
        xtest <- data.frame(x = data[index, -1])
        colnames(xtest) <- col.names[-1]
        newfm <- lm(y ~., data = newtrain)
        newrsq[i] <- summary(newfm)$r.squared
        ypred[index] <- predict(newfm, xtest)
    }
    q.squared <- 1 - sum((ytest - ypred)^2) / sum((ytest - mean(ytest))^2)
    SDEP <- sqrt(sum((ytest - ypred)^2) / N)
    return(list(q.squared = q.squared, SDEP = SDEP, newrsq = newrsq))
}