Commit 338db54e authored by Dan Baston's avatar Dan Baston

Pull standard attr generation out of write_vars_to_cdf

parent aaa3fa64
Pipeline #75223392 passed with stages
in 18 minutes and 15 seconds
# Copyright (c) 2019 ISciences, LLC.
# All rights reserved.
#
# WSIM is licensed under the Apache License, Version 2.0 (the "License").
# You may not use this file except in compliance with the License. You may
# obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#' Generate a list of standard attributes to include in netCDF outputs
#'
#' @param is_new is the file new?
#' @param is_spatial does the file have spatial data?
#' @param existing_history optional character vector with an existing history
#' entry to which we should potential apppend
#' @return list of attributes
standard_netcdf_attrs <- function(is_new, is_spatial, existing_history=NULL) {
history <- paste0(date_string(), ': ', get_command(), '\n')
if (!is.null(existing_history)) {
if (endsWith(existing_history, history)) {
history <- existing_history
} else {
history <- paste0(existing_history, history)
}
}
ret <- list(
list(key="wsim_version", val=wsim_version_string()),
list(key="history", val=history)
)
if (is_new) {
ret <- c(ret, list(
list(key="date_created", val=date_string())
))
}
if (is_spatial) {
ret <- c(ret, list(
# CF conventions require that each measurement can be located
# on the surface of the Earth. So we only stamp our file with
# a "Conventions" attribute when writing spatial data.
list(key="Conventions", val="CF-1.6"),
list(var="lon", key="axis", val="X"),
list(var="lon", key="standard_name", val="longitude"),
list(var="lat", key="axis", val="Y"),
list(var="lat", key="standard_name", val="latitude")
))
}
return(ret)
}
# Calculate a time stamp on package load so that it's the same for
# each write within a loop. This prevents duplicate history
# entries.
time_loaded <- Sys.time()
date_string <- function() {
strftime(time_loaded, '%Y-%m-%dT%H:%M:%S%z')
}
......@@ -102,18 +102,10 @@ write_vars_to_cdf <- function(vars,
append=FALSE,
put_data=TRUE,
quick_append=FALSE) {
datestring <- strftime(Sys.time(), '%Y-%m-%dT%H:%M%S%z')
history_entry <- paste0(datestring, ': ', get_command(), '\n')
# TODO allow implicit id definition with 'id' col in vars
is_spatial <- is.null(ids) # !(is.null(extent) && is.null(xmin) && is.null(xmax) && is.null(ymin) && is.null(ymax))
character_ids <- !is_spatial && mode(ids) == 'character'
standard_attrs <- list(
list(key="Conventions", val="CF-1.6"),
list(key="wsim_version", val=wsim_version_string())
)
if (is.array(vars)) {
vars <- cube_to_matrices(vars)
}
......@@ -139,13 +131,6 @@ write_vars_to_cdf <- function(vars,
ncdf4::ncdim_def("lon", units="degrees_east", vals=lons, longname="Longitude", create_dimvar=TRUE),
ncdf4::ncdim_def("lat", units="degrees_north", vals=lats, longname="Latitude", create_dimvar=TRUE)
)
standard_attrs <- c(standard_attrs, list(
list(var="lon", key="axis", val="X"),
list(var="lon", key="standard_name", val="longitude"),
list(var="lat", key="axis", val="Y"),
list(var="lat", key="standard_name", val="latitude")
))
} else {
if (any(is.na(ids))) {
stop('All IDs must be defined.')
......@@ -254,25 +239,10 @@ write_vars_to_cdf <- function(vars,
ncout <- ncdf4::ncvar_add(ncout, var)
}
}
existing_history <- ncdf4::ncatt_get(ncout, 0, "history")
if (existing_history$hasatt) {
# TODO avoid pasting same command to history multiple times
history_entry <- paste0(existing_history$value, history_entry)
}
standard_attrs <- c(standard_attrs, list(
list(key="history", val=history_entry)
))
}
} else {
ncout <- ncdf4::nc_create(filename, ncvars)
standard_attrs <- c(standard_attrs, list(
list(key="date_created", val=datestring),
list(key="history", val=history_entry)
))
if (character_ids) {
ncdf4::ncvar_put(ncout, ncvars$id, ids)
}
......@@ -333,6 +303,16 @@ write_vars_to_cdf <- function(vars,
# Write attributes
if (!append || !quick_append) {
if (append && ncdf4::ncatt_get(ncout, 0, "history")$hasatt) {
existing_history <- ncdf4::ncatt_get(ncout, 0, "history")$value
} else {
existing_history <- NULL
}
standard_attrs <- standard_netcdf_attrs(is_new = !append,
is_spatial = is_spatial,
existing_history = existing_history)
for (attr in c(standard_attrs, attrs)) {
if (!is.null(attr$var) && attr$var == '*') {
# Global attribute. Apply the attribute to all variables modified
......
# Copyright (c) 2019 ISciences, LLC.
# All rights reserved.
#
# WSIM is licensed under the Apache License, Version 2.0 (the "License").
# You may not use this file except in compliance with the License. You may
# obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0.
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
require(testthat)
context("netCDF attributes")
get_attribute <- function(attrs, attr_name) {
Filter(function(attr) attr$key == attr_name, attrs)[[1]]$val
}
test_that('timestamp is constant between multiple calls', {
first <- date_string()
Sys.sleep(2)
second <- date_string()
expect_equal(first, second)
})
test_that('history entries are not duplicated', {
first <- get_attribute(standard_netcdf_attrs(is_new=FALSE, is_spatial=FALSE), 'history')
second <- get_attribute(standard_netcdf_attrs(is_new=FALSE, is_spatial=FALSE, existing_history=first), 'history')
expect_equal(first, second)
})
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment