/
plot_DetPlot.R
374 lines (324 loc) · 11.9 KB
/
plot_DetPlot.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
#' @title Create De(t) plot
#'
#' @description Plots the equivalent dose (De) in dependency of the chosen signal integral
#' (cf. Bailey et al., 2003). The function is simply passing several arguments
#' to the function [plot] and the used analysis functions and runs it in a loop.
#' Example: `legend.pos` for legend position, `legend` for legend text.
#'
#' @details
#'
#' **method**
#'
#' The original method presented by Bailey et al., 2003 shifted the signal integrals and slightly
#' extended them accounting for changes in the counting statistics. Example: `c(1:3, 3:5, 5:7)`.
#' However, here also another method is provided allowing to expand the signal integral by
#' consecutively expanding the integral by its chosen length. Example: `c(1:3, 1:5, 1:7)`
#'
#' Note that in both cases the integral limits are overlap. The finally applied limits are part
#' of the function output.
#'
#' **analyse_function.control**
#'
#' The argument `analyse_function.control` currently supports the following arguments
#' `sequence.structure`, `dose.points`, `mtext.outer`, `fit.method`, `fit.force_through_origin`, `plot`, `plot.single`
#'
#' @param object [RLum.Analysis-class] (**required**):
#' input object containing data for analysis
#'
#' @param signal.integral.min [integer] (**required**):
#' lower bound of the signal integral.
#'
#' @param signal.integral.max [integer] (**required**):
#' upper bound of the signal integral.
#'
#' @param background.integral.min [integer] (**required**):
#' lower bound of the background integral.
#'
#' @param background.integral.max [integer] (**required**):
#' upper bound of the background integral.
#'
#' @param method [character] (*with default*):
#' method applied for constructing the De(t) plot.
#' - `shift` (*the default*): the chosen signal integral is shifted the shine down curve,
#' - `expansion`: the chosen signal integral is expanded each time by its length
#'
#' @param signal_integral.seq [numeric] (*optional*):
#' argument to provide an own signal integral sequence for constructing the De(t) plot
#'
#' @param analyse_function [character] (*with default*):
#' name of the analyse function to be called. Supported functions are:
#' [analyse_SAR.CWOSL], [analyse_pIRIRSequence]
#'
#' @param analyse_function.control [list] (*optional*):
#' selected arguments to be passed to the supported analyse functions
#' ([analyse_SAR.CWOSL], [analyse_pIRIRSequence])
#'
#' @param n.channels [integer] (*optional*):
#' number of channels used for the De(t) plot. If nothing is provided all
#' De-values are calculated and plotted until the start of the background
#' integral.
#'
#' @param show_ShineDownCurve [logical] (*with default*):
#' enables or disables shine down curve in the plot output
#'
#' @param respect_RC.Status [logical] (*with default*):
#' remove De-values with 'FAILED' RC.Status from the plot
#' (cf. [analyse_SAR.CWOSL] and [analyse_pIRIRSequence])
#'
#' @param verbose [logical] (*with default*):
#' enables or disables terminal feedback
#'
#' @param ... further arguments and graphical parameters passed to
#' [plot.default], [analyse_SAR.CWOSL] and [analyse_pIRIRSequence] (see details for further information).
#' Plot control parameters are: `ylim`, `xlim`, `ylab`, `xlab`, `main`, `pch`, `mtext`, `cex`, `legend`,
#' `legend.text`, `legend.pos`
#'
#' @return
#' A plot and an [RLum.Results-class] object with the produced De values
#'
#' `@data`:
#'
#' \tabular{lll}{
#' **Object** \tab **Type** \tab **Description**\cr
#' De.values \tab `data.frame` \tab table with De values \cr
#' signal_integral.seq \tab `numeric` \tab integral sequence used for the calculation
#' }
#'
#' `@info`:
#'
#' \tabular{lll}{
#' **Object** \tab **Type** \tab **Description**\cr
#' call \tab `call` \tab the original function call
#' }
#'
#'
#' @note
#' The entire analysis is based on the used analysis functions, namely
#' [analyse_SAR.CWOSL] and [analyse_pIRIRSequence]. However, the integrity
#' checks of this function are not that thoughtful as in these functions itself.
#' It means, that every sequence should be checked carefully before running long
#' calculations using several hundreds of channels.
#'
#' @section Function version: 0.1.5
#'
#' @author Sebastian Kreutzer, Institute of Geography, Ruprecht-Karl University of Heidelberg (Germany)
#'
#' @references
#' Bailey, R.M., Singarayer, J.S., Ward, S., Stokes, S., 2003. Identification of partial resetting
#' using De as a function of illumination time. Radiation Measurements 37, 511-518.
#' doi:10.1016/S1350-4487(03)00063-5
#'
#' @seealso [plot], [analyse_SAR.CWOSL], [analyse_pIRIRSequence]
#'
#' @examples
#'
#' \dontrun{
#' ##load data
#' ##ExampleData.BINfileData contains two BINfileData objects
#' ##CWOSL.SAR.Data and TL.SAR.Data
#' data(ExampleData.BINfileData, envir = environment())
#'
#' ##transform the values from the first position in a RLum.Analysis object
#' object <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos=1)
#'
#' plot_DetPlot(
#' object,
#' signal.integral.min = 1,
#' signal.integral.max = 3,
#' background.integral.min = 900,
#' background.integral.max = 1000,
#' n.channels = 5)
#' }
#'
#' @md
#' @export
plot_DetPlot <- function(
object,
signal.integral.min,
signal.integral.max,
background.integral.min,
background.integral.max,
method = "shift",
signal_integral.seq = NULL,
analyse_function = "analyse_SAR.CWOSL",
analyse_function.control = list(),
n.channels = NULL,
show_ShineDownCurve = TRUE,
respect_RC.Status = FALSE,
verbose = TRUE,
...
) {
# Integrity Tests -----------------------------------------------------------------------------
##check input
if(!inherits(object, "RLum.Analysis"))
stop("[plot_DetPlot()] input must be an RLum.Analysis object!", call. = FALSE)
##get structure
object.structure <- structure_RLum(object)
# Set parameters ------------------------------------------------------------------------------
##set n.channels
if(is.null(n.channels)){
n.channels <- ceiling(
(background.integral.min - 1 - signal.integral.max) / (signal.integral.max - signal.integral.min)
)
}
analyse_function.settings <- list(
sequence.structure = c("TL", "IR50", "pIRIR225"),
dose.points = NULL,
mtext.outer = "",
fit.method = "EXP",
fit.force_through_origin = FALSE,
plot = FALSE,
plot.single = FALSE
)
analyse_function.settings <- modifyList(analyse_function.settings, analyse_function.control)
# Analyse -------------------------------------------------------------------------------------
##set integral sequence
if (is.null(signal_integral.seq)) {
if(signal.integral.min == signal.integral.max){
signal_integral.seq <- signal.integral.min:(background.integral.min - 1)
}else{
signal_integral.seq <-
seq(signal.integral.min,
background.integral.min - 1,
by = signal.integral.max - signal.integral.min)
}
}
if(analyse_function == "analyse_SAR.CWOSL"){
results <- merge_RLum(lapply(1:n.channels, function(x){
analyse_SAR.CWOSL(
object = object,
signal.integral.min = if(method == "shift"){signal_integral.seq[x]}else{signal_integral.seq[1]},
signal.integral.max = signal_integral.seq[x+1],
background.integral.min = background.integral.min,
background.integral.max = background.integral.max,
dose.points = analyse_function.settings$dose.points,
mtext.outer = analyse_function.settings$mtext.outer,
fit.force_through_origin = analyse_function.settings$fit.force_through_origin,
fit.method = analyse_function.settings$fit.method,
plot = analyse_function.settings$plot,
plot.single = analyse_function.settings$plot.single,
verbose = verbose
)
}))
}
else if(analyse_function == "analyse_pIRIRSequence"){
results <- merge_RLum(lapply(1:n.channels, function(x){
analyse_pIRIRSequence(
object = object,
signal.integral.min = if(method == "shift"){signal_integral.seq[x]}else{signal_integral.seq[1]},
signal.integral.max = signal_integral.seq[x+1],
background.integral.min = background.integral.min,
background.integral.max = background.integral.max,
dose.points = analyse_function.settings$dose.points,
mtext.outer = analyse_function.settings$mtext.outer,
plot = analyse_function.settings$plot,
plot.single = analyse_function.settings$plot.single,
sequence.structure = analyse_function.settings$sequence.structure,
verbose = verbose
)
}))
}
else{
stop("[plot_DetPlot()] 'analyse_function' unknown!", call. = FALSE)
}
# Plot ----------------------------------------------------------------------------------------
##get De results
if(analyse_function == "analyse_pIRIRSequence"){
pIRIR_signals <- unique(get_RLum(results)$Signal)
}else{
pIRIR_signals <- NA
}
##run this in a loop to account for pIRIR data
df_final <- lapply(1:length(pIRIR_signals), function(i){
##get data.frame
df <- get_RLum(results)
##further limit
if(!is.na(pIRIR_signals[1]))
df <- df[df$Signal == pIRIR_signals[i],]
##add shine down curve, which is by definition the first IRSL/OSL curve
##and normalise on the highest De value
OSL_curve <-
as(get_RLum(object, recordType = "SL")[[i]], "matrix")
##limit to what we see
OSL_curve <- OSL_curve[1:signal_integral.seq[n.channels + 1],]
m <-
((min(df$De - df$De.Error, na.rm = TRUE)) -
(max(df$De, na.rm = TRUE) +
max(df$De.Error, na.rm = TRUE))) /
(min(OSL_curve[, 2], na.rm = TRUE) -
max(OSL_curve[, 2], na.rm = TRUE))
n <- (max(df$De, na.rm = TRUE) +
max(df$De.Error, na.rm = TRUE)) - m * max(OSL_curve[, 2])
OSL_curve[, 2] <- m * OSL_curve[, 2] + n
rm(n, m)
##set plot setting
plot.settings <- modifyList(list(
ylim = c(
min(df$De - df$De.Error, na.rm = TRUE),
(max(df$De, na.rm = TRUE) + max(df$De.Error, na.rm = TRUE))),
xlim = c(min(OSL_curve[, 1]), max(OSL_curve[, 1])),
ylab = expression(paste(D[e] / s, " and ", L[n]/(a.u.))),
xlab = "Stimulation time [s]",
main = "De(t) plot",
pch = 1,
mtext = ifelse(is.na(pIRIR_signals[1]), "", paste0("Signal: ",pIRIR_signals[i])),
cex = 1,
legend = TRUE,
legend.text = c(expression(L[n]-signal), expression(D[e])),
legend.pos = "bottomleft"
), list(...))
##general settings
par(cex = plot.settings$cex)
##set x-axis
df_x <-
OSL_curve[seq(signal.integral.max, signal_integral.seq[n.channels+1], length.out = nrow(df)),1]
#combine everything to allow excluding unwanted values
df_final <- cbind(df, df_x)
if (respect_RC.Status) {
df_final <- df_final[df_final$RC.Status != "FAILED", ]
}
##open plot area
plot(
NA,
NA,
xlim = plot.settings$xlim,
ylim = if(any(is.infinite(plot.settings$ylim))) c(-1,1) else plot.settings$ylim ,
xlab = plot.settings$xlab,
ylab = plot.settings$ylab,
main = plot.settings$main
)
if (show_ShineDownCurve)
lines(OSL_curve, type = "b", pch = 20)
##ToDo:color failed points red
##plot points and error bars
points(df_final[, c("df_x", "De")], pch = plot.settings$pch)
segments(
x0 = df_final$df_x,
y0 = df_final$De + df_final$De.Error,
x1 = df_final$df_x,
y1 = df_final$De - df_final$De.Error
)
##set mtext
mtext(side = 3, plot.settings$mtext)
##legend
if(plot.settings$legend){
legend(
plot.settings$legend.pos,
legend = plot.settings$legend.text,
pch = c(plot.settings$pch, 20),
bty = "n"
)
}
##set return
return(df_final)
})
##merge results
return(set_RLum(
class = "RLum.Results",
data = list(
De.values = as.data.frame(data.table::rbindlist(df_final)),
signal_integral.seq = signal_integral.seq
),
info = list(call = sys.call())
))
}