GK-work merged to master

.gitignore

@@ -7,6 +7,6 @@ Rplots.pdf
 revdep/
 /doc/
 /Meta/
-
 # Claude Code local settings
 .claude/
+.DS_Store

DESCRIPTION

@@ -74,7 +74,8 @@ Imports:
     rgl,
     colorspace,
     gt,
-    scales
+    scales,
+    methods
 Description: Provides additional data sets, methods and documentation to complement the 'vcd' package for Visualizing Categorical Data
     and the 'gnm' package for Generalized Nonlinear Models.
 	In particular, 'vcdExtra' extends mosaic, assoc and sieve plots from 'vcd' to handle 'glm()' and 'gnm()' models and

NAMESPACE

@@ -48,6 +48,10 @@ export(HLtest)
 export(Kway)
 export(LRstats)
 export(Summarise)
+export(as_array)
+export(as_caseform)
+export(as_freqform)
+export(as_table)
 export(assoc_graph)
 export(blogits)
 export(center3d)
@@ -87,6 +91,7 @@ importFrom(MASS,loglm)
 importFrom(ca,cacoord)
 importFrom(ca,multilines)
 importFrom(dplyr,all_of)
+importFrom(dplyr,as_tibble)
 importFrom(dplyr,everything)
 importFrom(gnm,meanResiduals)
 importFrom(grDevices,col2rgb)
@@ -106,6 +111,7 @@ importFrom(grid,seekViewport)
 importFrom(grid,unit)
 importFrom(grid,upViewport)
 importFrom(grid,viewport)
+importFrom(methods,is)
 importFrom(rgl,translate3d)
 importFrom(stats,as.formula)
 importFrom(stats,chisq.test)

R/as_array.R

@@ -0,0 +1,46 @@
+#' Convert frequency, case, or table form data into an array
+#' 
+#' Converts object (`obj`) in frequency, case or table form into an array. The 
+#' column containing the frequencies (`freq`) must be supplied if `obj` is in 
+#' frequency form.
+#' 
+#' @param obj object to be converted to an array
+#' @param freq If `obj` is in frequency form, this is the name of the frequency column. Leave as `NULL` if `obj` is in any other form.
+#' @param dims A character vector of dimensions. If not specified, all variables apart from `freq` will be used as dimensions
+#' @return object in array form
+#' 
+#' @details
+#' Unclasses the \code{as_table()} function to return an object in array form.
+#' 
+#' @author Gavin M. Klorfine
+#' 
+#' @examples
+#' library(vcdExtra)
+#' 
+#' data("HairEyeColor")
+#' 
+#' freqForm <- as.data.frame(HairEyeColor) # Generate frequency form data
+#' tidy_freqForm <- dplyr::as_tibble(HairEyeColor) # Generate tidy frequency form data
+#' caseForm <- expand.dft(freqForm) # Generate case form data
+#' 
+#' # Frequency form -> array form
+#' as_array(freqForm, freq = "Freq") |> str()
+#' 
+#' # Warned if forgot to specify freq
+#' as_array(freqForm) |> str()
+#' 
+#' # Case form -> array form
+#' as_array(caseForm) |> str()
+#' 
+#' # Frequency (tibble) form -> array form
+#' as_array(tidy_freqForm, freq = "n") |> str()
+#' 
+#' # For specific dimensions
+#' as_array(tidy_freqForm, freq = "n", dims = c("Hair", "Eye")) |> str()
+#' 
+#' 
+#' @export
+
+as_array <- function(obj, freq = NULL, dims = NULL){
+  return(unclass(as_table(obj, freq, dims))) # Unclass as_table output
+}

R/as_caseform.R

