added debug statements

NAMESPACE

@@ -18,7 +18,8 @@ export(LogisticSelectivity)
 export(Parameter)
 export(ParameterVector)
 export(RealVector)
-export(fims_int)
+export(SharedInt)
+export(SharedReal)
 export(Population)
 export(clear)
 export(create_default_parameters)

R/FIMS-package.R

@@ -28,7 +28,8 @@
 #' @export ParameterVector
 #' @export RealVector
 #' @export CreateVector
-#' @export fims_int
+#' @export SharedInt
+#' @export SharedReal
 #' @export Population
 #' @export set_log_throw_on_error
 #' @import methods

R/initialize_modules.R

@@ -24,7 +24,7 @@ initialize_module <- function(parameters, data, module_name) {
   # # Retrieve all objects in the environment
   # objs <- mget(ls())
   # modules <- get_rcpp_modules(objs)
-
+print(27)
   # Input checks
   # Check if parameters is a list and contains the necessary sub-elements
   if (!is.list(parameters)) {
@@ -35,19 +35,21 @@ initialize_module <- function(parameters, data, module_name) {
       lists."
     ))
   }
+
+  print(39)
   # Validate module_name
   if (!is.character(module_name) || length(module_name) != 1) {
     cli::cli_abort("{.var module_name} must be a single character string.")
   }
-
+print(44)
   # Check if module_name exists in the parameters list
   if (!module_name %in% c(
     names(parameters[["parameters"]]),
     names(parameters[["modules"]])
   )) {
     cli::cli_abort("{.var module_name} is missing from the {.var parameters}.")
   }
-
+print(52)
   # Define module class and fields
   module_class_name <- if (module_name == "population") {
     "Population"
@@ -64,12 +66,12 @@ initialize_module <- function(parameters, data, module_name) {
   } else {
     parameters[["modules"]][[module_name]][["form"]]
   }
-
+print(69)
   module_class <- get(module_class_name)
   module_fields <- names(module_class@fields)
   module <- methods::new(module_class)
   module_input <- parameters[["parameters"]][[module_name]]
-
+print(74)
   if (module_class_name == "Fleet") {
     module_fields <- setdiff(module_fields, c(
       "log_expected_index",
@@ -92,7 +94,7 @@ initialize_module <- function(parameters, data, module_name) {
         "log_Fmort"
       ))
     }
-
+print(97)
     # TODO: refactor "age-to-length-conversion" in FIMSFrame data and
     # "age_length_conversion_matrix" in the Rcpp interface to
     # "age_to_legnth_conversion" for consistency
@@ -116,7 +118,7 @@ initialize_module <- function(parameters, data, module_name) {
         "nlengths"
       ))
     }
