R/AllClasses.R

In fmrs: Variable Selection in Finite Mixture of AFT Regression and FMR

#' @title An S4 class to represent estimated optimal lambdas
#'
#' @description An S4 class to represent estimated optimal lambdas resulted
#'    from running \code{\link{fmrs.tunsel}}
#' @name fmrstunpar-class
#' @docType class
#' @exportClass fmrstunpar
#' @import methods
#' @slot ncomp A length-one numeric vector
#' @slot lambPen A dimension-one-\code{ncomp} numeric array
#' @slot MCPGam A length-one numeric vector
#' @slot SICAGam A length-one numeric vector
#' @slot disFamily A length-one character vector
#' @slot penFamily A length-one character vector
#' @slot lambRidge A length-one numeric vector
#' @slot model A length-one character vector
#' @slot activeset A dimension-\code{nobs}-\code{ncomp} 0-1 matrix
#' @rdname fmrstunpar-class
#' @keywords object
#' @export
fmrstunpar <- setClass("fmrstunpar", representation(ncomp = "numeric", lambPen = "array", lambRidge = "numeric", MCPGam = "numeric", SICAGam = "numeric", disFamily = "character",
    penFamily = "character", model = "character", activeset = "matrix"), prototype(ncomp = numeric(length = 1L), lambPen = array(), lambRidge = numeric(length = 1L),
    MCPGam = numeric(length = 1L), SICAGam = numeric(length = 1L), disFamily = character(), penFamily = character(), model = character(), activeset = matrix()))

#' @title An S4 class to represent a fitted FMRs model
#'
#' @description is an S4 class represents a fitted of FMRs model
#'    resulted from running \code{\link{fmrs.mle}}
#'    or \code{\link{fmrs.varsel}}
#' @name fmrsfit-class
#' @import methods
#' @slot y A length-\code{nobs} numeric vector
#' @slot delta A length-\code{nobs} numeric vector
#' @slot x A dimension-\code{nobs}-\code{ncov} numeric matrix
#' @slot nobs A length-one numeric vector
#' @slot ncov A length-one numeric vector
#' @slot ncomp A length-one numeric vector
#' @slot coefficients A length-\code{(ncov+1)}-\code{ncomp} numeric matrix
#' @slot dispersion A length-\code{ncomp} numeric vector
#' @slot mixProp A length-\code{ncomp} numeric vector
#' @slot logLik A length-one numeric vector
#' @slot BIC A length-one numeric vector
#' @slot nIterEMconv A length-one numeric vector
#' @slot disFamily A length-one character vector
#' @slot penFamily A length-one character vector
#' @slot lambPen A length-\code{ncomp} numeric vector
#' @slot lambRidge A length-one numeric vector
#' @slot MCPGam A length-one numeric vector
#' @slot SICAGam A length-one numeric vector
#' @slot model A length-one character vector
#' @slot fitted A dimension-\code{nobs}-\code{ncomp} numeric matrix
#' @slot residuals A dimension-\code{nobs}-\code{ncomp} numeric matrix
#' @slot weights A dimension-\code{nobs}-\code{ncomp} numeric matrix
#' @slot activeset A dimension-\code{nobs}-\code{ncomp} 0-1 matrix
#' @docType class
#' @keywords object
#' @rdname fmrsfit-class
#' @exportClass fmrsfit
frmsfit <- setClass("fmrsfit", representation(y = "vector", delta = "vector", x = "matrix", nobs = "numeric", ncov = "numeric", ncomp = "numeric", coefficients = "matrix",
    dispersion = "array", mixProp = "array", logLik = "numeric", BIC = "numeric", nIterEMconv = "numeric", disFamily = "character", penFamily = "character", lambPen = "array",
    lambRidge = "numeric", MCPGam = "numeric", SICAGam = "numeric", model = "character", fitted = "matrix", residuals = "matrix", weights = "matrix", activeset = "matrix"),
    prototype(y = vector(), delta = vector(), x = matrix(), nobs = numeric(length = 1L), ncov = numeric(length = 1L), ncomp = numeric(length = 1L), coefficients = matrix(),
        dispersion = array(), mixProp = array(), logLik = numeric(length = 1L), BIC = numeric(length = 1L), nIterEMconv = numeric(length = 1L), disFamily = character(),
        penFamily = character(), lambPen = array(), lambRidge = numeric(length = 1L), MCPGam = numeric(length = 1L), SICAGam = numeric(length = 1L), model = character(),
        fitted = matrix(), residuals = matrix(), weights = matrix(), activeset = matrix()), contains = "fmrstunpar")

validity.fmrsfit <- function(object) {
    if ((length(object@y) != object@nobs) | (dim(object@x)[1] != object@nobs) | (dim(object@x)[1] != length(object@y))) {
        return("data do not match")
    } else return(TRUE)
}