@@ -0,0 +1,58 @@
+#' Convert frequency or table form into case form.
+#' 
+#' Converts object (`obj`) in frequency or table form into case form. The 
+#' column containing the frequencies (`freq`) must be supplied if `obj` is in 
+#' frequency form. Returns a tibble if `tidy` is set to `TRUE`.
+#' 
+#' @param obj object to be converted to case form
+#' @param freq If `obj` is in frequency form, this is the name of the frequency column. If `obj` is in any other form, do not supply an argument (see "Details")
+#' @param dims A character vector of dimensions. If not specified, all variables apart from `freq` will be used as dimensions
+#' @param tidy returns a tibble if set to TRUE
+#' @return object in case form.
+#' 
+#' @details
+#' A wrapper for \code{expand.dft()} that is able to handle arrays.
+#' 
+#' If a frequency column is not supplied, this function defaults to "Freq"
+#' just like \code{expand.dft()}. Converts `obj` to a table using 
+#' \code{as_table()} before converting to case form.
+#' 
+#' @author Gavin M. Klorfine
+#' 
+#' @importFrom dplyr as_tibble
+#' 
+#' @examples
+#' library(vcdExtra)
+#' 
+#' data("HairEyeColor")
+#' 
+#' freqForm <- as.data.frame(HairEyeColor) # Generate frequency form data
+#' tidy_freqForm <- dplyr::as_tibble(HairEyeColor) # Generate tidy frequency form data
+#' tableForm <- as_table(HairEyeColor) # Generate table form data
+#' arrayDat <- as_array(HairEyeColor) # Generate an array
+#' 
+#' # Frequency form -> case form
+#' as_caseform(freqForm) |> str()
+#' 
+#' # Frequency form (tibble) -> case form
+#' as_caseform(tidy_freqForm, freq = "n") |> str()
+#' 
+#' # Array -> case form
+#' as_caseform(arrayDat) |> str()
+#' 
+#' # Optionally specify dims
+#' as_caseform(tableForm, dims = c("Hair", "Eye")) |> str()
+#'
+#' 
+#' @export
+
+as_caseform <- function(obj, freq = "Freq", dims = NULL, tidy = TRUE){
+
+  tab <- expand.dft(as_table(obj, freq = freq, dims = dims), freq = freq)
+
+  if (tidy){
+    tab <- dplyr::as_tibble(tab)
+  }
+
+  return(tab)
+}

R/as_freqform.R

@@ -0,0 +1,59 @@
+#' Convert any form (case or table form) into frequency form.
+#' 
+#' A wrapper for \code{as.data.frame()} that is able to properly handle arrays.
+#' Converts object (`obj`) in case or table form into frequency form. The 
+#' column containing the frequencies (`freq`) must be supplied if `obj` is 
+#' already in frequency form (and you are using this function to select
+#' dimensions). Returns a tibble if `tidy` is set to `TRUE`.
+#' 
+#' @param obj object to be converted to frequency form
+#' @param freq If `obj` is already in frequency form, this is the name of the frequency column. If `obj` is in any other form, do not supply an argument (see "Details")
+#' @param dims A character vector of dimensions. If not specified, all variables apart from `freq` will be used as dimensions
+#' @param tidy returns a tibble if set to TRUE
+#' @return object in frequency form.
+#' 
+#' @details
+#' Converts `obj` to a table using \code{as_table()} before converting to
+#' frequency form
+#' 
+#' @author Gavin M. Klorfine
+#' 
+#' @importFrom dplyr as_tibble
+#' 
+#' @examples
+#' library(vcdExtra)
+#' 
+#' data("HairEyeColor")
+#' 
+#' freqForm <- as.data.frame(HairEyeColor) # Generate frequency form data
+#' tableForm <- as_table(HairEyeColor) # Generate table form data
+#' arrayDat <- as_array(HairEyeColor) # Generate an array
+#' caseForm <- as_caseform(HairEyeColor) # Generate case form data
+#' 
+#' # array -> frequency form
+#' as_freqform(arrayDat) |> str()
+#' 
+#' # table -> frequency form
+#' as_freqform(tableForm) |> str()
+#' 
+#' # case -> frequency form
+#' as_freqform(caseForm) |> str()
+#' 
+#' # Selecting dimensions (optional)
+#' as_freqform(freqForm, freq = "Freq", dims = c("Hair", "Eye")) |> str()
+#' 
+#' as_freqform(tableForm, dims = c("Hair", "Eye")) |> str()
+#' 
+#' 
+#' @export
+
+as_freqform <- function(obj, freq = NULL, dims = NULL, tidy = TRUE){
+
+  tab <- as.data.frame(as_table(obj, freq = freq, dims = dims))
+
+  if (tidy){
+    tab <- dplyr::as_tibble(tab)
+  }
+
+  return(tab)
+}

