-
Notifications
You must be signed in to change notification settings - Fork 5
/
processMonitor.R
138 lines (129 loc) · 5.58 KB
/
processMonitor.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
#' Adaptive Process Training
#'
#' @description Apply Adaptive-Dynamic PCA to state-specific data matrices.
#'
#' @param data An xts data matrix
#' @param trainObs The number of training observations to be used
#' @param ... Lazy dots for additional internal arguments
#' @param updateFreq The number of non-flagged observations to collect before
#' the function updates. Defaults to half as many observations as the number
#' of training observations.
#' @param faultsToTriggerAlarm The number of sequential faults needed to trigger
#' an alarm. Defaults to 5.
#'
#' @return A list with the following components:
#' \describe{
#' \item{FaultChecks -- }{a class-specific xts flagging matrix with the
#' same number of rows as "data". This flag matrix has the following five
#' columns:
#' \describe{
#' \item{SPE -- }{the SPE statistic value for each observation in
#' "data"}
#' \item{SPE_Flag -- }{a vector of SPE indicators recording 0 if the
#' test statistic is less than or equal to the critical value
#' passed through from the threshold object}
#' \item{T2 -- }{the T2 statistic value for each observation in
#' "data"}
#' \item{T2_Flag -- }{a vector of T2 fault indicators, defined like
#' SPE_Flag}
#' \item{Alarm -- }{a column indicating if there have been five flags
#' in a row for either the SPE or T2 monitoring statistics or both.
#' Alarm states are as follows: 0 = no alarm, 1 = Hotelling's T2
#' alarm, 2 = Squared Prediction Error alarm, and 3 = both alarms.}
#' }
#' }
#' \item{Non_Alarmed_Obs -- }{a class-specific xts data matrix of all the
#' non-alarmed observations (observations with alarm state equal to 0)}
#' \item{Alarms -- }{a class-specific xts data matrix of the features and
#' specific alarms of Alarmed observations, where the alarm codes are
#' listed above}
#' \item{trainSpecs -- }{a threshold object returned by the internal
#' threshold() function. See the threshold() function's help file for
#' more details.}
#' }
#'
#' @details This function is the class-specific implementation of the Adaptive-
#' Dynamic PCA described in the details of the mspTrain() function. See
#' the mspTrain() function's help file for further details.
#'
#' This internal function is called by mspTrain(). This function calls the
#' faultFilter() function.
#'
#' @seealso Calls: \code{\link{faultFilter}}. Called by: \code{\link{mspTrain}}.
#'
#' @export
#'
#' @importFrom lazyeval lazy_dots
#' @importFrom lazyeval lazy_eval
#' @importFrom utils head
#'
#' @examples
#' nrml <- mspProcessData(faults = "NOC")
#' data <- nrml[nrml[,1] == 1]
#'
#' processMonitor(data = data[,-1], trainObs = 672)
#'
processMonitor <- function(data,
trainObs,
updateFreq = ceiling(0.5 * trainObs),
faultsToTriggerAlarm = 5,
...){
ls <- lazy_dots(...)
# browser()
faultObj_ls <- do.call(faultFilter,
args = c(list(trainData = data[1:trainObs,],
testData = data[(trainObs + 1):nrow(data), ],
updateFreq = updateFreq,
faultsToTriggerAlarm = faultsToTriggerAlarm),
lazy_eval(ls)))
fault_xts <- faultObj_ls$faultObj
obsToKeepNew <- faultObj_ls$nonAlarmedTestObs
obsToKeep <- faultObj_ls$nonAlarmedTestObs
while(nrow(obsToKeepNew) == updateFreq){
# browser()
# How many ok observations have we found so far with faultFilter?
n <- nrow(obsToKeepNew)
if(n < trainObs){
trainData <- rbind(data[(n + 1):trainObs,], obsToKeep)
}else{
trainData <- head(obsToKeep[(n - trainObs + 1):n,], n = trainObs)
}
testTime <- index(obsToKeep[nrow(obsToKeep)])
# Train on all observations after the last observation in obsToKeep. This
# is what the date/ means for xts objects (date/ means that date and all
# after it, this is why we remove the first row).
testData <- data[paste0(testTime, "/")]
testData <- testData[-1,]
if(nrow(testData) == 0) break
faultObj_ls <- do.call(faultFilter,
args = c(list(trainData = trainData,
testData = testData,
updateFreq = updateFreq,
faultsToTriggerAlarm = faultsToTriggerAlarm),
lazy_eval(ls)))
# Update the monitoring statistic values in the fault matrix. Because of
# the adaptive nature of the algorithm, many observations which would have
# been alarmed under the first run of faultFilter are now within normal
# limits. We update the fault matrix with new statistic values and flags.
fault_xts[index(faultObj_ls$faultObj),] <- faultObj_ls$faultObj
obsToKeepNew <- faultObj_ls$nonAlarmedTestObs
if(nrow(obsToKeepNew) != 0){
obsToKeep <- rbind(obsToKeep, obsToKeepNew)
}
}
# FaultChecks
faultNames <- colnames(fault_xts)
faultNames[5] <- "Alarm"
colnames(fault_xts) <- faultNames
# Alarms
alarms_xts <- fault_xts[fault_xts[,5] != 0, ]
alarmIndex <- index(alarms_xts)
alarmObs <- data[alarmIndex]
alarms_xts <- cbind(alarmObs, alarms_xts)
# thresholdObj: Training Thresholds and Projection Matrix
trainSpecs <- faultObj_ls$trainSpecs
list(FaultChecks = fault_xts,
Non_Alarmed_Obs = obsToKeep,
Alarms = alarms_xts,
TrainingSpecs = trainSpecs)
}