Package 'thisutils'

Description

Provides utility functions for data analysis and computing. Includes functions for logging, parallel processing, and other computational tasks to streamline workflows.

Author(s)

Meng Xu (Maintainer), [email protected]

Source

https://mengxu98.github.io/thisutils/

See Also

Useful links:

• https://mengxu98.github.io/thisutils/

• Report bugs at https://github.com/mengxu98/thisutils/issues

Description

This operator returns the left side if it's not NULL, otherwise it returns the right side.

Usage

a %ss% b

Arguments

Value

a if it is not NULL, otherwise b.

Examples

NULL %ss% 10
5 %ss% 10

Description

Add a package file and print package information

Usage

add_pkg_file(
  use_figlet = TRUE,
  figlet_font = "Slant",
  colors = c("red", "yellow", "green", "magenta", "cyan", "yellow", "green", "white",
    "magenta", "cyan"),
  verbose = TRUE
)

Arguments

Value

Creates a file named ⁠R/<pkg_name>-package.R⁠.

Description

Convert matrix into dense/sparse matrix

Usage

as_matrix(x, return_sparse = FALSE)

Arguments

Value

A dense or sparse matrix.

Examples

m <- simulate_sparse_matrix(
  1000, 1000,
  decimal = 3
)

a <- as_matrix(m)
a[1:5, 1:5]

b <- as_matrix(m, return_sparse = TRUE)
b[1:5, 1:5]

Description

Capitalize the first letter of each word

Usage

capitalize(x, force_tolower = FALSE)

Arguments

Examples

x <- c(
  "hello world",
  "hello World"
)
capitalize(x)

Description

Check CI environment

Usage

check_ci_env()

Value

A logical value.

Description

Check if a package is installed with the specified version

Usage

check_pkg_status(pkg, version = NULL, lib = .libPaths()[1])

Arguments

Value

TRUE if the package is installed with the specified version, FALSE otherwise.

Description

Check and install R packages

Usage

check_r(
  packages,
  lib = .libPaths()[1],
  dependencies = NA,
  force = FALSE,
  verbose = TRUE
)

Arguments

Value

Package installation status.

Description

Check sparsity of matrix

Usage

check_sparsity(x)

Arguments

Value

Sparsity of matrix.

Description

Collapse sparse matrix rows by group

Usage

collapse_sparse_rows(matrix, group)

Arguments

Value

A sparse matrix with rows collapsed by 'group'.

Examples

mat <- Matrix::Matrix(
  matrix(c(1, 0, 2, 0, 3, 4), nrow = 3, byrow = TRUE),
  sparse = TRUE
)
collapse_sparse_rows(mat, c("g1", "g1", "g2"))

Description

Compute per-cell Local Inverse Simpson's Index (LISI) scores for one or more categorical variables. This is a clean-room reimplementation of the immunogenomics/LISI.

Usage

compute_lisi(
  X,
  meta_data,
  label_colnames,
  perplexity = 30,
  tol = 1e-05,
  max_iter = 50
)

Arguments

Value

A data frame with one row per cell and one column per label.

References

Korsunsky I, Millard N, Fan J, et al. Fast, sensitive and accurate integration of single-cell data with Harmony. Nature Methods (2019). https://www.nature.com/articles/s41592-019-0619-0

LISI reference implementation: https://github.com/immunogenomics/LISI

Examples

set.seed(1)
X <- rbind(
  matrix(stats::rnorm(100, mean = -1), ncol = 2),
  matrix(stats::rnorm(100, mean = 1), ncol = 2)
)
meta_data <- data.frame(
  batch = rep(c("A", "B"), each = 50),
  group = sample(c("g1", "g2"), 100, replace = TRUE)
)

res <- compute_lisi(
  X, meta_data,
  c("batch", "group"),
  perplexity = 10
)
head(res)
boxplot(res)

Description

Download file from the Internet

Usage

download(
  url,
  destfile,
  methods = c("auto", "wget", "libcurl", "curl", "wininet", "internal"),
  quiet = FALSE,
  ...,
  max_tries = 2
)

Arguments

Description

Create ASCII art text using figlet.

Usage

figlet(
  text,
  font = "Slant",
  width = getOption("width", 80),
  justify = "left",
  absolute = FALSE,
  strip = TRUE
)

