From 56765872197a30fe0e33f211c6ff7fa3e277ff23 Mon Sep 17 00:00:00 2001 From: Matthew-Supernaw-NOAA Date: Wed, 17 Apr 2024 11:21:36 -0400 Subject: [PATCH] updated operators --- R/operators.R | 74 +++++++++++++++++++ R/zzz.R | 1 + .../include/interface/rcpp/rcpp_interface.hpp | 2 + .../rcpp/rcpp_objects/rcpp_interface_base.hpp | 11 +++ test/testv.R | 10 ++- 5 files changed, 97 insertions(+), 1 deletion(-) create mode 100644 R/operators.R diff --git a/R/operators.R b/R/operators.R new file mode 100644 index 0000000..730c8ae --- /dev/null +++ b/R/operators.R @@ -0,0 +1,74 @@ + + +setMethod("Ops", signature(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), + function(e1, e2) callGeneric(e1, e2)) + + setMethod("Ops", signature(e1 = "Rcpp_Variable", e2 = "numeric"), + function(e1, e2) callGeneric(e1, e2)) + + setMethod("Ops", signature(e1 = "numeric", e2 = "Rcpp_Variable"), + function(e1, e2) callGeneric(e1, e2)) + +#Variable +setMethod("acos", signature(x = "Rcpp_Variable"), function (x) {new(Variable,acos(x$value))}) + setMethod("asin", signature(x = "Rcpp_Variable"), function (x) {new(Variable,asin(x$value))}) + setMethod("atan", signature(x = "Rcpp_Variable"), function (x) {new(Variable,atan(x$value))}) + setMethod("cos", signature(x = "Rcpp_Variable"), function (x) {new(Variable,cos(x$value))}) + setMethod("cosh", signature(x = "Rcpp_Variable"), function (x) {new(Variable,cosh(x$value))}) + setMethod("sin", signature(x = "Rcpp_Variable"), function (x) {new(Variable,sin(x$value))}) + setMethod("sinh", signature(x = "Rcpp_Variable"), function (x) {new(Variable,sinh(x$value))}) + setMethod("tan", signature(x = "Rcpp_Variable"), function (x) {new(Variable,tan(x$value))}) + setMethod("tanh", signature(x = "Rcpp_Variable"), function (x) {new(Variable,tanh(x$value))}) + setMethod("exp", signature(x = "Rcpp_Variable"), function (x) {new(Variable,exp(x$value))}) + setMethod("log10", signature(x = "Rcpp_Variable"), function (x) {new(Variable,log10(x$value))}) + setMethod("sqrt", signature(x = "Rcpp_Variable"), function (x) {new(Variable, (x$value^0.5))}) + setMethod("log", signature(x = "Rcpp_Variable"), function (x, base=exp(1)){return(new(Variable,log(x$value)))}) + + setMethod("^", signature(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), function (e1, e2){ + (e1$value^e2$value)}) + setMethod("^", signature(e1 = "Rcpp_Variable", e2 = "numeric"), function (e1, e2){ + ((e1$value^ e2))}) + setMethod("^", signature(e1 = "numeric", e2 = "Rcpp_Variable"), function (e1, e2){ + (e1^ e2$value)}) + + #+ + setMethod("+", signature(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1$value + e2$value))}) + setMethod("+", signature(e1 = "Rcpp_Variable", e2 = "numeric"), function (e1, e2){ + return(new(Variable,e1$value + e2))}) + setMethod("+", signature(e1 = "numeric", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1 + e2$value))}) + #- + setMethod("-", signature(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1$value - e2$value))}) + setMethod("-", signature(e1 = "Rcpp_Variable", e2 = "numeric"), function (e1, e2){ + return (new(Variable,e1 - e2$value))}) + setMethod("-", signature(e1 = "numeric", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1 - e2$value))}) + + #* + setMethod("*", signature(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1$value * e2$value))}) + setMethod("*", signature(e1 = "Rcpp_Variable", e2 = "numeric"), function (e1, e2){ + return(new(Variable,e1$value * e2))}) + setMethod("*", signature(e1 = "numeric", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1 * e2$value))}) + + #/ + setMethod("/", signature(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1$value / e2$value))}) + setMethod("/", signature(e1 = "Rcpp_Variable", e2 = "numeric"), function (e1, e2){ + return(new(Variable,e1$value / e2))}) + setMethod("/", signature(e1 = "numeric", e2 = "Rcpp_Variable"), function (e1, e2){ + return(new(Variable,e1 / e2$value))}) + + +# ------------------------------------------------------------------------- + +#setMethod("<-", c(e1 = "Rcpp_Variable", e2 = "Rcpp_Variable"), function (e1, e2){ + # (e1$value<- e2$value)}) + +#setMethod("=", c(e1 = "Rcpp_Variable", e2 = "numeric"), function (e1, e2){ + # (e1$value<- e2)}) + + diff --git a/R/zzz.R b/R/zzz.R index 5b91598..70a2ece 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -18,3 +18,4 @@ setMethod("length", signature(x = "Rcpp_VariableVector"), function(x) { return(x$size()) }) + diff --git a/inst/include/interface/rcpp/rcpp_interface.hpp b/inst/include/interface/rcpp/rcpp_interface.hpp index 61bec8b..c0ae5e8 100644 --- a/inst/include/interface/rcpp/rcpp_interface.hpp +++ b/inst/include/interface/rcpp/rcpp_interface.hpp @@ -69,6 +69,7 @@ void clear(){ RCPP_MODULE(growth) { Rcpp::class_("Variable") .constructor() + .constructor() .field("value", &Variable::value) .field("estimable",&Variable::estimable) .field("id",&Variable::id); @@ -116,6 +117,7 @@ RCPP_MODULE(growth) { Rcpp::function("get_parameter_names_vector", get_parameter_names_vector); Rcpp::function("clear", clear); Rcpp::function("CreateModel", CreateModel); + Rcpp::function("CreateVector", CreateVector); }; #endif diff --git a/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp b/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp index e336d42..59d5a62 100644 --- a/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp +++ b/inst/include/interface/rcpp/rcpp_objects/rcpp_interface_base.hpp @@ -24,11 +24,18 @@ class Variable { double value = 0; std::string name_m; + Variable() { this->id = Variable::id_g++; Variable::parameters.push_back(this); } + Variable(double d) { + this->id = Variable::id_g++; + Variable::parameters.push_back(this); + this->value = d; + } + Variable(const Variable& other){ this->id = other.id; this->estimable = other.estimable; @@ -124,6 +131,10 @@ uint32_t VariableVector::id_g = 0; +VariableVector CreateVector(size_t size){ + return VariableVector(size); +} + /** *@brief Base class for all interface objects diff --git a/test/testv.R b/test/testv.R index d7b6169..cb358d4 100644 --- a/test/testv.R +++ b/test/testv.R @@ -1,7 +1,7 @@ library(ModularTMBExample) -v<-new(VariableVector, 100) +v<-CreateVector(100) #new(VariableVector, 100) str(v) str(v[1]) @@ -24,3 +24,11 @@ v$resize(10) for( i in 1:length(v)){ print(v[i]$id) } + + +var<-v[1] + cos(v[2]) +str(var) +print(v[1]$value) +print(v[2]$value) +print(cos(v[2]$value)) +str(var)