#**************************************************************************
#*
#* Original work Copyright (C) 2016 Antoine Pierucci
#*
#* This program is free software: you can redistribute it and/or modify
#* it under the terms of the GNU General Public License as published by
#* the Free Software Foundation, either version 3 of the License, or
#* (at your option) any later version.
#*
#* This program is distributed in the hope that it will be useful,
#* but WITHOUT ANY WARRANTY; without even the implied warranty of
#* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#* GNU General Public License for more details.
#*
#* You should have received a copy of the GNU General Public License
#* along with this program. If not, see <http://www.gnu.org/licenses/>.
#**************************************************************************
#' Convenience Functions to Compute Probabilities
#'
#' These convienience functions make it easier to compute
#' transition probabilities from indidence rates, OR, RR, or
#' probabilities estimated on a different timeframe.
#'
#' @name probability
#' @param p Probability.
#' @param r Rate.
#' @param or Odds ratio.
#' @param rr Relative risk.
#' @param to Compute probability for that timeframe.
#' @param from Timeframe of the original probability.
#' @param per Number of person-time corresponding to the
#' rate.
#' @param ... For deprecated functions.
#'
#' @return A probability.
#'
#' @example inst/examples/example_transform.R
NULL
#' @export
#' @rdname probability
rescale_prob <- function(p, to = 1, from = 1) {
stopifnot(
p >= 0,
p <= 1,
to > 0,
from > 0
)
r <- - log(1 - p) / from
rate_to_prob(r, to = to)
}
#' @export
#' @rdname probability
prob_to_prob <- function(...) {
warning("'prob_to_prob' is deprecated, use 'rescale_prob()' instead.")
rescale_prob(...)
}
#' @export
#' @rdname probability
rate_to_prob <- function(r, to = 1, per = 1) {
stopifnot(
r > 0,
to > 0,
per > 0
)
r <- r / per
1 - exp(- r * to)
}
#' @export
#' @rdname probability
or_to_prob <- function(or, p) {
stopifnot(
or >= 0,
p >= 0,
p <= 1
)
res <- 1 / (1 + exp(- log(p / (1 - p) + log(or))))
stopifnot(
res >= 0,
res <= 1
)
res
}
#' @export
#' @rdname probability
rr_to_prob <- function(rr, p) {
res <- rr * p
stopifnot(
rr >= 0,
p >= 0,
p <= 1,
res >= 0,
res <= 1
)
res
}
#' Rescale Discount Rate
#'
#' Rescale a discount rate between two time frames.
#'
#' Continuous discounting is assumed, i.e. when converting a
#' long-term discount rate into a short-term rate, we assume
#' that a partial gain from one short term is
#' multiplicatively discounted in all following short terms.
#' At the same time, we assume the short-term rate is
#' time-invariant.
#'
#' @param x Discount rate to rescale.
#' @param from Original time period.
#' @param to Final time period.
#'
#' @return Rate rescaled under the assumption of compound
#' discounting.
#'
#' @export
#'
#' @examples
#' ## 1% monthly interest rate to annual
#' rescale_discount_rate(0.01, 1, 12)
#' ## 3% annual discount rate to (approximately) weekly
#' rescale_discount_rate(0.03, 52, 1)
rescale_discount_rate <- function(x, from, to) {
((1 + x) ^ (to / from)) -1
}
#' Combine Probabilities
#'
#' Given several independent probabilities of an event,
#' return the final probability of the event.
#'
#' This function is only correct if the probabilities are
#' independent!
#'
#' @param ... Probability vectors.
#'
#' @return A probability vector.
#' @export
#'
#' @examples
#'
#' (p1 <- runif(5))
#' (p2 <- runif(5))
#' combine_probs(p1, p2)
#'
combine_probs <- function(...) {
combine_probs_(list(...))
}
combine_probs_ <- function(x) {
1 - Reduce("*", lapply(x, function(x) {1 - x}))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.