Ganttchart

DESCRIPTION

@@ -2,10 +2,13 @@ Package: graphicsutils
 Type: Package
 Title: Collection of graphics utilities
 Version: 1.3.0-9000
-Date: 2019-08-07
-Authors@R: c(person("Kevin", "Cazelles", role = c("aut", "cre"), email = "kcazelle@uoguelph.ca", comment = c(ORCID = "0000-0001-6619-9874")),
-  person("Nicolas", "Casajus", role = c("aut"), comment = c(ORCID = "0000-0002-5537-5294")),
-  person("David", "Beauchesne", role = c("aut")))
+Date: 2019-08-16
+Authors@R: c(
+  person("Kevin", "Cazelles", role = c("aut", "cre"), email = "kcazelle@uoguelph.ca", comment = c(ORCID = "0000-0001-6619-9874")),
+  person("Nicolas", "Casajus", role = "aut", comment = c(ORCID = "0000-0002-5537-5294")),
+  person("David", "Beauchesne", role = "aut", comment = c(ORCID = "0000-0002-3590-8161")),
+  person(given = "Steve", family = "Vissault", comment = c(ORCID = "0000-0002-0866-4376"), role = "aut")
+  )
 Description: A collection of functions to make the customizing graphics-based plots easier.
 Depends:
     R (>= 3.0.0)

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(arrows2)
 export(biBoxplot)
+export(blendColors)
 export(box2)
 export(boxplot2)
 export(circles)
@@ -15,6 +16,7 @@ export(ellipse)
 export(encircle)
 export(envelop)
 export(frameIt)
+export(ganttChart)
 export(getAngle2d)
 export(gpuPalette)
 export(gpuPalettes)
@@ -46,21 +48,37 @@ export(translation)
 export(vecfield2d)
 import(Rcpp)
 importFrom(Rcpp,evalCpp)
+importFrom(grDevices,as.graphicsAnnot)
 importFrom(grDevices,as.raster)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)
+importFrom(grDevices,dev.off)
+importFrom(grDevices,palette)
+importFrom(grDevices,rgb)
+importFrom(grDevices,xy.coords)
 importFrom(graphics,abline)
+importFrom(graphics,axis)
 importFrom(graphics,box)
 importFrom(graphics,image)
 importFrom(graphics,layout)
+importFrom(graphics,layout.show)
 importFrom(graphics,lines)
 importFrom(graphics,lines.default)
 importFrom(graphics,locator)
 importFrom(graphics,par)
+importFrom(graphics,plot)
+importFrom(graphics,plot.default)
+importFrom(graphics,plot.new)
+importFrom(graphics,plot.window)
 importFrom(graphics,points)
+importFrom(graphics,polygon)
+importFrom(graphics,rasterImage)
 importFrom(graphics,rect)
+importFrom(graphics,strheight)
+importFrom(graphics,strwidth)
 importFrom(graphics,text)
 importFrom(stats,aggregate)
+importFrom(stats,as.formula)
 importFrom(stats,quantile)
 importFrom(stats,rnorm)
 importFrom(stats,runif)

R/arrows2.R

@@ -20,7 +20,7 @@
 #'
 #' @keywords arrows
 #'
-#' @seealso \code{[graphics::arrows()]}, \code{[shape::Arrows()]}
+#' @seealso `[graphics::arrows()]`, `[shape::Arrows()]`
 #'
 #' @examples
 #' # Example 1:
@@ -35,24 +35,25 @@
 #' arrows2(runif(2), runif(2), x1=runif(2), y1=runif(2), prophead=FALSE, lty=3)
 
 
