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
|
## The multitaper R package
## Multitaper and spectral analysis package for R
## Copyright (C) 2011 Karim Rahim
##
## Written by Karim Rahim.
##
## This file is part of the multitaper package for R.
## http://cran.r-project.org/web/packages/multitaper/index.html
##
## The multitaper package is free software: you can redistribute it and
## or modify it under the terms of the GNU General Public License as
## published by the Free Software Foundation, either version 2 of the
## License, or any later version.
##
## The multitaper package is distributed in the hope that it will be
## useful, but WITHOUT ANY WARRANTY; without even the implied warranty
## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with multitaper. If not, see <http://www.gnu.org/licenses/>.
##
## If you wish to report bugs please contact the author:
##
## Karim Rahim
## karim.rahim@gmail.com
################################################################
##
## dropFreqs.*
##
## Plotting utility functions that allow the user to subselect
## a frequency range of interest, and 'drop' the extraneous
## frequencies. Note that these functions are intended to be
## used only at the end of analysis, as once they have been
## applied to an object, the result is not suitable for
## passing into any further computational routines (such as
## mtm.coh).
##
################################################################
# Handler
dropFreqs <- function(spec, minFreq, maxFreq) UseMethod("dropFreqs")
# Fall-through case
dropFreqs.default <- function(spec, minFreq, maxFreq) {
print("This function is only valid for objects of spec, mtm, or mtm.coh classes")
spec
}
# Spectrum object
dropFreqs.spec <- function(spec, minFreq, maxFreq) {
idx <- (findInterval(spec$freq, c(minFreq,maxFreq)) == 1)
if(sum(idx) <= 1) {
stop("minFreq and maxFreq must allow for a range of frequencies to be returned")
}
spec.out <- spec
spec.out$freq <- spec$freq[idx]
spec.out$spec <- spec$spec[idx]
spec.out
}
# mtm object
dropFreqs.mtm <- function(spec, minFreq, maxFreq) {
idx <- (findInterval(spec$freq, c(minFreq,maxFreq)) == 1)
if(sum(idx) <= 1) {
stop("minFreq and maxFreq must allow for a range of frequencies to be returned")
}
spec.out <- spec
spec.out$freq <- spec$freq[idx]
spec.out$spec <- spec$spec[idx]
##adjust mtm parameters
if(!is.null(spec.out$mtm)) {
## null unnecessary values
## enforces fact that currently function is mainly a
## plotting utility
spec.out$mtm$dpss <- NULL
spec.out$mtm$eigenCoefs <- NULL
spec.out$mtm$eigenCoefsWt <- NULL
## keep values used in plotting
spec.out$mtm$Ftest <- spec.out$mtm$Ftest[idx]
spec.out$mtm$dofs <- spec.out$mtm$dofs[idx]
if(!is.null(spec.out$mtm$jk)) {
spec.out$mtm$jk$varjk <- NULL
spec.out$mtm$jk$upperCI <- spec.out$mtm$jk$upperCI[idx]
spec.out$mtm$jk$maxVal <- max(spec.out$mtm$jk$upperCI)
spec.out$mtm$jk$bcjk <- NULL
spec.out$mtm$jk$lowerCI <- spec.out$mtm$jk$lowerCI[idx]
spec.out$mtm$jk$sjk <- NULL
spec.out$mtm$jk$minVal <- min(spec.out$mtm$jk$lowerCI)
}
}
spec.out
}
# mtm.coh object
dropFreqs.mtm.coh <- function(spec, minFreq, maxFreq) {
idx <- (findInterval(spec$freq, c(minFreq,maxFreq)) == 1)
if(sum(idx) <= 1) {
stop("minFreq and maxFreq must allow for a range of frequencies to be returned")
}
spec.out <- spec
spec.out$NTmsc <- spec.out$NTmsc[idx]
spec.out$msc <- spec.out$msc[idx]
spec.out$NTvar <- spec.out$NTvar[idx]
spec.out$freq <- spec.out$freq[idx]
spec.out$ph <- spec.out$ph[idx]
spec.out$phvar <- spec.out$phvar[idx]
spec.out$nfreqs <- sum(idx)
spec.out
}
|
