Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Feature 38/rename functions (47) #74

Merged
merged 7 commits into from
Dec 14, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand Down Expand Up @@ -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'
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 4 additions & 2 deletions R/DEPRECATED-pooled.cov.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' @name DEPRECATED-fun
#' @name DEPRECATED-pooled.cov
#' @concept deprecated
#'
#' @title (DEPRECATED)
Expand All @@ -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()]
Expand Down
49 changes: 49 additions & 0 deletions R/DEPRECATED-raster.R
Original file line number Diff line number Diff line change
@@ -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")
})
}
73 changes: 40 additions & 33 deletions R/raster.R
Original file line number Diff line number Diff line change
@@ -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")
Expand All @@ -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)
Expand All @@ -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

Expand All @@ -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")
Expand All @@ -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")
Expand All @@ -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) {
Expand All @@ -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)
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions vignettes/plotting.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down