[Rd] package NAMESPACE question

[Duncan Murdoch]

On 14-01-26 9:34 AM, Axel Urbiz wrote:> Hi Duncan,
 >
 > My most sincere apologies. It's really not my intention to waste anyones
 > time. More the opposite...for some reason I thought that the problem had
 > to do with my call to options() and thought that would be enough. Here's
 > something reproducible:
 >
 > I built a foo package based on the code under the "----" below. In the
 > namespace file, I've only exported: trt and cmt (not contr.none and
 > contr.diff). Notice that cmt calls contr.none and contr.diff by default.
 >
 > Then in R, I run this code and I get this error message:
 >
 > library(foo)
 > set.seed(1)
 > dd <- data.frame(y = rbinom(100, 1, 0.5), treat = rbinom(100, 1, 0.5), x
 > = rnorm(100),
 >                           f = gl(4, 250, labels = c("A", "B", "C", "D")))
 > dd2 <- cmt(y ~ x + f + trt(treat), data =dd)
 >  > Error in get(ctr, mode = "function", envir = parent.frame()) :
 >     object 'contr.none' of mode 'function' was not found

In your call to model.matrix in cmt, you pass "contrasts" without 
defining it.  This looks like an error, though it wouldn't cause the 
message you saw, it's likely it would cause some strange problem.

I haven't tried putting your code in a package to see what difference 
that makes.  It's your job to make a reproducible example, not mine.

Duncan Murdoch


 >
 > Thanks,
 > Axel.
 >
 > --------------------------------------------
 >
 > trt <- function(x) x
 >
 > cmt <- function(formula, data, subset, na.action = na.pass, cts = 
TRUE)  {
 >    if (!inherits(formula, "formula"))
 >      stop("Method is only for formula objects.")
 >    mf <- match.call(expand.dots = FALSE)
 >    args <- match(c("formula", "data", "subset", "na.action"),
 >                  names(mf), 0)
 >    mf <- mf[c(1, args)]
 >    mf$drop.unused.levels <- TRUE
 >    mf[[1]] <- as.name <http://as.name>("model.frame")
 >    special <- "trt"
 >    mt <- if(missing(data)) terms(formula, special) else terms(formula,
 > special, data = data)
 >    mf$formula <- mt
 >    mf <- eval.parent(mf)
 >    Terms <- attr(mf, "terms")
 >    attr(Terms, "intercept") <- 0
 >    trt.var <- attr(Terms, "specials")$trt
 >    ct <- mf[, trt.var]
 >    y <- model.response(mf, "numeric")
 >    var_names <- attributes(Terms)$term.labels[-(trt.var-1)]
 >    treat.names <- levels(as.factor(ct))
 >    oldcontrasts <- unlist(options("contrasts"))
 >    if (cts)
 >      options(contrasts = c(unordered = "contr.none", ordered =
 > "contr.diff"))
 >    x <- model.matrix(terms(reformulate(var_names)),
 >                      mf, contrasts)
 >    options(contrasts = oldcontrasts)
 >    intercept <- which(colnames(x) == "(Intercept)")
 >    if (length(intercept > 0)) x <- x[, -intercept]
 >    return(x)
 >    }
 > #######################################
 > # An alternative contrasts function for unordered factors
 > # Ensures symmetric treatment of all levels of a factor
 > #######################################
 > contr.none <- function(n, contrasts) {
 >    if (length(n) == 1)
 >      contr.treatment(n, contrasts = n<=2)
 >    else
 >      contr.treatment(n, contrasts = length(unique(n))<=2)
 > }
 >
 > #######################################
 > # An alternative contrasts function for ordered factors
 > # Ensures use of a difference penalty for such factors
 > #######################################
 > contr.diff <- function (n, contrasts = TRUE)
 > {
 >    if (is.numeric(n) && length(n) == 1) {
 >      if (n > 1)
 >        levs <- 1:n
 >      else stop("not enough degrees of freedom to define contrasts")
 >    }
 >    else {
 >      levs <- n
 >      n <- length(n)
 >    }
 >    contr <- array(0, c(n, n), list(levs, paste(">=", levs, sep="")))
 >    contr[outer(1:n,1:n, ">=")] <- 1
 >    if (n < 2)
 >      stop(gettextf("contrasts not defined for %d degrees of freedom",
 >                    n - 1), domain = NA)
 >    if (contrasts)
 >      contr <- contr[, -1, drop = FALSE]
 >    contr
 > }
 >
 >
 >
 > On Sun, Jan 26, 2014 at 1:21 PM, Duncan Murdoch
 > <murdoch.duncan at gmail.com <mailto:murdoch.duncan at gmail.com>> wrote:
 >
 >     On 14-01-25 6:05 PM, Axel Urbiz wrote:
 >
 >         Thanks again all. Essentially, this is the section of the code
 >         that is
 >         causing trouble. This is part of the (exported) function 
which calls
 >         contr.none (not exported). As mentioned, when I call the
 >         exported function
 >         it complains with the error described before.
 >
 >
 >             oldcontrasts <- unlist(options("contrasts"))
 >               if (cts)
 >                   options(contrasts = c(unordered = "contr.none", 
ordered =
 >         "contr.diff"))
 >               x <- model.matrix(terms(__reformulate(var_names)), mf,
 >         contrasts)
 >               options(contrasts = oldcontrasts)
 >
 >
 >     This is hugely incomplete.  Please stop wasting everyone's time, and
 >     post something reproducible.
 >
 >     Duncan Murdoch
 >
 >