rcpp_interface.hpp

Go to the documentation of this file.

 
#ifndef FIMS_INTERFACE_RCPP_INTERFACE_HPP
#define FIMS_INTERFACE_RCPP_INTERFACE_HPP
#include "../../common/model.hpp"
#include "../../common/model_object.hpp"
#include "../../utilities/fims_json.hpp"
#include "rcpp_objects/rcpp_data.hpp"
#include "rcpp_objects/rcpp_distribution.hpp"
#include "rcpp_objects/rcpp_fleet.hpp"
#include "rcpp_objects/rcpp_growth.hpp"
#include "rcpp_objects/rcpp_interface_base.hpp"
#include "rcpp_objects/rcpp_maturity.hpp"
#include "rcpp_objects/rcpp_models.hpp"
#include "rcpp_objects/rcpp_natural_mortality.hpp"
#include "rcpp_objects/rcpp_population.hpp"
#include "rcpp_objects/rcpp_recruitment.hpp"
#include "rcpp_objects/rcpp_selectivity.hpp"
 
void init_logging() {
  std::signal(SIGSEGV, &fims::WriteAtExit);
  std::signal(SIGINT, &fims::WriteAtExit);
  std::signal(SIGABRT, &fims::WriteAtExit);
  std::signal(SIGFPE, &fims::WriteAtExit);
  std::signal(SIGILL, &fims::WriteAtExit);
  std::signal(SIGTERM, &fims::WriteAtExit);
}
 
bool CreateTMBModel() {
  init_logging();
 
  // clear first
  //  base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> info0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
  info0->Clear();
 
  std::shared_ptr<fims_info::Information<TMBAD_FIMS_TYPE>> info =
      fims_info::Information<TMBAD_FIMS_TYPE>::GetInstance();
  info->Clear();
 
  for (size_t i = 0; i < FIMSRcppInterfaceBase::fims_interface_objects.size();
       i++) {
    FIMSRcppInterfaceBase::fims_interface_objects[i]->add_to_fims_tmb();
  }
 
  // base model
  info0->CreateModel();
  info0->CheckModel();
 
  info->CreateModel();
 
  // instantiate the model? TODO: Ask Matthew what this does
  std::shared_ptr<fims_model::Model<TMB_FIMS_REAL_TYPE>> m0 =
      fims_model::Model<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  return true;
}
 
/* Dictionary block for shared documentation.
  [details_set_x_parameters]
  Updates the internal parameter values for the model base of type
  TMB_FIMS_REAL_TYPE. It is typically called before finalize() or
  @ref CatchAtAgeInterface::to_json "`get_output()`" to ensure the correct
  values are used because TMB doesn't always keep the updated parameters in
  the "double" version of the tape. So we need to update those first.
  \n\n
  Usage example in R:
  \code{.R}
  set_fixed_parameters(c(1, 2, 3))
  set_random_parameters(c(1, 2, 3))
  catch_at_age$get_output()
  \endcode
  [details_set_x_parameters]
*/
/* Dictionary block for shared documentation.
  [param_par]
  @param par A vector of parameter values.
  [param_par]
 */
 
void set_fixed_parameters(Rcpp::NumericVector par) {
  // base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> info0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  for (size_t i = 0; i < info0->fixed_effects_parameters.size(); i++) {
    *info0->fixed_effects_parameters[i] = par[i];
  }
}
 
Rcpp::NumericVector get_fixed_parameters_vector() {
  // base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> info0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  Rcpp::NumericVector p;
 
  for (size_t i = 0; i < info0->fixed_effects_parameters.size(); i++) {
    p.push_back(*info0->fixed_effects_parameters[i]);
  }
 
  return p;
}
 
void set_random_parameters(Rcpp::NumericVector par) {
  // base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> info0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  for (size_t i = 0; i < info0->random_effects_parameters.size(); i++) {
    *info0->random_effects_parameters[i] = par[i];
  }
}
 
