Merge pull request #20 from brazil-data-cube/b-0.8

Merge B-0.8 into master

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rwlts
 Type: Package
 Title: Web Land Trajectory Service R Client
-Version: 0.6.0
+Version: 0.8.0
 Authors@R:
     c(person("Brazil Data Cube Team",
             email = "[email protected]",
@@ -15,14 +15,14 @@ Imports:
   httr,
   tibble,
   magrittr,
-  dplyr,
+  dplyr
+Suggests:
   ggplot2,
-  ggalluvial
+  ggalluvial,
+  covr,
+  vcr,
+  testthat
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
-Suggests:
-    covr,
-    vcr,
-    testthat
+RoxygenNote: 7.1.2

NAMESPACE

@@ -1,21 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(plot,alluvial)
+S3method(plot,wlts)
 export("%>%")
 export(describe_collection)
 export(get_trajectory)
 export(list_collections)
-export(plot_sankey)
 importFrom(dplyr,arrange)
 importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,ungroup)
-importFrom(ggalluvial,geom_flow)
-importFrom(ggalluvial,geom_stratum)
-importFrom(ggplot2,aes_string)
-importFrom(ggplot2,facet_wrap)
-importFrom(ggplot2,geom_text)
-importFrom(ggplot2,ggplot)
-importFrom(ggplot2,scale_y_continuous)
-importFrom(ggplot2,stat)
-importFrom(ggplot2,theme)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,3 +1,10 @@
+# Version 0.8.0 (2021-10-04)
+
+- Change `sankey` to `alluvial`
+- Collection can be provide as character vector
+- Implement plot using s3 class
+- Change version
+
 # Version 0.6.0 (2021-09-03)
 
 - Add Sankey Plot

R/plot.R

@@ -1,43 +1,62 @@
-#' @title Sankey Plot
+#' @title Plots for rwlts package
 #'
-#' @description Visualization method based on the sankey graph. In which the
-#' changes between each class are presented on the time axis.
+#' @name plot.wlts
 #'
-#' @param wtls_tibble           a \code{tibble} object from class \code{wlts}.
-#' @param show_count_transition a \code{logical} parameter, if true, is added
-#' the number of points on each bar. The default value is FALSE.
+#' @description A set of visualization methods for trajectories extracted in
+#'  rwlts package.
+#'
+#' @param x    a \code{tibble} object from class \code{wlts}.
+#' @param type a \code{character} with the type of plot.
+#'  Nowadays, only the "alluvial" plot is supported. By default is "alluvial".
+#' @param ...         additional functions
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #'  wlts_bdc <- "https://brazildatacube.dpi.inpe.br/wlts/"
 #'
 #'  wlts_tibble <- get_trajectory(
 #'                      URL        = wlts_bdc,
 #'                      latitude    = c(-12, -11),
 #'                      longitude   = c(-54, -55),
-#'                      collections = "mapbiomas5_amazonia",
+#'                      collections = "mapbiomas_amazonia-v5",
 #'                      start_date  = "2015-07-01",
 #'                      end_date    = "2017-07-01",
 #'                      config = httr::add_headers("x-api-key" = "BDC-KEY"))
 #'
-#'
-#'  plot_sankey(wlts_tibble)
+#'  plot(wlts_tibble)
 #' }
 #'
 #' @return a \code{gg} object from ggplot2 package.
 #'
 #' @export
-plot_sankey <- function(wtls_tibble, show_count_transition = FALSE) {
+plot.wlts <- function(x, ..., type = "alluvial") {
 
-  if (!inherits(wtls_tibble, "wlts"))
-    stop(paste("The given object does not correspond to a time trajectory.",
-               "Please use the `get_trajectory` function."), .call = FALSE)
-
-  if (is.null(wtls_tibble$result))
+  if (is.null(x$result))
     stop(paste("The result provided is empty, please check your query."),
          .call = FALSE)
 
-  traj_data_sankey <- wtls_tibble$result %>%
+  if (!requireNamespace("ggplot2", quietly = TRUE)) {
+    stop(paste("ggplot2 required for this function to work.",
+               "Please install it."), call. = FALSE)
+  }
+
+  # dispatch for S3 methods
+  class(x) <- c(type, class(x))
+  plot(x, ...)
+}
+
+#' @rdname plot.wlts
+#' @param show_count  a \code{logical} parameter, if true, is added
+#' the number of points on each bar. The default value is FALSE.
+#' @export
+plot.alluvial <- function(x, ..., show_count = FALSE) {
+
+  if (!requireNamespace("ggalluvial", quietly = TRUE)) {
+    stop(paste("ggalluvial required for this function to work.",
+               "Please install it."), call. = FALSE)
+  }
+
+  traj_data_sankey <- x$result %>%
     dplyr::mutate(date = as.factor(as.numeric(date)),
                   class = as.factor(class)) %>%
     dplyr::arrange(date) %>%
@@ -58,11 +77,11 @@ plot_sankey <- function(wtls_tibble, show_count_transition = FALSE) {
     ggplot2::scale_y_continuous(expand = c(0, 0)) +
     ggplot2::theme(legend.position = "bottom")
 
-  if (show_count_transition)
+  if (show_count)
     g <- g + ggplot2::geom_text(stat = "stratum",
                                 ggplot2::aes_string(label = "n_points"))
 
-  if (length(unique(wtls_tibble$result$collection)) > 1)
+  if (length(unique(x$result$collection)) > 1)
     g <- g + ggplot2::facet_wrap(~ traj_data_sankey$collection)
 
   return(g)

R/rwlts-package.R

@@ -30,7 +30,4 @@
 NULL
 
 #' @importFrom dplyr mutate arrange ungroup group_by
-#' @importFrom ggplot2 ggplot aes_string scale_y_continuous theme facet_wrap
-#' geom_text stat
-#' @importFrom ggalluvial geom_flow geom_stratum
 NULL

R/wlts.R

@@ -122,6 +122,9 @@ get_trajectory <- function(URL,
   if (any(!is.null(start_date) | !is.null(end_date)))
     .check_datetime(start_date, end_date)
 
+  if (length(collections) > 1)
+    collections <- paste(collections, collapse = ",")
+
   # build final url
   url_obj <- .build_url(URL, path  = "/trajectory",
                         query      = list(start_date, end_date, collections),