Merge branch 'develop' into init-size-dist

R/RcppExports.R

@@ -497,6 +497,10 @@ Interpolator__eval <- function(obj_, x) {
     .Call('_plant_Interpolator__eval', PACKAGE = 'plant', obj_, x)
 }
 
+Interpolator__set_extrapolate <- function(obj_, e) {
+    invisible(.Call('_plant_Interpolator__set_extrapolate', PACKAGE = 'plant', obj_, e))
+}
+
 Interpolator__x__get <- function(obj_) {
     .Call('_plant_Interpolator__x__get', PACKAGE = 'plant', obj_)
 }
@@ -3325,6 +3329,26 @@ FF16_Environment__ctor <- function(canopy_rescale_usually, soil_number_of_depths
     .Call('_plant_FF16_Environment__ctor', PACKAGE = 'plant', canopy_rescale_usually, soil_number_of_depths)
 }
 
+FF16_Environment__set_extrinsic_driver <- function(obj_, driver_name, x, y) {
+    invisible(.Call('_plant_FF16_Environment__set_extrinsic_driver', PACKAGE = 'plant', obj_, driver_name, x, y))
+}
+
+FF16_Environment__extrinsic_driver_extrapolation <- function(obj_, driver_name, extrapolate) {
+    invisible(.Call('_plant_FF16_Environment__extrinsic_driver_extrapolation', PACKAGE = 'plant', obj_, driver_name, extrapolate))
+}
+
+FF16_Environment__extrinsic_driver_evaluate <- function(obj_, driver_name, u) {
+    .Call('_plant_FF16_Environment__extrinsic_driver_evaluate', PACKAGE = 'plant', obj_, driver_name, u)
+}
+
+FF16_Environment__extrinsic_driver_evaluate_range <- function(obj_, driver_name, u) {
+    .Call('_plant_FF16_Environment__extrinsic_driver_evaluate_range', PACKAGE = 'plant', obj_, driver_name, u)
+}
+
+FF16_Environment__get_extrinsic_driver_names <- function(obj_) {
+    .Call('_plant_FF16_Environment__get_extrinsic_driver_names', PACKAGE = 'plant', obj_)
+}
+
 FF16_Environment__canopy_openness <- function(obj_, height) {
     .Call('_plant_FF16_Environment__canopy_openness', PACKAGE = 'plant', obj_, height)
 }
@@ -3337,10 +3361,6 @@ FF16_Environment__set_fixed_environment <- function(obj_, value, height_max) {
     invisible(.Call('_plant_FF16_Environment__set_fixed_environment', PACKAGE = 'plant', obj_, value, height_max))
 }
 
-FF16_Environment__set_soil_infiltration_rate <- function(obj_, rate) {
-    invisible(.Call('_plant_FF16_Environment__set_soil_infiltration_rate', PACKAGE = 'plant', obj_, rate))
-}
-
 FF16_Environment__set_soil_water_state <- function(obj_, state) {
     invisible(.Call('_plant_FF16_Environment__set_soil_water_state', PACKAGE = 'plant', obj_, state))
 }

R/RcppR6.R

@@ -1,6 +1,10 @@
 ## Generated by RcppR6: do not edit by hand
 ## Version: 0.2.4
+<<<<<<< HEAD
 ## Hash: f58c99ad15f3f665237bff0862aa5349
+=======
+## Hash: 584c07ca68ef8e920c7e89821952cc98
+>>>>>>> develop
 
 ##' @importFrom Rcpp evalCpp
 ##' @importFrom R6 R6Class
