HTNPoRT changes

DESCRIPTION

@@ -15,7 +15,7 @@ Depends:
   glue (>= 1.6.2),
   yaml (>= 2.3.5)
 Suggests:
-  testthat (>= 3.0.0)
+  testthat (>= 3.0.0),
   devtools (>= 2.4.5)
 Encoding: UTF-8
 LazyData: true

R/validate-model-paramater-file.R

@@ -2,7 +2,10 @@
 #'
 #' @param model_parameters_file_path Path to the model parametera file
 #'
-#' @return
+#' @return A named list containing the following fields:
+#' * success: boolean indicating whether validation failed or succeeded.
+#' * errors: A character vector where each item is a validation error message.
+#'   this field is only present if validation failed.
 #' @export
 #'
 #' @examples
@@ -65,22 +68,52 @@ validate_model_parameters <- function(model_parameters_file_path) {
 
     model_parameter_file <- read.csv(model_parameter_file_path,
                                      fileEncoding = "UTF-8-BOM")
+    file_validation <- validate_file(
+      model_parameter_file,
+      model_parameter_file_row$fileType,
+      basename(model_parameter_file_path),
+      file_metadata,
+      column_metadata,
+      column_category_metadata
+    )
     file_errors <- c(
       file_errors,
-      validate_file(
-        model_parameter_file,
-        model_parameter_file_row$fileType,
-        basename(model_parameter_file_path),
-        file_metadata,
-        column_metadata,
-        column_category_metadata
-      )
+      file_validation 
     )
+
+    MODEL_STEPS_FILE_TYPE <- "model-steps"
+    if(model_parameter_file_row$fileType == MODEL_STEPS_FILE_TYPE &
+       length(file_validation) == 0) {
+      model_step_file_errors <- purrr::pmap(
+        model_parameter_file,
+        function(step, filePath, fileType, ...) {
+          model_step_file_path <- file.path(dirname(model_parameter_file_path), filePath)
+          model_step_file <- read.csv(model_step_file_path, fileEncoding = "UTF-8-BOM")
+          # Step types whose fileType value cannot be N/A
+          NON_NA_FILE_TYPE_STEPS <- c("fine-and-gray", "cox")
+          model_step_file_type <- if(step %in% NON_NA_FILE_TYPE_STEPS) {
+            fileType
+          } else {
+            step 
+          } 
+          validation <- validate_file(
+            model_step_file,
+            model_step_file_type,
+            basename(model_step_file_path),
+            file_metadata,
+            column_metadata,
+            column_category_metadata
+          )
+          return(validation)
+        }
+      ) %>% purrr::list_c()
+      file_errors <- c(file_errors, model_step_file_errors)
+    }
   }
   if (length(file_errors) == 0) {
-    return(TRUE)
+    return(list(success = TRUE))
   }
-  return(file_errors)
+  return(list(success = FALSE, errors = file_errors))
 }
 
 validate_file <- function(file,
@@ -162,4 +195,4 @@ validate_file <- function(file,
     }
   }
   return(errors)
-}
+}

inst/metadata/README.md

@@ -20,3 +20,10 @@ column in the `column-category.csv` file and the `fileDesc` column in the
 When the data type for a value is an array i.e. it needs to encode multiple
 values, a colon (;) should be used as the separator, for example, `a;b`. The
 `algorithmType` column in the `file-metadata.csv` file uses this format.
+
+## New Algorithms
+
+When adding a newly supported algorithm to the repository, make sure to update
+the `algorithmType` column in the `file-metadata.csv` appropriately. This 
+column is used to specify which algorithm(s) each file is applicable to. Use a 
+value of `all` if a file is applicable to all algorithms.

inst/metadata/column-category.csv

@@ -29,6 +29,7 @@ model-steps,step,interaction,Step used to create interaction terms
 model-steps,step,fine-and-gray,Step used to calculate the outcome of a fine and gray model
 model-steps,step,cox,Step used to calculate the outcome of a cox proportional hazards model
 model-steps,step,simple-model,Step used to calculate the outcome of a simple model
+model-steps,step,logistic-regression,Step used to calculate the outcome of a logistic regression model
 model-steps,fileType,N/A,Missing since certain steps don't need to specify the file type
 model-steps,fileType,beta-coefficients,A beta coefficients file for a fine and gray model or a cox model
 model-steps,fileType,baseline-hazards,The baseline hazards for a fine and gray model or a cox model
