R Under development (unstable) (2025-09-01 r88761 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 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)
> data(feems)
> 
> cube <- feemscale(feemscatter(cube, rep(24, 4), 'pchip'), na.rm = TRUE)
================================================================================
> 
> # must make sense for only one number of factors / one split
> (sh <- feemsplithalf(cube, 2, random = 1, ctol = 1e-4))
================================================================================
Split-half: minimal TCC between matching components
        2 
0.8860239 
> stopifnot(inherits(sh, 'feemsplithalf'))
> 
> # must handle non-even numbers of samples
> (sh <- feemsplithalf(cube[,,1:11], 2, splits = 4, ctol = 1e-4))
================================================================================
Split-half: minimal TCC between matching components
       2 
0.775655 
> # feemsplithalf(splits=s) makes choose(s, s/2) halves then combines them
> # resulting in choose(s, s/2)/2 comparisons
> stopifnot(dim(sh$factors)[3] == choose(4, 2)/2)
> # must be able to limit the number of comparisons
> (sh <- feemsplithalf(cube, 2, splits = c(10, 5), ctol = 1e-4))
================================================================================
Split-half: minimal TCC between matching components
        2 
0.8884387 
> stopifnot(dim(sh$factors)[3] == 5)
> 
> # must not compare splits containing same samples
> for (pair in coef(sh)$subset)
+ 	stopifnot(length(intersect(pair[[1]], pair[[2]])) == 0)
> 
> # must handle progress argument
> (sh <- feemsplithalf(cube, 2, random = 1, progress = FALSE, ctol = 1e-4))
Split-half: minimal TCC between matching components
        2 
0.9871049 
> 
> # must work correctly when there's only one pair of splits
> coef(feemsplithalf(cube, 2, splits = 2, ctol = 1e-4))
================================================================================
  factor       tcc test       subset nfac
