numerous and sundry

Author: bbuchsbaum

NAMESPACE

@@ -23,6 +23,7 @@ S3method(get_searchlight,mvpa_surface_dataset)
 S3method(has_crossval,default)
 S3method(has_crossval,model_spec)
 S3method(has_crossval,mvpa_model)
+S3method(has_test_set,model_spec)
 S3method(has_test_set,mvpa_dataset)
 S3method(has_test_set,mvpa_design)
 S3method(has_test_set,mvpa_model)
@@ -33,6 +34,7 @@ S3method(merge_results,feature_rsa_model)
 S3method(merge_results,multiway_classification_result)
 S3method(merge_results,regional_mvpa_result)
 S3method(merge_results,regression_result)
+S3method(merge_results,vector_rsa_model)
 S3method(nobs,mvpa_design)
 S3method(nresponses,mvpa_design)
 S3method(pairwise_dist,cordist)
@@ -74,15 +76,15 @@ S3method(prob_observed,binary_classification_result)
 S3method(prob_observed,multiway_classification_result)
 S3method(process_roi,custom_internal_model_spec)
 S3method(run_regional,default)
-S3method(run_regional,feature_rsa_model)
 S3method(run_regional,mvpa_model)
 S3method(run_regional,rsa_model)
+S3method(run_regional,vector_rsa_model)
 S3method(run_searchlight,default)
-S3method(run_searchlight,feature_rsa_model)
 S3method(run_searchlight,vector_rsa)
 S3method(select_features,FTest)
 S3method(select_features,catscore)
 S3method(select_features,mvpa_model)
+S3method(strip_dataset,default)
 S3method(sub_result,binary_classification_result)
 S3method(sub_result,multiway_classification_result)
 S3method(summary,feature_rsa_model)
@@ -97,7 +99,12 @@ S3method(y_train,feature_rsa_design)
 S3method(y_train,feature_rsa_model)
 S3method(y_train,mvpa_design)
 S3method(y_train,mvpa_model)
+export("for")
+export(MVPA)
 export(MVPAModels)
+export(Objects)
+export(Regional)
+export(`vector_rsa_model`)
 export(balance_partitions)
 export(binary_classification_result)
 export(blocked_cross_validation)
@@ -116,6 +123,7 @@ export(custom_performance)
 export(data_sample)
 export(eucdist)
 export(evaluate_model.feature_rsa_model)
+export(evaluate_model.vector_rsa_model)
 export(feature_rsa_design)
 export(feature_rsa_model)
 export(feature_selector)
@@ -162,6 +170,7 @@ export(run_searchlight_base)
 export(second_order_similarity)
 export(select_features)
 export(sequential_blocked_cross_validation)
+export(strip_dataset)
 export(sub_result)
 export(test_design)
 export(train_model)

R/allgeneric.R

@@ -11,6 +11,19 @@ get_unique_regions <- function(region_mask, ...) {
   UseMethod("get_unique_regions")
 }
 
+#' Strip Dataset from Model Specification
+#' 
+#' Removes the potentially large dataset component from a model specification object
+#' to avoid copying it during parallel processing.
+#' 
+#' @param obj The model specification object.
+#' @param ... Additional arguments.
+#' @return The model specification object with the `dataset` element removed or set to NULL.
+#' @export
+strip_dataset <- function(obj, ...) {
+  UseMethod("strip_dataset")
+} 
+
 #' Select Features
 #'
 #' Given a \code{feature_selection} specification object and a dataset, returns the set of selected features as a binary vector.
