## util.R | i2ds
## hn | uni.kn | 2023 12 23
# General utility functions: ------
## swap_xy_dims: Swap 2 dimensions x and y of an array/table OR elements of a vector/list/columns of a data.frame: ------
# Goal: A generalized version of t() that works for multiple object types.
swap_xy_dims <- function(obj, x = 1, y = 2){
# Inputs: Ensure that x and y are integer values:
if ( (x %% 1 != 0) || (y %% 1 != 0) ) {
message("swap_xy_dims: x and y must be integer values.")
x <- as.integer(x)
y <- as.integer(y)
}
t_obj <- NA # initialize
if (is.array(obj)) { # Case 1: obj is an array/matrix/table: ----
# print("1: An array, matrix, or table: Transpose dimensions") # 4debugging
n_dim <- length(dim(obj))
if ( (x <= n_dim) && (y <= n_dim) && (x != y) ){
ix <- 1:n_dim
ix[x] <- y
ix[y] <- x
t_obj <- aperm(obj, perm = ix) # permute dimensions x and y
} else { # no change:
message("swap_xy_dims: no change.")
t_obj <- obj
}
} else if ( is.atomic(obj) | is.list(obj) ) { # Case 2: obj is atomic vector/list/df: ----
# print("2: An atomic vector, list, or data frame: Swap elements") # 4debugging
n <- length(obj)
if ( (x <= n) && (y <= n) && (x != y) ){
ix <- 1:n
ix[x] <- y
ix[y] <- x
t_obj <- obj[ix] # switch elements x and y
} else { # Trivial case 0: no change:
message("swap_xy_dims: no change.")
t_obj <- obj
}
} else { # any other obj:
message("swap_xy_dims: obj is not an array/table or linear vector/list.")
}
return(t_obj)
} # swap_xy_dims().
# # Check:
# (v <- 1:4)
# (m <- matrix(1:6, nrow = 3))
# (l <- list(a = 1:3, b = letters[1:2], c = 11:14))
# (df <- data.frame(v1 = v, v2 = letters[1:4], v3 = 11:14))
# (ar <- array(1:24, dim = c(4, 3, 2)))
# (tb <- UCBAdmissions)
#
# swap_xy_dims(v)
# swap_xy_dims(v, 1, 4)
# swap_xy_dims(v, 2.2, pi) # as integers
# swap_xy_dims(v, 1, 9) # no change
#
# swap_xy_dims(l)
#
# swap_xy_dims(l, 2, pi)
# swap_xy_dims(l, 1, 9) # no change
#
# swap_xy_dims(df) # df is list
#
# swap_xy_dims(m) # same as t(m)
#
# swap_xy_dims(ar)
# swap_xy_dims(ar, 2, 3)
#
# swap_xy_dims(tb)
# swap_xy_dims(tb, 2, 3)
# swap_xy_dims(tb, 1, pi)
#
# swap_xy_dims(factor(v)) # factor
## get_arg: Get raw argument(s) of a function (from inside a function) ------
get_arg <- function(x){
base::substitute(x)
# rlang::enexpr(x)
} # get_arg().
# # Check:
# get_arg(x = "abc")
# get_arg(x = list("abc", 123, TRUE))
# get_arg(x = list(a, b, c))
# as.character(get_arg(x = list(a, b, c)))[-1]
## get_name: Get an object's name (from inside a function): ------
# vec <- 1:10
# deparse(substitute(vec))
get_name <- function(x){
nm <- NA
nm <- deparse(substitute(x))
return(nm)
} # get_name().
# # Check:
# (v <- 1:4)
# (m <- matrix(1:6, nrow = 3))
# (l <- list(a = 1:3, b = letters[1:2], c = 11:14))
# (df <- data.frame(v1 = v, v2 = letters[1:4], v3 = 11:14))
# (ar <- array(1:24, dim = c(4, 3, 2)))
# (tb <- UCBAdmissions)
#
# get_name(v)
# get_name(m)
# get_name(df)
# get_name(ar)
# get_name(tb)
## ToDo: ------
# 1. Verify that some object contains only freq counts (i.e., integers >= 0).
# (see is_freq() in riskyr and i2ds).
## eof. ----------
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.