##' @import ggplot2
##' @import grid
NULL
##---------------------------------------------------------------------------------------------------------
StatTimeLine <- ggproto("StatTimeLine", Stat,
required_aes = c("x"),
default_aes = ggplot2::aes(),
compute_group = function(data, scales, xmin, xmax) {
if (substr(xmin,1,1)=="-")
xmin <- as.Date(-1*as.numeric(difftime(substr(xmin, 2, nchar(xmin)), "0000-01-01")), origin="0000-01-01")
else
xmin <- as.Date(xmin, origin="0000-01-01")
if (substr(xmax,1,1)=="-")
xmax <- as.Date(-1*as.numeric(difftime(substr(xmax, 2, nchar(xmax)), "0000-01-01")), origin="0000-01-01")
else
xmax <- as.Date(xmax, origin="0000-01-01")
data <- data[data$x >= xmin & data$x <= xmax, ]
data
})
GeomTimeLine <- ggproto("GeomTimeLine", Geom,
required_aes = c("x"),
default_aes = aes(shape = 19, colour = "grey",
size = 7, fill = NA, alpha = .5,
stroke = 0.5, y=.2),
draw_key = draw_key_point,
draw_panel = function(data, panel_scales, coord) {
coords <- coord$transform(data, panel_scales)
line_ypos <- unique(coords$y)
lines <- data.frame("x"=c(1:2*length(line_ypos)) ,
"y"=c(1:2*length(line_ypos)) ,
"group"=c(1:2*length(line_ypos)))
for (i in 1:length(line_ypos)) {
lines[i, ] <- list(0, line_ypos[i], i)
lines[i+length(line_ypos), ] <- list(1,
line_ypos[i],
i)
}
# print(coords$size)
# print(data$colour)
grid::grobTree(
grid::polylineGrob(lines$x, lines$y, id=lines$group, gp=grid::gpar(col="grey")),
grid::pointsGrob(
coords$x, coords$y,
pch = ifelse(is.na(coords$size), 4, coords$shape),
gp = grid::gpar(
col = alpha(coords$colour, ifelse(coords$colour=="grey50", .2, coords$alpha)),
fill = alpha(coords$fill, coords$alpha),
fontsize = ifelse(is.na(coords$size), 7, coords$size * .pt + coords$stroke * .stroke / 2),
lwd = coords$stroke * .stroke / 2
)
)
)
}
)
#' Creates the main layer in the timeline visualization of earthquakes
#'
#' @param xmin a character value. Tthe minimun date to display in the x-axis
#' @param xmax a character value. Tthe maximun date to display in the x-axis
#' @param mapping default to NULL
#' @param data defaults to NULL
#' @param stat defaults to "TimeLine"
#' @param position defaults to "identity"
#' @param na.rm defaults to false
#' @param show.legend defaults to NA
#' @param inherit.aes defaults to true
#' @param ... other arguments
#' @return the main layer
#' @example p + geom_timeline(xmin="1000-01-01", xmax="2000-01-01")
#' @example p + geom_timeline(xmin="-1000-01-01", xmax="2000-01-01")
#' @export
geom_timeline <- function(mapping = NULL, data = NULL, stat = "TimeLine",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
xmin="2000-01-01", xmax="2018-01-01", ...) {
ggplot2::layer(
geom = GeomTimeLine, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(xmin=xmin, xmax=xmax, na.rm = na.rm, ...)
)
}
# --------------------ANnotation layer-------------------------
GeomTimeLineLabel <- ggproto("GeomTimeLineLabel", Geom,
required_aes = c("x", "label"),
default_aes = aes(y=.2),
draw_panel = function(data, panel_scales, coord, n_max) {
stopifnot("size" %in% colnames(data))
# print(data)
n_max <- min(n_max, nrow(data))
data <- head(data[order(data$size,decreasing=TRUE), ], n_max)
data <- data[!is.na(data$size), ]
# print(data)
coords <- coord$transform(data, panel_scales)
# str(coords)
lines <- data.frame("x"=c(1:2*nrow(coords)) ,
"y"=c(1:2*nrow(coords)) ,
"group"=c(1:2*nrow(coords)))
for (i in 1:nrow(coords)) {
lines[i, ] <- list(coords[i, "x"], coords[i, "y"], i)
lines[i+nrow(coords), ] <- list(coords[i,"x"], coords[i, "y"]+.05, i)
}
# print(nrow(coords))
# print(n_max)
# str(coords)
grid::grobTree( grid::polylineGrob(x=lines$x, y=lines$y,
id=lines$group,
gp=grid::gpar(col="grey")),
grid::textGrob(label=coords$label,
x=coords$x,
y=coords$y+.055,
rot=45, just='left'))
}
)
#' Creates the annotation layer in the timeline visualization of earthquakes
#'
#' @param n_max an integer value. The value represents the largest n_th sample to annotate
#' @param xmin a character value. Tthe minimun date to display in the x-axis
#' @param xmax a character value. Tthe maximun date to display in the x-axis
#' @param mapping default to NULL
#' @param data defaults to NULL
#' @param stat defaults to "TimeLine"
#' @param position defaults to "identity"
#' @param na.rm defaults to false
#' @param show.legend defaults to NA
#' @param inherit.aes defaults to true
#' @param ... other arguments
#' @return the annotation layer
#' @example p + geom_timeline(aes(label=LOCATION_NAME), n_max=6, xmin="1000-01-01", xmax="2000-01-01")
#' @example p + geom_timeline(aes(label=LOCATION_NAME), n_max=6, xmin="-1000-01-01", xmax="2000-01-01")
#' @export
geom_timeline_label <- function(mapping = NULL, data = NULL, stat = "TimeLine",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE,
n_max=5, xmin="2000-01-01", xmax="2018-01-01", ...) {
ggplot2::layer(
geom = GeomTimeLineLabel, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(n_max=n_max, xmin=xmin, xmax=xmax, na.rm = na.rm, ...)
)
}
#-----example run-----------------------------------------------------------------------------------------
# ggplot(noaa[noaa$COUNTRY=="CHINA", ] ,
# aes(DATE, COUNTRY, size=EQ_MAG_MW, colour=DEATHS)) +
# geom_timeline(xmin="0000-01-01", xmax="1000-01-01") + theme_classic() +
# theme(legend.position="bottom", axis.line.y=element_blank()) + labs(y=NULL) +
#
# geom_timeline_label(aes(label=LOCATION_NAME), n_max=10, xmin="0000-01-01", xmax="1000-01-01")
#--------------------------------------------------------------------------------------------------------
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.