R devel - May 2013 - making makepredictcall() work

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().

Any pointers on how to resolve this will be highly appreciated.

Thanks in advance.

Best,
Dimitris


-- 
Dimitris Rizopoulos
Assistant Professor
Department of Biostatistics
Erasmus University Medical Center

Address: PO Box 2040, 3000 CA Rotterdam, the Netherlands
Tel: +31/(0)10/7043478
Fax: +31/(0)10/7043014
Web: http://www.erasmusmc.nl/biostatistiek/

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