RLumModel
Solving Ordinary Differential Equations to Understand Luminescence

Package index
Search the RLumModel package
Vignettes
Functions
28
Source code
39
Man pages
6
Home
/
CRAN
/
RLumModel
/
R/translate_sequence.R

R/translate_sequence.R
In RLumModel: Solving Ordinary Differential Equations to Understand Luminescence

Defines functions .translate_sequence 

#' 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)))
)

}

Try the RLumModel package in your browser

Any scripts or data that you put into this service are public.

RLumModel documentation built on March 18, 2022, 7:06 p.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close