From ripley at stats.ox.ac.uk  Tue May 21 18:20:08 2013
From: ripley at stats.ox.ac.uk (Prof Brian Ripley)
Date: Tue, 21 May 2013 17:20:08 +0100
Subject: [Rd] making makepredictcall() work
In-Reply-To: <7191AFC7255B4F49A30707E39BEAD05F3C5FFFA1@EXCH-RX03.erasmusmc.nl>
References: <7191AFC7255B4F49A30707E39BEAD05F3C5FFFA1@EXCH-RX03.erasmusmc.nl>
Message-ID: <519B9EB8.3030407@stats.ox.ac.uk>

On 21/05/2013 12:19, D. Rizopoulos wrote:
> Dear All,
>
> I'm interested in creating a function similar to ns() from package
> splines that can be passed in a model formula. The idea is to produce
> "safe" predictions from a model using this function. As I have seen, to
> do this I need to use makepredictcall(). Consider the following toy example:
>
> myns <- function (x, df = NULL, knots = NULL, intercept = FALSE,
> Boundary.knots = range(x),
>                      extraArg = 0) {
>       ns.x <- if (is.null(knots)) {
>           ns(x, df = df, intercept = intercept, Boundary.knots =
> Boundary.knots)
>       } else {
>           ns(x, knots = knots, intercept = intercept, Boundary.knots =
> Boundary.knots)
>       }
>       out <- ns.x + extraArg
>       attr(out, "class") <- c("myns", "basis", "matrix")
>       out
> }
>
> makepredictcall.myns <- function (var, call) {
>       # based on splines:::makepredictcall.ns
>       if (as.character(call)[1L] != "myns")
>           return(call)
>       at <- attributes(var)[c("knots", "Boundary.knots", "intercept",
> "extraArg")]
>       xxx <- call[1L:2L]
>       xxx[names(at)] <- at
>       xxx
> }
>
> dd <- data.frame(y = rnorm(12))
> terms(model.frame(terms(~ myns(y, df = 3, extraArg = 0.5)), data = dd))
>
> As it can be seen, makepredictcall.myns() succeeds in correctly passing
> the knots and Boundary.knots from the original data in the "predvars"
> attribute of the terms objects but it does not work for the new argument
> 'extraArg' I introduced in myns().

Well, you did not set that attribute in myns(), but you looked for it. 
I guess you intended

myns <- function (x, df = NULL, knots = NULL, intercept = FALSE,
Boundary.knots = range(x),
                     extraArg = 0) {
      ns.x <- if (is.null(knots)) {
          ns(x, df = df, intercept = intercept, Boundary.knots =
Boundary.knots)
      } else {
          ns(x, knots = knots, intercept = intercept, Boundary.knots =
Boundary.knots)
      }
      out <- ns.x + extraArg
      attr(out, "extraArg") <- extraArg
      attr(out, "class") <- c("myns", "basis", "matrix")
      out
}



>
> Any pointers on how to resolve this will be highly appreciated.
>
> Thanks in advance.
>
> Best,
> Dimitris
>
>


-- 
Brian D. Ripley,                  ripley at stats.ox.ac.uk
Professor of Applied Statistics,  http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595



[Rd] making makepredictcall() work
Prof Brian Ripley