Arguments

Value

An object of class figlet_text which is a character vector with a handy print method.

References

https://github.com/richfitz/rfiglet, https://github.com/jbkunst/figletr, https://www.figlet.org/

Examples

figlet("thisutils")

Description

Get a figlet font

Usage

figlet_font(font)

Arguments

Value

A 'figlet_font' object for use with [figlet]

Description

Get a function from a namespace

Usage

get_namespace_fun(pkg, fun)

Arguments

Value

Function.

Description

Get the verbose option from the global options or the local argument.

Usage

get_verbose(verbose = NULL)

Arguments

Value

The verbose option.

Examples

get_verbose()
get_verbose(verbose = FALSE)
get_verbose(verbose = TRUE)

options(log_message.verbose = FALSE)
get_verbose()
get_verbose(verbose = TRUE)

options(log_message.verbose = TRUE)
get_verbose()

options(log_message.verbose = NULL)

Description

Invoke a function with a list of arguments

Usage

invoke_fun(.fn, .args = list(), ..., .env = rlang::caller_env())

Arguments

Examples

f <- function(x, y) {
  x + y
}
invoke_fun(f, list(x = 1, y = 2))
invoke_fun("f", list(x = 1, y = 2))
invoke_fun("f", x = 1, y = 2)

Description

Check if the system is running on Apple Silicon

Usage

is_apple_silicon()

Value

A logical value.

Description

Check if the operating system is Linux

Usage

is_linux()

Value

A logical value.

Description

Check if the operating system is macOS

Usage

is_osx()

Value

A logical value.

Description

Detect outliers using MAD (Median Absolute Deviation)

Usage

is_outlier(
  x,
  nmads = 2.5,
  constant = 1.4826,
  type = c("both", "lower", "higher")
)

Arguments

Value

Numeric vector of indices indicating the positions of outliers in x.

Examples

x <- c(1, 2, 3, 4, 5, 100)
is_outlier(x) # returns 6

x <- c(3, 4, 5, NA, 6, 7)
is_outlier(x, nmads = 1.5, type = "lower") # returns 4

x <- c(10, 20, NA, 15, 35)
is_outlier(x, nmads = 2, type = "higher") # returns 3, 5

Description

Check if the operating system is Windows

Usage

is_windows()

Value

A logical value.

Description

Integrate the message printing function with the cli package, and the base::message function. The message could be suppressed by base::suppressMessages.

Usage

log_message(
  ...,
  expr = NULL,
  verbose = NULL,
  message_type = c("info", "success", "warning", "error", "running", "ask"),
  cli_model = TRUE,
  level = 1,
  symbol = "  ",
  text_color = NULL,
  back_color = NULL,
  text_style = NULL,
  multiline_indent = FALSE,
  timestamp = TRUE,
  timestamp_format = paste0("[", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "] "),
  timestamp_style = FALSE,
  plain_text = FALSE,
  .envir = parent.frame(),
  .frame = .envir
)

Arguments

Value

Formated message, a logical value (TRUE/FALSE/NA) if message_type = "ask", or the evaluated result of expr if expr is supplied.

References

https://cli.r-lib.org/articles/index.html

Examples

# basic usage
log_message("Hello, ", "world!")

log_message("hello, world!")

log_message("Hello, world!", timestamp = FALSE)

log_message(
  "Hello, ", "world!",
  message_type = "success"
)

log_message(
  "Hello, world!",
  message_type = "warning"
)

log_message(
  "Processing data...",
  message_type = "running"
)

log_message(
  "Hello, ", "world!",
  cli_model = FALSE
)


# suppress messages
suppressMessages(log_message("Hello, world!"))
log_message("Hello, world!", verbose = FALSE)
options(log_message.verbose = FALSE)
log_message("Hello, world!")

# for global verbose option
options(log_message.verbose = TRUE)
log_message("Hello, world!", verbose = FALSE)
options(log_message.verbose = NULL)


# cli inline markup
log_message("{.arg abc} is a argument")

## 'message' can not deal with cli inline markup
message("hello, {.code world}!")

log_message("{.val list('abc')} is a {.cls {class(list('abc'))}}")

log_message("{.code lm(y ~ x)} is a code example")

log_message("{.dt List}list('abc')")

