jyjekNOAA: Plot for Analysis NOAA dataset

#' Geom Timeline
#' Helping function for create Geom Timeline
#'
#' See \code{\link{geom_timeline}} for description.
#'
#' @format NULL
#' @usage NULL
#' @export
#' @examples
#' library(dplyr); library(lubridate);library(ggplot2)
#' NOAA_quakes%>%
#'  eq_clean_data()%>%
#'  dplyr::filter(COUNTRY %in% c('CHINA','MEXICO')) %>%
#'  dplyr::filter(DATE > '2010-01-01') %>%
#'  ggplot2::ggplot() +
#'  geom_timeline(aes(x = DATE, y = COUNTRY, size = as.numeric(EQ_PRIMARY),
#'                    color = as.numeric(TOTAL_DEATHS))) +
#'  guides(size = guide_legend(order=1))+
#'  scale_color_continuous(name = '# deaths') +
#'  scale_size_continuous(name = 'Richter scale value') +
#'  NOAA_thm()

GT <- ggplot2::ggproto("GT", ggplot2::Geom,
                       required_aes = c('x'),

                       default_aes = ggplot2::aes(
                         y = 0,
                         size = 1,
                         color = 'black',
                         alpha = 0.5,
                         shape = 19,
                         stroke = 0.5,
                         fill = NA
                       ),

                       draw_key = ggplot2::draw_key_point,

                       draw_panel = function(data, panel_scales, coord) {

                         coords <- coord$transform(data, panel_scales)
                         coords<-coords%>%
                           dplyr::mutate(size=size/max(size)*1.5)

                         ## Construct a grid grob
                         grid::pointsGrob(
                           x = coords$x,
                           y = coords$y,
                           pch = coords$shape,
                           gp = grid::gpar(
                             cex = coords$size,
                             col = coords$colour,
                             alpha = coords$alpha
                           )
                         )
                       }
)


#' Timeline Plot for NOAA
#'
#' This function create Timeline Plot of NOAA dataset by Country and Time
#'
#' @param mapping See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param data See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param stat See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param position See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param na.rm See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param show.legend See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param inherit.aes See \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param ... other arguments passed on to \code{\link{layer}}.
#' @import ggplot2
#'
#' @examples
#' library(dplyr); library(lubridate);library(ggplot2)
#' NOAA_quakes%>%
#'  eq_clean_data()%>%
#'  dplyr::filter(COUNTRY %in% c('CHINA','MEXICO')) %>%
#'  dplyr::filter(DATE > '2010-01-01') %>%
#'  ggplot2::ggplot() +
#'  geom_timeline(aes(x = DATE, y = COUNTRY, size = as.numeric(EQ_PRIMARY),
#'                    color = as.numeric(TOTAL_DEATHS))) +
#'  guides(size = guide_legend(order=1))+
#'  scale_color_continuous(name = '# deaths') +
#'  scale_size_continuous(name = 'Richter scale value') +
#'  NOAA_thm()
#' @export

geom_timeline <- function(mapping = NULL,
                          data = NULL,
                          stat = "identity",
                          position = "identity",
                          na.rm = FALSE,
                          show.legend = T,
                          inherit.aes = TRUE,
                          ...) {
  ggplot2::layer(
    geom = GT,
    mapping = mapping,
    data = data,
    stat = stat,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

#' Theme for Timeline Plot
#' 
#' This function modificate Plot output and making it more pretty
#'
#' @param base_size Text base size
#' @param base_family Text base family
#' @import ggplot2
#'
#' @export
#' @examples
#' library(dplyr); library(lubridate);library(ggplot2)
#' NOAA_quakes%>%
#'  eq_clean_data()%>%
#'  dplyr::filter(COUNTRY %in% c('CHINA','MEXICO')) %>%
#'  dplyr::filter(DATE > '2010-01-01') %>%
#'  ggplot2::ggplot() +
#'  geom_timeline(aes(x = DATE, y = COUNTRY, size = as.numeric(EQ_PRIMARY),
#'                    color = as.numeric(TOTAL_DEATHS))) +
#'  guides(size = guide_legend(order=1))+
#'  scale_color_continuous(name = '# deaths') +
#'  scale_size_continuous(name = 'Richter scale value') +
#'  NOAA_thm()

NOAA_thm <- function(base_size = 13,
                     base_family = 'serif') {
  thm <- (
    ggplot2::theme_minimal(base_size = base_size,
                           base_family = base_family) +
      theme(
        legend.position = 'bottom',
        legend.box = "horizontal",
        legend.key.size = unit(1.25,"line"),
        panel.grid.minor.x = element_blank(),
        panel.grid.major.x = element_blank(),
        axis.ticks.x = element_line(),
        axis.line.x = element_line()
      )
  )
}


#' Label for NOAA Time line
#' 
#' 
#' This function add labeling the top \code{n} earthquakes, by
#' magnitude.  Default value is the top 5 earthquakes for each country specified.
#' User can change this value \code{n_max} aesthetic.
#'
#' @param mapping see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param data see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param stat see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param position see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param na.rm see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param show.legend see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param inherit.aes see \code{ggplot2} \code{\link[ggplot2]{layer}}
#' @param ... other arguments.
#'
#' @section Aesthetics:
#' \code{geom_timeline_label} undertands the following aesthetics (required
#' aesthetics are in bold):
#' \itemize{
#'  \item \strong{x}: recommend \code{DATE}
#'  \item \strong{label}: recommend \code{LOCATION_NAME}
#'  \item \strong{magnitude}: recommend \code{EQ_PRIMARY}
#'  \item y: recommend \code{COUNTRY}
#'  \item n_max: default 5. Top \code{n} earthquakes to label,
#'        sorted by magnitude.
#'  \item color
#'  \item linetype
#'  \item size
#'  \item alpha
#'  \item NOAA_thm
#'  \item GTL
#' }
#'
#' @export
#' @examples
#' library(dplyr); library(lubridate);library(ggplot2)
#' NOAA_quakes%>%
#'  eq_clean_data()%>%
#'  dplyr::filter(COUNTRY %in% c('CHINA','MEXICO')) %>%
#'  dplyr::filter(DATE > '2010-01-01') %>%
#'  ggplot2::ggplot() +
#'  geom_timeline(aes(x = DATE, y = COUNTRY, size = as.numeric(EQ_PRIMARY),
#'                    color = as.numeric(TOTAL_DEATHS))) +
#'  guides(size = guide_legend(order=1))+
#'  scale_color_continuous(name = '# deaths') +
#'  scale_size_continuous(name = 'Richter scale value') +
#'  NOAA_thm()

geom_timeline_label<- function(mapping = NULL,
           data = NULL,
           stat = "identity",
           position = "identity",
           na.rm = FALSE,
           show.legend = NA,
           inherit.aes = TRUE,
           ...) {
    ggplot2::layer(
      geom = GTL,
      mapping = mapping,
      data = data,
      stat = stat,
      position = position,
      show.legend = show.legend,
      inherit.aes = inherit.aes,
      params = list(na.rm = na.rm, ...)
    )
  }



#' Geom Timeline Label
#'
#' See \code{\link{geom_timeline_label}} for description.
#' @importFrom dplyr %>%
#' @import ggplot2
#' @format NULL
#' @usage NULL
#' @export
#' @examples
#' library(dplyr); library(lubridate);library(ggplot2)
#' NOAA_quakes%>%
#'  eq_clean_data()%>%
#'  dplyr::filter(COUNTRY %in% c('CHINA','MEXICO')) %>%
#'  dplyr::filter(DATE > '2010-01-01') %>%
#'  ggplot2::ggplot() +
#'  geom_timeline(aes(x = DATE, y = COUNTRY, size = as.numeric(EQ_PRIMARY),
#'                    color = as.numeric(TOTAL_DEATHS))) +
#'  guides(size = guide_legend(order=1))+
#'  scale_color_continuous(name = '# deaths') +
#'  scale_size_continuous(name = 'Richter scale value') +
#'  NOAA_thm()
GTL <-
  ggplot2::ggproto(
    "GTL",
    ggplot2::Geom,
    required_aes = c('x', 'label', 'magnitude'),

    default_aes = ggplot2::aes(
      n_max = 5,
      y = 0,
      color = 'grey35',
      size = 0.5,
      linetype = 1,
      alpha = NA
    ),

    draw_key = ggplot2::draw_key_point,

    draw_panel = function(data, panel_scales, coord) {
      n_max <- data[1,"n_max"]
      if(n_max<1){
        stop("n_max may be greather then 0")
      }
      data <- data %>%
        dplyr::mutate(magnitude = magnitude/max(magnitude)*1.5)%>%
        dplyr::group_by(group) %>%
        dplyr::top_n(n_max, magnitude)

      #vertical line
      data$xend <- data$x
      data$yend <- data$y+0.17
      g1 <- ggplot2::GeomSegment$draw_panel(unique(data), panel_scales, coord)

      #text label
      data$y <- data$yend+0.02
      data$angle <- 45
      data$fontface <- 17
      data$lineheight <- 2
      data$hjust <- 'left'
      data$vjust <- 'top'
      data$family <- 'serif'
      data$size <- 3.5
      data$colour <- 'black'
      g2 <- ggplot2::GeomText$draw_panel(unique(data), panel_scales, coord)

      ggplot2:::ggname('geom_timeline_label', grid::grobTree(g1, g2))
    }
  )