R/plsRglmmodel.default.R

Defines functions plsRglmmodel.default

Documented in plsRglmmodel.default

#' @rdname plsRglm
#' @export

plsRglmmodel.default <- function(object,dataX,nt=2,limQ2set=.0975,dataPredictY=dataX,modele="pls",family=NULL,typeVC="none",EstimXNA=FALSE,scaleX=TRUE,scaleY=NULL,pvals.expli=FALSE,alpha.pvals.expli=.05,MClassed=FALSE,tol_Xi=10^(-12),weights,sparse=FALSE,sparseStop=TRUE,naive=FALSE,verbose=TRUE,...)
{
  if(missing(modele)){modele="pls"}
  mf0 <- match.call(expand.dots = FALSE)
  m0 <- match(c("object","dataX","nt","limQ2set","dataPredictY","modele","family","typeVC","EstimXNA","scaleX","scaleY","pvals.expli","alpha.pvals.expli","MClassed","tol_Xi","weights","sparse","sparseStop","naive","verbose"), names(mf0), 0L)
  mf0$dataY <- mf0$object
  m <- match(c("dataY","dataX","nt","limQ2set","dataPredictY","modele","family","typeVC","EstimXNA","scaleX","scaleY","pvals.expli","alpha.pvals.expli","MClassed","tol_Xi","weights","sparse","sparseStop","naive","verbose"), names(mf0), 0L)
  mf <- mf0[c(1L, m)]
  if(is.null(mf$modele)){mf$modele<-"pls"}
  mf[[1L]] <- as.name("PLS_glm")
  
  estmodel <- eval(mf, parent.frame())
  
  if (typeVC!="none") {stop("Use plsRglm_kfoldcv for applying kfold cross validation to glms")}
  callf0 <- match.call()
  callf0$dataY <- mf0$object
  call0 <- c(toString(callf0[[1]]),names(callf0))
  call1 <- call0[!(call0=="") & !(call0=="object")]
  estmodel$call <- callf0[call1]
  estmodel$call[[1L]] <- as.name(toString(callf0[[1]]))
  class(estmodel) <- "plsRglmmodel"
  estmodel
}

Try the plsRglm package in your browser

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

plsRglm documentation built on March 31, 2023, 11:10 p.m.