log_message("address: {.email [email protected]}")

log_message("{.emph R} is a programming language")

log_message("{.envvar R_HOME}")

log_message("{.file log_message.R} is a file")

log_message("{.fn lm} is a function")

log_message("{.fun lm} is a function")

log_message("{.help lm} to get help")

log_message("... see {.help [{.fun lm}](stats::lm)} to learn more")

log_message(
  "See the {.href [cli homepage](https://cli.r-lib.org)} for details"
)

log_message("press {.kbd ENTER}")

log_message("press {.key ENTER}")

log_message("URL: {.url https://cli.r-lib.org}")

log_message("Some {.field field}")

log_message("{.path /usr/bin/R} is a path")

log_message("{.pkg cli} is a package")

log_message("{.val object} is a variable")

log_message("{.run Rscript log_message.R} is a runnable file")

log_message("{.str object} is a string")

log_message("{.strong abc} is a strong string")

log_message("{.topic stats::lm} is a topic")

log_message("{.vignette cli} is a vignette")


# set indentation
log_message("Hello, world!", level = 2)

log_message("Hello, world!", symbol = "->")

log_message(
  "Hello, world!",
  symbol = "#####",
  level = 3
)

# color formatting
log_message(
  "This is a red message",
  text_color = "#ff9900"
)

log_message(
  "This is a message with background",
  back_color = "#EE4000"
)

log_message(
  "This is a message with both text and background",
  text_color = "white",
  back_color = "cyan"
)

log_message(
  "This is a message with background",
  back_color = "#EE4000",
  cli_model = FALSE
)

log_message(
  "This is a message with both text and background",
  text_color = "red",
  back_color = "cyan",
  cli_model = FALSE
)

log_message(
  "Hex color with {.arg cli_model = FALSE}",
  text_color = "#FF5733",
  cli_model = FALSE
)

log_message(
  "Bright red text",
  text_color = "br_red"
)

log_message(
  "Bright background",
  back_color = "br_yellow"
)

log_message(
  "Combined grey and style",
  text_color = "grey",
  text_style = "bold"
)

# text style formatting
log_message(
  "Bold message",
  text_style = "bold"
)

log_message(
  "Italic message",
  text_style = "italic"
)

log_message(
  "Underlined message",
  text_style = "underline"
)

log_message(
  "Combined styles",
  text_style = c("bold", "underline")
)

log_message(
  "Color and style",
  text_color = "blue",
  text_style = c("bold", "italic")
)

log_message(
  "Hex color and style",
  text_color = "#FF5733",
  text_style = c("bold", "underline")
)


# multiline message
log_message(
  "Line 1\nLine 2\nLine 3",
  multiline_indent = TRUE,
  text_style = "italic"
)

log_message(
  "Multi-line\ncolored\nmessage",
  text_color = "blue",
  text_style = "italic"
)

log_message(
  "Multi-line\ncolored\nmessage",
  text_color = "blue",
  timestamp = FALSE
)

# timestamp styling
log_message(
  "Multi-line message\nwith timestamp styling",
  text_color = "red",
  text_style = "bold",
  timestamp_style = TRUE
)

log_message(
  "Multi-line message\nwithout timestamp styling",
  text_color = "#669999",
  text_style = c("bold", "italic")
)


# combine cli package and log_message
log_message(
  cli::col_green(
    "I am a green line ",
    cli::col_blue(
      cli::style_underline(
        cli::style_bold("with a blue substring")
      )
    ),
    " that becomes green again!"
  )
)

# cli variables
fun <- function(x = 1) {
  log_message("{.val x}")
  log_message("{.val {x}}")
  log_message("{.val {x + 1}}")
}
fun()


# print objects directly
df <- data.frame(
  x = 1:3,
  y = letters[1:3],
  z = c(" a", "b  ", "c")
)
log_message("Content:\n", df)

# interactive prompt
if (interactive()) {
  log_message(
    "Do you want to continue?",
    message_type = "ask"
  )
}

# capture output from another expression
fun <- function() {
  cat("This is standard output\n")
  message("This is a message")
  return(1 + 1)
}
fun()

log_message(
  expr = fun(),
  message_type = "running"
)

Description

Process matrix

Usage

matrix_process(
  matrix,
  method = c("raw", "zscore", "fc", "log2fc", "log1p"),
  ...
)

