#' 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,
...))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.