From c340ba3952e25cd0872f88371f404f5d06689382 Mon Sep 17 00:00:00 2001 From: Martin Ueding Date: Fri, 21 Aug 2020 17:12:59 +0200 Subject: [PATCH 1/4] Add test for two elements --- tests/testthat/test_tex_catwitherror.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test_tex_catwitherror.R b/tests/testthat/test_tex_catwitherror.R index 26c0c89c5..70f473140 100644 --- a/tests/testthat/test_tex_catwitherror.R +++ b/tests/testthat/test_tex_catwitherror.R @@ -75,3 +75,13 @@ test_that('vector', { tex.catwitherror(c(x, dx), digits = 4)) } }) + + +test_that('vectorized_two_elements', { + val <- runif(2) + err <- runif(2) + + str_apply <- mapply(function (v, e) tex.catwitherror(v, e), val, err) + str_vec <- tex.catwitherror(val, err) + expect_equal(str_apply, str_vec) +}) \ No newline at end of file From 4d45cc42bfb34d75649912d87b0f5f5df14b6b9b Mon Sep 17 00:00:00 2001 From: Martin Ueding Date: Fri, 21 Aug 2020 17:14:42 +0200 Subject: [PATCH 2/4] Check for missing dx first --- R/tex-utils.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/tex-utils.R b/R/tex-utils.R index 6495d7350..4c2c80762 100644 --- a/R/tex-utils.R +++ b/R/tex-utils.R @@ -38,13 +38,14 @@ tex.catwitherror <- function(x, dx, digits=1, with.dollar=TRUE, with.cdot=TRUE, if(missing(x) || length(x) == 0) { stop("x must be a numeric vector with length > 0") } - if(length(x) == 2){ + + if (!missing(dx)) { + have.error <- TRUE + } else if (length(x) == 2) { dx <- x[2] x <- x[1] have.error <- TRUE - }else if(!missing(dx)){ - have.error <- TRUE - }else{ + } else { have.error <- FALSE } From 1e013c92e7b49eb9457b7c423eaa90696e491904 Mon Sep 17 00:00:00 2001 From: Martin Ueding Date: Fri, 21 Aug 2020 17:30:44 +0200 Subject: [PATCH 3/4] Fully vectorize the function --- R/tex-utils.R | 53 +++++++++++++++----------- tests/testthat/test_tex_catwitherror.R | 9 +++++ 2 files changed, 40 insertions(+), 22 deletions(-) diff --git a/R/tex-utils.R b/R/tex-utils.R index 4c2c80762..5ab6e2377 100644 --- a/R/tex-utils.R +++ b/R/tex-utils.R @@ -48,34 +48,43 @@ tex.catwitherror <- function(x, dx, digits=1, with.dollar=TRUE, with.cdot=TRUE, } else { have.error <- FALSE } + + tmp <- character(length(x)) - if(!have.error){ + if (!have.error) { ## just a number without error - tmp <- formatC(x, digits=digits, ...) + tmp <- sapply(x, formatC, digits = digits, ...) } - else if(is.numeric(dx) && dx == 0){ - tmp <- formatC(x, digits=digits, ...) - if(grepl("e", tmp, fixed=TRUE)){ - tmp <- sub("e", "(0)e", tmp) - }else{ - tmp <- paste0(tmp, "(0)") + else { + zero_error <- is.numeric(dx) & dx == 0 + if (any(zero_error)) { + tmp[zero_error] <- formatC(x[zero_error], digits = digits, ...) + tmp[zero_error] <- ifelse( + grepl("e", tmp[zero_error], fixed = TRUE), + sub("e", "(0)e", tmp[zero_error]), + paste0(tmp[zero_error], "(0)")) } - } - else{ - if(requireNamespace('errors')){ - tmp <- format(errors::set_errors(x, dx), digits=digits, ...) - }else{ - warning("The `errors`-package is not installed. The output of `tex.catwitherror` might not be as you want it.") - tmp <- formatC(x, digits=digits, ...) - tmp <- paste0(tmp, " +- ", formatC(dx, digits=digits, ...)) + if (any(!zero_error)) { + if (requireNamespace('errors')) { + tmp[!zero_error] <- + format(errors::set_errors(x[!zero_error], dx[!zero_error]), digits = digits, ...) + } else{ + warning( + "The `errors`-package is not installed. The output of `tex.catwitherror` might not be as you want it." + ) + tmp[!zero_error] <- + formatC(x[!zero_error], digits = digits, ...) + tmp[!zero_error] <- + paste0(tmp[!zero_error], " +- ", formatC(dx[!zero_error], digits = digits, ...)) + } } - } + } - if(with.cdot){ - if(grepl("e", tmp, fixed=TRUE)){ - tmp <- sub("e", "\\\\cdot 10^{", tmp) - tmp <- paste0(tmp, "}") - } + if (with.cdot) { + tmp <- ifelse( + grepl("e", tmp, fixed = TRUE), + paste0(sub("e", "\\\\cdot 10^{", tmp), "}"), + tmp) tmp <- sub("+-", "\\\\pm", tmp, fixed=TRUE) } if (with.dollar) { diff --git a/tests/testthat/test_tex_catwitherror.R b/tests/testthat/test_tex_catwitherror.R index 70f473140..cc57c8445 100644 --- a/tests/testthat/test_tex_catwitherror.R +++ b/tests/testthat/test_tex_catwitherror.R @@ -81,6 +81,15 @@ test_that('vectorized_two_elements', { val <- runif(2) err <- runif(2) + str_apply <- mapply(function (v, e) tex.catwitherror(v, e), val, err) + str_vec <- tex.catwitherror(val, err) + expect_equal(str_apply, str_vec) +}) + +test_that('vectorized_with_zero_error', { + val <- runif(20) + err <- c(runif(10), rep(0.0, 10)) + str_apply <- mapply(function (v, e) tex.catwitherror(v, e), val, err) str_vec <- tex.catwitherror(val, err) expect_equal(str_apply, str_vec) From bcca2c6ac9ef2886174a536ca0392dcd41e93a3a Mon Sep 17 00:00:00 2001 From: Martin Ueding Date: Fri, 21 Aug 2020 17:31:16 +0200 Subject: [PATCH 4/4] Check for order of elements --- tests/testthat/test_tex_catwitherror.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/testthat/test_tex_catwitherror.R b/tests/testthat/test_tex_catwitherror.R index cc57c8445..764e15939 100644 --- a/tests/testthat/test_tex_catwitherror.R +++ b/tests/testthat/test_tex_catwitherror.R @@ -90,6 +90,15 @@ test_that('vectorized_with_zero_error', { val <- runif(20) err <- c(runif(10), rep(0.0, 10)) + str_apply <- mapply(function (v, e) tex.catwitherror(v, e), val, err) + str_vec <- tex.catwitherror(val, err) + expect_equal(str_apply, str_vec) +}) + +test_that('vectorized_with_zero_error_at_front', { + val <- runif(20) + err <- c(rep(0.0, 10), runif(10)) + str_apply <- mapply(function (v, e) tex.catwitherror(v, e), val, err) str_vec <- tex.catwitherror(val, err) expect_equal(str_apply, str_vec)