R/RcppExports.R

Defines functions ehsa dhsa bsplineComb bsplineEstimate bsplineGenerate bsplineNames bsplineMerge bsplineMult printPolynomial polynomialIndex truncatedNormalMoment normalMoment logLik_hpaSelection print_summary_hpaSelection summary_hpaSelection predict_hpaSelection hpaSelection rhpa qhpa ihpaDiff ehpaDiff dhpaDiff itrhpa dtrhpa etrhpa ehpa ihpa phpa dhpa hpaMain mecdf logLik_hpaML print_summary_hpaML summary_hpaML predict_hpaML hpaML logLik_hpaBinary print_summary_hpaBinary summary_hpaBinary predict_hpaBinary hpaBinary phpa0 dhpa0 pnorm_parallel dnorm_parallel

Documented in bsplineComb bsplineEstimate bsplineGenerate dhpa dhpa0 dhpaDiff dhsa dnorm_parallel dtrhpa ehpa ehpaDiff ehsa etrhpa hpaBinary hpaML hpaSelection ihpa ihpaDiff itrhpa logLik_hpaBinary logLik_hpaML logLik_hpaSelection mecdf normalMoment phpa phpa0 pnorm_parallel polynomialIndex predict_hpaBinary predict_hpaML predict_hpaSelection printPolynomial print_summary_hpaBinary print_summary_hpaML print_summary_hpaSelection qhpa rhpa summary_hpaBinary summary_hpaML summary_hpaSelection truncatedNormalMoment

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

#' Calculate normal pdf in parallel
#' @description Calculate in parallel for each value from vector \code{x} 
#' density function of normal distribution with 
#' mean equal to \code{mean} and standard deviation equal to \code{sd}.
#' @param x numeric vector of quantiles.
#' @param mean double value.
#' @param sd double positive value.
#' @template is_parallel_Template
#' @template dnorm_parallel_examples_Template
#' @export
dnorm_parallel <- function(x, mean = 0, sd = 1, is_parallel = FALSE) {
    .Call(`_hpa_dnorm_parallel`, x, mean, sd, is_parallel)
}

#' Calculate normal cdf in parallel
#' @description Calculate in parallel for each value from vector \code{x} 
#' distribution function of normal distribution with 
#' mean equal to \code{mean} and standard deviation equal to \code{sd}.
#' @param x vector of quantiles: should be numeric vector,
#' not just double value.
#' @param mean double value.
#' @param sd double positive value.
#' @template is_parallel_Template
#' @export
pnorm_parallel <- function(x, mean = 0, sd = 1, is_parallel = FALSE) {
    .Call(`_hpa_pnorm_parallel`, x, mean, sd, is_parallel)
}

#' Fast pdf and cdf for standardized univariate PGN distribution
#' @description This function uses fast algorithms to calculate densities
#' and probabilities (along with their derivatives) related to standardized 
#' PGN distribution.
#' @name hpaDist0
#' @param x numeric vector of functions arguments.
#' @param pc polynomial coefficients without the first term.
#' @param mean expected value (mean) of the distribution.
#' @param sd standard deviation of the distribution.
#' @param is_parallel logical; if TRUE then multiple cores will be used for 
#' some calculations. Currently unavailable.
#' @template log_Template
#' @template is_validation_Template
#' @param is_grad logical; if \code{TRUE} (default) then function returns 
#' gradients respect to \code{x} and \code{pc}.
#' @details Functions \code{\link[hpa]{dhpa0}} and 
#' \code{\link[hpa]{phpa0}} are similar to \code{\link[hpa]{dhpa}} and
#' \code{\link[hpa]{phpa}} correspondingly. However there are two key
#' differences. First, \code{\link[hpa]{dhpa0}} and \code{\link[hpa]{phpa0}}
#' are deal with univariate PGN distribution only. Second, this distribution
#' is standardized to zero mean and unit variances. Moreover \code{pc} is 
#' similar to \code{pol_coefficients} argument of \code{\link[hpa]{dhpa}} but
#' without the first component i.e. \code{pc=pol_coefficients[-1]}. Also
#' \code{mean} and \code{sd} are not the arguments of the normal density
#' but actual mean and standard deviation of the resulting distribution. So
#' if these arguments are different from \code{0} and \code{1} correspondingly
#' then standardized PGN distribution will be linearly transformed to have
#' mean \code{mean} and standard deviation \code{sd}.
#' @return Both functions return a list.
#' Function \code{\link[hpa]{dhpa0}} returns a list with element named
#' \code{"den"} that is a numeric vector of density values. 
#' Function \code{\link[hpa]{phpa0}} returns a list with element named
#' \code{"prob"} that is a numeric vector of probabilities. 
#' 
#' If \code{is_grad = TRUE} then elements \code{"grad_x"} and \code{"grad_pc"}
#' will be add to the list containing gradients respect to input argument
#' \code{x} and parameters \code{pc} correspondingly. If \code{log = TRUE} then
#' additional elements will be add to the list containing density, probability
#' and gradient values for logarithms of corresponding functions. These
#' elements will be named as \code{"grad_x_log"}, \code{"grad_pc_log"},
#' \code{"grad_prob_log"} and \code{"grad_den_log"}.
#' @examples
#' # Calculate density and probability of standartized PGN
#' # distribution
#'   # distribution parameters
#' pc <- c(0.5, -0.2)
#'   # function arguments
#' x <- c(-0.3, 0.8, 1.5)
#'   # probability density function
#' dhpa0(x, pc)
#'   # cumulative distribution function
#' phpa0(x, pc)
#' 
#' # Additionally calculate gradients respect to arguments
#' # and parameters of the PGN distribution
#' dhpa0(x, pc, is_grad = TRUE)
#' phpa0(x, pc, is_grad = TRUE)
#' 
#' # Let's denote by X standardized PGN random variable and repeat
#' # calculations for 2 * X + 1
#' dhpa0(x, pc, is_grad = TRUE, mean = 1, sd = 2)
#' phpa0(x, pc, is_grad = TRUE, mean = 1, sd = 2)
#' @export
dhpa0 <- function(x, pc, mean = 0, sd = 1, is_parallel = FALSE, log = FALSE, is_validation = TRUE, is_grad = FALSE) {
    .Call(`_hpa_dhpa0`, x, pc, mean, sd, is_parallel, log, is_validation, is_grad)
}

