From a04e7c0dae7c76de306c5353ec3e98169f1a1e14 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 14 Jan 2026 19:00:21 +0000 Subject: [PATCH] use = more --- R/highlevel64.R | 630 ++++++++++++++++++++++++------------------------ 1 file changed, 315 insertions(+), 315 deletions(-) diff --git a/R/highlevel64.R b/R/highlevel64.R index 135ca9e..90cd9e9 100644 --- a/R/highlevel64.R +++ b/R/highlevel64.R @@ -127,27 +127,27 @@ NULL #' @export # nocov start # nolint start: brace_linter, line_length_linter. -benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time) { +benchmark64 = function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time) { message('\ncompare performance for a complete sessions of calls') - s <- sample(nbig, nsmall, TRUE) - b <- sample(nbig, nbig, TRUE) - b2 <- sample(nbig, nbig, TRUE) + s = sample(nbig, nsmall, TRUE) + b = sample(nbig, nbig, TRUE) + b2 = sample(nbig, nbig, TRUE) - tim1 <- double(6L) + tim1 = double(6L) names(tim1) <- c("32-bit", "64-bit", "hashcache", "sortordercache", "ordercache", "allcache") - s <- as.integer(s) - b <- as.integer(b) - b2 <- as.integer(b2) + s = as.integer(s) + b = as.integer(b) + b2 = as.integer(b2) for (i in 1:6) { message("\n=== ", names(tim1)[i], " ===") if (i==2L) { - s <- as.integer64(s) - b <- as.integer64(b) - b2 <- as.integer64(b2) + s <- as.integer64(s) + b <- as.integer64(b) + b2 <- as.integer64(b2) } tim1[i] <- 0L @@ -237,26 +237,26 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time) { message("\nnow let's look more systematically at the components involved") - s <- sample(nbig, nsmall, TRUE) - b <- sample(nbig, nbig, TRUE) - b2 <- sample(nbig, nbig, TRUE) + s = sample(nbig, nsmall, TRUE) + b = sample(nbig, nbig, TRUE) + b2 = sample(nbig, nbig, TRUE) - tim2 <- matrix(0.0, 15L, 6L) + tim2 = matrix(0.0, 15L, 6L) dimnames(tim2) <- list( c("cache", "match(s, b)", "s %in% b", "match(b, s)", "b %in% s", "match(b, b)", "b %in% b", "duplicated(b)", "unique(b)", "table(b)", "sort(b)", "order(b)", "rank(b)", "quantile(b)", "summary(b)"), # nolint: line_length_linter. c("32-bit", "64-bit", "hashcache", "sortordercache", "ordercache", "allcache") ) - s <- as.integer(s) - b <- as.integer(b) - b2 <- as.integer(b2) + s = as.integer(s) + b = as.integer(b) + b2 = as.integer(b2) - i <- 1L + i = 1L for (i in 1:6) { if (i==2L) { - s <- as.integer64(s) - b <- as.integer64(b) - b2 <- as.integer64(b2) + s <- as.integer64(s) + b <- as.integer64(b) + b2 <- as.integer64(b2) } if (i>2L) message(colnames(tim2)[i], " cache") @@ -345,7 +345,7 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time) { remcache(b) remcache(b2) - tim3 <- rbind(tim2, SESSION=tim1) + tim3 = rbind(tim2, SESSION=tim1) #tim2 <- tim2[, 1]/tim2 cat("seconds") @@ -399,307 +399,307 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time) { #' R integer function with several low-level integer64 functions with and #' without caching #' @export -optimizer64 <- function(nsmall=2L^16L, +optimizer64 = function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time, what=c("match", "%in%", "duplicated", "unique", "unipos", "table", "rank", "quantile"), uniorder=c("original", "values", "any"), taborder=c("values", "counts"), plot=TRUE) { - uniorder <- match.arg(uniorder) - taborder <- match.arg(taborder) - ret <- vector("list", 2L*length(what)) + uniorder = match.arg(uniorder) + taborder = match.arg(taborder) + ret = vector("list", 2L*length(what)) dim(ret) <- c(length(what), 2L) dimnames(ret) <- list(what, c(nsmall, nbig)) if (plot) { - oldpar <- par(no.readonly = TRUE) + oldpar = par(no.readonly = TRUE) on.exit(par(oldpar)) par(mfrow=c(2L, 1L)) } if ("match" %in% what) { message("match: timings of different methods") - N1 <- c(nsmall, nbig) - N2 <- c(nbig, nsmall) + N1 = c(nsmall, nbig) + N2 = c(nbig, nsmall) for (i in seq_along(N1)) { - n1 <- N1[i] - n2 <- N2[i] - x1 <- c(sample(n2, n1-1L, TRUE), NA) - x2 <- c(sample(n2, n2-1L, TRUE), NA) - tim <- matrix(0.0, 9L, 3L) - dimnames(tim) <- list( - c("match", "match.64", "hashpos", "hashrev", "sortorderpos", "orderpos", "hashcache", "sortorder.cache", "order.cache"), # nolint: line_length_linter. - c("prep", "both", "use") - ) - - tim["match", "both"] <- timefun({ - p <- match(x1, x2) - })[3L] - x1 <- as.integer64(x1) - x2 <- as.integer64(x2) + n1 <- N1[i] + n2 <- N2[i] + x1 <- c(sample(n2, n1-1L, TRUE), NA) + x2 <- c(sample(n2, n2-1L, TRUE), NA) + tim <- matrix(0.0, 9L, 3L) + dimnames(tim) <- list( + c("match", "match.64", "hashpos", "hashrev", "sortorderpos", "orderpos", "hashcache", "sortorder.cache", "order.cache"), # nolint: line_length_linter. + c("prep", "both", "use") + ) - tim["match.64", "both"] <- timefun({ - p2 <- match.integer64(x1, x2) - })[3L] - stopifnot(identical(p2, p)) + tim["match", "both"] <- timefun({ + p <- match(x1, x2) + })[3L] + x1 <- as.integer64(x1) + x2 <- as.integer64(x2) - tim["hashpos", "prep"] <- timefun({ - h2 <- hashmap(x2) - })[3L] - tim["hashpos", "use"] <- timefun({ - p2 <- hashpos(h2, x1) - })[3L] - stopifnot(identical(p2, p)) + tim["match.64", "both"] <- timefun({ + p2 <- match.integer64(x1, x2) + })[3L] + stopifnot(identical(p2, p)) - tim["hashrev", "prep"] <- timefun({ - h1 <- hashmap(x1) - })[3L] - tim["hashrev", "use"] <- timefun({ - p1 <- hashrev(h1, x2) - })[3L] - stopifnot(identical(p1, p)) + tim["hashpos", "prep"] <- timefun({ + h2 <- hashmap(x2) + })[3L] + tim["hashpos", "use"] <- timefun({ + p2 <- hashpos(h2, x1) + })[3L] + stopifnot(identical(p2, p)) - tim["sortorderpos", "prep"] <- system.time({ - s2 <- clone(x2) - o2 <- seq_along(x2) - ramsortorder(s2, o2, na.last=FALSE) - })[3L] - tim["sortorderpos", "use"] <- timefun({ - p2 <- sortorderpos(s2, o2, x1) - })[3L] - stopifnot(identical(p2, p)) + tim["hashrev", "prep"] <- timefun({ + h1 <- hashmap(x1) + })[3L] + tim["hashrev", "use"] <- timefun({ + p1 <- hashrev(h1, x2) + })[3L] + stopifnot(identical(p1, p)) + + tim["sortorderpos", "prep"] <- system.time({ + s2 <- clone(x2) + o2 <- seq_along(x2) + ramsortorder(s2, o2, na.last=FALSE) + })[3L] + tim["sortorderpos", "use"] <- timefun({ + p2 <- sortorderpos(s2, o2, x1) + })[3L] + stopifnot(identical(p2, p)) - tim["orderpos", "prep"] <- timefun({ - o2 <- seq_along(x2) - ramorder(x2, o2, na.last=FALSE) - })[3L] - tim["orderpos", "use"] <- timefun({ - p2 <- orderpos(x2, o2, x1, method=2L) - })[3L] - stopifnot(identical(p2, p)) + tim["orderpos", "prep"] <- timefun({ + o2 <- seq_along(x2) + ramorder(x2, o2, na.last=FALSE) + })[3L] + tim["orderpos", "use"] <- timefun({ + p2 <- orderpos(x2, o2, x1, method=2L) + })[3L] + stopifnot(identical(p2, p)) - hashcache(x2) - tim["hashcache", "use"] <- timefun({ - p2 <- match.integer64(x1, x2) - })[3L] - stopifnot(identical(p2, p)) - remcache(x2) + hashcache(x2) + tim["hashcache", "use"] <- timefun({ + p2 <- match.integer64(x1, x2) + })[3L] + stopifnot(identical(p2, p)) + remcache(x2) - sortordercache(x2) - tim["sortorder.cache", "use"] <- timefun({ - p2 <- match.integer64(x1, x2) - })[3L] - stopifnot(identical(p2, p)) - remcache(x2) + sortordercache(x2) + tim["sortorder.cache", "use"] <- timefun({ + p2 <- match.integer64(x1, x2) + })[3L] + stopifnot(identical(p2, p)) + remcache(x2) - ordercache(x2) - tim["order.cache", "use"] <- timefun({ - p2 <- match.integer64(x1, x2) - })[3L] - stopifnot(identical(p2, p)) - remcache(x2) + ordercache(x2) + tim["order.cache", "use"] <- timefun({ + p2 <- match.integer64(x1, x2) + })[3L] + stopifnot(identical(p2, p)) + remcache(x2) - if (plot) { - barplot(t(tim)) - n <- format(c(n1, n2)) - title(paste("match", n[1L], "in", n[2L])) - } + if (plot) { + barplot(t(tim)) + n <- format(c(n1, n2)) + title(paste("match", n[1L], "in", n[2L])) + } - ret[["match", as.character(n1)]] <- tim + ret[["match", as.character(n1)]] <- tim } } if ("%in%" %in% what) { message("%in%: timings of different methods") - N1 <- c(nsmall, nbig) - N2 <- c(nbig, nsmall) + N1 = c(nsmall, nbig) + N2 = c(nbig, nsmall) for (i in seq_along(N1)) { - n1 <- N1[i] - n2 <- N2[i] - x1 <- c(sample(n2, n1-1L, TRUE), NA) - x2 <- c(sample(n2, n2-1L, TRUE), NA) - tim <- matrix(0.0, 10L, 3L) - dimnames(tim) <- list( - c("%in%", "match.64", "%in%.64", "hashfin", "hashrin", "sortfin", "orderfin", "hash.cache", "sortorder.cache", "order.cache"), # nolint: line_length_linter. - c("prep", "both", "use") - ) + n1 <- N1[i] + n2 <- N2[i] + x1 <- c(sample(n2, n1-1L, TRUE), NA) + x2 <- c(sample(n2, n2-1L, TRUE), NA) + tim <- matrix(0.0, 10L, 3L) + dimnames(tim) <- list( + c("%in%", "match.64", "%in%.64", "hashfin", "hashrin", "sortfin", "orderfin", "hash.cache", "sortorder.cache", "order.cache"), # nolint: line_length_linter. + c("prep", "both", "use") + ) - tim["%in%", "both"] <- timefun({ - p <- x1 %in% x2 - })[3L] - x1 <- as.integer64(x1) - x2 <- as.integer64(x2) + tim["%in%", "both"] <- timefun({ + p <- x1 %in% x2 + })[3L] + x1 <- as.integer64(x1) + x2 <- as.integer64(x2) - tim["match.64", "both"] <- timefun({ - p2 <- match.integer64(x1, x2, nomatch = 0L) > 0L - })[3L] - stopifnot(identical(p2, p)) + tim["match.64", "both"] <- timefun({ + p2 <- match.integer64(x1, x2, nomatch = 0L) > 0L + })[3L] + stopifnot(identical(p2, p)) - tim["%in%.64", "both"] <- timefun({ - p2 <- "%in%.integer64"(x1, x2) # this is using the custom version - })[3L] - stopifnot(identical(p2, p)) + tim["%in%.64", "both"] <- timefun({ + p2 <- "%in%.integer64"(x1, x2) # this is using the custom version + })[3L] + stopifnot(identical(p2, p)) - tim["hashfin", "prep"] <- timefun({ - h2 <- hashmap(x2) - })[3L] - tim["hashfin", "use"] <- timefun({ - p2 <- hashfin(h2, x1) - })[3L] - stopifnot(identical(p2, p)) + tim["hashfin", "prep"] <- timefun({ + h2 <- hashmap(x2) + })[3L] + tim["hashfin", "use"] <- timefun({ + p2 <- hashfin(h2, x1) + })[3L] + stopifnot(identical(p2, p)) - tim["hashrin", "prep"] <- timefun({ - h1 <- hashmap(x1) - })[3L] - tim["hashrin", "use"] <- timefun({ - p1 <- hashrin(h1, x2) - })[3L] - stopifnot(identical(p2, p)) + tim["hashrin", "prep"] <- timefun({ + h1 <- hashmap(x1) + })[3L] + tim["hashrin", "use"] <- timefun({ + p1 <- hashrin(h1, x2) + })[3L] + stopifnot(identical(p2, p)) - tim["sortfin", "prep"] <- timefun({ - s2 <- clone(x2) - ramsort(s2, na.last=FALSE) - })[3L] - tim["sortfin", "use"] <- timefun({ - p2 <- sortfin(s2, x1) - })[3L] - stopifnot(identical(p2, p)) + tim["sortfin", "prep"] <- timefun({ + s2 <- clone(x2) + ramsort(s2, na.last=FALSE) + })[3L] + tim["sortfin", "use"] <- timefun({ + p2 <- sortfin(s2, x1) + })[3L] + stopifnot(identical(p2, p)) - tim["orderfin", "prep"] <- timefun({ - o2 <- seq_along(x2) - ramorder(x2, o2, na.last=FALSE) - })[3L] - tim["orderfin", "use"] <- timefun({ - p2 <- orderfin(x2, o2, x1) - })[3L] - stopifnot(identical(p2, p)) + tim["orderfin", "prep"] <- timefun({ + o2 <- seq_along(x2) + ramorder(x2, o2, na.last=FALSE) + })[3L] + tim["orderfin", "use"] <- timefun({ + p2 <- orderfin(x2, o2, x1) + })[3L] + stopifnot(identical(p2, p)) - hashcache(x2) - tim["hash.cache", "use"] <- timefun({ - p2 <- "%in%.integer64"(x1, x2) - })[3L] - stopifnot(identical(p2, p)) - remcache(x2) + hashcache(x2) + tim["hash.cache", "use"] <- timefun({ + p2 <- "%in%.integer64"(x1, x2) + })[3L] + stopifnot(identical(p2, p)) + remcache(x2) - sortordercache(x2) - tim["sortorder.cache", "use"] <- timefun({ - p2 <- "%in%.integer64"(x1, x2) - })[3L] - stopifnot(identical(p2, p)) - remcache(x2) + sortordercache(x2) + tim["sortorder.cache", "use"] <- timefun({ + p2 <- "%in%.integer64"(x1, x2) + })[3L] + stopifnot(identical(p2, p)) + remcache(x2) - ordercache(x2) - tim["order.cache", "use"] <- timefun({ - p2 <- "%in%.integer64"(x1, x2) - })[3L] - stopifnot(identical(p2, p)) - remcache(x2) + ordercache(x2) + tim["order.cache", "use"] <- timefun({ + p2 <- "%in%.integer64"(x1, x2) + })[3L] + stopifnot(identical(p2, p)) + remcache(x2) - if (plot) { - barplot(t(tim)) - n <- format(c(n1, n2)) - title(paste(n[1L], "%in%", n[2L])) - } + if (plot) { + barplot(t(tim)) + n <- format(c(n1, n2)) + title(paste(n[1L], "%in%", n[2L])) + } - ret[["%in%", as.character(n1)]] <- tim + ret[["%in%", as.character(n1)]] <- tim } } if ("duplicated" %in% what) { message("duplicated: timings of different methods") - N <- c(nsmall, nbig) + N = c(nsmall, nbig) for (i in seq_along(N)) { - n <- N[i] - x <- c(sample(n, n-1L, TRUE), NA) - tim <- matrix(0.0, 10L, 3L) - dimnames(tim) <- list( - c("duplicated", "duplicated.64", "hashdup", "sortorderdup1", "sortorderdup2", "orderdup1", "orderdup2", "hash.cache", "sortorder.cache", "order.cache"), # nolint: line_length_linter. - c("prep", "both", "use") - ) + n <- N[i] + x <- c(sample(n, n-1L, TRUE), NA) + tim <- matrix(0.0, 10L, 3L) + dimnames(tim) <- list( + c("duplicated", "duplicated.64", "hashdup", "sortorderdup1", "sortorderdup2", "orderdup1", "orderdup2", "hash.cache", "sortorder.cache", "order.cache"), # nolint: line_length_linter. + c("prep", "both", "use") + ) - tim["duplicated", "both"] <- timefun({ - p <- duplicated(x) - })[3L] - x <- as.integer64(x) + tim["duplicated", "both"] <- timefun({ + p <- duplicated(x) + })[3L] + x <- as.integer64(x) - tim["duplicated.64", "both"] <- timefun({ - p2 <- duplicated(x) - })[3L] - stopifnot(identical(p2, p)) + tim["duplicated.64", "both"] <- timefun({ + p2 <- duplicated(x) + })[3L] + stopifnot(identical(p2, p)) - tim["hashdup", "prep"] <- timefun({ - h <- hashmap(x) - })[3L] - tim["hashdup", "use"] <- timefun({ - p2 <- hashdup(h) - })[3L] - stopifnot(identical(p2, p)) + tim["hashdup", "prep"] <- timefun({ + h <- hashmap(x) + })[3L] + tim["hashdup", "use"] <- timefun({ + p2 <- hashdup(h) + })[3L] + stopifnot(identical(p2, p)) - tim["sortorderdup1", "prep"] <- timefun({ - s <- clone(x) - o <- seq_along(x) - ramsortorder(s, o, na.last=FALSE) - nunique <- sortnut(s)[1L] - })[3L] - tim["sortorderdup1", "use"] <- timefun({ - p2 <- sortorderdup(s, o, method=1L) - })[3L] - stopifnot(identical(p2, p)) + tim["sortorderdup1", "prep"] <- timefun({ + s <- clone(x) + o <- seq_along(x) + ramsortorder(s, o, na.last=FALSE) + nunique <- sortnut(s)[1L] + })[3L] + tim["sortorderdup1", "use"] <- timefun({ + p2 <- sortorderdup(s, o, method=1L) + })[3L] + stopifnot(identical(p2, p)) - tim["sortorderdup2", "prep"] <- tim["sortorderdup1", "prep"] - tim["sortorderdup2", "use"] <- timefun({ - p2 <- sortorderdup(s, o, method=2L) - })[3L] - stopifnot(identical(p2, p)) + tim["sortorderdup2", "prep"] <- tim["sortorderdup1", "prep"] + tim["sortorderdup2", "use"] <- timefun({ + p2 <- sortorderdup(s, o, method=2L) + })[3L] + stopifnot(identical(p2, p)) - tim["orderdup1", "prep"] <- timefun({ - o <- seq_along(x) - ramorder(x, o, na.last=FALSE) - nunique <- ordernut(x, o)[1L] - })[3L] - tim["orderdup1", "use"] <- timefun({ - p2 <- orderdup(x, o, method=1L) - })[3L] - stopifnot(identical(p2, p)) + tim["orderdup1", "prep"] <- timefun({ + o <- seq_along(x) + ramorder(x, o, na.last=FALSE) + nunique <- ordernut(x, o)[1L] + })[3L] + tim["orderdup1", "use"] <- timefun({ + p2 <- orderdup(x, o, method=1L) + })[3L] + stopifnot(identical(p2, p)) - tim["orderdup2", "prep"] <- tim["orderdup1", "prep"] - tim["orderdup2", "use"] <- timefun({ - p2 <- orderdup(x, o, method=2L) - })[3L] - stopifnot(identical(p2, p)) + tim["orderdup2", "prep"] <- tim["orderdup1", "prep"] + tim["orderdup2", "use"] <- timefun({ + p2 <- orderdup(x, o, method=2L) + })[3L] + stopifnot(identical(p2, p)) - hashcache(x) - tim["hash.cache", "use"] <- timefun({ - p2 <- duplicated(x) - })[3L] - stopifnot(identical(p2, p)) - remcache(x) + hashcache(x) + tim["hash.cache", "use"] <- timefun({ + p2 <- duplicated(x) + })[3L] + stopifnot(identical(p2, p)) + remcache(x) - sortordercache(x) - tim["sortorder.cache", "use"] <- timefun({ - p2 <- duplicated(x) - })[3L] - stopifnot(identical(p2, p)) - remcache(x) + sortordercache(x) + tim["sortorder.cache", "use"] <- timefun({ + p2 <- duplicated(x) + })[3L] + stopifnot(identical(p2, p)) + remcache(x) - ordercache(x) - tim["order.cache", "use"] <- timefun({ - p2 <- duplicated(x) - })[3L] - stopifnot(identical(p2, p)) - remcache(x) + ordercache(x) + tim["order.cache", "use"] <- timefun({ + p2 <- duplicated(x) + })[3L] + stopifnot(identical(p2, p)) + remcache(x) - if (plot) { - barplot(t(tim), cex.names=0.7) - title(paste0("duplicated(", n, ")")) - } + if (plot) { + barplot(t(tim), cex.names=0.7) + title(paste0("duplicated(", n, ")")) + } - ret[["duplicated", as.character(n)]] <- tim + ret[["duplicated", as.character(n)]] <- tim } } if ("unique" %in% what) { message("unique: timings of different methods") - N <- c(nsmall, nbig) + N = c(nsmall, nbig) for (i in seq_along(N)) { n <- N[i] x <- c(sample(n, n-1L, TRUE), NA) @@ -845,7 +845,7 @@ optimizer64 <- function(nsmall=2L^16L, } if ("unipos" %in% what) { message("unipos: timings of different methods") - N <- c(nsmall, nbig) + N = c(nsmall, nbig) for (i in seq_along(N)) { n <- N[i] x <- c(sample(n, n-1L, TRUE), NA) @@ -980,7 +980,7 @@ optimizer64 <- function(nsmall=2L^16L, } if ("table" %in% what) { message("table: timings of different methods") - N <- c(nsmall, nbig) + N = c(nsmall, nbig) for (i in seq_along(N)) { n <- N[i] x <- c(sample.int(1024L, n-1L, replace=TRUE), NA) @@ -1354,7 +1354,7 @@ optimizer64 <- function(nsmall=2L^16L, #' } #' @keywords manip logic #' @export -match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, method=NULL, ...) { +match.integer64 = function(x, table, nomatch = NA_integer_, nunique=NULL, method=NULL, ...) { # trivial cases for zero length input if (!length(x)) return(integer()) if (!length(table)) { @@ -1362,8 +1362,8 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho return(rep(nomatch, length(x))) } stopifnot(is.integer64(x)) - table <- as.integer64(table) - cache_env <- cache(table) + table = as.integer64(table) + cache_env = cache(table) if (is.null(method)) { if (is.null(cache_env)) { nx <- length(x) @@ -1399,7 +1399,7 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho } } } - method <- match.arg(method, c("hashpos", "hashrev", "sortorderpos", "orderpos")) + method = match.arg(method, c("hashpos", "hashrev", "sortorderpos", "orderpos")) switch(method, hashpos={ if (is.null(cache_env) || is.null(cache_env$hashmap)) { @@ -1458,9 +1458,9 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho #' @export `%in%.integer64` <- function(x, table, ...) { stopifnot(is.integer64(x)) - table <- as.integer64(table) - nunique <- NULL - cache_env <- cache(table) + table = as.integer64(table) + nunique = NULL + cache_env = cache(table) if (is.null(cache_env)) { nx <- length(x) if (is.null(nunique)) @@ -1494,7 +1494,7 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho method <- "hashfin" } } - method <- match.arg(method, c("hashfin", "hashrin", "sortfin", "orderfin")) + method = match.arg(method, c("hashfin", "hashrin", "sortfin", "orderfin")) switch(method, hashfin={ if (is.null(cache_env) || is.null(cache_env$hashmap)) { @@ -1580,9 +1580,9 @@ match.integer64 <- function(x, table, nomatch = NA_integer_, nunique=NULL, metho #' stopifnot(identical(duplicated(x), duplicated(as.integer(x)))) #' @keywords logic manip #' @export -duplicated.integer64 <- function(x, incomparables = FALSE, nunique = NULL, method = NULL, ...) { +duplicated.integer64 = function(x, incomparables = FALSE, nunique = NULL, method = NULL, ...) { stopifnot(identical(incomparables, FALSE)) - cache_env <- cache(x) + cache_env = cache(x) if (is.null(nunique) && !is.null(cache_env)) nunique <- cache_env$nunique if (is.null(method)) { @@ -1603,7 +1603,7 @@ duplicated.integer64 <- function(x, incomparables = FALSE, nunique = NULL, metho method <- "hashdup" } } - method <- match.arg(method, c("hashdup", "sortorderdup", "orderdup")) + method = match.arg(method, c("hashdup", "sortorderdup", "orderdup")) switch(method, hashdup={ if (is.null(cache_env) || is.null(cache_env$hashmap)) @@ -1689,16 +1689,16 @@ duplicated.integer64 <- function(x, incomparables = FALSE, nunique = NULL, metho #' #' @keywords manip logic #' @export -unique.integer64 <- function(x, +unique.integer64 = function(x, incomparables=FALSE, order=c("original", "values", "any"), nunique=NULL, method=NULL, ...) { stopifnot(identical(incomparables, FALSE)) - order <- match.arg(order) - cache_env <- cache(x) - keep.order <- order == "original" + order = match.arg(order) + cache_env = cache(x) + keep.order = order == "original" if (is.null(nunique) && !is.null(cache_env)) nunique <- cache_env$nunique if (is.null(method)) { @@ -1744,7 +1744,7 @@ unique.integer64 <- function(x, ) } } - method <- match.arg(method, c("hashmapuni", "hashuni", "sortuni", "sortorderuni", "orderuni")) + method = match.arg(method, c("hashmapuni", "hashuni", "sortuni", "sortorderuni", "orderuni")) switch(method, hashmapuni={ p <- hashmapuni(x, nunique=nunique) @@ -1846,20 +1846,20 @@ unique.integer64 <- function(x, #' #' @keywords manip logic #' @export -unipos <- function(x, incomparables = FALSE, order = c("original", "values", "any"), ...) UseMethod("unipos") +unipos = function(x, incomparables = FALSE, order = c("original", "values", "any"), ...) UseMethod("unipos") #' @rdname unipos #' @export -unipos.integer64 <- function(x, +unipos.integer64 = function(x, incomparables=FALSE, order=c("original", "values", "any"), nunique=NULL, method=NULL, ...) { stopifnot(identical(incomparables, FALSE)) - order <- match.arg(order) - cache_env <- cache(x) - keep.order <- order == "original" + order = match.arg(order) + cache_env = cache(x) + keep.order = order == "original" if (is.null(nunique) && !is.null(cache_env)) nunique <- cache_env$nunique if (is.null(method)) { @@ -1907,7 +1907,7 @@ unipos.integer64 <- function(x, ) } } - method <- match.arg(method, c("hashmapupo", "hashupo", "sortorderupo", "orderupo")) + method = match.arg(method, c("hashmapupo", "hashupo", "sortorderupo", "orderupo")) switch(method, hashmapupo={ p <- hashmapupo(x, nunique=nunique) @@ -2048,17 +2048,17 @@ unipos.integer64 <- function(x, #' @concept occurrences #' @concept contingency table #' @export -table.integer64 <- function(..., +table.integer64 = function(..., return = c("table", "data.frame", "list"), order = c("values", "counts"), nunique = NULL, method = NULL, dnn = list.names(...), deparse.level = 1L) { - order <- match.arg(order) - return <- match.arg(return) + order = match.arg(order) + return = match.arg(return) # this is taken from 'table' - list.names <- function(...) { + list.names = function(...) { l <- as.list(substitute(list(...)))[-1L] nm <- names(l) fixup <- if (is.null(nm)) @@ -2080,10 +2080,10 @@ table.integer64 <- function(..., # COPY ON MODIFY is broken for reading from list(...) # because list(...) creates a copy of all ... and this invalidates our caches # therefore we go this sick workaround - argsymbols <- as.list(substitute(list(...)))[-1L] - argframe <- parent.frame() - A <- function(i) eval(argsymbols[[i]], argframe) - N <- length(argsymbols) + argsymbols = as.list(substitute(list(...)))[-1L] + argframe = parent.frame() + A = function(i) eval(argsymbols[[i]], argframe) + N = length(argsymbols) if (!N) stop("nothing to tabulate") if (N == 1L && is.list(A(1L))) { @@ -2142,7 +2142,7 @@ table.integer64 <- function(..., x <- x + d[[i]] * (sortorderkey(s, o) - 1L) } } - cache_env <- cache(x) + cache_env = cache(x) if (is.null(nunique) && !is.null(cache_env)) nunique <- cache_env$nunique if (is.null(method)) { @@ -2175,7 +2175,7 @@ table.integer64 <- function(..., } } } - method <- match.arg(method, c("hashmaptab", "hashtab", "sorttab", "ordertab")) + method = match.arg(method, c("hashmaptab", "hashtab", "sorttab", "ordertab")) switch(method, hashmaptab={ tmp <- hashmaptab(x, nunique=nunique) @@ -2272,7 +2272,7 @@ table.integer64 <- function(..., cnt } -as.integer64.factor <- function(x, ...) as.integer64(unclass(x)) +as.integer64.factor = function(x, ...) as.integer64(unclass(x)) #' Extract Positions in redundant dimension table #' @@ -2306,12 +2306,12 @@ as.integer64.factor <- function(x, ...) as.integer64(unclass(x)) #' stopifnot(identical(keypos(x), match.integer64(x, sort(unique(x), na.last=FALSE)))) #' @keywords manip univar #' @export -keypos <- function(x, ...) UseMethod("keypos") +keypos = function(x, ...) UseMethod("keypos") #' @rdname keypos #' @export -keypos.integer64 <- function(x, method = NULL, ...) { - cache_env <- cache(x) +keypos.integer64 = function(x, method = NULL, ...) { + cache_env = cache(x) if (is.null(method)) { if (is.null(cache_env)) { method <- "sortorderkey" @@ -2324,7 +2324,7 @@ keypos.integer64 <- function(x, method = NULL, ...) { method <- "sortorderkey" } } - method <- match.arg(method, c("sortorderkey", "orderkey")) + method = match.arg(method, c("sortorderkey", "orderkey")) switch(method, sortorderkey={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { @@ -2381,12 +2381,12 @@ keypos.integer64 <- function(x, method = NULL, ...) { #' stopifnot(identical(tiepos(x), (1:length(x))[duplicated(x) | rev(duplicated(rev(x)))])) #' @keywords manip univar #' @export -tiepos <- function(x, ...) UseMethod("tiepos") +tiepos = function(x, ...) UseMethod("tiepos") #' @rdname tiepos #' @export -tiepos.integer64 <- function(x, nties = NULL, method = NULL, ...) { - cache_env <- cache(x) +tiepos.integer64 = function(x, nties = NULL, method = NULL, ...) { + cache_env = cache(x) if (is.null(nties) && !is.null(cache_env)) nties <- cache_env$nties if (is.null(method)) { @@ -2401,7 +2401,7 @@ tiepos.integer64 <- function(x, nties = NULL, method = NULL, ...) { method <- "sortordertie" } } - method <- match.arg(method, c("sortordertie", "ordertie")) + method = match.arg(method, c("sortordertie", "ordertie")) switch(method, sortordertie={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { @@ -2459,8 +2459,8 @@ tiepos.integer64 <- function(x, nties = NULL, method = NULL, ...) { #' #' @keywords univar #' @export -rank.integer64 <- function(x, method = NULL, ...) { - cache_env <- cache(x) +rank.integer64 = function(x, method = NULL, ...) { + cache_env = cache(x) if (is.null(method)) { if (is.null(cache_env)) { method <- "sortorderrnk" @@ -2473,7 +2473,7 @@ rank.integer64 <- function(x, method = NULL, ...) { method <- "sortorderrnk" } } - method <- match.arg(method, c("sortorderrnk", "orderrnk")) + method = match.arg(method, c("sortorderrnk", "orderrnk")) switch(method, sortorderrnk={ if (is.null(cache_env) || is.null(cache_env$sort) || is.null(cache_env$order)) { @@ -2525,11 +2525,11 @@ rank.integer64 <- function(x, method = NULL, ...) { #' stopifnot(identical(x, unname(qtile(x, probs=prank(x))))) #' @keywords univar #' @export -prank <- function(x, ...) UseMethod("prank") +prank = function(x, ...) UseMethod("prank") #' @rdname prank #' @export -prank.integer64 <- function(x, method = NULL, ...) { - n <- nvalid(x) +prank.integer64 = function(x, method = NULL, ...) { + n = nvalid(x) if (n<2L) return(rep(as.integer64(NA), length(x))) (rank.integer64(x, method=method, ...)-1L) / (n-1L) } @@ -2583,16 +2583,16 @@ prank.integer64 <- function(x, method = NULL, ...) { #' stopifnot(identical(x, unname(qtile(x, probs=prank(x))))) #' @keywords univar #' @export -qtile <- function(x, probs = seq(0.0, 1.0, 0.25), ...) UseMethod("qtile") +qtile = function(x, probs = seq(0.0, 1.0, 0.25), ...) UseMethod("qtile") #' @rdname qtile #' @param names logical; if `TRUE`, the result has a `names` attribute. Set to `FALSE` for speedup with many probs. #' @param method NULL for automatic method selection or a suitable low-level method, see details #' @export -qtile.integer64 <- function(x, probs = seq(0.0, 1.0, 0.25), names = TRUE, method = NULL, ...) { +qtile.integer64 = function(x, probs = seq(0.0, 1.0, 0.25), names = TRUE, method = NULL, ...) { if (any(is.na(probs) | probs<0.0 | probs>1.0)) stop("p outside [0, 1]") - cache_env <- cache(x) + cache_env = cache(x) if (is.null(method)) { if (is.null(cache_env)) method <- "sortqtl" @@ -2603,7 +2603,7 @@ qtile.integer64 <- function(x, probs = seq(0.0, 1.0, 0.25), names = TRUE, method else method <- "sortqtl" } - method <- match.arg(method, c("sortqtl", "orderqtl")) + method = match.arg(method, c("sortqtl", "orderqtl")) switch(method, sortqtl={ if (is.null(cache_env) || is.null(cache_env$sort)) { @@ -2646,7 +2646,7 @@ qtile.integer64 <- function(x, probs = seq(0.0, 1.0, 0.25), names = TRUE, method #' @param na.rm logical; if `TRUE`, any `NA` and `NaN`'s are removed from #' `x` before the quantiles are computed. #' @export -quantile.integer64 <- function(x, probs = seq(0.0, 1.0, 0.25), na.rm = FALSE, names = TRUE, type=0L, ...) { +quantile.integer64 = function(x, probs = seq(0.0, 1.0, 0.25), na.rm = FALSE, names = TRUE, type=0L, ...) { if (type[[1L]]!=0L) stop("only type==0 ('qtile') supported") if (!na.rm && na.count(x)>0L) @@ -2656,7 +2656,7 @@ quantile.integer64 <- function(x, probs = seq(0.0, 1.0, 0.25), na.rm = FALSE, na #' @rdname qtile #' @export -median.integer64 <- function(x, na.rm=FALSE, ...) { +median.integer64 = function(x, na.rm=FALSE, ...) { if (!na.rm && na.count(x)>0L) return(NA_integer64_) if (!length(x)) return(NA_integer64_) qtile(x, probs = 0.5, na.rm = na.rm, names = FALSE) @@ -2664,7 +2664,7 @@ median.integer64 <- function(x, na.rm=FALSE, ...) { #' @rdname qtile #' @export -mean.integer64 <- function(x, na.rm=FALSE, ...) { +mean.integer64 = function(x, na.rm=FALSE, ...) { ret <- .Call(C_mean_integer64, x, as.logical(na.rm), double(1L)) oldClass(ret) <- "integer64" ret @@ -2673,7 +2673,7 @@ mean.integer64 <- function(x, na.rm=FALSE, ...) { #' @rdname qtile #' @param object a integer64 vector #' @export -summary.integer64 <- function(object, ...) { +summary.integer64 = function(object, ...) { nas <- na.count(object) qq <- quantile(object, na.rm=TRUE) qq <- c(qq[1L:3L], mean(object, na.rm=TRUE), qq[4L:5L])