R/evalCall.R

In PredictABEL: Assessment of risk prediction models

## The following function was copied from the PBSmodelling R
## package version 2.64 (downloaded on 2012-08-01 from SVN:
## http://pbs-modelling.googlecode.com/svn/trunk).
## The PBSModelling package is has a GPL v2 (or higher) licence
## according to the DESCRIPTION file, so we can use this copy without
## problem.
##
## Since this is the only part of PBSmodelling PredictABEL depends on,
## this is the smartest way to remove the PBSmodelling dependency
## (which itself drags in TCL/TK and other deps at the OS level.)
##
## 2012-08-02 L.C. Karssen.


##================================================|
##                 PBS Modelling                  |
## Support functions (in alphabetic order)--------|
## Authors:                                       |
##  Jon T. Schnute <Jon.SchnuteJ@dfo-mpo.gc.ca>   |
##  Alex Couture-Beil <alex@mofo.ca>              |
##  Rowan Haigh <Rowan.HaighR@dfo-mpo.gc.ca>      |
##  Anisa Egeli <>                                |
##================================================|
#
##evalCall-------------------------------2009-03-03
## Evaluates a function call, resolving conflicting arguments.
##-----------------------------------------------RH
evalCall=function(fn,argu,...,envir=parent.frame(),checkdef=FALSE,checkpar=FALSE){
        fnam=as.character(substitute(fn))
        fnam.def=paste(fnam,"default",sep=".")
        base=formals(fnam)
        if (checkdef && exists(fnam.def)) {
                defs=formals(fnam.def)
                udefs=defs[setdiff(names(defs),names(base))]
                base=c(base,udefs) }
        base=base[setdiff(names(base),"...")]
        if (checkpar) {
                pars=par(); pars=pars[setdiff(names(pars),names(base))] # use only pars not in base
                forms=c(base,pars) } # all possible formal arguments
        else forms=base
#if (fnam=="axis") {browser();return()}
        #forms=NULL
        #for (i in names(base)) forms[[i]]=get(i,envir=envir)
        dots=list(...)
        argus=argu[setdiff(names(argu),names(dots))]
        given=c(argus,dots)
        allow=given[intersect(names(given),names(forms))]
        strargs=sapply(allow,deparse,width.cutoff=500,simplify=FALSE)
        strargs=sapply(strargs,paste,collapse="",simplify=FALSE) # collapse multiple strings
        argspec=character(0)
        for (i in names(strargs)) argspec=c(argspec,paste(i,"=",strargs[[i]]))
        expr=paste(fnam,"(",paste(argspec,collapse=","),")",sep="")
        eval(parse(text=expr))
        invisible(expr) }
#-----------------------------------------evalCall