@@ -44,3 +45,7 @@ validate,error_handle,truncate,"Failed validations for the variable should log a
 beta-coefficients,type,cat,Categorical type
 beta-coefficients,type,cont,Continuous type
 simple-model,name,outputVariableName,The name of the output variable for the model. Should be defined in the variables and variable details sheets.
+logistic-regression,type,cat,Categorical type
+logistic-regression,type,cont,Continuous type
+center,centeredVariableType,cat,Categorical type
+center,centeredVariableType,cont,Continuous type

inst/metadata/column-metadata.csv

@@ -41,6 +41,7 @@ dummy,dummyVariable,The name of the dummy variable,string,FALSE,,,,
 center,origVariable,The name of the variable to center,string,FALSE,,,,
 center,centerValue,The value to center with,string,FALSE,,,,
 center,centeredVariable,The name of the new centered variable,string,FALSE,,,,
+center,centeredVariableType,The type of the new centered variable,category,FALSE,,,,,
 interaction,interactionVariable,The name of the interaction variable,string,FALSE,,,,
 interaction,interactingVariables,The names of the variables that are part of this interaction variable,string,FALSE,,,,
 interaction,interactionVariableType,The statistical type of the interaction variable,category,FALSE,,,,
@@ -53,7 +54,7 @@ validate,value,The value to use when applying the validation,string,FALSE,,,,
 validate,error_handle,How to handle failed validations,category,FALSE,,,,
 validate,error_replace,Value to replace variables that fail validations whose errorHandle value is warning,string,FALSE,,,,
 validate,location,Which step in the scoring process the validation should be used,string,FALSE,,,,
-beta-coefficients,variable,The name of the variable whose beta coefficient the row contains,string,FALSE,,,,
+beta-coefficients,variable,The name of the variable whose beta coefficient the row contains. If this is the coefficient for the intercept then use the name "Intercept",string,FALSE,,,,
 beta-coefficients,coefficient,The beta coefficient,number,FALSE,,,,
 beta-coefficients,type,The statistical type of the variable,category,FALSE,,,,
 baseline-hazards,time,The time upto which the baseline hazard should be used,number,FALSE,,,,
@@ -65,3 +66,6 @@ tables,tableName,The name of the table,string,FALSE,,,,
 tables,tablePath,The path to the table relative to this file,string,FALSE,,,,
 simple-model,name,The name of the metadata,category,FALSE,,,,
 simple-model,value,The value of the metadata,string,FALSE,,,,
+logistic-regression,variable,The name of the variable whose beta coefficient the row contains. If this is the coefficient for the intercept then use the name "Intercept",string,FALSE,,,,
+logistic-regression,coefficient,The beta coefficient,number,FALSE,,,,
+logistic-regression,type,The statistical type of the variable,category,FALSE,,,,

inst/metadata/file-metadata.csv

@@ -10,9 +10,11 @@ center,Contains the variables to create centered variables,,all
 interaction,Contains the interaction variables for an algorithm,,all
 rcs,Contains the RCS variables for an algorithm,,all
 validate,Contains the validation rules for variables in the algorithm,,all
-beta-coefficients,Contains the beta coefficients used to evaluate a cox proportional hazards model or a fine and grey model,,cox;fine-and-gray
+beta-coefficients,Contains the coefficients for regression models,,cox;fine-and-gray;logistic-regression
 baseline-hazards,Contains the baseline hazards to use with a cox proportional hazards model or a fine and grey model,,cox;fine-and-gray
 survival_bins,Contains the survival data for the different bins in a survival algorithm,,survival
 lookup,Contains the range of score values for each bin in a survival algorithm,,survival
 tables,Contains the list of tables referenced in the variable and variable detail files,,all
 simple-model,Contains the metadata for a simple model,,simple-model
+logistic-regression,Contains the beta coefficients for a logistic regression model,,logistic-regression
+

tests/testthat/test-validate-model-parameter-file.R

