[Rd] package NAMESPACE question
Duncan Murdoch
murdoch.duncan at gmail.com
Tue Jan 28 13:15:24 CET 2014
On 14-01-28 6:32 AM, Axel Urbiz wrote:
> 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.
You are asking for non-standard evaluation of the formula argument. You
want some parts of it to be evaluated in the global environment (f),
some parts in the dd dataframe (x), and some parts evaluated in the
package namespace (trt). R is flexible so this is possible, but it's
not the way that the terms function works, so you'll need to do more
work yourself, including specifying what the evaluation rules should be
in case a variable occurs in more than one of those locations.
Duncan Murdoch
>
> 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 <http://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
> <mailto:hb at biostat.ucsf.edu>> wrote:
>
> On Sun, Jan 26, 2014 at 6:34 AM, Axel Urbiz <axel.urbiz at gmail.com
> <mailto: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 <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
> >>
> >>
> >
> > [[alternative HTML version deleted]]
> >
> > ______________________________________________
> > R-devel at r-project.org <mailto:R-devel at r-project.org> mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-devel
>
>
More information about the R-devel
mailing list