[R] Folding ?

[Yves Gauvreau]

----- Original Message -----
From: "Bill Venables" <William.Venables at cmis.CSIRO.AU>
To: "Yves Gauvreau" <cyg at sympatico.ca>
Cc: <r-help at stat.math.ethz.ch>; <Bill.Venables at cmis.csiro.au>
Sent: Monday, September 25, 2000 3:12 AM
Subject: Re: [R] Folding ?


> > Hi,
> >
> > I need to write a function that would look something like this:
> >
> >  S <- function(b=betas){
> >      expression(b[1] * f(b[2] * x * f(b[3] * x * f(...b[n-1] * x *
f(b[n] *
> > x)))...)
> > }
> >
> > Where n is the number of element in b.
>
> I see Saikat Debroy has already responded to this, but here is
> (possibly) a simpler version.  It is a function that returns a list of
> two functions, one of which is S as above (assuming the leading part
> is missing an "x") and the other of which is the derivative, dS/dx:
>

No, "x" is not missing. I double check and from 2 different source beside
that. I checked out an idea while waiting and I came up with this:

makeS <- function(b){
  txt <- "1"
  for(i in length(b):2){
    txt <- paste("exp(", b[i], " * x * ", txt, ")", sep="")
  }
  txt <- paste(b[1], " * ", txt, sep="")
  as.expression(parse(text=txt))
}

It seems to work, I think though, it's not as elegant as yours and it shows
a non functional approach.
I can modify your function to account for the added "x".

Thanks to all

Yves Gauvreau



> makeS <- function(b, f) {
>   f <- deparse(substitute(f))
>   b <- rev(b)
>   ex <- call("*", b[1], as.name("x"))
>   b <- b[-1]
>   while(length(b) > 0) {
>     ex <- call("*", b[1],
>                call("*", as.name("x"),
>                     call(f, ex)))
>     b <- b[-1]
>   }
>   S <- function(x) NULL
>   body(S) <- ex
>   dS <- function(x) NULL
>   body(dS) <- D(ex, "x")
>   list(S = S, dS = dS)
> }
>
> Here is a small example:
>
> > makeS(5:1, sqrt)
> $S
> function (x)
> 5 * x * sqrt(4 * x * sqrt(3 * x * sqrt(2 * x * sqrt(1 * x))))
> <environment: 678810>
>
> $dS
> function (x)
> 5 * (sqrt(4 * (x * sqrt(3 * (x * sqrt(2 * (x * sqrt(1 * x))))))) +
>     x * (0.5 * (4 * (sqrt(3 * (x * sqrt(2 * (x * sqrt(1 * x))))) +
>         x * (0.5 * (3 * (sqrt(2 * (x * sqrt(1 * x))) + x * (0.5 *
>             (2 * (sqrt(1 * x) + x * (0.5 * 1 * x^-0.5)) * 2 *
>                 (x * sqrt(1 * x))^-0.5))) * 3 * (x * sqrt(2 *
>             (x * sqrt(1 * x))))^-0.5))) * 4 * (x * sqrt(3 * (x *
>         sqrt(2 * (x * sqrt(1 * x))))))^-0.5)))
> <environment: 678810>
>
> You could probably do it a little more cleverly if you closures but
> you would not be able to read the functions you get very well.
>
> > Further I need to be able to evaluate S at some x numerically of course
and
> > I need to use "deriv" and produce dS/dx such that I can evaluate it also
at
> > some x.
>
> > ms <- makeS(5:1, sqrt)
> > S <- ms[[1]]
> > S(1:10)
>  [1]   14.352   54.974  120.596  210.572  324.462  461.931
>  [7]  622.711  806.577 1013.337 1242.822
> > dS <- ms[[2]]
> > dS(1:10)
>  [1]  27.807  53.256  77.885 101.996 125.729 149.165 172.358
>  [8] 195.343 218.149 240.797
>
> > I tried building the S expression manually to test the deriv (D)
function,
> > evaluate them both and everything work's fine.
> >
> > My trouble is automating the building of the expression S that is
dependent
> > on the length of b.
> >
> > Any suggestion are welcome.
>
> Use a loop.
>
> Bill Venables.
> --
> Bill Venables,      Statistician,     CMIS Environmetrics Project
> CSIRO Marine Labs, PO Box 120, Cleveland, Qld,  AUSTRALIA.   4163
> Tel: +61 7 3826 7251           Email: Bill.Venables at cmis.csiro.au
> Fax: +61 7 3826 7304      http://www.cmis.csiro.au/bill.venables/
>
>
>

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._