Rcpp::NumericVector get_random_parameters_vector() {
  // base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> d0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  Rcpp::NumericVector p;
 
  for (size_t i = 0; i < d0->random_effects_parameters.size(); i++) {
    p.push_back(*d0->random_effects_parameters[i]);
  }
 
  return p;
}
 
Rcpp::List get_parameter_names(Rcpp::List pars) {
  // base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> d0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  pars.attr("names") = d0->parameter_names;
 
  return pars;
}
 
Rcpp::List get_random_names(Rcpp::List pars) {
  // base model
  std::shared_ptr<fims_info::Information<TMB_FIMS_REAL_TYPE>> d0 =
      fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance();
 
  pars.attr("names") = d0->random_effects_names;
 
  return pars;
}
 
template <typename Type>
void clear_internal() {
  std::shared_ptr<fims_info::Information<Type>> d0 =
      fims_info::Information<Type>::GetInstance();
  d0->Clear();
}
 
void clear_impl(bool get_error_msg) {
  // rcpp_interface_base.hpp
  FIMSRcppInterfaceBase::fims_interface_objects.clear();
 
  // Variable and VariableVector
  Variable::id_g = 1;
  VariableVector::id_g = 1;
  // rcpp_data.hpp
  DataInterfaceBase::id_g = 1;
  DataInterfaceBase::live_objects.clear();
 
  AgeCompDataInterface::id_g = 1;
  AgeCompDataInterface::live_objects.clear();
 
  LengthCompDataInterface::id_g = 1;
  LengthCompDataInterface::live_objects.clear();
 
  LandingsDataInterface::id_g = 1;
  LandingsDataInterface::live_objects.clear();
 
  IndexDataInterface::id_g = 1;
  IndexDataInterface::live_objects.clear();
 
  // rcpp_fleets.hpp
  FleetInterfaceBase::id_g = 1;
  FleetInterfaceBase::live_objects.clear();
 
  FleetInterface::id_g = 1;
  FleetInterface::live_objects.clear();
 
  // rcpp_growth.hpp
  GrowthInterfaceBase::id_g = 1;
  GrowthInterfaceBase::live_objects.clear();
 
  EWAAGrowthInterface::id_g = 1;
  EWAAGrowthInterface::live_objects.clear();
 
  // rcpp_maturity.hpp
  MaturityInterfaceBase::id_g = 1;
  MaturityInterfaceBase::live_objects.clear();
 
  LogisticMaturityInterface::id_g = 1;
  LogisticMaturityInterface::live_objects.clear();
 
  // rcpp_population.hpp
  PopulationInterfaceBase::id_g = 1;
  PopulationInterfaceBase::live_objects.clear();
 
  PopulationInterface::id_g = 1;
  PopulationInterface::live_objects.clear();
 
  // rcpp_recruitment.hpp
  RecruitmentInterfaceBase::id_g = 1;
  RecruitmentInterfaceBase::live_objects.clear();
 
  BevertonHoltRecruitmentInterface::id_g = 1;
  BevertonHoltRecruitmentInterface::live_objects.clear();
 
  // rcpp_selectivity.hpp
  SelectivityInterfaceBase::id_g = 1;
  SelectivityInterfaceBase::live_objects.clear();
 
  LogisticSelectivityInterface::id_g = 1;
  LogisticSelectivityInterface::live_objects.clear();
 
  DoubleLogisticSelectivityInterface::id_g = 1;
  DoubleLogisticSelectivityInterface::live_objects.clear();
 
  // rcpp_distribution.hpp
  DistributionsInterfaceBase::id_g = 1;
  DistributionsInterfaceBase::live_objects.clear();
 
  DnormDistributionsInterface::id_g = 1;
  DnormDistributionsInterface::live_objects.clear();
 
  DlnormDistributionsInterface::id_g = 1;
  DlnormDistributionsInterface::live_objects.clear();
 
  DmultinomDistributionsInterface::id_g = 1;
  DmultinomDistributionsInterface::live_objects.clear();
 
  FisheryModelInterfaceBase::id_g = 1;
  FisheryModelInterfaceBase::live_objects.clear();
 
  clear_internal<TMB_FIMS_REAL_TYPE>();
  clear_internal<TMBAD_FIMS_TYPE>();
 
  fims::FIMSLog::fims_log->clear();
 
  std::unique_ptr<fims_popdy::LogisticSelectivity<double>> test_obj;
  if (get_error_msg) {
    test_obj = std::make_unique<fims_popdy::LogisticSelectivity<double>>();
  }
 
  // --- AUTOMATED DANGLING POINTER DIAGNOSTIC PRINT ---
  if (fims_model_object::FIMSMemoryTracker::total_active_objects > 0) {
    std::ostringstream msg;
    msg << "\n⚠️  WARNING: FIMS Dangling Pointer or Module Detected after "
           "clear()!\n";
    msg << "--------------------------------------------------\n";
    msg << "A total of "
        << fims_model_object::FIMSMemoryTracker::total_active_objects
        << " pointer(s) NOT cleared\n";
    msg << "--------------------------------------------------\n";
    msg << "Ensure all pointers are being reset.\n\n";
 
    Rcpp::warning(msg.str());
  }
}
 
