This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
upper_left <- function(n, diag = TRUE, byrow = FALSE) { | |
x <- seq.int(n) | |
tmp1 <- sequence(rev(x)) | |
tmp2 <- rep(x, rev(x)) | |
out <- if (byrow) { | |
cbind(row = tmp2, col = tmp1) | |
} else { | |
cbind(row = tmp1, col = tmp2) | |
} | |
if (diag) out else out[rowSums(out) != n + 1, ] |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
fun_for <- function(x, target, n) { | |
if (!n %in% c(2, 3)) stop("The accounting Elves are crazy!") | |
if (n == 2) { | |
out <- x[(target - x) %in% x] | |
} else if (n == 3) { | |
out <- numeric(0) | |
for (i in seq_along(x)) { | |
s1 <- x + x[i] | |
for (j in seq_along(s1)) { | |
s2 <- s1 + x[j] |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Using `fread` and `fwrite` to paste together columns like `do.call(paste, ...)` | |
fpaste <- function(dt, sep = ",") { | |
x <- tempfile() | |
if (sep == "") { | |
data.table(V1 = do.call(stringi::stri_join, c(dt, sep = ""))) | |
} else { | |
fwrite(dt, file = x, sep = sep, col.names = FALSE) | |
fread(x, sep = "\n", header = FALSE) | |
} | |
} |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## If your replacement is just a sequence of integers the length of the unique values being factored, | |
## you can create a function like this which should be quite fast. | |
fac2int <- function(x, levels, labels = levels, exclude = NA, ordered = is.ordered(x), nmax = NA) { | |
as.integer(factor(x, levels, labels, exclude, ordered, nmax)) | |
} | |
### DIFFERENT APPROACHES TO TEST | |
fun_datamatrix <- function() { | |
df[] <- data.matrix(as.data.frame(lapply(df, factor, levels = df2$Group))) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## SETUP: Sample data and packages | |
library(data.table) | |
library(readr) | |
library(dplyr) | |
library(iotools) | |
n <- 5000 | |
set.seed(1) | |
vals_row <- sample(2000, n, TRUE) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
row_wrap <- function(input, ...) { | |
UseMethod("row_wrap") | |
} | |
row_wrap.data.frame <- function(input, ncols, row_ind = FALSE) { | |
if (ncol(input) %% ncols != 0) stop("Number of columns not divisible by desired output") | |
data.frame(row_wrap.matrix(input, ncols, row_ind)) | |
} | |
row_wrap.matrix <- function(input, ncols, row_ind = FALSE) { |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' Calculate the Mean of Already Grouped Data | |
#' | |
#' Calculates the mean of already grouped data given the interval ranges and | |
#' the frequencies of each group. | |
#' | |
#' @param frequencies A vector of frequencies. | |
#' @param intervals A 2-column `matrix` with the same number of rows as | |
#' the length of frequencies, with the first column being the lower class | |
#' boundary, and the second column being the upper class boundary. | |
#' Alternatively, `intervals` may be a character vector, and you may |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' All Factors of a Number | |
#' | |
#' @param x The number that you want to find the factors of. | |
#' @examples | |
#' factors_of(8) | |
#' @export | |
factors_of <- function(x) which(!x %% seq_len(x)) | |
#' Common Factors of Multiple Numbers | |
#' |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
lengthen <- function(vec, length) { | |
vec[sort(rep(seq_along(vec), length.out = length))] | |
} | |
lengthen(a2, length(a1)) | |
# [1] 1 1 1 3 3 3 4 4 5 5 | |
lengthen(a3, length(a1)) | |
# [1] 1 1 2 2 5 5 6 6 9 9 | |
lengthen(a4, length(a1)) | |
# [1] 5 5 5 1 1 1 3 3 4 4 |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(data.table) | |
## Sample data | |
L <- list(A = 1:2, B = NULL, C = 3:4) | |
DF <- data.frame(ID = 1:3, V1 = I(L), V2 = I(unname(L)), V3 = I(setNames(L, c("X", "Y", "Z")))) | |
DF2 <- data.frame(ID = 1:3, V1 = letters[1:3], V2 = letters[4:6], V3 = letters[7:9]) | |
DF3 <- do.call(rbind, replicate(1000, DF, FALSE)) | |
set.seed(1) | |
DF4 <- data.frame(ID = 1:300000, V1 = I(rep(L, 100000)), V2 = I(rep(unname(L), 100000)), |
NewerOlder