POSIXct dates

DESCRIPTION

@@ -2,7 +2,7 @@ Package: medfate
 Type: Package
 Title: Mediterranean Forest Simulation
 Version: 4.3.2
-Date: 2024-05-31
+Date: 2024-06-03
 Authors@R: c(
  person('Miquel', 'De Cáceres', role=c('aut','cre', 'cph'),
  email='miquelcaceres@gmail.com', comment = c(ORCID = "0000-0001-7132-2080")),

NEWS.md

@@ -8,6 +8,7 @@
 - Default control parameters changed
 - Subdaily soil temperature change limited for stability with thin first layer
 - Column 'Strict' added to SpParamsDefinition
+- Detection of POSIXct date columns
 
 # Version 4.3.1
 - Functions forest2spwbInput/forest2growthInput deprecated. Preferred function names are spwbInput/growthInput.

R/RcppExports.R

@@ -3405,6 +3405,10 @@ soil_temperatureChange <- function(widths, Temp, sand, clay, W, Theta_SAT, Theta
  .Call(`_medfate_temperatureChange`, widths, Temp, sand, clay, W, Theta_SAT, Theta_FC, Gdown, tstep)
 }
 
+.getWeatherDates <- function(meteo) {
+ .Call(`_medfate_getWeatherDates`, meteo)
+}
+
 #' Single-day simulation
 #'
 #' Function \code{spwb_day} performs water balance for a single day and \code{growth_day} 

inst/include/medfate_RcppExports.h

@@ -1218,6 +1218,27 @@ namespace medfate {
  return Rcpp::as<NumericVector >(rcpp_result_gen);
  }
 
+ inline CharacterVector _getWeatherDates(DataFrame meteo) {
+ typedef SEXP(*Ptr__getWeatherDates)(SEXP);
+ static Ptr__getWeatherDates p__getWeatherDates = NULL;
+ if (p__getWeatherDates == NULL) {
+ validateSignature("CharacterVector(*_getWeatherDates)(DataFrame)");
+ p__getWeatherDates = (Ptr__getWeatherDates)R_GetCCallable("medfate", "_medfate__getWeatherDates");
+ }
+ RObject rcpp_result_gen;
+ {
+ RNGScope RCPP_rngScope_gen;
+ rcpp_result_gen = p__getWeatherDates(Shield<SEXP>(Rcpp::wrap(meteo)));
+ }
+ if (rcpp_result_gen.inherits("interrupted-error"))
+ throw Rcpp::internal::InterruptedException();
+ if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen))
+ throw Rcpp::LongjumpException(rcpp_result_gen);
+ if (rcpp_result_gen.inherits("try-error"))
+ throw Rcpp::exception(Rcpp::as<std::string>(rcpp_result_gen).c_str());
+ return Rcpp::as<CharacterVector >(rcpp_result_gen);
+ }
+
  inline List spwb_day(List x, CharacterVector date, NumericVector meteovec, double latitude, double elevation, double slope = NA_REAL, double aspect = NA_REAL, double runon = 0.0, Nullable<NumericVector> lateralFlows = R_NilValue, double waterTableDepth = NA_REAL, bool modifyInput = true) {
  typedef SEXP(*Ptr_spwb_day)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP);
  static Ptr_spwb_day p_spwb_day = NULL;

src/RcppExports.cpp

@@ -5027,6 +5027,40 @@ RcppExport SEXP _medfate_temperatureChange(SEXP widthsSEXP, SEXP TempSEXP, SEXP
  UNPROTECT(1);
  return rcpp_result_gen;
 }