R/as_table.R

@@ -0,0 +1,152 @@
+#' Convert frequency or case form data into table form
+#' 
+#' Converts object (`obj`) in frequency or case form into table form. The 
+#' column containing the frequencies (`freq`) must be supplied if `obj` is in 
+#' frequency form. Optionally returns a table of proportions with (optionally) specified margins.
+#' 
+#' @param obj object to be converted to table form
+#' @param freq If `obj` is in frequency form, this is the name of the frequency column. Leave as `NULL` if `obj` is in any other form.
+#' @param dims A character vector of dimensions. If not specified, all variables apart from `freq` will be used as dimensions
+#' @param prop If set to TRUE, returns a table of proportions. May also be set to a character or numeric vector of margins.
+#' @return object in table form
+#' 
+#' @details
+#' If `obj` was in table form to begin with, it is returned to the user as-is
+#' unless dimensions were specified (in which case it returns a table with
+#' entries summed over excluded dimensions). When `prop` is set to `TRUE`, the 
+#' returned table will have proportions that sum to one, whereas if a character 
+#' or numerical vector of table dimensions is supplied to `prop`, proportions 
+#' will be marginalized across the specified dimensions.
+#' 
+#' @author Gavin M. Klorfine
+#' 
+#' @importFrom stats reformulate xtabs
+#' @importFrom methods is
+#' 
+#' @examples
+#' library(vcdExtra)
+#' 
+#' data("HairEyeColor")
+#' 
+#' freqForm <- as.data.frame(HairEyeColor) # Generate frequency form data
+#' tidy_freqForm <- dplyr::as_tibble(HairEyeColor) # Generate tidy frequency form data
+#' caseForm <- expand.dft(freqForm) # Generate case form data
+#' 
+#' # Frequency form -> table form
+#' as_table(freqForm, freq = "Freq") |> str()
+#' 
+#' # Warned if forgot to specify freq
+#' as_table(freqForm) |> str()
+#' 
+#' # Frequency form (tibble) -> table form
+#' as_table(tidy_freqForm, freq = "n") |> str()
+#' 
+#' # Case form -> table form
+#' as_table(caseForm) |> str()
+#' 
+#' # For specific dimensions
+#' as_table(tidy_freqForm, freq = "n", dims = c("Hair", "Eye")) |> str()
+#' 
+#' #-----For proportions-----#
+#' 
+#' as_table(freqForm, freq = "Freq", prop = TRUE) |> head(c(4,4,1)) # print only Sex == Male rows
+#' 
+#' # Marginalize proportions along "Sex" (i.e., male proportions sum to 1, female proportions sum to 1)
+#' as_table(freqForm, freq = "Freq", prop = "Sex") |> head(c(4,4,1))
+#' 
+#' as_table(freqForm, freq = "Freq", prop = 3) |> head(c(4,4,1)) # Same as above
+#' 
+#' # Marginalize proportions along multiple variables
+#' as_table(freqForm, freq = "Freq", prop = c("Hair", "Sex")) |> head(c(4,4,1))
+#' 
+#' as_table(freqForm, freq = "Freq", prop = c(1, 3)) |> head(c(4,4,1)) # Same as above
+#' 
+#' # Using dims and prop arguments in tandem
+#' as_table(freqForm, freq = "Freq", dims = c("Hair", "Eye"), prop = TRUE)
+#' 
+#' 
+#' @export
+
+as_table <- function(obj, freq = NULL, dims = NULL, prop = NULL){
+
+  # If user supplied a table or array, remember that
+  tab_or_array <- FALSE
+  if (is(obj, "table") || is(obj, "array")){
+
+    tab <- as.table(obj) # Handle arrays
+
+    # To include dimensions if specified
+    if (!is.null(dims)){
+      tab <- margin.table(tab, margin = dims)
+    }
+
+    tab_or_array <- TRUE
+  }
+  # If obj is a tibble, convert to data frame
+  else if (is(obj, "table")){
+    obj <- as.data.frame(obj)
+  }
+
+  if (!is.null(dims)){ # If dims supplied by user, use those
+    cols <- dims
+  }
+  else { # If dims NOT supplied by user, use everything else
+    cols <- colnames(obj)
+  }
+
+  if (!tab_or_array){ # If not a table or array...
+    if (!is.null(freq)){  # If freq supplied by user, then... (freq form)
+      cols <- cols[cols != freq] # Remove freq column
+      tab <- xtabs(reformulate(cols, response = freq), data = obj) # freq ~ cols
+    }
+    else if (is.null(freq)){ # If freq NOT supplied by user, and not array, then... (case form)
+      tab <- xtabs(reformulate(cols), data = obj)
+
+      # Check if user forgot to supply freq, warn if they potentially forgot
+      common <- c("n", "freq", "frequency", "count")
+      if (length(intersect(tolower(colnames(obj)), common)) > 0){
+        warning("Ensure a value for 'freq' was supplied if your data was in frequency form.")
+      }
+    }
+  }
+
+
+  if (!is.null(prop)){ # If user wants proportions
+
+    if (is(prop, "logical") && prop == TRUE){ # If margins not specified
+      tab <- prop.table(tab)
+    }
+    else if (is.character(prop) || is.numeric(prop)){ # If proportions are to be marginal
+
+      ### Make sure margins are not problematic ###
+      if (length(prop) > length(dim(tab))){ # Raise error if # of margin dims exceeds actual # of dims
+        stop("Number of specified margins in `prop` exceeds number of dims in table.")
+      }
+      if (length(unique(prop)) != length(prop)){ # Make sure prop margins are unique
+        stop("`prop` margins are not unique (i.e., a duplicate was provided).")
+      }
+      # If character vector for proportion margins, make sure margins in prop are a subset of dims in table
+      if (is.character(prop) && length(prop) != length(intersect(prop, names(dimnames(tab))))){ 
+        stop("Ensure all margins specified in `prop` are dims in the table.")
+      }
+      # If numeric vector for proportion margins, 
+      else if(is.numeric(prop)){
+        if (!all(prop > 0) || !all(prop %% 1 == 0)){ # Make sure margins in prop are positive, whole nums
+          stop("Ensure all margins specified in `prop` are positive whole numbers.")
+        }
+        if (!all(prop <= length(dim(tab)))){ # Make sure margins in prop do not exceed # of dims in table
+          stop("Ensure all margins specified in `prop` do not exceed the total number of dims in the table.")
+        }
+      }
+      ### 
+
+      tab <- prop.table(tab, margin = prop)
+    }
+    else{ # If prop not TRUE or a numeric / character vector
+      stop("Argument `prop` must be supplied with either a numeric or character vector")
+    }
+  }
+
+
+  return(tab)
+}

_pkgdown.yml

@@ -141,4 +141,13 @@ reference:
       - Vietnam
       - Vote1980
       - WorkerSat
-      - Yamaguchi87
+      - Yamaguchi87
+
+  - title: Conversions
+    desc: converting between table, freq, case, array forms
+    contents:
+      - as_table
+      - as_array
+      - as_freqform
+      - as_caseform
+