diff --git a/.Rbuildignore b/.Rbuildignore index 5d5136cd..226943ba 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -20,3 +20,5 @@ revdep ^\.lintr$ ^\.git$ ^air\.toml$ +^\.positai$ +^\.claude$ diff --git a/.gitignore b/.gitignore index 63df67f5..acf8ae5a 100644 --- a/.gitignore +++ b/.gitignore @@ -46,3 +46,4 @@ revdep/checks/libraries.csv revdep/data.sqlite tests/testthat/Rplots.pdf docs +.positai diff --git a/DESCRIPTION b/DESCRIPTION index 22bbc8ea..2b12a1b2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,8 +24,10 @@ Depends: Imports: cli, cnd, + facts, fs (>= 0.2.0), fuj, + generics, magrittr (>= 2.0.1), rlang, stats (>= 3.6), @@ -48,6 +50,7 @@ Suggests: knitr (>= 1.30), nanoparquet, rcmdcheck (>= 1.3.3), + rmarkdown, stringi (>= 1.5.3), spelling (>= 2.2), testthat (>= 3.0.0), @@ -57,9 +60,9 @@ Suggests: xopen, yaml (>= 2.3.9), Remotes: + github::jmbarbone/facts, github::jmbarbone/cnd@v0.1.1.9002, - github::jmbarbone/fuj@v0.2.2.9010 -RoxygenNote: 7.3.3 + github::jmbarbone/fuj@105-defaults Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 Config/testthat/parallel: true @@ -86,7 +89,6 @@ Collate: 'directory.R' 'environments.R' 'expand.R' - 'fact.R' 'fct-expand-seq.R' 'file.R' 'fizzbuzz.R' @@ -122,6 +124,7 @@ Collate: 'recode.R' 'reexports-fuj.R' 'reexports-magrittr.R' + 'rexports-facts.R' 'round-by.R' 'round.R' 'row-bind.R' @@ -140,3 +143,4 @@ Collate: 'within.R' 'write.R' 'zzz.R' +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index 4c88d97b..238b9ed8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,14 +1,8 @@ # Generated by roxygen2: do not edit by hand -S3method("[",fact) S3method(append0,data.frame) S3method(append0,default) S3method(append0,list) -S3method(as.Date,fact) -S3method(as.character,fact) -S3method(as.double,fact) -S3method(as.integer,fact) -S3method(as_ordered,default) S3method(assign_labels,data.frame) S3method(assign_labels,default) S3method(char2fact,character) @@ -23,20 +17,6 @@ S3method(depth,default) S3method(depth,list) S3method(detail,data.frame) S3method(detail,default) -S3method(drop_levels,data.frame) -S3method(drop_levels,fact) -S3method(drop_levels,factor) -S3method(fact,Date) -S3method(fact,POSIXt) -S3method(fact,character) -S3method(fact,default) -S3method(fact,fact) -S3method(fact,factor) -S3method(fact,haven_labelled) -S3method(fact,integer) -S3method(fact,logical) -S3method(fact,numeric) -S3method(fact,pseudo_id) S3method(get_labels,data.frame) S3method(get_labels,default) S3method(is_false,default) @@ -46,7 +26,6 @@ S3method(is_true,logical) S3method(normalize,data.frame) S3method(normalize,default) S3method(print,diff_time) -S3method(print,fact) S3method(print,has_catch) S3method(print,mark_bib_df) S3method(print,mark_bib_entry) @@ -74,7 +53,6 @@ S3method(to_boolean,factor) S3method(to_boolean,integer) S3method(to_boolean,logical) S3method(to_boolean,numeric) -S3method(unique,fact) S3method(write_clipboard,data.frame) S3method(write_clipboard,default) S3method(write_clipboard,list) @@ -103,7 +81,6 @@ export(add_file_timestamp) export(any_match) export(are_identical) export(array_extract) -export(as_ordered) export(assign_labels) export(base_alpha) export(base_n) @@ -130,7 +107,6 @@ export(diff_time_secs) export(diff_time_weeks) export(diff_time_wyears) export(diff_time_years) -export(drop_levels) export(either) export(environments) export(ept) @@ -138,7 +114,6 @@ export(eval_named_chunk) export(expand_by) export(fact) export(fact2char) -export(fact_na) export(fct_expand_seq) export(file_copy_md5) export(file_name) @@ -303,6 +278,7 @@ importFrom(cnd,input_error) importFrom(cnd,input_warning) importFrom(cnd,type_error) importFrom(cnd,value_error) +importFrom(facts,fact) importFrom(fuj,"%::%") importFrom(fuj,"%:::%") importFrom(fuj,"%colons%") diff --git a/R/char2fact.R b/R/char2fact.R index eee4bacd..e1b1d89b 100644 --- a/R/char2fact.R +++ b/R/char2fact.R @@ -20,9 +20,9 @@ char2fact.default <- function(x, n = 5) { #' @rdname char2fact #' @export char2fact.character <- function(x, n = 5) { - id <- pseudo_id(x) + fct <- factor(x) - if (length(.uniques(id)) <= n) { + if (length(attr(id, "uniques")) <= n) { x <- fact(id) } diff --git a/R/counts.R b/R/counts.R index 185bf740..4100e411 100644 --- a/R/counts.R +++ b/R/counts.R @@ -49,9 +49,10 @@ counts <- function(x, ...) { #' @export counts.default <- function(x, sort = FALSE, ...) { x <- pseudo_id(x) - u <- .uniques(x) + u <- attr(x, "uniques") out <- tabulate(x, length(u)) - names(out) <- na_last(u) + nas <- is.na(u) + names(out) <- c(u[!nas], u[nas]) if (sort) { return(sort_names(out, numeric = is.numeric(x))) diff --git a/R/fact.R b/R/fact.R deleted file mode 100644 index d41b622c..00000000 --- a/R/fact.R +++ /dev/null @@ -1,546 +0,0 @@ -# NOTE I'll eventually replace these with jmbarbone/facts (or jmbarbone/fctrs) - -# fact -------------------------------------------------------------------- - -#' Factor -#' -#' Quickly create a factor -#' -#' @details [mark::fact()] can be about 5 times quicker than [base::factor()] or -#' [base::as.factor()] as it doesn't bother sorting the levels for non-numeric -#' data or have other checks or features. It simply converts a vector to a -#' factor with all unique values as levels with `NA`s included. -#' -#' [mark::fact.factor()] will perform several checks on a factor to include -#' `NA` levels and to check if the levels should be reordered to conform with -#' the other methods. The [mark::fact.fact()] method simple returns `x`. -#' -#' @section level orders: -#' -#' The order of the levels may be adjusted to these rules depending on the -#' class of `x`: -#' \describe{ -#' \item{`character`}{The order of appearance} -#' \item{`numeric`/`integer`/`Date`/`POSIXt`}{By the numeric order} -#' \item{`logical`}{As `TRUE`, `FALSE`, then `NA` if present} -#' \item{`factor`}{Numeric if levels can be safely converted, otherwise as -#' they are} -#' } -#' -#' @param x A vector of values -#' @return A vector of equal length of `x` with class `fact` and `factor`. If -#' `x` was `ordered`, that class is added in between. -#' -#' @seealso [mark::as_ordered()] -#' @family factors -#' @export -fact <- function(x) { - UseMethod("fact", x) -} - -#' @rdname fact -#' @export -fact.default <- function(x) { - stop( - "No fact method for class(es) ", - collapse0(class(x), sep = ", "), - call. = FALSE - ) -} - -#' @rdname fact -#' @export -fact.character <- function(x) { - out <- pseudo_id(x) - new_fact(out, .uniques(out)) -} - -#' @rdname fact -#' @export -fact.numeric <- function(x) { - u <- sort.int(unique(x), method = "radix", na.last = TRUE) - - # Don't bother NaN - nas <- is.na(u) - u[nas] <- NA - - if (sum(nas) > 1) { - u <- u[-length(u)] - } - - x[is.nan(x)] <- NA - new_fact(match(x, u), u) -} - -#' @rdname fact -#' @export -fact.integer <- fact.numeric - -#' @rdname fact -#' @export -fact.Date <- fact.numeric - -#' @rdname fact -#' @export -fact.POSIXt <- fact.numeric - -#' @rdname fact -#' @export -fact.logical <- function(x) { - out <- as.integer(x) - w <- which(!x) - out[w] <- out[w] + 2L - nas <- is.na(x) - out[nas] <- 3L - - new_fact( - out, - levels = c(TRUE, FALSE, if (any(nas)) NA), - na = if (any(nas)) 3L else 0L - ) -} - -#' @rdname fact -#' @export -fact.factor <- function(x) { - old_levels <- levels(x) - new_levels <- fact_coerce_levels(old_levels) - - if (is.logical(new_levels)) { - m <- match(new_levels[x], c(TRUE, FALSE, NA)) - res <- new_fact(m, c(TRUE, FALSE, if (anyNA(new_levels[x])) NA)) - return(res) - } - - if (is.numeric(new_levels) || inherits(x, c("Date", "POSIXt"))) { - ord_levels <- sort(new_levels, na.last = TRUE) - o <- match(old_levels, as.character(ord_levels)) - - levels <- c(ord_levels, if (anyNA(x) && !anyNA(ord_levels)) NA) - - if (identical(o, seq_along(o))) { - res <- new_fact(x, levels, is.ordered(x)) - return(res) - } - - m <- match(order(old_levels), o)[x] - res <- new_fact(m, levels, is.ordered(x)) - return(res) - } - - if (anyNA(x) || anyNA(old_levels)) { - new_levels <- - if (!anyNA(new_levels)) { - c(new_levels, NA) - } else { - na_last(new_levels) - } - } - - m <- match(old_levels, as.character(new_levels))[x] - new_fact(m, new_levels, is.ordered(x)) -} - -#' @rdname fact -#' @export -fact.fact <- function(x) { - x -} - -#' @rdname fact -#' @export -fact.pseudo_id <- function(x) { - u <- .uniques(x) - - # check if numeric and already ordered - if (is.numeric(u)) { - o <- order(u) - if (!identical(o, u)) { - x <- match(u[o], u)[x] - u <- u[o] - } - } - - new_fact(x, levels = u) -} - -#' @rdname fact -#' @export -fact.haven_labelled <- function(x) { - require_namespace("haven") - lvls <- attr(x, "labels") - - if (length(lvls)) { - ux <- unclass(x) - uniques <- sort.int(unique(c(ux, lvls))) - m <- match(ux, uniques) - ml <- match(lvls, uniques) - uniques[ml] <- names(lvls) - res <- new_fact(m, uniques) - } else { - res <- fact(unclass(x)) - } - - attr(res, "label") <- exattr(x, "label") - res -} - -#' @export -print.fact <- function( - x, - max_levels = getOption("mark.fact.max_levels", TRUE), - width = getOption("width"), - ... -) { - # mostly a reformatted base::print.factor() - ord <- is.ordered(x) - if (length(x) == 0L) { - cat(if (ord) "ordered" else "factor", "(0)\n", sep = "") - } else { - print(as.character(x), quote = FALSE, ...) - } - - if (max_levels) { - lev <- encodeString(levels(x), quote = "") - n <- length(lev) - colsep <- if (ord) " < " else " " - T0 <- "Levels: " # nolint: object_name_linter. - if (is.logical(max_levels)) { - max_levels <- { - width <- width - (nchar(T0, "w") + 3L + 1L + 3L) - lenl <- cumsum(nchar(lev, "w") + nchar(colsep, "w")) - - if (n <= 1L || lenl[n] <= width) { - n - } else { - max(1L, which.max(lenl > width) - 1L) - } - } - } - drop <- n > max_levels - cat( - if (drop) paste(format(n), ""), - T0, - paste( - if (drop) { - c(lev[1:max(1L, max_levels - 1L)], "...", if (max_levels > 1L) lev[n]) - } else { - lev - }, - collapse = colsep - ), - "\n", - sep = "" - ) - - # Be nice to haven_labelled - lab <- exattr(x, "label") - if (!is.null(lab)) { - cat("Label: ", paste(format(lab), ""), "\n", sep = "") - } - } - - invisible(x) -} - -# as_ordered -------------------------------------------------------------- - -#' Ordered -#' -#' As ordered -#' -#' @details Simple implementation of `ordered`. If `x` is `ordered` it is -#' simply returned. If `x` is a `factor` the `ordered` class is added. -#' Otherwise, `x` is made into a `factor` with [mark::fact()] and then the -#' `ordered` class is added. Unlike just `fact`, `ordered` will replace the -#' `NA` levels with `NA_integer_` to work appropriately with other functions. -#' -#' @inheritParams fact -#' @seealso [mark::fact()] -#' @family factors -#' @export -#' @returns An `ordered` vector -#' @examples -#' x <- c("a", NA, "b") -#' x <- fact(x) -#' str(x) # NA is 3L -#' -#' y <- x -#' class(y) <- c("ordered", class(y)) -#' max(y) -#' max(y, na.rm = TRUE) # returns NA -- bad -#' -#' # as_ordered() removes the NA level -#' x <- as_ordered(x) -#' str(x) -#' max(x, na.rm = TRUE) # returns b -- correct - -as_ordered <- function(x) { - UseMethod("as_ordered", x) -} - -#' @rdname as_ordered -#' @export -as_ordered.default <- function(x) { - res <- fact_na(x, remove = TRUE) - - if (!is.ordered(x)) { - add_class(res, "ordered", 2L) - } else { - res - } -} - - -# drop_levels ------------------------------------------------------------- - -#' Drop levels -#' -#' Drop unused levels of a factor -#' -#' @param x A `factor` or `data.frame` -#' @param ... Additional arguments passed to methods (not used) -#' @seealso [base::droplevels] -#' @export -#' @family factors -drop_levels <- function(x, ...) { - UseMethod("drop_levels", x) -} - -#' @export -#' @rdname drop_levels -drop_levels.data.frame <- function(x, ...) { - factors <- which(vap_lgl(x, is.factor)) - x[factors] <- lapply(x[factors], drop_levels) - x -} - -#' @export -#' @rdname drop_levels -drop_levels.fact <- function(x, ...) { - if (is.ordered(x)) { - as_ordered(fact_values(x)) - } else { - fact(fact_values(x)) - } -} - -#' @export -#' @rdname drop_levels -drop_levels.factor <- function(x, ...) { - chr <- as.character(x) - lvl <- levels(x) %wi% chr - struct( - match(chr, lvl), - class = c(if (is.fact(x)) "fact", if (is.ordered(x)) "ordered", "factor"), - levels = lvl - ) -} - -# fact_na ----------------------------------------------------------------- - -#' `fact` with `NA` -#' -#' Included `NA` values into `fact()` -#' -#' @details -#' This re-formats the `x` value so that `NA`s are found immediately within the -#' object rather than accessed through its attributes. -#' -#' @param x A `fact` or object cohered to `fact` -#' @param remove If `TRUE` removes `NA` value from the `fact` `levels` and -#' `uniques` attributes -#' @returns A `fact` vector -#' @family factors -#' @export -fact_na <- function(x, remove = FALSE) { - x <- fact(x) - na <- attr(x, "na") - - if (na == 0L) { - return(x) - } - - if (remove) { - attr(x, "levels") <- attr(x, "levels")[-na] - attr(x, "uniques") <- attr(x, "uniques")[-na] - } - - a <- attributes(x) - x <- unclass(x) - x[x == na] <- NA_integer_ - attributes(x) <- a - attr(x, "na") <- 0L - x -} - -# fact_reverse ------------------------------------------------------------ - -#' Fact reverse levels -#' -#' Reverse the levels of a `fact` -#' -#' @param x A `fact` object (or passed to [mark::fact()]) -fact_reverse <- function(x) { - x <- fact(x) - lvls <- flip(attr(x, "uniques")) - seq <- flip(seq_along(lvls)) - na <- attr(x, "na") - - if (na > 0) { - lvls <- c(lvls[-1L], lvls[1L]) - seq <- c(seq[-1L], seq[1L]) - } - - new_fact(seq[x], levels = lvls, ordered = is.ordered(x), na = na) -} - -# other methods ----------------------------------------------------------- - -#' @export -as.integer.fact <- function(x, ...) { - x <- fact_na(x) - nas <- is.na(x) - attributes(x) <- NULL - class(x) <- "integer" - x[nas] <- NA_integer_ - x -} - -#' @export -as.double.fact <- function(x, ...) { - as.double(as.integer(x)) -} - -#' @export -as.character.fact <- function(x, ...) { - as.character(attr(x, "uniques")[x]) -} - -# because unique.factor() remakes factor -# this won't drop levels -#' @export -unique.fact <- function(x, incomparables = FALSE, ...) { - att <- attributes(x) - struct( - unique(unclass(x)), - class = att$class, - levels = att$levels, - uniques = att$uniques, - na = att$na - ) -} - -#' @export -as.Date.fact <- function(x, ...) { - as.Date(attr(x, "uniques"), ...)[x] -} - -#' @export -`[.fact` <- function(x, ...) { - y <- NextMethod("[") - attributes(y) <- attributes(x) - y -} - -# helpers ----------------------------------------------------------------- - -new_fact <- function( - x, - levels, - ordered = FALSE, - na = if (anyNA(levels)) length(levels) else 0L -) { - struct( - as.integer(x), - class = c("fact", if (ordered) "ordered", "factor"), - levels = as.character(levels), - uniques = levels, - na = na - ) -} - -try_numeric <- function(x) { - if (is.numeric(x)) { - return(x) - } - - nas <- is.na(x) - - if (all(nas)) { - return(x) - } - - nums <- wuffle(as.numeric(x[!nas])) - - if (anyNA(nums)) { - return(x) - } - - out <- rep.int(NA_real_, length(x)) - out[!nas] <- nums - out -} - -fact_values <- function(x) { - if (!is.fact(x)) { - stop("x must be a fact object", call. = FALSE) - } - - attr(x, "uniques")[as.integer(x)] -} - -fact_coerce_levels <- function(x) { - nas <- is.na(x) - - if (all(nas) || !anyNA(match(x[!nas], c("TRUE", "FALSE")))) { - return(as.logical(x)) - } - - tz <- getOption("mark.default_tz", "UTC") - wuffle({ - numbers <- as.numeric(x[!nas]) - dates <- as.Date(x[!nas], optional = TRUE) - posix <- as.POSIXct( - x = x[!nas], - tryFormats = try_formats(), - tz = tz, - optional = TRUE - ) - }) - - n <- length(x) - - if (!anyNA(dates) && all(nchar(x[!nas]) == 10L)) { - x <- rep(NA_Date_, n) - x[!nas] <- dates - } else if (!anyNA(posix)) { - x <- rep(NA_real_, n) - if (any(nas)) { - stop() - } - x[] <- as.double(posix) - x <- as.POSIXct( - x = x, - origin = "1970-01-01", - tz = tz - ) - } else if (!anyNA(numbers)) { - x <- rep(NA_real_, n) - x[!nas] <- numbers - } - - x -} - -`fact_levels<-` <- function(x, value) { - x <- fact(x) - levels <- levels(x) - value <- c(value, if (!anyNA(value) & (anyNA(x) | anyNA(levels))) NA) - new_fact(match(levels, value)[x], value, is.ordered(x)) -} - -# nolint next: object_name_linter. -is.fact <- function(x) { - inherits(x, "fact") -} diff --git a/R/pseudo-id.R b/R/pseudo-id.R index c1f4e40c..ae10c9b7 100644 --- a/R/pseudo-id.R +++ b/R/pseudo-id.R @@ -16,6 +16,11 @@ #' #' @export pseudo_id <- function(x, ...) { + # TODO consider deprecating pseudo_id() in v0.9.0 + # warning(deprecated_warning( + # "pseudo_id() is deprecated and will be removed in a future version.", + # " Use as.integer(fact(x)) instead." + # )) UseMethod("pseudo_id", x) } @@ -41,7 +46,7 @@ pseudo_id.default <- function(x, na_last = TRUE, ...) { #' @export #' @rdname pseudo_id pseudo_id.factor <- function(x, ...) { - pseudo_id(fact_values(fact(x))) + pseudo_id(facts::values(fact(x))) } #' Print `pseudo_id` diff --git a/R/rexports-facts.R b/R/rexports-facts.R new file mode 100644 index 00000000..f9d9417f --- /dev/null +++ b/R/rexports-facts.R @@ -0,0 +1,3 @@ +#' @importFrom facts fact +#' @export +facts::fact diff --git a/R/unlist.R b/R/unlist.R index 4ffee60d..a372001a 100644 --- a/R/unlist.R +++ b/R/unlist.R @@ -45,6 +45,6 @@ squash_vec <- function(x, sep = ".") { x <- unlist0(x) id <- pseudo_id(x, na_last = FALSE) nm <- names(x) - squasher <- function(i) collapse(nm[i], sep = sep) - .uniques(id) %names% vap_chr(split(seq_along(id), id), squasher) + squasher <- function(i) collapse0(nm[i], sep = sep) + attr(id, "uniques") %names% vap_chr(split(seq_along(id), id), squasher) } diff --git a/man/as_ordered.Rd b/man/as_ordered.Rd deleted file mode 100644 index 69707684..00000000 --- a/man/as_ordered.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fact.R -\name{as_ordered} -\alias{as_ordered} -\alias{as_ordered.default} -\title{Ordered} -\usage{ -as_ordered(x) - -\method{as_ordered}{default}(x) -} -\arguments{ -\item{x}{A vector of values} -} -\value{ -An \code{ordered} vector -} -\description{ -As ordered -} -\details{ -Simple implementation of \code{ordered}. If \code{x} is \code{ordered} it is -simply returned. If \code{x} is a \code{factor} the \code{ordered} class is added. -Otherwise, \code{x} is made into a \code{factor} with \code{\link[=fact]{fact()}} and then the -\code{ordered} class is added. Unlike just \code{fact}, \code{ordered} will replace the -\code{NA} levels with \code{NA_integer_} to work appropriately with other functions. -} -\examples{ -x <- c("a", NA, "b") -x <- fact(x) -str(x) # NA is 3L - -y <- x -class(y) <- c("ordered", class(y)) -max(y) -max(y, na.rm = TRUE) # returns NA -- bad - -# as_ordered() removes the NA level -x <- as_ordered(x) -str(x) -max(x, na.rm = TRUE) # returns b -- correct -} -\seealso{ -\code{\link[=fact]{fact()}} - -Other factors: -\code{\link{char2fact}()}, -\code{\link{drop_levels}()}, -\code{\link{fact}()}, -\code{\link{fact2char}()}, -\code{\link{fact_na}()} -} -\concept{factors} diff --git a/man/char2fact.Rd b/man/char2fact.Rd index 0230cebf..d89114cf 100644 --- a/man/char2fact.Rd +++ b/man/char2fact.Rd @@ -29,11 +29,7 @@ Converts characters to factors \seealso{ \code{\link[=fact2char]{fact2char()}} -Other factors: -\code{\link{as_ordered}()}, -\code{\link{drop_levels}()}, -\code{\link{fact}()}, -\code{\link{fact2char}()}, -\code{\link{fact_na}()} +Other factors: +\code{\link[=fact2char]{fact2char()}} } \concept{factors} diff --git a/man/clipboard.Rd b/man/clipboard.Rd index 0220579d..605db20f 100644 --- a/man/clipboard.Rd +++ b/man/clipboard.Rd @@ -43,7 +43,7 @@ read_clipboard_methods() \itemize{ \item \code{\link[=write_clipboard]{write_clipboard()}} None, called for side effects \item \code{\link[=read_clipboard]{read_clipboard()}} Either a vector, \code{data.frame}, or \code{tibble} -depending on the \code{method} chosen. Unlike \code{\link[utils:clipboard]{utils::readClipboard()}}, an +depending on the \code{method} chosen. Unlike \code{\link[utils:readClipboard]{utils::readClipboard()}}, an empty clipboard value returns \code{NA} rather than \code{""} } } @@ -52,7 +52,7 @@ Wrappers for working with the clipboard } \details{ As these functions rely on \code{\link[clipr:read_clip]{clipr::read_clip()}} and -\code{\link[utils:clipboard]{utils::writeClipboard()}} they are only available for Windows 10. For +\code{\link[utils:writeClipboard]{utils::writeClipboard()}} they are only available for Windows 10. For copying and pasting floats, there may be some rounding that can occur. } \examples{ diff --git a/man/diff_time.Rd b/man/diff_time.Rd index d99e284f..99613ef7 100644 --- a/man/diff_time.Rd +++ b/man/diff_time.Rd @@ -89,7 +89,7 @@ specifications into the console for less potential confusion. \section{Time zones}{ Time zones can be passed as either a numeric vector of GMT/UTC offsets (the number of seconds from GMT) or as a character vector. -If the letter, these need to conform with values from \code{\link[base:timezones]{base::OlsonNames()}}. +If the letter, these need to conform with values from \code{\link[base:OlsonNames]{base::OlsonNames()}}. A default timezone can be set with \code{options(mark.default_tz = .)}. The value can either be a numeric diff --git a/man/drop_levels.Rd b/man/drop_levels.Rd deleted file mode 100644 index d1c4c4c5..00000000 --- a/man/drop_levels.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fact.R -\name{drop_levels} -\alias{drop_levels} -\alias{drop_levels.data.frame} -\alias{drop_levels.fact} -\alias{drop_levels.factor} -\title{Drop levels} -\usage{ -drop_levels(x, ...) - -\method{drop_levels}{data.frame}(x, ...) - -\method{drop_levels}{fact}(x, ...) - -\method{drop_levels}{factor}(x, ...) -} -\arguments{ -\item{x}{A \code{factor} or \code{data.frame}} - -\item{...}{Additional arguments passed to methods (not used)} -} -\description{ -Drop unused levels of a factor -} -\seealso{ -\link[base:droplevels]{base::droplevels} - -Other factors: -\code{\link{as_ordered}()}, -\code{\link{char2fact}()}, -\code{\link{fact}()}, -\code{\link{fact2char}()}, -\code{\link{fact_na}()} -} -\concept{factors} diff --git a/man/fact.Rd b/man/fact.Rd deleted file mode 100644 index 3567df6c..00000000 --- a/man/fact.Rd +++ /dev/null @@ -1,86 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fact.R -\name{fact} -\alias{fact} -\alias{fact.default} -\alias{fact.character} -\alias{fact.numeric} -\alias{fact.integer} -\alias{fact.Date} -\alias{fact.POSIXt} -\alias{fact.logical} -\alias{fact.factor} -\alias{fact.fact} -\alias{fact.pseudo_id} -\alias{fact.haven_labelled} -\title{Factor} -\usage{ -fact(x) - -\method{fact}{default}(x) - -\method{fact}{character}(x) - -\method{fact}{numeric}(x) - -\method{fact}{integer}(x) - -\method{fact}{Date}(x) - -\method{fact}{POSIXt}(x) - -\method{fact}{logical}(x) - -\method{fact}{factor}(x) - -\method{fact}{fact}(x) - -\method{fact}{pseudo_id}(x) - -\method{fact}{haven_labelled}(x) -} -\arguments{ -\item{x}{A vector of values} -} -\value{ -A vector of equal length of \code{x} with class \code{fact} and \code{factor}. If -\code{x} was \code{ordered}, that class is added in between. -} -\description{ -Quickly create a factor -} -\details{ -\code{\link[=fact]{fact()}} can be about 5 times quicker than \code{\link[base:factor]{base::factor()}} or -\code{\link[base:factor]{base::as.factor()}} as it doesn't bother sorting the levels for non-numeric -data or have other checks or features. It simply converts a vector to a -factor with all unique values as levels with \code{NA}s included. - -\code{\link[=fact.factor]{fact.factor()}} will perform several checks on a factor to include -\code{NA} levels and to check if the levels should be reordered to conform with -the other methods. The \code{\link[=fact.fact]{fact.fact()}} method simple returns \code{x}. -} -\section{level orders}{ - - -The order of the levels may be adjusted to these rules depending on the -class of \code{x}: -\describe{ -\item{\code{character}}{The order of appearance} -\item{\code{numeric}/\code{integer}/\code{Date}/\code{POSIXt}}{By the numeric order} -\item{\code{logical}}{As \code{TRUE}, \code{FALSE}, then \code{NA} if present} -\item{\code{factor}}{Numeric if levels can be safely converted, otherwise as -they are} -} -} - -\seealso{ -\code{\link[=as_ordered]{as_ordered()}} - -Other factors: -\code{\link{as_ordered}()}, -\code{\link{char2fact}()}, -\code{\link{drop_levels}()}, -\code{\link{fact2char}()}, -\code{\link{fact_na}()} -} -\concept{factors} diff --git a/man/fact2char.Rd b/man/fact2char.Rd index b1f70cbd..c1d3c73a 100644 --- a/man/fact2char.Rd +++ b/man/fact2char.Rd @@ -21,11 +21,7 @@ Convert factor columns to characters in a \code{data.frame} \seealso{ \code{\link[=char2fact]{char2fact()}} -Other factors: -\code{\link{as_ordered}()}, -\code{\link{char2fact}()}, -\code{\link{drop_levels}()}, -\code{\link{fact}()}, -\code{\link{fact_na}()} +Other factors: +\code{\link[=char2fact]{char2fact()}} } \concept{factors} diff --git a/man/fact_na.Rd b/man/fact_na.Rd deleted file mode 100644 index 3c54f131..00000000 --- a/man/fact_na.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fact.R -\name{fact_na} -\alias{fact_na} -\title{\code{fact} with \code{NA}} -\usage{ -fact_na(x, remove = FALSE) -} -\arguments{ -\item{x}{A \code{fact} or object cohered to \code{fact}} - -\item{remove}{If \code{TRUE} removes \code{NA} value from the \code{fact} \code{levels} and -\code{uniques} attributes} -} -\value{ -A \code{fact} vector -} -\description{ -Included \code{NA} values into \code{fact()} -} -\details{ -This re-formats the \code{x} value so that \code{NA}s are found immediately within the -object rather than accessed through its attributes. -} -\seealso{ -Other factors: -\code{\link{as_ordered}()}, -\code{\link{char2fact}()}, -\code{\link{drop_levels}()}, -\code{\link{fact}()}, -\code{\link{fact2char}()} -} -\concept{factors} diff --git a/man/fact_reverse.Rd b/man/fact_reverse.Rd deleted file mode 100644 index c3aaf460..00000000 --- a/man/fact_reverse.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fact.R -\name{fact_reverse} -\alias{fact_reverse} -\title{Fact reverse levels} -\usage{ -fact_reverse(x) -} -\arguments{ -\item{x}{A \code{fact} object (or passed to \code{\link[=fact]{fact()}})} -} -\description{ -Reverse the levels of a \code{fact} -} diff --git a/man/file_copy_md5.Rd b/man/file_copy_md5.Rd index f1767865..0ea48350 100644 --- a/man/file_copy_md5.Rd +++ b/man/file_copy_md5.Rd @@ -12,7 +12,7 @@ file_copy_md5(path, new_path, overwrite = NA, quiet = FALSE) \item{new_path}{A character vector of paths to the new locations.} \item{overwrite}{When \code{NA}, only saves if the md5 hashes do not match. -Otherwise, see \code{\link[fs:copy]{fs::file_copy()}}.} +Otherwise, see \code{\link[fs:file_copy]{fs::file_copy()}}.} \item{quiet}{When \code{TRUE}, suppresses messages from md5 checks.} } diff --git a/man/fizzbuzz.Rd b/man/fizzbuzz.Rd index 60f9da16..0361019b 100644 --- a/man/fizzbuzz.Rd +++ b/man/fizzbuzz.Rd @@ -1,14 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/fizzbuzz.R -\docType{data} \name{fizzbuzz} \alias{fizzbuzz} \alias{fizzbuzz_lazy} \alias{.fizzbuzz_vector} \title{Fizz Buzz} -\format{ -An object of class \code{character} of length 1000000. -} \usage{ fizzbuzz(n, show_numbers = TRUE) @@ -47,4 +43,3 @@ if (package_available("bench")) { } } } -\keyword{datasets} diff --git a/man/is_dir.Rd b/man/is_dir.Rd index 7dc40ff2..27573da8 100644 --- a/man/is_dir.Rd +++ b/man/is_dir.Rd @@ -19,6 +19,6 @@ A \code{logical} vector Is the path a file/directory? } \details{ -These are essentially taken from \code{\link[utils:filetest]{utils::file_test()}} for \code{op = '-d'} and +These are essentially taken from \code{\link[utils:file_test]{utils::file_test()}} for \code{op = '-d'} and \code{op = -f} but separated. } diff --git a/man/logic_ext.Rd b/man/logic_ext.Rd index 707d434a..8bdd46c1 100644 --- a/man/logic_ext.Rd +++ b/man/logic_ext.Rd @@ -74,14 +74,14 @@ All functions take logical or logical-like (i.e., \code{1}, \code{0}, or Extensions to the base logical operations to account for \code{NA} values. -\code{\link[base:Logic]{base::isTRUE()}} and \code{\link[base:Logic]{base::isFALSE()}} will only return single length +\code{\link[base:isTRUE]{base::isTRUE()}} and \code{\link[base:isFALSE]{base::isFALSE()}} will only return single length \code{TRUE} or \code{FALSE} as it checks for valid lengths in the evaluation. When needing to check over a vector for the presence of \code{TRUE} or \code{FALSE} and not being held back by \code{NA} values, \code{\link[=is_true]{is_true()}} and \code{\link[=is_false]{is_false()}} will always provide a \code{TRUE} \code{FALSE} when the vector is logical or return \code{NA} is the vector \code{x} is not logical. -\link{\%xor\%} is just a wrapper for \code{\link[base:Logic]{base::xor()}} +\link{\%xor\%} is just a wrapper for \code{\link[base:xor]{base::xor()}} } \details{ Logical operations, extended diff --git a/man/mark.Rd b/man/mark.Rd index f3f77b45..48ee7050 100644 --- a/man/mark.Rd +++ b/man/mark.Rd @@ -21,4 +21,9 @@ Useful links: \author{ \strong{Maintainer}: Jordan Mark Barbone \email{jmbarbone@gmail.com} (\href{https://orcid.org/0000-0001-9788-3628}{ORCID}) [copyright holder] +Authors: +\itemize{ + \item Jordan Mark Barbone \email{jmbarbone@gmail.com} (\href{https://orcid.org/0000-0001-9788-3628}{ORCID}) [copyright holder] +} + } diff --git a/man/median2.Rd b/man/median2.Rd index 90ebddfb..d722c8a8 100644 --- a/man/median2.Rd +++ b/man/median2.Rd @@ -18,7 +18,7 @@ q50(x, type = 7, na.rm = FALSE) \item{type}{an integer between 1 and 9 selecting one of the nine quantile algorithms detailed below to be used.} -\item{na.rm}{logical; if true, any \code{\link{NA}} and \code{NaN}'s +\item{na.rm}{logical; if true, any \code{\link{NA}} and \code{NaN} values are removed from \code{x} before the quantiles are computed.} } \value{ diff --git a/man/multi_grepl.Rd b/man/multi_grepl.Rd index e8673d73..dbc47f81 100644 --- a/man/multi_grepl.Rd +++ b/man/multi_grepl.Rd @@ -10,13 +10,13 @@ multi_grepl(x, patterns, ..., simplify = TRUE) multi_grep(x, patterns, ..., simplify = TRUE) } \arguments{ -\item{x}{Passed to \code{\link[base:grep]{base::grepl()}}} +\item{x}{Passed to \code{\link[base:grepl]{base::grepl()}}} \item{patterns}{A list or vector of patterns to search across \code{x}; if named value returned will be the name of the pattern -- otherwise the position. Pattern match reported will be the first in the list that is found} -\item{...}{Additional arguments passed to \code{\link[base:grep]{base::grepl()}}} +\item{...}{Additional arguments passed to \code{\link[base:grepl]{base::grepl()}}} \item{simplify}{if \code{FALSE} will return a list of all matches, otherwise the first match found} diff --git a/man/not_available.Rd b/man/not_available.Rd index f53ff6bf..04f16e57 100644 --- a/man/not_available.Rd +++ b/man/not_available.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/not-available.R -\docType{data} \name{not_available} \alias{not_available} \alias{set_not_available} @@ -8,13 +7,6 @@ \alias{NA_POSIXct_} \alias{NA_POSIXlt_} \title{Make not available} -\format{ -An object of class \code{Date} of length 1. - -An object of class \code{POSIXct} (inherits from \code{POSIXt}) of length 1. - -An object of class \code{logical} of length 1. -} \usage{ not_available(type = "logical", length = 0L) @@ -48,4 +40,3 @@ x class(x) } -\keyword{datasets} diff --git a/man/package_available.Rd b/man/package_available.Rd index 08243da1..485ba33a 100644 --- a/man/package_available.Rd +++ b/man/package_available.Rd @@ -16,5 +16,5 @@ package_available(namespace) } } \description{ -A wrapped \code{\link[base:ns-load]{base::requireNamespace()}} +A wrapped \code{\link[base:requireNamespace]{base::requireNamespace()}} } diff --git a/man/range2.Rd b/man/range2.Rd index 49060112..e4d27f56 100644 --- a/man/range2.Rd +++ b/man/range2.Rd @@ -7,7 +7,7 @@ range2(x, na.rm = FALSE) } \arguments{ -\item{x}{A numeric (or character) vector (see Note in \link[base:Extremes]{base::min})} +\item{x}{A numeric (or character) vector (see Note in \link[base:min]{base::min})} \item{na.rm}{Logical, if \code{TRUE} removes missing values} } @@ -16,7 +16,7 @@ A \code{numeric} vector of length 2 of the minimum and maximum values, respectively } \description{ -Employs \code{\link[base:Extremes]{base::min()}} and \code{\link[base:Extremes]{base::max()}}. However, \code{\link[base:range]{base::range()}}, there is +Employs \code{\link[base:min]{base::min()}} and \code{\link[base:max]{base::max()}}. However, \code{\link[base:range]{base::range()}}, there is no argument for removing \code{Inf} values. } \examples{ diff --git a/man/reexports.Rd b/man/reexports.Rd index e31cd8b3..16f1f359 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -1,5 +1,6 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reexports-fuj.R, R/reexports-magrittr.R +% Please edit documentation in R/reexports-fuj.R, R/reexports-magrittr.R, +% R/rexports-facts.R \docType{import} \name{reexports} \alias{reexports} @@ -29,6 +30,7 @@ \alias{require_namespace} \alias{struct} \alias{\%>\%} +\alias{fact} \title{Objects exported from other packages} \keyword{internal} \description{ @@ -36,8 +38,10 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{fuj}{\code{\link[fuj:colons]{\%::\%}}, \code{\link[fuj:colons]{\%:::\%}}, \code{\link[fuj:colons]{\%colons\%}}, \code{\link[fuj:if_null]{\%len\%}}, \code{\link[fuj:names]{\%names\%}}, \code{\link[fuj:match_ext]{\%out\%}}, \code{\link[fuj:match_ext]{\%wi\%}}, \code{\link[fuj:match_ext]{\%wo\%}}, \code{\link[fuj:if_null]{\%||\%}}, \code{\link[fuj:match_ext]{any_match}}, \code{\link[fuj]{exattr}}, \code{\link[fuj]{flip}}, \code{\link[fuj:os]{is_linux}}, \code{\link[fuj:os]{is_macos}}, \code{\link[fuj:names]{is_named}}, \code{\link[fuj:os]{is_windows}}, \code{\link[fuj]{muffle}}, \code{\link[fuj:match_ext]{no_match}}, \code{\link[fuj]{quick_df}}, \code{\link[fuj:quick_df]{quick_dfl}}, \code{\link[fuj:names]{remove_names}}, \code{\link[fuj]{require_namespace}}, \code{\link[fuj:names]{set_names}}, \code{\link[fuj]{struct}}, \code{\link[fuj:muffle]{wuffle}}} + \item{facts}{\code{\link[facts:fact]{fact()}}} - \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} + \item{fuj}{\code{\link[fuj:\%::\%]{\%::\%}}, \code{\link[fuj:\%:::\%]{\%:::\%}}, \code{\link[fuj:\%colons\%]{\%colons\%}}, \code{\link[fuj:\%len\%]{\%len\%}}, \code{\link[fuj:\%names\%]{\%names\%}}, \code{\link[fuj:\%out\%]{\%out\%}}, \code{\link[fuj:\%wi\%]{\%wi\%}}, \code{\link[fuj:\%wo\%]{\%wo\%}}, \code{\link[fuj:\%||\%]{\%||\%}}, \code{\link[fuj:any_match]{any_match()}}, \code{\link[fuj:exattr]{exattr()}}, \code{\link[fuj:flip]{flip()}}, \code{\link[fuj:is_linux]{is_linux()}}, \code{\link[fuj:is_macos]{is_macos()}}, \code{\link[fuj:is_named]{is_named()}}, \code{\link[fuj:is_windows]{is_windows()}}, \code{\link[fuj:muffle]{muffle()}}, \code{\link[fuj:no_match]{no_match()}}, \code{\link[fuj:quick_df]{quick_df()}}, \code{\link[fuj:quick_dfl]{quick_dfl()}}, \code{\link[fuj:remove_names]{remove_names()}}, \code{\link[fuj:require_namespace]{require_namespace()}}, \code{\link[fuj:set_names]{set_names()}}, \code{\link[fuj:struct]{struct()}}, \code{\link[fuj:wuffle]{wuffle()}}} + + \item{magrittr}{\code{\link[magrittr:\%>\%]{\%>\%}}} }} diff --git a/man/row_bind.Rd b/man/row_bind.Rd index 37c36bcd..1c073a95 100644 --- a/man/row_bind.Rd +++ b/man/row_bind.Rd @@ -18,5 +18,5 @@ and \code{0} rows is returned if \code{...} has no length Bind a list of \code{data.frames} } \seealso{ -\code{\link[dplyr:bind_rows]{dplyr::bind_rows()}} \code{\link[base:cbind]{base::rbind()}} +\code{\link[dplyr:bind_rows]{dplyr::bind_rows()}} \code{\link[base:rbind]{base::rbind()}} } diff --git a/man/sourcing.Rd b/man/sourcing.Rd index bce399b6..adbb1cf3 100644 --- a/man/sourcing.Rd +++ b/man/sourcing.Rd @@ -18,7 +18,7 @@ try_ksource(file, ...) \item{...}{Additional arguments passed to \code{\link[base:source]{base::source()}}} -\item{quiet}{Logical; Determines whether to apply silence to \code{\link[knitr:knit]{knitr::purl()}}} +\item{quiet}{Logical; Determines whether to apply silence to \code{\link[knitr:purl]{knitr::purl()}}} \item{cd}{Logical; if \code{TRUE}, the \strong{R} working directory is temporarily changed to the directory containing file for evaluating} diff --git a/man/switch-ext.Rd b/man/switch-ext.Rd index 5a9e182a..191f42dd 100644 --- a/man/switch-ext.Rd +++ b/man/switch-ext.Rd @@ -22,7 +22,7 @@ switch_case(..., .default = NULL, .envir = parent.frame()) (default: \code{NULL} produces an \code{NA} value derived from \code{...})} \item{.envir}{The environment in which to evaluate the LHS of \code{...} (default: -\code{\link[base:sys.parent]{base::parent.frame()}})} +\code{\link[base:parent.frame]{base::parent.frame()}})} } \value{ A named vector of values of same length \code{x}; or for diff --git a/man/tableNA.Rd b/man/tableNA.Rd index 6eff10de..2d84e7f3 100644 --- a/man/tableNA.Rd +++ b/man/tableNA.Rd @@ -49,9 +49,10 @@ tableNA(x[1], x[2]) tableNA(x[1], x[2], x[3]) # equivalent ot tableNA(x, .list = TRUE) } \references{ -Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988) - \emph{The New S Language}. - Wadsworth & Brooks/Cole. +{\if{html}{\out{}}Becker RA, Chambers JM, Wilks AR (1988). +\emph{The New S Language}. +Chapman and Hall/CRC, London. +ISBN 053409192X.} } \seealso{ \code{\link[base]{tabulate}} is the underlying function and allows finer diff --git a/man/vap.Rd b/man/vap.Rd index 3b6ffaad..14676bfa 100644 --- a/man/vap.Rd +++ b/man/vap.Rd @@ -39,7 +39,7 @@ A vector of type matching the intended value in the function name. Wrappers for vapply } \details{ -These are simply wrappers for \code{\link[base:lapply]{base::vapply()}} to shorten lines. +These are simply wrappers for \code{\link[base:vapply]{base::vapply()}} to shorten lines. Each function is designed to use specific vector types: @@ -53,5 +53,5 @@ Each function is designed to use specific vector types: } } \seealso{ -\code{\link[base:lapply]{base::vapply()}} +\code{\link[base:vapply]{base::vapply()}} } diff --git a/man/write_file_md5.Rd b/man/write_file_md5.Rd index c4230055..6bcc56fe 100644 --- a/man/write_file_md5.Rd +++ b/man/write_file_md5.Rd @@ -31,7 +31,7 @@ determined by file extension of \code{path}, if present, otherwise by the type of object of \code{x}.} \item{overwrite}{When \code{NA}, only saves if the md5 hashes do not match. -Otherwise, see \code{\link[fs:copy]{fs::file_copy()}}.} +Otherwise, see \code{\link[fs:file_copy]{fs::file_copy()}}.} \item{quiet}{When \code{TRUE}, suppresses messages from md5 checks.} @@ -44,7 +44,7 @@ Otherwise, see \code{\link[fs:copy]{fs::file_copy()}}.} \value{ \itemize{ \item \code{\link[=write_file_md5]{write_file_md5()}}: \code{x}, invisibly. When \code{path} is not the -\code{\link[base:showConnections]{base::stdout()}}, \code{x} is returned with the attribute \code{"path"} set to the +\code{\link[base:stdout]{base::stdout()}}, \code{x} is returned with the attribute \code{"path"} set to the result of \code{\link[=file_copy_md5]{file_copy_md5()}}. \item \code{\link[=mark_write_methods]{mark_write_methods()}}: A list of applicable methods and their aliases diff --git a/tests/testthat/_snaps/fact.md b/tests/testthat/_snaps/fact.md deleted file mode 100644 index cb5c9a9f..00000000 --- a/tests/testthat/_snaps/fact.md +++ /dev/null @@ -1,55 +0,0 @@ -# snapshots - - Code - fact(character()) - Output - factor(0) - Levels: - ---- - - Code - fact(1:5) - Output - [1] 1 2 3 4 5 - Levels: 1 2 3 4 5 - ---- - - Code - print(fact(1:100), max_levels = TRUE) - Output - [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 - [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 - [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 - [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 - [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 - [91] 91 92 93 94 95 96 97 98 99 100 - 100 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 ... 100 - ---- - - Code - print(fact(1:100), max_levels = 20) - Output - [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 - [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 - [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 - [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 - [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 - [91] 91 92 93 94 95 96 97 98 99 100 - 100 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ... 100 - ---- - - Code - print(fact(1:100), max_levels = 100) - Output - [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 - [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 - [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 - [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 - [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 - [91] 91 92 93 94 95 96 97 98 99 100 - Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 - diff --git a/tests/testthat/_snaps/write.md b/tests/testthat/_snaps/write.md index 6b3add41..eb791f28 100644 --- a/tests/testthat/_snaps/write.md +++ b/tests/testthat/_snaps/write.md @@ -12,11 +12,11 @@ Code write_file_md5(dataframe(a = 1), method = "parquet") Output - # A data frame: 2 x 12 - file_name name r_type type type_length repetition_type converted_type - - 1 /tmp/ sche~ NA - 2 /tmp/ a double DOUB~ NA REQUIRED - # i 5 more variables: logical_type >, num_children , scale , - # precision , field_id + # A data frame: 2 x 14 + file_name r_col name r_type type type_length repetition_type converted_type + + 1 /tmp/Rtmp~ NA sche~ NA + 2 /tmp/Rtmp~ 1 a double DOUB~ NA REQUIRED + # i 6 more variables: logical_type >, num_children , scale , + # precision , field_id , children diff --git a/tests/testthat/test-counts.R b/tests/testthat/test-counts.R index 83bf6905..a284ca86 100644 --- a/tests/testthat/test-counts.R +++ b/tests/testthat/test-counts.R @@ -1,5 +1,3 @@ - - # counts() ---------------------------------------------------------------- test_that("counts.default() work", { @@ -19,7 +17,6 @@ test_that("counts.default() work", { }) test_that("counts() works with NAs", { - # Correct sort x <- c(FALSE, TRUE, NA) res <- set_names(c(1, 1, 1), x) @@ -123,7 +120,7 @@ test_that("props() handles NA", { df <- dataframe(x = x, y = y) res_x1 <- dataframe(x = c(1, 2, 3, NA), prop = c(.20, .40, .20, .20)) - res_x2 <- dataframe(x = c(1, 2, 3, NA), prop = c(.25, .50, .25, NA)) + res_x2 <- dataframe(x = c(1, 2, 3, NA), prop = c(.25, .50, .25, NA)) expect_identical(props(df, "x"), res_x1) expect_identical(props(df, "x", na.rm = TRUE), res_x2) diff --git a/tests/testthat/test-fact.R b/tests/testthat/test-fact.R deleted file mode 100644 index 4e720445..00000000 --- a/tests/testthat/test-fact.R +++ /dev/null @@ -1,391 +0,0 @@ - -# fact.logical() ---- - -test_that("fact.logical() works", { - x <- fact(c(TRUE, FALSE, NA)) - expect_message(capture.output(print(x)), NA) - - x <- fact(c(FALSE, NA, NA, TRUE, FALSE)) - res <- new_fact(c(2L, 3L, 3L, 1L, 2L), c(TRUE, FALSE, NA)) - expect_identical(x, res) - - expect_false(anyNA(x)) -}) - -# fact.pseudo_id() ---- - -test_that("fact.pseudo_id() works", { - expect_message( - capture.output(print(fact(pseudo_id(c("a", "a", "b", NA_character_))))), - NA - ) - - # Should appropriately order numeric values - x <- c(0L, 10L, 10L, NA, 0L, 5L) - id <- pseudo_id(x) - f <- fact(id) - res <- new_fact(c(1L, 3L, 3L, 4L, 1L, 2L), c(0L, 5L, 10L, NA_integer_)) - - expect_identical(fact(x), f) - expect_identical(fact(x), res) - - # Shouldn't have any NA - expect_false(anyNA(fact(x))) - - # pseudo_id() ordered by appearance, fact() has pre-set ordering - expect_identical(pseudo_id(f), id) - - # factors store levels as characters - o <- order(as.integer(levels(f))) - expect_identical(o, 1:4) -}) - -# fact.integer() ---- - -test_that("fact.integer() works", { - expect_equal( - fact(struct(1L, c("foo", "integer"))), - new_fact(1L, levels = 1L) - ) -}) - -# fact.factor() ---- - -test_that("fact.factor() works", { - x <- factor(letters) - class(x) <- c("fact", "factor") - expect_identical(fact(x), x) - - x <- ordered(letters) - class(x) <- c("fact", "ordered", "factor") - expect_identical(fact(x), x) - - x <- struct(1L, c("fact", "factor"), levels = c("a", NA_character_)) - expect_identical(fact(x), x) - - # fact.fact() checks for NA and adds - x <- factor(c(1, NA, 2)) - expect_identical(levels(fact(x)), c("1", "2", NA_character_)) - - # moves NA to the end and reordered when number - x <- factor(c(1, NA, 2), levels = c(2, NA, 1), exclude = NULL) - res <- new_fact(c(1, 3, 2), levels = c(1, 2, NA)) - expect_identical(fact(x), res) - - x <- factor(c(NA, TRUE, FALSE)) - res <- new_fact(c(3L, 1L, 2L), levels = c(TRUE, FALSE, NA)) - expect_identical(fact(x), res) - - x <- factor(c(NA, TRUE, FALSE), exclude = NULL) - res <- new_fact(c(3L, 1L, 2L), levels = c(TRUE, FALSE, NA)) - expect_identical(fact(x), res) -}) - -# fact.haven_labelled() ---- - -test_that("fact.haven_labelled() works", { - skip_if_not_installed("haven") - .haven_as_factor <- "haven" %:::% "as_factor.haven_labelled" - haven_as_fact <- function(...) { - res <- fact(.haven_as_factor(...)) - attr(res, "label") <- exattr(..1, "label") - res - } - - expect_id_fact <- function(x) { - testthat::expect_identical( - fact(x), - haven_as_fact(x), - ignore_attr = c("uniques", "na") - ) - } - - # Integers - r <- rep(1:3, 2) - x <- haven::labelled(r, labels = c(good = 1, bad = 3)) - expect_id_fact(x) - - x <- haven::labelled(r, labels = c(good = 1, bad = 3), label = "this") - expect_id_fact(x) - - x <- haven::labelled( - r, - labels = c(good = 1, neutral = 2, bad = 3), - label = "this" - ) - expect_id_fact(x) - - x <- haven::labelled(r, label = "this") - expect_id_fact(x) - - # Doubles - x <- haven::labelled(c(0, 0.5, 1), c(a = 0, b = 1)) - expect_id_fact(x) - - # Character - x <- haven::labelled(letters, c(good = "j", something = "m", cool = "b")) - expect_id_fact(x) - - # Unique not in levels; levels not in unique - x <- haven::labelled( - c(-10, 20, 40, 60), - labels = c(a = 10, b = 20, c = 30, d = 40), - label = "foo" - ) - expect_id_fact(x) -}) - -# nas ---- - -test_that("fact() correctly labels NAs [#24]", { - expect_equal( - fact(c(NA, "a", "b")), - new_fact(c(3L, 1L, 2L), c("a", "b", NA)) - ) - - expect_equal( - fact(c(NA, 1, 3)), - new_fact(c(3L, 1L, 2L), c(1, 3, NA)) - ) - - expect_equal( - fact(c(1, NA, NA, 3)), - new_fact(c(1L, 3L, 3L, 2L), c(1, 3, NA)) - ) - - expect_equal( - fact(c(TRUE, TRUE, NA, FALSE, TRUE)), - new_fact(c(1L, 1L, 3L, 2L, 1L), c(TRUE, FALSE, NA)) - ) -}) - - -test_that("fact() ignores NaN", { - # ignore NaN - res <- fact(c(1, 2, NA, 3, NaN)) - exp <- struct( - c(1L, 2L, 4L, 3L, 4L), - class = c("fact", "factor"), - levels = c("1", "2", "3", NA), - uniques = c(1, 2, 3, NA), - na = 4L - ) - - expect_identical(res, exp) -}) - - -# ordering ---- - -test_that("as_ordered() works", { - res <- fact(c(1:3, NA_integer_)) - exp <- struct( - c(1:3, NA_integer_), - c("fact", "ordered", "factor"), - levels = as.character(1:3), - uniques = 1:3, - na = 0L - ) - expect_identical(as_ordered(res), exp) -}) - -test_that("as_ordered() doesn't duplicate class", { - res <- class(as_ordered(as.ordered(letters[1:3]))) - expect_identical(res, c("fact", "ordered", "factor")) -}) - - -# fact.default() ---------------------------------------------------------- - -test_that("fact.default() fails", { - expect_error(fact(struct(NULL, "foo"))) -}) - - -# `fact_levels<-`() ------------------------------------------------------- - -test_that("`fact_levels<-`() works", { - x <- fact(1:3) - fact_levels(x) <- 1:4 - exp <- struct( - 1:3, - class = c("fact", "factor"), - levels = as.character(1:4), - uniques = 1:4, - na = 0L - ) - expect_identical(x, exp) -}) - - -# fact_coerce_levels() ---------------------------------------------------- - -test_that("fact_coerce_levels() works", { - x <- as.Date("2021-09-03") + 0:2 - expect_equal(fact_coerce_levels(as.character(x)), x) - - # Be careful about setting a time zone - # Not very good for dealing with local - # NOTE r-dev after 4.2.1 has some weird behavior with the 0 and returns: - # ('2021-09-03', '2021-09-03 00:00:01', '2021-09-03 00:00:02') - x <- as.POSIXlt("2021-09-03", tz = "UTC") + 1:3 - expect_equal(fact_coerce_levels(as.character(x)), x) - - x <- as.POSIXlt("2021-09-03", tz = "UTC") + 1:3 - expect_equal(fact_coerce_levels(as.character(x)), x) -}) - - -# try_numeric() ----------------------------------------------------------- - -test_that("try_numeric() works", { - x <- 1 - expect_identical(try_numeric(x), x) - - x <- c(NA, NA) - expect_identical(try_numeric(x), x) - - x <- c("a", 1) - expect_identical(try_numeric(x), x) - - x <- c(1, NA, 2) - expect_identical(try_numeric(as.character(x)), x) -}) - - -# drop_levels ------------------------------------------------------------- - -test_that("drop_levels() works", { - x <- factor(1, 1:2) - exp <- factor(1, 1) - expect_equal(drop_levels(x), exp) - - df <- dataframe(x = x, y = 1) - df_exp <- dataframe(x = exp, y = 1) - expect_equal(drop_levels(df), df_exp) - - # facts and ordered - x <- fact(1:10) - expect_identical(drop_levels(x), x) - - x <- as_ordered(factor(1, 1:2)) - exp <- struct( - 1L, - class = c("fact", "ordered", "factor"), - levels = "1", - uniques = 1L, - na = 0L - ) - expect_equal(drop_levels(x), exp) -}) - - -# fact_reverse() ---------------------------------------------------------- - -test_that("fact_reverse() works", { - res <- fact_reverse(1:4) - exp <- new_fact(4:1, 4:1) - expect_identical(res, exp) - - res <- fact_reverse(as_ordered(1:4)) - exp <- new_fact(4:1, 4:1, ordered = TRUE) - expect_identical(res, exp) - - res <- fact_reverse(c(1:3, NA)) - exp <- new_fact(c(3:1, 4L), c(3:1, NA)) - expect_identical(res, exp) - - res <- fact_reverse(as_ordered(c(1:3, NA))) - exp <- struct( - c(3:1, NA), - class = c("fact", "ordered", "factor"), - levels = c("3", "2", "1"), - uniques = 3:1, - na = 0L - ) - - expect_identical(res, exp) -}) - - - -# other methods ----------------------------------------------------------- - -test_that("[.fact() works", { - x <- fact(1:3) - x1 <- do.call(structure, c(1, attributes(x))) - x2 <- do.call(structure, c(2, attributes(x))) - expect_identical(x[1], x1) - expect_identical(x[2], x2) -}) - -test_that("is.na.fact(), works", { - x <- fact(c(1, 2, NA, 3)) - res <- is.na(x) - exp <- c(FALSE, FALSE, FALSE, FALSE) - expect_identical(res, exp) - - x <- fact_na(c(1, 2, NA, 3)) - res <- is.na(x) - exp <- c(FALSE, FALSE, TRUE, FALSE) - expect_identical(res, exp) - - x <- fact_na(c("a", "b", "c")) - res <- is.na(x) - exp <- c(FALSE, FALSE, FALSE) - expect_identical(res, exp) -}) - -test_that("as.integer.fact() works", { - x <- fact(c(1, 2, NA, 3)) - res <- as.integer(x) - exp <- c(1L, 2L, NA_integer_, 3L) - expect_identical(res, exp) -}) - -test_that("as.integer.fact() works", { - x <- fact(c(1, 2, NA, 3)) - res <- as.double(x) - exp <- c(1, 2, NA_real_, 3) - expect_identical(res, exp) - expect_identical(as.numeric(x), exp) -}) - -test_that("unique.fact() works", { - x <- fact(c(1, 2, NA, 3, 2)) - exp <- fact(c(1, 2, NA, 3)) - res <- unique(x) - expect_identical(exp, res) - - x <- as_ordered(x) - exp <- as_ordered(exp) - res <- unique(x) - expect_identical(exp, res) -}) - -test_that("as.Date.fact() works", { - exp <- as.Date(c("2022-01-02", NA, "1908-12-21")) - res <- as.Date(fact(exp)) - expect_identical(exp, res) - - x <- c("01-01-2022", "01-02-2000") - exp <- as.Date(x, "%d-%m-%Y") - res <- as.Date(fact(x), "%d-%m-%Y") - expect_identical(exp, res) -}) - -test_that("as.character.fact() works", { - exp <- c("a", NA_character_, "b", "b", "a") - res <- as.character(fact(exp)) - expect_identical(exp, res) -}) - -# snapshots --------------------------------------------------------------- - -test_that("snapshots", { - expect_snapshot(fact(character())) - expect_snapshot(fact(1:5)) - expect_snapshot(print(fact(1:100), max_levels = TRUE)) - expect_snapshot(print(fact(1:100), max_levels = 20)) - expect_snapshot(print(fact(1:100), max_levels = 100)) -}) diff --git a/tests/testthat/test-nas.R b/tests/testthat/test-nas.R index c90f39a2..171680e4 100644 --- a/tests/testthat/test-nas.R +++ b/tests/testthat/test-nas.R @@ -9,7 +9,7 @@ test_that("remove_na()", { 1:3, c("fact", "factor"), levels = c("1", "2", "3"), - uniques = c(1, 2, 3), + values = c(1, 2, 3), na = 0L ) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..097b2416 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/facts.Rmd b/vignettes/facts.Rmd new file mode 100644 index 00000000..a49546eb --- /dev/null +++ b/vignettes/facts.Rmd @@ -0,0 +1,114 @@ +--- +title: "Working with `facts`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Working with `facts`} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +bench_mark <- function(x) { + if (!(requireNamespace("bench") & requireNamespace("forcats"))) return(NULL) + b <- bench::mark(fact(x), factor(x), forcats::as_factor(x), iterations = 50, check = FALSE) + if (requireNamespace("ggplot2")) print(ggplot2::autoplot(b) + ggplot2::labs(title = class(x))) + b +} +``` + +```{r setup} +library(mark) +``` + +`fact`s are a special class much like `factors` but with some performance improvements. + +| Case | `factor()` | `fact()` | +| ------- | ---------- | -------- | +| Level sorting | When not set, sorts | Sorts numbers, preset sorting for logical, no sorting for character | +| `NA` | Default levels don't include `NA` | When `NA` is present, is added as the last level | +| S3 methods | None | S3 methods can extend functionality | +| Parameters | `x = character()`, `levels`, `labels = levels`, `exclude = NA`, `ordered = is.ordered(x)`, `nmax = NA` | `x` | +| Attributes | `levels`, `class`| `levels`, `uniques`, `na`, `class` | + +Notes on S3 methods + +| Class | Notes | +| ----- | ---------- | +| `.default` | Warns and defaults to `character()`. Adding new S3 methods will avoid this warning | +| `.character` | Does not perform any sorting, levels taken as they appear in the data | +| `.numeric`, `.integer`, `.Date`, `POSIXt` | Performs radix sorting, treats `NaN` as `NA` | +| `.factor` | Tries to restore data types before dispatching S3 methods | +| `.fact` | Returns values -- assumes value was created with `fact()` | +| `.haven_labelled` | Designed to mimic `haven::as_factor.haven_labelled()` | + +```{r, fig.width=6} +x <- apply(matrix(sample(letters, 1e3, TRUE), ncol = 4), 1, collapse0) +bench_mark(x) + +x <- round(runif(1e3), 2) +bench_mark(x) + +x <- order(x) +bench_mark(x) + +x <- x > 1e5 / 2 +x[sample(x, 1e3)] <- NA +bench_mark(x) +``` + +`fact()` takes an S3 approach for factors which allows data to take different sorting and matching processes. +This allows `fact()` to be most efficient with its labeling and transformations. +This differs from `factor()` which uses the same process, and always sorts labels in ascending order. + +```{r} +utils::methods("fact") +``` + +`fact()` currently doesn't have any further arguments than `x`, the object passed to it. +This makes their utility different than `factor()`, the later of which can be helpful when levels are known a prior. +Otherwise, `fact()` is better suited for not knowing levels. + +```{r} +x <- 4:1 +factor(x) +fact(x) +``` + +```{r} +x <- c("j", "m", "b") +factor(x) +fact(x) +``` + +```{r} +x <- c(1, 3, 2, 0) +factor(x) +fact(x) +``` + +There is a divergence here, where `fact` is meant to understand that boolean operations can have 3 possible outcomes and that it might be best to allow at least `TRUE` and `FALSE` regardless of their presence. +This understanding also speeds up performance and becomes much quicker. +`factor()` runs the same routine for all data, so many of the check are a bit useless if you don't intend to rec + +```{r} +x <- c(TRUE, NA, FALSE) +factor(x) +fact(x) +``` + +The last example also highlights `fact()`'s handling of `NA`s. +For `fact()`, `NA` values are always stored as the last `level`. + +```{r} +x <- as.Date("2022-03-29") - 0:2 + +fact1 <- factor(x) +x2 <- fact(x) + +bench::mark(as.Date(x1), as.Date(x2)) +```