https://github.com/cran/robCompositions
Tip revision: 6cf109eab116e889a3e3bcc1309cbdcc254895e8 authored by Matthias Templ on 25 August 2023, 15:30:06 UTC
version 2.4.1
version 2.4.1
Tip revision: 6cf109e
ilr.2x2.R
#' ilr coordinates in 2x2 compositional tables
#'
#' ilr coordinates of original, independent and interaction compositional table using SBP1 and SBP2
#'
#' @param x a 2x2 table
#' @param margin for 2x2 tables available for a whole set of another dimension.
#' For example, if 2x2 tables are available for every country.
#' @param type choose between \dQuote{independence} or \dQuote{interaction} table
#' @param version the version used in the \dQuote{paper} below or the version of
#' the \dQuote{book}.
#' @author Kamila Facevicova, Matthias Templ
#' @return The ilr coordinates
#' @references
#' Facevicova, K., Hron, K., Todorov, V., Guo, D., Templ, M. (2014).
#' Logratio approach to statistical analysis of 2x2 compositional tables.
#' \emph{Journal of Applied Statistics}, 41 (5), 944--958.
#' @export
#' @examples
#' data(employment)
#' ilr.2x2(employment[,,"AUT"])
#' ilr.2x2(employment[,,"AUT"], version = "paper")
#' ilr.2x2(employment, margin = 3, version = "paper")
#' ilr.2x2(employment[,,"AUT"], type = "interaction")
ilr.2x2 <- function(x, margin = 1, type = "independence", version = "book"){
ilrind <- function(x){
z1 <- z2 <- numeric(3)
z1[1] <- (1/3^(1/2))*log(x[1,1]/x[2,2])
z1[2] <- (2^(1/2)/(4*3^(1/2)))*log((x[1,1]*x[2,1]^3)/(x[1,2]^3*x[2,2]))
z1[3] <- (1/(2*2^(1/2)))*log((x[1,1]*x[1,2])/(x[2,1]*x[1,1]))
z2[1] <- (1/2)*log((x[1,1]*x[2,2])/(x[2,1]*x[1,2]))
z2[2] <- (1/2^(1/2))*log(x[2,1]/x[1,2])
list(z1=z1, z2=z2)
}
ilrintPaper <- function(x){
z2 <- (1/2)*log((x[1,1]*x[2,2])/(x[2,1]*x[1,2]))
z1 <- numeric(3)
z1[1] <- (3^(1/2)/6)*log((x[1,1]*x[2,2])/(x[2,1]*x[1,2]))
z1[2] <- (6^(1/2)/12)*log((x[2,1]*x[1,2])/(x[1,1]*x[2,2]))
z1[3] <- (2^(1/2)/4)*log((x[2,1]*x[1,2])/(x[1,1]*x[2,2]))
list(z1=z1, z2=z2)
}
ilrorigPaper <- function(x){
z1 <- z2 <- numeric(3)
z1[1] <- (3^(1/2)/2)*log(x[1,1]/(x[2,1]*x[1,2]*x[2,2])^(1/3))
z1[2] <- (2/3)^(1/2)*log(x[2,1]/(x[1,2]*x[2,2])^(1/2))
z1[3] <- 1/2^(1/2)*log(x[1,2]/x[2,2])
z2[1] <- 1/2*log((x[1,1]*x[2,2])/(x[2,1]*x[1,2]))
z2[2] <- 1/2^(1/2)*log(x[2,1]/x[1,2])
z2[3] <- 1/2^(1/2)*log(x[1,1]/x[2,2])
list(z1=z1, z2=z2)
}
ilrorig <- function(x){
z1 <- z2 <- numeric(3)
z1[1] <- 1/2 * log((x[1,1] * x[2,2]) / (x[1,2] * x[2,1]))
z1[2] <- 1 / sqrt(2) * log(x[1,2]/x[2,1])
z1[3] <- 1 / sqrt(2) * log(x[1,1]/x[2,2])
z2[1] <- NA
z2[2] <- NA
z2[3] <- NA
list(z1=z1, z2=z2)
}
ilrint <- function(x){
z1 <- z2 <- numeric(3)
z1[1] <- 1/2 * log((x[1,1] * x[2,2])/(x[1,2]*x[2,1]))
z1[2] <- 1/2 * log((x[1,1] * x[1,2])/(x[2,1]*x[2,2]))
z1[3] <- 1/2 * log((x[1,1] * x[2,1])/(x[1,2]*x[2,2]))
z2[1] <- NA
z2[2] <- NA
z2[3] <- NA
list(z1=z1, z2=z2)
}
stopifnot(type %in% c("independence", "interaction"))
stopifnot(version %in% c("paper", "book"))
if(type == "independence" & version == "paper"){
method = "ilrorigPaper"
}
if(type == "independence" & version == "book"){
method = "ilrorig"
}
if(type == "interaction" & version == "paper"){
method = "ilrintPaper"
}
if(type == "interaction" & version == "book"){
method = "ilrint"
}
ilrmethod <- function(x, type) {
switch(type,
ilrind = ilrind(x),
ilrorigPaper = ilrorigPaper(x),
# ilrindPaper = ilrindPaper(x),
ilrint = ilrint(x),
ilrintPaper = ilrintPaper(x),
ilrorig = ilrorig(x))
}
# if(!is.null(method)){
# stopifnot(method %in% c("ilrind","ilrintPaper","ilrorigPaper",
# "ilrorig","ilrint","ilrindPaper"))
# }
# if(is.null(method)){
# method <- ifelse(class(x) == "ind2x2", "ilrindPaper",
# ifelse(class(x) == "int2x2", "ilrintPaper",
# "ilrorig"))
# }
dn <- dimnames(x)
if(length(dim(x)) == 2){
res <- ilrmethod(x, method)
} else {
res <- apply(x, margin, ilrmethod, type=method)
}
# class(res) <- "ilr2x2"
res
}