-
Notifications
You must be signed in to change notification settings - Fork 7
/
apply_EfficiencyCorrection.R
151 lines (117 loc) · 4.7 KB
/
apply_EfficiencyCorrection.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
#' Function to apply spectral efficiency correction to RLum.Data.Spectrum S4
#' class objects
#'
#' The function allows spectral efficiency corrections for RLum.Data.Spectrum
#' S4 class objects
#'
#' The efficiency correction is based on a spectral response dataset provided
#' by the user. Usually the data set for the quantum efficiency is of lower
#' resolution and values are interpolated for the required spectral resolution using
#' the function [stats::approx][stats::approxfun]
#'
#' If the energy calibration differs for both data set `NA` values are produces that
#' will be removed from the matrix.
#'
#' @param object [RLum.Data.Spectrum-class] or [RLum.Analysis-class] (**required**):
#' S4 object of class `RLum.Data.Spectrum`, `RLum.Analysis`or a [list] of such objects. Other objects in
#' the list are skipped.
#'
#' @param spectral.efficiency [data.frame] (**required**):
#' Data set containing wavelengths (x-column) and relative spectral response values
#' (y-column) (values between 0 and 1). The provided data will be used to correct all spectra if `object` is
#' a [list]
#'
#' @return Returns same object as provided as input
#'
#' @note
#' Please note that the spectral efficiency data from the camera alone may not
#' sufficiently correct for spectral efficiency of the entire optical system
#' (e.g., spectrometer, camera ...).
#'
#' @section Function version: 0.2.0
#'
#' @author
#' Sebastian Kreutzer, IRAMAT-CRP2A, UMR 5060, CNRS-Université Bordeaux Montaigne (France)\cr
#' Johannes Friedrich, University of Bayreuth (Germany)
#'
#' @seealso [RLum.Data.Spectrum-class], [RLum.Analysis-class]
#'
#' @keywords manip
#'
#' @examples
#'
#' ##(1) - use with your own data (uncomment for usage)
#' ## spectral.efficiency <- read.csv("your data")
#' ##
#' ## your.spectrum <- apply_EfficiencyCorrection(your.spectrum, )
#'
#' @md
#' @export
apply_EfficiencyCorrection <- function(
object,
spectral.efficiency
){
# self-call -----------------------------------------------------------------------------------
##case we have a list
if(inherits(object, "list")){
output_list <- lapply(object, function(o){
if(inherits(o, "RLum.Data.Spectrum") || inherits(o, "RLum.Analysis")){
apply_EfficiencyCorrection(object = o, spectral.efficiency = spectral.efficiency)
}else{
warning(paste0("[apply_EfficiencyCorrection()] Skipping ",class(o)," object in input list."), call. = FALSE)
return(o)
}
})
return(output_list)
}
##the case of an RLum.Analysis object
if(inherits(object, "RLum.Analysis")){
object@records <- lapply(object@records, function(o){
if(inherits(o, "RLum.Data.Spectrum")){
apply_EfficiencyCorrection(object = o, spectral.efficiency = spectral.efficiency)
}else{
warning(paste0("[apply_EfficiencyCorrection()] Skipping ",class(o)," object in input list."), call. = FALSE)
return(o)
}
})
return(object)
}
# Integrity check -----------------------------------------------------------
##check if object is of class RLum.Data.Spectrum
if(!inherits(object, "RLum.Data.Spectrum"))
stop("[apply_EfficiencyCorrection()] Input object is not of type RLum.Data.Spectrum",call. = FALSE)
if(!inherits(spectral.efficiency, "data.frame"))
stop("[apply_EfficiencyCorrection()] 'spectral.efficiency' is not of type data.frame", call. = FALSE)
## grep data matrix from the input object
temp.matrix <- as(object, "matrix")
## grep efficency values
temp.efficiency <- as.matrix(spectral.efficiency[,1:2])
##test max
if(max(temp.efficiency[,2]) > 1)
stop("[apply_EfficiencyCorrection()] Relative quantum efficiency values > 1 are not allowed.", call. = FALSE)
# Apply method ------------------------------------------------------------
##the interpolation is needed to align the resolution
#set data for interpolation
temp.efficiency.x <- as.numeric(row.names(temp.matrix))
temp.efficiency.interpolated <- approx(
x = temp.efficiency[,1],
y = temp.efficiency[,2],
xout = temp.efficiency.x,
ties = mean)
##correct for quantum efficiency
temp.matrix <- vapply(X = 1:ncol(temp.matrix), FUN = function(x){
temp.matrix[,x]/temp.efficiency.interpolated$y*max(temp.efficiency.interpolated$y, na.rm = TRUE)
}, FUN.VALUE = numeric(length = nrow(temp.matrix)))
##remove NA values
temp.matrix <- na.exclude(temp.matrix)
##correct colnames
colnames(temp.matrix) <- colnames(get_RLum(object))
# Return Output------------------------------------------------------------
temp.output <- set_RLum(
class = "RLum.Data.Spectrum",
recordType = object@recordType,
curveType = object@curveType,
data = temp.matrix,
info = object@info)
invisible(temp.output)
}