Merge pull request #12 from ropensci/devel

rOpenSci open review changes

.Rbuildignore

@@ -1,3 +1,4 @@
+^codemeta\.json$
 ^codecov\.yml$
 ^\.travis\.yml$
 ^Meta$
@@ -11,4 +12,5 @@ PET.Rcheck
 readme.md
 paper.md
 paper.bib
-contributing.md
+contributing.md
+docs

.gitignore

@@ -1,3 +1,4 @@
+doc
 Meta
 analysis
 scratch

DESCRIPTION

@@ -1,13 +1,21 @@
 Package: tacmagic
 Type: Package
 Title: tacmagic: PET Analysis in R
-Version: 0.1.9
+Version: 0.2.0
 Authors@R: c(person("Eric", "Brown", 
                     role = c("aut", "cre"),
                     email = "[email protected]",
                     comment = c(ORCID = "0000-0002-1575-2606")),
              person("Ariel", "Graff-Guerrero",
-                    role = c("dgs")))
+                    role = "dgs"),
+             person("Jon", "Clayden",
+                    role = c("rev"),
+                    comment = c(ORCID = "0000-0002-6608-0619", 
+                    "Jon Clayden reviewed the package for ropensci, see <https://github.com/ropensci/software-review/issues/280>")),
+             person("Brandon", "Hurr",
+                    role = c("rev"),
+                    comment = c(ORCID = "0000-0003-2576-4544", 
+                    "Brandon Hurr reviewed the package for ropensci, see <https://github.com/ropensci/software-review/issues/280>")))
 Description: To faciliate analysis of positron emission tomography (PET) time
     activity curve (TAC) data, and to encourage open science and replicability,
     this package supports data loading and analysis of multiple TAC file 

NAMESPACE

@@ -1,22 +1,26 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.data.frame,tac)
+S3method(plot,ref_Logan)
+S3method(plot,tac)
+S3method(summary,tac)
 export(DVR_all_ref_Logan)
 export(DVR_ref_Logan)
+export(as.tac)
 export(batch_load)
 export(batch_tm)
 export(batch_voistat)
 export(cutoff_aiz)
+export(dvr)
 export(load_tac)
 export(load_voistat)
 export(load_vol)
-export(plot_ref_Logan)
-export(plot_tac)
 export(pos_anyroi)
-export(references)
 export(roi_ham_full)
 export(roi_ham_pib)
 export(roi_ham_stand)
 export(save_tac)
+export(split_pvc)
 export(suvr)
 export(suvr_auc)
 export(tac_roi)
@@ -34,6 +38,7 @@ importFrom(stats,lm)
 importFrom(stats,quantile)
 importFrom(stats,sd)
 importFrom(stats,weighted.mean)
+importFrom(tools,file_ext)
 importFrom(utils,head)
 importFrom(utils,read.csv)
 importFrom(utils,read.delim)

R/ROI_definitions.R

@@ -7,14 +7,18 @@
 
 # ROI definitions file.
 
-
 #' Return a list of merged ROIs made up of the atomic ROIs in the Hammer's 
-#' atlas (see references()$Hammers_2003).
+#' atlas.
 #'
 #'@export
 #'@return A list of lists, where each list is an ROI (e.g.) frontal lobe that 
 #' specifies the atomic ROIs from the atlas that make it up.
 #'@family ROI definitions
