diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..e291d8b --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,13 @@ +^codecov\.yml$ +^appveyor\.yml$ +^cran-comments\.md$ +^CRAN-RELEASE$ +^.*\.Rproj$ +^\.Rproj\.user$ +^\.travis\.yml$ +^\.idea$ +^img$ +^\.gitignore$ +^\.Rhistory$ +^\.RData$ +^\.gitattributes$ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..e590b5a --- /dev/null +++ b/.travis.yml @@ -0,0 +1,32 @@ +# R for travis: see documentation at https://docs.travis-ci.com/user/languages/r + +language: R +sudo: false +cache: packages + +matrix: + include: + - name: "Release R github" + r: release + env: bdverse='github' + after_success: + - Rscript -e 'covr::codecov()' + r_github_packages: + - bd-R/bdDwC + - bd-R/bdchecks + + - name: "Release R github OSX" + r: release + env: bdverse='github' + r_github_packages: + - bd-R/bdDwC + - bd-R/bdchecks + os: osx + +addons: + apt: + sources: + - sourceline: 'ppa:opencpu/jq' + packages: + - libjq-dev + - libv8-dev \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 21d8b67..ddc2d8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,50 @@ Package: bdclean Type: Package -Title: Biodiversity Data Cleaning Workflow -Version: 0.0.7 -Date: 2018-02-28 -Author: Tomer Gueta , Vijay Barve , - Thiloshon Nagarajah , Ashwin Agrawal , - Carmel Yohay -Maintainer: Vijay Barve -Description: Provides a set of functions to build a workflow to deal - with biodiversity data cleaning protocols. +Title: A User-Friendly Biodiversity Data Cleaning App for the Inexperienced R User +Description: Provides features to manage the complete workflow for biodiversity data cleaning. Uploading data, gathering input from users (in order to adjust cleaning procedures), cleaning data and finally, generating various reports and several versions of the data. Facilitates user-level data cleaning, designed for the inexperienced R user. T Gueta et al (2018) . T Gueta et al (2017) . +Version: 0.1.17 +Date: 2019-05-21 License: GPL-3 -Imports: rmarkdown, knitr, taxize, varhandle -RoxygenNote: 6.0.1 +URL: https://github.com/bd-R/bdclean, https://bd-r.github.io/The-bdverse/index.html +BugReports: https://github.com/bd-R/bdclean/issues +Authors@R: c( + person( + "Thiloshon", "Nagarajah", + email = "thiloshon@gmail.com", + role = c("aut","cre")), + person( + "Tomer", "Gueta", + email = "tomer.gu@gmail.com", + role = c("aut"), + comment = c(ORCID = '0000-0003-1557-8596')), + person( + "Vijay", "Barve", , + email = "vijay.barve@gmail.com", + role = c("aut"), + comment = c(ORCID = '0000-0002-4852-2567')), + person( + "Ashwin", "Agrawal", + email = "ashwin.agrawal.met14@itbhu.ac.in", + role = c("aut")), + person( + "Povilas", "Gibas", + email = "povilasgibas@gmail.com", + role = c("aut"), + comment = c(ORCID = '0000-0001-5311-6021')), + person( + "Yohay", "Carmel", + email = "yohay@cv.technion.ac.il", + role = c("aut"), + comment = c(ORCID = '0000-0002-5883-0184')) + ) +Maintainer: Thiloshon Nagarajah +Imports: rmarkdown, knitr, shiny, shinydashboard, shinyjs, leaflet, DT, data.table, rgbif, spocc, finch, bdDwC, bdchecks, methods, tools, gtools +Depends: R (>= 2.10) +RoxygenNote: 6.1.1 +Suggests: + testthat, + roxygen2, + covr, + assertive, + shinytest +LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 4ce4b3f..ec6fc4d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,28 @@ # Generated by roxygen2: do not edit by hand +export(BdQuestion) +export(BdQuestionContainer) export(clean_data) -export(get_config) -importFrom(knitr,kable) -importFrom(rmarkdown,render) -importFrom(utils,menu) +export(cleaning_function) +export(create_default_questionnaire) +export(create_report_data) +export(earliest_date) +export(get_checks_list) +export(run_bdclean) +export(run_questionnaire) +export(spatial_resolution) +export(taxo_level) +export(temporal_resolution) +import(bdDwC) +import(bdchecks) +import(data.table) +import(finch) +import(leaflet) +import(rgbif) +import(shinydashboard) +import(shinyjs) +import(spocc) +import(tools) +importFrom(methods,new) +importFrom(shiny,runApp) +importFrom(tools,Rd_db) diff --git a/R/bd_taxonomic_resolver.R b/R/bd_taxonomic_resolver.R deleted file mode 100644 index c03e16f..0000000 --- a/R/bd_taxonomic_resolver.R +++ /dev/null @@ -1,103 +0,0 @@ -#' -#' @title Function to resolve biodiveristy data based on taxonomic ranks. -#' -#' @param df (data.frame) Data frame containing biodiversity data. -#' @return (data.frame) Returns a data frame containing resolved biodiversity data. -#' -#' @example -#' occdat1 <- occ_data( -#' country = "AU", # Country code for australia -#' classKey= 359, # Class code for mammalia -#' limit=500, # Get only 5000 records -#' ) -#' -#' #example1 -#' df<-bd_taxonomic_resolver(occdat1$data) #Enter species as taxonomic rank -#' -#' #exmaple2 -#' #Now artificially inserting missing values in taxonRank field in data -#' #occdat1$data$taxonRank[20]<-NA -#' #occdat1$data$taxonRank[40]<-NA -#' #occdat1$data$taxonRank[100]<-NA -#' #occdat1$data$taxonRank[150]<-NA -#' -#' #Now run the function again -#' -#' df<-bd_taxonomic_resolver(occdat1$data) #Enter species as taxonomic rank -#' -#' - - -bd_taxonomic_resolver<-function(df=NULL){ - - - tax_rank<- readline(prompt="Choose the lowest taxonomic rank for resolving the data - 1) kingdom - 2) phylum - 3) class - 4) order - 5) family - 6) genus - 7) species - 8) subspecies ") - - df<-as.data.frame(df) - if(nrow(df)==0){ - stop(paste("The data frame is empty.")) - } - tax_rank<-toupper(tax_rank) - res_index<-readline(prompt="Do you want to resolve the missing ranks in the data (y/n)") - - if(res_index=='n'){ - # - df_subset<-subset(df,taxonRank==tax_rank) - return (df_subset) - - }else{ - - df_subset<-subset(df,taxonRank==tax_rank) - df_na<-subset(df,is.na(taxonRank)) - - if(nrow(df_na)!=0){ - count1<-nrow(df_na) - count2<-0 - for (i in 1:nrow(df_na)){ - if(!is.na( df_na$name[i])){ - - #using only two data bases 'itis', 'ncbi' to keep the function simple - tax_hierarchy_itis <- suppressMessages( as.data.frame(taxize::classification(taxize::get_uid(df_na$name[i]), db = "itis")[[1]])) - tax_hierarchy_ncbi <- suppressMessages( as.data.frame(taxize::classification(taxize::get_uid(df_na$name[i]), db = "ncbi")[[1]])) - } - - if(suppressMessages(!is.na(tax_hierarchy_ncbi[[1]]))){ - - df_na$taxonRank[i]<-tax_hierarchy_ncbi$rank[nrow(tax_hierarchy_ncbi)] - - }else if(suppressMessages(!is.na(tax_hierarchy_itis[[1]]))){ - - df_na$taxonRank[i]<-tax_hierarchy_itis$rank[nrow(tax_hierarchy_itis)] - - }else{ - count2=count2+1 - - } - - } - #Now combine both the data frames to form the final data frame - - df_subset<-df_subset[!is.na(df_subset$taxonRank),] - df_na<-subset(df_na,taxonRank=tax_rank) - df_final<-rbind(df_subset,df_na) - - #cat("The number of records with missing taxon rank were",count1,"\n") - #cat("The number of records which are resolved:",count2,"\n") - - return(df_final) - }else{ - - return(df_subset) - } - - } - -} \ No newline at end of file diff --git a/R/bdclean.R b/R/bdclean.R index c5d5683..c114f6a 100644 --- a/R/bdclean.R +++ b/R/bdclean.R @@ -1,4 +1,4 @@ -#' bdclean: Biodiversity Data Cleaning Workflows +#' bdclean: Biodiversity Data Cleaning Workflows. #' #' Biodiversity Data Cleaning Workflows using R would be helpful #' to clean biodiversity occurrence data typically downloaded from @@ -8,19 +8,18 @@ #' in order to achieve minimum quality to use the data further for any #' analysis or modelling. #' -#'@section Data cleaning: -#'\itemize{ -#'\item \link{get_config} -#'\item \link{clean_data} -#'} +#' @section Data cleaning: +#' \itemize{ +#' \item \link{run_bdclean} +#' \item \link{clean_data} +#' } #' #' -#'@section Citation: -#'\itemize{ -#'\item Gueta, T., Barve, V., Nagarajah, T., Agrawal, A. & Carmel, Y. (2017). bdclean: Biodiversity data cleaning workflows (R package V 0.0.1). Retrieved from https://github.com/bd-R/bdclean/ -#'} +#' @section Citation: +#' \itemize{ +#' \item Gueta, T., Barve, V., Nagarajah, T., Agrawal, A. & Carmel, Y. (2019). bdclean: Biodiversity data cleaning workflows (R package V 0.1.13). Retrieved from https://github.com/bd-R/bdclean/ +#' } #' #' @docType package #' @name bdclean NULL -#> NULL diff --git a/R/clean_data.R b/R/clean_data.R index 878fff0..f4b9144 100644 --- a/R/clean_data.R +++ b/R/clean_data.R @@ -1,263 +1,177 @@ -#' Data cleaning according to configuration supplied +#' Data cleaning according to Questionnaire Responses. #' -#' Use \code{get_config} to generate configuration and pass it to this -#' function to process the data accordingly. +#' Use \code{run_questionnaire} to add Questionnaire Responses and pass it to this +#' function to process the data faster. #' -#'@importFrom knitr kable -#'@importFrom rmarkdown render +#' Use \code{create_default_questionnaire} to create default questionnaire object. +#' You can add your custom questions to this questionnaire and then pass it to this +#' function to process the data. #' -#'@param bddata Biodiversity data in a data frame -#'@param config Configuration generated using \code{get_config} -#'@param verbose Verbose output if TRUE else brief output if FALSE -#'@param report Whether to print report of cleaning done. -#'@param format Formats of the cleaning report required. Options are: Markdown, HTML or / and PDF +#' @param data Biodiversity data in a data frame +#' @param custom_questionnaire Custom user created questionnaire responses if to pypass answering questions each time. +#' @param clean Whether to clean after flagging. If false only flagging will be done. +#' @param missing How to treat data with missing values. Default: false - will be treated as bad data. +#' @param report Whether to print report of cleaning done. +#' @param format Formats of the cleaning report required. Options are: Markdown, HTML or / and PDF #' -#'@return data frame with clean data +#' @return data frame with clean data #' -#'@examples \dontrun{ -#'library(rgbif) -#'occdat1 <- occ_data( -#' country = "AU", # Country code for australia -#' classKey= 359, # Class code for mammalia -#' limit=5000, # Get only 5000 records -#' ) -#' myData<-occdat1$data -#' myConfig <- get_config() -#' cleanData <- clean_data(myData,myConfig) -#' cleanData <- clean_data(myData,myConfig, report = T) -#'} +#' @examples +#' +#' custom_questionnaire <- create_default_questionnaire() +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' +#' responses <- run_questionnaire() +#' cleaned_data <- clean_data(myData, responses) +#' +#' cleaned_data2 <- clean_data(myData) +#' +#' } #' -#'@export -clean_data <- function(bddata, - config, - verbose = T, - report = T, - format = c("md_document", "html_document", "pdf_document")) { - if (verbose) { - cat("\n Initial records ...", dim(bddata)[1], "\n") - } - - ##------- Initializing dataframe and variables that hold output table details -------## - recordsTable <- data.frame( - DataCleaningProcedure = "Initial Records", - NoOfRecords = NROW(bddata), - Action = "" - ) - selectedOption <- "" - actionRequired <- "" - ##------- End Of Initializing dataframe and variables that hold output table details -------## - - for (i in 1:dim(config)[1]) { - count=1 - if(config$quest[i]!="dateCheck"){ +#' @export +clean_data <- + function(data, + custom_questionnaire = NULL, + clean = TRUE, + missing = FALSE, + report = TRUE, + format = c("html_document", "pdf_document")) { - if(i>4){ - if(config$response[4]!="Yes"){ - count=0 - } + assertive::assert_is_data.frame(data) + assertive::assert_has_cols(data) + assertive::assert_is_logical(clean) + assertive::assert_is_logical(missing) + assertive::assert_is_logical(report) + assertive::assert_is_character(format) + if(!all(format %in% c("html_document", "pdf_document"))){ + stop("Format can only be one of html_document, pdf_document") + } + if(!assertive::is_inherited_from(custom_questionnaire, "BdQuestionContainer") & !is.null(custom_questionnaire)){ + stop("custom_questionnaire should be of type BdQuestionContainer") } - if(count==1){ - cat(paste("\n", config$quest[i], config$response[i], "\n")) - res <- as.character(config$response[i]) - sizeBeforeCleaning <- NROW(bddata) - #print(res) - switch( - as.character(config$quest[i]), - taxoLevel = { - bddata <- taxoLevel(bddata, res) - selectedOption <- - "Taxon Cleaning" # Storing values to be used in building output table - actionRequired <- - "Removal" # Storing values to be used in building output table - }, - misNames = { - bddata <- misNames(bddata, res) - selectedOption <- "Mis Match Names" - actionRequired <- "Removal" - }, - spatialResolution = { - bddata <- spatialResolution(bddata, res) - selectedOption <- "Spatial Resolution Fixing" - actionRequired <- "Removal" - }, - earliestDate = { - bddata <- earliestDate(bddata, res) - selectedOption <- "Earliest Date Events Removal" - actionRequired <- "Removal" - }, - temporalResolution = { - bddata <- temporalResolution(bddata, res) - selectedOption <- "Temporal Resolution Fixing" - actionRequired <- "Repair" - } - - ) - if (verbose) { - cat("\n Records remaining...", dim(bddata)[1], "\n") + responses <- list() + input_data <- data + flagged_data <- data + cleaned_data <- data + + # Questionnaire + if (is.null(custom_questionnaire)) { + responses <- run_questionnaire() + } else { + responses <- custom_questionnaire } - ## ------- Adding record of this iteration to the records dataframe ------- ## - recordsTable <- - rbind( - recordsTable, - data.frame( - DataCleaningProcedure = selectedOption, - NoOfRecords = sizeBeforeCleaning - NROW(bddata), - Action = actionRequired - ) - ) - ## ------- End of Adding record of this iteration to the records dataframe ------- ## + # Flagging + flagged_data <- responses$flag_data(input_data, missing) + + # Decision Making + if (clean) { + cleaned_data <- cleaning_function(flagged_data) } - } - } - - ## ------- Adding Final results to the records dataframe ------- ## - removedRecords <- - sum(recordsTable[recordsTable$Action == "Removal", 2]) - repairedRecords <- - sum(recordsTable[recordsTable$Action == "Repair", 2]) - remainingRecords <- - (recordsTable[1, 2] - removedRecords) - - recordsTable <- - rbind( - recordsTable, - data.frame( - DataCleaningProcedure = "Total", - NoOfRecords = paste( - "Remaining " , - remainingRecords, - " Records (", - (remainingRecords / recordsTable[1, 2]) * 100, - "%)", - sep = "" - ), - Action = paste ( - "Removal of ", - removedRecords, - " Records (", - (removedRecords / recordsTable[1, 2]) * 100, - "%) and Repair of ", - repairedRecords, - " Records (", - (repairedRecords / recordsTable[1, 2]) * 100, - "%)", - sep = "" - ) - ) - ) - ## ------- End of Adding Final results to the records dataframe ------- ## - - ## ------- Exporting Outputs ------- ## - print(kable(recordsTable, format = "markdown")) - - if (report) { - generateReport(recordsTable, format) - } - ## ------- End of Exporting Outputs ------- ## - - return(bddata) -} - - -# Support functions that are called within main function - -taxoLevel <- function(bddata, res = "SPECIES") { - ranks <- - c("CLASS", - "ORDER", - "FAMILY", - "GENUS", - "SPECIES", - "SUBSPECIES") - if (!(res %in% ranks)) { - print("Rank Value unknown. It should be FAMILY, GENUS, SPECIES or SUBSPECIES") - return(bddata) - } - idx <- which(ranks == res) - cat(paste("\n Removing records above :", res, "\n")) - retmat <- NULL - if (idx > 0) { - for (i in idx:length(ranks)) { - resmat <- bddata[which(bddata$taxonRank == ranks[i]),] - retmat <- rbind(retmat, resmat) + + # Report + if (report) { + create_report_data(data, + flagged_data, + cleaned_data, + responses, + clean, + format) } + + # Cleaning + if (clean) { + assertive::assert_is_data.frame(cleaned_data) + return(cleaned_data) + } + + assertive::assert_is_data.frame(cleaned_data) + return(flagged_data) } - return(retmat) -} - -misNames <- function(bddata, res = "No") { - cat("\n fxn misNames not implemented yet \n") - return(bddata) -} - -spatialResolution <- function(bddata, res = 100) { - #print("fxn Spatial Resoultion") - res <- as.numeric(res) - if (res > 0) { - retmat <- - bddata[which(bddata$coordinateUncertaintyInMeters < res),] - } - return(retmat) -} -earliestDate <- function(bddata, res = "1700-01-01") { - bddata <- as.data.frame(bddata) - ed <- try(as.Date(res, format = "%Y-%m-%d")) - if (class(ed) == "try-error" || is.na(ed)) { - print("That date wasn't correct!") - return(bddata) - } - retmat <- bddata[which(as.Date(bddata$eventDate) > ed),] - return(retmat) -} -temporalResolution <- function(bddata, res = "Day") { - bddata <- as.data.frame(bddata) - if (res == "Day") { - retmat <- bddata[which(!is.na(bddata$day)),] - } - if (res == "Month") { - retmat <- bddata[which(!is.na(bddata$month)),] +#' Execute the Questionnaire and save user responses. +#' +#' +#' @param custom_questionnaire Custom User Created Questionnaire if already available. +#' +#' @return list with BdQuestionObjects containing user answers +#' +#' @examples +#' +#' if(interactive()){ +#' +#' responses <- run_questionnaire() +#' +#' } +#' +#' @export +run_questionnaire <- function(custom_questionnaire = NULL) { + responses <- list() + if (is.null(custom_questionnaire)) { + message("Custom Questionnaire not given. Using package default Questionnaire...") + responses <- create_default_questionnaire() + } else { + if (class(custom_questionnaire) != "BdQuestionContainer") { + message( + "Provided Custom Questionnaire is not of class BdQuestionContainer. + Using package default Questionnaire" + ) + responses <- create_default_questionnaire() + } else { + message("Custom Questionnaire detected.") + responses <- custom_questionnaire + } } - if (res == "Year") { - retmat <- bddata[which(!is.na(bddata$year)),] + message("Please answer the following questions to initiate cleaning process.") + for (question in responses$bdquestions) { + if (question$question.type != "Child" && + question$question.type != "ChildRouter") { + get_user_response(question) + } } - return(retmat) + message("Thank you! Cleaning can be started now based on your responses.") + return(responses) } -generateReport <- function(recordsTable, format) { - message("Generating Reports...") - - dir.create(file.path(getwd(), "CleaningReports"), showWarnings = FALSE) - save(recordsTable, file = "CleaningReports/cleaningReport.RData") - - script <- c( - "#' ---", - "#' title: Data Cleaning Report of bdclean Package", - "#' ---", - "#' # Data cleaning summary table", - "#+ echo=F, eval=T", - "#' `r library('knitr')`", - "#' `r knitr::kable(recordsTable)`" - ) - - write(script, "CleaningReports/generateReport.R") - - try(rmarkdown::render( - "CleaningReports/generateReport.R", - format, - quiet = T, - output_dir = "CleaningReports" - )) - +#' Internal function for getting user response +#' +#' @param bd_question The BDQuestion object to get users responses. +#' +#' @examples +#' +#' if(interactive()){ +#' +#' question <- BdQuestion() +#' responses <- get_user_response(question) +#' +#' } +get_user_response <- function(bd_question) { + assertive::assert_is_inherited_from(custom_questionnaire, "BdQuestionContainer") - suppressWarnings(suppressMessages({ - file.remove("CleaningReports/generateReport.R", - showWarnings = FALSE) - file.remove("CleaningReports/cleaningReport.RData", - showWarnings = FALSE) - })) - message("Saved generated reports to 'workingDirectory/CleaningReports'") + # Child & ChildRouter already filtered in first loop above + if (bd_question$question.type == "Atomic") { + # Atomic is filtered + bd_question$print_question() + bd_question$get_response() + } else { + # Router , Child as child & ChildRouter as child is filtered + bd_question$print_question() + bd_question$get_response() + if (bd_question$users.answer %in% bd_question$router.condition) { + for (question in bd_question$child.questions) { + get_user_response(question) + } + } + } } diff --git a/R/decision_making.R b/R/decision_making.R new file mode 100644 index 0000000..0d0ba06 --- /dev/null +++ b/R/decision_making.R @@ -0,0 +1,181 @@ +#' Data decision function (binary decision) required in bdclean internal usage. +#' +#' NOTE: This is an package internal function. Do not use for external uses. Exported to make it available for shiny app. +#' +#' @param bddata The dataframe to clean +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' cleaned_data <- cleaning_function(myData) +#' +#' } +#' +#' @export +cleaning_function <- function(bddata) { + bddata <- as.data.frame(bddata) + + check_columns <- which(grepl("bdclean", names(bddata))) + + if (length(check_columns) == 0) { + warning("Dataset has no flag columns! Skipping cleaning") + return(bddata) + } + + check_data <- bddata[, check_columns] + + # ------------- Decision Making of Cleaning ------------- + # Cleaning criteria is binary: Pass, Fail Records with cleanliness-score 10 for all + # checks will pass. Records with cleanliness-score less than 10 in atleast 1 check will fail + # ------------- Decision Making of Cleaning ------------- + + if (class(check_data) == "logical") { + failed_data_logical <- check_data != TRUE + } else { + failed_data_logical <- rowSums(check_data != TRUE, na.rm = T) >= 1 + } + + # ------------- End of Decision Making of Cleaning ------------- + message("Records remaining:", + nrow(bddata) - sum(failed_data_logical)) + + return(bddata[!failed_data_logical, !grepl("bdclean", names(bddata))]) +} + +#' Data decision function (threshold tuning) required in bdclean internal usage. +#' +#' NOTE: This is an package internal function. Do not use for external uses. +#' +#' @param flagged_data The dataset with flags to be cleaned. +#' @param cleaning_threshold The Cleaning tolerance. Not used in current version. +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' cleaned_data <- perform_Cleaning(myData) +#' +#' } +perform_Cleaning <- function(flagged_data, cleaning_threshold = 5) { + flag_columns <- which(grepl("bdclean", names(flagged_data))) + + if (length(flag_columns) == 0) { + warning("Dataset has no flag columns! Skipping cleaning") + return(flagged_data) + } + assert_is_numeric(cleaning_threshold) + + cleaned_data <- flagged_data + cleaned_data$cleanliness_score <- 0 + + for (column_index in flag_columns) { + cleaned_data$cleanliness_score <- + cleaned_data$cleanliness_score + cleaned_data[, column_index] + } + cleaned_data$cleanliness_score <- + cleaned_data$cleanliness_score / length(flag_columns) + cleaned_data <- + cleaned_data[cleaned_data$cleanliness_score >= cleaning_threshold, c(flag_columns, length(cleaned_data)) * -1] + return(cleaned_data) +} + +#' Returning checks list, function required in bdclean internal usage. +#' +#' NOTE: This is an package internal function. Do not use for external uses. +#' +#' @examples +#' +#' if(interactive()){ +#' +#' all_checks <- get_checks_list() +#' +#' } +#' +#' @export +get_checks_list <- function() { + bdchecks_documentation <- tools::Rd_db("bdchecks") + package_documentation <- bdchecks_documentation + + quality_checks <- list() + for (i in 1:length(package_documentation)) { + string <- paste(package_documentation[i], collapse = " ") + + if (grepl("checkCategory", string)) { + name_of_quality_check <- + gsub(".Rd", "", names(package_documentation)[i]) + + function_documentation <- package_documentation[i] + broken_documentation <- + unlist(strsplit( + paste(function_documentation[[1]], collapse = " "), + split = "\\", + fixed = TRUE + )) + broken_documentation <- + gsub("\\n", "", gsub("[{}]", "", broken_documentation)) + + description <- + broken_documentation[grep("title", broken_documentation)] + description <- + gsub("title Data check", "", description, fixed = T) + + sample_pass_data <- + broken_documentation[grep("samplePassData", broken_documentation)] + sample_pass_data <- + gsub("section samplePassData", + "", + sample_pass_data, + fixed = T) + + sample_fail_data <- + broken_documentation[grep("sampleFailData", broken_documentation)] + sample_fail_data <- + gsub("section sampleFailData", + "", + sample_fail_data, + fixed = T) + + check_category <- + broken_documentation[grep("checkCategory", broken_documentation)] + check_category <- + gsub("section checkCategory", + "", + check_category, + fixed = T) + + target_dwc_field <- + broken_documentation[grep("targetDWCField", broken_documentation)] + target_dwc_field <- + gsub("section targetDWCField", + "", + target_dwc_field, + fixed = T) + + temp <- list() + temp$name_of_quality_check <- + paste("DC_", name_of_quality_check, sep = "") + temp$description <- paste(description, collapse = " ") + temp$sample_pass_data <- sample_pass_data + temp$sample_fail_data <- sample_fail_data + temp$check_category <- check_category + temp$target_dwc_field <- target_dwc_field + quality_checks[name_of_quality_check] <- list(temp) + } + } + return(quality_checks) +} diff --git a/R/generate_report.R b/R/generate_report.R new file mode 100644 index 0000000..af26c85 --- /dev/null +++ b/R/generate_report.R @@ -0,0 +1,207 @@ +#' Generate data required to create report, function required in bdclean internal usage. +#' +#' NOTE: This is an package internal function. Do not use for external uses. Exported to make it available for shiny app. +#' +#' @param input_data The input dataframe before cleaning +#' @param flagged_data The flagged data for cleaning +#' @param cleaned_data The data with flagged records removed +#' @param responses The BDQuestions object with user responses +#' @param cleaning_true Flag specifying if the cleaning should be done, or just flagging +#' @param format The format of the report to be generated +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' +#' question <- BdQuestion() +#' responses <- get_user_response(question) +#' +#' cleaned_data <- create_report_data(myData, myData, myData, responses, T, 'pdf_document') +#' +#' } +#' +#' @export +create_report_data <- + function(input_data, + flagged_data, + cleaned_data, + responses, + cleaning_true, + format) { + + assertive::assert_is_data.frame(input_data) + assertive::assert_has_cols(input_data) + assertive::assert_is_data.frame(flagged_data) + assertive::assert_has_cols(flagged_data) + assertive::assert_is_data.frame(cleaned_data) + assertive::assert_is_logical(cleaning_true) + #assertive::assert_is_inherited_from(responses, "BdQuestionContainer") + if(!all(format %in% c("html_document", "pdf_document", "md_document", "word_document"))){ + stop("Format can only be one of html_document, pdf_document") + } + + for (question in responses$bdquestions) { + if (length(question$quality.checks) > 0 && + length(question$users.answer) > 0) { + question$add_to_report(flagged_data, cleaning_true) + } + } + + if (!cleaning_true) { + cleaned_data <- flagged_data + } + + # --------------- Data required for detailed report --------------- + input_data <- as.data.frame(input_data) + input_size <- dim(input_data) + output_size <- dim(cleaned_data) + + input_unique_species <- + length(unique(input_data[, "scientificName"])) + output_unique_species <- + length(unique(cleaned_data[, "scientificName"])) + + earliest_input_date <- + try(as.POSIXct(unique(input_data[, "eventDate"]), tz = "UTC"), silent = T) + + if (class(earliest_input_date) != "try-error") { + earliest_input_date <- min(earliest_input_date) + latest_input_date <- + max(as.POSIXct(unique(input_data[, "eventDate"]), tz = "UTC")) + } else { + earliest_input_date <- "Not Available" + latest_input_date <- "Not Available" + } + + earliest_output_date <- + try(as.POSIXct(unique(cleaned_data[, "eventDate"]), tz = "UTC"), silent = T) + + if (class(earliest_output_date) != "try-error") { + earliest_output_date <- min(earliest_input_date) + latest_output_date <- + max(as.POSIXct(unique(cleaned_data[, "eventDate"]), tz = "UTC")) + } else { + earliest_output_date <- "Not Available" + latest_output_date <- "Not Available" + } + input_data_meta <- + c( + input_size[1], + input_size[2], + input_unique_species, + paste(earliest_input_date, "-", latest_input_date) + ) + cleaned_data_meta <- + c( + output_size[1], + output_size[2], + output_unique_species, + paste(earliest_output_date, "-", latest_output_date) + ) + data.summary <- data.frame(input_data_meta, cleaned_data_meta) # One + row.names(data.summary) <- + c("Rows", + "Columns", + "Number of unique scientific names", + "Date Range") + + checks.records <- list() # Three + index <- 1 + + for (question in responses$bdquestions) { + # length(question$quality.checks) > 0 && + if (length(question$users.answer) > 0) { + checks.records[[paste("question", index, sep = "")]] <- + list( + question = question$question, + answer = question$users.answer, + checks = question$cleaning.details + ) + index <- index + 1 + } + } + # ------------------- End of data required for detailed report --------------- + + # ------------------ Data required for short report --------------- + records_table <- + data.frame( + DataCleaningProcedure = "Initial Records", + NoOfRecords = nrow(input_data), + Action = "Initialize" + ) + + for (question in checks.records) { + check_index <- 1 + for (check in question$checks) { + records_table <- + rbind( + records_table, + data.frame( + DataCleaningProcedure = names(question$checks)[check_index], + NoOfRecords = ifelse(is.null(check$affectedData), 0, check$affectedData), + Action = ifelse(cleaning_true, "Removal", "Flagging") + ) + ) + check_index <- check_index + 1 + } + } + remaining_records <- (nrow(cleaned_data)) + removed_records <- nrow(input_data) - nrow(cleaned_data) + records_table <- + rbind( + records_table, + data.frame( + DataCleaningProcedure = "Total", + NoOfRecords = paste( + "Remaining ", + remaining_records, + " Records (", + (remaining_records / records_table[1, 2]) * 100, + "%)", + sep = "" + ), + Action = paste( + ifelse(cleaning_true, "Removal of ", "Flagging of"), + removed_records, + " Records (", + (removed_records / records_table[1, 2]) * 100, + "%)", + sep = "" + ) + ) + ) + # ------------ End of data required for short report --------------- + message(knitr::kable(records_table, format = "markdown")) + generate_short_report(records_table, format) + generate_detailed_report(data.summary, checks.records, format) + } + +generate_short_report <- function(records_table, format) { + message("Generating Reports...") + try(rmarkdown::render( + system.file("rmd/generateShortReport.Rmd", package = "bdclean"), + format, + quiet = T, + output_dir = tempdir() + )) + message("generated simple") +} + +generate_detailed_report <- + function(data.summary, checks.records, format) { + try(rmarkdown::render( + system.file("rmd/generateDetailedReport.Rmd", package = "bdclean"), + format, + quiet = T, + output_dir = tempdir() + )) + message(paste("Saved generated reports to '", tempdir(), sep = "")) + } diff --git a/R/get_config.R b/R/get_config.R deleted file mode 100644 index da47a84..0000000 --- a/R/get_config.R +++ /dev/null @@ -1,115 +0,0 @@ -#' Get user inputs about data cleaning protocol to follow -#' -#' \code{get_config} asks user a set of questions and the answers are stored -#' in configuration variable. This variable will be used to clean the data -#' depending on the responces -#' -#'@importFrom utils menu -#' -#' -#'@return data frame with the responces, which would be passed on to \code{clean_data} -#' -#'@examples \dontrun{ -#' myConfig <- get_config() -#'} -#' -#'@export -get_config <- function(){ - data(quest, envir=environment()) - data(responses, envir=environment()) - res<-vector(mode="character",length = nrow(quest)) - for (i in 1:nrow(quest)){ - if(quest$qlink[i]>0){ - if(res[quest$qlink[i]]!=quest$rescond[i]){ - next - } - } - if(quest$mtype[i]=="m"){ - rval <- menu(responses[[quest[i,1]]]$value,title = quest[i,2] ) - } else if(quest$rtype[i]=="Numeric"){ - rval <- readline(prompt=quest[i,2]) - if(!(varhandle::check.numeric(rval,only.integer = TRUE))){ - message(paste("The spatial resolution should be integer, please enter again")) - rval <- readline(prompt=quest[i,2]) - }else{ - res[i]=rval - } - - if(!(varhandle::check.numeric(rval,only.integer = TRUE))){ - message(paste("The spatial resolution should be integer, please enter again")) - rval <- readline(prompt=quest[i,2]) - }else{ - res[i]=rval - } - - if(!(varhandle::check.numeric(rval,only.integer = TRUE))){ - message(paste("The spatial resolution should be integer, please enter again")) - rval <- readline(prompt=quest[i,2]) - }else{ - res[i]=rval - } - - - if(!(varhandle::check.numeric(rval,only.integer = TRUE))){ - message(paste("The spatial resolution entered is not integer, setting default resolution as 10")) - rval<-1000 - res[i]=rval - }else{ - res[i]=rval - } - - } else{ - rval <- readline(prompt=quest[i,2]) - if(IsDate(rval)){ - res[i]=rval - }else{ - message(paste("The entered date format is incorrect, please enter the date in %Y-%m-%d")) - rval <- readline(prompt=quest[i,2]) - } - if(IsDate(rval)){ - res[i]=rval - }else{ - message(paste("The entered date format is incorrect, please enter the date in %Y-%m-%d")) - rval <- readline(prompt=quest[i,2]) - } - if(IsDate(rval)){ - res[i]=rval - }else{ - message(paste("The entered date format is incorrect, please enter the date in %Y-%m-%d")) - rval <- readline(prompt=quest[i,2]) - } - if(IsDate(rval)){ - res[i]=rval - }else{ - message(paste("The entered date format is incorrect, setting default date as 1990-01-01")) - rval="1990-01-01" - res[i]=rval - - } - - } - - if(quest[i,3]=="I_Numeric"){ - if(rval<=quest[i,4] && rval>=1){ - qvar<-quest[i,1] - data<-as.data.frame(responses[qvar]) - colnames(data)<-c("choice","value") - res[i]<-as.character((data[data$choice==rval,2])) - quest1[i,3]="Numeric" - } - else{ - stop(paste("The entered choice is wrong.")) - } - } - } - response<-data.frame(quest=quest1[,1],response=res) - return(response) -} - - -# Functions for input. -IsDate <- function(mydate, date.format = "%Y-%m-%d") { - tryCatch(!is.na(as.Date(mydate, date.format)), - error = function(err) {FALSE}) -} - diff --git a/R/quality_checks.R b/R/quality_checks.R new file mode 100644 index 0000000..a033e4b --- /dev/null +++ b/R/quality_checks.R @@ -0,0 +1,236 @@ +#' Clean data based on lower taxon level +#' +#' Clean data based on lower taxon level +#' +#' @section samplePassData: +#' When resolution is Species, Subspecies and Species will pass. +#' +#' @section sampleFailData: +#' When resolution is Species, Family or Genus or any lower ranks will fail. +#' +#' @section targetDWCField: +#' taxonRank +#' +#' @section checkCategory: +#' taxonomic +#' +#' @param bddata Bio diversity data in a data frame +#' @param res The low rank of species required +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' +#' responses <- taxo_level(myData, 'SPECIES') +#' +#' } +#' +#' @export +taxo_level <- function(bddata, res = "SPECIES") { + assertive::assert_is_data.frame(bddata) + assertive::assert_has_cols(bddata) + + ranks <- + c("CLASS", + "ORDER", + "FAMILY", + "GENUS", + "SPECIES", + "SUBSPECIES") + res <- toupper(res) + + if (!(res %in% ranks)) { + warning("Rank Value unknown. It should be FAMILY, GENUS, SPECIES or SUBSPECIES") + return(bddata) + } + + idx <- which(ranks == res) + message(paste("taxoLevel:", "\n Removing records above :", res, "\n")) + bddata[, "bdclean.taxoLevel"] <- FALSE + if (idx > 0) { + for (i in idx:length(ranks)) { + bddata[which(bddata[, "taxonRank"] == ranks[i]), "bdclean.taxoLevel"] <- + TRUE + } + } + + return(bddata) +} + +#' Clean data based on spatial resolution +#' +#' Clean data based on spatial resolution +#' +#' @section samplePassData: +#' When resolution is 100 meters, Coordinate Uncertainties below 100 meters will pass. +#' +#' @section sampleFailData: +#' When resolution is 100 meters, Coordinate Uncertainties above 100 meters will fail. +#' +#' @section targetDWCField: +#' coordinateUncertaintyInMeters +#' +#' @section checkCategory: +#' spatial +#' +#' @param bddata Bio diversity data in a data frame +#' @param res The highest coordinate uncertainty required +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' +#' responses <- spatial_resolution(myData, 1500) +#' +#' } +#' +#' @export +spatial_resolution <- function(bddata, res = 100) { + assertive::assert_is_data.frame(bddata) + assertive::assert_has_cols(bddata) + + message(paste( + "spatialResolution:", + "\n Removing records above :", + res, + "\n" + )) + res <- as.numeric(res) + bddata[, "bdclean.spatialResolution"] <- FALSE + if (res > 0) { + bddata[which(bddata[, "coordinateUncertaintyInMeters"] < res), "bdclean.spatialResolution"] <- + TRUE + } + return(bddata) +} + +#' Clean data based on earliest date. +#' +#' Clean data based on earliest date. +#' +#' @section samplePassData: +#' When resolution is 20-Jan-2005, records recorded after the date will pass. +#' +#' @section sampleFailData: +#' When resolution is 20-Jan-2005, records recorded before the date will fail. +#' +#' @section targetDWCField: +#' eventDate +#' +#' @section checkCategory: +#' temporal +#' +#' @param bddata Bio diversity data in a data frame +#' @param res The earliest data required +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' responses <- earliest_date(myData, '2000-01-01') +#' +#' } +#' +#' @export +earliest_date <- function(bddata, res = "1700-01-01") { + assertive::assert_is_data.frame(bddata) + assertive::assert_has_cols(bddata) + + message(paste("earliestDate:", "\n Removing records above :", res, "\n")) + dates <- strsplit(res, " ")[[1]] + bddata <- as.data.frame(bddata) + ed <- try(as.Date(dates[1], format = "%Y-%m-%d")) + if (class(ed) == "try-error" || is.na(ed)) { + warning("That date wasn't correct!") + return(bddata) + } + bddata[, "bdclean.earliestDate"] <- FALSE + bddata[which(as.Date(bddata[, "eventDate"]) > ed), "bdclean.earliestDate"] <- + TRUE + return(bddata) +} + +#' Clean data based on temporal resolution +#' +#' Clean data based on temporal resolution +#' +#' @section samplePassData: +#' When resolution is day, records with day specified will pass. +#' +#' @section sampleFailData: +#' When resolution is month, records with NA/empty month specified will fail. +#' +#' @section targetDWCField: +#' day, month, year +#' +#' @section checkCategory: +#' temporal +#' +#' @param bddata Bio diversity data in a data frame +#' @param res restriction of records with/without data, month, year fields +#' +#' @examples +#' +#' if(interactive()){ +#' +#' library(rgbif) +#' occdat <- occ_data( +#' country = 'AU', # Country code for australia +#' classKey = 359, # Class code for mammalia +#' limit = 50 # Get only 50 records +#' ) +#' myData <- occdat$data +#' responses <- temporal_resolution(myData, 'Day') +#' +#' } +#' +#' @export +temporal_resolution <- function(bddata, res = "Day") { + assertive::assert_is_data.frame(bddata) + assertive::assert_has_cols(bddata) + + message(paste( + "temporalResolution:", + "\n Removing records above :", + res, + "\n" + )) + bddata <- as.data.frame(bddata) + bddata[, "bdclean.temporalResolution"] <- FALSE + if (res == "Day") { + bddata[which(!is.na(bddata$day)), "bdclean.temporalResolution"] <- + TRUE + } + if (res == "Month") { + bddata[which(!is.na(bddata$month)), "bdclean.temporalResolution"] <- + TRUE + } + if (res == "Year") { + bddata[which(!is.na(bddata$year)), "bdclean.temporalResolution"] <- + TRUE + } + return(bddata) +} diff --git a/R/questionnaire.R b/R/questionnaire.R new file mode 100644 index 0000000..df59b1a --- /dev/null +++ b/R/questionnaire.R @@ -0,0 +1,220 @@ +#' Create the package default Questionnaire. +#' +#' @return BdQuestionContainer object with default Questions +#' +#' @examples +#' +#' customQuestionnaire <- create_default_questionnaire() +#' +#' @export +create_default_questionnaire <- function() { + question1 <- + BdQuestion( + question = "Do you worry about taxonomical aspect of the data?", + possible.responses = c("Yes", "No"), + question.type = "Router", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + question.id = "taxonMain", + ui.type = "single-checkbox" + ) + + question2 <- + BdQuestion( + question = "What is the lowest taxonomic level you require in your data?", + possible.responses = c( + "Subspecies", + "Species", + "Genus", + "Family", + "Order", + "Class" + ), + question.type = "Child", + quality.checks = c("taxo_level"), + question.id = "taxonLevel", + ui.type = "select" + ) + + question1$add_child_question(c(question2)) + + question3 <- + BdQuestion( + question = "Do you worry about spatial aspect of the data?", + possible.responses = c("Yes", "No"), + question.type = "Router", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + quality.checks = c("DC_coordinatesZero"), + question.id = "spatialMain", + ui.type = "single-checkbox" + ) + + question4 <- + BdQuestion( + question = "What is the spatial resolution required for your data? (in meteres)", + question.type = "Child", + quality.checks = c("spatial_resolution"), + question.id = "spatialResolution", + ui.type = "numericInput" + ) + + question4$add_validation_function(function(answer) { + answer <- suppressWarnings(as.numeric(answer)) + check <- (!is.na(answer) && answer > 0 && answer < 1e+05) + if (!check) { + message( + "Spatial resolution should be a number between 0 to 100 KM. Please give a correct value." + ) + } + return(check) + }) + + question_sub_01 <- + BdQuestion( + question = "Do you worry about precision of coordinates?", + possible.responses = c("Yes", "No"), + question.type = "ChildRouter", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + quality.checks = c( + "DC_coordinatePrecisionMismatch", + "DC_precisionRangeMismatch", + "DC_uncertaintyRangeMismatch" + ), + question.id = "precisionCoord", + ui.type = "single-checkbox" + ) + + question_sub_02 <- + BdQuestion( + question = "Do you worry about countries of occurrences?", + possible.responses = c("Yes", "No"), + question.type = "ChildRouter", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + quality.checks = c("DC_countryMismatch", "DC_countryNameUnknown"), + question.id = "countryCoord", + ui.type = "single-checkbox" + ) + + question_sub_03 <- + BdQuestion( + question = "Do you worry about elevation of occurrences?", + possible.responses = c("Yes", "No"), + router.condition = c("Yes", + "Y", "yes", 1, TRUE, "TRUE"), + question.type = "ChildRouter", + quality.checks = c("DC_depthOutOfRange", "DC_elevationOutOfRange"), + question.id = "elevationCoord", + ui.type = "single-checkbox" + ) + + question3$add_child_question(c( + question4, + question_sub_01, + question_sub_02, + question_sub_03 + )) + + question5 <- + BdQuestion( + question = "Do you worry about temporal aspect of your data?", + possible.responses = c("Yes", "No"), + question.type = "Router", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + quality.checks = c( + "DC_dateNull", + "DC_dayInvalid", + "DC_eventDateInFuture", + "DC_monthInvalid", + "DC_yearMissing" + ), + question.id = "temporalMain", + ui.type = "single-checkbox" + ) + + question6 <- + BdQuestion( + question = "What is the range of dates of the observations in this data set? In format (YYYY-mm-dd YYYY-mm-dd)", + question.type = "Child", + quality.checks = c("earliest_date"), + question.id = "temporalEarliest", + ui.type = "date-range" + ) + + question6$add_validation_function(function(answer) { + dates <- strsplit(answer, " ")[[1]] + d <- try(as.Date(dates[1])) + if (class(d) == "try-error" || is.na(d)) { + message("Invalid Date! Please follow the date format (YYYY-mm-dd)") + return(FALSE) + } + d <- try(as.Date(dates[2])) + if (class(d) == "try-error" || is.na(d)) { + message("Invalid Date! Please follow the date format (YYYY-mm-dd)") + return(FALSE) + } + return(TRUE) + }) + + question7 <- + BdQuestion( + question = "What temporal resolution are you interested in?", + possible.responses = c("Day", "Month", "Year"), + question.type = "Child", + quality.checks = c("temporal_resolution"), + question.id = "temporalResolution", + ui.type = "radio" + ) + + question_sub_04 <- + BdQuestion( + question = "Do you worry about dates other than occured date (published date/identified date)?", + possible.responses = c("Yes", + "No"), + question.type = "ChildRouter", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + quality.checks = c( + "DC_identifiedDateImprobable", + "DC_modifiedInFuture", + "DC_namePublishedYearInFuture" + ), + question.id = "smallerDates", + ui.type = "single-checkbox" + ) + + question5$add_child_question(c(question6, question7, question_sub_04)) + + question_sub_05 <- + BdQuestion( + question = "Do you worry about other properties of occurrence? (GBIF issues/publisher/occuranceremark, etc)?", + possible.responses = c("Yes", "No"), + question.type = "Router", + router.condition = c("Yes", "Y", "yes", 1, TRUE, "TRUE"), + quality.checks = c( + "DC_basisOfRecordBadlyFormed", + "DC_classUnknown", + "DC_dataGeneralised", + "DC_individualcountInvalid", + "DC_occurrenceIdNotGuid" + ), + question.id = "smallerIssues", + ui.type = "single-checkbox" + ) + + all_questions <- + BdQuestionContainer( + c( + question1, + question2, + question3, + question4, + question_sub_01, + question_sub_02, + question_sub_03, + question5, + question6, + question7, + question_sub_04, + question_sub_05 + ) + ) + return(all_questions) +} diff --git a/R/reference_classes.R b/R/reference_classes.R new file mode 100644 index 0000000..3e7b772 --- /dev/null +++ b/R/reference_classes.R @@ -0,0 +1,287 @@ +#' The Question Reference Class +#' +#' @export BdQuestion +#' @importFrom tools Rd_db +#' @importFrom methods new +BdQuestion <- + setRefClass( + "BdQuestion", + fields = list( + question = "character", + possible.responses = "character", + users.answer = "character", + validation.function = "function", + child.questions = "list", + quality.checks = "character", + router.condition = "character", + cleaning.details = "list", + question.type = "character", + question.id = "character", + ui.type = "character" + ), + methods = list( + initialize = function(question = character(), + possible.responses = character(), + quality.checks = character(), + question.type = character(), + router.condition = character(), + question.id = character(), + ui.type = character()) { + .self$question <- question + .self$possible.responses <- possible.responses + .self$quality.checks <- quality.checks + .self$question.type <- question.type + .self$router.condition <- router.condition + .self$question.id <- question.id + .self$ui.type <- ui.type + }, + print_question = function() { + cat(.self$question, "\n") + if (length(.self$possible.responses) > 0) { + for (i in 1:length(.self$possible.responses)) { + cat(" ", i, " ", .self$possible.responses[i], "\n") + } + } + }, + add_validation_function = function(val_function) { + .self$validation.function <- val_function + }, + set_response = function(response) { + if (class(response) == "logical") { + .self$users.answer <- ifelse(response, "yes", "no") + } else { + .self$users.answer <- as.character(response) + } + }, + + + + get_response = function() { + ans <- readline() + length <- length(.self$possible.responses) + if (length > 0) { + # Means it was a menu question, and not an open answer + ans <- suppressWarnings(as.numeric(ans)) + if (!is.na(ans) && ans > 0 && ans <= length) { + # Validating user renponse is a menu number. + .self$users.answer <- + .self$possible.responses[as.numeric(ans)] + } else { + message("Please choose number from menu...") + .self$getResponse() + } + } else { + # Means answer is open ended + if (is.null(.self$validation.function)) { + # If a validation function is not given + .self$users.answer <- ans + } else { + val <- .self$validation.function(ans) + if (val) { + # If the validation function passes (returns true) + .self$users.answer <- ans + } else { + .self$getResponse() + } + } + } + }, + add_child_question = function(questions) { + .self$child.questions <- questions + }, + add_quality_checks = function(new_checks) { + .self$quality.checks <- new_checks + }, + flag_data = function(data, missing = FALSE) { + flagged_data <- data + + if (length(.self$quality.checks) > 0) { + for (i in 1:length(.self$quality.checks)) { + check_name <- .self$quality.checks[i] + if (grepl("DC_", check_name)) { + # bdchecks quality checks + check_temp <- + bdchecks::dc_perform(data = flagged_data, + DConly = c(check_name)) + + if (!is.null(check_temp) && + length(check_temp@flags) > 0 && + length(check_temp@flags[[1]]@result) > 0) { + check_temp <- check_temp@flags[[1]]@result + + if (missing) { + check_temp[is.na(check_temp)] <- + FALSE # Treating mising values as fails + } else { + check_temp[is.na(check_temp)] <- TRUE + } + flagged_data[, paste("bdclean", check_name, sep = ".")] <- + check_temp + } + } else { + # bdclean quality checks + flagged_data <- + get(check_name)(flagged_data, .self$users.answer) + } + } + } + return(flagged_data) + }, + add_to_report = function(flagged_data, + clean = TRUE, + cleaning_threshold = 5) { + package_documentation <- tools::Rd_db("bdchecks") + flagged_data <- as.data.frame(flagged_data) + + for (i in 1:length(.self$quality.checks)) { + name_of_quality_check <- .self$quality.checks[i] + + if (!(paste("bdclean", name_of_quality_check, sep = ".") %in% names(flagged_data))) { + # both bdchecks and bdclean columns have bdcelan prefix + warning( + "Required column ", + paste("bdclean", name_of_quality_check, sep = "."), + " not found! Probably, quality check is missing from + environment and check was not performed." + ) + next + } + + flag <- + flagged_data[, paste("bdclean", name_of_quality_check, sep = ".")] + count_of_flagged_data <- sum(flag != TRUE, na.rm = T) + + + # ------ Parsing MetaData for check from .Rd file + function_documentation <- + package_documentation[grep(name_of_quality_check, names(package_documentation))] + + if (length(function_documentation) == 0) { + warning( + "Could not find function documentation for ", + name_of_quality_check, + ". Skipping report." + ) + next + } + + broken_documentation <- + unlist(strsplit( + paste(function_documentation[[1]], collapse = " "), + split = "\\", + fixed = TRUE + )) + + broken_documentation <- + gsub("\\n", "", gsub("[{}]", "", broken_documentation)) + + description <- + broken_documentation[grep("title", broken_documentation)] + description <- + gsub("title Data check", "", description, fixed = T) + + sample_pass_data <- + broken_documentation[grep("samplePassData", broken_documentation)] + sample_pass_data <- + gsub("section samplePassData", "", sample_pass_data, fixed = T) + + sample_fail_data <- + broken_documentation[grep("sampleFailData", broken_documentation)] + sample_fail_data <- + gsub("section sampleFailData", "", sample_fail_data, fixed = T) + + check_category <- + broken_documentation[grep("checkCategory", broken_documentation)] + check_category <- + gsub("section checkCategory", "", check_category, fixed = T) + + target_dwc_field <- + broken_documentation[grep("targetDWCField", broken_documentation)] + target_dwc_field <- + gsub("section targetDWCField", "", target_dwc_field, fixed = T) + + # ------ End of Parsing MetaData for check from .Rd file + + temp <- list() + temp$description <- paste(description, collapse = " ") + temp$sample_pass_data <- sample_pass_data + temp$sample_fail_data <- sample_fail_data + temp$check_category <- check_category + temp$target_dwc_field <- target_dwc_field + temp$affected_data <- count_of_flagged_data + + .self$cleaning.details[name_of_quality_check] <- list(temp) + } + }, + notify = function() { + message("New Question object created.") + }, + print_self = function() { + print(.self$question) + for (i in 1:length(.self$possible.responses)) { + cat(" ", i, " ", .self$possible.responses[i], "\n") + } + cat(" User Response: ", .self$users.answer, "\n") + cat("\n") + } + ) + ) + + +#' The Question Container Reference Class +#' +#' @export BdQuestionContainer +BdQuestionContainer <- + setRefClass( + "BdQuestionContainer", + fields = list(bdquestions = "list"), + methods = list( + initialize = function(bdquestions = NA) { + "Construct an instance of BdQuestionContainer after validating the type." + + if (class(bdquestions[[1]]) != "BdQuestion") { + stop("Incompatible input type. Provide a list of BdQuestion") + } + .self$bdquestions <- bdquestions + .self$notify() + }, + reset_responses = function(){ + for (question in .self$bdquestions) { + question$set_response(character()) + } + }, + flag_data = function(input_data, missing) { + message("Initial records: ", paste(dim(input_data), collapse = "x")) + flagged_data <- input_data + for (question in .self$bdquestions) { + if (length(question$quality.checks) > 0 && + length(question$users.answer) > 0) { + if (question$question.type == "Router" && + !(question$users.answer %in% question$router.condition)) { + # If its router and condition fails + next + } else if (question$question.type == "ChildRouter" && + !(question$users.answer %in% question$router.condition)) { + # If its ChildRouter and condition fails + next + } + flagged_data <- + question$flag_data(flagged_data, missing) + } + } + return(flagged_data) + }, + notify = function() { + message(paste( + "New BdQuestionContainer instance created with", + length(.self$bdquestions), + "questions." + )) + }, + print_self = function() { + for (question in .self$bdquestions) { + question$print_self() + } + } + ) + ) diff --git a/R/run_bdclean.R b/R/run_bdclean.R new file mode 100644 index 0000000..9451422 --- /dev/null +++ b/R/run_bdclean.R @@ -0,0 +1,18 @@ +#' Launch bdclean Shiny Application +#' +#' @import shinydashboard shinyjs leaflet data.table rgbif spocc finch bdDwC bdchecks tools +#' @importFrom shiny runApp +#' +#' @examples +#' +#' if(interactive()){ +#' +#' run_bdclean() +#' +#' } +#' +#' @export +run_bdclean <- function() { + app_path <- system.file("shiny/bdclean", package = "bdclean") + return(shiny::runApp(app_path, launch.browser = TRUE)) +} diff --git a/README.md b/README.md index 40ad8fa..26cba4f 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,20 @@ +[![Build Status](https://travis-ci.org/bd-R/bdclean.svg?branch=new_bdclean)](https://travis-ci.org/bd-R/bdclean) +[![AppVeyor build status](https://ci.appveyor.com/api/projects/status/github/thiloshon/bdclean?branch=master&svg=true)](https://ci.appveyor.com/project/thiloshon/bdclean) +[![](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://www.tidyverse.org/lifecycle/#stable) +[![Coverage status](https://codecov.io/gh/thiloshon/bdclean/branch/master/graph/badge.svg)](https://codecov.io/github/thiloshon/bdclean?branch=master) + +![](https://www.r-pkg.org/badges/version/bdclean) +![](https://www.r-pkg.org/badges/ago/bdclean) +![](https://cranlogs.r-pkg.org/badges/grand-total/bdclean) +[![](https://img.shields.io/github/languages/code-size/bd-R/bdclean.svg)](https://github.com/bd-R/bdclean) + +[![](https://img.shields.io/badge/doi-10.3897/biss.2.25564-yellow.svg)](https://doi.org/10.3897/biss.2.25564) +[![](https://img.shields.io/badge/doi-10.3897/tdwgproceedings.1.20311-yellow.svg)](https://doi.org/10.3897/tdwgproceedings.1.20311) + + + + + # bdclean ### User-friendly biodiversity data cleaning pipeline @@ -11,65 +28,36 @@ one stop shop for many biodiversity data cleaning needs. ## Install -Development version, from GitHub - -```r -library("devtools") -devtools::install_github("bd-R/bdclean") -``` +From CRAN ```r -library("bdclean") +install.packages("bdclean") ``` -## Download some data from GBIF - -```r -library(rgbif) -``` +Development version, from GitHub ```r -occdat <- occ_data( - country = "AU", # Country code for australia - classKey= 359, # Class code for mammalia - limit = 5000, # Get only 5000 records -) +library("devtools") +devtools::install_github("bd-R/bdclean") ``` -Taking just the species occurrence dataframe - ```r -myData <- occdat$data +library("bdclean") ``` - ## Using bdclean -### Getting your input: generating input questions and saving your answers ```r -myConfig <- get_config() +run_bdclean() ``` - -### Cleaning your data based on your answers - -```r -cleanData <- clean_data(myData, myConfig) -``` Cleaning reports should be created in `Your-Working-Directory\CleaningReports` -## Package release - - -`bdclean` **is still under development**, a CRAN release with many package upgrades is expected in July 2018. - - - ## We need your feedback :innocent: -Please submit your feedback useing this **[link](https://github.com/bd-R/Feedback-bdclean/issues/new)** +Please submit your feedback using this **[link](https://github.com/bd-R/Feedback-bdclean/issues/new)** :deciduous_tree: :mushroom: :shell: :fish: :frog: :honeybee: :turtle: :rooster: :whale2: :monkey: :octocat: diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000..eceb3b0 --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,47 @@ +# DO NOT CHANGE the "init" and "install" sections below + +# Download script file from GitHub +init: + ps: | + $ErrorActionPreference = "Stop" + Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" + Import-Module '..\appveyor-tool.ps1' + +install: + ps: Bootstrap + +cache: + - C:\RLibrary + +# Adapt as necessary starting from here + +build_script: + - travis-tool.sh install_github bd-R/bdDwC + - travis-tool.sh install_github bd-R/bdchecks + - travis-tool.sh install_deps + +test_script: + - travis-tool.sh run_tests + +on_failure: + - 7z a failure.zip *.Rcheck\* + - appveyor PushArtifact failure.zip + +artifacts: + - path: '*.Rcheck\**\*.log' + name: Logs + + - path: '*.Rcheck\**\*.out' + name: Logs + + - path: '*.Rcheck\**\*.fail' + name: Logs + + - path: '*.Rcheck\**\*.Rout' + name: Logs + + - path: '\*_*.tar.gz' + name: Bits + + - path: '\*_*.zip' + name: Bits diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 0000000..8f36b6c --- /dev/null +++ b/codecov.yml @@ -0,0 +1,12 @@ +comment: false + +coverage: + status: + project: + default: + target: auto + threshold: 1% + patch: + default: + target: auto + threshold: 1% diff --git a/data/quest.rda b/data/quest.rda deleted file mode 100644 index 7848190..0000000 Binary files a/data/quest.rda and /dev/null differ diff --git a/data/responses.rda b/data/responses.rda deleted file mode 100644 index e7ed75c..0000000 Binary files a/data/responses.rda and /dev/null differ diff --git a/inst/rmd/generateDetailedReport.Rmd b/inst/rmd/generateDetailedReport.Rmd new file mode 100644 index 0000000..4aeeae7 --- /dev/null +++ b/inst/rmd/generateDetailedReport.Rmd @@ -0,0 +1,115 @@ +--- +title: 'Detailed Data Cleaning Report of package bdclean' +author: "`r Sys.info()[['user']]`" +date: "`r date()`" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +suppressPackageStartupMessages(library(knitr)) +suppressPackageStartupMessages(library(tools)) +``` + +## Data Summary + +```{r echo=FALSE} +kable(data.summary) +``` + +## Quality Checks Summary + +```{r echo=FALSE} +spatialChecks <- 0 +temporalChecks <- 0 +taxonChecks <- 0 +otherChecks <- 0 + +for (question in checks.records) { + for (check in question$checks) { + if (grepl("Location", check$check_category)) { + spatialChecks = spatialChecks + 1 + } else if (grepl("Event", check$check_category)) { + temporalChecks = temporalChecks + 1 + } else if (grepl("Taxon", check$check_category)) { + taxonChecks = taxonChecks + 1 + } else { + otherChecks = otherChecks + 1 + } + } +} + +Checks <- + c( + 'Taxonomical quality Checks', + 'Spatial quality Checks', + 'Temporal quality Checks', + 'Total quality Checks' + ) +Count <- + c( + taxonChecks, + spatialChecks, + temporalChecks, + (taxonChecks + spatialChecks + temporalChecks + otherChecks) + ) +check.summary <- data.frame(Checks, Count) +kable(check.summary) +``` + +## Quality Checks + +```{r echo=FALSE, results='asis'} +index <- 1 +checkCount <- 1 +for (question in checks.records) { + cat(paste('###', index, '. ', question$question, '\n', sep = '')) + cat('\n') + + cat(paste('Received Response: ', question$answer, '\n', sep = '')) + cat('\n') + + checkIndex <- 1 + for (check in question$checks) { + cat(paste( + '####', + 'Quality Check ', + checkCount, + ': ', + names(question$checks[checkIndex]), + sep = '' + )) + + Type <- + c('Description', + 'Sample Pass Data', + 'Sample Fail Data', + 'Target DwC Field', + 'Check Category', + 'Flagged Records') + + Value <- + c( + check$description, + check$sample_pass_data, + check$sample_fail_data, + check$target_dwc_field, + toTitleCase(check$check_category), + check$affected_data + ) + + check.data.summary <- data.frame(Type, Value) + print(kable(check.data.summary)) + cat('\n') + checkIndex <- checkIndex + 1 + checkCount <- checkCount + 1 + } + index <- index + 1 +} +``` + +## References + +Tomer Gueta, Vijay Barve, Thiloshon Nagarajah, Ashwin Agrawal and Carmel Yohay (2018). bdclean: Biodiversity Data + Cleaning Workflow. R package version 0.0.6. + +R Core Team (2012). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, URL http://www.R-project.org/ diff --git a/inst/rmd/generateShortReport.Rmd b/inst/rmd/generateShortReport.Rmd new file mode 100644 index 0000000..390d489 --- /dev/null +++ b/inst/rmd/generateShortReport.Rmd @@ -0,0 +1,16 @@ +--- +title: 'Data Cleaning Report of bdclean Package' +author: "`r Sys.info()[['user']]`" +date: "`r date()`" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +suppressPackageStartupMessages(library(knitr)) +``` + +## Data Cleaning Summary Table + +```{r echo=FALSE} +kable(records_table) +``` \ No newline at end of file diff --git a/inst/shiny/bdclean-modules/functions.R b/inst/shiny/bdclean-modules/functions.R new file mode 100644 index 0000000..fe32a75 --- /dev/null +++ b/inst/shiny/bdclean-modules/functions.R @@ -0,0 +1,38 @@ +summarizeDataframe <- function(data) { + if (nrow(data) == 0) { + return(data) + } + temp_data <- as.data.frame(data) + temp_data <- + temp_data[, names(temp_data) %in% c( + "scientificName", + "taxonRank", + "eventDate", + "country", + "decimalLatitude", + "decimalLongitude" + )] + temp_data <- cbind(temp_data, data) + hiding_cols <- c() + temp_data[] <- lapply(temp_data, as.character) + + for (i in 1:length(names(temp_data))) { + size <- ifelse(nrow(temp_data) > 1000, 1000, nrow(temp_data)) + sample <- + sample(1:nrow(temp_data), size = size) + f <- + mean(sapply(temp_data[sample, i], function(x) + nchar(x)), na.rm = T) + + if (!is.nan(f)) { + if (f > 50) { + hiding_cols <- c(hiding_cols, i) + } + } + } + + if (length(hiding_cols) > 0) { + temp_data <- temp_data[, c(hiding_cols * -1)] + } + temp_data +} diff --git a/inst/shiny/bdclean-modules/global.R b/inst/shiny/bdclean-modules/global.R new file mode 100644 index 0000000..7658557 --- /dev/null +++ b/inst/shiny/bdclean-modules/global.R @@ -0,0 +1,4 @@ +source("modules/input-module.R") +source("modules/questionnaire-module.R") +source("modules/customized-checks-module.R") +source("modules/flagging-module.R") \ No newline at end of file diff --git a/inst/shiny/bdclean-modules/modules/customized-checks-module.R b/inst/shiny/bdclean-modules/modules/customized-checks-module.R new file mode 100644 index 0000000..a4144d5 --- /dev/null +++ b/inst/shiny/bdclean-modules/modules/customized-checks-module.R @@ -0,0 +1,91 @@ +# UI Function +customizedCheckUI <- function(id) { + ns <- NS(id) + + tagList( + div(class = "secondaryHeaders", h3("Option 02: Customized Checks")), + helpText( + "Note: Select the quality checks you prefer and + continue cleaning with just those checks" + ), + + # ------------------------------- + + uiOutput(ns("qualityChecks")) + + # ------------------------------- + ) +} + +# Server Function +customizedCheck <- function(input, output, session) { + ns <- session$ns + qualityChecks <- bdclean::get_checks_list() + + output$qualityChecks <- renderUI({ + components <- list() + + for (i in 1:length(qualityChecks)) { + components[[i]] <- tagList( + HTML( + paste( + "" + ) + ), + div( + class = "checksListContent", + h4(qualityChecks[[i]]$nameOfQualityCheck), + + div(class = "checksListTopic col-sm-3", p("Description: ")), + div( + class = "checksListTitle", + p(qualityChecks[[i]]$description) + ), + + div(class = "checksListTopic col-sm-3", p("Sample Passing Data: ")), + div( + class = "checksListTitle", + p(qualityChecks[[i]]$samplePassData) + ), + + div(class = "checksListTopic col-sm-3", p("Sample Failing Data: ")), + div( + class = "checksListTitle", + p(qualityChecks[[i]]$sampleFailData) + ), + + div(class = "checksListTopic col-sm-3", p("Category of Quality Check: ")), + div( + class = "checksListTitle", + p(qualityChecks[[i]]$checkCategory) + ), + + div(class = "checksListTopic col-sm-3", p( + "DWC Field Targetted by Check: " + )), + div( + class = "checksListTitle", + p(qualityChecks[[i]]$targetDWCField) + ) + ), + br(), + br() + ) + } + + return( + div( + id = "typeInput", + class = "form-group shiny-input-checkboxgroup shiny-input-container shiny-bound-input", + tags$br(), + tags$br(), + column(width = 12, + components) + ) + ) + }) + +} \ No newline at end of file diff --git a/inst/shiny/bdclean-modules/modules/domain-cleaning-module.R b/inst/shiny/bdclean-modules/modules/domain-cleaning-module.R new file mode 100644 index 0000000..9d25fe5 --- /dev/null +++ b/inst/shiny/bdclean-modules/modules/domain-cleaning-module.R @@ -0,0 +1,60 @@ +# UI Function +domainCleaningUI <- function(id) { + ns <- NS(id) + + tagList( + + renderUI({ + components <- list() + + components[[1]] <- tagList( + HTML( + paste("") + ), + div( + class = "checksListContent", + h4("Marine Research"), + + div(class = "checksListTopic col-sm-3", p("Description: ")), + div( + class = "checksListTitle", + p( + "Researches focused on marine species and marine occarance distribution" + ) + ), + + div(class = "checksListTopic col-sm-3", p("Quality checks performed: ")), + div( + class = "checksListTitle", + p( + "depth_out_of_range_flag, country_coordinate_mismatch_flag, precision_uncertainty_mismatch_flag + , center_of_the_country_coordinates_flag + , coordinate_negated_flag" + ) + ), + + div(class = "checksListTopic col-sm-3", p("DWC Fields Targetted by Checks: ")), + div(class = "checksListTitle", p("coordinates")) + ), + br(), + br() + ) + + return( + div( + id = "domainInput", + class = "form-group shiny-input-radiogroup shiny-input-container shiny-bound-input", + tags$br(), + tags$br(), + column(width = 12, + components) + ) + ) + }) + + + ) +} \ No newline at end of file diff --git a/inst/shiny/bdclean-modules/modules/flagging-module.R b/inst/shiny/bdclean-modules/modules/flagging-module.R new file mode 100644 index 0000000..394162a --- /dev/null +++ b/inst/shiny/bdclean-modules/modules/flagging-module.R @@ -0,0 +1,197 @@ +# UI Function +FlaggingUI <- function(id) { + ns <- NS(id) + + tagList( + h1("Flag Data"), + br(), + h4("Input Data"), + div( + class = "center", + fluidRow( + infoBox("# of Records", textOutput("inputDataRows"), icon = icon("list-ol")), + infoBox( + "# of Fields", + textOutput("inputDataColumns"), + icon = icon("th-list"), + color = "purple" + ), + infoBox( + "# of Unique Scientific Names", + textOutput("inputDataSpecies"), + icon = icon("paw"), + color = "yellow" + ) + ), + + h4("Flag Settings"), + checkboxInput(ns("missingCase"), label = "Mark missing values as Fail", value = FALSE), + helpText( + "Quality checks in bdclean check the validity of each records of the column it targets. If ticked, records with missing values will be considered as invalid record and will be removed. If not ticked, missing records will not be considered in the quality check, so, will remain in the cleaned data. + " + ), + fluidRow( + div( + id = ns("flagButtonDiv"), + class = "completedButton", + actionButton(ns("flagButton"), label = "Flag Data") + ) + + ) + ), + br(), + + # ------------------------------- + + uiOutput(ns("flaggedContentUI")) + + + + # ------------------------------- + ) +} + +# Server Function +Flagging <- function(input, output, session, data_store) { + ns <- session$ns + returnState <- data.frame() + + observeEvent(input$flagButton, { + tempData <- data_store()$inputData + + withProgress(message = "Flagging Data...", { + checks <- + ifelse(data_store()$customizedCheck, + "customizedChecks", + "questionnaire") + + warnings <- capture.output( + returnState <<- + data_store()[[checks]]$flag_data(data_store()$inputData, missing = + input$missingCase), + type = "message" + ) + }) + + shinyjs::addClass(id = "flagButtonDiv", + class = "readyButton") + + shinyjs::removeClass(id = "flagButtonDiv", + class = "completedButton") + + shinyjs::addClass(id = "flagToCleanDiv", + class = "completedButton") + shinyjs::removeClass(id = "flagToCleanDiv", + class = "activeButton") + + }) + + + output$flaggedContentUI <- renderUI({ + input$flagButton + + get_flagging_statistics <- + function(flaggedData) { + flaggedData <- as.data.frame(flaggedData) + + if (nrow(flaggedData) == 0) { + return(0) + } + + checkColumns <- + which(grepl("bdclean", names(flaggedData))) + + if (length(checkColumns) == 0) { + warning("Dataset has no flag columns!") + return(nrow(flaggedData)) + } + + checkData <- flaggedData[, checkColumns] + + + if (class(checkData) == "logical") { + return(nrow(flaggedData) - length(checkData[checkData != TRUE])) + } + + return(nrow(flaggedData) - sum(rowSums(checkData != TRUE, na.rm = TRUE) >= 1)) + } + + warnings <- capture.output(flaggedCount <- + get_flagging_statistics(returnState), + type = "message") + #addWarnings("Message while Flagging", warnings, "question") + + + conditionalPanel( + "input['flaggingMod-flagButton'] > 0", + tagList( + h3("Flagged Data"), + + br(), + + tabsetPanel( + type = "tabs", + tabPanel( + "Statistics View", + div(class = "secondaryHeaders", h3("View 01: Statistics Boxes")), + fluidRow( + infoBox("# of Clean Records", + flaggedCount, + icon = icon("list-ol")), + infoBox( + "# of Newly Added Columns", + length(returnState) - length(data_store()$inputData), + icon = icon("th-list"), + color = "purple" + ), + infoBox( + "# of Unique Scientific Names Remaining", + length(unique( + returnState$scientificName + )), + icon = icon("paw"), + color = "yellow" + ), + infoBox( + "Clean Data", + paste((( + flaggedCount / nrow(data_store()$inputData) + ) * 100), "%", sep = ""), + icon = icon("flag"), + color = "red" + ) + ) + ), + tabPanel( + "Table View", + div(class = "secondaryHeaders", h3("View 02: Summarized Table")), + DT::renderDataTable(summarizeDataframe(returnState), width = 300) + ) + ), + + div( + id = "flagToCleanDiv", + class = "completedButton", + actionButton("flagToClean", label = "Next: Perform Cleaning") + ), + + actionButton("flagToDocument", label = "Next: Continue with Just Flagging") + ) + ) + + + }) + + output$flaggedDataTable <- + reactive(DT::renderDT(summarizeDataframe(data_store$flaggedData))) + + returnDataReact <- reactive({ + # Input actions that need to trigger new dataframe return + input$flagButton + + returnState + }) + + + return(returnDataReact) +} \ No newline at end of file diff --git a/inst/shiny/bdclean-modules/modules/input-module.R b/inst/shiny/bdclean-modules/modules/input-module.R new file mode 100644 index 0000000..1717b11 --- /dev/null +++ b/inst/shiny/bdclean-modules/modules/input-module.R @@ -0,0 +1,347 @@ +# Input Module UI function +bdFileInput <- function(id, label = "Add Occurrence Data") { + # Create a namespace function using the provided id + ns <- NS(id) + + tagList( + column( + 12, + h1("Add Occurrence Data"), + column( + 3, + # ------------- DB Module ------------------- + tabsetPanel( + type = "tabs", + tabPanel( + "Download Data", + div(class = "secondaryHeaders", h3("Option 01: From Online Database")), + textInput( + ns("scientificName"), + label = h3("Scientific Name:"), + value = "Puma concolor" + ), + + numericInput( + ns("recordSize"), + label = h3("Record Size:"), + value = 500 + ), + + selectInput( + ns("hasCoords"), + label = h3("Records Filter:"), + choices = list( + "With Coordinates" = "1", + "Without Coordinates" = "2", + "No Filter" = "3" + ), + selected = 3 + ), + + radioButtons( + ns("queryDB"), + label = h3("Online Database:"), + choices = list( + "GBIF (Global Biodiversity Information Facility)" = "gbif", + "iDigBio (Integrated Digitized Biocollections)" = "idigbio", + "EcoEngine (Berkeley Ecoinformatics Engine)" = "ecoengine", + "Vertnet (Vertebrate Network)" = "vertnet", + "BISON (Biodiversity Information Serving Our Nation)" = "bison", + "iNaturalist" = "inat", + "ALA (Atlas of Living Australia)" = "ala" + # "OBIS (Ocean Biogeographic Information System)" = "obis", + # "AntWeb" = "antweb" + ), + selected = "gbif" + ), + + br(), + div( + id = ns("queryDatabaseDiv"), + class = "activeButton", + actionButton(ns("queryDatabase"), "Query Database", icon("download")) + ), + br() + ), + + # ------------- End of DB Module ------------------- + + # ------------- Local Disk Module ------------------- + tabPanel( + "Upload Data", + div(class = "secondaryHeaders", h3("Option 02: From Local Disk")), + div( + id = ns("inputFileDiv"), + class = "activeButton", + fileInput( + ns("inputFile"), + label = h3("CSV / DWCA ZIP file input"), + accept = c( + "text/csv", + "text/comma-separated-values,text/plain", + ".csv", + ".zip", + "application/zip" + ) + ) + ) + ), + + checkboxInput(ns("darwinizerControl"), + label = "Perform Header Cleaning", + value = TRUE), + + helpText( + "To manually edit or clean headers, use ", + a("bdDwC", href = "https://github.com/bd-R/bdDwC"), + " package." + ) + + + # ------------- End of Local Disk Module ------------------- + + + ) + + + ), + + # ------------- Map / Table Module ------------------- + column(9, + tabsetPanel( + type = "tabs", + tabPanel( + "Map View", + leafletOutput(ns("mymap"), height = "700"), + absolutePanel( + top = 60, + right = 20, + selectInput( + ns("mapTexture"), + "Map Texture", + choices = list( + "OpenStreetMap.Mapnik" = "OpenStreetMap.Mapnik", + "OpenStreetMap.BlackAndWhite" = "OpenStreetMap.BlackAndWhite", + "Stamen.Toner" = "Stamen.Toner", + "CartoDB.Positron" = "CartoDB.Positron", + "Esri.NatGeoWorldMap" = "Esri.NatGeoWorldMap", + "Stamen.Watercolor" = "Stamen.Watercolor", + "Stamen.Terrain" = "Stamen.Terrain", + "Esri.WorldImagery" = "Esri.WorldImagery", + "Esri.WorldTerrain" = "Esri.WorldTerrain" + ), + selected = "CartoDB.Positron" + ), + selectInput( + ns("mapColor"), + "Points Color", + choices = list( + "Red" = 'red', + "Green" = "green", + "Blue" = "blue", + "Black" = "black" + ) + ) + ) + ), + tabPanel("Table View", + DT::dataTableOutput(ns("inputDataTable"))) + )) + + # ------------- End of Map/Table Module ------------------- + ) + ) +} + + + + + +# Input Module server function +bdFile <- function(input, output, session) { + ns <- session$ns + returnData <- data.frame() + map <- leafletProxy(ns("mymap")) + + # ---------------- + + observeEvent(input$queryDatabase, { + withProgress(message = paste("Querying", input$queryDB, "..."), { + if (input$queryDB == "gbif") { + data <- + rgbif::occ_search( + scientificName = input$scientificName, + limit = input$recordSize, + hasCoordinate = switch( + input$hasCoords, + "1" = TRUE, + "2" = FALSE, + "3" = NULL + ) + ) + returnData <<- data$data + + } else { + warnings <- capture.output( + data <- + spocc::occ( + query = input$scientificName, + from = input$queryDB, + limit = input$recordSize, + has_coords = switch( + input$hasCoords, + "1" = TRUE, + "2" = FALSE, + "3" = NULL + ) + ), + type = "message" + ) + + if (length(warnings) > 0) { + showNotification(paste(warnings, collapse = " "), + duration = 6) + } + + tempData <- data[[input$queryDB]]$data[[1]] + returnData <<- tempData + } + }) + + dataLoadedTask(returnData) + + + }) + + observeEvent(input$inputFile, { + withProgress(message = paste("Reading", input$inputFile$name, "..."), { + + if (is.null(input$inputFile)) + return("No data to view") + + if (grepl("zip", tolower(input$inputFile$type))) { + message("Reading DWCA ZIP...") + finchRead <- + finch::dwca_read(input$inputFile$datapath, read = T) + returnData <<- finchRead$data[[1]] + + } else { + returnData <<- + data.table::fread(input$inputFile$datapath) + } + }) + dataLoadedTask(returnData) + + + }) + + + observeEvent(input$mapTexture, { + if (length(returnData) == 0) { + return(NULL) + } + leafletProxy(ns("mymap"), data = returnData) %>% + clearShapes() %>% + addCircles(~ decimalLongitude, ~ decimalLatitude, color = input$mapColor) + }) + + observeEvent(input$mapColor, { + if (length(returnData) == 0) { + return(NULL) + } + leafletProxy(ns("mymap"), data = returnData) %>% + clearShapes() %>% + addCircles(~ decimalLongitude, ~ decimalLatitude, color = input$mapColor) + }) + + + output$mymap <- renderLeaflet({ + leaflet() %>% + addProviderTiles(input$mapTexture) %>% + setView(0, 0, zoom = 2) + }) + + dataLoadedTask <- function(data) { + if (length(data) == 0) { + showNotification("Empty data returned! Try different setting.", + duration = 2) + return() + } + + # ------------ Darwinizing Data ------------- + + if (input$darwinizerControl) { + showNotification("Cleaning Headers", duration = 2) + dictionaryPath <- + system.file("txts/customDwCdictionary.txt", package = "bdclean") + customDictionary <- + data.table::fread(file = dictionaryPath) + + darwinizer <- + bdDwC::darwinize_names(as.data.frame(returnData), as.data.frame(customDictionary)) + + fixed <- + darwinizer[darwinizer$matchType == "Darwinized",] + + if (nrow(fixed) > 0) { + tidyData <- bdDwC::renameUserData(returnData, darwinizer) + + returnData <<- tidyData + + showNotification(paste( + "Converted Columns:", + paste( + paste(fixed[, 1], collapse = ", "), + paste(fixed[, 2], collapse = ", "), + sep = " -> " + ) + ), + duration = 7) + } + } + + if ("decimalLatitude" %in% colnames(returnData)) { + returnData$decimalLatitude <<- + as.numeric(returnData$decimalLatitude) + returnData$decimalLongitude <<- + as.numeric(returnData$decimalLongitude) + } + + # ------------ End of Darwinizing Data ------------- + + try(leafletProxy(ns("mymap"), data = returnData) %>% + clearShapes() %>% + addCircles(~ decimalLongitude, ~ decimalLatitude, color = input$mapColor)) + + output$inputDataTable <- DT::renderDataTable(DT::datatable({ + summarizeDataframe(returnData) + }, options = list(scrollX = TRUE))) + + + shinyjs::runjs(code = paste('$("#', ns("queryDatabaseDiv"), '").addClass("readyButton");', sep = "")) + shinyjs::runjs(code = paste('$("#', ns("queryDatabaseDiv"), '").removeClass("activeButton");', sep = "")) + shinyjs::runjs(code = paste('$("#', ns("inputFileDiv"), '").addClass("readyButton");', sep = "")) + shinyjs::runjs(code = paste('$("#', ns("inputFileDiv"), '").removeClass("activeButton");', sep = "")) + shinyjs::runjs(code = paste('$("#', "dataToConfigureDiv", '").addClass("completedButton");', sep = "")) + shinyjs::runjs(code = paste('$("#', "dataToConfigureDiv", '").removeClass("activeButton");', sep = "")) + + + showNotification("Read Data Successfully", duration = 2) + + + # --------- Setting flag tab statistic boxes ------- + # TODO + + } + + returnDataReact <- reactive({ + # Input actions that need to trigger new dataframe return + input$inputFile + input$queryDatabase + + returnData + }) + + + return(returnDataReact) +} \ No newline at end of file diff --git a/inst/shiny/bdclean-modules/modules/questionnaire-module.R b/inst/shiny/bdclean-modules/modules/questionnaire-module.R new file mode 100644 index 0000000..c8c3363 --- /dev/null +++ b/inst/shiny/bdclean-modules/modules/questionnaire-module.R @@ -0,0 +1,131 @@ +# UI Function +questionnaireUI <- function(id) { + ns <- NS(id) + + tagList( + div(class = "secondaryHeaders", h3("Option 01: Questionnaire")), + helpText( + "Note: If you have limited knowledge in Biodiversity data, + this option is preferred.", + "Answer a few questions and let bdclean take care of the cleaning." + ), + + + # ------------------------------- + + uiOutput(ns("questionnaire")) + + # ------------------------------- + ) +} + +# Server Function +questionnaire <- function(input, output, session, bdquestions) { + ns <- session$ns + + output$questionnaire <- renderUI({ + components <- list() + + for (question in bdquestions) { + if (question$question.type != "Child" && + question$question.type != "ChildRouter") { + components <- createUIContainer(question, components) + } + } + + return(components) + }) +} + + +# Helper Functions + + +createUIContainer <- function(bdQuestion, components) { + val <- length(components) + 1 + components[[val]] <- createQuestionsUI(bdQuestion, val) + val <- val + 1 + + for (question in bdQuestion$child.questions) { + components[[val]] <- conditionalPanel( + condition = paste( + "input.", + bdQuestion$question.id, + " == true", + sep = "" + ), + div(class = "subSpan", createQuestionsUI(question, val)) + + ) + val <- val + 1 + } + + return(components) +} + +createQuestionsUI <- function(question, index) { + return(switch( + question$ui.type, + "single-checkbox" = tagList( + h4(paste( + index, question$question, sep = ") " + )), + checkboxInput( + question$question.id, + label = "Yes", + value = FALSE + ), + br() + ), + + "select" = tagList( + h4(paste( + index, question$question, sep = ") " + )), + selectInput( + question$question.id, + label = "", + choices = setNames( + as.character(question$possible.responses), + question$possible.responses + ) + ), + br() + ), + "radio" = tagList( + h4(paste( + index, question$question, sep = ") " + )), + radioButtons( + question$question.id, + label = "", + choices = setNames( + as.character(question$possible.responses), + question$possible.responses + ) + ), + br() + ), + "numericInput" = tagList( + h4(paste( + index, question$question, sep = ") " + )), + numericInput( + question$question.id, + label = "", + value = 1 + ), + br() + ), + + "date-range" = tagList( + h4(paste( + index, question$question, sep = ") " + )), + dateRangeInput(question$question.id, + label = ""), + br() + ) + )) +} + diff --git a/inst/shiny/bdclean-modules/server.R b/inst/shiny/bdclean-modules/server.R new file mode 100644 index 0000000..1a8d09c --- /dev/null +++ b/inst/shiny/bdclean-modules/server.R @@ -0,0 +1,436 @@ +options(shiny.maxRequestSize = 50 * 1024 ^ 2) +library(bdchecks) + +shinyServer(function(input, output, session) { + # ------------- Local Data store ------------------------ + data_store <- + list( + inputData = data.frame(), + configuredCleaning = FALSE, + customizedChecks = c(), + customizedCheck = FALSE, + flaggedData = data.frame(), + flaggingDone = FALSE, + cleanedData = data.frame(), + cleaningDone = FALSE, + questionnaire = bdclean::create_default_questionnaire(), + + warningData = + data.frame( + from = c("Startup"), + message = c("bdclean Started"), + time = "Now", + icon = "rocket" + ), + + cleaningThresholdControl = 7 + ) + + + # ------------- End of Local Data store ------------------------ + + + # ------------- Information Modal ------------------------ + + showModal(modalDialog( + title = h3("Welcome to bdclean!"), + p( + "Clean your Biodiversity data with this tool with greater control." + ), + p( + "Click the tabs in the left and follow the instructions to customize cleaning." + ), + img(src = "bdverse.png", align = "center"), + helpText( + "GPL-3 ©Tomer Gueta, Vijay Barve, Thiloshon Nagarajah, Ashwin Agrawal and Carmel Yohay (2018). + bdclean: Biodiversity Data Cleaning Workflow. R package version 0.1.900" + ), + helpText( + "Contribute: ", + a("https://github.com/bd-R/bdclean", href = "https://github.com/bd-R/bdclean"), + " Join: ", + a("https://bd-r-group.slack.com", href = "https://bd-r-group.slack.com") + ) + + )) + + # ------------- End of Information Modal ------------------------ + + + # ------------- Next Buttons Navigation Control ------------------- + + observeEvent(input$dataToConfigure, { + # Converting reactive element to dataframe + data_store$inputData <<- data_store$inputData() + + + output$inputDataRows <- renderText(nrow(data_store$inputData)) + output$inputDataColumns <- renderText(length(data_store$inputData)) + output$inputDataSpecies <- + renderText(length(unique(data_store$inputData$scientificName))) + + if (nrow(data_store$inputData) > 0) { + updateTabItems(session, "sideBar", "configure") + } else { + showNotification("Please add data first!", duration = 2) + } + }) + + observeEvent(input$configureToFlag, { + if (length(input$typeInput) > 0) { + showNotification("Response to customized cleaning detected", + duration = 2) + + dummyQuestion <- + bdclean::BdQuestion( + # bdclean:: + question = "Customized Quality Checks", + possible.responses = c("Yes", "No"), + question.type = "ChildRouter", + router.condition = c("Yes"), + quality.checks = input$typeInput, + question.id = "dummy", + ui.type = "single-checkbox" + + ) + dummyQuestion$users.answer <- "Yes" + + data_store$customizedChecks <<- + BdQuestionContainer(c(dummyQuestion)) + data_store$customizedCheck <<- TRUE + + } else { + getResponse <- function(bdQuestion) { + showNotification("Response to questionnaire detected", + duration = 2) + # set response + bdQuestion$set_response(input[[bdQuestion$question.id]]) + + if (bdQuestion$question.type == "Router") { + if (bdQuestion$users.answer %in% bdQuestion$router.condition) { + for (question in bdQuestion$child.questions) { + getResponse(question) + } + } + } + } + + for (question in data_store$questionnaire$bdquestions) { + if (question$question.type != "Child") { + getResponse(question) + } + } + } + + data_store$configuredCleaning <<- TRUE + updateTabItems(session, "sideBar", "flag") + }) + + observeEvent(input$flagToClean, { + data_store$flaggedData <<- data_store$flaggedData() + data_store$flaggingDone <<- TRUE + + if (!data_store$flaggingDone) { + showNotification("Please click Flag first!", duration = 2) + return() + } + + withProgress(message = "Cleaning Data...", { + data_store$cleanedData <<- + bdclean::cleaning_function(data_store$flaggedData) # bdclean:: + }) + + shinyjs::addClass(id = "flagToCleanDiv", + class = "readyButton") + shinyjs::removeClass(id = "flagToCleanDiv", + class = "completedButton") + + data_store$cleaningDone <<- TRUE + }) + + observeEvent(input$flagToDocument, { + data_store$flaggedData <<- data_store$flaggedData() + data_store$flaggingDone <<- TRUE + + updateTabItems(session, "sideBar", "document") + + checks <- + ifelse(data_store$customizedCheck, + "customizedChecks", + "questionnaire") + + withProgress(message = "Generating Artifacts...", { + bdclean::create_report_data( + # bdclean:: + data_store$inputData, + data_store$flaggedData, + data_store$cleanedData, + data_store[[checks]], + data_store$cleaningDone, + c("md_document") + ) + }) + + data_store$cleaningDone <- FALSE + data_store$cleanedData <- data_store$flaggedData + }) + + observeEvent(input$cleanToDocument, { + updateTabItems(session, "sideBar", "document") + + withProgress(message = "Generating Artifacts...", { + checks <- + ifelse(data_store$customizedCheck, + "customizedChecks", + "questionnaire") + + bdclean::create_report_data( + # bdclean:: + data_store$inputData, + data_store$flaggedData, + data_store$cleanedData, + data_store[[checks]], + data_store$cleaningDone, + c("md_document") + ) + + }) + }) + + # ------------- End of Next Buttons Navigation Control ------------------- + + + # ------------- Add Data Module ------------------- + + data_store$inputData <- callModule(bdFile, "bdFileInput") + + # ------------- End of Add Data Module ------------------- + + + # ------------- Questionnaire Module ------------------- + + callModule(questionnaire, "questionnaireMod", bdquestions = data_store$questionnaire$bdquestions) + + # ------------- End of Questionnaire Module ------------------- + + + # ------------- Quality Checks Module ------------------- + + callModule(customizedCheck, "customCheckMod") + + # ------------- End of Quality Checks Module ------------------- + + + # ------------- Flagging Module ------------------- + + + data_store$flaggedData <- callModule(Flagging, "flaggingMod", reactive({data_store})) + + # ------------- End of Flagging Module ------------------- + + + # ------------- Cleaning Module ------------------------ + + output$cleanedResultsUI <- renderUI({ + conditionalPanel("input.flagToClean > 0", + tagList( + div(id = "completedIcon", img( + src = "completed.png", align = "center" + )), + p(paste("Cleaning is succesfully done.")), + + div( + id = "cleanToDocumentDiv", + class = "completedButton", + actionButton("cleanToDocument", label = "Next: Manage Artifacts and Reports") + ), + + div(class = "progressStep", taskItem( + value = 80, color = "red", + "Step 5 of 6" + )) + )) + }) + + # ------------- End of Cleaning Module ------------------------ + + + # ------------- Documentation Module ------------------------ + + output$documentContentUI <- renderUI({ + input$flagButton + tagList( + conditionalPanel( + "input.flagToDocument > 0 || input.cleanToDocument > 0", + tagList( + tabsetPanel( + type = "tabs", + tabPanel( + "Input Data", + div(class = "secondaryHeaders", h3("Artifact 01: Input RAW Data")), + downloadButton("downloadInput", "Download Input Data"), + br(), + br(), + DT::renderDataTable(summarizeDataframe(data_store$inputData), width = 300) + ), + tabPanel( + "Flagged Data", + div(class = "secondaryHeaders", h3( + "Artifact 02: Complete Flagged Data" + )), + downloadButton("downloadFlagged", "Download Flagged Data"), + br(), + br(), + DT::renderDataTable(summarizeDataframe(data_store$flaggedData), width = 300) + ), + tabPanel( + "Cleaned Data", + div(class = "secondaryHeaders", h3("Artifact 03: Cleaned Data")), + downloadButton("downloadCleaned", "Download Cleaned Data"), + br(), + br(), + DT::renderDataTable(summarizeDataframe(data_store$cleanedData), width = 300) + ), + tabPanel( + "Cleaning Report", + div(class = "secondaryHeaders", h3( + "Report 01: Short Cleaning Summary" + )), + + downloadButton("downloadShortReport", "Download Cleaning Summary"), + br(), + br(), + includeMarkdown(paste(tempdir(), "/generateShortReport.md", sep = "")) + ), + tabPanel( + "Detailed Quality Check Report", + div(class = "secondaryHeaders", h3( + "Report 02: Detailed Quality Check Report" + )), + downloadButton("downloadDetailedReport", "Download Detailed Report"), + br(), + br(), + includeMarkdown(paste(tempdir(), "/generateDetailedReport.md", sep = "")) + ) + ), + div( + class = "progressStep", + taskItem(value = 100, color = "green", + "Step 6 of 6") + ) + ) + ) + ) + }) + + output$downloadShortReport <- downloadHandler( + filename = function() { + paste("shortReport-", Sys.Date(), switch( + input$reportFormat, + "pdf_document" = ".pdf", + "html_document" = ".html", + "word_document" = ".docx", + "md_document" = ".md" + ), sep = "") + }, + content = function(file) { + withProgress(message = "Preparing download...", { + checks <- + ifelse(data_store$customizedCheck, + "customizedChecks", + "questionnaire") + + bdclean::create_report_data( + # bdclean:: + data_store$inputData, + data_store$cleanedData, + data_store$flaggedData, + data_store[[checks]], + data_store$cleaningDone, + input$reportFormat + ) + }) + + file.copy(file.path( + tempdir(), + paste("/generateShortReport", switch( + input$reportFormat, + "pdf_document" = ".pdf", + "html_document" = ".html", + "word_document" = ".docx", + "md_document" = ".md" + ), sep = "") + ), + file) + } + ) + + output$downloadDetailedReport <- downloadHandler( + filename = function() { + paste("detailedReport-", Sys.Date(), switch( + input$reportFormat, + "pdf_document" = ".pdf", + "html_document" = ".html", + "word_document" = ".word", + "md_document" = ".md" + ), sep = "") + }, + content = function(file) { + withProgress(message = "Preparing download...", { + checks <- + ifelse(data_store$customizedCheck, + "customizedChecks", + "questionnaire") + bdclean::create_report_data( + # bdclean:: + data_store$inputData, + data_store$cleanedData, + data_store$flaggedData, + data_store[[checks]], + data_store$cleaningDone, + input$reportFormat + ) + }) + file.copy(file.path( + tempdir(), + paste("/generateDetailedReport", switch( + input$reportFormat, + "pdf_document" = ".pdf", + "html_document" = ".html", + "word_document" = ".word", + "md_document" = ".md" + ), sep = "") + ), + file) + } + ) + + + output$downloadInput <- downloadHandler( + filename = function() { + paste("inputData-", Sys.Date(), ".csv") + }, + content = function(con) { + write.csv(data_store$inputData, con) + } + ) + output$downloadFlagged <- downloadHandler( + filename = function() { + paste("flaggedData-", Sys.Date(), ".csv") + }, + content = function(con) { + write.csv(data_store$flaggedData, con) + } + ) + + output$downloadCleaned <- downloadHandler( + filename = function() { + paste("cleanedData-", Sys.Date(), ".csv") + }, + content = function(con) { + write.csv(data_store$cleanedData, con) + } + ) + + # ------------- End of Documentation Module ------------------------ +}) diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/001.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/001.json new file mode 100644 index 0000000..b4c6c60 --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/001.json @@ -0,0 +1,117 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 1, + "bdFileInput-queryDB": "gbif", + "bdFileInput-recordSize": 500, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/001.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/001.png new file mode 100644 index 0000000..c7dfcb1 Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/001.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/002.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/002.json new file mode 100644 index 0000000..3d9f22c --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/002.json @@ -0,0 +1,117 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 2, + "bdFileInput-queryDB": "idigbio", + "bdFileInput-recordSize": 500, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/002.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/002.png new file mode 100644 index 0000000..f03e1ec Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/002.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/003.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/003.json new file mode 100644 index 0000000..26e32d2 --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/003.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 3, + "bdFileInput-queryDB": "vertnet", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/003.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/003.png new file mode 100644 index 0000000..0c8f7bd Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/003.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/004.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/004.json new file mode 100644 index 0000000..707ecea --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/004.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 4, + "bdFileInput-queryDB": "bison", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/004.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/004.png new file mode 100644 index 0000000..07e2fb7 Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/004.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/005.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/005.json new file mode 100644 index 0000000..4b006e7 --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/005.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 5, + "bdFileInput-queryDB": "inat", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/005.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/005.png new file mode 100644 index 0000000..85523c3 Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/005.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/006.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/006.json new file mode 100644 index 0000000..dae38df --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/006.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 6, + "bdFileInput-queryDB": "inat", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/006.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/006.png new file mode 100644 index 0000000..85523c3 Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/006.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/007.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/007.json new file mode 100644 index 0000000..324921b --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/007.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 7, + "bdFileInput-queryDB": "ala", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/007.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/007.png new file mode 100644 index 0000000..8816916 Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/007.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/008.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/008.json new file mode 100644 index 0000000..03dd906 --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/008.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "1", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 41, + 42, + 43, + 44, + 45, + 46, + 47, + 48, + 49, + 50 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 8, + "bdFileInput-queryDB": "gbif", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/008.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/008.png new file mode 100644 index 0000000..7ccbacc Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/008.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/009.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/009.json new file mode 100644 index 0000000..790d0ea --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/009.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": false, + "bdFileInput-hasCoords": "1", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 10, + "bdFileInput-queryDB": "idigbio", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/009.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/009.png new file mode 100644 index 0000000..6dc46fd Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/009.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/010.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/010.json new file mode 100644 index 0000000..ccfcff2 --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/010.json @@ -0,0 +1,181 @@ +{ + "input": { + "bdFileInput-darwinizerControl": false, + "bdFileInput-hasCoords": "2", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputDataTable_rows_all": [ + 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 + ], + "bdFileInput-inputDataTable_rows_current": [ + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10 + ], + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 11, + "bdFileInput-queryDB": "idigbio", + "bdFileInput-recordSize": 50, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flaggingMod-flagButton": 0, + "flaggingMod-missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + } + }, + "export": { + + } +} diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/010.png b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/010.png new file mode 100644 index 0000000..ca04225 Binary files /dev/null and b/inst/shiny/bdclean-modules/tests/data-input-module-testing-current/010.png differ diff --git a/inst/shiny/bdclean-modules/tests/data-input-module-testing-expected/001.json b/inst/shiny/bdclean-modules/tests/data-input-module-testing-expected/001.json new file mode 100644 index 0000000..cba86fb --- /dev/null +++ b/inst/shiny/bdclean-modules/tests/data-input-module-testing-expected/001.json @@ -0,0 +1,138 @@ +{ + "input": { + "bdFileInput-darwinizerControl": true, + "bdFileInput-hasCoords": "3", + "bdFileInput-hasCoords-selectized": "", + "bdFileInput-inputFile": null, + "bdFileInput-mapColor": "red", + "bdFileInput-mapColor-selectized": "", + "bdFileInput-mapTexture": "CartoDB.Positron", + "bdFileInput-mapTexture-selectized": "", + "bdFileInput-mymap_bounds": { + "north": 76.6797849031069, + "east": 91.40625, + "south": -76.6797849031069, + "west": -91.0546875 + }, + "bdFileInput-mymap_center": { + "lng": 0, + "lat": 0 + }, + "bdFileInput-mymap_zoom": 2, + "bdFileInput-queryDatabase": 1, + "bdFileInput-queryDB": "gbif", + "bdFileInput-recordSize": 500, + "bdFileInput-scientificName": "Puma concolor", + "configureToFlag": 0, + "dataToConfigure": 0, + "flagButton": 0, + "missingCase": false, + "reportFormat": "pdf_document", + "reportFormat-selectized": "", + "sideBar": "add", + "sidebarCollapsed": false, + "sidebarItemExpanded": null + }, + "output": { + "bdFileInput-mymap": { + "x": { + "options": { + "crs": { + "crsClass": "L.CRS.EPSG3857", + "code": null, + "proj4def": null, + "projectedBounds": null, + "options": { + + } + } + }, + "calls": [ + { + "method": "addProviderTiles", + "args": [ + "CartoDB.Positron", + null, + null, + { + "errorTileUrl": "", + "noWrap": false, + "detectRetina": false + } + ] + } + ], + "setView": [ + [ + 0, + 0 + ], + 2, + [ + + ] + ] + }, + "evals": [ + + ], + "jsHooks": [ + + ], + "deps": [ + { + "name": "leaflet-providers", + "version": "1.1.17", + "src": { + "href": "leaflet-providers-1.1.17" + }, + "meta": null, + "script": "leaflet-providers.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + }, + { + "name": "leaflet-providers-plugin", + "version": "2.0.2", + "src": { + "href": "leaflet-providers-plugin-2.0.2" + }, + "meta": null, + "script": "leaflet-providers-plugin.js", + "stylesheet": null, + "head": null, + "attachment": null, + "package": null, + "all_files": true + } + ] + }, + "messageMenu": { + "html": "
  • \n \n <\/i>\n 1<\/span>\n <\/a>\n