[Rd] package NAMESPACE question
Duncan Murdoch
murdoch.duncan at gmail.com
Tue Jan 28 19:44:48 CET 2014
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.
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