package NAMESPACE question

-----Original Message-----
From: r-devel-bounces at r-project.org [mailto:r-devel-bounces at r-project.org] On Behalf
Of Axel Urbiz
Sent: Tuesday, January 28, 2014 3:33 AM
To: Henrik Bengtsson
Cc: r-devel
Subject: Re: [Rd] package NAMESPACE question

Hi,

I've tried to put together a simpler example where I'm having the issue.

I've built a foo package by only including a single .R file with the two
functions listed below: trt and cmt. The second function calls the first.
In the namespace file, if I only export(cmt), I get the following error
message when running this

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 could not find function "trt"

The problem is solved by doing export(cmt, trt) in the namespace. However,
I'd like to avoid exporting trt and should not be required. Sorry I can't
seem to figure this out by myself, and so I'd appreciate your help.

Thanks,
Axel.

----

#mycodefiles <- c("cmt.R")
#package.skeleton(name = "foo", code_files = mycodefiles)
#promptPackage("foo")

#where cmt.R includes the code below:

trt <- function(x) x

cmt <- function(formula, data, subset, na.action = na.pass)  {

  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("model.frame")
  special <- "trt"
  mt <- if(missing(data)) terms(formula, special) else terms(formula,
special, data = data)
  browser()
  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)]
  x <- model.matrix(terms(reformulate(var_names)),
                    mf, contrasts)
  intercept <- which(colnames(x) == "(Intercept)")
  if (length(intercept > 0)) x <- x[, -intercept]
  return(x)
  }




On Mon, Jan 27, 2014 at 2:42 AM, Henrik Bengtsson <hb at biostat.ucsf.edu>wrote:

On Sun, Jan 26, 2014 at 6:34 AM, Axel Urbiz <axel.urbiz at gmail.com> 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.

As a start, try to export everything, particularly 'contr.none' and
'contr.diff' and see if that works.  Just a guess, but worth trying
out.

My $.02

/Henrik

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

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("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>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

        [[alternative HTML version deleted]]

	[[alternative HTML version deleted]]