test_that("robScale computes correctly", { tol <- sqrt(.Machine$double.eps) y <- c(9, 2, 14, 4) expect_equal(robScale(y), 5.8798343299206977, tolerance = tol) # For n < 4 robScale returns MAD (using precise constant 1.482602...) # which differs slightly from R's mad() that uses rounded 1.4826 expect_equal(robScale(y[1:3]), mad(y[1:3]), tolerance = 1e-4) }) test_that("robScale handles implosion and fallback", { tol <- sqrt(.Machine$double.eps) expect_equal(robScale(c(0.00001, 0, 4)), adm(c(0.00001, 0, 4)), tolerance = tol) expect_equal(robScale(c(1e-4, 0, 0, 4)), 0.000101530115510382, tolerance = 1e-7) }) test_that("robScale handles known location", { tol <- sqrt(.Machine$double.eps) y <- c(9, 2, 14, 4) robScaleLocTest <- function(x, loc) { x <- x - loc s <- 1.4826 * median(abs(x)) converged <- FALSE k <- 0 while (!converged && k < 80) { k <- k + 1 v <- sqrt(2 * mean((2 * plogis(x / (s * 0.37394112142347236)) - 1)^2)) converged <- abs(v - 1) <= sqrt(.Machine$double.eps) s <- s * v } s } expect_equal(robScale(y, loc = 7), robScaleLocTest(y, loc = 7), tolerance = 2 * tol) }) test_that("robScale handles NAs and edge cases", { expect_error(robScale(c(1, 2, NA)), "There are NAs in the data yet na.rm is FALSE") expect_true(is.na(robScale(numeric(0)))) expect_equal(robScale(5), 0) expect_equal(robScale(c(5, 5, 5, 5)), 0) }) test_that("robScale: pinning test — 20 random inputs at each n=4..1000", { # Reference values computed from robscale NR production path. # set.seed(2025). Tolerance 2*sqrt(eps). refs <- list( "4" = c(0.39763828751507213, 0.38109129857754848, 0.46974986179895112, 0.91315657827999019, 1.1568257504281014, 0.46063054482158289, 0.79237968616903454, 1.3801765596371454, 0.64158490306235028, 0.67751029874830326, 1.3994706303406073, 1.0405007675493521, 0.34498516001507779, 0.67933293064042355, 0.70839962872240425, 0.11122329888619056, 0.54417788821736557, 0.53518207923277961, 0.95963960395845183, 0.17383407277844434), "5" = c(1.0729888258374478, 1.3425737358257352, 0.96859044485946344, 0.67121850680185036, 0.8478853716608461, 1.1329038995115837, 0.48092301684760957, 0.3623164332929944, 0.47951737601940514, 0.19846706295480032, 0.77634132095313235, 1.3548569466950384, 1.1624954533798384, 0.93755615552740701, 0.22566892717399259, 0.39397029106277981, 0.5125282350202236, 1.2671178544184989, 0.088086170669360683, 1.3602016040310545), "6" = c(0.80832548885331923, 0.25736426950164815, 0.63482108746036969, 0.42915113829364393, 1.3431628068251351, 0.87849920457671538, 0.58367952398483203, 0.18719100030558938, 0.78669547289194974, 1.1665697111894791, 0.3630931184117332, 0.30122120103575117, 0.85260219634353207, 0.91159848004498067, 1.2551641980411092, 0.46750022107986217, 0.90891810542456608, 1.3802784263840784, 0.86785364357225259, 1.0308590195939948), "8" = c(0.83733586731903031, 0.84308587590776141, 1.2500265730855087, 1.1180367114955552, 0.77227906264933488, 0.53147008061133227, 1.0235517634904114, 0.81032778754941404, 0.70943485199288092, 0.91099528326954093, 1.4206186268373799, 0.81167395169911816, 0.57794332960517047, 0.763493708827363, 0.99370706018627486, 0.74913391064559809, 1.033646350417615, 1.1958053968173223, 0.85828641407554151, 0.72126132796354225), "10" = c(1.0090255823354057, 2.2089095046644194, 0.67908211751127134, 0.67132005317108778, 1.2532292135812932, 0.94276913870397461, 1.1111256617631773, 0.56438917633059515, 0.54882737212897559, 0.73309385434470831, 0.80122203262019775, 1.0403547152631105, 0.44391962964891191, 1.567665311536139, 1.249349181786612, 1.0504568180356662, 0.89191295930147474, 0.56934842455431856, 1.0058568367095175, 0.87501714924882945), "15" = c(1.0029572128869477, 1.1698446350494518, 0.79387667746889246, 1.5147555983258558, 0.46059681298915278, 1.0225073035291183, 0.68109770478641574, 0.77447915399099754, 0.47607501147727083, 0.82965230650212662, 0.69397572851224554, 0.85753448411726918, 0.49025960989231898, 1.0882448336774615, 1.0325232294896325, 0.89447837489797433, 0.86880953563621355, 1.285617580871711, 0.82674921518487132, 1.2278315072140162), "20" = c(0.7418973662100945, 1.0154188505520181, 0.91615720846761284, 1.0890578722333986, 0.67552723258026803, 0.8394712909482881, 1.5972375425687999, 0.95569536608649042, 1.1115748076690641, 0.92621683313479553, 0.91560575218447493, 0.37283886692033985, 0.99235293944868119, 0.97847469350045102, 1.0750272525581248, 1.0111237591101545, 1.1682310793116253, 1.497244517495403, 0.95534869930614053, 1.0268368899848455), "25" = c(0.99071923057706102, 0.94096899559026603, 1.2210630210279383, 0.95420499326751596, 1.1942697218080314, 0.87839758464032247, 0.9322387440074682, 1.0368336776321856, 1.1513218782910861, 1.1919233390750743, 0.95454046317085328, 0.86777530485185872, 1.1613080596541612, 0.80632472941352062, 0.86380787894825928, 0.90062777727416143, 0.79039771912508328, 0.75743287535408321, 0.99042478998250705, 0.8147148631672505), "32" = c(0.98684877478139521, 0.88707068467904848, 0.9594240679894559, 1.2230358237085368, 0.76578436169969621, 1.2604723310970776, 0.89908265571747714, 1.0719417772935889, 0.98328722474275077, 1.4065723494029647, 1.1850120553808878, 0.96209739489041457, 0.86308917894040316, 0.9808361763906307, 0.86329105475835088, 0.96634777000186245, 0.9377840897730001, 0.77643089255133779, 1.0655663844995755, 0.92052586683939364), "50" = c(0.77920030187403055, 0.79544282159973323, 0.85203318882829682, 1.0899384061730815, 0.98855784288852289, 0.96206842693023797, 1.0102412176391826, 0.9108326919914328, 1.0357606635761218, 0.97511174653710864, 0.98003271576214257, 0.80580535163458988, 1.0158030818688295, 0.91889294404431954, 1.0670870345712404, 0.91742607254078645, 0.88412128066237161, 0.95144682129912539, 0.86264277396541511, 1.0714665760134772), "64" = c(1.0286745532233901, 0.95571815892865775, 1.0269679537496283, 0.88287585325728046, 1.0176117772637514, 0.89879264774268675, 1.1138483661351333, 0.94573623825061881, 1.1051690321892007, 1.196872793010372, 0.97807697475356581, 1.0526056588864143, 1.1070326424374035, 1.1429928775636704, 0.99651045339864952, 0.91235265956578515, 1.150630819033271, 0.97554010447075767, 0.95272787822040095, 1.1258569377126564), "100" = c(1.0641351941212112, 0.97671845246741207, 0.95071794826668066, 0.951672938247074, 1.1273698390692348, 0.89796117298506806, 1.027361592543981, 0.94499924408058122, 0.81561716982262944, 0.95659203197697051, 0.90876066631261654, 1.0566726259986925, 1.0420588598145, 1.0925107197845494, 0.80003749406091229, 0.95211071788626989, 0.90886467014250216, 1.073086321745756, 1.015242536874619, 0.98321288614625768), "500" = c(0.97956016941096158, 1.0183110423494204, 1.0349208581817513, 0.96508612570042018, 0.9588557248828643, 0.97743180354880932, 1.0013515817754799, 1.0335467204351527, 0.96474347002124972, 0.99338229503271214, 1.0401889532225816, 0.99521226627463222, 1.0026099587201798, 1.0279514216539989, 1.0064230382706825, 0.99573142790632752, 0.98164376707939305, 0.98104083004923115, 1.0804989909276073, 0.99706388633522025), "1000" = c(0.99557130461191101, 1.0109078278523049, 0.96277164314956043, 1.0500583877565766, 0.99155012887647043, 0.9782573049202905, 1.0036070962391832, 0.9656689228716957, 1.002705310416214, 1.0748675730075976, 1.0098936595288259, 1.0729327933088655, 1.0068023750727304, 1.0010510343065155, 0.94764600519944875, 1.0442252226863451, 1.0120879354907033, 0.99713981378664496, 1.0300177781512327, 0.94904046110000928) ) tol <- 2 * sqrt(.Machine$double.eps) set.seed(2025) for (n in as.integer(names(refs))) { for (i in seq_along(refs[[as.character(n)]])) { x <- rnorm(n) expect_equal(robScale(x), refs[[as.character(n)]][i], tolerance = tol, label = paste0("n=", n, " trial=", i)) } } }) test_that("robScale default and explicit fallback='adm' give identical results", { tol <- sqrt(.Machine$double.eps) set.seed(42) x <- rnorm(9) expect_equal(robScale(x), robScale(x, fallback = "adm"), tolerance = tol) expect_equal(robScale(c(5, 5, 5, 5, 6)), robScale(c(5, 5, 5, 5, 6), fallback = "adm"), tolerance = tol) })