+#'@references Hammers, Alexander, Richard Allom, Matthias J. Koepp, Samantha L. Free, 
+#' Ralph Myers, Louis Lemieux, Tejal N. Mitchell, David J. Brooks, and John S. 
+#' Duncan. 2003. Three-dimensional Maximum Probability Atlas of the Human 
+#' Brain, with Particular Reference to the Temporal Lobe. Human Brain Mapping 
+#' 19 (4): 224-247. doi:10.1002/hbm.10123
 #'@examples 
 #' roi_ham_stand()
 roi_ham_stand <- function() {
@@ -77,6 +81,11 @@ roi_ham_stand <- function() {
 #'@return A list of lists, where each list is an ROI (e.g.) frontal lobe that 
 #' specifies the atomic ROIs from the atlas that make it up.
 #'@family ROI definitions
+#'@references Hammers, Alexander, Richard Allom, Matthias J. Koepp, Samantha L. Free, 
+#' Ralph Myers, Louis Lemieux, Tejal N. Mitchell, David J. Brooks, and John S. 
+#' Duncan. 2003. Three-dimensional Maximum Probability Atlas of the Human 
+#' Brain, with Particular Reference to the Temporal Lobe. Human Brain Mapping 
+#' 19 (4): 224-247. doi:10.1002/hbm.10123
 #'@examples roi_ham_full()
 roi_ham_full <- function() {
 
@@ -107,6 +116,11 @@ roi_ham_full <- function() {
 #'@return A list of lists, where each list is an ROI (e.g.) frontal lobe that 
 #' specifies the atomic ROIs from the atlas that make it up.
 #'@family ROI definitions
+#'@references Hammers, Alexander, Richard Allom, Matthias J. Koepp, Samantha L. Free, 
+#' Ralph Myers, Louis Lemieux, Tejal N. Mitchell, David J. Brooks, and John S. 
+#' Duncan. 2003. Three-dimensional Maximum Probability Atlas of the Human 
+#' Brain, with Particular Reference to the Temporal Lobe. Human Brain Mapping 
+#' 19 (4): 224-247. doi:10.1002/hbm.10123
 #'@examples 
 #' roi_ham_pib()
 roi_ham_pib <- function() {

R/SUVR.R

@@ -13,9 +13,8 @@
 #'@export 
 #'@param tac The time-activity curve data from tac_roi()
 #'@param SUVR_def a vector of start times for window to be used in SUVR
-#'@param ref a string, e.g. "cerbellum", to specify reference region
-#'@param params a list of paramters passed from the batch_tm function and is
-#'              not needed when calling for individual participants.
+#'@param ref a string, e.g. "cerebellum", to specify reference region
+#'@param ... When called from tm_batch, unused parameters may be supplied
 #'@return A data.frame of SUVR values for the specified ROIs
 #'@family SUVR functions
 #'@examples
@@ -28,25 +27,12 @@
 #' 
 #' AD06_SUVR <- suvr(AD06, SUVR_def=c(3000,3300,3600), ref="cerebellum")
 #' 
-suvr <- function(tac, SUVR_def=NULL, ref=NULL, params=NULL) {
+suvr <- function(tac, SUVR_def, ref, ...) {
 
-    if (!(is.null(params))) {
-      if(!is.null(c(SUVR_def, ref))) {
-        stop("Only provide either params argument or both SUVR_def and ref.")
-      } 
-      if ( is.null(params$SUVR_def) | is.null(params$ref) ) {
-        stop("Both SUVR_def and ref are needed to calculate SUVR.")
-      }
-
-      ref <- params$ref
-      SUVR_def <- params$SUVR
-    }
-
-    #TODO: validate that SUVR_def is suitable
+    validate_suvr_params(tac, SUVR_def, ref)
 
     SUVRtable <- new_table(tac, "SUVR")
 
-    # TODO validate that t1$start and t2$end are numeric
     frames <- match(SUVR_def, tac$start)
     frame_weights <- tac$end[frames] - tac$start[frames]
 
@@ -67,7 +53,8 @@ suvr <- function(tac, SUVR_def=NULL, ref=NULL, params=NULL) {
 #'@export 
 #'@param tac The time-activity curve data from tac_roi()
 #'@param SUVR_def a vector of start times for window to be used in SUVR
-#'@param ref is a string, e.g. "cerbellum", to specify reference region
+#'@param ref is a string, e.g. "cerebellum", to specify reference region
+#'@param ... When called from tm_batch, unused parameters may be supplied
 #'@family SUVR functions
 #'@return A data.frame of SUVR values for the specified ROIs
 #' #' f <- system.file("extdata", "AD06.tac", package="tacmagic")
@@ -79,19 +66,37 @@ suvr <- function(tac, SUVR_def=NULL, ref=NULL, params=NULL) {
 #' 
 #' AD06_SUVR <- suvr_auc(AD06, SUVR_def=c(3000,3300,3600), ref="cerebellum")
 #' 
-suvr_auc <- function(tac, SUVR_def, ref) {
+suvr_auc <- function(tac, SUVR_def, ref, ...) {
 
-    SUVRtable <- new_table(tac, "SUVR")
+  validate_suvr_params(tac, SUVR_def, ref)
+
+  SUVRtable <- new_table(tac, "SUVR")
 
-    tac$mid <- (tac$start + tac$end) / 2
+  tac$mid <- (tac$start + tac$end) / 2
 
-    for (ROI in names(tac)[-c(1:2, length(tac))]) {    
-        rich <- pracma::trapz(tac[(tac$start %in% SUVR_def),][,"mid"], 
-                              tac[(tac$start %in% SUVR_def),][,ROI])
-        poor <- pracma::trapz(tac[(tac$start %in% SUVR_def),][,"mid"], 
-                              tac[(tac$start %in% SUVR_def),][,ref])
-        SUVRtable[ROI, "SUVR"] <-  rich/poor
-    }    
+  for (ROI in names(tac)[-c(1:2, length(tac))]) {    
+    rich <- pracma::trapz(tac[(tac$start %in% SUVR_def),][,"mid"], 
+                          tac[(tac$start %in% SUVR_def),][,ROI])
+    poor <- pracma::trapz(tac[(tac$start %in% SUVR_def),][,"mid"], 
+                          tac[(tac$start %in% SUVR_def),][,ref])
+    SUVRtable[ROI, "SUVR"] <-  rich/poor
+  }    
 
     return(SUVRtable)
 }
+
+
+# Checks to ensure SUVR parameters are appropriate and throws error if not.
+#' @noRd
+validate_suvr_params <- function(tac, SUVR_def, ref) {
+
+  if(!validate_tac(tac)) stop("Supplied tac file did not validate.")
+
+  if (!all(SUVR_def %in% tac$start)) {
+    stop("The SUVR definition must refer to valid start times in the tac")
+  }
+
+  if(!(ref %in% names(tac))) {
+    stop("The reference region (ref) must be in the supplied tac.")
+  }  
+}

R/batch_models.R

@@ -31,7 +31,7 @@ model_definitions <- function() {
 #'@param params Parameters passed from batch_tm()
 #'@return A data.frame of SUVR values for the ROIs for all participants
 #'@noRd
-model_batch <- function(all_tacs, model=NULL, params) {
+model_batch <- function(all_tacs, model=NULL, ...) {
 
   # Specify function to use (except Logan, which needs different params) ------
   if (class(model) == "function") {
@@ -55,7 +55,7 @@ model_batch <- function(all_tacs, model=NULL, params) {
     #message(paste("Working on...", participants[i]))
 
     tac_data <- all_tacs[[i]]    
-    VALUE <- suppressMessages(model_fn(tac_data, params=params))
+    VALUE <- suppressMessages(model_fn(tac_data, ...))
     master[participants[i], ] <- t(VALUE)
   }
 

R/batches.R

@@ -19,12 +19,9 @@
 #'@export
 #'@param all_tacs A list by participant, of tac data (load_batch())
 #'@param models A vector of names of the models to calculate
-#'@param ref The name of the reference region for DVR/SUVR calculation
-#'@param SUVR_def is a vector of the start times for window to be used in SUVR
-#'@param k2prime Fixed k2' for DVR calculation
-#'@param t_star Change from 0 to manually specify a t* for DVR calculation
 #'@param custom_model A function that can be run like other models (advanced)
-#'@param custom_params To pass to custom_model as params$custom_params
+#'@param ... The arguments that get passed to the specified models/custom model,
+#' many are required; please check with model desired.
 #'@return A table of SUVR values for the specified ROIs for all participants
 #'@family Batch functions
 #'@examples
@@ -33,34 +30,31 @@
 #'                   system.file("extdata", "AD08.tac", package="tacmagic"))
 #' 
 #' tacs <- batch_load(participants, tac_file_suffix="")
-#' for (i in 1:3) tacs[[i]][,1:80] # to remove the PVC values for this example
+#'
+#' # Keeps only the ROIs without partial-volume correction (PMOD convention)
+#' tacs <- lapply(tacs, split_pvc, FALSE)
 #' 
 #' batch <- batch_tm(tacs, models=c("SUVR", "Logan"), ref="Cerebellum_r",
 #'                   SUVR_def=c(3000,3300,3600), k2prime=0.2, t_star=23)
 #'
-batch_tm <- function(all_tacs, models=c("SUVR", "Logan"), ref, SUVR_def=NULL, 
-                     k2prime=NULL, t_star=NULL,
-                     custom_model=NULL, custom_params=NULL) {
+batch_tm <- function(all_tacs, models, custom_model=NULL, ...) {
 
   #----------------------------------------------------------------------------
-  params <- list(ref=ref, SUVR_def=SUVR_def, k2prime=k2prime, 
-                 t_star=t_star, custom_params=custom_params)
-
   all_models <- names(model_definitions())
   if (!(all(models %in% all_models))) stop("Invalid model name(s) supplied.")
 
   master <- NULL
 
   # Run each model from available models --------------------------------------
   for (this_model in models) {
-    MOD <- model_batch(all_tacs, model=this_model, params=params)
+    MOD <- model_batch(all_tacs, model=this_model, ...)
     names(MOD) <- lapply(names(MOD), paste0, "_", this_model)  
     if (is.null(master)) master <- MOD else master <- data.frame(master, MOD)
   }
 
   # Run the custom model if one was specified ---------------------------------
   if(!is.null(custom_model)) {
-    MOD <- model_batch(all_tacs, params=params, model=custom_model)
+    MOD <- model_batch(all_tacs, model=custom_model, ...)
     names(MOD) <- lapply(names(MOD), paste0, "_custom")
     if (is.null(master)) master <- MOD else master <- data.frame(master, MOD)
   }
@@ -81,7 +75,8 @@ batch_tm <- function(all_tacs, models=c("SUVR", "Logan"), ref, SUVR_def=NULL,
 #'@param dir A directory and/or file name prefix for the tac/volume files
 #'@param tac_format Format of tac files provided: See load_tac()
 #'@param tac_file_suffix How participant IDs corresponds to the TAC files
-#'@param roi_m T if you want to merge atomic ROIs into larger ROIs
+#'@param roi_m TRUE if you want to merge atomic ROIs into larger ROIs (and if 
+#' not, the following parameters are not used)
 #'@param vol_format The file format that includes volumes: See load_vol()
 #'@param vol_file_suffix How participant IDs correspond to volume files
 #'@param ROI_def Object that defines combined ROIs, see ROI_definitions.R
@@ -96,11 +91,19 @@ batch_tm <- function(all_tacs, models=c("SUVR", "Logan"), ref, SUVR_def=NULL,
 #'                   system.file("extdata", "AD08.tac", package="tacmagic"))
 #' 
 #' tacs <- batch_load(participants, tac_file_suffix="")
-batch_load <- function(participants, PVC=FALSE, dir="", tac_format="PMOD", 
-                       tac_file_suffix=".tac", roi_m=FALSE,
+batch_load <- function(participants, dir="", tac_file_suffix=".tac",
+                       tac_format="PMOD", roi_m=FALSE, PVC=NULL, 
                        vol_file_suffix=NULL, vol_format=NULL, 
                        merge=NULL, ROI_def=NULL) {
 
+  if (!roi_m) {
+    if (!all(c(is.null(vol_format), is.null(vol_file_suffix), is.null(ROI_def), 
+              is.null(PVC)))) {
+      warning("You specified parameters used for volume-based ROI merging, but 
+               roi_m is FALSE so those parameters will not be used.")
+    }
+  }
+
   r <- lapply(participants, load_tacs, dir=dir, tac_format=tac_format, 
               roi_m=roi_m, tac_file_suffix=tac_file_suffix, 
               vol_file_suffix=vol_file_suffix, 
@@ -125,7 +128,7 @@ batch_load <- function(participants, PVC=FALSE, dir="", tac_format="PMOD",
 #'@param ROI_def Object that defines combined ROIs, see ROI_definitions.R
 #'@param dir Directory and/or filename prefix of the files
 #'@param filesuffix Optional filename characters between ID and ".voistat"
-#'@param varname The name of the variable being exctracted, e.g. "SRTM"
+#'@param varname The name of the variable being extracted, e.g. "SRTM"
 #'@return A table of values for the specified ROIs for all participants
 #'@family Batch functions
 #'@examples