void clear() { clear_impl(false); }
 
void test_clear_with_leak_check() { clear_impl(true); }
 
std::string get_log() { return fims::FIMSLog::fims_log->get_log(); }
 
std::string get_log_errors() { return fims::FIMSLog::fims_log->get_errors(); }
 
std::string get_log_warnings() {
  return fims::FIMSLog::fims_log->get_warnings();
}
 
std::string get_log_info() { return fims::FIMSLog::fims_log->get_info(); }
 
void write_log(bool write) { fims::FIMSLog::fims_log->write_on_exit = write; }
 
void set_log_path(const std::string &path) {
  fims::FIMSLog::fims_log->set_path(path);
}
 
void set_log_throw_on_error(bool throw_on_error) {
  fims::FIMSLog::fims_log->throw_on_error = throw_on_error;
}
 
void log_info(std::string log_entry) {
  fims::FIMSLog::fims_log->info_message(log_entry, -1, "R_env",
                                        "R_script_entry");
}
 
void log_warning(std::string log_entry) {
  fims::FIMSLog::fims_log->warning_message(log_entry, -1, "R_env",
                                           "R_script_entry");
}
 
std::string escapeQuotes(const std::string &input) {
  std::string result = input;
  std::string search = "\"";
  std::string replace = "\\\"";
 
  // Find each occurrence of `"` and replace it with `\"`
  size_t pos = result.find(search);
  while (pos != std::string::npos) {
    result.replace(pos, search.size(), replace);
    pos = result.find(search,
                      pos + replace.size());  // Move past the replaced position
  }
  return result;
}
 
void log_error(std::string log_entry) {
  std::stringstream ss;
  ss << "capture.output(traceback(4))";
  SEXP expression, result;
  ParseStatus status;
 
  PROTECT(expression = R_ParseVector(Rf_mkString(ss.str().c_str()), 1, &status,
                                     R_NilValue));
  if (status != PARSE_OK) {
    Rcpp::Rcout << "Error parsing expression" << std::endl;
    UNPROTECT(1);
  }
  Rcpp::Rcout << "before call.";
  PROTECT(result = Rf_eval(VECTOR_ELT(expression, 0), R_GlobalEnv));
  Rcpp::Rcout << "after call.";
  UNPROTECT(2);
  std::stringstream ss_ret;
  ss_ret << "traceback: ";
  for (int j = 0; j < LENGTH(result); j++) {
    std::string str(CHAR(STRING_ELT(result, j)));
    ss_ret << escapeQuotes(str) << "\\n";
  }
 
  std::string ret =
      ss_ret.str();  //"find error";//Rcpp::as<std::string>(result);
 
  fims::FIMSLog::fims_log->error_message(log_entry, -1, "R_env", ret.c_str());
}
#endif  // FIMS_INTERFACE_RCPP_INTERFACE_HPP