diff XSeekerPreparator.R @ 20:ce94e7a141bb draft default tip

" master branch Updating"
author lain
date Tue, 06 Dec 2022 10:18:10 +0000
parents 2937e72e5891
children
line wrap: on
line diff
--- a/XSeekerPreparator.R	Tue Oct 18 12:57:28 2022 +0000
+++ b/XSeekerPreparator.R	Tue Dec 06 10:18:10 2022 +0000
@@ -198,7 +198,7 @@
 search_tree <- function(path, target) {
     target <- tolower(target)
     for (file in list.files(path)) {
-        if (is.dir(file)) {
+        if (fs::is.dir(file)) {
             result <- search_tree(file.path(path, file), target)
             if (!is.null(result)) {
                 return(result)
@@ -400,12 +400,10 @@
 
 guess_translator <- function(header) {
     result <- list(
-        # HMDB_ID = NULL,
         mz = NULL,
         name = NULL,
         common_name = NULL,
-        formula = NULL,
-        # inchi_key = NULL
+        formula = NULL
     )
     asked_cols <- names(result)
     for (asked_col in asked_cols) {
@@ -471,12 +469,12 @@
         process_sample_list(
             orm, rdata, samples,
             show_percent = show_percent,
-            file_grouping_var = options$class
+            file_grouping_var = options$class,
+            options = options
         )
         NULL
     }, error = function(e) {
-        message(e)
-        e
+        return(e)
     })
     if (!is.null(mzml_tmp_dir)) {
         unlink(mzml_tmp_dir, recursive = TRUE)
@@ -484,6 +482,7 @@
     if (!is.null(error)) {
         stop(error)
     }
+    return(!is.null(error))
 }
 
 gather_mzml_files <- function(rdata) {
@@ -510,7 +509,8 @@
     rdata,
     sample_names,
     show_percent,
-    file_grouping_var = NULL
+    file_grouping_var = NULL,
+    options = list()
 ) {
     if (is.null(file_grouping_var)) {
         file_grouping_var <- find_grouping_var(rdata$variableMetadata)
@@ -587,19 +587,6 @@
 
     message("Parameters from previous processes extracted.")
 
-
-    indices <- as.numeric(unique(var_meta[, file_grouping_var]))
-    if (any(is.null(names(singlefile)[indices]))) {
-        stop(sprintf(
-            paste(
-                "Indices defined by grouping variable %s are not all present",
-                "in singlefile names (%s).\nCannot continue. Indices: %s"
-            ),
-            file_grouping_var,
-            paste(names(singlefile), collapse = ", "),
-            paste(indices, collapse = ", ")
-        ))
-    }
     smol_xcms_set <- orm$smol_xcms_set()
     mz_tab_info <- new.env()
     g <- xcms::groups(xcms_set)
@@ -623,7 +610,7 @@
     smol_xcms_set_id <- smol_xcms_set$get_id()
     rm(smol_xcms_set)
 
-    for (no in indices) {
+    for (no in seq_along(names(singlefile))) {
         sample_name <- names(singlefile)[[no]]
         sample_path <- singlefile[[no]]
         if (
@@ -760,7 +747,6 @@
     field_names <- as.list(names(orm$feature()$fields__))
     field_names[field_names == "id"] <- NULL
 
-    features <- list()
     dummy_feature <- orm$feature()
 
     if (show_percent <- context$show_percent) {
@@ -772,7 +758,10 @@
 
         rows <- rows[1:as.integer(FAST_FEATURE_RATIO / 100.0 * length(rows))]
     }
-    cluster_row <- list()
+    # features <- list()
+    features <- as.list(rows) ## allocate all memory before processing
+    # cluster_row <- list()
+    cluster_row <- as.list(rows) ## allocate all memory before processing
     for (row in rows) {
         if (show_percent && (row / total) * 100 > percent) {
             percent <- percent + 1
@@ -843,7 +832,8 @@
             next_align_group
         )
         next_align_group <- next_align_group + 1
-        features[[length(features) + 1]] <- as.list(dummy_feature, field_names)
+        features[[row]] <- as.list(dummy_feature, field_names)
+        # features[[length(features) + 1]] <- as.list(dummy_feature, field_names)
         dummy_feature$clear()
     }
     rm(var_meta)
@@ -963,6 +953,7 @@
     }
     cluster$save()
     feature$set_cluster(cluster)
+    feature$save()
     return(cluster)
 }
 
@@ -1064,6 +1055,12 @@
         help = "Display this tool's version and exits"
     ),
     optparse::make_option(
+        c("-V", "--verbose"),
+        action = "store_true",
+        help = "Does more verbose outputs",
+        default = FALSE
+    ),
+    optparse::make_option(
         c("-i", "--input"),
         type = "character",
         help = "The rdata path to import in XSeeker"
@@ -1161,6 +1158,18 @@
 
 load(args$options$input, rdata <- new.env())
 
-process_rdata(orm, rdata, args$options)
+args$options$verbose <- (
+    if (args$options$verbose) {
+        message("Verbose outputs.")
+        \(...) {
+            message(sprintf(...))
+        }
+    } else {
+        \(...) {
+        }
+    }
+)
+
+err_code <- process_rdata(orm, rdata, args$options)
 
 quit(status = err_code)