Nothing
#' Translate a 'RLumModel' sequence into simulation steps
#'
#' This function translates the sequence (built by the user or parsed from a *.seq file)
#' into simulation steps.
#' It detects automatically differences between single steps and simulates a heating/cooling step
#' up to the current step in the sequence.
#'
#' @param sequence \code{\link{list}} (\bold{required}): a list generated by \code{\link{read_SEQ2R}} or handmade
#'
#' @param n \code{\link{numeric}} or \code{\linkS4class{RLum.Results}} (\bold{required}):
#' concentration of electron-/holetraps, valence- and conduction band
#' from step before. This is necessary to get the boundary condition for the ODEs.
#'
#' @param parms \code{\linkS4class{RLum.Results}} (\bold{required}): The specific model parameters are used to simulate
#' numerical quartz luminescence results.
#'
#' @param model \code{\link{character}} (\bold{required}): Model (parameter set), which is used for calculations.
#'
#' @param txtProgressBar \code{\link{logical}} (with default): enables or disables txtProgressBar
#'
#' @param verbose \code{\link{logical}} (with default): enables or disables verbose mode. If \code{FALSE}
#' \code{txtProgressBar} is set to \code{FALSE} automatically
#'
#' @return This function returns an \code{\linkS4class{RLum.Analysis}} object which can be analysed
#' by further \code{\linkS4class{RLum}} functions.
#'
#' @section Function version: 0.1.2
#'
#' @author Johannes Friedrich, University of Bayreuth (Germany),
#'
#' @references
#'
#' @seealso \code{\link{model_LuminescenceSignals}}, \code{\linkS4class{RLum}}
#'
#' @examples
#'
#' #so far no example available
#'
#' @noRd
.translate_sequence <- function(
sequence,
n,
parms,
model,
txtProgressBar = TRUE,
verbose = TRUE
){
output.model <- list()
output.steps <- list()
##terminal output for sequence progress
if(verbose) cat("\n[.translate_Sequence()] \n\t>> Simulate sequence \n")
##PROGRESS BAR
if(txtProgressBar & verbose){
pb <- txtProgressBar(min=0,max=length(sequence), char = "=", style=3)
}
for (i in 1:length(sequence)){
##### check temperature differences between different steps ####
#check if temperatures of step before is lower than current sequence step and if step is not PH or CH
#automatically heat to temperature of current sequence step
#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)
if(!"temp" %in% names(sequence[[i]]) && !"temp_begin" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp"}
#check if temp_begin is part of sequence, if so, temp = temp_begin
if("temp_begin" %in% names(sequence[[i]])) {sequence[[i]]["temp"] <- sequence[[i]]["temp_begin"]}
#check if temperature is higher than the step before
#automatically heat to temperature of current sequence step, except stepname is "PH" or "CH"
if(((n$temp < sequence[[i]]["temp"])&&(names(sequence)[i] != "PH")&&(names(sequence)[i] != "CH")) == TRUE){
n <- .simulate_heating(temp_begin = n$temp,temp_end = sequence[[i]]["temp"], heating_rate = 1, n, parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
#check if temperature is lower than the step before
#automatically cool to temperatrue of current sequence step
if(n$temp > sequence[[i]]["temp"]){
n <- .simulate_heating(temp_begin = n$temp,temp_end = sequence[[i]]["temp"], heating_rate = -1, n, parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
##### end check temperature differences between different steps #####
##### check sequence #####
#check if current sequence step is PH and if a heating rate was submitted
if("PH" %in% names(sequence)[i] || "CH" %in% names(sequence)[i]){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(length(sequence[[i]]) == 1){
n <- .simulate_heating(temp_begin = n$temp,
temp_end = sequence[[i]]["temp"],
heating_rate = 5,
n,
parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
if(length(sequence[[i]]) == 2){
if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
n <- .simulate_heating(temp_begin = n$temp,
temp_end = sequence[[i]]["temp"],
heating_rate = 5,
n = n,
parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
n <- .simulate_pause(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
n = n,
parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
if(length(sequence[[i]]) == 3){
if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
if(!"heating_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "heating_rate"}
n <- .simulate_heating(temp_begin = n$temp,
temp_end = sequence[[i]]["temp"],
heating_rate = sequence[[i]]["heating_rate"],
n,
parms)
##collect originators
output.steps <- c(output.steps,n@originator)
n <- .simulate_pause(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
n = n,
parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
}
#check if current sequence step is CW_OSL
if("OSL" %in% names(sequence)[i]) {
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp"}
if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
if(!"optical_power" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "optical_power"}
n <- .simulate_CW_OSL(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
optical_power = sequence[[i]]["optical_power"],
n,
parms,
RLumModel_ID = i)
##collect originators
output.steps <- c(output.steps,n@originator)
output.model <- c(output.model,n$CW_OSL.data, n$concentrations)
}
#check if current sequence step is ILL (illumination)
if("ILL" %in% names(sequence)[i]){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(!"duration" %in% names(sequence[[i]])) {names( sequence[[i]])[2] <- "duration"}
if(!"optical_power" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "optical_power"}
n <- .simulate_illumination(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
optical_power = sequence[[i]]["optical_power"],
n,
parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
#check if current sequence step is LM_OSL
if("LM_OSL" %in% names(sequence)[i]){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
if(length(sequence[[i]]) == 2){
n <- .simulate_LM_OSL(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
n=n,
parms=parms,
RLumModel_ID = i)
##collect originators
output.steps <- c(output.steps,n@originator)
}
if(length(sequence[[i]]) > 2){
if(!"start_power" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "start_power"}
if(!"end_power" %in% names(sequence[[i]])) {names(sequence[[i]])[4] <- "end_power"}
n <- .simulate_LM_OSL(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
start_power = sequence[[i]]["start_power"],
end_power = sequence[[i]]["end_power"],
n=n,
parms=parms,
RLumModel_ID = i)
##collect originators
output.steps <- c(output.steps,n@originator)
}
output.model <- c(output.model,n$LM_OSL.data, n$concentrations)
}
#check if current sequence step is TL
if("TL" %in% names(sequence)[i]){
if(!"temp_begin" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp_begin"}
if(!"temp_end" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "temp_end"}
if(!"heating_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "heating_rate"}
n <- .simulate_TL(temp_begin = sequence[[i]]["temp_begin"],
temp_end = sequence[[i]]["temp_end"],
heating_rate = sequence[[i]]["heating_rate"],
n,
parms,
RLumModel_ID = i)
##collect originators
output.steps <- c(output.steps,n@originator)
output.model <- c(output.model,n$TL.data, n$concentrations)
}
#check if current sequence step is IRR
if("IRR" %in% names(sequence)[i]){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(!"dose" %in% names(sequence[[i]])) {names( sequence[[i]])[2] <- "dose"}
if(!"dose_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "dose_rate"}
n <- .simulate_irradiation(temp = sequence[[i]]["temp"],
dose = sequence[[i]]["dose"],
dose_rate = sequence[[i]]["dose_rate"],
n,
parms)
##collect originators
output.steps <- c(output.steps,n@originator)
##pause to releax
n <- .simulate_pause(temp = sequence[[i]]["temp"], duration = 5, n = n, parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
#check if current sequence step is RF
if("RF" %in% names(sequence)[i] || "RL" %in% names(sequence)[i]){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(!"dose" %in% names(sequence[[i]])) {names( sequence[[i]])[2] <- "dose"}
if(!"dose_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "dose_rate"}
n <- .simulate_RF(temp = sequence[[i]]["temp"],
dose = sequence[[i]]["dose"],
dose_rate = sequence[[i]]["dose_rate"],
n,
parms,
RLumModel_ID = i)
##collect originators
output.steps <- c(output.steps, n@originator)
output.model <- c(output.model,n$RF.data, n$concentrations)
##pause to releax
n <- .simulate_pause(temp = sequence[[i]]["temp"], duration = 5, n = n, parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
#check if current sequence step is PAUSE
if("PAUSE" %in% names(sequence)[i]){
if(length(sequence[[i]]) == 2){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
n <- .simulate_pause(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
n = n,
parms= parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
if(length(sequence[[i]]) == 3){
if(!"temp" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp" }
if(!"duration" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "duration"}
if(!"detection" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "detection"}
n <- .simulate_pause(temp = sequence[[i]]["temp"],
duration = sequence[[i]]["duration"],
detection = sequence[[i]]["detection"],
RLumModel_ID = i,
n= n,
parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
output.model <- c(output.model,n$pause.data, n$concentrations)
}
}
#check if current sequence step is RF
if("RF_heating" %in% names(sequence)[i] || "RL_heating" %in% names(sequence)[i]){
if(!"temp_begin" %in% names(sequence[[i]])) {names(sequence[[i]])[1] <- "temp_begin"}
if(!"temp_end" %in% names(sequence[[i]])) {names(sequence[[i]])[2] <- "temp_end"}
if(!"heating_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[3] <- "heating_rate"}
if(!"dose_rate" %in% names(sequence[[i]])) {names(sequence[[i]])[4] <- "dose_rate"}
n <- .simulate_RF_and_heating(temp_begin = sequence[[i]]["temp_begin"],
temp_end = sequence[[i]]["temp_end"],
heating_rate = sequence[[i]]["heating_rate"],
dose_rate = sequence[[i]]["dose_rate"],
n = n,
parms = parms,
RLumModel_ID = i)
##collect originators
output.steps <- c(output.steps, n@originator)
output.model <- c(output.model, n$RF_heating.data, n$concentrations)
##pause to relax
n <- .simulate_pause(temp = sequence[[i]]["temp_end"], duration = 5, n = n, parms = parms)
##collect originators
output.steps <- c(output.steps,n@originator)
}
##update progress bar
if (txtProgressBar & verbose) {
setTxtProgressBar(pb, i)
}
}##end for loop over sequence-list
##close txtProgressBar
if(txtProgressBar & verbose){close(pb)}
# delete null/empty entries in a list
output.model <- output.model[unlist(lapply(output.model,length)!=0)]
#return of the function is a "RLum.Analysis" object with the output of the given sequence
return(set_RLum(
class = "RLum.Analysis",
records = output.model,
protocol = model,
originator = "model_LuminescenceSignals",
info = list(
sequence = sequence,
parms = parms,
originators = unlist(output.steps)))
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.