From 5e8ef202b9debea4e59a7582b0864df63e36f9b9 Mon Sep 17 00:00:00 2001 From: Sergio Oller Date: Tue, 1 Mar 2016 17:53:59 +0100 Subject: [PATCH 1/2] rescale() works with Date, POSIXct, POSIXt and POSIXlt objects. --- NEWS.md | 2 ++ R/bounds.r | 18 ++++++++++++++++++ tests/testthat/test-bounds.r | 28 +++++++++++++++++++++------- 3 files changed, 41 insertions(+), 7 deletions(-) diff --git a/NEWS.md b/NEWS.md index cbff0520..cd111144 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,8 @@ * `train_discrete()` gets a new `na.rm` argument which controls whether `NA`s are preserved or dropped. +* `rescale()` works with `Date`, `POSIXct` and `POSIXlt` objects (@zeehio, #74). + # scales 0.4.0 * Switched from `NEWS` to `NEWS.md` diff --git a/R/bounds.r b/R/bounds.r index 5407f08b..65b32819 100644 --- a/R/bounds.r +++ b/R/bounds.r @@ -1,3 +1,14 @@ +# If needed, converts input from classes that lack division and multiplication +# to classes that can be scaled. +# @param x vector of values to convert, if needed +adapt_input_class <- function(x) { + if (inherits(x, c("Date", "POSIXct", "POSIXlt", "POSIXt"))) { + as.numeric(x) + } else { + x + } +} + #' Rescale numeric vector to have specified minimum and maximum. #' #' @param x numeric vector of values to manipulate. @@ -11,6 +22,8 @@ #' rescale(runif(50)) #' rescale(1) rescale <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE)) { + x <- adapt_input_class(x) + from <- adapt_input_class(from) if (zero_range(from) || zero_range(to)) { return(ifelse(is.na(x), NA, mean(to))) } @@ -31,6 +44,9 @@ rescale <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE #' rescale_mid(runif(50), mid = 0.5) #' rescale_mid(1) rescale_mid <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) { + x <- adapt_input_class(x) + from <- adapt_input_class(from) + mid <- adapt_input_class(mid) if (zero_range(from) || zero_range(to)) return(rep(mean(to), length(x))) extent <- 2 * max(abs(from - mid)) @@ -49,6 +65,8 @@ rescale_mid <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) #' rescale_max(runif(50)) #' rescale_max(1) rescale_max <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) { + x <- adapt_input_class(x) + from <- adapt_input_class(from) x / from[2] * to[2] } diff --git a/tests/testthat/test-bounds.r b/tests/testthat/test-bounds.r index aa3dd112..bfaeb5ba 100644 --- a/tests/testthat/test-bounds.r +++ b/tests/testthat/test-bounds.r @@ -2,13 +2,13 @@ context("Bounds") test_that("rescale_mid returns correct results", { x <- c(-1, 0, 1) - + expect_equal(rescale_mid(x), c(0, 0.5, 1)) expect_equal(rescale_mid(x, mid = -1), c(0.5, 0.75, 1)) expect_equal(rescale_mid(x, mid = 1), c(0, 0.25, 0.5)) - + expect_equal(rescale_mid(x, mid = 1, to = c(0, 10)), c(0, 2.5, 5)) - expect_equal(rescale_mid(x, mid = 1, to = c(8, 10)), c(8, 8.5, 9)) + expect_equal(rescale_mid(x, mid = 1, to = c(8, 10)), c(8, 8.5, 9)) }) @@ -23,13 +23,27 @@ test_that("resacle_max returns correct results", { test_that("zero range inputs return mid range", { expect_that(rescale(0), equals(0.5)) - expect_that(rescale(c(0, 0)), equals(c(0.5, 0.5))) + expect_that(rescale(c(0, 0)), equals(c(0.5, 0.5))) }) test_that("censor and squish ignore infinite values", { expect_equal(squish(c(1, Inf)), c(1, Inf)) expect_equal(censor(c(1, Inf)), c(1, Inf)) - - -}) \ No newline at end of file + + +}) + +test_that("scaling is possible with dates and times", { + dates <- as.Date(c("2010-01-01", "2010-01-03", "2010-01-05", "2010-01-07")) + expect_equal(rescale(dates, from = c(dates[1], dates[4])), seq(0,1,1/3)) + expect_equal(rescale_mid(dates, mid = dates[3])[3], 0.5) + + dates <- as.POSIXct(c("2010-01-01 01:40:40", + "2010-01-01 03:40:40", + "2010-01-01 05:40:40", + "2010-01-01 07:40:40")) + expect_equal(rescale(dates, from = c(dates[1], dates[4])), seq(0, 1, 1/3)) + expect_equal(rescale_mid(dates, mid = dates[3])[3], 0.5) + +}) From 497a1f0bb7466333dc91e072fd36ca9cab2ae527 Mon Sep 17 00:00:00 2001 From: Sergio Oller Date: Mon, 26 Jun 2017 18:09:46 +0200 Subject: [PATCH 2/2] rescale and rescale_mid as S3 generics Provide support for Date, POSIXct, POSIXlt and integer64 types, as well as numeric. --- DESCRIPTION | 1 + NAMESPACE | 8 +++ NEWS.md | 3 +- R/bounds.r | 98 ++++++++++++++++++++++++++---------- man/rescale.Rd | 28 +++++++++-- man/rescale_mid.Rd | 28 +++++++++-- tests/testthat/test-bounds.r | 10 +++- 7 files changed, 138 insertions(+), 38 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1db60ad6..f05538a2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,6 +23,7 @@ Imports: LinkingTo: Rcpp Suggests: testthat (>= 0.8), + bit64, covr, hms License: MIT + file LICENSE diff --git a/NAMESPACE b/NAMESPACE index 9dafe0e0..e46de24f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,14 @@ S3method(fullseq,Date) S3method(fullseq,POSIXt) S3method(fullseq,numeric) S3method(print,trans) +S3method(rescale,Date) +S3method(rescale,POSIXt) +S3method(rescale,integer64) +S3method(rescale,numeric) +S3method(rescale_mid,Date) +S3method(rescale_mid,POSIXt) +S3method(rescale_mid,integer64) +S3method(rescale_mid,numeric) export(ContinuousRange) export(DiscreteRange) export(abs_area) diff --git a/NEWS.md b/NEWS.md index cd111144..12fe0766 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,7 +9,8 @@ * `train_discrete()` gets a new `na.rm` argument which controls whether `NA`s are preserved or dropped. -* `rescale()` works with `Date`, `POSIXct` and `POSIXlt` objects (@zeehio, #74). +* `rescale()` and `rescale_mid()` are now S3 generics, and work with `numeric`, + `Date`, `POSIXct`, `POSIXlt` and `bit64::integer64` objects (@zeehio, #74). # scales 0.4.0 diff --git a/R/bounds.r b/R/bounds.r index 65b32819..953798fe 100644 --- a/R/bounds.r +++ b/R/bounds.r @@ -1,58 +1,106 @@ -# If needed, converts input from classes that lack division and multiplication -# to classes that can be scaled. -# @param x vector of values to convert, if needed -adapt_input_class <- function(x) { - if (inherits(x, c("Date", "POSIXct", "POSIXlt", "POSIXt"))) { - as.numeric(x) - } else { - x - } -} - -#' Rescale numeric vector to have specified minimum and maximum. +#' Rescale continuous vector to have specified minimum and maximum. #' -#' @param x numeric vector of values to manipulate. +#' @param x continuous vector of values to manipulate. #' @param to output range (numeric vector of length two) -#' @param from input range (numeric vector of length two). If not given, is +#' @param from input range (vector of length two). If not given, is #' calculated from the range of \code{x} +#' @param ... other arguments passed on to methods #' @keywords manip #' @export #' @examples #' rescale(1:100) #' rescale(runif(50)) #' rescale(1) -rescale <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE)) { - x <- adapt_input_class(x) - from <- adapt_input_class(from) +rescale <- function(x, to, from, ...) { + UseMethod("rescale") +} + + +#' @rdname rescale +#' @export +rescale.numeric <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE), ...) { if (zero_range(from) || zero_range(to)) { return(ifelse(is.na(x), NA, mean(to))) } + (x - from[1]) / diff(from) * diff(to) + to[1] +} + +#' @rdname rescale +#' @export +rescale.POSIXt <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE), ...) { + x <- as.numeric(x) + from <- as.numeric(from) + rescale.numeric(x = x, to = to, from = from) +} +#' @rdname rescale +#' @export +rescale.Date <- rescale.POSIXt + +#' @rdname rescale +#' @export +rescale.integer64 <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), ...) { + if (zero_range(from, tol = 0) || zero_range(to)) { + return(ifelse(is.na(x), NA, mean(to))) + } (x - from[1]) / diff(from) * diff(to) + to[1] } -#' Rescale numeric vector to have specified minimum, midpoint, and maximum. + +#' Rescale vector to have specified minimum, midpoint, and maximum. #' #' @export -#' @param x numeric vector of values to manipulate. +#' @param x vector of values to manipulate. #' @param to output range (numeric vector of length two) -#' @param from input range (numeric vector of length two). If not given, is +#' @param from input range (vector of length two). If not given, is #' calculated from the range of \code{x} #' @param mid mid-point of input range +#' @param ... other arguments passed on to methods #' @examples #' rescale_mid(1:100, mid = 50.5) #' rescale_mid(runif(50), mid = 0.5) #' rescale_mid(1) -rescale_mid <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) { - x <- adapt_input_class(x) - from <- adapt_input_class(from) - mid <- adapt_input_class(mid) +rescale_mid <- function(x, to, from, mid, ...) { + UseMethod("rescale_mid") +} + +#' @rdname rescale_mid +#' @export +rescale_mid.numeric <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0, ...) { if (zero_range(from) || zero_range(to)) return(rep(mean(to), length(x))) extent <- 2 * max(abs(from - mid)) (x - mid) / extent * diff(to) + mean(to) } +#' @rdname rescale_mid +#' @export +rescale_mid.POSIXt <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), + mid, ...) { + x <- as.numeric(as.POSIXct(x)) + if (!is.numeric(from)) { + from <- as.numeric(as.POSIXct(from)) + } + if (!is.numeric(mid)) { + mid <- as.numeric(as.POSIXct(mid)) + } + rescale_mid.numeric(x = x, to = to, from = from, mid = mid) +} + +#' @rdname rescale_mid +#' @export +rescale_mid.Date <- rescale_mid.POSIXt + +#' @rdname rescale_mid +#' @export +rescale_mid.integer64 <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0, ...) { + if (zero_range(from, tol = 0) || zero_range(to)) return(rep(mean(to), length(x))) + + extent <- 2 * max(abs(from - mid)) + (x - mid) / extent * diff(to) + mean(to) +} + + #' Rescale numeric vector to have specified maximum. #' #' @export @@ -65,8 +113,6 @@ rescale_mid <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) #' rescale_max(runif(50)) #' rescale_max(1) rescale_max <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) { - x <- adapt_input_class(x) - from <- adapt_input_class(from) x / from[2] * to[2] } diff --git a/man/rescale.Rd b/man/rescale.Rd index 376e280b..221a9d59 100644 --- a/man/rescale.Rd +++ b/man/rescale.Rd @@ -2,20 +2,38 @@ % Please edit documentation in R/bounds.r \name{rescale} \alias{rescale} -\title{Rescale numeric vector to have specified minimum and maximum.} +\alias{rescale.numeric} +\alias{rescale.POSIXt} +\alias{rescale.Date} +\alias{rescale.integer64} +\title{Rescale continuous vector to have specified minimum and maximum.} \usage{ -rescale(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE)) +rescale(x, to, from, ...) + +\method{rescale}{numeric}(x, to = c(0, 1), from = range(x, na.rm = TRUE, + finite = TRUE), ...) + +\method{rescale}{POSIXt}(x, to = c(0, 1), from = range(x, na.rm = TRUE, + finite = TRUE), ...) + +\method{rescale}{Date}(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite + = TRUE), ...) + +\method{rescale}{integer64}(x, to = c(0, 1), from = range(x, na.rm = TRUE), + ...) } \arguments{ -\item{x}{numeric vector of values to manipulate.} +\item{x}{continuous vector of values to manipulate.} \item{to}{output range (numeric vector of length two)} -\item{from}{input range (numeric vector of length two). If not given, is +\item{from}{input range (vector of length two). If not given, is calculated from the range of \code{x}} + +\item{...}{other arguments passed on to methods} } \description{ -Rescale numeric vector to have specified minimum and maximum. +Rescale continuous vector to have specified minimum and maximum. } \examples{ rescale(1:100) diff --git a/man/rescale_mid.Rd b/man/rescale_mid.Rd index b2f51591..3736eeab 100644 --- a/man/rescale_mid.Rd +++ b/man/rescale_mid.Rd @@ -2,22 +2,40 @@ % Please edit documentation in R/bounds.r \name{rescale_mid} \alias{rescale_mid} -\title{Rescale numeric vector to have specified minimum, midpoint, and maximum.} +\alias{rescale_mid.numeric} +\alias{rescale_mid.POSIXt} +\alias{rescale_mid.Date} +\alias{rescale_mid.integer64} +\title{Rescale vector to have specified minimum, midpoint, and maximum.} \usage{ -rescale_mid(x, to = c(0, 1), from = range(x, na.rm = TRUE), mid = 0) +rescale_mid(x, to, from, mid, ...) + +\method{rescale_mid}{numeric}(x, to = c(0, 1), from = range(x, na.rm = + TRUE), mid = 0, ...) + +\method{rescale_mid}{POSIXt}(x, to = c(0, 1), from = range(x, na.rm = TRUE), + mid, ...) + +\method{rescale_mid}{Date}(x, to = c(0, 1), from = range(x, na.rm = TRUE), + mid, ...) + +\method{rescale_mid}{integer64}(x, to = c(0, 1), from = range(x, na.rm = + TRUE), mid = 0, ...) } \arguments{ -\item{x}{numeric vector of values to manipulate.} +\item{x}{vector of values to manipulate.} \item{to}{output range (numeric vector of length two)} -\item{from}{input range (numeric vector of length two). If not given, is +\item{from}{input range (vector of length two). If not given, is calculated from the range of \code{x}} \item{mid}{mid-point of input range} + +\item{...}{other arguments passed on to methods} } \description{ -Rescale numeric vector to have specified minimum, midpoint, and maximum. +Rescale vector to have specified minimum, midpoint, and maximum. } \examples{ rescale_mid(1:100, mid = 50.5) diff --git a/tests/testthat/test-bounds.r b/tests/testthat/test-bounds.r index bfaeb5ba..f7f8684f 100644 --- a/tests/testthat/test-bounds.r +++ b/tests/testthat/test-bounds.r @@ -12,12 +12,13 @@ test_that("rescale_mid returns correct results", { }) -test_that("resacle_max returns correct results", { +test_that("rescale_max returns correct results", { expect_equal(rescale_max(0), NaN) expect_equal(rescale_max(1), 1) expect_equal(rescale_max(.3), 1) expect_equal(rescale_max(c(4, 5)), c(0.8, 1.0)) expect_equal(rescale_max(c(-3, 0, -1, 2)), c(-1.5, 0, -0.5, 1)) + expect_equal(rescale_max(c(-3, 0, -1, 2)), c(-1.5, 0, -0.5, 1)) }) @@ -47,3 +48,10 @@ test_that("scaling is possible with dates and times", { expect_equal(rescale_mid(dates, mid = dates[3])[3], 0.5) }) + +test_that("scaling is possible with integer64 data", { + x <- bit64::as.integer64(2^60) + c(0:3) + expect_equal( + rescale_mid(x, mid = bit64::as.integer64(2^60) + 1), + c(0.25, 0.5, 0.75, 1)) +})