/
filter_sels.R
executable file
·202 lines (179 loc) · 8.93 KB
/
filter_sels.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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
#' Subset selection data frames based on manually filtered image files
#'
#' \code{filter_sels} subsets selection data frames based on image files that have been manually filtered.
#' @usage filter_sels(X, path = NULL, lspec = FALSE, img.suffix = NULL, it = "jpeg",
#' incl.wav = TRUE, missing = FALSE, index = FALSE)
#' @param X object of class 'selection_table', 'extended_selection_table' or data frame with the following columns: 1) "sound.files": name of the .wav
#' files, 2) "sel": number of the selections.
#' @param path Character string containing the directory path where the image files are located.
#' If \code{NULL} (default) then the current working directory is used.
#' \code{\link{warbleR_options}} 'wav.path' argument does not apply.
#' @param lspec A logical argument indicating if the image files to be use for filtering were produced by the function \code{\link{full_spectrograms}}.
#' All the image files that correspond to a sound file must be deleted in order to be
#' filtered out.
#' @param img.suffix A character vector of length 1 with the suffix (label) at the end
#' of the names of the image files. Default is \code{NULL} (i.e. no suffix as in the images
#' produced by \code{\link{spectrograms}}). Ignored if \code{lspec = TRUE}.
#' @param it A character vector of length 1 giving the image type ("tiff", "jpeg" or "pdf") Default is "jpeg". Note that pdf files can only be generated by \code{\link{lspec2pdf}}.
#' @param incl.wav Logical. To indicate if sound files extensions are included ( \code{TRUE}, default) or not in the image
#' file names.
#' @param missing Logical. Controls whether the output data frame (or row index if is \code{index = TRUE})
#' contains the selections with images in the working directory (Default, \code{missing = FALSE})
#' or the ones with no image.
#' @param index Logical. If \code{TRUE} and \code{missing = FALSE} the row index for the selections with images in the working directory is returned. If \code{missing = TRUE}) then the row index of the ones with no image is returned instead. Default is \code{FALSE}.
#' @return If all sound files are ok, returns message "All files are ok!".
#' Otherwise returns "These file(s) cannot be read" message with names of the
#' corrupted sound files.
#' @details This function subsets selections (or sound files if \code{lspec} is \code{TRUE}) listed in a data frame
#' based on the image files from spectrogram-creating functions (e.g. \code{\link{spectrograms}}) in the
#' working directory. Only the selections/sound files with and image in the working directory will remain.
#' This is useful for excluding selections from undesired signals. Note that the
#' image files should be in the working directory (or the directory provided in 'path').
#' @export
#' @name filter_sels
#' @examples \dontrun{
#' # save wav file examples
#' data(list = c("Phae.long1", "Phae.long2", "Phae.long3", "lbh_selec_table"))
#' writeWave(Phae.long1, file.path(tempdir(), "Phae.long1.wav"))
#' writeWave(Phae.long2, file.path(tempdir(), "Phae.long2.wav"))
#' writeWave(Phae.long3, file.path(tempdir(), "Phae.long3.wav"))
#'
#' spectrograms(lbh_selec_table,
#' flim = c(0, 11), inner.mar = c(4, 4.5, 2, 1), outer.mar = c(4, 2, 2, 1),
#' picsize = 2, res = 300, cexlab = 2, mar = 0.05, wl = 300, path = tempdir()
#' )
#'
#' # go to the working directory (tempdir()) and delete some images
#'
#' # filter selection data frame
#' fmloc <- filter_sels(X = lbh_selec_table, path = tempdir())
#'
#' # this data frame does not have the selections corresponding to the images that were deleted
#' fmloc
#'
#' # now using lspec images
#' full_spectrograms(
#' sxrow = 2, rows = 8, pal = reverse.heat.colors, wl = 300, ovlp = 10,
#' path = tempdir()
#' )
#'
#' # go to the working directory (tempdir()) and delete lspec
#' # images (the ones with several rows of spectrograms)
#'
#' # filter selection data frame
#' fmloc2 <- filter_sels(
#' X = lbh_selec_table, lspec = TRUE,
#' path = tempdir()
#' )
#' }
#'
#' @references {
#' Araya-Salas, M., & Smith-Vidaurre, G. (2017). warbleR: An R package to streamline analysis of animal acoustic signals. Methods in Ecology and Evolution, 8(2), 184-191.
#' }
#' @author Marcelo Araya-Salas (\email{marcelo.araya@@ucr.ac.cr})
# last modification on feb-6-2017 (MAS)
filter_sels <- function(X, path = NULL, lspec = FALSE, img.suffix = NULL, it = "jpeg",
incl.wav = TRUE, missing = FALSE, index = FALSE) {
#### set arguments from options
# get function arguments
argms <- methods::formalArgs(filter_sels)
# get warbleR options
opt.argms <- if (!is.null(getOption("warbleR"))) getOption("warbleR") else SILLYNAME <- 0
# remove options not as default in call and not in function arguments
opt.argms <- opt.argms[!sapply(opt.argms, is.null) & names(opt.argms) %in% argms]
# get arguments set in the call
call.argms <- as.list(base::match.call())[-1]
# remove arguments in options that are in call
opt.argms <- opt.argms[!names(opt.argms) %in% names(call.argms)]
# set options left
if (length(opt.argms) > 0) {
for (q in seq_len(length(opt.argms))) {
assign(names(opt.argms)[q], opt.argms[[q]])
}
}
# check path to working directory
if (is.null(path)) {
path <- getwd()
} else if (!dir.exists(path)) {
stop2("'path' provided does not exist")
} else {
path <- normalizePath(path)
}
# if X is not a data frame
if (!any(is.data.frame(X), is_selection_table(X), is_extended_selection_table(X))) stop2("X is not of a class 'data.frame', 'selection_table' or 'extended_selection_table'")
# if it argument is not "jpeg" or "tiff"
if (!any(it == "jpeg", it == "tiff", it == "pdf")) stop2(paste("Image type", it, "not allowed"))
if (!all(c("sound.files", "selec") %in% colnames(X))) {
stop2(paste(paste(c("sound.files", "selec")[!(c("sound.files", "selec") %in% colnames(X))], collapse = ", "), "column(s) not found in data frame"))
}
if (it != "pdf") {
# check if files are in working directory
imgs <- list.files(path = path, pattern = "\\.jpeg$|\\.tiff$", ignore.case = FALSE)
if (length(imgs) == 0) {
stop2("No image files in working directory")
}
# if not long spec
if (!lspec) {
# if img suffix not provided
if (is.null(img.suffix)) {
# if .wav extension is included
if (incl.wav) {
imgn <- paste(paste(X$sound.files, X$selec, sep = "-"), it, sep = ".")
} else {
imgn <- paste(paste(gsub("\\.wav$|\\.wac$|\\.mp3$|\\.flac$", "", X$sound.files, ignore.case = TRUE), X$selec, sep = "-"), it, sep = ".")
}
} else {
if (incl.wav) {
imgn <- paste(paste(X$sound.files, X$selec, img.suffix, sep = "-"), it, sep = ".")
} else {
imgn <- paste(paste(gsub("\\.wav$|\\.wac$|\\.mp3$|\\.flac$", "", X$sound.files, ignore.case = TRUE), X$selec, img.suffix, sep = "-"), it, sep = ".")
}
}
# subset data frame X
miss.index <- imgn %in% imgs
if (!index) {
if (missing) Y <- X[!miss.index, , drop = FALSE] else Y <- X[miss.index, , drop = FALSE]
} else if (missing) Y <- which(!miss.index) else Y <- which(miss.index)
} else {
# #remove the ones with no pX.it ending
imgs <- grep("p\\d+\\.jpeg|p\\d+\\.tiff", imgs, value = TRUE)
if (length(imgs) == 0) stop2("Images have not been produced by 'full_spectrograms' function")
# subset selection table
miss.index <- gsub("\\.wav$|\\.wac$|\\.mp3$|\\.flac$", "", X$sound.files, ignore.case = TRUE) %in% gsub("-p\\d+\\.jpeg$|-p\\d+\\.tiff$", "", imgs)
if (!index) {
if (missing) Y <- X[!miss.index, , drop = FALSE] else Y <- X[miss.index, , drop = FALSE]
} else if (missing) Y <- which(!miss.index) else Y <- which(miss.index)
}
} else {
# check if pdf files are in working directory
imgs <- list.files(path = path, pattern = ".pdf$", ignore.case = FALSE)
if (length(imgs) == 0) {
stop2("No pdf files in working directory")
}
# subset selection table
miss.index <- gsub("\\.wav$|\\.wac$|\\.mp3$|\\.flac$", "", X$sound.files, ignore.case = TRUE) %in% gsub(".pdf$", "", imgs)
if (!index) {
if (missing) miss.index <- !miss.index
Y <- X[miss.index, , drop = FALSE]
if (is_extended_selection_table(X)) {
attributes(X)$check.results <- droplevels(attributes(X)$check.results[miss.index, ])
}
} else {
Y <- which(miss.index)
}
}
if (!index) {
if (nrow(Y) == 0) stop2("Image files in working directory do not match sound file names in X (wrong working directory?)")
return(Y)
} else {
if (length(Y) == 0) message2("Index vector is of length 0")
return(Y)
}
}
##############################################################################################################
#' alternative name for \code{\link{filter_sels}}
#'
#' @keywords internal
#' @details see \code{\link{filter_sels}} for documentation. \code{\link{filtersels}} will be deprecated in future versions.
#' @export
filtersels <- filter_sels