Arguments

Value

A processed matrix.

Examples

m <- simulate_sparse_matrix(10, 10)
matrix_process(m, method = "raw")
matrix_process(m, method = "zscore")
matrix_process(m, method = "fc")
matrix_process(m, method = "log2fc")
matrix_process(m, method = "log1p")
m <- as_matrix(m)
matrix_process(m, method = function(x) x / rowMeans(x))

Description

Switch matrix to table

Usage

matrix_to_table(
  matrix,
  row_names = NULL,
  col_names = NULL,
  threshold = 0,
  keep_zero = TRUE
)

Arguments

Value

A table with three columns: row, col, and value.

See Also

table_to_matrix

Examples

test_matrix <- simulate_sparse_matrix(10, 10)
colnames(test_matrix) <- paste0("c", 1:10)
rownames(test_matrix) <- paste0("r", 1:10)
table <- matrix_to_table(test_matrix)
matrix_new <- table_to_matrix(table)
test_matrix <- test_matrix[rownames(matrix_new), colnames(matrix_new)] |>
  as_matrix()
identical(test_matrix, matrix_new)

matrix_to_table(
  test_matrix,
  threshold = 2
)

matrix_to_table(
  test_matrix,
  row_names = c("r1", "r2"),
  col_names = c("c1", "c2")
)

Description

Maximum depth of a list

Usage

max_depth(x, depth = 0)

Arguments

Examples

x <- list(
  a = list(b = list(c = 1)),
  d = list(e = list(f = 2))
)
max_depth(x)

Description

Maximum P-value

Usage

maximump(p, alpha = 0.05, log.p = FALSE)

Arguments

Examples

p <- c(0.01, 0.02, 0.03, 0.04, 0.05)
maximump(p)
maximump(p, alpha = 0.01)
maximump(p, log.p = TRUE)

Description

Mean P-value

Usage

meanp(p)

Arguments

Examples

p <- c(0.01, 0.02, 0.03, 0.04, 0.05)
meanp(p)

Description

Minimum P-value

Usage

minimump(p, alpha = 0.05, log.p = FALSE)

Arguments

Examples

p <- c(0.01, 0.02, 0.03, 0.04, 0.05)
minimump(p)
minimump(p, alpha = 0.01)
minimump(p, log.p = TRUE)

Description

Normalize numeric vector

Usage

normalization(x, method = "max_min", na_rm = TRUE, ...)

Arguments

Value

Normalized numeric vector.

Examples

x <- c(runif(2), NA, -runif(2))
x
normalization(x, method = "max_min")
normalization(x, method = "maximum")
normalization(x, method = "sum")
normalization(x, method = "softmax")
normalization(x, method = "z_score")
normalization(x, method = "mad")
normalization(x, method = "unit_vector")
normalization(x, method = "unit_vector", na_rm = FALSE)

Description

Parallelize a function

Usage

parallelize_fun(
  x,
  fun,
  cores = 1,
  export_fun = NULL,
  clean_result = FALSE,
  throw_error = TRUE,
  progress_bar_width = 10L,
  timestamp_format = paste0("[", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "] "),
  verbose = TRUE
)

Arguments

Value

A list of computed results. If clean_result = FALSE, failed results are included as error objects. If clean_result = TRUE, only successful results are returned.

Examples

parallelize_fun(1:3, function(x) {
  Sys.sleep(0.2)
  x^2
})

parallelize_fun(list(1, 2, 3), function(x) {
  Sys.sleep(0.2)
  x^2
}, cores = 2)

# Examples with error handling
parallelize_fun(1:5, function(x) {
  if (x == 3) stop("Error on element 3")
  x^2
}, clean_result = FALSE)

parallelize_fun(1:5, function(x) {
  if (x == 3) stop("Error on element 3")
  x^2
}, clean_result = TRUE)

# Control error printing
parallelize_fun(1:5, function(x) {
  if (x == 2) stop("Error on element 3")
  if (x == 4) stop("Error on element 4")
  x^2
})

parallelize_fun(1:5, function(x) {
  if (x == 3) stop("Error on element 3")
  x^2
}, throw_error = FALSE)

Description

Parse '' inline expressions and evaluate them in the current environment, while preserving outer formatting markers like '{.val ...}'.

