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.
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.
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.
Thanks in advance.
Yves Gauvreau
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
>>>>> "Yves" == Yves Gauvreau <cyg at sympatico.ca> writes:> 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.> 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.> 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.Try the following. fold.fun <- function(b, f, name.var = x) { if (length(b) == 0) return(1) name.var <- substitute(name.var) if (is.character(name.var)) name.var <- as.name(name.var) fun <- quote((f)) fun[[2]] <- substitute(f) ans <- quote(u*y) ans[[2]] <- b[length(b)] ans[[3]] <- namevec for (i in seq(length = length(b)-1)) { ans1 <- quote(u * y * f(v)) ans1[[2]][[2]] <- b[i] ans1[[2]][[3]] <- name.var ans1[[3]][[1]] <- fun ans1[[3]][[2]] <- ans ans <- ans1 } ans } You use it as in -> fold.fun(1:2, exp)1 * x * (exp)(2 * x)> fold.fun(1:2, exp, y)1 * y * (exp)(2 * y) Hope this helps. Saikat -- Department of Statistics Email: saikat at stat.wisc.edu University of Wisconsin - Madison Phone: (608) 263 5948 1210 West Dayton Street Fax: (608) 262 0032 Madison, WI 53706-1685 -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- 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 _._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
> 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: 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 _._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._