@@ -788,6 +792,9 @@ OdeRunner <- function(T) {
       },
       eval = function(x) {
         Interpolator__eval(self, x)
+      },
+      set_extrapolate = function(e) {
+        Interpolator__set_extrapolate(self, e)
       }),
     active=list(
       x = function(value) {
@@ -4854,6 +4861,21 @@ StochasticPatchRunner <- function(T, E) {
       initialize = function(ptr) {
         self$.ptr <- ptr
       },
+      set_extrinsic_driver = function(driver_name, x, y) {
+        FF16_Environment__set_extrinsic_driver(self, driver_name, x, y)
+      },
+      extrinsic_driver_extrapolation = function(driver_name, extrapolate) {
+        FF16_Environment__extrinsic_driver_extrapolation(self, driver_name, extrapolate)
+      },
+      extrinsic_driver_evaluate = function(driver_name, u) {
+        FF16_Environment__extrinsic_driver_evaluate(self, driver_name, u)
+      },
+      extrinsic_driver_evaluate_range = function(driver_name, u) {
+        FF16_Environment__extrinsic_driver_evaluate_range(self, driver_name, u)
+      },
+      get_extrinsic_driver_names = function() {
+        FF16_Environment__get_extrinsic_driver_names(self)
+      },
       canopy_openness = function(height) {
         FF16_Environment__canopy_openness(self, height)
       },
@@ -4863,9 +4885,6 @@ StochasticPatchRunner <- function(T, E) {
       set_fixed_environment = function(value, height_max) {
         FF16_Environment__set_fixed_environment(self, value, height_max)
       },
-      set_soil_infiltration_rate = function(rate) {
-        FF16_Environment__set_soil_infiltration_rate(self, rate)
-      },
       set_soil_water_state = function(state) {
         FF16_Environment__set_soil_water_state(self, state)
       },

R/ff16w.R

@@ -64,16 +64,15 @@ FF16w_StochasticPatchRunner <- function(p) {
 ## Helper:
 ##' @export
 ##' @rdname FF16_Environment
-##' @param infil_rate rate of water entering the first layer
-##' @param n_layers the number of layers
-##' @param init starting conditions
+##' @param soil_number_of_depths the number of soil layers
+##' @param rainfall constant function value for rainfall driver, y = rainfall
 FF16w_make_environment <- function(canopy_light_tol = 1e-4, 
                                    canopy_light_nbase = 17,
                                    canopy_light_max_depth = 16, 
                                    canopy_rescale_usually = TRUE,
                                    soil_number_of_depths = 1,
                                    soil_initial_state = 0.0,
-                                   soil_infiltration_rate = 0.0) {
+                                   rainfall = 1) {
 
   if(soil_number_of_depths < 1)
     stop("FF16w Environment must have at least one soil layer")
@@ -85,15 +84,18 @@ FF16w_make_environment <- function(canopy_light_tol = 1e-4,
                      canopy_light_nbase, 
                      canopy_light_max_depth)
 
-  # there might be a better way to skip this if using defaultss
+  # there might be a better way to skip this if using defaults
   if(sum(soil_initial_state) > 0.0) {
     if(soil_number_of_depths != length(soil_initial_state))
       stop("Not enough starting points for all layers")
 
     e$set_soil_water_state(soil_initial_state)
   }
 
-  e$set_soil_infiltration_rate(soil_infiltration_rate)
+  x <- seq(0, 10, 1)
+  y <- rep(rainfall, 11)
+  e$set_extrinsic_driver("rainfall", x, y)
+  e$extrinsic_driver_extrapolation("rainfall", TRUE);
 
   return(e)
 }

inst/RcppR6_classes.yml

@@ -215,6 +215,9 @@ Interpolator:
       return_type: "std::vector<double>"
       args: [x: "std::vector<double>"]
       name_cpp: r_eval
+    set_extrapolate:
+      return_type: void
+      args: [e: bool]
   active:
     x: {type: "std::vector<double>", access: member, name_cpp: get_x}
     y: {type: "std::vector<double>", access: member, name_cpp: get_y}
@@ -876,6 +879,22 @@ FF16_Environment:
       FF16_Environment object
       @export
   methods:
+    # unforunately need to expose these base Environment functions for every derived class...
+    set_extrinsic_driver:
+      args: [driver_name: "std::string", x: "std::vector<double>", y: "std::vector<double>"]
+      return_type: void
+    extrinsic_driver_extrapolation:
+      args: [driver_name: "std::string", extrapolate: bool]
+      return_type: void
+    extrinsic_driver_evaluate:
+      args: [driver_name: "std::string", u: double]
+      return_type: double
+    extrinsic_driver_evaluate_range:
+      args: [driver_name: "std::string", u: "std::vector<double>"]
+      return_type: "std::vector<double>"
+    get_extrinsic_driver_names:
+      args: []
+      return_type: "std::vector<std::string>"
     canopy_openness:
       args: [height: double]
       return_type: double
@@ -884,9 +903,6 @@ FF16_Environment:
     set_fixed_environment:
       args: [value: double, height_max: double]
       return_type: void
-    set_soil_infiltration_rate:
-      args: [rate: double]
-      return_type: void
     set_soil_water_state:
       args: [state: "std::vector<double>"]
       return_type: void

inst/include/plant/environment.h

@@ -8,6 +8,7 @@
 #include <plant/ode_interface.h>
 #include <plant/internals.h>
 #include <plant/util.h>
+#include <unordered_map>
 #include <Rcpp.h>
 
 using namespace Rcpp;
@@ -69,6 +70,44 @@ class Environment {
   size_t species_arriving_index;
 
   Internals vars;
+
+  /* EXSTRINSIC DRIVERS API*/
+
+  // initialise spline of driver with x, y control points
+  void set_extrinsic_driver(std::string driver_name, std::vector<double> const& x, std::vector<double> const& y) {
+    // if we wanted to be faster we could skip this check (but less safe)
+    if (extrinsic_drivers.count(driver_name) == 0) {
+      util::stop(driver_name + " doesn't exist in the list of extrinsic_drivers.");
+    } else {
+      extrinsic_drivers.at(driver_name).init(x, y);
+      extrinsic_driver_extrapolation(driver_name, false); // default no extrapolation
+    }
+  }
+
+  void extrinsic_driver_extrapolation(std::string driver_name, bool extrapolate) {
+    extrinsic_drivers.at(driver_name).set_extrapolate(extrapolate);
+  }
+
+  // evaluate/query interpolated spline for driver at point u, return s(u), where s is interpolated function
+  double extrinsic_driver_evaluate(std::string driver_name, double u) const {
+    return extrinsic_drivers.at(driver_name).eval(u);
+  }
+
+  // // evaluate/query interpolated spline for driver at vector of points, return vector of values
+  std::vector<double> extrinsic_driver_evaluate_range(std::string driver_name, std::vector<double> u) const {
+    return extrinsic_drivers.at(driver_name).r_eval(u);
+  }
+
+  std::vector<std::string> get_extrinsic_driver_names() {
+    auto ret = std::vector<std::string>();
+    for (auto const& driver : extrinsic_drivers) {
+      ret.push_back(driver.first);
+    }
+    return ret;
+  }
+
+protected:
+  std::unordered_map<std::string, interpolator::Interpolator> extrinsic_drivers;
 };
 
 }

inst/include/plant/interpolator.h

@@ -16,16 +16,20 @@ class Interpolator {
   void initialise();
 
   void add_point(double xi, double yi);
+  void add_point_sorted(double xi, double yi);
   void clear();
 
   double eval(double u) const;
+  double operator()(double u) const;
   size_t size() const;
 
   double min() const;
   double max() const;
+  void set_extrapolate(bool e);
 
   std::vector<double> get_x() const;
   std::vector<double> get_y() const;
+
 
   // * R interface
   SEXP r_get_xy() const;
@@ -35,7 +39,8 @@ class Interpolator {
   void check_active() const;
   std::vector<double> x, y;
   tk::spline tk_spline;
-  bool active;
+  bool active = false;
+  bool extrapolate = true;
 };
 
 }

inst/include/plant/models/ff16_environment.h

@@ -4,6 +4,8 @@
 
 #include <plant/environment.h>
 #include <plant/canopy.h>
+#include <plant/interpolator.h>
+#include <iostream>
 
 using namespace Rcpp;
 
@@ -19,14 +21,16 @@ class FF16_Environment : public Environment {
       : canopy_rescale_usually(canopy_rescale_usually) {
     time = 0.0;
     canopy = Canopy();
-    soil_infiltration_rate = 0.0;
     vars = Internals(soil_number_of_depths);
     set_soil_water_state(std::vector<double>(soil_number_of_depths, 0.0));
+    extrinsic_drivers["rainfall"] = interpolator::Interpolator();
   };
 
+
   // Light interface
   bool canopy_rescale_usually;
 
+  // private?
   Canopy canopy;
 
   // Should this be here or in canopy?
@@ -51,12 +55,9 @@ class FF16_Environment : public Environment {
     canopy.r_init_interpolators(state);
   }
 
-  // Soil interface
-  double soil_infiltration_rate;
-
   virtual void compute_rates() {
     for (size_t i = 0; i < vars.state_size; i++) {
-      vars.set_rate(i, soil_infiltration_rate / (i+1));
+      vars.set_rate(i, extrinsic_driver_evaluate("rainfall", time) / (i+1));
     }
   }
 
@@ -74,10 +75,6 @@ class FF16_Environment : public Environment {
     }
   }
 
-  void set_soil_infiltration_rate(double rate) {
-    soil_infiltration_rate = rate;
-  }
-
   // Core functions
   template <typename Function>
   void compute_environment(Function f_compute_competition, double height_max) {
@@ -92,7 +89,6 @@ class FF16_Environment : public Environment {
   void clear_environment() {
     canopy.clear();
   }
-
 };
 
 inline Rcpp::NumericMatrix get_state(const FF16_Environment environment) {