R/auxiliaries.R

In zenplots: Zigzag Expanded Navigation Plots

##' @title Scale data to [0,1]
##' @param x vector or matrix
##' @param method character string indicating the method to be used
##'        if x is a matrix: scale all x with the same linear
##'        transformation or scale the columns/rows of x componentwise
##' @param ... additional arguments passed to range() or rank()
##' @return x scaled to [0,1]
##' @author Marius Hofert
scale01 <- function(x, method=c("columnwise", "rowwise", "all", "pobs"), ...)
{
    if(is.data.frame(x)) x <- data.matrix(x)
    stopifnot(is.matrix(x))
    method <- match.arg(method)
    switch(method,
           "columnwise" = {
               apply(x, 2, FUN=function(x.) {
                         ran <- range(x., ...)
                         (x.-ran[1])/diff(ran)
                     })
           },
           "rowwise" = {
               apply(x, 1, FUN=function(x.) {
                         ran <- range(x., ...)
                         (x.-ran[1])/diff(ran)
                     })
           },
           "all" = {
               ran <- range(x, ...)
               (x-ran[1])/diff(ran)
           },
           "pobs" = {
               ## If not given, use na.last = "keep"
               if(hasArg("na.last")) {
                   apply(x, 2, rank, ...) / (nrow(x)+1)
               } else apply(x, 2, rank, na.last="keep", ...) / (nrow(x)+1)
           },
           stop("Wrong 'method'"))
}

##' @title Converting an Occupancy Matrix (consisting of 0--4) to
##'        a Human Readable Matrix
##' @param x an occupancy matrix
##' @param to symbols being mapped to by the occupancy matrix
##' @return matrix of encoded entries of the occupancy matrix
##' @author Marius Hofert
occupancy_to_human <- function(x, to=c("", "<", ">", "v", "^"))
{
    stopifnot(0 <= x, x <= 4, length(to) == 5)
    if(is.matrix(x)) {
        dm <- dim(x)
        matrix(to[x+1], nrow=dm[1], ncol=dm[2])
    } else {
        to[x+1]
    }
}

##' @title Creating a Gray Color with Alpha Blending
##' @param n a number determining the alpha levels if alpha is NULL
##'        (= number of distinguishable layers on each pixel); n/10 = number of
##'        points needed to saturate
##' @param h see ?hcl
##' @param c see ?hcl
##' @param l see ?hcl
##' @param alpha see ?hcl; if NULL, then alpha is determined from 'n'
##' @param fixup see ?hcl
##' @return hcl alpha blended gray color
##' @author Marius Hofert and Wayne Oldford
gray_alpha_blend <- function(n, h=260, c=0, l=65, alpha=NULL, fixup=TRUE)
    hcl(h, c=c, l=l, alpha=if(is.null(alpha)) 1/(n/10 + 1) else alpha, fixup=fixup)

##' @title Defining an arrow
##' @param turn The direction in which the arrow shall point ("l", "r", "d", "u")
##' @param length The length of the arrow
##' @param angle The angle
##' @return A 3-column matrix containing the (x,y) coordinates of the left
##'         edge end point, the arrow head and the right edge end point
##' @author Marius Hofert
zen_arrow <- function(turn, length, angle=30)
{
    ## Convert angle
    stopifnot(0 <= angle, angle <= 90)
    th <- (pi/2)*angle/90 # now in radians
    ## Define the 3 points around the center (0,0) determining the base arrow
    ## (pointing right)
    left <-  length * c(-0.5,  tan(th)) # end point of left edge of the arrow head
    right <- length * c(-0.5, -tan(th)) # end point of right edge of the arrow head
    head <-  length * c( 0.5, 0) # arrow head
    ## Now turn the base arrow appropriately
    rot <- switch(turn,
                  "l" = {   pi },
                  "r" = {    0 },
                  "d" = { 3*pi/2 },
                  "u" = {   pi/2 },
                  stop("Wrong 'turn'"))
    rot.mat <- matrix(c(cos(rot), -sin(rot), sin(rot), cos(rot)),
                      nrow=2, ncol=2, byrow=TRUE)
    left <- rot.mat %*% left
    right <- rot.mat %*% right
    head <- rot.mat %*% head
    ## Return
    cbind(left=left, head=head, right=right)
}