Skip to content

Commit

Permalink
improve cbind arg name deparsing
Browse files Browse the repository at this point in the history
  • Loading branch information
Enchufa2 committed Jan 19, 2025
1 parent da91301 commit 923beaa
Show file tree
Hide file tree
Showing 4 changed files with 26 additions and 9 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: quantities
Type: Package
Title: Quantity Calculus for R Vectors
Version: 0.2.3
Version: 0.2.3.1
Authors@R: c(
person("Iñaki", "Ucar", email="[email protected]",
role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550")))
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
# quantities devel

- Improve `cbind` arg name deparsing.

# quantities 0.2.3

- Fixes for `covar` and `correl` implementations.
Expand Down
9 changes: 1 addition & 8 deletions R/misc.R
Original file line number Diff line number Diff line change
Expand Up @@ -152,17 +152,10 @@ t.quantities <- function(x) reclass(NextMethod())
#'
#' @export
cbind.quantities <- function(..., deparse.level = 1) {
dots <- list(...)
dots <- .deparse(list(...), substitute(list(...)), deparse.level)
stopifnot(all(sapply(dots, inherits, "units")))
u <- units(dots[[1]])
dots <- lapply(dots, set_units, u, mode="standard")

nm <- names(as.list(match.call()))
nm <- nm[nm != "" & nm != "deparse.level"]
if (is.null(nm))
names(dots) <- sapply(substitute(list(...))[-1], deparse)
else names(dots) <- nm

call <- as.character(match.call()[[1]])
assign(call, getS3method(call, "errors"))
value <- do.call(call, c(dots, deparse.level=deparse.level))
Expand Down
20 changes: 20 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,3 +10,23 @@ dfapply <- function(X, FUN, ...) {
attributes(X) <- attrs
X
}

.deparse <- function(dots, symarg, deparse.level) {
deparse.level <- as.integer(deparse.level)
if (identical(deparse.level, -1L)) deparse.level <- 0L # R Core's hack
stopifnot(0 <= deparse.level, deparse.level <= 2)

nm <- c( ## 0:
function(i) NULL,
## 1:
function(i) if(is.symbol(s <- symarg[[i]])) deparse(s) else NULL,
## 2:
function(i) deparse(symarg[[i]])[[1L]])[[ 1L + deparse.level ]]
Nms <- function(i) { if(!is.null(s <- names(symarg)[i]) && nzchar(s)) s else nm(i) }

symarg <- as.list(symarg)[-1L]
dnames <- sapply(seq_along(dots), Nms)
if (!all(sapply(dnames, is.null)))
names(dots) <- dnames
dots
}

0 comments on commit 923beaa

Please sign in to comment.