[Rd] returning information from functions via attributes rather than return list

From: Paul Johnson <pauljohn32_at_gmail.com>
Date: Tue, 03 Jan 2012 14:08:14 -0600


I would like to ask for advice from R experts about the benefits or dangers of using attr to return information with an object that is returned from a function. I have a feeling as though I have cheated by using attributes, and wonder if I've done something fishy.

Maybe I mean to ask, where is the dividing line between attributes and instance variables? The separation is not clear in my mind anymore.

Background: I paste below a function that takes in a regression object and make changes to the data and/or call and then run a revised regression. In my earlier effort, I was building a return list, including the new fitted regression object plus some variables that have information about the changes that a were made.

That creates some inconvenience, however. When the regression is in a list object, then methods for lm objects don't apply to that result object. The return is not an lm anymore. I either need to write custom methods for every function or remember to extract the object from the list before sending to the generic function.

I *guessed* it would work to write the new information as object attributes, and it seems to work. There is a generic function "meanCenter" and a method "meanCenter.default". At the end of meanCenter.default, here's my use (or abuse) of attributes.

  res <- eval(mc)
  class(res) <- c("mcreg", class(model))   attr(res, "centeredVars") <- nc
  attr(res, "centerCall") <- match.call()   res

I wrote print and summary methods, but other methods that work for lm objects like plot will also work for these new ones.

meanCenter <- function(model, centerOnlyInteractors=TRUE, centerDV=FALSE, standardize=FALSE, centerContrasts = F){   UseMethod("meanCenter")
}

meanCenter.default <- function(model, centerOnlyInteractors=TRUE, centerDV=FALSE, standardize=FALSE, centerContrasts = F){

  std <- function(x) {
    if( !is.numeric(x) ){
      stop("center.lm tried to center a factor variable. No Can Do!")
} else {

      scale(x, center = TRUE, scale = standardize)
}

  }

  rdf <- get_all_vars(formula(model), model$model) #raw data frame   t <- terms(model)
  tl <- attr(t, "term.labels")
  tmdc <- attr(t, "dataClasses") ##term model data classes

  isNumeric <- names(tmdc)[ which(tmdc %in% c("numeric"))]   isFac <- names(tmdc)[ which(tmdc %in% c("factor"))]   if (tmdc[1] != "numeric") stop("Sorry, DV not a single numeric column")

  ##Build "nc", a vector of variable names that "need centering"   ##
  if (!centerDV) {
    if (centerOnlyInteractors == FALSE){

      nc <- isNumeric[-1] #-1 excludes response
      unique(nc)

}else{
interactTerms <- tl[grep(":", tl)] nc <- unique(unlist(strsplit( interactTerms, ":"))) nc <- nc[which(nc %in% isNumeric)]

}

  }else{
    if (centerOnlyInteractors == FALSE){       nc <- isNumeric
}else{
      interactTerms <- tl[grep(":", tl)]
      nc <- unique(unlist(strsplit( interactTerms, ":")))
      nc <- nc[which(nc %in% isNumeric)]
      nc <- c( names(tmdc)[1] , nc)

}

  }

  mc <- model$call
  # run same model call, replacing non centered data with centered data.   ## if no need to center factor contrasts:   if (!centerContrasts)
    {

      stddat <- rdf
      for (i in nc) stddat[ , i] <- std( stddat[, i])
      mc$data <- quote(stddat)

}else{
##dm: design matrix, only includes intercept and predictors dm <- model.matrix(model, data=rdf, contrasts.arg = model$contrasts, xlev = model$xlevels) ##contrastIdx: indexes of contrast variables in dm contrastIdx <- which(attr(dm, "assign")== match(isFac, tl)) contrastVars <- colnames(dm)[contrastIdx] nc <- c(nc, contrastVars) dm <- as.data.frame(dm) hasIntercept <- attr(t, "intercept") if (hasIntercept) dm <- dm[ , -1] # removes intercept, column 1 dv <- rdf[ ,names(tmdc)[1]] #tmdc[1] is response variable name dm <- cbind(dv, dm) colnames(dm)[1] <- names(tmdc)[1] #put colname for dv dmnames <- colnames(dm) hasColon <- dmnames[grep(":", dmnames)] dm <- dm[ , -match(hasColon, dmnames)] ##remove vars with colons
(lm will recreate)
      ##Now, standardise the variables that need standardizing
      for (i in nc) dm[ , i] <- std( dm[, i])


      fmla <- formula(paste(dmnames[1], " ~ ",  paste(dmnames[-1],
collapse=" + ")))
      cat("This fitted model will use those centered variables\n")
      cat("Model-constructed interactions such as \"x1:x3\" are built
from centered variables\n")
      mc$formula <- formula(fmla)
      mc$data <-  quote(dm)

}

  cat("These variables", nc, "Are centered in the design matrix \n")

  res <- eval(mc)
  class(res) <- c("mcreg", class(model))   attr(res, "centeredVars") <- nc
  attr(res, "centerCall") <- match.call()   res
}

summary.mcreg <- function(object, ...){
  nc <- attr(object, "centeredVars")
  cat("The centered variables were: \n")   print(nc)
  cat("Even though the variables here have the same names as their non-centered counterparts, I assure you these are centered.\n")   mc <- attr(object, "centerCall")
  cat("These results were produced from: \n")   print(mc)
  NextMethod(generic = "summary", object = object, ...) }

print.mcreg <- function(x, ...){
  nc <- attr(x, "centeredVars")
  cat("The centered variables were: \n")   print(nc)
  cat("Even though the variables here have the same names as their non-centered counterparts, I assure you these are centered.\n")   mc <- attr(x, "centerCall")
  cat("These results were produced from: \n")   print(mc)
  NextMethod(generic = "print", object = x, ...) }

-- 
Paul E. Johnson
Professor, Political Science
1541 Lilac Lane, Room 504
University of Kansas

______________________________________________
R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Received on Tue 03 Jan 2012 - 20:16:35 GMT

This quarter's messages: by month, or sorted: [ by date ] [ by thread ] [ by subject ] [ by author ]

All messages

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Wed 04 Jan 2012 - 12:50:06 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.

list of date sections of archive