Usage

parse_inline_expressions(text, env = parent.frame())

Arguments

Value

A character string with expressions evaluated but formatting preserved.

Examples

i <- 1
parse_inline_expressions(
  "{.val {i}}"
)

x <- 5
y <- 10
parse_inline_expressions(
  "{.pkg {x + y}}"
)

name <- "testing"
name <- parse_inline_expressions(
  "{.pkg {name}}"
)
name

log_message(name)

Description

Correlation and covariance calculation for sparse matrix

Usage

pearson_correlation(x, y = NULL)

Arguments

Value

A list with covariance and correlation matrices.

Examples

m1 <- simulate_sparse_matrix(
  100, 100
)
m2 <- simulate_sparse_matrix(
  100, 100,
  sparsity = 0.05
)
a <- pearson_correlation(m1, m2)
a$cov[1:5, 1:5]
a$cor[1:5, 1:5]

Description

Print logo

Usage

## S3 method for class 'thisutils_logo'
print(x, ...)

Arguments

Value

Print the ASCII logo

Description

Coefficient of determination ($R^2$)

Usage

r_square(y_true, y_pred)

Arguments

Value

The $R^2$ value.

Examples

y <- rnorm(100)
y_pred <- y + rnorm(100, sd = 0.5)
r_square(y, y_pred)

Description

Check and remove R packages

Usage

remove_r(packages, lib = .libPaths()[1], verbose = TRUE)

Arguments

Description

Remove and normalize spaces

Usage

remove_space(
  x,
  trim_start = TRUE,
  trim_end = FALSE,
  collapse_multiple = TRUE,
  preserve_newlines = TRUE
)

Arguments

Value

A character vector with spaces normalized according to the specified parameters.

Examples

x <- c(
  " hello  world ",
  "  test   case  ",
  "no space",
  "   multiple   spaces   "
)
remove_space(x)
remove_space(x, trim_start = FALSE)
remove_space(x, trim_end = TRUE)
remove_space(x, collapse_multiple = FALSE)
remove_space(
  x,
  trim_start = FALSE,
  trim_end = FALSE,
  collapse_multiple = FALSE
)

# with newlines
multiline <- c(
  "hello\n\n  world  ",
  "  first  \n  second  "
)
remove_space(multiline)
remove_space(multiline, preserve_newlines = FALSE)

Description

This function generates a sparse matrix with a specified number of rows and columns, a given sparsity level, and a distribution function for the non-zero values.

Usage

simulate_sparse_matrix(
  nrow,
  ncol,
  sparsity = 0.95,
  distribution_fun = function(n) stats::rpois(n, lambda = 0.5) + 1,
  decimal = 0,
  seed = 1
)

Arguments

Value

A sparse matrix of class "dgCMatrix".

Examples

simulate_sparse_matrix(1000, 500) |>
  check_sparsity()

simulate_sparse_matrix(10, 10, decimal = 1)
simulate_sparse_matrix(10, 10, decimal = 5)

Description

Safe correlation function which returns a sparse matrix.

Usage

sparse_cor(
  x,
  y = NULL,
  method = "pearson",
  allow_neg = TRUE,
  remove_na = TRUE,
  remove_inf = TRUE,
  ...
)

Arguments

Value

A correlation matrix.

Examples

m1 <- simulate_sparse_matrix(
  500, 100
)
m2 <- simulate_sparse_matrix(
  500, 100,
  seed = 2025
)
a <- sparse_cor(m1)
b <- sparse_cor(m1, m2)
c <- as_matrix(
  cor(as_matrix(m1)),
  return_sparse = TRUE
)
d <- as_matrix(
  cor(as_matrix(m1), as_matrix(m2)),
  return_sparse = TRUE
)

a[1:5, 1:5]
c[1:5, 1:5]
all.equal(a, c)

b[1:5, 1:5]
d[1:5, 1:5]
all.equal(b, d)

m1[sample(1:500, 10)] <- NA
m2[sample(1:500, 10)] <- NA

sparse_cor(m1, m2)[1:5, 1:5]

system.time(
  sparse_cor(m1)
)
system.time(
  cor(as_matrix(m1))
)

system.time(
  sparse_cor(m1, m2)
)
system.time(
  cor(as_matrix(m1), as_matrix(m2))
)

