Commit 5f10823c authored by Dan Baston's avatar Dan Baston

Pull regular dim creation out of write_vars_to_cdf

parent 338db54e
make_netcdf_dims <- function(extent, ids, dims=NULL) {
if (is.null(ids)) {
lats <- lat_seq(extent, dims)
lons <- lon_seq(extent, dims)
return(list(
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)
))
} else {
if (mode(ids) == 'character') {
# The R ncdf4 library does not support proper netCDF 4 strings. So we do it the
# old-school way, with fixed-length character arrays. Data written in this
# way seems to be interpreted correctly by software such as QGIS.
return(list(
ncdf4::ncdim_def("id", units="", vals=1:length(ids), create_dimvar=FALSE)
))
} else {
# integer ids
return(list(
ncdf4::ncdim_def("id", units="", vals=ids, create_dimvar=TRUE)
))
}
}
}
......@@ -103,58 +103,26 @@ write_vars_to_cdf <- function(vars,
put_data=TRUE,
quick_append=FALSE) {
# 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))
is_spatial <- is.null(ids)
character_ids <- !is_spatial && mode(ids) == 'character'
if (is.array(vars)) {
vars <- cube_to_matrices(vars)
}
if (is.null(names(vars)) || length(vars) != length(names(vars))) {
stop("vars must be an array with dimnames, or a named list of variables.")
}
vars <- standardize_vars(vars)
extent <- standardize_extent(extent, xmin, xmax, ymin, ymax)
ids <- standardize_ids(ids)
for (varname in names(vars)) {
if(class(vars[[varname]]) == 'factor') {
vars[[varname]] <- as.character(vars[[varname]])
}
if (is.null(extent) && is.null(ids)) {
stop("Must provide either extent or ids")
}
if (!append || !quick_append) {
if (is_spatial) {
extent <- validate_extent(extent, xmin, xmax, ymin, ymax)
lats <- lat_seq(extent, dim(vars[[1]]))
lons <- lon_seq(extent, dim(vars[[1]]))
dims <- list(
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)
)
} else {
if (any(is.na(ids))) {
stop('All IDs must be defined.')
}
dims <- make_netcdf_dims(extent, ids, dim(vars[[1]]))
if (!is_spatial) {
if (is.null(extra_dims) || !is.null(write_slice)) {
verify_var_size(vars, length(ids))
} else {
verify_var_size(vars, length(ids)*prod(sapply(extra_dims, length)))
}
if (character_ids) {
# The R ncdf4 library does not support proper netCDF 4 strings. So we do it the
# old-school way, with fixed-length character arrays. Data written in this
# way seems to be interpreted correctly by software such as QGIS.
dims <- list(
ncdf4::ncdim_def("id", units="", vals=1:length(ids), create_dimvar=FALSE)
)
} else {
# Assume that our IDs are integers, and error out if they're not.
dims <- list(
ncdf4::ncdim_def("id", units="", vals=coerce_to_integer(ids), create_dimvar=TRUE)
)
}
}
extra_ncdf_dims <- list()
......@@ -226,7 +194,7 @@ write_vars_to_cdf <- function(vars,
# Verify that our dimensions match up before writing
if (!quick_append) {
if (is_spatial) {
check_coordinate_variables(ncout, lat=lats, lon=lons)
check_coordinate_variables(ncout, lat=lat_seq(extent, dim(vars[[1]])), lon=lon_seq(extent, dim(vars[[1]])))
} else {
check_coordinate_variables(ncout, id=ids)
}
......@@ -413,19 +381,21 @@ write_wgs84_crs_attributes <- function(ncout, var_names) {
}
}
validate_extent <- function(extent, xmin, xmax, ymin, ymax) {
# Must provide extent in one form or another
if (is.null(extent) && any(is.null(c(xmin, xmax, ymin, ymax)))) {
stop("Must provide either extent or xmin, xmax, ymin, ymax")
}
# Can't provide extent in both forms
if (!is.null(extent) && !all(is.null(c(xmin, xmax, ymin, ymax)))) {
stop("Both extent and xmin, xmax, ymin, ymax arguments provided.")
}
standardize_extent <- function(extent, xmin, xmax, ymin, ymax) {
if (is.null(extent)) {
extent <- c(xmin, xmax, ymin, ymax)
if (all(is.null(extent))) {
return(NULL)
}
if (any(is.null(c(xmin, xmax, ymin, ymax)))) {
stop("Must provide either extent or xmin, xmax, ymin, ymax")
}
} else {
if (!all(is.null(c(xmin, xmax, ymin, ymax)))) {
stop("Both extent and xmin, xmax, ymin, ymax arguments provided.")
}
}
if (length(extent) != 4) {
......@@ -503,3 +473,39 @@ verify_var_size <- function(vars, sz) {
}
}
}
standardize_vars <- function(vars) {
# convert 3D to list of matrices
if (is.array(vars)) {
vars <- cube_to_matrices(vars)
}
if (is.null(names(vars)) || length(vars) != length(names(vars))) {
stop("vars must be an array with dimnames, or a named list of variables.")
}
# convert factors to text
for (varname in names(vars)) {
if(class(vars[[varname]]) == 'factor') {
vars[[varname]] <- as.character(vars[[varname]])
}
}
return(vars)
}
standardize_ids <- function(ids) {
if (is.null(ids)) {
return(NULL)
}
if (any(is.na(ids))) {
stop('All IDs must be defined.')
}
if (mode(ids) == 'character') {
return(ids)
} else {
return(coerce_to_integer(ids))
}
}
......@@ -238,7 +238,7 @@ test_that('write_vars_to_cdf provides useful errors if extent is not correctly s
)
expect_error(write_vars_to_cdf(data, fname),
"Must provide either extent or xmin,")
"Must provide either extent or")
expect_error(write_vars_to_cdf(data, fname, extent=c(0, 1, 0, 1), xmin=2),
"Both extent and xmin.* provided")
......
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