tensor_predictors/tensorPredictors/R/num_deriv.R

37 lines
999 B
R

#' Numeric differentiation
#'
#' @example inst/examples/num_deriv.R
#'
#' @export
num.deriv <- function(F, X, h = 1e-6, sym = FALSE) {
if (sym) {
stopifnot(isSymmetric(X))
p <- nrow(X)
k <- seq_along(X) - 1
mapply(function(i, j) {
dx <- h * ((k == i * p + j) | (k == j * p + i))
(F(X + dx) - F(X - dx)) / (2 * h)
}, .row(dim(X)) - 1, .col(dim(X)) - 1)
} else {
sapply(seq_along(X), function(i) {
dx <- h * (seq_along(X) == i)
(F(X + dx) - F(X - dx)) / (2 * h)
})
}
}
#' Second numeric derivative
#'
#' @export
num.deriv2 <- function(F, X, Y, h = 1e-6, symX = FALSE, symY = FALSE) {
if (missing(Y)) {
num.deriv(function(x) {
num.deriv(function(z) F(z), x, h = h, sym = symX)
}, X, h = h, sym = symX)
} else {
num.deriv(function(y) {
num.deriv(function(x) F(x, y), X, h = h, sym = symX)
}, Y, h = h, sym = symY)
}
}