-arrows2 <- function(x0, y0, x1 = x0, y1 = y0, off0 = 0, off1 = off0, cex.arr = 1,
-    cex.shr = 1, cex.hh = 1, cex.hl = 1, prophead = TRUE, twoheaded = FALSE, ...) {
+arrows2 <- function(x0, y0, x1 = x0, y1 = y0, off0 = 0, off1 = off0,
+    cex.arr = 1, cex.shr = 1, cex.hh = 1, cex.hl = 1, prophead = TRUE,
+    twoheaded = FALSE, ...) {
     stopifnot(all(c(off0, off1)^2 < 1))
     ## ---- Format checking / adjusting vectors sizes
     argn <- c("x0", "y0", "x1", "y1")
     argo <- list(x0, y0, x1, y1)
-    sz <- max(sapply(list(x0, y0, x1, y1), length))
-    for (i in 1L:length(argn)) assign(argn[i], rep_len(argo[[i]], sz))
+    sz <- max(lengths(list(x0, y0, x1, y1)))
+    for (i in seq_along(argn)) assign(argn[i], rep_len(argo[[i]], sz))
     argo <- list(x0, y0, x1, y1)
     ## ----
     rx <- (x1 - x0)
     ry <- (y1 - y0)
     distpt <- sqrt(rx * rx + ry * ry)
     # ----- Checking
     pb <- which(distpt == 0)
-    if (length(pb) > 0) {
+    if (length(pb)) {
         warning("Zero-length arrows are skipped.")
-        for (i in 1L:length(argn)) assign(argn[i], argo[[i]][-pb])
+        for (i in seq_along(argn)) assign(argn[i], argo[[i]][-pb])
     }
     ## ----
     anglept <- 0.5 * pi
@@ -70,7 +71,7 @@ arrows2 <- function(x0, y0, x1 = x0, y1 = y0, off0 = 0, off1 = off0, cex.arr = 1
     hg2 <- hg1 * cex.shr
     hg3 <- hg2 + cex.hh * hg1
     ## ----
-    for (i in 1L:sz) {
+    for (i in seq_len(sz)) {
         lg1 <- distpt[i]
         if (!prophead) {
             lg3 <- cex.hl * 0.06 * (myusr[2L] - myusr[1L])
@@ -90,9 +91,9 @@ arrows2 <- function(x0, y0, x1 = x0, y1 = y0, off0 = 0, off1 = off0, cex.arr = 1
                 -hg1, -hg2, -hg3)
         }
         ## ----
-        ptcoord <- rotation(sqptx, sqpty, rot = anglept[i], xrot = x0[i], yrot = y0[i],
-            rad = TRUE)
-        graphics::polygon(ptcoord$x, ptcoord$y, ...)
+        ptcoord <- rotation(sqptx, sqpty, rot = anglept[i], xrot = x0[i],
+          yrot = y0[i], rad = TRUE)
+        polygon(ptcoord$x, ptcoord$y, ...)
     }
     ## ----
     invisible(NULL)

R/biBoxplot.R

@@ -4,7 +4,7 @@
 #'
 #' @param df1 first set of boxplots.
 #' @param df2 first set of boxplots.
-#' @param probs numeric vector of five probabilities (see \code{[stats::quantile()]}).
+#' @param probs numeric vector of five probabilities (see `[stats::quantile()]`).
 #' @param width a vector giving the relative widths of the boxes making up the plot.
 #' @param sta_wd staple width.
 #' @param median a list of arguments passed to [graphics::lines()] to custom the median line.
@@ -16,13 +16,11 @@
 #' @param at numeric vector giving the locations where the boxplots should be drawn. Same default behavior as in [graphics::boxplot()].
 #' @keywords boxplots
 #'
-#' @importFrom graphics lines.default rect
-#' @importFrom stats quantile rnorm
 #' @export
 #'
 #' @details Do not attempt to assess the distributions. Based on quantiles only.
 #'
-#' @seealso \code{[graphics::box()]}
+#' @seealso `[graphics::box()]`
 #'
 #' @examples
 #' # Example 1:
@@ -52,7 +50,7 @@ biBoxplot <- function(df1, df2 = df1, probs = c(0.01, 0.25, 0.5, 0.75, 0.99), wi
     if (!isTRUE(add))
         plot0(c(0.5, sz + 0.5), range(unlist(c(seqy1, seqy2))))
 
-    for (i in 1:sz) {
+    for (i in seq_len(sz)) {
         makeUnit(at[i], seqy1[[i]], seqy2[[i]], width, sta_wd, col_left, col_right,
             dft_med, dft_sta, dft_whi)
     }

R/box2.R

@@ -5,17 +5,17 @@
 #' @param side a numerical or character vector or a character string specifying which side(s) of the plot the box is to be drawn (see details).
 #' @param which a character, one of `plot`, `figure`, `inner` and `outer`.
 #' @param fill the color to be used to fill the box.
-#' @param ... further graphical parameters (see \code{[graphics::par()]}) may also be supplied as arguments, particularly, line type, `lty`, line width, `lwd`, color, `col` and for \code{type = 'b'}, `pch`.  Also the line characteristics `lend`, `ljoin` and `lmitre`.
+#' @param ... further graphical parameters (see `[graphics::par()]`) may also be supplied as arguments, particularly, line type, `lty`, line width, `lwd`, color, `col` and for \code{type = 'b'}, `pch`.  Also the line characteristics `lend`, `ljoin` and `lmitre`.
 #'
 #' @keywords box
 #'
 #' @export
 #'
-#' @details This function intends to give more flexibility to the \code{[graphics::box()]} function.
-#' As `which` parameter, the user provides an object first coerced by \code{as.character} to a character string that is secondly split into single characters. For all of these characters, matches are sought with all elements of \code{1, 2, 3, 4, b, l, t, r} where \code{1=below, 2=left, 3=above, 4=right, b=below, l=left, t=above and r=right}.
+#' @details This function intends to give more flexibility to the `[graphics::box()]` function.
+#' As `which` parameter, the user provides an object first coerced by `as.character` to a character string that is secondly split into single characters. For all of these characters, matches are sought with all elements of `1, 2, 3, 4, b, l, t, r` where `1=below, 2=left, 3=above, 4=right, b=below, l=left, t=above and r=right`.
 #'
 #'
-#' @seealso \code{[graphics::box()]}
+#' @seealso `[graphics::box()]`
 #'
 #' @examples
 #' # Example 1:
@@ -31,66 +31,68 @@
 #' box2(c(1,4), fill='grey80', lwd=2)
 #'
 #' # Example 3:
-#' graphics::par(mfrow=c(2,2),oma=c(2,2,2,2))
+#' par(mfrow=c(2,2),oma=c(2,2,2,2))
 #' plot0(0,0)
-#' graphics::box('outer',lwd=2)
-#' graphics::box('inner',lwd=2)
-#' graphics::plot.default(0,0)
-#' graphics::plot.default(0,0)
+#' box('outer',lwd=2)
+#' box('inner',lwd=2)
+#' plot.default(0,0)
+#' plot.default(0,0)
 #' plot0()
 #' box2(which='figure',lwd=2, fill=2)
 #' box2(side=12, lwd=2, fill=8)
 
 
-box2 <- function(side = 1:4, which = "plot", fill = NULL, ...) {
-    ## 
-    stopifnot(which %in% c("plot", "figure", "outer", "inner"))
-    ## 
+box2 <- function(side, which = c("plot", "figure", "outer", "inner"),
+  fill = NULL, ...) {
+    ##
+    which <- match.arg(which)
+    if (missing(side)) side <- 1:4
+    ## get the sides desired
     vec <- unlist(strsplit(tolower(as.character(side)), ""))
-    ax1 <- match(vec, c("1", "2", "3", "4"))%%5
-    ax2 <- match(vec, c("b", "l", "t", "r"))%%5
+    ax1 <- match(vec, as.character(1:4)) %% 5
+    ax2 <- match(vec, c("b", "l", "t", "r")) %% 5
     ax <- unique(c(ax1, ax2), na.rm = TRUE)
     ax <- ax[!is.na(ax)]
-    ## 
+    ##
     if (length(ax)) {
-        coord <- graphics::par()$usr
+        opar <- par(no.readonly = TRUE)
+        on.exit(par(opar))
+        coord <- opar$usr
         if (which != "plot") {
             ## figure margins in user units
-            cvx <- (graphics::par()$usr[2L] - graphics::par()$usr[1L])/graphics::par()$pin[1L]
-            cvy <- (graphics::par()$usr[4L] - graphics::par()$usr[3L])/graphics::par()$pin[2L]
-            mau <- graphics::par()$mai * rep(c(cvy, cvx), 2)
+            cvx <- (opar$usr[2L] - opar$usr[1L])/opar$pin[1L]
+            cvy <- (opar$usr[4L] - opar$usr[3L])/opar$pin[2L]
+            mau <- opar$mai * rep(c(cvy, cvx), 2)
             coord <- coord + c(-mau[2L], mau[4L], -mau[1L], mau[3L])
             ## inner margins in user units (get the lenght and adjust!)
             if (which != "figure") {
                 diffx <- coord[2L] - coord[1L]
                 diffy <- coord[4L] - coord[3L]
-                lenx <- diffx * 1/(diff(graphics::par()$fig[1L:2L]))
-                leny <- diffy * 1/(diff(graphics::par()$fig[1L:2L]))
-                coord[1L] <- coord[1L] - graphics::par()$fig[1L] * lenx
+                lenx <- diffx * 1/(diff(opar$fig[1L:2L]))
+                leny <- diffy * 1/(diff(opar$fig[1L:2L]))
+                coord[1L] <- coord[1L] - opar$fig[1L] * lenx
                 coord[2L] <- coord[1L] + lenx
-                coord[3L] <- coord[3L] - graphics::par()$fig[3L] * leny
+                coord[3L] <- coord[3L] - opar$fig[3L] * leny
                 coord[4L] <- coord[3L] + leny
                 ## outer margins in user units
                 if (which != "inner") {
-                  omu <- graphics::par()$omi * rep(c(cvy, cvx), 2)
+                  omu <- opar$omi * rep(c(cvy, cvx), 2)
                   coord <- coord + c(-omu[2L], omu[4L], -omu[1L], omu[3L])
                 }
             }
         }
-        op <- graphics::par("xpd")
-        graphics::par(xpd = NA)
+        op <- par("xpd")
+        par(xpd = NA)
         mat <- matrix(c(4, 2, 3, 1, 3, 1, 4, 2), ncol = 2)
-        if (!is.null(fill)) 
-            graphics::rect(coord[1L], coord[3L], coord[2L], coord[4L], col = fill, 
-                border = NA)
+        if (!is.null(fill))
+            rect(coord[1L], coord[3L], coord[2L], coord[4L],
+              col = fill, border = NA)
         for (i in ax) {
             coordb <- coord
             coordb[mat[i, 1L]] <- coordb[mat[i, 2L]]
-            graphics::lines(c(coordb[1L], coordb[2L]), c(coordb[3L], coordb[4L]), 
-                ...)
+            lines(c(coordb[1L], coordb[2L]), c(coordb[3L], coordb[4L]), ...)
         }
-        graphics::par(xpd = op)
-    } else warning("'bty' does not match any of '1', '2', '3', '4', 'b', 'l', 't', 'r'")
-
-    invisible(NULL)
+    } else warning("'side' does not match ant of the available values.")
+
+    invisible(ax)
 }

R/boxplot2.R

@@ -23,8 +23,6 @@
 #' @return
 #' Draw a boxplot and returns the coordinates as an invisible output.
 #'
-#' @importFrom graphics lines points
-#' @importFrom stats aggregate quantile runif
 #' @export
 #'
 #' @examples
@@ -50,7 +48,7 @@ boxplot2 <- function(x, ..., probs = c(.05, 0.25, .5, .75, .95),
     val <- apply(as.data.frame(x), 2, quantile, probs = probs)
   }
   ##
-  if (is.null(at)) xco <- 1:ncol(val) else xco <- rep_len(at, ncol(val))
+  if (is.null(at)) xco <- seq_len(ncol(val)) else xco <- rep_len(at, ncol(val))
   ##
   if (!add)
     plot0(c(.5, ncol(val) + .5), range(val))

R/circles.R

@@ -11,7 +11,7 @@
 #' @param pie a logical. If `TRUE`, end points are linked with the center of the circle (default is set to `FALSE`).
 #' @param clockwise a logical. Shall circles and arcs be drawn clockwise? Defaut is `FALSE`.
 #' @param add a logical. Should the circles be added on the current plot?
-#' @param ... additional arguments to be passed to \code{[graphics::polygon()]} function.
+#' @param ... additional arguments to be passed to `[graphics::polygon()]` function.
 #'
 #' @keywords circle geometries
 #'
@@ -23,10 +23,10 @@
 #' Sizes are adjusted (i.e. repeated over) with \code{\link{rep_len}} function.
 #'
 #' @return
-#' An invisible list of \code{data.frame} of two columns including the
+#' An invisible list of `data.frame` of two columns including the
 #' coordinates of all circles.
 #'
-#' @seealso \code{[graphics::symbols()]}, \code{\link[plotrix]{draw.circle}}, \code{\link[plotrix]{draw.arc}}.
+#' @seealso `[graphics::symbols()]`, \code{\link[plotrix]{draw.circle}}, \code{\link[plotrix]{draw.arc}}.
 #'
 #' @examples
 #' # Example 1:
@@ -47,26 +47,26 @@
 #' plot0(x=c(-2,2),y=c(-2,2), asp=1)
 #' circles(x=c(-1,1),c(1,1,-1,-1),from=pi*seq(0.25,1,by=0.25),to=1.25*pi, col=2, border=4, lwd=3)
 
-circles <- function(x, y = x, radi = 1, from = 0, to = 2 * pi, incr = 0.01, pie = FALSE, 
+circles <- function(x, y = x, radi = 1, from = 0, to = 2 * pi, incr = 0.01, pie = FALSE,
     clockwise = FALSE, add = TRUE, ...) {
-    # 
+    #
     pipi <- 2 * pi
-    # 
-    if (!isTRUE(add)) 
+    #
+    if (!isTRUE(add))
         plot0()
     # format checking / adjusting vectors sizes
     matx <- as.matrix(x)
     argn <- c("x", "y", "radi", "from", "to")
     nbarg <- length(argn)
     nbcol <- min(nbarg, ncol(matx))
-    for (i in 1L:nbcol) assign(argn[i], matx[, i])
+    for (i in seq_len(nbcol)) assign(argn[i], matx[, i])
     argo <- list(x, y, radi, from, to)
-    ## 
-    sz <- max(sapply(argo, length))
-    for (i in 1L:nbarg) assign(argn[i], rep_len(argo[[i]], sz))
+    ##
+    sz <- max(lengths(argo))
+    for (i in seq_len(nbarg)) assign(argn[i], rep_len(argo[[i]], sz))
     # drawing circles
     out <- list()
-    for (i in 1L:sz) {
+    for (i in seq_len(sz)) {
         ## distance (in rardian)
         dagl <- abs(to[i] - from[i])
         ## --- angles sequence
@@ -75,24 +75,24 @@ circles <- function(x, y = x, radi = 1, from = 0, to = 2 * pi, incr = 0.01, pie
             to[i] <- pipi + 0.5 * pi
             from[i] <- 0.5 * pi
         }
-        ## 
+        ##
         if (!clockwise) {
             sqc <- seq(from[i], from[i] + dagl, by = incr)
         } else {
             sqc <- seq(from[i], from[i] - dagl, by = -incr)
         }
-        ## 
+        ##
         if (!pie) {
             xout <- x[i] + radi[i] * cos(sqc)
             yout <- y[i] + radi[i] * sin(sqc)
         } else {
             xout <- x[i] + c(0, radi[i] * cos(sqc), 0)
             yout <- y[i] + c(0, radi[i] * sin(sqc), 0)
         }
-        
-        graphics::polygon(xout, yout, ...)
+
+        polygon(xout, yout, ...)
         out[[i]] <- data.frame(x = xout, y = yout)
     }
-    
+
     invisible(out)
 }