Merge branch 'issue-21' into develop (closes #21)
This commit is contained in:
Waldir Leoncio
commit
721b2527ca
26 changed files with 0 additions and 965 deletions
14
R/blanks.R
14
R/blanks.R
|
|
@ -1,14 +0,0 @@
|
|||
#' @title Blanks
|
||||
#' @description Create character vector of blanks
|
||||
#' @details This function emulates the behavior of a homonimous function from Matlab
|
||||
#' @param n length of vector
|
||||
#' @return Vector of n blanks
|
||||
#' @author Waldir Leoncio
|
||||
#' @export
|
||||
blanks <- function(n) {
|
||||
if (n < 0) {
|
||||
warning("Negative n passed. Treating as n = 0")
|
||||
n <- 0
|
||||
}
|
||||
paste(rep(" ", n), collapse = "")
|
||||
}
|
||||
36
R/cell.R
36
R/cell.R
|
|
@ -1,36 +0,0 @@
|
|||
#' @title Cell array
|
||||
#' @description Creates an array of zeros
|
||||
#' @param n a the first dimension (or both, if sz is not passed)
|
||||
#' @param sz the second dimension (or 1st and 2nd, if not passed)
|
||||
#' @param expandable if TRUE, output is a list (so it can take different
|
||||
#' lengths)
|
||||
#' @param ... Other dimensions
|
||||
#' @return An array of zeroes with the dimensions passed on call
|
||||
cell <- function(n, sz = c(n, n), expandable = FALSE, ...) {
|
||||
|
||||
# Uglyly figuring out if the third arg is an extra dim --- #
|
||||
|
||||
sz3 <- vector()
|
||||
if (!is.logical(expandable)) {
|
||||
sz3 <- expandable
|
||||
expandable <- FALSE
|
||||
}
|
||||
args <- c(as.list(environment()), list(...))
|
||||
exp <- args$expandable
|
||||
extra_dims <- c(sz3, args[names(args) == ""])
|
||||
|
||||
# Creating output vector --------------------------------- #
|
||||
|
||||
if (exp) {
|
||||
return(vector("list", length = n))
|
||||
}
|
||||
if (length(sz) == 1 & length(extra_dims) == 0) {
|
||||
return(array(0, dim = c(n, sz)))
|
||||
} else if (length(extra_dims) > 0) {
|
||||
return(array(0, dim = c(n, sz, extra_dims)))
|
||||
} else if (length(sz) == 2) {
|
||||
return(array(0, dim = sz))
|
||||
} else {
|
||||
return(array(0, dim = c(n, sz, ...)))
|
||||
}
|
||||
}
|
||||
12
R/colon.R
12
R/colon.R
|
|
@ -1,12 +0,0 @@
|
|||
#' @title Vector creation
|
||||
#' @description Simulates the function `colon()` and its equivalent `:` operator from Matlab, which have a similar but not quite equivalent behavior when compared to `seq()` and `:` in R.
|
||||
#' @param a initial number
|
||||
#' @param b final number
|
||||
#' @export
|
||||
colon <- function(a, b) {
|
||||
if (a <= b) {
|
||||
return(a:b)
|
||||
} else {
|
||||
return(vector(mode = "numeric"))
|
||||
}
|
||||
}
|
||||
15
R/find.R
15
R/find.R
|
|
@ -1,15 +0,0 @@
|
|||
#' @title Find indices and values of nonzero elements
|
||||
#' @description Emulates behavior of `find`
|
||||
#' @param x object or logic operation on an object
|
||||
#' @param sort sort output?
|
||||
find <- function(x, sort = TRUE) {
|
||||
if (is.logical(x)) {
|
||||
out <- which(x)
|
||||
} else {
|
||||
out <- which(x > 0)
|
||||
}
|
||||
if (sort) {
|
||||
out <- sort(out)
|
||||
}
|
||||
return(out)
|
||||
}
|
||||
5
R/fix.R
5
R/fix.R
|
|
@ -1,5 +0,0 @@
|
|||
#' @title Round toward zero
|
||||
#' @description Rounds each element of input to the nearest integer towards zero. Basically the same as trunc()
|
||||
#' @param X input element
|
||||
#' @author Waldir Leoncio
|
||||
fix <- function(X) trunc(X)
|
||||
18
R/inputdlg.R
18
R/inputdlg.R
|
|
@ -1,18 +0,0 @@
|
|||
#' @title Gather user input
|
||||
#' @description Replicates the functionality of the homonymous function in Matlab (sans dialog box)
|
||||
#' @param prompt Text field with user instructions
|
||||
#' @param dims number of dimensions in the answwers
|
||||
#' @param definput default value of the input
|
||||
#' @export
|
||||
inputdlg <- function(prompt, dims = 1, definput = NULL) {
|
||||
if (!is.null(definput)) {
|
||||
prompt <- append(prompt, paste0(" (default: ", definput, ")"))
|
||||
}
|
||||
input_chr <- readline(paste0(prompt, ": "))
|
||||
if (input_chr == "") input_chr <- definput
|
||||
input_chr_or_num <- tryCatch(
|
||||
as.numeric(input_chr),
|
||||
warning = function(w) input_chr
|
||||
)
|
||||
return(input_chr_or_num)
|
||||
}
|
||||
13
R/isempty.R
13
R/isempty.R
|
|
@ -1,13 +0,0 @@
|
|||
#' @title Is Array Empty?
|
||||
#' @description Determine whether array is empty. An empty array, table, or timetable has at least one dimension with length 0, such as 0-by-0 or 0-by-5.
|
||||
#' @details Emulates the behavior of the `isempty` function on Matlab
|
||||
#' @param x array
|
||||
#'
|
||||
isempty <- function(x) {
|
||||
if (class(x)[1] %in% c("array", "matrix")) {
|
||||
dim_mat_x <- dim(x)
|
||||
} else {
|
||||
dim_mat_x <- dim(matrix(x))
|
||||
}
|
||||
return(any(dim_mat_x == 0) | is.null(dim_mat_x))
|
||||
}
|
||||
10
R/isfield.R
10
R/isfield.R
|
|
@ -1,10 +0,0 @@
|
|||
#' @title Checks if a list contains a field
|
||||
#' @description This function tries to replicate the behavior of the `isfield`
|
||||
#' function in Matlab
|
||||
#' @param x list
|
||||
#' @param field name of field
|
||||
#' @references https://se.mathworks.com/help/matlab/ref/isfield.html
|
||||
#' @export
|
||||
isfield <- function(x, field) {
|
||||
sapply(field, function(f) f %in% names(x))
|
||||
}
|
||||
11
R/isspace.R
11
R/isspace.R
|
|
@ -1,11 +0,0 @@
|
|||
#' @title Determine space characters
|
||||
#' @description Determine which characters are space characters
|
||||
#' @param A a character array or a string scalar
|
||||
#' @return a vector TF such that the elements of TF are logical 1 (true) where corresponding characters in A are space characters, and logical 0 (false) elsewhere
|
||||
#' @note Recognized whitespace characters are ` ` and `\\t`.
|
||||
#' @author Waldir Leoncio
|
||||
isspace <- function(A) {
|
||||
A_split <- unlist(strsplit(A, ""))
|
||||
TF <- A_split %in% c(" ", "\t")
|
||||
return(as.numeric(TF))
|
||||
}
|
||||
158
R/matlab2r.R
158
R/matlab2r.R
|
|
@ -1,158 +0,0 @@
|
|||
#' @title Convert Matlab function to R
|
||||
#' @description Performs basic syntax conversion from Matlab to R
|
||||
#' @param filename name of the file
|
||||
#' @param output can be "asis", "clean", "save" or "diff"
|
||||
#' @param improve_formatting if `TRUE` (default), makes minor changes
|
||||
#' to conform to best-practice formatting conventions
|
||||
#' @param change_assignment if `TRUE` (default), uses `<-` as the assignment operator
|
||||
#' @param append if `FALSE` (default), overwrites file; otherwise, append
|
||||
#' output to input
|
||||
#' @return text converted to R, printed to screen or replacing input file
|
||||
#' @author Waldir Leoncio
|
||||
#' @importFrom utils write.table
|
||||
#' @export
|
||||
#' @note This function is intended to expedite the process of converting a
|
||||
#' Matlab function to R by making common replacements. It does not have the
|
||||
#' immediate goal of outputting a ready-to-use function. In other words,
|
||||
#' after using this function you should go back to it and make minor changes.
|
||||
#'
|
||||
#' It is also advised to do a dry-run with `output = "clean"` and only switching
|
||||
#' to `output = "save"` when you are confident that no important code will be
|
||||
#' lost (for shorter functions, a careful visual inspection should suffice).
|
||||
matlab2r <- function(filename, output = "diff", improve_formatting = TRUE, change_assignment = TRUE,
|
||||
append = FALSE) {
|
||||
# TODO: this function is too long! Split into subfunctions
|
||||
# (say, by rule and/or section)
|
||||
# ======================================================== #
|
||||
# Verification #
|
||||
# ======================================================== #
|
||||
if (!file.exists(filename)) stop("File not found")
|
||||
|
||||
# ======================================================== #
|
||||
# Reading file into R #
|
||||
# ======================================================== #
|
||||
txt <- readLines(filename)
|
||||
original <- txt
|
||||
|
||||
# ======================================================== #
|
||||
# Replacing text #
|
||||
# ======================================================== #
|
||||
|
||||
# Uncommenting ------------------------------------------- #
|
||||
txt <- gsub("^#\\s?(.+)", "\\1", txt)
|
||||
|
||||
# Output variable ---------------------------------------- #
|
||||
out <- gsub(
|
||||
pattern = "\\t*function ((\\S|\\,\\s)+)\\s?=\\s?(\\w+)\\((.+)\\)",
|
||||
replacement = "\\1",
|
||||
x = txt[1]
|
||||
) # TODO: improve by detecting listed outputs
|
||||
if (substring(out, 1, 1) == "[") {
|
||||
out <- strsplit(out, "(\\,|\\[|\\]|\\s)")[[1]]
|
||||
out <- out[which(out != "")]
|
||||
out <- sapply(seq_along(out), function(x) paste(out[x], "=", out[x]))
|
||||
out <- paste0("list(", paste(out, collapse = ", "), ")")
|
||||
}
|
||||
|
||||
# Function header ---------------------------------------- #
|
||||
txt <- gsub(
|
||||
pattern = "\\t*function (.+)\\s*=\\s*(.+)\\((.+)\\)",
|
||||
replacement = "\\2 <- function(\\3) {",
|
||||
x = txt
|
||||
)
|
||||
txt <- gsub(
|
||||
pattern = "function (.+)\\((.+)\\)",
|
||||
replacement = "\\1 <- function(\\2) {",
|
||||
x = txt
|
||||
)
|
||||
|
||||
# Function body ------------------------------------------ #
|
||||
txt <- gsub("(.+)\\.\\.\\.", "\\1", txt)
|
||||
txt <- gsub(";", "", txt)
|
||||
|
||||
# Loops and if-statements
|
||||
txt <- gsub("for (.+)=(.+)", "for (\\1 in \\2) {", txt)
|
||||
txt <- gsub("end$", "}", txt)
|
||||
txt <- gsub("if (.+)", "if (\\1) {", txt) # FIXME: paste comments after {
|
||||
txt <- gsub("else$", "} else {", txt)
|
||||
txt <- gsub("elseif", "} else if", txt)
|
||||
txt <- gsub("while (.+)", "while \\1 {", txt)
|
||||
|
||||
# MATLAB-equivalent functions in R
|
||||
txt <- gsub("gamma_ln", "log_gamma", txt)
|
||||
txt <- gsub("nchoosek", "choose", txt)
|
||||
txt <- gsub("isempty", "is.null", txt)
|
||||
# txt <- gsub("(.+)\\'", "t(\\1)", txt)
|
||||
|
||||
# Subsets ------------------------------------------------ #
|
||||
ass_op <- ifelse(change_assignment, "<-", "=")
|
||||
txt <- gsub(
|
||||
pattern = "([^\\(]+)\\(([^\\(]+)\\)=(.+)",
|
||||
replacement = paste0("\\1[\\2] ", ass_op, "\\3"),
|
||||
x = txt
|
||||
)
|
||||
txt <- gsub("\\(:\\)", "[, ]", txt)
|
||||
txt <- gsub("(.+)(\\[|\\():,end(\\]|\\()", "\\1[, ncol()]", txt)
|
||||
|
||||
# Formatting --------------------------------------------- #
|
||||
if (improve_formatting) {
|
||||
txt <- gsub("(.),(\\S)", "\\1, \\2", txt)
|
||||
# Math operators
|
||||
txt <- gsub("(\\S)\\+(\\S)", "\\1 + \\2", txt)
|
||||
txt <- gsub("(\\S)\\-(\\S)", "\\1 - \\2", txt)
|
||||
txt <- gsub("(\\S)\\*(\\S)", "\\1 * \\2", txt)
|
||||
txt <- gsub("(\\S)\\/(\\S)", "\\1 / \\2", txt)
|
||||
# Logic operators
|
||||
txt <- gsub("~", "!", txt)
|
||||
txt <- gsub("(\\S)>=(\\S)", "\\1 >= \\2", txt)
|
||||
txt <- gsub("(\\S)<=(\\S)", "\\1 <= \\2", txt)
|
||||
txt <- gsub("(\\S)==(\\S)", "\\1 == \\2", txt)
|
||||
# Assignment
|
||||
txt <- gsub(
|
||||
pattern = "(\\w)(\\s?)=(\\s?)(\\w)",
|
||||
replacement = paste0("\\1 ", ass_op, " \\4"),
|
||||
x = txt
|
||||
)
|
||||
# txt <- gsub(
|
||||
# pattern = "(\\s+(.|\\_|\\[|\\])+)(\\s?)=(\\s?)(.+)",
|
||||
# replacement = paste0("\\1 ", ass_op, "\\5"),
|
||||
# x = txt
|
||||
# )
|
||||
txt <- gsub("%(\\s?)(\\w)", "# \\2", txt)
|
||||
}
|
||||
|
||||
# Adding output and end-of-file brace -------------------- #
|
||||
txt <- append(txt, paste0("\treturn(", out, ")\n}"))
|
||||
|
||||
# Returning converted code ------------------------------- #
|
||||
if (output == "asis") {
|
||||
return(txt)
|
||||
} else if (output == "clean") {
|
||||
return(cat(txt, sep = "\n"))
|
||||
} else if (output == "save") {
|
||||
return(
|
||||
write.table(
|
||||
x = txt,
|
||||
file = filename,
|
||||
quote = FALSE,
|
||||
row.names = FALSE,
|
||||
col.names = FALSE,
|
||||
append = append
|
||||
)
|
||||
)
|
||||
} else if (output == "diff") {
|
||||
diff_text <- vector(mode = "character", length = (2 * length(original) + 1))
|
||||
for (i in seq_along(txt)) {
|
||||
new_i <- (2 * i) + i - 2
|
||||
diff_text[new_i] <- paste(
|
||||
"-----------------------", "line", i, "-----------------------"
|
||||
)
|
||||
diff_text[new_i + 1] <- original[i]
|
||||
diff_text[new_i + 2] <- txt[i]
|
||||
}
|
||||
message("Displaying line number, original content and modified content")
|
||||
return(cat(diff_text, sep = "\n"))
|
||||
} else {
|
||||
stop("Invalid output argument")
|
||||
}
|
||||
}
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
#' @title Minimum (MATLAB version)
|
||||
#' @description Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
#' @param X matrix
|
||||
#' @param indices return indices?
|
||||
#' @return Either a list or a vector
|
||||
#' @author Waldir Leoncio
|
||||
min_MATLAB <- function(X, indices = TRUE) {
|
||||
if (!is(X, "matrix")) X <- as.matrix(X)
|
||||
mins <- apply(X, 2, min)
|
||||
idx <- sapply(seq_len(ncol(X)), function(x) match(mins[x], X[, x]))
|
||||
if (indices) {
|
||||
return(list(mins = mins, idx = idx))
|
||||
} else {
|
||||
return(mins)
|
||||
}
|
||||
}
|
||||
|
||||
#' @title Maximum (MATLAB version)
|
||||
#' @description Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
#' @param X matrix
|
||||
#' @param indices return indices?
|
||||
#' @return Either a list or a vector
|
||||
#' @author Waldir Leoncio
|
||||
max_MATLAB <- function(X, indices = TRUE) {
|
||||
if (!is(X, "matrix")) X <- as.matrix(X)
|
||||
maxs <- apply(X, 2, max)
|
||||
idx <- sapply(seq_len(ncol(X)), function(x) match(maxs[x], X[, x]))
|
||||
if (indices) {
|
||||
return(list(maxs = maxs, idx = idx))
|
||||
} else {
|
||||
return(maxs)
|
||||
}
|
||||
}
|
||||
10
R/nargin.R
10
R/nargin.R
|
|
@ -1,10 +0,0 @@
|
|||
#' @title Number of function input arguments
|
||||
#' @description Returns the number of arguments passed to the parent function
|
||||
#' @return An integer
|
||||
#' @author Waldir Leoncio
|
||||
#' @note This function only makes sense inside another function
|
||||
#' @references https://stackoverflow.com/q/64422780/1169233
|
||||
nargin <- function() {
|
||||
if (sys.nframe() < 2) stop("must be called from inside a function")
|
||||
length(as.list(sys.call(-1))) - 1
|
||||
}
|
||||
39
R/questdlg.R
39
R/questdlg.R
|
|
@ -1,39 +0,0 @@
|
|||
#' @title Prompt for multiple-choice
|
||||
#' @param quest Question
|
||||
#' @param dlgtitle Title of question
|
||||
#' @param btn Vector of alternatives
|
||||
#' @param defbtn Scalar with the name of the default option
|
||||
#' @param accepted_ans Vector containing accepted answers
|
||||
#' @description This function aims to loosely mimic the behavior of the
|
||||
#' questdlg function on Matlab
|
||||
#' @export
|
||||
questdlg <- function(quest,
|
||||
dlgtitle = "",
|
||||
btn = c("y", "n"),
|
||||
defbtn = "n",
|
||||
accepted_ans = c("y", "yes", "n", "no")) {
|
||||
message(dlgtitle)
|
||||
# ==========================================================================
|
||||
# Replacing the default option with a capitalized version on btn
|
||||
# ==========================================================================
|
||||
btn[match(tolower(defbtn), tolower(btn))] <- toupper(defbtn)
|
||||
# ==========================================================================
|
||||
# Creating prompt
|
||||
# ==========================================================================
|
||||
option_char <- paste0(" [", paste(btn, collapse = ", "), "]")
|
||||
answer <- readline(paste0(quest, option_char, ": "))
|
||||
# ==========================================================================
|
||||
# Processing answer
|
||||
# ==========================================================================
|
||||
answer <- tolower(answer)
|
||||
if (!(answer %in% tolower(c(btn, accepted_ans)))) {
|
||||
if (answer != "") {
|
||||
warning(
|
||||
"'", answer, "' is not a valid alternative. Defaulting to ",
|
||||
defbtn
|
||||
)
|
||||
}
|
||||
answer <- defbtn
|
||||
}
|
||||
return(answer)
|
||||
}
|
||||
10
R/rand.R
10
R/rand.R
|
|
@ -1,10 +0,0 @@
|
|||
#' @title Generate matrix with U(0, 1) trials
|
||||
#' @description Imitates the behavior of `rand()` on Matlab
|
||||
#' @param r number of rows of output matrix
|
||||
#' @param c number of columns of output matrix
|
||||
#' @return \eqn{r \times c} matrix with random trials from a standard uniform distribution.
|
||||
#' @importFrom stats runif
|
||||
#' @export
|
||||
rand <- function(r = 1, c = 1) {
|
||||
matrix(runif(r * c), r, c)
|
||||
}
|
||||
38
R/repmat.R
38
R/repmat.R
|
|
@ -1,38 +0,0 @@
|
|||
#' @title Repeat matrix
|
||||
#' @description Repeats a matrix over n columns and rows
|
||||
#' @details This function was created to replicate the behavior of a homonymous
|
||||
#' function on Matlab
|
||||
#' @param mx matrix
|
||||
#' @param n either a scalar with the number of replications in both rows and
|
||||
#' columns or a <= 3-length vector with individual repetitions.
|
||||
#' @return matrix replicated over `ncol(mx) * n` columns and `nrow(mx) * n` rows
|
||||
#' @note The Matlab implementation of this function accepts `n` with length > 2.
|
||||
#'
|
||||
#' It should also be noted that a concatenated vector in R, e.g. `c(5, 2)`, becomes a column vector when coerced to matrix, even though it may look like a row vector at first glance. This is important to keep in mind when considering the expected output of this function. Vectors in R make sense to be seen as column vectors, given R's Statistics-oriented paradigm where variables are usually disposed as columns in a dataset.
|
||||
#' @export
|
||||
repmat <- function(mx, n) {
|
||||
# Validation
|
||||
if (length(n) > 3) warning("Extra dimensions of n ignored")
|
||||
if (!is(mx, "matrix")) mx <- t(as.matrix(mx))
|
||||
if (length(n) == 1) n <- rep(n, 2)
|
||||
if (any(n == 0)) {
|
||||
n_zero <- which(n == 0)
|
||||
out_dim <- dim(mx)
|
||||
out_dim[n_zero] <- 0
|
||||
return(array(dim = out_dim))
|
||||
}
|
||||
|
||||
# Replicating cols
|
||||
out <- mx_col <- matrix(rep(mx, n[2]), nrow(mx))
|
||||
|
||||
# Replicating rows
|
||||
if (n[1] > 1) {
|
||||
for (i in seq(n[1] - 1)) out <- rbind(out, mx_col)
|
||||
}
|
||||
|
||||
# Replicating 3rd dimension
|
||||
if (!is.na(n[3]) & n[3] > 1) out <- array(out, c(dim(out), n[3]))
|
||||
|
||||
# Output
|
||||
return(unname(as.array(out)))
|
||||
}
|
||||
24
R/reshape.R
24
R/reshape.R
|
|
@ -1,24 +0,0 @@
|
|||
#' @title Reshape array
|
||||
#' @description Reshapes a matrix according to a certain number of dimensions
|
||||
#' @param A input matrix
|
||||
#' @param sz vector containing the dimensions of the output vector
|
||||
#' @details This function replicates the functionality of the `reshape()`
|
||||
#' function on Matlab. This function is basically a fancy wrapper for the
|
||||
#' `array()` function in R, but is useful because it saves the user translation
|
||||
#' time. Moreover, it introduces validation code that alter the behavior of
|
||||
#' `array()` and makes it more similar to `replicate()`.
|
||||
#' @note The Matlab function also accepts as input the dismemberment of sz as
|
||||
#' scalars.
|
||||
reshape <- function(A, sz) {
|
||||
# Validation
|
||||
if (prod(sz) != prod(dim(A))) {
|
||||
stop("To RESHAPE the number of elements must not change.")
|
||||
}
|
||||
if (length(sz) == 1) {
|
||||
stop("Size vector must have at least two elements.")
|
||||
}
|
||||
|
||||
# Reshaping A
|
||||
A <- array(A, sz)
|
||||
return(A)
|
||||
}
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
#' @title Set differences of two arrays
|
||||
#' @description Loosely replicates the behavior of the homonym Matlab function
|
||||
#' @param A first array
|
||||
#' @param B second array
|
||||
#' @param legacy if `TRUE`, preserves the behavior of the setdiff function from MATLAB R2012b and prior releases. (currently not supported)
|
||||
#' @author Waldir Leoncio
|
||||
setdiff_MATLAB <- function(A, B, legacy = FALSE) {
|
||||
if (legacy) message("legacy=TRUE not supported. Ignoring.")
|
||||
if (is(A, "numeric") & is(B, "numeric")) {
|
||||
values <- sort(unique(A[is.na(match(A, B))]))
|
||||
} else if (is(A, "data.frame") & is(B, "data.frame")) {
|
||||
C <- A
|
||||
exclude_rows <- vector()
|
||||
for (r1 in seq_len(nrow(A))) {
|
||||
for (r2 in seq_len(nrow(B))) {
|
||||
if (all(A[r1, ] == B[r2, ])) {
|
||||
exclude_rows <- append(exclude_rows, r1)
|
||||
}
|
||||
}
|
||||
}
|
||||
values <- C[-exclude_rows, ]
|
||||
}
|
||||
# TODO: add support for indices (if necessary)
|
||||
return(values)
|
||||
}
|
||||
38
R/size.R
38
R/size.R
|
|
@ -1,38 +0,0 @@
|
|||
#' @title Size of an object
|
||||
#' @description This functions tries to replicate the behavior of the base function "size" in Matlab
|
||||
#' @param x object to be evaluated
|
||||
#' @param d dimension of object to be evaluated
|
||||
#' @note On MATLAB, size(1, 100) returns 1. As a matter of fact, if the user
|
||||
#' calls for a dimension which x doesn't have `size()` always returns 1. R's
|
||||
#' default behavior is more reasonable in those cases (i.e., returning NA),
|
||||
#' but since the point of this function is to replicate MATLAB behaviors
|
||||
#' (bugs and questionable behaviors included), this function also does this.
|
||||
#' @export
|
||||
size <- function(x, d) {
|
||||
# Determining the number of dimensions
|
||||
if (all(is.na(x))) {
|
||||
if (missing(d)) {
|
||||
return(c(0, 0))
|
||||
} else {
|
||||
return(ifelse(d <= 2, 0, 1))
|
||||
}
|
||||
}
|
||||
if (length(x) == 1) {
|
||||
# x is surely a scalar
|
||||
return(1)
|
||||
} else {
|
||||
# x is a vector, a matrix or an array
|
||||
n_dim <- ifelse(is.null(dim(x)), 1, length(dim(x)))
|
||||
if (missing(d)) {
|
||||
if (n_dim == 1) {
|
||||
out <- c(1, length(x))
|
||||
} else {
|
||||
out <- dim(x)
|
||||
}
|
||||
} else {
|
||||
out <- ifelse(n_dim == 1, c(1, length(x))[d], dim(x)[d])
|
||||
if (is.na(out)) out <- 1 # for MATLAB compatibility
|
||||
}
|
||||
return(out)
|
||||
}
|
||||
}
|
||||
15
R/sortrows.R
15
R/sortrows.R
|
|
@ -1,15 +0,0 @@
|
|||
#' @title Sort rows of matrix or table
|
||||
#' @description Emulates the behavior of the `sortrows` function on Matlab
|
||||
#' @param A matrix
|
||||
#' @param column ordering column
|
||||
sortrows <- function(A, column = 1) {
|
||||
if (length(column) == 1) {
|
||||
new_row_order <- order(A[, column])
|
||||
} else if (length(column) == 2) {
|
||||
new_row_order <- order(A[, column[1]], A[, column[2]])
|
||||
} else {
|
||||
stop("Not yet implemented for 2+ tie-breakers")
|
||||
}
|
||||
A_reordered <- A[new_row_order, ]
|
||||
return(A_reordered)
|
||||
}
|
||||
15
R/squeeze.R
15
R/squeeze.R
|
|
@ -1,15 +0,0 @@
|
|||
#' @title Squeeze
|
||||
#' @description Remove dimensions of length 1
|
||||
#' @details This function implements the behavior of the homonimous function on
|
||||
#' Matlab. `B = squeeze(A)` returns an array with the same elements as the
|
||||
#' input array A, but with dimensions of length 1 removed. For example, if A is
|
||||
#' a 3-by-1-by-1-by-2 array, then squeeze(A) returns a 3-by-2 matrix. If A is a
|
||||
#' row vector, column vector, scalar, or an array with no dimensions of length
|
||||
#' 1, then squeeze returns the input A.
|
||||
#' @note This is basically a wrapper of drop() with a minor adjustment to adapt
|
||||
#' the output to what happens on Matlab
|
||||
#' @param A input or array matrix
|
||||
#' @return An array with the same elements as the input array, but with
|
||||
#' dimensions of length 1 removed.
|
||||
#' @author Waldir Leoncio
|
||||
squeeze <- function(A) as.matrix(drop(A))
|
||||
28
R/strcmp.R
28
R/strcmp.R
|
|
@ -1,28 +0,0 @@
|
|||
#' @title Compare two character elements
|
||||
#' @description Logical test if two character elements are identical
|
||||
#' @param s1 first character element (string, vector or matrix)
|
||||
#' @param s2 second character element (string, vector or matrix)
|
||||
#' @return a logical element of the same type as the input
|
||||
#' @export
|
||||
strcmp <- function(s1, s2) {
|
||||
if (length(s1) == 1 & length(s2) == 1) {
|
||||
# Both are scalars, comparison is straightforward
|
||||
return(identical(s1, s2))
|
||||
} else if (length(s1) == 1 & length(s2) > 1) {
|
||||
# s1 is a scalar and s2 is a vector or a matrix
|
||||
checks <- sapply(s2, function(s) s1 %in% s)
|
||||
if (is(s2, "matrix")) checks <- matrix(checks, nrow(s2))
|
||||
} else if (length(s1) > 1 & length(s2) == 1) {
|
||||
# s1 is a vector/matrix, s2 is a scalar
|
||||
checks <- sapply(s1, function(s) s2 %in% s)
|
||||
if (is(s1, "matrix")) checks <- matrix(checks, nrow(s1))
|
||||
} else {
|
||||
# s1 and s2 are vectors/matrices
|
||||
if (identical(dim(s1), dim(s2))) {
|
||||
checks <- as.matrix(s1 == s2)
|
||||
} else {
|
||||
stop("Inputs must be the same size or either one can be a scalar.")
|
||||
}
|
||||
}
|
||||
return(checks)
|
||||
}
|
||||
51
R/times.R
51
R/times.R
|
|
@ -1,51 +0,0 @@
|
|||
#' @title Element-wise matrix multiplication
|
||||
#' @description Emulates the `times()` and `.*` operators from Matlab.
|
||||
#' @details This function basically handles elements of different length better than the `*` operator in R, at least as far as behavior from a Matlab user is expecting.
|
||||
#' @param a first factor of the multiplication
|
||||
#' @param b second factor of the multiplication
|
||||
#' @export
|
||||
#' @returns matrix with dimensions equal to the larger of the two factors
|
||||
times <- function(a, b) {
|
||||
# Converting everything to matrix because Matlab looooooves the matrix
|
||||
a <- as.matrix(a)
|
||||
b <- as.matrix(b)
|
||||
|
||||
dominant_mx <- NULL
|
||||
if (!all(dim(a) == dim(b))) {
|
||||
if (all(dim(a) >= dim(b))) {
|
||||
dominant_mx <- a
|
||||
dominated_mx <- b
|
||||
} else if (all(dim(b) >= dim(a))) {
|
||||
dominant_mx <- b
|
||||
dominated_mx <- a
|
||||
} else {
|
||||
dominant_mx <- "neither"
|
||||
dominant_dim <- c(max(nrow(b), nrow(a)), max(ncol(b), ncol(a)))
|
||||
}
|
||||
}
|
||||
|
||||
if (is.null(dominant_mx)) {
|
||||
out <- a * b
|
||||
} else if (dominant_mx[1] == "neither") {
|
||||
a <- repmat(
|
||||
mx = a,
|
||||
n = c(dominant_dim[1] - nrow(a) + 1, dominant_dim[2] - ncol(a) + 1)
|
||||
)
|
||||
b <- repmat(
|
||||
mx = b,
|
||||
n = c(dominant_dim[1] - nrow(b) + 1, dominant_dim[2] - ncol(b) + 1)
|
||||
)
|
||||
out <- a * b
|
||||
} else {
|
||||
# Expanding dominated matrix
|
||||
dominated_mx <- repmat(
|
||||
mx = dominated_mx,
|
||||
n = c(
|
||||
nrow(dominant_mx) - nrow(dominated_mx) + 1,
|
||||
ncol(dominant_mx) - ncol(dominated_mx) + 1
|
||||
)
|
||||
)
|
||||
out <- dominant_mx * dominated_mx
|
||||
}
|
||||
return(out)
|
||||
}
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
#' @title Select a file for loading
|
||||
#' @description Loosely mimics the functionality of the `uigetfile` function on
|
||||
#' Matlab.
|
||||
#' @references https://se.mathworks.com/help/matlab/ref/uigetfile.html
|
||||
#' @param filter Filter listed files
|
||||
#' @param title Pre-prompt message
|
||||
#' @export
|
||||
uigetfile <- function(filter = "", title = "") {
|
||||
# ==========================================================================
|
||||
# Pre-prompt message
|
||||
# ==========================================================================
|
||||
message(title)
|
||||
# ==========================================================================
|
||||
# Reading file path and name
|
||||
# ==========================================================================
|
||||
filepath <- readline(
|
||||
paste0("Enter file path (leave empty for ", getwd(), "): ")
|
||||
)
|
||||
if (filepath == "") filepath <- getwd()
|
||||
# ==========================================================================
|
||||
# Presenting possible files
|
||||
# ==========================================================================
|
||||
message("Files present on that directory:")
|
||||
print(list.files(path = filepath, pattern = filter, ignore.case = TRUE))
|
||||
filename <- file.choose()
|
||||
# ==========================================================================
|
||||
# Organizing output
|
||||
# ==========================================================================
|
||||
out <- list(name = filename, path = filepath)
|
||||
return(out)
|
||||
}
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
#' @title Save file
|
||||
#' @param filter accepted file extension
|
||||
#' @param title Title
|
||||
#' @description This function intends to loosely mimic the behaviour of the
|
||||
#' homonymous Matlab function.
|
||||
#' @export
|
||||
uiputfile <- function(filter = ".rda", title = "Save file") {
|
||||
# ==========================================================================
|
||||
# Processing input
|
||||
# ==========================================================================
|
||||
message(title)
|
||||
filename <- readline(paste0("File name (end with ", filter, "): "))
|
||||
filepath <- readline(paste0("File path (leave empty for ", getwd(), "): "))
|
||||
if (filename == "") filename <- 0
|
||||
if (filepath == "") filepath <- getwd()
|
||||
# ==========================================================================
|
||||
# Processing output
|
||||
# ==========================================================================
|
||||
out <- list(name = filename, path = filepath)
|
||||
return(out)
|
||||
}
|
||||
|
|
@ -1,50 +0,0 @@
|
|||
#' @title Matrix of zeros or ones
|
||||
#' @description Generates a square or rectangular matrix of zeros or ones
|
||||
#' @param n scalar or 2D vector
|
||||
#' @param x value to fill matrix with
|
||||
#' @return n-by-n matrix filled with `x`
|
||||
#' @details This is a wrapper function to replicate the behavior of the
|
||||
#' `zeros()` and the `ones()` functions on Matlab
|
||||
#' @note Actually works for any `x`, but there's no need to bother imposing
|
||||
#' validation controls here.
|
||||
zeros_or_ones <- function(n, x) {
|
||||
# Expanding n to length 2 if necessary
|
||||
if (length(n) == 1) n <- c(n, n)
|
||||
|
||||
# Returning a matrix or an array
|
||||
if (length(n) == 2) {
|
||||
return(matrix(x, n[1], n[2]))
|
||||
} else {
|
||||
return(array(x, dim = n))
|
||||
}
|
||||
}
|
||||
|
||||
#' @title Matrix of zeros
|
||||
#' @description wrapper of `zeros_or_ones()` that replicates the behavior of
|
||||
#' the `zeros()` function on Matlab
|
||||
#' @param n1 number of rows
|
||||
#' @param n2 number of columns
|
||||
#' @param ... extra dimensions
|
||||
zeros <- function(n1, n2 = n1, ...) {
|
||||
if (length(n1) == 1) {
|
||||
n <- c(n1, n2, ...)
|
||||
} else {
|
||||
n <- n1
|
||||
}
|
||||
return(zeros_or_ones(n, 0))
|
||||
}
|
||||
|
||||
#' @title Matrix of ones
|
||||
#' @description wrapper of `zeros_or_ones()` that replicates the behavior of
|
||||
#' the `ones()` function on Matlab
|
||||
#' @param n1 number of rows
|
||||
#' @param n2 number of columns
|
||||
#' @param ... extra dimensions
|
||||
ones <- function(n1, n2 = n1, ...) {
|
||||
if (length(n1) == 1) {
|
||||
n <- c(n1, n2, ...)
|
||||
} else {
|
||||
n <- n1
|
||||
}
|
||||
return(zeros_or_ones(n, 1))
|
||||
}
|
||||
|
|
@ -1,245 +0,0 @@
|
|||
context("Basic Matlab functions")
|
||||
|
||||
test_that("rand works properly", {
|
||||
expect_equal(dim(rand()), c(1, 1))
|
||||
expect_equal(dim(rand(1, 2)), c(1, 2))
|
||||
expect_equal(dim(rand(3, 2)), c(3, 2))
|
||||
})
|
||||
|
||||
test_that("repmat works properly", {
|
||||
mx0 <- c(1:4) # when converted to matrix, results in a column vector
|
||||
mx1 <- matrix(5:8)
|
||||
mx2 <- matrix(0:-3, 2)
|
||||
expect_error(repmat(mx0))
|
||||
expect_equal(repmat(mx0, 1), t(as.matrix(mx0)))
|
||||
expect_equal(
|
||||
object = repmat(mx0, 2),
|
||||
expected = unname(cbind(rbind(mx0, mx0), rbind(mx0, mx0)))
|
||||
)
|
||||
expect_equal(
|
||||
object = repmat(mx1, 2),
|
||||
expected = unname(cbind(rbind(mx1, mx1), rbind(mx1, mx1)))
|
||||
)
|
||||
expect_equal(
|
||||
object = repmat(mx2, c(2, 3)),
|
||||
expected = cbind(rbind(mx2, mx2), rbind(mx2, mx2), rbind(mx2, mx2))
|
||||
)
|
||||
expect_equal(
|
||||
object = repmat(mx2, c(4, 1)),
|
||||
expected = rbind(mx2, mx2, mx2, mx2)
|
||||
)
|
||||
expect_equal(
|
||||
object = repmat(mx2, c(1, 1, 2)),
|
||||
expected = array(mx2, c(2, 2, 2))
|
||||
)
|
||||
expect_equal(repmat(1:2, 3), matrix(rep(1:2, 9), 3, 6, byrow = TRUE))
|
||||
expect_equal(repmat(10, c(3, 2)), matrix(10, 3, 2))
|
||||
})
|
||||
|
||||
test_that("zeros and ones work as expected", {
|
||||
expect_equal(zeros(1), matrix(0, 1))
|
||||
expect_equal(zeros(2), matrix(0, 2, 2))
|
||||
expect_equal(zeros(2, 1), matrix(0, 2, 1))
|
||||
expect_equal(zeros(1, 10), matrix(0, 1, 10))
|
||||
expect_equal(zeros(3, 2, 4), array(0, c(3, 2, 4)))
|
||||
expect_equal(ones(8), matrix(1, 8, 8))
|
||||
expect_equal(ones(5, 2), matrix(1, 5, 2))
|
||||
expect_equal(ones(2, 100), matrix(1, 2, 100))
|
||||
expect_equal(ones(3, 2, 4, 2), array(1, c(3, 2, 4, 2)))
|
||||
})
|
||||
|
||||
test_that("times works as expected", {
|
||||
expect_equal(times(9, 6), as.matrix(54))
|
||||
expect_equal(times(9, c(.8, 9)), as.matrix(c(7.2, 81)))
|
||||
expect_equal(times(c(.8, 9), 5), as.matrix(c(4, 45)))
|
||||
expect_equal(times(matrix(1:4, 2), 5), matrix(c(5, 10, 15, 20), 2))
|
||||
expect_equal(times(5, matrix(1:4, 2)), matrix(c(5, 10, 15, 20), 2))
|
||||
expect_equal(times(matrix(1:4, 2), c(10, 3)), matrix(c(10, 6, 30, 12), 2))
|
||||
expect_equal(
|
||||
object = times(matrix(1:4, 2), matrix(c(10, 3), 1)),
|
||||
expected = matrix(c(10, 20, 9, 12), 2)
|
||||
)
|
||||
expect_equal(times(c(10, 3), matrix(1:4, 2)), matrix(c(10, 6, 30, 12), 2))
|
||||
expect_equal(
|
||||
object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)),
|
||||
expected = matrix(c(10, -10, 9, 36), 2)
|
||||
)
|
||||
expect_equal(
|
||||
object = times(matrix(c(-1.6, 5), 1), c(8, 1)),
|
||||
expected = matrix(c(-12.8, -1.6, 40, 5), 2)
|
||||
)
|
||||
})
|
||||
|
||||
test_that("colon works as expected (hee hee)", {
|
||||
expect_equal(colon(1, 4), 1:4)
|
||||
expect_length(colon(4, 1), 0)
|
||||
})
|
||||
|
||||
test_that("size works as on MATLAB", {
|
||||
sk <- 10
|
||||
vk <- 1:4
|
||||
mx <- matrix(1:6, 2)
|
||||
ra <- array(1:24, c(2, 3, 4))
|
||||
expect_equal(size(sk), 1)
|
||||
expect_equal(size(vk), c(1, 4))
|
||||
expect_equal(size(mx), c(2, 3))
|
||||
expect_equal(size(ra), c(2, 3, 4))
|
||||
expect_equal(size(sk, 199), 1)
|
||||
expect_equal(size(vk, 199), 1)
|
||||
expect_equal(size(mx, 199), 1)
|
||||
expect_equal(size(ra, 199), 1)
|
||||
expect_equal(size(vk, 2), 4)
|
||||
expect_equal(size(mx, 2), 3)
|
||||
expect_equal(size(ra, 2), 3)
|
||||
expect_equal(size(ra, 3), 4)
|
||||
})
|
||||
|
||||
test_that("reshape reshapes properly", {
|
||||
mx <- matrix(1:4, 2)
|
||||
ra <- array(1:12, c(2, 3, 2))
|
||||
expect_equal(reshape(mx, c(1, 4)), matrix(1:4, 1))
|
||||
expect_equal(reshape(mx, c(2, 2)), mx)
|
||||
expect_equal(reshape(mx, c(1, 1, 4)), array(mx, c(1, 1, 4)))
|
||||
expect_error(reshape(mx, c(1, 2, 3)))
|
||||
expect_error(reshape(ra, c(1, 2, 3)))
|
||||
expect_equal(reshape(ra, c(3, 2, 2)), array(ra, c(3, 2, 2)))
|
||||
})
|
||||
|
||||
test_that("isfield works as on Matlab", {
|
||||
S <- list()
|
||||
S$x <- rnorm(100)
|
||||
S$y <- sin(S$x)
|
||||
S$title <- "y = sin(x)"
|
||||
expect_true(isfield(S, "title"))
|
||||
expect_equivalent(
|
||||
object = isfield(S, c("x", "y", "z", "title", "error")),
|
||||
expected = c(TRUE, TRUE, FALSE, TRUE, FALSE)
|
||||
)
|
||||
})
|
||||
|
||||
test_that("strcmp works as expected", {
|
||||
yes <- "Yes"
|
||||
no <- "No"
|
||||
ja <- "Yes"
|
||||
expect_false(strcmp(yes, no))
|
||||
expect_true(strcmp(yes, ja))
|
||||
s1 <- "upon"
|
||||
s2 <- matrix(c("Once", "upon", "a", "time"), 2, byrow = TRUE)
|
||||
s3 <- c("Once", "upon", "a", "time")
|
||||
s4 <- matrix(c("A", "bc", "def", "G"), 2, byrow = TRUE)
|
||||
s5 <- matrix(c("B", "c", "def", "G"), 2, byrow = TRUE)
|
||||
expect_equal(strcmp(s1, s2), matrix(c(FALSE, FALSE, TRUE, FALSE), 2))
|
||||
expect_equivalent(strcmp(s1, s3), c(FALSE, TRUE, FALSE, FALSE))
|
||||
expect_error(strcmp(s2, s3))
|
||||
expect_equal(strcmp(s4, s5), matrix(c(FALSE, TRUE, FALSE, TRUE), 2))
|
||||
})
|
||||
|
||||
test_that("isempty works as expected", {
|
||||
A <- array(dim = c(0, 2, 2))
|
||||
B <- matrix(rep(NA, 4), 2)
|
||||
C <- matrix(rep(0, 4), 2)
|
||||
cat1 <- as.factor(c(NA, NA))
|
||||
cat2 <- factor()
|
||||
str1 <- matrix(rep("", 3))
|
||||
expect_true(isempty(A))
|
||||
expect_false(isempty(B))
|
||||
expect_false(isempty(C))
|
||||
expect_false(isempty(cat1))
|
||||
expect_true(isempty(cat2))
|
||||
expect_false(isempty(str1))
|
||||
})
|
||||
|
||||
test_that("find works as expected", {
|
||||
X <- matrix(c(1, 0, 2, 0, 1, 1, 0, 0, 4), 3, byrow = TRUE)
|
||||
Y <- seq(1, 19, 2)
|
||||
expect_equal(find(X), c(1, 5, 7, 8, 9))
|
||||
expect_equal(find(!X), c(2, 3, 4, 6))
|
||||
expect_equal(find(Y == 13), 7)
|
||||
})
|
||||
|
||||
test_that("sortrows works as expected", {
|
||||
mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
|
||||
expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
|
||||
expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
|
||||
expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
|
||||
})
|
||||
|
||||
test_that("cell works as expected", {
|
||||
expect_equivalent(cell(0), array(0, dim = c(0, 0)))
|
||||
expect_equivalent(cell(1), array(0, dim = c(1, 1)))
|
||||
expect_equivalent(cell(2), array(0, dim = c(2, 2)))
|
||||
expect_equivalent(cell(3, 4), array(0, dim = c(3, 4)))
|
||||
expect_equivalent(cell(5, 7, 6), array(0, dim = c(5, 7, 6)))
|
||||
})
|
||||
|
||||
test_that("blanks works as expected", {
|
||||
expect_warning(blanks(-1))
|
||||
expect_equal(suppressWarnings(blanks(-1)), "")
|
||||
expect_equal(blanks(0), "")
|
||||
expect_equal(blanks(1), " ")
|
||||
expect_equal(blanks(10), " ")
|
||||
})
|
||||
|
||||
test_that("squeeze works as expected", {
|
||||
A <- array(dim = c(2, 1, 2))
|
||||
A[, , 1] <- c(1, 2)
|
||||
A[, , 2] <- c(3, 4)
|
||||
expect_equal(squeeze(A), matrix(1:4, 2))
|
||||
A <- array(0, dim = c(1, 1, 3))
|
||||
A[, , 1:3] <- 1:3
|
||||
expect_equal(squeeze(A), matrix(1:3, 3))
|
||||
})
|
||||
|
||||
test_that("fix works as expected", {
|
||||
X <- matrix(c(-1.9, -3.4, 1.6, 2.5, -4.5, 4.5), 3, byrow = TRUE)
|
||||
Y <- matrix(c(-1, -3, 1, 2, -4, 4), 3, byrow = TRUE)
|
||||
expect_identical(fix(X), Y)
|
||||
})
|
||||
|
||||
test_that("isspace works as expected", {
|
||||
chr <- "123 Main St."
|
||||
X <- "\t a b\tcde f"
|
||||
expect_identical(isspace(chr), c(0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0))
|
||||
expect_identical(isspace(X), c(1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0))
|
||||
})
|
||||
|
||||
test_that("nargin works correctly", {
|
||||
addme <- function(a, b) {
|
||||
if (nargin() == 2) {
|
||||
c <- a + b
|
||||
} else if (nargin() == 1) {
|
||||
c <- a + a
|
||||
} else {
|
||||
c <- 0
|
||||
}
|
||||
return(c)
|
||||
}
|
||||
expect_equal(addme(13, 42), 55)
|
||||
expect_equal(addme(13), 26)
|
||||
expect_equal(addme(), 0)
|
||||
})
|
||||
|
||||
test_that("setdiff works as expected", {
|
||||
A <- c(3, 6, 2, 1, 5, 1, 1)
|
||||
B <- c(2, 4, 6)
|
||||
C <- c(1, 3, 5)
|
||||
expect_equal(setdiff_MATLAB(A, B), C)
|
||||
A <- data.frame(
|
||||
Var1 = 1:5,
|
||||
Var2 = LETTERS[1:5],
|
||||
Var3 = c(FALSE, TRUE, FALSE, TRUE, FALSE)
|
||||
)
|
||||
B <- data.frame(
|
||||
Var1 = seq(1, 9, by = 2),
|
||||
Var2 = LETTERS[seq(1, 9, by = 2)],
|
||||
Var3 = rep(FALSE, 5)
|
||||
)
|
||||
C <- data.frame(
|
||||
Var1 = c(2, 4),
|
||||
Var2 = c("B", "D"),
|
||||
Var3 = c(TRUE, TRUE)
|
||||
)
|
||||
row.names(C) <- c(2L, 4L)
|
||||
expect_equal(setdiff_MATLAB(A, B), C) # TODO: implement for data frames
|
||||
# TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1
|
||||
})
|
||||
Loading…
Add table
Reference in a new issue