R/geom.R

In JunlueZhao/CourseraCaptsoneWeek3: Coursera Capstone Course

##' @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")

#--------------------------------------------------------------------------------------------------------