From 61205166d7b1c0ab34cf0c074b5684f4cdef256d Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 6 Sep 2022 11:10:51 +0200 Subject: [PATCH 1/2] Added checks for dimension name of the attributes lon and lat --- R/s2dv_cube.R | 54 ++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 43 insertions(+), 11 deletions(-) diff --git a/R/s2dv_cube.R b/R/s2dv_cube.R index 5a208a3d..6fd59564 100644 --- a/R/s2dv_cube.R +++ b/R/s2dv_cube.R @@ -105,10 +105,10 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = if (is.null(lat)) { if (any(c('lat', 'latitude') %in% names(dims))) { warning("Parameter 'lat' is not provided but data contains a ", - "latitudinal dimension.") + "latitudinal dimension.") } else { warning("Parameter 'lat' is not provided so the data is from an ", - "unknown location.") + "unknown location.") } } if (is.null(Variable)) { @@ -122,11 +122,11 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = if (is.null(Dates)) { if (!is.null(time_dims)) { if (any(time_dims %in% names(dims))) { - warning("Parameter 'Dates' is not provided but data contains a ", - "temporal dimension.") + warning("Parameter 'Dates' is not provided but data contains a ", + "temporal dimension.") } else { - warning("Data does not contain any of the temporal dimensions ", - "in 'time_dims'.") + warning("Data does not contain any of the temporal dimensions ", + "in 'time_dims'.") } } else if (any(c('time', 'ftime', 'sdate') %in% names(dims))) { warning("Parameter 'Dates' is not provided but data contains a ", @@ -190,10 +190,10 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = "is expected to be 'start'.") } if (length(Dates) == 2) { - if (names(Dates)[2] != 'end') { - warning("The name of the second element of parameter 'Dates' ", - "is expected to be 'end'.") - } + if (names(Dates)[2] != 'end') { + warning("The name of the second element of parameter 'Dates' ", + "is expected to be 'end'.") + } if (length(Dates[[1]]) != length(Dates[[2]])) { stop("The length of the elements in parameter 'Dates' must ", "be equal.") @@ -203,7 +203,7 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = time_dims <- dims[names(dims) %in% time_dims] } else { warning("Parameter 'time_dims' is not provided, assigning 'sdate', ", - "'time' and 'ftime' as default time dimension names.") + "'time' and 'ftime' as default time dimension names.") time_dims <- dims[names(dims) %in% c('sdate', 'time', 'ftime')] } if (prod(time_dims) != length(Dates[[1]])) { @@ -212,6 +212,38 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = } } } + + # Dimension name check + if (!is.null(lon)) { + if (any(names(dims) %in% c('lon', 'longitude'))) { + name_lon <- names(dims[names(dims) %in% c('lon', 'longitude')]) + if (!is.null(names(dim(lon)))) { + if (!identical(name_lon, names(dim(lon)))) { + stop("The dimension name of parameter 'lon' is not consistent ", + "with data dimension name for longitude.") + } + } else { + dim(lon) <- length(lon) + names(dim(lon)) <- name_lon + } + } + } + + if (!is.null(lat)) { + if (any(names(dims) %in% c('lat', 'latitude'))) { + name_lat <- names(dims[names(dims) %in% c('lat', 'latitude')]) + if (!is.null(names(dim(lat)))) { + if (!identical(name_lat, names(dim(lat)))) { + stop("The dimension name of parameter 'lat' is not consistent ", + "with data dimension name for latitude.") + } + } else { + dim(lat) <- length(lat) + names(dim(lat)) <- name_lat + } + } + } + object <- list(data = data, lon = lon, lat = lat, Variable = Variable, Datasets = Datasets, Dates = Dates, time_dims = time_dims, when = when, source_files = source_files) -- GitLab From 8fb84ff095f197f285ed2b240d3362a4dbe3c794 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 6 Sep 2022 17:22:27 +0200 Subject: [PATCH 2/2] Correct checks for dimension names --- R/s2dv_cube.R | 92 +++++++++++++++++++++++++++++---------------------- 1 file changed, 52 insertions(+), 40 deletions(-) diff --git a/R/s2dv_cube.R b/R/s2dv_cube.R index 6fd59564..1a73d543 100644 --- a/R/s2dv_cube.R +++ b/R/s2dv_cube.R @@ -158,24 +158,67 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = } } # Dimensions comparison + ## lon if (!is.null(lon)) { if (any(names(dims) %in% c('lon', 'longitude'))) { - if (dims[(names(dims) %in% c('lon', 'longitude'))] != length(lon) & - dims[(names(dims) %in% c('lon', 'longitude'))] != 1) { - stop("Length of parameter 'lon' doesn't match the length of ", - "longitudinal dimension in parameter 'data'.") + name_lon <- names(dims[names(dims) %in% c('lon', 'longitude')]) + if (dims[name_lon] != length(lon) & dims[name_lon] != 1) { + stop("Length of parameter 'lon' doesn't match the length of ", + "longitudinal dimension in parameter 'data'.") + } + if (!is.null(names(dim(lon))) && !identical(name_lon, names(dim(lon)))) { + stop("The dimension name of parameter 'lon' is not consistent ", + "with data dimension name for longitude.") + } else { + dim(lon) <- length(lon) + names(dim(lon)) <- name_lon } + } else if (!is.null(names(dim(lon))) && names(dim(lon)) %in% names(dims)) { + name_lon <- names(dims[names(dim(lon))]) + if (length(lon) != dims[name_lon]) { + stop("The length of the longitudinal dimension doesn't match ", + "with the length of 'lon' parameter.") + } else { + warning(paste0("Detected the longitude dimension name to be ", names(dim(lon)), + ", which is not the expected names ('lon' or 'longitude') by s2dv_cube.")) + } + } else { + stop("Parameter 'lon' is provided but data doesn't contain a ", + "longitudinal dimension.") } } - if (!is.null(lat)) { + + ## lat + if (!is.null(lat)) { if (any(names(dims) %in% c('lat', 'latitude'))) { - if (dims[(names(dims) %in% c('lat', 'latitude'))] != length(lat) & - dims[(names(dims) %in% c('lat', 'latitude'))] != 1) { - stop("Length of parameter 'lat' doesn't match the length of ", - "latitudinal dimension in parameter 'data'.") + name_lat <- names(dims[names(dims) %in% c('lat', 'latitude')]) + if (dims[name_lat] != length(lat) & dims[name_lat] != 1) { + stop("Length of parameter 'lat' doesn't match the length of ", + "longitudinal dimension in parameter 'data'.") } + if (!is.null(names(dim(lat))) && !identical(name_lat, names(dim(lat)))) { + stop("The dimension name of parameter 'lat' is not consistent ", + "with data dimension name for latitude.") + } else { + dim(lat) <- length(lat) + names(dim(lat)) <- name_lat + } + } else if (!is.null(names(dim(lat))) && names(dim(lat)) %in% names(dims)) { + name_lat <- names(dims[names(dim(lat))]) + if (length(lat) != dims[name_lat]) { + stop("The length of the latgitudinal dimension doesn't match ", + "with the length of 'lat' parameter.") + } else { + warning(paste0("Detected the latitude dimension name to be ", names(dim(lat)), + ", which is not the expected names ('lat' or 'latitude') by s2dv_cube.")) + } + } else { + stop("Parameter 'lat' is provided but data doesn't contain a ", + "latitudinal dimension.") } } + + ## Dates if (!is.null(Dates)) { if (!is.list(Dates)) { stop("Parameter 'Dates' must be a list.") @@ -213,37 +256,6 @@ s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = } } - # Dimension name check - if (!is.null(lon)) { - if (any(names(dims) %in% c('lon', 'longitude'))) { - name_lon <- names(dims[names(dims) %in% c('lon', 'longitude')]) - if (!is.null(names(dim(lon)))) { - if (!identical(name_lon, names(dim(lon)))) { - stop("The dimension name of parameter 'lon' is not consistent ", - "with data dimension name for longitude.") - } - } else { - dim(lon) <- length(lon) - names(dim(lon)) <- name_lon - } - } - } - - if (!is.null(lat)) { - if (any(names(dims) %in% c('lat', 'latitude'))) { - name_lat <- names(dims[names(dims) %in% c('lat', 'latitude')]) - if (!is.null(names(dim(lat)))) { - if (!identical(name_lat, names(dim(lat)))) { - stop("The dimension name of parameter 'lat' is not consistent ", - "with data dimension name for latitude.") - } - } else { - dim(lat) <- length(lat) - names(dim(lat)) <- name_lat - } - } - } - object <- list(data = data, lon = lon, lat = lat, Variable = Variable, Datasets = Datasets, Dates = Dates, time_dims = time_dims, when = when, source_files = source_files) -- GitLab