Skip to content
Snippets Groups Projects
Commit 2b5a2762 authored by Walmes Marques Zeviani's avatar Walmes Marques Zeviani
Browse files

Tidy the code and text and modify function

  - Apply 72 in all text and code;
  - Make dashes after commented sentences go until max column;
  - Replace the switch() statment by a do.call() in the
    mc_link_function().
  - Replace = by <- in assignments.
parent 96d083fa
No related branches found
No related tags found
No related merge requests found
......@@ -2,69 +2,76 @@
#'
#' @description The \code{mc_link_function} is a customized call of the
#' \code{\link[stats]{make.link}} function.
#' Given the name of a link function, it returns a list with two elements.
#' The first element is the inverse of the link function applied on the linear predictor
#' \eqn{\mu = g^{-1}(X\beta).} The second element is the derivative of mu with respect to the regression
#' parameters \eqn{\beta}. It will be useful when computing the quasi-score function.
#'
#' Given the name of a link function, it returns a list with two
#' elements. The first element is the inverse of the link function
#' applied on the linear predictor \eqn{\mu = g^{-1}(X\beta).} The
#' second element is the derivative of mu with respect to the regression
#' parameters \eqn{\beta}. It will be useful when computing the
#' quasi-score function.
#'
#' @param beta A numeric vector of regression parameters.
#' @param X A design matrix, see \code{\link[stats]{model.matrix}} for details.
#' @param offset A numeric vector of offset values. It will be sum up on the linear predictor as a
#' covariate with known regression parameter equals one (\eqn{\mu = g^{-1}(X\beta + offset)}).
#' If no offset is present in the model, set offset = NULL.
#' @param link A string specifing the name of the link function. mcglm implements the following
#' link functions: logit, probit, cauchit, cloglog, loglog, identity, log, sqrt, 1/mu^2 and inverse.
#' @param X A design matrix, see \code{\link[stats]{model.matrix}} for
#' details.
#' @param offset A numeric vector of offset values. It will be sum up on
#' the linear predictor as a covariate with known regression
#' parameter equals one (\eqn{\mu = g^{-1}(X\beta + offset)}). If
#' no offset is present in the model, set offset = NULL.
#' @param link A string specifing the name of the link function. mcglm
#' implements the following link functions: logit, probit, cauchit,
#' cloglog, loglog, identity, log, sqrt, 1/mu^2 and inverse.
#' @return A list with two elements: mu and D.
#' @seealso \code{\link[stats]{model.matrix}}, \code{\link[stats]{make.link}}.
#' @details The link function is an important component of the multivariate covariance generalized
#' linear model, since it link the expectation of the response variable with the covariates.
#' Let \eqn{\beta} a \eqn{p x 1} regression parameter vector and \eqn{X} an
#' \eqn{n x p} design matrix. The expected value of a response variable \eqn{Y} is given by
#' \deqn{E(Y) = g^{-1}(X\beta),} where \eqn{g} is the link function and \eqn{\eta = X\beta}
#' is the linear predictor. Let \eqn{D} be a \eqn{n \times p}
#' matrix whose entries are given by the derivatives of \eqn{mu} with respect to \eqn{\beta}.
#' Such matrix will be required by the fitting algorithm. The function \code{mc_link_function} returns
#' a list where the first element is mu (n x 1) vector and the second D (n x p) matrix.
#' @seealso \code{\link[stats]{model.matrix}},
#' \code{\link[stats]{make.link}}.
#' @details The link function is an important component of the
#' multivariate covariance generalized linear model, since it link
#' the expectation of the response variable with the covariates.
#' Let \eqn{\beta} a \eqn{p x 1} regression parameter vector and
#' \eqn{X} an \eqn{n x p} design matrix. The expected value of a
#' response variable \eqn{Y} is given by \deqn{E(Y) =
#' g^{-1}(X\beta),} where \eqn{g} is the link function and \eqn{\eta
#' = X\beta} is the linear predictor. Let \eqn{D} be a \eqn{n \times
#' p} matrix whose entries are given by the derivatives of \eqn{mu}
#' with respect to \eqn{\beta}. Such matrix will be required by the
#' fitting algorithm. The function \code{mc_link_function} returns a
#' list where the first element is mu (n x 1) vector and the second
#' D (n x p) matrix.
#' @examples
#' x1 <- seq(-1, 1, l = 5)
#' X <- model.matrix(~ x1)
#' mc_link_function(beta = c(1,0.5), X = X, offset = NULL, link = 'log')
#' mc_link_function(beta = c(1,0.5), X = X, offset = rep(10,5), link = 'identity')
#' mc_link_function(beta = c(1,0.5), X = X,
#' offset = NULL, link = 'log')
#' mc_link_function(beta = c(1,0.5), X = X,
#' offset = rep(10,5), link = 'identity')
#' @export
#' @import assertthat
# Generic link function ---------------------------
## Generic link function -----------------------------------------------
mc_link_function <- function(beta, X, offset, link) {
assert_that(noNA(beta))
assert_that(noNA(X))
if (!is.null(offset))
assert_that(noNA(offset))
switch(link, logit = {
output <- mc_logit(beta = beta, X = X, offset = offset)
}, probit = {
output <- mc_probit(beta = beta, X = X, offset = offset)
}, cauchit = {
output <- mc_cauchit(beta = beta, X = X, offset = offset)
}, cloglog = {
output <- mc_cloglog(beta = beta, X = X, offset = offset)
}, loglog = {
output <- mc_loglog(beta = beta, X = X, offset = offset)
}, identity = {
output <- mc_identity(beta = beta, X = X, offset = offset)
}, log = {
output <- mc_log(beta = beta, X = X, offset = offset)
}, sqrt = {
output <- mc_sqrt(beta = beta, X = X, offset = offset)
}, `1/mu^2` = {
output <- mc_invmu2(beta = beta, X = X, offset = offset)
}, inverse = {
output <- mc_inverse(beta = beta, X = X, offset = offset)
}, stop(gettextf("%s link not recognised", sQuote(link)), domain = NA))
link_name <- c("logit", "probit", "cauchit", "cloglog", "loglog",
"identity", "log", "1/mu^2", "inverse")
link_func <- c("mc_logit", "mc_probit", "mc_cauchit", "mc_cloglog",
"mc_loglog", "mc_identity", "mc_log", "mc_invmu2",
"mc_inverse")
names(link_func) <- link_name
if (!link %in% link_name) {
stop(gettextf(paste0("%s link not recognised. ",
"Available links are: ",
paste(link_name, collapse = ", "),
"."),
sQuote(link)), domain = NA)
}
output <- do.call(link_func[link],
args = list(beta = beta, X = X, offset = offset))
return(output)
}
#' @rdname mc_link_function
# Logit link function ---------------------------
## Logit link function -------------------------------------------------
mc_logit <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -75,7 +82,7 @@ mc_logit <- function(beta, X, offset) {
}
#' @rdname mc_link_function
# Probit link function ---------------------------
## Probit link function ------------------------------------------------
mc_probit <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -87,7 +94,7 @@ mc_probit <- function(beta, X, offset) {
}
#' @rdname mc_link_function
# Cauchit link function ---------------------------
## Cauchit link function -----------------------------------------------
mc_cauchit <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -99,7 +106,7 @@ mc_cauchit <- function(beta, X, offset) {
}
#' @rdname mc_link_function
# Complement log-log link function ---------------------------
## Complement log-log link function ------------------------------------
mc_cloglog <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -111,7 +118,7 @@ mc_cloglog <- function(beta, X, offset) {
}
#' @rdname mc_link_function
## Log-log link function ---------------------------
## Log-log link function -----------------------------------------------
mc_loglog <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -123,7 +130,7 @@ mc_loglog <- function(beta, X, offset) {
}
#' @rdname mc_link_function
## Identity link function ---------------------------
## Identity link function ----------------------------------------------
mc_identity <- function(beta, X, offset) {
eta <- X %*% beta
if (!is.null(offset)) {
......@@ -133,7 +140,7 @@ mc_identity <- function(beta, X, offset) {
}
#' @rdname mc_link_function
## Log link function ---------------------------
## Log link function ---------------------------------------------------
mc_log <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -144,7 +151,7 @@ mc_log <- function(beta, X, offset) {
}
#' @rdname mc_link_function
## Square-root link function ---------------------------
## Square-root link function -------------------------------------------
mc_sqrt <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
......@@ -155,25 +162,25 @@ mc_sqrt <- function(beta, X, offset) {
}
#' @rdname mc_link_function
## Inverse mu square link function ---------------------------
## Inverse mu square link function -------------------------------------
mc_invmu2 <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
eta <- eta + offset
}
mu = make.link("1/mu^2")$linkinv(eta = eta)
Deri = make.link("1/mu^2")$mu.eta(eta = eta)
mu <- make.link("1/mu^2")$linkinv(eta = eta)
Deri <- make.link("1/mu^2")$mu.eta(eta = eta)
return(list(mu = mu, D = X * Deri))
}
#' @rdname mc_link_function
## Inverse link function ---------------------------
## Inverse link function -----------------------------------------------
mc_inverse <- function(beta, X, offset) {
eta <- as.numeric(X %*% beta)
if (!is.null(offset)) {
eta <- eta + offset
}
mu = make.link("inverse")$linkinv(eta = eta)
Deri = make.link("inverse")$mu.eta(eta = eta)
mu <- make.link("inverse")$linkinv(eta = eta)
Deri <- make.link("inverse")$mu.eta(eta = eta)
return(list(mu = mu, D = X * Deri))
}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment