R/plotMethods.R

In OpenLand: Quantitative Analysis and Visualization of LUCC

utils::globalVariables(c("Type", "St", "U"))
#' @include intensityAnalysis.R
NULL

#' Methods for function \code{plot} in package \pkg{OpenLand}
#'
#' Plot \code{Intensity} objects based on Intensity Analysis output.
#'
#' @param x An intensity object generated by \code{\link{intensityAnalysis}}.
#' @param y ignored.
#' @param labels character. Left and right axis titles(caption).
#' @param title character. Main title.
#' @param labs character. The lateral legend.
#' @param marginplot numeric. Adjustment of the origins of left and right part of
#' the plots.
#' @param leg_curv numeric. x and y values that control the arrow size and position
#' pointing to the Uniform Intensity vertical line.
#' @param color_bar character. Colors defined for the fast, slow and area bars
#' (only for an \code{\linkS4class{Interval}} object).
#' @param fontsize_ui numeric. Fontsize of the uniform intensity percent in the plot.
#' @param \dots additional arguments for theme parameters from ggplot2, see
#' \code{\link[ggplot2]{theme}}.
#'
#' @return An intensity graph
#'
#'
#' @import ggplot2
#' @importFrom gridExtra grid.arrange
#' @importFrom grid textGrob gpar
#'
#' @keywords methods plot
#' @docType methods
#' @rdname plot
#' @aliases plot,ANY,ANY-method plot,Interval,ANY-method plot,Category,ANY-method plot,Transition,ANY-method
#' @export
#'
#'
methods::setGeneric(name = "plot", def = function(x, y, ...)
  standardGeneric("plot"))



#' @param Interval The class.
#' @docType methods
#' @rdname plot
#' @export
#' @aliases plot,Interval,ANY-method
#'
#'
methods::setMethod(
  f = "plot",
  signature("Interval", "ANY"),
  definition = function(x,
                        y,
                        labels = c(
                          leftlabel = "Interval Change Area (percent of map)",
                          rightlabel = "Annual Change Area (percent of map)"),
                        title = NA,
                        labs = c(type = "Changes", ur = "Uniform Intensity"),
                        marginplot = c(lh = -10, rh = 0),
                        leg_curv = c(x = 0.1, y = 0.1),
                        color_bar = c(fast = "#B22222",
                                      slow = "#006400",
                                      area = "gray40"),
                        fontsize_ui = 10,
                        ...) {

        dataset <-
      x$intervalData %>% dplyr::mutate(Type = ifelse(St > U, "Fast", "Slow"))


    GL01_taxa <-
      dataset %>% ggplot(aes(factor(dataset[[1]], levels = rev(levels(dataset[[1]]))), dataset[[3]])) +
      geom_bar(
        aes(fill = Type),
        stat = "identity",
        position = "dodge",
        width = .5
      ) +
      geom_hline(aes(yintercept = dataset[[4]], color = "U"),
                 linetype = 5,
                 size = .5) +
      geom_hline(aes(yintercept = 0), size = .01) +
      scale_fill_manual(values = c(color_bar[[1]], color_bar[[2]])) +
      ylab(NULL) +
      scale_color_manual(values = "black") +
      labs(fill = labs[[1]], color = labs[[2]]) +
      scale_y_continuous(expand = expansion(mult = c(0, .01))) +
      scale_x_discrete(expand = expansion(mult = c(0.06, 0.06))) +
      guides(fill = guide_legend(order = 1),
             color = guide_legend(order = 2)) +
      coord_flip() +
      geom_curve(
        aes(
          x = length(unique(dataset[[1]])) / 2,
          y = dataset[[4]],
          xend = (length(unique(dataset[[1]])) / 2) + leg_curv[[2]],
          yend = dataset[[4]] + leg_curv[[1]]
        ),
        size = .6,
        curvature = .1,
        arrow = arrow(length = unit(2, "mm"), ends = "first")
      ) +
      geom_text(
        aes(x = (length(unique(
          dataset[[1]]
        )) / 2) + leg_curv[[2]],
        y = dataset[[4]] + leg_curv[[1]]),
        label = paste(round(dataset[[4]], 2), "%"),
        colour = "black",
        fontface = c("plain", "bold", "italic", "bold.italic")[1],
        family = c("sans", "serif", "mono")[1],
        size = fontsize_ui / .pt,
        nudge_y = 1 / 100,
        hjust = "left"
      ) +
      theme(
        axis.title.y = element_blank(),
        axis.text.y = element_text(margin = margin(r = 8)),
        axis.ticks.length.y = unit(2, "pt"),
        legend.position = "right",
        legend.direction = "vertical",
        plot.margin = unit(c(
          t = 0,
          r = 0,
          b = 0,
          l = -(marginplot[[2]])
        ), "pt"), ...
      )

    #Area---------------
    GL01_area <-
      dataset %>% ggplot(aes(factor(dataset[[1]], levels = rev(levels(dataset[[1]]))), dataset[[2]])) +
      geom_bar(
        stat = "identity",
        position = "dodge",
        width = .5,
        fill = color_bar[[3]]
      ) +
      coord_flip() +
      xlab(expression(paste("Periodo de tempo [ ", Y[t], ",", Y[t + 1], "]"))) +
      ylab(NULL) +
      geom_hline(aes(yintercept = 0), size = .01) +
      scale_y_reverse(expand = expansion(mult = c(0.01, 0))) +
      scale_x_discrete(position = "top", expand = expansion(mult = c(0.06, 0.06))) +
      theme(
        axis.title.y = element_blank(),
        axis.ticks.length.y = unit(2, "pt"),
        axis.text.y = element_blank(),
        plot.margin = unit(c(
          t = 0,
          r = -(marginplot[[1]]),
          b = 0,
          l = 0
        ), "pt"), ...
      )


    format_lab <- function(x, font = 1, size = 11) {
      grid::textGrob(x, gp = grid::gpar(fontface = font, fontsize = size))
    }

    if (!is.na(title)) {
      title_lab <- format_lab(title)
      left_lab <- format_lab(labels[[1]])
      right_lab <- format_lab(labels[[2]])

      my_layout <-
        matrix(c(rep(1, 6), NA, rep(rep(2:3, c(
          3, 4
        )), 20), rep(4:5, c(3, 3)), NA),
        ncol = 7,
        byrow = TRUE)

      gridExtra::grid.arrange(title_lab,
                              GL01_area,
                              GL01_taxa,
                              left_lab,
                              right_lab,
                              layout_matrix = my_layout)
    } else {
      left_lab <- format_lab(labels[[1]])
      right_lab <- format_lab(labels[[2]])

      my_layout <-
        matrix(c(rep(rep(2:3, c(
          3, 5
        )), 20), rep(c(4, 5, NA), c(3, 4, 1))),
        ncol = 8, byrow = TRUE)

      gridExtra::grid.arrange(GL01_area, GL01_taxa,
                              left_lab, right_lab,
                              layout_matrix = my_layout)

    }

  }
)



#' @param Category The class.
#' @docType methods
#' @rdname plot
#' @export
#'
#' @aliases plot,Category,ANY-method
methods::setMethod(
  f = "plot",
  signature("Category", "ANY"),
  definition = function(x,
                        y,
                        labels = c(
                          leftlabel = "Annual Change Area (km2 or pixels)",
                          rightlabel = "Annual Change Intensity (percent of category)"),
                        title = NA,
                        labs = c(type = "Categories", ur = "Uniform Intensity"),
                        marginplot = c(lh = 0.5, rh = 0.5),
                        leg_curv = c(x = 0.1, y = 0.1),
                        fontsize_ui = 10,
                        ...) {
    dataset <- x$categoryData
    lookupcolor <- x$lookupcolor

    GL02_ganho_taxa <-
      dataset %>% ggplot(aes(factor(dataset[[2]], levels = rev(levels(dataset[[2]]))), dataset[[5]])) +
      geom_bar(aes(fill = dataset[[2]]), stat = "identity", position = "dodge") +
      facet_wrap(~ dataset[[1]], ncol = 1) +
      scale_fill_manual(values =  unname(lookupcolor[as.character(unique(dataset[[2]]))
                                                     [order(match(as.character(unique(dataset[[2]])),
                                                                  levels(dataset[[2]])))]])) +
      xlab(NULL) +
      ylab(NULL) +
      geom_hline(aes(yintercept = 0), size = .3) +
      geom_hline(aes(yintercept = dataset[[6]], color = names(dataset)[[6]]),
                 linetype = 5,
                 size = .3) +
      scale_color_manual(values = "black") +
      coord_flip() +
      labs(fill = labs[[1]], colour = labs[[2]]) +
      scale_y_continuous(expand = expansion(mult = c(0, .01))) +
      guides(fill = guide_legend(order = 1),
             color = guide_legend(order = 2)) +

      geom_curve(
        aes(
          x = length(unique(dataset[[2]])) / 2,
          y = dataset[[6]],
          xend = (length(unique(dataset[[2]])) / 2) + leg_curv[[2]],
          yend = dataset[[6]] + leg_curv[[1]]
        ),
        curvature = .1,
        arrow = arrow(length = unit(2, "mm"), ends = "first")
      ) +

      geom_text(
        aes(x = (length(unique(
          dataset[[2]]
        )) / 2) + leg_curv[[2]],
        y = dataset[[6]] + leg_curv[[1]]),
        label = paste(round(dataset[[6]], 2), "%"),
        colour = "black",
        fontface = c("plain", "bold", "italic", "bold.italic")[1],
        family = c("sans", "serif", "mono")[1],
        size = fontsize_ui / .pt,
        nudge_y = 1 / 100,
        hjust = "left"
      ) +
      theme(
        axis.text.y = element_blank(),
        axis.title.x = element_text(size = 13, face = "plain"),
        axis.ticks.length.y = unit(0, "pt"),
        legend.position = "right",
        legend.direction = "vertical",
        plot.margin = unit(c(
          t = 0,
          r = 0,
          b = 0,
          l = -(marginplot[[2]])
        ), "pt"), ...
      )

    #Area ----
    GL02_ganho_area <-
      dataset %>% ggplot(aes(factor(dataset[[2]], levels = rev(levels(dataset[[2]]))), dataset[[4]])) +
      geom_bar(aes(fill = dataset[[2]]), stat = "identity", position = "dodge") +
      facet_wrap(~ dataset[[1]], ncol = 1) +
      scale_fill_manual(values = unname(lookupcolor[as.character(unique(dataset[[2]]))
                                                    [order(match(as.character(unique(dataset[[2]])),
                                                                 levels(dataset[[2]])))]])) +
      xlab(NULL) +
      ylab(NULL) +
      geom_hline(aes(yintercept = 0), size = .3) +
      coord_flip() +
      labs(fill = "Categories") +
      scale_y_reverse(expand = expansion(mult = c(0.01, 0))) +
      scale_x_discrete(position = "top") +
      theme(
        axis.ticks.length.y = unit(0, "pt"),
        axis.title.x = element_text(size = 12, face = "plain"),
        axis.text.y = element_blank(),
        legend.position = "none",
        plot.margin = unit(c(
          t = 0,
          r = -(marginplot[[1]]),
          b = 0,
          l = 0
        ), "pt"), ...

      )

    format_lab <- function(x, font = 1, size = 11) {
      grid::textGrob(x, gp = grid::gpar(fontface = font, fontsize = size))
    }

    if (!is.na(title)) {
      title_lab <- format_lab(title)
      left_lab <- format_lab(labels[[1]])
      right_lab <- format_lab(labels[[2]])

      my_layout <-
        matrix(c(rep(1, 6), NA, rep(rep(2:3, c(
          3, 4
        )), 20), rep(4:5, c(3, 3)), NA),
        ncol = 7,
        byrow = TRUE)

      gridExtra::grid.arrange(
        title_lab,
        GL02_ganho_area,
        GL02_ganho_taxa,
        left_lab,
        right_lab,
        layout_matrix = my_layout
      )
    } else {
      left_lab <- format_lab(labels[[1]])
      right_lab <- format_lab(labels[[2]])

      my_layout <-
        matrix(c(rep(rep(2:3, c(
          3, 4
        )), 20), rep(c(4, 5, NA), c(3, 3, 1))),
        ncol = 7, byrow = TRUE)

      gridExtra::grid.arrange(GL02_ganho_area,
                              GL02_ganho_taxa,
                              left_lab,
                              right_lab,
                              layout_matrix = my_layout)

    }

  }
)





