Progress https://github.com/richelbilderbeek/nsphs_ml_qt/issues/55

NAMESPACE

@@ -94,6 +94,7 @@ export(create_test_gcae_setup)
 export(create_test_genotype_concordances_table)
 export(create_test_losses_from_train_t_table)
 export(create_test_losses_from_train_v_table)
+export(create_test_model)
 export(create_test_nmse_in_time_table)
 export(create_test_phenotype_predictions_table)
 export(create_test_r_squared_in_time_table)
@@ -144,6 +145,7 @@ export(get_gcaer_folder)
 export(get_gcaer_tempfilename)
 export(get_gcaer_theme)
 export(get_n_neurons_in_latent_layer)
+export(get_n_neurons_in_latent_layer_from_model)
 export(get_run_gcae_py_path)
 export(get_test_data)
 export(get_test_datadir)
@@ -155,6 +157,7 @@ export(is_equal_json)
 export(is_gcae_installed)
 export(is_gcae_repo_cloned)
 export(is_gcae_script_fixed)
+export(is_model)
 export(is_tensorboard_installed)
 export(normalize_true_and_estimated_values)
 export(parse_evaluate_filenames)

R/create_test_model.R

@@ -0,0 +1,15 @@
+#' Create a GCAE model to be used in testing
+#'
+#' Create a GCAE model to be used in testing
+#' @inheritParams default_params_doc
+#' @return a GCAE model
+#' @examples
+#' create_test_model()
+#' check_model(create_test_model())
+#' @author Richèl J.C. Bilderbeek
+#' @export
+create_test_model <- function(
+  model_filename = gcaer::get_gcaer_filename("M0.json")
+) {
+  gcaer::read_model_file(model_filename)
+}

R/do_gcae_experiment.R

