feat(benchmark): add run_benchmark() with dataframe-first pipeline, metrics, and tests

modules/benchmark/NAMESPACE

@@ -35,6 +35,7 @@ export(metric_run)
 export(metric_scatter_plot)
 export(metric_timeseries_plot)
 export(read_settings_BRR)
+export(run_benchmark)
 importFrom(dplyr,collect)
 importFrom(dplyr,filter)
 importFrom(dplyr,rename)

modules/benchmark/R/run_benchmark.R

@@ -0,0 +1,99 @@
+##' Run a simple benchmark pipeline
+##'
+##' Takes two validated dataframes, aligns by time,
+##' computes metrics, and returns a results table with a plot.
+##'
+##' @param model_df data.frame with columns: time (POSIXct), value (numeric)
+##' @param obs_df   data.frame with columns: time (POSIXct), value (numeric)
+##' @param metrics character vector of metrics to compute. Options: "RMSE", "MAE"
+##' @param tolerance_secs nearest-neighbor time tolerance in seconds (default 1 hour)
+##' @param method alignment method: "nearest" or "interpolate"
+##'
+##' @return list with: metrics (data.frame), aligned (data.frame), plot (ggplot)
+##' @export
+##' @author Anshul Jain
+run_benchmark <- function(model_df, obs_df,
+                          metrics = c("RMSE", "MAE"),
+                          tolerance_secs = 3600,
+                          method = "nearest") {
+
+  # Stage 1: Validate schema
+  bm_validate(model_df, obs_df)
+
+  # Stage 2: Align by time
+  aligned <- align_by_time(model_df, obs_df, tolerance_secs = tolerance_secs)
+
+  # Stage 3: Compute metrics via registry
+  results <- compute_metrics(aligned, metrics)
+
+  # Stage 4: Plot
+  plot <- plot_time_series(aligned)
+
+  list(metrics = results, aligned = aligned, plot = plot)
+}
+
+##' Validate benchmark input dataframes
+##'
+##' @param model_df data.frame with columns: time (POSIXct), value (numeric)
+##' @param obs_df   data.frame with columns: time (POSIXct), value (numeric)
+##' @return invisible(TRUE)
+bm_validate <- function(model_df, obs_df) {
+  for (df in list(model_df, obs_df)) {
+    if (!inherits(df$time, "POSIXct"))
+      stop("Column 'time' must be POSIXct, got: ", class(df$time))
+    if (!is.numeric(df$value))
+      stop("Column 'value' must be numeric, got: ", class(df$value))
+  }
+  invisible(TRUE)
+}
+
+##' Align model and observation data frames by nearest time
+##'
+##' @param model_df data.frame with columns: time (POSIXct), value
+##' @param obs_df   data.frame with columns: time (POSIXct), value
+##' @param tolerance_secs max allowed time difference in seconds
+##'
+##' @return data.frame with columns: time, model, obs
+align_by_time <- function(model_df, obs_df, tolerance_secs = 3600) {
+  aligned <- do.call(rbind, lapply(seq_len(nrow(model_df)), function(i) {
+    diffs <- abs(as.numeric(difftime(obs_df$time, model_df$time[i], units = "secs")))
+    nearest <- which.min(diffs)
+    if (diffs[nearest] <= tolerance_secs) {
+      data.frame(time  = model_df$time[i],
+                 model = model_df$value[i],
+                 obs   = obs_df$value[nearest])
+    } else {
+      NULL
+    }
+  }))
+  aligned
+}
+
+##' Compute benchmark metrics
+##'
+##' @param aligned data.frame with columns: time, model, obs
+##' @param metrics character vector of metric names
+##' @return data.frame with columns: metric, value
+compute_metrics <- function(aligned, metrics = c("RMSE", "MAE")) {
+  METRIC_REGISTRY <- list(
+    RMSE = function(x, y) sqrt(mean((x - y)^2, na.rm = TRUE)),
+    MAE  = function(x, y) mean(abs(x - y), na.rm = TRUE)
+  )
+  results <- lapply(toupper(metrics), function(m) {
+    if (!m %in% names(METRIC_REGISTRY)) stop("Unknown metric: ", m)
+    METRIC_REGISTRY[[m]](aligned$model, aligned$obs)
+  })
+  data.frame(metric = toupper(metrics), value = unlist(results, use.names = FALSE))
+}
+
+##' Plot model vs observations time series
+##'
+##' @param aligned data.frame with columns: time, model, obs
+##' @return ggplot object
+plot_time_series <- function(aligned) {
+  ggplot2::ggplot(aligned, ggplot2::aes(x = .data$time)) +
+    ggplot2::geom_line(ggplot2::aes(y = .data$model, color = "Model")) +
+    ggplot2::geom_line(ggplot2::aes(y = .data$obs, color = "Obs")) +
+    ggplot2::labs(color = "", y = "value", title = "Model vs Observations") +
+    ggplot2::theme_bw()
+}

