CapstoneProject:

#Definition of the geomTimeline skeleton
#For more information see exported function definition geom_timeline
#or read commented code
GeomTimeline <- ggplot2::ggproto(
  "GeomTimeline", ggplot2::Geom,

  #Geom timeline only requires x and y coordinates
  required_aes = c("x", "y"),

  #A size, shape and colour parameter are though defined inside the code,
  #and can optionnaly be modified
  non_missing_aes = c("size", "shape", "colour"),

  #Default values for aes are set as following (19 means filled circle
  #for shape)
  default_aes = ggplot2::aes(shape = 19,
                             colour = "black",
                             size = 1.5,
                             fill = NA,
                             alpha = NA,
                             stroke = 0.5),

  #This aes is based on drawing points
  draw_key = ggplot2::draw_key_point,


  #' Function used to draw a layer
  draw_panel = function(data, panel_scales, coord) {

    #Update x and y to allow a good display
    coords <- coord$transform(data, panel_scales)

    #Draw points
    grid::pointsGrob(
      coords$x, coords$y,
      pch = coords$shape,
      gp = grid::gpar(

        #Note: following lines are taken from ggplot2 geom_points
        #They allow ggplot2 arguments to pass to grid "pointsGrob"
        col = ggplot2::alpha(coords$colour, coords$alpha),
        fill = ggplot2::alpha(coords$fill, coords$alpha),
        fontsize = coords$size * ggplot2::.pt + coords$stroke * ggplot2::.stroke / 2,
        lwd = coords$stroke * ggplot2::.stroke / 2)
    )
  }
)