@@ -17,6 +17,10 @@ do_gcae_experiment <- function( # nolint indeed a function that is too complex
   resume_froms <- c(0, analyse_epochs[-length(analyse_epochs)])
   n_epochs <- analyse_epochs - resume_froms
 
+  n_neurons_in_latent_layer <- gcaer::get_n_neurons_in_latent_layer(
+    gcae_experiment_params
+  )
+
   # Results
   losses_from_project_table <- NA # Will be overwritten by each last project
   genotype_concordances_table <- NA # Will be overwritten by each last project

R/get_n_neurons_in_latent_layer.R

@@ -1,7 +1,9 @@
 #' Get the number of neurons in the layent layer
-#' @inheritParams default_params_doc
+#' @param x an input of type `model` or `gcae_experiment_params`
 #' @return the number of neurons in the latent layer
 #' @examples
+#'
+#' # A model
 #' if (is_gcae_repo_cloned()) {
 #'   # A real GCAE file
 #'   model_filename <- get_gcae_model_filename("M1")
@@ -13,18 +15,24 @@
 #' get_n_neurons_in_latent_layer(model)
 #' @author Richèl J.C. Bilderbeek
 #' @export
-get_n_neurons_in_latent_layer <- function(model) {
-  gcaer::check_model(model)
-  if (length(model$layers) == 1) {
-    return(model$layers[[1]]$args$units)
+get_n_neurons_in_latent_layer <- function(x) {
+  # Check data type
+  if (gcaer::is_model(x)) {
+    return(
+      gcaer::get_n_neurons_in_latent_layer_from_model(model = x)
+    )
+  }
+  if (gcaer::is_gcae_experiment_params()) {
+    return(
+      gcaer::get_n_neurons_in_latent_layer_from_gcae_experiment_params(
+        gcae_experiment_params = x
+      )
+    )
   }
 
-  is_dense <- purrr::map_lgl(model$layers, function(e) e$class == "Dense")
-  has_name <- purrr::map_lgl(
-    model$layers,
-    function(e) "name" %in% names(e$args)
+  stop(
+    "'x' is of an unsupported data type. \n",
+    "class(x): ", class(x), " \n",
+    "Tip: use a 'model' or 'gcae_experiment_params'"
   )
-  layer_index <- which(is_dense & has_name)
-  testthat::expect_equal(1, length(layer_index))
-  model$layers[[layer_index]]$args$units[[1]]
 }

R/get_n_neurons_in_latent_layer_from_model.R

@@ -0,0 +1,35 @@
+#' Get the number of neurons in the layent layer from a `model`
+#'
+#' Get the number of neurons in the layent layer from a `model`
+#' @inheritParams default_params_doc
+#' @return the number of neurons in the latent layer
+#' @seealso use \link{get_n_neurons_in_latent_layer}
+#' to get the number of neurons in the latent layer
+#' for different input arguments
+#' @examples
+#' if (is_gcae_repo_cloned()) {
+#'   # A real GCAE file
+#'   model_filename <- get_gcae_model_filename("M1")
+#' } else {
+#'   # An example file
+#'   model_filename <- get_gcaer_filename("M0.json")
+#' }
+#' model <- read_model_file(model_filename)
+#' get_n_neurons_in_latent_layer_from_model(model)
+#' @author Richèl J.C. Bilderbeek
+#' @export
+get_n_neurons_in_latent_layer_from_model <- function(model) {
+  gcaer::check_model(model)
+  if (length(model$layers) == 1) {
+    return(model$layers[[1]]$args$units)
+  }
+
+  is_dense <- purrr::map_lgl(model$layers, function(e) e$class == "Dense")
+  has_name <- purrr::map_lgl(
+    model$layers,
+    function(e) "name" %in% names(e$args)
+  )
+  layer_index <- which(is_dense & has_name)
+  testthat::expect_equal(1, length(layer_index))
+  model$layers[[layer_index]]$args$units[[1]]
+}

R/is_model.R

@@ -0,0 +1,27 @@
+#' Determine if the `model` is indeed a `model`
+#' @inheritParams default_params_doc
+#' @return \link{TRUE} if the `model` is indeed a `model`
+#' @examples
+#' # TRUE
+#' is_model(model = create_test_model())
+#'
+#' # FALSE
+#' is_model(model = "nonsense")
+#' is_model(model = "nonsense", verbose = TRUE)
+#' @author Richèl J.C. Bilderbeek
+#' @export
+is_model <- function(
+  model,
+  verbose = FALSE
+) {
+  plinkr::check_verbose(verbose)
+  result <- FALSE
+  tryCatch({
+    gcaer::check_model(model = model)
+    result <- TRUE
+  }, error = function(e) {
+      if (verbose) message(e$message)
+    }
+  )
+  result
+}

tests/testthat/test-create_test_model.R

@@ -0,0 +1,3 @@
+test_that("use", {
+  check_model(create_test_model())
+})

tests/testthat/test-gcae_project.R

@@ -1,4 +1,4 @@
 test_that("use", {
   expect_equal(1 + 1, 2) # Prevents testthat warning for empty test
-  # See test-gcae_workflow for the use of gcae_project
+  # See test-do_gcae_experiment for the use of gcae_project
 })

tests/testthat/test-get_n_neurons_in_latent_layer.R

@@ -1,46 +1,14 @@
-test_that("M0, example file", {
+test_that("M0, from model", {
   model_filename <- get_gcaer_filename("M0.json")
   model <- read_model_file(model_filename)
   n_neurons <- get_n_neurons_in_latent_layer(model)
   expect_equal(2, n_neurons)
 })
 
-test_that("M0, GCAE file", {
-  if (!is_gcae_script_fixed()) return()
-  model_filename <- get_gcae_model_filename("M0")
-  model <- read_model_file(model_filename)
-  n_neurons <- get_n_neurons_in_latent_layer(model)
-  expect_equal(2, n_neurons)
-})
-
-test_that("M1", {
-  if (!is_gcae_script_fixed()) return()
-  model_filename <- get_gcae_model_filename("M1")
-  model <- read_model_file(model_filename)
-  n_neurons <- get_n_neurons_in_latent_layer(model)
-  expect_equal(2, n_neurons)
-})
-
-test_that("M3d", {
-  if (!is_gcae_script_fixed()) return()
-  model_filename <- get_gcae_model_filename("M3d")
-  model <- read_model_file(model_filename)
-  n_neurons <- get_n_neurons_in_latent_layer(model)
-  expect_equal(2, n_neurons)
-})
-
-test_that("M3e", {
-  if (!is_gcae_script_fixed()) return()
-  model_filename <- get_gcae_model_filename("M3e")
-  model <- read_model_file(model_filename)
-  n_neurons <- get_n_neurons_in_latent_layer(model)
-  expect_equal(2, n_neurons)
-})
-
-test_that("M3f", {
-  if (!is_gcae_script_fixed()) return()
-  model_filename <- get_gcae_model_filename("M3f")
-  model <- read_model_file(model_filename)
-  n_neurons <- get_n_neurons_in_latent_layer(model)
+test_that("M0, from gcae_experiment_params", {
+  skip("nsphs_ml_qt #55")
+  gcae_experiment_params <- create_test_gcae_experiment_params()
+  expect_equal("M0", gcae_experiment_params$gcae_setup$model_id)
+  n_neurons <- get_n_neurons_in_latent_layer(gcae_experiment_params)
   expect_equal(2, n_neurons)
 })