#' @name hpaDist0
#' @export
phpa0 <- function(x, pc, mean = 0, sd = 1, is_parallel = FALSE, log = FALSE, is_validation = TRUE, is_grad = FALSE) {
    .Call(`_hpa_phpa0`, x, pc, mean, sd, is_parallel, log, is_validation, is_grad)
}

#' Semi-nonparametric single index binary choice model estimation
#' @description This function performs semi-nonparametric (SNP) maximum 
#' likelihood estimation of single index binary choice model 
#' using Hermite polynomial based approximating function proposed by Gallant 
#' and Nychka in 1987. Please, see \code{\link[hpa]{dhpa}} 'Details' section to 
#' get more information concerning this approximating function.
#' @template formula_Template
#' @template data_Template
#' @template K_Template
#' @template mean_fixed_Template
#' @template sd_fixed_Template
#' @template constant_fixed_Template
#' @template coef_fixed_Template
#' @template x0_binary_Template
#' @template cov_type_Template
#' @template boot_iter_Template
#' @template is_parallel_Template
#' @template opt_type_Template
#' @template opt_control_Template
#' @template is_validation_Template
#' @param is_x0_probit logical; if \code{TRUE} (default) then initial
#' points for optimization routine will be
#' obtained by probit model estimated via \link[stats]{glm} function.
#' @template is_sequence_Template
#' @template GN_details_Template
#' @template hpaBinary_formula_Template
#' @template is_numeric_Template
#' @template parametric_paradigm_Template
#' @template optim_details_Template
#' @template opt_control_details_Template
#' @template opt_control_details_hpaBinary_Template
#' @return This function returns an object of class "hpaBinary".\cr \cr
#' An object of class "hpaBinary" is a list containing the 
#' following components:
#' \itemize{
#' \item \code{optim} - \code{\link[stats]{optim}} function output. 
#' If \code{opt_type = "GA"} then it is the list containing 
#' \code{\link[stats]{optim}} and \code{\link[GA]{ga}} functions outputs.
#' \item \code{x1} - numeric vector of distribution parameters estimates.
#' \item \code{mean} - mean (mu) parameter of density function estimate.
#' \item \code{sd} - sd (sigma) parameter of density function estimate.
#' \item \code{pol_coefficients} - polynomial coefficients estimates.
#' \item \code{pol_degrees} - the same as \code{K} input parameter.
#' \item \code{coefficients} - regression (single index) 
#' coefficients estimates.
#' \item \code{cov_mat} - covariance matrix estimate.
#' \item \code{marginal_effects} - marginal effects matrix where columns are
#' variables and rows are observations.
#' \item \code{results} - numeric matrix representing estimation results.
#' \item \code{log-likelihood} - value of Log-Likelihood function.
#' \item \code{AIC} - AIC value.
#' \item \code{errors_exp} - random error expectation estimate.
#' \item \code{errors_var} - random error variance estimate.
#' \item \code{dataframe} - data frame containing variables mentioned in 
#' \code{formula} without \code{NA} values.
#' \item \code{model_Lists} - lists containing information about 
#' fixed parameters and parameters indexes in \code{x1}.
#' \item \code{n_obs} - number of observations.
#' \item \code{z_latent} - latent variable (single index) estimates.
#' \item \code{z_prob} - probabilities of positive 
#' outcome (i.e. 1) estimates.}
#' @seealso \link[hpa]{summary.hpaBinary}, \link[hpa]{predict.hpaBinary}, 
#' \link[hpa]{plot.hpaBinary},
#' \link[hpa]{logLik.hpaBinary}
#' @template hpaBinary_examples_Template
#' @export	
hpaBinary <- function(formula, data, K = 1L, mean_fixed = NA_real_, sd_fixed = NA_real_, constant_fixed = 0, coef_fixed = TRUE, is_x0_probit = TRUE, is_sequence = FALSE, x0 = numeric(0), cov_type = "sandwich", boot_iter = 100L, is_parallel = FALSE, opt_type = "optim", opt_control = NULL, is_validation = TRUE) {
    .Call(`_hpa_hpaBinary`, formula, data, K, mean_fixed, sd_fixed, constant_fixed, coef_fixed, is_x0_probit, is_sequence, x0, cov_type, boot_iter, is_parallel, opt_type, opt_control, is_validation)
}

#' Predict method for hpaBinary
#' @param object Object of class "hpaBinary"
#' @template newdata_Template
#' @param is_prob logical; if TRUE (default) 
#' then function returns predicted probabilities. 
#' Otherwise latent variable
#' (single index) estimates will be returned.
#' @return This function returns predicted probabilities 
#' based on \code{\link[hpa]{hpaBinary}} estimation results.
#' @export
predict_hpaBinary <- function(object, newdata = NULL, is_prob = TRUE) {
    .Call(`_hpa_predict_hpaBinary`, object, newdata, is_prob)
}

