R-Lum / RLumModel
1
#' Translate a 'RLumModel' sequence into simulation steps
2
#'
3
#' This function translates the sequence (built by the user or parsed from  a *.seq file)
4
#' into simulation steps.
5
#' It detects automatically differences between single steps and simulates a heating/cooling step
6
#' up to the current step in the sequence.
7
#'
8
#' @param sequence \code{\link{list}} (\bold{required}): a list generated by \code{\link{read_SEQ2R}} or handmade
9
#'
10
#' @param n \code{\link{numeric}} or \code{\linkS4class{RLum.Results}} (\bold{required}):
11
#' concentration of electron-/holetraps, valence- and conduction band
12
#' from step before. This is necessary to get the boundary condition for the ODEs.
13
#'
14
#' @param parms \code{\linkS4class{RLum.Results}} (\bold{required}): The specific model parameters are used to simulate
15
#' numerical quartz luminescence results.
16
#'
17
#' @param model \code{\link{character}} (\bold{required}): Model (parameter set), which is used for calculations.
18
#'
19
#' @param txtProgressBar \code{\link{logical}} (with default): enables or disables txtProgressBar
20
#'
21
#' @param verbose \code{\link{logical}} (with default): enables or disalbes verbose mode. If \code{FALSE}
22
#' \code{txtProgressBar} is set to \code{FALSE} automatically
23
#'
24
#' @return This function returns an \code{\linkS4class{RLum.Analysis}} object which can be analysed
25
#' by further \code{\linkS4class{RLum}} functions.
26
#'
27
#' @section Function version: 0.1.1
28
#'
29
#' @author Johannes Friedrich, University of Bayreuth (Germany),
30
#'
31
#' @references
32
#'
33
#' @seealso \code{\link{model_LuminescenceSignals}}, \code{\linkS4class{RLum}}
34
#'
35
#' @examples
36
#'
37
#' #so far no example available
38
#'
39
#' @noRd
40
.translate_sequence <- function(
41
  sequence,
42
  n,
43
  parms,
44
  model,
45
  txtProgressBar = TRUE,
46
  verbose = TRUE
47
  ){
48

49 6
output.model <- list()
50 6
output.steps <- list()
51
##terminal output for sequence progress
52 0
if(verbose) cat("\n[.translate_Sequence()] \n\t>> Simulate sequence \n")
53
##PROGRESS BAR
54 6
if(txtProgressBar & verbose){
55 0
  pb <- txtProgressBar(min=0,max=length(sequence), char = "=", style=3)
56
}
57

58 6
for (i in 1:length(sequence)){
59

60
  ##### check temperature differences between different steps ####
61

62
  #check if temperatures of step before is lower than current sequence step and if step is not PH or CH
63
  #automatically heat to temperatrue of current sequence step
64

65
  #check if "temp" or "temp_begin" (only for TL) is part of the sequence, if not, the first entry in sequence is temp (per definition)
66 6
  if(!"temp" %in% names(sequence[[i]]) && !"temp_begin" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp"}
67

68
  #check if temp_begin is part of sequence, if so, temp = temp_begin
69 0
  if("temp_begin" %in% names(sequence[[i]])) {sequence[[i]]["temp"] <- sequence[[i]]["temp_begin"]}
70

71
  #check if temperature is higher than the step before
72
  #automatically heat to temperatrue of current sequence step, except stepname is "PH" or "CH"
73 6
  if(((n$temp < sequence[[i]]["temp"])&&(names(sequence)[i] != "PH")&&(names(sequence)[i] != "CH")) == TRUE){
74 6
    n <- .simulate_heating(temp_begin = n$temp,temp_end = sequence[[i]]["temp"], heating_rate = 1, n, parms)
75
    
76
    ##collect originators
77 6
    output.steps <- c(output.steps,n@originator)
78
  }
79
  
80

81
  #check if temperature is lower than the step before
82
  #automatically cool to temperatrue of current sequence step
83 6
  if(n$temp > sequence[[i]]["temp"]){
84 6
    n <- .simulate_heating(temp_begin = n$temp,temp_end = sequence[[i]]["temp"], heating_rate = -1, n, parms)
85

86
    ##collect originators
87 6
    output.steps <- c(output.steps,n@originator)
88
  }
89
  ##### end check temperature differences between different steps #####
90

91

92
  ##### check sequence #####
93

94
  #check if current sequence step is PH and if a heating rate was submitted
95 6
  if("PH" %in% names(sequence)[i] || "CH" %in% names(sequence)[i]){
96

97 0
    if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
98

99 6
    if(length(sequence[[i]]) == 1){
100 0
      n <- .simulate_heating(temp_begin = n$temp,
101 0
                             temp_end = sequence[[i]]["temp"],
102 0
                             heating_rate = 5,
103 0
                             n,
104 0
                             parms)
105
      
106
      ##collect originators
107 0
      output.steps <- c(output.steps,n@originator)
108
    }
109

110

111 6
    if(length(sequence[[i]]) == 2){
112 6
      if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
113

114 6
      n <- .simulate_heating(temp_begin = n$temp,
115 6
                             temp_end = sequence[[i]]["temp"],
116 6
                             heating_rate = 5,
117 6
                             n = n,
118 6
                             parms = parms)
119
      ##collect originators
120 6
      output.steps <- c(output.steps,n@originator)
121
      
122 6
      n <- .simulate_pause(temp = sequence[[i]]["temp"],
123 6
                           duration = sequence[[i]]["duration"],
124 6
                           n = n,
125 6
                           parms = parms)
126
      
127
      ##collect originators
128 6
      output.steps <- c(output.steps,n@originator)
129
    }
130

131 6
    if(length(sequence[[i]]) == 3){
132

133 6
      if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
134 6
      if(!"heating_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "heating_rate"}
135

136 6
      n <- .simulate_heating(temp_begin = n$temp,
137 6
                             temp_end = sequence[[i]]["temp"],
138 6
                             heating_rate =  sequence[[i]]["heating_rate"],
139 6
                             n,
140 6
                             parms)
141
      
142
      ##collect originators
143 6
      output.steps <- c(output.steps,n@originator)
144

145 6
      n <- .simulate_pause(temp = sequence[[i]]["temp"],
146 6
                           duration = sequence[[i]]["duration"],
147 6
                           n = n,
148 6
                           parms = parms)
149
      
150
      ##collect originators
151 6
      output.steps <- c(output.steps,n@originator)
152

153
    }
154

155
  }
156

157

158
  #check if current sequence step is CW_OSL
159 6
  if("OSL" %in% names(sequence)[i]) {
160 0
      if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp"}
161 6
      if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
162 6
      if(!"optical_power" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "optical_power"}
163

164 6
    n <- .simulate_CW_OSL(temp = sequence[[i]]["temp"],
165 6
                          duration = sequence[[i]]["duration"],
166 6
                          optical_power = sequence[[i]]["optical_power"],
167 6
                          n,
168 6
                          parms,
169 6
                          RLumModel_ID = i)
170
    
171
    ##collect originators
172 6
    output.steps <- c(output.steps,n@originator)
173

174 6
    output.model <- c(output.model,n$CW_OSL.data, n$concentrations)
175

176
  }
177

178
  #check if current sequence step is ILL (illumination)
179 6
  if("ILL" %in% names(sequence)[i]){
180

181 0
    if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
182 6
    if(!"duration" %in% names(sequence[[i]])) {names( sequence[[i]])[2] <- "duration"}
183 6
    if(!"optical_power" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "optical_power"}
184

185 6
    n <- .simulate_illumination(temp = sequence[[i]]["temp"],
186 6
                                duration = sequence[[i]]["duration"],
187 6
                                optical_power = sequence[[i]]["optical_power"],
188 6
                                n,
189 6
                                parms)
190
    
191
    ##collect originators
192 6
    output.steps <- c(output.steps,n@originator)
193

194
  }
195

196
  #check if current sequence step is LM_OSL
197 6
  if("LM_OSL" %in% names(sequence)[i]){
198

199 0
    if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
200 6
    if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
201

202 6
    if(length(sequence[[i]]) == 2){
203 6
    n <- .simulate_LM_OSL(temp = sequence[[i]]["temp"],
204 6
                          duration = sequence[[i]]["duration"],
205 6
                          n=n,
206 6
                          parms=parms,
207 6
                          RLumModel_ID = i)
208
    
209
    ##collect originators
210 6
    output.steps <- c(output.steps,n@originator)
211
    }
212

213 6
    if(length(sequence[[i]]) > 2){
214

215 0
      if(!"start_power" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "start_power"}
216 0
      if(!"end_power" %in% names(sequence[[i]])) {names(sequence[[i]])[4] <- "end_power"}
217

218 0
      n <- .simulate_LM_OSL(temp = sequence[[i]]["temp"],
219 0
                            duration = sequence[[i]]["duration"],
220 0
                            start_power = sequence[[i]]["start_power"],
221 0
                            end_power = sequence[[i]]["end_power"],
222 0
                            n=n,
223 0
                            parms=parms,
224 0
                            RLumModel_ID = i)
225
      
226
      ##collect originators
227 0
      output.steps <- c(output.steps,n@originator)
228

229
    }
230

231 6
    output.model <- c(output.model,n$LM_OSL.data, n$concentrations)
232
  }
233

234
  #check if current sequence step is TL
235 6
  if("TL" %in% names(sequence)[i]){
236

237 6
    if(!"temp_begin" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp_begin"}
238 6
    if(!"temp_end" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "temp_end"}
239 6
    if(!"heating_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "heating_rate"}
240

241 6
    n <- .simulate_TL(temp_begin = sequence[[i]]["temp_begin"],
242 6
                      temp_end = sequence[[i]]["temp_end"],
243 6
                      heating_rate = sequence[[i]]["heating_rate"],
244 6
                      n,
245 6
                      parms,
246 6
                      RLumModel_ID = i)
247
    
248
    ##collect originators
249 6
    output.steps <- c(output.steps,n@originator)
250

251 6
    output.model <- c(output.model,n$TL.data, n$concentrations)
252
  }
253

254
  #check if current sequence step is IRR
255 6
  if("IRR" %in% names(sequence)[i]){
256

257 0
    if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
258 6
    if(!"dose" %in% names(sequence[[i]])) {names( sequence[[i]])[2] <- "dose"}
259 6
    if(!"dose_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "dose_rate"}
260

261 6
    n <- .simulate_irradiation(temp = sequence[[i]]["temp"],
262 6
                               dose = sequence[[i]]["dose"],
263 6
                               dose_rate = sequence[[i]]["dose_rate"],
264 6
                               n,
265 6
                               parms)
266
    
267
    ##collect originators
268 6
    output.steps <- c(output.steps,n@originator)
269

270
    ##pause to releax
271 6
    n <- .simulate_pause(temp = sequence[[i]]["temp"], duration = 5, n = n, parms = parms)
272
    
273
    ##collect originators
274 6
    output.steps <- c(output.steps,n@originator)
275
  }
276

277
  #check if current sequence step is RF
278 6
  if("RF" %in% names(sequence)[i] || "RL" %in% names(sequence)[i]){
279

280 0
    if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
281 6
    if(!"dose" %in% names(sequence[[i]])) {names( sequence[[i]])[2] <- "dose"}
282 6
    if(!"dose_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "dose_rate"}
283

284 6
    n <- .simulate_RF(temp = sequence[[i]]["temp"],
285 6
                               dose = sequence[[i]]["dose"],
286 6
                               dose_rate = sequence[[i]]["dose_rate"],
287 6
                               n,
288 6
                               parms,
289 6
                               RLumModel_ID = i)
290
    
291
    ##collect originators
292 6
    output.steps <- c(output.steps, n@originator)
293

294 6
    output.model <- c(output.model,n$RF.data, n$concentrations)
295

296
    ##pause to releax
297 6
    n <- .simulate_pause(temp = sequence[[i]]["temp"], duration = 5, n = n, parms = parms)   
298
    
299
    ##collect originators
300 6
    output.steps <- c(output.steps,n@originator)
301
    
302
    }
303

304
  #check if current sequence step is PAUSE
305
  
306 6
  if("PAUSE" %in% names(sequence)[i]){
307
    
308 6
    if(length(sequence[[i]]) == 2){
309
      
310 0
    if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
311 6
    if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
312

313 6
    n <- .simulate_pause(temp = sequence[[i]]["temp"], 
314 6
                         duration = sequence[[i]]["duration"], 
315 6
                         n = n, 
316 6
                         parms= parms)
317
    
318
    ##collect originators
319 6
    output.steps <- c(output.steps,n@originator)
320
    
321
    }
322
  
323 6
  if(length(sequence[[i]]) == 3){
324

325 0
      if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
326 0
      if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
327 0
      if(!"detection" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "detection"}
328
      
329 0
      n <- .simulate_pause(temp = sequence[[i]]["temp"], 
330 0
                           duration = sequence[[i]]["duration"], 
331 0
                           detection = sequence[[i]]["detection"],
332 0
                           RLumModel_ID = i,
333 0
                           n= n, 
334 0
                           parms = parms)
335
      
336
      ##collect originators
337 0
      output.steps <- c(output.steps,n@originator)
338
      
339 0
      output.model <- c(output.model,n$pause.data, n$concentrations)
340
      
341
   } 
342
  }
343
  
344
  #check if current sequence step is RF
345 6
  if("RF_heating" %in% names(sequence)[i] || "RL_heating" %in% names(sequence)[i]){
346
    
347 6
    if(!"temp_begin" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp_begin"}
348 6
    if(!"temp_end" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "temp_end"}
349 6
    if(!"heating_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "heating_rate"}
350 6
    if(!"dose_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[4] <- "dose_rate"}
351
    
352 6
    n <- .simulate_RF_and_heating(temp_begin = sequence[[i]]["temp_begin"],
353 6
                      temp_end = sequence[[i]]["temp_end"],
354 6
                      heating_rate = sequence[[i]]["heating_rate"],
355 6
                      dose_rate = sequence[[i]]["dose_rate"],
356 6
                      n = n,
357 6
                      parms = parms,
358 6
                      RLumModel_ID = i)
359
    
360
    ##collect originators
361 6
    output.steps <- c(output.steps, n@originator)
362
    
363 6
    output.model <- c(output.model, n$RF_heating.data, n$concentrations)
364
    
365
    ##pause to releax
366 6
    n <- .simulate_pause(temp = sequence[[i]]["temp_end"], duration = 5, n = n, parms = parms)   
367
    
368
    ##collect originators
369 6
    output.steps <- c(output.steps,n@originator)
370
    
371
  }
372

373
  ##update progress bar
374 6
  if (txtProgressBar & verbose) {
375 0
    setTxtProgressBar(pb, i)
376
  }
377
  
378
}##end for loop over sequence-list
379

380
##close txtProgressBar
381 0
if(txtProgressBar & verbose){close(pb)}
382

383
# delete null/empty entries in a list
384 6
output.model <- output.model[unlist(lapply(output.model,length)!=0)]
385

386
#return of the function is a "RLum.Analysis" object with the output of the given sequence
387 6
return(set_RLum(
388 6
  class = "RLum.Analysis", 
389 6
  records = output.model, 
390 6
  protocol = model, 
391 6
  originator = "model_LuminescenceSignals()",
392 6
  info = list(sequence = sequence, originators = unlist(output.steps)))
393
)
394

395
}

Read our documentation on viewing source code .

Loading