Add collapse_levels(), as_matrix(), prop arguments to applicable as_*() functions, and the a1a-collapse-convert vignette

.gitignore

@@ -10,3 +10,4 @@ revdep/
 # Claude Code local settings
 .claude/
 .DS_Store
+inst/doc

DESCRIPTION

@@ -62,6 +62,7 @@ Suggests:
     readxl, 
     stringr, 
     tidyr (>= 1.3.0),
+    factoextra,
     rgl
 Imports:
     MASS,
@@ -78,7 +79,9 @@ Imports:
     methods,
     knitr,
     htmlwidgets,
-    webshot2
+    webshot2,
+    forcats,
+    rlang
 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

@@ -52,11 +52,13 @@ export(Summarise)
 export(as_array)
 export(as_caseform)
 export(as_freqform)
+export(as_matrix)
 export(as_table)
 export(assoc_graph)
 export(blogits)
 export(center3d)
 export(collapse.table)
+export(collapse_levels)
 export(color_table)
 export(conditional)
 export(cutfac)
@@ -96,6 +98,10 @@ importFrom(ca,multilines)
 importFrom(dplyr,all_of)
 importFrom(dplyr,as_tibble)
 importFrom(dplyr,everything)
+importFrom(dplyr,is.tbl)
+importFrom(dplyr,rename)
+importFrom(dplyr,summarise)
+importFrom(forcats,fct_collapse)
 importFrom(gnm,meanResiduals)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,hsv)
@@ -118,6 +124,8 @@ importFrom(htmlwidgets,saveWidget)
 importFrom(knitr,include_graphics)
 importFrom(knitr,is_html_output)
 importFrom(methods,is)
+importFrom(rlang,.data)
+importFrom(rlang,set_names)
 importFrom(stats,as.formula)
 importFrom(stats,chisq.test)
 importFrom(stats,deviance)

R/as_array.R

@@ -4,16 +4,29 @@
 #' 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
+#' @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.
+#' @param prop 
+#'  If set to `TRUE`, returns an array of proportions (that sum to 1). May also 
+#'  be set to a character or numeric vector of dimensions to be used as margins 
+#'  from which proportions will be computed.
 #' @return object in array form
 #' 
 #' @details
-#' Unclasses the \code{as_table()} function to return an object in array form.
+#' Unclasses the \code{\link{as_table}} function to return an object in array form.
 #' 
 #' @author Gavin M. Klorfine
 #' 
+#' @seealso
+#' \code{\link{as_table}}, \code{\link{as_freqform}}, \code{\link{as_caseform}},
+#' \code{\link{as_matrix}}
+#' 
 #' @examples
 #' library(vcdExtra)
 #' 
@@ -38,9 +51,27 @@
 #' # For specific dimensions
 #' as_array(tidy_freqForm, freq = "n", dims = c("Hair", "Eye")) |> str()
 #' 
+#' #-----For proportions-----#
+#' 
+#' as_array(freqForm, freq = "Freq", prop = TRUE) |> # proportions relative to grand total
+#'   head(c(4,4,1)) 
+#' 
+#' # Marginalize proportions along "Sex" (i.e., male proportions sum to 1, female proportions sum to 1)
+#' as_array(freqForm, freq = "Freq", prop = "Sex") |> head(c(4,4,1))
+#' 
+#' as_array(freqForm, freq = "Freq", prop = 3) |> head(c(4,4,1)) # Same as above
+#' 
+#' # Marginalize proportions along multiple variables
+#' as_array(freqForm, freq = "Freq", prop = c("Hair", "Sex")) |> head(c(4,4,1))
+#' 
+#' as_array(freqForm, freq = "Freq", prop = c(1, 3)) |> head(c(4,4,1)) # Same as above
+#' 
+#' # Using dims and prop arguments in tandem
+#' as_array(freqForm, freq = "Freq", dims = c("Hair", "Eye"), prop = TRUE)
+#' 
 #' 
 #' @export
 