#' Summarizing hpaBinary Fits
#' @param object Object of class "hpaBinary"
#' @return This function returns the same list as 
#' \code{\link[hpa]{hpaBinary}} function changing 
#' its class to "summary.hpaBinary".
#' @export
summary_hpaBinary <- function(object) {
    .Call(`_hpa_summary_hpaBinary`, object)
}

#' Summary for hpaBinary output
#' @param x Object of class "hpaML"
#' @export	
print_summary_hpaBinary <- function(x) {
    invisible(.Call(`_hpa_print_summary_hpaBinary`, x))
}

#' Calculates log-likelihood for "hpaBinary" object
#' @description This function calculates log-likelihood for "hpaBinary" object
#' @param object Object of class "hpaBinary"
#' @export	
logLik_hpaBinary <- function(object) {
    .Call(`_hpa_logLik_hpaBinary`, object)
}

#' Semi-nonparametric maximum likelihood estimation
#' @description This function performs semi-nonparametric (SNP)
#' maximum likelihood estimation of unknown (possibly truncated) multivariate  
#' density using Hermite polynomial based approximating function proposed by 
#' Gallant and Nychka in 1987. Please, see \code{\link[hpa]{dhpa}} 'Details' 
#' section to get more information concerning this approximating function.
#' @template data_ML_Template
#' @template pol_degrees_Template
#' @template tr_left_vec_Template
#' @template tr_right_vec_Template
#' @template given_ind_Template
#' @template omit_ind_Template
#' @template x0_ML_Template
#' @template cov_type_Template
#' @template boot_iter_Template
#' @template is_parallel_Template
#' @template opt_type_Template
#' @template opt_control_Template
#' @template is_validation_Template
#' @template GN_details_Template
#' @template hpaML_formula_Template
#' @template parametric_paradigm_Template
#' @template optim_details_Template
#' @template opt_control_details_Template
#' @template opt_control_details_hpaML_Template
#' @return This function returns an object of class "hpaML".\cr \cr
#' An object of class "hpaML" is a list containing the following components:
#' \itemize{
#' \item \code{optim} - \code{\link[stats]{optim}} function output. 
#' If \code{opt_type = "GA"} then it is the list containing 
#' \code{\link[stats]{optim}} and \code{\link[GA]{ga}} functions outputs.
#' \item \code{x1} - numeric vector of distribution parameters estimates.
#' \item \code{mean} - density function mean vector estimate.
#' \item \code{sd} - density function sd vector estimate.
#' \item \code{pol_coefficients} - polynomial coefficients estimates.
#' \item \code{tr_left }- the same as \code{tr_left} input parameter.
#' \item \code{tr_right} - the same as \code{tr_right} input parameter.
#' \item \code{omit_ind }- the same as \code{omit_ind} input parameter.
#' \item \code{given_ind} - the same as \code{given_ind} input parameter.
#' \item \code{cov_mat} - covariance matrix estimate.
#' \item \code{results} - numeric matrix representing estimation results.
#' \item \code{log-likelihood} - value of Log-Likelihood function.
#' \item \code{AIC} - AIC value.
#' \item \code{data} - the same as \code{data} input parameter but without \code{NA} observations.
#' \item \code{n_obs} - number of observations.
#' \item \code{bootstrap} - list where bootstrap estimation results are stored.}
#' @seealso \link[hpa]{summary.hpaML}, \link[hpa]{predict.hpaML}, 
#' \link[hpa]{logLik.hpaML}, \link[hpa]{plot.hpaML}
#' @template hpaML_examples_Template
#' @export
hpaML <- function(data, pol_degrees = numeric(0), tr_left = numeric(0), tr_right = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), x0 = numeric(0), cov_type = "sandwich", boot_iter = 100L, is_parallel = FALSE, opt_type = "optim", opt_control = NULL, is_validation = TRUE) {
    .Call(`_hpa_hpaML`, data, pol_degrees, tr_left, tr_right, given_ind, omit_ind, x0, cov_type, boot_iter, is_parallel, opt_type, opt_control, is_validation)
}

#' Predict method for hpaML
#' @param object Object of class "hpaML"
#' @template newdata_Template
#' @return This function returns predictions based 
#' on \code{\link[hpa]{hpaML}} estimation results.
#' @export
predict_hpaML <- function(object, newdata = matrix(1, 1)) {
    .Call(`_hpa_predict_hpaML`, object, newdata)
}

#' Summarizing hpaML Fits
#' @param object Object of class "hpaML"
#' @return This function returns the same 
#' list as \code{\link[hpa]{hpaML}} function changing 
#' its class to "summary.hpaML".
#' @export
summary_hpaML <- function(object) {
    .Call(`_hpa_summary_hpaML`, object)
}

#' Summary for hpaML output
#' @param x Object of class "hpaML"
#' @export
print_summary_hpaML <- function(x) {
    invisible(.Call(`_hpa_print_summary_hpaML`, x))
}

#' Calculates log-likelihood for "hpaML" object
#' @description This function calculates log-likelihood for "hpaML" object
#' @param object Object of class "hpaML"
#' @export
logLik_hpaML <- function(object) {
    .Call(`_hpa_logLik_hpaML`, object)
}

#' Calculates multivariate empirical cumulative distribution function
#' @description This function calculates multivariate 
#' empirical cumulative distribution function
#' at each point of the sample
#' @param x numeric matrix which rows are observations
#' @export
mecdf <- function(x) {
    .Call(`_hpa_mecdf`, x)
}

