Thanks for all your help on this Duncan. Much appreciated!
Regards
Axel
On Tuesday, January 28, 2014, Duncan Murdoch <murdoch.dun...@gmail.com>
wrote:
> 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 <h...@biostat.ucsf.edu
>> <mailto:h...@biostat.ucsf.edu>> wrote:
>>
>> On Sun, Jan 26, 2014 at 6:34 AM, Axel Urbiz <axel.ur...@gmail.com
>> <mailto:axel.ur...@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.dun...@gmail.com <mailto:murdoch.dun...@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@r-project.org <mailto:R-devel@r-project.org> mailing list
>> > https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>>
>>
>
[[alternative HTML version deleted]]
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
