added access_wikiaves and modify query_wikiaves to deal with cloudfare block

Author: maRce10

.Rhistory

@@ -1,98 +1,3 @@
-# add 0 if same lek and 1 if else
-out <- lapply(1:(length(labels) - 1), function(i){
-sapply((i + 1):length(labels), function(j)
-if (labels[i] == labels[j]) 0 else 1)
-})
-# add to mat
-mat[lower.tri(mat)] <- unlist(out)
-# retunr as distance matrix
-return(as.dist(mat))
-}
-plot_detection <- function(reference, detection, lwd = 90, sep = 1, labels = detection$selec){
-if (!is.null(detection$detection.class)){
-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"))))))))
-detection$labels <- paste0(detection$selec, labels)
-} else detection$labels <- detection$selec
-old_par <- par()
-old_par <- old_par[!names(old_par) %in%  c("cin", "cra", "csi", "cxy", "din", "page")]
-on.exit(par(old_par))
-par(mar = rep(0, 4))
-n_sound.files <- length(unique(c(reference$sound.files, detection$sound.files)))
-if (n_sound.files > 1)
-par(mfrow = c(n_sound.files, 1))
-for (e in unique(c(detection$sound.files, reference$sound.files))){
-sub_detec <- detection[detection$sound.files == e, ]
-sub_ref <- reference[reference$sound.files == e, ]
-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 = "")
-# plot references first
-if (nrow(sub_ref) > 0)
-for (i in 1:nrow(sub_ref)){
-segments(
-x0 = sub_ref$start[i],
-x1 = sub_ref$end[i],
-y0 = sep / -2,
-y1 = sep / -2,
-lwd = lwd,
-col = viridis::magma(10, alpha = 0.4)[3],
-lend = 1
-)
-text(x = (sub_ref$end[i] + sub_ref$start[i]) / 2, y = sep / -2, labels = i, col = "white")
-}
-# add detections
-if (nrow(sub_detec) > 0)
-for (i in 1:nrow(sub_detec)){
-segments(
-x0 = sub_detec$start[i],
-x1 = sub_detec$end[i],
-y0 = sep / 2,
-y1 = sep / 2,
-lwd = lwd,
-col = viridis::magma(10, alpha = 0.4)[7],
-lend = 1
-)
-text(x = (sub_detec$end[i] + sub_detec$start[i]) / 2, y = sep / 2, labels = sub_detec$labels[i])
-}
-}
-}
-### simulate annotation tables
-# cannot have duration shorter than 2
-sim_annotation <- function(n = 10, n.sound.files = 1){
-sims_l <- lapply(1:n.sound.files, function(x){
-possible_start <- seq(0, 98, 2)
-sim_ref <- data.frame(sound.files = paste0(x, ".wav"), selec = 1:(n + 1), start = sort(c(sample(possible_start, n), 100)))
-sim_ref$end <- NA
-for(i in 1:(n))
-sim_ref$end[i] <- sim_ref$start[i] + round(runif(n = 1, min = 1, max = sim_ref$start[i + 1] - sim_ref$start[i] - 0.5))
-sim_ref <- sim_ref[-nrow(sim_ref), ]
-return(sim_ref)
-})
-sims <- do.call(rbind, sims_l)
-return(sims)
-}
-run.all()
-df1 <- query_gbif(
-species = 'Phaethornis anthophilus',
-all_data = FALSE,
-format = "image"
-)
-df2 <- df1[df1$key %in% c("5063794756", "5077057045"), ]
-sxc1 <- df2[!duplicated(df2$key), ][1:2, ]
-a <- download_media(metadata = sxc1, path = tempdir())
-fls <- list.files(path = tempdir(), pattern = "jpeg$")
-a
-fls <- list.files(path = tempdir(), pattern = "jpeg$")
-library(warbleR)
-open_wd(tempdir())
-a
-devtools::document()
-help("download_media")
-all(
-c("download_status", "downloaded_file_name", "file_size") %in% names(a)
-)
-# remove filess
-unlink(file.path(tempdir(), a$downloaded_file_name))
-a <- download_media(metadata = sxc1, path = tempdir(), folder_by = "country")
-a
 source("~/Dropbox/R_package_testing/suwo/testing/update_citation.R")
 if (!nzchar(Sys.getenv("xc_api_key")))
 Sys.setenv(xc_api_key = getPass::getPass())
