Add indicator native range year

R/indicator_native_range_year.R

@@ -0,0 +1,117 @@
+#' 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")} 
+#' @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{
+#' \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, 
+                                 x_lab = "year",
+                                 y_lab = "alien species",
+                                 relative = FALSE) {
+
+  require(plotly)
+  require(data.table)
+
+  type <- match.arg(type)
+
+  if (is.null(jaartallen))
+    jaartallen <- 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$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")
+  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$locatie <- as.factor(summaryData$locatie)
+  summaryData$locatie <- factor(summaryData$locatie, levels = rev(levels(summaryData$locatie)))
+  summaryData$first_observed <- as.factor(summaryData$first_observed)
+
+
+
+  # Create plot
+
+  if(relative == TRUE){
+    position <- "fill"
+    text <- paste0(summaryData$locatie, "<br>", summaryData$perc, "%")
+  }else{
+    position <- "stack"
+    text <- paste0(summaryData$locatie, "<br>", summaryData$value)
+  }
+
+  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, 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"] <- "aantal"
+  names(summaryData)[names(summaryData) == "first_observed"] <- "jaar"
+  names(summaryData)[names(summaryData) == "locatie"] <- "regio van oorsprong"
+
+  return(list(plot = pl, data = summaryData))
+
+}

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(1990:2019), type = "native_range", relative = FALSE)