R/RcppExports.R

In dsfa: Distributional Stochastic Frontier Analysis

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

dcop_unrot_cpp <- function(u, v, p, distr, deriv_order, tri, logp) {
    .Call('_dsfa_dcop_unrot_cpp', PACKAGE = 'dsfa', u, v, p, distr, deriv_order, tri, logp)
}

dcop_cpp <- function(u, v, p, distr, rot, deriv_order, tri, logp) {
    .Call('_dsfa_dcop_cpp', PACKAGE = 'dsfa', u, v, p, distr, rot, deriv_order, tri, logp)
}

chainrule_bi <- function(f, g, tri, deriv_order) {
    .Call('_dsfa_chainrule_bi', PACKAGE = 'dsfa', f, g, tri, deriv_order)
}

#' Chainrule
#'
#' Chainrule for derivs objects.
#' 
#' @details Let \eqn{f_m} be a function defined in [trind()], where \eqn{m \in {1,...,M}}.
#' Define \eqn{h((x_{n1},x_{n2},...,x_{nK})) = f_1(\cdot) \circ f_2(\cdot) ... \circ f_M(x_{n1},x_{n2},...,x_{nK}))}.
#' In order to get the derivatives of \eqn{h(\cdot)} w.r.t all parameters \eqn{x_{nk}}, the chainrule is applied.
#' For more details see [trind()] and [trind_generator()].
#' 
#' @return Returns an object of class \code{derivs} for the function \eqn{h(\cdot)}.
#'
#' @inheritParams trind
#' @inheritParams list2derivs
#' @param f_list, list of \code{derivs} objects of length \eqn{M}, e.g. \eqn{list(f_1(\cdot), f_2(\cdot),...,f_M(\cdot))}
#' 
#' @examples 
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_derivs<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' B_derivs<-transform(A, type="exp", par=0, deriv_order=4)
#' C_derivs<-transform(B_derivs, type="log", par=0, deriv_order=4)
#' chainrule(list(C_derivs, B_derivs), trind_generator(1), deriv_order=4) #equal to A_derivs
#'
#' @family derivs
#'
#' @export
chainrule <- function(f_list, tri, deriv_order) {
    .Call('_dsfa_chainrule', PACKAGE = 'dsfa', f_list, tri, deriv_order)
}

sumrule_bi <- function(f, g, tri, deriv_order) {
    .Call('_dsfa_sumrule_bi', PACKAGE = 'dsfa', f, g, tri, deriv_order)
}

#' Sumrule
#'
#' Sumrule for derivs objects.
#' 
#' @details Let \eqn{f_m} be a function defined in [trind()], where \eqn{m \in {1,...,M}}.
#' Define \eqn{h((x_{n1},x_{n2},...,x_{nK})) = f_1(\cdot) + f_2(\cdot) ... + f_M(x_{n1},x_{n2},...,x_{nK}))}.
#' In order to get the derivatives of \eqn{h(\cdot)} w.r.t all parameters \eqn{x_{nk}}, the sumrule is applied.
#' For more details see [trind()] and [trind_generator()].
#' 
#' @return Returns an object of class \code{derivs} for the function \eqn{h(\cdot)}.
#' 
#' @inheritParams chainrule
#' 
#' @examples 
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_derivs<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' sumrule(list(A_derivs, A_derivs), trind_generator(1), deriv_order=4) #equal to 2*A_derivs
#' 
#' @family derivs
#' 
#' @export
sumrule <- function(f_list, tri, deriv_order) {
    .Call('_dsfa_sumrule', PACKAGE = 'dsfa', f_list, tri, deriv_order)
}

differencerule_bi <- function(f, g, tri, deriv_order) {
    .Call('_dsfa_differencerule_bi', PACKAGE = 'dsfa', f, g, tri, deriv_order)
}

