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 <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
