R/xkcdman.R

In xkcd: Plotting ggplot2 Graphics in an XKCD Style

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




##' It draws a stick figure
##'
##' This function draws a stick figure.
##' 
 ##' The following aesthetics are required:
 ##'\enumerate{
 ##'  \item x: x position of the center of the head.
 ##'  \item y: y position of the center of the head.
 ##'  \item scale: scale of the man. It is the size of the man (in units of
 ##'  the Y axis).
 ##'  \item ratioxy: Ratio x to y of the graph (Use ratioxy <- diff(xrange) / diff(yrange))
 ##'  \item angleofspine: angle between the spine and a horizontal line
 ##'  that passes by the center of the head.
 ##'  \item anglerighthumerus, anglelefthumerus: angle between the right/left humerus and a
 ##'  horizontal line that passes by the top of the spine.
 ##'  \item anglerightradius, angleleftradius: angle between the right/left radius and a
 ##'  horizontal line that passes by the end of the right/left humerus.
 ##'  \item anglerightleg, anglelefthleg:  angle between the right/left left and a
 ##'  horizontal line that passes by the end of the end of the spine.
 ##'  \item angleofneck: angle between the begin of spine and a horizontal
 ##'  line that passes by the center of the head.
 ##'}
 ##'Angles are in radians.
 ##'
 ##'  
 ##' Additionally, you can use the aesthetics of \code{\link[ggplot2]{geom_path}},
 ##' and \code{xkcdline}.
##'
##' @title Draw a stick figure
##' @param mapping Mapping between variables and aesthetics generated by \code{\link[ggplot2]{aes}}. See Details.
##' @param data Dataset used in this layer.
##' @param ... Optional arguments.
##' @return A layer.
##' @seealso   \code{\link[ggplot2]{aes}},  \code{\link[ggplot2]{geom_path}},  \code{\link{xkcdline}}
##' @keywords manip
##' @import ggplot2
##' @export
##' @examples
##' datascaled <- data.frame(x=c(-3,3),y=c(-30,30))
##' p <- ggplot(data=datascaled, aes(x=x,y=y)) + geom_point()
##' xrange <- range(datascaled$x)
##' yrange <- range(datascaled$y)
##' ratioxy <- diff(xrange) / diff(yrange)
##'  
##' mapping <- aes(x=x,
##'                y=y,
##'                scale=scale,
##'                ratioxy=ratioxy,
##'                angleofspine = angleofspine,
##'                anglerighthumerus = anglerighthumerus,
##'                anglelefthumerus = anglelefthumerus,
##'                anglerightradius = anglerightradius,
##'                angleleftradius = angleleftradius,
##'                anglerightleg =  anglerightleg,
##'                angleleftleg = angleleftleg,
##'                angleofneck = angleofneck,
##'                color = color )
##'  
##' dataman <- data.frame( x= c(-1,0,1), y=c(-10,0,10),
##'                   scale = c(10,7,5),
##'                   ratioxy = ratioxy,
##'                   angleofspine =  seq(- pi / 2, -pi/2 + pi/8, l=3) ,
##'                   anglerighthumerus = -pi/6,
##'                   anglelefthumerus = pi + pi/6,
##'                   anglerightradius = 0,
##'                   angleleftradius = runif(3,- pi/4, pi/4),
##'                   angleleftleg = 3*pi/2  + pi / 12 ,
##'                   anglerightleg = 3*pi/2  - pi / 12,
##'                   angleofneck = runif(3, min = 3 * pi / 2 - pi/10 , max = 3 * pi / 2 + pi/10),
##'                   color=c("A","B","C"))
##'  
##' p + xkcdman(mapping,dataman)
xkcdman <- function(mapping, data, ...) {

    requiredaesthetics <-  c("x","y",
                             "scale",
                             "ratioxy",
                             "angleofspine",
                             "anglerighthumerus",
                             "anglelefthumerus",
                             "anglerightradius",
                             "angleleftradius",
                             "anglerightleg",
                             "angleleftleg",
                             "angleofneck")


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

    centerofhead <- cbind(data$x,data$y)
    diameterofhead <-  data$scale
    lengthofspine <- diameterofhead
    lengthofleg <- lengthofspine * 1.2
    lengthofhumerus <- lengthofspine * 0.6
    lengthofradius <- lengthofspine * 0.5
    beginspine <- centerofhead + (diameterofhead / 2) * cbind( cos(data$angleofneck) * data$ratioxy, sin( data$angleofneck))
    endspine <- beginspine + lengthofspine * cbind( cos( data$angleofspine) * data$ratioxy , sin(data$angleofspine))
    endrighthumerus <- beginspine + lengthofhumerus * cbind( cos( data$anglerighthumerus) * data$ratioxy, sin(data$anglerighthumerus))
    endlefthumerus <- beginspine + lengthofhumerus * cbind( cos( data$anglelefthumerus)* data$ratioxy, sin(data$anglelefthumerus))

    bone <- function(begin, distance, angle, ratioxy, mapping, data, ... ) {
        end <- cbind( begin[,1] + distance * cos( angle ) * ratioxy, begin[,2] + distance * sin(angle) )
        data$x <- begin[,1]
        data$y <- begin[,2]
        data$xend <- end[,1]
        data$yend <- end[,2]

        ttmapping <- unlist(mapping)
        ttmapping$x <- parse(text = "x")[[1]]
        ttmapping$y <- parse(text = "y")[[1]]
        ttmapping$xend <- parse(text = "xend")[[1]]
        ttmapping$yend <- parse(text = "yend")[[1]]
        newmapping <- structure(ttmapping, class = "uneval")

        xkcdline(mapping=newmapping, data=data, ...)
    }

    head <- function(centerofhead, diameter, ratioxy , mapping, data,...) {
        data$diameter <- diameter

        ttmapping <- unlist(mapping)
        ttmapping$diameter <- parse(text = "diameter")[[1]]
        newmapping <- structure(ttmapping, class = "uneval")
        xkcdline(mapping = newmapping, data =data, typexkcdline="circunference", ...)
    }

    c(head(centerofhead=centerofhead, diameter = diameterofhead, ratioxy = data$ratioxy, mapping = mapping, data = data, ...),
      bone(begin = beginspine, distance = lengthofspine, angle = data$angleofspine, ratioxy = data$ratioxy, mapping =mapping, data = data, ...  ),
      bone(begin = beginspine, distance = lengthofhumerus, angle = data$anglerighthumerus, ratioxy = data$ratioxy, mapping =mapping, data = data, ...) , # right humerus
      bone(begin = endrighthumerus, distance = lengthofradius, angle = data$anglerightradius , ratioxy = data$ratioxy, mapping =mapping, data = data, ...),
      bone(begin = beginspine, distance = lengthofhumerus, angle = data$anglelefthumerus, ratioxy = data$ratioxy, mapping =mapping, data = data, ...),
      bone(begin = endlefthumerus, distance = lengthofradius, angle = data$angleleftradius, ratioxy = data$ratioxy, mapping =mapping, data = data, ...),
      bone(begin = endspine, distance = lengthofleg, angle = data$angleleftleg, ratioxy = data$ratioxy, mapping =mapping, data = data, ...), # Leg
      bone(begin = endspine, distance = lengthofleg, angle = data$anglerightleg, ratioxy= data$ratioxy, mapping =mapping, data = data, ...)
      ) #Leg
}