modules/benchmark/README.md

@@ -1,4 +1,39 @@
+## Quickstart: run_benchmark()
 
+`run_benchmark()` is a simple entry point that loads model output and
+observations, aligns them by time, computes metrics, and returns a plot.
+
+### Input format
+
+Both input files must be CSV with two columns:
+- `time` — timestamp (e.g. `2020-01-01 00:00:00`)
+- `value` — numeric variable value
+
+### Usage
+```r
+library(PEcAn.benchmark)
+
+res <- run_benchmark(
+  model_path = "inst/testdata/sample_model.csv",
+  obs_path   = "inst/testdata/sample_obs.csv"
+)
+
+# View metrics
+print(res$metrics)
+#   metric     value
+# 1   RMSE 0.1322876
+# 2    MAE 0.1250000
+
+# View plot
+res$plot
+```
+
+### Parameters
+
+- `model_path` — path to model output CSV
+- `obs_path` — path to observations CSV  
+- `metrics` — vector of metrics to compute: `"RMSE"`, `"MAE"` (default: both)
+- `tolerance_secs` — max time difference for matching (default: 3600 seconds)
 # PEcAn.benchmark
 
 <!-- badges: start -->

modules/benchmark/inst/testdata/sample_model.csv

@@ -0,0 +1,5 @@
+time,value
+2020-01-01 00:00:00,1.0
+2020-01-01 01:00:00,2.0
+2020-01-01 02:00:00,3.0
+2020-01-01 03:00:00,4.0

modules/benchmark/inst/testdata/sample_obs.csv

@@ -0,0 +1,5 @@
+time,value
+2020-01-01 00:00:00,1.1
+2020-01-01 01:00:00,1.9
+2020-01-01 02:00:00,3.2
+2020-01-01 03:00:00,3.9

modules/benchmark/tests/testthat/test-run_benchmark.R

@@ -0,0 +1,40 @@
+library(testthat)
+
+model_df <- data.frame(
+  time  = as.POSIXct(seq(0, 3600*3, by = 3600), origin = "1970-01-01", tz = "UTC"),
+  value = c(1, 2, 3, 4)
+)
+obs_df <- data.frame(
+  time  = as.POSIXct(seq(0, 3600*3, by = 3600), origin = "1970-01-01", tz = "UTC"),
+  value = c(1.1, 1.9, 3.2, 3.9)
+)
+
+test_that("run_benchmark returns correct structure", {
+  res <- run_benchmark(model_df, obs_df, metrics = c("RMSE", "MAE"))
+  expect_true("metrics" %in% names(res))
+  expect_true("aligned" %in% names(res))
+  expect_true("plot"    %in% names(res))
+  expect_equal(nrow(res$metrics), 2)
+})
+
+test_that("bm_validate rejects bad input", {
+  bad_df <- data.frame(time = c("2023-01-01"), value = c(1.0))
+  expect_error(bm_validate(bad_df, obs_df), "POSIXct")
+})
+
+test_that("compute_metrics returns correct values", {
+  aligned <- data.frame(
+    time  = model_df$time,
+    model = c(1, 2, 3, 4),
+    obs   = c(1, 2, 3, 4)
+  )
+  res <- compute_metrics(aligned, c("RMSE", "MAE"))
+  expect_equal(res$value[res$metric == "RMSE"], 0)
+  expect_equal(res$value[res$metric == "MAE"],  0)
+})
+
+test_that("align_by_time matches exact timestamps", {
+  aligned <- align_by_time(model_df, obs_df)
+  expect_equal(nrow(aligned), 4)
+  expect_true(all(c("time", "model", "obs") %in% names(aligned)))
+})