Merge pull request #2665 from tezansahu/api_2

Endpoints for PFT details & plotting of run outputs

apps/api/R/entrypoint.R

@@ -27,6 +27,10 @@ root$mount("/api/models", models_pr)
 sites_pr <- plumber::plumber$new("sites.R")
 root$mount("/api/sites", sites_pr)
 
+# The endpoints mounted here are related to details of PEcAn pfts
+pfts_pr <- plumber::plumber$new("pfts.R")
+root$mount("/api/pfts", pfts_pr)
+
 # The endpoints mounted here are related to details of PEcAn workflows
 workflows_pr <- plumber::plumber$new("workflows.R")
 root$mount("/api/workflows", workflows_pr)

apps/api/R/models.R

@@ -19,21 +19,31 @@ getModel <- function(model_id, res){
 
   qry_res <- Model %>% collect()
 
-  PEcAn.DB::db.close(dbcon)
-
   if (nrow(qry_res) == 0) {
+    PEcAn.DB::db.close(dbcon)
     res$status <- 404
     return(list(error="Model not found"))
   }
   else {
-    return(qry_res)
+    # Convert the response from tibble to list
+    response <- list()
+    for(colname in colnames(qry_res)){
+      response[colname] <- qry_res[colname]
+    }
+
+    inputs_req <- tbl(dbcon, "modeltypes_formats") %>% 
+      filter(modeltype_id == bit64::as.integer64(qry_res$modeltype_id)) %>% 
+      select(input=tag, required) %>% collect()
+    response$inputs <- jsonlite::fromJSON(gsub('(\")', '"', jsonlite::toJSON(inputs_req)))
+    PEcAn.DB::db.close(dbcon)
+    return(response)
   }
 }
 
 #########################################################################
 
-#' Search for PEcAn sites containing wildcards for filtering
-#' @param name Model name search string (character)
+#' Search for PEcAn model(s) containing wildcards for filtering
+#' @param model_name Model name search string (character)
 #' @param revision Model version/revision search string (character)
 #' @param ignore_case Logical. If `TRUE` (default) use case-insensitive search otherwise, use case-sensitive search
 #' @return Model subset matching the model search string

apps/api/R/pfts.R

@@ -0,0 +1,83 @@
+library(dplyr)
+
+#' Retrieve the details of a PEcAn PFT, based on pft_id
+#' @param pft_id PFT ID (character)
+#' @return PFT details
+#' @author Tezan Sahu
+#* @get /<pft_id>
+getPfts <- function(pft_id, res){
+
+  dbcon <- PEcAn.DB::betyConnect()
+
+  pft <- tbl(dbcon, "pfts") %>%
+    select(pft_id = id, pft_name = name, definition, pft_type, modeltype_id) %>%
+    filter(pft_id == !!pft_id)
+
+  pft <- tbl(dbcon, "modeltypes") %>%
+    select(modeltype_id = id, model_type = name) %>%
+    inner_join(pft, by = "modeltype_id")
+
+  qry_res <- pft %>% 
+    select(-modeltype_id) %>% 
+    collect()
+
+  PEcAn.DB::db.close(dbcon)
+
+  if (nrow(qry_res) == 0) {
+    res$status <- 404
+    return(list(error="PFT not found"))
+  }
+  else {
+    # Convert the response from tibble to list
+    response <- list()
+    for(colname in colnames(qry_res)){
+      response[colname] <- qry_res[colname]
+    }
+
+    return(response)
+  }
+}
+
+#########################################################################
+
+#' Search for PFTs containing wildcards for filtering
+#' @param pft_name PFT name search string (character)
+#' @param pft_type PFT type (either 'plant' or 'cultivar') (character)
+#' @param model_type Model type serch string (character)
+#' @param ignore_case Logical. If `TRUE` (default) use case-insensitive search otherwise, use case-sensitive search
+#' @return PFT subset matching the searc criteria
+#' @author Tezan Sahu
+#* @get /
+searchPfts <- function(pft_name="", pft_type="", model_type="", ignore_case=TRUE, res){
+  if(! pft_type %in% c("", "plant", "cultivar")){
+    res$status <- 400
+    return(list(error = "Invalid pft_type"))
+  }
+
+  dbcon <- PEcAn.DB::betyConnect()
+
+  pfts <- tbl(dbcon, "pfts") %>%
+    select(pft_id = id, pft_name = name, pft_type, modeltype_id)
+
+  pfts <- tbl(dbcon, "modeltypes") %>%
+    select(modeltype_id = id, model_type = name) %>%
+    inner_join(pfts, by = "modeltype_id")
+
+  qry_res <- pfts %>% 
+    filter(grepl(!!pft_name, pft_name, ignore.case=ignore_case)) %>%
+    filter(grepl(!!pft_type, pft_type, ignore.case=ignore_case)) %>%
+    filter(grepl(!!model_type, model_type, ignore.case=ignore_case)) %>%
+    select(-modeltype_id) %>%
+    arrange(pft_id) %>%
+    collect()
+
+  PEcAn.DB::db.close(dbcon)
+
+  if (nrow(qry_res) == 0) {
+    res$status <- 404
+    return(list(error="PFT(s) not found"))
+  }
+  else {
+    return(list(pfts=qry_res, count = nrow(qry_res)))
+  }
+}