@@ -107,7 +120,7 @@ process_roi <- function(mod_spec, roi, rnum, ...) {
 process_roi.default <- function(mod_spec, roi, rnum, ...) {
   if (!is.null(mod_spec$process_roi)) {
     mod_spec$process_roi(mod_spec, roi, rnum, ...)
-  } else if (has_test_set(mod_spec$dataset)) {
+  } else if (has_test_set(mod_spec)) {
     external_crossval(mod_spec, roi, rnum, ...)
   } else if (has_crossval(mod_spec)) {
     #print("internal crossval")
@@ -462,13 +475,18 @@ run_searchlight <- function(model_spec, radius, method = c("standard", "randomiz
 #'
 #' @param model_spec A \code{mvpa_model} instance containing the model specifications
 #' @param region_mask A \code{NeuroVol} or \code{NeuroSurface} object where each region is identified by a unique integer
-#' @param ... Extra arguments passed to specific regional analysis methods
-#'
-#' @return A named list containing:
-#'   \item{performance}{Performance metrics for each region}
-#'   \item{prediction_table}{Predictions for each region}
-#'   \item{fits}{Model fits if return_fits=TRUE}
-#'
+#' @param coalesce_design_vars If \code{TRUE}, merges design variables into the prediction table (if present and generated). Default is \code{FALSE}.
+#' @param processor An optional custom processor function for each region (ROI). If NULL (default), behavior depends on the \code{model_spec} class.
+#' @param verbose If \code{TRUE}, print progress messages during iteration (default is \code{FALSE}).
+#' @param ... Extra arguments passed to specific regional analysis methods (e.g., `return_fits`, `compute_performance`).
+#'
+#' @return A \code{regional_mvpa_result} object (list) containing:
+#'   \item{performance_table}{A tibble of performance metrics for each region (if computed).}
+#'   \item{prediction_table}{A tibble with detailed predictions for each observation/region (if generated).}
+#'   \item{vol_results}{A list of volumetric maps representing performance metrics across space (if computed).}
+#'   \item{fits}{A list of fitted model objects for each region (if requested via `return_fits=TRUE`).}
+#'   \item{model_spec}{The original model specification object provided.} # Note: Original documentation said 'performance', clarified here.
+#' 
 #' @examples
 #' \donttest{
 #'   # Generate sample dataset (3D volume with categorical response)
@@ -512,6 +530,7 @@ run_searchlight <- function(model_spec, radius, method = c("standard", "randomiz
 #'   first_roi_fit <- results$fits[[1]]  # First ROI's fitted model
 #' }
 #'
+#' @rdname run_regional-methods
 #' @export
 run_regional <- function(model_spec, region_mask, ...) {
   UseMethod("run_regional")

R/dataset.R

@@ -129,15 +129,22 @@ gen_sample_dataset <- function(D, nobs, response_type=c("categorical", "continuo
 
   block_var <- as.integer(as.character(cut(1:nobs, blocks, labels=1:blocks)))
 
-  des <- if (external_test) {
+  if (external_test) {
     message("external test")
-    mvpa_design(data.frame(Y=Y, block_var=block_var), test_design=data.frame(Ytest = Ytest), 
+    mvdes <- mvpa_design(data.frame(Y=Y, block_var=block_var), test_design=data.frame(Ytest = Ytest), 
                        block_var= "block_var", y_train= ~ Y, y_test = ~ Ytest, split_by=split_by)
   } else {
-    mvpa_design(data.frame(Y=Y, block_var=block_var), block_var="block_var", y_train= ~ Y, split_by=split_by)
+    mvdes <- mvpa_design(data.frame(Y=Y, block_var=block_var), block_var="block_var", y_train= ~ Y, split_by=split_by)
   }
 
-  list(dataset=dset, design=des)
+  # Make sure the dataset also has the _has_test_set flag set consistently
+  if (is.list(dset) && "dataset" %in% names(dset)) {
+    dset$dataset$has_test_set <- external_test
+  } else {
+    dset$has_test_set <- external_test
+  }
+  
+  list(dataset=dset, design=mvdes)
 }
 
 
@@ -155,6 +162,7 @@ gen_sample_dataset <- function(D, nobs, response_type=c("categorical", "continuo
 #'     \item{train_data}{The training data as a \code{NeuroVec} instance}
 #'     \item{test_data}{The test data as a \code{NeuroVec} instance (if provided, otherwise NULL)}
 #'     \item{mask}{The binary mask defining valid voxels as a \code{NeuroVol} instance}
+#'     \item{has_test_set}{Logical flag indicating whether this dataset has a test set}
 #'   }
 #'
 #' @examples
@@ -196,11 +204,15 @@ mvpa_dataset <- function(train_data, test_data=NULL, mask) {
     stop("Invalid dataset: Only ", active_voxels, " active voxel(s) in mask. Feature RSA analysis requires multiple active voxels.")
   }
 
+  # Store a flag indicating whether this dataset has a test set
+  has_test <- !is.null(test_data)
+  
   ret <- structure(
     list(
       train_data=train_data,
       test_data=test_data,
-      mask=mask
+      mask=mask,
+      has_test_set=has_test  # Add flag for test set presence
     ),
     class=c("mvpa_image_dataset", "mvpa_dataset", "list")
   )
@@ -224,6 +236,7 @@ mvpa_dataset <- function(train_data, test_data=NULL, mask) {
 #'     \item{test_data}{The test data as a \code{NeuroSurfaceVector} instance (if provided)}
 #'     \item{mask}{A numeric vector indicating valid vertices (1) and excluded vertices (0)}
 #'     \item{name}{Character string identifier for the dataset}
+#'     \item{has_test_set}{Logical flag indicating whether this dataset has a test set}
 #'   }
 #'
 #' @details
@@ -263,17 +276,19 @@ mvpa_surface_dataset <- function(train_data, test_data=NULL, mask=NULL, name="")
     mask[indices(train_data)] <- 1
   }
 
+  # Store a flag indicating whether this dataset has a test set
+  has_test <- !is.null(test_data)
+  
   structure(
     list(
       train_data=train_data,
       test_data=test_data,
       mask=mask,
-      name=name
+      name=name,
+      has_test_set=has_test  # Add flag for test set presence
     ),
     class=c("mvpa_surface_dataset", "mvpa_dataset", "list")
   )
-
-  
 }
 
 #' @export
@@ -440,7 +455,8 @@ wrap_output.mvpa_surface_dataset <- function(obj, vals, indices) {
 
 #' @export
 has_test_set.mvpa_dataset <- function(obj) {
-  !is.null(obj$test_data) 
+  # Use the stored flag rather than checking for existence of test_data
+  isTRUE(obj$has_test_set)
 }