#' Differencerule
#'
#' Differencerule for derivs objects.
#' 
#' @details Let \eqn{f_m} be a function defined in [trind()], where \eqn{m \in {1,...,M}}.
#' Define \eqn{h((x_{n1},x_{n2},...,x_{nK})) = f_1(\cdot) - f_2(\cdot) ... - f_M(x_{n1},x_{n2},...,x_{nK}))}.
#' In order to get the derivatives of \eqn{h(\cdot)} w.r.t all parameters \eqn{x_{nk}}, the difference rule is applied.
#' For more details see [trind()] and [trind_generator()].
#' 
#' @return Returns an object of class \code{derivs} for the function \eqn{h(\cdot)}.
#' 
#' @inheritParams chainrule
#' 
#' @examples 
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_derivs<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' differencerule(list(A_derivs, A_derivs), trind_generator(1), deriv_order=4) #equal to 0
#'
#' @family derivs
#' 
#' @export
differencerule <- function(f_list, tri, deriv_order) {
    .Call('_dsfa_differencerule', PACKAGE = 'dsfa', f_list, tri, deriv_order)
}

productrule_bi <- function(f, g, tri, deriv_order) {
    .Call('_dsfa_productrule_bi', PACKAGE = 'dsfa', f, g, tri, deriv_order)
}

#' Productrule
#'
#' Productrule for derivs objects.
#' 
#' @details Let \eqn{f_m} be a function defined in [trind()], where \eqn{m \in {1,...,M}}.
#' Define \eqn{h((x_{n1},x_{n2},...,x_{nK})) = f_1(\cdot) \cdot f_2(\cdot) ... \cdot f_M(x_{n1},x_{n2},...,x_{nK}))}.
#' In order to get the derivatives of \eqn{h(\cdot)} w.r.t all parameters \eqn{x_{nk}}, the productrule is applied.
#' For more details see [trind()] and [trind_generator()].
#' 
#' @return Returns an object of class \code{derivs} for the function \eqn{h(\cdot)}.
#' 
#' @inheritParams chainrule
#' 
#' @examples 
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_derivs<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=2)
#' B_derivs<-derivs_transform(A, type="inv", par=0,  trind_generator(1), deriv_order=2)
#' productrule (list(A_derivs, B_derivs), trind_generator(1), deriv_order=2) #identity
#' 
#' @family derivs
#' 
#' @export
productrule <- function(f_list, tri, deriv_order) {
    .Call('_dsfa_productrule', PACKAGE = 'dsfa', f_list, tri, deriv_order)
}

quotientrule_bi <- function(f, g, tri, deriv_order) {
    .Call('_dsfa_quotientrule_bi', PACKAGE = 'dsfa', f, g, tri, deriv_order)
}

#' Quotientrule
#'
#' Quotientrule for derivs objects.
#' 
#' @details Let \eqn{f_m} be a function defined in [trind()], where \eqn{m \in {1,...,M}}.
#' Define \eqn{h((x_{n1},x_{n2},...,x_{nK})) = f_1(\cdot) / f_2(\cdot) ... / f_M(x_{n1},x_{n2},...,x_{nK}))}.
#' In order to get the derivatives of \eqn{h(\cdot)} w.r.t all parameters \eqn{x_{nk}}, the quotientrule is applied.
#' For more details see [trind()] and [trind_generator()].The values of the \code{derivs} objects must be positive.
#' Numerically not precise, but included for  reasons of completeness.
#' 
#' @return Returns an object of class \code{derivs} for the function \eqn{h(\cdot)}.
#' 
#' @inheritParams chainrule
#' 
#' @examples 
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_derivs<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=2)
#' B_derivs<-derivs_transform(A, type="inv", par=0,  trind_generator(1), deriv_order=2)
#' quotientrule (list(A_derivs, B_derivs), trind_generator(1), deriv_order=2) #A/(1/A)=A^2
#' 
#' @family derivs
#' 
#' @export
quotientrule <- function(f_list, tri, deriv_order) {
    .Call('_dsfa_quotientrule', PACKAGE = 'dsfa', f_list, tri, deriv_order)
}

dnormhnorm_cpp <- function(x, m, v, u, s, deriv_order, tri, logp) {
    .Call('_dsfa_dnormhnorm_cpp', PACKAGE = 'dsfa', x, m, v, u, s, deriv_order, tri, logp)
}

pnormhnorm_cpp <- function(q, m, v, u, s, deriv_order, tri, logp) {
    .Call('_dsfa_pnormhnorm_cpp', PACKAGE = 'dsfa', q, m, v, u, s, deriv_order, tri, logp)
}

dnormexp_cpp <- function(x, m, v, u, s, deriv_order, tri, logp) {
    .Call('_dsfa_dnormexp_cpp', PACKAGE = 'dsfa', x, m, v, u, s, deriv_order, tri, logp)
}

