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 <h...@biostat.ucsf.edu>wrote:

On Sun, Jan 26, 2014 at 6:34 AM, Axel Urbiz <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("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>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 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


--
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: hpa...@fhcrc.org
Phone:  (206) 667-5791
Fax:    (206) 667-1319

______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to