#' Definition of the geomTimeline "function handle"
#' For more information see exported function definition geom_timeline
#' or read commented code
#'
#' @param mapping a mapping aes
#' @param data a dataset
#' @param stat a stat
#' @param position a position
#' @param na.rm if na shall be removed or not
#' @param show.legend a show.legend tag
#' @param inherit.aes a inherit.aes tag
#' @param ... some complementary arguments
#'
#' @return a layer
geom_timeline_raw <- function(mapping = NULL, data = NULL, stat = "identity",
                              position = "identity", na.rm = FALSE, show.legend = NA,
                              inherit.aes = TRUE, ...) {

  ggplot2::layer(
    geom = GeomTimeline, mapping = mapping,  data = data, stat = stat,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

#' Plot a eq timeline graph with input data
#'
#' @param data As a cleaned NOAA Significant Earthquakes
#' @param colors As a character vector
#' @param alpha As a numeric
#' @param size As a numeric
#' @param xmindate As a Date
#' @param xmaxdate As a Date
#'
#' @import ggplot2
#' @import grid
#' @importFrom lubridate ymd_hms
#'
#' @return A ggplot2 chart
#' @export
#'
#' @examples
#' db <- utils::head(eq_clean_data(),500)
#' geom_timeline(db)
geom_timeline <- function(data,
                          colors = c("light blue", "blue", "black"),
                          alpha = 0.75,
                          size = NULL,
                          xmindate = NULL,
                          xmaxdate = NULL){

    data <- remove_NA(data)



  #Set datemin depending of the existence (or not) of an input date
  if(is.null(xmindate)){
    date_min <- min(data$date, na.rm = TRUE)
  } else {
    date_min <- xmindate
  }

  #Set datemax depending of the existence (or not) of an input date
  if(is.null(xmaxdate)){
    date_max <- max(data$date, na.rm = TRUE)
  } else {
    date_max <- xmaxdate
  }

  #Take number of countries and their names
  Countries <- unique(data$COUNTRY)
  nb_countries <- length(Countries)

  #Add an x offset depending on the country
  data$y <- sapply(data$COUNTRY, function(x){which(Countries == x)})

  #Correct data for size input
  if(!is.null(size)){
    data$EQ_PRIMARY = size
  }

  #Add or remove the legend depending on the inputs
  if(!is.null(size)){
    size_legend <- ggplot2::guides(size=FALSE)
  } else {
    size_legend <- ggplot2::element_blank()
  }

  #Add or remove the legend depending on the inputs
  if(length(colors)<2){
    color_legend <- ggplot2::guides(colour=FALSE)
  } else {
    color_legend <- ggplot2::element_blank()
  }

  #Create a ggplot
  ggplot2::ggplot() +

    #Plot each earthquake point
    geom_timeline_raw(
      ggplot2::aes(
        x = data$date,
        y = data$y,
        size = data$EQ_PRIMARY,
        colour = data$TOTAL_DEATHS),
      alpha = alpha) +

    ggplot2::scale_colour_gradientn(colors = colors) +

    ggplot2::labs(size="Richter scale\nvalue",
                  colour = "#Deaths") +

    #Add semi-transparent lines
    ggplot2::geom_hline(
      yintercept = c(1:nb_countries),
      alpha = 0.25) +

    #Add an y scale with labels
    ggplot2::scale_y_continuous(
      name="",
      limits=c(1, max(nb_countries + 0.5)),
      breaks=seq(1, max(nb_countries)),
      labels = Countries) +

    #Add a date x scale with 5 breaks
    ggplot2::scale_x_date(
      name="Date",
      limits=c(date_min, date_max),
      breaks=seq(from = date_min, to = date_max,length.out = 5)) +

    #Add a blank theme
    ggplot2::theme() +
    ggplot2::theme(
      axis.line.x = ggplot2::element_line(color="black", size = 2),
      panel.grid.major = ggplot2::element_blank(),
      panel.grid.minor = ggplot2::element_blank(),
      panel.border = ggplot2::element_blank(),
      panel.background = ggplot2::element_blank()) +
    size_legend + color_legend

}

###########################################################################
###########################################################################
###########################################################################

#Definition of the geom_timeline_label skeleton
#For more information see exported function definition geom_timeline_label
#or read commented code
GeomTimelineLabel <- ggplot2::ggproto(
  "GeomTimelineLabel", ggplot2::Geom,

  #Geom timeline label only requires x and y coordinates
  required_aes = c("x", "y", "label"),

  #This aes is based on drawing points
  draw_key = ggplot2::draw_key_point,

  draw_panel = function(data, panel_scales, coord) {

    #Update x and y to allow a good display
    coords <- coord$transform(data, panel_scales)

    basey <- min(coords$y)

    seg <- grid::segmentsGrob(x0 = coords$x,
                              y0 = coords$y,
                              x1 = coords$x,
                              y1 = coords$y+1/30)

    text <- grid::textGrob(x = coords$x,
                           y = coords$y+1.25/30,
                           label = coords$label,
                           just = "left",
                           rot = 45,
                           gp=grid::gpar(cex=0.75))

    grid::gList(seg, text)

  }
)

#'Definition of the geomTimelineLabel "function handle"
#'For more information see exported function definition geom_timeline_label
#'or read commented code
#'NON EXPORTED FUNCTION: USE geom_timeline_label
#'
#' @param mapping a mapping aes
#' @param data a dataset
#' @param stat a stat
#' @param position a position
#' @param na.rm if na shall be removed or not
#' @param show.legend a show.legend tag
#' @param inherit.aes a inherit.aes tag
#' @param ... some complementary arguments
#'
#' @return a layer
geom_timeline_label_raw <- function(mapping = NULL, data = NULL,
                                    stat = "identity",
                                    position = "identity", na.rm = FALSE,
                                    show.legend = NA,
                                    inherit.aes = TRUE, ...) {

  ggplot2::layer(
    geom = GeomTimelineLabel, mapping = mapping,  data = data, stat = stat,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

#' Add eq timeline labels with input data
#'
#' @param dtb  As a cleaned NOAA Significant Earthquakes
#' @param n_max Number of markers to add, from the highest EQ_PRIMARY as numeric
#' @param label Name of the column to print as label, as character
#'
#' @importFrom utils head
#'
#' @return A ggplot2 chart with labels
#' @export
#'
#' @examples
#' db <- utils::head(eq_clean_data(),500)
#' geom_timeline(db)
#' geom_timeline(db)+geom_timeline_label(db)
geom_timeline_label <- function(dtb, n_max = 10, label = "LOCATION_NAME"){

  dtb <- remove_NA(dtb)

  #Take number of countries and their names
  Countries <- unique(dtb$COUNTRY)
  nb_countries <- length(Countries)

  #Add an x offset depending on the country
  dtb$y <- sapply(dtb$COUNTRY, function(x){which(Countries == x)})

  #Filter n_max most important eq by magnitude
  dtb <- utils::head(dtb[order(dtb$EQ_PRIMARY, decreasing = TRUE),], n_max)

  dtb$label <- as.character(unlist(dtb[,label]))

  #Fixes no binding y issue
  y = 0

  #Plot each earthquake point
  geom_timeline_label_raw(
    data = dtb,
    mapping = ggplot2::aes(
      x = date,
      y = y,
      label = label)
    )
}


#' Extract rows with valid date, EQ_PRIMARY and TOTAL_DEATHS
#'
#' @param data a data frame
#'
#' @return a data frame
remove_NA <- function(data){

  dplyr::filter_(
    data,
    stats::setNames(object = ~ !is.na(as.numeric(date)),
                           nm = "date"),
    stats::setNames(object = ~ !is.na(as.numeric(EQ_PRIMARY)),
                           nm = "EQ_PRIMARY"),
    stats::setNames(object = ~ !is.na(as.numeric(TOTAL_DEATHS)),
                           nm = "TOTAL_DEATHS")
  )
}