R/RcppExports.R

Defines functions speed_theta_ml info score fastZIP_logistic_ fastZIP_binomial_ grad_ZINB grad_ZIP_logit grad_ZIP_probit grad_ZIP dmudeta_logit dmudeta_probit loglik_ZINB loglik_ZIP invprobit invlogit probit logit

Documented in info invlogit invprobit logit score speed_theta_ml

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

#' @title logit and inverse logit functions
#'
#' @description
#' transform \code{x} either via the logit, or inverse logit.
#'
#' @details
#' The loogit and inverse logit functions are part of R via the
#' logistic distribution functions in the stats package.
#' Quoting from the documentation for the logistic distribution
#'
#' "\code{qlogis(p)} is the same as the \code{logit} function, \code{logit(p) =
#' log(p/1-p)}, and \code{plogis(x)} has consequently been called the 'inverse
#' logit'."
#'
#' See the examples for benchmarking these functions.  The \code{logit} and
#' \code{invlogit} functions are faster than the \code{qlogis} and \code{plogis}
#' functions.
#'
#' @seealso \code{\link[stats]{qlogis}}
#'
#' @examples
#' library(rbenchmark)
#'
#' # compare logit to qlogis
#' p <- runif(1e5)
#' identical(logit(p), qlogis(p))
#' benchmark(logit(p), qlogis(p))
#'
#' # compare invlogit to plogis
#' x <- runif(1e5, -1000, 1000)
#' identical(invlogit(x), plogis(x))
#' benchmark(invlogit(x), plogis(x))
#'
#' @param x a numeric vector
#' @export
#' @rdname logit
logit <- function(x) {
    .Call('_gravity_logit', PACKAGE = 'gravity', x)
}

probit <- function(x) {
    .Call('_gravity_probit', PACKAGE = 'gravity', x)
}

#' @export
#' @rdname logit
invlogit <- function(x) {
    .Call('_gravity_invlogit', PACKAGE = 'gravity', x)
}

#' @export
#' @rdname logit
invprobit <- function(x) {
    .Call('_gravity_invprobit', PACKAGE = 'gravity', x)
}

#' @export
loglik_ZIP <- function(params, x, z, y, weights, offsetx, offsetz, link = "probit") {
    .Call('_gravity_loglik_ZIP', PACKAGE = 'gravity', params, x, z, y, weights, offsetx, offsetz, link)
}

#' @export
loglik_ZINB <- function(params, x, z, y, weights, offsetx, offsetz, link = "probit") {
    .Call('_gravity_loglik_ZINB', PACKAGE = 'gravity', params, x, z, y, weights, offsetx, offsetz, link)
}

dmudeta_probit <- function(eta) {
    .Call('_gravity_dmudeta_probit', PACKAGE = 'gravity', eta)
}

dmudeta_logit <- function(eta) {
    .Call('_gravity_dmudeta_logit', PACKAGE = 'gravity', eta)
}

grad_ZIP <- function(params, x, z, y, weights, offsetx, offsetz, link = "probit") {
    .Call('_gravity_grad_ZIP', PACKAGE = 'gravity', params, x, z, y, weights, offsetx, offsetz, link)
}

grad_ZIP_probit <- function(params, x, z, y, weights, offsetx, offsetz) {
    .Call('_gravity_grad_ZIP_probit', PACKAGE = 'gravity', params, x, z, y, weights, offsetx, offsetz)
}

grad_ZIP_logit <- function(params, x, z, y, weights, offsetx, offsetz) {
    .Call('_gravity_grad_ZIP_logit', PACKAGE = 'gravity', params, x, z, y, weights, offsetx, offsetz)
}

grad_ZINB <- function(params, x, z, y, weights, offsetx, offsetz, link = "probit") {
    .Call('_gravity_grad_ZINB', PACKAGE = 'gravity', params, x, z, y, weights, offsetx, offsetz, link)
}

fastZIP_binomial_ <- function(x, z, y, weights, offsetx, offsetz, start, eps_f, eps_g, maxit) {
    .Call('_gravity_fastZIP_binomial_', PACKAGE = 'gravity', x, z, y, weights, offsetx, offsetz, start, eps_f, eps_g, maxit)
}

fastZIP_logistic_ <- function(x, z, y, weights, offsetx, offsetz, start, eps_f, eps_g, maxit) {
    .Call('_gravity_fastZIP_logistic_', PACKAGE = 'gravity', x, z, y, weights, offsetx, offsetz, start, eps_f, eps_g, maxit)
}

#' Score for negative binomial maximum-likelihood estimates
#' 
#' @param n Number of observations
#' @param th \eqn{\theta} parameter
#' @param mu Predicted values
#' @param y Observed values
#' 
#' @return Score value
score <- function(n, th, mu, y) {
    .Call('_gravity_score', PACKAGE = 'gravity', n, th, mu, y)
}

#' Information iteration value
#' 
#' @inheritParams score
info <- function(n, th, mu, y) {
    .Call('_gravity_info', PACKAGE = 'gravity', n, th, mu, y)
}

#' Maximum likelihood estimation for negative binomial models
#' 
#' Simplified C++ function for \link[MASS]{theta.ml}
#' 
#' @inheritParams MASS::theta.ml
#' @importFrom MASS theta.ml
#' 
#' @return A maximum-likelihood estimator for \eqn{\theta}
#' 
#' @seealso \link{fastglm.nb} ; \link[MASS]{theta.ml} ; \link[MASS]{glm.nb}
#' 
#' @references <Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer>
#' 
#' @export
#' 
speed_theta_ml <- function(y, mu, limit = 10L, eps = 1e-6, trace = TRUE) {
    .Call('_gravity_speed_theta_ml', PACKAGE = 'gravity', y, mu, limit, eps, trace)
}
linogaliana/gravity documentation built on April 24, 2020, 2:06 a.m.