From 2e14fcf64a474a14bc0c01517b15a2357e34a65b Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 20 Feb 2017 11:47:54 +0100 Subject: [PATCH 01/19] Small warning fix. --- R/Utils.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/Utils.R b/R/Utils.R index 806ad92d..210cdfaf 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -341,12 +341,14 @@ if (!is.null(work_piece[['progress_amount']])) { cat("\n") } - cat(paste0("! Warning: the dataset with index ", tail(work_piece[['indices']], 1), - " in '", work_piece[['dataset_type']], "' is originally on ", - "a grid coarser than the common grid and it has been ", - "extrapolated. Check the results carefully. It is ", - "recommended to specify as common grid the coarsest grid ", - "among all requested datasets via the parameter 'grid'.\n")) + if (!explore_dims) { + cat(paste0("! Warning: the dataset with index ", tail(work_piece[['indices']], 1), + " in '", work_piece[['dataset_type']], "' is originally on ", + "a grid coarser than the common grid and it has been ", + "extrapolated. Check the results carefully. It is ", + "recommended to specify as common grid the coarsest grid ", + "among all requested datasets via the parameter 'grid'.\n")) + } } # Now calculate if the user requests for a lonlat subset or for the # entire field -- GitLab From 17b5e3590e78da8888c6856567343407a3801bd3 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Tue, 21 Feb 2017 15:51:13 +0100 Subject: [PATCH 02/19] Small fix in ArrayToNetCDF documentation. --- man/ArrayToNetCDF.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/ArrayToNetCDF.Rd b/man/ArrayToNetCDF.Rd index b857eaf2..fcfb7700 100644 --- a/man/ArrayToNetCDF.Rd +++ b/man/ArrayToNetCDF.Rd @@ -13,8 +13,8 @@ ArrayToNetCDF(arrays = list(temperature = array(1:9, c(3, 3))), \item{Via the dimension names of each provided array:}{The dimension names of each of the provided arrays will be interpreted as names for the dimensions of the NetCDF files. Read further for special dimension names that will trigger special behaviours, such as 'time' and 'var'.\cr E.g:\cr \code{ -temperature <- array(rnorm(10 * 50 * 100), dim = c(10, 50, 100)) -names(dim(temperature)) <- c('time', 'latitude', 'longitude') +temperature <- array(rnorm(100 * 50 * 10), dim = c(100, 50, 10)) +names(dim(temperature)) <- c('longitude', 'latitude', 'time') ArrayToNetCDF(list(temperature = temperature), file_path = 'example.nc') } } -- GitLab From 64b1ea728d4d350d7a9192e3f102cb094e29a2ae Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 27 Feb 2017 17:04:11 +0100 Subject: [PATCH 03/19] ArrayToNetCDF now accepts customized attributes. --- R/ArrayToNetCDF.R | 8 ++++++++ man/CDORemap.Rd | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/R/ArrayToNetCDF.R b/R/ArrayToNetCDF.R index 2b573f63..0d8a87b8 100644 --- a/R/ArrayToNetCDF.R +++ b/R/ArrayToNetCDF.R @@ -297,6 +297,14 @@ ArrayToNetCDF <- function(arrays, file_path) { } ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, 'coordinates', var_info[['coordinates']]) } + attrs_to_skip <- which(names(var_info) %in% c('addOffset', 'scaleFact', 'coordinates')) + attrs_to_add <- names(var_info) + if (length(attrs_to_skip) > 0) { + attrs_to_add <- attrs_to_add[-attrs_to_skip] + } + for (attribute_name in attrs_to_add) { + ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, attribute_name, var_info[[attribute_name]]) + } var_counter <- var_counter + 1 } } diff --git a/man/CDORemap.Rd b/man/CDORemap.Rd index 7960d7bb..fa539dc6 100644 --- a/man/CDORemap.Rd +++ b/man/CDORemap.Rd @@ -14,7 +14,7 @@ CDORemap(data_array = NULL, lons, lats, grid, method, \item{data_array}{Multidimensional numeric array to be interpolated. If provided, it must have at least a longitude and a latitude dimensions, identified by the array dimension names. The names for these dimensions must be one of the recognized by s2dverification (can be checked with \code{s2dverification:::.KnownLonNames()} and \code{s2dverification:::.KnownLatNames()}).} \item{lons}{Numeric vector or array of longitudes of the centers of the grid cells. Its size must match the size of the longitude/latitude dimensions of the input array.} \item{lats}{Numeric vector or array of latitudes of the centers of the grid cells. Its size must match the size of the longitude/latitude dimensions of the input array.} - \item{grid}{Character string specifying either a name of a grid (recognized by CDO; e.g.: 'r256x128', 't106grid') or a path to another NetCDF file which to read the grid from (a single grid must be defined in such file).} + \item{grid}{Character string specifying either a name of a target grid (recognized by CDO; e.g.: 'r256x128', 't106grid') or a path to another NetCDF file which to read the target grid from (a single grid must be defined in such file).} \item{method}{Character string specifying an interpolation method (recognized by CDO; e.g.: 'con', 'bil', 'bic', 'dis'). The following long names are also supported: 'conservative', 'bilinear', 'bicubic' and 'distance-weighted'.} \item{avoid_writes}{The step of permutation is needed when the input array has more than 3 dimensions and none of the longitude or latitude dimensions in the right-most position (CDO would not accept it without permuting previously). This step, executed by default when needed, can be avoided for the price of writing more intermediate files (whis usually is unconvenient) by setting the parameter \code{avoid_writes = TRUE}.} \item{crop}{Whether to crop the data after interpolation with 'cdo sellonlatbox' (TRUE) or to extend interpolated data to the whole world as CDO does by default (FALSE). If \code{crop = TRUE} then the longitude and latitude borders which to crop at are taken as the limits of the cells at the borders ('lons' and 'lats' are perceived as cell centers), i.e. the resulting array will contain data that covers the same area as the input array. This is equivalent to specifying \code{crop = 'preserve'}, i.e. preserving area. If \code{crop = 'tight'} then the borders which to crop at are taken as the minimum and maximum cell centers in 'lons' and 'lats', i.e. the area covered by the resulting array may be smaller if interpolating from a coarse grid to a fine grid. The parameter 'crop' also accepts a numeric vector of custom borders which to crop at: c(western border, eastern border, southern border, northern border). } -- GitLab From a3b3990aa4d72eedac396a15fcdb75aa020d062d Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Mar 2017 19:03:17 +0100 Subject: [PATCH 04/19] Bugfix in CDORemap. --- R/CDORemap.R | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index 24809c3f..7d6ff391 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -79,19 +79,39 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } } else { if (!(lon_dim %in% names(dim(lons)))) { - stop("Parameter 'lon' must have the same longitude dimension name as the 'data_array'.") + if (!return_array) { + if (any(names(dim(lons)) %in% known_lon_names)) { + lon_dim <- names(dim(lons))[which(names(dim(lons)) %in% known_lon_names)] + names(dim(data_array))[2] <- lon_dim + } else { + stop("Parameter 'lon' must have a longitude dimension.") + } + } else { + stop("Parameter 'lon' must have the same longitude dimension name as the 'data_array'.") + } } if (length(dim(lons)) > 1 && !(lat_dim %in% names(dim(lons)))) { stop("Parameter 'lon' must have the same latitude dimension name as the 'data_array'.") } } if (is.null(names(dim(lats)))) { - if (length(dim(lats)) > 1) { + if (length(dim(lats)) == 1) { + names(dim(lats)) <- lat_dim + } else { stop("Parameter 'lats' must be provided with dimension names.") } } else { if (!(lat_dim %in% names(dim(lats)))) { - stop("Parameter 'lat' must have the same latitude dimension name as the 'data_array'.") + if (!return_array) { + if (any(names(dim(lats)) %in% known_lat_names)) { + lat_dim <- names(dim(lats))[which(names(dim(lats)) %in% known_lat_names)] + names(dim(data_array))[1] <- lat_dim + } else { + stop("Parameter 'lat' must have a latitude dimension.") + } + } else { + stop("Parameter 'lat' must have the same latitude dimension name as the 'data_array'.") + } } if (length(dim(lats)) > 1 && !(lon_dim %in% names(dim(lats)))) { stop("Parameter 'lat' must have the same longitude dimension name as the 'data_array'.") -- GitLab From bfb3c7201b0dcea6320fd27b0ece7ab9dccc5cba Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Mar 2017 20:18:06 +0100 Subject: [PATCH 05/19] Fix in CDORemap. --- R/CDORemap.R | 45 +++++++++++++++++++++------------------------ 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index 7d6ff391..f3909bae 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -42,11 +42,24 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, return_array <- FALSE if (length(dim(lons)) == 1) { array_dims <- c(length(lats), length(lons)) - names(array_dims) <- c('lat', 'lon') + new_lon_dim_name <- 'lon' + new_lat_dim_name <- 'lat' } else { array_dims <- dim(lons) - names(array_dims) <- c('j', 'i') + new_lon_dim_name <- 'i' + new_lat_dim_name <- 'j' } + if (!is.null(names(dim(lons)))) { + if (any(known_lon_names %in% names(dim(lons)))) { + new_lon_dim_name <- known_lon_names[which(known_lon_names %in% names(dim(lons)))[1]] + } + } + if (!is.null(names(dim(lats)))) { + if (any(known_lat_names %in% names(dim(lats)))) { + new_lat_dim_name <- known_lat_names[which(known_lat_names %in% names(dim(lats)))[1]] + } + } + names(array_dims) <- c(new_lat_dim_name, new_lon_dim_name) data_array <- array(NA, array_dims) } if (!(is.logical(data_array) || is.numeric(data_array)) || !is.array(data_array)) { @@ -79,16 +92,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } } else { if (!(lon_dim %in% names(dim(lons)))) { - if (!return_array) { - if (any(names(dim(lons)) %in% known_lon_names)) { - lon_dim <- names(dim(lons))[which(names(dim(lons)) %in% known_lon_names)] - names(dim(data_array))[2] <- lon_dim - } else { - stop("Parameter 'lon' must have a longitude dimension.") - } - } else { - stop("Parameter 'lon' must have the same longitude dimension name as the 'data_array'.") - } + stop("Parameter 'lon' must have the same longitude dimension name as the 'data_array'.") } if (length(dim(lons)) > 1 && !(lat_dim %in% names(dim(lons)))) { stop("Parameter 'lon' must have the same latitude dimension name as the 'data_array'.") @@ -102,16 +106,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } } else { if (!(lat_dim %in% names(dim(lats)))) { - if (!return_array) { - if (any(names(dim(lats)) %in% known_lat_names)) { - lat_dim <- names(dim(lats))[which(names(dim(lats)) %in% known_lat_names)] - names(dim(data_array))[1] <- lat_dim - } else { - stop("Parameter 'lat' must have a latitude dimension.") - } - } else { - stop("Parameter 'lat' must have the same latitude dimension name as the 'data_array'.") - } + stop("Parameter 'lat' must have the same latitude dimension name as the 'data_array'.") } if (length(dim(lats)) > 1 && !(lon_dim %in% names(dim(lats)))) { stop("Parameter 'lat' must have the same longitude dimension name as the 'data_array'.") @@ -223,7 +218,8 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, tmp_lon <- Subset(lons, lat_dim, min_pos[which(names(dim(lons)) == lat_dim)], drop = 'selected') } i <- 1:length(tmp_lon) - lon_model <- lm(tmp_lon ~ poly(i, 3)) + degree <- min(3, length(i) - 1) + lon_model <- lm(tmp_lon ~ poly(i, degree)) lon_extremes <- c(NA, NA) left_is_min <- FALSE right_is_max <- FALSE @@ -281,7 +277,8 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, tmp_lat <- Subset(lats, lon_dim, min_pos[which(names(dim(lats)) == lon_dim)], drop = 'selected') } i <- 1:length(tmp_lat) - lat_model <- lm(tmp_lat ~ poly(i, 3)) + degree <- min(3, length(i) - 1) + lat_model <- lm(tmp_lat ~ poly(i, degree)) lat_extremes <- c(NA, NA) if (which.min(tmp_lat) == 1) { prev_lat <- predict(lat_model, data.frame(i = 0)) -- GitLab From ab8ffc66faa55bfcf7e04deb583d7dd92e8bd84c Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Thu, 2 Mar 2017 01:58:41 +0100 Subject: [PATCH 06/19] Updates in CDORemap and Utils. --- R/CDORemap.R | 63 ++++++++++++-------- R/Utils.R | 161 +++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 190 insertions(+), 34 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index f3909bae..8a210ca1 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -491,15 +491,18 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } names(attr(lons, 'variables')) <- lon_var_name names(attr(lats, 'variables')) <- lat_var_name + lons_lats_taken <- FALSE for (i in 1:total_slices) { tmp_file <- tempfile('R_CDORemap_', write_dir, fileext = '.nc') tmp_file2 <- tempfile('R_CDORemap_', write_dir, fileext = '.nc') if (!is.null(dims_to_iterate)) { slice_indices <- which(slices_to_iterate == i, arr.ind = TRUE) subset <- Subset(data_array, dims_to_iterate, as.list(slice_indices), drop = 'selected') +# dims_before_crop <- dim(subset) # Make sure subset goes along with metadata ArrayToNetCDF(setNames(list(subset, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } else { +# dims_before_crop <- dim(data_array) ArrayToNetCDF(setNames(list(data_array, lons, lats), c('var', lon_var_name, lat_var_name)), tmp_file) } sellonlatbox <- '' @@ -508,7 +511,6 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, ',', lat_extremes[1], ',', lat_extremes[2], ' -') } err <- try({ -## TODO: Here add sellonlatbox. Also check constantin's issue, may contain hint. Also search if possible to crop without system(paste0("cdo -s ", sellonlatbox, "remap", method, ",", grid, " ", tmp_file, " ", tmp_file2)) }) file.remove(tmp_file) @@ -516,30 +518,45 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, stop("CDO remap failed.") } ncdf_remapped <- nc_open(tmp_file2) - found_dim_names <- sapply(ncdf_remapped$var$var$dim, '[[', 'name') - found_lon_dim <- found_dim_names[which(found_dim_names %in% .KnownLonNames())[1]] - found_lat_dim <- found_dim_names[which(found_dim_names %in% .KnownLatNames())[1]] - found_lon_dim_size <- length(ncdf_remapped$dim[[found_lon_dim]]$vals) - found_lat_dim_size <- length(ncdf_remapped$dim[[found_lat_dim]]$vals) - found_lons <- ncvar_get(ncdf_remapped, 'lon', collapse_degen = FALSE) - found_lats <- ncvar_get(ncdf_remapped, 'lat', collapse_degen = FALSE) - if (length(dim(found_lons)) > 1) { - if (found_lon_dim < found_lat_dim) { - names(dim(found_lons)) <- c(found_lon_dim, found_lat_dim) + if (!lons_lats_taken) { + found_dim_names <- sapply(ncdf_remapped$var$var$dim, '[[', 'name') + found_lon_dim <- found_dim_names[which(found_dim_names %in% .KnownLonNames())[1]] + found_lat_dim <- found_dim_names[which(found_dim_names %in% .KnownLatNames())[1]] + found_lon_dim_size <- length(ncdf_remapped$dim[[found_lon_dim]]$vals) + found_lat_dim_size <- length(ncdf_remapped$dim[[found_lat_dim]]$vals) + found_lons <- ncvar_get(ncdf_remapped, 'lon', collapse_degen = FALSE) + found_lats <- ncvar_get(ncdf_remapped, 'lat', collapse_degen = FALSE) + if (length(dim(lons)) == length(dim(found_lons))) { + new_lon_name <- lon_dim } else { - names(dim(found_lons)) <- c(found_lat_dim, found_lon_dim) + new_lon_name <- found_lon_dim } - } else { - names(dim(found_lons)) <- found_lon_dim - } - if (length(dim(found_lats)) > 1) { - if (found_lon_dim < found_lat_dim) { - names(dim(found_lats)) <- c(found_lon_dim, found_lat_dim) + if (length(dim(lats)) == length(dim(found_lats))) { + new_lat_name <- lat_dim } else { - names(dim(found_lats)) <- c(found_lat_dim, found_lon_dim) + new_lat_name <- found_lat_dim } - } else { - names(dim(found_lats)) <- found_lat_dim + if (length(dim(found_lons)) > 1) { + if (which(sapply(ncdf_remapped$var$lon$dim, '[[', 'name') == found_lon_dim) < + which(sapply(ncdf_remapped$var$lon$dim, '[[', 'name') == found_lat_dim)) { + names(dim(found_lons)) <- c(new_lon_name, new_lat_name) + } else { + names(dim(found_lons)) <- c(new_lat_name, new_lon_name) + } + } else { + names(dim(found_lons)) <- new_lon_name + } + if (length(dim(found_lats)) > 1) { + if (which(sapply(ncdf_remapped$var$lat$dim, '[[', 'name') == found_lon_dim) < + which(sapply(ncdf_remapped$var$lat$dim, '[[', 'name') == found_lat_dim)) { + names(dim(found_lats)) <- c(new_lon_name, new_lat_name) + } else { + names(dim(found_lats)) <- c(new_lat_name, new_lon_name) + } + } else { + names(dim(found_lats)) <- new_lat_name + } + lons_lats_taken <- TRUE } if (!is.null(dims_to_iterate)) { if (is.null(result_array)) { @@ -559,7 +576,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, new_dims <- dim(data_array) new_dims[c(lon_dim, lat_dim)] <- c(found_lon_dim_size, found_lat_dim_size) result_array <- ncvar_get(ncdf_remapped, 'var', collapse_degen = FALSE) - names(dim(result_array)) <- names(new_dims) + dim(result_array) <- new_dims } nc_close(ncdf_remapped) file.remove(tmp_file2) @@ -576,8 +593,6 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } attribute_backup[['dim']][which(names(dim(result_array)) == lon_dim)] <- dim(result_array)[lon_dim] attribute_backup[['dim']][which(names(dim(result_array)) == lat_dim)] <- dim(result_array)[lat_dim] - new_lon_name <- names(dim(found_lons))[which(names(dim(found_lons)) %in% .KnownLonNames())] - new_lat_name <- names(dim(found_lats))[which(names(dim(found_lats)) %in% .KnownLatNames())] names(attribute_backup[['dim']])[which(names(dim(result_array)) == lon_dim)] <- new_lon_name names(attribute_backup[['dim']])[which(names(dim(result_array)) == lat_dim)] <- new_lat_name if (!is.null(attribute_backup[['variables']]) && (length(attribute_backup[['variables']]) > 0)) { diff --git a/R/Utils.R b/R/Utils.R index 210cdfaf..c5f034c3 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -230,12 +230,12 @@ grids_types <- unlist(lapply(grids_info, function (x) x[grep('gridtype', x) + 1])) grids_matches <- unlist(lapply(grids_info, function (x) { nlons <- if (length(grep('xsize', x)) > 0) { - as.integer(x[grep('xsize', x) + 1]) + as.numeric(x[grep('xsize', x) + 1]) } else { NA } nlats <- if (length(grep('ysize', x)) > 0) { - as.integer(x[grep('ysize', x) + 1]) + as.numeric(x[grep('ysize', x) + 1]) } else { NA } @@ -279,14 +279,14 @@ # Now we calculate the common grid type and its lons and lats if (length(grep('^t\\d{1,+}grid$', work_piece[['grid']])) > 0) { common_grid_type <- 'gaussian' - common_grid_res <- as.integer(strsplit(work_piece[['grid']], '[^0-9]{1,+}')[[1]][2]) + common_grid_res <- as.numeric(strsplit(work_piece[['grid']], '[^0-9]{1,+}')[[1]][2]) nlonlat <- .t2nlatlon(common_grid_res) common_grid_lats <- nlonlat[1] common_grid_lons <- nlonlat[2] } else if (length(grep('^r\\d{1,+}x\\d{1,+}$', work_piece[['grid']])) > 0) { common_grid_type <- 'lonlat' - common_grid_lons <- as.integer(strsplit(work_piece[['grid']], '[^0-9]{1,+}')[[1]][2]) - common_grid_lats <- as.integer(strsplit(work_piece[['grid']], '[^0-9]{1,+}')[[1]][3]) + common_grid_lons <- as.numeric(strsplit(work_piece[['grid']], '[^0-9]{1,+}')[[1]][2]) + common_grid_lats <- as.numeric(strsplit(work_piece[['grid']], '[^0-9]{1,+}')[[1]][3]) } else { stop("Error: Only supported grid types in parameter 'grid' are tgrid and rx") } @@ -612,15 +612,15 @@ ' 2>/dev/null'), intern = TRUE), split = ' ') years <- strsplit(system(paste('cdo showyear ', filein, ' 2>/dev/null'), intern = TRUE), split = ' ') - mons <- as.integer(mons[[1]][which(mons[[1]] != "")]) - years <- as.integer(years[[1]][which(years[[1]] != "")]) + mons <- as.numeric(mons[[1]][which(mons[[1]] != "")]) + years <- as.numeric(years[[1]][which(years[[1]] != "")]) time_indices <- ts(time_indices, start = c(years[1], mons[1]), end = c(years[length(years)], mons[length(mons)]), frequency = 12) ltimes_list <- list() for (sdate in work_piece[['startdates']]) { - selected_time_indices <- window(time_indices, start = c(as.integer( - substr(sdate, 1, 4)), as.integer(substr(sdate, 5, 6))), + selected_time_indices <- window(time_indices, start = c(as.numeric( + substr(sdate, 1, 4)), as.numeric(substr(sdate, 5, 6))), end = c(3000, 12), frequency = 12, extend = TRUE) selected_time_indices <- selected_time_indices[work_piece[['leadtimes']]] ltimes_list <- c(ltimes_list, list(selected_time_indices)) @@ -1158,7 +1158,7 @@ if (give_warning) { .warning(paste0("Too complex path pattern specified for ", dataset_name, - ". Double check carefully the 'source_files' fetched for this dataset or specify a simpler path pattern.")) + ". Double check carefully the '$Files' fetched for this dataset or specify a simpler path pattern.")) } if (permissive) { @@ -1168,6 +1168,60 @@ } } +.FindTagValue <- function(path_with_globs_and_tag, actual_path, tag) { + tag <- paste0('\\$', tag, '\\$') + path_with_globs_and_tag <- paste0('^', path_with_globs_and_tag, '$') + parts <- strsplit(path_with_globs_and_tag, '*', fixed = TRUE)[[1]] + parts <- as.list(parts[grep(tag, parts)]) + longest_couples <- c() + pos_longest_couples <- c() + found_value <- NULL + for (i in 1:length(parts)) { + parts[[i]] <- strsplit(parts[[i]], tag)[[1]] + if (length(parts[[i]]) == 1) { + parts[[i]] <- c(parts[[i]], '') + } + len_parts <- sapply(parts[[i]], nchar) + len_couples <- len_parts[-length(len_parts)] + len_parts[2:length(len_parts)] + pos_longest_couples <- c(pos_longest_couples, which.max(len_couples)) + longest_couples <- c(longest_couples, max(len_couples)) + } + chosen_part <- which.max(longest_couples) + parts[[chosen_part]] <- parts[[chosen_part]][pos_longest_couples[chosen_part]:(pos_longest_couples[chosen_part] + 1)] + if (nchar(parts[[chosen_part]][1]) >= nchar(parts[[chosen_part]][2])) { + if (nchar(parts[[chosen_part]][1]) > 0) { + matches <- gregexpr(parts[[chosen_part]][1], actual_path)[[1]] + if (length(matches) == 1) { + match_left <- matches + actual_path <- substr(actual_path, match_left + attr(match_left, 'match.length'), nchar(actual_path)) + } + } + if (nchar(parts[[chosen_part]][2]) > 0) { + matches <- gregexpr(parts[[chosen_part]][2], actual_path)[[1]] + if (length(matches) == 1) { + match_right <- matches + found_value <- substr(actual_path, 0, match_right - 1) + } + } + } else { + if (nchar(parts[[chosen_part]][2]) > 0) { + matches <- gregexpr(parts[[chosen_part]][2], actual_path)[[1]] + if (length(matches) == 1) { + match_right <- matches + actual_path <- substr(actual_path, 0, match_right - 1) + } + } + if (nchar(parts[[chosen_part]][1]) > 0) { + matches <- gregexpr(parts[[chosen_part]][1], actual_path)[[1]] + if (length(matches) == 1) { + match_left <- matches + found_value <- substr(actual_path, match_left + attr(match_left, 'match.length'), nchar(actual_path)) + } + } + } + found_value +} + .FilterUserGraphicArgs <- function(excludedArgs, ...) { # This function filter the extra graphical parameters passed by the user in # a plot function, excluding the ones that the plot function uses by default. @@ -1440,3 +1494,90 @@ plot(0, type = 'n', axes = FALSE, ann = FALSE) par(mfg = next_attempt) } + +# Function to permute arrays of non-atomic elements (e.g. POSIXct) +.aperm2 <- function(x, new_order) { + y <- array(1:length(x), dim = dim(x)) + y <- aperm(y, new_order) + old_dims <- dim(x) + x <- x[as.vector(y)] + dim(x) <- old_dims[new_order] + x +} + +# 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 +# format is reached. +.MergeArrayDims <- function(dims1, dims2) { + new_dims1 <- c() + new_dims2 <- c() + while (length(dims1) > 0) { + if (names(dims1)[1] %in% names(dims2)) { + pos <- which(names(dims2) == names(dims1)[1]) + dims_to_add <- rep(1, pos - 1) + if (length(dims_to_add) > 0) { + names(dims_to_add) <- names(dims2[1:(pos - 1)]) + } + new_dims1 <- c(new_dims1, dims_to_add, dims1[1]) + new_dims2 <- c(new_dims2, dims2[1:pos]) + dims1 <- dims1[-1] + dims2 <- dims2[-c(1:pos)] + } else { + new_dims1 <- c(new_dims1, dims1[1]) + new_dims2 <- c(new_dims2, 1) + names(new_dims2)[length(new_dims2)] <- names(dims1)[1] + dims1 <- dims1[-1] + } + } + if (length(dims2) > 0) { + dims_to_add <- rep(1, length(dims2)) + names(dims_to_add) <- names(dims2) + new_dims1 <- c(new_dims1, dims_to_add) + new_dims2 <- c(new_dims2, dims2) + } + list(new_dims1, new_dims2) +} + +# This function takes two named arrays and merges them, filling with +# NA where needed. +# dim(array1) +# 'b' 'c' 'e' 'f' +# 1 3 7 9 +# dim(array2) +# 'a' 'b' 'd' 'f' 'g' +# 2 3 5 9 11 +# dim(.MergeArrays(array1, array2, 'b')) +# 'a' 'b' 'c' 'e' 'd' 'f' 'g' +# 2 4 3 7 5 9 11 +.MergeArrays <- function(array1, array2, along) { + if (!(identical(names(dim(array1)), names(dim(array2))) && + identical(dim(array1)[-which(names(dim(array1)) == along)], + dim(array2)[-which(names(dim(array2)) == along)]))) { + new_dims <- .MergeArrayDims(dim(array1), dim(array2)) + dim(array1) <- new_dims[[1]] + dim(array2) <- new_dims[[2]] + for (j in 1:length(dim(array1))) { + if (names(dim(array1))[j] != along) { + if (dim(array1)[j] != dim(array2)[j]) { + if (which.max(c(dim(array1)[j], dim(array2)[j])) == 1) { + na_array_dims <- dim(array2) + na_array_dims[j] <- dim(array1)[j] - dim(array2)[j] + na_array <- array(dim = na_array_dims) + array2 <- abind(array2, na_array, along = j) + names(dim(array2)) <- names(na_array_dims) + } else { + na_array_dims <- dim(array1) + na_array_dims[j] <- dim(array2)[j] - dim(array1)[j] + na_array <- array(dim = na_array_dims) + array1 <- abind(array1, na_array, along = j) + names(dim(array1)) <- names(na_array_dims) + } + } + } + } + } + array1 <- abind(array1, array2, along = which(names(dim(array1)) == along)) + names(dim(array1)) <- names(dim(array2)) + array1 +} -- GitLab From eee70f10d328e7581b052c22dd2d6a3f1e0a07d3 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Thu, 2 Mar 2017 15:30:44 +0100 Subject: [PATCH 07/19] Small fix in Utils. --- R/Utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Utils.R b/R/Utils.R index c5f034c3..ec154153 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -239,8 +239,8 @@ } else { NA } - if (identical(nlons, length(lon)) && - identical(nlats, length(lat))) { + if ((nlons == length(lon)) && + (nlats == length(lat))) { TRUE } else { FALSE -- GitLab From 852b58b7f6b079d1c68c527f5fea57d6b7962e66 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 15 Mar 2017 21:24:10 +0100 Subject: [PATCH 08/19] Small bugfix for CDORemap. --- R/CDORemap.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index 8a210ca1..d0895228 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -227,7 +227,8 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, left_is_min <- TRUE prev_lon <- predict(lon_model, data.frame(i = 0)) first_lon_cell_width <- (tmp_lon[1] - prev_lon) - lon_extremes[1] <- tmp_lon[1] - first_lon_cell_width / 2 + # The signif is needed because cdo sellonlatbox crashes with too many digits + lon_extremes[1] <- signif(tmp_lon[1] - first_lon_cell_width / 2, 6) } else { lon_extremes[1] <- min(tmp_lon) } @@ -235,7 +236,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, right_is_max <- TRUE next_lon <- predict(lon_model, data.frame(i = length(tmp_lon) + 1)) last_lon_cell_width <- (next_lon - tmp_lon[length(tmp_lon)]) - lon_extremes[2] <- tmp_lon[length(tmp_lon)] + last_lon_cell_width / 2 + lon_extremes[2] <- signif(tmp_lon[length(tmp_lon)] + last_lon_cell_width / 2, 6) } else { lon_extremes[2] <- max(tmp_lon) } @@ -282,13 +283,13 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, lat_extremes <- c(NA, NA) if (which.min(tmp_lat) == 1) { prev_lat <- predict(lat_model, data.frame(i = 0)) - lat_extremes[1] <- tmp_lat[1] - (tmp_lat[1] - prev_lat) / 2 + lat_extremes[1] <- signif(tmp_lat[1] - (tmp_lat[1] - prev_lat) / 2, 6) } else { lat_extremes[1] <- min(tmp_lat) } if (which.max(tmp_lat) == length(tmp_lat)) { next_lat <- predict(lat_model, data.frame(i = length(tmp_lat) + 1)) - lat_extremes[2] <- tmp_lat[length(tmp_lat)] + (next_lat - tmp_lat[length(tmp_lat)]) / 2 + lat_extremes[2] <- signif(tmp_lat[length(tmp_lat)] + (next_lat - tmp_lat[length(tmp_lat)]) / 2, 6) } else { lat_extremes[2] <- max(tmp_lat) } -- GitLab From 9bff34058ccf0e42fc35aff8657246b3efc07b16 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 15 Mar 2017 21:39:42 +0100 Subject: [PATCH 09/19] Bugfix in CDORemap. --- R/CDORemap.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/CDORemap.R b/R/CDORemap.R index d0895228..49bd9dbe 100644 --- a/R/CDORemap.R +++ b/R/CDORemap.R @@ -228,7 +228,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, prev_lon <- predict(lon_model, data.frame(i = 0)) first_lon_cell_width <- (tmp_lon[1] - prev_lon) # The signif is needed because cdo sellonlatbox crashes with too many digits - lon_extremes[1] <- signif(tmp_lon[1] - first_lon_cell_width / 2, 6) + lon_extremes[1] <- tmp_lon[1] - first_lon_cell_width / 2 } else { lon_extremes[1] <- min(tmp_lon) } @@ -236,7 +236,7 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, right_is_max <- TRUE next_lon <- predict(lon_model, data.frame(i = length(tmp_lon) + 1)) last_lon_cell_width <- (next_lon - tmp_lon[length(tmp_lon)]) - lon_extremes[2] <- signif(tmp_lon[length(tmp_lon)] + last_lon_cell_width / 2, 6) + lon_extremes[2] <- tmp_lon[length(tmp_lon)] + last_lon_cell_width / 2 } else { lon_extremes[2] <- max(tmp_lon) } @@ -283,13 +283,13 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, lat_extremes <- c(NA, NA) if (which.min(tmp_lat) == 1) { prev_lat <- predict(lat_model, data.frame(i = 0)) - lat_extremes[1] <- signif(tmp_lat[1] - (tmp_lat[1] - prev_lat) / 2, 6) + lat_extremes[1] <- tmp_lat[1] - (tmp_lat[1] - prev_lat) / 2 } else { lat_extremes[1] <- min(tmp_lat) } if (which.max(tmp_lat) == length(tmp_lat)) { next_lat <- predict(lat_model, data.frame(i = length(tmp_lat) + 1)) - lat_extremes[2] <- signif(tmp_lat[length(tmp_lat)] + (next_lat - tmp_lat[length(tmp_lat)]) / 2, 6) + lat_extremes[2] <- tmp_lat[length(tmp_lat)] + (next_lat - tmp_lat[length(tmp_lat)]) / 2 } else { lat_extremes[2] <- max(tmp_lat) } @@ -508,8 +508,10 @@ CDORemap <- function(data_array = NULL, lons, lats, grid, method, } sellonlatbox <- '' if (crop) { - sellonlatbox <- paste0('sellonlatbox,', lon_extremes[1], ',', lon_extremes[2], - ',', lat_extremes[1], ',', lat_extremes[2], ' -') + sellonlatbox <- paste0('sellonlatbox,', format(lon_extremes[1], scientific = FALSE), + ',', format(lon_extremes[2], scientific = FALSE), + ',', format(lat_extremes[1], scientific = FALSE), + ',', format(lat_extremes[2], scientific = FALSE), ' -') } err <- try({ system(paste0("cdo -s ", sellonlatbox, "remap", method, ",", grid, " ", tmp_file, " ", tmp_file2)) -- GitLab From a15961974e6c9a34f0306de6eaaac2d062b81713 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Thu, 23 Mar 2017 13:06:24 +0100 Subject: [PATCH 10/19] Enhancement in PlotEquiMap. --- R/PlotEquiMap.R | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index b8b7bd60..51599dc7 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -83,16 +83,28 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, dims <- dim(var) # Transpose the input matrices because the base plot functions work directly # with dimensions c(lon, lat). + transpose <- FALSE + if (!is.null(names(dims))) { + if (any(names(dims) %in% .KnownLonNames()) && + any(names(dims) %in% .KnownLatNames())) { + if (which(names(dims) %in% .KnownLonNames()) != 1) { + transpose <- TRUE + } + } + } if (dims[1] != length(lon) || dims[2] != length(lat)) { if (dims[1] == length(lat) && dims[2] == length(lon)) { - var <- t(var) - if (!is.null(varu)) varu <- t(varu) - if (!is.null(varv)) varv <- t(varv) - if (!is.null(contours)) contours <- t(contours) - if (!is.null(dots)) dots <- aperm(dots, c(1, 3, 2)) - dims <- dim(var) + transpose <- TRUE } } + if (transpose) { + var <- t(var) + if (!is.null(varu)) varu <- t(varu) + if (!is.null(varv)) varv <- t(varv) + if (!is.null(contours)) contours <- t(contours) + if (!is.null(dots)) dots <- aperm(dots, c(1, 3, 2)) + dims <- dim(var) + } # Check lon if (length(lon) != dims[1]) { -- GitLab From 17fa84d9e9f9de200345490f91c1a3e04dff1693 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 27 Mar 2017 19:36:13 +0200 Subject: [PATCH 11/19] Small fix in ArrayToNetCDF. --- R/ArrayToNetCDF.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ArrayToNetCDF.R b/R/ArrayToNetCDF.R index 0d8a87b8..64b85eda 100644 --- a/R/ArrayToNetCDF.R +++ b/R/ArrayToNetCDF.R @@ -74,7 +74,7 @@ ArrayToNetCDF <- function(arrays, file_path) { if (!is.numeric(dim_info[['len']])) { stop("The provided 'len' for the ", k, "th dimension in the ", i, "th array must be a numeric value.") } - dim_info[['len']] <- round(dim_info[['len']][1]) + dim_info[['len']] <- as.integer(round(dim_info[['len']][1])) if (dim_info[['len']] != dim(arrays[[i]])[k]) { stop("The provided 'len' for the ", k, "th dimension in the ", i, "th array does not match the actual length of the provided array.") } -- GitLab From 523afdf58c7d35a0932d07b43250033b5ac111ac Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 27 Mar 2017 23:06:40 +0200 Subject: [PATCH 12/19] Enhancements for ArrayToNetCDF. --- R/ArrayToNetCDF.R | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/R/ArrayToNetCDF.R b/R/ArrayToNetCDF.R index 64b85eda..20b2227e 100644 --- a/R/ArrayToNetCDF.R +++ b/R/ArrayToNetCDF.R @@ -40,7 +40,7 @@ ArrayToNetCDF <- function(arrays, file_path) { } dim_names <- names(dim(arrays[[i]])) if (!is.null(dim_names)) { - if (any(is.na(dim_names) || (sapply(dim_names, nchar) == 0))) { + if (any(is.na(dim_names) | (sapply(dim_names, nchar) == 0))) { stop("The provided arrays must have all named dimensions or ", "all unnamed dimensions.") } @@ -292,10 +292,14 @@ ArrayToNetCDF <- function(arrays, file_path) { if (!is.character(var_info[['coordinates']])) { stop("The attribute 'coordinates' must be a character string.") } - if (!(all(strsplit(var_info[['coordinates']], ' ')[[1]] %in% sapply(defined_vars, '[[', 'name')))) { - stop("All the dimensions appearing in 'coordinates' must point to defined variables.") + coords <- strsplit(var_info[['coordinates']], ' ')[[1]] + if (!(all(coords %in% sapply(defined_vars, '[[', 'name') | + coords %in% sapply(defined_dims[which(sapply(defined_dims, '[[', 'create_dimvar'))], '[[', 'name')))) { + coords <- coords[which(coords %in% sapply(defined_vars, '[[', 'name') | + coords %in% sapply(defined_dims[which(sapply(defined_dims, '[[', 'create_dimvar'))], '[[', 'name'))] + .warning("Some of the dimensions appearing in 'coordinates' have been removed because they point to undefined variables.") } - ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, 'coordinates', var_info[['coordinates']]) + ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, 'coordinates', paste(coords, collapse = ' ')) } attrs_to_skip <- which(names(var_info) %in% c('addOffset', 'scaleFact', 'coordinates')) attrs_to_add <- names(var_info) @@ -303,7 +307,10 @@ ArrayToNetCDF <- function(arrays, file_path) { attrs_to_add <- attrs_to_add[-attrs_to_skip] } for (attribute_name in attrs_to_add) { - ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, attribute_name, var_info[[attribute_name]]) + if (is.numeric(var_info[[attribute_name]]) || + is.character(var_info[[attribute_name]])) { + ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, attribute_name, var_info[[attribute_name]]) + } } var_counter <- var_counter + 1 } -- GitLab From 6107224ccb90c221b6a030126a8d81438ece90d3 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 29 Mar 2017 21:12:03 +0200 Subject: [PATCH 13/19] Fixes in ArrayToNetCDF. --- R/ArrayToNetCDF.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ArrayToNetCDF.R b/R/ArrayToNetCDF.R index 20b2227e..47fe13ef 100644 --- a/R/ArrayToNetCDF.R +++ b/R/ArrayToNetCDF.R @@ -98,7 +98,7 @@ ArrayToNetCDF <- function(arrays, file_path) { if (!('vals' %in% names(dim_info))) { dim_info[['vals']] <- 1:dim_info[['len']] } else { - if (!is.numeric(dim_info[['vals']])) { + if (!(is.numeric(dim_info[['vals']]))) { stop("The provided 'vals' for the ", k, "th dimension in the ", i, "th array must be a numeric vector.") } if (dim_info[['units']] == '') { @@ -301,7 +301,7 @@ ArrayToNetCDF <- function(arrays, file_path) { } ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, 'coordinates', paste(coords, collapse = ' ')) } - attrs_to_skip <- which(names(var_info) %in% c('addOffset', 'scaleFact', 'coordinates')) + attrs_to_skip <- which(names(var_info) %in% c('addOffset', 'scaleFact', 'coordinates', 'dim')) attrs_to_add <- names(var_info) if (length(attrs_to_skip) > 0) { attrs_to_add <- attrs_to_add[-attrs_to_skip] -- GitLab From 49fa62f5b28db171d247f0aa29cc9c19db020c15 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Sat, 1 Apr 2017 20:36:17 +0200 Subject: [PATCH 14/19] Small fixes to PlotLayout. --- R/PlotLayout.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 36719d6d..e5156acf 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -227,8 +227,8 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, dim_ids <- plot_dims[[plot_array_i]] if (is.character(dim_ids)) { dimnames <- NULL - if (!is.null(names(plot_array))) { - dimnames <- names(plot_array) + if (!is.null(names(dim(plot_array)))) { + dimnames <- names(dim(plot_array)) } else if (!is.null(attr(plot_array, 'dimensions'))) { dimnames <- attr(plot_array, 'dimensions') } @@ -237,7 +237,7 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, stop("All arrays provided in parameter 'var' must have all the dimensions in 'plot_dims'.") } dim_ids <- sapply(dim_ids, function(x) which(dimnames == x)[1]) - var[[plot_array_i]] <- aperm(var[[plot_array_i]], c((1:length(dim(plot_array)))[-dim_ids], dim_ids)) + var[[plot_array_i]] <- .aperm2(var[[plot_array_i]], c((1:length(dim(plot_array)))[-dim_ids], dim_ids)) } else { .warning(paste0("Assuming the ", plot_array_i, "th array provided in 'var' has 'plot_dims' as last dimensions (right-most).")) dims <- tail(c(rep(1, length(dim_ids)), dim(plot_array)), length(dim_ids)) -- GitLab From 40f3111633b9a10b894e67416313714a7e5bf157 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 5 Apr 2017 16:36:13 +0200 Subject: [PATCH 15/19] Fix bug for PlotLayout, when drawleg = FALSE. --- R/PlotLayout.R | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index e5156acf..a3f67e56 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -127,21 +127,19 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } # Check the rest of parameters (unless the user simply wants to build an empty layout) - if (!(drawleg == FALSE)) { - var_limits <- NULL - if (!all(sapply(var, is_single_na))) { - var_limits <- c(min(unlist(var), na.rm = TRUE), max(unlist(var), na.rm = TRUE)) - if ((any(is.infinite(var_limits)) || var_limits[1] == var_limits[2])) { - stop("Arrays in parameter 'var' must contain at least 2 different values.") - } + var_limits <- NULL + if (!all(sapply(var, is_single_na))) { + var_limits <- c(min(unlist(var), na.rm = TRUE), max(unlist(var), na.rm = TRUE)) + if ((any(is.infinite(var_limits)) || var_limits[1] == var_limits[2])) { + stop("Arrays in parameter 'var' must contain at least 2 different values.") } - colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, - var_limits, triangle_ends, col_inf, col_sup, color_fun, - plot = FALSE, draw_bar_ticks, - draw_separators, triangle_ends_scale, bar_extra_labels, - units, units_scale, bar_label_scale, bar_tick_scale, - bar_extra_margin, bar_label_digits) } + colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, + var_limits, triangle_ends, col_inf, col_sup, color_fun, + plot = FALSE, draw_bar_ticks, + draw_separators, triangle_ends_scale, bar_extra_labels, + units, units_scale, bar_label_scale, bar_tick_scale, + bar_extra_margin, bar_label_digits) # Check bar_scale if (!is.numeric(bar_scale)) { -- GitLab From e93441dbdd4ba36294ff25ebb12c17558f48cc14 Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Thu, 20 Apr 2017 17:15:47 +0200 Subject: [PATCH 16/19] Minor bugfix --- R/Corr.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/Corr.R b/R/Corr.R index 10858c29..4654db2c 100644 --- a/R/Corr.R +++ b/R/Corr.R @@ -149,8 +149,8 @@ Corr <- function(var_exp, var_obs, posloop = 1, poscor = 2, compROW = NULL, } } if (pval && (method == "pearson")) { - t <- CORR * sqrt((eno - 2) / (1 - (CORR ^ 2))) - p_val <- 1 - pt(t, eno - 2) + t <-sqrt(CORR * CORR * (eno - 2) / (1 - (CORR ^ 2))) + p_val <- pt(t, eno - 2, lower.tail = FALSE) } if (conf && (method == "pearson")) { conf_low <- (1 - siglev) / 2 -- GitLab From 5b5d7199e31e374aca4b6cc3b3e79b2d37bceabf Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Fri, 21 Apr 2017 11:51:57 +0200 Subject: [PATCH 17/19] Fix in PlotLayout for custom dimension orderings. Fixes #189. --- R/PlotLayout.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index a3f67e56..7d5eee1e 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -432,8 +432,13 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } plot_number <<- plot_number + 1 } else { + if (is.character(plot_dims[[array_number]])) { + plot_dim_indices <- which(names(dim(x)) %in% plot_dims[[array_number]]) + } else { + plot_dim_indices <- plot_dims[[array_number]] + } # For each of the arrays provided in that array - apply(x, (1:length(dim(x)))[1:(length(dim(x)) - length(plot_dims[[array_number]]))], + apply(x, (1:length(dim(x)))[-plot_dim_indices], function(y) { # Do the plot fun_args <- c(list(y, toptitle = titles[plot_number]), list(...), -- GitLab From 8991ba0a9c9d871f36c395f862f40bdbe678fae8 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 15 May 2017 17:30:45 +0200 Subject: [PATCH 18/19] Fixed bug when loading files with generic grids. Fixes #192. --- R/Load.R | 13 +++++++++---- R/Utils.R | 19 +++++++++++++------ 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/R/Load.R b/R/Load.R index 96b696a8..190872f3 100644 --- a/R/Load.R +++ b/R/Load.R @@ -268,14 +268,19 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, # grid if (!is.null(grid)) { if (is.character(grid)) { - supported_grids <- list('r[0-9]{1,}x[0-9]{1,}', 't[0-9]{1,}grid') - grid_matches <- unlist(lapply(lapply(supported_grids, regexpr, grid), .IsFullMatch, grid)) - if (sum(grid_matches) < 1) { - stop("The specified grid in the parameter 'grid' is incorrect. Must be one of rx or tgrid.") + if (grid == 'none') { + grid <- NULL + } else { + supported_grids <- list('r[0-9]{1,}x[0-9]{1,}', 't[0-9]{1,}grid') + grid_matches <- unlist(lapply(lapply(supported_grids, regexpr, grid), .IsFullMatch, grid)) + if (sum(grid_matches) < 1) { + stop("The specified grid in the parameter 'grid' is incorrect. Must be one of rx or tgrid.") + } } } else { stop("Error: parameter 'grid' should be a character string, if specified.") } + } } # maskmod diff --git a/R/Utils.R b/R/Utils.R index ec154153..c748a508 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -220,6 +220,9 @@ # Here we read the grid type and its number of longitudes and latitudes file_info <- system(paste('cdo -s griddes', filein, '2> /dev/null'), intern = TRUE) grids_positions <- grep('# gridID', file_info) + if (length(grids_positions) < 1) { + stop("The grid should be defined in the files.") + } grids_first_lines <- grids_positions + 2 grids_last_lines <- c((grids_positions - 2)[-1], length(file_info)) grids_info <- as.list(1:length(grids_positions)) @@ -239,12 +242,14 @@ } else { NA } - if ((nlons == length(lon)) && - (nlats == length(lat))) { - TRUE - } else { - FALSE + result <- FALSE + if (!any(is.na(c(nlons, nlats)))) { + if ((nlons == length(lon)) && + (nlats == length(lat))) { + result <- TRUE + } } + result })) grids_matches <- grids_matches[which(grids_types %in% c('gaussian', 'lonlat'))] grids_info <- grids_info[which(grids_types %in% c('gaussian', 'lonlat'))] @@ -261,8 +266,10 @@ } else { stop("Error: Load() can't disambiguate: More than one lonlat/gaussian grids with the same size as the requested variable defined in ", filename) } - } else { + } else if (sum(grids_matches) == 1) { grid_type <- grids_types[which(grids_matches)] + } else { + stop("Unexpected error.") } grid_lons <- length(lon) grid_lats <- length(lat) -- GitLab From eef96d3de4d7c99fd774230071031c3a343f923f Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 15 May 2017 17:38:19 +0200 Subject: [PATCH 19/19] Bumped version to 2.8.2. --- DESCRIPTION | 2 +- R/Load.R | 1 - man/s2dverification.Rd | 4 ++-- s2dverification-manual.pdf | Bin 371556 -> 371555 bytes 4 files changed, 3 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cf50cf03..d36c898a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: s2dverification Title: Set of Common Tools for Forecast Verification -Version: 2.8.1 +Version: 2.8.2 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("Virginie", "Guemas", , "virginie.guemas@bsc.es", role = "aut"), diff --git a/R/Load.R b/R/Load.R index 190872f3..efcc74c1 100644 --- a/R/Load.R +++ b/R/Load.R @@ -280,7 +280,6 @@ Load <- function(var, exp = NULL, obs = NULL, sdates, nmember = NULL, } else { stop("Error: parameter 'grid' should be a character string, if specified.") } - } } # maskmod diff --git a/man/s2dverification.Rd b/man/s2dverification.Rd index af6beaae..ee3fca80 100644 --- a/man/s2dverification.Rd +++ b/man/s2dverification.Rd @@ -10,8 +10,8 @@ Set of tools to verify forecasts through the computation of typical prediction s \tabular{ll}{ Package: \tab s2dverification\cr Type: \tab Package\cr -Version: \tab 2.8.1\cr -Date: \tab 2017-02-15\cr +Version: \tab 2.8.2\cr +Date: \tab 2017-05-15\cr License: \tab LGPLv3\cr } Check an overview of the package functionalities and its modules at \url{https://earth.bsc.es/gitlab/es/s2dverification/wikis/home}. diff --git a/s2dverification-manual.pdf b/s2dverification-manual.pdf index 01c10e3721942fc4dfc4179606bda389e0b0a1ba..8c8bdc7fc49c2a8c052aefcaa8a4d462386c393c 100644 GIT binary patch delta 10447 zcmajBWl$Vk6E(;HGq}S*aJS&@uECw)?iwWc4DOIXkf0NS1PD%WcMa|~xVvk<=dG=+ z+8F?b8`^f$N zr@5D4xM+t;!4OXF?fhlR7i7-^xe(O?A&>d**N&eAZ&%UOI;Y8tc_qD>ARiub7HMFkQiX6j#7S%5pHGGT@uJ#F^{{x47Upw8abttU8XBcmYUue<% z!P(6tf`&>|&)jmXM;vIGj>8Wr{PgR)nDsCNji;hADf+r>>OS=xjvUVU_M4*Us-~Yl zTjYlxB`>cGQ!iuFwFv8p*3Ww=qv#*=hrWNq8akH=uAatWdToHj3vRj4$_wTB5Jcc(*zLm4#$|5%AIdXrSuLs-9g4>>mcWt*U zG-ZTIPoZ0xxY?FPohDJjSGL>^DJ{s&ysP?w-}QNht`6%sF7DgZ5)!KPdkH7<<#)1; zjyjkdf{Qx+neaG4)xT%Hzb$-RU)l?M^k)IxN*GqBf+L(TW+%&Ni89_|Qql9ZYt`zu zP%U*=tz9Csp=}5@ebM41_oW~(?VT-X-yJJS=Vye;8M>Qa6M*mo?WKtctSu-wJ5YZqsaP&S_TD{rUuysK5TA}>P+B(BP$kKaoz1)h7?eLsR z?c=@R4yLWv*Vg8SCY;z`G{Wb+6GM4_>coy);~|xt9nBa>@4f04lPhlLt@8FkmM#o6 z`wF4%6&T0cN5!s>*URedde>$*?(6GIoxdRudmNc&nBsekEFOA-B&iTZ4zUy@``6)* z(b%FPw2pqe;kl3R&9Hi!gdvC}eq|h7mZfARL)-7o1oQj$w@n^&r|5m_W*6c*wu6mB z8Ym>M^fhcd2lWPV5Dn!0aeWK~e4@{D@{${D_C1Tx2g>2OSyQHlOhq!Pv@&?=2Jan8q6$f{u8*Dc9W@gLd zo%wUfo{|SWP+DVOU&^DuTJTC5H!D53;i9aYetlASXrH~E(R@Bw8LVAP^I=)dZLt!q zLCHI~{J0mIef>s-F+94}hm|t5FtSw|BH74ru}jpktM(&Bch4QNGoYn9(EshZQc#e? zqwU0IHL&)WqAD5-*>#HN!Uk2v^`q&YT0hFY)MqnyBYY{F2_s*o>qbYMw)4?|==zTC z{p{!Ldlg{L9@F*~rT;p6foPDsm3SO> zpYxlE^V{uV+YKivgoOn$O=K5_VmYFTdOD2Z{gs^}Tt@t&jFA4=7$sj&v(tUK_*kN= zI3-S`19;jY!q-2i>nR_BD8{sHt~Y}uJ8Vl>V*HMq=deo!VmlE%-RDQzKlEo4oaehwf0M7Maz&q$AZ=jP%0Bg3dHd>gVz+ZD z%6S6y>`w-liJm8CdnM7v%j@ZB4pDEw?2bbTWyM_{xnv%>N};6rQu20F^B3Q4Db5Ki zx)b@lb304B-RSt_PCtD>Hmrrrru4QjiSjqDlQ>}P=J!ZI)5HA|xxu1Hx#L8ltX-rd zrZjr-qDc1~MEPq(tS6bS%J<40lsBc^e_Xo3!VQqM!ZS3`vcA3$gi(mu*>sKmYfH-h z@v`ZS3aTkRR?okFPKVA;F5?Kxom%MAfbrC>D;nDJECj)3{#lz8j9h-IxgUqt7FnM6 z&x!XJWLeh&b*ENh#O7;ZF}U8rGkMz?SREN*7yk_i`GMqqk#>XV?kALYv7tty&_VOT6L%03mMNZe7lP-S520MIc9q zSqNj)9l%va2G-q*HL@IO_3}_+gk8l?z8`X0GD?|<%D_FCj$GtEy^l~h%mY+i^ z{&Iv6eDpe(TlJe&X;n1RnJ|d)q*NR4o-Wem_tvb275b@-4YJxwvaCSL*5Rj z2uF2v#ZTo>E~vv-;=!cAA7xK@cu7FV)hvWu;(oVZ3B7>pD{FX!o?s-~(!?DbUr?{Z zs7J&3wUr|Mep95-&+uYdfSqXOlGRKtPKu@z(doxHFWC|dz3h$C8HJO ziAixtt{~|xE?MPvxD~>E&!pPufY0$r^1F5c$#m_y_H4Dtsmz}a*LYV?Un~2`+4+yguahFrNzS19I`7?02;mTp(Lz`h6c{Ww(t%#4c(q^4h^&? zEtkCv)2JQ7G0*;)cZO&d@PsJcqOQBB^#dWLOAKj*@6|)&9VD>=)eOt-F!r4f6}6)s z(}yZfvek*5twoY)B_<jFT(D&Ham?ydVCv5@_nKAlQ=KRY1~#!(D z408J}Bo`Rve4hwNmD-wX#o0+)5+qE|z(5tLJDed91}Gp}&})M1jg*H3I9aR(H-y93(VmYS zWroV2E}wboft4tX0h%_aBhw|E$V{vaqVtR)9y4p+uJcU)jVJBYtV4nCz5lK_2-_Pl z`X%PTY!;Lbqlv2UA57DHbb9xYa}G~gB1W;&v@WOljIFK%m6Ucjvg(14$Y8RXpp}Kr z*{&l5f+SMwzc+M|jo*LM1^hi3sxHJZ;mGuk>|LGd&>iTaiM+ii-1sGzw8myF#Aq8) zuDyr>;8V4U_{k~Qs+H%^uboyNgZ#GGiX^GkMjv~JpV(H5r!4XzjjW9bGBCAaZ|#S8 z5A*+A!00yJ4C3Y0X7(VL04H>xrOVk=8fnjWm5~V~<#iNzW_2}kpB=fDcL*em3jKEU zhDKT@kWT>+<^#O)z{6-MJ8q_Io5-JjgLbnGeXqA`9Q6c-40dxf8H=dxeu{gOqxdy1 z3+T-$*=Y=5y^7LPewAc|jFU{?56H}9bTSlaJ@iiyXXdBM<&%oIqK#*%w1p+^h+Qn%#h<(<8gj={*;_v5iTZ23 zw5|E}yfhfvl2ccDgZj z++2?3?BXY!D-F@JjGYA(28_m^qhM+xo5cz7{c_^K$P_?c^oCVQ{Kgc?S2o%+);jB% zd@?h_R!fqPbUoJa7}tIj6BCmrh~skWo(^QiqyY7T?cq9ddX`i$eb(e0_BT?8Ku{&s z9!GDlSr&=YJKW>K#AG+GW$Xs7_NAmUgK4NDTdv@Rl<2-U$yc~Z7dNh-7?enhDb-G~ zT`>iSAssC3o_rS0!y>|sRA35nxhpRJpg`18IVH0_=@r6V+kt{%#6!+4@2zheM*#_U z2|}3U2pi%k(Lri;S0t8u8Jo`#&>!DqR;(pVS@btzp*5dZW);!e;}=2eX;$}e=`0|S zaeZ{InxB{o%J3*i@f0An|H#mmq=z4XSC0IZ)ArZV#QPcya&&GbH6?<%B3L=Sqy z^}9&jy``*KTFCP$oTKctJwZoN)&){~ObFqEUs+*i_C{!ZvF6=ZAft@OM(E+9>GnPq z#n%v~f)m$1QKfss*2wM=gPA?_opCjZ`-VSD4(abRS7Uzh$hmAs)-ci{M-1xG2b%Zi zhx3R=as8Q=n;H3I;ZZvNoG;0f0BD=X+&C@UvN12wW64}AP??ZJAdg2yScdqX=Ft#F z)q>_$XP>+eNr)>eh#YNxPZj-nw-i#(I1(gDWu4(-Uo~DCTy$$Q>>&P8q%jY3ckH1i zV$%d$=M$@%##p#3(%!HDPYqU2H9s36YI%X{B7K*7WqH;n?xs~&)$qG#qEQC|8S*WB zM8-x})5c@!C{@)QB=pzsG{z8fgkK^{u%kS-9uy*SY*&=Dcgv+zc%0%fAlAz9l+e{J zZfekr2bT@D_*R=!{Sjl#R*b=ygUOh?Q@sQy^!DbNxpC~j=IthzM-3Gt?w?Ig^@Mzh-9d0@n#K6EN5VCRh>)tCu_r2>+)b`fXMt^fC2J_Id8kR89jx+( zu`Rn|K%WQ%O&xSMS^hw&0UdYW8D@w@T=YR%(SvcD3fxt9tpW+@<8#Kr(J2rxWCHMT zpR02<CAq$|R7B zmeR(~Lr5PM3=bs%ND->uwfu%l*RvTWM7|n^ZcMFtdY>ehRi68EQIlOP`Pk$u zsR1K_`}k$cwmwx@yx~Y&q@hTV2$>ig_yx}ULuyqMNvapSJ=g5M>m13e{iEv)9E{t# z^Jupm?A?DeXB5ELY=x!O&iG34mnQRn)+G!~c6dx}Y&Q4_H1Ys+s;&fWV`aq6UIePk z@+d|F`6ZspXrte*7IQw&!TqVfVC56cZ=6*0;r6=aoVEt^+q+hc3aRFhUcW1us4JN- zJxo%*Waa>9tEtMzh0(st79#A#chhntf4_OdmQ#@W{-q zS}2qF0RmWYy>5;RIPL{N4jngpHI}1#v4*)D#dc$L44y|&Q(gjd5}M^Q5~CJyyy&vI zq_nCo$b-O@HYlbz2zk)P;W%ZFhA6a{uaS8+tDoSWG=FJ04b%4SLPJT#?WJ`q2c|78 zaKJt-gL~K+qmN%Y5ZcN?GOpHyyK&xJqlDvMIkN4lp)EqIatEi7-#L>i&53<~j9lPw zQQijEG@-gjLeEseenvE;VI(2z&ZiBE=1(Q z&t;`|gW}fB?9qm|!F{z9bO9%(2rc+2I-FT}@7fP?$Xw}fi!8?0aJW^%?0i+#B&D=x zCcw(5swPp5Dx!?h7^oiXD$nAD&TE&j<&n>0{OKUc%9v$HfktClZwNK`b-MggUKpw+ zwnIGMgxV@(HnPjHHK408YVd0&O%t|{VAX7PY#%WwaZXL{1Z5lgMoT9afbIvF_QHcJ z=co?~<$lOfj~2q}aJ#@mT&jbWDasZt@axcK+D-@ySykO%E>RwhQmAuY2$^GQdH_~dSoES>7*}`+KqBon$etER$qoFx^%y+p>C~ZqLP}0M#*P?uI=wo zMEK@G!654}_-LldFMy1^B*3K0*bW79*T%N%%IHdjye~f++`T3aSz zrZ_|CR0K$j(0m8hWGm8Cy*-NzO7v)PzJYzR==M9M+f(zbZJ*_|oi%oEU?rQC`U;3SIdpM*?it5a(aIHn}Biv%BjS)5!-YZI|IQCkqvYlr)G29p8Fzk>&!RdYx>%%|C^jq%Ad?HQ zM(R8G&vaS2U|Zl}6_t^-#Ipr81zekNr_jlVOGiXYM*te7BM?VxAfGrsThP>fl4S`V zmapBJ(w6hGGXGA_NbwQj=h57#VAWaJ5(jFK^cenke-%UInZD*tm-1_47fwxFqG0Fx zKH;su4s0=jpX+{99eZx-_`)sg%0ID^&*)Sb{cuK9J?GL)Xtjc@rPi|5@WOzm6c2a1 z-uNSYc8FP>*)}U3?vR$5RDz1-kkQK4oGBNoA?%mJ)>N_?;-e>I*zk>5vtVPf=+b;q zo?G`eTNpDh&HaS+(glg4wOj??P!u-ims0BB(H{WBf?uAuazi3Gp?2TcN2Q-a=jZ(! z3YkCXQvY1e)=krYod03MX7c9`!MacG`3F<188of3^HAeflu}4Zf>2KF$uW{yG2%4q z6Qq$EO_HXT`BhNTvZEQ;Ohu$=Ig7jby!9iru-c3T)jAT9J|`N$--reXa3iQC&NvIa zB*YPVt@&PI3qSsR{DVM(D$E`0q+`?Xw>@P@{`iMD1cB{`Ko|Y;iZ!x=*(A*{5hF>0 z#lTsXZXVSYM-uprFZ%g1Rv)>@vy1V$58B6{0fw}iQ3-2TG`pIj+6hq|X$8N-U1enXJ2HS*8C#St5h+sUCJZ5l19jN(ucv7bnSRf2pfi4tFri1%}UalKL z!#-w7*WUPpu>?#t;<4L`R-z3AqMlnq%{8e)vDTuVDi|^7vy_Q(2bzUp>9)YFsdS=N z2gBu}WJ!IeITTIYXAz9VkXt7?ek5wHV%@>UVOTmYD1lSy zlTpmR&|oZf?)rGb`*0+Ol}Qi_C35s6c7Z9(kHotGa@d|z;)hHwPbMGFLWyMRfHMhV zrbJo8sz9B5V#z~bn(~F+YMlT|CT~7ZXo+D3Oa)B+)fPkgTVN`uqm}kN$v73ja)g5g zTa%g5IAomoIh?FRcneKrN@lz@^Ck-rmURf=WMVn$PlEZt4)JV880zU9)(CA6NS1~9 z#5;N*T%iJC^YU8KS#mSt$8#(ZGY&2LKMAYC6vhfpgtE+@F*D_lWseK}C|0FXscK!Y zSLIqmePg!Rxsn-^ZSGyGp$$pC&@BoNK}^;^><)1sC{|@xq8pO8XbokKWpu{Q!ciPr zGTI5L!ffkT9O4e>E=W#kmMP;jx<1INymyF$-0M`wHDI_B_w!dL`I4xqZNKwN@&&u1 z^e2L@6s$MuB;kFw>XQwhNCPPg*5t~y3TyU>>Yp9zM{@@91W5ynbfJy^!}RKN9qJGN z!x{@%s4ED4tjMwu3s|3~NV8;2i++(Uhx$^gNlp;#woVRAWwBfdT!}mI=r#^yL&ok4 z*bDTSw`4kST#3|@Bg6fBmy2uc>c7yQ?MF{8Pu+Y_QeTgqj|FSe`#fsZD~LKJ-Ks0Q ztVaqY+~v?ZPP9%{7Hlf2s|=H={TeoxHZD@|4PVmlKtn zdYP$!uK`$B2udX2+t2yST!Odn4KWv16D;W+b*vUPwNd9CKh*UiwO1F+nW6U*Im?O4 zoSEC_>kJ~DJoxmAm1QJ>;b8HIB~>@#j!3E_f#V?ahzQ%<`3x9m=tOa#f5eA5?%*I` z(VBz$M49d%p+Mt~pM#J-oukM@GsnOImyAL!;a5!%tBCbh8)hH;*NVdqEs)mSbl{F5MGXs!kEBGw($x0-m8V(&e8 zc72wrL?!-K9S0ijtpZVlHs~EA_rk%3g~<*#tQzZ@Rns5`_d^ygbT_DopMq@R2Y*z} zB65U`E;g81vrKPnmmAF2AJGJPo9_pjTLlJr1AH?7ctErp&x4R0$-c`Iqh+Inm8na4 z5=lMWj0^d%k;h)s(QRl57lM@sC1zMW9G|3tI&Xo94r(Tm2ibJMH)*iAF%}U84TQSA zpf>@E*)pGE%1nSQzF-rSc#FSbOPr-6>|8i*;Xn`K*>3S_#B{byh^GNgmuxjAWhfIL zQf{zQ_jLTTG0@q9LJVo5I|>MSRRkEwb+P%~1ry0qrh&9vK|~nq&!Zw!$jegk!1MgC z4L}zl>4hr=u+rJ*-0|H*uA1&yzA1&c4s86{de8c5}$)BXylwt(sv;TedsKP<)l zr354ll?@_nSF<9OIW+>Q%F9R4y1L4jd%aBd4={yXyH)bFiK2}429)L$*vuZ&`J(jo z2DIl$RG}E)m%X;X(}}v#U0fu9pKu-$ByYMoVGl@um_d1q3%Y7}Ih=Gde$I3a;d8ed zMs3wWoUsMvDhLCPZ3yzgkhsn|Vn@7<^)}KQ0M~?Q;Q85f8=vd64_aXH1%yfl$&!j& z`lLx{MO7MK+;QakVG9UJbE5&4lvwR3W~MI$9UI`epLGjm)nlZl(TAkNE|tf_IwfJO zI}irTFZsBk5vcTX)HH}_cuE&Mj&krdTT^Lde5@sY1t#iPg}tVH@?9nr-zT zx##Fm(1ewSq-C)2uTp0HQJ%C;)WPFM|MU#L#O%;ea}Lu(2^?PrlS@P4W^3Ib+aj;)aHy63W4-5&M1XD#Obls>tZ8 zoF1KBuZZ^;{{?>zxI}LS%MzY}XT(kB@Q~1F;5=Ay9Au^~E~7IEAiTko7p#hy*TIe7 zDqI>GEh~8h3p2+^{ct4OBMP=7*e)wzAv`0_62kiuRwEyJ2^=6MF`wM}ud>5%f9BFn z{vnD-Cp8~1kJ!%)Hwtkh4)U(9*<45bgrmB(>kJVELzRQ8*&-KBX(1Ezkrb=}5meLa%}Pz*@gRQdh2JLhjDFYDZtS6!oscYSvv zr=ifYI(P5&*x1{H57DsnJSOSu>xv|M1)4?B{80BovXZq&&ez1>b0^v6sS32Uu24gp zK3Y2PyPBaGc?Gsw?8%r&h+YPF-`^nx1?<{jyMMkPnUs_v3LkjVKUl3B`681GJfDk~ z$(Zr~r1Jhi=krc$IOcA%UUg$|d zq?-9G4sKckFeTxajT{3V>vu3GBirhm_#7SQI}ECKKZa4&e2E;itOk1S)c%KQ4cCWt z$0?~o1bD2zt~Fdt>d(!zM6QSaP02aoHmt8c*3gTbw7~)V*MPG!W#N%%dPLQ4vRTCvY9wyN>r% z1uK%qtMenKjO-{#y;_$Donn1cW18?7>y;>BFbnv2%8GDQLH z+ONI<#FUgDH^^NN^;1+Y`(}EK!j7EO;6q_45^ctAM>@=ZyuSh>Xc#bAER|3I{>sq^ zj3sp7w+((hMobnKo6LNMRi^eJ-LLH3RsNANtHvS-imRBwh{~L8iCm$g>Ix zAY;4OdC0bM4Ol3k=qwm1h7r4z*mbXL&fG5_&ZD$#W6_rRDGp|NDXtXQ?vdU87)A1ukkrY!@-F`N(+=Ao1e2{&=R&-sU_Q~K4=--KX#uXFN4JB z&XDibTqJ&>7hG zv*QT^V@9Tl)u-5DhWT_}Fnih8Z+w^dkkM>}R25YY?&iYS38^!=k|lKm22#C zQ64!&<&&lp`zehx^QYrj`SR2jOo$4t=5(=2#f*h(v-ECP0p~q3`Jb?;VM%|Jesl*! zb{KlYeLA$sG=K;cVSBM8W-;3Hm^;_(4Iw_T! zK`7W_0_qkY0&z6CHFTjk29zL-j$QI75_f%!54lY`%0&u>QDH(!a!@k5Ve(Xvk7?0e zs3gGuOb|)k!RN~I5#%OB#%{t)&_Wkx6Oc6VAu;(Vj?4mk75Q^_n|!`tZaWsZi^2nk zEsVi~N(`Y^ALjv845R@C&*p{cRfFccc`wM}_4`#2eJUoA|L>&jdM0oPZuR7W=Q0k`$=&}*si=|=P(3*I zkD2-cd%$RoD1LG%+T?-mMu-9D9V<0r9;%%V)8OX4uHJY5z%6O1GKqgE08zh7 z2j=*Y#UK1Ywrr9O8lyg5He5)$V{5{$-{(iEw=NN%_J>i(OT77F0kmk+-uJMj^ zCfNbYce5eeJn(JJ1z)a4{r&l)RU=bTduOTaf{89KDKirbwa$l$44N`v2mm(&RtB`= zv+I4(;3;=m?|V>7*!X|H#$D%cViO0d+K$5iq5N(iGR+Vz2hyPOp))YZYbc=qAFLmw AhX4Qo delta 10432 zcmaiZRZtv2(=EHOxO?!Riv$*ey95Zq-CcqNcU|1wLvVL@C%7-JfyIIZ4IU(azOU-u zx-a+Mhw19mb$X^Bdb&={>@5@TFB8}2BLR3)3XoW!_O2Ven6F#LJC02kwt5`P8|STE zjP{K`H`y}0Ugqx{nvo_A7*y#hzMR)lTO>yxfVH}mX&HcCmk3BSpOcld$8T8=!w!f4 zEbUI*Gv-QthhZ@OIvY|1?#d3(-_YXAyjtWaiYi`M)xIw|*3KIIat@lgQ9iazIFrXc zZQApKGHb?ai%s`dJE|0jIU6P;1+B1PO5t)3S#$61%J+G#pm>Tw8<#_545 zI}w{h=?h3&qklRaCG$r+;U!s~+FJhlO0N8s1+K9uhA+L5M6#0+GKL7YPjbAyPR?Mc zyYUf;xkBV9-g4-G#Z-MISLg^#{Y3ZT{Ik;mnitq~i51yFo=BR90xlo4kxNDVK8pQ- z=S;972v5pv|7`#DdOf}1<=vP@yVBlq+i>fCk;^M1q%%vE2? z`MoTw*R9jNmb=$J;wHSunQiN=-ic*l8R#?_Mp6-O$XK5F%;aSKm*9OKZ-3=xK47RC^l)uPK z@&q~Q31oT~v#IeV@<2};d09C-o8$^4Ol2$2d*zJ76=Q`nrt{=>`>gC?OU#>3M^BAE zC3A)kn1YVFXmlptsJO?C(52E&VwwE^S^;= zq3c0qXU+=O^$!vLmM#r@mfI~PA%*rWiG%cW#2i`ARJlwSo~Ag!jg=$ibnG{po>l-nUI`0J`cQ)SWf!S#cXQ*tm# z^El*vmHOQI?|(f%@)VD?h=KZwWvBRJ_1EF$M2yk)&1KU(TC!w@X)=%*+M{FdxG{$J zdTuO{kD|k-K$UU9T??8Y>MiWq*V7-%xWTO+OZz|}eez&7`nR`9sEIJ65dU89CS>~H z^t^jkSju~O=65x9-D_j-pI1@L>ZxfnvDRh%81G#2(1x_3Tyjuv3wyP46`%d2@v_HB zO%_fe^yz%-)$*n7;v(c2It(*+NCs-Vhj4oDPtXZCE$3ysAJy+MC5LN^u7B;@U80Ho zcFp7zU3LN_Nbhux7Vh11zt;5=m8_tZM08Tv$#v_m_gin> z>~;yRKYF^tOBaW&NYLKy?`_@88p#vSahv?n5Rs z{evWcU#sxR_Lht&892&M@t!GY3N2}c8djM{W(2QP?{+r4%!Q`h?uRvs=48A|(=kZr ztCdmQ&?vk?FA(t#Vs9)lS1Cs^N(;7lfy1w{7B4nhk2@3UD~b!_FT}epuoa!(YZ~Ac zAaIO7$S&RVtGK)wKGu?nRS>+K2l{N?^&6WI>zcxSB&-@QzL^`}twW*TN0U5z#2rE7 zV}`vS-$gx5K0FPi!tPKS2b8o5-!nz_xM{h$HN;ftA%qhB{*9&`; z_KuUExTT;YrH-Am^Qs+~b19fftno$eEV38N+I@zcu*s%XRNth-F5OJs$DNY}j$F-t z#`1GyU0ac=A{5q8J!ORVB2|r4b+6u>qeQJUw(G8YiBMfrGO5I1=2j&qcQtxbvrXhB zwNlo{Br(-PF-%S4_%ma^3Y6fW)-<9SV^r)3J#9X@;@bVkP7jh7d`S|ykV~;EjP(nS zDPmL74z~Q>D7e3Z&dw| zhcE>dI_AF3a-E6q)+9|4V{Afz`xXvE;4xf->nSFtU=zP)bKJKzie~c+a&B5cx$puh zs9A?JeqNp`02s|pMSE=~giE!_a*W2F=)Y6J_QBZ~g=&bL(89Z32E76|p+zd$!lx84 zCHb!SPeTPpY>!5#YEbASLv9$J-MQJMT0`TWwR_R%W+hh$mMZ>P1CjaaO{x%b4Hb&n zLFh5D;&%q>5Y0QE{3>6g<(w{!IM4HQs7Jx6u(1kr*1TeT-$h!5k-9A!3!)4 zR#`iSc*@)LHQ!#GBWQ^I1*Msr9_cyuKyXl;%xP1Q&*?(a+#PImDM$RcW9PcKVAwCO zY)tcUB??`Lg-{$n^RxKZQtET&J;w&3fvN#E5zeA>MEdE|568EbAx~ij6y#E5(BlvC z<_g^TnNi5(+3~j0fz4s_wiY%m?P0s7rhd^S8u4X_R~1bNN%4Els>a5IZ$C*?|>NLzlBl<_;#dLI6 zD*)n?=q+MbyK+~tTnkl}o~vkrvdk6T>oD45QL|SX2{VK&X$#6ZS1Z|Y z21B^ZKruPR&)oYGE@W)x>IkM683vbAt2cw3%yb56-)E3ukR-hLTt|;0;koD%7HzyB zm&F|LCBd+KvNgxt7%Mq6sklg^V?f`O;zf{rkf0r9x{H9vIc0_?^J|i1(B5T(38qII zJ+13fawD?Vk9y~u8=|-cq~17ZZAbmv7E^-}Q^g`gHca#VNNj}q@ zF(sPwfVYPlzfmVBRy9iWvRn*tGlMwE&kFYV`zM!LD=KBUe0d$9N84|&BA+>JMiP7Z zh_ia1-!aD(ItKLiKWE4Gg=6KkhFU2yp(663TG_V{nd5ic)^8&|M7KV1Kw^x=Sv)X` z)>jhg$gYBk--`GXASkVIrxp3Oo>}C6nVbH-IUcinc-BhrbCyBDW`x$eY0{hF+*?$P zlPZ(7PWKm6{Ps1qlDQJiK}0hD;!oNcm&av_>5R5cne{z(*H= znzHKi0m_s+NQma3_iAJ(qZv2%qo5{juB2;=J^=pQc)$=*YxvaQs-M;=jG~gopSEN8 zWbWuSr&NPD+c6wQ=8as-+k5fTd1{l{Afs5RhR9xyOBSuz-hsuHjYnBieP(V#p?>hi zXP;h~(xj4eNqZK~1=?4;uO?m1PIBJmR*k^Tn0Oe4HVgCk+(d zY^B7e70xHQ86z&zVUO%cC$cYkv*hr`!~=NbHn+vS1WkmlJNMD|iGp?8DGgf@Drg1+ z&IOEnR#{UOE`^_og$$qLM$rDFyf?UABV^OP_bE$I}H)e>83Gz2tzIQLI7ulcxwlQJoQf=ZW5uhU;J&%mnh<0 z=;hx=<&>q-{k2=MwlkbI=DuBficgI3K$CW>kM}roq-Bj%_EYF3=%m|=$ z7~oSxR77^fRXjf#q!4l>!h6A^SdF48l!RLA^&$f~TD<>W%gUJa*YYG>cxXB| z)-6;LjwxyB%H?r&pRJ2j;c?Ve4{$^ITEKd2E+41)J6p91lagdImKpy^!YrEWM?Xx% z#<(8dt~>W-Jd1G?N{RHDYDDMEbzISOaCQ}dp$tE3+B8`nkkA^)-wFy9ZU%MqS6Y*E z1@Sv+t!Pf~;f@X?7^gJdvZl{5hVl;Sq|GP955096uG(m2>HFcHHpdaU60+!1gu{k}trz49`|)aBoeWU9?arU;wAjPy zk8>MTF=xi&WG4lRES1pS+4$QXICy-z3&+$cN8f8;8G4amOb(G4EHOxYKZ;;VYyx4n zMB7I5!d!-Y1KDM!P=7xO`V`T*daD21IFow4m)3?25-Ec-f`!pD)G_E&C$h|-{FdTM zoG46mti8}t;lRX~kR~R3nz$_GZvZj$K=k=(hWXyQnIb@KIJzO#Cq|gXtI{MNqlU_K zXk9u>ZdXMhMkU(tGHnI)Y{$wQJfyW7rMLp&7ssNJQp3(gNFV15i6RBWf-_Iubq7K| z>(-NEJT-jpE$Z4kU8UAE+`hIz;DtB+8WRo5LPtlLq0~s5JTW4-LS`D`!N!K-qQ6ZJ z8WgKe4S_hn_+5Vc+GdYG>-svDS2b%a%Com?#GcB?Qsl}5lhxaH(Ki8v}kSgSN^(ticTueubKtF za!}Kof7XcMuugCP?b4uMG+qZa74-&4DZUloA&~JPHy#*N*iu`*<#O(>O;;pzfwRV= zY3QN9)+giROIpRl58Of$?7(7M{(m+i-h%ReV=MoTU`+0sdq_9a6>}t&`#JJxLK6N1 z5>pettIJkIZ-DNHX$9$W=t}-&p1Hb?Jl_1=QmI@H2*g!@dNnC#br?Z?3dx3*m%|6K z#yQ)B52DnypC(WfpM5`!7z9ts4E{pd9Ai{aS!5MP$@6DjlUNA>(813d%u8Df9o~z(#8s19|2Dg9h;;x zXVDq*PMZMSZQA8v`q1iZn7Y99P>bFd7+i>})joy4>5R4%4RIVXvcdS}qG$}6 zHHD1*-J%{NZ^bdOSvGaM+^LxDcjF#NST+*TT+PUpTK2Uc-<7NUZnh$(Ei)f~11B*w zwKP6)UprE^QY&Z)lquINFI9jo+QR%eQ)9cc2?*^3Q>0;*ohGY=#8iz04*J|Kuv z4^VJ;W($0>WQsoh7<9Gx?K?j{XjE$;si`i@7P|R9b;AKwb6Xa?!5KWdg%rs8R^Ybq zP10P5#N7anUB6jK(WrOfG`7VYCj4`-g`kn8`mFMnIa9`R* zrX3qrfB{~MG&IjaGvY;*?au+;NsJ3Zq1OaQwKJZFO?T>~VQ5@MZhDgi6DdwIutX=M3nYrUiZO@>tK*75cQx%mGpO zI8mDb1<+a?%~o7g{tl6~PO~?Y{;4lgIDT!B1?pMk1xUjjQ9RJzRdTo-`w5TFrvW;| zc&CP@`uI>&-ASD>>*%F$P+(`#0}{Dj$lH#uDbWH3KwyOus3<0Oe? z$)^Nu?~QOb_=tsa*b4viNbHO(EVplAyVWAk&|u}pJmbP3;PEEPd2`#hn$=bN zmcu?*uFiK@;HKmUf#Y4uce6chTAacxb;8iQ$~S-5wpc^Pqhk)VFGX#7{?6)%-DU~% zn8lYVxvpicJj8H|!C2u9V!4V9A8&ahZ$^+K=koXihF2;2X~{lm^0|@dJ~-X}>;sLE z@rH$1+QdSElMPTac2ASHO)gT*{^Qb(`!39d0u6Nv*eUUBfvUGB2j8?k2fmOX z_0m{HO?5M{1>5XyI<+o6zH21`M@IMZ=gig8t=zU>G7DYSuW1Sp#UEE_ z)xdZFrJkhV5yOVQb2;7g)ijviE@LZN*0WZ9eFa#Gqmuq3LUDOP@}^82O2PF%abj&{*G<5^N0 zejEy3y6>;~5wZwXm!VM7y}Jc)r~_<>Ui$PCL-TNTQ(wR3LAE!8HxtmyA-0j1{#P(@ zHJv)b&<05W{>)%t)*~}p*X3>3EetIWXP^z)W7|o1`8`hG ztQCVa!Z+t<5#Fk$<#Q}mTUoFKWlbL1smP*LY?G(LhY%>eyIePJz!@%gms%gGFAL=a zebBM3i1bwI&2i%QiVb$XqFVc-pjWTA@ZR%yQ@+G{lQ*Sj+?Y;2LSdd~$Y$6%{;f6l zouSpLB5ZhIsS$_AM3-_(W*I5t_%b?*kqzox8(*^DiB6Z-Aw%GZc3})u$kKpRyUTYg zNet2koe2Fn<{2a7-l(54*h71cIrm>?#wNE)EJ{ADU|%xbK`!K|5u&q}#lJvsr|gyl zZ1)}#unyZsx3hioCJ2Oy8J$DX(c*)tnq-FS}q8U0xxBq-IIVfZ26_1f#{kn!o}DZK}KJmsj;u9u7R>Cn}?s6GBD^M82%1@MqZksTuFA4dI1Qkp{YjF#E`E#MK3Dc6aos*P^Ov8oDYXwdWQ_8F(mPG1< zBtcPX54oOyy}1r^-sgS(=|B6`RSp+v;BS}&E;2Ea(8D1g^e#+dZ=O3V2=|PCop2ac z12$8rsP+XR&RTnp5zHIJvQF7NN%&0yW1X(qIeMf2uHL8(bcR2yr6RSF;E}Y84GZ@m zvyU|sT8;9+vrpY+uO~kvTL(q^_8T=5HRDB7<~P+cgnQ)fiq=!x3#|)8qllBN1Dcx% zy9OkUPvkVs{|}HI;T`{d_@$F)~pI`riwqlb_>P_uc%I{HZJ67>wQ?hu_Ypl2x0Y8`z~ za7hTYXIfW^{$+w#L$0W}_r@#U1HUG2*NW1+r{Urpo8LK#pt&Y{BsaqP+L|Yt`>s3K z11HYo>%!`_k9l1x`lZKzV$sX-GT&xwPQ5X*fb){7Osz%CG?j(aH3iIzn$evFyv^^e z|9Izux1&7X)Fjb5(rw2vO1ay0kNa_~b3ygOXxaC3td-|(boet@YV1iJKVUHL25g13 zqA1pd?(d__VHbi3iu)=hH6Qj^Yr`(-%1ZWc85iM9bG+dB z370HmrLHNPdVzNWV)haTnlEx>zDk2L<6a7MQDp!}y50%2ELWw^sSA;=opsrz-=GUS z2i&XK>|AAEf4Wr)#Jw*gpRq|6p!8IdnmRsl%`z56w07%wMOJ*52jZ^x!-iG=_7*pv za0Fzj^deaEKhoxR?0W*@=#2r~anGXp68lwwUWfal)UElC)VB{f-k*9PKPKr!X({tb zvVreSs5XnL>VSd|C(KUR3PD})H_#pz0vI10%#WkhPw?l1s5t0zOn?)a0df;u)JtYt z1LWI}mLH&&Gl%Cyk#9M#)lZgiNeHubl@?!9vF7zg@{htgdLjq-yORg@wkV1luUh3_ zobc9DHV2cf0@lTaR?$3yewg5_VjN*#^I+H-FH@Jv$J{F2hakGiV+FQqLWNM-1HYMk z6)oJV5)M%BnZOqJl}`xagrKDNzbB*BoM0DEb0IZAY6|o@Aj4t;b_K3mQuE`mFN89- zw@|_CC03|^jo<`J!6E!WrNAQMn*asPKmD9A9OQl)QUKFC{<%6IDL6MNGABRcOwcu) zw%tUcyPQ=9(BtP9SH$cD9S?5kTUc{;dUG_wG(eHrYVv1P^8g*z(gYXOLFQx2^w-vO z2-b)5>LA3JplyQeOooH?skfH=FA=JPBjB9V;-B+$>VF5t=LWmi19F27O%{U1UVQqA z@E{nu{>sCNvLzB4;6J0G;GklcH{SMdUgO&)8G(z)@il*Ds%wKDHQGQBYXhsqIkY@^P>2V*L2F%|yNvB1hY*kxN_8*;#@1`{$vec` zC^tRL5#ojbWjrtI0U>J59$6F0Mc*LL?Nk|M9sf^xU@1N}FUK||VU%y#`I(`CU+9UN z;;ZH_`D~iuZj___T>|OSOdl zHmYNE+C=NIT24WL95>hK%RVGw!dK}5nO=n04^}Zr8pzb12M>@$$-_iARf-h8RGd@m`fsDzmRG7eflPMRd=<|KFwPcG=Yy}5|T#A3|m0~gk33?P3adW z==e#(2>T4)sFC8TJJ!?H{_3~;q75H;1ADXoQk%bNv7H+r~Y#>%br^UQlzv*3`c!+`{!1{G8TSAxLeQy$P~OBh%6KvV_qtu z?qWB1dQ9GlSr((HghYdcS030oZY=L^MqVdC-IBmdl**87MRsQt!Rryz0Eh1yN zIv>KqJoB6Ui7C;t^FZl(r1Rh>li|~0%9ja|OI%^d)8^-rnqX)dJZUXsEBTJJI*3Ue zamBr<&Eez}xk!ytgwOYLUOaEd6$oQg5Nzd@`*rQ2w}4h)j7*}Z4|*Y6!h;Yydm`ZV zHKeMwT}7a6E}9R@)m@Ec*;}n7Tdc4|#+09}Q(RxC)b#;;Q?$a$Z_z@GHLH zLMmq?KY5_zrp1<9d|;qsd80ZWDekfLJ-qG&CGyh{W8L?pr zu`r8J#x7tp*m?T9NZ5a3deMToN^C z_53R4Jo&9y^~fsbyGB)izkg|Bc~4i)d0f|mSo){MP?#Ylh)g|foeG0wU9$u66!9s@ ziV512zwte-P2&KUA2U9%$OPd=_hElfmLK^KASH2K4r09{`>Op}IdB1<8b(nbm{ zOxg;W`%*^ypN`-k6|vK_rij&fI9}0oB!rAs7y{MdjbU}Kl`~3#a!w!x{RfO|K~6-6 zz$)T^29`52lTwW?>`eWoo2;Mj{F)Rsp$!>31_?APKK-I9M_Ua{xEZmj0h4N z%E;8QZ8g`@GTUWTzkHA=D6A`vm1*K~E z7$yCQZJwPfTvo9`NW@}Cj8a{sF)2B&83i{n6|=-2VQ;|)dP$vAso*j%AcKP}BMHw}=v z;bR?eQ`woP$3b;6k%b^JwZkj=3VLi`-=DJQ7~OJQC~YrRHc|Y3DckS@biaUNLMhx_ z?y7sM6Qh8pSV{D8Q(5i<^S>c4_@KG8K(@!oblHvh&c`N|fWau8CmG%ve{uJLE(G2cDC%X;L<8NSBvlJ^P!7a?=@UN7wEQzbfOckUcI z#xIl4W{;AN(m%+Q#>i8%%<_-=!5{#(Ib~qX$TTo>i5h2EPG4cu)1qUx*=2Z5zeY%r zS77JtD2~b?)m(lte7PKfUbPLa_HCB2*V z_F!Fz!yJi2`24AbTO_B4(G8*k2+` z_Ty)dT0j%Vd-34Sqc#Z(xgQ?v5mH1LeHHF9PdV2JkoySgvkp1eE&%*z&g*;sILfro zfd0z7QJYz^?oo$?A5>i;9=>Kfx|a9V*giEi=53=6VhG59hD#=Zl5h6i|4w6j7U-8O z8nuA}O#V?4e*8PhIltv&^{tB!biB}0hu9`|bO5Q`v-0Al#^{tt97!1OGIYckrTxNr zd#{&?{FS)hE8&W2Po&{eJ`mN579JJI1kC+^I#|!{_ooOWdOI-)6YA1ybg!IOOI0s z!l^IY;B!M4Xy2OI)33AeN7M<^S}p-=UFTd`|Hikkc$BO@ochltVC^MZ8G(1q%mZw0 zUspd$ffGWS-Ec&1-nm;X{nub=PN2%bOI!A^rct!22(PO9IV+wWs&fz{2AeC_e0^aR zBx?#M@E0`e5?rSF#i@g+99X*ZYx#15ucd<*F;jxw#@tY7{huy{<*s1mQwp6WZ2{L+ z_xJjWd+w$CxnT2#`SzUlp?2!Z8@cO_1|UC*^k&Mbns?52@|)|)9y7~9ywZ6=hk@Pg z{bT_rLYqx=-0`psrb>_(05v1O5@f}r_2a?VLTjx(>`I@s@Bd;pYId$UmY@f>eK@bw Xq@!b{8G==yx2U}63=GoBGU)#UA^6yb -- GitLab