From 610c365ed0948472ab3d3ea21e0300029ce9030a Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 2 Jul 2018 16:25:52 +0200 Subject: [PATCH 1/3] Fix to support 'day ', 'hour ', 'minute ' 'since' as time units. --- R/NcDataReader.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/NcDataReader.R b/R/NcDataReader.R index 62fab19..d0455e5 100644 --- a/R/NcDataReader.R +++ b/R/NcDataReader.R @@ -151,10 +151,12 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, } else if (grepl(' since ', units)) { parts <- strsplit(units, ' since ')[[1]] units <- parts[1] - if (units == 'seconds') { + if (units %in% c('second', 'seconds')) { units <- 'secs' - } else if (units == 'minutes') { + } else if (units %in% c('minute', 'minutes')) { units <- 'mins' + } else if (units == 'day') { + units <- 'days' } new_array <- rep(as.POSIXct(parts[2]), length(result)) + -- GitLab From be0f8125b284d2d77cb231c140e4d367c1963f93 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Thu, 5 Jul 2018 16:01:17 +0200 Subject: [PATCH 2/3] Fixes for date selection. --- R/SelectorChecker.R | 7 ++++--- R/Start.R | 5 +++++ 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/R/SelectorChecker.R b/R/SelectorChecker.R index e75d98c..c013dff 100644 --- a/R/SelectorChecker.R +++ b/R/SelectorChecker.R @@ -174,9 +174,10 @@ SelectorChecker <- function(selectors, var = NULL, return_indices = TRUE, res <- which.min(dif)[1] if (!is.null(tolerance)) { if (dif[res] > tolerance) { - stop("Could not find a value in 'var' close ", - "enough to one of the 'selectors', ", - "according to 'tolerance'.") + res <- NA + #stop("Could not find a value in 'var' close ", + # "enough to one of the 'selectors', ", + # "according to 'tolerance'.") } } res diff --git a/R/Start.R b/R/Start.R index bed9fd3..54e57d4 100644 --- a/R/Start.R +++ b/R/Start.R @@ -2114,6 +2114,11 @@ print("-> THE INNER DIMENSION GOES ACROSS A FILE DIMENSION.") } sub_array_of_indices <- selector_checker(sub_array_of_selectors, sub_array_of_values, tolerance = tolerance_params[[inner_dim]]) + # It is needed to expand the indices here, otherwise for + # values(list(date1, date2)) only 2 values are picked. + if (is.list(sub_array_of_indices)) { + sub_array_of_indices <- sub_array_of_indices[[1]]:sub_array_of_indices[[2]] + } sub_array_of_indices <- sub_array_of_indices[chunk_indices(length(sub_array_of_indices), chunks[[inner_dim]]['chunk'], chunks[[inner_dim]]['n_chunks'], -- GitLab From 52f12364ebc35790681797914307791c6771cfd0 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Thu, 5 Jul 2018 21:37:53 +0200 Subject: [PATCH 3/3] Improvement to load files of different length. --- R/Start.R | 48 ++++++++++++++++++++++++++++++++++++++++++++---- R/Utils.R | 30 ++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+), 4 deletions(-) diff --git a/R/Start.R b/R/Start.R index 54e57d4..29f7db6 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1213,6 +1213,7 @@ debug <- TRUE } else { array_var_dims <- dim(picked_vars[[i]][[var_to_read]]) } + full_array_var_dims <- array_var_dims if (any(names(array_var_dims) %in% names(var_file_dims))) { array_var_dims <- array_var_dims[-which(names(array_var_dims) %in% names(var_file_dims))] } @@ -1225,10 +1226,49 @@ debug <- TRUE collapse = ', '), ".\n", array_of_var_files[j]) } if (any(var_dims > array_var_dims)) { - stop("Error while reading the variable '", var_to_read, "' from ", - "the file. Found size (", paste(var_dims, collapse = ' x '), - ") is greater than expected maximum size (", - array_var_dims, ").") + longer_dims <- which(var_dims > array_var_dims) + if (length(longer_dims) == 1) { + longer_dims_in_full_array <- longer_dims + if (any(names(full_array_var_dims) %in% names(var_file_dims))) { + candidates <- (1:length(full_array_var_dims))[-which(names(full_array_var_dims) %in% names(var_file_dims))] + longer_dims_in_full_array <- candidates[longer_dims] + } + padding_dims <- full_array_var_dims + padding_dims[longer_dims_in_full_array] <- var_dims[longer_dims] - + array_var_dims[longer_dims] + special_types <- list('POSIXct' = as.POSIXct, 'POSIXlt' = as.POSIXlt, + 'Date' = as.Date) + if (var_to_read %in% names(common_return_vars)) { + var_class <- class(picked_common_vars[[var_to_read]]) + } else { + var_class <- class(picked_vars[[i]][[var_to_read]]) + } + if (any(var_class %in% names(special_types))) { + padding_size <- prod(padding_dims) + padding <- rep(special_types[[var_class[1]]](NA), padding_size) + dim(padding) <- padding_dims + } else { + padding <- array(dim = padding_dims) + } + if (var_to_read %in% names(common_return_vars)) { + picked_common_vars[[var_to_read]] <- .abind2( + picked_common_vars[[var_to_read]], + padding, + names(full_array_var_dims)[longer_dims_in_full_array] + ) + } else { + picked_vars[[i]][[var_to_read]] <- .abind2( + picked_vars[[i]][[var_to_read]], + padding, + names(full_array_var_dims)[longer_dims_in_full_array] + ) + } + } else { + stop("Error while reading the variable '", var_to_read, "' from ", + "the file. Found size (", paste(var_dims, collapse = ' x '), + ") is greater than expected maximum size (", + array_var_dims, ").") + } } } var_store_indices <- c(as.list(current_indices[names(var_file_dims)]), lapply(var_dims, function(x) 1:x)) diff --git a/R/Utils.R b/R/Utils.R index 65dc0c6..f4dd5e5 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -484,6 +484,36 @@ chunk <- function(chunk, n_chunks, selectors) { x } +# Function to bind arrays of non-atomic elements (e.g. POSIXct) +# 'x' and 'y' must have dimension names +# parameter 'along' must be a dimension name +.abind2 <- function(x, y, along) { + x_along <- which(names(dim(x)) == along) + if (x_along != length(dim(x))) { + tmp_order_x <- c((1:length(dim(x)))[-x_along], x_along) + x <- .aperm2(x, tmp_order_x) + } + y_along <- which(names(dim(y)) == along) + if (y_along != length(dim(y))) { + tmp_order_y <- c((1:length(dim(y)))[-y_along], y_along) + y <- .aperm2(y, tmp_order_y) + } + r <- c(x, y) + new_dims <- dim(x) + new_dims[length(new_dims)] <- dim(x)[length(dim(x))] + dim(y)[length(dim(y))] + dim(r) <- new_dims + if (x_along != length(dim(x))) { + final_order <- NULL + if (x_along > 1) { + final_order <- c(final_order, (1:length(dim(r)))[1:(x_along - 1)]) + } + final_order <- c(final_order, length(dim(r))) + final_order <- c(final_order, (1:length(dim(r)))[x_along:(length(dim(r)) - 1)]) + r <- .aperm2(r, final_order) + } + r +} + # This function is a helper for the function .MergeArrays. # It expects as inputs two named numeric vectors, and it extends them # with dimensions of length 1 until an ordered common dimension -- GitLab