|
5 | 5 | #' @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). |
6 | 6 | #' @param which a character, one of `plot`, `figure`, `inner` and `outer`. |
7 | 7 | #' @param fill the color to be used to fill the box. |
8 | | -#' @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`. |
| 8 | +#' @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`. |
9 | 9 | #' |
10 | 10 | #' @keywords box |
11 | 11 | #' |
12 | 12 | #' @export |
13 | 13 | #' |
14 | | -#' @details This function intends to give more flexibility to the \code{[graphics::box()]} function. |
15 | | -#' 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}. |
| 14 | +#' @details This function intends to give more flexibility to the `[graphics::box()]` function. |
| 15 | +#' 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`. |
16 | 16 | #' |
17 | 17 | #' |
18 | | -#' @seealso \code{[graphics::box()]} |
| 18 | +#' @seealso `[graphics::box()]` |
19 | 19 | #' |
20 | 20 | #' @examples |
21 | 21 | #' # Example 1: |
|
31 | 31 | #' box2(c(1,4), fill='grey80', lwd=2) |
32 | 32 | #' |
33 | 33 | #' # Example 3: |
34 | | -#' graphics::par(mfrow=c(2,2),oma=c(2,2,2,2)) |
| 34 | +#' par(mfrow=c(2,2),oma=c(2,2,2,2)) |
35 | 35 | #' plot0(0,0) |
36 | | -#' graphics::box('outer',lwd=2) |
37 | | -#' graphics::box('inner',lwd=2) |
38 | | -#' graphics::plot.default(0,0) |
39 | | -#' graphics::plot.default(0,0) |
| 36 | +#' box('outer',lwd=2) |
| 37 | +#' box('inner',lwd=2) |
| 38 | +#' plot.default(0,0) |
| 39 | +#' plot.default(0,0) |
40 | 40 | #' plot0() |
41 | 41 | #' box2(which='figure',lwd=2, fill=2) |
42 | 42 | #' box2(side=12, lwd=2, fill=8) |
43 | 43 |
|
44 | 44 |
|
45 | | -box2 <- function(side = 1:4, which = "plot", fill = NULL, ...) { |
46 | | - ## |
47 | | - stopifnot(which %in% c("plot", "figure", "outer", "inner")) |
48 | | - ## |
| 45 | +box2 <- function(side, which = c("plot", "figure", "outer", "inner"), |
| 46 | + fill = NULL, ...) { |
| 47 | + ## |
| 48 | + which <- match.arg(which) |
| 49 | + if (missing(side)) side <- 1:4 |
| 50 | + ## get the sides desired |
49 | 51 | vec <- unlist(strsplit(tolower(as.character(side)), "")) |
50 | | - ax1 <- match(vec, c("1", "2", "3", "4"))%%5 |
51 | | - ax2 <- match(vec, c("b", "l", "t", "r"))%%5 |
| 52 | + ax1 <- match(vec, as.character(1:4)) %% 5 |
| 53 | + ax2 <- match(vec, c("b", "l", "t", "r")) %% 5 |
52 | 54 | ax <- unique(c(ax1, ax2), na.rm = TRUE) |
53 | 55 | ax <- ax[!is.na(ax)] |
54 | | - ## |
| 56 | + ## |
55 | 57 | if (length(ax)) { |
56 | | - coord <- graphics::par()$usr |
| 58 | + opar <- par(no.readonly = TRUE) |
| 59 | + on.exit(par(opar)) |
| 60 | + coord <- opar$usr |
57 | 61 | if (which != "plot") { |
58 | 62 | ## figure margins in user units |
59 | | - cvx <- (graphics::par()$usr[2L] - graphics::par()$usr[1L])/graphics::par()$pin[1L] |
60 | | - cvy <- (graphics::par()$usr[4L] - graphics::par()$usr[3L])/graphics::par()$pin[2L] |
61 | | - mau <- graphics::par()$mai * rep(c(cvy, cvx), 2) |
| 63 | + cvx <- (opar$usr[2L] - opar$usr[1L])/opar$pin[1L] |
| 64 | + cvy <- (opar$usr[4L] - opar$usr[3L])/opar$pin[2L] |
| 65 | + mau <- opar$mai * rep(c(cvy, cvx), 2) |
62 | 66 | coord <- coord + c(-mau[2L], mau[4L], -mau[1L], mau[3L]) |
63 | 67 | ## inner margins in user units (get the lenght and adjust!) |
64 | 68 | if (which != "figure") { |
65 | 69 | diffx <- coord[2L] - coord[1L] |
66 | 70 | diffy <- coord[4L] - coord[3L] |
67 | | - lenx <- diffx * 1/(diff(graphics::par()$fig[1L:2L])) |
68 | | - leny <- diffy * 1/(diff(graphics::par()$fig[1L:2L])) |
69 | | - coord[1L] <- coord[1L] - graphics::par()$fig[1L] * lenx |
| 71 | + lenx <- diffx * 1/(diff(opar$fig[1L:2L])) |
| 72 | + leny <- diffy * 1/(diff(opar$fig[1L:2L])) |
| 73 | + coord[1L] <- coord[1L] - opar$fig[1L] * lenx |
70 | 74 | coord[2L] <- coord[1L] + lenx |
71 | | - coord[3L] <- coord[3L] - graphics::par()$fig[3L] * leny |
| 75 | + coord[3L] <- coord[3L] - opar$fig[3L] * leny |
72 | 76 | coord[4L] <- coord[3L] + leny |
73 | 77 | ## outer margins in user units |
74 | 78 | if (which != "inner") { |
75 | | - omu <- graphics::par()$omi * rep(c(cvy, cvx), 2) |
| 79 | + omu <- opar$omi * rep(c(cvy, cvx), 2) |
76 | 80 | coord <- coord + c(-omu[2L], omu[4L], -omu[1L], omu[3L]) |
77 | 81 | } |
78 | 82 | } |
79 | 83 | } |
80 | | - op <- graphics::par("xpd") |
81 | | - graphics::par(xpd = NA) |
| 84 | + op <- par("xpd") |
| 85 | + par(xpd = NA) |
82 | 86 | mat <- matrix(c(4, 2, 3, 1, 3, 1, 4, 2), ncol = 2) |
83 | | - if (!is.null(fill)) |
84 | | - graphics::rect(coord[1L], coord[3L], coord[2L], coord[4L], col = fill, |
85 | | - border = NA) |
| 87 | + if (!is.null(fill)) |
| 88 | + rect(coord[1L], coord[3L], coord[2L], coord[4L], |
| 89 | + col = fill, border = NA) |
86 | 90 | for (i in ax) { |
87 | 91 | coordb <- coord |
88 | 92 | coordb[mat[i, 1L]] <- coordb[mat[i, 2L]] |
89 | | - graphics::lines(c(coordb[1L], coordb[2L]), c(coordb[3L], coordb[4L]), |
90 | | - ...) |
| 93 | + lines(c(coordb[1L], coordb[2L]), c(coordb[3L], coordb[4L]), ...) |
91 | 94 | } |
92 | | - graphics::par(xpd = op) |
93 | | - } else warning("'bty' does not match any of '1', '2', '3', '4', 'b', 'l', 't', 'r'") |
94 | | - |
95 | | - invisible(NULL) |
| 95 | + } else warning("'side' does not match ant of the available values.") |
| 96 | + |
| 97 | + invisible(ax) |
96 | 98 | } |
0 commit comments