From b4d33bbe00bf52e7dd817c2c85663f0d375a186b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Sun, 9 Apr 2023 08:39:53 +0200
Subject: [PATCH] Function `gen_val_unc' now represents errors with
uncertanties.
---
R/base.R | 20 ++++++++++++++++++++
tests/testthat/test-base.R | 11 +++++++++++
2 files changed, 31 insertions(+)
diff --git a/R/base.R b/R/base.R
index 11bef74..74da45d 100644
--- a/R/base.R
+++ b/R/base.R
@@ -149,3 +149,23 @@ uniqy_slugs <- function(slugs) {
dt = data.table::data.table(slug=slugs)
dt[,slug:=fifelse(rep(.N==1L,.N),slug,paste0(slug,"_",seq(1L,.N))),by="slug"]$slug
}
+
+gen_val_unc <- function(x,dx) {
+ ## Doesn't work well for <=0.
+ p = floor(log10(x))
+ dp = floor(log10(dx))
+ ## Zero?
+ message("p ",p)
+ w = which(is.infinite(p))
+ p[w] = 0
+
+ ## Normalise x and dx.
+ main = x/10**p
+ unc = round(dx/10**dp,0)
+ place = p - dp
+ main = mapply(function (m,d) formatC(m,digits=d,format='f',flag="#"),main,place,USE.NAMES=F)
+ w = which(main=='10.')
+ main[w]='1'
+ p[w]=p[w]+1
+ paste0(main,"(",unc,") x 10^",p)
+}
diff --git a/tests/testthat/test-base.R b/tests/testthat/test-base.R
index 87905dd..47f86a6 100644
--- a/tests/testthat/test-base.R
+++ b/tests/testthat/test-base.R
@@ -15,3 +15,14 @@ test_that("uniqy_slugs",{
out = uniqy_slugs(inp)
expect_snapshot(out)
})
+
+test_that("gen_val_unc",{
+ vals = c(1234567,991458,256.236546546,0.2,0.002,0)
+ dvals = c(6733,123000,1.e-4,0.5,0.0001,0.001)
+ x = gen_val_unc(vals,dvals)
+ message("\n")
+ message("====")
+ message(paste0(x,collapse=";;"))
+ print("----")
+ expect_true(1==1)
+})
--
GitLab