R/pcls.R

Defines functions pcls

Documented in pcls

## sum( ( y - y_hat )^2 )
pcls <- function(y, x) {

  n <- dim(x)[1]
  xtx <- crossprod(x)
  xty <- crossprod(x, y)
  be <- as.matrix( nnsolve::fnnls(xtx, xty, sum_to_constant = TRUE) )
  rownames(be) <- colnames(x)
  mse <- sum( (y - x %*% be)^2) / n
  list(coefficients = be, value = mse)
}

# pcls <- function(y, x) {
#
#   dm <- dim(x)
#   n <- dm[1]   ;   p <- dm[2]
#
#   dvec <- as.vector( crossprod(x, y) )
#   xx <- crossprod(x)
#   A <- cbind(1, diag(p) )
#   bvec <- c(1, rep(0, p) )
#   f <- quadprog::solve.QP(Dmat = xx, dvec = dvec, Amat = A, meq = 1, bvec = bvec)
#   be <- as.matrix( f$solution )
#   rownames(be) <- colnames(x)
#   mse <- ( sum(y^2) + 2 * f$value ) / n
#
#   list(coefficients = round(be, 12), value = mse)
# }

Try the scpropreg package in your browser

Any scripts or data that you put into this service are public.

scpropreg documentation built on March 24, 2026, 5:07 p.m.