Adding keeping track of incorrect pirho cases

code/simulations/simulations_inference_bernoulli.R

@@ -112,6 +112,8 @@ results <- parallel::mclapply(conditions_rows, function(s) {
   Cpi1 <- matrix(c(current_pi1, pi2), byrow = TRUE, nrow = M) > 0
   Cpi2 <- matrix(c(rho1, current_rho2), byrow = TRUE, nrow = M) > 0
 
+  current_seed <- .Random.seed
+
   netlist_generated <- list(
     generate_bipartite_collection(
       nr, nc, conditions[s, ]$pi1, rho1,
@@ -205,7 +207,7 @@ results <- parallel::mclapply(conditions_rows, function(s) {
 
   stop_time_condition <- Sys.time()
 
-  ## Preparing date for export
+  ##  Preparing date for export
   # BICLs
   sep_BICL <- sum(sep_BiSBM$BICL)
   iid_BICL <- fitted_bisbmpop_iid$best_fit$BICL
@@ -308,9 +310,10 @@ results <- parallel::mclapply(conditions_rows, function(s) {
     pirho_double_col_ARI = pirho_double_ARIs[[2]],
     pirho_Q1 = fitted_bisbmpop_pirho$best_fit$Q[1],
     pirho_Q2 = fitted_bisbmpop_pirho$best_fit$Q[2],
-
-    elapsed_secs = difftime(stop_time_condition, 
-      start_time_condition, units = "sec")
+    elapsed_secs = difftime(stop_time_condition,
+      start_time_condition,
+      units = "sec"
+    )
   )
   message("Finished step ", s, "/", nrow(conditions))
 
@@ -322,9 +325,30 @@ results <- parallel::mclapply(conditions_rows, function(s) {
 
   saveRDS(object = data_frame_output, file = temp_file_save)
 
+  #  Saving inhabitual data
+  if (all(pirho_mean_ARIs == 1L) & any(pirho_double_ARIs) < 1L) {
+    warning("Incorrect result encountered, saving.")
+    incorrect_filepath <- file.path(temp_dir, paste0(
+      "incorrect_conditions_", s, "_on_",
+      nrow(conditions), ".Rds"
+    ))
+
+    inc_data <- list(
+      epsilon_alpha = ea,
+      pi1 = current_pi1,
+      rho2 = current_rho2,
+      alpha = current_alpha,
+      pirho_double_row_ARI = pirho_double_ARIs[[1]],
+      pirho_double_col_ARI = pirho_double_ARIs[[2]],
+      netlist = netlist_generated,
+      seed = current_seed
+    )
+    saveRDS(object = inc_data, file = incorrect_filepath)
+  }
+
   return(data_frame_output)
 },
-mc.cores = parallel::detectCores() - 1
+mc.cores = parallel::detectCores() - 1L
 )
 
 
@@ -334,4 +358,4 @@ full_data_frame <- do.call(rbind, results)
 saveRDS(full_data_frame,
   file = file_save
 )
-message("Finished simulations.")
+message("Finished simulations.")