R/gen.cens.R

In gamlss.cens: Fitting an Interval Response Variable Using `gamlss.family' Distributions

################################################################################
################################################################################
################################################################################
################################################################################
gen.cens <- function(family = "NO", 
                      type = c( "right", "left", "interval"),
                      name = "cens", 
                      ...)
{
      type <- match.arg(type)
      fam  <- as.gamlss.family(family) # family 
     fname <- fam$family[[1]] # family name  
      dfun <- paste(paste("d",fname,sep=""), substr(type,start=1,stop=1),
                   substr(name,start=1,stop=1), sep="") # say dNOrc
      pfun <- paste(paste("p",fname,sep=""), substr(type,start=1,stop=1),
                   substr(name,start=1,stop=1), sep="") # say pNOrc
      qfun <- paste(paste("q",fname,sep=""), substr(type,start=1,stop=1),
                  substr(name,start=1,stop=1), sep="") # say qNOrc
       fun <- paste(fname, substr(type,start=1,stop=1),
                   substr(name,start=1,stop=1), sep="")
alldislist <- c(dfun,pfun,qfun,fun)
# generate d 
eval(dummy <- cens.d(family = fname, type = type, ...))
eval(call("<-",as.name(dfun),dummy), envir=parent.frame(n = 1))
# generate p
eval(dummy <- cens.p(par, family = fname, type = type, ...))
eval(call("<-",as.name(pfun),dummy), envir=parent.frame(n = 1))
# generate q
eval(dummy <- cens.q(par, family = fname, type = type, ...))
eval(call("<-",as.name(qfun),dummy), envir=parent.frame(n = 1))   
# generate the fitting distribution
eval(dummy <- cens(family = fam, type = type, name=name, local=FALSE, ...))
eval(call("<-",as.name(fun),dummy), envir=parent.frame(n = 1))
  cat("A censored family of distributions from",  fname, 
      "has been generated \n", "and saved under the names: ", 
      "\n",paste(alldislist, sep=","),"\n")#
  cat("The type of censoring is", type,  " \n") 
 }
################################################################################
################################################################################
################################################################################
################################################################################
# this is a dummy function to be able to generate a quantile function
# needed if centiles are to be form from a given fitted model 
cens.q <-function(family = "NO", ...)
  {
    fname <- family
   if (mode(family) != "character" && mode(family) != "name")
    fname <- as.character(substitute(family))
     qfun <- paste("q",fname,sep="")
   invcdf <- eval(parse(text=qfun))
   invcdf
  }
################################################################################
################################################################################
################################################################################
################################################################################