Skip to content

Commit 25968f7

Browse files
authored
Merge pull request #560 from LucSteinbuch/new_crosstalk_detection
New: functions underlaying paper "A novel tool to access crosstalk in luminescence detection" Anna-Maartje de Boer, Luc Steinbuch Thanks @LucSteinbuch for this valuable contribution and all the effort you have undertaken to implement it. @mcol For aligning the code with the package structure and the review. I will make a few additional changes after the merge, but they are all of technical nature only.
2 parents 1dd804c + 9b6e678 commit 25968f7

20 files changed

+2641
-2
lines changed

NAMESPACE

+5
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,7 @@ export(analyse_baSAR)
9494
export(analyse_pIRIRSequence)
9595
export(analyse_portableOSL)
9696
export(apply_CosmicRayRemoval)
97+
export(apply_Crosstalk)
9798
export(apply_EfficiencyCorrection)
9899
export(bin)
99100
export(bin_RLum.Data)
@@ -114,6 +115,7 @@ export(calc_IEU)
114115
export(calc_Lamothe2003)
115116
export(calc_MaxDose)
116117
export(calc_MinDose)
118+
export(calc_MoransI)
117119
export(calc_OSLLxTxDecomposed)
118120
export(calc_OSLLxTxRatio)
119121
export(calc_SourceDoseRate)
@@ -184,6 +186,7 @@ export(plot_FilterCombinations)
184186
export(plot_GrowthCurve)
185187
export(plot_Histogram)
186188
export(plot_KDE)
189+
export(plot_MoranScatterplot)
187190
export(plot_NRt)
188191
export(plot_OSLAgeSummary)
189192
export(plot_RLum)
@@ -195,6 +198,7 @@ export(plot_RLum.Results)
195198
export(plot_ROI)
196199
export(plot_RadialPlot)
197200
export(plot_Risoe.BINfileData)
201+
export(plot_SingleGrainDisc)
198202
export(plot_ViolinPlot)
199203
export(read_BIN2R)
200204
export(read_Daybreak2R)
@@ -302,6 +306,7 @@ importFrom(stats,coef)
302306
importFrom(stats,complete.cases)
303307
importFrom(stats,confint)
304308
importFrom(stats,density)
309+
importFrom(stats,dist)
305310
importFrom(stats,dnorm)
306311
importFrom(stats,fitted)
307312
importFrom(stats,formula)

NEWS.Rmd

+4
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,10 @@ header-includes:
1010

1111
## New functions
1212

