R/geom_timeline_label.R

#' Geom to add labels to points in Geom_Timeline
#'
#' \code{geom_timeline_label} is meant to work in conjunction with \code{ggplot} and
#' \code{geom_timeline_label} to provide a framework to label important earthquakes.
#'
#'
#' @import ggplot2
#' @import grid
#' @import dplyr
#' @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.
#' #  Be sure to repeat \code{x, xmindate, and xmaxdate}
#' mydate=as.Date("2014-1-1","%Y-%m-%d")
#'
#' ggplot(data)+
#' geom_timeline(xmindate=mydate,aes(x=DATE,y=COUNTRY,alpha=EQ_PRIMARY))+
#' geom_timeline(xmindate=mydate,aes(x=DATE,label=LOCATION_NAME,orderdata=EQ_PRIMARY))
#' theme_classic()
#'
#' }
#'
GeomTimelineLabel<-ggplot2::ggproto("GeomTimelineLabel",ggplot2::Geom,

                               required_aes = c("x","label","orderdata"),
                               optional_aes = c("n_max","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,
                                                 linelen=.15,
                                                 fontsize=10),


                               draw_key=ggplot2::draw_key_point,



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


                                 #filter data for min/max dates provided
                                 data<-data[data$x>=params$xmindate&data$x<=params$xmaxdate,]
                                 data<-dplyr::group_by(data,group)
                                 data<-dplyr::top_n(data,params$n_max,orderdata)
                                 data<-dplyr::ungroup(data)

                                 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){
                                  #browser()
                                 coords <- coord$transform(data, panel_scales)

                                 words<-grid::textGrob(
                                                      label = coords$label,
                                                      x = coords$x,
                                                      y = coords$y + coords$linelen+0.02,
                                                      #hjust = coords$hjust,
                                                      #vjust = coords$vjust,
                                                      #rot = coords$angle,
                                                      default.units = "native",
                                                      gp = grid::gpar(
                                                                      col = "black",
                                                                      alpha = 1,
                                                                      fontsize = coords$fontsize,
                                                                      size = coords$size,
                                                                      fontfamily = coords$family,
                                                                      fontface = coords$fontface,
                                                                      lineheight = coords$lineheight,
                                                                      fill = NA)
                                                      )

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

                                 grid::gList(
                                   words,
                                   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 n_max This aesthetic will limit the number of labels on the graph, ordered by the magnitude
#' in the EQ_PRIMARY field.
#'
#' @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.
#'
#' @param n_max This parameter controls how many EQ are labeled per timeline.
#'
#' @note linelen This is the length of lines originating at th desired points.
#'
#' @note orderby This is the data used to rank the data so that we can select the top
#' n_max. It will sort largest to smallest to select.
#'
#' @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.
#'
#' @note label This aesthetic is the data column corresponding to the desired label for each point.

#' @inheritParams ggplot2::geom_point
#'
#' @export
#'

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

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