From b16aeb6959ebbac8b4a28c20dcffb6c043b58990 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 8 Sep 2022 18:02:15 +0200 Subject: [PATCH 1/5] Create new function WeightCells --- NAMESPACE | 1 + R/WeightCells.R | 87 ++++++++++++++++++++++++++++ man/WeightCells.Rd | 36 ++++++++++++ tests/testthat/test-WeightCells.R | 94 +++++++++++++++++++++++++++++++ 4 files changed, 218 insertions(+) create mode 100644 R/WeightCells.R create mode 100644 man/WeightCells.Rd create mode 100644 tests/testthat/test-WeightCells.R diff --git a/NAMESPACE b/NAMESPACE index 40ba733..58def58 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(ShiftLon) export(Subset) export(Threshold) export(WaveDuration) +export(WeightCells) export(WeightedMean) import(PCICt) import(climdex.pcic) diff --git a/R/WeightCells.R b/R/WeightCells.R new file mode 100644 index 0000000..7bc3156 --- /dev/null +++ b/R/WeightCells.R @@ -0,0 +1,87 @@ +#'Compute the square-root of the cosine of the latitude weighting on the given +#'array. +#' +#'This function performs square-root of the cosine of the latitude weighting on +#'the given array. +#' +#'@param data A numeric array with named dimensions, representing the data to be +#' applied the weights. It should have at least the latitude dimension and it +#' can have more other dimensions. +#'@param lat A numeric array with one dimension containing the latitudes. +#'@param lat_dim A character string indicating the name of the latitudinal +#' dimension. The default value is 'lat'. +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#' +#'@return An array with same dimensions as parameter 'data'. +#' +#'@examples +#'exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) +#'lat <- rnorm(3)*10 +#'\dontrun{ +#'res <- WeightCells(data = exp, lat = lat) +#'} +#'@import multiApply +#'@export +WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { + + # Check inputs + ## data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + if (is.null(dim(data))) { + stop("Parameter 'data' must be at least latitude dimension.") + } + if(any(is.null(names(dim(data)))) | any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + + ## lat_dim + if (!is.character(lat_dim) | length(lat_dim) > 1) { + stop("Parameter 'lat_dim' must be a character string.") + } + if (!lat_dim %in% names(dim(data))) { + stop("Parameter 'lat_dim' is not found in 'data'.") + } + + ## lat + if (is.null(lat)) { + stop("Parameter 'lat' cannot be NULL.") + } + if (!is.numeric(lat)) { + stop("Parameter 'lat' must be a numeric array.") + } + if (dim(data)[lat_dim] != length(lat)) { + stop("Length of parameter 'lat' doesn't match the length of ", + "latitudinal dimension in parameter 'data'.") + } + ## ncores + if (!is.null(ncores)) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | + length(ncores) > 1) { + stop("Parameter 'ncores' must be either NULL or a positive integer.") + } + } + + namedims <- names(dim(data)) + + res <- Apply(data = data, + target_dims = c(lat_dim), + fun = .WeightCells, + lat = as.vector(lat), + ncores = ncores)$output1 + res <- Reorder(res, namedims) + + return(res) +} + +.WeightCells <- function(data, lat) { + dim_data <- dim(data) + wt <- sqrt(cos(lat * pi/180)) + data <- wt*data + return(data) +} diff --git a/man/WeightCells.Rd b/man/WeightCells.Rd new file mode 100644 index 0000000..dfee371 --- /dev/null +++ b/man/WeightCells.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/WeightCells.R +\name{WeightCells} +\alias{WeightCells} +\title{Compute the square-root of the cosine of the latitude weighting on the given +array.} +\usage{ +WeightCells(data, lat, lat_dim = "lat", ncores = NULL) +} +\arguments{ +\item{data}{A numeric array with named dimensions, representing the data to be +applied the weights. It should have at least the latitude dimension and it +can have more other dimensions.} + +\item{lat}{A numeric array with one dimension containing the latitudes.} + +\item{lat_dim}{A character string indicating the name of the latitudinal +dimension. The default value is 'lat'.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} +} +\value{ +An array with same dimensions as parameter 'data'. +} +\description{ +This function performs square-root of the cosine of the latitude weighting on +the given array. +} +\examples{ +exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) +lat <- rnorm(3)*10 +\dontrun{ +res <- WeightCells(data = exp, lat = lat) +} +} diff --git a/tests/testthat/test-WeightCells.R b/tests/testthat/test-WeightCells.R new file mode 100644 index 0000000..fe3def1 --- /dev/null +++ b/tests/testthat/test-WeightCells.R @@ -0,0 +1,94 @@ +context("s2dv::WeightCells tests") + +############################################## + +# dat1 +set.seed(1) +data1 <- array(rnorm(5), dim = c(lat = 5)) +set.seed(2) +lat1 <- array(rnorm(5)*5) + +# dat2 +set.seed(1) +data2 <- array(rnorm(60), dim = c(sdate = 10, lat = 2, lon = 3)) +set.seed(2) +lat2 <- array(rnorm(2)*10) + + +############################################## +test_that("1. Input checks", { + # data + expect_error( + WeightCells(c()), + "Parameter 'data' cannot be NULL." + ) + expect_error( + WeightCells('lat'), + "Parameter 'data' must be a numeric array." + ) + expect_error( + WeightCells(rnorm(5)), + "Parameter 'data' must be at least latitude dimension." + ) + expect_error( + WeightCells(array(rnorm(5), dim = c(5))), + "Parameter 'data' must have dimension names." + ) + #lat_dim + expect_error( + WeightCells(data1, lat1, 3), + "Parameter 'lat_dim' must be a character string." + ) + expect_error( + WeightCells(data1, lat1, 'latitude'), + "Parameter 'lat_dim' is not found in 'data'." + ) + #lat + expect_error( + WeightCells(data1, NULL), + "Parameter 'lat' cannot be NULL." + ) + expect_error( + WeightCells(data1, rnorm(10)), + "Length of parameter 'lat' doesn't match the length of latitudinal dimension in parameter 'data'." + ) + # ncores + expect_error( + WeightCells(data1, lat1, ncores = 1.5), + "Parameter 'ncores' must be either NULL or a positive integer." + ) + +}) + +############################################## +test_that("2. Output checks: dat1", { + + expect_equal( + dim(WeightCells(data1, lat1)), + c(lat = 5) + ) + expect_equal( + as.vector(WeightCells(data1, lat1)), + c(-0.6254941, 0.1836314, -0.8316143, 1.5913985, 0.3295037), + tolerance = 0.0001 + ) + +}) + +############################################## +test_that("3. Output checks: dat2", { + + expect_equal( + dim(WeightCells(data2, lat2)), + c(sdate = 10, lat = 2, lon = 3) + ) + expect_equal( + as.vector(WeightCells(data2, lat2))[1:5], + c( -0.6226120, 0.1825171, -0.8305040, 1.5854976, 0.3274870), + tolerance = 0.0001 + ) + expect_equal( + dim(WeightCells(data2, lat2)), + dim(data2) + ) +}) -- GitLab From b05a5653fbc55446301905de3561140476e898b9 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 8 Sep 2022 18:05:09 +0200 Subject: [PATCH 2/5] Add import s2dv --- R/WeightCells.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/WeightCells.R b/R/WeightCells.R index 7bc3156..2c59cdb 100644 --- a/R/WeightCells.R +++ b/R/WeightCells.R @@ -21,7 +21,7 @@ #'\dontrun{ #'res <- WeightCells(data = exp, lat = lat) #'} -#'@import multiApply +#'@import multiApply, s2dv #'@export WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { -- GitLab From 193ddd389946bfd46be5a24cb5de8e3d4d800e1f Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 21 Sep 2022 16:38:10 +0200 Subject: [PATCH 3/5] Correct documentation and improved code of WeightCells --- R/WeightCells.R | 25 ++++++++++++++----------- man/WeightCells.Rd | 8 ++++---- tests/testthat/test-WeightCells.R | 6 +++++- 3 files changed, 23 insertions(+), 16 deletions(-) diff --git a/R/WeightCells.R b/R/WeightCells.R index 2c59cdb..8461abf 100644 --- a/R/WeightCells.R +++ b/R/WeightCells.R @@ -7,21 +7,21 @@ #'@param data A numeric array with named dimensions, representing the data to be #' applied the weights. It should have at least the latitude dimension and it #' can have more other dimensions. -#'@param lat A numeric array with one dimension containing the latitudes. +#'@param lat A numeric vector or array with one dimension containing the +#' latitudes (in degrees). #'@param lat_dim A character string indicating the name of the latitudinal #' dimension. The default value is 'lat'. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' -#'@return An array with same dimensions as parameter 'data'. +#'@return An array containing the latitude weighted data with same dimensions as +#'parameter 'data'. #' #'@examples #'exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) #'lat <- rnorm(3)*10 -#'\dontrun{ #'res <- WeightCells(data = exp, lat = lat) -#'} -#'@import multiApply, s2dv +#'@import multiApply #'@export WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { @@ -53,12 +53,13 @@ WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { stop("Parameter 'lat' cannot be NULL.") } if (!is.numeric(lat)) { - stop("Parameter 'lat' must be a numeric array.") + stop("Parameter 'lat' must be a numeric vector or array.") } if (dim(data)[lat_dim] != length(lat)) { stop("Length of parameter 'lat' doesn't match the length of ", "latitudinal dimension in parameter 'data'.") } + ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -68,20 +69,22 @@ WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { } namedims <- names(dim(data)) + lat <- as.vector(lat) + wt <- sqrt(cos(lat * pi/180)) res <- Apply(data = data, target_dims = c(lat_dim), fun = .WeightCells, - lat = as.vector(lat), + wt = wt, ncores = ncores)$output1 - res <- Reorder(res, namedims) + + order <- match(namedims, names(dim(res))) + res <- aperm(res, order) return(res) } -.WeightCells <- function(data, lat) { - dim_data <- dim(data) - wt <- sqrt(cos(lat * pi/180)) +.WeightCells <- function(data, wt) { data <- wt*data return(data) } diff --git a/man/WeightCells.Rd b/man/WeightCells.Rd index dfee371..dfd0570 100644 --- a/man/WeightCells.Rd +++ b/man/WeightCells.Rd @@ -12,7 +12,8 @@ WeightCells(data, lat, lat_dim = "lat", ncores = NULL) applied the weights. It should have at least the latitude dimension and it can have more other dimensions.} -\item{lat}{A numeric array with one dimension containing the latitudes.} +\item{lat}{A numeric vector or array with one dimension containing the +latitudes (in degrees).} \item{lat_dim}{A character string indicating the name of the latitudinal dimension. The default value is 'lat'.} @@ -21,7 +22,8 @@ dimension. The default value is 'lat'.} computation. The default value is NULL.} } \value{ -An array with same dimensions as parameter 'data'. +An array containing the latitude weighted data with same dimensions as +parameter 'data'. } \description{ This function performs square-root of the cosine of the latitude weighting on @@ -30,7 +32,5 @@ the given array. \examples{ exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) lat <- rnorm(3)*10 -\dontrun{ res <- WeightCells(data = exp, lat = lat) } -} diff --git a/tests/testthat/test-WeightCells.R b/tests/testthat/test-WeightCells.R index fe3def1..2229456 100644 --- a/tests/testthat/test-WeightCells.R +++ b/tests/testthat/test-WeightCells.R @@ -48,6 +48,10 @@ test_that("1. Input checks", { WeightCells(data1, NULL), "Parameter 'lat' cannot be NULL." ) + expect_error( + WeightCells(data1, list(lat)), + "Parameter 'lat' must be a numeric vector or array." + ) expect_error( WeightCells(data1, rnorm(10)), "Length of parameter 'lat' doesn't match the length of latitudinal dimension in parameter 'data'." @@ -84,7 +88,7 @@ test_that("3. Output checks: dat2", { ) expect_equal( as.vector(WeightCells(data2, lat2))[1:5], - c( -0.6226120, 0.1825171, -0.8305040, 1.5854976, 0.3274870), + c(-0.6226120, 0.1825171, -0.8305040, 1.5854976, 0.3274870), tolerance = 0.0001 ) expect_equal( -- GitLab From e548c13f414aa2cc7618e88a50b974f8bd4911ce Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Fri, 7 Oct 2022 16:52:27 +0200 Subject: [PATCH 4/5] Added method parameter and correct test --- NAMESPACE | 2 +- R/{WeightCells.R => WeightedCells.R} | 23 +++++++-- man/{WeightCells.Rd => WeightedCells.Rd} | 14 ++++-- ...est-WeightCells.R => test-WeightedCells.R} | 49 ++++++++++++------- 4 files changed, 59 insertions(+), 29 deletions(-) rename R/{WeightCells.R => WeightedCells.R} (80%) rename man/{WeightCells.Rd => WeightedCells.Rd} (72%) rename tests/testthat/{test-WeightCells.R => test-WeightedCells.R} (59%) diff --git a/NAMESPACE b/NAMESPACE index 58def58..e3226a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,7 +15,7 @@ export(ShiftLon) export(Subset) export(Threshold) export(WaveDuration) -export(WeightCells) +export(WeightedCells) export(WeightedMean) import(PCICt) import(climdex.pcic) diff --git a/R/WeightCells.R b/R/WeightedCells.R similarity index 80% rename from R/WeightCells.R rename to R/WeightedCells.R index 8461abf..1ce1dc4 100644 --- a/R/WeightCells.R +++ b/R/WeightedCells.R @@ -11,6 +11,9 @@ #' latitudes (in degrees). #'@param lat_dim A character string indicating the name of the latitudinal #' dimension. The default value is 'lat'. +#'@param method A character string indicating the type of weighting applied: +#' 'cos' (cosine of the latitude) or 'sqrtcos' (square-root of the +#' cosine of the latitude). #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -20,10 +23,10 @@ #'@examples #'exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) #'lat <- rnorm(3)*10 -#'res <- WeightCells(data = exp, lat = lat) +#'res <- WeightedCells(data = exp, lat = lat) #'@import multiApply #'@export -WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { +WeightedCells <- function(data, lat, lat_dim = 'lat', method = 'cos', ncores = NULL) { # Check inputs ## data @@ -60,6 +63,11 @@ WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { "latitudinal dimension in parameter 'data'.") } + ## method + if (!method %in% c('cos','sqrtcos')) { + stop("Parameter 'method' must be one of 'cos' or 'sqrtcos'.") + } + ## ncores if (!is.null(ncores)) { if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | @@ -70,11 +78,16 @@ WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { namedims <- names(dim(data)) lat <- as.vector(lat) - wt <- sqrt(cos(lat * pi/180)) + if (method == 'cos') { + wt <- cos(lat * pi/180) + } else { + wt <- sqrt(cos(lat * pi/180)) + } + res <- Apply(data = data, target_dims = c(lat_dim), - fun = .WeightCells, + fun = .WeightedCells, wt = wt, ncores = ncores)$output1 @@ -84,7 +97,7 @@ WeightCells <- function(data, lat, lat_dim = 'lat', ncores = NULL) { return(res) } -.WeightCells <- function(data, wt) { +.WeightedCells <- function(data, wt) { data <- wt*data return(data) } diff --git a/man/WeightCells.Rd b/man/WeightedCells.Rd similarity index 72% rename from man/WeightCells.Rd rename to man/WeightedCells.Rd index dfd0570..0a8fe98 100644 --- a/man/WeightCells.Rd +++ b/man/WeightedCells.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/WeightCells.R -\name{WeightCells} -\alias{WeightCells} +% Please edit documentation in R/WeightedCells.R +\name{WeightedCells} +\alias{WeightedCells} \title{Compute the square-root of the cosine of the latitude weighting on the given array.} \usage{ -WeightCells(data, lat, lat_dim = "lat", ncores = NULL) +WeightedCells(data, lat, lat_dim = "lat", method = "cos", ncores = NULL) } \arguments{ \item{data}{A numeric array with named dimensions, representing the data to be @@ -18,6 +18,10 @@ latitudes (in degrees).} \item{lat_dim}{A character string indicating the name of the latitudinal dimension. The default value is 'lat'.} +\item{method}{A character string indicating the type of weighting applied: +'cos' (cosine of the latitude) or 'sqrtcos' (square-root of the +cosine of the latitude).} + \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} } @@ -32,5 +36,5 @@ the given array. \examples{ exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) lat <- rnorm(3)*10 -res <- WeightCells(data = exp, lat = lat) +res <- WeightedCells(data = exp, lat = lat) } diff --git a/tests/testthat/test-WeightCells.R b/tests/testthat/test-WeightedCells.R similarity index 59% rename from tests/testthat/test-WeightCells.R rename to tests/testthat/test-WeightedCells.R index 2229456..29e5e9b 100644 --- a/tests/testthat/test-WeightCells.R +++ b/tests/testthat/test-WeightedCells.R @@ -1,4 +1,4 @@ -context("s2dv::WeightCells tests") +context("s2dv::WeightedCells tests") ############################################## @@ -19,46 +19,51 @@ lat2 <- array(rnorm(2)*10) test_that("1. Input checks", { # data expect_error( - WeightCells(c()), + WeightedCells(c()), "Parameter 'data' cannot be NULL." ) expect_error( - WeightCells('lat'), + WeightedCells('lat'), "Parameter 'data' must be a numeric array." ) expect_error( - WeightCells(rnorm(5)), + WeightedCells(rnorm(5)), "Parameter 'data' must be at least latitude dimension." ) expect_error( - WeightCells(array(rnorm(5), dim = c(5))), + WeightedCells(array(rnorm(5), dim = c(5))), "Parameter 'data' must have dimension names." ) #lat_dim expect_error( - WeightCells(data1, lat1, 3), + WeightedCells(data1, lat1, 3), "Parameter 'lat_dim' must be a character string." ) expect_error( - WeightCells(data1, lat1, 'latitude'), + WeightedCells(data1, lat1, 'latitude'), "Parameter 'lat_dim' is not found in 'data'." ) #lat expect_error( - WeightCells(data1, NULL), + WeightedCells(data1, NULL), "Parameter 'lat' cannot be NULL." ) expect_error( - WeightCells(data1, list(lat)), + WeightedCells(data1, list(lat1)), "Parameter 'lat' must be a numeric vector or array." ) expect_error( - WeightCells(data1, rnorm(10)), + WeightedCells(data1, rnorm(10)), "Length of parameter 'lat' doesn't match the length of latitudinal dimension in parameter 'data'." ) + # method + expect_error( + WeightedCells(data1, lat1, method = 1.5), + "Parameter 'method' must be one of 'cos' or 'sqrtcos'." + ) # ncores expect_error( - WeightCells(data1, lat1, ncores = 1.5), + WeightedCells(data1, lat1, ncores = 1.5), "Parameter 'ncores' must be either NULL or a positive integer." ) @@ -68,12 +73,12 @@ test_that("1. Input checks", { test_that("2. Output checks: dat1", { expect_equal( - dim(WeightCells(data1, lat1)), + dim(WeightedCells(data1, lat1)), c(lat = 5) ) expect_equal( - as.vector(WeightCells(data1, lat1)), - c(-0.6254941, 0.1836314, -0.8316143, 1.5913985, 0.3295037), + as.vector(WeightedCells(data1, lat1)), + c(-0.6245359, 0.1836194, -0.8276192, 1.5875256, 0.3294997), tolerance = 0.0001 ) @@ -83,16 +88,24 @@ test_that("2. Output checks: dat1", { test_that("3. Output checks: dat2", { expect_equal( - dim(WeightCells(data2, lat2)), + dim(WeightedCells(data2, lat2)), c(sdate = 10, lat = 2, lon = 3) ) expect_equal( - as.vector(WeightCells(data2, lat2))[1:5], - c(-0.6226120, 0.1825171, -0.8305040, 1.5854976, 0.3274870), + as.vector(WeightedCells(data2, lat2))[1:5], + c(-0.6187938, 0.1813978, -0.8254109, 1.5757744, 0.3254787), tolerance = 0.0001 ) expect_equal( - dim(WeightCells(data2, lat2)), + dim(WeightedCells(data2, lat2)), dim(data2) ) + expect_equal( + WeightedCells(data2, lat2), + WeightedCells(data2, lat2, method = 'sqrtcos')*as.vector(sqrt(cos(lat2*pi/180))), + tolerance = 0.01 + ) + }) + +############################################## -- GitLab From 089d3991e32c307aa56317952ea867c297da774f Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 2 Nov 2022 16:28:18 +0100 Subject: [PATCH 5/5] Refine doc and format --- R/WeightedCells.R | 14 +++++++------- man/WeightedCells.Rd | 4 ++-- tests/testthat/test-WeightedCells.R | 4 ++-- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/R/WeightedCells.R b/R/WeightedCells.R index 1ce1dc4..884870f 100644 --- a/R/WeightedCells.R +++ b/R/WeightedCells.R @@ -13,7 +13,7 @@ #' dimension. The default value is 'lat'. #'@param method A character string indicating the type of weighting applied: #' 'cos' (cosine of the latitude) or 'sqrtcos' (square-root of the -#' cosine of the latitude). +#' cosine of the latitude). The default value is 'cos'. #'@param ncores An integer indicating the number of cores to use for parallel #' computation. The default value is NULL. #' @@ -22,7 +22,7 @@ #' #'@examples #'exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) -#'lat <- rnorm(3)*10 +#'lat <- c(10, 15, 20) #'res <- WeightedCells(data = exp, lat = lat) #'@import multiApply #'@export @@ -64,8 +64,8 @@ WeightedCells <- function(data, lat, lat_dim = 'lat', method = 'cos', ncores = N } ## method - if (!method %in% c('cos','sqrtcos')) { - stop("Parameter 'method' must be one of 'cos' or 'sqrtcos'.") + if (!method %in% c('cos', 'sqrtcos')) { + stop("Parameter 'method' must be 'cos' or 'sqrtcos'.") } ## ncores @@ -80,9 +80,9 @@ WeightedCells <- function(data, lat, lat_dim = 'lat', method = 'cos', ncores = N lat <- as.vector(lat) if (method == 'cos') { - wt <- cos(lat * pi/180) + wt <- cos(lat * pi / 180) } else { - wt <- sqrt(cos(lat * pi/180)) + wt <- sqrt(cos(lat * pi / 180)) } res <- Apply(data = data, @@ -98,6 +98,6 @@ WeightedCells <- function(data, lat, lat_dim = 'lat', method = 'cos', ncores = N } .WeightedCells <- function(data, wt) { - data <- wt*data + data <- wt * data return(data) } diff --git a/man/WeightedCells.Rd b/man/WeightedCells.Rd index 0a8fe98..9b5c880 100644 --- a/man/WeightedCells.Rd +++ b/man/WeightedCells.Rd @@ -20,7 +20,7 @@ dimension. The default value is 'lat'.} \item{method}{A character string indicating the type of weighting applied: 'cos' (cosine of the latitude) or 'sqrtcos' (square-root of the -cosine of the latitude).} +cosine of the latitude). The default value is 'cos'.} \item{ncores}{An integer indicating the number of cores to use for parallel computation. The default value is NULL.} @@ -35,6 +35,6 @@ the given array. } \examples{ exp <- array(rnorm(1:30), dim = c(lat = 3, lon = 5, sdate = 2)) -lat <- rnorm(3)*10 +lat <- c(10, 15, 20) res <- WeightedCells(data = exp, lat = lat) } diff --git a/tests/testthat/test-WeightedCells.R b/tests/testthat/test-WeightedCells.R index 29e5e9b..dcf171d 100644 --- a/tests/testthat/test-WeightedCells.R +++ b/tests/testthat/test-WeightedCells.R @@ -59,7 +59,7 @@ test_that("1. Input checks", { # method expect_error( WeightedCells(data1, lat1, method = 1.5), - "Parameter 'method' must be one of 'cos' or 'sqrtcos'." + "Parameter 'method' must be 'cos' or 'sqrtcos'." ) # ncores expect_error( @@ -102,7 +102,7 @@ test_that("3. Output checks: dat2", { ) expect_equal( WeightedCells(data2, lat2), - WeightedCells(data2, lat2, method = 'sqrtcos')*as.vector(sqrt(cos(lat2*pi/180))), + WeightedCells(data2, lat2, method = 'sqrtcos') * as.vector(sqrt(cos(lat2 * pi/180))), tolerance = 0.01 ) -- GitLab