From 46972aa0ec2c0ccc23a4d1f382654679559eb831 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 22:35:57 +0200 Subject: [PATCH 1/7] Improve documentation and style --- R/raster.R | 55 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 31 insertions(+), 24 deletions(-) diff --git a/R/raster.R b/R/raster.R index cb0ece11..8759e83e 100644 --- a/R/raster.R +++ b/R/raster.R @@ -2,27 +2,35 @@ #' @description #' `makeraster()` fits the data to the specified raster. #' -#' `fitraster()` tries different raster parameter and returns the raster that covers most of the -#' `x` values: The differences between the values of `x` are calculated (possible step -#' sizes). For each of those step sizes, different points are tried (until all points have been -#' covered by a raster) and the parameter combination leading to the best coverage (i.e. most points -#' on the grid) is not used. -#' -#' Note that only differences between the sorted values of x are considered as step size. -#' @param x numeric to be fitted with a raster -#' @param startx starting point ("origin") for calculation of the raster -#' @param d step size of the raster -#' @param tol tolerance for rounding to new levels: elements of x within `tol` of the distance between the levels of the new grid are rounded to the new grid point. -#' @param newlevels levels of the raster -#' @return list with elements +#' `fitraster()` tries different raster parameter and returns the raster that +#' covers most of the `x` values: The differences between the values of `x` are +#' calculated (possible step sizes). For each of those step sizes, different +#' points are tried (until all points have been covered by a raster) and the +#' parameter combination leading to the best coverage (i.e. most points on the +#' grid) is not used. +#' +#' Note that only differences between the sorted values of x are considered as +#' step size. +#' +#' @param x Numeric to be fitted with a raster. +#' @param startx Starting point ("origin") for calculation of the raster. +#' @param d Step size of the raster. +#' @param tol Tolerance for rounding to new levels: elements of x within `tol` +#' of the distance between the levels of the new grid are rounded to the +#' new grid point. +#' @param newlevels Levels of the raster. +#' +#' @return List with elements: #' \item{x}{the values of `x`, possibly rounded to the raster values} #' \item{levels}{the values of the raster} #' +#' @importFrom utils tail #' @export #' #' @concept manipulation #' #' @author Claudia Beleites +#' #' @examples #' x <- c(sample(1:20, 10), (0:5) + 0.5) #' raster <- makeraster(x, x[1], 2) @@ -34,13 +42,12 @@ #' missing <- setdiff(raster$levels, raster$x) #' abline(h = missing, col = "red") #' -#' ## points acutally on the raster +#' ## points actually on the raster #' onraster <- raster$x %in% raster$levels #' points(which(onraster), raster$x[onraster], col = "blue", pch = 20) -#' @importFrom utils tail makeraster <- function(x, startx, d, newlevels, tol = 0.1) { if (missing(newlevels)) { - ## make sure to cover the whole data range + 1 point + # make sure to cover the whole data range + 1 point newlevels <- c( rev(seq(startx, min(x, na.rm = TRUE) - d, by = -d)[-1]), seq(startx, max(x, na.rm = TRUE) + d, by = d) @@ -49,7 +56,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { inew <- approx(newlevels, seq_along(newlevels), x)$y - ## rounding + # rounding rinew <- round(inew) wholenum <- abs(inew - rinew) < tol @@ -81,7 +88,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { #' missing <- setdiff(raster$levels, raster$x) #' abline(h = missing, col = "red") #' -#' ## points acutally on the raster +#' ## points actually on the raster #' onraster <- raster$x %in% raster$levels #' points(which(onraster), raster$x[onraster], col = "blue", pch = 20) #' @@ -95,7 +102,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { #' missing <- setdiff(raster$levels, raster$x) #' abline(h = missing, col = "red") #' -#' ## points acutally on the raster +#' ## points actually on the raster #' onraster <- raster$x %in% raster$levels #' points(which(onraster), raster$x[onraster], col = "blue", pch = 20) fitraster <- function(x, tol = 0.1) { @@ -107,7 +114,7 @@ fitraster <- function(x, tol = 0.1) { dx <- sort(unique(diff(levels))) - ## reduce by rounding? + # reduce by rounding? dx <- c(dx[!diff(dx) < tol], tail(dx, 1)) dx <- rev(dx) @@ -117,14 +124,14 @@ fitraster <- function(x, tol = 0.1) { for (d in dx) { totry <- order(x) while (length(totry) > 0L) { - ## cat ("totry: ", totry, "\n") + # cat ("totry: ", totry, "\n") startx <- x[totry[1]] - ## cat ("startx: ", startx, "\n") + # cat ("startx: ", startx, "\n") - ## cat ("fit: ", c (startx, d), "\n") + # cat ("fit: ", c (startx, d), "\n") raster <- makeraster(x, startx, d, tol = tol) tmp <- sum(raster$x %in% raster$levels, na.rm = TRUE) - ## cat (" ", tmp, "\n") + # cat (" ", tmp, "\n") if (tmp > max.covered) { max.covered <- tmp fit <- raster From c3f0841d31d2a528ae44befba21cbf2ed85ac5b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 22:40:00 +0200 Subject: [PATCH 2/7] =?UTF-8?q?Rname=20fitraster=20=20=E2=86=92=20=20raste?= =?UTF-8?q?r=5Ffit?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/raster.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/raster.R b/R/raster.R index 8759e83e..5f5f026b 100644 --- a/R/raster.R +++ b/R/raster.R @@ -2,7 +2,7 @@ #' @description #' `makeraster()` fits the data to the specified raster. #' -#' `fitraster()` tries different raster parameter and returns the raster that +#' `raster_fit()` tries different raster parameter and returns the raster that #' covers most of the `x` values: The differences between the values of `x` are #' calculated (possible step sizes). For each of those step sizes, different #' points are tried (until all points have been covered by a raster) and the @@ -79,7 +79,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { #' #' @examples #' -#' raster <- fitraster(x) +#' raster <- raster_fit(x) #' raster #' plot(x) #' abline(h = raster$levels, col = "#00000040") @@ -93,7 +93,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { #' points(which(onraster), raster$x[onraster], col = "blue", pch = 20) #' #' x <- c(sample(1:20, 10), (0:5) + 0.45) -#' raster <- fitraster(x) +#' raster <- raster_fit(x) #' raster #' plot(x) #' abline(h = raster$levels, col = "#00000040") @@ -105,7 +105,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { #' ## points actually on the raster #' onraster <- raster$x %in% raster$levels #' points(which(onraster), raster$x[onraster], col = "blue", pch = 20) -fitraster <- function(x, tol = 0.1) { +raster_fit <- function(x, tol = 0.1) { levels <- sort(unique(x)) if (length(levels) == 1L) { From cbc1bebd05572507bf020e3df39515c78ab51479 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 22:42:11 +0200 Subject: [PATCH 3/7] =?UTF-8?q?Rename=20makeraster=20=E2=86=92=20raster=5F?= =?UTF-8?q?make?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/raster.R | 10 +++++----- vignettes/plotting.Rmd | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/raster.R b/R/raster.R index 5f5f026b..929a06c0 100644 --- a/R/raster.R +++ b/R/raster.R @@ -1,6 +1,6 @@ #' @title Find an evenly spaced grid for x #' @description -#' `makeraster()` fits the data to the specified raster. +#' `raster_make()` fits the data to the specified raster. #' #' `raster_fit()` tries different raster parameter and returns the raster that #' covers most of the `x` values: The differences between the values of `x` are @@ -33,7 +33,7 @@ #' #' @examples #' x <- c(sample(1:20, 10), (0:5) + 0.5) -#' raster <- makeraster(x, x[1], 2) +#' raster <- raster_make(x, x[1], 2) #' raster #' plot(x) #' abline(h = raster$levels, col = "#00000040") @@ -45,7 +45,7 @@ #' ## points actually on the raster #' onraster <- raster$x %in% raster$levels #' points(which(onraster), raster$x[onraster], col = "blue", pch = 20) -makeraster <- function(x, startx, d, newlevels, tol = 0.1) { +raster_make <- function(x, startx, d, newlevels, tol = 0.1) { if (missing(newlevels)) { # make sure to cover the whole data range + 1 point newlevels <- c( @@ -72,7 +72,7 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { ) } -#' @rdname makeraster +#' @rdname raster_make #' @export #' #' @concept manipulation @@ -129,7 +129,7 @@ raster_fit <- function(x, tol = 0.1) { # cat ("startx: ", startx, "\n") # cat ("fit: ", c (startx, d), "\n") - raster <- makeraster(x, startx, d, tol = tol) + raster <- raster_make(x, startx, d, tol = tol) tmp <- sum(raster$x %in% raster$levels, na.rm = TRUE) # cat (" ", tmp, "\n") if (tmp > max.covered) { diff --git a/vignettes/plotting.Rmd b/vignettes/plotting.Rmd index 229d83da..ade1ecf2 100644 --- a/vignettes/plotting.Rmd +++ b/vignettes/plotting.Rmd @@ -1300,10 +1300,10 @@ CAPTION = "Unevenly spaced measurement grid: example IV. " ``` ```{r uneven-IV, fig.cap=CAPTION} -rx <- makeraster(uneven$x, startx = -11.55, d = 1, tol = 0.3) +rx <- raster_make(uneven$x, startx = -11.55, d = 1, tol = 0.3) uneven$x <- rx$x -ry <- makeraster(uneven$y, startx = -4.77, d = 1, tol = 0.3) +ry <- raster_make(uneven$y, startx = -4.77, d = 1, tol = 0.3) uneven$y <- ry$x plotmap(uneven) From 9573b37ad134f087af9dfe576093e1efd4bdc580 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 22:56:41 +0200 Subject: [PATCH 4/7] Deprecate makeraster and fitraster --- R/DEPRECATED-raster.R | 49 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 R/DEPRECATED-raster.R diff --git a/R/DEPRECATED-raster.R b/R/DEPRECATED-raster.R new file mode 100644 index 00000000..ba623e46 --- /dev/null +++ b/R/DEPRECATED-raster.R @@ -0,0 +1,49 @@ +#' @name DEPRECATED-raster +#' @concept deprecated +#' +#' @title (DEPRECATED) +#' Find an evenly spaced grid for x +#' +#' @description +#' These \pkg{hyperSpec} functions are **deprecated** and not maintained any +#' more. You should not use these. +#' Currently they are present due to back-compatibility reasons and will be +#' removed in the next release of the package. +#' Please, use the suggested alternative functions instead: +#' +#' - [hyperSpec::raster_make()] +#' - [hyperSpec::raster_fit()] +#' +#' +#' @param ... arguments to [hyperSpec::raster_make()] and +#' [hyperSpec::raster_fit()]. +#' +#' @include raster.R +#' @export +makeraster <- function(...) { + hySpc_deprecated("raster_make") + raster_make(...) +} + +#' @rdname DEPRECATED-raster +#' @export +fitraster <- function(...) { + hySpc_deprecated("raster_fit") + raster_fit(...) +} + + +# Unit tests ----------------------------------------------------------------- + +hySpc.testthat::test(makeraster) <- function() { + context("Deprecated functions") + + test_that("makeraster() and fitraster() are deprecated", { + expect_error(expect_warning(makeraster(), "deprecated")) + expect_error(expect_warning(fitraster(), "deprecated")) + + x <- c(sample(1:20, 10), (0:5) + 0.5) + expect_warning(makeraster(x, x[1], 2), "deprecated") + expect_warning(fitraster(x), "deprecated") + }) +} From 9e87f5d230b379ed056ed86186bb4a2606d691f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 22:57:08 +0200 Subject: [PATCH 5/7] Update DESCRIPTION --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0eed5b21..d56d2d17 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -100,6 +100,8 @@ Collate: 'DEPRECATED-isample.R' 'cov_pooled.R' 'DEPRECATED-pooled.cov.R' + 'raster.R' + 'DEPRECATED-raster.R' 'DEPRECATED-read.ENVI.R' 'DEPRECATED-read.ENVI.HySpex.R' 'DEPRECATED-read.ENVI.Nicolet.R' @@ -189,7 +191,6 @@ Collate: 'plot_mat.R' 'plot_voronoi.R' 'quantile.R' - 'raster.R' 'rbind.fill.R' 'read_txt_long.R' 'read_txt_wide.R' From 1a77c1a4e121296f9e736dab3f5bfc62049e4939 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 22:59:44 +0200 Subject: [PATCH 6/7] Update NEWS.md #47 --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 32eea965..f9309f6b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -30,10 +30,12 @@ `.fix_spc_colnames()` | `.spc_fix_colnames()` | cbeleites/hyperSpec#208, cbeleites/hyperSpec#301 `alois.palette()` | `palette_alois()` | cbeleites/hyperSpec#208, cbeleites/hyperSpec#299, @sangttruong `chk.hy()` | `assert_hyperSpec()` | #34 + `fitraster()` | `raster_fit()` | #47 `guess.wavelength()` | `extract_numbers()` | cbeleites/hyperSpec#208, cbeleites/hyperSpec#309 `hy.getOption()` | `hy_get_option()` | #21 `hy.getOptions()` | `hy_get_options()` | #21 `hy.setOptions()` | `hy_set_options()` | #21 + `makeraster()` | `raster_make()` | #47 `matlab.dark.palette()` | `palette_matlab_dark()` | cbeleites/hyperSpec#299, cbeleites/hyperSpec#299, @sangttruong `matlab.palette()` | `palette_matlab()` | cbeleites/hyperSpec#208, cbeleites/hyperSpec#299, @sangttruong `mergeextra()` | `merge_data()` | cbeleites/hyperSpec#208, cbeleites/hyperSpec#302 From f53dd1ff06cf955993cde387e3fd9945f4808309 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vilmantas=20G=C4=97g=C5=BEna?= Date: Tue, 14 Dec 2021 23:00:02 +0200 Subject: [PATCH 7/7] Fix deprecated documentation --- R/DEPRECATED-pooled.cov.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/DEPRECATED-pooled.cov.R b/R/DEPRECATED-pooled.cov.R index 955ee8db..d4b9afff 100644 --- a/R/DEPRECATED-pooled.cov.R +++ b/R/DEPRECATED-pooled.cov.R @@ -1,4 +1,4 @@ -#' @name DEPRECATED-fun +#' @name DEPRECATED-pooled.cov #' @concept deprecated #' #' @title (DEPRECATED) @@ -9,7 +9,9 @@ #' more. You should not use these. #' Currently they are present due to back-compatibility reasons and will be #' removed in the next release of the package. -#' Please, use the suggested alternative functions instead. +#' Please, use the suggested alternative functions instead: +#' +#' - [hyperSpec::cov_pooled()] #' #' #' @param ... arguments to [hyperSpec::cov_pooled()]