R/getlayout.R

##' @title Auxiliary function for adjusting a bounding box
##' @param lastturn last turn
##' @param coordslastBB coordinates of the last bounding box
##' @param w width
##' @param h height
##' @return Coordinates of the adjusted bounding box
##' @author Wayne Oldford
adjust_bb <- function(lastturn, coordslastBB, w, h)
{
    stopifnot(lastturn %in% c("d", "u", "r", "l"),
              names(coordslastBB) == c("left", "right", "bottom", "top"),
              w >= 0, h >= 0)
    switch(lastturn,
           "l" = {
               c(coordslastBB["left"] - w,
                 coordslastBB["left"],
                 coordslastBB["bottom"],
                 coordslastBB["top"])
           },
           "r" = {
               c(coordslastBB["right"],
                 coordslastBB["right"] + w,
                 coordslastBB["bottom"],
                 coordslastBB["top"])
           },
           "d" = {
               c(coordslastBB["left"],
                 coordslastBB["right"],
                 coordslastBB["bottom"] - h,
                 coordslastBB["bottom"])
           },
           "u" = {
               c(coordslastBB["left"],
                 coordslastBB["right"],
                 coordslastBB["top"],
                 coordslastBB["top"] + h)
           },
           stop("Wrong 'turns'"))
}

##' @title Compute the layout of the zen plot
##' @param nVars number of variables (>= 1)
##' @param turns turns (character vector consisting if "u", "d", "l", "r")
##' @param last1d logical indicating whether the last 1d plot should be omitted
##'        from the path
##' @param width1d width of 1d plots
##' @param width2d width of 2d plots
##' @return list containing
##'         1) the plot orientations (c("h", "s", "v", "s", ...))
##'         2) the plot dimensions (1d plot, 2d plot, 1d plot, ...)
##'         3) the variable numbers plotted (an (nPlots, 2)-matrix)
##'         4) the total width of the layout
##'         5) the total height of the layout
##'         6) coordinates of the bounding boxes
##' @author Wayne Oldford
get_layout <- function(nVars, turns, last1d=TRUE, width1d=1, width2d=10)
{
    stopifnot(nVars >= 1, length(turns) == if(last1d) 2*nVars-1 else 2*nVars-2,
              is.character(turns) && all(turns %in% c("d", "u", "r", "l")),
              width1d >= 0, width2d >= 0)
    dimensions <- if(last1d) c(rep(1:2, nVars-1), 1) else rep(1:2, nVars-1) # plot dimensions (1d plot, 2d plot, 1d plot, ...)
    nPlots <- length(dimensions) # number of plots; >= 1 (checked)
    orientations <- rep("s", nPlots) # plot orientations ("s"=square, "h"=horizontal, "v"=vertical)

    ## Determine positions of bounding boxes (in terms of default width and
    ## height units); for each plot, start at zero
    coordsBB <- matrix(0, nrow=nPlots, ncol=4,
                       dimnames=list(NULL, c("left", "right", "bottom", "top")))

    ## Now we have to build the variable selections and their information
    vars <- matrix(0, nrow=nPlots, ncol=2, dimnames=list(NULL, c("x", "y")))
    if (dimensions[1]==1) {
        lastVar <- 1
        curVar <- lastVar
        vars[1,] <- c(1, 1)
        if (turns[1] %in% c("u", "d")) {
            orientations[1] <- "h"
	    coordsBB[1, "right"] <- width2d
	    coordsBB[1, "top"]   <- width1d
        } else if(turns[1] %in% c("l", "r")) {
            orientations[1] <- "v"
	    coordsBB[1, "right"] <- width1d
	    coordsBB[1, "top"]   <- width2d
        } else stop("Wrong 'turns'")
    } else {
        lastVar <- 1
        curVar <- 2
        vars[1,] <- c(1, 2)
        lastVar <- curVar
        coordsBB[1, "right"] <- width2d
        coordsBB[1, "top"]   <- width2d
    }

    ## Loop over all plots starting from the 2nd
    for(i in 1+seq_len(nPlots-1)) { # 2,3,...,nPlots
        if(dimensions[i] == 1) {
            vars[i,] <- rep(curVar, 2)
            coordsBB[i,] <-
                switch(turns[i],
                       "l" = {
                           orientations[i]="v"
                           adjust_bb(turns[i-1], coordslastBB=coordsBB[i-1,],
                                     w=width1d, h=width2d)
                       },
                       "r" = {
                           orientations[i]="v"
                           adjust_bb(turns[i-1], coordslastBB=coordsBB[i-1,],
                                     w=width1d, h=width2d)
                       },
                       "d" = {
                           orientations[i]="h"
                           adjust_bb(turns[i-1], coordslastBB=coordsBB[i-1,],
                                     w=width2d, h=width1d)
                       },
                       "u" = {
                           orientations[i]="h"
                           adjust_bb(turns[i-1], coordslastBB=coordsBB[i-1,],
                                     w=width2d, h=width1d)
                       },
                       stop("Wrong 'turns' for 1d plot"))
        } else { # dimensions[i] == 2
            curVar <- curVar + 1
            coordsBB[i,] <- adjust_bb(turns[i-1], coordslastBB=coordsBB[i-1,],
                                      w=width2d, h=width2d)
            vars[i,] <- switch(turns[i],
                               "l" = {
                                   c(lastVar, curVar)
                               },
                               "r" = {
                                   c(lastVar, curVar)
                               },
                               "d" = {
                                   c(curVar, lastVar)
                               },
                               "u" = {
                                   c(curVar, lastVar)
                               },
                               stop("Wrong 'turns' for 2d plot"))
            lastVar <- curVar
        }
    }

    ## Return
    LayoutWidth  <- diff(range(coordsBB[,c(  "left", "right")])) # total width
    LayoutHeight <- diff(range(coordsBB[,c("bottom", "top")])) # total height
    list(orientations = orientations, # vector of plot orientations ("s"=square, "h"=horizontal, "v"=vertical)
         dimensions = dimensions, # plot dimensions (1d plot, 2d plot, 1d plot, ...)
         vars = vars, # (nPlots, 2)-matrix of variables
         LayoutWidth = LayoutWidth, LayoutHeight = LayoutHeight, # total width and height
         boundingBoxes = coordsBB) # bounding boxes
}

Try the zenplots package in your browser

Any scripts or data that you put into this service are public.

zenplots documentation built on May 2, 2019, 4:34 p.m.