Commit d4815d0e authored by Dan Baston's avatar Dan Baston

Reduce obscurity of data reshaping prior to ncvar_put

parent ded39e3e
Pipeline #75263389 failed with stages
in 15 minutes and 59 seconds
......@@ -328,7 +328,7 @@ find_offset <- function(cdf, real_dims, dim_values) {
sapply(real_dims, function(dimname) {
if (dimname %in% names(dim_values)) {
i <- which(ncdf4::ncvar_get(cdf, dimname)==dim_values[[dimname]])
i <- which(ncdf4::ncvar_get(cdf, dimname) == dim_values[[dimname]])
if (length(i) == 0) {
stop(sprintf("Invalid value \"%s\" for dimension \"%s\".", dim_values[[dimname]], dimname))
}
......
......@@ -177,34 +177,32 @@ write_vars_to_cdf <- function(vars,
# Write data to vars
if (!is_spatial) {
cmbn <- do.call(combos, c(list(id=ids), extra_dims))
# Get a data frame representing the Cartesian product of all dimensions
# so that we can properly fill in missing values with NA
dimension_df <- do.call(combos, c(list(id=ids), extra_dims))
}
if (put_data) {
for (param in names(vars)) {
# Don't write dimension vals
if (!is.null(dims[[param]]))
if (!is.null(dims[[param]])) {
next
}
# Figure out what dimensions are used for this variable
dimnames <- sapply(ncout$var[[param]]$dim, function(d) d$name)
if (is_spatial) {
ndim <- length(dim(vars[[param]]))
if (ndim > 2) {
permut <- c(2, 1, 3:ndim)
} else {
permut <- c(2, 1)
}
dat <- aperm(vars[[param]], permut)
dat <- flip_first_two_dims(vars[[param]])
} else {
if (is.null(extra_dims)) {
dat <- vars[[param]]
} else {
dat <- merge(cmbn,
vars,
by=names(cmbn),
all.x=TRUE)
# Join our data to dimension_df to fill in missing values
dat <- merge(dimension_df, vars, by=names(dimension_df), all.x=TRUE)
# Sort the data frame according to the order of dimension values used in the netCDF file
# Then, drop off the dimension columns
dat <- dat[do.call(order, lapply(rev(dimnames), function(d) match(dat[[d]], ncdf4::ncvar_get(ncout, d)))), param]
}
}
......@@ -518,3 +516,15 @@ create_vars <- function(vars, dims, ids, prec, extra_dims) {
return(ncvars)
}
#' Flip the first two dimensions of a multidimensional array
flip_first_two_dims <- function(arr) {
ndim <- length(dim(arr))
if (ndim > 2) {
permut <- c(2, 1, 3:ndim)
} else {
permut <- c(2, 1)
}
aperm(arr, permut)
}
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