Skip to content

Commit e90b4f8

Browse files
maRce10maRce10
committed
fix typo
1 parent 3a928c2 commit e90b4f8

3 files changed

Lines changed: 161 additions & 161 deletions

File tree

‎.Rhistory‎

Lines changed: 158 additions & 158 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,111 @@
1+
if (simulated){
2+
# Creating vector for duration
3+
durs <- rep(c(0.3, 1), 5)
4+
# Creating simulated song
5+
set.seed(12)
6+
simulated_1 <- warbleR::simulate_songs(n = 10, durs = durs, freqs = 5, sig2 = 0.01, gaps = 0.5, harms = 1, bgn = 0.1, path = tempdir(), file.name = "simulated_1", selec.table = TRUE, shape = "cos", fin = 0.3, fout = 0.35, samp.rate = 18)
7+
sim_2 <- sim_songs(n = 10, durs = durs, freqs = 5, sig2 = 0.01, gaps = 0.5, harms = 1, bgn = 0.1, path = tempdir(), file.name = "simulated_2", selec.table = TRUE, shape = "cos", fin = 0.3, fout = 0.35, samp.rate = 18, am.amps = c(1, 2, 3, 2, 0.1, 2, 3, 3, 2, 1))
8+
sel_tab2 <- sel_tab1 <- simulated_1$selec.table
9+
sel_tab2$sound.files <- gsub("_1", "_2", sel_tab2$sound.files)
10+
sel_tab <- rbind(sel_tab1, sel_tab2)
11+
return(sel_tab)
12+
}
13+
# if (other.formats){
14+
# file.copy(from = system.file("extdata", "recording_20170716_230503.wac", package = "bioacoustics"), to = file.path(tempdir(), "recording_20170716_230503.wac"))
15+
#
16+
# file.copy(from = "../Phae.long4.mp3", to = file.path(tempdir(), "Phae.long4.mp3"))
17+
#
18+
# file.copy(from = file.path(tempdir(), "Phae.long1.wav"), to = file.path(tempdir(), "Phae.long5.wav"))
19+
#
20+
# wav2flac(file.path(tempdir(), "Phae.long5.wav"))
21+
#
22+
# if (selection.table){
23+
#
24+
# lbh_selec_table$sound.files <- as.character(lbh_selec_table$sound.files)
25+
#
26+
# sub_tab <- lbh_selec_table[lbh_selec_table$sound.files %in% c("Phae.long1.wav", "Phae.long4.wav"), 1:7]
27+
#
28+
# sub_tab$sound.files[sub_tab$sound.files == "Phae.long1.wav"] <- "Phae.long5.flac"
29+
#
30+
# sub_tab$sound.files[sub_tab$sound.files == "Phae.long4.wav"] <- "Phae.long4.mp3"
31+
#
32+
# # fix times
33+
# sub_tab$start[sub_tab$sound.files == "Phae.long4.mp3"] <- c(0.2085945, 1.5950019, 2.3057996)
34+
#
35+
# sub_tab$end[sub_tab$sound.files == "Phae.long4.mp3"] <- c(0.3528653, 1.7287163, 2.4289576)
36+
#
37+
#
38+
# sub_tab <- rbind(sub_tab, data.frame(sound.files = "recording_20170716_230503.wac", channel = 1, selec = 1, start = 0.1, end = 0.3, bottom.freq = 2, top.freq = 10))
39+
#
40+
# sub_tab <- rbind(sub_tab, lbh_selec_table[, 1:7])
41+
#
42+
# sub_tab$format <-ifelse(grepl("flac$", sub_tab$sound.files), "flac", ifelse(grepl("mp3$", sub_tab$sound.files), "mp3", "wav"))
43+
#
44+
#
45+
# return(sub_tab)
46+
# } else return(NULL)
47+
# }
48+
}
49+
# run all warbleR fuctions
50+
run.all <- function() invisible(lapply(list.files(pattern = "\\.R", path = "./R", full.names = T, all.files = T), function(x) source(x)))
51+
# run.all()
52+
list.selection.table <- function(lbh_selec_table, path = tempdir())
53+
{
54+
crr.dr <- getwd()
55+
on.exit(setwd(crr.dr))
56+
if(!is.null(path)) setwd(path)
57+
Xlist <- list()
58+
Xlist$Xdf <- lbh_selec_table
59+
Xlist$Xst <- selection_table(lbh_selec_table)
60+
Xlist$Xest <- selection_table(lbh_selec_table, extended = T, confirm.extended = F)
61+
lbh_selec_table$song <- as.numeric(lbh_selec_table$sound.files)
62+
Xlist$Xestbs <- selection_table(X = lbh_selec_table, extended = T, by.song = "song", confirm.extended = F)
63+
names(Xlist) <- c("DATA.FRAME", "SELECTION_TABLE", "EXTENDED_SELECTION_TABLE", "by.song.EXTENDED_SELECTION_TABLE")
64+
return(Xlist)
65+
}
66+
bi_mats <- function(X, labels) {
67+
# create empty matrix to store memebership matrix
68+
mat <- matrix(nrow = ncol(X), ncol = ncol(X))
69+
# add labels to row and col names
70+
rownames(mat) <- colnames(mat) <- labels
71+
# add 0 if same lek and 1 if else
72+
out <- lapply(1:(length(labels) - 1), function(i){
73+
sapply((i + 1):length(labels), function(j)
74+
if (labels[i] == labels[j]) 0 else 1)
75+
})
76+
# add to mat
77+
mat[lower.tri(mat)] <- unlist(out)
78+
# retunr as distance matrix
79+
return(as.dist(mat))
80+
}
81+
plot_detection <- function(reference, detection, lwd = 90, sep = 1, labels = detection$selec){
82+
if (!is.null(detection$detection.class)){
83+
labels <- ifelse(detection$detection.class == "true.positive", "\nTP", ifelse(detection$detection.class == "false.positive", "\nFP", ifelse(detection$detection.class == "false.negative", "\nFN", ifelse(detection$detection.class == "true.positive (split)", "\nTPs", ifelse(detection$detection.class == "true.positive (merged)", "\nTPm", ifelse(detection$detection.class == "negative (split)", "\nNs", ifelse(detection$detection.class == "negative (merged)", "\nNm", ifelse(detection$detection.class == "negative (split/merged)", "\nNsm", "\nTPsm"))))))))
84+
detection$labels <- paste0(detection$selec, labels)
85+
} else detection$labels <- detection$selec
86+
old_par <- par()
87+
old_par <- old_par[!names(old_par) %in% c("cin", "cra", "csi", "cxy", "din", "page")]
88+
on.exit(par(old_par))
89+
par(mar = rep(0, 4))
90+
n_sound.files <- length(unique(c(reference$sound.files, detection$sound.files)))
91+
if (n_sound.files > 1)
92+
par(mfrow = c(n_sound.files, 1))
93+
for (e in unique(c(detection$sound.files, reference$sound.files))){
94+
sub_detec <- detection[detection$sound.files == e, ]
95+
sub_ref <- reference[reference$sound.files == e, ]
96+
plot(x = range(c(sub_detec$start, sub_detec$end, sub_ref$start, sub_ref$end)), y = c(-1, 1), col = "white", pch = 21, yaxt = "n", ylab = "", xaxt = "n", xlab = "")
97+
# plot references first
98+
if (nrow(sub_ref) > 0)
99+
for (i in 1:nrow(sub_ref)){
100+
segments(
101+
x0 = sub_ref$start[i],
102+
x1 = sub_ref$end[i],
103+
y0 = sep / -2,
104+
y1 = sep / -2,
105+
lwd = lwd,
106+
col = viridis::magma(10, alpha = 0.4)[3],
107+
lend = 1
108+
)
1109
text(x = (sub_ref$end[i] + sub_ref$start[i]) / 2, y = sep / -2, labels = i, col = "white")
2110
}
3111
# add detections
@@ -31,134 +139,50 @@ return(sim_ref)
31139
sims <- do.call(rbind, sims_l)
32140
return(sims)
33141
}
34-
# set XC key
35-
if (!nzchar(Sys.getenv("xc_api_key")))
36-
Sys.setenv(xc_api_key = getPass::getPass())
37-
# update citation
38-
source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
39-
lintr::lint_package(linters = list(lintr::line_length_linter()))
40-
lintr::lint_package(linters = list(lintr::line_length_linter()))
41-
devtools::document(".")
42-
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
43-
up_amanitas_list <-
44-
lapply(split(sub_amanitas, sub_amanitas$repository), update_metadata)
45-
# merge updated metadata
46-
up_amanitas <- do.call(merge_metadata, up_amanitas_list)
47-
# check number of rows is the same (e.g. it has been updated)
48-
nrow(amanitas) == nrow(a_gioiosa) + nrow(a_orientigemmata)
49-
devtools::document(".")
50-
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
51-
beepr::beep(3)
52-
devtools::document(".")
53-
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
54-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
55-
source("~/Dropbox/R_package_testing/suwo/R/internal_functions.R")
56-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
57-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
58-
merged_data <- read.csv("map_location_vignette_data.csv")
59-
merged_data <- read.csv("./vignettes/map_location_vignette_data.csv")
60-
op_sound <- merged_data[
61-
merged_data$format == "sound" & merged_data$species == "Oophaga pumilio",
62-
]
63-
op_image_ca_sample <- merged_data[merged_data$format == "image", ]
64-
cm_video_display <- merged_data[merged_data$format == "video", ]
65-
alouatta_sound <- merged_data[grep("Alouatta", merged_data$species), ]
66-
# get metadata
67-
op_image <- query_inaturalist(
68-
species = "Oophaga pumilio",
142+
run.all()
143+
df1 <- query_gbif(
144+
species = 'Phaethornis anthophilus',
145+
all_data = FALSE,
69146
format = "image"
70147
)
71-
# restrict only to those in its natural range (Central America)
72-
op_image_ca <- op_image[
73-
op_image$latitude >= 7 &
74-
op_image$latitude <= 15 &
75-
op_image$longitude >= -90 &
76-
op_image$longitude <= -80 &
77-
!is.na(op_image$latitude),
78-
]
79-
# restrict only to those in its natural range (Central America)
80-
op_image_ca <- op_image[
81-
op_image$latitude >= 7 &
82-
op_image$latitude <= 15 &
83-
op_image$longitude >= -90 &
84-
op_image$longitude <= -80 &
85-
!is.na(op_image$latitude),
86-
]
87-
# make map
88-
map_locations(
89-
metadata = op_image_ca_sample
90-
)
91-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
92-
# make map
93-
map_locations(
94-
metadata = op_image_ca_sample
95-
)
96-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
97-
# make map
98-
map_locations(
99-
metadata = op_image_ca_sample
100-
)
101-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
102-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
103-
# make map
104-
map_locations(
105-
metadata = op_image_ca_sample
106-
)
107-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
108-
# make map
109-
map_locations(
110-
metadata = op_image_ca_sample
111-
)
112-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
113-
# make map
114-
map_locations(
115-
metadata = op_image_ca_sample
116-
)
117-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
118-
source("~/Dropbox/R_package_testing/suwo/R/map_locations.R")
119-
# make map
120-
map_locations(
121-
metadata = op_image_ca_sample
122-
)
123-
# make map
124-
map_locations(
125-
alouatta_sound,
126-
by = "species",
127-
show_media = FALSE,
128-
palette = grDevices::hcl.colors # viridis palette
129-
)
130-
devtools::reload()
131-
devtools::document()
132-
devtools::document()
133-
devtools::reload()
134-
devtools::reload()
148+
df2 <- df1[df1$key %in% c("5063794756", "5077057045"), ]
149+
sxc1 <- df2[!duplicated(df2$key), ][1:2, ]
150+
a <- download_media(metadata = sxc1, path = tempdir())
151+
fls <- list.files(path = tempdir(), pattern = "jpeg$")
152+
a
153+
fls <- list.files(path = tempdir(), pattern = "jpeg$")
154+
library(warbleR)
155+
open_wd(tempdir())
156+
a
135157
devtools::document()
136-
devtools::reload()
137-
lintr::lint_packag(linters = list(lintr::line_length_linter()))
138-
lintr::lint_package(linters = list(lintr::line_length_linter()))
158+
help("download_media")
159+
all(
160+
c("download_status", "downloaded_file_name", "file_size") %in% names(a)
161+
)
162+
# remove filess
163+
unlink(file.path(tempdir(), a$downloaded_file_name))
164+
a <- download_media(metadata = sxc1, path = tempdir(), folder_by = "country")
165+
a
166+
source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
139167
if (!nzchar(Sys.getenv("xc_api_key")))
140168
Sys.setenv(xc_api_key = getPass::getPass())
141-
# update vignette (Need XC key)
142-
# if (nzchar(Sys.getenv("xc_api_key")))
143-
# source("~/Dropbox/R_package_testing/suwo/vignettes/precompile.R")
144169
devtools::document(".")
145170
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
146171
beepr::beep(3)
147-
if (!nzchar(Sys.getenv("xc_api_key")))
148-
Sys.setenv(xc_api_key = getPass::getPass())
149-
# update vignette (Need XC key)
150-
# if (nzchar(Sys.getenv("xc_api_key")))
151-
# source("~/Dropbox/R_package_testing/suwo/vignettes/precompile.R")
152172
devtools::document(".")
153173
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
154174
beepr::beep(3)
155-
# update citation
156-
source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
157-
# update citation
158-
source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
159-
source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
160-
source("~/Dropbox/R_package_testing/suwo/R/download_media.R")
161-
source("~/Dropbox/R_package_testing/suwo/R/download_media.R")
175+
system("air format . --check")
176+
system("air format ./R --check")
177+
system("air format ./R --check")
178+
system("air format ./R --check")
179+
system("air format . --check")
180+
system("air format .")
181+
system("air format . --check")
182+
citation("suwo")
183+
devtools::install()
184+
citation("suwo")
185+
cat(format(citation("suwo"), style = "text"))
162186
# devtools::install()
163187
remotes::install_github("ropensci-review-tools/pkgcheck")
164188
pkgs <- c("remotes", "curl", "RCurl", "jsonlite", "crayon", "devtools", "leaflet", "maps", "pkgcheck", "pkgstats", "testthat", "styler", "cli", "beepr", "RecordLinkage", "getPass")
@@ -467,46 +491,22 @@ sims <- do.call(rbind, sims_l)
467491
return(sims)
468492
}
469493
run.all()
470-
df1 <- query_gbif(
471-
species = 'Phaethornis anthophilus',
472-
all_data = FALSE,
473-
format = "image"
494+
df1 <- query_macaulay(
495+
species = 'Glaucis dohrnii',
496+
format = "sound",
497+
path = tempdir()
474498
)
475-
df2 <- df1[df1$key %in% c("5063794756", "5077057045"), ]
476-
sxc1 <- df2[!duplicated(df2$key), ][1:2, ]
477-
a <- download_media(metadata = sxc1, path = tempdir())
478-
fls <- list.files(path = tempdir(), pattern = "jpeg$")
479-
a
480-
fls <- list.files(path = tempdir(), pattern = "jpeg$")
481-
library(warbleR)
482-
open_wd(tempdir())
483-
a
484-
devtools::document()
485-
help("download_media")
486-
all(
487-
c("download_status", "downloaded_file_name", "file_size") %in% names(a)
499+
load("~/Dropbox/R_package_testing/suwo/R/sysdata.rda")
500+
df1 <- query_macaulay(
501+
species = 'Glaucis dohrnii',
502+
format = "sound",
503+
path = tempdir()
504+
)
505+
source("~/Dropbox/R_package_testing/suwo/R/internal_functions.R")
506+
source("~/Dropbox/R_package_testing/suwo/R/internal_functions.R")
507+
source("~/Dropbox/R_package_testing/suwo/R/query_macaulay.R")
508+
df1 <- query_macaulay(
509+
species = 'Glaucis dohrnii',
510+
format = "sound",
511+
path = tempdir()
488512
)
489-
# remove filess
490-
unlink(file.path(tempdir(), a$downloaded_file_name))
491-
a <- download_media(metadata = sxc1, path = tempdir(), folder_by = "country")
492-
a
493-
source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
494-
if (!nzchar(Sys.getenv("xc_api_key")))
495-
Sys.setenv(xc_api_key = getPass::getPass())
496-
devtools::document(".")
497-
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
498-
beepr::beep(3)
499-
devtools::document(".")
500-
devtools::check(document = TRUE, run_dont_test = TRUE, vignettes = TRUE, manual = TRUE)
501-
beepr::beep(3)
502-
system("air format . --check")
503-
system("air format ./R --check")
504-
system("air format ./R --check")
505-
system("air format ./R --check")
506-
system("air format . --check")
507-
system("air format .")
508-
system("air format . --check")
509-
citation("suwo")
510-
devtools::install()
511-
citation("suwo")
512-
cat(format(citation("suwo"), style = "text"))

‎R/internal_functions.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -556,7 +556,7 @@
556556
.message(
557557
text = paste0(
558558
"{n} observation{?s} d{?oes/o} not have a download link and w{?as/ere}",
559-
" removed from the results (inlcuded as an attribute called",
559+
" removed from the results (included as an attribute called",
560560
" 'excluded_results')",
561561
".\n"
562562
),

‎vignettes/suwo.Rmd‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1163,7 +1163,7 @@ truf_gbf <- query_gbif(species = "Turdus rufiventris", format = "sound")
11631163
```
11641164

11651165
```
1166-
! 2 observations do not have a download link and were removed from the results (inlcuded as an attribute called 'excluded_results').
1166+
! 2 observations do not have a download link and were removed from the results (included as an attribute called 'excluded_results').
11671167
```
11681168

11691169
``` r
@@ -1913,7 +1913,7 @@ d_holocanthus <- query_gbif(species = "Diodon holocanthus", format = "image")
19131913
```
19141914

19151915
```
1916-
! 1 observation does not have a download link and was removed from the results (inlcuded as an attribute called 'excluded_results').
1916+
! 1 observation does not have a download link and was removed from the results (included as an attribute called 'excluded_results').
19171917
```
19181918

19191919
``` r

0 commit comments

Comments
 (0)