#' @param Transition The class.
#' @docType methods
#' @rdname plot
#' @export
#'
#' @aliases plot,Transition,ANY-method
methods::setMethod(
  f = "plot",
  signature("Transition", "ANY"),
  definition = function(x,
                        y,
                        labels = c(
                          leftlabel = "Annual Transition Area (km2 or pixels)",
                          rightlabel = "Annual Transition Intensity (percent of category)"),
                        title = NA,
                        labs = c(type = "Categories", ur = "Uniform Intensity"),
                        marginplot = c(lh = 0.5, rh = 0.5),
                        leg_curv = c(x = 0.1, y = 0.1),
                        fontsize_ui = 10,
                        ...) {
    dataset <- x$transitionData
    lookupcolor <- x$lookupcolor

    GL03_ganho_taxa <-
      dataset %>% ggplot(aes(factor(dataset[[2]], levels = rev(levels(dataset[[2]]))), dataset[[6]])) +
      geom_bar(aes(fill = dataset[[2]]), stat = "identity", position = "dodge") +
      facet_wrap(~ dataset[[1]], ncol = 1) +
      scale_fill_manual(values = unname(lookupcolor[as.character(unique(dataset[[2]]))
                                                    [order(match(as.character(unique(dataset[[2]])),
                                                                 levels(dataset[[2]])))]])) +
      xlab(NULL) +
      ylab(NULL) +
      geom_hline(aes(yintercept = 0), size = .3) +
      geom_hline(aes(yintercept = dataset[[7]], color = names(dataset)[[7]]),
                 linetype = 5,
                 size = .3) +
      scale_color_manual(values = "black") +
      coord_flip() +
      labs(fill = labs[[1]], colour = labs[[2]]) +
      scale_y_continuous(expand = expansion(mult = c(0, .01))) +
      guides(fill = guide_legend(order = 1),
             color = guide_legend(order = 2)) +
      geom_curve(
        aes(
          x = length(unique(dataset[[2]])) / 2,
          y = dataset[[7]],
          xend = (length(unique(dataset[[2]])) / 2) + leg_curv[[2]],
          yend = dataset[[7]] + leg_curv[[1]]
        ),
        curvature = .1,
        arrow = arrow(length = unit(2, "mm"), ends = "first")
      ) +

      geom_text(
        aes(x = (length(unique(
          dataset[[2]]
        )) / 2) + leg_curv[[2]],
        y = dataset[[7]] + leg_curv[[1]]),
        label = paste(round(dataset[[7]], 2), "%"),
        colour = "black",
        fontface = c("plain", "bold", "italic", "bold.italic")[1],
        family = c("sans", "serif", "mono")[1],
        size = fontsize_ui / .pt,
        nudge_y = 1 / 100,
        hjust = "left"
      ) +
      theme(
        axis.text.y = element_blank(),
        axis.title.x = element_text(size = 13, face = "plain"),
        axis.ticks.length.y = unit(0, "pt"),
        legend.position = "right",
        legend.direction = "vertical",
        plot.margin = unit(c(
          t = 0,
          r = 0,
          b = 0,
          l = -(marginplot[[2]])
        ), "pt"), ...
      )

    # Area ----
    GL03_ganho_area <- dataset %>%
      ggplot(aes(factor(dataset[[2]], levels = rev(levels(dataset[[2]]))), dataset[[5]])) +
      geom_bar(aes(fill = dataset[[2]]), stat = "identity", position = "dodge") +
      facet_wrap(~ dataset[[1]], ncol = 1) +
      scale_fill_manual(values = unname(lookupcolor[as.character(unique(dataset[[2]]))
                                                    [order(match(as.character(unique(dataset[[2]])),
                                                                 levels(dataset[[2]])))]])) +
      xlab(NULL) +
      ylab(NULL) +
      geom_hline(aes(yintercept = 0), size = .3) +
      coord_flip() +
      labs(fill = "Categories") +
      scale_y_reverse(expand = expansion(mult = c(0.01, 0))) +
      scale_x_discrete(position = "top") +
      theme(
        axis.ticks.length.y = unit(0, "pt"),
        axis.title.x = element_text(size = 12, face = "plain"),
        axis.text.y = element_blank(),
        legend.position = "none",
        plot.margin = unit(c(
          t = 0,
          r = -(marginplot[[1]]),
          b = 0,
          l = 0
        ), "pt"), ...
      )


    format_lab <- function(x, font = 1, size = 11) {
      grid::textGrob(x, gp = grid::gpar(fontface = font, fontsize = size))
    }

    if (!is.na(title)) {
      title_lab <- format_lab(title)
      left_lab <- format_lab(labels[[1]])
      right_lab <- format_lab(labels[[2]])

      my_layout <-
        matrix(c(rep(1, 6), NA, rep(rep(2:3, c(
          3, 4
        )), 20), rep(4:5, c(3, 3)), NA),
        ncol = 7,
        byrow = TRUE)

      gridExtra::grid.arrange(
        title_lab,
        GL03_ganho_area,
        GL03_ganho_taxa,
        left_lab,
        right_lab,
        layout_matrix = my_layout
      )
    } else {
      left_lab <- format_lab(labels[[1]])
      right_lab <- format_lab(labels[[2]])

      my_layout <-
        matrix(c(rep(rep(2:3, c(
          3, 4
        )), 20), rep(c(4, 5, NA), c(3, 3, 1))),
        ncol = 7, byrow = TRUE)

      gridExtra::grid.arrange(GL03_ganho_area,
                              GL03_ganho_taxa,
                              left_lab,
                              right_lab,
                              layout_matrix = my_layout)

    }
  }
)