hpaMain <- function(x_lower_vec = numeric(0), x_upper_vec = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), type = "pdf", given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), expectation_powers = numeric(0), grad_type = "NO", is_parallel = FALSE, is_cdf = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_hpaMain`, x_lower_vec, x_upper_vec, pol_coefficients, pol_degrees, type, given_ind, omit_ind, mean, sd, expectation_powers, grad_type, is_parallel, is_cdf, log, is_validation)
}

#' Probabilities and Moments Hermite Polynomial Approximation
#' @name hpaDist
#' @template dhpa_formula_Template
#' @template x_pdf_Template
#' @template x_lower_Template
#' @template x_upper_Template
#' @template pol_coefficients_Template
#' @template pol_degrees_Template
#' @template given_ind_Template
#' @template omit_ind_Template
#' @template mean_Template
#' @template sd_Template
#' @template is_parallel_Template
#' @template log_Template
#' @template expectation_powers_Template
#' @template tr_left_Template
#' @template tr_right_Template
#' @template type_diff_Template
#' @template is_validation_Template
#' @template given_omit_Template
#' @template GN_details_Template
#' @template dhpa_examples_Template
#' @param p numeric vector of probabilities
#' @param n positive integer representing the number of observations
#' @export
dhpa <- function(x, pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_dhpa`, x, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template phpa_examples_Template
#' @export
phpa <- function(x, pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_phpa`, x, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template ihpa_examples_Template
#' @export
ihpa <- function(x_lower = numeric(0), x_upper = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_ihpa`, x_lower, x_upper, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template ehpa_examples_Template
#' @export
ehpa <- function(x = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), expectation_powers = numeric(0), is_parallel = FALSE, is_validation = TRUE) {
    .Call(`_hpa_ehpa`, x, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, expectation_powers, is_parallel, is_validation)
}

#' @name hpaDist
#' @template etrhpa_examples_Template
#' @export
etrhpa <- function(tr_left = numeric(0), tr_right = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), mean = numeric(0), sd = numeric(0), expectation_powers = numeric(0), is_parallel = FALSE, is_validation = TRUE) {
    .Call(`_hpa_etrhpa`, tr_left, tr_right, pol_coefficients, pol_degrees, mean, sd, expectation_powers, is_parallel, is_validation)
}

#' @name hpaDist
#' @template dtrhpa_examples_Template
#' @export
dtrhpa <- function(x, tr_left = numeric(0), tr_right = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_dtrhpa`, x, tr_left, tr_right, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template itrhpa_examples_Template
#' @export
itrhpa <- function(x_lower = numeric(0), x_upper = numeric(0), tr_left = numeric(0), tr_right = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_itrhpa`, x_lower, x_upper, tr_left, tr_right, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template dhpaDiff_examples_Template
#' @export
dhpaDiff <- function(x, pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), type = "pol_coefficients", is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_dhpaDiff`, x, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, type, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template ehpaDiff_examples_Template
#' @export
ehpaDiff <- function(x = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), expectation_powers = numeric(0), type = "pol_coefficients", is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_ehpaDiff`, x, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, expectation_powers, type, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template ihpaDiff_examples_Template
#' @export
ihpaDiff <- function(x_lower = numeric(0), x_upper = numeric(0), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0), type = "pol_coefficients", is_parallel = FALSE, log = FALSE, is_validation = TRUE) {
    .Call(`_hpa_ihpaDiff`, x_lower, x_upper, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd, type, is_parallel, log, is_validation)
}

#' @name hpaDist
#' @template qhpa_examples_Template
#' @export
qhpa <- function(p, x = matrix(1, 1), pol_coefficients = numeric(0), pol_degrees = numeric(0), given_ind = numeric(0), omit_ind = numeric(0), mean = numeric(0), sd = numeric(0)) {
    .Call(`_hpa_qhpa`, p, x, pol_coefficients, pol_degrees, given_ind, omit_ind, mean, sd)
}

#' @name hpaDist
#' @template rhpa_examples_Template
#' @export
rhpa <- function(n, pol_coefficients = numeric(0), pol_degrees = numeric(0), mean = numeric(0), sd = numeric(0)) {
    .Call(`_hpa_rhpa`, n, pol_coefficients, pol_degrees, mean, sd)
}