@@ -0,0 +1,125 @@
+#' Creates a folder with model parameter files for testing purposes. The folder
+#' is cleaned up after the test is done.
+#'
+#' @param model_parameter_files a named list containing all the model parameter
+#' files to add to the folder. Each name in the list should be name of the file
+#' including its extension and each value should be a data frame that contains
+#' the file's contents. The named list must contain an entry for the model
+#' export file which should be named `model-export.csv`.
+#' @param env DO NOT SET THIS. Optional parameter that used for clean up
+#' purposes
+#' @return a string containing the path to the model export file
+#' @examples
+#' \dontrun {
+#' model_export_file <- data.frame(
+#'   fileType = c("model-steps"),
+#'   filePath = c("./model-steps.csv")
+#' )
+#' model_steps_file <- data.frame(
+#'   step = c("dummy"),
+#'   fileType = c("N/A"),
+#'   filePath = c("./dummy.csv"),
+#'   notes = c("")
+#' )
+#' dummy_file <- data.frame(
+#'   origVar = c("sex"),
+#'   catValue = c("1"),
+#'   dummyVariable = c("sex_cat1")
+#' )
+#'
+#' model_export_file_path <- .create_model_parameters_test_dir(list(
+#'   "model-export.csv" = model_export_file,
+#'   "model-steps.csv" = model_steps_file,
+#'   "dummy.csv" = dummy_file
+#' ))
+#' }
+.create_model_parameters_test_dir <- function(
+  model_parameter_files, env = parent.frame()) {
+  MODEL_EXPORT_FILE_NAME <- "model-export.csv"
+
+  stopifnot(MODEL_EXPORT_FILE_NAME %in% names(model_parameter_files))
+
+  MODEL_PARAMETERS_FOLDER_NAME <- "model-parameters"
+  model_parameters_folder_path <- file.path(
+    tempdir(), MODEL_PARAMETERS_FOLDER_NAME)
+  dir.create(model_parameters_folder_path)
+  withr::defer(unlink(model_parameters_folder_path, recursive = TRUE), env)
+
+  for(file_name in names(model_parameter_files)) {
+    current_file <- model_parameter_files[[file_name]]
+    write.csv(current_file, file.path(model_parameters_folder_path, file_name))
+  }
+
+  return(file.path(model_parameters_folder_path, MODEL_EXPORT_FILE_NAME))
+}
+
+test_that("files within the model steps file should be validated", {
+  model_export_file <- data.frame(
+    fileType = c("model-steps"),
+    filePath = c("./model-steps.csv")
+  )
+  model_steps_file <- data.frame(
+    step = c("dummy"),
+    fileType = c("N/A"),
+    filePath = c("./dummy.csv"),
+    notes = c("")
+  )
+  dummy_file <- data.frame(
+    origVar = c("sex"),
+    catValue = c("1"),
+    dummyVariable = c("sex_cat1")
+  )
+
+  model_export_file_path <- .create_model_parameters_test_dir(list(
+    "model-export.csv" = model_export_file,
+    "model-steps.csv" = model_steps_file,
+    "dummy.csv" = dummy_file
+  ))
+
+  expected_result <- list(
+    success = FALSE,
+    errors = c(
+      "Column <origVariable> not found in file dummy.csv"
+    )
+  )
+
+  actual_result <- validate_model_parameters(model_export_file_path)
+
+  expect_equal(actual_result, expected_result)
+})
+
+test_that("files within model steps whose type is in the fileType column should
+          be validated", {
+  model_export_file <- data.frame(
+    fileType = c("model-steps"),
+    filePath = c("./model-steps.csv")
+  )
+  model_steps_file <- data.frame(
+    step = c("fine-and-gray"),
+    fileType = c("beta-coefficients"),
+    filePath = c("./beta-coefficients.csv"),
+    notes = c("")
+  )
+  beta_coefficients <- data.frame(
+    var = c("sex_cat1"),
+    type = c("cat"),
+    coefficient = c("2")
+  )
+
+  model_export_file_path <- .create_model_parameters_test_dir(list(
+    "model-export.csv" = model_export_file,
+    "model-steps.csv" = model_steps_file,
+    "beta-coefficients.csv" = beta_coefficients
+  ))
+
+  expected_result <- list(
+    success = FALSE,
+    errors = c(
+      "Column <variable> not found in file beta-coefficients.csv"
+    )
+  )
+
+  actual_result <- validate_model_parameters(model_export_file_path)
+
+  expect_equal(actual_result, expected_result)
+})