From 557b4dee4f77af956796d3b9cea2c597d4d03eea Mon Sep 17 00:00:00 2001 From: THEERTHA KARIYATHAN Date: Thu, 27 Feb 2025 12:53:47 +0100 Subject: [PATCH 1/6] split_dim and new_dim in coords --- R/CST_SplitDim.R | 27 ++++++++++++++++++++------- tests/testthat/test-CST_SplitDim.R | 16 +++++++++++++--- 2 files changed, 33 insertions(+), 10 deletions(-) diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R index bac378be..5da45ca3 100644 --- a/R/CST_SplitDim.R +++ b/R/CST_SplitDim.R @@ -129,9 +129,12 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, indices = indices, freq = freq, new_dim_name = new_dim_name, dates = data$attrs$Dates, - return_indices = return_indices) - if (inherits(res, 'list')) { + return_indices = return_indices, + coords = data$coords) + + if (inherits(res, 'list')) { data$data <- res$data + data$coords <- res$coords # Split dim on Dates if (!is.null(res$dates)) { data$attrs$Dates <- res$dates @@ -143,6 +146,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, # Coordinates # TO DO: Subset splitted coordinate and add the new dimension coordinate. + if (return_indices) { return(list(data = data, indices = res$indices)) } else { @@ -190,7 +194,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, #'@importFrom ClimProjDiags Subset #'@export SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly', - new_dim_name = NULL, dates = NULL, + new_dim_name = NULL, dates = NULL, coords = NULL, return_indices = FALSE) { # check data if (is.null(data)) { @@ -317,6 +321,7 @@ SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly', if (!is.null(dates)) { if (any(split_dim %in% names(dim(dates)))) { datesdims <- dim(dates) + print(repited) dates <- lapply(repited, function(x) {rebuild(x, dates, along = split_dim, indices = indices, max_times)}) dates <- abind(dates, along = length(datesdims) + 1) @@ -325,16 +330,24 @@ SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly', } dates_exist <- TRUE } + + # Coordinates + # TO DO: Subset splitted coordinate and add the new dimension coordinate. + + coords[[split_dim]] <- 1:dim(data)[[split_dim]] + attr(coords[[split_dim]], 'indices') <- TRUE + coords[[new_dim_name]] <- 1:dim(data)[[new_dim_name]] + attr(coords[[new_dim_name]], 'indices') <- TRUE # Return objects if (all(dates_exist, return_indices)) { - return(list(data = data, dates = dates, indices = indices)) + return(list(data = data, dates = dates, indices = indices, coords = coords)) } else if (all(dates_exist, !return_indices)) { - return(list(data = data, dates = dates)) + return(list(data = data, dates = dates, coords = coords)) } else if (all(!dates_exist, return_indices)) { - return(list(data = data, indices = indices)) + return(list(data = data, indices = indices, coords = coords)) } else { - return(data) + return(list(data = data, coords = coords)) } } diff --git a/tests/testthat/test-CST_SplitDim.R b/tests/testthat/test-CST_SplitDim.R index f8ad88ee..ab001e84 100644 --- a/tests/testthat/test-CST_SplitDim.R +++ b/tests/testthat/test-CST_SplitDim.R @@ -9,8 +9,10 @@ class(data1) <- 's2dv_cube' indices1 <- c(rep(1,5), rep(2,5), rep (3, 5), rep(4, 5)) output1 <- matrix(data1$data, nrow = 5, ncol = 4) names(dim(output1)) <- c('time', 'monthly') -output1 <- list(data = output1) +output1 <- list(data = output1, coords = list(time = 1:5, monthly = 1:4)) output1$dims <- dim(output1$data) +attr(output1$coords$time, 'indices') <- TRUE +attr(output1$coords$monthly, 'indices') <- TRUE class(output1) <- 's2dv_cube' exp_cor <- 1 : 20 @@ -21,7 +23,9 @@ class(exp_cor) <- 's2dv_cube' # dat2 output2 <- matrix(data1$data, nrow = 5, ncol = 4) names(dim(output2)) <- c('time', 'index') -output2 <- list(data = output2) +output2 <- list(data = output2, coords = list(time = 1:5, index = 1:4)) +attr(output2$coords$time, 'indices') <- TRUE +attr(output2$coords$index, 'indices') <- TRUE output2$dims <- dim(output2$data) class(output2) <- 's2dv_cube' @@ -43,8 +47,10 @@ output3 <- c(data3$data, rep(NA, 4)) dim(output3) <- c(time = 8, monthly = 3) result3 <- data3 result3$data <- output3 +result3$coords <- list(time = 1:8, monthly = 1:3) result3$dims <- dim(result3$data) - +attr(result3$coords$time, 'indices') <- TRUE +attr(result3$coords$monthly, 'indices') <- TRUE # dat4 data4 <- list(data = array(rnorm(10), dim = c(sdate = 2, lon = 5))) class(data4) <- 's2dv_cube' @@ -107,6 +113,10 @@ test_that("3. Output checks: sample data", { result$dims <- c(dataset = 1, member = 15, sdate = 6, ftime = 1, lat = 22, lon = 53, monthly = 3) attributes(result$attrs$Dates)$end <- NULL + result$coords$ftime <- 1 + result$coords$monthly <- 1:3 + attr(result$coords$ftime, 'indices') <- TRUE + attr(result$coords$monthly, 'indices') <- TRUE expect_equal( CST_SplitDim(data = lonlat_temp$exp, split_dim = 'ftime', ftime_dim = 'ftime'), result -- GitLab From 3ca5506a0efe34202eb3e0ac12d899df41669a5f Mon Sep 17 00:00:00 2001 From: THEERTHA KARIYATHAN Date: Fri, 28 Feb 2025 13:15:59 +0100 Subject: [PATCH 2/6] rm accidental 'print' --- R/CST_SplitDim.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R index 5da45ca3..5542baa4 100644 --- a/R/CST_SplitDim.R +++ b/R/CST_SplitDim.R @@ -321,7 +321,6 @@ SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly', if (!is.null(dates)) { if (any(split_dim %in% names(dim(dates)))) { datesdims <- dim(dates) - print(repited) dates <- lapply(repited, function(x) {rebuild(x, dates, along = split_dim, indices = indices, max_times)}) dates <- abind(dates, along = length(datesdims) + 1) -- GitLab From 86db3ad74dcef47bc75e2ade292d7176f7bc6c85 Mon Sep 17 00:00:00 2001 From: THEERTHA KARIYATHAN Date: Mon, 3 Mar 2025 10:34:29 +0100 Subject: [PATCH 3/6] update splitdim lines-AdamontQQCorr --- R/CST_AdamontQQCorr.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/CST_AdamontQQCorr.R b/R/CST_AdamontQQCorr.R index 33091803..d58fa99e 100644 --- a/R/CST_AdamontQQCorr.R +++ b/R/CST_AdamontQQCorr.R @@ -248,9 +248,9 @@ AdamontQQCorr <- function(exp, wt_exp, obs, wt_obs, # Split 'time' dim in weather types obs <- SplitDim(obs, split_dim = 'time', indices = as.vector(wt_obs), - new_dim_name = 'type') + new_dim_name = 'type')$data exp_corr <- SplitDim(exp_corr, split_dim = 'time', indices = as.vector(wt_exp2), - new_dim_name = 'type') + new_dim_name = 'type')$data ## Add NAs to exp_corr if needed to have compatible sample dimensions numtobs <- dim(obs)[which(names(dim(obs)) == 'time')] numtexp <- dim(exp_corr)[which(names(dim(exp_corr)) == 'time')] -- GitLab From c583a452ea7246276eb499527713c781b3b7a565 Mon Sep 17 00:00:00 2001 From: THEERTHA KARIYATHAN Date: Mon, 3 Mar 2025 11:06:15 +0100 Subject: [PATCH 4/6] update SplitDim lines-AdamontAnalog --- R/CST_AdamontAnalog.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/CST_AdamontAnalog.R b/R/CST_AdamontAnalog.R index 23bdb531..99914a45 100644 --- a/R/CST_AdamontAnalog.R +++ b/R/CST_AdamontAnalog.R @@ -209,7 +209,7 @@ AdamontAnalog <- function(exp, obs, wt_exp, wt_obs, nanalogs = 5, names(dim(wt_obs))[which(names(dim(wt_obs)) == search_obsdims[length(search_obsdims)])] <- 'time' # Split 'time' dim in weather types obs <- SplitDim(obs, split_dim = 'time', indices = as.vector(wt_obs), - new_dim_name='type') + new_dim_name='type')$data analog_vals <- Apply(list(exp, obs, wt_exp), target_dims = list(c(londim, latdim), -- GitLab From 623724b6582e4743588ec5311cf13d25a6c02ea2 Mon Sep 17 00:00:00 2001 From: THEERTHA KARIYATHAN Date: Mon, 3 Mar 2025 11:31:02 +0100 Subject: [PATCH 5/6] update SpliDims lines-PlotWeeklyClim --- R/PlotWeeklyClim.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index 48e71328..f1cbd7b9 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -230,7 +230,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, ## Weekly aggregations for reference period weekly_aggre <- SplitDim(data_subset, split_dim = time_dim, indices = sort(rep(1:(length(index_first_date:index_last_date)/7), 7)), - new_dim_name = 'week') + new_dim_name = 'week')$data weekly_means <- MeanDims(weekly_aggre, time_dim) weekly_clim <- MeanDims(weekly_means, sdate_dim) -- GitLab From a8a110ce4d14647d069e955c92520f6d99c876bd Mon Sep 17 00:00:00 2001 From: THEERTHA KARIYATHAN Date: Thu, 6 Mar 2025 13:12:22 +0100 Subject: [PATCH 6/6] coords in 'CST_' part, revert other funct --- R/CST_AdamontAnalog.R | 2 +- R/CST_AdamontQQCorr.R | 4 ++-- R/CST_SplitDim.R | 35 ++++++++++++++---------------- R/PlotWeeklyClim.R | 2 +- tests/testthat/test-CST_SplitDim.R | 11 ++++++---- 5 files changed, 27 insertions(+), 27 deletions(-) diff --git a/R/CST_AdamontAnalog.R b/R/CST_AdamontAnalog.R index 99914a45..23bdb531 100644 --- a/R/CST_AdamontAnalog.R +++ b/R/CST_AdamontAnalog.R @@ -209,7 +209,7 @@ AdamontAnalog <- function(exp, obs, wt_exp, wt_obs, nanalogs = 5, names(dim(wt_obs))[which(names(dim(wt_obs)) == search_obsdims[length(search_obsdims)])] <- 'time' # Split 'time' dim in weather types obs <- SplitDim(obs, split_dim = 'time', indices = as.vector(wt_obs), - new_dim_name='type')$data + new_dim_name='type') analog_vals <- Apply(list(exp, obs, wt_exp), target_dims = list(c(londim, latdim), diff --git a/R/CST_AdamontQQCorr.R b/R/CST_AdamontQQCorr.R index d58fa99e..33091803 100644 --- a/R/CST_AdamontQQCorr.R +++ b/R/CST_AdamontQQCorr.R @@ -248,9 +248,9 @@ AdamontQQCorr <- function(exp, wt_exp, obs, wt_obs, # Split 'time' dim in weather types obs <- SplitDim(obs, split_dim = 'time', indices = as.vector(wt_obs), - new_dim_name = 'type')$data + new_dim_name = 'type') exp_corr <- SplitDim(exp_corr, split_dim = 'time', indices = as.vector(wt_exp2), - new_dim_name = 'type')$data + new_dim_name = 'type') ## Add NAs to exp_corr if needed to have compatible sample dimensions numtobs <- dim(obs)[which(names(dim(obs)) == 'time')] numtexp <- dim(exp_corr)[which(names(dim(exp_corr)) == 'time')] diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R index 5542baa4..4ab9e5a4 100644 --- a/R/CST_SplitDim.R +++ b/R/CST_SplitDim.R @@ -124,17 +124,17 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, } } } + old_dim_name <- names(dim(data$data)) # Call the function res <- SplitDim(data = data$data, split_dim = split_dim, indices = indices, freq = freq, new_dim_name = new_dim_name, dates = data$attrs$Dates, - return_indices = return_indices, - coords = data$coords) + return_indices = return_indices) + if (inherits(res, 'list')) { data$data <- res$data - data$coords <- res$coords # Split dim on Dates if (!is.null(res$dates)) { data$attrs$Dates <- res$dates @@ -142,11 +142,16 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, } else { data$data <- res } + data$dims <- dim(data$data) - + new_dim_name <- names(data$dims)[!names(data$dims) %in% (old_dim_name)] + # Coordinates - # TO DO: Subset splitted coordinate and add the new dimension coordinate. - + data$coords[[split_dim]] <- 1:dim(data$data)[[split_dim]] + attr(data$coords[[split_dim]], 'indices') <- TRUE + data$coords[[new_dim_name]] <- 1:dim(data$data)[[new_dim_name]] + attr(data$coords[[new_dim_name]], 'indices') <- TRUE + if (return_indices) { return(list(data = data, indices = res$indices)) } else { @@ -194,7 +199,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, #'@importFrom ClimProjDiags Subset #'@export SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly', - new_dim_name = NULL, dates = NULL, coords = NULL, + new_dim_name = NULL, dates = NULL, return_indices = FALSE) { # check data if (is.null(data)) { @@ -330,23 +335,15 @@ SplitDim <- function(data, split_dim = 'time', indices, freq = 'monthly', dates_exist <- TRUE } - # Coordinates - # TO DO: Subset splitted coordinate and add the new dimension coordinate. - - coords[[split_dim]] <- 1:dim(data)[[split_dim]] - attr(coords[[split_dim]], 'indices') <- TRUE - coords[[new_dim_name]] <- 1:dim(data)[[new_dim_name]] - attr(coords[[new_dim_name]], 'indices') <- TRUE - # Return objects if (all(dates_exist, return_indices)) { - return(list(data = data, dates = dates, indices = indices, coords = coords)) + return(list(data = data, dates = dates, indices = indices)) } else if (all(dates_exist, !return_indices)) { - return(list(data = data, dates = dates, coords = coords)) + return(list(data = data, dates = dates)) } else if (all(!dates_exist, return_indices)) { - return(list(data = data, indices = indices, coords = coords)) + return(list(data = data, indices = indices)) } else { - return(list(data = data, coords = coords)) + return(data = data) } } diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index f1cbd7b9..48e71328 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -230,7 +230,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, ## Weekly aggregations for reference period weekly_aggre <- SplitDim(data_subset, split_dim = time_dim, indices = sort(rep(1:(length(index_first_date:index_last_date)/7), 7)), - new_dim_name = 'week')$data + new_dim_name = 'week') weekly_means <- MeanDims(weekly_aggre, time_dim) weekly_clim <- MeanDims(weekly_means, sdate_dim) diff --git a/tests/testthat/test-CST_SplitDim.R b/tests/testthat/test-CST_SplitDim.R index ab001e84..f461de52 100644 --- a/tests/testthat/test-CST_SplitDim.R +++ b/tests/testthat/test-CST_SplitDim.R @@ -8,9 +8,11 @@ class(data1) <- 's2dv_cube' indices1 <- c(rep(1,5), rep(2,5), rep (3, 5), rep(4, 5)) output1 <- matrix(data1$data, nrow = 5, ncol = 4) +output1 <- matrix(data1$data, nrow = 5, ncol = 4) names(dim(output1)) <- c('time', 'monthly') -output1 <- list(data = output1, coords = list(time = 1:5, monthly = 1:4)) +output1 <- list(data = output1) output1$dims <- dim(output1$data) +output1$coords <- list(time = 1:5, monthly = 1:4) attr(output1$coords$time, 'indices') <- TRUE attr(output1$coords$monthly, 'indices') <- TRUE class(output1) <- 's2dv_cube' @@ -23,10 +25,11 @@ class(exp_cor) <- 's2dv_cube' # dat2 output2 <- matrix(data1$data, nrow = 5, ncol = 4) names(dim(output2)) <- c('time', 'index') -output2 <- list(data = output2, coords = list(time = 1:5, index = 1:4)) +output2 <- list(data = output2) +output2$dims <- dim(output2$data) +output2$coords <- list(time = 1:5, index = 1:4) attr(output2$coords$time, 'indices') <- TRUE attr(output2$coords$index, 'indices') <- TRUE -output2$dims <- dim(output2$data) class(output2) <- 's2dv_cube' time2 <- c(seq(ISOdate(1903, 1, 1), ISOdate(1903, 1, 4), "days"), @@ -47,8 +50,8 @@ output3 <- c(data3$data, rep(NA, 4)) dim(output3) <- c(time = 8, monthly = 3) result3 <- data3 result3$data <- output3 -result3$coords <- list(time = 1:8, monthly = 1:3) result3$dims <- dim(result3$data) +result3$coords <- list(time = 1:8, monthly = 1:3) attr(result3$coords$time, 'indices') <- TRUE attr(result3$coords$monthly, 'indices') <- TRUE # dat4 -- GitLab