Skip to content

Commit 5ae6b91

Browse files
mcolmcol
authored
Merge pull request #598 from R-Lum/issue_597
Tighten the outlier threshold in calc_FadingCorr() [skip ci]
2 parents 726bc65 + 3c99950 commit 5ae6b91

File tree

5 files changed

+174
-3
lines changed

5 files changed

+174
-3
lines changed

‎NEWS.Rmd

+9
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,15 @@ the minimum device size from 18 to 16 inches (#593).
4444
* The function crashed if the number of depths provided exceeded that of the
4545
densities and the latter contained more than one value (#595).
4646

47+
### `calc_FadingCorr()`
48+
49+
* The function sporadically returned an unplausibly large error estimate if
50+
any of the Monte Carlo simulations produced an outlier solution (#597).
51+
52+
* The function now allocates only as much memory as required if the user
53+
specifies a value for `n.MC` other than `"auto"`, which brings a small
54+
speed-up if fewer than 10 million samples are requested.
55+
4756
### `calc_FastRatio()`
4857

4958
* The function crashed if the input was an RLum.Analysis object (#586).

‎NEWS.md

+10
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,16 @@
4343
- The function crashed if the number of depths provided exceeded that of
4444
the densities and the latter contained more than one value (#595).
4545

46+
### `calc_FadingCorr()`
47+
48+
- The function sporadically returned an unplausibly large error estimate
49+
if any of the Monte Carlo simulations produced an outlier solution
50+
(#597).
51+
52+
- The function now allocates only as much memory as required if the user
53+
specifies a value for `n.MC` other than `"auto"`, which brings a small
54+
speed-up if fewer than 10 million samples are requested.
55+
4656
### `calc_FastRatio()`
4757

4858
- The function crashed if the input was an RLum.Analysis object (#586).

‎R/calc_FadingCorr.R

+6-3
Original file line numberDiff line numberDiff line change
@@ -300,12 +300,12 @@ calc_FadingCorr <- function(
300300
# Start loop ---------------------------------------------------------------------------------
301301

302302
##set object and preallocate memory
303-
tempMC <- vector("numeric", length = 1e+07)
303+
tempMC <- vector("numeric", length = if (n.MC == "auto") 1e+07 else n.MC)
304304
tempMC[] <- NA
305305
i <- 1
306306
j <- n.MC.i
307307

308-
while(length(unique(tempMC.sd.count))>1 | j > 1e+07){
308+
while (length(unique(tempMC.sd.count)) > 1 || j > length(tempMC)) {
309309

310310
##set previous
311311
if(!is.na(tempMC.sd.recent)){
@@ -337,7 +337,7 @@ calc_FadingCorr <- function(
337337
##otherwise the automatic error value finding
338338
##will never work
339339
res <- NA
340-
if(!is(temp,"try-error") && temp$root<1e8) {
340+
if (!is(temp,"try-error") && temp$root < 1e8) {
341341
res <- temp$root
342342
}
343343
return(res)
@@ -380,6 +380,9 @@ calc_FadingCorr <- function(
380380
##remove all NA values from tempMC
381381
tempMC <- tempMC[!is.na(tempMC)]
382382

383+
## discard wild outliers, as they will bias the error if present
384+
tempMC <- tempMC[tempMC < 100 * IQR(tempMC)]
385+
383386
##obtain corrected age
384387
age.corr <- data.frame(
385388
AGE = round(temp$root, digits = 4),

‎tests/testthat/_snaps/calc_FadingCorr.md

+142
Original file line numberDiff line numberDiff line change
@@ -282,3 +282,145 @@
282282
}
283283
}
284284

285+
---
286+
287+
{
288+
"type": "S4",
289+
"attributes": {
290+
"data": {
291+
"type": "list",
292+
"attributes": {
293+
"names": {
294+
"type": "character",
295+
"attributes": {},
296+
"value": ["age.corr", "age.corr.MC"]
297+
}
298+
},
299+
"value": [
300+
{
301+
"type": "list",
302+
"attributes": {
303+
"names": {
304+
"type": "character",
305+
"attributes": {},
306+
"value": ["AGE", "AGE.ERROR", "AGE_FADED", "AGE_FADED.ERROR", "G_VALUE", "G_VALUE.ERROR", "KAPPA", "KAPPA.ERROR", "TC", "TC.G_VALUE", "n.MC", "OBSERVATIONS", "SEED"]
307+
},
308+
"class": {
309+
"type": "character",
310+
"attributes": {},
311+
"value": ["data.frame"]
312+
},
313+
"row.names": {
314+
"type": "integer",
315+
"attributes": {},
316+
"value": [1]
317+
}
318+
},
319+
"value": [
320+
{
321+
"type": "double",
322+
"attributes": {},
323+
"value": [1.3382]
324+
},
325+
{
326+
"type": "double",
327+
"attributes": {},
328+
"value": [5.4639]
329+
},
330+
{
331+
"type": "double",
332+
"attributes": {},
333+
"value": [1]
334+
},
335+
{
336+
"type": "double",
337+
"attributes": {},
338+
"value": [6]
339+
},
340+
{
341+
"type": "double",
342+
"attributes": {},
343+
"value": [5.47792719]
344+
},
345+
{
346+
"type": "double",
347+
"attributes": {},
348+
"value": [0.70551392]
349+
},
350+
{
351+
"type": "double",
352+
"attributes": {},
353+
"value": [0.02379034]
354+
},
355+
{
356+
"type": "double",
357+
"attributes": {},
358+
"value": [0.00306401]
359+
},
360+
{
361+
"type": "double",
362+
"attributes": {},
363+
"value": [0.00001198]
364+
},
365+
{
366+
"type": "double",
367+
"attributes": {},
368+
"value": [5.47581401e-06]
369+
},
370+
{
371+
"type": "double",
372+
"attributes": {},
373+
"value": [1000]
374+
},
375+
{
376+
"type": "integer",
377+
"attributes": {},
378+
"value": [585]
379+
},
380+
{
381+
"type": "double",
382+
"attributes": {},
383+
"value": [11]
384+
}
385+
]
386+
},
387+
{
388+
"type": "double",
389+
"attributes": {},
390+
"value": [4.75643726, 4.65718725, 6.9647454, 8.02327331, 2.34135678, 23.57480211, 6.70231207, 11.65197143, 7.03308894, 5.32416198, 9.14539155, 2.12696543, 19.18961061, 0.25394477, 2.23531167, 1.25633366, 0.79250982, 6.15258562, 20.71387146, 2.69144136, 7.41833182, 4.24079197, 2.65257361, 3.50274545, 1.67720265, 12.33109335, 14.90056831, 6.821073, 0.19213184, 1.78988519, 5.12723854, 2.84423404, 1.84396483, 3.54646016, 12.09820692, 8.52528959, 13.19718126, 27.75699651, 15.28120125, 6.82904872, 0.14129142, 6.00046537, 8.82357555, 11.84847977, 12.87505016, 2.59085728, 0.8031953, 7.32840377, 6.10090906, 0.93054929, 3.06594813, 10.5558045, 20.21396415, 1.04749076, 0.35240632, 3.61411597, 6.7770515, 13.0539188, 3.90560798, 4.78414205, 7.27311258, 3.133312, 1.41065367, 5.56711893, 3.48257293, 1.0170773, 7.69072743, 14.6374508, 11.5379669, 4.37918258, 23.27588051, 12.66985313, 5.92918185, 7.85171586, 5.4200696, 6.0554618, 6.61566981, 7.21974847, 5.11535126, 15.54629298, 3.14585139, 8.27499154, 1.99596256, 5.73605014, 11.93732421, 8.32621002, 13.02432488, 0.63649563, 7.66441731, 0.17094736, 25.6655326, 6.70188324, 1.75757961, 4.74697633, 0.15961598, 14.73009415, 3.81602833, 8.62078634, 9.54004195, 5.91395815, 1.00052272, 4.65256742, 11.07674069, 8.44679446, 4.39738387, 5.27672381, 11.96751894, 9.44269252, 9.70414113, 4.4716865, 0.2048417, 4.07898026, 13.58371539, 2.65466722, 0.09803816, 29.16676643, 1.71275274, 11.15111662, 1.30241361, 5.82577591, 9.84791421, 22.19560957, 4.89064931, 4.8425933, 0.66794466, 2.42576073, 10.40620699, 2.21012046, 5.71290549, 5.97747546, 15.04713764, 13.92410253, 16.83947614, 4.17463255, 2.62972243, 2.53128476, 1.62639724, 22.2983533, 10.43658917, 2.78272759, 11.14155356, 0.51924006, 6.94842845, 10.25576575, 8.98224869, 10.19652859, 22.7423511, 12.23326133, 1.95727655, 4.8925744, 1.82704522, 3.41607854, 16.74776412, 4.91147484, 1.51332667, 4.28081305, 4.55606061, 14.52538043, 12.39049903, 3.27492545, 16.92019306, 4.83368566, 13.09930222, 22.45646241, 5.15274947, 23.45792175, 6.08912943, 4.01865346, 4.29196263, 0.67728217, 1.64019904, 0.14301667, 5.0270826, 4.16679326, 2.37757744, 1.87381685, 0.36515995, 5.88213422, 1.2279858, 7.28158463, 7.88156695, 22.2846776, 1.97672297, 9.54387295, 4.88672503, 4.22039623, 2.51619348, 8.69241001, 3.82081529, 4.92460185, 7.36129099, 4.68546313, 10.31467267, 1.61362598, 7.72173969, 15.61468084, 5.22218977, 0.30338717, 3.34238845, 9.90914833, 8.82785521, 3.32212542, 10.11869589, 2.08545263, 2.45004196, 3.87194961, 2.06069094, 13.43155782, 6.80513408, 13.20352788, 4.17616538, 0.03398763, 1.66429352, 9.0697084, 6.76683989, 5.19142726, 11.71000107, 7.79337059, 1.69609131, 15.5608457, 7.32200889, 4.61311646, 6.40825669, 3.2837366, 6.00591416, 0.70086008, 17.15363523, 6.84712923, 15.72944657, 13.6093225, 13.17433069, 5.47016463, 9.34702998, 2.53234133, 11.23608053, 9.96771232, 1.58342358, 7.7209567, 0.1941767, 3.0649981, 8.69190183, 7.91651593, 5.40484452, 5.96767116, 1.05716308, 7.65760649, 0.3493716, 10.13455212, 21.98031451, 2.04877003, 14.41123776, 6.55273472, 0.63248097, 8.00570955, 3.21350399, 4.34778145, 3.12818348, 0.94259334, 2.35128052, 17.27651297, 5.46751562, 7.86347966, 7.57279399, 0.07119138, 2.85374604, 8.07572097, 10.26617185, 2.50897444, 5.72958701, 10.56600694, 6.40137795, 11.33434911, 5.03468949, 2.21983752, 3.40182608, 1.68544433, 12.42293101, 12.97238104, 4.75377116, 2.73499698, 1.18557282, 0.4457696, 0.49714165, 14.36227519, 5.00320054, 20.64996724, 5.53090925, 5.05805789, 11.90867883, 7.99807507, 3.91527519, 4.39685399, 17.84802687, 10.64103668, 11.76144157, 12.66119777, 1.36411618, 6.70617215, 8.68592246, 3.01540794, 10.02384411, 18.75638215, 9.08773407, 4.52619689, 0.44761491, 7.05773042, 0.61785906, 7.06907378, 6.51547208, 19.50718672, 11.22753682, 8.29730107, 6.4838077, 7.16577815, 0.56595822, 1.32098579, 6.61136756, 4.45116386, 4.39149124, 4.55836283, 13.56572776, 7.76505129, 5.92589755, 14.52309942, 5.67162516, 20.36058968, 1.45064713, 1.44539822, 0.3597053, 8.54392242, 13.18206512, 25.57598594, 9.06222609, 1.08896176, 9.63220911, 2.33868243, 3.51326924, 13.96898633, 16.03500694, 2.34119811, 6.25099846, 10.71122117, 14.2375497, 1.26516094, 6.10257459, 5.81599491, 2.94074845, 12.68008139, 8.93439682, 3.08548439, 1.49435017, 0.79598993, 0.35036933, 12.80365823, 7.5557557, 12.52931836, 3.18265777, 2.46418832, 10.71318009, 20.76476929, 4.66584983, 6.04989341, 1.1465397, 9.84374967, 9.25284599, 7.37704219, 4.42339933, 12.08826431, 0.26121762, 11.54485451, 1.78083221, 11.41524676, 1.37205942, 2.2459167, 0.36164406, 0.09819227, 8.78699707, 6.42216724, 0.60316163, 16.16632448, 2.79070498, 6.9363138, 3.4771919, 1.15342348, 3.83234232, 0.7655679, 9.43719687, 11.31056112, 3.75321865, 15.05807092, 7.04453951, 6.09183217, 9.14531931, 2.9185972, 4.69228119, 20.20400584, 7.19792934, 3.80664703, 1.50429872, 11.77601683, 6.7263558, 9.15637424, 12.96014852, 19.53689257, 0.4974004, 12.8617575, 12.19697939, 6.14654654, 3.00079274, 2.24272562, 3.07484468, 7.62672369, 9.68719318, 7.19634358, 1.12229572, 11.83318289, 11.57838972, 8.3320917, 3.41081483, 1.92088388, 4.55565153, 0.83040103, 2.66541896, 4.50530833, 18.87237702, 1.37883236, 5.13034295, 10.50397907, 14.15361604, 9.11795813, 2.74033489, 11.04943552, 11.63420686, 1.43857504, 9.74613434, 16.54258055, 4.88594677, 22.79279703, 4.22514255, 4.70136524, 3.22115086, 4.05517099, 2.67324127, 7.02728491, 0.77609534, 2.44552153, 4.15212635, 7.59194618, 2.28680104, 4.65441732, 2.2196729, 7.49778549, 23.65028275, 3.68575377, 3.92722208, 7.29632526, 1.571589, 9.60578144, 5.6687765, 8.46730752, 4.77441419, 10.01130275, 4.5681493, 7.32842447, 14.1596956, 1.62074789, 3.21222125, 0.75828245, 10.12316179, 14.53728615, 8.02576204, 2.40175189, 6.81975034, 0.90160708, 10.48318506, 12.02175925, 9.8568179, 7.90771073, 1.1800374, 16.54364531, 2.49722508, 7.80136275, 6.65653607, 5.90029511, 6.31466631, 2.7646461, 2.41187253, 3.1141049, 0.11050794, 8.15917806, 13.98864806, 9.87458913, 4.85619353, 7.47548484, 11.78290686, 10.93366711, 1.64754874, 3.12732511, 16.00493906, 11.11998169, 12.05128933, 5.7602535, 4.5392395, 3.78861154, 18.94786942, 7.28593907, 12.17735258, 8.00843877, 3.82270364, 5.03764491, 1.69687901, 5.53804723, 0.88524402, 1.40975898, 5.89814913, 6.25549724, 6.85763754, 4.07348433, 3.4338016, 10.49172701, 3.65628841, 2.6636845, 9.26179951, 2.90569208, 9.55319698, 1.7855019, 2.20290427, 1.67448174, 0.96642627, 1.64455022, 6.0913027, 17.27558675, 0.72653646, 0.85090138, 14.12355998, 4.3905976, 4.87235478, 6.22168148, 6.92326008, 1.00250436, 17.24066483, 3.91032475, 0.96012191, 11.25058549, 9.18429703, 1.57949092, 2.92729354, 12.27394379, 7.93537998, 14.39296864, 15.16543005, 13.95529714, 5.2555147, 6.64468488, 9.82332977, 17.49418089, 1.85168918, 13.85587833, 1.83496106, 6.13717451, 11.44188309, 10.21496334, 1.82680945, 0.01509283, 16.35974873, 7.02203213, 10.32295972, 12.64716172, 1.14892677, 10.61045707, 7.50300593, 2.51954124, 8.26267724, 2.56852764, 10.37285975, 8.84632724, 7.51818284, 11.16619606, 0.30071331, 10.39501395, 6.47318471, 2.44963985, 1.2757242, 7.5520862, 13.39022467]
391+
}
392+
]
393+
},
394+
"originator": {
395+
"type": "character",
396+
"attributes": {},
397+
"value": ["calc_FadingCorr"]
398+
},
399+
"info": {
400+
"type": "list",
401+
"attributes": {
402+
"names": {
403+
"type": "character",
404+
"attributes": {},
405+
"value": []
406+
}
407+
},
408+
"value": []
409+
},
410+
".uid": {
411+
"type": "character",
412+
"attributes": {},
413+
"value": [null]
414+
},
415+
".pid": {
416+
"type": "character",
417+
"attributes": {},
418+
"value": [null]
419+
}
420+
},
421+
"value": {
422+
"class": "RLum.Results",
423+
"package": "Luminescence"
424+
}
425+
}
426+

‎tests/testthat/test_calc_FadingCorr.R

+7
Original file line numberDiff line numberDiff line change
@@ -123,4 +123,11 @@ test_that("snapshot tests", {
123123
tc.g_value = 172800,
124124
n.MC = 20, verbose = FALSE),
125125
tolerance = snapshot.tolerance)
126+
127+
expect_snapshot_RLum(calc_FadingCorr(
128+
age.faded = c(1, 6),
129+
g_value = c(5.37778156709913, 0.70382588155986),
130+
tc = 378000, tc.g_value = 172800,
131+
n.MC = 1000, seed = 11, verbose = FALSE),
132+
tolerance = snapshot.tolerance)
126133
})

0 commit comments

Comments
 (0)