test-code/internal-functions.R

In ttrodrigz/onezero: Analysis tools for binary (0/1) data

library(tidyverse)
library(collapse)
library(onezero)
library(gdata)

fs <-
    FoodSample %>%
    select(2:5) %>%
    mutate(
        across(
            .cols = everything(),
            .fns = ~factor(.x, levels = c(1, 0))
        )
    )

wt <- FoodSample$weight

#' Goodman Kruskal Lambda
#'
#'
int_goodman_kruskal_lambda <- function(X, w) {

    items   <- colnames(X)
    n.items <- length(items)

    m <- matrix(
        nrow = n.items,
        ncol = n.items,
        dimnames = list(items, items)
    )

    for (i in seq_along(items)) {
        for (j in seq_along(items)) {

            if (i == j) {
                next
            }


            ct <- qtab(
                item_i = X[[i]],
                item_j = X[[j]],
                w = w
            )

            m[i, j] <- DescTools::Lambda(ct, direction = "row")
            m[j, i] <- DescTools::Lambda(ct, direction = "column")

        }
    }

    m

}

int_goodman_kruskal_lambda(
    X = fs,
    w = rep(1, times = nrow(fs))
)


xx <- matrix(
    data = c(118, 72, 182, 628),
    byrow = TRUE,
    nrow = 2,
    dimnames = list(
        "A" = c("Off", "On"),
        "B" = c("Off", "On")
    )
)

xx <- as.table(xx)

DescTools::Lambda(t(xx), direction = "row", conf.level = 0.95)
DescTools::Lambda(
    x = fs$Bisque,
    y = fs$Chicken
)

MESS::gkgamma(xx, )

yy <-
    xx %>%
    as_tibble() %>%
    uncount(weights = n) %>%
    mutate(
        across(
            .cols = everything(),
            .fns = ~factor(.x, levels = c("Off", "On"))
        )
    )

int_goodman_kruskal_lambda(yy, w = rep(1, times = 1000))