Nothing
# This file is based on https://cran.r-project.org/web/packages/settings/vignettes/settings.html MYPKGOPTIONS Variable, global to
# package's namespace. This function is not exported to user space and does not need to be documented.
MYPKGOPTIONS <- settings::options_manager(
add_margins = FALSE,
colname_for_total = "Total",
replace_NA_by = "missing",
colname_for_variable = "variable___",
colname_for_observations = "Observations",
colname_for_group = "Group",
colname_for_value = "value",
colname_for_blocks = "block_name___",
colname_for_order = "order___",
colname_for_variable_compact = " ",
labels_TRUE_FALSE = c("yes", "no"),
labels_Mean_SD = "Mean (SD)",
labels_valid_missing = "valid (missing)",
format_to = "Latex",
statistics.numeric = NULL,
statistics.factor = NULL,
statistics.ordered = NULL,
two_sample_htest.factor = NULL,
two_sample_htest.numeric = NULL,
two_sample_htest.ordered = NULL,
multi_sample_htest.factor = NULL,
multi_sample_htest.numeric = NULL,
multi_sample_htest.ordered = NULL,
format_statistics.statistics_factor = NULL,
format_statistics.statistics_numeric = NULL,
format_tests.htest = NULL,
format_tests.htest_with_effect_size = NULL,
format_p_values = function(x){
if (!is.nan(x) & x < 0.001){
return("<0.001")
}else{
return(sapply(x, format, scientific = FALSE, digits = 2, trim = TRUE, nsmall = 0))
}
},
format_numbers = function(x){
# I want scientific notation when x has more than 3 digits to base 10
scientific <- sapply(x, function(x)is.numeric(x) && is.finite(x) && x != 0 && abs(log10(abs(x))) > 3)
return(mapply(format, x = x, scientific = scientific,
MoreArgs = list(digits = atable_options("digits"), trim = TRUE, nsmall = 0)))
},
format_percent = function(x){
return(sapply(x, format, scientific = FALSE, digits = atable_options("digits"), trim = TRUE, nsmall = 0))
},
digits = 2,
get_alias.default = function(x, ...){
attr(x, "alias", exact = TRUE)
},
modifiy_colnames_without_alias = function(x, ...){
x = gsub(x, pattern = "_", replacement = " ")
x = trimws(x, which ="both")
return(x)},
get_alias.labelled = function(x, ...){
out <- attr(x, "label", exact = TRUE)
Units <- attr(x, "units", exact = TRUE)
out = if(!is.null(Units)){
paste0(out, " [", Units, "]")}else{out}
return(out)
},
indent_character_Word = " ",
indent_character_Latex = "\\quad",
indent_character_HTML = "   ",
indent_character_Console = " ",
indent_character_markdown = " ",
indent_character_compact = " ",
indent = TRUE,
format_statistics_compact.statistics_factor = function(x, ...)
{
nn <- names(x)
value <- unlist(x)
total <- sum(value)
percent <- 100 * value/total
if(length(nn)<=3){
# return only first level, ignore the others
# As atable::statistics.factor calls table(..., useNA='always'), there is always NA in nn and thus three
# levels are the minimum, not two levels
# The counts of missing values will not be displayed, but are included in the percent-calculation in the denominator
value <- paste0(atable_options("format_percent")(percent[1]), "% (", atable_options("format_numbers")(value[1]), ")")
format_statistics_out <- data.frame(tag = factor(nn[1], levels = nn[1]), value = value[1],
row.names = NULL, stringsAsFactors = FALSE, check.names = FALSE, fix.empty.names = FALSE)
return(format_statistics_out)
} else{
value <- paste0(atable_options("format_percent")(percent), "% (", atable_options("format_numbers")(value), ")")
format_statistics_out <- data.frame(tag = factor(nn, levels = nn),
value = value,
row.names = NULL, stringsAsFactors = FALSE, check.names = FALSE, fix.empty.names = FALSE)
return(format_statistics_out)
}
},
format_statistics_compact.statistics_numeric = function(x, ...)
{
the_mean <- atable_options("format_numbers")(x$mean)
the_sd <- atable_options("format_numbers")(x$sd)
values <- c(Mean_SD = paste0(the_mean, " (", the_sd, ")") )
format_statistics_out <- data.frame(tag = factor("remove_me", levels = "remove_me"),
value = values, row.names = NULL, stringsAsFactors = FALSE, check.names = FALSE,
fix.empty.names = FALSE)
return(format_statistics_out)
},
format_statistics_longitudinal.statistics_factor = function(x, ...)
{
nn <- names(x)
value <- unlist(x)
total <- sum(value)
percent <- 100 * value/total
if(length(nn)<=3){
# return only first level, ignore the others
# As atable::statistics.factor calls table(..., useNA='always'), there is always NA in nn and thus three
# levels are the minimum, not two levels
# The counts of missing values will not be displayed, but are included in the percent-calculation in the denominator
# Add total number of observations
value <- paste0(atable_options("format_percent")(percent[1]), "% (", atable_options("format_numbers")(value[1]), " / ", atable_options("format_numbers")(total), ")")
format_statistics_out <- data.frame(tag = factor(nn[1], levels = nn[1]), value = value[1],
row.names = NULL, stringsAsFactors = FALSE, check.names = FALSE, fix.empty.names = FALSE)
return(format_statistics_out)
} else{
value <- paste0(atable_options("format_percent")(percent), "% (", atable_options("format_numbers")(value), ")")
format_statistics_out <- data.frame(tag = factor(nn, levels = nn),
value = value,
row.names = NULL, stringsAsFactors = FALSE, check.names = FALSE, fix.empty.names = FALSE)
return(format_statistics_out)
}
},
format_statistics_longitudinal.statistics_numeric = function(x, ...)
{
the_mean <- atable_options("format_numbers")(x$mean)
the_sd <- atable_options("format_numbers")(x$sd)
the_valids = x$length - x$missing
the_missing = x$missing
values <- c(Mean_SD = paste0(the_mean, " (", the_sd, "), ",the_valids, ", ", the_missing) )
format_statistics_out <- data.frame(tag = factor("mean_sd_valid_missing", levels = "mean_sd_valid_missing"),
value = values, row.names = NULL, stringsAsFactors = FALSE, check.names = FALSE,
fix.empty.names = FALSE)
return(format_statistics_out)
}
)
# User function that gets exported:
#' Set or get options
#'
#' Set or get options for the atable-package via the \code{\link[settings]{settings}} package.
#'
#' These options control some aspects of the atable package.
#'
#' For restoring the default values see \code{\link{atable_options_reset}}.
#'
#' @param ... Option names to retrieve option values or \code{[key]=[value]} pairs to set options.
#'
#' @section Supported options:
#' The following options are supported:
#' \describe{
#' \item{\code{add_margins}}{A logical with length 1, TRUE of FALSE. This is the default-value of atable's
#' argument \code{add_margins}. See the help there.}
#'
#' \item{\code{colname_for_total}}{A character with length 1. Default is \code{'Total'}. This character will show up
#' in the results of \code{\link{atable}} when \code{add_margins} is \code{TRUE} and \code{group_col} is not \code{NULL}.}
#'
#' \item{\code{replace_NA_by}}{A character with length 1, or \code{NULL}. Default is \code{'missing'}.
#' Used in function \code{\link{replace_NA}}. This character will show up in the results of \code{\link{atable}},
#' so it can be modified. }
#'
#' \item{\code{colname_for_variable}}{A character with length 1. Default is \code{'variable___'}.
#' Used in function \code{add_name_to_tests} and \code{add_name_to_statistics}.
#' This character will not show up in the results and is only used internally for intermediate data.frames.
#' There may be name clashes with user-supplied data.frames; so modification may be necessary.}
#'
#' \item{\code{colname_for_observations}}{A character with length 1. Default is \code{'Observations'}.
#' Used in function \code{add_observation_column}.
#' This character will show up in the results of \code{\link{atable}}, so it can be modified.
#' There may be name clashes with user-supplied data.frames; so modification may be necessary.}
#'
#' \item{\code{colname_for_blocks}}{A character with length 1. Default is \code{'block_name___'}.
#' Used in function \code{indent_data_frame_with_blocks}.
#' This character will not show up in the results and is only used internally for intermediate data.frames.
#' There may be name clashes with user-supplied data.frames; so modification may be necessary.}
#'
#' \item{\code{labels_TRUE_FALSE}}{A character of length 2. Default is \code{c('yes', 'no')}.
#' Currently used in function \code{statistics.logical} (see \code{\link{statistics}}) to cast logical to factor.
#' \code{TRUE} is mapped to \code{labels_TRUE_FALSE[1]} and \code{FALSE} to \code{labels_TRUE_FALSE[2]}.
#' This characters may show up in the results of \code{\link{atable}}, so it can be modified.}
#'
#' \item{\code{labels_Mean_SD}}{A character length 1. Default is \code{'Mean (SD)'}.
#' Currently used in function \code{\link{format_statistics}} as a name for the mean and standard deviation of
#' numeric variables. This character may show up in the results of \code{\link{atable}}, so it can be modified.}
#'
#' \item{\code{labels_valid_missing}}{A character length 1. Default is \code{'valid (missing)'}.
#' Currently used in function \code{\link{format_statistics}} as a name for the number of valid and missing values
#' of numeric variables. This character may show up in the results of \code{\link{atable}}, so it can be modified.}
#'
#' \item{\code{format_to}}{A character length 1. Default is \code{'Latex'}.
#' Currently used in function \code{\link{atable}}.}
#'
#' \item{\code{colname_for_group}}{A character of length 1. Default is \code{'Group'}.
#' This character will show up in the results of \code{\link{atable}}.
#' This column will contain all values of \code{DD[split_cols]} and \code{DD[target_cols]}.}
#'
#' \item{\code{colname_for_value}}{A character of length 1. Default is \code{'value'}.
#' This character shows up in the results of \code{\link{atable}} when \code{group_col} is \code{NULL}.
#' The column will contain the results of the \code{\link{statistics}}.}
#'
#' \item{\code{colname_for_variable_compact}}{A character of length 1. Default is \code{intToUtf8(160)}, a non-breaking space.
#' This character will show up in the results of \code{\link{atable_compact}} as name of the first column.}
#'
#' \item{\code{statistics.numeric}}{Either \code{NULL} or a function. Default is \code{NULL}.
#' If a function, then it will replace \code{atable:::statistics.numeric} when atable is called.
#' The function must mimic \code{\link{statistics}}: see the help there.}
#'
#' \item{\code{statistics.factor}}{Analog to argument statistics.numeric.}
#'
#' \item{\code{statistics.ordered}}{Analog to argument statistics.numeric.}
#'
#' \item{\code{two_sample_htest.numeric}}{Either \code{NULL} or a function. Default is \code{NULL}.
#' If a function, then it will replace \code{atable:::two_sample_htest.numeric} when atable is called.
#' The function must mimic \code{\link{two_sample_htest}}: see the help there.}
#'
#' \item{\code{two_sample_htest.factor}}{Analog to argument two_sample_htest.numeric}
#'
#' \item{\code{two_sample_htest.ordered}}{Analog to argument two_sample_htest.numeric}
#'
#'
#' \item{\code{multi_sample_htest.numeric}}{Either \code{NULL} or a function. Default is \code{NULL}.
#' If a function, then it will replace \code{atable:::multi_sample_htest.numeric} when atable is called.
#' The function must mimic \code{\link{multi_sample_htest}}see the help there.}
#'
#' \item{\code{multi_sample_htest.factor}}{Analog to argument multi_sample_htest.numeric}
#'
#' \item{\code{multi_sample_htest.ordered}}{Analog to argument multi_sample_htest.numeric}
#'
#' \item{\code{format_statistics.statistics_numeric}}{Either \code{NULL} or a function. Default is \code{NULL}.
#' If a function, then it will replace \code{atable:::format_statistics.statistics_numeric}.
#' The function must mimic \code{\link{format_statistics}}: see the help there.}
#'
#' \item{\code{format_statistics.statistics_factor}}{Analog to argument format_statistics.statistics_numeric}
#'
#' \item{\code{format_tests.htest}}{Either \code{NULL} or a function. Default is \code{NULL}.
#' If a function, then it will replace \code{format_tests.htest}.
#' The function must mimic \code{\link{format_tests}}: arguments are \code{x} and the ellipsis ... .
#' Result is a data.frame with 1 rows and unique colnames.}
#'
#' \item{\code{format_tests.htest_with_effect_size}}{Analog to argument format_tests.htest}
#'
#'
#'
#' \item{\code{format_p_values}}{A function with one argument returning a character with same length as the argument.
#' This functions is called by \code{\link{format_tests}} to produce printable p-values.}
#'
#' \item{\code{format_percent}}{A function with one argument returning a character with same length as the argument.
#' This functions is called by \code{\link{format_statistics}} for factors to produce printable percentages.}
#'
#' \item{\code{format_numbers}}{A function with one argument returning a character with same length as the argument.
#' This functions is called by \code{\link{format_statistics}} and \code{\link{format_tests}} for number,
#' that are not p-values or percentages.}
#'
#' \item{\code{digits}}{How many digits a number should have in the table. Default 2.
#' Used by \code{format_percent} and \code{format_percent} and passed to \code{\link[base]{format}}. }
#'
#' \item{\code{get_alias.default}}{A function with one argument \code{x} and \code{...} returning a character or \code{NULL}.
#' This functions is called by \code{get_alias} and \code{create_alias_mapping} to retrieve alternative Variable names to print
#' in the table.}
#'
#' \item{\code{get_alias.labelled}}{A function with one argument \code{x} and \code{...}, that must return a character.
#' This functions is called by \code{get_alias} on the columns that have class labelled.}
#'
#' \item{\code{modifiy_colnames_without_alias}}{A function with one argument \code{x} and \code{...} returning a character.
#' This functions is called by \code{create_alias_mapping} on the columns that have \code{is.NULL(get_alias(x))}.
#' Replaces underscores by blanks and then calls \code{\link[base]{trimws}}. }
#'
#' \item{\code{indent_character}}{A Character with length 1. Passed to \code{indent_data_frame}. Every option of \code{format_to}
#' has a corresponding indent_character. See the help of \code{atable} for these options. }
#'
#' \item{\code{indent_character_compact}}{A Character with length 1. Passed to \code{atable_compact}.
#' Value is \code{" "} for viewing in the console. Use \code{"\\quad"} for Latex and \code{intToUtf8(160)} for Word.}
#'
#' \item{\code{indent}}{A logical with length 1. Passed to \code{atable}. Controls, if indent_data_frame is called.}
#'
#' \item{\code{format_statistics_compact.statistics_factor}}{A function with the same Properties as \code{\link{format_statistics}}. Used as a
#' default value for \code{\link{atable_compact}}}
#'
#' \item{\code{format_statistics_compact.statistics_numeric }}{A function with the same Properties as \code{\link{format_statistics}}. Used as a
#' default value for \code{\link{atable_compact}}}
#'
#' \item{\code{format_statistics_longitudinal.statistics_factor}}{A function with the same Properties as \code{\link{format_statistics}}. Used as a
#' default value for \code{\link{atable_longitudinal}}}
#'
#' \item{\code{format_statistics_longitudinal.statistics_numeric }}{A function with the same Properties as \code{\link{format_statistics}}. Used as a
#' default value for \code{\link{atable_longitudinal}}}
#' }
#'
#' @examples
#' atable_options() # show all options
#' atable_options('replace_NA_by' = 'no value') # set a new value
#' atable_options('replace_NA_by') # return the new value
#'
#'
#' @export
atable_options <- function(...) {
# protect against the use of reserved words.
settings::stop_if_reserved(...)
MYPKGOPTIONS(...)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.