apps/api/R/runs.R

@@ -7,7 +7,7 @@ library(dplyr)
 #' @return List of runs (belonging to a particuar workflow)
 #' @author Tezan Sahu
 #* @get /
-getRuns <- function(req, workflow_id, offset=0, limit=50, res){
+getRuns <- function(req, workflow_id=NULL, offset=0, limit=50, res){
   if (! limit %in% c(10, 20, 50, 100, 500)) {
     res$status <- 400
     return(list(error = "Invalid value for parameter"))
@@ -20,8 +20,12 @@ getRuns <- function(req, workflow_id, offset=0, limit=50, res){
 
   Runs <- tbl(dbcon, "ensembles") %>%
     select(runtype, ensemble_id=id, workflow_id) %>%
-    full_join(Runs, by="ensemble_id") %>%
-    filter(workflow_id == !!workflow_id)
+    full_join(Runs, by="ensemble_id") 
+
+  if(! is.null(workflow_id)){
+    Runs <- Runs %>%
+      filter(workflow_id == !!workflow_id)
+  }
 
   qry_res <- Runs %>% 
     arrange(id) %>%
@@ -76,22 +80,22 @@ getRuns <- function(req, workflow_id, offset=0, limit=50, res){
 
 #################################################################################################
 
-#' Get the of the run specified by the id
-#' @param id Run id (character)
+#' Get the details of the run specified by the id
+#' @param run_id Run id (character)
 #' @return Details of requested run
 #' @author Tezan Sahu
-#* @get /<id>
-getRunDetails <- function(id, res){
+#* @get /<run_id>
+getRunDetails <- function(run_id, res){
 
   dbcon <- PEcAn.DB::betyConnect()
 
   Runs <- tbl(dbcon, "runs") %>%
-    select(-outdir, -outprefix, -setting)
+    select(-outdir, -outprefix, -setting, -created_at, -updated_at)
 
   Runs <- tbl(dbcon, "ensembles") %>%
     select(runtype, ensemble_id=id, workflow_id) %>%
     full_join(Runs, by="ensemble_id") %>%
-    filter(id == !!id)
+    filter(id == !!run_id)
 
   qry_res <- Runs %>% collect()
 
@@ -102,6 +106,102 @@ getRunDetails <- function(id, res){
     return(list(error="Run with specified ID was not found"))
   }
   else {
-    return(qry_res)
+    # Convert the response from tibble to list
+    response <- list()
+    for(colname in colnames(qry_res)){
+      response[colname] <- qry_res[colname]
+    }
+
+    # If outputs exist on the host, add them to the response
+    outdir <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", response$workflow_id, "/out/", run_id)
+    if(dir.exists(outdir)){
+      response$outputs <- getRunOutputs(outdir)
+    }
+
+    return(response)
+  }
+}
+
+#################################################################################################
+
+#' Plot the results obtained from a run
+#' @param run_id Run id (character)
+#' @param year the year this data is for
+#' @param yvar the variable to plot along the y-axis.
+#' @param xvar the variable to plot along the x-axis, by default time is used.
+#' @param width the width of the image generated, default is 800 pixels.
+#' @param height the height of the image generated, default is 600 pixels.
+#' @return List of runs (belonging to a particuar workflow)
+#' @author Tezan Sahu
+#* @get /<run_id>/graph/<year>/<y_var>
+#* @serializer contentType list(type='image/png')
+
+plotResults <- function(run_id, year, y_var, x_var="time", width=800, height=600, res){
+  # Get workflow_id for the run
+  dbcon <- PEcAn.DB::betyConnect()
+
+  Run <- tbl(dbcon, "runs") %>%
+    filter(id == !!run_id)
+
+  workflow_id <- tbl(dbcon, "ensembles") %>%
+    select(ensemble_id=id, workflow_id) %>%
+    full_join(Run, by="ensemble_id")  %>%
+    filter(id == !!run_id) %>%
+    pull(workflow_id)
+
+  PEcAn.DB::db.close(dbcon)
+
+  # Check if the data file exists on the host
+  datafile <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", workflow_id, "/out/", run_id, "/", year, ".nc")
+  if(! file.exists(datafile)){
+    res$status <- 404
+    return()
+  }
+
+  # Plot & return
+  filename <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/temp", stringi::stri_rand_strings(1, 10), ".png")
+  PEcAn.visualization::plot_netcdf(datafile, y_var, x_var, as.integer(width), as.integer(height), year=year, filename=filename)
+  img_bin <- readBin(filename,'raw',n = file.info(filename)$size)
+  file.remove(filename)
+  return(img_bin)
+}
+
+#################################################################################################
+
+#' Get the outputs of a run (if the files exist on the host)
+#' @param outdir Run output directory (character)
+#' @return Output details of the run
+#' @author Tezan Sahu
+
+getRunOutputs <- function(outdir){
+  outputs <- list()
+  if(file.exists(paste0(outdir, "/logfile.txt"))){
+    outputs$logfile <- "logfile.txt"
+  }
+
+  if(file.exists(paste0(outdir, "/README.txt"))){
+    outputs$info <- "README.txt"
+  }
+
+  year_files <- list.files(outdir, pattern="*.nc$")
+  years <- stringr::str_replace_all(year_files, ".nc", "")
+  years_data <- c()
+  outputs$years <- list()
+  for(year in years){
+    var_lines <- readLines(paste0(outdir, "/", year, ".nc.var"))
+    keys <- stringr::word(var_lines, 1)
+    values <- stringr::word(var_lines, 2, -1)
+    vars <- list()
+    for(i in 1:length(keys)){
+      vars[keys[i]] <- values[i]
+    }
+    years_data <- c(years_data, list(list(
+      data = paste0(year, ".nc"),
+      variables = vars
+    )))
+  }
+  for(i in 1:length(years)){
+    outputs$years[years[i]] <- years_data[i]
   }
+  return(outputs)
 }

apps/api/R/sites.R

@@ -23,7 +23,12 @@ getSite <- function(site_id, res){
     return(list(error="Site not found"))
   }
   else {
-    return(qry_res)
+    # Convert the response from tibble to list
+    response <- list()
+    for(colname in colnames(qry_res)){
+      response[colname] <- qry_res[colname]
+    }
+    return(response)
   }
 }