-as_array <- function(obj, freq = NULL, dims = NULL){
-  return(unclass(as_table(obj, freq, dims))) # Unclass as_table output
+as_array <- function(obj, freq = NULL, dims = NULL, prop = NULL){
+  return(unclass(as_table(obj, freq, dims, prop))) # Unclass as_table output
 }

R/as_caseform.R

@@ -4,22 +4,32 @@
 #' 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
+#' @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.
+#' A wrapper for \code{\link{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.
+#' just like \code{\link{expand.dft}}. Converts `obj` to a table using 
+#' \code{\link{as_table}} before converting to case form.
 #' 
 #' @author Gavin M. Klorfine
 #' 
-#' @importFrom dplyr as_tibble
+#' @seealso
+#' \code{\link{as_table}}, \code{\link{as_freqform}}, \code{\link{as_array}},
+#' \code{\link{as_matrix}}, \code{\link{expand.dft}}
+#' 
+#' @importFrom dplyr as_tibble is.tbl
 #' 
 #' @examples
 #' library(vcdExtra)
@@ -48,11 +58,21 @@
 
 as_caseform <- function(obj, freq = "Freq", dims = NULL, tidy = TRUE){
 
-  tab <- expand.dft(as_table(obj, freq = freq, dims = dims), freq = freq)
+  if ((dplyr::is.tbl(obj) || is.data.frame(obj)))
+    freqs <- obj[[freq]]
+  else
+    freqs <- as.numeric(obj)
+
+  if (any(freqs %% 1 != 0))
+    stop("Frequency column contains decimal values.")
+  if (any(freqs < 0))
+    stop("Frequency column contains negative values.")
+
+  tab <- as_table(obj, freq = freq, dims = dims)
+  cf <- expand.dft(tab, freq = freq)
 
-  if (tidy){
-    tab <- dplyr::as_tibble(tab)
-  }
+  if (tidy)
+    cf <- dplyr::as_tibble(cf)
 
-  return(tab)
+  return(cf)
 }

R/as_freqform.R

@@ -1,24 +1,39 @@
 #' Convert any form (case or table form) into frequency form.
 #' 
-#' A wrapper for \code{as.data.frame()} that is able to properly handle arrays.
+#' A wrapper for \code{\link[base]{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.
+#' @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 prop 
+#'  If set to `TRUE`, the resulting "frequency" column will contain proportions 
+#'  (that sum to 1). May also be set to a character or numeric vector of 
+#'  dimensions to be used as margins from which proportions will be computed. 
+#'  The resulting "frequency" column is renamed to "Prop."
+#' @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
+#' Converts `obj` to a table using \code{\link{as_table}} before converting to
 #' frequency form
 #' 
 #' @author Gavin M. Klorfine
 #' 
-#' @importFrom dplyr as_tibble
+#' @seealso
+#' \code{\link{as_table}}, \code{\link{as_caseform}}, \code{\link{as_array}},
+#' \code{\link{as_matrix}}
+#' 
+#' @importFrom dplyr as_tibble rename all_of
 #' 
 #' @examples
 #' library(vcdExtra)
@@ -44,16 +59,38 @@
 #' 
 #' as_freqform(tableForm, dims = c("Hair", "Eye")) |> str()
 #' 
+#' #-----For proportions-----#
+#' 
+#' as_freqform(tableForm, prop = TRUE) |> head() # print only Sex == Male rows
+#' 
+#' # Marginalize proportions along "Sex" (i.e., male proportions sum to 1, female proportions sum to 1)
+#' as_freqform(tableForm, prop = "Sex") |> head()
+#' 
+#' as_freqform(tableForm, prop = 3) |> head() # Same as above
+#' 
+#' # Marginalize proportions along multiple variables
+#' as_freqform(tableForm, prop = c("Hair", "Sex")) |> head()
+#' 
+#' as_freqform(tableForm, prop = c(1, 3)) |> head() # Same as above
+#' 
+#' # Using dims and prop arguments in tandem
+#' as_freqform(tableForm, dims = c("Hair", "Eye"), prop = TRUE)
 #' 
 #' @export
 
-as_freqform <- function(obj, freq = NULL, dims = NULL, tidy = TRUE){
+as_freqform <- function(obj, freq = NULL, dims = NULL, prop = NULL, tidy = TRUE){
 
-  tab <- as.data.frame(as_table(obj, freq = freq, dims = dims))
+  tab <- as.data.frame(as_table(obj, freq = freq, dims = dims, prop = prop))
 
-  if (tidy){
+  if (tidy)
     tab <- dplyr::as_tibble(tab)
-  }
+
+  # Account for new column named "Freq" if freq was NULL
+  if (is.null(freq))
+    freq <- "Freq"
+
+  if (!is.null(prop))
+    tab <- tab |> dplyr::rename("Prop" = dplyr::all_of(freq))
 
   return(tab)
 }

R/as_matrix.R

@@ -0,0 +1,78 @@
+#' Convert frequency, case, or table form data into a matrix.
+#' 
+#' Converts object (`obj`) in frequency, case or table form into a matrix of
+#' specified dimensions (`dims`). The column containing the frequencies (`freq`) 
+#' must be supplied if `obj` is in frequency form.
+#' 
+#' @param obj 
+#'  Object to be converted into a matrix.
+#' @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 matrix of proportions (that sum to 1). May also 
+#'  be set to a character or numeric vector of dimensions to be used as margins 
+#'  from which proportions will be computed.
+#' @return Object in matrix form.
+#' 
+#' @details
+#' First converts `obj` into an array using \code{\link{as_array}}. Then a
+#' check is made to ensure the user inputted a 2D `obj`. If `obj` is not 2D, an 
+#' error is returned. If `obj` is 2D, \code{\link[base]{as.matrix}} is applied.
+#' 
+#' @author Gavin M. Klorfine
+#' 
+#' @seealso
+#' \code{\link{as_array}}, \code{\link{as_table}}, \code{\link{as_freqform}},
+#' \code{\link{as_caseform}}
+#' 
+#' @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
+#' arrayDat <- as_array(HairEyeColor) # Generate an array
+#' 
+#' # Table form -> matrix
+#' as_matrix(HairEyeColor, dims = c("Hair", "Sex")) |> str()
+#' 
+#' # Frequency form -> matrix
+#' as_matrix(freqForm, freq = "Freq", dims = c("Hair", "Sex")) |> str()
+#' 
+#' # Case form -> matrix form
+#' as_matrix(caseForm, dims = c("Hair", "Sex")) |> str()
+#' 
+#' # Frequency (tibble) form -> matrix form
+#' as_matrix(tidy_freqForm, freq = "n", dims = c("Hair", "Sex")) |> str()
+#' 
+#' #-----For proportions-----#
+#' 
+#' # Proportions relative to grand total
+#' as_matrix(HairEyeColor, dims = c("Hair", "Sex"), prop = TRUE)
+#' 
+#' # Marginalize proportions along "Sex" (i.e., male proportions sum to 1, 
+#' # female proportions sum to 1)
+#' as_matrix(HairEyeColor, dims = c("Hair", "Sex"), prop = "Sex")
+#' 
+#' as_matrix(HairEyeColor, dims = c("Hair", "Sex"), prop = 2) # Same as above
+#' 
+#' 
+#' @export
+
+as_matrix <- function(obj, freq = NULL, dims = NULL, prop = NULL){
+
+  tab <- as_array(obj, freq = freq, dims = dims, prop = prop)
+
+  if (length(dim(tab)) == 2){ # If number of dimensions equal 2
+    return(as.matrix(tab))
+  }
+  else{
+    stop("Please supply an object with two dimensions. You may use the `dims` argument.")
+  }
+}