[Rd] package NAMESPACE question
Hervé Pagès
hpages at fhcrc.org
Tue Jan 28 22:43:21 CET 2014
Hi Alex,
On 01/28/2014 03: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"
All I see is that trt *is* used by the user here (even if it's going
to be evaluated latter, that doesn't change anything). So it should
be exported and documented. Otherwise, how, as a user, does it make
sense for me to make reference in my own code to a symbol that is no
visible and has no documented meaning?
Not everybody will agree e.g. the designer of the table() interface
had no problem setting the default value for the 'dnn' arg to an
expression that makes no sense from a user point of view (can't
evaluate it, can't see the code, ?list.names doesn't work).
Cheers,
H.
>
> 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
>
--
Hervé Pagès
Program in Computational Biology
Division of Public Health Sciences
Fred Hutchinson Cancer Research Center
1100 Fairview Ave. N, M1-B514
P.O. Box 19024
Seattle, WA 98109-1024
E-mail: hpages at fhcrc.org
Phone: (206) 667-5791
Fax: (206) 667-1319
More information about the R-devel
mailing list