[R] Function to Define a Function

[Martin Maechler]

>>>>> Gabor Grothendieck <ggrothendieck at gmail.com>
>>>>>     on Mon, 9 Aug 2010 23:20:18 -0400 writes:

    > On Mon, Aug 9, 2010 at 9:31 PM, Derek Ogle <DOgle at northland.edu> wrote:

    >> I am trying to define a general R function that has a
    >> function as the output that depends on the user's input
    >> arguments (this may make more sense by looking at the toy
    >> example below).  My real use for this type of code is to
    >> allow a user to choose from many parameterizations of the
    >> same general model.

    >> 
    >> My "issue" is that when I compile a package with this
    >> type of code in it I get a __warning__ that "multiple local
    >> function definitions for 'm' with different formal
    >> arguments."  While this is not a "deadly error" I would like
    >> to avoid the warning if possible.  Can someone provide some
    >> guidance? 
    >> Thank you in advance for any help you can offer.
    >> 
    >> For what it is worth ... I am working on a Windows XP machine with R 2.11.1.
    >> 
    >> 

    >> ## A function that allows the user to create a new function that depends on their
    >> ##   choice in the type argument.  As a simple example, if the user chooses "one"
    >> ##   then the output function is exponential growth, if the user choses "two" then
    >> ##   thhe output function is logistic growth.
    >> 
    >> mdlChooser <- function(type=c("one","two")) {
    >>  type <- match.arg(type)
    >>  switch(type,
    >>    one={ m <- function(x,N0,r) N0*exp(x*r) },
    >>    two={ m <- function(x,N0,r,K) (N0*K)/(N0+(K-N0)*exp(-x*r)) },
    >>  )
    >>  m
    >> }
    >> 
    >> ## define time steps
    >> t <- 0:10
    >> 
    >> ## create a function -- junk1 -- that produces exponential growth
    >> junk1 <- mdlChooser("one")
    >> junk1
    >> res1 <- junk1(t,500,0.2)
    >> res1
    >> 
    >> ## create a function -- junk2 -- that produces logistic growth
    >> junk2 <- mdlChooser("two")
    >> junk2
    >> res2 <- junk2(t,500,0.2,1000)
    >> res2
    >> 


    > Try this:

    > mdlChooser <- function(type = c("one", "two")) {
    > one <- function(x,N0,r) N0*exp(x*r)
    > two <- function(x,N0,r,K) (N0*K)/(N0+(K-N0)*exp(-x*r))
    > type <- match.arg(type)
    > get(type)
    > }

or a bit more elegantly, I think,

mdlChooser <- function(type=c("one","two")) {
  switch(match.arg(type),
    one= function(x,N0,r) N0*exp(x*r),
    two= function(x,N0,r,K) (N0*K)/(N0+(K-N0)*exp(-x*r))
  )
}

which just leaves away some unnecessary code from Derek's
original code (and here you could even drop the last "{ .. }"
pair).

Martin Maechler, ETH Zurich