R/geom_timeline.R

#' Geom to plot EQ timelines.
#'
#' \code{geom_timeline} is meant to work in conjunction with \code{ggplot} to provide
#' visualization of earthquake data over time. The optional arguments for alpha and color
#' are defaulted to provide a visual cue as to the severity (Richter scale) and mortality caused
#' by each event.
#'
#' @import ggplot2
#' @import grid
#' @importFrom dplyr select
#' @importFrom dplyr filter
#' @importFrom lubridate make_date
#' @export
#'
#' @examples
#' \dontrun{
#'
#' #This operates as any other geom. A theme with a blank background
#' #  is recommended to make it look more timeline like.
#' mydate=as.Date("2014-1-1","%Y-%m-%d")
#'
#' ggplot(data)+
#' geom_timeline(xmindate=mydate,aes(x=DATE,y=COUNTRY,alpha=EQ_PRIMARY))+
#' theme_classic()
#'
#' }
#'
#'
GeomTimeline<-ggplot2::ggproto("GeomTimeline",ggplot2::Geom,

                                required_aes = c("x"),
                                optional_aes = c("xmindate","xmaxdate"),
                                default_aes = ggplot2::aes(colour="black",
                                                  y=0.50,
                                                  size=5,
                                                  linetype=1,
                                                  fill="black",
                                                  shape=19,
                                                  stroke=0.5,
                                                  alpha=0.5
                                                  ),

                               draw_key=ggplot2::draw_key_point,



                               setup_data = function(data,params,xmindate,xmaxdate){


                                #filter data for min/max dates provided
                                 data<-data[data$x>=params$xmindate&data$x<=params$xmaxdate,]


                                 if(length(data$x)<=0){stop("No data between min and max dates!")}

                                 data

                               },

                # I have not figured out how to essentially set a theme withing the geom
                # to remove the labels and gridlines. I am not too worried since the timeline
                # does specifically require this to be the case in the assignment.


                                draw_group = function(data,panel_scales,coord,params){

                                  coords <- coord$transform(data, panel_scales)

                                  points<-grid::pointsGrob(x=coords$x,
                                                           y=coords$y,
                                                           pch = coords$shape,
                                                           default.units = "native",
                                                            gp = grid::gpar(col = scales::alpha(coords$colour, coords$alpha),
                                                              fill = scales::alpha(coords$fill,coords$alpha),
                                                              fontsize=coords$size*ggplot2::.pt+coords$stroke*ggplot2::.stroke/2))

                                  lines<-grid::segmentsGrob(x0=grid::unit(0,"native"),
                                                            y0=coords$y,
                                                            x1=grid::unit(1,"native"),
                                                            y1=coords$y,
                                                            gp = grid::gpar(col = scales::alpha("black",.5),
                                                                            fill = scales::alpha("black", .5),
                                                                            lwd = coords$size/7 * ggplot2::.pt),
                                                      default.units = "native")

                                  grid::gList(
                                             points,
                                             lines
                                            )
                                              }
                                  )




#' This is the wrapper to the layer function for the GeomTimeline.
#'
#' The wrapper is just to plot the object. See \code{ggplot2} package documenation
#' for more specifics on geom_* and layer_* functions.
#'
#' @param xmindate This is a date that will filter data prior to plotting. No EQ prior to this parameter
#' will be plotted.
#'
#' @param xmaxdate This is a date that will filter data prior to plotting. No EQ after this parameter
#' will be plotted.
#'
#' @note x This aesthetic should be a date field as this is mean to be a timeline.
#'
#' @note y This aesthetic is used to group EQ in some fashion. For example, y could be set
#' to a country which would subsequently plot each COuntries EQ on a separate line.
#'
#' @inheritParams ggplot2::geom_point
#'
#' @note See \code{geom_timeline_lable} to provide text based annotations to the timeline
#'
#' @export
#'

geom_timeline<-function (mapping = NULL,
                          data = NULL,
                          stat = "identity",
                          position = "identity",
                          xmindate = lubridate::make_date(-6000,1,1),
                          xmaxdate = lubridate::make_date(6000,1,1),
                          ..., na.rm = TRUE, show.legend = NA, inherit.aes = TRUE){


  ggplot2::layer(data = data, mapping = mapping, stat = stat,
        geom = GeomTimeline,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm,xmindate=xmindate,xmaxdate=xmaxdate,
                      ...))
}
JJNewkirk/NOAAEQ documentation built on May 27, 2019, 1:12 p.m.