#' Perform semi-nonparametric selection model estimation
#' @description This function performs semi-nonparametric (SNP) maximum 
#' likelihood estimation of sample selection model 
#' using Hermite polynomial based approximating function proposed by Gallant 
#' and Nychka in 1987. Please, see \code{\link[hpa]{dhpa}} 'Details' section to 
#' get more information concerning this approximating function.
#' @param selection an object of class "formula" 
#' (or one that can be coerced to that class): a symbolic description of the 
#' selection equation form. All variables in \code{selection} should be numeric 
#' vectors of the same length.
#' @param outcome an object of class "formula" (or one that can be coerced 
#' to that class): a symbolic description of the outcome equation form. 
#' All variables in \code{outcome} should be numeric vectors of the 
#' same length.
#' @template data_Template
#' @template selection_K_Template
#' @template outcome_K_Template
#' @param pol_elements number of conditional expectation approximating terms 
#' for Newey's method. If \code{is_Newey_loocv} is \code{TRUE} then determines 
#' maximum number of these terms during leave-one-out cross-validation.
#' @param is_Newey logical; if TRUE then returns only Newey's method 
#' estimation results (default value is FALSE).
#' @param is_Newey_loocv logical; if TRUE then number of conditional 
#' expectation approximating terms for Newey's method will be selected
#' based on leave-one-out cross-validation criteria iterating through 0 
#' to pol_elements number of these terms.
#' @template x0_selection_Template
#' @template cov_type_Template
#' @template boot_iter_Template
#' @template is_parallel_Template
#' @template opt_type_Template
#' @template opt_control_Template
#' @template is_validation_Template
#' @template GN_details_Template
#' @template hpaSelection_formula_Template
#' @details Note that coefficient for the first
#' independent variable in \code{selection} will be fixed
#' to 1 i.e. \eqn{\gamma_{1}=1}.
#' @template is_numeric_selection_Template
#' @template parametric_paradigm_Template
#' @template Newey_details_Template
#' @details Note that selection equation dependent variables should have 
#' exactly two levels (0 and 1) where "0" states for the selection results 
#' which leads to unobservable values of dependent variable in 
#' outcome equation.
#' @template Mroz_reference_Template
#' @template optim_details_Template
#' @template opt_control_details_Template
#' @template opt_control_details_hpaSelection_Template
#' @return This function returns an object of class "hpaSelection".\cr \cr
#' An object of class "hpaSelection" is a list containing the 
#' following components:
#' \itemize{
#' \item \code{optim} - \code{\link[stats]{optim}} function output. 
#' If \code{opt_type = "GA"} then it is the list containing 
#' \code{\link[stats]{optim}} and \code{\link[GA]{ga}} functions outputs.
#' \item \code{x1} - numeric vector of distribution parameters estimates.
#' \item \code{Newey} - list containing information concerning Newey's 
#' method estimation results.
#' \item \code{selection_mean} - estimate of the hermite polynomial mean 
#' parameter related to selection equation random error marginal distribution.
#' \item \code{outcome_mean} - estimate of the hermite polynomial mean parameter 
#' related to outcome equation random error marginal distribution.
#' \item \code{selection_sd} - estimate of sd parameter related to 
#' selection equation random error marginal distribution.
#' \item \code{outcome_sd} - estimate of the hermite polynomial sd parameter related 
#' to outcome equation random error marginal distribution.
#' \item \code{pol_coefficients} - polynomial coefficients estimates.
#' \item \code{pol_degrees} - numeric vector which first element is \code{selection_K} 
#' and the second is \code{outcome_K}.
#' \item \code{selection_coef} - selection equation regression coefficients estimates.
#' \item \code{outcome_coef} - outcome equation regression coefficients estimates.
#' \item \code{cov_mat} - covariance matrix estimate.
#' \item \code{results} - numeric matrix representing estimation results.
#' \item \code{log-likelihood} - value of Log-Likelihood function.
#' \item \code{re_moments} - list which contains information about random 
#' errors expectations, variances and correlation.
#' \item \code{data_List} - list containing model variables and their 
#' partition according to outcome and selection equations.
#' \item \code{n_obs} - number of observations.
#' \item \code{ind_List} - list which contains information about parameters 
#' indexes in \code{x1}.
#' \item \code{selection_formula} - the same as \code{selection} 
#' input parameter.
#' \item \code{outcome_formula} - the same as \code{outcome} input parameter.}
#' Abovementioned list \code{Newey} has class "hpaNewey" and contains 
#' the following components:
#' \itemize{
#' \item \code{outcome_coef} - regression coefficients estimates (except 
#' constant term which is part of conditional expectation 
#' approximating polynomial).
#' \item \code{selection_coef} - regression coefficients estimates related 
#' to selection equation.
#' \item \code{constant_biased} - biased estimate of constant term.
#' \item \code{inv_mills} - inverse mills ratios estimates and their 
#' powers (including constant).
#' \item \code{inv_mills_coef} - coefficients related to \code{inv_mills}.
#' \item \code{pol_elements} - the same as \code{pol_elements} 
#' input parameter. However if \code{is_Newey_loocv} is \code{TRUE}
#' then it will equal to the number of conditional expectation 
#' approximating terms for Newey's method which minimize leave-one-out 
#' cross-validation criteria.
#' \item \code{outcome_exp_cond} - dependent variable conditional 
#' expectation estimates.
#' \item \code{selection_exp} - selection equation random error 
#' expectation estimate.
#' \item \code{selection_var} - selection equation random error 
#' variance estimate.
#' \item \code{hpaBinaryModel} - object of class "hpaBinary" which 
#' contains selection equation estimation results.}
#' Abovementioned list \code{re_moments} contains the following components:
#' \itemize{
#' \item \code{selection_exp} - selection equation random errors 
#' expectation estimate.
#' \item \code{selection_var} - selection equation random errors 
#' variance estimate.
#' \item \code{outcome_exp} - outcome equation random errors 
#' expectation estimate.
#' \item \code{outcome_var} - outcome equation random errors 
#' variance estimate.
#' \item \code{errors_covariance} - outcome and selection equation 
#' random errors covariance estimate.
#' \item \code{rho} - outcome and selection equation random errors 
#' correlation estimate.
#' \item \code{rho_std} - outcome and selection equation random 
#' errors correlation estimator standard error estimate.}
#' @seealso \link[hpa]{summary.hpaSelection}, 
#' \link[hpa]{predict.hpaSelection}, \link[hpa]{plot.hpaSelection}, 
#' \link[hpa]{logLik.hpaSelection}
#' @template hpaSelection_examples_Template
#' @export	
hpaSelection <- function(selection, outcome, data, selection_K = 1L, outcome_K = 1L, pol_elements = 3L, is_Newey = FALSE, x0 = numeric(0), is_Newey_loocv = FALSE, cov_type = "sandwich", boot_iter = 100L, is_parallel = FALSE, opt_type = "optim", opt_control = NULL, is_validation = TRUE) {
    .Call(`_hpa_hpaSelection`, selection, outcome, data, selection_K, outcome_K, pol_elements, is_Newey, x0, is_Newey_loocv, cov_type, boot_iter, is_parallel, opt_type, opt_control, is_validation)
}

