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' 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 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()] 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") + }) +} diff --git a/R/raster.R b/R/raster.R index cb0ece11..929a06c0 100644 --- a/R/raster.R +++ b/R/raster.R @@ -1,31 +1,39 @@ #' @title Find an evenly spaced grid for x #' @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 +#' `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 +#' 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) +#' raster <- raster_make(x, x[1], 2) #' raster #' plot(x) #' abline(h = raster$levels, col = "#00000040") @@ -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) { +raster_make <- 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 @@ -65,14 +72,14 @@ makeraster <- function(x, startx, d, newlevels, tol = 0.1) { ) } -#' @rdname makeraster +#' @rdname raster_make #' @export #' #' @concept manipulation #' #' @examples #' -#' raster <- fitraster(x) +#' raster <- raster_fit(x) #' raster #' plot(x) #' abline(h = raster$levels, col = "#00000040") @@ -81,12 +88,12 @@ 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) #' #' 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") @@ -95,10 +102,10 @@ 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) { +raster_fit <- function(x, tol = 0.1) { levels <- sort(unique(x)) if (length(levels) == 1L) { @@ -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") - raster <- makeraster(x, startx, d, tol = tol) + # cat ("fit: ", c (startx, d), "\n") + raster <- raster_make(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 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)