R Under development (unstable) (2024-05-06 r86526 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(albatross)
> library(tools)
> 
> # .integ must work about as well as linear interpolation
> data(feems)
> x <- albatross:::.extract(
+ 	feems$a, c(290, 310), 254, TRUE, c(1,1), FALSE
+ )
> (trapz <- albatross:::.integ(x))
[1] 75.94969
> with(
+ 	integrate(
+ 		approxfun(attr(x, 'emission'), as.vector(x)),
+ 		min(attr(x, 'emission')), max(attr(x, 'emission'))
+ 	),
+ 	if (abs(trapz - value) >= abs.error) stop(paste(
+ 		'Trapezoid value', trapz, '- approxfun value', value,
+ 		'=', trapz - value, '|>=| error estimate', abs.error
+ 	))
+ )
> (ztrap <- albatross:::.integ(x[nrow(x):1,, drop = FALSE]))
[1] 75.94969
> # .integ must handle unsorted data
> stopifnot(all.equal(trapz, ztrap))
> 
> # exact wavelength extraction
> x <- feem(matrix(1:4, 2), c(300, 450), c(310, 320))
> # - must return NAs for points out of range
> (y <- albatross:::.extract(x, c(380, 430), 310, FALSE, c(60, 60), FALSE))
        excitation
emission 310
    <NA>  NA
    450    2
attr(,"emission")
[1]  NA 450
attr(,"excitation")
[1] 310
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(any(is.na(y)))
> # - if multiple points match due to tolerance being too high...
> assertWarning(
+ 	y <- albatross:::.extract(x, c(380, 430), 310, FALSE, c(70, 70), FALSE),
+ 	verbose = TRUE
+ )
Asserted warning: The same grid wavelength matches as closest to different wavelengths I need. Please decrease emission tolerance to at most 25 and enable interpolation.
> (y) # => must warn and set them to NA anyway
        excitation
emission 310
    450    2
    <NA>  NA
attr(,"emission")
[1] 450  NA
attr(,"excitation")
[1] 310
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(any(is.na(y)))
> # - must be able to interpolate if requested
> (y <- albatross:::.extract(x, c(380, 430), 310, FALSE, c(2, 2), 'whittaker', d = 1, lambda = 1e-3))
        excitation
emission      310
     380 2.678443
     430 2.847651
attr(,"emission")
[1] 380 430
attr(,"excitation")
[1] 310
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(!is.na(y))
> # - but not if it's out of range
> (y <- albatross:::.extract(x, 290, 310, FALSE, c(2, 2), 'whittaker', d = 1, lambda = 1e-3))
        excitation
emission 310
    <NA>  NA
attr(,"emission")
[1] NA
attr(,"excitation")
[1] 310
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(is.na(y))
> # - must interpolate NAs present in the spectrum if enabled
> xx <- replace(x, matrix(c(1,1), 1), NA)
> (y <- albatross:::.extract(x, 300, 310, FALSE, c(2, 2), 'whittaker', d = 1, lambda = 1e-3))
        excitation
emission 310
     300   1
attr(,"emission")
[1] 300
attr(,"excitation")
[1] 310
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(!is.na(y))
> 
> # range extraction
> x <- feem(matrix(1:12, 4), seq(300, 330, len = 4), seq(270, 360, len = 3))
> # - no duplicates even if border touches grid points
> (y <- albatross:::.extract(x, c(309, 321), c(314, 316), TRUE, c(2, 2), FALSE))
        excitation
emission 315
     310   6
     320   7
attr(,"emission")
[1] 310 320
attr(,"excitation")
[1] 315
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(!anyDuplicated(attr(y, 'emission')), !anyDuplicated(attr(y, 'excitation')))
> # - must be able to interpolate whole ranges
> (y <- albatross:::.extract(x, c(305, 325), c(300, 350), TRUE, c(2, 2), 'whittaker'))
        excitation
emission      300      315       350
     305 4.411349 5.501050  8.870340
     310 4.822061 6.000000  9.302307
     320 5.668598 7.000000 10.192430
     325 6.079310 7.499101 10.624397
attr(,"emission")
[1] 305 310 320 325
attr(,"excitation")
[1] 300 315 350
attr(,"scale")
[1] 1
attr(,"class")
[1] "feem"
> stopifnot(!is.na(y))
> 
> proc.time()
   user  system elapsed 
   1.51    0.17    1.67