From 574f84b610a4f652fa85b61a381c446d348a3941 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Tue, 30 Jun 2020 16:41:06 +0200 Subject: [PATCH 01/63] Create indicator_native_range_year.R #64 downloaded and renamed from: https://github.com/inbo/reporting-rshiny-grofwildjacht/files/4851491/exoten_indicatorYearByNativeRange.zip --- R/indicator_native_range_year.R | 89 +++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 R/indicator_native_range_year.R diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R new file mode 100644 index 00000000..e33a2264 --- /dev/null +++ b/R/indicator_native_range_year.R @@ -0,0 +1,89 @@ +#' Create interactive plot for counts per native region and year of introduction +#' +#' Based on \code{\link{countYearProvince}} plot from grofwild +#' @param type character, native_range level of interest should be one of +#' \code{c("native_continent", "native_range")} +#' @inheritParams countYearProvince +#' @return list with: +#' \itemize{ +#' \item{'plot': }{plotly object, for a given specie the observed number +#' per year and per province is plotted in a stacked bar chart} +#' \item{'data': }{data displayed in the plot, as data.frame with: +#' \itemize{ +#' \item{'year': }{year at which the animal was introduced} +#' \item{'nativeRange': }{native range of the introduced animal} +#' \item{'aantal': }{counts of animals} +#' } +#' } +#' } +#' @import plotly +#' @importFrom reshape2 melt +#' @importFrom INBOtheme inbo.2015.colours +#' @export +countYearNativerange <- function(data, jaartallen = NULL, + type = c("native_continent", "native_range"), + width = NULL, height = NULL) { + + type <- match.arg(type) + + if (is.null(jaartallen)) + jaartallen <- sort(unique(data$first_observed)) + + plotData <- data + plotData$locatie <- switch(type, + native_range = plotData$native_range, + native_continent = plotData$native_continent + ) + + # Select data + plotData <- plotData[plotData$first_observed %in% jaartallen, c("first_observed", "locatie")] + plotData <- plotData[!is.na(plotData$first_observed) & !is.na(plotData$locatie), ] + + # Exclude unused provinces + plotData$locatie <- as.factor(plotData$locatie) + plotData$locatie <- droplevels(plotData$locatie) + + # Summarize data per native_range and year + plotData$first_observed <- with(plotData, factor(first_observed, levels = + min(jaartallen):max(jaartallen))) + + summaryData <- melt(table(plotData), id.vars = "first_observed") + + # Summarize data per year + totalCount <- table(plotData$first_observed) + + + # For optimal displaying in the plot + summaryData$locatie <- as.factor(summaryData$locatie) + summaryData$locatie <- factor(summaryData$locatie, levels = rev(levels(summaryData$locatie))) + summaryData$first_observed <- as.factor(summaryData$first_observed) + + colors <- rev(inbo.2015.colours(n = nlevels(summaryData$locatie))) + title <- yearToTitleString(year = c(jaartallen[1], tail(jaartallen, 1)), brackets = FALSE) + + # Create plot + pl <- plot_ly(data = summaryData, x = ~first_observed, y = ~value, color = ~locatie, + colors = colors, type = "bar", width = width, height = height) %>% + layout(title = title, + xaxis = list(title = "Jaar"), + yaxis = list(title = "Aantal", tickformat = ",d"), + margin = list(b = 80, t = 100), + barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack"), + annotations = list(x = levels(summaryData$first_observed), + y = totalCount, + text = paste(ifelse(nlevels(summaryData$first_observed) == 1, "totaal:", ""), ifelse(totalCount > 0, totalCount, "")), + xanchor = 'center', yanchor = 'bottom', + showarrow = FALSE), + showlegend = TRUE) + + # To prevent warnings in UI + pl$elementId <- NULL + + # Change variable name + names(summaryData)[names(summaryData) == "value"] <- "aantal" + names(summaryData)[names(summaryData) == "first_observed"] <- "jaar" + names(summaryData)[names(summaryData) == "locatie"] <- "regio van oorsprong" + + return(list(plot = pl, data = summaryData)) + +} From d7373b96138d48c6fc9393b8349d0c3fe1686623 Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 7 Jul 2020 13:21:06 +0200 Subject: [PATCH 02/63] Create test_indicator_native_range_year.R #64 --- tests/testthat/test_indicator_native_range_year.R | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 tests/testthat/test_indicator_native_range_year.R diff --git a/tests/testthat/test_indicator_native_range_year.R b/tests/testthat/test_indicator_native_range_year.R new file mode 100644 index 00000000..74c39be0 --- /dev/null +++ b/tests/testthat/test_indicator_native_range_year.R @@ -0,0 +1,7 @@ +library(readr) +data_input_checklist_indicators <- read_delim("https://raw.githubusercontent.com/trias-project/indicators/master/data/interim/data_input_checklist_indicators.tsv", + "\t", escape_double = FALSE, trim_ws = TRUE) + +source("./R/indicator_native_range_year.r") + +countYearNativerange(data_input_checklist_indicators, jaartallen = c(1950:2019), type = "native_range") \ No newline at end of file From c2ed6216d74817bb0f6ea92cb7bbfff8fbf268ed Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 7 Jul 2020 13:22:18 +0200 Subject: [PATCH 03/63] Get the function working outside of reportinggrofwild & INBOtheme #64 --- R/indicator_native_range_year.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index e33a2264..2ab98078 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -23,6 +23,8 @@ countYearNativerange <- function(data, jaartallen = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL) { + require(plotly) + require(data.table) type <- match.arg(type) @@ -58,15 +60,12 @@ countYearNativerange <- function(data, jaartallen = NULL, summaryData$locatie <- factor(summaryData$locatie, levels = rev(levels(summaryData$locatie))) summaryData$first_observed <- as.factor(summaryData$first_observed) - colors <- rev(inbo.2015.colours(n = nlevels(summaryData$locatie))) - title <- yearToTitleString(year = c(jaartallen[1], tail(jaartallen, 1)), brackets = FALSE) + # Create plot - pl <- plot_ly(data = summaryData, x = ~first_observed, y = ~value, color = ~locatie, - colors = colors, type = "bar", width = width, height = height) %>% - layout(title = title, xaxis = list(title = "Jaar"), yaxis = list(title = "Aantal", tickformat = ",d"), + pl <- plot_ly(data = summaryData, x = ~first_observed, y = ~value, color = ~locatie, type = "bar", width = width, height = height) %>% margin = list(b = 80, t = 100), barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack"), annotations = list(x = levels(summaryData$first_observed), From 2879cf53bed0c5360e4992b867400837bbe9601c Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 7 Jul 2020 13:23:42 +0200 Subject: [PATCH 04/63] add axis label customisation #64 this should enable setting the axis labels in english & dutch (default english) --- R/indicator_native_range_year.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 2ab98078..db62ef0f 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -3,6 +3,9 @@ #' Based on \code{\link{countYearProvince}} plot from grofwild #' @param type character, native_range level of interest should be one of #' \code{c("native_continent", "native_range")} +#' @param xlab character string, label of the x-axis. Defaults to "year". +#' @param ylab character string, label of the y-axis. Defaults to "number of +#' alien species". #' @inheritParams countYearProvince #' @return list with: #' \itemize{ @@ -22,7 +25,10 @@ #' @export countYearNativerange <- function(data, jaartallen = NULL, type = c("native_continent", "native_range"), - width = NULL, height = NULL) { + width = NULL, height = NULL, + x_lab = "year", + y_lab = "number of alien species") { + require(plotly) require(data.table) @@ -63,9 +69,9 @@ countYearNativerange <- function(data, jaartallen = NULL, # Create plot - xaxis = list(title = "Jaar"), - yaxis = list(title = "Aantal", tickformat = ",d"), pl <- plot_ly(data = summaryData, x = ~first_observed, y = ~value, color = ~locatie, type = "bar", width = width, height = height) %>% + layout(xaxis = list(title = x_lab), + yaxis = list(title = y_lab, tickformat = ",d"), margin = list(b = 80, t = 100), barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack"), annotations = list(x = levels(summaryData$first_observed), From 2e5f002dd69b399edb60a4e0d06e60e695d0fa56 Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 7 Jul 2020 17:12:44 +0200 Subject: [PATCH 05/63] add relative parameter #64 --- R/indicator_native_range_year.R | 49 +++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index db62ef0f..e15bc1ca 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -24,10 +24,11 @@ #' @importFrom INBOtheme inbo.2015.colours #' @export countYearNativerange <- function(data, jaartallen = NULL, - type = c("native_continent", "native_range"), - width = NULL, height = NULL, - x_lab = "year", - y_lab = "number of alien species") { + type = c("native_continent", "native_range"), + width = NULL, height = NULL, + x_lab = "year", + y_lab = "number of alien species", + relative = FALSE) { require(plotly) require(data.table) @@ -39,8 +40,8 @@ countYearNativerange <- function(data, jaartallen = NULL, plotData <- data plotData$locatie <- switch(type, - native_range = plotData$native_range, - native_continent = plotData$native_continent + native_range = plotData$native_range, + native_continent = plotData$native_continent ) # Select data @@ -53,7 +54,7 @@ countYearNativerange <- function(data, jaartallen = NULL, # Summarize data per native_range and year plotData$first_observed <- with(plotData, factor(first_observed, levels = - min(jaartallen):max(jaartallen))) + min(jaartallen):max(jaartallen))) summaryData <- melt(table(plotData), id.vars = "first_observed") @@ -66,20 +67,28 @@ countYearNativerange <- function(data, jaartallen = NULL, summaryData$locatie <- factor(summaryData$locatie, levels = rev(levels(summaryData$locatie))) summaryData$first_observed <- as.factor(summaryData$first_observed) - + # Create plot - pl <- plot_ly(data = summaryData, x = ~first_observed, y = ~value, color = ~locatie, type = "bar", width = width, height = height) %>% - layout(xaxis = list(title = x_lab), - yaxis = list(title = y_lab, tickformat = ",d"), - margin = list(b = 80, t = 100), - barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack"), - annotations = list(x = levels(summaryData$first_observed), - y = totalCount, - text = paste(ifelse(nlevels(summaryData$first_observed) == 1, "totaal:", ""), ifelse(totalCount > 0, totalCount, "")), - xanchor = 'center', yanchor = 'bottom', - showarrow = FALSE), - showlegend = TRUE) + + if(relative == TRUE){ + position <- "fill" + }else{ + position <- "stack" + } + + pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = locatie)) + + geom_bar(position = position, stat = "identity") + + if(relative == TRUE){ + pl <- pl + scale_y_continuous(labels = scales::percent_format()) + } + + pl <- ggplotly(data = summaryData, pl, width = width, height = height) %>% + layout(xaxis = list(title = x_lab, tickangle = "auto"), + yaxis = list(title = y_lab, tickformat = ",d"), + margin = list(b = 80, t = 100), + barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack")) # To prevent warnings in UI pl$elementId <- NULL @@ -88,7 +97,7 @@ countYearNativerange <- function(data, jaartallen = NULL, names(summaryData)[names(summaryData) == "value"] <- "aantal" names(summaryData)[names(summaryData) == "first_observed"] <- "jaar" names(summaryData)[names(summaryData) == "locatie"] <- "regio van oorsprong" - + return(list(plot = pl, data = summaryData)) } From 215f434fcd278e6c08f525d86a1d76c1d4edc302 Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 7 Jul 2020 17:21:29 +0200 Subject: [PATCH 06/63] Update test_indicator_native_range_year.R #64 --- tests/testthat/test_indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_indicator_native_range_year.R b/tests/testthat/test_indicator_native_range_year.R index 74c39be0..9cfb7d0d 100644 --- a/tests/testthat/test_indicator_native_range_year.R +++ b/tests/testthat/test_indicator_native_range_year.R @@ -4,4 +4,4 @@ data_input_checklist_indicators <- read_delim("https://raw.githubusercontent.com source("./R/indicator_native_range_year.r") -countYearNativerange(data_input_checklist_indicators, jaartallen = c(1950:2019), type = "native_range") \ No newline at end of file +countYearNativerange(data_input_checklist_indicators, jaartallen = c(1990:2019), type = "native_range", relative = FALSE) From 614106de7a7993d9e386d2aa0499dbecf85feca2 Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 7 Jul 2020 18:29:50 +0200 Subject: [PATCH 07/63] set dynamic hoverover text #64 --- R/indicator_native_range_year.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index e15bc1ca..60db8e41 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -27,7 +27,7 @@ countYearNativerange <- function(data, jaartallen = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL, x_lab = "year", - y_lab = "number of alien species", + y_lab = "alien species", relative = FALSE) { require(plotly) @@ -57,6 +57,10 @@ countYearNativerange <- function(data, jaartallen = NULL, min(jaartallen):max(jaartallen))) summaryData <- melt(table(plotData), id.vars = "first_observed") + summaryData <- summaryData %>% + group_by(first_observed) %>% + mutate(total = sum(value), + perc = round((value/total)*100,2)) # Summarize data per year totalCount <- table(plotData$first_observed) @@ -73,23 +77,25 @@ countYearNativerange <- function(data, jaartallen = NULL, if(relative == TRUE){ position <- "fill" + text <- paste0(summaryData$locatie, "
", summaryData$perc, "%") }else{ position <- "stack" + text <- paste0(summaryData$locatie, "
", summaryData$value) } - pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = locatie)) + + pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = locatie, text = text)) + geom_bar(position = position, stat = "identity") if(relative == TRUE){ pl <- pl + scale_y_continuous(labels = scales::percent_format()) } - pl <- ggplotly(data = summaryData, pl, width = width, height = height) %>% + pl <- ggplotly(data = summaryData, pl, width = width, height = height, tooltip ="text") %>% layout(xaxis = list(title = x_lab, tickangle = "auto"), yaxis = list(title = y_lab, tickformat = ",d"), margin = list(b = 80, t = 100), - barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack")) - + barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack")) + # To prevent warnings in UI pl$elementId <- NULL From 323d1a537bb4fc72d1831a1b8203ca355c71e56c Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Wed, 5 Aug 2020 15:15:44 +0200 Subject: [PATCH 08/63] Add translation from native_rang to native_continent #64 --- R/indicator_native_range_year.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 60db8e41..ffa5f8cc 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -38,7 +38,15 @@ countYearNativerange <- function(data, jaartallen = NULL, if (is.null(jaartallen)) jaartallen <- sort(unique(data$first_observed)) - plotData <- data + plotData <- data %>% + mutate(native_continent = case_when(grepl(pattern = "Africa", native_range, ignore.case = TRUE) ~ "Africa", + grepl(pattern = "America", native_range, ignore.case = TRUE) ~ "America", + grepl(pattern = "Asia", native_range, ignore.case = TRUE) ~ "Asia", + grepl(pattern = "Australia", native_range, ignore.case = TRUE) ~ "Oceania", + grepl(pattern = "nesia", native_range, ignore.case = TRUE) ~ "Oceania", + grepl(pattern = "Europe", native_range, ignore.case = TRUE) ~ "Europe", + TRUE ~ as.character(NA))) + plotData$locatie <- switch(type, native_range = plotData$native_range, native_continent = plotData$native_continent From 7c8ff30e4fc4eab0e595677131d6310ad481d598 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 10:30:53 +0200 Subject: [PATCH 09/63] rename function #65 --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index ffa5f8cc..51892649 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -23,7 +23,7 @@ #' @importFrom reshape2 melt #' @importFrom INBOtheme inbo.2015.colours #' @export -countYearNativerange <- function(data, jaartallen = NULL, +indicator_count_year_nativerange <- function(data, jaartallen = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL, x_lab = "year", From c4bd355c5bdb13d38df0532838168542c4f20853 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 10:41:42 +0200 Subject: [PATCH 10/63] translate to english #65 --- R/indicator_native_range_year.R | 34 ++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 51892649..e6321a7e 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -23,7 +23,7 @@ #' @importFrom reshape2 melt #' @importFrom INBOtheme inbo.2015.colours #' @export -indicator_count_year_nativerange <- function(data, jaartallen = NULL, +indicator_count_year_nativerange <- function(data, years = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL, x_lab = "year", @@ -35,8 +35,8 @@ indicator_count_year_nativerange <- function(data, jaartallen = NULL, type <- match.arg(type) - if (is.null(jaartallen)) - jaartallen <- sort(unique(data$first_observed)) + if (is.null(years)) + years <- sort(unique(data$first_observed)) plotData <- data %>% mutate(native_continent = case_when(grepl(pattern = "Africa", native_range, ignore.case = TRUE) ~ "Africa", @@ -47,22 +47,22 @@ indicator_count_year_nativerange <- function(data, jaartallen = NULL, grepl(pattern = "Europe", native_range, ignore.case = TRUE) ~ "Europe", TRUE ~ as.character(NA))) - plotData$locatie <- switch(type, + plotData$location <- switch(type, native_range = plotData$native_range, native_continent = plotData$native_continent ) # Select data - plotData <- plotData[plotData$first_observed %in% jaartallen, c("first_observed", "locatie")] - plotData <- plotData[!is.na(plotData$first_observed) & !is.na(plotData$locatie), ] + plotData <- plotData[plotData$first_observed %in% years, c("first_observed", "location")] + plotData <- plotData[!is.na(plotData$first_observed) & !is.na(plotData$location), ] # Exclude unused provinces - plotData$locatie <- as.factor(plotData$locatie) - plotData$locatie <- droplevels(plotData$locatie) + plotData$location <- as.factor(plotData$location) + plotData$location <- droplevels(plotData$location) # Summarize data per native_range and year plotData$first_observed <- with(plotData, factor(first_observed, levels = - min(jaartallen):max(jaartallen))) + min(years):max(years))) summaryData <- melt(table(plotData), id.vars = "first_observed") summaryData <- summaryData %>% @@ -75,8 +75,8 @@ indicator_count_year_nativerange <- function(data, jaartallen = NULL, # For optimal displaying in the plot - summaryData$locatie <- as.factor(summaryData$locatie) - summaryData$locatie <- factor(summaryData$locatie, levels = rev(levels(summaryData$locatie))) + summaryData$location <- as.factor(summaryData$location) + summaryData$location <- factor(summaryData$location, levels = rev(levels(summaryData$location))) summaryData$first_observed <- as.factor(summaryData$first_observed) @@ -85,13 +85,13 @@ indicator_count_year_nativerange <- function(data, jaartallen = NULL, if(relative == TRUE){ position <- "fill" - text <- paste0(summaryData$locatie, "
", summaryData$perc, "%") + text <- paste0(summaryData$location, "
", summaryData$perc, "%") }else{ position <- "stack" - text <- paste0(summaryData$locatie, "
", summaryData$value) + text <- paste0(summaryData$location, "
", summaryData$value) } - pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = locatie, text = text)) + + pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = location, text = text)) + geom_bar(position = position, stat = "identity") if(relative == TRUE){ @@ -108,9 +108,9 @@ indicator_count_year_nativerange <- function(data, jaartallen = NULL, pl$elementId <- NULL # Change variable name - names(summaryData)[names(summaryData) == "value"] <- "aantal" - names(summaryData)[names(summaryData) == "first_observed"] <- "jaar" - names(summaryData)[names(summaryData) == "locatie"] <- "regio van oorsprong" + names(summaryData)[names(summaryData) == "value"] <- "number" + names(summaryData)[names(summaryData) == "first_observed"] <- "year" + names(summaryData)[names(summaryData) == "location"] <- "region of origin" return(list(plot = pl, data = summaryData)) From 09958da1f25f5727322d40620787692b925f2fb8 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:04:43 +0200 Subject: [PATCH 11/63] add data.table & plotly to description #65 --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 43e686f0..42819f72 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,6 +17,7 @@ Depends: Imports: assertthat, assertable, + data.table, dplyr, egg, forcats, @@ -25,6 +26,7 @@ Imports: lazyeval, magrittr, mgcv, + plotly, purrr, readr, rgbif, From b4f8fca8037550fb4502a6cbf1b8b420e2395896 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:05:08 +0200 Subject: [PATCH 12/63] Add @sanderdevisscher to Authors #65 --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 42819f72..4b9501bb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,8 @@ Description: TrIAS provides functionality to facilitate the data processing Authors@R: c( person("Damiano", "Oldoni", role = c("aut", "cre"), email = "damiano.oldoni@inbo.be", comment = c(ORCID = "0000-0003-3445-7562")), person("Peter", "Desmet", role = "aut", email = "peter.desmet@inbo.be", comment = c(ORCID = "0000-0002-8442-8025")), - person("Stijn", "Van Hoey", role = "ctb", email = "stijnvanhoey@gmail.com", comment = c(ORCID = "0000-0001-6413-3185")) + person("Stijn", "Van Hoey", role = "ctb", email = "stijnvanhoey@gmail.com", comment = c(ORCID = "0000-0001-6413-3185")), + person("Sander", "Devisscher", role = "ctb", email = sander.devisscher@inbo.be, comment = c(ORCID = "0000-0003-2015-5731")) ) License: MIT + file LICENSE URL: https://github.com/trias-project/trias, https://trias-project.github.io/trias From 68783924e72d74b475e8519f93906e6ddb2cba7f Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:14:51 +0200 Subject: [PATCH 13/63] Add reshape 2 & scales to description #65 --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 4b9501bb..4506178f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,6 +32,8 @@ Imports: readr, rgbif, rlang, + reshape2, + scales, stringr, tibble, tidyr, From 2ae86fdef3f8770523b939b919f06b5b89551c00 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:38:23 +0200 Subject: [PATCH 14/63] cleanup roxygen part of function #65 --- R/indicator_native_range_year.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index e6321a7e..87e633d5 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -3,25 +3,26 @@ #' Based on \code{\link{countYearProvince}} plot from grofwild #' @param type character, native_range level of interest should be one of #' \code{c("native_continent", "native_range")} -#' @param xlab character string, label of the x-axis. Defaults to "year". -#' @param ylab character string, label of the y-axis. Defaults to "number of +#' @param xlab character string, label of the x-axis. Default: "year". +#' @param ylab character string, label of the y-axis. Default: "number of #' alien species". -#' @inheritParams countYearProvince +#' #' @return list with: #' \itemize{ -#' \item{'plot': }{plotly object, for a given specie the observed number +#' \item{'plot': }{plotly object, for a given species the observed number #' per year and per province is plotted in a stacked bar chart} #' \item{'data': }{data displayed in the plot, as data.frame with: #' \itemize{ #' \item{'year': }{year at which the animal was introduced} -#' \item{'nativeRange': }{native range of the introduced animal} -#' \item{'aantal': }{counts of animals} +#' \item{'native_range': }{native range of the introduced animal} +#' \item{'n': }{counts of animals} #' } #' } #' } -#' @import plotly +#' @importForm plotly plotly, ggplotly, layout #' @importFrom reshape2 melt -#' @importFrom INBOtheme inbo.2015.colours +#' @importFrom ggplot2 ggplot, geom_bar, scale_y_continuous +#' @importFrom scales percent_format #' @export indicator_count_year_nativerange <- function(data, years = NULL, type = c("native_continent", "native_range"), @@ -95,7 +96,7 @@ indicator_count_year_nativerange <- function(data, years = NULL, geom_bar(position = position, stat = "identity") if(relative == TRUE){ - pl <- pl + scale_y_continuous(labels = scales::percent_format()) + pl <- pl + scale_y_continuous(labels = percent_format()) } pl <- ggplotly(data = summaryData, pl, width = width, height = height, tooltip ="text") %>% From eafc40efce2b0f802421460dea308620f093fa0a Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:39:37 +0200 Subject: [PATCH 15/63] stringify my email #65 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4506178f..7bf85f8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,7 @@ Authors@R: c( person("Damiano", "Oldoni", role = c("aut", "cre"), email = "damiano.oldoni@inbo.be", comment = c(ORCID = "0000-0003-3445-7562")), person("Peter", "Desmet", role = "aut", email = "peter.desmet@inbo.be", comment = c(ORCID = "0000-0002-8442-8025")), person("Stijn", "Van Hoey", role = "ctb", email = "stijnvanhoey@gmail.com", comment = c(ORCID = "0000-0001-6413-3185")), - person("Sander", "Devisscher", role = "ctb", email = sander.devisscher@inbo.be, comment = c(ORCID = "0000-0003-2015-5731")) + person("Sander", "Devisscher", role = "ctb", email = "sander.devisscher@inbo.be"", comment = c(ORCID = "0000-0003-2015-5731")) ) License: MIT + file LICENSE URL: https://github.com/trias-project/trias, https://trias-project.github.io/trias From 9d0eacc3c0bf01ffc9e15809df66ee48c6875ab1 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:40:26 +0200 Subject: [PATCH 16/63] remove extra quote #65 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7bf85f8a..16eb62ea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,7 @@ Authors@R: c( person("Damiano", "Oldoni", role = c("aut", "cre"), email = "damiano.oldoni@inbo.be", comment = c(ORCID = "0000-0003-3445-7562")), person("Peter", "Desmet", role = "aut", email = "peter.desmet@inbo.be", comment = c(ORCID = "0000-0002-8442-8025")), person("Stijn", "Van Hoey", role = "ctb", email = "stijnvanhoey@gmail.com", comment = c(ORCID = "0000-0001-6413-3185")), - person("Sander", "Devisscher", role = "ctb", email = "sander.devisscher@inbo.be"", comment = c(ORCID = "0000-0003-2015-5731")) + person("Sander", "Devisscher", role = "ctb", email = "sander.devisscher@inbo.be", comment = c(ORCID = "0000-0003-2015-5731")) ) License: MIT + file LICENSE URL: https://github.com/trias-project/trias, https://trias-project.github.io/trias From b0e064be563b0f987628ab5984a805d084c7e869 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 11:44:04 +0200 Subject: [PATCH 17/63] rename function correctly #65 --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 87e633d5..0b0467c4 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -24,7 +24,7 @@ #' @importFrom ggplot2 ggplot, geom_bar, scale_y_continuous #' @importFrom scales percent_format #' @export -indicator_count_year_nativerange <- function(data, years = NULL, +indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL, x_lab = "year", From 66a85842ca61ebc8e886d07b5fbf2deba519ea4c Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 12:50:33 +0200 Subject: [PATCH 18/63] add dplyr to import rules #65 --- R/indicator_native_range_year.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 0b0467c4..361f9e44 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -23,6 +23,7 @@ #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot, geom_bar, scale_y_continuous #' @importFrom scales percent_format +#' @importFrom dplyr mutate, group_by #' @export indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), From 2d280b59f591e5a62133a2bc477820ebbc8229eb Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 12:54:09 +0200 Subject: [PATCH 19/63] add ggplot - plot to output & rename slots #65 --- R/indicator_native_range_year.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 361f9e44..81379e95 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -9,7 +9,9 @@ #' #' @return list with: #' \itemize{ -#' \item{'plot': }{plotly object, for a given species the observed number +#' \item{'static_plot': }{ggplot object, for a given species the observed number +#' per year and per province is plotted in a stacked bar chart} +#' \item{'interactive_plot': }{plotly object, for a given species the observed number #' per year and per province is plotted in a stacked bar chart} #' \item{'data': }{data displayed in the plot, as data.frame with: #' \itemize{ @@ -100,7 +102,7 @@ indicator_native_range_year <- function(data, years = NULL, pl <- pl + scale_y_continuous(labels = percent_format()) } - pl <- ggplotly(data = summaryData, pl, width = width, height = height, tooltip ="text") %>% + pl_2 <- ggplotly(data = summaryData, pl, width = width, height = height, tooltip ="text") %>% layout(xaxis = list(title = x_lab, tickangle = "auto"), yaxis = list(title = y_lab, tickformat = ",d"), margin = list(b = 80, t = 100), @@ -114,6 +116,6 @@ indicator_native_range_year <- function(data, years = NULL, names(summaryData)[names(summaryData) == "first_observed"] <- "year" names(summaryData)[names(summaryData) == "location"] <- "region of origin" - return(list(plot = pl, data = summaryData)) + return(list(static_plot = pl, interactive_plot = pl_2, data = summaryData)) } From 55678f95ad6a2b060da9e6a1ec40382b5aec2c0f Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:32:22 +0200 Subject: [PATCH 20/63] add case_when to import + remove plotly::plotly from import rules #65 - plotly is the package name not a function - I use mutate, group_by and case_when from dplyr for data manipulation --- R/indicator_native_range_year.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 81379e95..ea2f40d9 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -21,11 +21,11 @@ #' } #' } #' } -#' @importForm plotly plotly, ggplotly, layout +#' @importForm plotly ggplotly, layout #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot, geom_bar, scale_y_continuous #' @importFrom scales percent_format -#' @importFrom dplyr mutate, group_by +#' @importFrom dplyr mutate, group_by, case_when #' @export indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), From 655896b0524c80d48a8d248fd38c946f44616d7f Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:32:57 +0200 Subject: [PATCH 21/63] Update roxygen items & text #65 --- R/indicator_native_range_year.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index ea2f40d9..61537656 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -10,14 +10,16 @@ #' @return list with: #' \itemize{ #' \item{'static_plot': }{ggplot object, for a given species the observed number -#' per year and per province is plotted in a stacked bar chart} +#' per year and per native range is plotted in a stacked bar chart} #' \item{'interactive_plot': }{plotly object, for a given species the observed number -#' per year and per province is plotted in a stacked bar chart} +#' per year and per native range is plotted in a stacked bar chart} #' \item{'data': }{data displayed in the plot, as data.frame with: #' \itemize{ -#' \item{'year': }{year at which the animal was introduced} -#' \item{'native_range': }{native range of the introduced animal} -#' \item{'n': }{counts of animals} +#' \item{'year': }{year at which the species were introduced} +#' \item{'native_range': }{native range of the introduced species} +#' \item{'n': }{number of species introduced from the native range for a given year} +#' \item{'total': }{total number of species, from all around the world, introduced during a given year} +#' \item{'perc': }{percentage of species introduced from the native range for a given year. (n/total)*100} #' } #' } #' } From 84b14ad27f705bb33e22c8d95d3ba7df63c64a95 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:33:30 +0200 Subject: [PATCH 22/63] remove required packages #65 suspected to cause problems --- R/indicator_native_range_year.R | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 61537656..8a5ee816 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -30,14 +30,11 @@ #' @importFrom dplyr mutate, group_by, case_when #' @export indicator_native_range_year <- function(data, years = NULL, - type = c("native_continent", "native_range"), - width = NULL, height = NULL, - x_lab = "year", - y_lab = "alien species", - relative = FALSE) { - - require(plotly) - require(data.table) + type = c("native_continent", "native_range"), + width = NULL, height = NULL, + x_lab = "year", + y_lab = "alien species", + relative = FALSE) { type <- match.arg(type) From 405c0c1a542bb8a5adde5950dc52a165492ed0d7 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:34:42 +0200 Subject: [PATCH 23/63] Remove width & height parameters from ggplotly #65 these are inhereted => NULL --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 8a5ee816..f7b80475 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -101,7 +101,7 @@ indicator_native_range_year <- function(data, years = NULL, pl <- pl + scale_y_continuous(labels = percent_format()) } - pl_2 <- ggplotly(data = summaryData, pl, width = width, height = height, tooltip ="text") %>% + pl_2 <- ggplotly(data = summaryData, pl, tooltip ="text") %>% layout(xaxis = list(title = x_lab, tickangle = "auto"), yaxis = list(title = y_lab, tickformat = ",d"), margin = list(b = 80, t = 100), From 36609c084854b507a5cace1b859ad87dae025224 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:35:02 +0200 Subject: [PATCH 24/63] rename data slots #65 --- R/indicator_native_range_year.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index f7b80475..0de7e7c4 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -111,9 +111,9 @@ indicator_native_range_year <- function(data, years = NULL, pl$elementId <- NULL # Change variable name - names(summaryData)[names(summaryData) == "value"] <- "number" + names(summaryData)[names(summaryData) == "value"] <- "n" names(summaryData)[names(summaryData) == "first_observed"] <- "year" - names(summaryData)[names(summaryData) == "location"] <- "region of origin" + names(summaryData)[names(summaryData) == "location"] <- "native_range" return(list(static_plot = pl, interactive_plot = pl_2, data = summaryData)) From 731271f3cc83787c485b9fa06d14a7d46312d1ff Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:35:26 +0200 Subject: [PATCH 25/63] general layouting/indentations #65 --- R/indicator_native_range_year.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 0de7e7c4..f4e1ca7c 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -49,10 +49,10 @@ indicator_native_range_year <- function(data, years = NULL, grepl(pattern = "nesia", native_range, ignore.case = TRUE) ~ "Oceania", grepl(pattern = "Europe", native_range, ignore.case = TRUE) ~ "Europe", TRUE ~ as.character(NA))) - + plotData$location <- switch(type, - native_range = plotData$native_range, - native_continent = plotData$native_continent + native_range = plotData$native_range, + native_continent = plotData$native_continent ) # Select data @@ -106,7 +106,7 @@ indicator_native_range_year <- function(data, years = NULL, yaxis = list(title = y_lab, tickformat = ",d"), margin = list(b = 80, t = 100), barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack")) - + # To prevent warnings in UI pl$elementId <- NULL From 81a49526bf2aac4de9c02fbe4f537b3c50087a15 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 13:53:43 +0200 Subject: [PATCH 26/63] add pipe to import rules #65 --- R/indicator_native_range_year.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index f4e1ca7c..892315b6 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -23,11 +23,12 @@ #' } #' } #' } -#' @importForm plotly ggplotly, layout #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot, geom_bar, scale_y_continuous +#' @importForm plotly ggplotly, layout #' @importFrom scales percent_format #' @importFrom dplyr mutate, group_by, case_when +#' @importFrom magrittr %>% #' @export indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), From bc4671b3c3a4a13bf25f2a69920550cb09dfcaee Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 14:23:28 +0200 Subject: [PATCH 27/63] Remove "," from import rules #65 --- R/indicator_native_range_year.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 892315b6..081ad96d 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -24,12 +24,14 @@ #' } #' } #' @importFrom reshape2 melt -#' @importFrom ggplot2 ggplot, geom_bar, scale_y_continuous -#' @importForm plotly ggplotly, layout +#' @importFrom ggplot2 ggplot geom_bar scale_y_continuous +#' @importForm plotly ggplotly layout #' @importFrom scales percent_format -#' @importFrom dplyr mutate, group_by, case_when +#' @importFrom dplyr mutate group_by case_when #' @importFrom magrittr %>% #' @export +NULL + indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL, From 946b1b2b769187ab6b1f82372d037e484cee9474 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 14:23:53 +0200 Subject: [PATCH 28/63] complete export rule #65 --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 081ad96d..a9d6e177 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -23,13 +23,13 @@ #' } #' } #' } +#' @export indicator_native_range_year #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot geom_bar scale_y_continuous #' @importForm plotly ggplotly layout #' @importFrom scales percent_format #' @importFrom dplyr mutate group_by case_when #' @importFrom magrittr %>% -#' @export NULL indicator_native_range_year <- function(data, years = NULL, From 5f247e3b26da1752bfad618368a0a30ce8e42f9f Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Thu, 13 Aug 2020 14:24:24 +0200 Subject: [PATCH 29/63] rebuild NAMESPACE #65 --- DESCRIPTION | 2 +- NAMESPACE | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 16eb62ea..afabdbf0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,4 +47,4 @@ LazyData: true Encoding: UTF-8 VignetteBuilder: knitr Roxygen: list(markdown = TRUE) -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 diff --git a/NAMESPACE b/NAMESPACE index c095265a..94a6e3d0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ export(gbif_has_distribution) export(gbif_verify_keys) export(get_table_pathways) export(indicator_introduction_year) +export(indicator_native_range_year) export(indicator_total_year) export(pathways_cbd) export(update_download_list) @@ -80,6 +81,7 @@ importFrom(ggplot2,ggsave) importFrom(ggplot2,ggtitle) importFrom(ggplot2,scale_colour_manual) importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme) importFrom(ggplot2,xlab) importFrom(ggplot2,ylab) @@ -87,6 +89,7 @@ importFrom(ggplot2,ylim) importFrom(grDevices,grey) importFrom(gratia,derivatives) importFrom(lazyeval,interp) +importFrom(magrittr,"%>%") importFrom(mgcv,gam) importFrom(mgcv,nb) importFrom(mgcv,summary.gam) @@ -100,6 +103,7 @@ importFrom(purrr,map_dfr) importFrom(purrr,pmap_dfr) importFrom(purrr,reduce) importFrom(readr,read_delim) +importFrom(reshape2,melt) importFrom(rgbif,name_lookup) importFrom(rgbif,name_usage) importFrom(rgbif,occ_download_meta) @@ -108,6 +112,7 @@ importFrom(rlang,"!!") importFrom(rlang,":=") importFrom(rlang,.data) importFrom(rlang,sym) +importFrom(scales,percent_format) importFrom(stats,formula) importFrom(stats,median) importFrom(stats,predict) From b6305f5f3957e1e56cd31b34d34792fbe5f3035c Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Mon, 17 Aug 2020 10:32:01 +0200 Subject: [PATCH 30/63] Rewrite link to original code #65 --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index a9d6e177..3e203721 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -1,6 +1,6 @@ #' Create interactive plot for counts per native region and year of introduction #' -#' Based on \code{\link{countYearProvince}} plot from grofwild +#' Based on [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] plot from reporting - rshiny - grofwildjacht #' @param type character, native_range level of interest should be one of #' \code{c("native_continent", "native_range")} #' @param xlab character string, label of the x-axis. Default: "year". From 1f49274411967a79575ef80260e62d6249dbe093 Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Mon, 7 Sep 2020 08:56:59 +0200 Subject: [PATCH 31/63] Fix title remove counts and replace by number of alien species. Also some minor fixes to grammar #65 --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 3e203721..353e48c9 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -1,4 +1,4 @@ -#' Create interactive plot for counts per native region and year of introduction +#' Create an interactive plot for the number of alien species per native region and year of introduction #' #' Based on [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] plot from reporting - rshiny - grofwildjacht #' @param type character, native_range level of interest should be one of From 42fbd0aa55392eead51db77e4f8c18e3994a3eca Mon Sep 17 00:00:00 2001 From: Sander Devisscher Date: Mon, 7 Sep 2020 09:00:09 +0200 Subject: [PATCH 32/63] remove case_when for native_continent #65 --- R/indicator_native_range_year.R | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 353e48c9..a5e6edfe 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -44,14 +44,7 @@ indicator_native_range_year <- function(data, years = NULL, if (is.null(years)) years <- sort(unique(data$first_observed)) - plotData <- data %>% - mutate(native_continent = case_when(grepl(pattern = "Africa", native_range, ignore.case = TRUE) ~ "Africa", - grepl(pattern = "America", native_range, ignore.case = TRUE) ~ "America", - grepl(pattern = "Asia", native_range, ignore.case = TRUE) ~ "Asia", - grepl(pattern = "Australia", native_range, ignore.case = TRUE) ~ "Oceania", - grepl(pattern = "nesia", native_range, ignore.case = TRUE) ~ "Oceania", - grepl(pattern = "Europe", native_range, ignore.case = TRUE) ~ "Europe", - TRUE ~ as.character(NA))) + plotData <- data plotData$location <- switch(type, native_range = plotData$native_range, From 29bc26033fadea72c6075204c6b5aff6e47aa15d Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Tue, 8 Sep 2020 14:58:56 +0200 Subject: [PATCH 33/63] Correct typo form -> from --- R/indicator_native_range_year.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index a5e6edfe..365354a3 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -26,7 +26,7 @@ #' @export indicator_native_range_year #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot geom_bar scale_y_continuous -#' @importForm plotly ggplotly layout +#' @importFrom plotly ggplotly layout #' @importFrom scales percent_format #' @importFrom dplyr mutate group_by case_when #' @importFrom magrittr %>% From 2b8f86411f95a78c4d09c8560ab01535a7369ba1 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Tue, 8 Sep 2020 15:00:50 +0200 Subject: [PATCH 34/63] Remove NULL --- R/indicator_native_range_year.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 365354a3..8b2fefed 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -30,7 +30,6 @@ #' @importFrom scales percent_format #' @importFrom dplyr mutate group_by case_when #' @importFrom magrittr %>% -NULL indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), From 824f2c85f51339396b629a34bb964aa0485d617e Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Tue, 8 Sep 2020 15:02:09 +0200 Subject: [PATCH 35/63] Import %>% from dplyr instead of adding magrittr to pkgs --- R/indicator_native_range_year.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 8b2fefed..2e3d7cc5 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -28,8 +28,7 @@ #' @importFrom ggplot2 ggplot geom_bar scale_y_continuous #' @importFrom plotly ggplotly layout #' @importFrom scales percent_format -#' @importFrom dplyr mutate group_by case_when -#' @importFrom magrittr %>% +#' @importFrom dplyr %>% mutate group_by case_when indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), From 25fc4300e580b7a2a498fa91720a99f07194e5ad Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Thu, 10 Sep 2020 17:58:50 +0200 Subject: [PATCH 36/63] Apply styling via styler pkg --- R/indicator_introduction_year.R | 6 +- R/indicator_native_range_year.R | 141 +++++++++--------- R/indicator_total_year.R | 6 +- R/visualize_pathways_level1.R | 3 +- R/visualize_pathways_level2.R | 2 +- R/visualize_pathways_year_level1.R | 99 ++++++------ R/visualize_pathways_year_level2.R | 6 +- .../testthat/test-visualize_pathways_level2.R | 2 +- 8 files changed, 137 insertions(+), 128 deletions(-) diff --git a/R/indicator_introduction_year.R b/R/indicator_introduction_year.R index f314b96e..d8c9d9cc 100644 --- a/R/indicator_introduction_year.R +++ b/R/indicator_introduction_year.R @@ -201,7 +201,8 @@ indicator_introduction_year <- function(df, start_year_plot, maxDate, x_minor_scale_stepsize - )) + + ) + ) + coord_cartesian(xlim = c(start_year_plot, maxDate)) if (is.null(facet_column)) { @@ -232,7 +233,8 @@ indicator_introduction_year <- function(df, start_year_plot, maxDate, x_minor_scale_stepsize - )) + + ) + ) + coord_cartesian(xlim = c(start_year_plot, maxDate)) ggarrange(top_graph, facet_graph) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 2e3d7cc5..5f7ab52f 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -1,114 +1,117 @@ -#' Create an interactive plot for the number of alien species per native region and year of introduction -#' -#' Based on [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] plot from reporting - rshiny - grofwildjacht -#' @param type character, native_range level of interest should be one of -#' \code{c("native_continent", "native_range")} +#' Create an interactive plot for the number of alien species per native region +#' and year of introduction +#' +#' Based on +#' [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] +#' plot from reporting - rshiny - grofwildjacht +#' @param type character, native_range level of interest should be one of +#' \code{c("native_continent", "native_range")} #' @param xlab character string, label of the x-axis. Default: "year". -#' @param ylab character string, label of the y-axis. Default: "number of -#' alien species". -#' -#' @return list with: -#' \itemize{ -#' \item{'static_plot': }{ggplot object, for a given species the observed number -#' per year and per native range is plotted in a stacked bar chart} -#' \item{'interactive_plot': }{plotly object, for a given species the observed number -#' per year and per native range is plotted in a stacked bar chart} -#' \item{'data': }{data displayed in the plot, as data.frame with: -#' \itemize{ -#' \item{'year': }{year at which the species were introduced} -#' \item{'native_range': }{native range of the introduced species} -#' \item{'n': }{number of species introduced from the native range for a given year} -#' \item{'total': }{total number of species, from all around the world, introduced during a given year} -#' \item{'perc': }{percentage of species introduced from the native range for a given year. (n/total)*100} -#' } -#' } -#' } -#' @export indicator_native_range_year +#' @param ylab character string, label of the y-axis. Default: "number of alien +#' species". +#' +#' @return list with: \itemize{ \item{'static_plot': }{ggplot object, for a +#' given species the observed number per year and per native range is plotted +#' in a stacked bar chart} \item{'interactive_plot': }{plotly object, for a +#' given species the observed number per year and per native range is plotted +#' in a stacked bar chart} \item{'data': }{data displayed in the plot, as +#' data.frame with: \itemize{ \item{'year': }{year at which the species were +#' introduced} \item{'native_range': }{native range of the introduced species} +#' \item{'n': }{number of species introduced from the native range for a given +#' year} \item{'total': }{total number of species, from all around the world, +#' introduced during a given year} \item{'perc': }{percentage of species +#' introduced from the native range for a given year. (n/total)*100} } } } +#' @export #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot geom_bar scale_y_continuous #' @importFrom plotly ggplotly layout #' @importFrom scales percent_format #' @importFrom dplyr %>% mutate group_by case_when -indicator_native_range_year <- function(data, years = NULL, +indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), - width = NULL, height = NULL, + width = NULL, height = NULL, x_lab = "year", y_lab = "alien species", relative = FALSE) { - type <- match.arg(type) - - if (is.null(years)) + + if (is.null(years)) { years <- sort(unique(data$first_observed)) - - plotData <- data - + } + + plotData <- data + plotData$location <- switch(type, - native_range = plotData$native_range, - native_continent = plotData$native_continent + native_range = plotData$native_range, + native_continent = plotData$native_continent ) - + # Select data plotData <- plotData[plotData$first_observed %in% years, c("first_observed", "location")] plotData <- plotData[!is.na(plotData$first_observed) & !is.na(plotData$location), ] - + # Exclude unused provinces - plotData$location <- as.factor(plotData$location) + plotData$location <- as.factor(plotData$location) plotData$location <- droplevels(plotData$location) - + # Summarize data per native_range and year - plotData$first_observed <- with(plotData, factor(first_observed, levels = - min(years):max(years))) - + plotData$first_observed <- with(plotData, factor(first_observed, + levels = + min(years):max(years) + )) + summaryData <- melt(table(plotData), id.vars = "first_observed") - summaryData <- summaryData %>% - group_by(first_observed) %>% - mutate(total = sum(value), - perc = round((value/total)*100,2)) - + summaryData <- summaryData %>% + group_by(first_observed) %>% + mutate( + total = sum(value), + perc = round((value / total) * 100, 2) + ) + # Summarize data per year totalCount <- table(plotData$first_observed) - - + + # For optimal displaying in the plot summaryData$location <- as.factor(summaryData$location) summaryData$location <- factor(summaryData$location, levels = rev(levels(summaryData$location))) summaryData$first_observed <- as.factor(summaryData$first_observed) - - - + + + # Create plot - - if(relative == TRUE){ + + if (relative == TRUE) { position <- "fill" text <- paste0(summaryData$location, "
", summaryData$perc, "%") - }else{ + } else { position <- "stack" text <- paste0(summaryData$location, "
", summaryData$value) } - + pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = location, text = text)) + - geom_bar(position = position, stat = "identity") - - if(relative == TRUE){ + geom_bar(position = position, stat = "identity") + + if (relative == TRUE) { pl <- pl + scale_y_continuous(labels = percent_format()) } - - pl_2 <- ggplotly(data = summaryData, pl, tooltip ="text") %>% - layout(xaxis = list(title = x_lab, tickangle = "auto"), - yaxis = list(title = y_lab, tickformat = ",d"), - margin = list(b = 80, t = 100), - barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack")) - + + pl_2 <- ggplotly(data = summaryData, pl, tooltip = "text") %>% + layout( + xaxis = list(title = x_lab, tickangle = "auto"), + yaxis = list(title = y_lab, tickformat = ",d"), + margin = list(b = 80, t = 100), + barmode = ifelse(nlevels(summaryData$first_observed) == 1, "group", "stack") + ) + # To prevent warnings in UI pl$elementId <- NULL - + # Change variable name names(summaryData)[names(summaryData) == "value"] <- "n" names(summaryData)[names(summaryData) == "first_observed"] <- "year" names(summaryData)[names(summaryData) == "location"] <- "native_range" - + return(list(static_plot = pl, interactive_plot = pl_2, data = summaryData)) - } diff --git a/R/indicator_total_year.R b/R/indicator_total_year.R index 9b416e8f..73825615 100644 --- a/R/indicator_total_year.R +++ b/R/indicator_total_year.R @@ -195,7 +195,8 @@ indicator_total_year <- function(df, start_year_plot = 1940, start_year_plot, maxDate, x_minor_scale_stepsize - )) + + ) + ) + coord_cartesian(xlim = c(start_year_plot, maxDate)) if (is.null(facet_column)) { @@ -220,7 +221,8 @@ indicator_total_year <- function(df, start_year_plot = 1940, facet_wrap(facet_column) + scale_x_continuous( breaks = seq(start_year_plot, maxDate, x_major_scale_stepsize), - minor_breaks = seq(start_year_plot, maxDate, x_minor_scale_stepsize)) + + minor_breaks = seq(start_year_plot, maxDate, x_minor_scale_stepsize) + ) + coord_cartesian(xlim = c(start_year_plot, maxDate)) ggarrange(top_graph, facet_graph) diff --git a/R/visualize_pathways_level1.R b/R/visualize_pathways_level1.R index 0a5b13bd..a6a16a86 100644 --- a/R/visualize_pathways_level1.R +++ b/R/visualize_pathways_level1.R @@ -357,7 +357,8 @@ visualize_pathways_level1 <- function(df, if (nrow(df_top_graph) > 0) { top_graph <- ggplot( - df_top_graph) + + df_top_graph + ) + geom_bar(aes(x = fct_rev(.data$pathway_level1))) + xlab(y_lab) + ylab(x_lab) + diff --git a/R/visualize_pathways_level2.R b/R/visualize_pathways_level2.R index 33dabd76..24d4049f 100644 --- a/R/visualize_pathways_level2.R +++ b/R/visualize_pathways_level2.R @@ -47,7 +47,7 @@ #' @param x_lab NULL or character. x-axis label. Default: "Number of introduced #' taxa". #' @param y_lab NULL or character. Title of the graph. Default: "Pathways". -#'@return A ggplot2 object (or egg object if facets are used). NULL if there are +#' @return A ggplot2 object (or egg object if facets are used). NULL if there are #' no data to plot. #' #' @export diff --git a/R/visualize_pathways_year_level1.R b/R/visualize_pathways_year_level1.R index 59476f18..791bba05 100644 --- a/R/visualize_pathways_year_level1.R +++ b/R/visualize_pathways_year_level1.R @@ -1,56 +1,56 @@ -#'Plot number of introduced taxa over time for pathways level 1 +#' Plot number of introduced taxa over time for pathways level 1 #' -#'Function to plot a line graph with number of taxa introduced over time through -#'different CBD pathways level 1. Time expressed in years. Possible breakpoints: -#'taxonomic (kingdoms + vertebrates/invertebrates). -#'@param df df. -#'@param bin numeric. Time span in years to use for agggregation. Default: 10. -#'@param from numeric. Year trade-off: taxa introduced before this year are +#' Function to plot a line graph with number of taxa introduced over time through +#' different CBD pathways level 1. Time expressed in years. Possible breakpoints: +#' taxonomic (kingdoms + vertebrates/invertebrates). +#' @param df df. +#' @param bin numeric. Time span in years to use for agggregation. Default: 10. +#' @param from numeric. Year trade-off: taxa introduced before this year are #' grouped all together. Default: 1950. -#'@param category NULL or character. One of the kingdoms as given in GBIF and +#' @param category NULL or character. One of the kingdoms as given in GBIF and #' `Chordata` (the phylum), `Not Chordata` (all other phyla of `Animalia`): 1. #' `Plantae` 2. `Animalia` 3. `Fungi` 4. `Chromista` 5. `Archaea` 6. `Bacteria` #' 7. `Protozoa` 8. `Viruses` 9. `incertae sedis` 10. `Chordata` 11. `Not #' Chordata` Default: `NULL`. -#'@param facet_column NULL or character. The column to use to create additional +#' @param facet_column NULL or character. The column to use to create additional #' facet wrap bar graphs underneath the main graph. When NULL, no facet graph #' are created. One of `family`, `order`, `class`, `phylum`, `locality`, #' `native_range`, `habitat`. If column has another name, rename it before #' calling this function. Default: `NULL`. -#'@param pathway_level1_names character. Name of the column of \code{df} +#' @param pathway_level1_names character. Name of the column of \code{df} #' containing information about pathways at level 1. Default: `pathway_level1`. -#'@param pathways character. Vector with pathways level 1 to visualize. The +#' @param pathways character. Vector with pathways level 1 to visualize. The #' pathways are displayed following the order as in this vector. -#'@param taxon_names character. Name of the column of \code{df} containing +#' @param taxon_names character. Name of the column of \code{df} containing #' information about taxa. This parameter is used to uniquely identify taxa. -#'@param kingdom_names character. Name of the column of \code{df} containing +#' @param kingdom_names character. Name of the column of \code{df} containing #' information about kingdom. Default: \code{"kingdom"}. -#'@param phylum_names character. Name of the column of \code{df} containing +#' @param phylum_names character. Name of the column of \code{df} containing #' information about phylum. This parameter is used only if \code{category} is #' one of: \code{"Chordata"}, \code{"Not Chordata"}. Default: #' \code{"phylum"}. -#'@param first_observed character. Name of the column of \code{df} containing +#' @param first_observed character. Name of the column of \code{df} containing #' information about year of introduction. Default: \code{"first_observed"}. -#'@param cbd_standard logical. If TRUE the values of pathway level 1 are checked +#' @param cbd_standard logical. If TRUE the values of pathway level 1 are checked #' based on CBD standard as returned by `pathways_cbd()`. Error is returned if #' unmatched values are found. If FALSE, a warning is returned. Default: TRUE. -#'@param title NULL or character. Title of the graph. Default: NULL. -#'@param x_lab NULL or character. x-axis label. Default: "Number of introduced +#' @param title NULL or character. Title of the graph. Default: NULL. +#' @param x_lab NULL or character. x-axis label. Default: "Number of introduced #' taxa". -#'@param y_lab NULL or character. Title of the graph. Default: "Pathways". -#'@return A ggplot2 object (or egg object if facets are used). NULL if there are +#' @param y_lab NULL or character. Title of the graph. Default: "Pathways". +#' @return A ggplot2 object (or egg object if facets are used). NULL if there are #' no data to plot. #' -#'@export -#'@importFrom assertthat assert_that -#'@importFrom assertable assert_colnames -#'@importFrom dplyr %>% .data anti_join count distinct filter group_by if_else +#' @export +#' @importFrom assertthat assert_that +#' @importFrom assertable assert_colnames +#' @importFrom dplyr %>% .data anti_join count distinct filter group_by if_else #' mutate pull rename_at sym ungroup -#'@importFrom egg ggarrange -#'@importFrom ggplot2 facet_wrap geom_line geom_point ggplot ggtitle xlab ylab +#' @importFrom egg ggarrange +#' @importFrom ggplot2 facet_wrap geom_line geom_point ggplot ggtitle xlab ylab #' ylim -#'@importFrom rlang !! -#'@importFrom tidyselect all_of +#' @importFrom rlang !! +#' @importFrom tidyselect all_of #' #' @examples #' \dontrun{ @@ -88,7 +88,8 @@ #' #' # facet locality #' visualize_pathways_year_level1( -#' data, category = "Not Chordata", +#' data, +#' category = "Not Chordata", #' facet_column = "locality" #' ) #' @@ -104,31 +105,31 @@ #' category = "Plantae", #' from = 1950, #' title = "Pathway level 1: Plantae" -#') +#' ) #' #' # Personalize axis labels #' visualize_pathways_year_level1( #' data, #' x_lab = "Jaar", -#' y_lab = "Aantal geïntroduceerde taxa" +#' y_lab = "Aantal geïntroduceerde taxa" #' ) #' } visualize_pathways_year_level1 <- function( - df, - bin = 10, - from = 1950, - category = NULL, - facet_column = NULL, - pathways = NULL, - pathway_level1_names = "pathway_level1", - taxon_names = "key", - kingdom_names = "kingdom", - phylum_names = "phylum", - first_observed = "first_observed", - cbd_standard = TRUE, - title = NULL, - x_lab = "Time period", - y_lab = "Number of introduced taxa") { + df, + bin = 10, + from = 1950, + category = NULL, + facet_column = NULL, + pathways = NULL, + pathway_level1_names = "pathway_level1", + taxon_names = "key", + kingdom_names = "kingdom", + phylum_names = "phylum", + first_observed = "first_observed", + cbd_standard = TRUE, + title = NULL, + x_lab = "Time period", + y_lab = "Number of introduced taxa") { # initial input checks # Check df assert_that(is.data.frame(df), msg = "`df` must be a data frame.") @@ -171,9 +172,9 @@ visualize_pathways_year_level1 <- function( ) if (is.character(facet_column)) { facet_column <- match.arg(facet_column, valid_facet_options) - assert_that(is.null(category) || - !(category == "Chordata" & facet_column == "phylum"), - msg = "You cannot use phylum as facet with category Chordata." + assert_that(is.null(category) || + !(category == "Chordata" & facet_column == "phylum"), + msg = "You cannot use phylum as facet with category Chordata." ) } # Check pathways diff --git a/R/visualize_pathways_year_level2.R b/R/visualize_pathways_year_level2.R index 3d196b9a..f90945bf 100644 --- a/R/visualize_pathways_year_level2.R +++ b/R/visualize_pathways_year_level2.R @@ -43,7 +43,7 @@ #' @param x_lab NULL or character. x-axis label. Default: "Number of introduced #' taxa". #' @param y_lab NULL or character. Title of the graph. Default: "Pathways". -#'@return A ggplot2 object (or egg object if facets are used). NULL if there are +#' @return A ggplot2 object (or egg object if facets are used). NULL if there are #' no data to plot. #' #' @export @@ -146,7 +146,7 @@ #' data, #' chosen_pathway_level1 = "escape", #' x_lab = "Jaar", -#' y_lab = "Aantal geïntroduceerde taxa" +#' y_lab = "Aantal geïntroduceerde taxa" #' ) #' } visualize_pathways_year_level2 <- function( @@ -531,7 +531,7 @@ visualize_pathways_year_level2 <- function( y = .data$n, group = .data$pathway_level2, color = .data$pathway_level2 - )) + + )) + ylim(0, max_n) + xlab(x_lab) + ylab(y_lab) + diff --git a/tests/testthat/test-visualize_pathways_level2.R b/tests/testthat/test-visualize_pathways_level2.R index 76aeb239..bf70c018 100644 --- a/tests/testthat/test-visualize_pathways_level2.R +++ b/tests/testthat/test-visualize_pathways_level2.R @@ -376,4 +376,4 @@ testthat::test_that("test pathway factors and their order", { pathways_selection_escape)) expect_true(all(levels(output_less_pathways_inverted_escape$data$pathway_level2) == pathways_selection_inverted_escape)) -}) \ No newline at end of file +}) From 947e0ea8bdaec73cb5d019753a52e27f46cb0aab Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Thu, 10 Sep 2020 18:03:45 +0200 Subject: [PATCH 37/63] devtools::document() --- NAMESPACE | 3 +- man/indicator_native_range_year.Rd | 45 +++++++++++++++++++++++++++ man/visualize_pathways_year_level1.Rd | 5 +-- man/visualize_pathways_year_level2.Rd | 2 +- 4 files changed, 51 insertions(+), 4 deletions(-) create mode 100644 man/indicator_native_range_year.Rd diff --git a/NAMESPACE b/NAMESPACE index 94a6e3d0..943d74d8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,10 +89,11 @@ importFrom(ggplot2,ylim) importFrom(grDevices,grey) importFrom(gratia,derivatives) importFrom(lazyeval,interp) -importFrom(magrittr,"%>%") importFrom(mgcv,gam) importFrom(mgcv,nb) importFrom(mgcv,summary.gam) +importFrom(plotly,ggplotly) +importFrom(plotly,layout) importFrom(purrr,cross_df) importFrom(purrr,map) importFrom(purrr,map2) diff --git a/man/indicator_native_range_year.Rd b/man/indicator_native_range_year.Rd new file mode 100644 index 00000000..b762239e --- /dev/null +++ b/man/indicator_native_range_year.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/indicator_native_range_year.R +\name{indicator_native_range_year} +\alias{indicator_native_range_year} +\title{Create an interactive plot for the number of alien species per native region +and year of introduction} +\usage{ +indicator_native_range_year( + data, + years = NULL, + type = c("native_continent", "native_range"), + width = NULL, + height = NULL, + x_lab = "year", + y_lab = "alien species", + relative = FALSE +) +} +\arguments{ +\item{type}{character, native_range level of interest should be one of +\code{c("native_continent", "native_range")}} + +\item{xlab}{character string, label of the x-axis. Default: "year".} + +\item{ylab}{character string, label of the y-axis. Default: "number of alien +species".} +} +\value{ +list with: \itemize{ \item{'static_plot': }{ggplot object, for a +given species the observed number per year and per native range is plotted +in a stacked bar chart} \item{'interactive_plot': }{plotly object, for a +given species the observed number per year and per native range is plotted +in a stacked bar chart} \item{'data': }{data displayed in the plot, as +data.frame with: \itemize{ \item{'year': }{year at which the species were +introduced} \item{'native_range': }{native range of the introduced species} +\item{'n': }{number of species introduced from the native range for a given +year} \item{'total': }{total number of species, from all around the world, +introduced during a given year} \item{'perc': }{percentage of species +introduced from the native range for a given year. (n/total)*100} } } } +} +\description{ +Based on +\link[=https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R]{countYearProvince} +plot from reporting - rshiny - grofwildjacht +} diff --git a/man/visualize_pathways_year_level1.Rd b/man/visualize_pathways_year_level1.Rd index e72cacba..d8417409 100644 --- a/man/visualize_pathways_year_level1.Rd +++ b/man/visualize_pathways_year_level1.Rd @@ -117,7 +117,8 @@ visualize_pathways_year_level1(data, from = 1970) # facet locality visualize_pathways_year_level1( - data, category = "Not Chordata", + data, + category = "Not Chordata", facet_column = "locality" ) @@ -139,7 +140,7 @@ visualize_pathways_year_level1( visualize_pathways_year_level1( data, x_lab = "Jaar", - y_lab = "Aantal geïntroduceerde taxa" + y_lab = "Aantal geïntroduceerde taxa" ) } } diff --git a/man/visualize_pathways_year_level2.Rd b/man/visualize_pathways_year_level2.Rd index 136ab4f0..1643ed8e 100644 --- a/man/visualize_pathways_year_level2.Rd +++ b/man/visualize_pathways_year_level2.Rd @@ -180,7 +180,7 @@ visualize_pathways_year_level2( data, chosen_pathway_level1 = "escape", x_lab = "Jaar", - y_lab = "Aantal geïntroduceerde taxa" + y_lab = "Aantal geïntroduceerde taxa" ) } } From ddbe7bd11a042d59914314b62a8b3891e8dbf563 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Thu, 10 Sep 2020 18:04:00 +0200 Subject: [PATCH 38/63] Update version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index afabdbf0..b5e60089 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: trias Title: Process Data for the Project Tracking Invasive Alien Species (TrIAS) -Version: 1.3.0.9000 +Version: 1.4.0.9000 Description: TrIAS provides functionality to facilitate the data processing for the project Tracking Invasive Alien Species (TrIAS ). From 11652f8a21e7737462e97723a4e058f68ea1c28d Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Thu, 10 Sep 2020 18:05:59 +0200 Subject: [PATCH 39/63] Remove test new function as it is not a test --- tests/testthat/test_indicator_native_range_year.R | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 tests/testthat/test_indicator_native_range_year.R diff --git a/tests/testthat/test_indicator_native_range_year.R b/tests/testthat/test_indicator_native_range_year.R deleted file mode 100644 index 9cfb7d0d..00000000 --- a/tests/testthat/test_indicator_native_range_year.R +++ /dev/null @@ -1,7 +0,0 @@ -library(readr) -data_input_checklist_indicators <- read_delim("https://raw.githubusercontent.com/trias-project/indicators/master/data/interim/data_input_checklist_indicators.tsv", - "\t", escape_double = FALSE, trim_ws = TRUE) - -source("./R/indicator_native_range_year.r") - -countYearNativerange(data_input_checklist_indicators, jaartallen = c(1990:2019), type = "native_range", relative = FALSE) From 06b25c05f2fad54760a6c55de66764c8e460a130 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Fri, 11 Sep 2020 19:53:07 +0200 Subject: [PATCH 40/63] Update fucntions using name_* functions from rgbif to be rgbif 3.x compatile --- R/gbif_get_taxa.R | 11 ++++------- R/gbif_has_distribution.R | 3 +-- R/gbif_verify_keys.R | 2 +- R/verify_taxa.R | 5 ++--- 4 files changed, 8 insertions(+), 13 deletions(-) diff --git a/R/gbif_get_taxa.R b/R/gbif_get_taxa.R index 8effa616..8aa564b5 100644 --- a/R/gbif_get_taxa.R +++ b/R/gbif_get_taxa.R @@ -134,7 +134,7 @@ gbif_get_taxa <- function( taxon_keys <- as.integer(taxon_keys[1:maxlimit]) taxon_keys_df <- as.data.frame(taxon_keys) taxon_taxa <- map_dfr( - taxon_keys_df$taxon_keys, ~ name_usage(key = ., return = "data") + taxon_keys_df$taxon_keys, ~ name_usage(key = .)$data ) taxon_taxa <- taxon_taxa %>% ungroup() %>% @@ -167,17 +167,14 @@ gbif_get_taxa <- function( checklist_keys, ~ name_lookup( datasetKey = ., origin = origins, - limit = maxlimit, - return = "data" - ) + limit = maxlimit)$data ) } else { checklist_taxa <- map_dfr(checklist_keys, ~ name_lookup( datasetKey = ., - limit = maxlimit, - return = "data" - )) + limit = maxlimit)$data + ) } checklist_taxa <- diff --git a/R/gbif_has_distribution.R b/R/gbif_has_distribution.R index af9165e1..8cf4f5c1 100644 --- a/R/gbif_has_distribution.R +++ b/R/gbif_has_distribution.R @@ -97,9 +97,8 @@ gbif_has_distribution <- function(taxon_key, ...) { # retrieve distribution properties from GBIF distr_properties <- rgbif::name_usage( key = as.integer(taxon_key), - return = "data", data = "distribution" - ) + )$data # no ditribution properties values specified by user if (is.null(names(user_properties))) { diff --git a/R/gbif_verify_keys.R b/R/gbif_verify_keys.R index 6bc2a7f6..7113b862 100644 --- a/R/gbif_verify_keys.R +++ b/R/gbif_verify_keys.R @@ -112,7 +112,7 @@ gbif_verify_keys <- function(keys, col_keys = "key") { names(keys) <- as.character(keys) gbif_info <- keys %>% - map(~ tryCatch(name_usage(., return = "data")[1, ], + map(~ tryCatch(name_usage(., return = "data")$data[1, ], error = function(e) { print(paste("Key", ., "is an invalid GBIF taxon key.")) } diff --git a/R/verify_taxa.R b/R/verify_taxa.R index 13586072..89c522bf 100644 --- a/R/verify_taxa.R +++ b/R/verify_taxa.R @@ -1040,9 +1040,8 @@ verify_taxa <- function(taxa, accepted_keys, function(bb_acceptedKey) { name_usage( - key = bb_acceptedKey, - return = "data" - ) + key = bb_acceptedKey + )$data } ) %>% select(.data$key, .data$kingdom, .data$rank, .data$taxonomicStatus) %>% From 3766a3659a403dcbff2832f3b4361c1424d159c6 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Fri, 11 Sep 2020 19:54:55 +0200 Subject: [PATCH 41/63] Solve new arised bug with empty df: logicals not set as chars Not possible to mutate logicals to characters for empty dfs --- R/get_table_pathways.R | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/R/get_table_pathways.R b/R/get_table_pathways.R index 2a64a709..0ef1961d 100644 --- a/R/get_table_pathways.R +++ b/R/get_table_pathways.R @@ -267,15 +267,17 @@ get_table_pathways <- function(df, ) } # Join pathways and samples together - pathway_data <- + if (nrow(pathway_data) == 0) { + tibble(pathway_level1 = character(0), + pathway_level2 = character(0), + n = integer(0), + examples = character(0)) + } else { pathway_data %>% - # if pathway_data is empty - mutate_if(is.logical, as.character) %>% - left_join(samples, - by = c("pathway_level1", "pathway_level2") - ) %>% - select(-.data$size_sample) %>% - ungroup() - - pathway_data + left_join(samples, + by = c("pathway_level1", "pathway_level2") + ) %>% + select(-.data$size_sample) %>% + ungroup() + } } From 5727ec55ba9a95c38d6e06aee4c553ae0c530e1b Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Fri, 11 Sep 2020 19:55:47 +0200 Subject: [PATCH 42/63] Use tibble/as_tibble as they are already exported by trias --- tests/testthat/input_dfs_tests_verify_taxa.R | 10 ++--- tests/testthat/test-gbif_verify_keys.R | 5 +-- .../testthat/test-output_get_table_pathways.R | 39 ++++++++----------- 3 files changed, 22 insertions(+), 32 deletions(-) diff --git a/tests/testthat/input_dfs_tests_verify_taxa.R b/tests/testthat/input_dfs_tests_verify_taxa.R index 060a4e1d..7e0f7058 100644 --- a/tests/testthat/input_dfs_tests_verify_taxa.R +++ b/tests/testthat/input_dfs_tests_verify_taxa.R @@ -1,4 +1,4 @@ -my_taxa <- data.frame( +my_taxa <- tibble( taxonKey = c( 141117238, 113794952, @@ -174,14 +174,13 @@ my_taxa <- data.frame( "a80caa33-da9d-48ed-80e3-f76b0b3810f9", "alien-plants-belgium:taxon:56d6564f59d9092401c454849213366f", "193729" - ), - stringsAsFactors = FALSE + ) ) # Add column verificationKey which will be overwritten by verify_taxa my_taxa_vk <- dplyr::mutate(my_taxa, verificationKey = 1) -my_verification <- data.frame( +my_verification <- tibble( taxonKey = c( 113794952, 141264857, @@ -422,8 +421,7 @@ my_verification <- data.frame( TRUE, TRUE, FALSE - ), - stringsAsFactors = FALSE + ) ) my_taxa_other_colnames <- diff --git a/tests/testthat/test-gbif_verify_keys.R b/tests/testthat/test-gbif_verify_keys.R index 90fc3b78..4a6c39e7 100644 --- a/tests/testthat/test-gbif_verify_keys.R +++ b/tests/testthat/test-gbif_verify_keys.R @@ -37,15 +37,14 @@ names(keys3) <- purrr::map_chr( keys4 <- as.numeric(keys1) # output expected -output_keys <- data.frame( +output_keys <- tibble( key = c( 12323785387253, 128545334, 1000693, 1000310 ), is_taxonKey = c(FALSE, TRUE, TRUE, TRUE), is_from_gbif_backbone = c(NA, FALSE, TRUE, TRUE), - is_synonym = c(NA, NA, TRUE, FALSE), - stringsAsFactors = FALSE + is_synonym = c(NA, NA, TRUE, FALSE) ) output1 <- gbif_verify_keys(keys1) diff --git a/tests/testthat/test-output_get_table_pathways.R b/tests/testthat/test-output_get_table_pathways.R index 18032008..7e9fdfe4 100644 --- a/tests/testthat/test-output_get_table_pathways.R +++ b/tests/testthat/test-output_get_table_pathways.R @@ -1,4 +1,4 @@ -input_test_df <- data.frame( +input_test_df <- tibble( key = c(152543101, 152543102, 152543110, 152543115, 152543120), canonicalName = c( "Gyrodactylus proterorhini", @@ -55,8 +55,7 @@ input_test_df <- data.frame( NA_character_, NA_character_, NA_character_ - ), - stringsAsFactors = FALSE + ) ) # kingdom column is not the default value @@ -86,19 +85,18 @@ input_test_df_large <- read.delim( "input_data_pathways.tsv" ), sep = "\t", - stringsAsFactors = FALSE -) + stringsAsFactors = FALSE) %>% + as_tibble # Output basic usage : default values for all params -output_test_df_basic <- data.frame( +output_test_df_basic <-tibble( pathway_level1 = c("contaminant", "unknown"), pathway_level2 = c("animal_parasite", "unknown"), n = as.integer(c(2, 3)), examples = c( "Aphanomyces astaci, Gyrodactylus proterorhini", "Thecaphora oxalidis, Tricellaria inopinata, Scutigera coleoptrata" - ), - stringsAsFactors = FALSE + ) ) testthat::test_that("Basic usage: default values", { @@ -141,32 +139,29 @@ testthat::test_that("Basic usage: default values", { }) testthat::test_that("Use with 'category'", { - output_test_df_animals <- data.frame( + output_test_df_animals <- tibble( pathway_level1 = c("contaminant", "unknown"), pathway_level2 = c("animal_parasite", "unknown"), n = as.integer(c(1, 2)), examples = c( "Gyrodactylus proterorhini", "Scutigera coleoptrata, Tricellaria inopinata" - ), - stringsAsFactors = FALSE + ) ) - output_test_df_chordata <- data.frame( + output_test_df_chordata <- tibble( pathway_level1 = "unknown", pathway_level2 = "unknown", n = as.integer(1), - examples = "Scutigera coleoptrata, Tricellaria inopinata", - stringsAsFactors = FALSE + examples = "Scutigera coleoptrata, Tricellaria inopinata" ) - output_test_df_not_chordata <- data.frame( + output_test_df_not_chordata <- tibble( pathway_level1 = c("contaminant", "unknown"), pathway_level2 = c("animal_parasite", "unknown"), n = as.integer(c(1, 1)), examples = c( "Gyrodactylus proterorhini", "Scutigera coleoptrata" - ), - stringsAsFactors = FALSE + ) ) pathways_plants <- get_table_pathways(input_test_df, category = "Plantae") pathways_animals <- get_table_pathways(input_test_df, category = "Animalia") @@ -215,19 +210,17 @@ testthat::test_that("Use with 'category'", { }) testthat::test_that("Use with 'from'", { - output_test_df_2012 <- data.frame( + output_test_df_2012 <- tibble( pathway_level1 = c("contaminant", "unknown"), pathway_level2 = c("animal_parasite", "unknown"), n = as.integer(c(1, 1)), - examples = c("Aphanomyces astaci", "Thecaphora oxalidis"), - stringsAsFactors = FALSE + examples = c("Aphanomyces astaci", "Thecaphora oxalidis") ) - output_test_df_2018 <- data.frame( + output_test_df_2018 <- tibble( pathway_level1 = "contaminant", pathway_level2 = "animal_parasite", n = as.integer(1), - examples = "Aphanomyces astaci", - stringsAsFactors = FALSE + examples = "Aphanomyces astaci" ) pathways_1000 <- get_table_pathways(input_test_df, from = 1000) pathways_2012 <- get_table_pathways(input_test_df, from = 2012) From 24fc728846973b16a79bcc9622ba6ab49da454e3 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 10:52:10 +0200 Subject: [PATCH 43/63] Use left_join instead of right_join to return same order of taxa --- R/verify_taxa.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/verify_taxa.R b/R/verify_taxa.R index 89c522bf..887e27dd 100644 --- a/R/verify_taxa.R +++ b/R/verify_taxa.R @@ -98,8 +98,8 @@ #' @export #' @importFrom assertthat assert_that is.date #' @importFrom dplyr desc filter filter_at select distinct mutate rename -#' rename_at arrange bind_rows inner_join anti_join left_join right_join %>% -#' pull vars as_tibble group_by count starts_with all_vars any_vars .data +#' rename_at arrange bind_rows inner_join anti_join left_join %>% pull vars +#' as_tibble group_by count starts_with all_vars any_vars .data #' @importFrom stringr str_remove str_split #' @importFrom tidyselect one_of ends_with #' @importFrom tibble tibble @@ -1195,8 +1195,11 @@ verify_taxa <- function(taxa, left_join(taxa_input, by = name_col_taxa ) %>% - bind_rows(not_to_verify_taxa) %>% - right_join(ordered_taxon_keys, by = "taxonKey") + bind_rows(not_to_verify_taxa) + # set same order as in input df taxa + taxa <- + ordered_taxon_keys %>% + left_join(taxa, by = "taxonKey") # Split outdated_taxa in outdated_unmatched_taxa and outdated_synonyms outdated_unmatched_taxa <- From f7bc6d1b30c08f9947ca84a8ce304dba1cfc34e3 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 11:20:21 +0200 Subject: [PATCH 44/63] Solve order columns in output info new synonyms df --- .../output1_new_synonyms.tsv | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/data_test_output_verify_taxa/output1_new_synonyms.tsv b/tests/testthat/data_test_output_verify_taxa/output1_new_synonyms.tsv index d469cdca..33843d27 100644 --- a/tests/testthat/data_test_output_verify_taxa/output1_new_synonyms.tsv +++ b/tests/testthat/data_test_output_verify_taxa/output1_new_synonyms.tsv @@ -1,6 +1,6 @@ -taxonKey scientificName datasetKey bb_key bb_scientificName bb_kingdom bb_rank bb_taxonomicStatus bb_acceptedKey bb_acceptedName verificationKey remarks verifiedBy dateAdded outdated bb_acceptedKingdom bb_acceptedRank bb_acceptedTaxonomicStatus -141117238 Aspius aspius 98940a79-2bf1-46e6-afd6-ba2e85a26f9f 2360181 Aspius aspius (Linnaeus, 1758) Animalia SPECIES SYNONYM 5851603 Leuciscus aspius (Linnaeus, 1758) NA NA NA 2018-12-21 FALSE Animalia SPECIES ACCEPTED -100220432 Rana catesbeiana b351a324-77c4-41c9-a909-f30f77268bc4 2427092 Rana catesbeiana Shaw, 1802 Animalia SPECIES SYNONYM 2427091 Lithobates catesbeianus (Shaw, 1802) NA NA NA 2018-12-21 FALSE Animalia SPECIES ACCEPTED -140563014 Atyaephyra desmaresti 289244ee-e1c1-49aa-b2d7-d379391ce265 4309705 Atyaephyra desmarestii (Millet, 1831) Animalia SPECIES HOMOTYPIC_SYNONYM 6454754 Hippolyte desmarestii Millet, 1831 NA NA NA 2018-12-21 FALSE Animalia SPECIES ACCEPTED -148437916 Ferrissia fragilis 1f3505cd-5d98-4e23-bd3b-ffe59d05d7c2 2291152 Ferrissia fragilis (Tryon, 1863) Animalia SPECIES SYNONYM 9520065 Ferrissia californica (Rowell, 1863) NA NA NA 2018-12-21 FALSE Animalia SPECIES ACCEPTED -114445583 Rana blanfordii Boulenger 3772da2f-daa1-4f07-a438-15a881a2142c 2430304 Rana blanfordii Boulenger, 1882 Animalia SPECIES SYNONYM 2430301 Nanorana blanfordii (Boulenger, 1882) NA NA NA 2018-12-21 FALSE Animalia SPECIES ACCEPTED +taxonKey scientificName datasetKey bb_key bb_scientificName bb_kingdom bb_rank bb_taxonomicStatus bb_acceptedKey bb_acceptedName bb_acceptedKingdom bb_acceptedRank bb_acceptedTaxonomicStatus verificationKey remarks verifiedBy dateAdded outdated +141117238 Aspius aspius 98940a79-2bf1-46e6-afd6-ba2e85a26f9f 2360181 Aspius aspius (Linnaeus, 1758) Animalia SPECIES SYNONYM 5851603 Leuciscus aspius (Linnaeus, 1758) Animalia SPECIES ACCEPTED NA NA NA 2018-12-21 FALSE +100220432 Rana catesbeiana b351a324-77c4-41c9-a909-f30f77268bc4 2427092 Rana catesbeiana Shaw, 1802 Animalia SPECIES SYNONYM 2427091 Lithobates catesbeianus (Shaw, 1802) Animalia SPECIES ACCEPTED NA NA NA 2018-12-21 FALSE +140563014 Atyaephyra desmaresti 289244ee-e1c1-49aa-b2d7-d379391ce265 4309705 Atyaephyra desmarestii (Millet, 1831) Animalia SPECIES HOMOTYPIC_SYNONYM 6454754 Hippolyte desmarestii Millet, 1831 Animalia SPECIES ACCEPTED NA NA NA 2018-12-21 FALSE +148437916 Ferrissia fragilis 1f3505cd-5d98-4e23-bd3b-ffe59d05d7c2 2291152 Ferrissia fragilis (Tryon, 1863) Animalia SPECIES SYNONYM 9520065 Ferrissia californica (Rowell, 1863) Animalia SPECIES ACCEPTED NA NA NA 2018-12-21 FALSE +114445583 Rana blanfordii Boulenger 3772da2f-daa1-4f07-a438-15a881a2142c 2430304 Rana blanfordii Boulenger, 1882 Animalia SPECIES SYNONYM 2430301 Nanorana blanfordii (Boulenger, 1882) Animalia SPECIES ACCEPTED NA NA NA 2018-12-21 FALSE From 84c27d110ce8c8af57e3339f67cd544469ef2321 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 11:22:02 +0200 Subject: [PATCH 45/63] Add checks for unique taxon keys and no NAs --- R/verify_taxa.R | 32 ++++++++++++++++++++ tests/testthat/input_dfs_tests_verify_taxa.R | 16 ++++++++++ tests/testthat/test-input_verify_taxa.R | 30 ++++++++++++++++++ 3 files changed, 78 insertions(+) diff --git a/R/verify_taxa.R b/R/verify_taxa.R index 887e27dd..4a7769e4 100644 --- a/R/verify_taxa.R +++ b/R/verify_taxa.R @@ -623,6 +623,22 @@ verify_taxa <- function(taxa, ) ) + # Check that taxon keys are all set up, no NAs present in input taxa + assertthat::assert_that(all(!is.na(taxa[[taxonKey]])), + msg = sprintf( + paste0("Missing values found in taxon keys of input ", + "taxa. Check values in column %s."), + taxonKey) + ) + + # Check that taxon keys are unique in taxa + assertthat::assert_that(nrow(taxa) == length(unique(taxa[[taxonKey]])), + msg = sprintf( + paste0("Taxon keys of input taxa must be unique. ", + "Check values in column %s."), + taxonKey) + ) + # Convert to default column names taxa <- taxa %>% @@ -742,6 +758,22 @@ verify_taxa <- function(taxa, ) ) + # Check that taxon keys are all set up, no NAs present in verification df + assertthat::assert_that(all(!is.na(verification[[verification_taxonKey]])), + msg = sprintf( + paste0("Missing values found in taxon keys of input ", + "taxa. Check values in column %s."), + verification_taxonKey) + ) + + # Check that taxon keys are unique in verification df + assertthat::assert_that( + nrow(verification) == length(unique(verification[[verification_taxonKey]])), + msg = sprintf(paste0("Taxon keys of input taxa must be unique. ", + "Check values in column %s."), + taxonKey) + ) + # Convert to standard column names verification <- verification %>% diff --git a/tests/testthat/input_dfs_tests_verify_taxa.R b/tests/testthat/input_dfs_tests_verify_taxa.R index 7e0f7058..37d2e261 100644 --- a/tests/testthat/input_dfs_tests_verify_taxa.R +++ b/tests/testthat/input_dfs_tests_verify_taxa.R @@ -439,3 +439,19 @@ my_verification_other_colnames <- is_outdated = outdated, author_verification = verifiedBy ) + +my_taxa_duplicates <- + my_taxa[1:2,] +my_taxa_duplicates$taxonKey[2] <- my_taxa_duplicates$taxonKey[1] + +my_verification_duplicates <- + my_verification[1:2,] +my_verification_duplicates$taxonKey[2] <- my_verification_duplicates$taxonKey[1] + +my_taxa_nas <- + my_taxa_duplicates +my_taxa_nas$taxonKey[2] <- NA_real_ + +my_verification_nas <- + my_verification_duplicates +my_verification_nas$taxonKey[2] <- NA_real_ diff --git a/tests/testthat/test-input_verify_taxa.R b/tests/testthat/test-input_verify_taxa.R index 34dc5a71..a89d7247 100644 --- a/tests/testthat/test-input_verify_taxa.R +++ b/tests/testthat/test-input_verify_taxa.R @@ -38,6 +38,36 @@ testthat::test_that("verification is a data frame", { ) }) + +# no missing taxon keys in both input taxa and verification df (if not NULL) +testthat::test_that("No missing taxon keys in input taxa and verification dfs", { + expect_error( + verify_taxa(taxa = my_taxa_nas, verification = my_verification), + paste("Missing values found in taxon keys of input taxa.", + "Check values in column taxonKey.") + ) + expect_error( + verify_taxa(taxa = my_taxa, verification = my_verification_nas), + paste("Missing values found in taxon keys of input taxa.", + "Check values in column taxonKey.") + ) +}) + +# taxon keys are unique +testthat::test_that("Taxon keys are unique in input taxa and verification dfs", { + expect_error( + verify_taxa(taxa = my_taxa_duplicates, verification = my_verification), + paste("Taxon keys of input taxa must be unique.", + "Check values in column taxonKey.") + ) + expect_error( + verify_taxa(taxa = my_taxa, verification = my_verification_duplicates), + paste("Taxon keys of input taxa must be unique.", + "Check values in column taxonKey.") + ) +}) + + # different taxa column names taxa_test1 <- data.frame( bad_checklist_taxonKey_colname = c(123452), From 7f422a1af189333eaba06e1c17787bbb3268180d Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 11:22:37 +0200 Subject: [PATCH 46/63] Make tubbles instead of dfs --- tests/testthat/test-input_verify_taxa.R | 52 ++++++++++--------------- 1 file changed, 21 insertions(+), 31 deletions(-) diff --git a/tests/testthat/test-input_verify_taxa.R b/tests/testthat/test-input_verify_taxa.R index a89d7247..41f77da6 100644 --- a/tests/testthat/test-input_verify_taxa.R +++ b/tests/testthat/test-input_verify_taxa.R @@ -69,7 +69,7 @@ testthat::test_that("Taxon keys are unique in input taxa and verification dfs", # different taxa column names -taxa_test1 <- data.frame( +taxa_test1 <- tibble( bad_checklist_taxonKey_colname = c(123452), bad_checklist_scientificName_colname = c("Aspius aspius"), bad_checklist_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -79,12 +79,11 @@ taxa_test1 <- data.frame( bad_backbone_rank_colname = c("SPECIES"), bad_backbone_taxonomicStatus_colname = c("SYNONYM"), bad_backbone_acceptedKey_colname = c(5851603), - bad_backbone_acceptedName_colname = c("Leuciscus aspius (Linnaeus, 1758)"), - stringsAsFactors = FALSE + bad_backbone_acceptedName_colname = c("Leuciscus aspius (Linnaeus, 1758)") ) # missing column -taxa_test2 <- data.frame( +taxa_test2 <- tibble( taxonKey = c(123452), scientificName = c("Aspius aspius"), datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -94,8 +93,7 @@ taxa_test2 <- data.frame( bb_rank = c("SPECIES"), bb_taxonomicStatus = c("SYNONYM"), # bb_acceptedKey is missing - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - stringsAsFactors = FALSE + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)") ) testthat::test_that("taxa column names are correct", { @@ -126,7 +124,7 @@ testthat::test_that("taxa column names are correct", { }) # inconsistency about unmatched taxa -taxa_test3 <- data.frame( +taxa_test3 <- tibble( taxonKey = c(123452), scientificName = c("Aspius aspius"), datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -136,8 +134,7 @@ taxa_test3 <- data.frame( bb_rank = c("SPECIES"), bb_taxonomicStatus = c("SYNONYM"), bb_acceptedKey = c(3483948), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - stringsAsFactors = FALSE + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)") ) testthat::test_that("consistency of 'taxa' about GBIF backbone info columns", { @@ -152,7 +149,7 @@ testthat::test_that("consistency of 'taxa' about GBIF backbone info columns", { }) # different verification column names -verification_test1 <- data.frame( +verification_test1 <- tibble( bad_checklist_taxonKey = c(12341), bad_checklist_scientificName_colname = c("Aspius aspius"), bad_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -170,12 +167,11 @@ verification_test1 <- data.frame( bad_remarks_colname = c("dummy example 1: backbone_accepted should be updated"), bad_verifiedBy_colname = c("Damiano Oldoni"), bad_dateAdded_colname = c(as.Date("2018-01-01")), - bad_outdated = c(FALSE), - stringsAsFactors = FALSE + bad_outdated = c(FALSE) ) # missing columns -verification_test2 <- data.frame( +verification_test2 <- tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), # datasetKey column missing @@ -193,12 +189,11 @@ verification_test2 <- data.frame( remarks = c("dummy example 1: backbone_accepted should be updated"), verifiedBy = c("Dami Oldi"), # dateAdded column missing - outdated = c(FALSE), - stringsAsFactors = FALSE + outdated = c(FALSE) ) # inconsistency bb_acceptedName - bb_acceptedKey -verification_test3 <- data.frame( +verification_test3 <- tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), @@ -216,12 +211,11 @@ verification_test3 <- data.frame( remarks = c("dummy example 1: backbone_accepted should be updated"), verifiedBy = c("Damiano Oldoni"), dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE), - stringsAsFactors = FALSE + outdated = c(FALSE) ) -# accepted taxa present (only synonyms and unmatched taxa allowed.) -verification_test4 <- data.frame( +# accepted taxa present (only synonyms and unmatched taxa allowed) +verification_test4 <- tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), @@ -239,12 +233,11 @@ verification_test4 <- data.frame( remarks = NA_character_, verifiedBy = NA_character_, dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE), - stringsAsFactors = FALSE + outdated = c(FALSE) ) # outdated must to be TRUE or FALSE. -verification_test5 <- data.frame( +verification_test5 <- tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), @@ -262,12 +255,11 @@ verification_test5 <- data.frame( remarks = NA_character_, verifiedBy = NA_character_, dateAdded = c(as.Date("2010-01-01")), - outdated = c(NA), - stringsAsFactors = FALSE + outdated = c(NA) ) # datasetKey should be 36 characters long -verification_test6 <- data.frame( +verification_test6 <- tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92,other stuff"), @@ -285,12 +277,11 @@ verification_test6 <- data.frame( remarks = NA_character_, verifiedBy = NA_character_, dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE), - stringsAsFactors = FALSE + outdated = c(FALSE) ) # commas not allowed in datasetKey -verification_test7 <- data.frame( +verification_test7 <- tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474,ae80a4f18e92"), @@ -308,8 +299,7 @@ verification_test7 <- data.frame( remarks = NA_character_, verifiedBy = NA_character_, dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE), - stringsAsFactors = FALSE + outdated = c(FALSE) ) testthat::test_that("verify_taxa column names are correct", { From cb57365e9c6575694a43f34abf22fcbcf2f249db Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 12:44:52 +0200 Subject: [PATCH 47/63] Add coumentation for data, years and relative --- R/indicator_native_range_year.R | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 5f7ab52f..7ac87797 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -4,11 +4,16 @@ #' Based on #' [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] #' plot from reporting - rshiny - grofwildjacht +#' @param data input data.frame +#' @param years (numeric) vector years we are interested to. If \code{NULL} +#' (default) all years from minimum and maximum of years of first observation +#' are taken into account. #' @param type character, native_range level of interest should be one of #' \code{c("native_continent", "native_range")} #' @param xlab character string, label of the x-axis. Default: "year". #' @param ylab character string, label of the y-axis. Default: "number of alien #' species". +#' @param relative (logical) if TRUE, each bar is standardised before stacking #' #' @return list with: \itemize{ \item{'static_plot': }{ggplot object, for a #' given species the observed number per year and per native range is plotted @@ -36,6 +41,11 @@ indicator_native_range_year <- function(data, years = NULL, relative = FALSE) { type <- match.arg(type) + # Rename to default column name + data <- + data %>% + rename_at(vars(first_observed), ~"first_observed") + if (is.null(years)) { years <- sort(unique(data$first_observed)) } @@ -63,10 +73,10 @@ indicator_native_range_year <- function(data, years = NULL, summaryData <- melt(table(plotData), id.vars = "first_observed") summaryData <- summaryData %>% - group_by(first_observed) %>% + group_by(.data$first_observed) %>% mutate( - total = sum(value), - perc = round((value / total) * 100, 2) + total = sum(.data$value), + perc = round((.data$value / .data$total) * 100, 2) ) # Summarize data per year @@ -90,7 +100,10 @@ indicator_native_range_year <- function(data, years = NULL, text <- paste0(summaryData$location, "
", summaryData$value) } - pl <- ggplot(data = summaryData, aes(x = first_observed, y = value, fill = location, text = text)) + + pl <- ggplot(data = summaryData, aes(x = .data$first_observed, + y = .data$value, + fill = .data$location, + text = text)) + geom_bar(position = position, stat = "identity") if (relative == TRUE) { From 4662830a3c6f6f58350039fbf4f7b5bc422e74bb Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 12:45:58 +0200 Subject: [PATCH 48/63] Add first_observed argument This makes this function more flexible and more similar to other functions of the package. --- R/indicator_native_range_year.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 7ac87797..3c2648a5 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -31,14 +31,15 @@ #' @importFrom ggplot2 ggplot geom_bar scale_y_continuous #' @importFrom plotly ggplotly layout #' @importFrom scales percent_format -#' @importFrom dplyr %>% mutate group_by case_when +#' @importFrom dplyr %>% mutate group_by case_when rename_at indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), width = NULL, height = NULL, x_lab = "year", y_lab = "alien species", - relative = FALSE) { + relative = FALSE, + first_observed = "first_observed") { type <- match.arg(type) # Rename to default column name From e78d77af895091d7d4b1096071120da4157c5629 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 12:47:14 +0200 Subject: [PATCH 49/63] Remove unused args in function It seems they are never used in this function. @SanderDevisscher : I remove them. Any objections? --- R/indicator_native_range_year.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 3c2648a5..1baa3b56 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -35,7 +35,6 @@ indicator_native_range_year <- function(data, years = NULL, type = c("native_continent", "native_range"), - width = NULL, height = NULL, x_lab = "year", y_lab = "alien species", relative = FALSE, From 36552304a32ff806b336991d555262f5358892b2 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 12:47:34 +0200 Subject: [PATCH 50/63] Set minimum requirement version for rgbif --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b5e60089..4f20f82e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,7 @@ Imports: plotly, purrr, readr, - rgbif, + rgbif (>= 3.0), rlang, reshape2, scales, From 0bfc5e5f11b8c67142b7f1ae1b26c226bc577259 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 12:48:03 +0200 Subject: [PATCH 51/63] Set tibble instead of data.frame --- tests/testthat/test-gbif_verify_keys.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-gbif_verify_keys.R b/tests/testthat/test-gbif_verify_keys.R index 4a6c39e7..0eddf040 100644 --- a/tests/testthat/test-gbif_verify_keys.R +++ b/tests/testthat/test-gbif_verify_keys.R @@ -20,10 +20,9 @@ keys1 <- c( NA, NA ) # input is a df -keys2 <- data.frame( +keys2 <- tibble( key = keys1, - other = sample.int(40, size = length(keys1)), - stringsAsFactors = FALSE + other = sample.int(40, size = length(keys1)) ) # input is a named list keys3 <- keys1 From 36960045fa6cbc2e6642f54c2e598fe1e2fc61b0 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 14:00:39 +0200 Subject: [PATCH 52/63] Update documentation devtools::document() --- NAMESPACE | 1 - man/indicator_native_range_year.Rd | 13 ++++++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 943d74d8..9c86c29e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,7 +52,6 @@ importFrom(dplyr,n_distinct) importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,rename_at) -importFrom(dplyr,right_join) importFrom(dplyr,rowwise) importFrom(dplyr,sample_n) importFrom(dplyr,select) diff --git a/man/indicator_native_range_year.Rd b/man/indicator_native_range_year.Rd index b762239e..153f9cfb 100644 --- a/man/indicator_native_range_year.Rd +++ b/man/indicator_native_range_year.Rd @@ -9,17 +9,24 @@ indicator_native_range_year( data, years = NULL, type = c("native_continent", "native_range"), - width = NULL, - height = NULL, x_lab = "year", y_lab = "alien species", - relative = FALSE + relative = FALSE, + first_observed = "first_observed" ) } \arguments{ +\item{data}{input data.frame} + +\item{years}{(numeric) vector years we are interested to. If \code{NULL} +(default) all years from minimum and maximum of years of first observation +are taken into account.} + \item{type}{character, native_range level of interest should be one of \code{c("native_continent", "native_range")}} +\item{relative}{(logical) if TRUE, each bar is standardised before stacking} + \item{xlab}{character string, label of the x-axis. Default: "year".} \item{ylab}{character string, label of the y-axis. Default: "number of alien From 244cc1cb318e0c93e739b53a32898601a6767279 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 14:11:03 +0200 Subject: [PATCH 53/63] Remove typos in @param names and add description of first_observed --- R/indicator_native_range_year.R | 10 +++++----- man/indicator_native_range_year.Rd | 14 ++++++++------ 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 1baa3b56..39795eb3 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -4,17 +4,17 @@ #' Based on #' [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] #' plot from reporting - rshiny - grofwildjacht -#' @param data input data.frame +#' @param data input data.frame. #' @param years (numeric) vector years we are interested to. If \code{NULL} #' (default) all years from minimum and maximum of years of first observation #' are taken into account. #' @param type character, native_range level of interest should be one of -#' \code{c("native_continent", "native_range")} -#' @param xlab character string, label of the x-axis. Default: "year". -#' @param ylab character string, label of the y-axis. Default: "number of alien +#' \code{c("native_continent", "native_range")}. +#' @param x_lab character string, label of the x-axis. Default: "year". +#' @param y_lab character string, label of the y-axis. Default: "number of alien #' species". #' @param relative (logical) if TRUE, each bar is standardised before stacking -#' +#' @param first_observed (character) Name of the column in \code{data} containing temporal information about introduction of the alien species. Expressed as years. #' @return list with: \itemize{ \item{'static_plot': }{ggplot object, for a #' given species the observed number per year and per native range is plotted #' in a stacked bar chart} \item{'interactive_plot': }{plotly object, for a diff --git a/man/indicator_native_range_year.Rd b/man/indicator_native_range_year.Rd index 153f9cfb..3d70c738 100644 --- a/man/indicator_native_range_year.Rd +++ b/man/indicator_native_range_year.Rd @@ -16,21 +16,23 @@ indicator_native_range_year( ) } \arguments{ -\item{data}{input data.frame} +\item{data}{input data.frame.} \item{years}{(numeric) vector years we are interested to. If \code{NULL} (default) all years from minimum and maximum of years of first observation are taken into account.} \item{type}{character, native_range level of interest should be one of -\code{c("native_continent", "native_range")}} +\code{c("native_continent", "native_range")}.} -\item{relative}{(logical) if TRUE, each bar is standardised before stacking} - -\item{xlab}{character string, label of the x-axis. Default: "year".} +\item{x_lab}{character string, label of the x-axis. Default: "year".} -\item{ylab}{character string, label of the y-axis. Default: "number of alien +\item{y_lab}{character string, label of the y-axis. Default: "number of alien species".} + +\item{relative}{(logical) if TRUE, each bar is standardised before stacking} + +\item{first_observed}{(character) Name of the column in \code{data} containing temporal information about introduction of the alien species. Expressed as years.} } \value{ list with: \itemize{ \item{'static_plot': }{ggplot object, for a From ef8266a8d1745bc6132e93c6c9b2a496268a1830 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 14:54:42 +0200 Subject: [PATCH 54/63] Remove a last return arg as it is defunct in rgbif 3 --- R/gbif_verify_keys.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/gbif_verify_keys.R b/R/gbif_verify_keys.R index 7113b862..13739d79 100644 --- a/R/gbif_verify_keys.R +++ b/R/gbif_verify_keys.R @@ -112,7 +112,7 @@ gbif_verify_keys <- function(keys, col_keys = "key") { names(keys) <- as.character(keys) gbif_info <- keys %>% - map(~ tryCatch(name_usage(., return = "data")$data[1, ], + map(~ tryCatch(name_usage(.)$data[1, ], error = function(e) { print(paste("Key", ., "is an invalid GBIF taxon key.")) } From e5e361dcb3590240c2b50185d309eb384c78e717 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 14:55:36 +0200 Subject: [PATCH 55/63] =?UTF-8?q?Set=20trias::tiblble=20to=20=C3=B9ake=20t?= =?UTF-8?q?ibble=20in=20test=20a=20recognizable=20function?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Imported function --- tests/testthat/input_dfs_tests_verify_taxa.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/input_dfs_tests_verify_taxa.R b/tests/testthat/input_dfs_tests_verify_taxa.R index 37d2e261..bf3a6a2f 100644 --- a/tests/testthat/input_dfs_tests_verify_taxa.R +++ b/tests/testthat/input_dfs_tests_verify_taxa.R @@ -1,4 +1,4 @@ -my_taxa <- tibble( +my_taxa <- trias::tibble( taxonKey = c( 141117238, 113794952, @@ -180,7 +180,7 @@ my_taxa <- tibble( # Add column verificationKey which will be overwritten by verify_taxa my_taxa_vk <- dplyr::mutate(my_taxa, verificationKey = 1) -my_verification <- tibble( +my_verification <- trias::tibble( taxonKey = c( 113794952, 141264857, From bd09e4f9c9e6868712974eb541bb6277181112ec Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 15:02:21 +0200 Subject: [PATCH 56/63] Put all tests for in/output together, avoid to source file with input dfs --- tests/testthat/input_dfs_tests_verify_taxa.R | 457 ------ tests/testthat/test-input_verify_taxa.R | 386 ----- tests/testthat/test-output_verify_taxa.R | 510 ------- tests/testthat/test-verify_taxa.R | 1352 ++++++++++++++++++ 4 files changed, 1352 insertions(+), 1353 deletions(-) delete mode 100644 tests/testthat/input_dfs_tests_verify_taxa.R delete mode 100644 tests/testthat/test-input_verify_taxa.R delete mode 100644 tests/testthat/test-output_verify_taxa.R create mode 100644 tests/testthat/test-verify_taxa.R diff --git a/tests/testthat/input_dfs_tests_verify_taxa.R b/tests/testthat/input_dfs_tests_verify_taxa.R deleted file mode 100644 index bf3a6a2f..00000000 --- a/tests/testthat/input_dfs_tests_verify_taxa.R +++ /dev/null @@ -1,457 +0,0 @@ -my_taxa <- trias::tibble( - taxonKey = c( - 141117238, - 113794952, - 141264857, - 100480872, - 141264614, - 100220432, - 141264835, - 140563014, - 140562956, - 145953989, - 148437916, - 114445583, - 141264849, - 101790530 - ), - scientificName = c( - "Aspius aspius", - "Rana catesbeiana", - "Polystichum tsus-simense J.Smith", - "Apus apus (Linnaeus, 1758)", - "Begonia x semperflorens hort.", - "Rana catesbeiana", - "Spiranthes cernua (L.) Richard x S. odorata (Nuttall) Lindley", - "Atyaephyra desmaresti", - "Ferrissia fragilis", - "Ferrissia fragilis", - "Ferrissia fragilis", - "Rana blanfordii Boulenger", - "Pterocarya x rhederiana C.K. Schneider", - "Stenelmis williami Schmude" - ), - datasetKey = c( - "98940a79-2bf1-46e6-afd6-ba2e85a26f9f", - "e4746398-f7c4-47a1-a474-ae80a4f18e92", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "39653f3e-8d6b-4a94-a202-859359c164c5", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "b351a324-77c4-41c9-a909-f30f77268bc4", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "289244ee-e1c1-49aa-b2d7-d379391ce265", - "289244ee-e1c1-49aa-b2d7-d379391ce265", - "3f5e930b-52a5-461d-87ec-26ecd66f14a3", - "1f3505cd-5d98-4e23-bd3b-ffe59d05d7c2", - "3772da2f-daa1-4f07-a438-15a881a2142c", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "9ca92552-f23a-41a8-a140-01abaa31c931" - ), - bb_key = c( - 2360181, - 2427092, - 2651108, - 5228676, - NA, - 2427092, - NA, - 4309705, - 2291152, - 2291152, - 2291152, - 2430304, - NA, - 1033588 - ), - bb_scientificName = c( - "Aspius aspius (Linnaeus, 1758)", - "Rana catesbeiana Shaw, 1802", - "Polystichum tsus-simense (Hook.) J.Sm.", - "Apus apus (Linnaeus, 1758)", - NA, - "Rana catesbeiana Shaw, 1802", - NA, - "Atyaephyra desmarestii (Millet, 1831)", - "Ferrissia fragilis (Tryon, 1863)", - "Ferrissia fragilis (Tryon, 1863)", - "Ferrissia fragilis (Tryon, 1863)", - "Rana blanfordii Boulenger, 1882", - NA, - "Stenelmis williami Schmude" - ), - bb_kingdom = c( - "Animalia", - "Animalia", - "Plantae", - "Animalia", - NA, - "Animalia", - NA, - "Animalia", - "Animalia", - "Animalia", - "Animalia", - "Animalia", - NA, - "Animalia" - ), - bb_rank = c( - "SPECIES", - "SPECIES", - "SPECIES", - "SPECIES", - NA, - "SPECIES", - NA, - "SPECIES", - "SPECIES", - "SPECIES", - "SPECIES", - "SPECIES", - NA, - "SPECIES" - ), - bb_taxonomicStatus = c( - "SYNONYM", - "SYNONYM", - "SYNONYM", - "ACCEPTED", - NA, - "SYNONYM", - NA, - "HOMOTYPIC_SYNONYM", - "SYNONYM", - "SYNONYM", - "SYNONYM", - "SYNONYM", - NA, - "SYNONYM" - ), - bb_acceptedKey = c( - 5851603, - 2427091, - 4046493, - NA, - NA, - 2427091, - NA, - 6454754, - 9520065, - 9520065, - 9520065, - 2430301, - NA, - 1033553 - ), - bb_acceptedName = c( - "Leuciscus aspius (Linnaeus, 1758)", - "Lithobates catesbeianus (Shaw, 1802)", - "Polystichum luctuosum (Kunze) Moore.", - NA, - NA, - "Lithobates catesbeianus (Shaw, 1802)", - NA, - "Hippolyte desmarestii Millet, 1831", - "Ferrissia californica (Rowell, 1863)", - "Ferrissia californica (Rowell, 1863)", - "Ferrissia californica (Rowell, 1863)", - "Nanorana blanfordii (Boulenger, 1882)", - NA, - "Stenelmis Dufour, 1835" - ), - taxonID = c( - "alien-fishes-checklist:taxon:c937610f85ea8a74f105724c8f198049", - "88", - "alien-plants-belgium:taxon:57c1d111f14fd5f3271b0da53c05c745", - "4512", - "alien-plants-belgium:taxon:9a6c5ed8907ff169433fe44fcbff0705", - "80-syn", - "alien-plants-belgium:taxon:29409d1e1adc88d6357dd0be13350d6c", - "alien-macroinvertebrates-checklist:taxon:54cca150e1e0b7c0b3f5b152ae64d62b", - "alien-macroinvertebrates-checklist:taxon:73f271d93128a4e566e841ea6e3abff0", - "rinse-checklist:taxon:7afe7b1fbdd06cbdfe97272567825c09", - "ad-hoc-checklist:taxon:32dc2e18733fffa92ba4e1b35d03c4e2", - "a80caa33-da9d-48ed-80e3-f76b0b3810f9", - "alien-plants-belgium:taxon:56d6564f59d9092401c454849213366f", - "193729" - ) -) - -# Add column verificationKey which will be overwritten by verify_taxa -my_taxa_vk <- dplyr::mutate(my_taxa, verificationKey = 1) - -my_verification <- trias::tibble( - taxonKey = c( - 113794952, - 141264857, - 143920280, - 141264835, - 141264614, - 140562956, - 145953989, - 114445583, - 128897752, - 101790530, - 141265523 - ), - scientificName = c( - "Rana catesbeiana", - "Polystichum tsus-simense J.Smith", - "Lemnaceae", - "Spiranthes cernua (L.) Richard x S. odorata (Nuttall) Lindley", - "Begonia x semperflorens hort.", - "Ferrissia fragilis", - "Ferrissia fragilis", - "Rana blanfordii Boulenger", - "Python reticulatus Fitzinger, 1826", - "Stenelmis williami Schmude", - "Veronica austriaca Jacq." - ), - datasetKey = c( - "e4746398-f7c4-47a1-a474-ae80a4f18e92", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "e4746398-f7c4-47a1-a474-ae80a4f18e92", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "9ff7d317-609b-4c08-bd86-3bc404b77c42", - "289244ee-e1c1-49aa-b2d7-d379391ce265", - "3f5e930b-52a5-461d-87ec-26ecd66f14a3", - "3772da2f-daa1-4f07-a438-15a881a2142c", - "7ddf754f-d193-4cc9-b351-99906754a03b", - "9ca92552-f23a-41a8-a140-01abaa31c931", - "9ff7d317-609b-4c08-bd86-3bc404b77c42" - ), - bb_key = c( - 2427092, - 2651108, - 6723, - NA, - NA, - 2291152, - 2291152, - 2430304, - 7587934, - 1033588, - NA - ), - bb_scientificName = c( - "Rana catesbeiana Shaw, 1802", - "Polystichum tsus-tsus-tsus (Hook.) Captain", - "Lemnaceae", - NA, - NA, - "Ferrissia fragilis (Tryon, 1863)", - "Ferrissia fragilis (Tryon, 1863)", - "Rana blanfordii Boulenger, 1882", - "Python reticulatus Fitzinger, 1826", - "Stenelmis williami Schmude", - NA - ), - bb_kingdom = c( - "Animalia", - "Plantae", - "Plantae", - NA, - NA, - "Animalia", - "Animalia", - "Animalia", - "Animalia", - "Animalia", - NA - ), - bb_rank = c( - "SPECIES", - "SPECIES", - "FAMILY", - NA, - NA, - "SPECIES", - "SPECIES", - "SPECIES", - "SPECIES", - "SPECIES", - NA - ), - bb_taxonomicStatus = c( - "SYNONYM", - "SYNONYM", - "SYNONYM", - NA, - NA, - "SYNONYM", - "SYNONYM", - "SYNONYM", - "SYNONYM", - "SYNONYM", - NA - ), - bb_acceptedKey = c( - 2427091, - 4046493, - 6979, - NA, - NA, - 9520065, - 9520065, - 2427008, - 9260388, - 1033553, - NA - ), - bb_acceptedName = c( - "Lithobates dummyus (Batman, 2018)", - "Polystichum luctuosum (Kunze) Moore.", - "Araceae", - NA, - NA, - "Ferrissia californica (Rowell, 1863)", - "Ferrissia californica (Rowell, 1863)", - "Hylarana chalconota (Schlegel, 1837)", - "Malayopython reticulatus (Schneider, 1801)", - "Stenelmis Dufour, 1835", - NA - ), - bb_acceptedKingdom = c( - "Animalia", - "Plantae", - "Plantae", - NA, - NA, - "Animalia", - "Animalia", - "Animalia", - "Animalia", - "Animalia", - NA - ), - bb_acceptedRank = c( - "SPECIES", - "SPECIES", - "FAMILY", - NA, - NA, - "SPECIES", - "SPECIES", - "SPECIES", - "SPECIES", - "GENUS", - NA - ), - bb_acceptedTaxonomicStatus = c( - "ACCEPTED", - "ACCEPTED", - "ACCEPTED", - NA, - NA, - "ACCEPTED", - "ACCEPTED", - "ACCEPTED", - "ACCEPTED", - "ACCEPTED", - NA - ), - verificationKey = c( - 2427091, - 4046493, - 6979, - "2805420,2805363", - NA, - NA, - NA, - NA, - 9260388, - NA, - 3172099 - ), - remarks = c( - "dummy example 1: bb_acceptedName should be updated.", - "dummy example 2: bb_scientificName should be updated.", - "dummy example 3: not used anymore. Set outdated = TRUE.", - "dummy example 4: multiple keys in verificationKey are allowed.", - "dummy example 5: nothing should happen.", - "dummy example 6: datasetKey should not be modified. If new taxa come in - with same name from other checklsits, they should be added as new rows. - Report them as duplicates in duplicates_taxa", - "dummy example 7: datasetKey should not be modified. If new taxa come in - with same name from other checklsits, they should be added as new rows. - Report them as duplicates in duplicates_taxa", - "dummy example 8: outdated synonym. Set outdated = TRUE.", - "dummy example 9: outdated synonym. outdated is already TRUE. No actions.", - "dummy example 10: outdated synonym. Not outdated anymore. Change outdated - back to FALSE.", - "dummy example 11: outdated unmatched taxa. Set outdated = TRUE." - ), - verifiedBy = c( - "Damiano Oldoni", - "Peter Desmet", - "Stijn Van Hoey", - "Tanja Milotic", - NA, - NA, - NA, - NA, - "Lien Reyserhove", - NA, - "Dimitri Brosens" - ), - dateAdded = as.Date( - c( - "2018-07-01", - "2018-07-01", - "2018-07-01", - "2018-07-16", - "2018-07-16", - "2018-07-01", - "2018-11-20", - "2018-11-29", - "2018-12-01", - "2018-12-02", - "2018-12-03" - ) - ), - outdated = c( - FALSE, - FALSE, - FALSE, - FALSE, - FALSE, - FALSE, - FALSE, - FALSE, - TRUE, - TRUE, - FALSE - ) -) - -my_taxa_other_colnames <- - dplyr::rename( - my_taxa, - checklist = datasetKey, - scientific_names = scientificName - ) - -my_verification_other_colnames <- - dplyr::rename( - my_verification, - backbone_scientific_names = bb_scientificName, - backbone_accepted_names = bb_acceptedName, - is_outdated = outdated, - author_verification = verifiedBy - ) - -my_taxa_duplicates <- - my_taxa[1:2,] -my_taxa_duplicates$taxonKey[2] <- my_taxa_duplicates$taxonKey[1] - -my_verification_duplicates <- - my_verification[1:2,] -my_verification_duplicates$taxonKey[2] <- my_verification_duplicates$taxonKey[1] - -my_taxa_nas <- - my_taxa_duplicates -my_taxa_nas$taxonKey[2] <- NA_real_ - -my_verification_nas <- - my_verification_duplicates -my_verification_nas$taxonKey[2] <- NA_real_ diff --git a/tests/testthat/test-input_verify_taxa.R b/tests/testthat/test-input_verify_taxa.R deleted file mode 100644 index 41f77da6..00000000 --- a/tests/testthat/test-input_verify_taxa.R +++ /dev/null @@ -1,386 +0,0 @@ -context("input_verify_taxa") - -# import correct inputs -source("input_dfs_tests_verify_taxa.R") - -testthat::test_that("taxa is a data frame", { - expect_error( - verify_taxa( - taxa = 3, - verification = my_verification - ), - "taxa is not a data frame" - ) - expect_error( - verify_taxa( - taxa = c("23"), - verification = my_verification - ), - "taxa is not a data frame" - ) -}) - - -testthat::test_that("verification is a data frame", { - expect_error( - verify_taxa( - taxa = my_taxa, - verification = 3 - ), - "verification is not a data frame" - ) - expect_error( - verify_taxa( - taxa = my_taxa, - verification = c("3") - ), - "verification is not a data frame" - ) -}) - - -# no missing taxon keys in both input taxa and verification df (if not NULL) -testthat::test_that("No missing taxon keys in input taxa and verification dfs", { - expect_error( - verify_taxa(taxa = my_taxa_nas, verification = my_verification), - paste("Missing values found in taxon keys of input taxa.", - "Check values in column taxonKey.") - ) - expect_error( - verify_taxa(taxa = my_taxa, verification = my_verification_nas), - paste("Missing values found in taxon keys of input taxa.", - "Check values in column taxonKey.") - ) -}) - -# taxon keys are unique -testthat::test_that("Taxon keys are unique in input taxa and verification dfs", { - expect_error( - verify_taxa(taxa = my_taxa_duplicates, verification = my_verification), - paste("Taxon keys of input taxa must be unique.", - "Check values in column taxonKey.") - ) - expect_error( - verify_taxa(taxa = my_taxa, verification = my_verification_duplicates), - paste("Taxon keys of input taxa must be unique.", - "Check values in column taxonKey.") - ) -}) - - -# different taxa column names -taxa_test1 <- tibble( - bad_checklist_taxonKey_colname = c(123452), - bad_checklist_scientificName_colname = c("Aspius aspius"), - bad_checklist_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", - bad_backbone_taxonKey_colname = c(2360181), - bad_backbone_scientificName_colname = c("Aspius aspius (Linnaeus, 1758)"), - bad_backbone_kingdom_colname = c("Animalia"), - bad_backbone_rank_colname = c("SPECIES"), - bad_backbone_taxonomicStatus_colname = c("SYNONYM"), - bad_backbone_acceptedKey_colname = c(5851603), - bad_backbone_acceptedName_colname = c("Leuciscus aspius (Linnaeus, 1758)") -) - -# missing column -taxa_test2 <- tibble( - taxonKey = c(123452), - scientificName = c("Aspius aspius"), - datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - # bb_acceptedKey is missing - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)") -) - -testthat::test_that("taxa column names are correct", { - expect_error(verify_taxa( - taxa = taxa_test1, - verification = my_verification - ), - paste( - "The following columns of taxa are not present:", - "taxonKey, scientificName, datasetKey, bb_key, bb_scientificName,", - "bb_kingdom, bb_rank, bb_taxonomicStatus, bb_acceptedKey, bb_acceptedName.", - "Did you maybe forget to provide the mapping of columns named differently", - "than the default names?" - ), - fixed = TRUE - ) - expect_error(verify_taxa( - taxa = taxa_test2, - verification = my_verification - ), - paste( - "The following columns of taxa are not present:", - "bb_acceptedKey. Did you maybe forget to provide the mapping of columns", - "named differently than the default names?" - ), - fixed = TRUE - ) -}) - -# inconsistency about unmatched taxa -taxa_test3 <- tibble( - taxonKey = c(123452), - scientificName = c("Aspius aspius"), - datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", - bb_key = c(NA_integer_), - bb_scientificName = c(NA_character_), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - bb_acceptedKey = c(3483948), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)") -) - -testthat::test_that("consistency of 'taxa' about GBIF backbone info columns", { - expect_error( - verify_taxa( - taxa = taxa_test3, - verification = my_verification - ), - "Columns with GBIF Backbone info should be empty for unmatched taxa.", - fixed = TRUE - ) -}) - -# different verification column names -verification_test1 <- tibble( - bad_checklist_taxonKey = c(12341), - bad_checklist_scientificName_colname = c("Aspius aspius"), - bad_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", - bad_backbone_taxonKey_colname = c(2360181), - bad_backbone_scientificName_colname = c("Aspius aspius (Linnaeus, 1758)"), - bad_backbone_kingdom_colname = c("Animalia"), - bad_backbone_rank_colname = c("SPECIES"), - bad_backbone_taxonomicStatus_colname = c("SYNONYM"), - bad_backbone_acceptedKey_colname = c(5851603), - bad_backbone_acceptedName_colname = c("Leuciscus aspius (Linnaeus, 1758)"), - bad_backbone_acceptedKingdom_colname = c("Animalia"), - bad_backbone_acceptedrank_colname = c("SPECIES"), - bad_backbone_acceptedTaxonomicStatus_colname = c("ACCEPTED"), - bad_verificationKey_colname = c(2427091), - bad_remarks_colname = c("dummy example 1: backbone_accepted should be updated"), - bad_verifiedBy_colname = c("Damiano Oldoni"), - bad_dateAdded_colname = c(as.Date("2018-01-01")), - bad_outdated = c(FALSE) -) - -# missing columns -verification_test2 <- tibble( - taxonKey = c(141117238), - scientificName = c("Aspius aspius"), - # datasetKey column missing - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - # bb_kingdom column missing - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - bb_acceptedKey = c(5851603), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - # bb_acceptedKingdom - bb_acceptedRank = c("SPECIES"), - bb_acceptedTaxonomicStatus = c("ACCEPTED"), - verificationKey = c(2427091), - remarks = c("dummy example 1: backbone_accepted should be updated"), - verifiedBy = c("Dami Oldi"), - # dateAdded column missing - outdated = c(FALSE) -) - -# inconsistency bb_acceptedName - bb_acceptedKey -verification_test3 <- tibble( - taxonKey = c(141117238), - scientificName = c("Aspius aspius"), - datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - bb_acceptedKey = c(NA_integer_), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - bb_acceptedKingdom = c("Animalia"), - bb_acceptedRank = c("SPECIES"), - bb_acceptedTaxonomicStatus = c("ACCEPTED"), - verificationKey = c(2427091), - remarks = c("dummy example 1: backbone_accepted should be updated"), - verifiedBy = c("Damiano Oldoni"), - dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE) -) - -# accepted taxa present (only synonyms and unmatched taxa allowed) -verification_test4 <- tibble( - taxonKey = c(141117238), - scientificName = c("Aspius aspius"), - datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("ACCEPTED"), - bb_acceptedKey = c(5851603), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - bb_acceptedKingdom = c("Animalia"), - bb_acceptedRank = c("SPECIES"), - bb_acceptedTaxonomicStatus = c("ACCEPTED"), - verificationKey = c(2427091), - remarks = NA_character_, - verifiedBy = NA_character_, - dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE) -) - -# outdated must to be TRUE or FALSE. -verification_test5 <- tibble( - taxonKey = c(141117238), - scientificName = c("Aspius aspius"), - datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - bb_acceptedKey = c(5851603), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - bb_acceptedKingdom = c("Animalia"), - bb_acceptedRank = c("SPECIES"), - bb_acceptedTaxonomicStatus = c("ACCEPTED"), - verificationKey = c(2427091), - remarks = NA_character_, - verifiedBy = NA_character_, - dateAdded = c(as.Date("2010-01-01")), - outdated = c(NA) -) - -# datasetKey should be 36 characters long -verification_test6 <- tibble( - taxonKey = c(141117238), - scientificName = c("Aspius aspius"), - datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92,other stuff"), - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - bb_acceptedKey = c(5851603), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - bb_acceptedKingdom = c("Animalia"), - bb_acceptedRank = c("SPECIES"), - bb_acceptedTaxonomicStatus = c("ACCEPTED"), - verificationKey = c(2427091), - remarks = NA_character_, - verifiedBy = NA_character_, - dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE) -) - -# commas not allowed in datasetKey -verification_test7 <- tibble( - taxonKey = c(141117238), - scientificName = c("Aspius aspius"), - datasetKey = c("e4746398-f7c4-47a1-a474,ae80a4f18e92"), - bb_key = c(2360181), - bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), - bb_kingdom = c("Animalia"), - bb_rank = c("SPECIES"), - bb_taxonomicStatus = c("SYNONYM"), - bb_acceptedKey = c(5851603), - bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), - bb_acceptedKingdom = c("Animalia"), - bb_acceptedRank = c("SPECIES"), - bb_acceptedTaxonomicStatus = c("ACCEPTED"), - verificationKey = c(2427091), - remarks = NA_character_, - verifiedBy = NA_character_, - dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE) -) - -testthat::test_that("verify_taxa column names are correct", { - expect_error(verify_taxa( - taxa = my_taxa, - verification = verification_test1 - ), - paste( - "The following columns of verification are not present:", - "taxonKey, scientificName, datasetKey, bb_key, bb_scientificName,", - "bb_kingdom, bb_rank, bb_taxonomicStatus,", - "bb_acceptedKey, bb_acceptedName, bb_acceptedKingdom, bb_acceptedRank,", - "bb_acceptedTaxonomicStatus, verificationKey, remarks, verifiedBy,", - "dateAdded, outdated. Did you maybe forget to provide the mapping of", - "columns named differently than the default names?" - ), - fixed = TRUE - ) - expect_error(verify_taxa( - taxa = my_taxa, - verification = verification_test2 - ), - paste( - "The following columns of verification are not present:", - "datasetKey, bb_kingdom, bb_acceptedKingdom, dateAdded.", - "Did you maybe forget to provide the mapping of columns named differently", - "than the default names?" - ), - fixed = TRUE - ) -}) - -testthat::test_that("synonym relations are inconsistent", { - expect_error(verify_taxa( - taxa = my_taxa, - verification = verification_test3 - ), - "bb_acceptedName and bb_acceptedKey should be both NA or both present.", - fixed = TRUE - ) -}) - -testthat::test_that("accepted taxa in verification input", { - expect_error(verify_taxa( - taxa = my_taxa, - verification = verification_test4 - ), - "Only synonyms and unmatched taxa allowed in verification.", - fixed = TRUE - ) -}) - -testthat::test_that("restrictions on input columns of verification", { - expect_error(verify_taxa( - taxa = my_taxa, - verification = verification_test5 - ), - "Only logicals (TRUE/FALSE) allowed in 'outdated' of verification.", - fixed = TRUE - ) -}) - -testthat::test_that("valid datsetKey values", { - expect_error( - verify_taxa( - taxa = my_taxa, - verification = verification_test6 - ), - paste( - "Incorrect datesetKey:", verification_test6$datasetKey, - "Is expected to be 36-character UUID." - ) - ) - expect_error( - verify_taxa( - taxa = my_taxa, - verification = verification_test7 - ), - paste( - "Incorrect datesetKey:", verification_test7$datasetKey, - "Is expected to be 36-character UUID." - ) - ) -}) diff --git a/tests/testthat/test-output_verify_taxa.R b/tests/testthat/test-output_verify_taxa.R deleted file mode 100644 index 7ceebff8..00000000 --- a/tests/testthat/test-output_verify_taxa.R +++ /dev/null @@ -1,510 +0,0 @@ -context("output_verify_taxa") - -# import correct inputs -source("input_dfs_tests_verify_taxa.R") - -# output -output1 <- verify_taxa(taxa = my_taxa, verification = my_verification) -output2 <- verify_taxa(taxa = my_taxa) -output3 <- verify_taxa(taxa = my_taxa_vk, verification = my_verification) -output4 <- verify_taxa( - taxa = my_taxa_other_colnames, - verification = my_verification_other_colnames, - datasetKey = "checklist", - scientificName = "scientific_names", - verification_bb_scientificName = "backbone_scientific_names", - verification_bb_acceptedName = "backbone_accepted_names", - verification_outdated = "is_outdated", - verification_verifiedBy = "author_verification" -) -outputs <- list(output1, output2, output3, output4) -testthat::test_that("output structure", { - expect_true(all(purrr::map_lgl(outputs, function(x) { - class(x) == "list" - }))) - expect_true(all(purrr::map_lgl(outputs, function(x) { - length(x) == 3 - }))) - expect_true(all(purrr::map_lgl(outputs, function(x) { - class(x$info) == "list" - }))) - expect_true(length(output1$info) == 8) - expect_true(length(output2$info) == 8) - expect_equivalent(output1$info, output3$info) - expect_true(all()) - expect_true(all(purrr::map_lgl(outputs, function(x) { - is.data.frame(x$taxa) - }))) - expect_equivalent(output1$taxa, output3$taxa) - expect_true( - all(purrr::map_lgl(outputs, function(x) { - is.data.frame(x$verification) - })) - ) - expect_equivalent(output1$verification, output3$verification) - expect_true(all(purrr::map_lgl(output1$info, ~ is.data.frame(.)))) - expect_true(all(purrr::map_lgl(output2$info, ~ is.data.frame(.)))) - expect_true(all(purrr::map_lgl(output1$info, ~ (!"grouped_df" %in% class(.))))) - expect_true(all(purrr::map_lgl(output2$info, ~ (!"grouped_df" %in% class(.))))) - expect_equivalent(output1$info, output3$info) - expect_true( - all(names(output4$verification) == names(my_verification_other_colnames)) - ) - expect_true( - all(purrr::map_lgl( - list( - output4$info$outdated_unmatched_taxa, - output4$info$outdated_synonyms - ), function(x) { - all(names(x) == names(my_verification_other_colnames)) - } - )) - ) - expect_true(all(names(output4$info$new_synonyms) == - names(my_verification_other_colnames))) - expect_true(all(names(output4$info$new_unmatched_taxa) == - names(my_verification_other_colnames))) - expect_true( - all(names(output4$info$updated_bb_scientificName) == - c( - "taxonKey", "bb_key", "bb_acceptedKey", - "backbone_scientific_names", "updated_backbone_scientific_names" - )) - ) - expect_true( - all(names(output4$info$updated_bb_acceptedName) == - c( - "taxonKey", "bb_key", "bb_acceptedKey", - "backbone_accepted_names", "updated_backbone_accepted_names" - )) - ) -}) - -testthat::test_that("consitency input - output", { - expect_true(nrow(output1$taxa) == nrow(my_taxa)) - expect_true(nrow(output2$taxa) == nrow(my_taxa)) - expect_true(ncol(output1$taxa) == ncol(my_taxa) + 1) - expect_true(ncol(output2$taxa) == ncol(my_taxa) + 1) - expect_true(all(output1$taxa$taxonKey == my_taxa$taxonKey)) - expect_true(all(output2$taxa$taxonKey == my_taxa$taxonKey)) - expect_true( - nrow(output1$verification) == - nrow(my_verification) + - nrow(output1$info$new_synonyms) + - nrow(output1$info$new_unmatched_taxa) - ) - expect_true( - nrow(output2$verification) == - nrow(output2$info$new_synonyms) + - nrow(output2$info$new_unmatched_taxa) - ) - expect_true(nrow(output1$verification %>% - filter(!is.na(verificationKey))) <= - nrow(output1$info$check_verificationKey)) - expect_true( - nrow(my_taxa %>% - filter(bb_taxonomicStatus %in% c("ACCEPTED", "DOUBTFUL"))) == - nrow(output2$taxa %>% - filter(!is.na(verificationKey))) - ) - expect_true(all(output1$info$new_synonyms$outdated == FALSE)) - expect_true(all(output2$info$new_synonyms$outdated == FALSE)) - expect_true(all(output1$info$new_unmatched_taxa$outdated == FALSE)) - expect_true(all(output2$info$new_unmatched_taxa$outdated == FALSE)) - expect_true(all(output2$verification$outdated == FALSE)) - expect_true(all(output1$info$outdated_unmatched_taxa$outdated == TRUE)) - expect_true(all(output2$info$outdated_unmatched_taxa$outdated == TRUE)) - expect_true(all(output1$info$outdated_synonyms$outdated == TRUE)) - expect_true(all(output2$info$outdated_synonyms$outdated == TRUE)) - expect_true( - nrow(output1$info$outdated_synonyms) + - nrow(output1$info$outdated_unmatched_taxa) == - nrow(dplyr::filter(output1$verification, outdated == TRUE)) - ) - expect_true( - nrow(output2$info$outdated_synonyms) + - nrow(output2$info$outdated_unmatched_taxa) == - nrow(dplyr::filter(output2$verification, outdated == TRUE)) - ) -}) - -col_types_verification <- readr::cols( - taxonKey = readr::col_double(), - scientificName = readr::col_character(), - datasetKey = readr::col_character(), - bb_key = readr::col_double(), - bb_scientificName = readr::col_character(), - bb_kingdom = readr::col_character(), - bb_rank = readr::col_character(), - bb_taxonomicStatus = readr::col_character(), - bb_acceptedKey = readr::col_double(), - bb_acceptedName = readr::col_character(), - bb_acceptedKingdom = readr::col_character(), - bb_acceptedRank = readr::col_character(), - bb_acceptedTaxonomicStatus = readr::col_character(), - verificationKey = readr::col_character(), - remarks = readr::col_character(), - verifiedBy = readr::col_character(), - dateAdded = readr::col_date(format = "%Y-%m-%d"), - outdated = readr::col_logical() -) - -col_types_output_taxa <- readr::cols( - taxonKey = readr::col_double(), - scientificName = readr::col_character(), - datasetKey = readr::col_character(), - bb_key = readr::col_double(), - bb_scientificName = readr::col_character(), - bb_kingdom = readr::col_character(), - bb_rank = readr::col_character(), - bb_taxonomicStatus = readr::col_character(), - bb_acceptedName = readr::col_character(), - bb_acceptedKey = readr::col_double(), - verificationKey = readr::col_character(), - taxonID = readr::col_character() -) - -col_types_updated_names <- readr::cols( - taxonKey = readr::col_double(), - bb_key = readr::col_double(), - bb_acceptedKey = readr::col_double() -) - -output1_taxa <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_taxa.tsv" - ), - col_types = col_types_output_taxa - ) -output2_taxa <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_taxa.tsv" - ), - col_types = col_types_output_taxa - ) - -output1_verification <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_verification.tsv" - ), - col_types = col_types_verification - ) -output2_verification <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_verification.tsv" - ), - col_types = col_types_verification - ) - -output1_new_synonyms <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_new_synonyms.tsv" - ), - col_types = col_types_verification - ) -output2_new_synonyms <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_new_synonyms.tsv" - ), - col_types = col_types_verification - ) - -output1_new_unmatched_taxa <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_new_unmatched_taxa.tsv" - ), - col_types = col_types_verification - ) -output2_new_unmatched_taxa <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_new_unmatched_taxa.tsv" - ), - col_types = col_types_verification - ) - -output1_outdated_unmatched_taxa <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_outdated_unmatched_taxa.tsv" - ), - col_types = col_types_verification - ) - -output2_outdated_unmatched_taxa <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_outdated_unmatched_taxa.tsv" - ), - col_types = col_types_verification - ) - -output1_outdated_synonyms <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_outdated_synonyms.tsv" - ), - col_types = col_types_verification - ) - -output2_outdated_synonyms <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_outdated_synonyms.tsv" - ), - col_types = col_types_verification - ) - -output1_updated_bb_scientificName <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_updated_bb_scientificName.tsv" - ), - col_types = col_types_updated_names - ) - -output2_updated_bb_scientificName <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_updated_bb_scientificName.tsv" - ), - col_types = col_types_updated_names - ) - -output1_updated_bb_acceptedName <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_updated_bb_acceptedName.tsv" - ), - col_types = col_types_updated_names - ) - -output2_updated_bb_acceptedName <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_updated_bb_acceptedName.tsv" - ), - col_types = col_types_updated_names - ) - -output1_duplicates <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output1_duplicates.tsv" - ), - col_types = readr::cols(n = readr::col_integer()) - ) -output2_duplicates <- - readr::read_tsv( - file = paste0( - "./data_test_output_verify_taxa/", - "output2_duplicates.tsv" - ), - col_types = readr::cols(n = readr::col_integer()) - ) - -testthat::test_that("output data.frames are correct", { - expect_equivalent(output1$taxa, output1_taxa) - expect_equivalent(output2$taxa, output2_taxa) - # output4 with default column names should be exactly equal to output1 - output4_default_names_verification <- - output4$verification %>% - dplyr::rename( - bb_scientificName = backbone_scientific_names, - bb_acceptedName = backbone_accepted_names, - outdated = is_outdated, - verifiedBy = author_verification - ) - expect_equivalent(output1$verification, output4_default_names_verification) - expect_equivalent( - output1$verification %>% - # new synonyms and unmatched get date of today - dplyr::select(-dateAdded), - output1_verification %>% - # new synonyms and unmatched got paste date - dplyr::select(-dateAdded) - ) - expect_equivalent( - output2$verification %>% - # new synonyms and unmatched get date of today - dplyr::select(-dateAdded), - output2_verification %>% - # new synonyms and unmatched got paste date - dplyr::select(-dateAdded) - ) - - output4_default_names_new_synonyms <- - output4$info$new_synonyms %>% - dplyr::rename( - bb_scientificName = backbone_scientific_names, - bb_acceptedName = backbone_accepted_names, - outdated = is_outdated, - verifiedBy = author_verification - ) - expect_equivalent( - output1$info$new_synonyms, - output4_default_names_new_synonyms - ) - expect_equivalent( - output1$info$new_synonyms %>% - # new synonyms get date of today - dplyr::select(-dateAdded), - output1_new_synonyms %>% - # unmatched got past date - dplyr::select(-dateAdded) - ) - expect_equivalent( - output2$info$new_synonyms %>% - # new synonyms get date of today - dplyr::select(-dateAdded), - output2_new_synonyms %>% - # unmatched got past date - dplyr::select(-dateAdded) - ) - - output4_default_names_new_unmatched_taxa <- - output4$info$new_unmatched_taxa %>% - dplyr::rename( - bb_scientificName = backbone_scientific_names, - bb_acceptedName = backbone_accepted_names, - outdated = is_outdated, - verifiedBy = author_verification - ) - expect_equivalent( - output1$info$new_unmatched_taxa, - output4_default_names_new_unmatched_taxa - ) - expect_equivalent( - output1$info$new_unmatched_taxa %>% - # unmatched get date of today - dplyr::select(-dateAdded), - output1_new_unmatched_taxa %>% - # unmatched got past date - dplyr::select(-dateAdded) - ) - expect_equivalent( - output2$info$new_unmatched_taxa %>% - # unmatched get date of today - dplyr::select(-dateAdded), - output2_new_unmatched_taxa %>% - # unmatched got past date - dplyr::select(-dateAdded) - ) - - output4_default_names_outdated_unmatched_taxa <- - output4$info$outdated_unmatched_taxa %>% - dplyr::rename( - bb_scientificName = backbone_scientific_names, - bb_acceptedName = backbone_accepted_names, - outdated = is_outdated, - verifiedBy = author_verification - ) - expect_equivalent( - output1$info$outdated_unmatched_taxa, - output4_default_names_outdated_unmatched_taxa - ) - expect_equivalent( - output1$info$outdated_unmatched_taxa, - output1_outdated_unmatched_taxa - ) - expect_equivalent( - output2$info$outdated_unmatched_taxa, - output2_outdated_unmatched_taxa - ) - - output4_default_names_outdated_synonyms <- - output4$info$outdated_synonyms %>% - dplyr::rename( - bb_scientificName = backbone_scientific_names, - bb_acceptedName = backbone_accepted_names, - outdated = is_outdated, - verifiedBy = author_verification - ) - expect_equivalent( - output1$info$outdated_synonyms, - output4_default_names_outdated_synonyms - ) - expect_equivalent( - output1$info$outdated_synonyms, - output1_outdated_synonyms - ) - expect_equivalent( - output2$info$outdated_synonyms, - output2_outdated_synonyms - ) - - output4_default_names_updated_bb_scientificName <- - output4$info$updated_bb_scientificName %>% - dplyr::rename( - bb_scientificName = backbone_scientific_names, - updated_bb_scientificName = updated_backbone_scientific_names - ) - expect_equivalent( - output1$info$updated_bb_scientificName, - output4_default_names_updated_bb_scientificName - ) - expect_equivalent( - output1$info$updated_bb_scientificName, - output1_updated_bb_scientificName - ) - expect_equivalent( - output2$info$updated_bb_scientificName, - output2_updated_bb_scientificName - ) - - output4_default_names_updated_bb_acceptedName <- - output4$info$updated_bb_acceptedName %>% - dplyr::rename( - bb_acceptedName = backbone_accepted_names, - updated_bb_acceptedName = updated_backbone_accepted_names - ) - expect_equivalent( - output1$info$updated_bb_acceptedName, - output4_default_names_updated_bb_acceptedName - ) - expect_equivalent( - output1$info$updated_bb_acceptedName, - output1_updated_bb_acceptedName - ) - expect_equivalent( - output2$info$updated_bb_acceptedName, - output2_updated_bb_acceptedName - ) - - output4_default_names_duplicates <- - output4$info$duplicates %>% - dplyr::rename(bb_scientificName = backbone_scientific_names) - expect_equivalent( - output1$info$duplicates, - output4_default_names_duplicates - ) - expect_equivalent(output1$info$duplicates, output1_duplicates) - expect_equivalent(output2$info$duplicates, output2_duplicates) - # check_verification_key df no tested here: output of another TrIAS function - # only check 0 rows with output2 - expect_true(nrow(output2$info$check_verificationKey) == 0) -}) diff --git a/tests/testthat/test-verify_taxa.R b/tests/testthat/test-verify_taxa.R new file mode 100644 index 00000000..bc716247 --- /dev/null +++ b/tests/testthat/test-verify_taxa.R @@ -0,0 +1,1352 @@ +# Define inputs + +my_taxa <- trias::tibble( + taxonKey = c( + 141117238, + 113794952, + 141264857, + 100480872, + 141264614, + 100220432, + 141264835, + 140563014, + 140562956, + 145953989, + 148437916, + 114445583, + 141264849, + 101790530 + ), + scientificName = c( + "Aspius aspius", + "Rana catesbeiana", + "Polystichum tsus-simense J.Smith", + "Apus apus (Linnaeus, 1758)", + "Begonia x semperflorens hort.", + "Rana catesbeiana", + "Spiranthes cernua (L.) Richard x S. odorata (Nuttall) Lindley", + "Atyaephyra desmaresti", + "Ferrissia fragilis", + "Ferrissia fragilis", + "Ferrissia fragilis", + "Rana blanfordii Boulenger", + "Pterocarya x rhederiana C.K. Schneider", + "Stenelmis williami Schmude" + ), + datasetKey = c( + "98940a79-2bf1-46e6-afd6-ba2e85a26f9f", + "e4746398-f7c4-47a1-a474-ae80a4f18e92", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "39653f3e-8d6b-4a94-a202-859359c164c5", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "b351a324-77c4-41c9-a909-f30f77268bc4", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "289244ee-e1c1-49aa-b2d7-d379391ce265", + "289244ee-e1c1-49aa-b2d7-d379391ce265", + "3f5e930b-52a5-461d-87ec-26ecd66f14a3", + "1f3505cd-5d98-4e23-bd3b-ffe59d05d7c2", + "3772da2f-daa1-4f07-a438-15a881a2142c", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "9ca92552-f23a-41a8-a140-01abaa31c931" + ), + bb_key = c( + 2360181, + 2427092, + 2651108, + 5228676, + NA, + 2427092, + NA, + 4309705, + 2291152, + 2291152, + 2291152, + 2430304, + NA, + 1033588 + ), + bb_scientificName = c( + "Aspius aspius (Linnaeus, 1758)", + "Rana catesbeiana Shaw, 1802", + "Polystichum tsus-simense (Hook.) J.Sm.", + "Apus apus (Linnaeus, 1758)", + NA, + "Rana catesbeiana Shaw, 1802", + NA, + "Atyaephyra desmarestii (Millet, 1831)", + "Ferrissia fragilis (Tryon, 1863)", + "Ferrissia fragilis (Tryon, 1863)", + "Ferrissia fragilis (Tryon, 1863)", + "Rana blanfordii Boulenger, 1882", + NA, + "Stenelmis williami Schmude" + ), + bb_kingdom = c( + "Animalia", + "Animalia", + "Plantae", + "Animalia", + NA, + "Animalia", + NA, + "Animalia", + "Animalia", + "Animalia", + "Animalia", + "Animalia", + NA, + "Animalia" + ), + bb_rank = c( + "SPECIES", + "SPECIES", + "SPECIES", + "SPECIES", + NA, + "SPECIES", + NA, + "SPECIES", + "SPECIES", + "SPECIES", + "SPECIES", + "SPECIES", + NA, + "SPECIES" + ), + bb_taxonomicStatus = c( + "SYNONYM", + "SYNONYM", + "SYNONYM", + "ACCEPTED", + NA, + "SYNONYM", + NA, + "HOMOTYPIC_SYNONYM", + "SYNONYM", + "SYNONYM", + "SYNONYM", + "SYNONYM", + NA, + "SYNONYM" + ), + bb_acceptedKey = c( + 5851603, + 2427091, + 4046493, + NA, + NA, + 2427091, + NA, + 6454754, + 9520065, + 9520065, + 9520065, + 2430301, + NA, + 1033553 + ), + bb_acceptedName = c( + "Leuciscus aspius (Linnaeus, 1758)", + "Lithobates catesbeianus (Shaw, 1802)", + "Polystichum luctuosum (Kunze) Moore.", + NA, + NA, + "Lithobates catesbeianus (Shaw, 1802)", + NA, + "Hippolyte desmarestii Millet, 1831", + "Ferrissia californica (Rowell, 1863)", + "Ferrissia californica (Rowell, 1863)", + "Ferrissia californica (Rowell, 1863)", + "Nanorana blanfordii (Boulenger, 1882)", + NA, + "Stenelmis Dufour, 1835" + ), + taxonID = c( + "alien-fishes-checklist:taxon:c937610f85ea8a74f105724c8f198049", + "88", + "alien-plants-belgium:taxon:57c1d111f14fd5f3271b0da53c05c745", + "4512", + "alien-plants-belgium:taxon:9a6c5ed8907ff169433fe44fcbff0705", + "80-syn", + "alien-plants-belgium:taxon:29409d1e1adc88d6357dd0be13350d6c", + "alien-macroinvertebrates-checklist:taxon:54cca150e1e0b7c0b3f5b152ae64d62b", + "alien-macroinvertebrates-checklist:taxon:73f271d93128a4e566e841ea6e3abff0", + "rinse-checklist:taxon:7afe7b1fbdd06cbdfe97272567825c09", + "ad-hoc-checklist:taxon:32dc2e18733fffa92ba4e1b35d03c4e2", + "a80caa33-da9d-48ed-80e3-f76b0b3810f9", + "alien-plants-belgium:taxon:56d6564f59d9092401c454849213366f", + "193729" + ) +) + +# Add column verificationKey which will be overwritten by verify_taxa +my_taxa_vk <- dplyr::mutate(my_taxa, verificationKey = 1) + +my_verification <- trias::tibble( + taxonKey = c( + 113794952, + 141264857, + 143920280, + 141264835, + 141264614, + 140562956, + 145953989, + 114445583, + 128897752, + 101790530, + 141265523 + ), + scientificName = c( + "Rana catesbeiana", + "Polystichum tsus-simense J.Smith", + "Lemnaceae", + "Spiranthes cernua (L.) Richard x S. odorata (Nuttall) Lindley", + "Begonia x semperflorens hort.", + "Ferrissia fragilis", + "Ferrissia fragilis", + "Rana blanfordii Boulenger", + "Python reticulatus Fitzinger, 1826", + "Stenelmis williami Schmude", + "Veronica austriaca Jacq." + ), + datasetKey = c( + "e4746398-f7c4-47a1-a474-ae80a4f18e92", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "e4746398-f7c4-47a1-a474-ae80a4f18e92", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "9ff7d317-609b-4c08-bd86-3bc404b77c42", + "289244ee-e1c1-49aa-b2d7-d379391ce265", + "3f5e930b-52a5-461d-87ec-26ecd66f14a3", + "3772da2f-daa1-4f07-a438-15a881a2142c", + "7ddf754f-d193-4cc9-b351-99906754a03b", + "9ca92552-f23a-41a8-a140-01abaa31c931", + "9ff7d317-609b-4c08-bd86-3bc404b77c42" + ), + bb_key = c( + 2427092, + 2651108, + 6723, + NA, + NA, + 2291152, + 2291152, + 2430304, + 7587934, + 1033588, + NA + ), + bb_scientificName = c( + "Rana catesbeiana Shaw, 1802", + "Polystichum tsus-tsus-tsus (Hook.) Captain", + "Lemnaceae", + NA, + NA, + "Ferrissia fragilis (Tryon, 1863)", + "Ferrissia fragilis (Tryon, 1863)", + "Rana blanfordii Boulenger, 1882", + "Python reticulatus Fitzinger, 1826", + "Stenelmis williami Schmude", + NA + ), + bb_kingdom = c( + "Animalia", + "Plantae", + "Plantae", + NA, + NA, + "Animalia", + "Animalia", + "Animalia", + "Animalia", + "Animalia", + NA + ), + bb_rank = c( + "SPECIES", + "SPECIES", + "FAMILY", + NA, + NA, + "SPECIES", + "SPECIES", + "SPECIES", + "SPECIES", + "SPECIES", + NA + ), + bb_taxonomicStatus = c( + "SYNONYM", + "SYNONYM", + "SYNONYM", + NA, + NA, + "SYNONYM", + "SYNONYM", + "SYNONYM", + "SYNONYM", + "SYNONYM", + NA + ), + bb_acceptedKey = c( + 2427091, + 4046493, + 6979, + NA, + NA, + 9520065, + 9520065, + 2427008, + 9260388, + 1033553, + NA + ), + bb_acceptedName = c( + "Lithobates dummyus (Batman, 2018)", + "Polystichum luctuosum (Kunze) Moore.", + "Araceae", + NA, + NA, + "Ferrissia californica (Rowell, 1863)", + "Ferrissia californica (Rowell, 1863)", + "Hylarana chalconota (Schlegel, 1837)", + "Malayopython reticulatus (Schneider, 1801)", + "Stenelmis Dufour, 1835", + NA + ), + bb_acceptedKingdom = c( + "Animalia", + "Plantae", + "Plantae", + NA, + NA, + "Animalia", + "Animalia", + "Animalia", + "Animalia", + "Animalia", + NA + ), + bb_acceptedRank = c( + "SPECIES", + "SPECIES", + "FAMILY", + NA, + NA, + "SPECIES", + "SPECIES", + "SPECIES", + "SPECIES", + "GENUS", + NA + ), + bb_acceptedTaxonomicStatus = c( + "ACCEPTED", + "ACCEPTED", + "ACCEPTED", + NA, + NA, + "ACCEPTED", + "ACCEPTED", + "ACCEPTED", + "ACCEPTED", + "ACCEPTED", + NA + ), + verificationKey = c( + 2427091, + 4046493, + 6979, + "2805420,2805363", + NA, + NA, + NA, + NA, + 9260388, + NA, + 3172099 + ), + remarks = c( + "dummy example 1: bb_acceptedName should be updated.", + "dummy example 2: bb_scientificName should be updated.", + "dummy example 3: not used anymore. Set outdated = TRUE.", + "dummy example 4: multiple keys in verificationKey are allowed.", + "dummy example 5: nothing should happen.", + "dummy example 6: datasetKey should not be modified. If new taxa come in + with same name from other checklsits, they should be added as new rows. + Report them as duplicates in duplicates_taxa", + "dummy example 7: datasetKey should not be modified. If new taxa come in + with same name from other checklsits, they should be added as new rows. + Report them as duplicates in duplicates_taxa", + "dummy example 8: outdated synonym. Set outdated = TRUE.", + "dummy example 9: outdated synonym. outdated is already TRUE. No actions.", + "dummy example 10: outdated synonym. Not outdated anymore. Change outdated + back to FALSE.", + "dummy example 11: outdated unmatched taxa. Set outdated = TRUE." + ), + verifiedBy = c( + "Damiano Oldoni", + "Peter Desmet", + "Stijn Van Hoey", + "Tanja Milotic", + NA, + NA, + NA, + NA, + "Lien Reyserhove", + NA, + "Dimitri Brosens" + ), + dateAdded = as.Date( + c( + "2018-07-01", + "2018-07-01", + "2018-07-01", + "2018-07-16", + "2018-07-16", + "2018-07-01", + "2018-11-20", + "2018-11-29", + "2018-12-01", + "2018-12-02", + "2018-12-03" + ) + ), + outdated = c( + FALSE, + FALSE, + FALSE, + FALSE, + FALSE, + FALSE, + FALSE, + FALSE, + TRUE, + TRUE, + FALSE + ) +) + +my_taxa_other_colnames <- + dplyr::rename( + my_taxa, + checklist = datasetKey, + scientific_names = scientificName + ) + +my_verification_other_colnames <- + dplyr::rename( + my_verification, + backbone_scientific_names = bb_scientificName, + backbone_accepted_names = bb_acceptedName, + is_outdated = outdated, + author_verification = verifiedBy + ) + +my_taxa_duplicates <- + my_taxa[1:2,] +my_taxa_duplicates$taxonKey[2] <- my_taxa_duplicates$taxonKey[1] + +my_verification_duplicates <- + my_verification[1:2,] +my_verification_duplicates$taxonKey[2] <- my_verification_duplicates$taxonKey[1] + +my_taxa_nas <- + my_taxa_duplicates +my_taxa_nas$taxonKey[2] <- NA_real_ + +my_verification_nas <- + my_verification_duplicates +my_verification_nas$taxonKey[2] <- NA_real_ + + +context("input_verify_taxa") + +testthat::test_that("taxa is a data frame", { + expect_error( + verify_taxa( + taxa = 3, + verification = my_verification + ), + "taxa is not a data frame" + ) + expect_error( + verify_taxa( + taxa = c("23"), + verification = my_verification + ), + "taxa is not a data frame" + ) +}) + + +testthat::test_that("verification is a data frame", { + expect_error( + verify_taxa( + taxa = my_taxa, + verification = 3 + ), + "verification is not a data frame" + ) + expect_error( + verify_taxa( + taxa = my_taxa, + verification = c("3") + ), + "verification is not a data frame" + ) +}) + + +# no missing taxon keys in both input taxa and verification df (if not NULL) +testthat::test_that("No missing taxon keys in input taxa and verification dfs", { + expect_error( + verify_taxa(taxa = my_taxa_nas, verification = my_verification), + paste("Missing values found in taxon keys of input taxa.", + "Check values in column taxonKey.") + ) + expect_error( + verify_taxa(taxa = my_taxa, verification = my_verification_nas), + paste("Missing values found in taxon keys of input taxa.", + "Check values in column taxonKey.") + ) +}) + +# taxon keys are unique +testthat::test_that("Taxon keys are unique in input taxa and verification dfs", { + expect_error( + verify_taxa(taxa = my_taxa_duplicates, verification = my_verification), + paste("Taxon keys of input taxa must be unique.", + "Check values in column taxonKey.") + ) + expect_error( + verify_taxa(taxa = my_taxa, verification = my_verification_duplicates), + paste("Taxon keys of input taxa must be unique.", + "Check values in column taxonKey.") + ) +}) + + +# different taxa column names +taxa_test1 <- tibble( + bad_checklist_taxonKey_colname = c(123452), + bad_checklist_scientificName_colname = c("Aspius aspius"), + bad_checklist_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", + bad_backbone_taxonKey_colname = c(2360181), + bad_backbone_scientificName_colname = c("Aspius aspius (Linnaeus, 1758)"), + bad_backbone_kingdom_colname = c("Animalia"), + bad_backbone_rank_colname = c("SPECIES"), + bad_backbone_taxonomicStatus_colname = c("SYNONYM"), + bad_backbone_acceptedKey_colname = c(5851603), + bad_backbone_acceptedName_colname = c("Leuciscus aspius (Linnaeus, 1758)") +) + +# missing column +taxa_test2 <- tibble( + taxonKey = c(123452), + scientificName = c("Aspius aspius"), + datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + # bb_acceptedKey is missing + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)") +) + +testthat::test_that("taxa column names are correct", { + expect_error(verify_taxa( + taxa = taxa_test1, + verification = my_verification + ), + paste( + "The following columns of taxa are not present:", + "taxonKey, scientificName, datasetKey, bb_key, bb_scientificName,", + "bb_kingdom, bb_rank, bb_taxonomicStatus, bb_acceptedKey, bb_acceptedName.", + "Did you maybe forget to provide the mapping of columns named differently", + "than the default names?" + ), + fixed = TRUE + ) + expect_error(verify_taxa( + taxa = taxa_test2, + verification = my_verification + ), + paste( + "The following columns of taxa are not present:", + "bb_acceptedKey. Did you maybe forget to provide the mapping of columns", + "named differently than the default names?" + ), + fixed = TRUE + ) +}) + +# inconsistency about unmatched taxa +taxa_test3 <- tibble( + taxonKey = c(123452), + scientificName = c("Aspius aspius"), + datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", + bb_key = c(NA_integer_), + bb_scientificName = c(NA_character_), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + bb_acceptedKey = c(3483948), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)") +) + +testthat::test_that("consistency of 'taxa' about GBIF backbone info columns", { + expect_error( + verify_taxa( + taxa = taxa_test3, + verification = my_verification + ), + "Columns with GBIF Backbone info should be empty for unmatched taxa.", + fixed = TRUE + ) +}) + +# different verification column names +verification_test1 <- tibble( + bad_checklist_taxonKey = c(12341), + bad_checklist_scientificName_colname = c("Aspius aspius"), + bad_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", + bad_backbone_taxonKey_colname = c(2360181), + bad_backbone_scientificName_colname = c("Aspius aspius (Linnaeus, 1758)"), + bad_backbone_kingdom_colname = c("Animalia"), + bad_backbone_rank_colname = c("SPECIES"), + bad_backbone_taxonomicStatus_colname = c("SYNONYM"), + bad_backbone_acceptedKey_colname = c(5851603), + bad_backbone_acceptedName_colname = c("Leuciscus aspius (Linnaeus, 1758)"), + bad_backbone_acceptedKingdom_colname = c("Animalia"), + bad_backbone_acceptedrank_colname = c("SPECIES"), + bad_backbone_acceptedTaxonomicStatus_colname = c("ACCEPTED"), + bad_verificationKey_colname = c(2427091), + bad_remarks_colname = c("dummy example 1: backbone_accepted should be updated"), + bad_verifiedBy_colname = c("Damiano Oldoni"), + bad_dateAdded_colname = c(as.Date("2018-01-01")), + bad_outdated = c(FALSE) +) + +# missing columns +verification_test2 <- tibble( + taxonKey = c(141117238), + scientificName = c("Aspius aspius"), + # datasetKey column missing + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + # bb_kingdom column missing + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + bb_acceptedKey = c(5851603), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), + # bb_acceptedKingdom + bb_acceptedRank = c("SPECIES"), + bb_acceptedTaxonomicStatus = c("ACCEPTED"), + verificationKey = c(2427091), + remarks = c("dummy example 1: backbone_accepted should be updated"), + verifiedBy = c("Dami Oldi"), + # dateAdded column missing + outdated = c(FALSE) +) + +# inconsistency bb_acceptedName - bb_acceptedKey +verification_test3 <- tibble( + taxonKey = c(141117238), + scientificName = c("Aspius aspius"), + datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + bb_acceptedKey = c(NA_integer_), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), + bb_acceptedKingdom = c("Animalia"), + bb_acceptedRank = c("SPECIES"), + bb_acceptedTaxonomicStatus = c("ACCEPTED"), + verificationKey = c(2427091), + remarks = c("dummy example 1: backbone_accepted should be updated"), + verifiedBy = c("Damiano Oldoni"), + dateAdded = c(as.Date("2010-01-01")), + outdated = c(FALSE) +) + +# accepted taxa present (only synonyms and unmatched taxa allowed) +verification_test4 <- tibble( + taxonKey = c(141117238), + scientificName = c("Aspius aspius"), + datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("ACCEPTED"), + bb_acceptedKey = c(5851603), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), + bb_acceptedKingdom = c("Animalia"), + bb_acceptedRank = c("SPECIES"), + bb_acceptedTaxonomicStatus = c("ACCEPTED"), + verificationKey = c(2427091), + remarks = NA_character_, + verifiedBy = NA_character_, + dateAdded = c(as.Date("2010-01-01")), + outdated = c(FALSE) +) + +# outdated must to be TRUE or FALSE. +verification_test5 <- tibble( + taxonKey = c(141117238), + scientificName = c("Aspius aspius"), + datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + bb_acceptedKey = c(5851603), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), + bb_acceptedKingdom = c("Animalia"), + bb_acceptedRank = c("SPECIES"), + bb_acceptedTaxonomicStatus = c("ACCEPTED"), + verificationKey = c(2427091), + remarks = NA_character_, + verifiedBy = NA_character_, + dateAdded = c(as.Date("2010-01-01")), + outdated = c(NA) +) + +# datasetKey should be 36 characters long +verification_test6 <- tibble( + taxonKey = c(141117238), + scientificName = c("Aspius aspius"), + datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92,other stuff"), + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + bb_acceptedKey = c(5851603), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), + bb_acceptedKingdom = c("Animalia"), + bb_acceptedRank = c("SPECIES"), + bb_acceptedTaxonomicStatus = c("ACCEPTED"), + verificationKey = c(2427091), + remarks = NA_character_, + verifiedBy = NA_character_, + dateAdded = c(as.Date("2010-01-01")), + outdated = c(FALSE) +) + +# commas not allowed in datasetKey +verification_test7 <- tibble( + taxonKey = c(141117238), + scientificName = c("Aspius aspius"), + datasetKey = c("e4746398-f7c4-47a1-a474,ae80a4f18e92"), + bb_key = c(2360181), + bb_scientificName = c("Aspius aspius (Linnaeus, 1758)"), + bb_kingdom = c("Animalia"), + bb_rank = c("SPECIES"), + bb_taxonomicStatus = c("SYNONYM"), + bb_acceptedKey = c(5851603), + bb_acceptedName = c("Leuciscus aspius (Linnaeus, 1758)"), + bb_acceptedKingdom = c("Animalia"), + bb_acceptedRank = c("SPECIES"), + bb_acceptedTaxonomicStatus = c("ACCEPTED"), + verificationKey = c(2427091), + remarks = NA_character_, + verifiedBy = NA_character_, + dateAdded = c(as.Date("2010-01-01")), + outdated = c(FALSE) +) + +testthat::test_that("verify_taxa column names are correct", { + expect_error(verify_taxa( + taxa = my_taxa, + verification = verification_test1 + ), + paste( + "The following columns of verification are not present:", + "taxonKey, scientificName, datasetKey, bb_key, bb_scientificName,", + "bb_kingdom, bb_rank, bb_taxonomicStatus,", + "bb_acceptedKey, bb_acceptedName, bb_acceptedKingdom, bb_acceptedRank,", + "bb_acceptedTaxonomicStatus, verificationKey, remarks, verifiedBy,", + "dateAdded, outdated. Did you maybe forget to provide the mapping of", + "columns named differently than the default names?" + ), + fixed = TRUE + ) + expect_error(verify_taxa( + taxa = my_taxa, + verification = verification_test2 + ), + paste( + "The following columns of verification are not present:", + "datasetKey, bb_kingdom, bb_acceptedKingdom, dateAdded.", + "Did you maybe forget to provide the mapping of columns named differently", + "than the default names?" + ), + fixed = TRUE + ) +}) + +testthat::test_that("synonym relations are inconsistent", { + expect_error(verify_taxa( + taxa = my_taxa, + verification = verification_test3 + ), + "bb_acceptedName and bb_acceptedKey should be both NA or both present.", + fixed = TRUE + ) +}) + +testthat::test_that("accepted taxa in verification input", { + expect_error(verify_taxa( + taxa = my_taxa, + verification = verification_test4 + ), + "Only synonyms and unmatched taxa allowed in verification.", + fixed = TRUE + ) +}) + +testthat::test_that("restrictions on input columns of verification", { + expect_error(verify_taxa( + taxa = my_taxa, + verification = verification_test5 + ), + "Only logicals (TRUE/FALSE) allowed in 'outdated' of verification.", + fixed = TRUE + ) +}) + +testthat::test_that("valid datsetKey values", { + expect_error( + verify_taxa( + taxa = my_taxa, + verification = verification_test6 + ), + paste( + "Incorrect datesetKey:", verification_test6$datasetKey, + "Is expected to be 36-character UUID." + ) + ) + expect_error( + verify_taxa( + taxa = my_taxa, + verification = verification_test7 + ), + paste( + "Incorrect datesetKey:", verification_test7$datasetKey, + "Is expected to be 36-character UUID." + ) + ) +}) + +context("output_verify_taxa") + +# output +output1 <- verify_taxa(taxa = my_taxa, verification = my_verification) +output2 <- verify_taxa(taxa = my_taxa) +output3 <- verify_taxa(taxa = my_taxa_vk, verification = my_verification) +output4 <- verify_taxa( + taxa = my_taxa_other_colnames, + verification = my_verification_other_colnames, + datasetKey = "checklist", + scientificName = "scientific_names", + verification_bb_scientificName = "backbone_scientific_names", + verification_bb_acceptedName = "backbone_accepted_names", + verification_outdated = "is_outdated", + verification_verifiedBy = "author_verification" +) +outputs <- list(output1, output2, output3, output4) +testthat::test_that("output structure", { + expect_true(all(purrr::map_lgl(outputs, function(x) { + class(x) == "list" + }))) + expect_true(all(purrr::map_lgl(outputs, function(x) { + length(x) == 3 + }))) + expect_true(all(purrr::map_lgl(outputs, function(x) { + class(x$info) == "list" + }))) + expect_true(length(output1$info) == 8) + expect_true(length(output2$info) == 8) + expect_equivalent(output1$info, output3$info) + expect_true(all()) + expect_true(all(purrr::map_lgl(outputs, function(x) { + is.data.frame(x$taxa) + }))) + expect_equivalent(output1$taxa, output3$taxa) + expect_true( + all(purrr::map_lgl(outputs, function(x) { + is.data.frame(x$verification) + })) + ) + expect_equivalent(output1$verification, output3$verification) + expect_true(all(purrr::map_lgl(output1$info, ~ is.data.frame(.)))) + expect_true(all(purrr::map_lgl(output2$info, ~ is.data.frame(.)))) + expect_true(all(purrr::map_lgl(output1$info, ~ (!"grouped_df" %in% class(.))))) + expect_true(all(purrr::map_lgl(output2$info, ~ (!"grouped_df" %in% class(.))))) + expect_equivalent(output1$info, output3$info) + expect_true( + all(names(output4$verification) == names(my_verification_other_colnames)) + ) + expect_true( + all(purrr::map_lgl( + list( + output4$info$outdated_unmatched_taxa, + output4$info$outdated_synonyms + ), function(x) { + all(names(x) == names(my_verification_other_colnames)) + } + )) + ) + expect_true(all(names(output4$info$new_synonyms) == + names(my_verification_other_colnames))) + expect_true(all(names(output4$info$new_unmatched_taxa) == + names(my_verification_other_colnames))) + expect_true( + all(names(output4$info$updated_bb_scientificName) == + c( + "taxonKey", "bb_key", "bb_acceptedKey", + "backbone_scientific_names", "updated_backbone_scientific_names" + )) + ) + expect_true( + all(names(output4$info$updated_bb_acceptedName) == + c( + "taxonKey", "bb_key", "bb_acceptedKey", + "backbone_accepted_names", "updated_backbone_accepted_names" + )) + ) +}) + +testthat::test_that("consitency input - output", { + expect_true(nrow(output1$taxa) == nrow(my_taxa)) + expect_true(nrow(output2$taxa) == nrow(my_taxa)) + expect_true(ncol(output1$taxa) == ncol(my_taxa) + 1) + expect_true(ncol(output2$taxa) == ncol(my_taxa) + 1) + expect_true(all(output1$taxa$taxonKey == my_taxa$taxonKey)) + expect_true(all(output2$taxa$taxonKey == my_taxa$taxonKey)) + expect_true( + nrow(output1$verification) == + nrow(my_verification) + + nrow(output1$info$new_synonyms) + + nrow(output1$info$new_unmatched_taxa) + ) + expect_true( + nrow(output2$verification) == + nrow(output2$info$new_synonyms) + + nrow(output2$info$new_unmatched_taxa) + ) + expect_true(nrow(output1$verification %>% + filter(!is.na(verificationKey))) <= + nrow(output1$info$check_verificationKey)) + expect_true( + nrow(my_taxa %>% + filter(bb_taxonomicStatus %in% c("ACCEPTED", "DOUBTFUL"))) == + nrow(output2$taxa %>% + filter(!is.na(verificationKey))) + ) + expect_true(all(output1$info$new_synonyms$outdated == FALSE)) + expect_true(all(output2$info$new_synonyms$outdated == FALSE)) + expect_true(all(output1$info$new_unmatched_taxa$outdated == FALSE)) + expect_true(all(output2$info$new_unmatched_taxa$outdated == FALSE)) + expect_true(all(output2$verification$outdated == FALSE)) + expect_true(all(output1$info$outdated_unmatched_taxa$outdated == TRUE)) + expect_true(all(output2$info$outdated_unmatched_taxa$outdated == TRUE)) + expect_true(all(output1$info$outdated_synonyms$outdated == TRUE)) + expect_true(all(output2$info$outdated_synonyms$outdated == TRUE)) + expect_true( + nrow(output1$info$outdated_synonyms) + + nrow(output1$info$outdated_unmatched_taxa) == + nrow(dplyr::filter(output1$verification, outdated == TRUE)) + ) + expect_true( + nrow(output2$info$outdated_synonyms) + + nrow(output2$info$outdated_unmatched_taxa) == + nrow(dplyr::filter(output2$verification, outdated == TRUE)) + ) +}) + +col_types_verification <- readr::cols( + taxonKey = readr::col_double(), + scientificName = readr::col_character(), + datasetKey = readr::col_character(), + bb_key = readr::col_double(), + bb_scientificName = readr::col_character(), + bb_kingdom = readr::col_character(), + bb_rank = readr::col_character(), + bb_taxonomicStatus = readr::col_character(), + bb_acceptedKey = readr::col_double(), + bb_acceptedName = readr::col_character(), + bb_acceptedKingdom = readr::col_character(), + bb_acceptedRank = readr::col_character(), + bb_acceptedTaxonomicStatus = readr::col_character(), + verificationKey = readr::col_character(), + remarks = readr::col_character(), + verifiedBy = readr::col_character(), + dateAdded = readr::col_date(format = "%Y-%m-%d"), + outdated = readr::col_logical() +) + +col_types_output_taxa <- readr::cols( + taxonKey = readr::col_double(), + scientificName = readr::col_character(), + datasetKey = readr::col_character(), + bb_key = readr::col_double(), + bb_scientificName = readr::col_character(), + bb_kingdom = readr::col_character(), + bb_rank = readr::col_character(), + bb_taxonomicStatus = readr::col_character(), + bb_acceptedName = readr::col_character(), + bb_acceptedKey = readr::col_double(), + verificationKey = readr::col_character(), + taxonID = readr::col_character() +) + +col_types_updated_names <- readr::cols( + taxonKey = readr::col_double(), + bb_key = readr::col_double(), + bb_acceptedKey = readr::col_double() +) + +output1_taxa <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_taxa.tsv" + ), + col_types = col_types_output_taxa + ) +output2_taxa <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_taxa.tsv" + ), + col_types = col_types_output_taxa + ) + +output1_verification <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_verification.tsv" + ), + col_types = col_types_verification + ) +output2_verification <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_verification.tsv" + ), + col_types = col_types_verification + ) + +output1_new_synonyms <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_new_synonyms.tsv" + ), + col_types = col_types_verification + ) +output2_new_synonyms <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_new_synonyms.tsv" + ), + col_types = col_types_verification + ) + +output1_new_unmatched_taxa <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_new_unmatched_taxa.tsv" + ), + col_types = col_types_verification + ) +output2_new_unmatched_taxa <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_new_unmatched_taxa.tsv" + ), + col_types = col_types_verification + ) + +output1_outdated_unmatched_taxa <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_outdated_unmatched_taxa.tsv" + ), + col_types = col_types_verification + ) + +output2_outdated_unmatched_taxa <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_outdated_unmatched_taxa.tsv" + ), + col_types = col_types_verification + ) + +output1_outdated_synonyms <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_outdated_synonyms.tsv" + ), + col_types = col_types_verification + ) + +output2_outdated_synonyms <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_outdated_synonyms.tsv" + ), + col_types = col_types_verification + ) + +output1_updated_bb_scientificName <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_updated_bb_scientificName.tsv" + ), + col_types = col_types_updated_names + ) + +output2_updated_bb_scientificName <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_updated_bb_scientificName.tsv" + ), + col_types = col_types_updated_names + ) + +output1_updated_bb_acceptedName <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_updated_bb_acceptedName.tsv" + ), + col_types = col_types_updated_names + ) + +output2_updated_bb_acceptedName <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_updated_bb_acceptedName.tsv" + ), + col_types = col_types_updated_names + ) + +output1_duplicates <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output1_duplicates.tsv" + ), + col_types = readr::cols(n = readr::col_integer()) + ) +output2_duplicates <- + readr::read_tsv( + file = paste0( + "./data_test_output_verify_taxa/", + "output2_duplicates.tsv" + ), + col_types = readr::cols(n = readr::col_integer()) + ) + +testthat::test_that("output data.frames are correct", { + expect_equivalent(output1$taxa, output1_taxa) + expect_equivalent(output2$taxa, output2_taxa) + # output4 with default column names should be exactly equal to output1 + output4_default_names_verification <- + output4$verification %>% + dplyr::rename( + bb_scientificName = backbone_scientific_names, + bb_acceptedName = backbone_accepted_names, + outdated = is_outdated, + verifiedBy = author_verification + ) + expect_equivalent(output1$verification, output4_default_names_verification) + expect_equivalent( + output1$verification %>% + # new synonyms and unmatched get date of today + dplyr::select(-dateAdded), + output1_verification %>% + # new synonyms and unmatched got paste date + dplyr::select(-dateAdded) + ) + expect_equivalent( + output2$verification %>% + # new synonyms and unmatched get date of today + dplyr::select(-dateAdded), + output2_verification %>% + # new synonyms and unmatched got paste date + dplyr::select(-dateAdded) + ) + + output4_default_names_new_synonyms <- + output4$info$new_synonyms %>% + dplyr::rename( + bb_scientificName = backbone_scientific_names, + bb_acceptedName = backbone_accepted_names, + outdated = is_outdated, + verifiedBy = author_verification + ) + expect_equivalent( + output1$info$new_synonyms, + output4_default_names_new_synonyms + ) + expect_equivalent( + output1$info$new_synonyms %>% + # new synonyms get date of today + dplyr::select(-dateAdded), + output1_new_synonyms %>% + # unmatched got past date + dplyr::select(-dateAdded) + ) + expect_equivalent( + output2$info$new_synonyms %>% + # new synonyms get date of today + dplyr::select(-dateAdded), + output2_new_synonyms %>% + # unmatched got past date + dplyr::select(-dateAdded) + ) + + output4_default_names_new_unmatched_taxa <- + output4$info$new_unmatched_taxa %>% + dplyr::rename( + bb_scientificName = backbone_scientific_names, + bb_acceptedName = backbone_accepted_names, + outdated = is_outdated, + verifiedBy = author_verification + ) + expect_equivalent( + output1$info$new_unmatched_taxa, + output4_default_names_new_unmatched_taxa + ) + expect_equivalent( + output1$info$new_unmatched_taxa %>% + # unmatched get date of today + dplyr::select(-dateAdded), + output1_new_unmatched_taxa %>% + # unmatched got past date + dplyr::select(-dateAdded) + ) + expect_equivalent( + output2$info$new_unmatched_taxa %>% + # unmatched get date of today + dplyr::select(-dateAdded), + output2_new_unmatched_taxa %>% + # unmatched got past date + dplyr::select(-dateAdded) + ) + + output4_default_names_outdated_unmatched_taxa <- + output4$info$outdated_unmatched_taxa %>% + dplyr::rename( + bb_scientificName = backbone_scientific_names, + bb_acceptedName = backbone_accepted_names, + outdated = is_outdated, + verifiedBy = author_verification + ) + expect_equivalent( + output1$info$outdated_unmatched_taxa, + output4_default_names_outdated_unmatched_taxa + ) + expect_equivalent( + output1$info$outdated_unmatched_taxa, + output1_outdated_unmatched_taxa + ) + expect_equivalent( + output2$info$outdated_unmatched_taxa, + output2_outdated_unmatched_taxa + ) + + output4_default_names_outdated_synonyms <- + output4$info$outdated_synonyms %>% + dplyr::rename( + bb_scientificName = backbone_scientific_names, + bb_acceptedName = backbone_accepted_names, + outdated = is_outdated, + verifiedBy = author_verification + ) + expect_equivalent( + output1$info$outdated_synonyms, + output4_default_names_outdated_synonyms + ) + expect_equivalent( + output1$info$outdated_synonyms, + output1_outdated_synonyms + ) + expect_equivalent( + output2$info$outdated_synonyms, + output2_outdated_synonyms + ) + + output4_default_names_updated_bb_scientificName <- + output4$info$updated_bb_scientificName %>% + dplyr::rename( + bb_scientificName = backbone_scientific_names, + updated_bb_scientificName = updated_backbone_scientific_names + ) + expect_equivalent( + output1$info$updated_bb_scientificName, + output4_default_names_updated_bb_scientificName + ) + expect_equivalent( + output1$info$updated_bb_scientificName, + output1_updated_bb_scientificName + ) + expect_equivalent( + output2$info$updated_bb_scientificName, + output2_updated_bb_scientificName + ) + + output4_default_names_updated_bb_acceptedName <- + output4$info$updated_bb_acceptedName %>% + dplyr::rename( + bb_acceptedName = backbone_accepted_names, + updated_bb_acceptedName = updated_backbone_accepted_names + ) + expect_equivalent( + output1$info$updated_bb_acceptedName, + output4_default_names_updated_bb_acceptedName + ) + expect_equivalent( + output1$info$updated_bb_acceptedName, + output1_updated_bb_acceptedName + ) + expect_equivalent( + output2$info$updated_bb_acceptedName, + output2_updated_bb_acceptedName + ) + + output4_default_names_duplicates <- + output4$info$duplicates %>% + dplyr::rename(bb_scientificName = backbone_scientific_names) + expect_equivalent( + output1$info$duplicates, + output4_default_names_duplicates + ) + expect_equivalent(output1$info$duplicates, output1_duplicates) + expect_equivalent(output2$info$duplicates, output2_duplicates) + # check_verification_key df no tested here: output of another TrIAS function + # only check 0 rows with output2 + expect_true(nrow(output2$info$check_verificationKey) == 0) +}) From 47f978f8fa2233b6194087903f93c32d5bd7c62e Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 17:01:02 +0200 Subject: [PATCH 57/63] set dplyr::tibble instead of trias::tibble in test --- tests/testthat/test-verify_taxa.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-verify_taxa.R b/tests/testthat/test-verify_taxa.R index bc716247..17ffcf5a 100644 --- a/tests/testthat/test-verify_taxa.R +++ b/tests/testthat/test-verify_taxa.R @@ -1,6 +1,6 @@ # Define inputs -my_taxa <- trias::tibble( +my_taxa <- dplyr::tibble( taxonKey = c( 141117238, 113794952, @@ -182,7 +182,7 @@ my_taxa <- trias::tibble( # Add column verificationKey which will be overwritten by verify_taxa my_taxa_vk <- dplyr::mutate(my_taxa, verificationKey = 1) -my_verification <- trias::tibble( +my_verification <- dplyr::tibble( taxonKey = c( 113794952, 141264857, @@ -527,7 +527,7 @@ testthat::test_that("Taxon keys are unique in input taxa and verification dfs", # different taxa column names -taxa_test1 <- tibble( +taxa_test1 <- dplyr::tibble( bad_checklist_taxonKey_colname = c(123452), bad_checklist_scientificName_colname = c("Aspius aspius"), bad_checklist_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -541,7 +541,7 @@ taxa_test1 <- tibble( ) # missing column -taxa_test2 <- tibble( +taxa_test2 <- dplyr::tibble( taxonKey = c(123452), scientificName = c("Aspius aspius"), datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -582,7 +582,7 @@ testthat::test_that("taxa column names are correct", { }) # inconsistency about unmatched taxa -taxa_test3 <- tibble( +taxa_test3 <- dplyr::tibble( taxonKey = c(123452), scientificName = c("Aspius aspius"), datasetKey = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -607,7 +607,7 @@ testthat::test_that("consistency of 'taxa' about GBIF backbone info columns", { }) # different verification column names -verification_test1 <- tibble( +verification_test1 <- dplyr::tibble( bad_checklist_taxonKey = c(12341), bad_checklist_scientificName_colname = c("Aspius aspius"), bad_datasetKey_colname = "e4746398-f7c4-47a1-a474-ae80a4f18e92", @@ -629,7 +629,7 @@ verification_test1 <- tibble( ) # missing columns -verification_test2 <- tibble( +verification_test2 <- dplyr::tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), # datasetKey column missing @@ -651,7 +651,7 @@ verification_test2 <- tibble( ) # inconsistency bb_acceptedName - bb_acceptedKey -verification_test3 <- tibble( +verification_test3 <- dplyr::tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), @@ -673,7 +673,7 @@ verification_test3 <- tibble( ) # accepted taxa present (only synonyms and unmatched taxa allowed) -verification_test4 <- tibble( +verification_test4 <- dplyr::tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), @@ -695,7 +695,7 @@ verification_test4 <- tibble( ) # outdated must to be TRUE or FALSE. -verification_test5 <- tibble( +verification_test5 <- dplyr::tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92"), @@ -717,7 +717,7 @@ verification_test5 <- tibble( ) # datasetKey should be 36 characters long -verification_test6 <- tibble( +verification_test6 <- dplyr::tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474-ae80a4f18e92,other stuff"), @@ -739,7 +739,7 @@ verification_test6 <- tibble( ) # commas not allowed in datasetKey -verification_test7 <- tibble( +verification_test7 <- dplyr::tibble( taxonKey = c(141117238), scientificName = c("Aspius aspius"), datasetKey = c("e4746398-f7c4-47a1-a474,ae80a4f18e92"), From b301f01367a9248a36f3fe81e06d2fd49e7ba7a7 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 17:19:43 +0200 Subject: [PATCH 58/63] Solve typo in markdown syntax for link in documentation ( ) instead of [ ] --- R/indicator_native_range_year.R | 2 +- man/indicator_native_range_year.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 39795eb3..1969c9fa 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -2,7 +2,7 @@ #' and year of introduction #' #' Based on -#' [countYearProvince][https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R] +#' [countYearProvince](https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R) #' plot from reporting - rshiny - grofwildjacht #' @param data input data.frame. #' @param years (numeric) vector years we are interested to. If \code{NULL} diff --git a/man/indicator_native_range_year.Rd b/man/indicator_native_range_year.Rd index 3d70c738..d2c78c60 100644 --- a/man/indicator_native_range_year.Rd +++ b/man/indicator_native_range_year.Rd @@ -49,6 +49,6 @@ introduced from the native range for a given year. (n/total)*100} } } } } \description{ Based on -\link[=https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R]{countYearProvince} +\href{https://github.com/inbo/reporting-rshiny-grofwildjacht/blob/exoten/reporting-grofwild/R/countYearProvince.R}{countYearProvince} plot from reporting - rshiny - grofwildjacht } From 4ce92ef0089cfdadc9e565ce70f393d0b932b00f Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Mon, 14 Sep 2020 17:32:08 +0200 Subject: [PATCH 59/63] Apply styler::style_pg() --- R/gbif_get_taxa.R | 7 +- R/get_table_pathways.R | 12 +-- R/indicator_native_range_year.R | 14 ++-- R/verify_taxa.R | 55 ++++++++----- .../testthat/test-output_get_table_pathways.R | 7 +- tests/testthat/test-verify_taxa.R | 80 ++++++++++--------- 6 files changed, 101 insertions(+), 74 deletions(-) diff --git a/R/gbif_get_taxa.R b/R/gbif_get_taxa.R index 8aa564b5..63152b48 100644 --- a/R/gbif_get_taxa.R +++ b/R/gbif_get_taxa.R @@ -167,14 +167,15 @@ gbif_get_taxa <- function( checklist_keys, ~ name_lookup( datasetKey = ., origin = origins, - limit = maxlimit)$data + limit = maxlimit + )$data ) } else { checklist_taxa <- map_dfr(checklist_keys, ~ name_lookup( datasetKey = ., - limit = maxlimit)$data - ) + limit = maxlimit + )$data) } checklist_taxa <- diff --git a/R/get_table_pathways.R b/R/get_table_pathways.R index 0ef1961d..187ab8ce 100644 --- a/R/get_table_pathways.R +++ b/R/get_table_pathways.R @@ -268,14 +268,16 @@ get_table_pathways <- function(df, } # Join pathways and samples together if (nrow(pathway_data) == 0) { - tibble(pathway_level1 = character(0), - pathway_level2 = character(0), - n = integer(0), - examples = character(0)) + tibble( + pathway_level1 = character(0), + pathway_level2 = character(0), + n = integer(0), + examples = character(0) + ) } else { pathway_data %>% left_join(samples, - by = c("pathway_level1", "pathway_level2") + by = c("pathway_level1", "pathway_level2") ) %>% select(-.data$size_sample) %>% ungroup() diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 1969c9fa..54e7a5b6 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -14,7 +14,7 @@ #' @param y_lab character string, label of the y-axis. Default: "number of alien #' species". #' @param relative (logical) if TRUE, each bar is standardised before stacking -#' @param first_observed (character) Name of the column in \code{data} containing temporal information about introduction of the alien species. Expressed as years. +#' @param first_observed (character) Name of the column in \code{data} containing temporal information about introduction of the alien species. Expressed as years. #' @return list with: \itemize{ \item{'static_plot': }{ggplot object, for a #' given species the observed number per year and per native range is plotted #' in a stacked bar chart} \item{'interactive_plot': }{plotly object, for a @@ -45,7 +45,7 @@ indicator_native_range_year <- function(data, years = NULL, data <- data %>% rename_at(vars(first_observed), ~"first_observed") - + if (is.null(years)) { years <- sort(unique(data$first_observed)) } @@ -100,10 +100,12 @@ indicator_native_range_year <- function(data, years = NULL, text <- paste0(summaryData$location, "
", summaryData$value) } - pl <- ggplot(data = summaryData, aes(x = .data$first_observed, - y = .data$value, - fill = .data$location, - text = text)) + + pl <- ggplot(data = summaryData, aes( + x = .data$first_observed, + y = .data$value, + fill = .data$location, + text = text + )) + geom_bar(position = position, stat = "identity") if (relative == TRUE) { diff --git a/R/verify_taxa.R b/R/verify_taxa.R index 4a7769e4..f36dc427 100644 --- a/R/verify_taxa.R +++ b/R/verify_taxa.R @@ -625,20 +625,26 @@ verify_taxa <- function(taxa, # Check that taxon keys are all set up, no NAs present in input taxa assertthat::assert_that(all(!is.na(taxa[[taxonKey]])), - msg = sprintf( - paste0("Missing values found in taxon keys of input ", - "taxa. Check values in column %s."), - taxonKey) + msg = sprintf( + paste0( + "Missing values found in taxon keys of input ", + "taxa. Check values in column %s." + ), + taxonKey + ) ) - + # Check that taxon keys are unique in taxa assertthat::assert_that(nrow(taxa) == length(unique(taxa[[taxonKey]])), - msg = sprintf( - paste0("Taxon keys of input taxa must be unique. ", - "Check values in column %s."), - taxonKey) - ) - + msg = sprintf( + paste0( + "Taxon keys of input taxa must be unique. ", + "Check values in column %s." + ), + taxonKey + ) + ) + # Convert to default column names taxa <- taxa %>% @@ -760,20 +766,27 @@ verify_taxa <- function(taxa, # Check that taxon keys are all set up, no NAs present in verification df assertthat::assert_that(all(!is.na(verification[[verification_taxonKey]])), - msg = sprintf( - paste0("Missing values found in taxon keys of input ", - "taxa. Check values in column %s."), - verification_taxonKey) + msg = sprintf( + paste0( + "Missing values found in taxon keys of input ", + "taxa. Check values in column %s." + ), + verification_taxonKey + ) ) - + # Check that taxon keys are unique in verification df assertthat::assert_that( nrow(verification) == length(unique(verification[[verification_taxonKey]])), - msg = sprintf(paste0("Taxon keys of input taxa must be unique. ", - "Check values in column %s."), - taxonKey) + msg = sprintf( + paste0( + "Taxon keys of input taxa must be unique. ", + "Check values in column %s." + ), + taxonKey + ) ) - + # Convert to standard column names verification <- verification %>% @@ -1230,7 +1243,7 @@ verify_taxa <- function(taxa, bind_rows(not_to_verify_taxa) # set same order as in input df taxa taxa <- - ordered_taxon_keys %>% + ordered_taxon_keys %>% left_join(taxa, by = "taxonKey") # Split outdated_taxa in outdated_unmatched_taxa and outdated_synonyms diff --git a/tests/testthat/test-output_get_table_pathways.R b/tests/testthat/test-output_get_table_pathways.R index 7e9fdfe4..a8d20320 100644 --- a/tests/testthat/test-output_get_table_pathways.R +++ b/tests/testthat/test-output_get_table_pathways.R @@ -85,11 +85,12 @@ input_test_df_large <- read.delim( "input_data_pathways.tsv" ), sep = "\t", - stringsAsFactors = FALSE) %>% - as_tibble + stringsAsFactors = FALSE +) %>% + as_tibble() # Output basic usage : default values for all params -output_test_df_basic <-tibble( +output_test_df_basic <- tibble( pathway_level1 = c("contaminant", "unknown"), pathway_level2 = c("animal_parasite", "unknown"), n = as.integer(c(2, 3)), diff --git a/tests/testthat/test-verify_taxa.R b/tests/testthat/test-verify_taxa.R index 17ffcf5a..e1c369ad 100644 --- a/tests/testthat/test-verify_taxa.R +++ b/tests/testthat/test-verify_taxa.R @@ -1,4 +1,4 @@ -# Define inputs +# Define inputs my_taxa <- dplyr::tibble( taxonKey = c( @@ -443,11 +443,11 @@ my_verification_other_colnames <- ) my_taxa_duplicates <- - my_taxa[1:2,] + my_taxa[1:2, ] my_taxa_duplicates$taxonKey[2] <- my_taxa_duplicates$taxonKey[1] my_verification_duplicates <- - my_verification[1:2,] + my_verification[1:2, ] my_verification_duplicates$taxonKey[2] <- my_verification_duplicates$taxonKey[1] my_taxa_nas <- @@ -501,13 +501,17 @@ testthat::test_that("verification is a data frame", { testthat::test_that("No missing taxon keys in input taxa and verification dfs", { expect_error( verify_taxa(taxa = my_taxa_nas, verification = my_verification), - paste("Missing values found in taxon keys of input taxa.", - "Check values in column taxonKey.") + paste( + "Missing values found in taxon keys of input taxa.", + "Check values in column taxonKey." + ) ) expect_error( verify_taxa(taxa = my_taxa, verification = my_verification_nas), - paste("Missing values found in taxon keys of input taxa.", - "Check values in column taxonKey.") + paste( + "Missing values found in taxon keys of input taxa.", + "Check values in column taxonKey." + ) ) }) @@ -515,13 +519,17 @@ testthat::test_that("No missing taxon keys in input taxa and verification dfs", testthat::test_that("Taxon keys are unique in input taxa and verification dfs", { expect_error( verify_taxa(taxa = my_taxa_duplicates, verification = my_verification), - paste("Taxon keys of input taxa must be unique.", - "Check values in column taxonKey.") + paste( + "Taxon keys of input taxa must be unique.", + "Check values in column taxonKey." ) + ) expect_error( verify_taxa(taxa = my_taxa, verification = my_verification_duplicates), - paste("Taxon keys of input taxa must be unique.", - "Check values in column taxonKey.") + paste( + "Taxon keys of input taxa must be unique.", + "Check values in column taxonKey." + ) ) }) @@ -757,7 +765,7 @@ verification_test7 <- dplyr::tibble( remarks = NA_character_, verifiedBy = NA_character_, dateAdded = c(as.Date("2010-01-01")), - outdated = c(FALSE) + outdated = c(FALSE) ) testthat::test_that("verify_taxa column names are correct", { @@ -903,22 +911,22 @@ testthat::test_that("output structure", { )) ) expect_true(all(names(output4$info$new_synonyms) == - names(my_verification_other_colnames))) + names(my_verification_other_colnames))) expect_true(all(names(output4$info$new_unmatched_taxa) == - names(my_verification_other_colnames))) + names(my_verification_other_colnames))) expect_true( all(names(output4$info$updated_bb_scientificName) == - c( - "taxonKey", "bb_key", "bb_acceptedKey", - "backbone_scientific_names", "updated_backbone_scientific_names" - )) + c( + "taxonKey", "bb_key", "bb_acceptedKey", + "backbone_scientific_names", "updated_backbone_scientific_names" + )) ) expect_true( all(names(output4$info$updated_bb_acceptedName) == - c( - "taxonKey", "bb_key", "bb_acceptedKey", - "backbone_accepted_names", "updated_backbone_accepted_names" - )) + c( + "taxonKey", "bb_key", "bb_acceptedKey", + "backbone_accepted_names", "updated_backbone_accepted_names" + )) ) }) @@ -932,22 +940,22 @@ testthat::test_that("consitency input - output", { expect_true( nrow(output1$verification) == nrow(my_verification) + - nrow(output1$info$new_synonyms) + - nrow(output1$info$new_unmatched_taxa) + nrow(output1$info$new_synonyms) + + nrow(output1$info$new_unmatched_taxa) ) expect_true( nrow(output2$verification) == nrow(output2$info$new_synonyms) + - nrow(output2$info$new_unmatched_taxa) + nrow(output2$info$new_unmatched_taxa) ) expect_true(nrow(output1$verification %>% - filter(!is.na(verificationKey))) <= - nrow(output1$info$check_verificationKey)) + filter(!is.na(verificationKey))) <= + nrow(output1$info$check_verificationKey)) expect_true( nrow(my_taxa %>% - filter(bb_taxonomicStatus %in% c("ACCEPTED", "DOUBTFUL"))) == + filter(bb_taxonomicStatus %in% c("ACCEPTED", "DOUBTFUL"))) == nrow(output2$taxa %>% - filter(!is.na(verificationKey))) + filter(!is.na(verificationKey))) ) expect_true(all(output1$info$new_synonyms$outdated == FALSE)) expect_true(all(output2$info$new_synonyms$outdated == FALSE)) @@ -1198,7 +1206,7 @@ testthat::test_that("output data.frames are correct", { # new synonyms and unmatched got paste date dplyr::select(-dateAdded) ) - + output4_default_names_new_synonyms <- output4$info$new_synonyms %>% dplyr::rename( @@ -1227,7 +1235,7 @@ testthat::test_that("output data.frames are correct", { # unmatched got past date dplyr::select(-dateAdded) ) - + output4_default_names_new_unmatched_taxa <- output4$info$new_unmatched_taxa %>% dplyr::rename( @@ -1256,7 +1264,7 @@ testthat::test_that("output data.frames are correct", { # unmatched got past date dplyr::select(-dateAdded) ) - + output4_default_names_outdated_unmatched_taxa <- output4$info$outdated_unmatched_taxa %>% dplyr::rename( @@ -1277,7 +1285,7 @@ testthat::test_that("output data.frames are correct", { output2$info$outdated_unmatched_taxa, output2_outdated_unmatched_taxa ) - + output4_default_names_outdated_synonyms <- output4$info$outdated_synonyms %>% dplyr::rename( @@ -1298,7 +1306,7 @@ testthat::test_that("output data.frames are correct", { output2$info$outdated_synonyms, output2_outdated_synonyms ) - + output4_default_names_updated_bb_scientificName <- output4$info$updated_bb_scientificName %>% dplyr::rename( @@ -1317,7 +1325,7 @@ testthat::test_that("output data.frames are correct", { output2$info$updated_bb_scientificName, output2_updated_bb_scientificName ) - + output4_default_names_updated_bb_acceptedName <- output4$info$updated_bb_acceptedName %>% dplyr::rename( @@ -1336,7 +1344,7 @@ testthat::test_that("output data.frames are correct", { output2$info$updated_bb_acceptedName, output2_updated_bb_acceptedName ) - + output4_default_names_duplicates <- output4$info$duplicates %>% dplyr::rename(bb_scientificName = backbone_scientific_names) From e500397102f8eb1ed693ef884df297432ac87535 Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 15 Sep 2020 11:32:55 +0200 Subject: [PATCH 60/63] add xlab, ylab and title to static plot #64 --- R/indicator_native_range_year.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 54e7a5b6..d9d225cc 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -28,7 +28,7 @@ #' introduced from the native range for a given year. (n/total)*100} } } } #' @export #' @importFrom reshape2 melt -#' @importFrom ggplot2 ggplot geom_bar scale_y_continuous +#' @importFrom ggplot2 ggplot geom_bar scale_y_continuous xlab ylab ggtitle #' @importFrom plotly ggplotly layout #' @importFrom scales percent_format #' @importFrom dplyr %>% mutate group_by case_when rename_at @@ -106,7 +106,10 @@ indicator_native_range_year <- function(data, years = NULL, fill = .data$location, text = text )) + - geom_bar(position = position, stat = "identity") + geom_bar(position = position, stat = "identity") + + xlab(x_lab) + + ylab(y_lab) + + ggtitle(text) if (relative == TRUE) { pl <- pl + scale_y_continuous(labels = percent_format()) From f68ac0aae590fd91279e2e9fd783d31ae64588c4 Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 15 Sep 2020 11:35:47 +0200 Subject: [PATCH 61/63] Remove title #64 --- R/indicator_native_range_year.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index d9d225cc..09a04997 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -108,8 +108,7 @@ indicator_native_range_year <- function(data, years = NULL, )) + geom_bar(position = position, stat = "identity") + xlab(x_lab) + - ylab(y_lab) + - ggtitle(text) + ylab(y_lab) if (relative == TRUE) { pl <- pl + scale_y_continuous(labels = percent_format()) From 261033497309c934430c132669dda47539371d6f Mon Sep 17 00:00:00 2001 From: SanderDevisscher Date: Tue, 15 Sep 2020 11:42:02 +0200 Subject: [PATCH 62/63] =?UTF-8?q?add=2090=C2=B0=20angle=20axis=20text=20fo?= =?UTF-8?q?r=20static=20plot?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit #64 --- R/indicator_native_range_year.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/indicator_native_range_year.R b/R/indicator_native_range_year.R index 09a04997..0eb21c22 100644 --- a/R/indicator_native_range_year.R +++ b/R/indicator_native_range_year.R @@ -28,7 +28,7 @@ #' introduced from the native range for a given year. (n/total)*100} } } } #' @export #' @importFrom reshape2 melt -#' @importFrom ggplot2 ggplot geom_bar scale_y_continuous xlab ylab ggtitle +#' @importFrom ggplot2 ggplot geom_bar scale_y_continuous xlab ylab theme element_text #' @importFrom plotly ggplotly layout #' @importFrom scales percent_format #' @importFrom dplyr %>% mutate group_by case_when rename_at @@ -108,7 +108,8 @@ indicator_native_range_year <- function(data, years = NULL, )) + geom_bar(position = position, stat = "identity") + xlab(x_lab) + - ylab(y_lab) + ylab(y_lab) + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) if (relative == TRUE) { pl <- pl + scale_y_continuous(labels = percent_format()) From 43a5c8492f6079b730f8243a6827a1f5604105c4 Mon Sep 17 00:00:00 2001 From: damianooldoni Date: Wed, 16 Sep 2020 09:23:04 +0200 Subject: [PATCH 63/63] Remove remote installation of rgbif --- DESCRIPTION | 2 -- 1 file changed, 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4f20f82e..5cb101ad 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,8 +41,6 @@ Imports: Suggests: knitr, testthat -Remotes: - ropensci/rgbif LazyData: true Encoding: UTF-8 VignetteBuilder: knitr