#' Predict outcome and selection equation values from hpaSelection model
#' @description This function predicts outcome and selection equation 
#' values from hpaSelection model.
#' @param object Object of class "hpaSelection"
#' @param method string value indicating prediction method based on hermite 
#' polynomial approximation "HPA" or Newey method "Newey".
#' @template newdata_Template
#' @param is_cond logical; if \code{TRUE} (default) then conditional 
#' predictions will be estimated. Otherwise unconditional predictions 
#' will be returned.
#' @param is_outcome logical; if \code{TRUE} (default) then predictions 
#' for selection equation will be estimated using "HPA" method.
#' Otherwise selection equation predictions (probabilities) will be returned.
#' @details Note that Newey method can't predict conditional outcomes for 
#' zero selection equation value. Conditional probabilities for 
#' selection equation could be estimated only when dependent variable from 
#' outcome equation is observable.
#' @return This function returns the list which structure depends 
#' on \code{method}, \code{is_probit} and \code{is_outcome} values.
#' @export
predict_hpaSelection <- function(object, newdata = NULL, method = "HPA", is_cond = TRUE, is_outcome = TRUE) {
    .Call(`_hpa_predict_hpaSelection`, object, newdata, method, is_cond, is_outcome)
}

#' Summarizing hpaSelection Fits
#' @description This function summarizing hpaSelection Fits.
#' @param object Object of class "hpaSelection".
#' @return This function returns the same list as 
#' \code{\link[hpa]{hpaSelection}} function changing its class 
#' to "summary.hpaSelection".
#' @export
summary_hpaSelection <- function(object) {
    .Call(`_hpa_summary_hpaSelection`, object)
}

#' Summary for hpaSelection output
#' @param x Object of class "hpaSelection"
#' @export
print_summary_hpaSelection <- function(x) {
    invisible(.Call(`_hpa_print_summary_hpaSelection`, x))
}

#' Calculates log-likelihood for "hpaSelection" object
#' @description This function calculates log-likelihood for 
#' "hpaSelection" object
#' @param object Object of class "hpaSelection"
#' @export
logLik_hpaSelection <- function(object) {
    .Call(`_hpa_logLik_hpaSelection`, object)
}

#' Calculate k-th order moment of normal distribution
#' @description This function recursively calculates k-th order moment of 
#' normal distribution.
#' @param k non-negative integer moment order.
#' @param mean numeric expected value.
#' @param sd positive numeric standard deviation.
#' @param return_all_moments logical; if \code{TRUE}, function returns 
#' (k+1)-dimensional numeric vector of moments of normally distributed random 
#' variable with mean = \code{mean} and standard deviation = \code{sd}. 
#' Note that i-th vector's component value corresponds to the (i-1)-th moment.
#' @template is_validation_Template
#' @param is_central logical; if \code{TRUE}, then central moments 
#' will be calculated.
#' @details This function estimates \code{k}-th order moment of normal 
#' distribution which mean equals to \code{mean} and standard deviation 
#' equals to \code{sd}.\cr
#' @template k_integer_Template
#' @template diff_type_Template
#' @return This function returns \code{k}-th order moment of
#' normal distribution which mean equals to \code{mean} and standard deviation 
#' is \code{sd}. If \code{return_all_moments} is \code{TRUE} then see this 
#' argument description above for output details.
#' @examples
#' ## Calculate 5-th order moment of normal random variable which
#' ## mean equals to 3 and standard deviation is 5.
#'
#' # 5-th moment
#' normalMoment(k = 5, mean = 3, sd = 5)
#' 
#' # (0-5)-th moments
#' normalMoment(k = 5, mean = 3, sd = 5, return_all_moments = TRUE)
#' 
#' # 5-th moment derivative respect to mean
#' normalMoment(k = 5, mean = 3, sd = 5, diff_type = "mean")
#' 
#' # 5-th moment derivative respect to sd
#' normalMoment(k = 5, mean = 3, sd = 5, diff_type = "sd")
#'
#' @export
normalMoment <- function(k = 0L, mean = 0, sd = 1, return_all_moments = FALSE, is_validation = TRUE, is_central = FALSE, diff_type = "NO") {
    .Call(`_hpa_normalMoment`, k, mean, sd, return_all_moments, is_validation, is_central, diff_type)
}

