From 3bfb1811bd055cb350ef704a481786ae2f28fa44 Mon Sep 17 00:00:00 2001 From: Sara Moreno Date: Tue, 9 May 2023 11:19:51 +0200 Subject: [PATCH 1/2] Calibration simple --- R/Intbc.R | 4 ++-- R/Interpolation.R | 22 ++++++---------------- R/Intlr.R | 12 +++++++++++- R/Utils.R | 2 +- 4 files changed, 20 insertions(+), 20 deletions(-) diff --git a/R/Intbc.R b/R/Intbc.R index 1cb558d..2574e5d 100644 --- a/R/Intbc.R +++ b/R/Intbc.R @@ -296,8 +296,8 @@ Intbc <- function(exp, obs, exp_lats, exp_lons, obs_lats, obs_lons, target_grid, warning('Simple Bias Correction should not be used with only one observation. Returning NA.') } - res <- BiasCorrection(exp = exp_interpolated$data, obs = obs_ref, memb_dim = member_dim, - sdate_dim = sdate_dim, ncores = ncores, ...) + res <- Calibration(exp = exp_interpolated$data, obs = obs_ref, memb_dim = member_dim, + sdate_dim = sdate_dim, ncores = ncores, cal.method = "bias") } else if (bc_method == 'cal' | bc_method == 'calibration') { if (dim(exp_interpolated$data)[member_dim] == 1) { diff --git a/R/Interpolation.R b/R/Interpolation.R index 0a53afa..0f78ecb 100644 --- a/R/Interpolation.R +++ b/R/Interpolation.R @@ -271,22 +271,12 @@ Interpolation <- function(exp, lats, lons, points = NULL, source_file = NULL, me .KnownLatNames <- s2dv:::.KnownLatNames .warning <- s2dv:::.warning - res <- multiApply::Apply(data = list(data_array = exp), - target_dims = c(lon_dim,lat_dim), - fun = CDORemap, - lats = lats, - lons = lons, - grid = target_grid, - method = method_remap, - crop = region, - ncores = ncores) - - # res <- CDORemap(data_array = exp, - # lats = lats, - # lons = lons, - # grid = target_grid, - # method = method_remap, - # crop = region) + res <- CDORemap(data_array = exp, + lats = lats, + lons = lons, + grid = target_grid, + method = method_remap, + crop = region) # Return a list res <- list(data = res$data_array, obs = NULL, lon = res$lons, lat = res$lats) diff --git a/R/Intlr.R b/R/Intlr.R index b4b8a75..c768dc4 100644 --- a/R/Intlr.R +++ b/R/Intlr.R @@ -393,9 +393,12 @@ Intlr <- function(exp, obs, exp_lats, exp_lons, obs_lats, obs_lons, lr_method, t # Predictors: model data # Predictand: observations else if (lr_method == '4nn') { + predictor <- .find_nn(coar = exp, lats_hres = obs_lats, lons_hres = obs_lons, lats_coar = exp_lats, lons_coar = exp_lons, lat_dim = lat_dim, lon_dim = lon_dim, nn = 4, ncores = ncores) + + if (is.null(points)) { if (!is.null(target_grid)) { warning("Interpolating to the 'obs' grid") @@ -429,12 +432,19 @@ Intlr <- function(exp, obs, exp_lats, exp_lons, obs_lats, obs_lons, lr_method, t else { stop(paste0(lr_method, " method is not implemented yet")) } - + + print(paste0('dim predictor',dim(predictor))) + print(paste0('dim predictand',dim(predictand))) + print(dim(list(predictor[1]))) # Apply the linear regressions + + + res <- Apply(list(predictor, predictand), target_dims = list(target_dims_predictor, target_dims_predictand), fun = .intlr, loocv = loocv, ncores = ncores)$output1 names(dim(res))[1] <- sdate_dim + # names(dim(res))[which(names(dim(res)) == '')] # restore ensemble dimension in observations if it existed originally if (restore_ens) { diff --git a/R/Utils.R b/R/Utils.R index d332aa3..3cd6585 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -1,5 +1,5 @@ .check_coords <- function(lat1, lon1, lat2, lon2) { - if (all(lat1 == lat2) & all(lon1 == lon2)) { + if (all(as.numeric(lat1) == as.numeric(lat2)) & all(as.numeric(lon1) == as.numeric(lon2))) { match <- TRUE } else { match <- FALSE -- GitLab From bb9a3de93cda3c06d1c355bbe53aa76107c931fa Mon Sep 17 00:00:00 2001 From: Jaume Ramon Date: Mon, 24 Jul 2023 10:57:39 +0200 Subject: [PATCH 2/2] unified calibration methods --- R/Intbc.R | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/R/Intbc.R b/R/Intbc.R index 2574e5d..207e7ef 100644 --- a/R/Intbc.R +++ b/R/Intbc.R @@ -23,8 +23,8 @@ #'@param target_grid a character vector indicating the target grid to be passed to CDO. #'It must be a grid recognised by CDO or a NetCDF file. #'@param bc_method a character vector indicating the bias adjustment method to be applied after -#'the interpolation. Accepted methods are 'simple_bias', 'calibration', 'quantile_mapping'. The -#'abbreviations 'sbc', 'cal', 'qm' can also be used. +#'the interpolation. Accepted methods are 'quantile_mapping', 'dynamical_bias', 'bias', 'evmos', +#''mse_min', 'crps_min', 'rpc-based'. The abbreviations 'dbc','qm' can also be used. #'@param int_method a character vector indicating the regridding method to be passed to CDORemap. #'Accepted methods are "con", "bil", "bic", "nn", "con2". If "nn" method is to be used, CDO_1.9.8 #'or newer version is required. @@ -135,8 +135,8 @@ CST_Intbc <- function(exp, obs, target_grid, bc_method, int_method = NULL, point #'@param target_grid a character vector indicating the target grid to be passed to CDO. #'It must be a grid recognised by CDO or a NetCDF file. #'@param bc_method a character vector indicating the bias adjustment method to be applied after -#'the interpolation. Accepted methods are 'simple_bias', 'calibration', 'quantile_mapping'. The -#'abbreviations 'sbc', 'cal', 'qm' can also be used. +#'the interpolation. Accepted methods are 'quantile_mapping', 'dynamical_bias', 'bias', 'evmos', +#''mse_min', 'crps_min', 'rpc-based'. The abbreviations 'dbc','qm' can also be used. #'@param int_method a character vector indicating the regridding method to be passed to CDORemap. #'Accepted methods are "con", "bil", "bic", "nn", "con2". If "nn" method is to be used, CDO_1.9.8 #'or newer version is required. @@ -291,22 +291,7 @@ Intbc <- function(exp, obs, exp_lats, exp_lons, obs_lats, obs_lons, target_grid, # which(names(dim(obs_ref)) == sdate_dim), 'sdate') #} - if (bc_method == 'sbc' | bc_method == 'simple_bias') { - if (dim(obs_ref)[sdate_dim] == 1) { - warning('Simple Bias Correction should not be used with only one observation. Returning NA.') - } - - res <- Calibration(exp = exp_interpolated$data, obs = obs_ref, memb_dim = member_dim, - sdate_dim = sdate_dim, ncores = ncores, cal.method = "bias") - } - else if (bc_method == 'cal' | bc_method == 'calibration') { - if (dim(exp_interpolated$data)[member_dim] == 1) { - stop('Calibration must not be used with only one ensemble member.') - } - res <- Calibration(exp = exp_interpolated$data, obs = obs_ref, memb_dim = member_dim, - sdate_dim = sdate_dim, ncores = ncores, ...) - } - else if (bc_method == 'qm' | bc_method == 'quantile_mapping') { + if (bc_method == 'qm' | bc_method == 'quantile_mapping') { res <- QuantileMapping(exp = exp_interpolated$data, obs = obs_ref, na.rm = TRUE, memb_dim = member_dim, sdate_dim = sdate_dim, ncores = ncores, ...) @@ -323,6 +308,15 @@ Intbc <- function(exp, obs, exp_lats, exp_lons, obs_lats, obs_lons, target_grid, } # REMEMBER to add na.rm = T in colMeans in .proxiesattractor res <- DynBiasCorrection(exp = exp_interpolated$data, obs = obs_ref, ncores = ncores, ...) + } else { + if (dim(exp_interpolated$data)[member_dim] == 1) { + stop('Calibration must not be used with only one ensemble member.') + } + if (dim(obs_ref)[sdate_dim] == 1) { + warning('Simple Bias Correction should not be used with only one observation. Returning NA.') + } + res <- Calibration(exp = exp_interpolated$data, obs = obs_ref, memb_dim = member_dim, + sdate_dim = sdate_dim, ncores = ncores, cal.method = bc_method) } # Return a list of three elements -- GitLab