added a forward run after each optimisation. The values are than inte…

…rpolated at the points of the measured variable which was added continously. Afterwards, the forward simulated signal was used in the plots

Tests/DBA_const_dye/tests.R

@@ -25,7 +25,7 @@ res <- opti(
     dye = 0.000151
   ),
   npop = 40,
-  ngen = 1000,
+  ngen = 11,
   Topology = "random",
   errorThreshold = 0.7
 )

Tests/IDA/tests.R

@@ -13,96 +13,38 @@ library(tsf)
 # Test several opti calls in parallel
 path <- "/home/konrad/Documents/GitHub/RProjects/Thermosimfit/Tests/IDA/idaBatch.csv"
 list_df <- tsf:::importDataBatch(path)
+
 seeds <- 1:length(list_df)
 messages <- paste0(1:length(list_df))
-lowerBounds = c(
+lowerBounds <- c(
   kG = 1000,
   I0 = 0,
   IHD = 0,
   ID = 0
 )
-upperBounds = c(
+upperBounds <- c(
   kG = 10^8,
   I0 = 100, # started at 10^7 but it ended always at 0...
   IHD = 10^7,
   ID = 10^7
 )
-additionalParameters = c(
+additionalParameters <- c(
   host = 1e-6,
   dye = 1e-6,
   kHD = 3e6
 )
 
-call_several_opti_in_bg <- function(case, lb, ub, df_list, ap,
-                                    seed_list, npop, ngen, topo,
-                                    et, messages) {
-  process <- callr::r_bg(
-    function(case, lb, ub, df_list, ap,
-             seed_list, npop, ngen, topo,
-             et, messages) {
-      env <- new.env()
-      env$intermediate_results <- lapply(seq_len(length((df_list))),
-        function(x) x)
-
-      for (i in seq_len(length(df_list))) {
-        tryCatch(
-          expr = {
-            df <- df_list[[i]]
-            seed <- seed_list[[i]]
-            m <- messages[[i]]
-            result <- tsf::opti(
-              case, lb, ub, df, ap, seed, npop, ngen,
-              topo, et, m
-            )
-            env$intermediate_results[[i]] <- result
-            return(env$intermediate_results)
-          },
-          interrupt = function(e) {
-            warning("interrupted!")
-            return(env$intermediate_results)
-          },
-          error = function(e) {
-            warning("\n\n Probably not finished optimisation \n\n")
-            return(env$intermediate_results)
-          }
-        )
-      }
-    },
-    args = list(
-      case, lb, ub, df_list,
-      ap, seed_list, npop, ngen, topo,
-      et, messages
-    )
-  )
-  return(process)
-}
-
-res <- call_several_opti_in_bg(
+res <- opti(
   case = "ida",
-  lb = lowerBounds,
-  ub = upperBounds,
-  df_list = list_df,
-  ap = additionalParameters,
-  seed_list = seeds,
+  lowerBounds = lowerBounds,
+  upperBounds = upperBounds,
+  path = list_df[[1]],
+  seed = 1234,
+  additionalParameters = additionalParameters,
   npop = 40,
-  ngen = 20,
-  topo = "random",
-  et = 0.7,
-  messages = messages
+  ngen = 100,
+  Topology = "random",
+  errorThreshold = 0.3
 )
 
-counter <- 1
-Sys.sleep(5)
-while (TRUE) {
-  if (!res$is_alive()) break
-  cat(res$read_output())
-  res$interrupt()
-  res$wait()
-}
-cat("Counter ", counter, "\n")
-print("Errors:")
-print(res$read_all_error())
-result <- res$get_result()
-cat("Length results ", length(result), "\n")
-trash <- lapply(result, function(x) print(class(x)))
-result
+res[[3]]

tsf/R/ForwardLossFunctions.R

@@ -57,7 +57,6 @@ forward_dba_host_const <- function(Kd, Id, Ihd, h0, d0_values) {
           upper = d0,
           tol = 1e-14,
           Kd = Kd,
-          Kg = Kg,
           h0 = h0,
           d0 = d0
         )$root
@@ -83,9 +82,8 @@ forward_dba_host_const <- function(Kd, Id, Ihd, h0, d0_values) {
       silent = TRUE
     )
   }
-
   results_table <- data.frame(
-    h0 = valid_h0,
+    d0 = valid_d0,
     Signal = Signal_values
   )
 

tsf/R/ForwardSimulation.R

@@ -18,7 +18,7 @@ forward_simulation <- function(case, df, additionalParameters, parameter, n = 10
   if (n > 10000) {
     stop("n has to be smaller than 10000")
   }
-  if (case == "hg" && length(additionalParameters) != 1) {
+  if (case == "hg" && length(additionalParameters) != 1) { # TODO: add check for dba
     stop("additionalParameters have to be of length 1")
   }
   if (case == "ida" && length(additionalParameters) != 3) {
@@ -60,6 +60,7 @@ forward_simulation <- function(case, df, additionalParameters, parameter, n = 10
       params[[1]], params[[2]],
       params[[3]], params[[4]], params[[5]]
     )
+    result[, 2] <- result[, 2] + parameter[2]
   } else if (case == "dba_dye_const") {
     params[[1]] <- parameter[1] # KaHD
     params[[2]] <- parameter[4] # I(D)
@@ -70,6 +71,7 @@ forward_simulation <- function(case, df, additionalParameters, parameter, n = 10
       params[[1]], params[[2]],
       params[[3]], params[[4]], params[[5]]
     )
+    result[, 2] <- result[, 2] + parameter[2]
   } else if (case == "ida") {
     params[[1]] <- parameter[1] # KaHG
     params[[2]] <- parameter[4] # I(D)
@@ -83,6 +85,7 @@ forward_simulation <- function(case, df, additionalParameters, parameter, n = 10
       params[[2]], params[[3]],
       params[[4]], params[[5]], params[[7]]
     )
+    result[, 2] <- result[, 2] + parameter[2]
   } else if (case == "gda") {
     params[[1]] <- parameter[1] # KaHD
     params[[2]] <- parameter[4] # I(D)
@@ -96,6 +99,7 @@ forward_simulation <- function(case, df, additionalParameters, parameter, n = 10
       params[[2]], params[[3]],
       params[[4]], params[[5]], params[[7]]
     )
+    result[, 2] <- result[, 2] + parameter[2]
   }
   return(result)
 }

tsf/R/optimize.R

@@ -215,8 +215,17 @@ opti <- function(case, lowerBounds, upperBounds,
         env, lowerBounds, upperBounds, lossFct, ngen, npop,
         errorThreshold, Topo, FALSE, runAsShiny, add_info
       )
-      df <- create_data_df(df, res, case)
       params <- create_params_df(res, case)
+      forwardResult <- forward_simulation(
+        case, df,
+        additionalParameters, params
+      )
+      df <- create_data_df(df, res, case)
+      df[["Signal simulated"]] <- spline(
+        x = forwardResult[, 1],
+        y = forwardResult[, 2],
+        xout = df[, 1]
+      )$y
       lowerBounds <- correct_names_params(lowerBounds, case)
       upperBounds <- correct_names_params(upperBounds, case)
       additionalParameters <- correct_names_additional_param(
@@ -232,8 +241,17 @@ opti <- function(case, lowerBounds, upperBounds,
     },
     interrupt = function(e) {
       res <- runAsShiny$insilico
-      df <- create_data_df(df, res, case)
       params <- create_params_df(res, case)
+      forwardResult <- forward_simulation(
+        case, df,
+        additionalParameters, params
+      )
+      df <- create_data_df(df, res, case)
+      df[["Signal simulated"]] <- spline(
+        x = forwardResult[, 1],
+        y = forwardResult[, 2],
+        xout = df[, 1]
+      )$y
       lowerBounds <- correct_names_params(lowerBounds, case)
       upperBounds <- correct_names_params(upperBounds, case)
       additionalParameters <- correct_names_additional_param(