From 9c73e6d8cca7a2fdc4d1fe60cf02540a6139f16f Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Dec 2022 07:13:41 +0100 Subject: [PATCH 1/7] Allow data to be non-numeric --- R/ShiftLon.R | 14 +++++++++----- tests/testthat/test-ShiftLon.R | 17 +++++++++++++++++ 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/R/ShiftLon.R b/R/ShiftLon.R index 88b034d..08fe00c 100644 --- a/R/ShiftLon.R +++ b/R/ShiftLon.R @@ -35,15 +35,19 @@ #' #'@import multiApply #'@export -ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { +ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { # Check inputs ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } - if (!is.array(data) | !is.numeric(data)) { - stop("Parameter 'data' must be a numeric array.") + if (is.vector(data)) { + data <- as.array(data) + names(dim(data)) <- lon_dim + } + if (!is.array(data)) { + stop("Parameter 'data' must be an array.") } if(any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { stop("Parameter 'data' must have dimension names.") @@ -106,7 +110,7 @@ ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { } else { new.lon <- c(lon[first:length(lon)],lon[1:(first-1)]) } - ## Order to monotonically increasing + ## Order to monotonically increasing if (!all(diff(new.lon) > 0)) { new.lon[(which(diff(new.lon) < 0) + 1):length(new.lon)] <- new.lon[(which(diff(new.lon) < 0) + 1):length(new.lon)] + 360 @@ -128,7 +132,7 @@ ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { .ShiftLon <- function(data, lon, new.lon) { # data: [lon] - new.data <- NA * data + new.data <- data new.data[new.lon %in% lon] <- data[lon %in% new.lon, drop = F] new.data[!new.lon %in% lon] <- data[!lon %in% new.lon, drop = F] diff --git a/tests/testthat/test-ShiftLon.R b/tests/testthat/test-ShiftLon.R index efa358e..154f1d5 100644 --- a/tests/testthat/test-ShiftLon.R +++ b/tests/testthat/test-ShiftLon.R @@ -17,6 +17,11 @@ dat3 <- array(1:512, dim = c(lon = 512, lat = 216, time = 2)) lon3 <- seq(0, 360, length.out = 513)[1:512] lat3 <- seq(-90, 90, length.out = 216) +# dat4: vector, logical +set.seed(1) +dat4 <- as.logical(sample(c(0, 1), replace = TRUE, size = 360)) +lon4 <- 0:359 + ############################################## test_that("1. Input checks", { # data @@ -340,3 +345,15 @@ test_that("4. dat3", { ) }) + + +############################################## +test_that("5. dat4", { + + westB <- -10 +expect_equal( +as.vector(ShiftLon(dat4, lon4, westB)$data), +dat4[c(351:360, 1:350)] +) + +) -- GitLab From 1831a9eed1dfce48a2846e466015ae8cf3264b4a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Dec 2022 07:18:55 +0100 Subject: [PATCH 2/7] Don't ignore unit test --- .Rbuildignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.Rbuildignore b/.Rbuildignore index dde50c4..0c51051 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,5 +5,5 @@ ./.nc$ .*\.gitlab-ci.yml$ # Ignore tests when submitting to CRAN -^tests$ +#^tests$ -- GitLab From 3a4cf2ce6682521c59dcc8ffb7d219a56f99e296 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Dec 2022 07:21:40 +0100 Subject: [PATCH 3/7] Fix syntax --- tests/testthat/test-ShiftLon.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ShiftLon.R b/tests/testthat/test-ShiftLon.R index 154f1d5..ce98c2f 100644 --- a/tests/testthat/test-ShiftLon.R +++ b/tests/testthat/test-ShiftLon.R @@ -356,4 +356,4 @@ as.vector(ShiftLon(dat4, lon4, westB)$data), dat4[c(351:360, 1:350)] ) -) +}) -- GitLab From 70afe5eefcf62d5d4bb58a560a57725549a7934d Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Dec 2022 07:30:58 +0100 Subject: [PATCH 4/7] Add warning and fix unit tests --- R/ShiftLon.R | 1 + tests/testthat/test-ShiftLon.R | 11 ++++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/R/ShiftLon.R b/R/ShiftLon.R index 08fe00c..db54d71 100644 --- a/R/ShiftLon.R +++ b/R/ShiftLon.R @@ -45,6 +45,7 @@ ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { if (is.vector(data)) { data <- as.array(data) names(dim(data)) <- lon_dim + warning("Parameter 'data' is a vector. Transfer it to an array and assign ", lon_dim, " as dimension name.") } if (!is.array(data)) { stop("Parameter 'data' must be an array.") diff --git a/tests/testthat/test-ShiftLon.R b/tests/testthat/test-ShiftLon.R index ce98c2f..e414b5c 100644 --- a/tests/testthat/test-ShiftLon.R +++ b/tests/testthat/test-ShiftLon.R @@ -29,14 +29,15 @@ test_that("1. Input checks", { ShiftLon(c()), "Parameter 'data' cannot be NULL." ) - expect_error( - ShiftLon(1:10), - "Parameter 'data' must be a numeric array." - ) expect_error( ShiftLon(array(1:10)), "Parameter 'data' must have dimension names." ) + expect_warning( + ShiftLon(1:10, lon = 1:10, westB = 2), + "Parameter 'data' is a vector. Transfer it to an array and assign lon as dimension name." + ) + # lon_dim expect_error( ShiftLon(dat1, lon1, lon_dim = 1), @@ -352,7 +353,7 @@ test_that("5. dat4", { westB <- -10 expect_equal( -as.vector(ShiftLon(dat4, lon4, westB)$data), +suppressWarnings(as.vector(ShiftLon(dat4, lon4, westB)$data)), dat4[c(351:360, 1:350)] ) -- GitLab From e06649d4c2d2e7a8a1ab4a2f2c65069e2a22784e Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 9 Jan 2023 10:11:14 +0100 Subject: [PATCH 5/7] Reorder dimension of ShiftLon; Allow SelBox() to have non-numeric input --- R/SelBox.R | 45 +++++++++++++++++++++++++++++++-------------- R/ShiftLon.R | 7 ++++++- man/SelBox.Rd | 35 +++++++++++++++++++++++++---------- 3 files changed, 62 insertions(+), 25 deletions(-) diff --git a/R/SelBox.R b/R/SelBox.R index 5b7cd59..3f8aa5a 100644 --- a/R/SelBox.R +++ b/R/SelBox.R @@ -1,21 +1,36 @@ #'Select apatial region from multidimensional arrays #' -#'@description This function subsets an spatial region from spatial data giving a vector with the maximum and minimum of latitudes and longitudes of the selected region. +#'@description This function subsets an spatial region from spatial data giving +#' a vector with the maximum and minimum of latitudes and longitudes of the +#' selected region. #' #'@param data An array with minimum two dimensions of latitude and longitude. -#'@param lon Numeric vector of longitude locations of the cell centers of the grid of \code{data}'. -#'@param lat Numeric vector of latitude locations of the cell centers of the grid of \code{data}'. -#'@param region A vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude. -#'@param londim An integer number indicating the position of the longitude dimension in the \code{data} object. If NULL (by deafault), the function search for a dimension call 'lon' in the \code{data} input. -#'@param latdim An integer number indicating the position of the latitude dimension in the \code{data} object. If NULL (by deafault), the function search for a dimension call 'lat' in the \code{data} input. +#'@param lon Numeric vector of longitude locations of the cell centers of the +#' grid of \code{data}'. +#'@param lat Numeric vector of latitude locations of the cell centers of the +#' grid of \code{data}'. +#'@param region A vector of length four indicating the minimum longitude, the +#' maximum longitude, the minimum latitude and the maximum latitude. +#'@param londim An integer number indicating the position of the longitude +#' dimension in the \code{data} object. If NULL (by deafault), the function +#' search for a dimension call 'lon' in the \code{data} input. +#'@param latdim An integer number indicating the position of the latitude +#' dimension in the \code{data} object. If NULL (by deafault), the function +#' search for a dimension call 'lat' in the \code{data} input. #'@param mask A matrix with the same spatial dimensions of \code{data}. #' #'@return A list of length 4: #'\itemize{ -#' \item\code{$data}{An array with the same dimensions as the input \code{data} array, but with spatial dimension reduced to the selected \code{region}} -#' \item\code{$lat}{A vector with the new corresponding latitudes for the selected \code{region}} -#' \item\code{$lon}{A vector with the new corresponding longitudes for the selected \code{region}} -#' \item\code{$mask}{If parameter \code{mask} is supplied, an array with reduced length of the dimensions to the selected \code{region}. Otherwise, a NULL element is returned.}} +#' \item\code{$data}{ +#' An array with the same dimensions as the input \code{data} array, but with +#' spatial dimension reduced to the selected \code{region}} +#' \item\code{$lat}{A vector with the new corresponding latitudes for the +#' selected \code{region}} +#' \item\code{$lon}{A vector with the new corresponding longitudes for the +#' selected \code{region}} +#' \item\code{$mask}{If parameter \code{mask} is supplied, an array with +#' reduced length of the dimensions to the selected \code{region}. Otherwise, +#' a NULL element is returned.}} #' #'@examples #'## Example with synthetic data: @@ -32,8 +47,8 @@ SelBox <- function(data, lon, lat, region, londim = NULL, latdim = NULL, mask = if (is.null(data) | is.null(lon) | is.null(lat) | is.null(region)){ stop("Parameters 'data', 'lon', 'lat' or 'region' cannot be NULL.") } - if (!is.numeric(data) | !is.numeric(lon) | !is.numeric(lat) | !is.numeric(region)){ - stop("Parameters 'data', 'lon', 'lat' or 'region' must be numeric.") + if (!is.numeric(lon) | !is.numeric(lat) | !is.numeric(region)) { + stop("Parameters 'lon', 'lat' or 'region' must be numeric.") } if (!is.array(data) && !is.matrix(data)) { stop("Parameter 'data' must be an array or matrix.") @@ -42,7 +57,8 @@ SelBox <- function(data, lon, lat, region, londim = NULL, latdim = NULL, mask = stop("Parameter 'lon' and lat' need to be a vector.") } if (length(region) != 4){ - stop("The region argument has to be a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.") + stop("The region argument has to be a vector of length four indicating the ", + "minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.") } dims <- 1:length(dim(data)) if (is.null(londim)) { @@ -51,7 +67,8 @@ SelBox <- function(data, lon, lat, region, londim = NULL, latdim = NULL, mask = } else if (length(lon) %in% dim(data)) { londim <- which(dim(data) == length(lon)) if (length(londim) > 1) { - stop("More than one dimension of the parameter 'data' has the same length as 'lon' parameter.") + stop("More than one dimension of the parameter 'data' has the same length as ", + "'lon' parameter.") } } else { stop("Non of the dimensions of the parameter 'data' are of the same length as 'lon'.") diff --git a/R/ShiftLon.R b/R/ShiftLon.R index db54d71..16c9fda 100644 --- a/R/ShiftLon.R +++ b/R/ShiftLon.R @@ -118,6 +118,8 @@ ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { } # Shifting the data + ori_dim <- dim(data) + output <- Apply(data = data, target_dims = lon_dim, fun = .ShiftLon, @@ -127,7 +129,10 @@ ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { # Shift new.lon back to start at westB new.lon <- new.lon + shft_westB_back - + + # Change dimension order back + output <- aperm(output, match(names(dim(output)), names(ori_dim))) + return(list(data = output, lon = new.lon)) } diff --git a/man/SelBox.Rd b/man/SelBox.Rd index 38e3547..03dc9e3 100644 --- a/man/SelBox.Rd +++ b/man/SelBox.Rd @@ -9,28 +9,43 @@ SelBox(data, lon, lat, region, londim = NULL, latdim = NULL, mask = NULL) \arguments{ \item{data}{An array with minimum two dimensions of latitude and longitude.} -\item{lon}{Numeric vector of longitude locations of the cell centers of the grid of \code{data}'.} +\item{lon}{Numeric vector of longitude locations of the cell centers of the +grid of \code{data}'.} -\item{lat}{Numeric vector of latitude locations of the cell centers of the grid of \code{data}'.} +\item{lat}{Numeric vector of latitude locations of the cell centers of the +grid of \code{data}'.} -\item{region}{A vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.} +\item{region}{A vector of length four indicating the minimum longitude, the +maximum longitude, the minimum latitude and the maximum latitude.} -\item{londim}{An integer number indicating the position of the longitude dimension in the \code{data} object. If NULL (by deafault), the function search for a dimension call 'lon' in the \code{data} input.} +\item{londim}{An integer number indicating the position of the longitude +dimension in the \code{data} object. If NULL (by deafault), the function +search for a dimension call 'lon' in the \code{data} input.} -\item{latdim}{An integer number indicating the position of the latitude dimension in the \code{data} object. If NULL (by deafault), the function search for a dimension call 'lat' in the \code{data} input.} +\item{latdim}{An integer number indicating the position of the latitude +dimension in the \code{data} object. If NULL (by deafault), the function +search for a dimension call 'lat' in the \code{data} input.} \item{mask}{A matrix with the same spatial dimensions of \code{data}.} } \value{ A list of length 4: \itemize{ - \item\code{$data}{An array with the same dimensions as the input \code{data} array, but with spatial dimension reduced to the selected \code{region}} - \item\code{$lat}{A vector with the new corresponding latitudes for the selected \code{region}} - \item\code{$lon}{A vector with the new corresponding longitudes for the selected \code{region}} - \item\code{$mask}{If parameter \code{mask} is supplied, an array with reduced length of the dimensions to the selected \code{region}. Otherwise, a NULL element is returned.}} + \item\code{$data}{ + An array with the same dimensions as the input \code{data} array, but with + spatial dimension reduced to the selected \code{region}} + \item\code{$lat}{A vector with the new corresponding latitudes for the + selected \code{region}} + \item\code{$lon}{A vector with the new corresponding longitudes for the + selected \code{region}} + \item\code{$mask}{If parameter \code{mask} is supplied, an array with + reduced length of the dimensions to the selected \code{region}. Otherwise, + a NULL element is returned.}} } \description{ -This function subsets an spatial region from spatial data giving a vector with the maximum and minimum of latitudes and longitudes of the selected region. +This function subsets an spatial region from spatial data giving + a vector with the maximum and minimum of latitudes and longitudes of the + selected region. } \examples{ ## Example with synthetic data: -- GitLab From 887b43d35512eaff0f346ef52d0cae0b59c7a84b Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 31 Jan 2023 08:32:47 +0100 Subject: [PATCH 6/7] Correct typo --- R/SelBox.R | 16 ++++++++-------- man/SelBox.Rd | 11 +++++------ 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/R/SelBox.R b/R/SelBox.R index 3f8aa5a..bab99bd 100644 --- a/R/SelBox.R +++ b/R/SelBox.R @@ -1,8 +1,7 @@ -#'Select apatial region from multidimensional arrays +#'Select spatial region from multidimensional arrays #' -#'@description This function subsets an spatial region from spatial data giving -#' a vector with the maximum and minimum of latitudes and longitudes of the -#' selected region. +#'@description Subset a spatial region from spatial data giving a vector with +#' the maximum and minimum of latitudes and longitudes of the selected region. #' #'@param data An array with minimum two dimensions of latitude and longitude. #'@param lon Numeric vector of longitude locations of the cell centers of the @@ -15,8 +14,8 @@ #' dimension in the \code{data} object. If NULL (by deafault), the function #' search for a dimension call 'lon' in the \code{data} input. #'@param latdim An integer number indicating the position of the latitude -#' dimension in the \code{data} object. If NULL (by deafault), the function -#' search for a dimension call 'lat' in the \code{data} input. +#' dimension in the \code{data} object. If NULL (by default), the function +#' searches for a dimension call 'lat' in the \code{data} input. #'@param mask A matrix with the same spatial dimensions of \code{data}. #' #'@return A list of length 4: @@ -44,7 +43,8 @@ #'str(a) #'@export SelBox <- function(data, lon, lat, region, londim = NULL, latdim = NULL, mask = NULL) { - if (is.null(data) | is.null(lon) | is.null(lat) | is.null(region)){ + + if (is.null(data) | is.null(lon) | is.null(lat) | is.null(region)) { stop("Parameters 'data', 'lon', 'lat' or 'region' cannot be NULL.") } if (!is.numeric(lon) | !is.numeric(lat) | !is.numeric(region)) { @@ -56,7 +56,7 @@ SelBox <- function(data, lon, lat, region, londim = NULL, latdim = NULL, mask = if (!is.null(dim(lat)) | !is.null(dim(lon))) { stop("Parameter 'lon' and lat' need to be a vector.") } - if (length(region) != 4){ + if (length(region) != 4) { stop("The region argument has to be a vector of length four indicating the ", "minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.") } diff --git a/man/SelBox.Rd b/man/SelBox.Rd index 03dc9e3..fa85629 100644 --- a/man/SelBox.Rd +++ b/man/SelBox.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/SelBox.R \name{SelBox} \alias{SelBox} -\title{Select apatial region from multidimensional arrays} +\title{Select spatial region from multidimensional arrays} \usage{ SelBox(data, lon, lat, region, londim = NULL, latdim = NULL, mask = NULL) } @@ -23,8 +23,8 @@ dimension in the \code{data} object. If NULL (by deafault), the function search for a dimension call 'lon' in the \code{data} input.} \item{latdim}{An integer number indicating the position of the latitude -dimension in the \code{data} object. If NULL (by deafault), the function -search for a dimension call 'lat' in the \code{data} input.} +dimension in the \code{data} object. If NULL (by default), the function +searches for a dimension call 'lat' in the \code{data} input.} \item{mask}{A matrix with the same spatial dimensions of \code{data}.} } @@ -43,9 +43,8 @@ A list of length 4: a NULL element is returned.}} } \description{ -This function subsets an spatial region from spatial data giving - a vector with the maximum and minimum of latitudes and longitudes of the - selected region. +Subset a spatial region from spatial data giving a vector with + the maximum and minimum of latitudes and longitudes of the selected region. } \examples{ ## Example with synthetic data: -- GitLab From 5244461a85c2178ba9232539d061e4202235a000 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 1 Feb 2023 04:56:06 +0100 Subject: [PATCH 7/7] Correct dimension reorder --- R/ShiftLon.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShiftLon.R b/R/ShiftLon.R index 16c9fda..1467108 100644 --- a/R/ShiftLon.R +++ b/R/ShiftLon.R @@ -131,7 +131,7 @@ ShiftLon <- function(data, lon, westB, lon_dim = 'lon', ncores = NULL) { new.lon <- new.lon + shft_westB_back # Change dimension order back - output <- aperm(output, match(names(dim(output)), names(ori_dim))) + output <- aperm(output, match(names(ori_dim), names(dim(output)))) return(list(data = output, lon = new.lon)) } -- GitLab