-
Notifications
You must be signed in to change notification settings - Fork 4
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
e015133
commit 23f964a
Showing
10 changed files
with
341 additions
and
210 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,73 @@ | ||
| #' Download a single floristic quality transect assessment with possible null result cached | ||
| #' | ||
| #' @param transect_id A numeric identifier of the desired floristic quality | ||
| #' transect assessment | ||
| #' | ||
| #' @return An untidy data frame in the original format of the Universal FQA | ||
| #' website. | ||
| #' | ||
| #' @import httr jsonlite | ||
| #' @importFrom memoise memoise | ||
| #' | ||
| #' @noRd | ||
|
|
||
| download_transect <- memoise::memoise(function(transect_id) { | ||
| if (!is.numeric(transect_id)) { | ||
| stop("transect_id must be an integer.", call. = FALSE) | ||
| } | ||
| if (transect_id %% 1 != 0) { | ||
| stop("transect_id must be an integer.", call. = FALSE) | ||
| } | ||
| if (transect_id == -40000) { | ||
| return(invisible(NULL)) | ||
| } # for testing memoisation | ||
|
|
||
| trans_address <- | ||
| paste0("http://universalfqa.org/get/transect/", transect_id) | ||
| ua <- | ||
| httr::user_agent("https://github.com/equitable-equations/fqar") | ||
|
|
||
| trans_get <- tryCatch(httr::GET(trans_address, ua), | ||
| error = function(e){ | ||
| message("Unable to connect. Please check internet connection.") | ||
| character(0) | ||
| } | ||
| ) | ||
|
|
||
| cl <- class(trans_get) | ||
| if (cl != "response"){ | ||
| return(invisible(NULL)) | ||
| } | ||
|
|
||
| if (httr::http_error(trans_get)) { | ||
| message( | ||
| paste( | ||
| "API request to universalFQA.org failed. Error", | ||
| httr::status_code(assessments_get) | ||
| ) | ||
| ) | ||
| return(invisible(NULL)) | ||
| } | ||
|
|
||
| trans_text <- httr::content(trans_get, | ||
| "text", | ||
| encoding = "ISO-8859-1") | ||
| trans_json <- jsonlite::fromJSON(trans_text) | ||
| list_data <- trans_json[[2]] | ||
|
|
||
| if ((list_data[[1]] == "The requested assessment is not public") & | ||
| (!is.na(list_data[[1]]))) { | ||
| stop("The requested assessment is not public", call. = FALSE) | ||
| } | ||
|
|
||
| max_length <- | ||
| max(unlist(lapply(list_data, length))) # determines how wide the df must be | ||
| list_data <- lapply(list_data, | ||
| function(x) { | ||
| length(x) <- max_length | ||
| unlist(x) | ||
| }) | ||
|
|
||
| as.data.frame(do.call(rbind, list_data)) | ||
|
|
||
| }) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,89 @@ | ||
| #' List all available public floristic quality assessments with possible null | ||
| #' results cached | ||
| #' | ||
| #' @param database_id A numeric identifier of the desired database | ||
| #' @return A data frame with 5 columns | ||
| #' | ||
| #' @import jsonlite httr | ||
| #' @importFrom memoise memoise | ||
| #' | ||
| #' @noRd | ||
|
|
||
|
|
||
| index_fqa_assessments_internal <- memoise::memoise(function(database_id) { | ||
| if (!is.numeric(database_id)) { | ||
| stop( | ||
| "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.", | ||
| call. = FALSE | ||
| ) | ||
| } | ||
| if (database_id %% 1 != 0) { | ||
| stop( | ||
| "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.", | ||
| call. = FALSE | ||
| ) | ||
| } | ||
| if (database_id == -40000) { | ||
| return(invisible(NULL)) | ||
| } # for testing memoisation | ||
|
|
||
| assessments_address <- | ||
| paste0("http://universalfqa.org/get/database/", | ||
| database_id, | ||
| "/inventory") | ||
| ua <- | ||
| httr::user_agent("https://github.com/equitable-equations/fqar") | ||
|
|
||
| assessments_get <- tryCatch(httr::GET(assessments_address, ua), | ||
| error = function(e){ | ||
| message("Unable to connect. Please check internet connection.") | ||
| character(0) | ||
| } | ||
| ) | ||
|
|
||
| cl <- class(assessments_get) | ||
| if (cl != "response"){ | ||
| return(invisible(NULL)) | ||
| } | ||
|
|
||
| if (httr::http_error(assessments_get)) { | ||
| message( | ||
| paste( | ||
| "API request to universalFQA.org failed. Error", | ||
| httr::status_code(assessments_get) | ||
| ) | ||
| ) | ||
| return(invisible(NULL)) | ||
| } | ||
|
|
||
| assessments_text <- httr::content(assessments_get, | ||
| "text", | ||
| encoding = "ISO-8859-1") | ||
| assessments_json <- jsonlite::fromJSON(assessments_text) | ||
| list_data <- assessments_json[[2]] | ||
|
|
||
| inventories_summary <- as.data.frame(list_data) | ||
|
|
||
| if (nrow(inventories_summary) == 0) { | ||
| stop("no data associated with specified database_id.", call. = FALSE) | ||
| } | ||
|
|
||
| colnames(inventories_summary) <- c("id", "assessment", | ||
| "date", | ||
| "site", | ||
| "practitioner") | ||
| inventories_summary$id <- as.double(inventories_summary$id) | ||
| inventories_summary$date[inventories_summary$date == "0000-00-00"] <- | ||
| NA | ||
| inventories_summary$date <- as.Date(inventories_summary$date) | ||
| class(inventories_summary) <- c("tbl_df", | ||
| "tbl", | ||
| "data.frame") | ||
|
|
||
| inventories_summary | ||
| }) | ||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
Oops, something went wrong.