R/beetle_score.R

In eco4cast/NEONeco4cast:

##' @title Generate null forecast from the Beetle group
##' @return None
##' @param targets_dir, directory where target csv is located
##' @param forecast_dir, directory where forecast is located
##' @param score_dir, directory where scores will be saved
##' @export
##'
##' @author Carl Boettiger
##' @author Anna Spiers
##'
##'

beetle_score <- function(targets_dir,
                         forecast_dir,
                         score_dir){

  richness_forecast <- readr::read_csv(file.path(forecast_dir, "richness_forecast.csv"))
  abund_forecast <- readr::read_csv(file.path(forecast_dir, "abund_forecast.csv"))

  ## Targets
  richness <- readr::read_csv(file.path(targets_dir,"richness.csv"))
  abund <- readr::read_csv(file.path(targets_dir,"abund.csv"))


  crps_score <- function(forecast,
                         target){

    ## Teach crps to treat NA observations as NA scores:
    scoring_fn <- function(y, dat)
      tryCatch(scoringRules::crps_sample(y, dat), error = function(e) NA_real_, finally = NA_real_)

    ## Left-join will keep only the rows for which site,month,year of the target match the predicted
    dplyr::left_join(forecast, target, by = c("siteID", "month", "year"))  %>%
      dplyr::mutate(id = paste(siteID, year, month, true, sep="-")) %>%
      dplyr::group_by(id) %>%
      dplyr::summarise(score = scoring_fn(true[[1]], y))
  }

  richness_score <- crps_score(richness_forecast, richness)
  abund_score <- crps_score(abund_forecast, abund)


  readr::write_csv(richness_score, "score/richness_score.csv")
  readr::write_csv(abund_score, "score/abund_score.csv")
  #publish(c("score/richness_score.csv", "score/abund_score.csv"))

}