# This file is automatically generated, you probably don't want to edit this
jmvtabOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"jmvtabOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
row_vars = NULL,
col_vars = NULL,
tab_vars = NULL,
wt = NULL,
pct = "no",
color = "no",
chi2 = TRUE,
OR = "no",
na = "keep",
lvs = "all",
other_if_less_than = 0,
cleannames = TRUE,
ref = "auto",
ref2 = "first",
comp = "tab",
ci = "auto",
conf_level = 0.95,
ci_print = "ci",
totaltab = "line",
wrap_rows = 35,
wrap_cols = 15,
display = "auto",
add_n = TRUE,
add_pct = FALSE,
subtext = "",
digits = 0, ...) {
super$initialize(
package="tabxplor",
name="jmvtab",
requiresData=TRUE,
...)
private$..row_vars <- jmvcore::OptionVariable$new(
"row_vars",
row_vars,
permitted=list(
"numeric",
"factor"),
default=NULL,
suggested=list(
"nominal",
"ordinal"))
private$..col_vars <- jmvcore::OptionVariables$new(
"col_vars",
col_vars,
suggested=list(
"nominal",
"ordinal",
"continuous"),
permitted=list(
"numeric",
"factor"),
default=NULL)
private$..tab_vars <- jmvcore::OptionVariables$new(
"tab_vars",
tab_vars,
suggested=list(
"nominal",
"ordinal"),
permitted=list(
"factor"),
default=NULL)
private$..wt <- jmvcore::OptionVariable$new(
"wt",
wt,
suggested=list(
"continuous"),
permitted=list(
"numeric"),
default=NULL)
private$..pct <- jmvcore::OptionList$new(
"pct",
pct,
options=list(
"no",
"row",
"col",
"all",
"all_tabs"),
default="no")
private$..color <- jmvcore::OptionList$new(
"color",
color,
options=list(
"no",
"diff",
"diff_ci",
"after_ci",
"contrib",
"OR"),
default="no")
private$..chi2 <- jmvcore::OptionBool$new(
"chi2",
chi2,
default=TRUE)
private$..OR <- jmvcore::OptionList$new(
"OR",
OR,
options=list(
"no",
"OR",
"OR_pct"),
default="no")
private$..na <- jmvcore::OptionList$new(
"na",
na,
options=list(
"keep",
"drop",
"drop_all"),
default="keep")
private$..lvs <- jmvcore::OptionList$new(
"lvs",
lvs,
options=list(
"all",
"first",
"auto"),
default="all")
private$..other_if_less_than <- jmvcore::OptionNumber$new(
"other_if_less_than",
other_if_less_than,
min=0,
default=0)
private$..cleannames <- jmvcore::OptionBool$new(
"cleannames",
cleannames,
default=TRUE)
private$..ref <- jmvcore::OptionString$new(
"ref",
ref,
default="auto")
private$..ref2 <- jmvcore::OptionString$new(
"ref2",
ref2,
default="first")
private$..comp <- jmvcore::OptionList$new(
"comp",
comp,
options=list(
"tab",
"all"),
default="tab")
private$..ci <- jmvcore::OptionList$new(
"ci",
ci,
options=list(
"auto",
"cell",
"diff"),
default="auto")
private$..conf_level <- jmvcore::OptionNumber$new(
"conf_level",
conf_level,
min=0,
max=1,
default=0.95)
private$..ci_print <- jmvcore::OptionList$new(
"ci_print",
ci_print,
options=list(
"ci",
"moe"),
default="ci")
private$..totaltab <- jmvcore::OptionList$new(
"totaltab",
totaltab,
options=list(
"line",
"table",
"no"),
default="line")
private$..wrap_rows <- jmvcore::OptionNumber$new(
"wrap_rows",
wrap_rows,
min=0,
default=35)
private$..wrap_cols <- jmvcore::OptionNumber$new(
"wrap_cols",
wrap_cols,
min=0,
default=15)
private$..display <- jmvcore::OptionList$new(
"display",
display,
options=list(
"auto",
"n",
"wn",
"pct",
"diff",
"ctr",
"mean",
"var",
"ci",
"pct_ci",
"mean_ci",
"OR",
"OR_pct"),
default="auto")
private$..add_n <- jmvcore::OptionBool$new(
"add_n",
add_n,
default=TRUE)
private$..add_pct <- jmvcore::OptionBool$new(
"add_pct",
add_pct,
default=FALSE)
private$..subtext <- jmvcore::OptionString$new(
"subtext",
subtext,
default="")
private$..digits <- jmvcore::OptionNumber$new(
"digits",
digits,
min=0,
max=10,
default=0)
self$.addOption(private$..row_vars)
self$.addOption(private$..col_vars)
self$.addOption(private$..tab_vars)
self$.addOption(private$..wt)
self$.addOption(private$..pct)
self$.addOption(private$..color)
self$.addOption(private$..chi2)
self$.addOption(private$..OR)
self$.addOption(private$..na)
self$.addOption(private$..lvs)
self$.addOption(private$..other_if_less_than)
self$.addOption(private$..cleannames)
self$.addOption(private$..ref)
self$.addOption(private$..ref2)
self$.addOption(private$..comp)
self$.addOption(private$..ci)
self$.addOption(private$..conf_level)
self$.addOption(private$..ci_print)
self$.addOption(private$..totaltab)
self$.addOption(private$..wrap_rows)
self$.addOption(private$..wrap_cols)
self$.addOption(private$..display)
self$.addOption(private$..add_n)
self$.addOption(private$..add_pct)
self$.addOption(private$..subtext)
self$.addOption(private$..digits)
}),
active = list(
row_vars = function() private$..row_vars$value,
col_vars = function() private$..col_vars$value,
tab_vars = function() private$..tab_vars$value,
wt = function() private$..wt$value,
pct = function() private$..pct$value,
color = function() private$..color$value,
chi2 = function() private$..chi2$value,
OR = function() private$..OR$value,
na = function() private$..na$value,
lvs = function() private$..lvs$value,
other_if_less_than = function() private$..other_if_less_than$value,
cleannames = function() private$..cleannames$value,
ref = function() private$..ref$value,
ref2 = function() private$..ref2$value,
comp = function() private$..comp$value,
ci = function() private$..ci$value,
conf_level = function() private$..conf_level$value,
ci_print = function() private$..ci_print$value,
totaltab = function() private$..totaltab$value,
wrap_rows = function() private$..wrap_rows$value,
wrap_cols = function() private$..wrap_cols$value,
display = function() private$..display$value,
add_n = function() private$..add_n$value,
add_pct = function() private$..add_pct$value,
subtext = function() private$..subtext$value,
digits = function() private$..digits$value),
private = list(
..row_vars = NA,
..col_vars = NA,
..tab_vars = NA,
..wt = NA,
..pct = NA,
..color = NA,
..chi2 = NA,
..OR = NA,
..na = NA,
..lvs = NA,
..other_if_less_than = NA,
..cleannames = NA,
..ref = NA,
..ref2 = NA,
..comp = NA,
..ci = NA,
..conf_level = NA,
..ci_print = NA,
..totaltab = NA,
..wrap_rows = NA,
..wrap_cols = NA,
..display = NA,
..add_n = NA,
..add_pct = NA,
..subtext = NA,
..digits = NA)
)
jmvtabResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"jmvtabResults",
inherit = jmvcore::Group,
active = list(
html_table = function() private$.items[["html_table"]],
chi2_table = function() private$.items[["chi2_table"]],
plot = function() private$.items[["plot"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Crosstables")
self$add(jmvcore::Html$new(
options=options,
name="html_table",
title="Table"))
self$add(jmvcore::Table$new(
options=options,
name="chi2_table",
title="Chi2 Test",
rows=0,
columns=list(
list(
`name`="row_var",
`title`="row_var",
`type`="text"))))
self$add(jmvcore::Image$new(
options=options,
name="plot",
title="",
width=1080,
height=0,
renderFun=".plot"))}))
jmvtabBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"jmvtabBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "tabxplor",
name = "jmvtab",
version = c(1,0,0),
options = options,
results = jmvtabResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'full')
}))
#' Crosstables
#'
#'
#' @param data A data.frame.
#' @param row_vars The row variable, which will be printed with one level per
#' line. If numeric, it will be converted to factor.
#' @param col_vars One column is printed for each level of each column
#' variable. For numeric variables means are calculated, in a single column.
#' @param tab_vars One subtable is made for each combination of levels of the
#' tab variables. All tab variables are converted to factor. Leave empty to
#' make a simple table.
#' @param wt A weight variable, of class numeric. Leave empty for unweighted
#' results.
#' @param pct The type of percentages to calculate : \itemize{ \item
#' \code{"row"}: row percentages. \item \code{"col"}: column percentages.
#' \item \code{"all"}: frequencies for each subtable/group, if there is
#' \code{tab_vars}. \item \code{"all_tabs"}: frequencies for the whole (set
#' of) table(s). }
#' @param color The type of colors to print, as a single string. Vectorised
#' over \code{row_vars}. \itemize{ \item \code{"no"}: by default, no
#' colors are printed. \item \code{"diff"}: color percentages and means
#' based on cells differences from totals (or from first cells when
#' \code{ref = "first"}). \item \code{"diff_ci"}: color pct and means based
#' on cells differences from totals or first cells, removing coloring when
#' the confidence interval of this difference is higher than the difference
#' itself. \item \code{"after_ci"}: idem, but cut off the confidence
#' interval from the difference first. \item \code{"contrib"}: color
#' cells based on their contribution to variance (except mean columns, from
#' numeric variables). \item \code{"OR"}: for \code{pct == "col"} or
#' \code{pct == "row"}, color based on odds ratios (or relative risks
#' ratios) }
#' @param chi2 Set to \code{TRUE} to make a Chi2 and add summary stats. Also
#' useful to color cells based on their contribution to variance.
#' @param OR With \code{pct = "row"} or \code{pct = "col"}, calculate and
#' print odds ratios (for binary variables) or relative risks ratios (for
#' variables with 3 levels or more). \itemize{ \item \code{"no"}: by
#' default, no OR are calculated. \item \code{"OR"}: print OR (instead of
#' percentages). \item \code{"OR_pct"}: print OR, with percentages in
#' bracket. }
#' @param na The policy to adopt with missing values. It must be a single
#' string. \itemize{ \item \code{na = "keep"}: by default, prints
#' \code{NA}'s as explicit \code{"NA"} level. \item \code{na = "drop"}:
#' removes \code{NA} levels before making each table (tabs made with
#' different column variables may have a different number of observations,
#' and won't exactly have the same total columns). }
#' @param lvs The levels of \code{col_vars} to keep. \itemize{ \item
#' \code{"all"}: by default, all levels are kept. \item \code{"first"}:
#' only keep the first level of each \code{col_vars} \item \code{"auto"}:
#' keep the first level when \code{col_var} is only two levels, keep all
#' levels otherwise. }
#' @param other_if_less_than When set to a positive integer, levels with less
#' count than that will be merged into an "Others" level.
#' @param cleannames By default, clean levels names, by removing prefix
#' numbers like "1-", and text in parenthesis. Set to \code{FALSE} to avoid
#' this behaviour.
#' @param ref The reference cell to calculate differences and ratios (used
#' to print \code{colors}) : \itemize{ \item \code{"auto"}: by default,
#' cell difference from the corresponding total (rows or cols depending on
#' \code{pct = "row"} or \code{pct = "col"}) is used for \code{diff} ; cell
#' ratio from the first line (or col) is use for \code{OR} (odds
#' ratio/relative risks ratio). \item \code{"tot"}: totals are always used.
#' \item \code{"first"}: calculate cell difference or ratio from the first
#' cell of the row or column (useful to color temporal developments).
#' \item \code{n}: when \code{ref} is an integer, the nth row (or column) is
#' used for comparison. \item \code{"regex"}: when \code{ref} is a string,
#' it it used as a regular expression, to match with the names of the rows
#' (or columns). Be precise enough to match only one column or row,
#' otherwise you get a warning message. \item \code{"no"}: not use ref and
#' not calculate diffs to gain calculation time. }
#' @param ref2 A second reference cell is needed to calculate odds ratios (or
#' relative risks ratios). The first cell of the row or column is used by
#' default. See \code{ref} for the full list of possible values.
#' @param comp The comparison level : by subtables/groups, or for the whole
#' table.
#' @param ci The type of confidence intervals to calculate, passed to
#' \code{\link{tab_ci}}. \itemize{ \item \code{"cell"}: absolute
#' confidence intervals of cells percentages. \item \code{"diff"}:
#' confidence intervals of the difference between a cell and the relative
#' total cell (or relative first cell when \code{ref = "first"}). \item
#' \code{"auto"}: \code{ci = "diff"} for means and row/col percentages,
#' \code{ci = "cell"} for frequencies ("all", "all_tabs"). } By default,
#' for percentages, with \code{ci = "cell"} Wilson's method is used, and with
#' \code{ci = "diff"} Wald's method along Agresti and Caffo's adjustment.
#' Means use classic method.
#' @param conf_level The confidence level, as a single numeric between 0 and
#' 1. Default to 0.95 (95\%).
#' @param ci_print By default confidence interval are printed with the
#' interval display. Set to "moe" to use pct +- moe instead.
#' @param totaltab The total table, if there are subtables/groups (i.e. when
#' \code{tab_vars} is provided). Vectorised over \code{row_vars}. \itemize{
#' \item \code{"line"}: by default, add a general total line (necessary for
#' calculations with \code{comp = "all"}) \item \code{"table"}: add a
#' complete total table (i.e. \code{row_var} by \code{col_vars} without
#' \code{tab_vars}). \item \code{"no"}: not to draw any total table. }
#' @param wrap_rows By default, rownames are wrapped when larger than 30
#' characters.
#' @param wrap_cols By default, colnames are wrapped when larger than 12
#' characters.
#' @param display The information to display in the table.
#' @param add_n For \code{pct = "row"} or \code{pct = "col"}, set to
#' \code{FALSE} not to add another column or row with unweighted counts
#' (\code{n}).
#' @param add_pct Set to \code{TRUE} to add a column with the frequencies of
#' the row variable (for \code{pct = "row"}) or a row with the frequencies of
#' the column variable (for \code{pct = "col"})
#' @param subtext A character vector to print rows of legend under the table.
#' @param digits The number of digits to print, as a single integer, or an
#' integer vector the same length as \code{col_vars}.
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$html_table} \tab \tab \tab \tab \tab a html \cr
#' \code{results$chi2_table} \tab \tab \tab \tab \tab a table \cr
#' \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$chi2_table$asDF}
#'
#' \code{as.data.frame(results$chi2_table)}
#'
#' @export
jmvtab <- function(
data,
row_vars = NULL,
col_vars = NULL,
tab_vars = NULL,
wt = NULL,
pct = "no",
color = "no",
chi2 = TRUE,
OR = "no",
na = "keep",
lvs = "all",
other_if_less_than = 0,
cleannames = TRUE,
ref = "auto",
ref2 = "first",
comp = "tab",
ci = "auto",
conf_level = 0.95,
ci_print = "ci",
totaltab = "line",
wrap_rows = 35,
wrap_cols = 15,
display = "auto",
add_n = TRUE,
add_pct = FALSE,
subtext = "",
digits = 0) {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("jmvtab requires jmvcore to be installed (restart may be required)")
if ( ! missing(row_vars)) row_vars <- jmvcore::resolveQuo(jmvcore::enquo(row_vars))
if ( ! missing(col_vars)) col_vars <- jmvcore::resolveQuo(jmvcore::enquo(col_vars))
if ( ! missing(tab_vars)) tab_vars <- jmvcore::resolveQuo(jmvcore::enquo(tab_vars))
if ( ! missing(wt)) wt <- jmvcore::resolveQuo(jmvcore::enquo(wt))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(row_vars), row_vars, NULL),
`if`( ! missing(col_vars), col_vars, NULL),
`if`( ! missing(tab_vars), tab_vars, NULL),
`if`( ! missing(wt), wt, NULL))
for (v in tab_vars) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- jmvtabOptions$new(
row_vars = row_vars,
col_vars = col_vars,
tab_vars = tab_vars,
wt = wt,
pct = pct,
color = color,
chi2 = chi2,
OR = OR,
na = na,
lvs = lvs,
other_if_less_than = other_if_less_than,
cleannames = cleannames,
ref = ref,
ref2 = ref2,
comp = comp,
ci = ci,
conf_level = conf_level,
ci_print = ci_print,
totaltab = totaltab,
wrap_rows = wrap_rows,
wrap_cols = wrap_cols,
display = display,
add_n = add_n,
add_pct = add_pct,
subtext = subtext,
digits = digits)
analysis <- jmvtabClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.