#' Calculate k-th order moment of truncated normal distribution
#' @description This function recursively calculates k-th order moment of 
#' truncated normal distribution.
#' @param k non-negative integer moment order.
#' @param x_lower numeric vector of lower truncation points.
#' @param x_upper numeric vector of upper truncation points.
#' @param mean numeric expected value.
#' @param sd positive numeric standard deviation.
#' @template pdf_lower_Template
#' @template cdf_lower_Template
#' @template pdf_upper_Template
#' @template cdf_upper_Template
#' @template cdf_difference_Template
#' @template is_validation_Template
#' @template is_parallel_Template
#' @template diff_type_Template
#' @param return_all_moments logical; if \code{TRUE}, function returns the 
#' matrix of moments of normally distributed random variable with 
#' mean = \code{mean} and standard deviation = \code{sd} under lower and upper 
#' truncation points \code{x_lower} and \code{x_upper} correspondingly. 
#' Note that element in i-th row and j-th column of this matrix corresponds to 
#' the i-th observation (j-1)-th order moment.
#' @details This function estimates \code{k}-th order moment of
#' normal distribution which mean equals to \code{mean} and standard deviation 
#' equals to \code{sd} truncated at points given by \code{x_lower} and 
#' \code{x_upper}. Note that the function is vectorized so you can provide
#' \code{x_lower} and \code{x_upper} as vectors of equal size. If vectors values 
#' for \code{x_lower} and \code{x_upper} are not provided then their default 
#' values will be set to \code{-(.Machine$double.xmin * 0.99)} and 
#' \code{(.Machine$double.xmax * 0.99)} correspondingly.
#' @template k_integer_Template
#' @template pdf_cdf_precalculated_Template
#' @return This function returns vector of k-th order moments for normally 
#' distributed random variable with mean = \code{mean} and standard 
#' deviation = \code{sd} under \code{x_lower} and \code{x_upper} truncation 
#' points \code{x_lower} and \code{x_upper} correspondingly. 
#' If \code{return_all_moments} is \code{TRUE} then see this argument 
#' description above for output details.
#' @examples
#' ## Calculate 5-th order moment of three truncated normal random  
#' ## variables (x1, x2, x3) which mean is 5 and standard deviation is 3. 
#' ## These random variables truncation points are given 
#' ## as follows:-1<x1<1, 0<x2<2, 1<x3<3.
#' k <- 3
#' x_lower <- c(-1, 0, 1, -Inf, -Inf)
#' x_upper <- c(1, 2 , 3, 2, Inf)
#' mean <- 3
#' sd <- 5
#' 
#' # get the moments
#' truncatedNormalMoment(k, x_lower, x_upper, mean, sd)
#'
#' # get matrix of (0-5)-th moments (columns) for each variable (rows)
#' truncatedNormalMoment(k, x_lower, x_upper, 
#'                       mean, sd, 
#'                       return_all_moments = TRUE)
#'
#' # get the moments derivatives respect to mean
#' truncatedNormalMoment(k, x_lower, x_upper, 
#'                       mean, sd, 
#'                       diff_type = "mean")
#' 
#' # get the moments derivatives respect to standard deviation
#' truncatedNormalMoment(k, x_lower, x_upper, 
#'                       mean, sd, 
#'                       diff_type = "sd")
#' 
#' @export
truncatedNormalMoment <- function(k = 1L, x_lower = numeric(0), x_upper = numeric(0), mean = 0, sd = 1, pdf_lower = numeric(0), cdf_lower = numeric(0), pdf_upper = numeric(0), cdf_upper = numeric(0), cdf_difference = numeric(0), return_all_moments = FALSE, is_validation = TRUE, is_parallel = FALSE, diff_type = "NO") {
    .Call(`_hpa_truncatedNormalMoment`, k, x_lower, x_upper, mean, sd, pdf_lower, cdf_lower, pdf_upper, cdf_upper, cdf_difference, return_all_moments, is_validation, is_parallel, diff_type)
}

#' Multivariate Polynomial Representation
#' @name polynomialIndex
#' @description Function \code{\link[hpa]{polynomialIndex}} 
#' provides matrix which allows to iterate through the elements 
#' of multivariate polynomial being aware of these elements powers. 
#' So (i, j)-th element of the matrix is power of j-th variable in i-th 
#' multivariate polynomial element.
#' 
#' Function \code{\link[hpa]{printPolynomial}} prints multivariate polynomial
#' given its degrees (\code{pol_degrees}) and coefficients 
#' (\code{pol_coefficients}) vectors.
#' @template pol_degrees_Template
#' @template pol_coefficients_Template
#' @details Multivariate polynomial of degrees   
#' \eqn{(K_{1},...,K_{m})} (\code{pol_degrees}) has the form:
#' \deqn{a_{(0,...,0)}x_{1}^{0}*...*x_{m}^{0}+ ... + 
#' a_{(K_{1},...,K_{m})}x_{1}^{K_{1}}*...*x_{m}^{K_{m}},}
#' where \eqn{a_{(i_{1},...,i_{m})}} are polynomial coefficients, while
#' polynomial elements are:
#' \deqn{a_{(i_{1},...,i_{m})}x_{1}^{i_{1}}*...*x_{m}^{i_{m}},}
#' where \eqn{(i_{1},...,i_{m})} are polynomial element's powers corresponding
#' to variables \eqn{(x_{1},...,x_{m})} respectively. Note that 
#' \eqn{i_{j}\in \{0,...,K_{j}\}}. 
#' 
#' Function \code{\link[hpa]{printPolynomial}} removes polynomial elements 
#' which coefficients are zero and variables which powers are zero. Output may 
#' contain long coefficients representation as they are not rounded.
#' @return Function \code{\link[hpa]{polynomialIndex}} 
#' returns matrix which rows are 
#' responsible for variables while columns are related to powers. 
#' So \eqn{(i, j)}-th element of this matrix corresponds to the 
#' power \eqn{i_{j}} of the \eqn{x_{j}} variable in \eqn{i}-th polynomial 
#' element. Therefore \eqn{i}-th column of this matrix contains vector of
#' powers \eqn{(i_{1},...,i_{m})} for the \eqn{i}-th polynomial element.
#' So the function transforms \eqn{m}-dimensional elements indexing
#' to one-dimensional.
#' 
#' Function \code{\link[hpa]{printPolynomial}} returns the string which 
#' contains polynomial symbolic representation.
#' @template polynomialIndex_examples_Template
#' @template printPol_examples_Template
#' @template is_validation_Template
#' @export
polynomialIndex <- function(pol_degrees = numeric(0), is_validation = TRUE) {
    .Call(`_hpa_polynomialIndex`, pol_degrees, is_validation)
}