1      1 0.8590514    1 c(1, 3, ....    2
2      2 0.9875074    1 c(1, 3, ....    2
> 
> # must work with groups of length() == splits
> groups <- c(rep(1, 4), rep(2, 8))
> for (pair in coef(feemsplithalf(
+ 	cube, 2, splits = 4, groups = groups, ctol = 1e-4
+ ))$splits) stopifnot(
+ 	# NB: for odd numbers of samples results are less strict but close
+ 	table(groups[pair[[1]]]) * 2 == table(groups),
+ 	table(groups[pair[[2]]]) * 2 == table(groups)
+ )
================================================================================
> 
> # must be able to create halves from a group of length() == 2
> groups <- c(rep(1, 2), rep(2, 10))
> for (pair in coef(feemsplithalf(
+ 	cube, 2, random = 3, groups = groups, ctol = 1e-4
+ ))$splits) stopifnot(
+ 	table(groups[pair[[1]]]) * 2 == table(groups),
+ 	table(groups[pair[[2]]]) * 2 == table(groups)
+ )
================================================================================
> 
> # must understand lists of factors
> groups1 <- list(
+ 	c(rep(1, 8), rep(2, 4)),
+ 	c(rep(1, 4), rep(2, 8))
+ )
> groups2 <- c(rep(1, 4), rep(2, 4), rep(3, 4))
> for (pair in coef(feemsplithalf(
+ 	cube, 2, splits = 2, groups = groups1, ctol = 1e-4
+ ))$splits) stopifnot(
+ 	table(groups2[pair[[1]]]) * 2 == table(groups2),
+ 	table(groups2[pair[[2]]]) * 2 == table(groups2)
+ )
================================================================================
> 
> # must return the correct columns
> stopifnot(colnames(coef(sh, 'tcc')) == c(
+ 	'factor', 'tcc', 'test', 'subset', 'nfac'
+ ))
> stopifnot(colnames(coef(sh, 'factors')) == c(
+ 	'wavelength', 'value', 'factor', 'mode',
+ 	'nfac', 'test', 'half', 'subset'
+ ))
> 
> # #fac, #test, Nfac must identify a point in df of TCCs
> stopifnot(1 == aggregate(
+ 	tcc ~ factor + nfac + test, coef(sh, 'tcc'),
+ 	FUN = length
+ )$tcc)
> 
> # wavelength + #fac + mode + Nfac + #test + #half must identify point
> stopifnot(1 == aggregate(
+ 	value ~ wavelength + factor + mode + nfac + test + half,
+ 	coef(sh, 'factors'),
+ 	FUN = length
+ )$value)
> 
> fixed <- list(list(
+ 	1:(round(dim(cube)[3]/2)),
+ 	(round(dim(cube)[3]/2)+1):dim(cube)[3]
+ ))
> sh <- feemsplithalf(cube, 1, fixed = fixed, ctol = 1e-4)
================================================================================
> # NOTE: testing one-factor model so that coef(sh) will have as many rows
> # as elements in `fixed`
> # NOTE: unclass() removes the "AsIs" class from the data.frame column
> stopifnot(all.equal(fixed, unclass(coef(sh)$subset)))
> # testing intersecting splits is an error
> fixed[[1]][[2]][1] <- fixed[[1]][[1]][1]
> assertError(feemsplithalf(cube, 2, fixed = fixed), verbose = TRUE)
Asserted error: Both halves in fixed[[1]] contain the following samples: 1
> # providing groups at the same time as fixed splits, or asking for
> # split-combine or random splits, is an error
> assertError(
+ 	feemsplithalf(cube, 2, fixed = fixed, groups = groups), verbose = TRUE
+ )
Asserted error: Please either request split-combine or random halves (optionally stratified by groups), or provide fixed halves.
> assertError(
+ 	feemsplithalf(cube, 2, fixed = fixed, splits = 2), verbose = TRUE
+ )
Asserted error: Please either request split-combine or random halves (optionally stratified by groups), or provide fixed halves.
> assertError(
+ 	feemsplithalf(cube, 2, fixed = fixed, random = 2), verbose = TRUE
+ )
Asserted error: Please either request split-combine or random halves (optionally stratified by groups), or provide fixed halves.
> # asking for both split-combine and random halves is an error
> assertError(feemsplithalf(cube, 2, splits = 2, random = 2), verbose = TRUE)
Asserted error: Please either request split-combine or random halves (optionally stratified by groups), or provide fixed halves.
> 
> stopifnot(all.equal(cube, feemcube(sh)))
> 
> # exercise some plot types not used otherwise
> plot(sh, 'factors')
> # "subset" takes some care to forward NSE bits properly
> plot(sh, 'bandfactors', subset = nfac == 1 & mode == 'Emission')
> 
> # Parallel `bootparafac` is a whole separate thing now
> library(parallel)
> cl <- makeCluster(2)
> sh <- feemsplithalf(cube, 2, random = 2, parallel = TRUE, cl = cl, ctol = 1e-4)
================================================================================
> stopCluster(cl)
> head(coef(sh, 'aggtcc'))
  nfac test       tcc
1    2    1 0.8618690
2    2    2 0.8613786
> head(coef(sh, 'bandfactors'))
  wavelength factor     mode nfac         lower   estimate      upper
1   240.0000      1 Emission    2  8.267044e-03 0.03320129 0.07924183
2   246.2903      1 Emission    2  0.000000e+00 0.06430798 0.14304398
3   252.5806      1 Emission    2  0.000000e+00 0.04187208 0.10226771
4   258.8710      1 Emission    2 -2.038854e-17 0.12917125 0.38764832
5   265.1613      1 Emission    2  0.000000e+00 0.18376690 0.51836156
6   271.4516      1 Emission    2  1.653125e-18 0.24623427 0.64452200
> plot(sh, 'aggtcc')
> stopifnot(is.environment(attr(sh$factors[[1]], 'envir')))
> 
> # must avoid warnings when `nfac` is named
> sh <- feemsplithalf(cube, setNames(nm = 1), random = 2, ctol = 1e-4)
================================================================================
> withCallingHandlers(
+ 	coef(sh, 'agg'),
+ 	warning = function(e) stop(conditionMessage(e))
+ )
  nfac test       tcc
1    1    1 0.9940164
2    1    2 0.9798000
> 
> proc.time()
   user  system elapsed 
  17.17    0.54   18.96