Merge pull request #29 from slamballais/fix_filenames

0.8.4: added file_out_tree

Author: slamballais

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(formula,vw_fastlm)
 S3method(hist,vw)
 S3method(nobs,vw_fastlm)
 S3method(print,vw)
@@ -15,6 +14,7 @@ export(fbm_row_is_0)
 export(fbm_row_mean)
 export(fbm_row_sd)
 export(fbm_row_sum)
+export(formula.vw_fastlm)
 export(freeview)
 export(imp2list)
 export(load.annot)

NEWS.md

@@ -4,6 +4,9 @@
 * Fixed that the model output files (p.mgh, t.mgh, etc) also contained the mcz threshold (e.g. cache.th30).
 * Lots of comments removed/modified, and code was cleaned up a bit
 
+## Minor Tweaks
+* Added the `file_out_tree` argument, which controls whether output files also contain the full project name. By default, it is the inverse of `dir_out_tree`.
+
 # QDECR 0.8.3
 
 ## Minor tweaks

R/qdecr.R

@@ -43,6 +43,7 @@ qdecr <- function(id,
                   dir_tmp = dir_out,
                   dir_out,
                   dir_out_tree = TRUE,
+                  file_out_tree = !dir_out_tree, 
                   clean_up = TRUE,
                   clean_up_bm = TRUE,
                   clobber = FALSE,
@@ -72,7 +73,7 @@ qdecr <- function(id,
   measure <- match.arg(measure)
   hemi <- match.arg(hemi)
   model <- match.arg(model)
-  
+
   # Check margs
   if (is.null(margs)) stop("`margs` is not defined, so no model can be run.")
   margs <- if (model == "default") qdecr_setnames(margs, deparse(margs[[1]])) else qdecr_setnames(margs, model)
@@ -88,7 +89,7 @@ qdecr <- function(id,
   md <- imp2list(data)
 
   # Assemble and check input arguments
-  vw$input <- qdecr_check(id, md, margs, hemi, vertex, measure, model, target, project, dir_out_tree, clobber, fwhm, n_cores, prep_fun)
+  vw$input <- qdecr_check(id, md, margs, hemi, vertex, measure, model, target, project, dir_out_tree, clobber, fwhm, n_cores, prep_fun, file_out_tree)
   vw$mask <- qdecr_check_mask(mask, mask_path)
   vw$paths <- check_paths(vw, dir_tmp, dir_subj, dir_out, dir_fshome, mask_path)
   mcz_thr <- check_mcz_thr(mcz_thr)
@@ -168,13 +169,13 @@ qdecr <- function(id,
   # Run clusterwise and move all files to the right directory
   for ( i in seq_along(vw$stack$names)){
     message2("\n", verbose = verbose)
-    run_mri_surf_cluster(vw$paths$final_path, vw$paths$dir_fshome, vw$input$hemi, vw$stack$p[[i]], vw$post$fwhm_est, 
-                      mask_path = vw$paths$final_mask_path, verbose = verbose, mcz_thr = mcz_thr, cwp_thr = cwp_thr,
+    run_mri_surf_cluster(vw, vw$stack$p[[i]], vw$post$fwhm_est, mask_path = vw$paths$final_mask_path, 
+                      verbose = verbose, mcz_thr = mcz_thr, cwp_thr = cwp_thr,
                       stack = i, stack_name = vw$stack$names[i])
   }
   vw$post$final_mask <- load.mgh(vw$paths$final_mask_path)$x
 
-    catprompt("Calculating vertex-wise values", verbose = verbose)
+  catprompt("Calculating vertex-wise values", verbose = verbose)
 
   # Do FBM-calculations for plotting histograms and such
   vw$post$mgh_description <- list()

R/qdecr_check.R

@@ -12,7 +12,8 @@ qdecr_check_backing <- function(backing, clobber){
 }
 
 qdecr_check <- function(id, md, margs, hemi, vertex, measure, model, target,
-                        project, dir_out_tree, clobber, fwhm, n_cores, prep_fun){
+                        project, dir_out_tree, clobber, fwhm, n_cores, prep_fun,
+                        file_out_tree){
 
   # verify that id is correct and exists within data
   check_id(id, md)
@@ -42,6 +43,7 @@ qdecr_check <- function(id, md, margs, hemi, vertex, measure, model, target,
   input[["project"]] <- project
   input[["project2"]] <- paste(hemi, project, measure, sep = ".")
   input[["dir_out_tree"]] <- dir_out_tree
+  input[["file_out_tree"]] <- file_out_tree
   input[["clobber"]] <- clobber
   input[["fwhm"]] <- fwhm
   input[["fwhmc"]] <- paste0("fwhm", fwhm)
@@ -143,7 +145,7 @@ check_id <- function(id, md){
 }
 
 check_mcz_thr <- function(mcz_thr) {
-  if (!is.numeric) stop("`mcz_thr` is not numeric.")
+  if (!is.numeric(mcz_thr)) stop("`mcz_thr` is not numeric.")
   if (mcz_thr %in% c(13, 1.3, 0.05)) 13 else 
     if (mcz_thr %in% c(20, 2.0, 0.01)) 20 else 
       if (mcz_thr %in% c(23, 2.3, 0.005)) 23 else 
@@ -158,7 +160,10 @@ check_paths <- function(vw, dir_tmp, dir_subj, dir_out, dir_fshome, mask_path){
  dir_out2 <- check_dir_out(dir_out, vw$input$project, vw$input$project2, vw$input$dir_out_tree, vw$input$clobber)
  if (is.null(dir_fshome) || dir_fshome == "") stop("dir_fshome is not specified. Please set the global variable FREESURFER_HOME.")
 
- final_path <- file.path(dir_out2, vw$input$project2)
+ final_path <- paste0(dir_out2, "/")
+ if (vw$input$file_out_tree) final_path <- paste0(final_path, vw$input$project2)
+ dat <- if (vw$input$file_out_tree) ".fwhm.dat" else "fwhm.dat"
+ finalmask <- if (vw$input$file_out_tree) ".finalMask.mgh" else "finalMask.mgh"
  dir_tmp2 <- file.path(dir_tmp, vw$input$project2)
  backing_mgh <- paste0(dir_tmp2, "_mgh_backend")
 
@@ -172,8 +177,8 @@ check_paths <- function(vw, dir_tmp, dir_subj, dir_out, dir_fshome, mask_path){
  paths[["backing_mgh"]] <- backing_mgh
  paths[["mask_path"]] <- mask_path
  paths[["final_path"]] <- final_path
- paths[["est_fwhm_path"]] <- paste0(final_path, ".fwhm.dat")
- paths[["final_mask_path"]] <- paste0(final_path, ".finalMask.mgh")
+ paths[["est_fwhm_path"]] <- paste0(final_path, dat)
+ paths[["final_mask_path"]] <- paste0(final_path, finalmask)
  paths[] <- lapply(paths, sub, pattern = "//", replacement = "/", fixed = TRUE)
  paths[] <- lapply(paths, sub, pattern = "/$", replacement = "")
  paths

R/qdecr_fastlm.R

@@ -18,6 +18,7 @@
 #' @param dir_fshome Freesurfer directory; defaults to FREESURFER_HOME
 #' @param dir_tmp directory to store the temporary big matrices; useful for shared memory; defaults to `dir_out`
 #' @param dir_out_tree if TRUE, creates a dir_out/project directory. If FALSE, all output is placed directory into dir_out
+#' @param file_out_tree if TRUE, adds the full project name to the output file names. By default it is the inverse of dir_out_tree
 #' @param clean_up_bm if TRUE, cleans all big matrices (.bk) that were generated in dir_tmp
 #' @param clean_up NOT IMPLEMENTED; will be used for setting cleaning of other files
 #' @param clobber if TRUE, ignores already existing directories and writes over them; if FALSE, stops and warns user that a given directory already exists
@@ -49,6 +50,7 @@ qdecr_fastlm <- function(formula,
                          dir_fshome = Sys.getenv("FREESURFER_HOME"),
                          dir_tmp = dir_out,
                          dir_out_tree = TRUE,
+                         file_out_tree = !dir_out_tree,
                          clean_up_bm = TRUE,
                          clean_up = TRUE,
                          clobber = FALSE,
@@ -74,7 +76,7 @@ if (sum(qt %in% rt) > 1) stop("qdecr currently cannot handle multiple vertex-wis
 qid <- rt %in% qt
 if (sum(terms[qid, ]) > 1) stop("qdecr currently cannot handle interactions or combinations of the vertex terms.")
 qqt <- rt[qid]
-qqt2 <- sub("qdecr_", "", qqt)
+measure <- sub("qdecr_", "", qqt)
 ff <- as.formula(deparse(formula))
 margs <- c(qdecr_decon(RcppEigen::fastLm()), list(formula = ff, data = data, method = 2))
 vw <- qdecr(id = id,
@@ -85,7 +87,7 @@ vw <- qdecr(id = id,
             fwhm = fwhm,
             mcz_thr = mcz_thr,
             cwp_thr = cwp_thr,
-            measure = qqt2,
+            measure = measure,
             mgh = mgh,
             mask = mask,
             mask_path = mask_path,
@@ -96,6 +98,7 @@ vw <- qdecr(id = id,
             dir_subj = dir_subj,
             dir_fshome = dir_fshome,
             dir_out_tree = dir_out_tree,
+            file_out_tree = file_out_tree,
             clean_up = clean_up,
             clean_up_bm = clean_up_bm,
             clobber = clobber,

R/qdecr_make_stack.R

@@ -9,7 +9,9 @@ qdecr_make_stack <- function(vw, stats, mcz_thr, clusterfiles = c("cluster.mgh",
     for (n in nn1) stack[[n]] <- list()
     for(i in seq_along(stack$names)){
       for (j in seq_along(nn1)){
-        stack[[nn1[j]]][[stack$names[i]]] <- paste0(vw$paths$final_path, ".stack", i, ".", nn2[j])
+        temp <- paste0("stack", i, ".", nn2[j])
+        fp <- vw$paths$final_path 
+        stack[[nn1[j]]][[stack$names[i]]] <- if(!vw$input$file_out_tree) file.path(fp, temp) else paste(fp, temp, sep = ".")
       }
     }
     stack

R/qdecr_post.R

@@ -8,25 +8,21 @@ calc_fwhm <- function(final_path, final_mask_path, est_fwhm_path, hemi, eres, ma
   return(fwhm)
 }
 
-run_mri_surf_cluster <- function(final_path, dir_fshome, hemi, pval, fwhm, mask_path = NULL, cwp_thr = 0.025, mcz_thr = 30, csd_sign = "abs", verbose = FALSE, stack, stack_name) {
-
+run_mri_surf_cluster <- function(vw, pval, fwhm, mask_path = NULL, cwp_thr = 0.025, mcz_thr = 30, csd_sign = "abs", verbose = FALSE, stack, stack_name) {
   mcz_thr2 <- paste0("th", mcz_thr)
-
-  o_base_name <- paste0(final_path, ".stack", stack, ".cache.", mcz_thr2, '.', csd_sign, ".sig")
   if (fwhm < 10) fwhm <- paste0("0", fwhm)
-  csd <- file.path(dir_fshome, "average/mult-comp-cor/fsaverage", hemi, paste0("cortex/fwhm", fwhm), csd_sign, mcz_thr2, "mc-z.csd")
+  csd <- file.path(vw$paths$dir_fshome, "average/mult-comp-cor/fsaverage", vw$input$hemi, paste0("cortex/fwhm", fwhm), csd_sign, mcz_thr2, "mc-z.csd")
   cmd_str <- paste("mri_surfcluster",
                    "--in", pval,
                    "--csd", csd, 
-                   "--cwsig", paste0(o_base_name, ".cluster.mgh"),
-                   "--vwsig", paste0(o_base_name, ".voxel.mgh"),
-                   "--sum", paste0(o_base_name, ".cluster.summary"),
-                   "--ocn",  paste0(o_base_name, ".ocn.mgh"),
-                   "--oannot", paste0(o_base_name, ".ocn.annot"),
-                   "--annot", "aparc",
-                   "--csdpdf",  paste0(o_base_name, ".pdf.dat"),
+                   "--cwsig", vw$stack$cluster.mgh[[stack]],
+                   "--vwsig", vw$stack$voxel.mgh[[stack]],
+                   "--sum", vw$stack$cluster.summary[[stack]],
+                   "--ocn",  vw$stack$ocn.mgh[[stack]],
+                   "--oannot", vw$stack$ocn.annot[[stack]],
+                   "--annot aparc",
                    "--cwpvalthresh", cwp_thr,
-                   "--o", paste0(o_base_name, ".masked.mgh"),
+                   "--o", vw$stack$masked.mgh[[stack]],
                    "--no-fixmni",
                    "--surf", "white")
   cmd_str <- if (!is.null(mask_path)) paste(cmd_str, "--mask", mask_path) else paste(cmd_str, "--cortex")