#' @name polynomialIndex
#' @export
printPolynomial <- function(pol_degrees, pol_coefficients, is_validation = TRUE) {
    .Call(`_hpa_printPolynomial`, pol_degrees, pol_coefficients, is_validation)
}

#' @export
bsplineMult <- function(b, t1, t2, is_left = TRUE) {
    .Call(`_hpa_bsplineMult`, b, t1, t2, is_left)
}

#' @export
bsplineMerge <- function(b_left, b_right) {
    .Call(`_hpa_bsplineMerge`, b_left, b_right)
}

#' @export
bsplineNames <- function(b) {
    .Call(`_hpa_bsplineNames`, b)
}

#' B-splines generation, estimation and combination
#' @name bspline
#' @description Function \code{\link[hpa]{bsplineGenerate}} generates a list
#' of all basis splines with appropriate \code{knots} vector and \code{degree}.
#' Function \code{\link[hpa]{bsplineComb}} allows to get linear combinations
#' of these b-splines with particular \code{weights}. 
#' Function \code{\link[hpa]{bsplineEstimate}} estimates the spline at
#' points \code{x}. The structure of this spline should be provided via
#' \code{m} and \code{knots} arguments.
#' @details In contrast to \code{\link[splines]{bs}} function 
#' \code{\link[hpa]{bsplineGenerate}} generates a splines basis in a form
#' of a list containing information concerning these b-splines structure.
#' In order to evaluate one of these b-splines at particular points
#' \code{\link[hpa]{bsplineEstimate}} function should be applied.
#' @return Function \code{\link[hpa]{bsplineGenerate}} returns a list. Each
#' element of this list is a list containing the following
#' information concerning b-spline structure:
#' \itemize{
#' \item \code{knots} - knots vector of the b-spline. 
#' \item \code{m} - matrix representing polynomial coefficients for each
#' interval of the spline in the same manner as for \code{m} argument
#' (see this argument description above).
#' \item \code{ind} - index of the b-spline.}
#' Function \code{bsplineComb} returns a list with the following arguments:
#' \itemize{
#' \item \code{knots} - knots vector of the \code{splines}. 
#' \item \code{m} - linear combination of the \code{splines} matrices; 
#' coefficients of this linear combination are given 
#' via \code{weights} argument.}
#' @return Function \code{\link[hpa]{bsplineGenerate}} returns a numeric
#' vector of values being calculated at points \code{x} via splines with 
#' \code{knots} vector and matrix \code{m}.
#' @template knots_Template
#' @template degree_Template
#' @template m_Template
#' @param is_names logical; if TRUE (default) then rows and columns of the
#' spline matrices will have a names. Set it to FALSE in order to get notable 
#' speed boost.
#' @template bsplines_examples_Template
#' @export
bsplineGenerate <- function(knots, degree, is_names = TRUE) {
    .Call(`_hpa_bsplineGenerate`, knots, degree, is_names)
}

#' @name bspline
#' @param x numeric vector representing the points at which the 
#' spline should be estimated.
#' @export
bsplineEstimate <- function(x, m, knots) {
    .Call(`_hpa_bsplineEstimate`, x, m, knots)
}

#' @name bspline
#' @param splines list being returned by the 
#' \code{\link[hpa]{bsplineGenerate}} function or a manually constructed
#' list with b-splines knots and matrices entries.
#' @param weights numeric vector of the same length as \code{splines}.
#' @export
bsplineComb <- function(splines, weights) {
    .Call(`_hpa_bsplineComb`, splines, weights)
}

#' Probabilities and Moments Hermite Spline Approximation
#' @name hsaDist
#' @param x numeric vector of values for which the function should 
#' be estimated.
#' @template m_Template
#' @template knots_Template
#' @param mean expected value of a normal distribution.
#' @param sd standard deviation of a normal distribution.
#' @template log_Template
#' @description The set of functions similar to \code{\link[hpa]{dhpa}}-like
#' functions. The difference is that instead of polynomial these functions
#' utilize spline.
#' @details In contrast to \code{\link[hpa]{dhpa}}-like functions these
#' functions may deal with univariate distributions only. In future this
#' functions will be generalized to work with multivariate distributions.
#' The main idea of these functions is to use squared spline instead of squared 
#' polynomial in order to provide greater numeric stability and approximation 
#' accuracy. To provide spline parameters please use \code{m} and \code{knots}
#' arguments (i.e. instead of \code{pol_degrees} and \code{pol_coefficients}
#' arguments that where used to specify the polynomial
#' for \code{\link[hpa]{dhpa}}-like functions).
#' @return Function \code{\link[hpa]{dhsa}} returns vector of probabilities
#' of the same length as \code{x}. Function \code{\link[hpa]{ehsa}} 
#' returns moment value.
#' @seealso \code{\link[hpa]{dhpa}}, \code{\link[hpa]{bsplineGenerate}}
#' @template dhsa_examples_Template
#' @export
dhsa <- function(x, m, knots, mean = 0, sd = 1, log = FALSE) {
    .Call(`_hpa_dhsa`, x, m, knots, mean, sd, log)
}

#' @name hsaDist
#' @param power non-negative integer representing the power of the 
#' expected value i.e. E(X ^ power) will be estimated.
#' @export
ehsa <- function(m, knots, mean = 0, sd = 1, power = 1) {
    .Call(`_hpa_ehsa`, m, knots, mean, sd, power)
}

# Register entry points for exported C++ functions
methods::setLoadAction(function(ns) {
    .Call('_hpa_RcppExport_registerCCallable', PACKAGE = 'hpa')
})

Try the hpa package in your browser

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

hpa documentation built on May 31, 2023, 8:25 p.m.