pnormexp_cpp <- function(q, m, v, u, s, deriv_order, tri, logp) {
    .Call('_dsfa_pnormexp_cpp', PACKAGE = 'dsfa', q, m, v, u, s, deriv_order, tri, logp)
}

dcomper_cpp <- function(x, m, v, u, s, distr, deriv_order, tri, logp) {
    .Call('_dsfa_dcomper_cpp', PACKAGE = 'dsfa', x, m, v, u, s, distr, deriv_order, tri, logp)
}

pcomper_cpp <- function(q, m, v, u, s, distr, deriv_order, tri, logp) {
    .Call('_dsfa_pcomper_cpp', PACKAGE = 'dsfa', q, m, v, u, s, distr, deriv_order, tri, logp)
}

dcomper_mv_cpp <- function(x, m, v, u, delta, s, distr, rot, deriv_order, tri, logp) {
    .Call('_dsfa_dcomper_mv_cpp', PACKAGE = 'dsfa', x, m, v, u, delta, s, distr, rot, deriv_order, tri, logp)
}

ind2joint_bi <- function(f, g, tri_f, tri_g, tri_h, deriv_order) {
    .Call('_dsfa_ind2joint_bi', PACKAGE = 'dsfa', f, g, tri_f, tri_g, tri_h, deriv_order)
}

#' Independent to joint function
#'
#' Combines multiple derivs objects into a single derivs object.
#' 
#' @return Returns a derivs object.
#'
#' @details Let \eqn{f_m} be a function defined in [trind()], where \eqn{m \in {1,...,M}}.
#' Define \eqn{h((x_{n1},x_{n2},...,x_{nK})) = (f_1(x_{n1}), f_2(x_{n2}), ... ,f_M(x_{nK}))}.
#' In order to get the derivatives of \eqn{h(\cdot)} w.r.t all parameters \eqn{x_{nk}}, the independent functions are combined.
#' For more details see [trind()] and [trind_generator()].
#' 
#' @param tri_f_list list of length \eqn{K} trind_generator objects, the \eqn{kth} element corresponds to \eqn{kth} derivs object.
#' @param tri_h_list list of length \eqn{K} trind_generator objects, the \eqn{kth} element corresponds to a derivs object with \eqn{k \cdot (k+1)/2} parameters.
#' @inheritParams chainrule
#' 
#' @examples
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_derivs<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' B_derivs<-transform(A, type="exp", par=0, deriv_order=4)
#' ind2joint (list(A_derivs,B_derivs),
#'            list(trind_generator(1),trind_generator(1)),
#'            list(trind_generator(1),trind_generator(1+1)), 4)
#' 
#' @family derivs
#' 
#' @export
ind2joint <- function(f_list, tri_f_list, tri_h_list, deriv_order) {
    .Call('_dsfa_ind2joint', PACKAGE = 'dsfa', f_list, tri_f_list, tri_h_list, deriv_order)
}

#' transform
#'
#' Transforms a matrix via the specified function.
#' 
#' @details Takes the numeric matrix x as an input for the function specified by \code{type} and evaluates it together with the derivatives.
#'  
#' @return Returns an object of class \code{derivs}.
#'
#' @examples
#' A<-matrix(c(1:9)/10, ncol=3)
#' A_mat<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' transform(x=transform(x = A, type="exp", par=0, deriv_order=4), type="log", deriv_order=4, par = 0)
#'
#' @inheritParams trind
#' @inheritParams list2derivs
#' 
#' @param x numeric matrix to be transformed.
#' @param type string, specifies the transformation function. Available are:
#' \enumerate{
#' \item  `identity`: \eqn{f(x)=x}.
#' \item  `exp`: \eqn{f(x)=\exp\{x\}}.
#' \item  `log`: \eqn{f(x)=\log\{x\}}.
#' \item  `glogit`: \eqn{f(x)=\log\{(-x + min)/(x - max)}, where \code{par=c(min, max)}.
#' \item  `glogitinv`: \eqn{f(x)=\exp\{x\} \cdot (max + min)/(1 + \exp\{x\}) }, where \code{par=c(min, max)}.
#' \item  `inv`: \eqn{f(x)=\frac{1}{x}}.
#' \item  `pnorm`: \eqn{f(x)=\Phi(x)}.
#' \item  `qnorm`: \eqn{f(x)=\Phi^{-1}(x)}.
#' \item  `mexp`: \eqn{f(x)=-\exp\{x\}}.
#' \item  `zeta`: \eqn{f(x)=\log\{2 \cdot \Phi(x)\}}.
#' \item  `constant`: \eqn{f(x)=c}.
#' \item  `chainrule_utility`: \eqn{f(x)=f'(x)=f''(x)=f'''(x)=f''''(x)}.
#' \item   onemx: \eqn{1-x}
#' }
#' @param par numeric vector, additional parameters, e.g. min and max for \code{glogit}.
#' 
#' 
#' @export
transform <- function(x, type, par, deriv_order) {
    .Call('_dsfa_transform', PACKAGE = 'dsfa', x, type, par, deriv_order)
}