13+
* `apply_Crosstalk()`, `calc_MoransI()`, `plot_SingleGrainDisc()` and
14+
`plot_MoranScatterplot()` were contributed by Anna-Maartje de Boer and Luc
15+
Steinbuch (#560).
16+
1317
* `calc_EED_Model()` models incomplete and heterogeneous bleaching of
1418
mobile grains after Guibert et al. (2017). Along with the function, the
1519
new `ExampleData.MortarData` data set was added.

NEWS.md

+5-1
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,14 @@
55

66
<!-- NEWS.md was auto-generated by NEWS.Rmd. Please DO NOT edit by hand!-->
77

8-
# Changes in version 0.9.26.9000-107 (2025-01-31)
8+
# Changes in version 0.9.26.9000-107 (2025-02-07)
99

1010
## New functions
1111

12+
- `apply_Crosstalk()`, `calc_MoransI()`, `plot_SingleGrainDisc()` and
13+
`plot_MoranScatterplot()` were contributed by Anna-Maartje de Boer and
14+
Luc Steinbuch (#560).
15+
1216
- `calc_EED_Model()` models incomplete and heterogeneous bleaching of
1317
mobile grains after Guibert et al. (2017). Along with the function,
1418
the new `ExampleData.MortarData` data set was added.

R/Luminescence-package.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -110,7 +110,7 @@
110110
#'
111111
#' @importFrom graphics plot plot.default frame abline mtext text lines par layout lines arrows axTicks axis barplot box boxplot contour curve grconvertX grconvertY hist legend persp points polygon rug segments title grid close.screen screen split.screen
112112
#' @importFrom grDevices adjustcolor axisTicks colorRampPalette gray.colors rgb topo.colors xy.coords dev.off
113-
#' @importFrom stats formula approx as.formula complete.cases density dnorm glm integrate lm median na.exclude na.omit nls nls.control pchisq pnorm quantile rnorm runif sd smooth smooth.spline spline t.test uniroot var weighted.mean setNames coef confint predict update residuals fitted qf
113+
#' @importFrom stats formula approx as.formula complete.cases density dist dnorm glm integrate lm median na.exclude na.omit nls nls.control pchisq pnorm quantile rnorm runif sd smooth smooth.spline spline t.test uniroot var weighted.mean setNames coef confint predict update residuals fitted qf
114114
#' @importFrom parallel parLapply makeCluster stopCluster
115115
#' @importFrom httr GET accept_json status_code content
116116
#'

R/apply_Crosstalk.R

+105
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
#' @title Apply crosstalk
2+
#'
3+
#' @description Add crosstalk, evenly spread in rook (top-right-bottom-left)
4+
#' directions, to all grain whole locations on one measurement discs
5+
#' (=on position on a measurement wheel in a reader). An
6+
#' added crosstalk value of as example 0.2 means that 0.2 of the value of
7+
#' the central grain is added to each grain in the rook directions. This is an additive
8+
#' action: the central grain itself is not affected by this operation (but will on its
9+
#' turn increase because of crosstalk from its neighbours).
10+
#' This function is used for simulations: can this added crosstalk be detected?
11+
#'
12+
#' @details If an element in `object` is `NA`, it is internally set to 0, so it will not
13+
#' be added.
14+
#'
15+
#' @param object [RLum.Results-class] or [numeric] (**required**): containing
16+
#' a numerical vector of length 100, representing one or more measurement
17+
#' discs ("positions") in a reader.
18+
#' Each element in the vector represents one grain hole location on a disc.
19+
#'
20+
#' @param n_crosstalk [numeric] (*with default*): A single number quantifying the added
21+
#' crosstalk. Defaults for testing purposes to 0.2. Can be any number, even negative,
22+
#' but for realistic simulations we suggest something between 0 and 0.25.
23+
#'
24+
#' @keywords crosstalk, simulation
25+
#'
26+
#' @return A vector of size 100, with the value at each grain hole location including simulated crosstalk.
27+
#'
28+
#' @author Anna-Maartje de Boer, Luc Steinbuch, Wageningen University & Research, 2025
29+
#'
30+
#' @references
31+
#' de Boer, A-M., Steinbuch, L., Heuvelink, G.B.M., Wallinga, J., 2025.
32+
#' A novel tool to assess crosstalk in single-grain luminescence detection.
33+
#' Submitted.
34+
#'
35+
#' @examples
36+
#' ## Create artificial disc observation
37+
#' observations <- set_RLum(class = "RLum.Results",
38+
#' data = list(vn_values = rep(x = c(1,2), each = 50))
39+
#' )
40+
#' hist(get_RLum(object = observations))
41+
#'
42+
#' ## Add crosstalk (with default set to 0.2), and visualize the difference
43+
#' ## in the resulting histogram.
44+
#' observations_with_simulated_crosstalk <- apply_Crosstalk(observations)
45+
#' hist(observations_with_simulated_crosstalk)
46+
#'
47+
#' @md
48+
#' @export
49+
apply_Crosstalk <- function(object,
50+
n_crosstalk = 0.2
51+
) {
52+
.set_function_name("apply_Crosstalk")
53+
on.exit(.unset_function_name(), add = TRUE)
54+
55+
## Validate input arguments -----------------------
56+
57+
.validate_class(object, c("RLum.Results", "numeric", "integer"))
58+
## To add: validation on `object`
59+
# - should contain a numerical vector of length 100
60+
61+
.validate_class(n_crosstalk, c("numeric"))
62+
## To add: validate on `n_crosstalk`
63+
# - should be a single numerical value
64+
65+
## Set variables -----------------------
66+
if(is.numeric(object))
67+
{
68+
vn_values <- object
69+
} else
70+
{
71+
vn_values <- get_RLum(object)
72+
}
73+
74+
75+
vb_na_s <- is.na(vn_values)
76+
77+
vn_values[vb_na_s] <- 0
78+
79+
## Prepare multiplication matrix -----------------------
80+
## Note: the physical appearance of a measurement disc,
81+
## 10x10 grains, is hard coded here
82+
df_disc_locations <- data.frame(location = 1:100,
83+
x = rep(1:10, times = 10),
84+
y = rep(1:10, each = 10))
85+
86+
# Calculate matrix with euclidean distances
87+
mn_dist <- as.matrix(dist(df_disc_locations[,c("x", "y")]))
88+
89+
## All distances equal to one are subject to crosstalk
90+
mn_crosstalk <- ifelse(mn_dist == 1, yes = n_crosstalk, no = 0)
91+
92+
## The diagonal -- all distances equal to zero -- are one
93+
diag(mn_crosstalk) <- 1
94+
95+
## Matrix calculations -----------------------
96+
97+
vn_sig_with_crosstalk <- as.numeric(mn_crosstalk %*% vn_values)
98+
99+
## Assign original NA's to output
100+
vn_sig_with_crosstalk[vb_na_s] <- NA
101+
102+
103+
return(vn_sig_with_crosstalk)
104+
105+
}

0 commit comments

Comments
 (0)