diff --git a/inst/include/common/model.hpp b/inst/include/common/model.hpp index 251c9eb..af1a3a7 100644 --- a/inst/include/common/model.hpp +++ b/inst/include/common/model.hpp @@ -5,20 +5,21 @@ #include "def.hpp" #include "../pop_dy/von_bertalanffy.hpp" +#include "../common/data.hpp" template class Model{ public: - std::vector data; //TODO: make sure data not empty - std::vector ages; std::vector predicted; std::shared_ptr< VonBertalanffy > vb; + std::shared_ptr< ObsData > obsdata; std::vector parameters; Model(){ this->vb = std::make_shared >(); + this->obsdata = std::make_shared >(); } @@ -39,10 +40,10 @@ class Model{ */ Type evaluate(){ Type norm2 = 0.0; - for(int i =0; i < ages.size(); i++){ - Type pred = vb -> evaluate(ages[i]); + for(int i =0; i < obsdata -> ages.size(); i++){ + Type pred = vb -> evaluate(obsdata -> ages[i]); this->predicted[i] = pred; - norm2+=(pred-data[i])*(pred-data[i]); + norm2+=(pred-obsdata -> data[i])*(pred-obsdata -> data[i]); } return norm2; } diff --git a/inst/include/interface/rcpp/rcpp_interface.hpp b/inst/include/interface/rcpp/rcpp_interface.hpp index 2d84e24..09efb1f 100644 --- a/inst/include/interface/rcpp/rcpp_interface.hpp +++ b/inst/include/interface/rcpp/rcpp_interface.hpp @@ -5,11 +5,20 @@ #include "rcpp_objects/rcpp_growth.hpp" #include "rcpp_objects/rcpp_data.hpp" + +bool CreateModel(){ + for (size_t i = 0; i < RcppInterfaceBase::interface_objects.size(); + i++) { + RcppInterfaceBase::interface_objects[i]->prepare(); + } +} + /** * Exposes the Variable and vonBertalanffyInterface classes to R. */ RCPP_EXPOSED_CLASS(Variable) RCPP_EXPOSED_CLASS(vonBertalanffyInterface) +RCPP_EXPOSED_CLASS(ObsDataInterface) /** * Returns the initial values for the parameter set @@ -43,10 +52,11 @@ RCPP_MODULE(growth) { .field("estimable",&Variable::estimable); Rcpp::class_("ObsData") .constructor() - .method("prepare", &ObsDataInterface::prepare); + .method("finalize", &ObsDataInterface::finalize) + .field("Data", &ObsDataInterface::data) + .field("ages", &ObsDataInterface::ages); Rcpp::class_("vonBertalanffy") .constructor() - .method("prepare", &vonBertalanffyInterface::prepare) .method("finalize", &vonBertalanffyInterface::finalize) .field("k", &vonBertalanffyInterface::k) .field("l_inf", &vonBertalanffyInterface::l_inf) @@ -55,6 +65,7 @@ RCPP_MODULE(growth) { .field("beta", &vonBertalanffyInterface::beta); Rcpp::function("get_parameter_vector", get_parameter_vector); Rcpp::function("clear", clear); + Rcpp::function("CreateModel", CreateModel); }; #endif \ No newline at end of file diff --git a/inst/include/interface/rcpp/rcpp_objects/rcpp_data.hpp b/inst/include/interface/rcpp/rcpp_objects/rcpp_data.hpp index b8854f5..de71bd6 100644 --- a/inst/include/interface/rcpp/rcpp_objects/rcpp_data.hpp +++ b/inst/include/interface/rcpp/rcpp_objects/rcpp_data.hpp @@ -8,14 +8,14 @@ class ObsDataInterface : public RcppInterfaceBase { public: Rcpp::NumericVector data; Rcpp::NumericVector ages; + Rcpp::NumericVector predicted; - virtual bool prepare(){ - - if(this->data.size() != this->ages.size()){ - Rcpp::stop("ages vector length not equal to data vector length"); - } - - ObsData* obsdata; + template + bool prepare_local() { + + std::shared_ptr > model = Model::getInstance(); + std::shared_ptr< ObsData > obsdata; + obsdata = std::make_shared >(); obsdata->ages.resize(this->ages.size()); obsdata->data.resize(this->data.size()); @@ -24,7 +24,61 @@ class ObsDataInterface : public RcppInterfaceBase { obsdata->ages[i] = this->ages[i]; obsdata->data[i] = this->data[i]; } + model->predicted.resize(this->data.size()); + + return true; + } + + /** + * Prepares the model to work with TMB. + */ + virtual bool prepare() { + + + if (this->data.size() != this->ages.size()) { + Rcpp::stop("ages vector length not equal to data vector length"); + } + + this->predicted = Rcpp::NumericVector(this->ages.size()); + +#ifdef TMB_MODEL + + this->prepare_local(); + this->prepare_local(); + this->prepare_local(); + this->prepare_local(); + +#endif + + return true; + } + + /** + * Update the model parameter values and finalize. Sets the parameter values and evaluates the + * portable model once and transfers values back to the Rcpp interface. + */ + void finalize(Rcpp::NumericVector v) { + std::shared_ptr< Model > model = Model::getInstance(); + + if (this->data.size() != this->ages.size()) { + Rcpp::stop("finalize: ages vector length not equal to data vector length"); + } + + for (int i = 0; i < this->predicted.size(); i++) { + this->predicted[i] = model->predicted[i]; + } + } + + /** + * Print model values. + */ + void show_() { + Rcpp::Rcout << std::setw(15) << "observed " << std::setw(15) << "predicted\n"; + //Rcpp::Rcout << "Predicted size: " << this->predicted.size() << std::endl; + for (int i = 0; i < this->predicted.size(); i++) { + Rcpp::Rcout << std::left << std::setw(15) << this->data[i] << std::setw(15) << this->predicted[i] << "\n"; + } } }; diff --git a/inst/include/interface/rcpp/rcpp_objects/rcpp_growth.hpp b/inst/include/interface/rcpp/rcpp_objects/rcpp_growth.hpp index f5ce0f6..823dae1 100644 --- a/inst/include/interface/rcpp/rcpp_objects/rcpp_growth.hpp +++ b/inst/include/interface/rcpp/rcpp_objects/rcpp_growth.hpp @@ -17,80 +17,65 @@ class vonBertalanffyInterface { template - void prepare_local() { + bool prepare_local() { - std::shared_ptr > model_1 = Model::getInstance(); + std::shared_ptr > model = Model::getInstance(); + std::shared_ptr< VonBertalanffy > vb; + vb = std::make_shared >(); - // model_1->clear(); - model_1->predicted.resize(this->data.size()); - model_1->ages.resize(this->ages.size()); - model_1->data.resize(this->data.size()); - for (int i = 0; i < this->data.size(); i++) { - model_1->ages[i] = this->ages[i]; - model_1->data[i] = this->data[i]; - } //initialize k - model_1->vb->k = this->k.value; - + vb->k = this->k.value; //initialize l_inf - model_1->vb->l_inf = this->l_inf.value; - + vb->l_inf = this->l_inf.value; //initialize a_min - model_1->vb->a_min = this->a_min.value; - + vb->a_min = this->a_min.value; //initialize alpha - model_1->vb->alpha = this->alpha.value; - + vb->alpha = this->alpha.value; //initialize beta - model_1->vb->beta = this->beta.value; + vb->beta = this->beta.value; if (this->k.estimable) { - model_1->parameters.push_back(&(model_1->vb)->k); + model->parameters.push_back(&(vb)->k); } if (this->l_inf.estimable) { - model_1->parameters.push_back(&(model_1->vb)->l_inf); + model->parameters.push_back(&(vb)->l_inf); } if (this->a_min.estimable) { - model_1->parameters.push_back(&(model_1->vb)->a_min); + model->parameters.push_back(&(vb)->a_min); } if (this->alpha.estimable) { - model_1->parameters.push_back(&(model_1->vb)->alpha); + model->parameters.push_back(&(vb)->alpha); } if (this->beta.estimable) { - model_1->parameters.push_back(&(model_1->vb)->beta); + model->parameters.push_back(&(vb)->beta); } + return true; } /** * Prepares the model to work with TMB. */ - void prepare() { - - - if (this->data.size() != this->ages.size()) { - Rcpp::stop("ages vector length not equal to data vector length"); - } - - this->predicted = Rcpp::NumericVector(this->ages.size()); + virtual bool prepare() { #ifdef TMB_MODEL - this->prepare_local(); this->prepare_local(); this->prepare_local(); this->prepare_local(); + #endif + return true; } @@ -100,11 +85,9 @@ class vonBertalanffyInterface { */ void finalize(Rcpp::NumericVector v) { std::shared_ptr< Model > model = Model::getInstance(); - std::shared_ptr > vb = model->vb; + std::shared_ptr< VonBertalanffy > vb; + vb = std::make_shared >(); - if (this->data.size() != this->ages.size()) { - Rcpp::stop("finalize: ages vector length not equal to data vector length"); - } for (int i = 0; i < v.size(); i++) { (*model->parameters[i]) = v[i]; @@ -117,9 +100,6 @@ class vonBertalanffyInterface { this->l_inf.value = vb->l_inf; - for (int i = 0; i < this->predicted.size(); i++) { - this->predicted[i] = model->predicted[i]; - } } /** @@ -130,12 +110,6 @@ class vonBertalanffyInterface { Rcpp::Rcout << "k = " << this->k.value << "\n"; Rcpp::Rcout << "a_min = " << this->a_min.value << "\n"; Rcpp::Rcout << "l_inf = " << this->l_inf.value << "\n"; - Rcpp::Rcout << std::setw(15) << "observed " << std::setw(15) << "predicted\n"; - //Rcpp::Rcout << "Predicted size: " << this->predicted.size() << std::endl; - for (int i = 0; i < this->predicted.size(); i++) { - Rcpp::Rcout << std::left << std::setw(15) << this->data[i] << std::setw(15) << this->predicted[i] << "\n"; - } - } }; diff --git a/test/test.R b/test/test.R index acf7451..a7fd3be 100644 --- a/test/test.R +++ b/test/test.R @@ -39,13 +39,14 @@ vonB$l_inf$value<-7 vonB$l_inf$estimable<-TRUE #set data -vonB$data <-data +Dat <- new(g$ObsData) +Dat$Data <- data #set ages -vonB$ages<-ages +Dat$ages<-ages #prepare for interfacing with TMB -vonB$prepare() +g$CreateModel() #create an empty data list (data set above) data <- list()