@@ -440,73 +345,168 @@ species = 'Glaucis dohrnii',
 format = "sound",
 path = tempdir()
 )
-library(hexSticker)
-install.packages("hexSticker")
-library(hexSticker)
-sticker(
-subplot = "./testing/sticker_testing/logo_v3.png",   # your image
-package = "suwo",
-s_x = 1,
-s_y = 0.9,
-s_width = 1,
-p_x = 1,
-p_y = 0.15,
-h_fill = "white",
-h_color = "black",
-p_color = "black",
-p_size = 18,
-filename = "suwo_sticker.png"
+library(devtools)
+load_all()
+wa <- query_wikiaves("Procnias verano")
+species <- "Procnias verano"
+format = getOption("suwo_format", c("image", "sound"))
+cores = getOption("suwo_cores", 1)
+pb = getOption("suwo_pb", TRUE)
+verbose = getOption("suwo_verbose", TRUE)
+all_data = getOption("suwo_all_data", FALSE)
+raw_data = getOption("suwo_raw_data", FALSE)
+!.checkconnection(verb = verbose, service = "wikiaves")
+source("~/Dropbox/R_package_testing/suwo/R/query_wikiaves.R")
+wa <- query_wikiaves("Procnias verano")
+# assign a value to format
+format <- rlang::arg_match(format, values = c("image", "sound"))
+wiki_format <- switch(format, sound = "s", image = "f")
+# initialize search with user agent
+request_obj <- httr2::request(
+"https://www.wikiaves.com.br/getTaxonsJSON.php"
+)
+request_obj <- httr2::req_url_query(
+request_obj,
+term = species
+)
+request_obj <- httr2::req_user_agent(
+request_obj,
+"suwo (https://github.com/ropensci/suwo)"
+)
+response <- httr2::req_perform(request_obj)
+rlang::last_trace()
+wa <- query_wikiaves("Procnias verano")
+devtools::load_all()
+species <- "Procnias averano"
+format <- "sound"
+cores = getOption("suwo_cores", 1)
+pb = getOption("suwo_pb", TRUE)
+verbose = getOption("suwo_verbose", TRUE)
+all_data = getOption("suwo_all_data", FALSE)
+raw_data = getOption("suwo_raw_data", FALSE)
+##  argument checking
+check_results <- .check_arguments(
+fun = "query_wikiaves",
+args = list(
+species = species,
+format = format,
+cores = cores,
+pb = pb,
+verbose = verbose,
+all_data = all_data,
+raw_data = raw_data
+)
+)
+# report errors
+.report_assertions(check_results)
+if (!.checkconnection(verb = verbose, service = "wikiaves")) {
+return(invisible(NULL))
+}
+# assign a value to format
+format <- rlang::arg_match(format, values = c("image", "sound"))
+wiki_format <- switch(format, sound = "s", image = "f")
+url <- paste0(
+"https://www.wikiaves.com.br/getTaxonsJSON.php?term=",
+utils::URLencode(species, reserved = TRUE)
+)
+utils::browseURL(url)
+id <- readline(
+"\nA browser window has been opened.\n\nCopy the JSON response (or just the species ID) and paste it here:\n> "
+)
+# User pasted just the ID
+if (grepl("^\\d+$", id)) {
+species_id <- as.integer(id)
+# User pasted the JSON
+} else {
+species_id <- jsonlite::fromJSON(id)$id
+}
+species_id
+get_ids <- data.frame(
+id = species_id,
+label = species,
+stringsAsFactors = FALSE
+)
+get_ids
+if (length(get_ids) > 1) {
+get_ids <- get_ids[
+trimws(tolower(get_ids$label)) == trimws(tolower(species)),
+]
+}
+if (length(get_ids) == 0) {
+if (verbose) {
+.message("Search species not found", as = "failure")
+}
+return(invisible(NULL))
+}
+get_ids$total_registers <- vapply(
+seq_len(nrow(get_ids)),
+function(u) {
+request_obj <- httr2::request(
+"https://www.wikiaves.com.br/getRegistrosJSON.php"
 )
-sticker(
-subplot = "./testing/sticker_testing/logo_v3.png",   # your image
-package = "",
-s_x = 1,
-s_y = 0.9,
-s_width = 1,
-p_x = 1,
-p_y = 0.15,
-h_fill = "white",
-h_color = "black",
-p_color = "black",
-p_size = 18,
-filename = "suwo_sticker.png"
+request_obj <- httr2::req_url_query(
+request_obj,
+tm = wiki_format,
+t = "s",
+s = get_ids$id[u],
+o = "mp",
+p = 1
+)
+request_obj <-
+httr2::req_user_agent(
+request_obj,
+"suwo (https://github.com/ropensci/suwo)"
+)
+request_obj <- httr2::req_error(request_obj, is_error = function(resp) {
+FALSE
+})
+response <- try(httr2::req_perform(request_obj), silent = TRUE)
+# if fail request return -9999
+if (.is_error(response)) {
+return(-999)
+}
+# check if request succeeded
+if (httr2::resp_is_error(response)) {
+return(-999)
+}
+content <- httr2::resp_body_json(response)
+as.numeric(content$registros$total)
+},
+numeric(1)
 )
-sticker(
-subplot = "./testing/sticker_testing/logo_v3.png",   # your image
-package = "",
-s_width = 1.05,
-h_fill = NA,
-h_color = NA,
-filename = "suwo_sticker.png"
+# let user gracefully know error when downloading metadata
+if (
+any(vapply(
+get_ids$total_registers,
+function(x) x == -999,
+FUN.VALUE = logical(1)
+))
+) {
+if (verbose) {
+.message(text = "Metadata could not be downloaded", as = "failure")
+}
+return(invisible(NULL))
+}
+seq_len(nrow(get_ids))
+u = 1
+request_obj <- httr2::request(
+"https://www.wikiaves.com.br/getRegistrosJSON.php"
 )
-sticker(
-subplot = "./testing/sticker_testing/logo_v3.png",   # your image
-package = "",
-h_fill = NA,
-h_color = NA,
-filename = "suwo_sticker.png"
+request_obj <- httr2::req_url_query(
+request_obj,
+tm = wiki_format,
+t = "s",
+s = get_ids$id[u],
+o = "mp",
+p = 1
 )
-library(magick)
-img <- image_read("./testing/sticker_testing/logo_v3.png")
-# remove outer whitespace
-img2 <- image_trim(img)
-img2
-image_write(img2, "./testing/sticker_testing/suwo_trimmed.png")
-sticker(
-subplot = "./testing/sticker_testing/suwo_trimmed.png",   # your image
-package = "",
-h_fill = NA,
-h_color = NA,
-filename = "suwo_sticker.png"
+request_obj <-
+httr2::req_user_agent(
+request_obj,
+"suwo (https://github.com/ropensci/suwo)"
 )
-image_write(img2, "./testing/sticker_testing/suwo_sticker.png")
-img <- image_read("./testing/sticker_testing/logo_v3.png")
-# remove outer whitespace
-img2 <- image_trim(img)
-image_write(img2, "./testing/sticker_testing/suwo_sticker.png")
-image_write(img2, "./suwo_sticker.png")
-img <- image_read("./testing/sticker_testing/logo_v3.png")
-# remove outer whitespace
-img2 <- image_trim(img)
-image_write(img2, "./suwo_sticker.png")
-pkgdown::build_favicons(overwrite = TRUE)
+request_obj <- httr2::req_error(request_obj, is_error = function(resp) {
+FALSE
+})
+response <- try(httr2::req_perform(request_obj), silent = TRUE)
+response

.Rproj.user/shared/notebooks/paths

@@ -1,3 +1,25 @@
-/home/marce/Dropbox/R_package_testing/suwo/testing/testing-checking suwo functions.qmd="6A351C16"
-/home/marce/Dropbox/R_package_testing/suwo/vignettes/suwo.Rmd="9049964F"
-/home/marce/Dropbox/R_package_testing/suwo/vignettes/suwo.Rmd.orig="3083E820"
+/home/m/Downloads/access_wikiaves.R="618EEC3E"
+/home/m/Downloads/access_wikiaves_1.R="FBDA1B60"
+/home/m/Downloads/access_wikiaves_2.R="EB8B4BCD"
+/home/m/Downloads/access_wikiaves_3.R="9809F108"
+/home/m/Downloads/access_wikiaves_4.R="4DDB9152"
+/home/m/Downloads/test_access_wikiaves.R="975585FE"
+/home/m/Downloads/test_access_wikiaves_1.R="BD7FCC16"
+/home/m/Downloads/test_access_wikiaves_2.R="2BA5AA34"
+/home/m/Dropbox/R_package_testing/suwo/DESCRIPTION="B1903E1C"
+/home/m/Dropbox/R_package_testing/suwo/R/access_wikiaves.R="53445A66"
+/home/m/Dropbox/R_package_testing/suwo/R/internal_functions.R="27D78764"
+/home/m/Dropbox/R_package_testing/suwo/R/query_macaulay.R="CF3158F1"
+/home/m/Dropbox/R_package_testing/suwo/R/query_wikiaves.R="B908ECFA"
+/home/m/Dropbox/R_package_testing/suwo/R/query_xenocanto.R="8EF58527"
+/home/m/Dropbox/R_package_testing/suwo/pkgdown/_pkgdown.yml="A4B63824"
+/home/m/Dropbox/R_package_testing/suwo/testing/fixWikiAves.R="F73C460D"
+/home/m/Dropbox/R_package_testing/suwo/testing/fixWikiAves_v2.R="5C844C8E"
+/home/m/Dropbox/R_package_testing/suwo/testing/suwo_v2.Rmd="3583BEDA"
+/home/m/Dropbox/R_package_testing/suwo/testing/suwo_vignette.Rmd="E870F6A9"
+/home/m/Dropbox/R_package_testing/suwo/testing/suwo_vignette2.Rmd="E18FEA8F"
+/home/m/Dropbox/R_package_testing/suwo/testing/testing-checking suwo functions.qmd="28715DE9"
+/home/m/Dropbox/R_package_testing/suwo/tests/testthat/test_query_wikiaves.R="F8D844BB"
+/home/m/Dropbox/R_package_testing/suwo/tests/testthat/test_query_xenocanto.R="AAC1D46F"
+/home/m/Dropbox/R_package_testing/suwo/vignettes/suwo.Rmd="A514BC9D"
+/home/m/Dropbox/R_package_testing/suwo/vignettes/suwo.Rmd.orig="8DBFCEA3"

DESCRIPTION

@@ -29,11 +29,13 @@ Suggests:
     jpeg,
     fs,
     kableExtra,
-    htmlwidgets
+    htmlwidgets,
+    websocket,
+    later,
+    chromote
 Depends:
     R (>= 4.0.0)
 Config/testthat/edition: 3
-RoxygenNote: 7.3.3
 Authors@R: 
     c(person("Marcelo", "Araya-Salas", 
       role = c("aut", "cre"), 
@@ -55,3 +57,4 @@ Authors@R:
       email = "ericrscott@arizona.edu", 
       comment = c(ORCID = "0000-0002-7430-7879")))
 VignetteBuilder: knitr
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(access_wikiaves)
 export(download_media)
 export(find_duplicates)
 export(map_locations)