Merge pull request #20 from EvolEcolGroup/dev

Fix Krapp2021 to work with new version of terra

.Rbuildignore

@@ -10,3 +10,4 @@ ci_dependencies
 ^cran-comments.md
 ^cran-comments\.md$
 ^CRAN-SUBMISSION$
+^codecov.yml

.circleci/config.yml

@@ -179,7 +179,7 @@ jobs:
       - run: rm deps_checksum  # Delete the temp file with the dir checksum
 
       - *devtools-check # (includes vignettes)
-      - *code-cov   
+#      - *code-cov   
 
 
 ###################################

.github/workflows/test-coverage.yaml

@@ -0,0 +1,35 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master, rcheck]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: r-lib/actions/setup-pandoc@v2
+#        with:
+#          pandoc-version: '2.17.1'
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr
+          needs: coverage
+
+      - name: Test coverage
+        run: covr::codecov(type="all")
+        shell: Rscript {0}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: pastclim
 Type: Package
 Title: Manipulate Time Series of Palaeoclimate Reconstructions 
-Version: 1.2.1
+Version: 1.2.2
 Authors@R: c(
        person("Michela", "Leonardi", role = "aut"),
        person(c("Emily","Y."), "Hallet", role = "ctb"),

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(check_dataset_path)
+export(clean_data_path)
 export(climate_for_locations)
 export(climate_for_time_slice)
 export(df_from_region_series)
@@ -27,5 +28,6 @@ export(set_data_path_for_CRAN)
 export(slice_region_series)
 export(time_bp)
 export(time_series_for_locations)
+export(update_dataset_list)
 export(var_labels)
 import(terra)

NEWS.md

@@ -1,3 +1,8 @@
+# pastclim 1.2.2
+* Update of Krapp2021 files to make them compatible with how terra now handles
+  time. Users will have to redownload datasets. Old files can be removed with
+  'clean_data_path()'
+
 # pastclim 1.2.1
 * Small updates for CRAN submission.
 

R/clean_data_path.R

@@ -0,0 +1,35 @@
+#' Clean the data path 
+#'
+#' This function deletes old reconstructions that have been superseded in the
+#' data_path. It assumes that the only files in data_path are part of pastclim
+#' (i.e. there are no custom datasets stored in that directory).
+#'
+#' @param ask boolean on whether the user should be asked before deleting
+#' @returns TRUE if files are deleted successfully
+#' @export
+
+clean_data_path <- function(ask=TRUE) {
+  if (is.null(get_data_path(silent=TRUE))){
+    message("The data path has not been set yet; use set_data_path() first!")
+    return(FALSE)
+  }
+  files_now <- list.files(get_data_path())
+  possible_files <- unique(getOption("pastclim.dataset_list")$file_name)
+  files_to_remove <- files_now[!files_now %in% possible_files]
+  if (length(files_to_remove)>0){
+    if (ask){
+      this_answer <- utils::menu(choices = c("yes","no"),
+                title = paste("The following files are obsolete:\n",
+                                   paste(files_to_remove,collapse = ", "),
+                                   "\n Do you want to delete them?"))
+    } else { # default to delete if we are not asking
+      this_answer <- 1
+    }
+    if (this_answer==1){
+      file.remove(file.path(get_data_path(),files_to_remove))
+    }
+  } else {
+    message("Everything is up-to-date; no files need removing.")
+  }
+  return(TRUE)
+}

R/download_dataset.R

@@ -16,7 +16,7 @@
 download_dataset <- function(dataset, bio_variables = NULL) {
 
   # check the dataset exists
-  available_datasets <- unique(files_by_dataset$dataset)
+  available_datasets <- unique(getOption("pastclim.dataset_list")$dataset)
   if (!dataset %in% available_datasets) {
     stop(
       "'dataset' must be one of ",
@@ -26,7 +26,7 @@ download_dataset <- function(dataset, bio_variables = NULL) {
 
   # check that the variable is available for this dataset
   available_variables <-
-    files_by_dataset$variable[files_by_dataset$dataset == dataset]
+    getOption("pastclim.dataset_list")$variable[getOption("pastclim.dataset_list")$dataset == dataset]
   # if variable is null, donwload all possible variables
   if (is.null(bio_variables)) {
     bio_variables <- available_variables
@@ -50,15 +50,21 @@ download_dataset <- function(dataset, bio_variables = NULL) {
   }
 
 
-  # download the dataset
-  for (this_var in bio_variables) {
-    file_details <- get_file_for_dataset(this_var, dataset)
-    # only download the file if it is needed
-    if (!file.exists(file.path(get_data_path(), file_details$file_name))) {
-      curl::curl_download(file_details$download_path,
-        destfile = file.path(get_data_path(), file_details$file_name),
-        quiet = FALSE
-      )
+  # special case for the example dataset
+  # as we have a copy on the package
+  if (dataset == "Example"){
+    copy_example_data()
+  } else {
+    # download the file for each variable
+    for (this_var in bio_variables) {
+      file_details <- get_file_for_dataset(this_var, dataset)
+      # only download the file if it is needed
+      if (!file.exists(file.path(get_data_path(), file_details$file_name))) {
+        curl::curl_download(file_details$download_path,
+                            destfile = file.path(get_data_path(), file_details$file_name),
+                            quiet = FALSE
+        )
+      }
     }
   }
   return(TRUE)

R/get_available_datasets.R

@@ -7,5 +7,5 @@
 #' @export
 
 get_available_datasets <- function() {
-  return(unique(as.character(files_by_dataset$dataset)))
+  return(unique(as.character(getOption("pastclim.dataset_list")$dataset)))
 }

R/get_downloaded_datasets.R

@@ -12,7 +12,7 @@ get_downloaded_datasets <- function(data_path = NULL) {
     data_path <- get_data_path()
   }
   all_nc_files <- list.files(data_path)
-  files_subset <- files_by_dataset[files_by_dataset$file_name %in%
+  files_subset <- getOption("pastclim.dataset_list")[getOption("pastclim.dataset_list")$file_name %in%
     all_nc_files, ]
   downloaded_vars <- list()
   for (dataset in unique(files_subset$dataset)) {

R/get_file_for_dataset.R

@@ -9,6 +9,6 @@
 
 get_file_for_dataset <- function(variable, dataset) {
   check_available_variable(variable, dataset)
-  return(files_by_dataset[files_by_dataset$variable %in% variable &
-    files_by_dataset$dataset == dataset, ])
+  return(getOption("pastclim.dataset_list")[getOption("pastclim.dataset_list")$variable %in% variable &
+    getOption("pastclim.dataset_list")$dataset == dataset, ])
 }

R/get_time_steps.R

@@ -1,6 +1,6 @@
 #' Get time steps for a given dataset
 #'
-#' Get the time steps available in a given dataset.
+#' Get the time steps (in time_bp) available in a given dataset.
 #'
 #' @param dataset string defining dataset to be downloaded (a list of possible
 #' values can be obtained with \code{get_available_datasets}). If set to
@@ -21,8 +21,11 @@ get_time_steps <- function(dataset, path_to_nc = NULL) {
     path_to_nc <- file.path(get_data_path(), this_file)
   }
 
-  climate_nc <- ncdf4::nc_open(path_to_nc)
-  time_steps <- (climate_nc$dim$time$vals)
-  ncdf4::nc_close(climate_nc)
-  return(time_steps)
+  climate_nc <- terra::rast(path_to_nc, subds=1)
+  return(time_bp(climate_nc))
+
+  # climate_nc <- ncdf4::nc_open(path_to_nc)
+  # time_steps <- (climate_nc$dim$time$vals)
+  # ncdf4::nc_close(climate_nc)
+  # return(time_steps)
 }

R/get_vars_for_dataset.R

@@ -21,9 +21,9 @@ get_vars_for_dataset <- function(dataset, path_to_nc = NULL, details=FALSE) {
     }
     check_available_dataset(dataset)
     if (!details){
-      return(files_by_dataset$variable[files_by_dataset$dataset == dataset])
+      return(getOption("pastclim.dataset_list")$variable[getOption("pastclim.dataset_list")$dataset == dataset])
     } else {
-      return(files_by_dataset[files_by_dataset$dataset == dataset,
+      return(getOption("pastclim.dataset_list")[getOption("pastclim.dataset_list")$dataset == dataset,
                               c("variable","long_name", "units")])
     }
   } else {
@@ -80,6 +80,6 @@ check_available_variable <- function(variable, dataset) {
 #'
 
 get_varname <- function(variable, dataset) {
-  return(files_by_dataset$ncvar[files_by_dataset$variable == variable &
-    files_by_dataset$dataset == dataset])
+  return(getOption("pastclim.dataset_list")$ncvar[getOption("pastclim.dataset_list")$variable == variable &
+    getOption("pastclim.dataset_list")$dataset == dataset])
 }

R/load_dataset_list.R

@@ -0,0 +1,38 @@
+#' Load the dataset list
+#'
+#' This function returns a dataframe with the details for each variable
+#' available in every dataset. It defaults to the copy stored within the
+#' package, but it checks in case there is an udpated version stored as
+#' 'data_list.csv' in 
+#' `tools::R_user_dir("pastclim","config")`. If the latter is present, the last
+#' column, named 'dataset_list_v', provides the version of this table, and the
+#' most advanced table is used.
+#'
+#' @param on_cran boolean to make this function run on ci tests using tempdir
+#' @returns the dataset list
+#' @keywords internal
+
+load_dataset_list <- function(on_cran=FALSE) {
+  if (!on_cran){
+    config_dir <- tools::R_user_dir("pastclim", "config")
+  } else {
+    config_dir <- tempdir()
+  }
+  if (file.exists(file.path(
+    config_dir,
+    "dataset_list_included.csv"
+  ))) {
+    table_in_config <- utils::read.csv(file.path(
+      config_dir,
+      "dataset_list_included.csv"
+    ))
+    table_in_config$dataset <- as.factor(table_in_config$dataset)
+    # we should check that the new table includes all the columns in the original file
+    if (utils::compareVersion(table_in_config$dataset_list_v[1], 
+                          dataset_list_included$dataset_list_v[1])==1){
+      # need to update
+      return(table_in_config)
+    }
+  }
+  return(dataset_list_included)
+}

R/location_series.R

@@ -116,7 +116,7 @@ location_series <-
 #' @export
 
 time_series_for_locations <- function(...) {
-  warning("DEPRECATED: use 'location_slice' instead")
+  warning("DEPRECATED: use 'location_series' instead")
   # if (!is.null(path_to_nc)) {
   #   stop(
   #     "the use of pastclimData is now deprecated",

R/set_data_path.R

@@ -92,12 +92,13 @@ set_data_path <- function(path_to_nc = NULL, ask = TRUE, write_config = TRUE,
 #' @keywords internal
 
 copy_example_data <- function() {
-  if (!file.exists(file.path(get_data_path(), "example_climate_v2.nc"))) {
+  example_filename <- unique(getOption("pastclim.dataset_list")$file_name[getOption("pastclim.dataset_list")$dataset == "Example"])
+  if (!file.exists(file.path(get_data_path(), example_filename))) {
     file.copy(
-      from = system.file("/extdata/example_climate_v2.nc",
+      from = system.file(file.path("/extdata",example_filename),
                          package = "pastclim"
       ),
-      to = file.path(get_data_path(), "example_climate_v2.nc")
+      to = file.path(get_data_path(), example_filename)
     )
   }
   return(TRUE)

R/time_bp.R

@@ -13,7 +13,8 @@ time_bp <- function(x){
     stop("x is not a SpatRaster")
   }
   if (x@ptr$timestep!="years"){
-    stop("the time units of SpatRaster are not 'years'",
+    # this should be escalated to an error once terra can properly set times in years (it's in dev)
+    warning("the time units of SpatRaster are not 'years'",
          " it might be a problem with the time units not being properly set in the original nc file")
   }
   time_yr<-terra::time(x)

R/update_dataset_list.R

@@ -0,0 +1,32 @@
+#' Update the dataset list
+#'
+#' If a newer dataset list (which includes all the information about the files
+#' storing the data for pastclim), download it and start using it as
+#' 'dataset_list_included.csv' in 
+#' `tools::R_user_dir("pastclim","config")`. If the latter is present, the last
+#' column, named 'dataset_list_v', provides the version of this table, and the
+#' most advanced table is used.
+#'
+#' @param on_cran boolean to make this function run on ci tests using tempdir
+#' @returns TRUE if the dataset was updated
+#' @export
+
+update_dataset_list <- function(on_cran=FALSE) {
+  curl::curl_download("https://raw.githubusercontent.com/EvolEcolGroup/pastclim/dataset_list/dataset_list_included.csv",
+                      destfile = file.path(tempdir(), "dataset_list_included.csv"),
+                      quiet = FALSE)
+  new_table_github <- utils::read.csv(file.path(tempdir(), "dataset_list_included.csv"))
+  # if the github version is more recent, copy it into config
+  if (utils::compareVersion(new_table_github$dataset_list_v[1], 
+                            getOption("pastclim.dataset_list")$dataset_list_v[1])==1){
+    file.copy(utils::read.csv(file.path(tempdir(), "dataset_list_included.csv")),
+              to= file.path(tools::R_user_dir("pastclim", "config"),"dataset_list_included.csv"))
+    load_dataset_list()
+    message("The dataset list was updated.")
+    return(TRUE)
+  } else {
+    message("The dataset list currently installed is already the latest version.")
+    return(FALSE)
+  }
+
+}

R/var_labels.R

@@ -47,7 +47,7 @@ var_labels <- function(x, dataset, with_units=TRUE,
   }
 
   # get variable details for this dataset
-  sub_table <- files_by_dataset[files_by_dataset$dataset==dataset,]
+  sub_table <- getOption("pastclim.dataset_list")[getOption("pastclim.dataset_list")$dataset==dataset,]
 
   indeces <- match(variables, sub_table$variable)
   if (any(is.na(indeces))){
@@ -69,4 +69,4 @@ var_labels <- function(x, dataset, with_units=TRUE,
     pretty_names <- c(pretty_names,this_name)
   }
   return(parse(text = pretty_names))
-}
+}

R/zzz.R

@@ -2,13 +2,13 @@
   # store the data path as an option for easy retrieval
   op <- options()
   op.pastclim <- list(
-    pastclim.data_path = get_data_path(silent=TRUE)
+    pastclim.data_path = get_data_path(silent=TRUE),
+    pastclim.dataset_list = load_dataset_list()
   )
   toset <- !(names(op.pastclim) %in% names(op))
   if (any(toset)) options(op.pastclim[toset])
 
   # check that gdal was compiled with netcdf support
-  d <- gdal(drivers=TRUE)
   if (!"netCDF" %in% terra::gdal(drivers=TRUE)$name){
     stop("The installed version of terra lacks support for reading netcdf files.\n",
          "pastclim needs netcdf support: you will need to reinstall terra,\n",

README.md

@@ -1,11 +1,16 @@
 # pastclim <img src="./man/figures/logo.png" align="right" alt="" width="150" />
 
 <!-- badges: start -->
-[![CircleCI](https://circleci.com/gh/EvolEcolGroup/pastclim/tree/master.svg?style=shield&circle-token=928bdbe8f065e17b22642f66a8b9c13f29f2e3fb)](https://app.circleci.com/pipelines/github/EvolEcolGroup/pastclim?branch=master)
-[![R-CMD-check dev](https://github.com/EvolEcolGroup/pastclim/actions/workflows/R-CMD-check.yaml/badge.svg?branch=dev)](https://github.com/EvolEcolGroup/pastclim/actions/workflows/R-CMD-check.yaml)
+[![R-CMD-check master](https://img.shields.io/github/checks-status/EvolEcolGroup/pastclim/master?label=master&logo=GitHub)](https://github.com/EvolEcolGroup/pastclim/actions/workflows/R-CMD-check.yaml)
+[![R-CMD-check dev](https://img.shields.io/github/checks-status/EvolEcolGroup/pastclim/dev?label=dev&logo=GitHub)](https://github.com/EvolEcolGroup/pastclim/actions/workflows/R-CMD-check.yaml)
 [![codecov](https://codecov.io/gh/EvolEcolGroup/pastclim/branch/master/graph/badge.svg?token=NflUsWlnQR)](https://app.codecov.io/gh/EvolEcolGroup/pastclim)
 <!-- badges: end -->
 
+<!-- old badges, kept for future reference
+[![CircleCI](https://circleci.com/gh/EvolEcolGroup/pastclim/tree/master.svg?style=shield&circle-token=928bdbe8f065e17b22642f66a8b9c13f29f2e3fb)](https://app.circleci.com/pipelines/github/EvolEcolGroup/pastclim?branch=master)
+[![R-CMD-check dev](https://github.com/EvolEcolGroup/pastclim/actions/workflows/R-CMD-check.yaml/badge.svg?branch=dev)](https://github.com/EvolEcolGroup/pastclim/actions/workflows/R-CMD-check.yaml)
+
+-->
 
 
 This `R` library is designed to provide an easy way to extract and manipulate palaeoclimate