#' derivs_transform
#'
#' Transforms a derivs object via the specified function and applies the chainrule.
#' 
#' @details Takes the derivs object \code{f} as an input for the function specified by \code{type} and evaluates it together with the derivatives utilizing the chainrule.
#' For more details see [trind()] and [trind_generator()].
#' 
#' @return Returns an object of class \code{derivs}
#'
#' @examples
#' A<-matrix(c(1:9)/10, ncol=1)
#' A_mat<-list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' derivs_transform(f =derivs_transform(f = A, type="exp", par=0,
#'                                      tri=trind_generator(1), deriv_order=4),
#'                    type="log", par=0, tri=trind_generator(1), deriv_order=4)
#' 
#' @inheritParams transform
#' @inheritParams trind
#' @inheritParams list2derivs
#' @param f derivs object.
#' 
#' @family derivs
#' @export
derivs_transform <- function(f, type, par, tri, deriv_order) {
    .Call('_dsfa_derivs_transform', PACKAGE = 'dsfa', f, type, par, tri, deriv_order)
}

#' trind function
#'
#' Provides the column index of the required derivative for the specified order of a \code{derivs} object. 
#'
#' @param tri list; created by the function [trind_generator()].
#' @param part_deriv_var integer vector; specifies \eqn{\frac{\partial^J f(\cdot)}{\partial x_{ni_1} ... \partial x_{ni_J}}}.
#' The length of the vector is denoted as \eqn{J} and determines the order of the partial derivatives with maximum four. The element \eqn{i_j \in \{0,...,K-1\}}  
#' specifies the variable with respect to which the derivative is taken, where \eqn{j \in \{1,...,J\}}, The order corresponds to the order of derivatives.
#' For example \code{c(0,0,1,2)} is equal to \eqn{\frac{\partial^4 f(\cdot)}{\partial x_{n1} \partial x_{n1} \partial x_{n2} \partial x_{n3}}}.
#' See details for more information.
#' 
#' @details  Let \eqn{f:\mathbb{R}^K -> \mathbb{R}^L, (x_{n1},x_{n2},...,x_{nK}) -> f(x_{n1},x_{n2},...,x_{nK})} be differentiable up to order four w.r.t all parameters \eqn{x_{nk}}, where \eqn{k \in \{1,...,K\}} and \eqn{n \in \{1,...,N\}}.
#' Then a \code{derivs} class object is a numeric matrix with \eqn{N} rows and \eqn{L} columns. \eqn{N} is the length  of the input vectors. Further, it has the following attributes:
#' \enumerate{
#' \item  `d1`: a numeric matrix of the first derivatives w.r.t all parameters,
#'  where the \eqn{nth} row  corresponds to: \eqn{(\frac{\partial   f(\cdot)}{\partial x_{n1}}, \frac{\partial f(\cdot)}{\partial x_{n1}},...,\frac{\partial f(\cdot)}{\partial x_{nK}})}
#' \item  `d2`: a numeric matrix of the second derivatives w.r.t all parameters,
#'  where the \eqn{nth} row  corresponds to: \eqn{(\frac{\partial^2 f(\cdot)}{\partial x_{n1} \partial x_{n1}}, \frac{\partial^2 f(\cdot)}{\partial x_{n1} \partial x_{n2}},...,\frac{\partial^2 f(\cdot)}{\partial x_{nK} \partial x_{nK}})}
#' \item  `d3`: a numeric matrix of the third derivatives w.r.t all parameters,
#'  where the \eqn{nth} row  corresponds to: \eqn{(\frac{\partial^3 f(\cdot)}{\partial x_{n1} \partial x_{n1} \partial x_{n1}}, \frac{\partial^3 f(\cdot)}{\partial x_{n1} \partial x_{n1} \partial x_{n2}},...,\frac{\partial^3 f(\cdot)}{\partial x_{nK} \partial x_{nK} \partial x_{nK}})}
#' \item  `d4`: a numeric matrix of the fourth derivatives w.r.t all parameters,
#'  where the \eqn{nth} row  corresponds to: \eqn{(\frac{\partial^4 f(\cdot)}{\partial x_{n1} \partial x_{n1} \partial x_{n1} \partial x_{n1}}, \frac{\partial^4 f(\cdot)}{\partial x_{n1} \partial x_{n1} \partial x_{n1} \partial x_{n2}},...,\frac{\partial^4 f(\cdot)}{\partial x_{nK} \partial x_{nK} \partial x_{nK} \partial x_{nK}})}
#' }
#' The function \code{trind()} provides the index for the corresponding derivatives. The \code{derivs} class object allows for a modular system which can be easily extended and is faster than numerical derivatives.
#' The advantage compared to analytical derivatives provided by 'mathematica' or \code{\link[stats:deriv]{deriv()}} is that asymptotics and approximations can be used for individual parts.
#' Handwritten derivatives can be tedious at times and may be prone to errors. Thus, the \code{derivs} class object can be used by lazy users.
#' Mainly intended for internal use.
#' 
#' @return Integer, the index for a derivs object.
#'
#' @examples
#' tri=trind_generator(3)
#' trind(tri, c(2,1))
#' 
#' @family derivs
#' 
#' @export
trind <- function(tri, part_deriv_var) {
    .Call('_dsfa_trind', PACKAGE = 'dsfa', tri, part_deriv_var)
}

