[R] Folding ?
Yves Gauvreau
cyg at sympatico.ca
Mon Sep 25 14:08:57 CEST 2000
----- 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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list