R/optim_fad.r

Defines functions optim_fad create_share

create_share <- function(fun_grad) {
  env <- new.env()
  env$xold <- NULL
  env$fun <- function(x) {
    if (is.null(env$xold) || any(env$xold != x)) {
      out <- fun_grad(x)
      env$xold <- x
      env$fun_val <- out[[1]]
      env$grad_val <- out[[2]]
    }
    env$fun_val
  }
  env$grad <- function(x = NULL) {
    if (is.null(env$xold) || any(env$xold != x)) {
      out <- fun_grad(x)
      env$xold <- x
      env$fun_val <- out[[1]]
      env$grad_val <- out[[2]]
    }
    env$grad_val
  }
  env
}

optim_fad <- function(par, fngr, ...) {
  env <- create_share(fngr)
  optim(par=par, fn=env$fun, gr=env$grad, ...)
}

Try the fad package in your browser

Any scripts or data that you put into this service are public.

fad documentation built on May 1, 2022, 5:08 p.m.