From d11926e79db00d8aac59cb4e78b51b42b4ad95e8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Todor=20Kondi=C4=87?= <kontrapunkt@uclmail.net>
Date: Sat, 4 Mar 2023 16:50:15 +0100
Subject: [PATCH] Functions get_fname_slug and uniqy_slugs generate keys based
on filenames.
---
R/base.R | 23 +++++++++++++++++++++++
R/shiny-state.R | 8 ++++----
tests/testthat/test-base.R | 18 ++++++++++++++++++
3 files changed, 45 insertions(+), 4 deletions(-)
create mode 100644 tests/testthat/test-base.R
diff --git a/R/base.R b/R/base.R
index 1ac7e90..320d6b6 100644
--- a/R/base.R
+++ b/R/base.R
@@ -120,3 +120,26 @@ gen_1d_keytab <- function(dt) {
eval(bquote(s[,`:=`(key1d=.(ex)),by=key(s)]))
}
+
+gen_fname_slug <- function(fname) {
+ ## Generates a name with blanks replaced with underscores and
+ ## extensions removed.
+
+ ## Drop path.
+ name = basename(fname)
+
+ ## Remove extension if any.
+ name = gsub(r"(\.[^.]*$)","",name)
+
+ ## Spaces into underscores.
+ name = gsub("[[:blank:]]+","_",name)
+
+ ## Reduce the number of underscores.
+ name = gsub(r"(_+)","_",name)
+ name
+}
+
+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
+}
diff --git a/R/shiny-state.R b/R/shiny-state.R
index efef88c..826f5bc 100644
--- a/R/shiny-state.R
+++ b/R/shiny-state.R
@@ -455,11 +455,11 @@ app_state2state <- function(input,gui,envopts,m=NULL) {
get_sets <- function(gui) {
## TODO FIXME
## Think about this
- fn_lists <- file.path(gui$paths$project,gui$compounds$lists)
+ ## fn_lists <- file.path(gui$paths$project,gui$compounds$lists)
- df <- fread(file=fn_lists)
- if (!
- res = df[,unique(set)]
+ ## df <- fread(file=fn_lists)
+ ## if (!
+ ## res = df[,unique(set)]
if (length(res)==0L) res = "ALL"
}
diff --git a/tests/testthat/test-base.R b/tests/testthat/test-base.R
new file mode 100644
index 0000000..ca5eb16
--- /dev/null
+++ b/tests/testthat/test-base.R
@@ -0,0 +1,18 @@
+test_that("gen_fname_slug",{
+
+ r1 = gen_fname_slug("file_name.csv")
+ expect_true(r1=="file_name")
+ r2 = gen_fname_slug(".file.name.csv")
+ expect_true(r2==".file.name")
+ r3 = gen_fname_slug("file name with blanks.x.y.csv")
+ expect_true(r3=="file_name_with_blanks.x.y")
+ r3 = gen_fname_slug("file name____with blanks____x.y.csv")
+ expect_true(r3=="file_name_with_blanks_x.y")
+})
+
+test_that("uniqy_slugs",{
+ inp = c('f1','f2','f2','f2','f3','f4','f4','f5','f3','f6')
+ out = uniqy_slugs(inp)
+ message(paste(out,coll=','))
+ expect_true(1==1)
+})
--
GitLab