[Rd] package NAMESPACE question

Duncan Murdoch murdoch.duncan at gmail.com
Tue Jan 28 21:08:52 CET 2014


On 28/01/2014 2:43 PM, William Dunlap wrote:
> [inline below]
>
> Bill Dunlap
> TIBCO Software
> wdunlap tibco.com
>
>
> > -----Original Message-----
> > From: Duncan Murdoch [mailto:murdoch.duncan at gmail.com]
> > Sent: Tuesday, January 28, 2014 10:45 AM
> > To: William Dunlap; Axel Urbiz; Henrik Bengtsson
> > Cc: r-devel
> > Subject: Re: [Rd] package NAMESPACE question
> >
> > On 28/01/2014 12:15 PM, William Dunlap wrote:
> > > You can more or less get what you want by reassigning the environment
> > > of the formula to be a child of its original environment, where you put
> > > your private functions in the new environment.  For example, do not
> > > export trt and make the following change to your R code:
> > >
> > > % diff -u foo/R/cmt.R~ foo/R/cmt.R
> > > --- foo/R/cmt.R~        2014-01-28 09:10:58.272711000 -0800
> > > +++ foo/R/cmt.R 2014-01-28 09:09:06.299398000 -0800
> > > @@ -1,9 +1,12 @@
> > > -trt <- function(x) x
> > > +trt <- function(x) { cat("Calling foo:::trt\n"); x }
> > >
> > >   cmt <- function(formula, data, subset, na.action = na.pass)  {
> > >
> > >     if (!inherits(formula, "formula"))
> > >       stop("Method is only for formula objects.")
> > > +  intercalatedEnvir <- new.env(parent=environment(formula))
> > > +  intercalatedEnvir$trt <- trt
> > > +  environment(formula) <- intercalatedEnvir
> > >     mf <- match.call(expand.dots = FALSE)
> > >     args <- match(c("formula", "data", "subset", "na.action"),
> > >                   names(mf), 0)
> >
> > I'm not so sure this is the right solution.  This means that if users
> > have their own function named trt, the one in the namespace will take
> > precedence.  In most cases users don't want that.
>
> But that is how an unexported function in a package works: the user's
> own functions cannot mask it.  The odd requirement is that the package
> writer wants the user to explicitly use this function, trt, but for some reason
> does not want to export it.

Yes, but the convention is that if it is not exported, then it is not 
usually visible to users.
>
> package:dplyr does this sort of thing as well: it exports an 'n' function
> which does different things than the 'n' function you use in calls to dplyr
> functions.

Another exception is in my own tables package:  there are things there 
that I call "pseudo-functions" (e.g. Format, Heading) that look like 
function calls but are treated specially, and take precedence over user 
functions of the same name.  I don't think I had a choice, but Axel does.

Duncan Murdoch

>     > summarise(group_by(mtcars, cyl), n(hp))
>     Source: local data frame [3 x 2]
>     
>       cyl n(hp)
>     1   6     7
>     2   4    11
>     3   8    14
>     > n(11:14)
>     Error in n(11:14) : unused argument (11:14)
>   
> > The problem is that in order to make the user one take precedence, you
> > could modify the parent of the environment of the formula, but that's
> > bad too (because it will have global effects since environments are
> > reference objects).
> >
> > I don't see a good solution here.  I would change the requirements.
> >
> > Duncan Murdoch
> > >
> > > Bill Dunlap
> > > TIBCO Software
> > > wdunlap tibco.com
> > >
> > >
> > > > -----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]]
> > > > > >
> > > > > > ______________________________________________
> > > > > > R-devel at r-project.org mailing list
> > > > > > https://stat.ethz.ch/mailman/listinfo/r-devel
> > > > >
> > > >
> > > > 	[[alternative HTML version deleted]]
> > > >
> > > > ______________________________________________
> > > > R-devel at r-project.org mailing list
> > > > https://stat.ethz.ch/mailman/listinfo/r-devel
> > >
> > > ______________________________________________
> > > R-devel at r-project.org mailing list
> > > https://stat.ethz.ch/mailman/listinfo/r-devel
>



More information about the R-devel mailing list