+// getWeatherDates
+CharacterVector getWeatherDates(DataFrame meteo);
+static SEXP _medfate_getWeatherDates_try(SEXP meteoSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< DataFrame >::type meteo(meteoSEXP);
+ rcpp_result_gen = Rcpp::wrap(getWeatherDates(meteo));
+ return rcpp_result_gen;
+END_RCPP_RETURN_ERROR
+}
+RcppExport SEXP _medfate_getWeatherDates(SEXP meteoSEXP) {
+ SEXP rcpp_result_gen;
+ {
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = PROTECT(_medfate_getWeatherDates_try(meteoSEXP));
+ }
+ Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
+ if (rcpp_isInterrupt_gen) {
+ UNPROTECT(1);
+ Rf_onintr();
+ }
+ bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen);
+ if (rcpp_isLongjump_gen) {
+ Rcpp::internal::resumeJump(rcpp_result_gen);
+ }
+ Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
+ if (rcpp_isError_gen) {
+ SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
+ UNPROTECT(1);
+ Rf_error("%s", CHAR(rcpp_msgSEXP_gen));
+ }
+ UNPROTECT(1);
+ return rcpp_result_gen;
+}
 // spwbDay
 List spwbDay(List x, CharacterVector date, NumericVector meteovec, double latitude, double elevation, double slope, double aspect, double runon, Nullable<NumericVector> lateralFlows, double waterTableDepth, bool modifyInput);
 static SEXP _medfate_spwbDay_try(SEXP xSEXP, SEXP dateSEXP, SEXP meteovecSEXP, SEXP latitudeSEXP, SEXP elevationSEXP, SEXP slopeSEXP, SEXP aspectSEXP, SEXP runonSEXP, SEXP lateralFlowsSEXP, SEXP waterTableDepthSEXP, SEXP modifyInputSEXP) {
@@ -5647,6 +5681,7 @@ static int _medfate_RcppExport_validate(const char* sig) {
  signatures.insert("NumericVector(*soil_thermalConductivity)(DataFrame,String)");
  signatures.insert("NumericVector(*soil_temperatureGradient)(NumericVector,NumericVector)");
  signatures.insert("NumericVector(*soil_temperatureChange)(NumericVector,NumericVector,NumericVector,NumericVector,NumericVector,NumericVector,NumericVector,double,double)");
+ signatures.insert("CharacterVector(*.getWeatherDates)(DataFrame)");
  signatures.insert("List(*spwb_day)(List,CharacterVector,NumericVector,double,double,double,double,double,Nullable<NumericVector>,double,bool)");
  signatures.insert("List(*.defineSPWBDailyOutput)(double,double,double,double,CharacterVector,List)");
  signatures.insert("void(*.fillSPWBDailyOutput)(List,List,List,int)");
@@ -5715,6 +5750,7 @@ RcppExport SEXP _medfate_RcppExport_registerCCallable() {
  R_RegisterCCallable("medfate", "_medfate_soil_thermalConductivity", (DL_FUNC)_medfate_thermalConductivity_try);
  R_RegisterCCallable("medfate", "_medfate_soil_temperatureGradient", (DL_FUNC)_medfate_temperatureGradient_try);
  R_RegisterCCallable("medfate", "_medfate_soil_temperatureChange", (DL_FUNC)_medfate_temperatureChange_try);
+ R_RegisterCCallable("medfate", "_medfate_.getWeatherDates", (DL_FUNC)_medfate_getWeatherDates_try);
  R_RegisterCCallable("medfate", "_medfate_spwb_day", (DL_FUNC)_medfate_spwbDay_try);
  R_RegisterCCallable("medfate", "_medfate_.defineSPWBDailyOutput", (DL_FUNC)_medfate_defineSPWBDailyOutput_try);
  R_RegisterCCallable("medfate", "_medfate_.fillSPWBDailyOutput", (DL_FUNC)_medfate_fillSPWBDailyOutput_try);
@@ -5984,6 +6020,7 @@ static const R_CallMethodDef CallEntries[] = {
  {"_medfate_thermalConductivity", (DL_FUNC) &_medfate_thermalConductivity, 2},
  {"_medfate_temperatureGradient", (DL_FUNC) &_medfate_temperatureGradient, 2},
  {"_medfate_temperatureChange", (DL_FUNC) &_medfate_temperatureChange, 9},
+ {"_medfate_getWeatherDates", (DL_FUNC) &_medfate_getWeatherDates, 1},
  {"_medfate_spwbDay", (DL_FUNC) &_medfate_spwbDay, 11},
  {"_medfate_defineSPWBDailyOutput", (DL_FUNC) &_medfate_defineSPWBDailyOutput, 6},
  {"_medfate_fillSPWBDailyOutput", (DL_FUNC) &_medfate_fillSPWBDailyOutput, 4},

src/spwb.cpp

@@ -20,16 +20,23 @@
 #include <meteoland.h>
 using namespace Rcpp;
 
+// [[Rcpp::export(".getWeatherDates")]]
 CharacterVector getWeatherDates(DataFrame meteo){
  CharacterVector dateStrings;
  String dateColumnName = NA_STRING;
  bool is_date_column = false;
  if(meteo.containsElementNamed("dates")) {
  dateColumnName = "dates";
  is_date_column = true;
+ } else if(meteo.containsElementNamed("date")) {
+ dateColumnName = "date";
+ is_date_column = true;
  } else if(meteo.containsElementNamed("Dates")) {
  dateColumnName = "Dates";
  is_date_column = true;
+ } else if(meteo.containsElementNamed("Date")) {
+ dateColumnName = "Date";
+ is_date_column = true;
  }
  if(is_date_column){
  RObject vector = Rcpp::as<Rcpp::RObject>(meteo[dateColumnName]);
@@ -50,8 +57,19 @@ CharacterVector getWeatherDates(DataFrame meteo){
  dS[i] = d.format("%Y-%m-%d");
  }
  dateStrings = dS;
+ } else if(vector.inherits("POSIXct")) {
+ DatetimeVector datetimeVector = Rcpp::as<Rcpp::DatetimeVector>(vector);
+ CharacterVector dS(datetimeVector.size(), NA_STRING);
+ for(int i=0;i< datetimeVector.size();i++) {
+ Datetime dt = datetimeVector[i];
+ Date d(dt.getYear(), dt.getMonth(), dt.getDay());
+ dS[i] = d.format("%Y-%m-%d");
+ }
+ dateStrings = dS;
  } else if(is<StringVector>(vector)) {
  dateStrings = Rcpp::as<Rcpp::StringVector>(vector);
+ } else {
+ stop("Could not parse date column.");
  }
  } else {
  dateStrings = meteo.attr("row.names");