cv.lars1<- function (x, y, K = 10, fraction = seq(from = 0, to = 1, length = 100), 
    trace = FALSE, plot.it = TRUE, se = TRUE) 
{
# Howard Bondell modification of cv.lars
### add this code

full.fit <- lars(x, y, trace = trace)
betas <- full.fit$beta
sbetas <- scale(betas, FALSE, 1/full.fit$normx)
kp <- dim(betas)
k <- kp[1]
p <- kp[2]
norm.bound <- fraction*(abs(sbetas[k,]) %*% rep(1, p))

###


    all.folds <- cv.folds(length(y), K)
    residmat <- matrix(0, length(fraction), K)
    for (i in seq(K)) {
        omit <- all.folds[[i]]
        fit <- lars(x[-omit, ], y[-omit], trace = trace)

        ### fit <- predict(fit, x[omit, , drop = FALSE], mode = "fraction", 
        ###    s = fraction)$fit
	### Replace this line with

fit <- predict.lars1(fit, x[omit, , drop = FALSE], mode = "norm", 
            s = norm.bound)$fit
	###

        if (length(omit) == 1) 
            fit <- matrix(fit, nrow = 1)
        residmat[, i] <- apply((y[omit] - fit)^2, 2, mean)
        if (trace) 
            cat("\n CV Fold", i, "\n\n")
    }
    cv <- apply(residmat, 1, mean)
    cv.error <- sqrt(apply(residmat, 1, var)/K)
    object <- list(fraction = fraction, cv = cv, cv.error = cv.error)
    if (plot.it) 
        plotCVLars(object, se = se)
    invisible(object)
}


predict.lars1 <- function (object, newx, s, type = c("fit", "coefficients"), mode = c("step", 
    "fraction", "norm")) 
{
    mode <- match.arg(mode)
    type <- match.arg(type)
    if (missing(newx) & type == "fit") {
        warning("Type=fit with no newx argument; type switched to coefficients")
        type <- "coefficients"
    }
    betas <- object$beta
    sbetas <- scale(betas, FALSE, 1/object$normx)
    kp <- dim(betas)
    k <- kp[1]
    p <- kp[2]
    steps <- seq(k)
    if (missing(s)) {
        s <- steps
        mode <- "step"
    }
    sbeta <- switch(mode, step = {
        if (any(s < 0) | any(s > k)) 
            stop("Argument s out of range")
        steps
    }, fraction = {
        if (any(s > 1) | any(s < 0)) 
            stop("Argument s out of range")
        nbeta <- drop(abs(sbetas) %*% rep(1, p))
        nbeta/nbeta[k]

### This part is changed

    }, norm = {
        nbeta <- drop(abs(sbetas) %*% rep(1, p))
        if (any(s < 0)) 
            stop("Argument s out of range")
        nbeta
    })

	s[s>nbeta[k]] <- nbeta[k]

###

    sfrac <- (s - sbeta[1])/(sbeta[k] - sbeta[1])
    sbeta <- (sbeta - sbeta[1])/(sbeta[k] - sbeta[1])
    usbeta <- unique(sbeta)
    useq <- match(usbeta, sbeta)
    sbeta <- sbeta[useq]
    betas <- betas[useq, ]
    coord <- approx(sbeta, seq(sbeta), sfrac)$y
    left <- floor(coord)
    right <- ceiling(coord)
    newbetas <- ((sbeta[right] - sfrac) * betas[left, , drop = FALSE] + 
        (sfrac - sbeta[left]) * betas[right, , drop = FALSE])/(sbeta[right] - 
        sbeta[left])
    newbetas[left == right, ] <- betas[left[left == right], ]
    robject <- switch(type, coefficients = list(s = s, fraction = sfrac, 
        mode = mode, coefficients = drop(newbetas)), fit = list(s = s, 
        fraction = sfrac, mode = mode, fit = drop(scale(newx, 
            object$meanx, FALSE) %*% t(newbetas)) + object$mu))
    robject
}