Description

An optimised version of split for the special case of splitting row indices into groups.

Usage

split_indices(group, n = 0L)

Arguments

Value

A list of vectors of indices.

References

https://github.com/hadley/plyr/blob/d57f9377eb5d56107ba3136775f2f0f005f33aa3/src/split-numeric.cpp#L20

Examples

split_indices(sample(10, 100, rep = TRUE))
split_indices(sample(10, 100, rep = TRUE), 10)

Description

Sum P-value

Usage

sump(p)

Arguments

Examples

p <- c(0.01, 0.02, 0.03, 0.04, 0.05)
sump(p)

Description

Switch table to matrix

Usage

table_to_matrix(
  table,
  row_names = NULL,
  col_names = NULL,
  threshold = 0,
  return_sparse = FALSE
)

Arguments

Value

A matrix.

See Also

matrix_to_table

Examples

table <- data.frame(
  row = c("r1", "r2", "r3", "r4", "r5", "r6"),
  col = c("c4", "c5", "c6", "c1", "c2", "c3"),
  value = c(0.6, -0.5, -0.4, 0.3, 0.2, 0.1)
)
matrix <- table_to_matrix(table)
table_new <- matrix_to_table(matrix)
identical(table, table_new)

table_to_matrix(table, threshold = 0.3)

table_to_matrix(
  table,
  row_names = c("r1", "r2"),
  col_names = c("c4", "c5")
)

sparse_matrix <- simulate_sparse_matrix(10, 10)
table_sparse <- matrix_to_table(
  sparse_matrix
)
sparse_matrix_new <- table_to_matrix(
  table_sparse,
  return_sparse = TRUE
)
identical(sparse_matrix, sparse_matrix_new)

Description

The thisutils logo, using ASCII or Unicode characters Use cli::ansi_strip to get rid of the colors.

Usage

thisutils_logo(unicode = cli::is_utf8_output())

Arguments

Value

A character vector with class thisutils_logo.

References

https://github.com/tidyverse/tidyverse/blob/main/R/logo.R

Examples

thisutils_logo()

Description

The function is used as a fail-safe if code sometimes works and sometimes doesn't, usually because it depends on a resource that may be temporarily unavailable. It tries to evaluate the expression max_tries times. If all the attempts fail, it throws an error; if not, the evaluated expression is returned.

Usage

try_get(expr, max_tries = 5, error_message = "", retry_message = "Retrying...")

Arguments

Value

The evaluated expression if successful, otherwise it throws an error if all attempts are unsuccessful.

Examples

f <- function() {
  value <- runif(1, min = 0, max = 1)
  if (value > 0.5) {
    log_message("value is larger than 0.5")
    return(value)
  } else {
    log_message(
      "value is smaller than 0.5",
      message_type = "error"
    )
  }
}
f_evaluated <- try_get(expr = f())
print(f_evaluated)

Description

Implement similar functions to the tidyr::unnest function.

Usage

unnest_fun(data, cols, keep_empty = FALSE)

Arguments

Examples

data <- data.frame(
  id = 1:3,
  x = c("a", "b", "c"),
  stringsAsFactors = FALSE
)
data$data <- list(
  c(1, 2),
  c(3, 4, 5),
  c(6)
)
unnest_fun(data, cols = "data")

data2 <- data.frame(
  id = 1:3,
  x = c("a", "b", "c"),
  stringsAsFactors = FALSE
)
data2$data <- list(
  c(1, 2),
  numeric(0),
  c(6)
)
unnest_fun(data2, cols = "data")
unnest_fun(data2, cols = "data", keep_empty = TRUE)

Description

Vote P-value

Usage

votep(p, alpha = 0.5)

Arguments

Examples

p <- c(0.01, 0.02, 0.03, 0.04, 0.05)
votep(p)
votep(p, alpha = 0.01)

Description

Wilkinson's P-value

Usage

wilkinsonp(p, r = 1, alpha = 0.05, log.p = FALSE)

Arguments

Examples

p <- c(0.01, 0.02, 0.03, 0.04, 0.05)
wilkinsonp(p)
wilkinsonp(p, r = 2)
wilkinsonp(p, alpha = 0.01)
wilkinsonp(p, log.p = TRUE)