R help - Sep 2012 - how to pass a function to a function inside a function

Hi,

I'm trying to compile two functions into one function. the first funtion is
called 'fs' which is self-made function, another function is from the
built-in 'integration' function that is copy-paste-edited. If built
separatey, these functions work well. However that is not the case if
combines together, where certainly I made mistake somewhere when
constructing the code.

can someone help point out the mistakes for me please?

Thanks!
Aehan

____________________

intgfun<- function(a,b,c,mu,alpha,xi,upper, ...,subdivisions = 100, rel.tol
= .Machine$double.eps^0.25,
    abs.tol = rel.tol, stop.on.error = TRUE, keep.xy = FALSE,
    aux = NULL)

{
x<-vector()
fs<-function(x){
temp<-(-xi^(-1))*log(1-xi*(x-mu)/alpha)

(((alpha^(-1))*(exp((-(1-xi)*temp)-exp(-temp))))*((a*(x-c)^0.5)+(b*(x-c))))
}
return(fs)

intgrt<-function(lower)
{
call(fs)
    fs <- match.fun(f)
    ff <- function(x) f(x, ...)
    limit <- as.integer(subdivisions)
    if (limit < 1 || (abs.tol <= 0 && rel.tol < max(50 *
.Machine$double.eps,
        5e-29)))
        stop("invalid parameter values")
    if (is.finite(lower) && is.finite(upper)) {
        wk <- .External("call_dqags", ff, rho = environment(),
            as.double(lower), as.double(upper), as.double(abs.tol),
            as.double(rel.tol), limit = limit, PACKAGE = "base")
    }
    else {
        if (is.na(lower) || is.na(upper))
            stop("a limit is missing")
        if (is.finite(lower)) {
            inf <- 1
            bound <- lower
        }
        else if (is.finite(upper)) {
            inf <- -1
            bound <- upper
        }
        else {
            inf <- 2
            bound <- 0
        }
        wk <- .External("call_dqagi", ff, rho = environment(),
            as.double(bound), as.integer(inf), as.double(abs.tol),
            as.double(rel.tol), limit = limit, PACKAGE = "base")
    }
    res <- wk[c("value", "abs.error",
"subdivisions")]
    res$message <- switch(wk$ierr + 1, "OK", "maximum number
of
subdivisions reached",
        "roundoff error was detected", "extremely bad integrand
behaviour",
        "roundoff error is detected in the extrapolation table",
        "the integral is probably divergent", "the input is
invalid")
    if (wk$ierr == 6 || (wk$ierr > 0 && stop.on.error))
        stop(res$message)
    res$call <- match.call()
    class(res) <- "integrate"
    res
}
return (intgrt)}

	[[alternative HTML version deleted]]

Hello,

Your function creates the vector 'x', then creates the function fs(), 
then returns the function just created. It _never_ reaches the line

     intgrt <- function(lower) {

and therefore never creates this last function. Now supposed it did. In 
the very end you make the same mistake, you simply return the function 
without ever calling it.

Hope this helps,

Rui Barradas

Em 25-09-2012 13:28, Al Ehan escreveu:
> Hi,
>
> I'm trying to compile two functions into one function. the first
funtion is
> called 'fs' which is self-made function, another function is from
the
> built-in 'integration' function that is copy-paste-edited. If built
> separatey, these functions work well. However that is not the case if
> combines together, where certainly I made mistake somewhere when
> constructing the code.
>
> can someone help point out the mistakes for me please?
>
> Thanks!
> Aehan
>
> ____________________
>
> intgfun<- function(a,b,c,mu,alpha,xi,upper, ...,subdivisions = 100,
rel.tol
> = .Machine$double.eps^0.25,
>      abs.tol = rel.tol, stop.on.error = TRUE, keep.xy = FALSE,
>      aux = NULL)
>
> {
> x<-vector()
> fs<-function(x){
> temp<-(-xi^(-1))*log(1-xi*(x-mu)/alpha)
>
> (((alpha^(-1))*(exp((-(1-xi)*temp)-exp(-temp))))*((a*(x-c)^0.5)+(b*(x-c))))
> }
> return(fs)
>
> intgrt<-function(lower)
> {
> call(fs)
>      fs <- match.fun(f)
>      ff <- function(x) f(x, ...)
>      limit <- as.integer(subdivisions)
>      if (limit < 1 || (abs.tol <= 0 && rel.tol < max(50 *
> .Machine$double.eps,
>          5e-29)))
>          stop("invalid parameter values")
>      if (is.finite(lower) && is.finite(upper)) {
>          wk <- .External("call_dqags", ff, rho =
environment(),
>              as.double(lower), as.double(upper), as.double(abs.tol),
>              as.double(rel.tol), limit = limit, PACKAGE = "base")
>      }
>      else {
>          if (is.na(lower) || is.na(upper))
>              stop("a limit is missing")
>          if (is.finite(lower)) {
>              inf <- 1
>              bound <- lower
>          }
>          else if (is.finite(upper)) {
>              inf <- -1
>              bound <- upper
>          }
>          else {
>              inf <- 2
>              bound <- 0
>          }
>          wk <- .External("call_dqagi", ff, rho =
environment(),
>              as.double(bound), as.integer(inf), as.double(abs.tol),
>              as.double(rel.tol), limit = limit, PACKAGE = "base")
>      }
>      res <- wk[c("value", "abs.error",
"subdivisions")]
>      res$message <- switch(wk$ierr + 1, "OK", "maximum
number of
> subdivisions reached",
>          "roundoff error was detected", "extremely bad
integrand behaviour",
>          "roundoff error is detected in the extrapolation table",
>          "the integral is probably divergent", "the input is
invalid")
>      if (wk$ierr == 6 || (wk$ierr > 0 && stop.on.error))
>          stop(res$message)
>      res$call <- match.call()
>      class(res) <- "integrate"
>      res
> }
> return (intgrt)}
>
> 	[[alternative HTML version deleted]]
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.