#' Trind_generator function
#'
#' Generates index matrices for upper triangular storage up to order four. 
#'
#' @param K integer; determines the number of parameters.
#'
#' @details Useful when working with higher order derivatives, which generate symmetric arrays. Mainly intended for internal use. Similar to 'mgcv::trind.generator'. Mostly internal function.
#' 
#' @return Returns a list with index matrices for the first to fourth derivative, which can be accessed via the function [trind()].
#' The numerical vectors \code{i_start} and \code{i_end} hold the starting and ending indexes, which are required by [trind()] for derivatives greater than two.
#'
#' @examples
#' tri<-trind_generator(3)
#' tri_mgcv<-mgcv::trind.generator(3)
#' 
#' for(i in 1:3){
#'   print(i==trind(tri, part_deriv_var=c(i)-1)+1)
#'   for(j in i:3){
#'     print(tri_mgcv$i2[i,j]==trind(tri, part_deriv_var=c(i,j)-1)+1)
#'     for(k in j:3){
#'       print(tri_mgcv$i3[i,j,k]==trind(tri, part_deriv_var=c(i,j,k)-1)+1)
#'       for(l in k:3){
#'         print(tri_mgcv$i4[i,j,k,l]==trind(tri, part_deriv_var=c(i,j,k,l)-1)+1)
#'       } 
#'     } 
#'   }
#'}
#'
#' @family derivs
#'
#' @export
trind_generator <- function(K) {
    .Call('_dsfa_trind_generator', PACKAGE = 'dsfa', K)
}

#' list2derivs
#'
#' Transforms a list of matrices d0, d1, d2, d3, d4 to a \code{derivs} object.
#'
#' @param f list of matrices; d0, d1, d2, d3, d4 
#' @param deriv_order integer; maximum order of derivative. Available are \code{0},\code{2} and \code{4}.
#' 
#' @return Mostly internal function. Returns an object of class \code{derivs}
#' For more details see [trind()] and [trind_generator()].
#' 
#' @examples
#' A<-matrix(c(1:9)/10, ncol=3)
#' list2derivs(list(A, A^0, A^2, A^3, A^4), deriv_order=4)
#' 
#' @family derivs
#' 
#' @export
list2derivs <- function(f, deriv_order) {
    .Call('_dsfa_list2derivs', PACKAGE = 'dsfa', f, deriv_order)
}

erfcinv <- function(x) {
    .Call('_dsfa_erfcinv', PACKAGE = 'dsfa', x)
}

OwenT <- function(h, a) {
    .Call('_dsfa_OwenT', PACKAGE = 'dsfa', h, a)
}