R/xkcdline.R

In xkcd: Plotting ggplot2 Graphics in an XKCD Style

## Emilio Torres Manzanera
## University of Oviedo
## Time-stamp: <2018-05-23 12:15 emilio on emilio-despacho>
## ============================================================




##' It draws a handwritten line.
##'
##' This function draws handwritten lines or circles.
##'
##'  It draws a segment or a circunference in an XKCD style.
##'
##' If it is a segment, the following aesthetics are required:
##'  \enumerate{
##'    \item xbegin: x position of the point from.
##'    \item ybegin: y position of the point from.
##'    \item xend: x position of the point to.
##'    \item yend: y position of the point to.
##'  }
##'
##'    If it is a circunference, the following aesthetics are required:
##'  \enumerate{
##'    \item x: x position of the center.
##'    \item y: y position of the center.
##'    \item diameter: diameter of the circunference.
##'  }
##'
##'   Additionally, you can use the aesthetics of \code{\link[ggplot2]{geom_path}}.
##'
##' @title Draw lines or circunferences
##' @param mapping Mapping between variables and aesthetics generated by \code{\link[ggplot2]{aes}}. See Details.
##' @param data Dataset used in this layer.
##' @param typexkcdline A string value. If it is \code{segment}, it draws  a segment. If it is \code{circunference}, it plots a circunference.
##' @param mask Logical. If it is TRUE, it erases the pictures that are under the line.
##' @param ... Optional arguments.
##' @return A layer.
##' @seealso   \code{\link[ggplot2]{aes}},  \code{\link[ggplot2]{geom_path}}
##' @keywords manip
##' @import ggplot2
##' @export
##' @examples
##' data <- data.frame(x1=c(1,2), y1=c(10,20), xend=c(2.5,0.5),
##' yend=c(20,10), model=c("low","high"))
##'
##' ggplot() + xkcdline(mapping=aes(x=x1 +y1, y=y1, xend =xend, yend= yend,
##' color = model), data=data)
##'
##' ggplot() + xkcdline(mapping=aes(x=x1 +y1, y=y1, xend =xend, yend= yend,
##' color = model), data=data) + facet_grid(. ~ model)
##'
##' ggplot() + xkcdline(mapping=aes(x=x1 +y1, y=y1, diameter =xend), data=data, type="circunference")
xkcdline <- function(mapping, data, typexkcdline="segment", mask = TRUE, ...) {
    if(typexkcdline == "segment" ){
        fun <- "pointssegment"
        ## Required variable in the aesthetics function for segment
        requiredaesthetics <-  c("x","y","xend","yend")

    } else if(typexkcdline == "circunference" ) {
        fun <- "pointscircunference"
        requiredaesthetics <-  c("x","y","diameter")

    } else stop("typexkcdline must be segment or circle")


    ## We transform the data to get a default mapping
    segementmapdat <- createdefaultmappinganddata(mapping, data, requiredaesthetics)
    data <- segementmapdat$data
    mapping <- segementmapdat$mapping

    nsegments <- dim(data)[1]

    ## Are arguments of fun in the ellipsis?
    ## Yes, try to add to the data base
    datafun <- data
    argList<-list(...)
    fcn <- get(fun, mode = "function")
    argsfcntt <-  names(formals(fcn))
    argsfcn <- argsfcntt[ argsfcntt != "..."]

    for( i in intersect(argsfcn, names(argList))) {
        if(!(is.null(argList[i])==TRUE)){
            if(length(argList[[i]]) == 1 ) datafun[, i] <- unlist(rep(argList[[i]],nsegments))
            if(length(argList[[i]]) == nsegments ) datafun[, i] <- argList[[i]]
        }
    }

    ## Now, calculate the interpolates for each segment
    listofinterpolates <- doforeachrow(datafun, fun, FALSE, ...)
    listofinterpolateswithillustrativedata <- lapply(1:nsegments,
                                                     function(i) {
                                                         dti <- listofinterpolates[[i]]
                                                         illustrativevariables <- names(datafun)[ ! names(datafun) %in% names(dti) ]
                                                         dti[, illustrativevariables] <- datafun[i, illustrativevariables]
                                                         dti}
                                                     )

    ##print(listofinterpolateswithillustrativedata)
    ## ggplot version <= 2.2.1
    if(typexkcdline == "segment" ){
        ## the mapping is xbegin, ybegin,...
        ## but we need x,y [functions pointssegment returns x,y and geom_path requires x,y]
        ## mapping <- mappingjoin(aes(x=x,y=y), mapping) # R CMD check gives NOTES
        ## mapping <- with(data, mappingjoin(aes(x=x,y=y), mapping)) ## ggplot version <= 2.2.1

    }

    mapping <- with(data, mappingjoin2(mapping))

    listofpaths <- lapply(listofinterpolateswithillustrativedata,
                          function(x, mapping, mask, ...) {
                              pathmask <- NULL
                              ##print(mapping)
                              if(mask) {
                                  ## Plot a white line widther that the original line
                                  ## We must check the color, colour or size
                                  ## and change them to white and a greater width
                                  argList<-list(...)

                                  for(i in intersect(c("color","colour"), names(argList)))
                                      argList[i] <- NULL
                                  argList$mapping <- mapping
                                  argList$data <- x
                                  argList$colour <- "white"
                                  if(is.null(argList$size)==TRUE) argList$size <- 3
                                  if(argList$size <= 3 ) argList$size <- 3
                                  else  argList$size <- argList$size *2
                                  ##print(argList)
                                  ##pathmask <- do.call("geom_path",argList)
                                  pathmask <- do.call("geom_path",argList) # ggplot 2 version <= 2.2.1
                                  ##pathmask <- geom_path(mapping = mapping, data = x, colour="white",size=8)
                              }
                              ## c(pathmask,
                              ##   geom_path(mapping = mapping, data = x, ...)) # ggplot2 version <= 2.2.1
                              c(pathmask,
                                geom_path(mapping = mapping, data = x, ...))

                          },
                          mapping = mapping,
                          mask= mask
                          ## mask = mask,
                          ## ... = ... ggplot2.0 does not like dots
                          )
    listofpaths
}