-
+print(121)
     module_fields <- setdiff(module_fields, c(
       "age_length_conversion_matrix",
       "proportion_catch_numbers_at_length"
@@ -140,28 +142,38 @@ initialize_module <- function(parameters, data, module_name) {
   #   - Reconsider exposing `log_expected_index` and
   #     `proportion_catch_numbers_at_age` to users. Their IDs are linked with
   #     index and agecomp distributions. No input values are required.
-
+print(145)
   non_standard_field <- c(
     "ages", "nages", "nlengths",
     "estimate_prop_female",
     "nyears", "nseasons", "nfleets", "estimate_log_devs", "weights",
     "is_survey", "estimate_q", "random_q"
   )
+  print(152)
   for (field in module_fields) {
+  cat(field)
+  cat(" of [")
+  cat(module_fields)
+  cat("]\n")
     if (field %in% non_standard_field) {
+    cat(typeof(get_n_lengths(data)))
+    cat("\nnon standard\n\n")
+
       # TODO: reorder the list alphabetically
+        tryCatch(
+        {
       module[[field]] <- switch(field,
-        "ages" = get_ages(data),
-        "nages" = get_n_ages(data),
-        "nlengths" = get_n_lengths(data),
+        "ages" = new(RealVector, get_ages(data), length(get_ages(data))),
+        "nages" = as.integer(get_n_ages(data)),
+        "nlengths" = as.integer(get_n_lengths(data)),
         "estimate_prop_female" = TRUE,
-        "nyears" = get_n_years(data),
+        "nyears" = as.integer(get_n_years(data)),
         "nseasons" = 1,
         "nfleets" = length(parameters[["modules"]][["fleets"]]),
         "estimate_log_devs" = module_input[[
           paste0(module_class_name, ".estimate_log_devs")
         ]],
-        "weights" = m_weight_at_age(data),
+        "weights" = new(RealVector, m_weight_at_age(data), length(m_weight_at_age(data))),
         "is_survey" = !("landings" %in% fleet_types),
         "estimate_q" = module_input[[
           paste0(module_class_name, ".log_q.estimated")
@@ -172,15 +184,44 @@ initialize_module <- function(parameters, data, module_name) {
           module."
         ))
       )
+      },
+           error = function(cond) {
+            message(paste("error occured processing:", field))
+            message(conditionMessage(cond))
+            # Choose a return value in case of error
+            NA
+        },
+        warning = function(cond) {
+            message(paste("field caused a warning:", field))
+            message(conditionMessage(cond))
+            # Choose a return value in case of warning
+            NULL
+        },
+        finally = {
+            # NOTE:
+            # Here goes everything that should be executed at the end,
+            # regardless of success or error.
+            # If you want more than one expression to be executed, then you
+            # need to wrap them in curly brackets ({...}); otherwise you could
+            # just have written 'finally = <expression>' 
+            message(paste("Successfully processed field:", field))
+
+        }
+        )
+      print(178)
     } else {
+    cat("standard\n")
+    print(180)
       set_param_vector(
         field = field,
         module = module,
         module_input = module_input
       )
+      print(185)
     }
+     print(188)
   }
-
+print(190)
   return(module)
 }
 
@@ -468,9 +509,9 @@ initialize_index <- function(data, fleet_name) {
   module <- methods::new(Index, get_n_years(data))
 
   if ("landings" %in% fleet_type) {
-    module[["index_data"]] <- m_landings(data, fleet_name)
+    module[["index_data"]] <- new(RealVector,m_landings(data, fleet_name), length(m_landings(data, fleet_name)))
   } else if ("index" %in% fleet_type) {
-    module[["index_data"]] <- m_index(data, fleet_name)
+    module[["index_data"]] <- new(RealVector,m_index(data, fleet_name),length(m_index(data, fleet_name)))
   } else {
     cli::cli_abort(c(
       "Fleet type `{fleet_type}` is not valid for index module initialization.
@@ -513,7 +554,7 @@ initialize_age_comp <- function(data, fleet_name) {
   # TODO: review the AgeComp interface, do we want to add
   # `age_comp_data` as an argument?
 
-  module$age_comp_data <- age_comp_data *
+  age_comp_temp <- age_comp_data *
     get_data(data) |>
       dplyr::filter(
         name == fleet_name,
@@ -524,6 +565,9 @@ initialize_age_comp <- function(data, fleet_name) {
       ) |>
       dplyr::pull(valid_n)
 
+module$age_comp_data <- new(RealVector, age_comp_temp, length(age_comp_temp))
+
+
   return(module)
 }
 
@@ -561,7 +605,7 @@ initialize_length_comp <- function(data, fleet_name) {
   # TODO: review the LengthComp interface, do we want to add
   # `age_comp_data` as an argument?
 
-  module$length_comp_data <- length_comp_data *
+  length_comp_temp <- length_comp_data *
     get_data(data) |>
       dplyr::filter(
         name == fleet_name,
@@ -571,6 +615,8 @@ initialize_length_comp <- function(data, fleet_name) {
         valid_n = ifelse(value == -999, 1, uncertainty)
       ) |>
       dplyr::pull(valid_n)
+
+  module$length_comp_data <- new(RealVector, length_comp_temp, length(length_comp_temp))
 
   return(module)
 }

R/zzz.R

@@ -263,4 +263,43 @@ methods::setMethod(
 
 CreateRealVector <- function(values = numeric()) {
   new(RealVector, values = values)
-}
+}
+
+
+# Getter method
+setMethod("$", "Rcpp_SharedInt", function(x, name) {
+    if (name == "value") {
+        return(x$get())
+    }
+    stop("Invalid field")
+})
+
+# Setter method
+setMethod("$<-", "Rcpp_SharedInt", function(x, name, value) {
+    if (name == "value") {
+        x$set(value)
+        return(x)
+    }
+    stop("Invalid field")
+})
+
+
+
+# Getter method
+setMethod("$", "Rcpp_SharedReal", function(x, name) {
+    if (name == "value") {
+        return(x$get())
+    }
+    stop("Invalid field")
+})
+
+# Setter method
+setMethod("$<-", "Rcpp_SharedReal", function(x, name, value) {
+    if (name == "value") {
+        x$set(value)
+        return(x)
+    }
+    stop("Invalid field")
+})
+
+

inst/include/interface/rcpp/rcpp_interface.hpp

@@ -575,10 +575,9 @@ RCPP_EXPOSED_CLASS(Parameter)
 RCPP_EXPOSED_CLASS(ParameterVector)
 RCPP_EXPOSED_CLASS(RealVector)
 RCPP_EXPOSED_CLASS(SharedInt)
-RCPP_EXPOSED_CLASS(Shareddouble)
+RCPP_EXPOSED_CLASS(ShareReal)
+
 
-typedef SharedInt fims_int;
-typedef SharedReal fims_double;
 /**
  * @brief The `fims` Rcpp module construct, providing declarative code of what
  * the module exposes to R.
@@ -728,16 +727,16 @@ RCPP_MODULE(fims) {
             .method("get_id", &RealVector::get_id,
             "Gets the ID of the RealVector object.");
 
-    Rcpp::class_<fims_int>(
-            "fims_int",
+    Rcpp::class_<SharedInt>(
+            "SharedInt",
             "An RcppInterface class that defines the fims_int class.")
             .constructor()
             .constructor<int>()
             .method("get", &fims_int::get)
             .method("set", &fims_int::set);
 
-       Rcpp::class_<fims_double>(
-            "fims_double",
+       Rcpp::class_<SharedReal>(
+            "SharedReal",
             "An RcppInterface class that defines the fims_int class.")
             .constructor()
             .constructor<double>()

inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp

@@ -467,6 +467,14 @@ class RealVector {
     virtual ~RealVector() {
     }
 
+    RealVector& operator=(const Rcpp::NumericVector& v) {
+        this->storage_m->resize(v.size());
+        for (size_t i = 0; i < v.size(); i++) {
+            storage_m->at(i) = v[i];
+        }
+        return *this;
+    }
+
     /**
      * @brief Gets the ID of the RealVector object.
      */
@@ -569,12 +577,6 @@ class RealVector {
 };
 uint32_t RealVector::id_g = 0;
 
-
-
-
-
-
-
 /**
  *@brief Base class for all interface objects.
  */