| Title: | Utilities for the Forest Research Institute of the State Baden-Wuerttemberg |
|---|---|
| Description: | Miscellaneous utilities, tools and helper functions for finding and searching files on disk, searching for and removing R objects from the workspace. Does not import or depend on any third party package, but on core R only (i.e. it may depend on packages with priority 'base'). |
| Authors: | Andreas Dominik Cullmann [aut, cre] |
| Maintainer: | Andreas Dominik Cullmann <[email protected]> |
| License: | BSD_2_clause + file LICENSE |
| Version: | 4.4.0.9000 |
| Built: | 2025-02-17 22:25:12 UTC |
| Source: | https://gitlab.com/fvafrcu/fritools |
Miscellaneous utilities, tools and helper functions.
You will find the details invignette("Not_an_Introduction_to_fritools", package = "fritools").
Maintainer: Andreas Dominik Cullmann [email protected]
Useful links:
Import a bunch of comma separated files or
all comma separated files below a directory using
read_csv.
bulk_read_csv( paths, stop_on_error = FALSE, is_latin1 = TRUE, pattern = ".*\\.csv$", all_files = TRUE, recursive = FALSE, ignore_case = FALSE, find_all = FALSE, select = NA, ... )bulk_read_csv( paths, stop_on_error = FALSE, is_latin1 = TRUE, pattern = ".*\\.csv$", all_files = TRUE, recursive = FALSE, ignore_case = FALSE, find_all = FALSE, select = NA, ... )
paths |
A vector of file paths or the directory to find files. |
stop_on_error |
Stop if any of the files is not read? Warn and continue otherwise. |
is_latin1 |
Are the files encoded in "Latin1"? |
pattern |
see |
all_files |
see |
recursive |
see |
ignore_case |
see |
find_all |
see |
select |
see |
... |
Arguments passed to |
A named list, each element holding the contents of one csv
file read by read_csv.
Other CSV functions:
bulk_write_csv(),
check_ascii_file(),
csv,
csv2csv()
unlink(dir(tempdir(), full.names = TRUE)) data(mtcars) mt_german <- mtcars rownames(mt_german)[1] <- "Mazda R\u00f64" names(mt_german)[1] <- "mg\u00dc" #% read from directory for (i in 1:10) { f <- file.path(tempdir(), paste0("f", i, ".csv")) write.csv(mtcars[1:5, TRUE], file = f) f <- file.path(tempdir(), paste0("f", i, "_german.csv")) write.csv2(mt_german[1:7, TRUE], file = f, fileEncoding = "Latin1") } bulk <- bulk_read_csv(tempdir()) #% pass a path f <- list.files(tempdir(), pattern = ".*\\.csv$", full.names = TRUE)[1] bulk <- bulk_read_csv(f) #% pass multiple path f <- list.files(tempdir(), pattern = ".*\\.csv$", full.names = TRUE)[2:4] bulk <- bulk_read_csv(f)unlink(dir(tempdir(), full.names = TRUE)) data(mtcars) mt_german <- mtcars rownames(mt_german)[1] <- "Mazda R\u00f64" names(mt_german)[1] <- "mg\u00dc" #% read from directory for (i in 1:10) { f <- file.path(tempdir(), paste0("f", i, ".csv")) write.csv(mtcars[1:5, TRUE], file = f) f <- file.path(tempdir(), paste0("f", i, "_german.csv")) write.csv2(mt_german[1:7, TRUE], file = f, fileEncoding = "Latin1") } bulk <- bulk_read_csv(tempdir()) #% pass a path f <- list.files(tempdir(), pattern = ".*\\.csv$", full.names = TRUE)[1] bulk <- bulk_read_csv(f) #% pass multiple path f <- list.files(tempdir(), pattern = ".*\\.csv$", full.names = TRUE)[2:4] bulk <- bulk_read_csv(f)
Write a bunch of objects to disk using write_csv.
bulk_write_csv(x, ...)bulk_write_csv(x, ...)
x |
A list of objects to be written to |
... |
Arguments passed to
|
The list holding the return values of write_csv.
Other CSV functions:
bulk_read_csv(),
check_ascii_file(),
csv,
csv2csv()
unlink(dir(tempdir(), full.names = TRUE)) data(mtcars) mt_german <- mtcars rownames(mt_german)[1] <- "Mazda R\u00f64" names(mt_german)[1] <- "mg\u00dc" for (i in 1:10) { f <- file.path(tempdir(), paste0("f", i, ".csv")) write.csv(mtcars[1:5, TRUE], file = f) f <- file.path(tempdir(), paste0("f", i, "_german.csv")) write.csv2(mt_german[1:7, TRUE], file = f, fileEncoding = "Latin1") } #% read bulk <- bulk_read_csv(tempdir()) print(mtime <- file.info(list.files(tempdir(), full.names = TRUE))["mtime"]) bulk[["f2"]][3, 5] <- bulk[["f2"]][3, 5] + 2 Sys.sleep(2) # make sure the mtimes would change result <- bulk_write_csv(bulk) print(new_times <- file.info(dir(tempdir(), full.names = TRUE))["mtime"]) index_change <- grep("f2\\.csv", rownames(mtime)) if (requireNamespace("digest", quietly = TRUE)) { only_f2_changed <- all((mtime == new_times)[-c(index_change)]) && (mtime < new_times)[c(index_change)] RUnit::checkTrue(only_f2_changed) } else { RUnit::checkTrue(all(mtime < new_times)) }unlink(dir(tempdir(), full.names = TRUE)) data(mtcars) mt_german <- mtcars rownames(mt_german)[1] <- "Mazda R\u00f64" names(mt_german)[1] <- "mg\u00dc" for (i in 1:10) { f <- file.path(tempdir(), paste0("f", i, ".csv")) write.csv(mtcars[1:5, TRUE], file = f) f <- file.path(tempdir(), paste0("f", i, "_german.csv")) write.csv2(mt_german[1:7, TRUE], file = f, fileEncoding = "Latin1") } #% read bulk <- bulk_read_csv(tempdir()) print(mtime <- file.info(list.files(tempdir(), full.names = TRUE))["mtime"]) bulk[["f2"]][3, 5] <- bulk[["f2"]][3, 5] + 2 Sys.sleep(2) # make sure the mtimes would change result <- bulk_write_csv(bulk) print(new_times <- file.info(dir(tempdir(), full.names = TRUE))["mtime"]) index_change <- grep("f2\\.csv", rownames(mtime)) if (requireNamespace("digest", quietly = TRUE)) { only_f2_changed <- all((mtime == new_times)[-c(index_change)]) && (mtime < new_times)[c(index_change)] RUnit::checkTrue(only_f2_changed) } else { RUnit::checkTrue(all(mtime < new_times)) }
whoami 1.3.0 uses things like
system("getent passwd $(whoami)", intern = TRUE)
which I can not tryCatch, as it gives no error nor warning.
So this function returns a fallback if the condition given is not
TRUE.
call_conditionally(f, condition, fallback, ..., harden = FALSE)call_conditionally(f, condition, fallback, ..., harden = FALSE)
f |
The function passed to |
condition |
An expression. |
fallback |
See Description. |
... |
arguments passed to |
harden |
The return value of f or fallback.
Other call functions:
call_safe()
call_conditionally(get_package_version, condition = TRUE, args = list(x = "fritools"), fallback = "0.0") call_conditionally(get_package_version, condition = FALSE, args = list(x = "fritools"), fallback = "0.0") call_conditionally(get_package_version, condition = TRUE, args = list(x = "not_there"), harden = TRUE, fallback = "0.0")call_conditionally(get_package_version, condition = TRUE, args = list(x = "fritools"), fallback = "0.0") call_conditionally(get_package_version, condition = FALSE, args = list(x = "fritools"), fallback = "0.0") call_conditionally(get_package_version, condition = TRUE, args = list(x = "not_there"), harden = TRUE, fallback = "0.0")
Just a specialized version of call_conditionally.
call_safe(f, dependency, fallback = "Fallback", ...)call_safe(f, dependency, fallback = "Fallback", ...)
f |
The function passed to |
dependency |
The external dependency, see Examples. |
fallback |
See Description. |
... |
arguments passed to |
The return value of f or fallback.
Other call functions:
call_conditionally()
call_safe(whoami::email_address, dependency = "whoami", args = list(fallback = "[email protected]"), fallback = "[email protected]") call_safe(whoami::email_address, dependency = "this_is_not_installed", args = list(fallback = "[email protected]"), fallback = "[email protected]")call_safe(whoami::email_address, dependency = "whoami", args = list(fallback = "[email protected]"), fallback = "[email protected]") call_safe(whoami::email_address, dependency = "this_is_not_installed", args = list(fallback = "[email protected]"), fallback = "[email protected]")
I often need a factor with levels the unique values of a character vector (for example: to prevent ggplot2 from sorting the character vector).
char2factor(x, levels = unique(x))char2factor(x, levels = unique(x))
x |
A character vector. |
levels |
The levels to use, see |
A factor.
Other vector functions:
file_string()
x <- c("beech", "oak", "spruce", "fir") char2factor(x)x <- c("beech", "oak", "spruce", "fir") char2factor(x)
Check the Number of Lines and Fields in a File
check_ascii_file(path, sep = ";")check_ascii_file(path, sep = ";")
path |
Path to a file. |
sep |
A character separating the fields in the file. |
A list giving the number of lines, number of fields and an boolean indicating whether all lines have the same number of fields.
Other CSV functions:
bulk_read_csv(),
bulk_write_csv(),
csv,
csv2csv()
f <- tempfile() write.csv2(mtcars, file = f) check_ascii_file(f)f <- tempfile() write.csv2(mtcars, file = f) check_ascii_file(f)
I often have to work under Windows, where file paths cannot just be pasted into the code, so I adapted code from https://www.r-bloggers.com/2015/12/stop-fiddling-around-with-copied-paths-in-windows-r/. Under Windows, the de-windowsified path is copied to the clipboard.
clipboard_path()clipboard_path()
The de-windowsified path.
It makes only sense to call clipboard_path in an interactive R
session.
Other operating system functions:
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
Other file utilities:
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
I often need to calculate the sums of the numeric columns of a
data.frame. While colSums requires the data frame
to be numeric, this is a convenience wrapper to select numeric columns only.
column_sums(x, ...)column_sums(x, ...)
x |
A |
... |
Arguments passed to |
A named vector of column sums (see colSums).
Other statistics:
count_groups(),
relative_difference(),
round_half_away_from_zero(),
sloboda(),
weighted_variance()
try(colSums(iris)) column_sums(iris) names(iris) # no column sum for `Species`try(colSums(iris)) column_sums(iris) names(iris) # no column sum for `Species`
Side-by-side comparison of two vectors. The vectors get sorted and are compared element-wise. So the result will be as long as the union of the two vectors plus their number of values unique to one of them.
compare_vectors(x, y, differences_only = FALSE)compare_vectors(x, y, differences_only = FALSE)
x, y
|
Two vectors of the same mode. |
differences_only |
Report only the differences? |
A matrix containing the side-by-side comparison.
Other searching functions:
file_modified_last(),
find_files(),
fromto(),
grep_file(),
missing_docs,
runsed(),
search_files(),
search_rows(),
summary.filesearch()
Other vector comparing functions:
relative_difference()
data(mtcars) cars <- rownames(mtcars) carz <- cars[-grep("Merc", cars)] cars <- cars[nchar(cars) < 15] cars <- c(cars, "foobar") compare_vectors(cars, carz)data(mtcars) cars <- rownames(mtcars) carz <- cars[-grep("Merc", cars)] cars <- cars[nchar(cars) < 15] cars <- c(cars, "foobar") compare_vectors(cars, carz)
Convert German Umlauts to a More or Less Suitable 'ascii' Representation
convert_umlauts_to_ascii(x) ## S3 method for class 'character' convert_umlauts_to_ascii(x) ## S3 method for class 'data.frame' convert_umlauts_to_ascii(x)convert_umlauts_to_ascii(x) ## S3 method for class 'character' convert_umlauts_to_ascii(x) ## S3 method for class 'data.frame' convert_umlauts_to_ascii(x)
x |
A string or |
x with the umlauts converted to ascii.
Other German umlaut converters:
convert_umlauts_to_tex(),
get_german_umlauts()
string <- paste("this is \u00e4 string") print(string) print(convert_umlauts_to_ascii(string)) string <- paste("this is \u00e4 string") df <- data.frame(v1 = c(string, "foobar"), v2 = c("foobar", string), v3 = 3:4) names(df)[3] <- "y\u00dfy" convert_umlauts_to_ascii(df)string <- paste("this is \u00e4 string") print(string) print(convert_umlauts_to_ascii(string)) string <- paste("this is \u00e4 string") df <- data.frame(v1 = c(string, "foobar"), v2 = c("foobar", string), v3 = 3:4) names(df)[3] <- "y\u00dfy" convert_umlauts_to_ascii(df)
Convert German umlauts in a string to their plain TeX representation.
convert_umlauts_to_tex(x)convert_umlauts_to_tex(x)
x |
A string. |
A string with the umlauts converted to plain TeX.
Other German umlaut converters:
convert_umlauts_to_ascii(),
get_german_umlauts()
string <- paste("this is \u00e4 string") print(string) print(convert_umlauts_to_tex(string))string <- paste("this is \u00e4 string") print(string) print(convert_umlauts_to_tex(string))
I tend to forget the syntax that works with
stats::aggregate.
count_groups(x, ...)count_groups(x, ...)
x |
A |
... |
Columns in |
A data.frame with the counts per groups.
Other statistics:
column_sums(),
relative_difference(),
round_half_away_from_zero(),
sloboda(),
weighted_variance()
count_groups(mtcars, "am", "gear") RUnit::checkEquals(dplyr::count(mtcars, am, gear), count_groups(mtcars, "am", "gear"), checkNames = FALSE)count_groups(mtcars, "am", "gear") RUnit::checkEquals(dplyr::count(mtcars, am, gear), count_groups(mtcars, "am", "gear"), checkNames = FALSE)
Functions to read and write CSV files. The objects returned by these
functions are data.frames with the following attributes:
The path to the file on disk.
The type of CSV: either standard or german.
The hash value computed with digest's digest function, if digest is installed.
read_csv is a wrapper to determine whether to use
utils:read.csv2 or
utils:read.csv.
It sets the above three arguments.
write_csv compares the hash value stored in the object's
attribute
with the objects current hash value. If they differ, it writes the object to
the file argument or, if not given, to the path
stored in the object's attribute. If no csv_type is given, it uses
the csv type stored in object's attribute.
If digest is not installed, the object will (unconditionally) be
written to disk.
read_csv(file, ...) write_csv(x, file = NULL, csv_type = c(NA, "standard", "german"))read_csv(file, ...) write_csv(x, file = NULL, csv_type = c(NA, "standard", "german"))
file |
The path to the file to be read or written. |
... |
Arguments passed to |
x |
The object to write to disk. |
csv_type |
Which |
For read_csv: An object read from the file.
For write_csv: The object with updated hash
(and possibly path and csv)
attribute.
Other CSV functions:
bulk_read_csv(),
bulk_write_csv(),
check_ascii_file(),
csv2csv()
# read from standard CSV f <- tempfile() write.csv(mtcars, file = f) str(read_csv(f)) f <- tempfile() write.csv2(mtcars, file = f) str(read_csv(f)) # write to standard CSV f <- tempfile() d <- mtcars str(d <- write_csv(d, file = f)) file.mtime(f) Sys.sleep(2) # make sure the mtime would have changed write_csv(d, file = f) file.mtime(f)# read from standard CSV f <- tempfile() write.csv(mtcars, file = f) str(read_csv(f)) f <- tempfile() write.csv2(mtcars, file = f) str(read_csv(f)) # write to standard CSV f <- tempfile() d <- mtcars str(d <- write_csv(d, file = f)) file.mtime(f) Sys.sleep(2) # make sure the mtime would have changed write_csv(d, file = f) file.mtime(f)
Convert a German Comma Separated File into a Comma Separated File
csv2csv(file, ...)csv2csv(file, ...)
file |
Path to the file. |
... |
Arguments passed to |
Invisibly the return value of
write_csv, but called for its side effect.
Other CSV functions:
bulk_read_csv(),
bulk_write_csv(),
check_ascii_file(),
csv
f <- tempfile() write.csv2(mtcars, file = f) res <- csv2csv(f) readLines(get_path(res), n = 1) write.csv(mtcars, file = f) readLines(get_path(res), n = 1)f <- tempfile() write.csv2(mtcars, file = f) res <- csv2csv(f) readLines(get_path(res), n = 1) write.csv(mtcars, file = f) readLines(get_path(res), n = 1)
Trailing blank lines are classical lints.
delete_trailing_blank_lines(...)delete_trailing_blank_lines(...)
... |
Arguments passed to |
Other file utilities:
clipboard_path(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
dir <- tempfile() dir.create(dir) file.copy(system.file("tinytest", package = "fritools"), dir, recursive = TRUE) delete_trailing_blank_lines(path = dir, recursive = TRUE) unlink(dir, recursive = TRUE)dir <- tempfile() dir.create(dir) file.copy(system.file("tinytest", package = "fritools"), dir, recursive = TRUE) delete_trailing_blank_lines(path = dir, recursive = TRUE) unlink(dir, recursive = TRUE)
Trailing whitespace is a classical lint.
delete_trailing_whitespace(...)delete_trailing_whitespace(...)
... |
Arguments passed to |
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
dir <- tempfile() dir.create(dir) file.copy(system.file("tinytest", package = "fritools"), dir, recursive = TRUE) delete_trailing_whitespace(path = dir, recursive = TRUE) unlink(dir, recursive = TRUE)dir <- tempfile() dir.create(dir) file.copy(system.file("tinytest", package = "fritools"), dir, recursive = TRUE) delete_trailing_whitespace(path = dir, recursive = TRUE) unlink(dir, recursive = TRUE)
Looking at the output of
covr::zero_coverage, I want to open a code
file and the corresponding unit testing file.
develop_test(file, force_runit = FALSE, force_tiny = TRUE)develop_test(file, force_runit = FALSE, force_tiny = TRUE)
file |
The path to the code file, assuming the working directory to be the root of an R package under development. |
force_runit |
If there is no corresponding RUnit test file: create one? |
force_tiny |
If there is no corresponding tinytest test file: create one? |
Other test helpers:
get_boolean_envvar(),
get_run_r_tests(),
is_cran(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
file.copy has an argument overwrite that allows for
overwriting existing files. But I often want to overwrite an existing file
while creating a backup copy of that file.
file_copy(from, to, stop_on_error = FALSE, ...)file_copy(from, to, stop_on_error = FALSE, ...)
from |
See |
to |
See |
stop_on_error |
Throw an exception on error? |
... |
Arguments passed to |
A vector of boolean values indicating
success or failure.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
Other operating system functions:
clipboard_path(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
touch(f1 <- file.path(tempdir(), "first.R"), f2 <- file.path(tempdir(), "second.R")) dir.create(t <- file.path(tempdir(), "foo")) file_copy(from = c(f2, f1), to = t) dir(t) touch(f1) touch(f2) file_copy(from = c(f2, f1), to = t) dir(t) list.files(tempdir(), pattern = "first.*\\.R") dir <- file.path(tempdir(), "subdir") dir.create(dir) file_copy(f1, dir) touch(f1) file_copy(f1, dir) list.files(dir, pattern = "first.*\\.R")touch(f1 <- file.path(tempdir(), "first.R"), f2 <- file.path(tempdir(), "second.R")) dir.create(t <- file.path(tempdir(), "foo")) file_copy(from = c(f2, f1), to = t) dir(t) touch(f1) touch(f2) file_copy(from = c(f2, f1), to = t) dir(t) list.files(tempdir(), pattern = "first.*\\.R") dir <- file.path(tempdir(), "subdir") dir.create(dir) file_copy(f1, dir) touch(f1) file_copy(f1, dir) list.files(dir, pattern = "first.*\\.R")
I often look for the file modified last under some directory.
file_modified_last(...)file_modified_last(...)
... |
Arguments passed to |
The path to the file last modified.
Other searching functions:
compare_vectors(),
find_files(),
fromto(),
grep_file(),
missing_docs,
runsed(),
search_files(),
search_rows(),
summary.filesearch()
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
for (suffix in c(".txt", ".ascii")) for (f in file.path(tempdir(), letters)) touch(paste0(f, suffix)) list.files(tempdir()) file_modified_last(path = tempdir(), pattern = "\\.txt$") dir.create(file.path(tempdir(), "new")) touch(file.path(tempdir(), "new", "file.txt")) file_modified_last(path = tempdir(), pattern = "\\.txt$") file_modified_last(path = tempdir(), pattern = "\\.txt$", recursive = TRUE)for (suffix in c(".txt", ".ascii")) for (f in file.path(tempdir(), letters)) touch(paste0(f, suffix)) list.files(tempdir()) file_modified_last(path = tempdir(), pattern = "\\.txt$") dir.create(file.path(tempdir(), "new")) touch(file.path(tempdir(), "new", "file.txt")) file_modified_last(path = tempdir(), pattern = "\\.txt$") file_modified_last(path = tempdir(), pattern = "\\.txt$", recursive = TRUE)
I often want a timestamped copies as backup of files or directories.
file_save( ..., file_extension_pattern = "\\.[A-z]{1,5}$", force = TRUE, recursive = NA, stop_on_error = TRUE, overwrite = FALSE )file_save( ..., file_extension_pattern = "\\.[A-z]{1,5}$", force = TRUE, recursive = NA, stop_on_error = TRUE, overwrite = FALSE )
... |
Paths to files. |
file_extension_pattern |
A Pattern to mark a file extension. If matched, the time stamp will get inserted before that pattern. |
force |
Force even if |
recursive |
Passed to |
stop_on_error |
Throw an exception on error? |
overwrite |
Passed to |
A vector of boolean values indicating
success or failure.
Other operating system functions:
clipboard_path(),
file_copy(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
f1 <- tempfile() f2 <- tempfile() try(file_save(f1)) touch(f1) file_save(f1, recursive = FALSE) f2 <- paste0(file.path(tempfile()), ".txt") touch(f2) file_save(f1, f2) file_save(f1, f2) file_save(f1, f2, overwrite = TRUE) dir(tempdir())f1 <- tempfile() f2 <- tempfile() try(file_save(f1)) touch(f1) file_save(f1, recursive = FALSE) f2 <- paste0(file.path(tempfile()), ".txt") touch(f2) file_save(f1, f2) file_save(f1, f2) file_save(f1, f2, overwrite = TRUE) dir(tempdir())
Need to store stuff on disk. Replacement may also be a minus sign instead of underscore.
file_string(x, replacement = c("_", "-"))file_string(x, replacement = c("_", "-"))
x |
A string. |
replacement |
The replacement character. |
A string.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
Other vector functions:
char2factor()
file_string("foo:bar$ this, indeed(!) is # a number 7") file_string("foo:bar$ this, indeed(!) is # a number 7", replacement = "-")file_string("foo:bar$ this, indeed(!) is # a number 7") file_string("foo:bar$ this, indeed(!) is # a number 7", replacement = "-")
Look for files on disk, either scanning a vector of names or searching for
files with list.files and throw an error if no files are found.
find_files( path = ".", pattern = NULL, file_names = NA, all_files = TRUE, recursive = FALSE, ignore_case = FALSE, find_all = FALSE, select = NA )find_files( path = ".", pattern = NULL, file_names = NA, all_files = TRUE, recursive = FALSE, ignore_case = FALSE, find_all = FALSE, select = NA )
path |
see |
pattern |
see |
file_names |
character vector of file names (to be checked if the files exist). |
all_files |
see |
recursive |
see |
ignore_case |
see |
find_all |
Throw an error if not all files (given by file_names) are found? |
select |
A named list of numerical vectors of maximum length 2 named
|
This is a wrapper to either file.exists or
list.files, that ensures that (some) files exists. This may
come handy if you want to perform some kind of file manipulation e.g. with
one of the functions listed under
See Also Other file utilities:.
A character vector of file names.
This is merely a wrapper around file.exists or
list.files, depending on whether file_names is
given.
Other searching functions:
compare_vectors(),
file_modified_last(),
fromto(),
grep_file(),
missing_docs,
runsed(),
search_files(),
search_rows(),
summary.filesearch()
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
#% create some files files <- unname(sapply(file.path(tempdir(), paste0(sample(letters, 10), ".", c("R", "Rnw", "txt"))), touch)) print(files) print(list.files(tempdir(), full.names = TRUE)) # same as above #% file names given find_files(file_names = files[1:3]) ##% some do not exist: find_files(file_names = c(files[1:3], replicate(2, tempfile()))) try(find_files(file_names = c(files[1:3], replicate(2, tempfile())), find_all = TRUE)) ##% all do not exist: try(find_files(file_names = replicate(2, tempfile()))) #% path given find_files(path = tempdir()) ##% change pattern find_files(path = tempdir(), pattern = ".*\\.[RrSs]$|.*\\.[RrSs]nw$|.*\\.txt") ##% find a specific file by it's basename find_files(path = tempdir(), pattern = paste0("^", basename(files[1]), "$")) #% file_names and path given: file_names beats path try(find_files(file_names = tempfile(), path = tempdir())) #% select by file size: write.csv(mtcars, file.path(tempdir(), "mtcars.csv")) find_files(path = tempdir()) find_files(path = tempdir(), select = list(size = c(min = 1000)) )#% create some files files <- unname(sapply(file.path(tempdir(), paste0(sample(letters, 10), ".", c("R", "Rnw", "txt"))), touch)) print(files) print(list.files(tempdir(), full.names = TRUE)) # same as above #% file names given find_files(file_names = files[1:3]) ##% some do not exist: find_files(file_names = c(files[1:3], replicate(2, tempfile()))) try(find_files(file_names = c(files[1:3], replicate(2, tempfile())), find_all = TRUE)) ##% all do not exist: try(find_files(file_names = replicate(2, tempfile()))) #% path given find_files(path = tempdir()) ##% change pattern find_files(path = tempdir(), pattern = ".*\\.[RrSs]$|.*\\.[RrSs]nw$|.*\\.txt") ##% find a specific file by it's basename find_files(path = tempdir(), pattern = paste0("^", basename(files[1]), "$")) #% file_names and path given: file_names beats path try(find_files(file_names = tempfile(), path = tempdir())) #% select by file size: write.csv(mtcars, file.path(tempdir(), "mtcars.csv")) find_files(path = tempdir()) find_files(path = tempdir(), select = list(size = c(min = 1000)) )
This comes in handy to cut lines from a file read by readLines.
fromto( x, from, to, from_i = 1, to_i = 1, shift_from = 0, shift_to = 0, remove_empty_item = TRUE )fromto( x, from, to, from_i = 1, to_i = 1, shift_from = 0, shift_to = 0, remove_empty_item = TRUE )
x |
A vector. |
from |
A pattern, use NA to start with the first item. |
to |
Another pattern, use NA to stop with the last item. |
from_i |
If the from pattern matches multiple times, which one is to be used. |
to_i |
Analogously to to_i. |
shift_from |
The number of items to shift from the item selected via from and from_i. |
shift_to |
Analogously to shift_from. |
remove_empty_item |
Remove empty items? |
The extracted vector.
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
grep_file(),
missing_docs,
runsed(),
search_files(),
search_rows(),
summary.filesearch()
foo <- c("First", "f1", "A", "f2", rep("B", 4), "t1", "f3", "C", "t2", rep("D", 4), "t3", "Last") fromto(foo, "^f", "^t") fromto(foo, NA, "^t") fromto(foo, "^f", NA) fromto(foo, "^f", "^t", from_i = 2) fromto(foo, "^f", "^t", from_i = 2, to_i = 2) fromto(foo, "^f", "^t", from_i = 2, to_i = 2, shift_from = 1, shift_to = -1) fromto(foo, "^f", "^t", from_i = 2, to_i = 2, shift_from = -1, shift_to = 2)foo <- c("First", "f1", "A", "f2", rep("B", 4), "t1", "f3", "C", "t2", rep("D", 4), "t3", "Last") fromto(foo, "^f", "^t") fromto(foo, NA, "^t") fromto(foo, "^f", NA) fromto(foo, "^f", "^t", from_i = 2) fromto(foo, "^f", "^t", from_i = 2, to_i = 2) fromto(foo, "^f", "^t", from_i = 2, to_i = 2, shift_from = 1, shift_to = -1) fromto(foo, "^f", "^t", from_i = 2, to_i = 2, shift_from = -1, shift_to = 2)
A convenience wrapper to Sys.getenv.
get_boolean_envvar(x, stop_on_failure = FALSE)get_boolean_envvar(x, stop_on_failure = FALSE)
x |
The name of the Environment Variable. |
stop_on_failure |
Throw an error instead of returning
|
As Sys.getenv seems to always return a character vector, the
class of the value you set it to does not matter.
The value the environment variable is set to, converted to boolean.
FALSE if the environment variable is not set or cannot be
converted to boolean. But see Arguments: stop_on_failure.
Other test helpers:
develop_test(),
get_run_r_tests(),
is_cran(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
message("See\n example(\"get_run_r_tests\", package = \"fritools\")")message("See\n example(\"get_run_r_tests\", package = \"fritools\")")
I often need German umlauts in reporting. So I need either a UTF-8 or LaTeX representation.
get_german_umlauts( which = NULL, type = c("utf-8", "latex"), strip_names = TRUE )get_german_umlauts( which = NULL, type = c("utf-8", "latex"), strip_names = TRUE )
which |
A character vector specifying a subset of the result vector. |
type |
UTF-8 or LaTeX? |
strip_names |
Return an unnamed vector? |
A (possibly named) vector of UTF-8 representations of german umlauts.
Other German umlaut converters:
convert_umlauts_to_ascii(),
convert_umlauts_to_tex()
get_german_umlauts() get_german_umlauts(type = "latex") get_german_umlauts(strip_names = FALSE) get_german_umlauts(which = c("sz", "Ae")) try(get_german_umlauts(which = c("sz", "foo", "Ae", "bar"))) paste0("Cologne is K", get_german_umlauts("oe"), "ln. In LaTeX it's K", get_german_umlauts("oe", "latex"), "ln")get_german_umlauts() get_german_umlauts(type = "latex") get_german_umlauts(strip_names = FALSE) get_german_umlauts(which = c("sz", "Ae")) try(get_german_umlauts(which = c("sz", "foo", "Ae", "bar"))) paste0("Cologne is K", get_german_umlauts("oe"), "ln. In LaTeX it's K", get_german_umlauts("oe", "latex"), "ln")
Get all lines between tagged lines. The tagged lines themselves may be in- or excluded from the selection.
get_lines_between_tags( file_name, keep_tagged_lines = TRUE, begin_pattern = "ROXYGEN_START", end_pattern = "ROXYGEN_STOP", from_first_line = TRUE, to_last_line = TRUE )get_lines_between_tags( file_name, keep_tagged_lines = TRUE, begin_pattern = "ROXYGEN_START", end_pattern = "ROXYGEN_STOP", from_first_line = TRUE, to_last_line = TRUE )
file_name |
The name of the R code file to be parsed. |
keep_tagged_lines |
Keep tagged lines output? |
begin_pattern |
A pattern that marks the line beginning a roxygen2 chunk. |
end_pattern |
A pattern that marks the line ending a roxygen2 chunk. |
from_first_line |
Use first line as tagged line if first tag found
matches the |
to_last_line |
Use last line as tagged line if last tag found matches
the |
A character vector of matching lines.
If you know the file to contain valid roxygen2 code only, you do not need to tag any lines if you keep from_first_line and to_last_line both TRUE: in this case the whole file will be returned.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
mtime Attribute from an ObjectWe set modification times on some objects, this is a convenience wrappers to
attr.
get_mtime(x)get_mtime(x)
x |
An object. |
The value of attr(attr(x, "path", "mtime").
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
x <- 2 path <- tempfile() touch(path) x <- set_path(x, path) get_mtime(x)x <- 2 path <- tempfile() touch(path) x <- set_path(x, path) get_mtime(x)
A convenience function for getOption.
get_options( ..., package_name = .packages()[1], remove_names = FALSE, flatten_list = TRUE )get_options( ..., package_name = .packages()[1], remove_names = FALSE, flatten_list = TRUE )
... |
See |
package_name |
The package's name. |
remove_names |
[boolean(1)] |
flatten_list |
[boolean(1)] |
A (possibly named) list or a vector.
Other option functions:
is_force(),
set_options()
example("set_options", package = "fritools")example("set_options", package = "fritools")
packageVersion converts to class package_version,
which then again would need to be converted for compareVersion.
So this is a modified copy of packageVersion skipping the
conversion to package_version.
get_package_version(x, lib_loc = NULL)get_package_version(x, lib_loc = NULL)
x |
A character giving the package name. |
lib_loc |
See argument |
A character giving the package version.
Other version functions:
get_session_string(),
is_r_package_installed(),
is_version_sufficient()
Other package functions:
is_r_package_installed(),
is_version_sufficient(),
load_internal_functions(),
rename_package()
get_package_version("base") try(get_package_version("mgcv")) utils::compareVersion("1000.0.0", get_package_version("base")) utils::compareVersion("1.0", get_package_version("base")) # from ?is_version_sufficient: is_version_sufficient(installed = get_package_version("base"), required = "1.0")get_package_version("base") try(get_package_version("mgcv")) utils::compareVersion("1000.0.0", get_package_version("base")) utils::compareVersion("1.0", get_package_version("base")) # from ?is_version_sufficient: is_version_sufficient(installed = get_package_version("base"), required = "1.0")
R CMD BATCH' RunRetrieve the path from parsing the command line arguments of a
R CMD BATCH run.
get_r_cmd_batch_script_path()get_r_cmd_batch_script_path()
A vector of mode character giving the name of the R
code file. Will be character(0) if not in an R CMD BATCH run.
Other script path getter functions:
get_rscript_script_path(),
get_script_name(),
get_script_path()
get_r_cmd_batch_script_path()get_r_cmd_batch_script_path()
Rscript' RunRetrieve the path from parsing the command line arguments of a
Rscript run.
get_rscript_script_path()get_rscript_script_path()
A vector of mode character giving the name of the R
code file. Will be character(0) if not in an Rscript run.
Other script path getter functions:
get_r_cmd_batch_script_path(),
get_script_name(),
get_script_path()
get_rscript_script_path()get_rscript_script_path()
A convenience wrapper to
get_boolean_envvar("RUN_R_TESTS").
get_run_r_tests(stop_on_failure = FALSE)get_run_r_tests(stop_on_failure = FALSE)
stop_on_failure |
Throw an error instead of returning
|
The value RUN_R_TESTS is set to, converted to boolean.
FALSE if RUN_R_TESTS is not set or cannot be converted to
boolean.
Other test helpers:
develop_test(),
get_boolean_envvar(),
is_cran(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
Other logical helpers:
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
set_run_r_tests("", force = TRUE) # make sure it is not set. get_run_r_tests() try(get_run_r_tests(stop_on_failure = TRUE)) set_run_r_tests("A", force = TRUE) # "A" is not boolean. get_run_r_tests() try(get_run_r_tests(stop_on_failure = TRUE)) set_run_r_tests(4213, force = TRUE) # All numbers apart from 0 are TRUE get_run_r_tests() set_run_r_tests("0", force = TRUE) # 0 (and "0") is FALSE get_run_r_tests() set_run_r_tests("FALSE", force = TRUE) get_run_r_tests() set_run_r_tests(TRUE, force = TRUE) get_run_r_tests()set_run_r_tests("", force = TRUE) # make sure it is not set. get_run_r_tests() try(get_run_r_tests(stop_on_failure = TRUE)) set_run_r_tests("A", force = TRUE) # "A" is not boolean. get_run_r_tests() try(get_run_r_tests(stop_on_failure = TRUE)) set_run_r_tests(4213, force = TRUE) # All numbers apart from 0 are TRUE get_run_r_tests() set_run_r_tests("0", force = TRUE) # 0 (and "0") is FALSE get_run_r_tests() set_run_r_tests("FALSE", force = TRUE) get_run_r_tests() set_run_r_tests(TRUE, force = TRUE) get_run_r_tests()
default
The code file name is retrieved only for R CMD BATCH and
Rscript,
if R is used interactively, the name is set to default,
even if you're working with code stored in a (named) file on disk.
get_script_name(default = "interactive_R_session")get_script_name(default = "interactive_R_session")
default |
the name to return if R is run interactively. |
A vector of length 1 and mode
character giving the name of the R code file if R was run via
R CMD BATCH or
Rscript, the given default otherwise.
Other script path getter functions:
get_r_cmd_batch_script_path(),
get_rscript_script_path(),
get_script_path()
get_script_name(default = 'foobar.R')get_script_name(default = 'foobar.R')
This is just a wrapper for get_rscript_script_path and
get_r_cmd_batch_script_path.
get_script_path()get_script_path()
A vector of length 1 and mode
character giving the name of the R code file if R was run via
R CMD BATCH or
Rscript.
Other script path getter functions:
get_r_cmd_batch_script_path(),
get_rscript_script_path(),
get_script_name()
get_script_path()get_script_path()
I sometimes wan't to document the R session used in a string, so a need an
excerpt of sessionInfo an Sys.time.
get_session_string()get_session_string()
An excerpt of sessionInfo as a string.
Other version functions:
get_package_version(),
is_r_package_installed(),
is_version_sufficient()
get_session_string()get_session_string()
I sometimes need a fairly unique string, mostly for file names, that should start with the current date.
get_unique_string()get_unique_string()
A fairly unique string.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
replicate(20, get_unique_string())replicate(20, get_unique_string())
Divide a length using the golden ratio.
golden_ratio(x)golden_ratio(x)
x |
The sum of the two quantities to be in the golden ratio. |
A numeric vector of length 2, containing the two quantities a and b, a being the larger.
Other bits and pieces:
is_difftime_less(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
rownames2col(),
str2num(),
string2words(),
strip_off_attributes(),
tapply(),
throw()
golden_ratio(10)golden_ratio(10)
This is an approximation of the unix command grep.
grep_file(paths, pattern, a = 1, b = 1, ...)grep_file(paths, pattern, a = 1, b = 1, ...)
paths |
A vector of file paths. |
pattern |
The pattern to grep. |
a |
Number of lines of trailing context before matching lines.
Like |
b |
Number of lines of leading context before matching lines.
Like |
... |
Arguments passed to |
A named list with one item per file path. Each item consists of a list of row numbers matching the pattern. Each item is a vector of the matching lines and b lines before and a lines after the matching lines.
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
fromto(),
missing_docs,
runsed(),
search_files(),
search_rows(),
summary.filesearch()
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
file_paths <- list.files(path = system.file("tinytest", package = "fritools"), pattern = ".*\\.R", full.names = TRUE) res <- grep_file(path = file_paths, pattern = "forSureNotThere", a = 3, b = 2, ignore.case = TRUE) tinytest::expect_true(all(res == FALSE))file_paths <- list.files(path = system.file("tinytest", package = "fritools"), pattern = ".*\\.R", full.names = TRUE) res <- grep_file(path = file_paths, pattern = "forSureNotThere", a = 3, b = 2, ignore.case = TRUE) tinytest::expect_true(all(res == FALSE))
Create starting and stopping indices for subsets defined by
subset_sizes.
index_groups(n, k)index_groups(n, k)
n |
The size of the set. |
k |
The number of subsets. |
A matrix with starting index, size, and stopping index for each subset.
Other subsetting functions:
subset_sizes()
index_groups(n = 100, k = 6) index_groups(n = 2, k = 6)index_groups(n = 100, k = 6) index_groups(n = 2, k = 6)
R CMD BATCH' or
'Rscript')?Just a wrapper to interactive.
is_batch()is_batch()
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
is_batch()is_batch()
This is a verbatim copy of fda::CRAN of
fda version 5.1.9.
is_cran(cran_pattern, n_r_check4cran)is_cran(cran_pattern, n_r_check4cran)
cran_pattern |
A regular expressions to apply to the names of
|
n_r_check4cran |
Assume this is CRAN if at least n_R_CHECK4CRAN
elements of
|
This function allows package developers to run tests themselves that should not run on CRAN or with
R CMD check --as-cran
because of compute time constraints with CRAN tests.
The "Writing R Extensions" manual says that R CMD check can be
customized "by setting environment variables _R_CHECK_*_:, as
described in" the Tools section of the "R Internals" manual.
R CMD check was tested with R 3.0.1 under Fedora 18 Linux and with
Rtools 3.0 from April 16, 2013 under Windows 7. With the
'--as-cran'
option, 7 matches were found; without it, only 3 were found. These numbers were unaffected by the presence or absence of the '–timings' parameter. On this basis, the default value of n_R_CHECK4CRAN was set at 5.
1. x. <- Sys.getenv()
2. Fix CRAN_pattern and n_R_CHECK4CRAN if missing.
3. Let i be the indices of x. whose names match all the patterns in the vector x.
4. Assume this is CRAN if length(i) >= n_R_CHECK4CRAN
A logical scalar with attributes ‘'sys_getenv'’ containing the
results of Sys.getenv() and 'matches' containing i per step 3
above.
Other test helpers:
develop_test(),
get_boolean_envvar(),
get_run_r_tests(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
if (!is_cran()) { message("Run your tests here.") }if (!is_cran()) { message("Run your tests here.") }
This is just a wrapper to difftime.
is_difftime_less( time1, time2, less_than = 1, units = "days", verbose = FALSE, visible = !verbose, stop_on_error = FALSE )is_difftime_less( time1, time2, less_than = 1, units = "days", verbose = FALSE, visible = !verbose, stop_on_error = FALSE )
time1 |
See |
time2 |
See |
less_than |
The number of units that would be too much of a difference. |
units |
See |
verbose |
Be verbose? |
visible |
|
stop_on_error |
Throw an error if the time lag is not less than less_than. |
TRUE if the times do not differ 'that much', but see
stop_on_error.
Other bits and pieces:
golden_ratio(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
rownames2col(),
str2num(),
string2words(),
strip_off_attributes(),
tapply(),
throw()
a <- as.POSIXct(0, origin = "1970-01-01", tz = "GMT") b <- as.POSIXct(60*60*24, origin = "1970-01-01", tz = "GMT") c <- as.POSIXct(60*60*24 - 1, origin = "1970-01-01", tz = "GMT") is_difftime_less(a, b) is_difftime_less(a, c) print(is_difftime_less(a, b, verbose = TRUE)) print(is_difftime_less(a, c, verbose = TRUE)) try(is_difftime_less(a, b, stop_on_error = TRUE)) is_difftime_less(a, c, verbose = TRUE, stop_on_error = TRUE)a <- as.POSIXct(0, origin = "1970-01-01", tz = "GMT") b <- as.POSIXct(60*60*24, origin = "1970-01-01", tz = "GMT") c <- as.POSIXct(60*60*24 - 1, origin = "1970-01-01", tz = "GMT") is_difftime_less(a, b) is_difftime_less(a, c) print(is_difftime_less(a, b, verbose = TRUE)) print(is_difftime_less(a, c, verbose = TRUE)) try(is_difftime_less(a, b, stop_on_error = TRUE)) is_difftime_less(a, c, verbose = TRUE, stop_on_error = TRUE)
isFALSE for 'R' < 3.5.0I still use R 3.3.3 for testing, isFALSE() was introduced in R
3.5.0.
is_false(x)is_false(x)
x |
The object to be tested. |
TRUE if the object is set to
FALSE,
FALSE
otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
is_false("not false") is_false(FALSE)is_false("not false") is_false(FALSE)
I sometimes produce a couple of files by some kind of process and need to check whether they are fairly current and probably product of the same run. So I need to know whether a bunch of files was modified within the last, say, 7 days and that their modification dates do not differ by more than, say, 24 hours.
is_files_current( ..., newer_than = 1, units = "week", within = 1, within_units = "days" )is_files_current( ..., newer_than = 1, units = "week", within = 1, within_units = "days" )
... |
File paths. |
newer_than |
The number of units the files need to be newer than. |
units |
The unit of newer_than. See |
within |
The number of units the files need to be modified within. |
within_units |
The unit of within. See |
TRUE on success,
FALSE otherwise.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
p1 <- tempfile() p2 <- tempfile() p3 <- tempfile() touch(p1) touch(p2) Sys.sleep(3) touch(p3) is_files_current(p3, newer_than = 1, units = "days", within = 4, within_units = "secs") is_files_current(p1, p2, p3, newer_than = 1, units = "days", within = 4, within_units = "secs") is_files_current(p1, p2, p3, newer_than = 1, units = "days", within = 1, within_units = "secs") is_files_current(p1, p2, p3, newer_than = 1, units = "secs", within = 4, within_units = "secs")p1 <- tempfile() p2 <- tempfile() p3 <- tempfile() touch(p1) touch(p2) Sys.sleep(3) touch(p3) is_files_current(p3, newer_than = 1, units = "days", within = 4, within_units = "secs") is_files_current(p1, p2, p3, newer_than = 1, units = "days", within = 4, within_units = "secs") is_files_current(p1, p2, p3, newer_than = 1, units = "days", within = 1, within_units = "secs") is_files_current(p1, p2, p3, newer_than = 1, units = "secs", within = 4, within_units = "secs")
Check whether or not a package option (set via set_options)
force is not set or set to TRUE.
is_force(x = .packages()[1])is_force(x = .packages()[1])
x |
The option under which an element |
TRUE if option x[["force"]] is either
TRUE or NULL (i.e. not set
at all).
Other option functions:
get_options(),
set_options()
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
is_force() set_options(list(force = FALSE)) get_options(flatten_list = FALSE) is_force()is_force() set_options(list(force = FALSE)) get_options(flatten_list = FALSE) is_force()
Is an external program installed?
is_installed(program)is_installed(program)
program |
Name of the program. |
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
if (is_running_on_fvafrcu_machines() || is_running_on_gitlab_com()) { # NOTE: There are CRAN machines where neither "R" nor "R-devel" is in # the path, so we skipt this example on unkown machines. is_installed("R") } is_installed("probably_not_installed")if (is_running_on_fvafrcu_machines() || is_running_on_gitlab_com()) { # NOTE: There are CRAN machines where neither "R" nor "R-devel" is in # the path, so we skipt this example on unkown machines. is_installed("R") } is_installed("probably_not_installed")
FALSE?Sometimes you need to know whether or not an object exists and is not set to
FALSE (and possibly not
NULL).
is_not_false(x, null_is_false = TRUE, ...)is_not_false(x, null_is_false = TRUE, ...)
x |
The object to be tested. |
null_is_false |
|
... |
Parameters passed to |
TRUE if the object is set to something
different than FALSE,
FALSE
otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
a <- 1 b <- FALSE c <- NULL is_not_false(a) is_not_false(b) is_not_false(c) is_not_false(c, null_is_false = FALSE) is_not_false(not_defined) f <- function() { print(a) print(is_not_false(a)) } f() f <- function() { a <- FALSE print(a) print(is_not_false(a)) } f() f <- function() { print(a) print(is_not_false(a, null_is_false = TRUE, inherits = FALSE)) } f() ### We use this to check whether an option is set to something ### different than FALSE: # Make sure an option is not set: set_options("test" = NULL, package = "fritools") tmp <- get_options("test") is_not_false(tmp) is_not_false(tmp, null_is_false = FALSE) # Does not work on the option directly as it is not an object defined: options("foo" = NULL) is_not_false(getOption("foo"), null_is_false = FALSE)a <- 1 b <- FALSE c <- NULL is_not_false(a) is_not_false(b) is_not_false(c) is_not_false(c, null_is_false = FALSE) is_not_false(not_defined) f <- function() { print(a) print(is_not_false(a)) } f() f <- function() { a <- FALSE print(a) print(is_not_false(a)) } f() f <- function() { print(a) print(is_not_false(a, null_is_false = TRUE, inherits = FALSE)) } f() ### We use this to check whether an option is set to something ### different than FALSE: # Make sure an option is not set: set_options("test" = NULL, package = "fritools") tmp <- get_options("test") is_not_false(tmp) is_not_false(tmp, null_is_false = FALSE) # Does not work on the option directly as it is not an object defined: options("foo" = NULL) is_not_false(getOption("foo"), null_is_false = FALSE)
TRUE or NULL?is_null_or_true(x)is_null_or_true(x)
x |
The object to be tested. |
TRUE if the object is set to
TRUE or NULL,
FALSE
otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
is_null_or_true("true") # FALSE is_null_or_true(TRUE) # TRUE is_null_or_true(NULL) # TRUE suppressWarnings(rm("not_defined")) try(is_null_or_true(not_defined)) # erroris_null_or_true("true") # FALSE is_null_or_true(TRUE) # TRUE is_null_or_true(NULL) # TRUE suppressWarnings(rm("not_defined")) try(is_null_or_true(not_defined)) # error
Some expressions evaluate to integer(0) or the like.
is_of_length_zero(x, class = NULL)is_of_length_zero(x, class = NULL)
x |
The object. |
class |
An optional character vector of length 1 giving the class. See examples. |
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
x <- ""; length(x); is_of_length_zero(x) x <- grep(" ", "") print(x) is_of_length_zero(x) is_of_length_zero(x, "character") is_of_length_zero(x, "numeric") is_of_length_zero(x, "integer")x <- ""; length(x); is_of_length_zero(x) x <- grep(" ", "") print(x) is_of_length_zero(x) is_of_length_zero(x, "character") is_of_length_zero(x, "numeric") is_of_length_zero(x, "integer")
Check Whether an Object Contains a Valid File System Path
is_path(x)is_path(x)
x |
The object. |
TRUE on success,
FALSE otherwise.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
paths,
runsed(),
search_files(),
split_code_file(),
touch()
is_path(tempdir()) path <- tempfile() is_path(path) touch(path) is_path(path)is_path(tempdir()) path <- tempfile() is_path(path) touch(path) is_path(path)
R CMD check'?Check for system variables to guess whether or not this is an
R CMD check.
is_r_cmd_check()is_r_cmd_check()
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
Other test helpers:
develop_test(),
get_boolean_envvar(),
get_run_r_tests(),
is_cran(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
Is an R package installed?
is_r_package_installed(x, version = "0")is_r_package_installed(x, version = "0")
x |
Name of the package as character string. |
version |
Required minimum version of the package as character string. |
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
Other package functions:
get_package_version(),
is_version_sufficient(),
load_internal_functions(),
rename_package()
Other version functions:
get_package_version(),
get_session_string(),
is_version_sufficient()
is_r_package_installed("base", "300.0.0") is_r_package_installed("fritools", "1.0.0")is_r_package_installed("base", "300.0.0") is_r_package_installed("fritools", "1.0.0")
Is the machine running the current R process known to me?
is_running_on_fvafrcu_machines(type = c("any", "cu", "bwi", "fvafr"))is_running_on_fvafrcu_machines(type = c("any", "cu", "bwi", "fvafr"))
type |
An optional selection. |
TRUE on success,
FALSE otherwise.
Other test helpers:
develop_test(),
get_boolean_envvar(),
get_run_r_tests(),
is_cran(),
is_r_cmd_check(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient(),
is_windows()
is_running_on_fvafrcu_machines()is_running_on_fvafrcu_machines()
Check whether the current machine is located on https://about.gitlab.com. This check is an approximation only.
is_running_on_gitlab_com(verbose = TRUE)is_running_on_gitlab_com(verbose = TRUE)
verbose |
Be verbose? |
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_success(),
is_version_sufficient(),
is_windows()
Other test helpers:
develop_test(),
get_boolean_envvar(),
get_run_r_tests(),
is_cran(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
run_r_tests_for_known_hosts(),
set_run_r_tests()
is_running_on_gitlab_com()is_running_on_gitlab_com()
This is just a wrapper to ease the evaluation of return values from external
commands:
External commands return 0 on success, which is
FALSE, when converted to logical.
is_success(x)is_success(x)
x |
The external commands return value. |
TRUE on success,
FALSE otherwise.
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_version_sufficient(),
is_windows()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_windows(),
view(),
vim(),
wipe_tempdir(),
with_dir()
is_success(0) is_success(1) is_success(-1)is_success(0) is_success(1) is_success(-1)
data.frame?I sometimes see tables with obscure structure so I try to guess their primary keys.
is_valid_primary_key(data, key, verbose = TRUE)is_valid_primary_key(data, key, verbose = TRUE)
data |
The |
key |
Character vector containing a subset of the columns names of
|
verbose |
Be verbose? |
TRUE, if key is a valid primary key,
FALSE otherwise.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
pause(),
r_cmd_install(),
rownames2col(),
str2num(),
string2words(),
strip_off_attributes(),
tapply(),
throw()
is_valid_primary_key(mtcars, "qsec") is_valid_primary_key(mtcars, "carb") is_valid_primary_key(mtcars, c("qsec", "gear")) is_valid_primary_key(mtcars, c("qsec", "carb")) cars <- mtcars cars$id <- seq_len(nrow(cars)) is_valid_primary_key(cars, "id")is_valid_primary_key(mtcars, "qsec") is_valid_primary_key(mtcars, "carb") is_valid_primary_key(mtcars, c("qsec", "gear")) is_valid_primary_key(mtcars, c("qsec", "carb")) cars <- mtcars cars$id <- seq_len(nrow(cars)) is_valid_primary_key(cars, "id")
Just a wrapper to compareVersion, I regularly forget how to use
it.
is_version_sufficient(installed, required)is_version_sufficient(installed, required)
installed |
The version available. |
required |
The version required. |
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_windows()
Other package functions:
get_package_version(),
is_r_package_installed(),
load_internal_functions(),
rename_package()
Other version functions:
get_package_version(),
get_session_string(),
is_r_package_installed()
is_version_sufficient(installed = "1.0.0", required = "2.0.0") is_version_sufficient(installed = "1.0.0", required = "1.0.0") is_version_sufficient(installed = get_package_version("base"), required = "3.5.2")is_version_sufficient(installed = "1.0.0", required = "2.0.0") is_version_sufficient(installed = "1.0.0", required = "1.0.0") is_version_sufficient(installed = get_package_version("base"), required = "3.5.2")
Is the system running a windows machine?
is_windows()is_windows()
Other logical helpers:
get_run_r_tests(),
is_batch(),
is_cran(),
is_false(),
is_force(),
is_installed(),
is_not_false(),
is_null_or_true(),
is_of_length_zero(),
is_r_cmd_check(),
is_r_package_installed(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
is_success(),
is_version_sufficient()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
view(),
vim(),
wipe_tempdir(),
with_dir()
is_windows()is_windows()
Load objects not exported from a package's namespace.
load_internal_functions(package, ...)load_internal_functions(package, ...)
package |
The name of the package as a string. |
... |
Arguments passed to |
Other package functions:
get_package_version(),
is_r_package_installed(),
is_version_sufficient(),
rename_package()
load_internal_functions("fritools")load_internal_functions("fritools")
List objects in an R environment by size.
memory_hogs( unit = c("b", "Kb", "Mb", "Gb", "Tb", "Pb"), return_numeric = TRUE, ..., envir = parent.frame() )memory_hogs( unit = c("b", "Kb", "Mb", "Gb", "Tb", "Pb"), return_numeric = TRUE, ..., envir = parent.frame() )
unit |
The unit to use. |
return_numeric |
Return a numeric vector? If set to
|
... |
Arguments passed to |
envir |
The environment where to look for objects. |
A named vector of memory usages.
Other R memory functions:
wipe_clean(),
wipe_tempdir()
va <- rep(mtcars, 1) vb <- rep(mtcars, 1000) vc <- rep(mtcars, 2000) vd <- rep(mtcars, 100) memory_hogs() memory_hogs(unit = "Mb", decreasing = TRUE) memory_hogs(unit = "Mb", decreasing = TRUE, return_numeric = FALSE)va <- rep(mtcars, 1) vb <- rep(mtcars, 1000) vc <- rep(mtcars, 2000) vd <- rep(mtcars, 100) memory_hogs() memory_hogs(unit = "Mb", decreasing = TRUE) memory_hogs(unit = "Mb", decreasing = TRUE, return_numeric = FALSE)
For fritools, we make exhaustive use of categorizing functions into families with the 'See also' section of the man pages (which are generated by the @family tags in the code files).
find_missing_see_also(path, list_families = TRUE) find_missing_family(path, list_families = TRUE, clean = TRUE)find_missing_see_also(path, list_families = TRUE) find_missing_family(path, list_families = TRUE, clean = TRUE)
path |
Path to a (package) directory. |
list_families |
List the function families defined so far. |
clean |
Remove temporary directory? |
For 'find_missing_see_also': a character vector of man pages with missing 'See also' sections.
For 'find_missing_family': a character vector of function names with missing '@family' tags.
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
fromto(),
grep_file(),
runsed(),
search_files(),
search_rows(),
summary.filesearch()
path Attribute to or from an ObjectWe set paths on some objects, these are convenience wrappers to
attr.
get_path(x, force = FALSE) set_path(x, path, action = c(NA, "read", "write"), overwrite = FALSE)get_path(x, force = FALSE) set_path(x, path, action = c(NA, "read", "write"), overwrite = FALSE)
x |
An object. |
force |
Force the retrieval, even if the path is not valid? Only meant for unit testing, leave alone! |
path |
The path to be set. |
action |
Do we have a read or write process? Passed by
|
overwrite |
Overwrite an existing path attribute instead of throwing an error? |
For get_path the value of attr(x, "path").
For set_path the modified object.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
runsed(),
search_files(),
split_code_file(),
touch()
x <- 2 path <- tempfile() touch(path) x <- set_path(x, path) get_path(x)x <- 2 path <- tempfile() touch(path) x <- set_path(x, path) get_path(x)
Pause
pause()pause()
A data.frame.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
is_valid_primary_key(),
r_cmd_install(),
rownames2col(),
str2num(),
string2words(),
strip_off_attributes(),
tapply(),
throw()
pause()pause()
We often try to compare vectors on near equality. This is a wrapper to
all.equal for our convenience. It also implements relative
difference and change as discussed in
https://en.wikipedia.org/wiki/Relative_change_and_difference.
relative_difference( current, reference, type = c("all.equal", "difference", "change", "change2") )relative_difference( current, reference, type = c("all.equal", "difference", "change", "change2") )
current |
One vector. |
reference |
Another vector, for |
type |
The method to be used. See Details. |
The default method (type = all.equal) applies
all.equal onto the two
vectors. Method type = difference is somewhat the same as the default,
method type = change takes account of the sign of the differences.
A vector of relative differences.
Other statistics:
column_sums(),
count_groups(),
round_half_away_from_zero(),
sloboda(),
weighted_variance()
Other vector comparing functions:
compare_vectors()
n <- 500 x <- rnorm(n) y <- x + rnorm(n, sd = 0.0001) plot(relative_difference(x, y), x) plot(relative_difference(x, y, "difference"), x) # They do approximately the same: max(relative_difference(relative_difference(x, y), relative_difference(x, y, "difference"))) # But "all.equal" is _much_ slower: microbenchmark::microbenchmark(all_equal = relative_difference(x, y), difference = relative_difference(x, y, "difference") ) # Takes sign into account: plot(relative_difference(x, y, "change"), x) max(relative_difference(relative_difference(x, y), abs(relative_difference(x, y, "change"))))n <- 500 x <- rnorm(n) y <- x + rnorm(n, sd = 0.0001) plot(relative_difference(x, y), x) plot(relative_difference(x, y, "difference"), x) # They do approximately the same: max(relative_difference(relative_difference(x, y), relative_difference(x, y, "difference"))) # But "all.equal" is _much_ slower: microbenchmark::microbenchmark(all_equal = relative_difference(x, y), difference = relative_difference(x, y, "difference") ) # Takes sign into account: plot(relative_difference(x, y, "change"), x) max(relative_difference(relative_difference(x, y), abs(relative_difference(x, y, "change"))))
Commercial rounding is done a lot, especially with invoices. There is even
standard 1333 by the German Institute for Standardization.
round rounds half to even, see round's Details
section.
round_commercially is just a link to round_half_away_from_zero.
round_half_away_from_zero(x, digits = 0) round_commercially(x, digits = 0)round_half_away_from_zero(x, digits = 0) round_commercially(x, digits = 0)
x |
A number to be rounded. |
digits |
The number of digits, as in |
The rounded number.
Other statistics:
column_sums(),
count_groups(),
relative_difference(),
sloboda(),
weighted_variance()
x <- 22.5 round_half_away_from_zero(x) round(x) round_half_away_from_zero(-x) round(-x)x <- 22.5 round_half_away_from_zero(x) round(x) round_half_away_from_zero(-x) round(-x)
Add a Column Containing the Row Names to a Data Frame
rownames2col(x, column_name)rownames2col(x, column_name)
x |
A |
column_name |
The name of the new column containing the
|
A data.frame.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
str2num(),
string2words(),
strip_off_attributes(),
tapply(),
throw()
rownames2col(mtcars, column_name = "model")rownames2col(mtcars, column_name = "model")
Enforce the environment variable RUN_R_TESTS to TRUE on known hosts.
run_r_tests_for_known_hosts()run_r_tests_for_known_hosts()
This should go into .onLoad to force tests on known hosts.
Other test helpers:
develop_test(),
get_boolean_envvar(),
get_run_r_tests(),
is_cran(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
set_run_r_tests()
get_run_r_tests() if (isFALSE(get_run_r_tests())) { run_r_tests_for_known_hosts() get_run_r_tests() }get_run_r_tests() if (isFALSE(get_run_r_tests())) { run_r_tests_for_known_hosts() get_run_r_tests() }
This function mimics the runsed script published in Unix
Power Tools.
runsed(files, pattern, replacement)runsed(files, pattern, replacement)
files |
A list of file names in which to replace. |
pattern |
A regex pattern, see |
replacement |
A string, see |
Invisibly the vector of names of files
changed.
Shelley Powers, Jerry Peek, Tim O'Reilly and Mike Loukides, 2002, Unix Power Tools, 3rd edition, O'Reilly Media, Inc.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
search_files(),
split_code_file(),
touch()
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
fromto(),
grep_file(),
missing_docs,
search_files(),
search_rows(),
summary.filesearch()
source_files <- list.files(system.file(package = "fritools", "source", "R"), pattern = ".*\\.R$", full.names = TRUE) file.copy(source_files, tempdir(), overwrite = TRUE) files <- find_files(file_names = file.path(tempdir(), basename(source_files))) print(f <- runsed(files, pattern = "_clean", replacement = "_cleanr")) print(f <- runsed(files, pattern = "_cleanr\\>", replacement = "_cleaner"))source_files <- list.files(system.file(package = "fritools", "source", "R"), pattern = ".*\\.R$", full.names = TRUE) file.copy(source_files, tempdir(), overwrite = TRUE) files <- find_files(file_names = file.path(tempdir(), basename(source_files))) print(f <- runsed(files, pattern = "_clean", replacement = "_cleanr")) print(f <- runsed(files, pattern = "_cleanr\\>", replacement = "_cleaner"))
This is an approximation of unix find and grep.
search_files(what, verbose = TRUE, exclude = NULL, ...)search_files(what, verbose = TRUE, exclude = NULL, ...)
what |
A regex pattern for which to search. |
verbose |
Be verbose? |
exclude |
A regular expression for excluding files. |
... |
Arguments passed to |
Invisibly a vector of names of files
containing the pattern given by what.
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
fromto(),
grep_file(),
missing_docs,
runsed(),
search_rows(),
summary.filesearch()
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
split_code_file(),
touch()
write.csv(mtcars, file.path(tempdir(), "mtcars.csv")) for (i in 0:9) { write.csv(iris, file.path(tempdir(), paste0("iris", i, ".csv"))) } search_files(what = "Mazda", path = tempdir(), pattern = "^.*\\.csv$") search_files(what = "[Ss]etosa", path = tempdir(), pattern = "^.*\\.csv$") x <- search_files(path = tempdir(), pattern = "^.*\\.csv$", exclude = "[2-9]\\.csv$", what = "[Ss]etosa") summary(x) summary(x, type = "what") summary(x, type = "matches") try(search_files(what = "ABC", path = tempdir(), pattern = "^.*\\.csv$"))write.csv(mtcars, file.path(tempdir(), "mtcars.csv")) for (i in 0:9) { write.csv(iris, file.path(tempdir(), paste0("iris", i, ".csv"))) } search_files(what = "Mazda", path = tempdir(), pattern = "^.*\\.csv$") search_files(what = "[Ss]etosa", path = tempdir(), pattern = "^.*\\.csv$") x <- search_files(path = tempdir(), pattern = "^.*\\.csv$", exclude = "[2-9]\\.csv$", what = "[Ss]etosa") summary(x) summary(x, type = "what") summary(x, type = "matches") try(search_files(what = "ABC", path = tempdir(), pattern = "^.*\\.csv$"))
I sometimes need to see which rows of a matrix-like structure
contain a string matched by a search pattern.
This somewhat similar to writing a matrix-like structure to disk and then
using search_files on it.
search_rows(x, pattern = ".*", include_row_names = TRUE)search_rows(x, pattern = ".*", include_row_names = TRUE)
x |
A |
pattern |
A pattern. |
include_row_names |
Include row names into the search? |
All rows where the pattern was found in at least one column.
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
fromto(),
grep_file(),
missing_docs,
runsed(),
search_files(),
summary.filesearch()
p <- "\\<4.0[[:alpha:]]*\\>" search_rows(x = mtcars, pattern = p) search_rows(x = mtcars, pattern = p, include_row_names = FALSE) try(search_rows(x = mtcars, pattern = "ABC"))p <- "\\<4.0[[:alpha:]]*\\>" search_rows(x = mtcars, pattern = p) search_rows(x = mtcars, pattern = p, include_row_names = FALSE) try(search_rows(x = mtcars, pattern = "ABC"))
Set a Hash Attribute on an Object
set_hash(x)set_hash(x)
x |
The object. |
The modified object.
Other hash functions for objects:
un_hash()
A convenience function for options.
set_options(..., package_name = .packages()[1], overwrite = TRUE)set_options(..., package_name = .packages()[1], overwrite = TRUE)
... |
See |
package_name |
The package's name. |
overwrite |
[boolean(1)] |
Other option functions:
get_options(),
is_force()
options("cleanr" = NULL) defaults <- list(max_file_width = 80, max_file_length = 300, max_lines = 65, max_lines_of_code = 50, max_num_arguments = 5, max_nesting_depth = 3, max_line_width = 80, check_return = TRUE) set_options(package_name = "cleanr", defaults) getOption("cleanr") set_options(package_name = "cleanr", list(max_line_width = 3, max_lines = "This is nonsense!")) set_options(package_name = "cleanr", check_return = NULL, max_lines = 4000) get_options(package_name = "cleanr")options("cleanr" = NULL) defaults <- list(max_file_width = 80, max_file_length = 300, max_lines = 65, max_lines_of_code = 50, max_num_arguments = 5, max_nesting_depth = 3, max_line_width = 80, check_return = TRUE) set_options(package_name = "cleanr", defaults) getOption("cleanr") set_options(package_name = "cleanr", list(max_line_width = 3, max_lines = "This is nonsense!")) set_options(package_name = "cleanr", check_return = NULL, max_lines = 4000) get_options(package_name = "cleanr")
A convenience wrapper to Sys.getenv for setting
RUN_R_TESTS.
set_run_r_tests(x, force = FALSE)set_run_r_tests(x, force = FALSE)
x |
A logical, typically some function output. |
force |
Overwrite the variable if already set? |
The value RUN_R_TESTS is set to, NULL if nothing is
done.
Other test helpers:
develop_test(),
get_boolean_envvar(),
get_run_r_tests(),
is_cran(),
is_r_cmd_check(),
is_running_on_fvafrcu_machines(),
is_running_on_gitlab_com(),
run_r_tests_for_known_hosts()
set_run_r_tests(is_running_on_fvafrcu_machines()) get_run_r_tests() set_run_r_tests(TRUE, force = TRUE) get_run_r_tests()set_run_r_tests(is_running_on_fvafrcu_machines()) get_run_r_tests() set_run_r_tests(TRUE, force = TRUE) get_run_r_tests()
Implement the growth function
published in Sloboda, B., 1971: Zur Darstellung von Wachstumsprozessen mit Hilfe von Differentialgleichungen erster Ordnung. Mitt. d. Baden-Württembergischen Forstlichen Versuchs- und Forschungsanstalt.
sloboda(a, b, c, y0, t0, t, type = c("classic", "kaendler"), k = 65)sloboda(a, b, c, y0, t0, t, type = c("classic", "kaendler"), k = 65)
a |
Sloboda's |
b |
Sloboda's |
c |
Sloboda's |
y0 |
Sloboda's |
t0 |
Sloboda's |
t |
Sloboda's |
type |
Gerald Kaendler reformulated the algorithm, but it doesn't get faster, see the examples. |
k |
Sloboda's |
The value of Sloboda's growth function.
Other statistics:
column_sums(),
count_groups(),
relative_difference(),
round_half_away_from_zero(),
weighted_variance()
microbenchmark::microbenchmark(cl = sloboda(0.2, 0.7, 3, 30, 30, 35), g = sloboda(0.2, 0.7, 3, 30, 30, 35, "kaendler"), check = "equivalent")microbenchmark::microbenchmark(cl = sloboda(0.2, 0.7, 3, 30, 30, 35), g = sloboda(0.2, 0.7, 3, 30, 30, 35, "kaendler"), check = "equivalent")
I tend to find files with dozens of functions. They don't read well. So I split a code file into multiple files each containing a single function.
split_code_file( file, output_directory = tempdir(), encoding = getOption("encoding"), write_to_disk = getOption("write_to_disk") )split_code_file( file, output_directory = tempdir(), encoding = getOption("encoding"), write_to_disk = getOption("write_to_disk") )
file |
The code file to be split. |
output_directory |
Where to create the new files. |
encoding |
The encoding passed to |
write_to_disk |
Set the output_directory to
|
Invisibly a vector of paths to the new
files.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
touch()
If you read text containing (possibly German, i.e. the decimals separated by comma and dots inserted for what they think of as readability) numbers, you may want to convert them to numeric.
str2num(x)str2num(x)
x |
A string representing a (possibly German) number. |
The number as a numeric.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
rownames2col(),
string2words(),
strip_off_attributes(),
tapply(),
throw()
line_in_text <- "foo bar 10.303,70 foo bar 1.211.000,55 foo bar" words <- unlist(strsplit(line_in_text, split = " ")) print(na.omit(sapply(words, str2num)), digits = 9) print(str2num(words[c(3, 4, 7)]), digits = 9) print(str2num(words[7]), digits = 9)line_in_text <- "foo bar 10.303,70 foo bar 1.211.000,55 foo bar" words <- unlist(strsplit(line_in_text, split = " ")) print(na.omit(sapply(words, str2num)), digits = 9) print(str2num(words[c(3, 4, 7)]), digits = 9) print(str2num(words[7]), digits = 9)
Convert a Character Vector Into an Enumeration
string2words(x, separator = ",", last = "and", add_whitespace = TRUE)string2words(x, separator = ",", last = "and", add_whitespace = TRUE)
x |
A |
separator |
A separator used for the enumeration. |
last |
The separator used last for the enumeration. |
add_whitespace |
Add whitespace after separators? |
A data.frame.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
rownames2col(),
str2num(),
strip_off_attributes(),
tapply(),
throw()
string2words(c("beech", "oak", "ash"))string2words(c("beech", "oak", "ash"))
Strip Attributes off an Object
strip_off_attributes(x)strip_off_attributes(x)
x |
An object. |
The object.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
rownames2col(),
str2num(),
string2words(),
tapply(),
throw()
y <- stats::setNames(1:3, letters[1:3]) attr(y, "myattr") <- "qwer" comment(y) <- "qwer" strip_off_attributes(y)y <- stats::setNames(1:3, letters[1:3]) attr(y, "myattr") <- "qwer" comment(y) <- "qwer" strip_off_attributes(y)
Determine the sizes of k subsets of a set with n elements in such a way that the sizes are as equal as possible.
subset_sizes(n, k)subset_sizes(n, k)
n |
The size of the set. |
k |
The number of subsets. |
A vector of k sizes of the subsets.
Other subsetting functions:
index_groups()
subset_sizes(n = 100, k = 6) subset_sizes(n = 2, k = 6)subset_sizes(n = 100, k = 6) subset_sizes(n = 2, k = 6)
A custom summary function for objects returned by search_files.
## S3 method for class 'filesearch' summary(object, ..., type = c("file", "what", "matches"))## S3 method for class 'filesearch' summary(object, ..., type = c("file", "what", "matches"))
object |
An object returned by |
... |
Needed for compatibility. |
type |
Type of summary. |
A summarized object.
Other searching functions:
compare_vectors(),
file_modified_last(),
find_files(),
fromto(),
grep_file(),
missing_docs,
runsed(),
search_files(),
search_rows()
write.csv(mtcars, file.path(tempdir(), "mtcars.csv")) for (i in 0:9) { write.csv(iris, file.path(tempdir(), paste0("iris", i, ".csv"))) } search_files(what = "Mazda", path = tempdir(), pattern = "^.*\\.csv$") search_files(what = "[Ss]etosa", path = tempdir(), pattern = "^.*\\.csv$") x <- search_files(path = tempdir(), pattern = "^.*\\.csv$", exclude = "[2-9]\\.csv$", what = "[Ss]etosa") summary(x) summary(x, type = "what") summary(x, type = "matches") try(search_files(what = "ABC", path = tempdir(), pattern = "^.*\\.csv$"))write.csv(mtcars, file.path(tempdir(), "mtcars.csv")) for (i in 0:9) { write.csv(iris, file.path(tempdir(), paste0("iris", i, ".csv"))) } search_files(what = "Mazda", path = tempdir(), pattern = "^.*\\.csv$") search_files(what = "[Ss]etosa", path = tempdir(), pattern = "^.*\\.csv$") x <- search_files(path = tempdir(), pattern = "^.*\\.csv$", exclude = "[2-9]\\.csv$", what = "[Ss]etosa") summary(x) summary(x, type = "what") summary(x, type = "matches") try(search_files(what = "ABC", path = tempdir(), pattern = "^.*\\.csv$"))
This is a modified version of base::tapply to
allow for data.frames to be passed as X.
tapply(object, index, func = NULL, ..., default = NA, simplify = TRUE)tapply(object, index, func = NULL, ..., default = NA, simplify = TRUE)
object |
See |
index |
See |
func |
See |
... |
See |
default |
See |
simplify |
See |
See base::tapply.
Other bits and pieces:
golden_ratio(),
is_difftime_less(),
is_valid_primary_key(),
pause(),
r_cmd_install(),
rownames2col(),
str2num(),
string2words(),
strip_off_attributes(),
throw()
result <- fritools::tapply(warpbreaks[["breaks"]], warpbreaks[, -1], sum) expectation <- base::tapply(warpbreaks[["breaks"]], warpbreaks[, -1], sum) RUnit::checkIdentical(result, expectation) data("mtcars") s <- stats::aggregate(x = mtcars[["mpg"]], by = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = mean) t <- base::tapply(X = mtcars[["mpg"]], INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = mean) if (require("reshape", quietly = TRUE)) { suppressWarnings(tm <- na.omit(reshape::melt(t))) if (RUnit::checkEquals(s, tm, check.attributes = FALSE)) message("Works!") } message("If you don't pass weigths, this is equal to:") w <- base::tapply(X = mtcars[["mpg"]], INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = stats::weighted.mean) all.equal(w, t, check.attributes = FALSE) message("But how do you pass those weights?") # we define a wrapper to pass the column names for a data.frame: weighted_mean <- function(df, x, w) { stats::weighted.mean(df[[x]], df[[w]]) } if (RUnit::checkIdentical(stats::weighted.mean(mtcars[["mpg"]], mtcars[["wt"]]), weighted_mean(mtcars, "mpg", "wt"))) message("Works!") message("base::tapply can't deal with data.frames:") try(base::tapply(X = mtcars, INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = weighted_mean, x = "mpg", w = "wt")) wm <- fritools::tapply(object = mtcars, index = list(mtcars[["cyl"]], mtcars[["vs"]]), func = weighted_mean, x = "mpg", w = "wt") subset <- mtcars[mtcars[["cyl"]] == 6 & mtcars[["vs"]] == 0, c("mpg", "wt")] stats::weighted.mean(subset[["mpg"]], subset[["wt"]]) == wmresult <- fritools::tapply(warpbreaks[["breaks"]], warpbreaks[, -1], sum) expectation <- base::tapply(warpbreaks[["breaks"]], warpbreaks[, -1], sum) RUnit::checkIdentical(result, expectation) data("mtcars") s <- stats::aggregate(x = mtcars[["mpg"]], by = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = mean) t <- base::tapply(X = mtcars[["mpg"]], INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = mean) if (require("reshape", quietly = TRUE)) { suppressWarnings(tm <- na.omit(reshape::melt(t))) if (RUnit::checkEquals(s, tm, check.attributes = FALSE)) message("Works!") } message("If you don't pass weigths, this is equal to:") w <- base::tapply(X = mtcars[["mpg"]], INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = stats::weighted.mean) all.equal(w, t, check.attributes = FALSE) message("But how do you pass those weights?") # we define a wrapper to pass the column names for a data.frame: weighted_mean <- function(df, x, w) { stats::weighted.mean(df[[x]], df[[w]]) } if (RUnit::checkIdentical(stats::weighted.mean(mtcars[["mpg"]], mtcars[["wt"]]), weighted_mean(mtcars, "mpg", "wt"))) message("Works!") message("base::tapply can't deal with data.frames:") try(base::tapply(X = mtcars, INDEX = list(mtcars[["cyl"]], mtcars[["vs"]]), FUN = weighted_mean, x = "mpg", w = "wt")) wm <- fritools::tapply(object = mtcars, index = list(mtcars[["cyl"]], mtcars[["vs"]]), func = weighted_mean, x = "mpg", w = "wt") subset <- mtcars[mtcars[["cyl"]] == 6 & mtcars[["vs"]] == 0, c("mpg", "wt")] stats::weighted.mean(subset[["mpg"]], subset[["wt"]]) == wm
touch UtilityCreating files or ensuring that their file modification times change.
touch2 is an alternate - yet not faster - implementation.
touch(...) touch2(...)touch(...) touch2(...)
... |
Paths to files. |
The Paths to the files touched.
Other file utilities:
clipboard_path(),
delete_trailing_blank_lines(),
delete_trailing_whitespace(),
develop_test(),
file_copy(),
file_modified_last(),
file_save(),
file_string(),
find_files(),
get_lines_between_tags(),
get_mtime(),
get_unique_string(),
grep_file(),
is_files_current(),
is_path(),
paths,
runsed(),
search_files(),
split_code_file()
file1 <- tempfile() file2 <- tempfile() touch(file1, file2) t1 <- file.mtime(file1, file2) touch(file2) t2 <- file.mtime(file1, file2) t1 < t2 file <- file.path(tempfile(), "path", "not", "there.txt") touch(file) file.exists(file)file1 <- tempfile() file2 <- tempfile() touch(file1, file2) t1 <- file.mtime(file1, file2) touch(file2) t2 <- file.mtime(file1, file2) t1 < t2 file <- file.path(tempfile(), "path", "not", "there.txt") touch(file) file.exists(file)
We calculate a hash value of an object and store it as an attribute of the objects, the hash value of that object will change. So we need to split the hash value from the object to see whether or not the objected changed.
un_hash(x)un_hash(x)
x |
The object. |
A list containing the object and its hash attribute.
Other hash functions for objects:
set_hash()
Call shell.exec on windows, mimic shell.exec
otherwise.
view(path, program = NA)view(path, program = NA)
path |
A path to a file or directory. |
program |
A program to use. |
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
vim(),
wipe_tempdir(),
with_dir()
path <- file.path(tempdir(), "foo.txt") writeLines(c("abc", "xyz"), con = path) view(path)path <- file.path(tempdir(), "foo.txt") writeLines(c("abc", "xyz"), con = path) view(path)
VIM' if PossibleJust a wrapper to file.edit, trying to use [g]vim as editor, if
installed.
vim(...)vim(...)
... |
See |
See file.edit.
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
wipe_tempdir(),
with_dir()
if (interactive()) { path <- file.path(tempdir(), "foo.txt") writeLines(c("abc", "xyz"), con = path) vim(path) }if (interactive()) { path <- file.path(tempdir(), "foo.txt") writeLines(c("abc", "xyz"), con = path) vim(path) }
Calculate a weighted variance.
weighted_variance(x, ...) ## S3 method for class 'numeric' weighted_variance(x, weights, weights_counts = NULL, ...) ## S3 method for class 'data.frame' weighted_variance(x, var, weight, ...)weighted_variance(x, ...) ## S3 method for class 'numeric' weighted_variance(x, weights, weights_counts = NULL, ...) ## S3 method for class 'data.frame' weighted_variance(x, var, weight, ...)
x |
A numeric |
... |
Other arguments ignored. |
weights |
A vector of weights. |
weights_counts |
Are the weights counts of the data? If so, we can calculate the unbiased sample variance, otherwise we calculate the biased (maximum likelihood estimator of the) sample variance. |
var |
The name of the column in |
weight |
The name of the column in |
The data.frame method is meant for use with
tapply, see examples.
A numeric giving the (weighted) variance of x.
Other statistics:
column_sums(),
count_groups(),
relative_difference(),
round_half_away_from_zero(),
sloboda()
## GPA from Siegel 1994 wt <- c(5, 5, 4, 1)/15 x <- c(3.7,3.3,3.5,2.8) var(x) weighted_variance(x = x) weighted_variance(x = x, weights = wt) weighted_variance(x = x, weights = wt, weights_counts = TRUE) weights <- c(5, 5, 4, 1) weighted_variance(x = x, weights = weights) weighted_variance(x = x, weights = weights, weights_counts = FALSE) weighted_variance(x = data.frame(x, wt), var = "x", weight = "wt") # apply by groups: fritools::tapply(object = mtcars, index = list(mtcars[["cyl"]], mtcars[["vs"]]), func = weighted_variance, var = "mpg", w = "wt")## GPA from Siegel 1994 wt <- c(5, 5, 4, 1)/15 x <- c(3.7,3.3,3.5,2.8) var(x) weighted_variance(x = x) weighted_variance(x = x, weights = wt) weighted_variance(x = x, weights = wt, weights_counts = TRUE) weights <- c(5, 5, 4, 1) weighted_variance(x = x, weights = weights) weighted_variance(x = x, weights = weights, weights_counts = FALSE) weighted_variance(x = data.frame(x, wt), var = "x", weight = "wt") # apply by groups: fritools::tapply(object = mtcars, index = list(mtcars[["cyl"]], mtcars[["vs"]]), func = weighted_variance, var = "mpg", w = "wt")
Wipe an environment clean. This is similar to the broom button in
RStudio.
wipe_clean(environment = getOption("wipe_clean_environment"), all_names = TRUE)wipe_clean(environment = getOption("wipe_clean_environment"), all_names = TRUE)
environment |
The environment that should be wiped clean. |
all_names |
See argument |
A character vector containing the names of objects removed, but called for its side effect of removing all objects from the environment.
Other R memory functions:
memory_hogs(),
wipe_tempdir()
an_object <- 1 wipe_clean() ls() e <- new.env() assign("a", 1, envir = e) assign("b", 1, envir = e) ls(envir = e) wipe_clean(envir = e) ls(envir = e) RUnit::checkIdentical(length(ls(envir = e)), 0L)an_object <- 1 wipe_clean() ls() e <- new.env() assign("a", 1, envir = e) assign("b", 1, envir = e) ls(envir = e) wipe_clean(envir = e) ls(envir = e) RUnit::checkIdentical(length(ls(envir = e)), 0L)
tempdir()
I often need a clean temporary directory.
wipe_tempdir(recreate = FALSE)wipe_tempdir(recreate = FALSE)
recreate |
Use the method described in the examples section of
|
The path to the temporary directory.
Other R memory functions:
memory_hogs(),
wipe_clean()
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
with_dir()
This is a verbatim copy of withr::with_dir from of withr's
version 2.4.1.
I often need withr only to import withr::with_dir, which is a
really simple function. So I just hijack withr::with_dir.
with_dir(new, code)with_dir(new, code)
new |
The new working directory. |
code |
Code to execute in the temporary working directory. |
The results of the evaluation of the code argument.
Other operating system functions:
clipboard_path(),
file_copy(),
file_save(),
get_boolean_envvar(),
get_run_r_tests(),
is_installed(),
is_r_package_installed(),
is_success(),
is_windows(),
view(),
vim(),
wipe_tempdir()
temp_dir <- file.path(tempfile()) dir.create(temp_dir) with_dir(temp_dir, getwd())temp_dir <- file.path(tempfile()) dir.create(temp_dir) with_dir(temp_dir, getwd())