WIP on VIMP task and VIMP hyperparameter task.

R/Familiar.R

@@ -392,8 +392,7 @@ summon_familiar <- function(
 
   # Select and sort unique tasks.
   tasks <- .sort_tasks(tasks)
-  browser()
-
+
   # Pre-processing -------------------------------------------------------------
   # Start pre-processing
   .run_preprocessing(
@@ -409,9 +408,9 @@ summon_familiar <- function(
   # Check if the process should be stopped at this point.
   if (.stop_after %in% c("preprocessing")) {
     return(create_experiment_data(
-      project_id = project_info$project_id,
-      experiment_setup = experiment_setup,
-      iteration_list = project_info$iter_list,
+      project_id = experiment_data@project_id,
+      experiment_setup = experiment_data@experiment_setup,
+      iteration_list = experiment_data@iteration_list,
       feature_info = get_feature_info_from_backend(
         data_id = waiver(),
         run_id = waiver()

R/FamiliarS4Classes.R

@@ -1572,20 +1572,22 @@ setClass(
 setClass(
   "familiarTask",
   slots = list(
-    task_name = "character",
-    task_id = "integer",
-    n_tasks = "integer",
-    data_id = "integer",
-    run_id = "integer",
-    file = "character",
-    project_id = "ANY"
+    "task_name" = "character",
+    "task_id" = "integer",
+    "n_tasks" = "integer",
+    "data_id" = "integer",
+    "run_id" = "integer",
+    "run_table" = "ANY",
+    "file" = "character",
+    "project_id" = "ANY"
   ),
   prototype = methods::prototype(
     task_name = NA_character_,
     task_id = 1L,
     n_tasks = 1L,
     data_id = NA_integer_,
     run_id = NA_integer_,
+    run_table = NULL,
     file = NA_character_,
     project_id = NULL
   )

R/TaskFeatureInfo.R

@@ -116,6 +116,17 @@ setMethod(
 
 
 
+# .get_feature_info_list (generic feature info task) ---------------------------
+setMethod(
+  ".get_feature_info_list",
+  signature(object = "familiarTaskGenericFeatureInfo"),
+  function(object, feature_info_list, ...) {
+    ..error_reached_unreachable_code(".get_feature_info_list does not exist for this task")
+  }
+)
+
+
+
 # familiarTaskFeatureInfo ------------------------------------------------------
 setClass(
   "familiarTaskFeatureInfo",
@@ -320,6 +331,15 @@ setMethod(
 
 
 
+# .get_feature_info_list (feature info task) ---------------------------
+setMethod(
+  ".get_feature_info_list",
+  signature(object = "familiarTaskFeatureInfo"),
+  function(object, feature_info_list, ...) {
+    ..error_reached_unreachable_code(".get_feature_info_list does not exist for this task")
+  }
+)
+
 
 
 .generate_data_preprocessing_tasks <- function(

R/TaskMain.R

@@ -15,6 +15,74 @@ setMethod(
 )
 
 
+# .get_feature_info_list (general task) ----------------------------------------
+setMethod(
+  ".get_feature_info_list",
+  signature(object = "familiarTask"),
+  function(object, feature_info_list, ...) {
+    # Suppress NOTES due to non-standard evaluation in data.table
+    can_pre_process <- NULL
+
+    # Attempt to get the feature info list from the backend.
+    if (is.null(feature_info_list) && !is.null(object@run_table)) {
+      # Find the last entry that is available for pre-processing
+      pre_processing_run <- tail(object@run_table[can_pre_process == TRUE, ], n = 1L)
+
+      feature_info_list <- tryCatch(
+        get_feature_info_from_backend(
+          data_id = pre_processing_run$data_id[1L],
+          run_id = pre_processing_run$run_id[1L]
+        ),
+        error = NULL
+      )
+    }
+
+    # If no feature list is present on the backend, check other options.
+    if (is.null(feature_info_list) && is.na(object@feature_info_file)) {
+      # Check that a feature info list is provided, otherwise create an ad-hoc
+      # list as an template.
+
+      # Set up task, and explicitly don't write to file.
+      generic_feature_info_task <- methods::new(
+        "familiarTaskFeatureInfo",
+        project_id = object@project_id,
+        file = NA_character_
+      )
+
+      # Execute the task.
+      feature_info_list <- .perform_task(
+        object = generic_feature_info_task,
+        ...
+      )
+
+    } else if (is.null(feature_info_list)) {
+      # Assume that the feature info file attribute contains the path to the
+      # file containing feature info.
+      if (!file.exists(object@feature_info_file)) {
+        ..error(paste0("feature info file does not exist at location: ", object@feature_info_file))
+      }
+      feature_info_list <- readRDS(object@feature_info_file)
+      feature_info_list <- update_object(feature_info_list)
+
+    } else if (is.character(feature_info_list)) {
+      # If the feature info list is a string, interpret this as a path to the
+      # file containing the feature info.
+      if (!file.exists(feature_info_list)) {
+        ..error(paste0("feature info file does not exist at location: ", feature_info_list))
+      }
+      feature_info_list <- readRDS(feature_info_list)
+      feature_info_list <- update_object(feature_info_list)
+    }
+
+    if (!rlang::is_bare_list(feature_info_list)) {
+      ..error("no feature info objects were found.")
+    }
+
+    return(feature_info_list)
+  }
+)
+
+
 
 .generate_trainer_tasks <- function(
     file_paths,
@@ -41,17 +109,16 @@ setMethod(
   task_list <- c(
     task_list,
     .generate_vimp_tasks(
-      file_paths = file_paths,
-      project_id = project_id
+      experiment_data = experiment_data
     )
   )
 
   # Add tasks related to data processing for learners.
   task_list <- c(
     task_list, 
     .generate_learner_data_preprocessing_tasks(
-      file_paths = file_paths,
-      project_id = project_id
+      experiment_data = experiment_data,
+      file_paths = file_paths
     )
   )