Fixed bug with singleton dimensions and expect_all_indices. Fixes #1.

R/NcToArray.R

@@ -158,11 +158,6 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
               }
             }
           }
-          if (expect_all_indices) {
-            extra_dims <- names(extra_dims)
-          } else {
-            extra_dims <- NULL
-          }
           any_empty_selectors <- FALSE
           # Here we are allowing for indices out of range (simply discarding them).
           for (inner_dim in names(indices_to_take)) {
@@ -201,15 +196,6 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
             #  }
             #  missing_dims <- missing_dim_names
             #}
-            reorder_back <- NULL
-            indices_dims <- names(dim_indices)[which(names(dim_indices) %in% names(found_dims))]
-            if (length(indices_dims) > 0) {
-              if (any(names(found_dims) != indices_dims)) {
-                #reorder <- sapply(names(found_dims), function(x) which(indices_dims == x))
-                reorder_back <- sapply(indices_dims, function(x) which(names(found_dims) == x))
-                #indices_to_take <- indices_to_take[reorder]
-              }
-            }
             start <- sapply(indices_to_take, function(x) if (is_single_na(x)) 1 else min(x))
             count <- sapply(indices_to_take, function(x) if (is_single_na(x)) -1 else max(x) - min(x) + 1)
             # Support for character strings
@@ -228,19 +214,32 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
               assignInNamespace('ncvar_get_inner', original_ncvar_get_inner, 'ncdf4')
             }
             #metadata <- c(metadata, structure(list(file_object$var[[var_name]]), .Names = var_name))
-            ## TODO: Crop dimensions in attributes
-            if (!is.null(reorder_back)) {
-              var_result <- aperm(var_result, reorder_back)
-              names(dim(var_result)) <- names(indices_to_take)[reorder_back]
-            } else {
-              names(dim(var_result)) <- names(indices_to_take)
+            names(dim(var_result)) <- names(indices_to_take)
+            # Drop extra dims
+            if (!is.null(extra_dims) && expect_all_indices) {
+              dim(var_result) <- dim(var_result)[-which(names(indices_to_take) %in% names(extra_dims))]
             }
+            # Reorder if needed
+            reorder_back <- NULL
+            indices_dims <- names(dim_indices)[which(names(dim_indices) %in% names(dim(var_result)))]
+            if (length(indices_dims) > 0) {
+              if (any(names(dim(var_result))[-which(names(dim(var_result)) %in% names(extra_dims))] != indices_dims)) {
+                reorder_back <- 1:length(dim(var_result))
+                dims_to_reorder <- which(!(names(dim(var_result)) %in% names(extra_dims)))
+                reorder_back[dims_to_reorder] <- dims_to_reorder[sapply(indices_dims, 
+                                                                   function(x) {
+                                                                     which(names(dim(var_result))[dims_to_reorder] == x)
+                                                                   })]
+                dimname_bk <- names(dim(var_result))
+                var_result <- aperm(var_result, reorder_back)
+                names(dim(var_result)) <- dimname_bk[reorder_back]
+                #indices_to_take <- indices_to_take[reorder]
+              }
+            }
+            ## TODO: Crop dimensions in attributes
             #if (!is.null(missing_dims)) {
             #  dim(var_result) <- original_dims
             #}
-            if (!is.null(extra_dims)) {
-              dim(var_result) <- dim(var_result)[-which(names(indices_to_take) %in% extra_dims)]
-            }
             #attr(var_result, 'variables') <- metadata
           }
           atts <- file_object$var[[var_name]]

man/NcToArray.Rd

@@ -39,7 +39,7 @@ Whether to drop the 'var' dimension this function assumes (read description). If
 Whether to merge the resulting array variables into a single array if possible (default) or not. Otherwise a list with as many arrays as requested variables is returned.
   }
   \item{expect_all_indices}{
-Whether the function should stop if indices are not provided for all the dimensions of any of the requested variables rather than assuming that all the indices are requested for the unspecified dimensions. By default the later is done.
+Whether the function should stop if indices are not provided for all the dimensions of any of the requested variables (TRUE) rather than assuming that all the indices are requested for the unspecified dimensions (FALSE). By default the later is done (FALSE).
   }
   \item{allow_out_of_range}{
 Whether to allow indices out of range (simply disregard them) or to stop if indices out of range are found.
@@ -64,6 +64,26 @@ NcClose(fnc)
 # Check the obtained array matches the original array
 print(a)
 print(a_from_file[1, , ])
+
+# Example with extra dimensions of length 1
+# Creating sample data with singleton dimensions. Only dimensions 'a', 'b' and
+# 'c' are of length > 1.
+test_var <- array(1:24, dim = c(1, 1, 2, 1, 1, 3, 1, 4, 1, 1))
+names(dim(test_var)) <- c('x', 'y', 'a', 'z', 't', 'b', 'u', 'c', 'v', 'w')
+# Storing the data into a NetCDF file
+a2nc(list(test_var = test_var), file_path)
+# Reading the data back
+fff <- nc2a(file_path, list(a = NA, b = NA, c = NA), vars_to_read = 'test_var')
+# By default, if no indices are provided for the singleton dimensions, they are 
+# automatically read in and preserved
+dim(fff)
+# Reading the data back with expect_all_indices = TRUE
+fff <- nc2a(file_path, list(a = NA, b = NA, c = NA), vars_to_read = 'test_var', 
+            expect_all_indices = TRUE)
+# If indices for all dimensions are not provided and expect_all_indices = TRUE, 
+# the function crashes, except if those dimensions are of length 1. In that 
+# case, the function ignores those (those are dropped)
+dim(fff)
 }
 \author{
 History:\cr