Functions get_fname_slug and uniqy_slugs generate keys based on filenames.

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
+}

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"
 }
 

tests/testthat/test-base.R

+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)
+})