From 411772217305fd56fb0910592a166bc20a890750 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Sun, 21 Sep 2025 08:54:05 -0400 Subject: [PATCH 1/7] Read sources from a dataset, not attrs --- R/ModelArray_Constructor.R | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/R/ModelArray_Constructor.R b/R/ModelArray_Constructor.R index 7b92c99..d52f6fd 100644 --- a/R/ModelArray_Constructor.R +++ b/R/ModelArray_Constructor.R @@ -191,8 +191,37 @@ ModelArray <- function(filepath, type = NA ) %>% DelayedArray::DelayedArray() - # load attribute "column_names", i.e. source filenames: - sources[[x]] <- rhdf5::h5readAttributes(filepath, name = sprintf("scalars/%s/values", scalar_types[x]))$column_names %>% as.character() + # load source filenames (column_names): prefer attribute; fallback to dataset + attrs <- rhdf5::h5readAttributes(filepath, name = sprintf("scalars/%s/values", scalar_types[x])) + colnames_attr <- attrs$column_names + if (is.null(colnames_attr)) { + # Fallback: read from dataset scalars//column_names + dataset_path <- sprintf("scalars/%s/column_names", scalar_types[x]) + colnames_ds <- tryCatch( + { + rhdf5::h5read(filepath, dataset_path) + }, + error = function(e) { + stop(paste0( + "Neither attribute 'column_names' nor dataset '", dataset_path, "' found or readable: ", + conditionMessage(e) + )) + } + ) + # Ensure character vector, not list/matrix; trim potential null terminators and whitespace + if (is.list(colnames_ds)) { + colnames_ds <- unlist(colnames_ds, use.names = FALSE) + } + colnames_ds <- as.vector(colnames_ds) + colnames_ds <- as.character(colnames_ds) + # Trim any trailing NULs (hex 00) and surrounding whitespace for cross-language string compatibility + # Use escaped hex in pattern to avoid embedding a NUL in the source code + colnames_ds <- gsub("[\\x00]+$", "", colnames_ds, perl = TRUE, useBytes = TRUE) + colnames_ds <- trimws(colnames_ds) + sources[[x]] <- colnames_ds + } else { + sources[[x]] <- as.character(colnames_attr) + } # transpose scalar_data[[x]] if needed: if (dim(scalar_data[[x]])[2] == length(sources[[x]])) { From f736b49218f7c6055a15405849e7db88b1f52ca9 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Tue, 23 Sep 2025 14:46:49 -0400 Subject: [PATCH 2/7] update --- R/ModelArray_Constructor.R | 59 +++++++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 17 deletions(-) diff --git a/R/ModelArray_Constructor.R b/R/ModelArray_Constructor.R index d52f6fd..6ee80a4 100644 --- a/R/ModelArray_Constructor.R +++ b/R/ModelArray_Constructor.R @@ -165,7 +165,7 @@ ModelArraySeed <- function(filepath, name, type = NA) { #' @importFrom rhdf5 h5readAttributes ModelArray <- function(filepath, scalar_types = c("FD"), - analysis_names = c("myAnalysis")) { + analysis_names = character(0)) { # TODO: try and use hdf5r instead of rhdf5 and delayedarray here # fn.h5 <- H5File$new(filepath, mode="a") # open; "a": creates a new file or opens an existing one for read/write @@ -195,19 +195,39 @@ ModelArray <- function(filepath, attrs <- rhdf5::h5readAttributes(filepath, name = sprintf("scalars/%s/values", scalar_types[x])) colnames_attr <- attrs$column_names if (is.null(colnames_attr)) { - # Fallback: read from dataset scalars//column_names - dataset_path <- sprintf("scalars/%s/column_names", scalar_types[x]) - colnames_ds <- tryCatch( - { - rhdf5::h5read(filepath, dataset_path) - }, - error = function(e) { - stop(paste0( - "Neither attribute 'column_names' nor dataset '", dataset_path, "' found or readable: ", - conditionMessage(e) - )) - } + # Fallback: attempt to read from dataset-based column names + # Try multiple plausible locations for compatibility across writers + paths_to_try <- c( + sprintf("scalars/%s/column_names", scalar_types[x]), + sprintf("scalars/%s/values/column_names", scalar_types[x]), + sprintf("scalars/scalars/%s/values/column_names", scalar_types[x]), + sprintf("scalars/scalars/%s/column_names", scalar_types[x]) ) + + colnames_ds <- NULL + last_error <- NULL + for (p in paths_to_try) { + tmp <- tryCatch( + { + rhdf5::h5read(filepath, p) + }, + error = function(e) { + last_error <<- e + NULL + } + ) + if (!is.null(tmp)) { + colnames_ds <- tmp + break + } + } + if (is.null(colnames_ds)) { + stop(paste0( + "Neither attribute 'column_names' nor a dataset with column names found. Tried: ", + paste(paths_to_try, collapse = ", "), + if (!is.null(last_error)) paste0(". Last error: ", conditionMessage(last_error)) else "" + )) + } # Ensure character vector, not list/matrix; trim potential null terminators and whitespace if (is.list(colnames_ds)) { colnames_ds <- unlist(colnames_ds, use.names = FALSE) @@ -249,12 +269,16 @@ ModelArray <- function(filepath, ## results: - # first, we need to check if results group exists in this .h5 file - flag_results_exist <- flagResultsGroupExistInh5(filepath) - # message(flag_results_exist) - if (flag_results_exist == FALSE) { + if (length(analysis_names) == 0) { + # user did not request any analyses; do not touch /results results_data <- list() } else { + # user requested analyses; check if results group exists in this .h5 file + flag_results_exist <- flagResultsGroupExistInh5(filepath) + # message(flag_results_exist) + if (flag_results_exist == FALSE) { + results_data <- list() + } else { # results group exist --> to load subfolders results_data <- vector("list", length(analysis_names)) @@ -334,6 +358,7 @@ ModelArray <- function(filepath, # would look like: $, instead of $$results_matrix } } + } } From 8afdf803ea53b3bb9d3c3a4fa77a4ce121206f35 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Tue, 23 Sep 2025 17:57:03 -0400 Subject: [PATCH 3/7] Add apptainer.def --- Apptainer.def | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 Apptainer.def diff --git a/Apptainer.def b/Apptainer.def new file mode 100644 index 0000000..ffb4922 --- /dev/null +++ b/Apptainer.def @@ -0,0 +1,42 @@ +Bootstrap: docker +From: rocker/r2u:jammy + +%help + ModelArray - an R package for statistical analysis of fixel-wise data and beyond + +%labels + org.label-schema.name "modelarray_confixel" + org.label-schema.description "ModelArray - an R package for statistical analysis of fixel-wise data and beyond" + org.label-schema.url "https://pennlinc.github.io/ModelArray/" + org.label-schema.vcs-url "https://github.com/PennLINC/ModelArray" + org.label-schema.schema-version "1.0" + +%environment + export DEBIAN_FRONTEND=noninteractive + +%post + set -e + apt-get update \ + && apt-get install -y --no-install-recommends \ + r-cran-devtools \ + r-bioc-rhdf5 \ + r-bioc-delayedarray \ + && apt-get clean \ + && rm -rf /var/lib/apt/lists/* + + cd /ModelArray + R -e 'devtools::install()' + +%files + . /ModelArray + +%runscript + echo "ModelArray container" + echo "R version: $(R --version | head -n 1)" + if [ $# -gt 0 ]; then + exec "$@" + else + exec R + fi + + From 2d031b88851586d95f23840244ac93a14e675155 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Tue, 23 Sep 2025 18:14:39 -0400 Subject: [PATCH 4/7] install more deps through r2u --- Apptainer.def | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/Apptainer.def b/Apptainer.def index ffb4922..d93a330 100644 --- a/Apptainer.def +++ b/Apptainer.def @@ -18,11 +18,27 @@ From: rocker/r2u:jammy set -e apt-get update \ && apt-get install -y --no-install-recommends \ + r-bioc-delayedarray \ + r-bioc-hdf5array \ + r-cran-broom \ + r-cran-crayon \ r-cran-devtools \ + r-cran-doparallel \ + r-cran-dplyr \ + r-cran-glue \ + r-cran-gratia \ + r-cran-hdf5r \ + r-cran-hdf5r.extra \ + r-cran-magrittr \ + r-cran-mgcv \ + r-cran-pbapply \ + r-cran-pbmcapply \ r-bioc-rhdf5 \ - r-bioc-delayedarray \ + r-cran-tibble \ + r-cran-tidyr \ && apt-get clean \ && rm -rf /var/lib/apt/lists/* + && echo 'options(bspm.sudo = TRUE)' >> /etc/R/Rprofile.site cd /ModelArray R -e 'devtools::install()' From bd65dac4a3a3f208c62bdbba1384986e1e024920 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Tue, 23 Sep 2025 18:55:50 -0400 Subject: [PATCH 5/7] update --- .Rbuildignore | 1 + Apptainer.def | 3 ++- DESCRIPTION | 26 +++++++++---------- NAMESPACE | 1 + R/ModelArray_Constructor.R | 3 ++- R/ModelArray_S4Methods.R | 14 +++++++++- man/ModelArray.Rd | 7 ++--- man/ModelArray.gam.Rd | 4 +++ man/ModelArray.lm.Rd | 4 +++ man/ModelArray.wrap.Rd | 4 +++ man/analyseOneElement.gam.Rd | 4 +++ man/analyseOneElement.lm.Rd | 4 +++ ...lArray-method.Rd => exampleElementData.Rd} | 13 +++++++++- 13 files changed, 68 insertions(+), 20 deletions(-) rename man/{exampleElementData-ModelArray-method.Rd => exampleElementData.Rd} (80%) diff --git a/.Rbuildignore b/.Rbuildignore index 6aca555..fd65249 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,4 +13,5 @@ ^LICENSE\.md$ ^CLONE\.md$ ^Dockerfile$ +^Apptainer\.def$ ^README\.Rmd$ diff --git a/Apptainer.def b/Apptainer.def index d93a330..44a6d06 100644 --- a/Apptainer.def +++ b/Apptainer.def @@ -36,9 +36,10 @@ From: rocker/r2u:jammy r-bioc-rhdf5 \ r-cran-tibble \ r-cran-tidyr \ + r-cran-tidyverse \ && apt-get clean \ + && echo 'options(bspm.sudo = TRUE)' >> /etc/R/Rprofile.site \ && rm -rf /var/lib/apt/lists/* - && echo 'options(bspm.sudo = TRUE)' >> /etc/R/Rprofile.site cd /ModelArray R -e 'devtools::install()' diff --git a/DESCRIPTION b/DESCRIPTION index 9b997e1..e4cc7cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,24 +22,24 @@ LazyData: true Depends: R (>= 4.1.2) biocViews: Imports: - magrittr, - methods, + DelayedArray, + HDF5Array, + broom, + crayon, + doParallel, dplyr, - tidyr, - tibble, glue, - parallel, - doParallel, - HDF5Array, - rhdf5, hdf5r, + magrittr, + methods, mgcv, - rlang, - DelayedArray, - broom, - pbmcapply, + parallel, pbapply, - crayon + pbmcapply, + rhdf5, + rlang, + tibble, + tidyr RoxygenNote: 7.3.1 Suggests: rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index e6d5bf3..c88d5ea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ export(ModelArray.wrap) export(analyseOneElement.gam) export(analyseOneElement.lm) export(analyseOneElement.wrap) +export(exampleElementData) export(gen_gamFormula_contIx) export(gen_gamFormula_fxSmooth) export(numElementsTotal) diff --git a/R/ModelArray_Constructor.R b/R/ModelArray_Constructor.R index 6ee80a4..b7d4b07 100644 --- a/R/ModelArray_Constructor.R +++ b/R/ModelArray_Constructor.R @@ -156,7 +156,8 @@ ModelArraySeed <- function(filepath, name, type = NA) { #' #' @param filepath file #' @param scalar_types expected scalars -#' @param analysis_names the subfolder names for results in .h5 file +#' @param analysis_names the subfolder names for results in .h5 file. If empty +#' (default), results are not read. #' @return ModelArray object #' @export #' @import methods diff --git a/R/ModelArray_S4Methods.R b/R/ModelArray_S4Methods.R index b95e478..5292069 100644 --- a/R/ModelArray_S4Methods.R +++ b/R/ModelArray_S4Methods.R @@ -114,10 +114,22 @@ setMethod( ### Example per-element data helper ##### -#' @aliases exampleElementData +#' Example per-element data.frame for user functions +#' +#' @title Example per-element data.frame for user functions +#' @name exampleElementData +#' @rdname exampleElementData +#' @description +#' Generic for constructing a per-element data.frame from a `ModelArray`. +#' See the `ModelArray` method for details. +#' +#' @param x A `ModelArray` object (or compatible type) +#' @param ... Additional arguments (ignored) +#' @export setGeneric("exampleElementData", function(x, ...) standardGeneric("exampleElementData")) #' Example per-element data.frame for user functions +#' @rdname exampleElementData #' #' @description #' Returns a copy of `phenotypes` with an extra column named by `scalar` populated diff --git a/man/ModelArray.Rd b/man/ModelArray.Rd index 3a5414e..defb99a 100644 --- a/man/ModelArray.Rd +++ b/man/ModelArray.Rd @@ -4,16 +4,17 @@ \alias{ModelArray} \title{An S4 class to represent element-wise scalar data and statistics.} \usage{ -ModelArray(filepath, scalar_types = c("FD"), analysis_names = c("myAnalysis")) +ModelArray(filepath, scalar_types = c("FD"), analysis_names = character(0)) -ModelArray(filepath, scalar_types = c("FD"), analysis_names = c("myAnalysis")) +ModelArray(filepath, scalar_types = c("FD"), analysis_names = character(0)) } \arguments{ \item{filepath}{file} \item{scalar_types}{expected scalars} -\item{analysis_names}{the subfolder names for results in .h5 file} +\item{analysis_names}{the subfolder names for results in .h5 file. If empty +(default), results are not read.} } \value{ ModelArray object diff --git a/man/ModelArray.gam.Rd b/man/ModelArray.gam.Rd index 5aba0f2..a12481d 100644 --- a/man/ModelArray.gam.Rd +++ b/man/ModelArray.gam.Rd @@ -93,6 +93,10 @@ Default is 0.2.} \item{n_cores}{Positive integer, The number of CPU cores to run with} +\item{on_error}{Character: one of "stop", "skip", or "debug". When an error occurs +while fitting an element, choose whether to stop, skip returning all-NaN values for +that element, or drop into `browser()` (if interactive) then skip. Default: "stop".} + \item{...}{Additional arguments for `mgcv::gam()`} } \value{ diff --git a/man/ModelArray.lm.Rd b/man/ModelArray.lm.Rd index 1c24ac4..0ff64e6 100644 --- a/man/ModelArray.lm.Rd +++ b/man/ModelArray.lm.Rd @@ -79,6 +79,10 @@ Default is 0.2.} \item{n_cores}{Positive integer, The number of CPU cores to run with} +\item{on_error}{Character: one of "stop", "skip", or "debug". When an error occurs +while fitting an element, choose whether to stop, skip returning all-NaN values for +that element, or drop into `browser()` (if interactive) then skip. Default: "stop".} + \item{...}{Additional arguments for `stats::lm()`} } \value{ diff --git a/man/ModelArray.wrap.Rd b/man/ModelArray.wrap.Rd index 046cfb6..044c352 100644 --- a/man/ModelArray.wrap.Rd +++ b/man/ModelArray.wrap.Rd @@ -42,6 +42,10 @@ It must match `sources(data)[[scalar]]` order and contents (reordered if needed) \item{n_cores}{Positive integer number of CPU cores} +\item{on_error}{Character: one of "stop", "skip", or "debug". When an error occurs in +the user function for an element, choose whether to stop, skip returning all-NaN values +for that element, or drop into `browser()` (if interactive) then skip. Default: "stop".} + \item{...}{Additional arguments forwarded to `FUN`} } \value{ diff --git a/man/analyseOneElement.gam.Rd b/man/analyseOneElement.gam.Rd index a5ea013..7dd5329 100644 --- a/man/analyseOneElement.gam.Rd +++ b/man/analyseOneElement.gam.Rd @@ -60,6 +60,10 @@ if FALSE, it will return the list of requested statistic values.} \item{flag_sse}{TRUE or FALSE, Whether to calculate SSE (sum of squared error) for the model (`model.sse`). SSE is needed for calculating partial R-squared.} +\item{on_error}{Character: one of "stop", "skip", or "debug". When an error occurs while +fitting one element, choose whether to stop, skip returning all-NaN values for that element, +or drop into `browser()` (if interactive) then skip. Default: "stop".} + \item{...}{Additional arguments for `mgcv::gam()`} } \value{ diff --git a/man/analyseOneElement.lm.Rd b/man/analyseOneElement.lm.Rd index d673936..52987a4 100644 --- a/man/analyseOneElement.lm.Rd +++ b/man/analyseOneElement.lm.Rd @@ -51,6 +51,10 @@ This is required when flag_initiate = TRUE.} If TRUE, it will return column names etc to be used for initiating data.frame; if FALSE, it will return the list of requested statistic values.} +\item{on_error}{Character: one of "stop", "skip", or "debug". When an error occurs while +fitting one element, choose whether to stop, skip returning all-NaN values for that element, +or drop into `browser()` (if interactive) then skip. Default: "stop".} + \item{...}{Additional arguments for `stats::lm()`} } \value{ diff --git a/man/exampleElementData-ModelArray-method.Rd b/man/exampleElementData.Rd similarity index 80% rename from man/exampleElementData-ModelArray-method.Rd rename to man/exampleElementData.Rd index 92e072b..1699b25 100644 --- a/man/exampleElementData-ModelArray-method.Rd +++ b/man/exampleElementData.Rd @@ -1,14 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ModelArray_S4Methods.R -\name{exampleElementData,ModelArray-method} +\name{exampleElementData} +\alias{exampleElementData} \alias{exampleElementData,ModelArray-method} \title{Example per-element data.frame for user functions} \usage{ +exampleElementData(x, ...) + \S4method{exampleElementData}{ModelArray}(x, scalar = "FD", i_element = 1L, phenotypes) } \arguments{ \item{x}{An ModelArray object} +\item{...}{Additional arguments (ignored)} + \item{scalar}{A character. The name of the element-wise scalar to append} \item{i_element}{An integer, the i_th element (1-based)} @@ -19,10 +24,16 @@ A data.frame with the additional response column named by `scalar` } \description{ +Generic for constructing a per-element data.frame from a `ModelArray`. +See the `ModelArray` method for details. + Returns a copy of `phenotypes` with an extra column named by `scalar` populated with the selected element's values from the `ModelArray`. This mirrors the per-element data that `ModelArray.wrap` passes to user functions (`data = dat`). } +\details{ +Example per-element data.frame for user functions +} \examples{ \dontrun{ h5_path <- system.file("extdata", "n50_fixels.h5", package = "ModelArray") From b628eee3f1149088c802e7ddf43095dd82197df9 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Wed, 24 Sep 2025 16:16:44 -0400 Subject: [PATCH 6/7] more pbar tries --- R/analyse.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/analyse.R b/R/analyse.R index 9e3e204..8aadd01 100644 --- a/R/analyse.R +++ b/R/analyse.R @@ -1491,11 +1491,19 @@ ModelArray.wrap <- function(FUN, data, phenotypes, scalar, element.subset = NULL if (verbose) message(glue::glue("looping across elements....")) + # Ensure progress bars show in non-interactive sessions when requested + if (pbar) { + old_pb_opts <- pbapply::pboptions() + pbapply::pboptions(type = "txt") + on.exit(pbapply::pboptions(old_pb_opts), add = TRUE) + } + if (n_cores > 1) { if (pbar) { fits <- pbmcapply::pbmclapply(element.subset, analyseOneElement.wrap, mc.cores = n_cores, + ignore.interactive = TRUE, user_fun = FUN, modelarray = data, phenotypes = phenotypes, scalar = scalar, num.subj.lthr = num.subj.lthr, num.stat.output = num.stat.output, flag_initiate = FALSE, on_error = on_error, From b5afe885da4027411779fdb1166d4ef84763b9e9 Mon Sep 17 00:00:00 2001 From: mattcieslak Date: Wed, 24 Sep 2025 16:54:53 -0400 Subject: [PATCH 7/7] lint --- R/ModelArray_Constructor.R | 136 ++++++++++++++++++------------------- 1 file changed, 68 insertions(+), 68 deletions(-) diff --git a/R/ModelArray_Constructor.R b/R/ModelArray_Constructor.R index b7d4b07..774e47c 100644 --- a/R/ModelArray_Constructor.R +++ b/R/ModelArray_Constructor.R @@ -280,86 +280,86 @@ ModelArray <- function(filepath, if (flag_results_exist == FALSE) { results_data <- list() } else { - # results group exist --> to load subfolders - results_data <- vector("list", length(analysis_names)) - - for (x in seq_along(analysis_names)) { - analysis_name <- analysis_names[x] + # results group exist --> to load subfolders + results_data <- vector("list", length(analysis_names)) + + for (x in seq_along(analysis_names)) { + analysis_name <- analysis_names[x] + + # we need to check if this subfolder exists in this .h5 file: + flag_analysis_exist <- flagAnalysisExistInh5(filepath, analysis_name = analysis_name) + if (flag_analysis_exist == FALSE) { + stop(paste0("This analysis: ", analysis_name, " does not exist...")) + } else { + # exists + # /results//has_names: + names_results_matrix <- rhdf5::h5readAttributes(filepath, + name = sprintf("results/%s/results_matrix", analysis_name) + )$colnames # after updating writeResults() + + # names_results_matrix <- ModelArraySeed(filepath, name = sprintf( + # "results/%s/has_names", analysis_name), type = NA) %>% + # DelayedArray::DelayedArray() + # if (dim(names_results_matrix)[1]/results_matrix: + results_data[[x]]$results_matrix <- ModelArraySeed( + filepath, + name = sprintf("results/%s/results_matrix", analysis_name), + type = NA + ) %>% DelayedArray::DelayedArray() - # we need to check if this subfolder exists in this .h5 file: - flag_analysis_exist <- flagAnalysisExistInh5(filepath, analysis_name = analysis_name) - if (flag_analysis_exist == FALSE) { - stop(paste0("This analysis: ", analysis_name, " does not exist...")) - } else { - # exists - # /results//has_names: - names_results_matrix <- rhdf5::h5readAttributes(filepath, - name = sprintf("results/%s/results_matrix", analysis_name) - )$colnames # after updating writeResults() - - # names_results_matrix <- ModelArraySeed(filepath, name = sprintf( - # "results/%s/has_names", analysis_name), type = NA) %>% - # DelayedArray::DelayedArray() - # if (dim(names_results_matrix)[1]/results_matrix: - results_data[[x]]$results_matrix <- ModelArraySeed( - filepath, - name = sprintf("results/%s/results_matrix", analysis_name), - type = NA - ) %>% DelayedArray::DelayedArray() - - if (dim(results_data[[x]]$results_matrix)[2] != length(names_results_matrix)) { - # transpose if needed - results_data[[x]]$results_matrix <- t(results_data[[x]]$results_matrix) - } + if (dim(results_data[[x]]$results_matrix)[2] != length(names_results_matrix)) { + # transpose if needed + results_data[[x]]$results_matrix <- t(results_data[[x]]$results_matrix) + } - colnames(results_data[[x]]$results_matrix) <- as.character(DelayedArray::realize(names_results_matrix)) # designate the column names + colnames(results_data[[x]]$results_matrix) <- as.character(DelayedArray::realize(names_results_matrix)) # designate the column names - # /results//lut_col?: # LOOP OVER # OF COL OF $RESULTS_MATRIX, AND SEE IF THERE IS LUT_COL - for (i_col in seq_along(names_results_matrix)) { - object_name <- paste0("lut_forcol", as.character(i_col)) - flag_lut_exist <- flagObjectExistInh5( - filepath, - group_name = paste0("/results/", analysis_name), - object_name = object_name - ) - if (flag_lut_exist == TRUE) { - lut <- ModelArraySeed( + # /results//lut_col?: # LOOP OVER # OF COL OF $RESULTS_MATRIX, AND SEE IF THERE IS LUT_COL + for (i_col in seq_along(names_results_matrix)) { + object_name <- paste0("lut_forcol", as.character(i_col)) + flag_lut_exist <- flagObjectExistInh5( filepath, - name = paste0("results/", analysis_name, "/", object_name), - type = NA - ) %>% DelayedArray::DelayedArray() - - # results_data[[x]]$lut[[i_col]] <- lut - - # turn values in results_matrix into factors | - # HOWEVER, this also makes the entire $results_matrix into type "character".... - lut <- lut %>% as.character() - for (j_lut in seq_along(lut)) { - str_lut <- lut[j_lut] - idx_list <- results_data[[x]]$results_matrix[, i_col] %in% c(j_lut) - results_data[[x]]$results_matrix[idx_list, i_col] <- lut[j_lut] + group_name = paste0("/results/", analysis_name), + object_name = object_name + ) + if (flag_lut_exist == TRUE) { + lut <- ModelArraySeed( + filepath, + name = paste0("results/", analysis_name, "/", object_name), + type = NA + ) %>% DelayedArray::DelayedArray() + + # results_data[[x]]$lut[[i_col]] <- lut + + # turn values in results_matrix into factors | + # HOWEVER, this also makes the entire $results_matrix into type "character".... + lut <- lut %>% as.character() + for (j_lut in seq_along(lut)) { + str_lut <- lut[j_lut] + idx_list <- results_data[[x]]$results_matrix[, i_col] %in% c(j_lut) + results_data[[x]]$results_matrix[idx_list, i_col] <- lut[j_lut] + } + + # } else { # the lut for this column does not exist + # results_data[[x]]$lut[[i_col]] <- NULL } - - # } else { # the lut for this column does not exist - # results_data[[x]]$lut[[i_col]] <- NULL } - } - # name the analysis: - names(results_data)[[x]] <- analysis_name + # name the analysis: + names(results_data)[[x]] <- analysis_name - # NOTES: - # if there is no "$lut", we can remove "$results_matrix", so that results(ModelArray) - # would look like: $, instead of $$results_matrix + # NOTES: + # if there is no "$lut", we can remove "$results_matrix", so that results(ModelArray) + # would look like: $, instead of $$results_matrix + } } } - } }