updated operators

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)})
+
+

R/zzz.R

@@ -18,3 +18,4 @@ setMethod("length", signature(x = "Rcpp_VariableVector"),
           function(x) {
             return(x$size())
           })
+

inst/include/interface/rcpp/rcpp_interface.hpp

@@ -69,6 +69,7 @@ void clear(){
 RCPP_MODULE(growth) {
     Rcpp::class_<Variable>("Variable")
     .constructor()
+    .constructor<double>()
     .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

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

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)