From 1081e7b3ccb021cd873e49915345c292177f4bd8 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Mon, 5 Sep 2022 12:59:10 +0200 Subject: [PATCH 1/5] Do not show repeated warnings --- R/Start.R | 86 +++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 74 insertions(+), 12 deletions(-) diff --git a/R/Start.R b/R/Start.R index d9e9b09..c0b3d1f 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1222,6 +1222,10 @@ Start <- function(..., # dim = indices/selectors, debug <- TRUE } + warnings1 <- NULL + warnings2 <- NULL + warnings3 <- NULL + ############################## READING FILE DIMS ############################ # Check that no unrecognized variables are present in the path patterns # and also that no file dimensions are requested to THREDDs catalogs. @@ -2101,11 +2105,23 @@ Start <- function(..., # dim = indices/selectors, } # Transform the variables - transformed_data <- do.call(transform, c(list(data_array = NULL, - variables = vars_to_transform, - file_selectors = selectors_of_first_files_with_data[[i]], - crop_domain = transform_crop_domain), - transform_params)) + res1 <- .withWarnings( + do.call(transform, c(list(data_array = NULL, + variables = vars_to_transform, + file_selectors = selectors_of_first_files_with_data[[i]], + crop_domain = transform_crop_domain), + transform_params)) + ) + transformed_data <- res1$value + + if (!is.null(res1$warnings)) { + if (is.null(warnings1)) { + warnings1 <- res1$warnings + } else { + warnings1 <- c(warnings1, res1$warnings) + } + } + # Discard the common transformed variables if already transformed before if (!is.null(transformed_common_vars)) { common_ones <- which(names(picked_common_vars) %in% names(transformed_data$variables)) @@ -2967,12 +2983,23 @@ Start <- function(..., # dim = indices/selectors, inner_dim, sub_array_of_fri) } } - - transformed_subset_var <- do.call(transform, c(list(data_array = NULL, - variables = subset_vars_to_transform, - file_selectors = selectors_of_first_files_with_data[[i]], - crop_domain = transform_crop_domain), - transform_params))$variables[[var_with_selectors_name]] + res2 <- .withWarnings( + do.call(transform, c(list(data_array = NULL, + variables = subset_vars_to_transform, + file_selectors = selectors_of_first_files_with_data[[i]], + crop_domain = transform_crop_domain), + transform_params))$variables[[var_with_selectors_name]] + ) + transformed_subset_var <- res2$value + + if (!is.null(res2$warnings)) { + if (is.null(warnings2)) { + warnings2 <- res2$warnings + } else { + warnings2 <- c(warnings2, res2$warnings) + } + } + # Sorting the transformed variable and working out the indices again after transform. if (!is.null(dim_reorder_params[[inner_dim]])) { transformed_subset_var_reorder <- dim_reorder_params[[inner_dim]](transformed_subset_var) @@ -3886,7 +3913,8 @@ Start <- function(..., # dim = indices/selectors, # NOTE: In .LoadDataFile(), metadata is saved in metadata_folder/1 or /2 etc. Before here, # the path name is created in work_pieces but the path hasn't been built yet. if (num_procs == 1) { - found_files <- lapply(work_pieces, .LoadDataFile, + res3 <- .withWarnings( + lapply(work_pieces, .LoadDataFile, shared_matrix_pointer = shared_matrix_pointer, file_data_reader = file_data_reader, synonims = synonims, @@ -3894,10 +3922,22 @@ Start <- function(..., # dim = indices/selectors, transform_params = transform_params, transform_crop_domain = transform_crop_domain, silent = silent, debug = debug) + ) + found_files <- res3$value + + if (!is.null(res3$warnings)) { + if (is.null(warnings3)) { + warnings3 <- res3$warnings + } else { + warnings3 <- c(warnings3, res3$warnings) + } + } + } else { cluster <- parallel::makeCluster(num_procs, outfile = "") # Send the heavy work to the workers work_errors <- try({ + res3 <- .withWarnings( found_files <- parallel::clusterApplyLB(cluster, work_pieces, .LoadDataFile, shared_matrix_pointer = shared_matrix_pointer, file_data_reader = file_data_reader, @@ -3906,6 +3946,17 @@ Start <- function(..., # dim = indices/selectors, transform_params = transform_params, transform_crop_domain = transform_crop_domain, silent = silent, debug = debug) + ) + found_files <- res3$value + + if (!is.null(res3$warnings)) { + if (is.null(warnings3)) { + warnings3 <- res3$warnings + } else { + warnings3 <- c(warnings3, res3$warnings) + } + } + }) parallel::stopCluster(cluster) } @@ -4144,6 +4195,17 @@ Start <- function(..., # dim = indices/selectors, } } + + if (!is.null(c(warnings1, warnings2, warnings3))) { + warn_list <- lapply(c(warnings1, warnings2, warnings3), function(x) { + return(x$message) + }) + warning_list <- unique(warn_list) + for (i in 1:length(warning_list)) { + .warning(warning_list[[i]]) + } + } + # Change final_dims_fake back because retrieve = FALSE will use it for attributes later if (exists("final_dims_fake_output")) { -- GitLab From f81a4802d56e0fe0d1d27b4906d2fa7bb802b766 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Mon, 5 Sep 2022 12:59:35 +0200 Subject: [PATCH 2/5] add warning function --- R/Utils.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/Utils.R b/R/Utils.R index 9bf23e9..fc0b059 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -859,3 +859,13 @@ } return(unlist(new_list)) } + +.withWarnings <- function(expr) { + myWarnings <- NULL + wHandler <- function(w) { + myWarnings <<- c(myWarnings, list(w)) + invokeRestart("muffleWarning") + } + val <- withCallingHandlers(expr, warning = wHandler) + list(value = val, warnings = myWarnings) +} \ No newline at end of file -- GitLab From 90a44230253bfc458ca7d88466e4c374780e22a7 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 4 Nov 2022 13:31:07 +0100 Subject: [PATCH 3/5] Refine the code (minor changes) --- R/Start.R | 129 +++++++++++++++++++++++++++++++++--------------------- 1 file changed, 78 insertions(+), 51 deletions(-) diff --git a/R/Start.R b/R/Start.R index 62abccc..0206ee1 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1221,10 +1221,12 @@ Start <- function(..., # dim = indices/selectors, dims_to_check <- debug debug <- TRUE } - - warnings1 <- NULL - warnings2 <- NULL - warnings3 <- NULL + +#-------NEW--------- +# warnings1 <- NULL +# warnings2 <- NULL +# warnings3 <- NULL +#------NEW_END-------- ############################## READING FILE DIMS ############################ # Check that no unrecognized variables are present in the path patterns @@ -1951,6 +1953,12 @@ Start <- function(..., # dim = indices/selectors, transformed_common_vars_unorder_indices <- NULL transform_crop_domain <- NULL +#--------NEW--------- + # store warning messages from transform + warnings1 <- NULL + warnings2 <- NULL +#-------NEW_END-------- + for (i in 1:length(dat)) { if (dataset_has_files[i]) { indices <- indices_of_first_files_with_data[[i]] @@ -2105,22 +2113,25 @@ Start <- function(..., # dim = indices/selectors, } # Transform the variables - res1 <- .withWarnings( + tmp <- .withWarnings( do.call(transform, c(list(data_array = NULL, variables = vars_to_transform, file_selectors = selectors_of_first_files_with_data[[i]], crop_domain = transform_crop_domain), transform_params)) ) - transformed_data <- res1$value - - if (!is.null(res1$warnings)) { - if (is.null(warnings1)) { - warnings1 <- res1$warnings - } else { - warnings1 <- c(warnings1, res1$warnings) - } - } + transformed_data <- tmp$value +#print("warnings1") +#browser() +#--------NEW------------- +# if (!is.null(res1$warnings)) { +# if (is.null(warnings1)) { +# warnings1 <- res1$warnings +# } else { + warnings1 <- c(warnings1, tmp$warnings) +# } +# } +#-------NEW_END---------- # Discard the common transformed variables if already transformed before if (!is.null(transformed_common_vars)) { @@ -2990,22 +3001,25 @@ Start <- function(..., # dim = indices/selectors, inner_dim, sub_array_of_fri) } } - res2 <- .withWarnings( + tmp <- .withWarnings( do.call(transform, c(list(data_array = NULL, variables = subset_vars_to_transform, file_selectors = selectors_of_first_files_with_data[[i]], crop_domain = transform_crop_domain), transform_params))$variables[[var_with_selectors_name]] ) - transformed_subset_var <- res2$value - - if (!is.null(res2$warnings)) { - if (is.null(warnings2)) { - warnings2 <- res2$warnings - } else { - warnings2 <- c(warnings2, res2$warnings) - } - } + transformed_subset_var <- tmp$value +#print("warnings2") +#browser() +#--------NEW----------- +# if (!is.null(res2$warnings)) { +# if (is.null(warnings2)) { +# warnings2 <- res2$warnings +# } else { + warnings2 <- c(warnings2, tmp$warnings) +# } +# } +#-----NEW_END------------ # Sorting the transformed variable and working out the indices again after transform. if (!is.null(dim_reorder_params[[inner_dim]])) { @@ -3764,7 +3778,11 @@ Start <- function(..., # dim = indices/selectors, final_dims_fake, dims_of_merge_dim, all_split_dims) } } - + +#------NEW--------- + # store warning messages from transform + warnings3 <- NULL +#----NEW_END------- # The following several lines will only run if retrieve = TRUE if (retrieve) { @@ -3843,10 +3861,11 @@ Start <- function(..., # dim = indices/selectors, # the appropriate work pieces. work_pieces <- retrieve_progress_message(work_pieces, num_procs, silent) + # NOTE: In .LoadDataFile(), metadata is saved in metadata_folder/1 or /2 etc. Before here, # the path name is created in work_pieces but the path hasn't been built yet. if (num_procs == 1) { - res3 <- .withWarnings( + tmp <- .withWarnings( lapply(work_pieces, .LoadDataFile, shared_matrix_pointer = shared_matrix_pointer, file_data_reader = file_data_reader, @@ -3856,21 +3875,24 @@ Start <- function(..., # dim = indices/selectors, transform_crop_domain = transform_crop_domain, silent = silent, debug = debug) ) - found_files <- res3$value - - if (!is.null(res3$warnings)) { - if (is.null(warnings3)) { - warnings3 <- res3$warnings - } else { - warnings3 <- c(warnings3, res3$warnings) - } - } + found_files <- tmp$value +#print('warnings3-1') +#browser() +#-----------NEW------------- +# if (!is.null(tmp$warnings)) { +# if (is.null(warnings3)) { +# warnings3 <- tmp$warnings +# } else { + warnings3 <- c(warnings3, tmp$warnings) +# } +# } +#----------NEW_END------------ } else { cluster <- parallel::makeCluster(num_procs, outfile = "") # Send the heavy work to the workers work_errors <- try({ - res3 <- .withWarnings( + tmp <- .withWarnings( found_files <- parallel::clusterApplyLB(cluster, work_pieces, .LoadDataFile, shared_matrix_pointer = shared_matrix_pointer, file_data_reader = file_data_reader, @@ -3880,15 +3902,18 @@ Start <- function(..., # dim = indices/selectors, transform_crop_domain = transform_crop_domain, silent = silent, debug = debug) ) - found_files <- res3$value - - if (!is.null(res3$warnings)) { - if (is.null(warnings3)) { - warnings3 <- res3$warnings - } else { - warnings3 <- c(warnings3, res3$warnings) - } - } + found_files <- tmp$value +#print('warnings3-2') +#browser() +#-----------NEW------------- +# if (!is.null(res3$warnings)) { +# if (is.null(warnings3)) { +# warnings3 <- res3$warnings +# } else { + warnings3 <- c(warnings3, tmp$warnings) +# } +# } +#----------NEW_END------------ }) parallel::stopCluster(cluster) @@ -4128,17 +4153,19 @@ Start <- function(..., # dim = indices/selectors, } } - +#browser() + # Print the warnings from transform if (!is.null(c(warnings1, warnings2, warnings3))) { - warn_list <- lapply(c(warnings1, warnings2, warnings3), function(x) { +#----------NEW----------- + transform_warnings_list <- lapply(c(warnings1, warnings2, warnings3), function(x) { return(x$message) }) - warning_list <- unique(warn_list) - for (i in 1:length(warning_list)) { - .warning(warning_list[[i]]) + transform_warnings_list <- unique(transform_warnings_list) + for (i in 1:length(transform_warnings_list)) { + .warning(transform_warnings_list[[i]]) } } - +#-------NEW_END---------- # Change final_dims_fake back because retrieve = FALSE will use it for attributes later if (exists("final_dims_fake_output")) { -- GitLab From dc68670a36db81edaed1f723a2f54f94f4ed3a1d Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 4 Nov 2022 14:46:14 +0100 Subject: [PATCH 4/5] Remove 'crop' in Start() call --- inst/doc/usecase/ex1_1_tranform.R | 3 +-- inst/doc/usecase/ex1_5_latlon_reorder.R | 8 ++------ inst/doc/usecase/ex2_12_transform_and_chunk.R | 9 +++------ 3 files changed, 6 insertions(+), 14 deletions(-) diff --git a/inst/doc/usecase/ex1_1_tranform.R b/inst/doc/usecase/ex1_1_tranform.R index a544f84..e735280 100644 --- a/inst/doc/usecase/ex1_1_tranform.R +++ b/inst/doc/usecase/ex1_1_tranform.R @@ -39,8 +39,7 @@ obs <- Start(dat = obs_path, transform = CDORemapper, transform_extra_cells = 2, transform_params = list(grid = 'r360x181', - method = 'conservative', - crop = c(lons.min, lons.max, lats.min, lats.max)), + method = 'conservative'), transform_vars = c('latitude', 'longitude'), return_vars = list(time = NULL, latitude = 'dat', diff --git a/inst/doc/usecase/ex1_5_latlon_reorder.R b/inst/doc/usecase/ex1_5_latlon_reorder.R index c54314f..75469bf 100644 --- a/inst/doc/usecase/ex1_5_latlon_reorder.R +++ b/inst/doc/usecase/ex1_5_latlon_reorder.R @@ -98,9 +98,7 @@ res <- Start(dat = path_exp, longitude_reorder = CircularSort(-180, 180), transform = CDORemapper, transform_params = list(grid ='r360x181', - method = 'con', - crop = c(lons.min, lons.max, - lats.min, lats.max)), + method = 'con'), transform_vars = c('longitude', 'latitude'), synonims = list(latitude=c('lat', 'latitude'), longitude=c('lon', 'longitude')), @@ -151,9 +149,7 @@ res <- Start(dat = path_exp, longitude_reorder = CircularSort(0, 360), transform = CDORemapper, transform_params = list(grid ='r360x181', - method = 'con', - crop = c(lons.min, lons.max, - lats.min, lats.max)), + method = 'con'), transform_vars = c('longitude', 'latitude'), synonims = list(latitude=c('lat', 'latitude'), longitude=c('lon', 'longitude')), diff --git a/inst/doc/usecase/ex2_12_transform_and_chunk.R b/inst/doc/usecase/ex2_12_transform_and_chunk.R index 8b2eb83..d89448c 100644 --- a/inst/doc/usecase/ex2_12_transform_and_chunk.R +++ b/inst/doc/usecase/ex2_12_transform_and_chunk.R @@ -43,8 +43,7 @@ exp <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$ longitude_reorder = CircularSort(0, 360), transform = CDORemapper, transform_params = list(grid = 'r100x50', - method = 'con', - crop = c(lons.min, lons.max, lats.min, lats.max)), + method = 'con'), transform_vars = c('latitude', 'longitude'), transform_extra_cells = 8, synonims = list(latitude = c('latitude', 'lat'), @@ -93,8 +92,7 @@ exp <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$ longitude_reorder = CircularSort(0, 360), transform = CDORemapper, transform_params = list(grid = 'r100x50', - method = 'con', - crop = FALSE), + method = 'con'), transform_vars = c('latitude', 'longitude'), transform_extra_cells = 8, synonims = list(latitude = c('latitude', 'lat'), @@ -136,8 +134,7 @@ exp <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$ longitude_reorder = CircularSort(0, 360), transform = CDORemapper, transform_params = list(grid = 'r100x50', - method = 'con', - crop = FALSE), + method = 'con'), transform_vars = c('latitude', 'longitude'), transform_extra_cells = 8, synonims = list(latitude = c('latitude', 'lat'), -- GitLab From 5bb170dc4a8a9f806c1fff247a213481575a23e6 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 4 Nov 2022 17:14:37 +0100 Subject: [PATCH 5/5] Clean comments; remove .withWarnings() for num_procs > 1 case --- R/Start.R | 61 +++---------------------------------------------------- R/Utils.R | 6 +++--- 2 files changed, 6 insertions(+), 61 deletions(-) diff --git a/R/Start.R b/R/Start.R index 0206ee1..964d52f 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1222,12 +1222,6 @@ Start <- function(..., # dim = indices/selectors, debug <- TRUE } -#-------NEW--------- -# warnings1 <- NULL -# warnings2 <- NULL -# warnings3 <- NULL -#------NEW_END-------- - ############################## READING FILE DIMS ############################ # Check that no unrecognized variables are present in the path patterns # and also that no file dimensions are requested to THREDDs catalogs. @@ -1953,11 +1947,9 @@ Start <- function(..., # dim = indices/selectors, transformed_common_vars_unorder_indices <- NULL transform_crop_domain <- NULL -#--------NEW--------- # store warning messages from transform warnings1 <- NULL warnings2 <- NULL -#-------NEW_END-------- for (i in 1:length(dat)) { if (dataset_has_files[i]) { @@ -2121,17 +2113,7 @@ Start <- function(..., # dim = indices/selectors, transform_params)) ) transformed_data <- tmp$value -#print("warnings1") -#browser() -#--------NEW------------- -# if (!is.null(res1$warnings)) { -# if (is.null(warnings1)) { -# warnings1 <- res1$warnings -# } else { warnings1 <- c(warnings1, tmp$warnings) -# } -# } -#-------NEW_END---------- # Discard the common transformed variables if already transformed before if (!is.null(transformed_common_vars)) { @@ -3009,17 +2991,7 @@ Start <- function(..., # dim = indices/selectors, transform_params))$variables[[var_with_selectors_name]] ) transformed_subset_var <- tmp$value -#print("warnings2") -#browser() -#--------NEW----------- -# if (!is.null(res2$warnings)) { -# if (is.null(warnings2)) { -# warnings2 <- res2$warnings -# } else { warnings2 <- c(warnings2, tmp$warnings) -# } -# } -#-----NEW_END------------ # Sorting the transformed variable and working out the indices again after transform. if (!is.null(dim_reorder_params[[inner_dim]])) { @@ -3779,10 +3751,9 @@ Start <- function(..., # dim = indices/selectors, } } -#------NEW--------- # store warning messages from transform warnings3 <- NULL -#----NEW_END------- + # The following several lines will only run if retrieve = TRUE if (retrieve) { @@ -3876,23 +3847,14 @@ Start <- function(..., # dim = indices/selectors, silent = silent, debug = debug) ) found_files <- tmp$value -#print('warnings3-1') -#browser() -#-----------NEW------------- -# if (!is.null(tmp$warnings)) { -# if (is.null(warnings3)) { -# warnings3 <- tmp$warnings -# } else { warnings3 <- c(warnings3, tmp$warnings) -# } -# } -#----------NEW_END------------ } else { cluster <- parallel::makeCluster(num_procs, outfile = "") # Send the heavy work to the workers + ##NOTE: .withWarnings() can't catch warnings like it does above (num_procs == 1). The warnings + ## show below when "bigmemory::as.matrix(data_array)" is called. Don't know how to fix it for now. work_errors <- try({ - tmp <- .withWarnings( found_files <- parallel::clusterApplyLB(cluster, work_pieces, .LoadDataFile, shared_matrix_pointer = shared_matrix_pointer, file_data_reader = file_data_reader, @@ -3901,20 +3863,6 @@ Start <- function(..., # dim = indices/selectors, transform_params = transform_params, transform_crop_domain = transform_crop_domain, silent = silent, debug = debug) - ) - found_files <- tmp$value -#print('warnings3-2') -#browser() -#-----------NEW------------- -# if (!is.null(res3$warnings)) { -# if (is.null(warnings3)) { -# warnings3 <- res3$warnings -# } else { - warnings3 <- c(warnings3, tmp$warnings) -# } -# } -#----------NEW_END------------ - }) parallel::stopCluster(cluster) } @@ -4153,10 +4101,8 @@ Start <- function(..., # dim = indices/selectors, } } -#browser() # Print the warnings from transform if (!is.null(c(warnings1, warnings2, warnings3))) { -#----------NEW----------- transform_warnings_list <- lapply(c(warnings1, warnings2, warnings3), function(x) { return(x$message) }) @@ -4165,7 +4111,6 @@ Start <- function(..., # dim = indices/selectors, .warning(transform_warnings_list[[i]]) } } -#-------NEW_END---------- # Change final_dims_fake back because retrieve = FALSE will use it for attributes later if (exists("final_dims_fake_output")) { diff --git a/R/Utils.R b/R/Utils.R index fc0b059..3d4d864 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -863,9 +863,9 @@ .withWarnings <- function(expr) { myWarnings <- NULL wHandler <- function(w) { - myWarnings <<- c(myWarnings, list(w)) - invokeRestart("muffleWarning") + myWarnings <<- c(myWarnings, list(w)) + invokeRestart("muffleWarning") } val <- withCallingHandlers(expr, warning = wHandler) list(value = val, warnings = myWarnings) -} \ No newline at end of file +} -- GitLab