#' Score transformation
#'
#' @description
#'
#' `r rlang:::lifecycle("stable")`
#'
#' These functions calculate the scores according to:
#'
#' * `score_z`: Normal(z) distribution
#' * `score_mad`: Mean absolute deviation
#' * `score_t`: t-distribution
#' * `score_chi`: chi-distribution
#'
#' @details Because function are known with different names:
#' * `score_z` is identical to `std_mean`
#' * `score_mad` is identical to `std_median`
#'
#'
#' @template x-na
#'
#' @name score
#' @export
#' @seealso \code{\link[outliers]{scores}}
#' @template return
#' @examples
#'
#' x <- seq(-3,3,0.5)
#' score_z(x)
#' score_mad(x)
#' score_t(x)
#'
score_z <- function(x, na.rm = getOption("transx.na.rm")) {
assert_uni_ts(x)
x <- with_na_rm(x, na.rm)
out <- zscore_(x)
with_attrs(out, x)
}
#' @importFrom stats sd var
zscore_ <- function(x) {
(x - mean(x))/sd(x)
}
#' @rdname score
#' @export
score_mad <- function(x, na.rm = getOption("transx.na.rm")) {
assert_uni_ts(x)
x <- with_na_rm(x, na.rm)
out <- madscore_(x)
with_attrs(out, x)
}
#' @importFrom stats median mad
madscore_ <- function(x) {
(x - median(x) )/ mad(x)
}
#' @rdname score
#' @export
score_t <- function(x, na.rm = getOption("transx.na.rm")) {
assert_uni_ts(x)
x <- with_na_rm(x, na.rm)
n <- length(x)
t <- zscore_(x)
out <- (t * sqrt(n - 2))/sqrt(n - 1 - t^2)
with_attrs(out, x)
}
#' @rdname score
#' @export
score_chisq <- function(x, na.rm = getOption("transx.na.rm")){
assert_uni_ts(x)
x <- with_na_rm(x, na.rm)
out <- (x - mean(x))^2/var(x)
with_attrs(out, x)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.