R Under development (unstable) (2024-02-26 r85989) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > pkgname <- "grDevices" > source(file.path(R.home("share"), "R", "examples-header.R")) > options(warn = 1) > library('grDevices') > > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') > base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv') > cleanEx() > nameEx("Devices") > ### * Devices > > flush(stderr()); flush(stdout()) > > ### Name: Devices > ### Title: List of Graphical Devices > ### Aliases: Devices device > ### Keywords: device > > ### ** Examples > ## Not run: > ##D ## open the default screen device on this platform if no device is > ##D ## open > ##D if(dev.cur() == 1) dev.new() > ## End(Not run) > > > cleanEx() > nameEx("Hershey") > ### * Hershey > > flush(stderr()); flush(stdout()) > > ### Name: Hershey > ### Title: Hershey Vector Fonts in R > ### Aliases: Hershey > ### Keywords: aplot > > ### ** Examples > > Hershey $typeface [1] "serif" "sans serif" "script" [4] "gothic english" "gothic german" "gothic italian" [7] "serif symbol" "sans serif symbol" $fontindex [1] "plain" "italic" "bold" "bold italic" [5] "cyrillic" "oblique cyrillic" "EUC" $allowed [,1] [,2] [1,] 1 1 [2,] 1 2 [3,] 1 3 [4,] 1 4 [5,] 1 5 [6,] 1 6 [7,] 1 7 [8,] 2 1 [9,] 2 2 [10,] 2 3 [11,] 2 4 [12,] 3 1 [13,] 3 2 [14,] 3 3 [15,] 4 1 [16,] 5 1 [17,] 6 1 [18,] 7 1 [19,] 7 2 [20,] 7 3 [21,] 7 4 [22,] 8 1 [23,] 8 2 > > ## for tables of examples, see demo(Hershey) > > > > cleanEx() > nameEx("Japanese") > ### * Japanese > > flush(stderr()); flush(stdout()) > > ### Name: Japanese > ### Title: Japanese characters in R > ### Aliases: Japanese > ### Keywords: aplot > > ### ** Examples > > require(graphics) > > plot(1:9, type = "n", axes = FALSE, frame.plot = TRUE, ylab = "", + main = "example(Japanese)", xlab = "using Hershey fonts") > par(cex = 3) > Vf <- c("serif", "plain") > text(4, 2, "\\#J244b\\#J245b\\#J2473", vfont = Vf) > text(4, 4, "\\#J2538\\#J2563\\#J2551\\#J2573", vfont = Vf) > text(4, 6, "\\#J467c\\#J4b5c", vfont = Vf) > text(4, 8, "Japan", vfont = Vf) > par(cex = 1) > text(8, 2, "Hiragana") > text(8, 4, "Katakana") > text(8, 6, "Kanji") > text(8, 8, "English") > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("Type1Font") > ### * Type1Font > > flush(stderr()); flush(stdout()) > > ### Name: Type1Font > ### Title: Type 1 and CID Fonts > ### Aliases: Type1Font CIDFont > ### Keywords: device > > ### ** Examples > > ## This duplicates "ComputerModernItalic". > CMitalic <- Type1Font("ComputerModern2", + c("CM_regular_10.afm", "CM_boldx_10.afm", + "cmti10.afm", "cmbxti10.afm", + "CM_symbol_10.afm"), + encoding = "TeXtext.enc") > > ## Not run: > ##D ## This could be used by > ##D postscript(family = CMitalic) > ##D ## or > ##D postscriptFonts(CMitalic = CMitalic) # once in a session > ##D postscript(family = "CMitalic", encoding = "TeXtext.enc") > ## End(Not run) > > > cleanEx() > nameEx("adjustcolor") > ### * adjustcolor > > flush(stderr()); flush(stdout()) > > ### Name: adjustcolor > ### Title: Adjust Colors in One or More Directions Conveniently > ### Aliases: adjustcolor > > ### ** Examples > > ## Illustrative examples : > opal <- palette("default") > stopifnot(identical(adjustcolor(1:8, 0.75), + adjustcolor(palette(), 0.75))) > cbind(palette(), adjustcolor(1:8, 0.75)) [,1] [,2] [1,] "black" "#000000BF" [2,] "#DF536B" "#DF536BBF" [3,] "#61D04F" "#61D04FBF" [4,] "#2297E6" "#2297E6BF" [5,] "#28E2E5" "#28E2E5BF" [6,] "#CD0BBC" "#CD0BBCBF" [7,] "#F5C710" "#F5C710BF" [8,] "gray62" "#9E9E9EBF" > > ## alpha = 1/2 * previous alpha --> opaque colors > x <- palette(adjustcolor(palette(), 0.5)) > > sines <- outer(1:20, 1:4, function(x, y) sin(x / 20 * pi * y)) > matplot(sines, type = "b", pch = 21:23, col = 2:5, bg = 2:5, + main = "Using an 'opaque ('translucent') color palette") > > x. <- adjustcolor(x, offset = c(0.5, 0.5, 0.5, 0), # <- "more white" + transform = diag(c(.7, .7, .7, 0.6))) > cbind(x, x.) x x. [1,] "black" "#80808099" [2,] "#DF536B" "#FFBACA99" [3,] "#61D04F" "#C3FFB799" [4,] "#2297E6" "#97E9FF99" [5,] "#28E2E5" "#9BFFFF99" [6,] "#CD0BBC" "#FF87FF99" [7,] "#F5C710" "#FFFF8B99" [8,] "gray62" "#EEEEEE99" > op <- par(bg = adjustcolor("goldenrod", offset = -rep(.4, 4)), xpd = NA) > plot(0:9, 0:9, type = "n", axes = FALSE, xlab = "", ylab = "", + main = "adjustcolor() -> translucent") > text(1:8, labels = paste0(x,"++"), col = x., cex = 8) > par(op) > > ## and > > (M <- cbind( rbind( matrix(1/3, 3, 3), 0), c(0, 0, 0, 1))) [,1] [,2] [,3] [,4] [1,] 0.3333333 0.3333333 0.3333333 0 [2,] 0.3333333 0.3333333 0.3333333 0 [3,] 0.3333333 0.3333333 0.3333333 0 [4,] 0.0000000 0.0000000 0.0000000 1 > adjustcolor(x, transform = M) [1] "#000000FF" "#8A8A8AFF" "#808080FF" "#8A8A8AFF" "#A5A5A5FF" "#878787FF" [7] "#999999FF" "#9E9E9EFF" > > ## revert to previous palette: active > palette(opal) > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("as.raster") > ### * as.raster > > flush(stderr()); flush(stdout()) > > ### Name: as.raster > ### Title: Create a Raster Object > ### Aliases: is.raster as.raster as.raster.logical as.raster.numeric > ### as.raster.raw as.raster.character as.raster.matrix as.raster.array > ### Keywords: dplot > > ### ** Examples > > # A red gradient > as.raster(matrix(hcl(0, 80, seq(50, 80, 10)), + nrow = 4, ncol = 5)) [,1] [,2] [,3] [,4] [,5] [1,] "#C54E6D" "#C54E6D" "#C54E6D" "#C54E6D" "#C54E6D" [2,] "#E16A86" "#E16A86" "#E16A86" "#E16A86" "#E16A86" [3,] "#FE86A1" "#FE86A1" "#FE86A1" "#FE86A1" "#FE86A1" [4,] "#FFA2BC" "#FFA2BC" "#FFA2BC" "#FFA2BC" "#FFA2BC" > > # Vectors are 1-column matrices ... > # character vectors are color names ... > as.raster(hcl(0, 80, seq(50, 80, 10))) [,1] [1,] "#C54E6D" [2,] "#E16A86" [3,] "#FE86A1" [4,] "#FFA2BC" > # numeric vectors are greyscale ... > as.raster(1:5, max = 5) [,1] [1,] "#333333" [2,] "#666666" [3,] "#999999" [4,] "#CCCCCC" [5,] "#FFFFFF" > # logical vectors are black and white ... > as.raster(1:10 %% 2 == 0) [,1] [1,] "#000000" [2,] "#FFFFFF" [3,] "#000000" [4,] "#FFFFFF" [5,] "#000000" [6,] "#FFFFFF" [7,] "#000000" [8,] "#FFFFFF" [9,] "#000000" [10,] "#FFFFFF" > > # ... unless nrow/ncol are supplied ... > as.raster(1:10 %% 2 == 0, nrow = 1) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [1,] "#000000" "#FFFFFF" "#000000" "#FFFFFF" "#000000" "#FFFFFF" "#000000" [,8] [,9] [,10] [1,] "#FFFFFF" "#000000" "#FFFFFF" > > # Matrix can also be logical or numeric (or raw) ... > as.raster(matrix(c(TRUE, FALSE), nrow = 3, ncol = 2)) [,1] [,2] [1,] "#FFFFFF" "#000000" [2,] "#000000" "#FFFFFF" [3,] "#FFFFFF" "#000000" > as.raster(matrix(1:3/4, nrow = 3, ncol = 4)) [,1] [,2] [,3] [,4] [1,] "#404040" "#404040" "#404040" "#404040" [2,] "#808080" "#808080" "#808080" "#808080" [3,] "#BFBFBF" "#BFBFBF" "#BFBFBF" "#BFBFBF" > > # An array can be 3-plane numeric (R, G, B planes) ... > as.raster(array(c(0:1, rep(0.5, 4)), c(2, 1, 3))) [,1] [1,] "#008080" [2,] "#FF8080" > > # ... or 4-plane numeric (R, G, B, A planes) > as.raster(array(c(0:1, rep(0.5, 6)), c(2, 1, 4))) [,1] [1,] "#00808080" [2,] "#FF808080" > > # subsetting > r <- as.raster(matrix(colors()[1:100], ncol = 10)) > r[, 2] [,1] [1,] "aquamarine3" [2,] "aquamarine4" [3,] "azure" [4,] "azure1" [5,] "azure2" [6,] "azure3" [7,] "azure4" [8,] "beige" [9,] "bisque" [10,] "bisque1" > r[2:4, 2:5] [,1] [,2] [,3] [,4] [1,] "aquamarine4" "bisque3" "brown" "cadetblue" [2,] "azure" "bisque4" "brown1" "cadetblue1" [3,] "azure1" "black" "brown2" "cadetblue2" > > # assigning to subset > r[2:4, 2:5] <- "white" > > # comparison > r == "white" [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [1,] TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [2,] FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE [3,] FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE [4,] FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE [5,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [6,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [7,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [8,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [9,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [10,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE > > ## Don't show: > stopifnot(r[] == r, + identical(r[3:5], colors()[3:5])) > r[2:4] <- "black" > stopifnot(identical(r[1:4, 1], as.raster(c("white", rep("black", 3))))) > ## End(Don't show) > > > > cleanEx() > nameEx("axisTicks") > ### * axisTicks > > flush(stderr()); flush(stdout()) > > ### Name: axisTicks > ### Title: Compute Pretty Axis Tick Scales > ### Aliases: axisTicks .axisPars > ### Keywords: dplot > > ### ** Examples > > ##--- Demonstrating correspondence between graphics' > ##--- axis() and the graphics-engine agnostic axisTicks() : > > require("graphics") > plot(10*(0:10)); (pu <- par("usr")) [1] 0.6 11.4 -4.0 104.0 > aX <- function(side, at, ...) + axis(side, at = at, labels = FALSE, lwd.ticks = 2, col.ticks = 2, + tck = 0.05, ...) > aX(1, print(xa <- axisTicks(pu[1:2], log = FALSE))) # x axis [1] 2 4 6 8 10 > aX(2, print(ya <- axisTicks(pu[3:4], log = FALSE))) # y axis [1] 0 20 40 60 80 100 > > axisTicks(pu[3:4], log = FALSE, nint = 10) [1] 0 10 20 30 40 50 60 70 80 90 100 > > plot(10*(0:10), log = "y"); (pu <- par("usr")) Warning in xy.coords(x, y, xlabel, ylabel, log) : 1 y value <= 0 omitted from logarithmic plot [1] 0.60 11.40 0.96 2.04 > aX(2, print(ya <- axisTicks(pu[3:4], log = TRUE))) # y axis [1] 10 20 50 100 > > plot(2^(0:9), log = "y"); (pu <- par("usr")) [1] 0.6400000 10.3600000 -0.1083708 2.8176408 > aX(2, print(ya <- axisTicks(pu[3:4], log = TRUE))) # y axis [1] 1 2 5 10 20 50 100 200 500 > > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("boxplot.stats") > ### * boxplot.stats > > flush(stderr()); flush(stdout()) > > ### Name: boxplot.stats > ### Title: Box Plot Statistics > ### Aliases: boxplot.stats > ### Keywords: dplot > > ### ** Examples > > require(stats) > x <- c(1:100, 1000) > (b1 <- boxplot.stats(x)) $stats [1] 1 26 51 76 100 $n [1] 101 $conf [1] 43.13921 58.86079 $out [1] 1000 > (b2 <- boxplot.stats(x, do.conf = FALSE, do.out = FALSE)) $stats [1] 1 26 51 76 100 $n [1] 101 $conf NULL $out numeric(0) > stopifnot(b1 $ stats == b2 $ stats) # do.out = FALSE is still robust > boxplot.stats(x, coef = 3, do.conf = FALSE) $stats [1] 1 26 51 76 100 $n [1] 101 $conf NULL $out [1] 1000 > > ## no outlier treatment: > (b3 <- boxplot.stats(x, coef = 0)) $stats [1] 1 26 51 76 1000 $n [1] 101 $conf [1] 43.13921 58.86079 $out numeric(0) > stopifnot(b3$stats == fivenum(x)) > > ## missing values are ignored > stopifnot(identical(boxplot.stats(c(x, NA)), b1)) > ## ... infinite values are not: > (r <- boxplot.stats(c(x, -1:1/0))) $stats [1] 1.0 25.5 51.0 76.5 100.0 $n [1] 103 $conf [1] 43.06022 58.93978 $out [1] 1000 -Inf Inf > stopifnot(r$out == c(1000, -Inf, Inf)) > > ## Don't show: > ## Difference between quartiles and hinges : > nn <- 1:17 ; n4 <- nn %% 4 > hin <- sapply(sapply(nn, seq), function(x) boxplot.stats(x)$stats[c(2,4)]) > q13 <- sapply(sapply(nn, seq), quantile, probs = c(1,3)/4, names = FALSE) > m <- t(rbind(q13,hin))[, c(1,3,2,4)] > dimnames(m) <- list(paste(nn), c("q1","lH", "q3","uH")) > stopifnot(m[n4 == 1, 1:2] == (nn[n4 == 1] + 3)/4, # quart. = hinge + m[n4 == 1, 3:4] == (3*nn[n4 == 1] + 1)/4, + m[,"lH"] == ( (nn+3) %/% 2) / 2, + m[,"uH"] == ((3*nn+2)%/% 2) / 2) > cm <- noquote(format(m)) > cm[m[,2] == m[,1], 2] <- " = " > cm[m[,4] == m[,3], 4] <- " = " > cm q1 lH q3 uH 1 1.00 = 1.00 = 2 1.25 1.00 1.75 2.00 3 1.50 = 2.50 = 4 1.75 1.50 3.25 3.50 5 2.00 = 4.00 = 6 2.25 2.00 4.75 5.00 7 2.50 = 5.50 = 8 2.75 2.50 6.25 6.50 9 3.00 = 7.00 = 10 3.25 3.00 7.75 8.00 11 3.50 = 8.50 = 12 3.75 3.50 9.25 9.50 13 4.00 = 10.00 = 14 4.25 4.00 10.75 11.00 15 4.50 = 11.50 = 16 4.75 4.50 12.25 12.50 17 5.00 = 13.00 = > ## End(Don't show) > > > > > cleanEx() > nameEx("cairoSymbolFont") > ### * cairoSymbolFont > > flush(stderr()); flush(stdout()) > > ### Name: cairoSymbolFont > ### Title: Specify a Symbol Font > ### Aliases: cairoSymbolFont > ### Keywords: device > > ### ** Examples > > ## Not run: > ##D ## If a font uses PUA, we can just specify the font name ... > ##D cairo_pdf(symbolfamily="OpenSymbol") > ##D dev.off() > ##D ## ... or equivalently ... > ##D cairo_pdf(symbolfamily=cairoSymbolFont("OpenSymbol")) > ##D dev.off() > ##D > ##D ## If a font does not use PUA, we must indicate that ... > ##D cairo_pdf(symbolfamily=cairoSymbolFont("Nimbus Sans", usePUA=FALSE)) > ##D dev.off() > ## End(Not run) > > > > cleanEx() > nameEx("check.options") > ### * check.options > > flush(stderr()); flush(stdout()) > > ### Name: check.options > ### Title: Set Options with Consistency Checks > ### Aliases: check.options > ### Keywords: utilities programming > > ### ** Examples > > (L1 <- list(a = 1:3, b = pi, ch = "CH")) $a [1] 1 2 3 $b [1] 3.141593 $ch [1] "CH" > check.options(list(a = 0:2), name.opt = "L1") $a [1] 0 1 2 $b [1] 3.141593 $ch [1] "CH" > check.options(NULL, reset = TRUE, name.opt = "L1") $a [1] 1 2 3 $b [1] 3.141593 $ch [1] "CH" > > > > cleanEx() > nameEx("chull") > ### * chull > > flush(stderr()); flush(stdout()) > > ### Name: chull > ### Title: Compute Convex Hull of a Set of Points > ### Aliases: chull > ### Keywords: graphs > > ### ** Examples > > X <- matrix(stats::rnorm(2000), ncol = 2) > chull(X) [1] 61 442 165 899 697 446 975 656 232 557 938 295 495 > > plot(X, cex = 0.5) > polygon(X[chull(X), ]) > > > > cleanEx() > nameEx("cm") > ### * cm > > flush(stderr()); flush(stdout()) > > ### Name: cm > ### Title: Unit Transformation > ### Aliases: cm > ### Keywords: dplot > > ### ** Examples > > cm(1) # = 2.54 [1] 2.54 > > ## Translate *from* cm *to* inches: > > 10 / cm(1) # -> 10cm are 3.937 inches [1] 3.937008 > > > > cleanEx() > nameEx("col2rgb") > ### * col2rgb > > flush(stderr()); flush(stdout()) > > ### Name: col2rgb > ### Title: Color to RGB Conversion > ### Aliases: col2rgb > ### Keywords: color dplot > > ### ** Examples > > col2rgb("peachpuff") [,1] red 255 green 218 blue 185 > col2rgb(c(blu = "royalblue", reddish = "tomato")) # note: colnames blu reddish red 65 255 green 105 99 blue 225 71 > > col2rgb(1:8) # the ones from the palette() (if the default) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] red 0 223 97 34 40 205 245 158 green 0 83 208 151 226 11 199 158 blue 0 107 79 230 229 188 16 158 > > col2rgb(paste0("gold", 1:4)) [,1] [,2] [,3] [,4] red 255 238 205 139 green 215 201 173 117 blue 0 0 0 0 > > col2rgb("#08a0ff") [,1] red 8 green 160 blue 255 > ## all three kinds of color specifications: > col2rgb(c(red = "red", hex = "#abcdef")) red hex red 255 171 green 0 205 blue 0 239 > col2rgb(c(palette = 1:3)) palette1 palette2 palette3 red 0 223 97 green 0 83 208 blue 0 107 79 > > # long and short form of hexadecimal notation > col2rgb(c(long = "#559955", short = "#595")) long short red 85 85 green 153 153 blue 85 85 > # with alpha > col2rgb(c(long = "#559955BB", short = "#595B"), alpha = TRUE) long short red 85 85 green 153 153 blue 85 85 alpha 187 187 > > ##-- NON-INTRODUCTORY examples -- > > grC <- col2rgb(paste0("gray", 0:100)) > table(print(diff(grC["red",]))) # '2' or '3': almost equidistant [1] 3 2 3 2 3 2 3 2 3 3 2 3 2 3 2 3 2 3 2 3 3 2 3 2 3 2 3 2 3 3 2 3 2 3 2 3 2 [38] 3 2 3 3 2 3 2 3 2 3 2 3 2 3 3 2 3 2 3 2 3 2 3 3 2 3 2 3 2 3 2 3 3 2 3 2 3 [75] 2 3 2 3 2 3 3 2 3 2 3 2 3 2 3 2 3 3 2 3 2 3 2 3 2 3 2 3 45 55 > ## The 'named' grays are in between {"slate gray" is not gray, strictly} > col2rgb(c(g66 = "gray66", darkg = "dark gray", g67 = "gray67", + g74 = "gray74", gray = "gray", g75 = "gray75", + g82 = "gray82", light = "light gray", g83 = "gray83")) g66 darkg g67 g74 gray g75 g82 light g83 red 168 169 171 189 190 191 209 211 212 green 168 169 171 189 190 191 209 211 212 blue 168 169 171 189 190 191 209 211 212 > > crgb <- col2rgb(cc <- colors()) > colnames(crgb) <- cc > t(crgb) # The whole table red green blue white 255 255 255 aliceblue 240 248 255 antiquewhite 250 235 215 antiquewhite1 255 239 219 antiquewhite2 238 223 204 antiquewhite3 205 192 176 antiquewhite4 139 131 120 aquamarine 127 255 212 aquamarine1 127 255 212 aquamarine2 118 238 198 aquamarine3 102 205 170 aquamarine4 69 139 116 azure 240 255 255 azure1 240 255 255 azure2 224 238 238 azure3 193 205 205 azure4 131 139 139 beige 245 245 220 bisque 255 228 196 bisque1 255 228 196 bisque2 238 213 183 bisque3 205 183 158 bisque4 139 125 107 black 0 0 0 blanchedalmond 255 235 205 blue 0 0 255 blue1 0 0 255 blue2 0 0 238 blue3 0 0 205 blue4 0 0 139 blueviolet 138 43 226 brown 165 42 42 brown1 255 64 64 brown2 238 59 59 brown3 205 51 51 brown4 139 35 35 burlywood 222 184 135 burlywood1 255 211 155 burlywood2 238 197 145 burlywood3 205 170 125 burlywood4 139 115 85 cadetblue 95 158 160 cadetblue1 152 245 255 cadetblue2 142 229 238 cadetblue3 122 197 205 cadetblue4 83 134 139 chartreuse 127 255 0 chartreuse1 127 255 0 chartreuse2 118 238 0 chartreuse3 102 205 0 chartreuse4 69 139 0 chocolate 210 105 30 chocolate1 255 127 36 chocolate2 238 118 33 chocolate3 205 102 29 chocolate4 139 69 19 coral 255 127 80 coral1 255 114 86 coral2 238 106 80 coral3 205 91 69 coral4 139 62 47 cornflowerblue 100 149 237 cornsilk 255 248 220 cornsilk1 255 248 220 cornsilk2 238 232 205 cornsilk3 205 200 177 cornsilk4 139 136 120 cyan 0 255 255 cyan1 0 255 255 cyan2 0 238 238 cyan3 0 205 205 cyan4 0 139 139 darkblue 0 0 139 darkcyan 0 139 139 darkgoldenrod 184 134 11 darkgoldenrod1 255 185 15 darkgoldenrod2 238 173 14 darkgoldenrod3 205 149 12 darkgoldenrod4 139 101 8 darkgray 169 169 169 darkgreen 0 100 0 darkgrey 169 169 169 darkkhaki 189 183 107 darkmagenta 139 0 139 darkolivegreen 85 107 47 darkolivegreen1 202 255 112 darkolivegreen2 188 238 104 darkolivegreen3 162 205 90 darkolivegreen4 110 139 61 darkorange 255 140 0 darkorange1 255 127 0 darkorange2 238 118 0 darkorange3 205 102 0 darkorange4 139 69 0 darkorchid 153 50 204 darkorchid1 191 62 255 darkorchid2 178 58 238 darkorchid3 154 50 205 darkorchid4 104 34 139 darkred 139 0 0 darksalmon 233 150 122 darkseagreen 143 188 143 darkseagreen1 193 255 193 darkseagreen2 180 238 180 darkseagreen3 155 205 155 darkseagreen4 105 139 105 darkslateblue 72 61 139 darkslategray 47 79 79 darkslategray1 151 255 255 darkslategray2 141 238 238 darkslategray3 121 205 205 darkslategray4 82 139 139 darkslategrey 47 79 79 darkturquoise 0 206 209 darkviolet 148 0 211 deeppink 255 20 147 deeppink1 255 20 147 deeppink2 238 18 137 deeppink3 205 16 118 deeppink4 139 10 80 deepskyblue 0 191 255 deepskyblue1 0 191 255 deepskyblue2 0 178 238 deepskyblue3 0 154 205 deepskyblue4 0 104 139 dimgray 105 105 105 dimgrey 105 105 105 dodgerblue 30 144 255 dodgerblue1 30 144 255 dodgerblue2 28 134 238 dodgerblue3 24 116 205 dodgerblue4 16 78 139 firebrick 178 34 34 firebrick1 255 48 48 firebrick2 238 44 44 firebrick3 205 38 38 firebrick4 139 26 26 floralwhite 255 250 240 forestgreen 34 139 34 gainsboro 220 220 220 ghostwhite 248 248 255 gold 255 215 0 gold1 255 215 0 gold2 238 201 0 gold3 205 173 0 gold4 139 117 0 goldenrod 218 165 32 goldenrod1 255 193 37 goldenrod2 238 180 34 goldenrod3 205 155 29 goldenrod4 139 105 20 gray 190 190 190 gray0 0 0 0 gray1 3 3 3 gray2 5 5 5 gray3 8 8 8 gray4 10 10 10 gray5 13 13 13 gray6 15 15 15 gray7 18 18 18 gray8 20 20 20 gray9 23 23 23 gray10 26 26 26 gray11 28 28 28 gray12 31 31 31 gray13 33 33 33 gray14 36 36 36 gray15 38 38 38 gray16 41 41 41 gray17 43 43 43 gray18 46 46 46 gray19 48 48 48 gray20 51 51 51 gray21 54 54 54 gray22 56 56 56 gray23 59 59 59 gray24 61 61 61 gray25 64 64 64 gray26 66 66 66 gray27 69 69 69 gray28 71 71 71 gray29 74 74 74 gray30 77 77 77 gray31 79 79 79 gray32 82 82 82 gray33 84 84 84 gray34 87 87 87 gray35 89 89 89 gray36 92 92 92 gray37 94 94 94 gray38 97 97 97 gray39 99 99 99 gray40 102 102 102 gray41 105 105 105 gray42 107 107 107 gray43 110 110 110 gray44 112 112 112 gray45 115 115 115 gray46 117 117 117 gray47 120 120 120 gray48 122 122 122 gray49 125 125 125 gray50 127 127 127 gray51 130 130 130 gray52 133 133 133 gray53 135 135 135 gray54 138 138 138 gray55 140 140 140 gray56 143 143 143 gray57 145 145 145 gray58 148 148 148 gray59 150 150 150 gray60 153 153 153 gray61 156 156 156 gray62 158 158 158 gray63 161 161 161 gray64 163 163 163 gray65 166 166 166 gray66 168 168 168 gray67 171 171 171 gray68 173 173 173 gray69 176 176 176 gray70 179 179 179 gray71 181 181 181 gray72 184 184 184 gray73 186 186 186 gray74 189 189 189 gray75 191 191 191 gray76 194 194 194 gray77 196 196 196 gray78 199 199 199 gray79 201 201 201 gray80 204 204 204 gray81 207 207 207 gray82 209 209 209 gray83 212 212 212 gray84 214 214 214 gray85 217 217 217 gray86 219 219 219 gray87 222 222 222 gray88 224 224 224 gray89 227 227 227 gray90 229 229 229 gray91 232 232 232 gray92 235 235 235 gray93 237 237 237 gray94 240 240 240 gray95 242 242 242 gray96 245 245 245 gray97 247 247 247 gray98 250 250 250 gray99 252 252 252 gray100 255 255 255 green 0 255 0 green1 0 255 0 green2 0 238 0 green3 0 205 0 green4 0 139 0 greenyellow 173 255 47 grey 190 190 190 grey0 0 0 0 grey1 3 3 3 grey2 5 5 5 grey3 8 8 8 grey4 10 10 10 grey5 13 13 13 grey6 15 15 15 grey7 18 18 18 grey8 20 20 20 grey9 23 23 23 grey10 26 26 26 grey11 28 28 28 grey12 31 31 31 grey13 33 33 33 grey14 36 36 36 grey15 38 38 38 grey16 41 41 41 grey17 43 43 43 grey18 46 46 46 grey19 48 48 48 grey20 51 51 51 grey21 54 54 54 grey22 56 56 56 grey23 59 59 59 grey24 61 61 61 grey25 64 64 64 grey26 66 66 66 grey27 69 69 69 grey28 71 71 71 grey29 74 74 74 grey30 77 77 77 grey31 79 79 79 grey32 82 82 82 grey33 84 84 84 grey34 87 87 87 grey35 89 89 89 grey36 92 92 92 grey37 94 94 94 grey38 97 97 97 grey39 99 99 99 grey40 102 102 102 grey41 105 105 105 grey42 107 107 107 grey43 110 110 110 grey44 112 112 112 grey45 115 115 115 grey46 117 117 117 grey47 120 120 120 grey48 122 122 122 grey49 125 125 125 grey50 127 127 127 grey51 130 130 130 grey52 133 133 133 grey53 135 135 135 grey54 138 138 138 grey55 140 140 140 grey56 143 143 143 grey57 145 145 145 grey58 148 148 148 grey59 150 150 150 grey60 153 153 153 grey61 156 156 156 grey62 158 158 158 grey63 161 161 161 grey64 163 163 163 grey65 166 166 166 grey66 168 168 168 grey67 171 171 171 grey68 173 173 173 grey69 176 176 176 grey70 179 179 179 grey71 181 181 181 grey72 184 184 184 grey73 186 186 186 grey74 189 189 189 grey75 191 191 191 grey76 194 194 194 grey77 196 196 196 grey78 199 199 199 grey79 201 201 201 grey80 204 204 204 grey81 207 207 207 grey82 209 209 209 grey83 212 212 212 grey84 214 214 214 grey85 217 217 217 grey86 219 219 219 grey87 222 222 222 grey88 224 224 224 grey89 227 227 227 grey90 229 229 229 grey91 232 232 232 grey92 235 235 235 grey93 237 237 237 grey94 240 240 240 grey95 242 242 242 grey96 245 245 245 grey97 247 247 247 grey98 250 250 250 grey99 252 252 252 grey100 255 255 255 honeydew 240 255 240 honeydew1 240 255 240 honeydew2 224 238 224 honeydew3 193 205 193 honeydew4 131 139 131 hotpink 255 105 180 hotpink1 255 110 180 hotpink2 238 106 167 hotpink3 205 96 144 hotpink4 139 58 98 indianred 205 92 92 indianred1 255 106 106 indianred2 238 99 99 indianred3 205 85 85 indianred4 139 58 58 ivory 255 255 240 ivory1 255 255 240 ivory2 238 238 224 ivory3 205 205 193 ivory4 139 139 131 khaki 240 230 140 khaki1 255 246 143 khaki2 238 230 133 khaki3 205 198 115 khaki4 139 134 78 lavender 230 230 250 lavenderblush 255 240 245 lavenderblush1 255 240 245 lavenderblush2 238 224 229 lavenderblush3 205 193 197 lavenderblush4 139 131 134 lawngreen 124 252 0 lemonchiffon 255 250 205 lemonchiffon1 255 250 205 lemonchiffon2 238 233 191 lemonchiffon3 205 201 165 lemonchiffon4 139 137 112 lightblue 173 216 230 lightblue1 191 239 255 lightblue2 178 223 238 lightblue3 154 192 205 lightblue4 104 131 139 lightcoral 240 128 128 lightcyan 224 255 255 lightcyan1 224 255 255 lightcyan2 209 238 238 lightcyan3 180 205 205 lightcyan4 122 139 139 lightgoldenrod 238 221 130 lightgoldenrod1 255 236 139 lightgoldenrod2 238 220 130 lightgoldenrod3 205 190 112 lightgoldenrod4 139 129 76 lightgoldenrodyellow 250 250 210 lightgray 211 211 211 lightgreen 144 238 144 lightgrey 211 211 211 lightpink 255 182 193 lightpink1 255 174 185 lightpink2 238 162 173 lightpink3 205 140 149 lightpink4 139 95 101 lightsalmon 255 160 122 lightsalmon1 255 160 122 lightsalmon2 238 149 114 lightsalmon3 205 129 98 lightsalmon4 139 87 66 lightseagreen 32 178 170 lightskyblue 135 206 250 lightskyblue1 176 226 255 lightskyblue2 164 211 238 lightskyblue3 141 182 205 lightskyblue4 96 123 139 lightslateblue 132 112 255 lightslategray 119 136 153 lightslategrey 119 136 153 lightsteelblue 176 196 222 lightsteelblue1 202 225 255 lightsteelblue2 188 210 238 lightsteelblue3 162 181 205 lightsteelblue4 110 123 139 lightyellow 255 255 224 lightyellow1 255 255 224 lightyellow2 238 238 209 lightyellow3 205 205 180 lightyellow4 139 139 122 limegreen 50 205 50 linen 250 240 230 magenta 255 0 255 magenta1 255 0 255 magenta2 238 0 238 magenta3 205 0 205 magenta4 139 0 139 maroon 176 48 96 maroon1 255 52 179 maroon2 238 48 167 maroon3 205 41 144 maroon4 139 28 98 mediumaquamarine 102 205 170 mediumblue 0 0 205 mediumorchid 186 85 211 mediumorchid1 224 102 255 mediumorchid2 209 95 238 mediumorchid3 180 82 205 mediumorchid4 122 55 139 mediumpurple 147 112 219 mediumpurple1 171 130 255 mediumpurple2 159 121 238 mediumpurple3 137 104 205 mediumpurple4 93 71 139 mediumseagreen 60 179 113 mediumslateblue 123 104 238 mediumspringgreen 0 250 154 mediumturquoise 72 209 204 mediumvioletred 199 21 133 midnightblue 25 25 112 mintcream 245 255 250 mistyrose 255 228 225 mistyrose1 255 228 225 mistyrose2 238 213 210 mistyrose3 205 183 181 mistyrose4 139 125 123 moccasin 255 228 181 navajowhite 255 222 173 navajowhite1 255 222 173 navajowhite2 238 207 161 navajowhite3 205 179 139 navajowhite4 139 121 94 navy 0 0 128 navyblue 0 0 128 oldlace 253 245 230 olivedrab 107 142 35 olivedrab1 192 255 62 olivedrab2 179 238 58 olivedrab3 154 205 50 olivedrab4 105 139 34 orange 255 165 0 orange1 255 165 0 orange2 238 154 0 orange3 205 133 0 orange4 139 90 0 orangered 255 69 0 orangered1 255 69 0 orangered2 238 64 0 orangered3 205 55 0 orangered4 139 37 0 orchid 218 112 214 orchid1 255 131 250 orchid2 238 122 233 orchid3 205 105 201 orchid4 139 71 137 palegoldenrod 238 232 170 palegreen 152 251 152 palegreen1 154 255 154 palegreen2 144 238 144 palegreen3 124 205 124 palegreen4 84 139 84 paleturquoise 175 238 238 paleturquoise1 187 255 255 paleturquoise2 174 238 238 paleturquoise3 150 205 205 paleturquoise4 102 139 139 palevioletred 219 112 147 palevioletred1 255 130 171 palevioletred2 238 121 159 palevioletred3 205 104 137 palevioletred4 139 71 93 papayawhip 255 239 213 peachpuff 255 218 185 peachpuff1 255 218 185 peachpuff2 238 203 173 peachpuff3 205 175 149 peachpuff4 139 119 101 peru 205 133 63 pink 255 192 203 pink1 255 181 197 pink2 238 169 184 pink3 205 145 158 pink4 139 99 108 plum 221 160 221 plum1 255 187 255 plum2 238 174 238 plum3 205 150 205 plum4 139 102 139 powderblue 176 224 230 purple 160 32 240 purple1 155 48 255 purple2 145 44 238 purple3 125 38 205 purple4 85 26 139 red 255 0 0 red1 255 0 0 red2 238 0 0 red3 205 0 0 red4 139 0 0 rosybrown 188 143 143 rosybrown1 255 193 193 rosybrown2 238 180 180 rosybrown3 205 155 155 rosybrown4 139 105 105 royalblue 65 105 225 royalblue1 72 118 255 royalblue2 67 110 238 royalblue3 58 95 205 royalblue4 39 64 139 saddlebrown 139 69 19 salmon 250 128 114 salmon1 255 140 105 salmon2 238 130 98 salmon3 205 112 84 salmon4 139 76 57 sandybrown 244 164 96 seagreen 46 139 87 seagreen1 84 255 159 seagreen2 78 238 148 seagreen3 67 205 128 seagreen4 46 139 87 seashell 255 245 238 seashell1 255 245 238 seashell2 238 229 222 seashell3 205 197 191 seashell4 139 134 130 sienna 160 82 45 sienna1 255 130 71 sienna2 238 121 66 sienna3 205 104 57 sienna4 139 71 38 skyblue 135 206 235 skyblue1 135 206 255 skyblue2 126 192 238 skyblue3 108 166 205 skyblue4 74 112 139 slateblue 106 90 205 slateblue1 131 111 255 slateblue2 122 103 238 slateblue3 105 89 205 slateblue4 71 60 139 slategray 112 128 144 slategray1 198 226 255 slategray2 185 211 238 slategray3 159 182 205 slategray4 108 123 139 slategrey 112 128 144 snow 255 250 250 snow1 255 250 250 snow2 238 233 233 snow3 205 201 201 snow4 139 137 137 springgreen 0 255 127 springgreen1 0 255 127 springgreen2 0 238 118 springgreen3 0 205 102 springgreen4 0 139 69 steelblue 70 130 180 steelblue1 99 184 255 steelblue2 92 172 238 steelblue3 79 148 205 steelblue4 54 100 139 tan 210 180 140 tan1 255 165 79 tan2 238 154 73 tan3 205 133 63 tan4 139 90 43 thistle 216 191 216 thistle1 255 225 255 thistle2 238 210 238 thistle3 205 181 205 thistle4 139 123 139 tomato 255 99 71 tomato1 255 99 71 tomato2 238 92 66 tomato3 205 79 57 tomato4 139 54 38 turquoise 64 224 208 turquoise1 0 245 255 turquoise2 0 229 238 turquoise3 0 197 205 turquoise4 0 134 139 violet 238 130 238 violetred 208 32 144 violetred1 255 62 150 violetred2 238 58 140 violetred3 205 50 120 violetred4 139 34 82 wheat 245 222 179 wheat1 255 231 186 wheat2 238 216 174 wheat3 205 186 150 wheat4 139 126 102 whitesmoke 245 245 245 yellow 255 255 0 yellow1 255 255 0 yellow2 238 238 0 yellow3 205 205 0 yellow4 139 139 0 yellowgreen 154 205 50 > > ## How many names are 'aliases' of each other? > ccodes <- c(256^(2:0) %*% crgb) > cl <- split(cc, ccodes) > length(cl) # 502 distinct colors [1] 502 > table(tcc <- lengths(cl)) 1 2 3 4 352 146 3 1 > ## All the multiply named colors: > clmult <- cl[tcc >= 2] > names(clmult) <- sapply(clmult, function(x) paste(crgb[,x[1]], collapse = ",")) > utils::str(clmult) List of 150 $ 0,0,0 : chr [1:3] "black" "gray0" "grey0" $ 0,0,128 : chr [1:2] "navy" "navyblue" $ 0,0,139 : chr [1:2] "blue4" "darkblue" $ 0,0,205 : chr [1:2] "blue3" "mediumblue" $ 0,0,255 : chr [1:2] "blue" "blue1" $ 0,139,139 : chr [1:2] "cyan4" "darkcyan" $ 0,191,255 : chr [1:2] "deepskyblue" "deepskyblue1" $ 0,255,0 : chr [1:2] "green" "green1" $ 0,255,127 : chr [1:2] "springgreen" "springgreen1" $ 0,255,255 : chr [1:2] "cyan" "cyan1" $ 3,3,3 : chr [1:2] "gray1" "grey1" $ 5,5,5 : chr [1:2] "gray2" "grey2" $ 8,8,8 : chr [1:2] "gray3" "grey3" $ 10,10,10 : chr [1:2] "gray4" "grey4" $ 13,13,13 : chr [1:2] "gray5" "grey5" $ 15,15,15 : chr [1:2] "gray6" "grey6" $ 18,18,18 : chr [1:2] "gray7" "grey7" $ 20,20,20 : chr [1:2] "gray8" "grey8" $ 23,23,23 : chr [1:2] "gray9" "grey9" $ 26,26,26 : chr [1:2] "gray10" "grey10" $ 28,28,28 : chr [1:2] "gray11" "grey11" $ 30,144,255 : chr [1:2] "dodgerblue" "dodgerblue1" $ 31,31,31 : chr [1:2] "gray12" "grey12" $ 33,33,33 : chr [1:2] "gray13" "grey13" $ 36,36,36 : chr [1:2] "gray14" "grey14" $ 38,38,38 : chr [1:2] "gray15" "grey15" $ 41,41,41 : chr [1:2] "gray16" "grey16" $ 43,43,43 : chr [1:2] "gray17" "grey17" $ 46,46,46 : chr [1:2] "gray18" "grey18" $ 46,139,87 : chr [1:2] "seagreen" "seagreen4" $ 47,79,79 : chr [1:2] "darkslategray" "darkslategrey" $ 48,48,48 : chr [1:2] "gray19" "grey19" $ 51,51,51 : chr [1:2] "gray20" "grey20" $ 54,54,54 : chr [1:2] "gray21" "grey21" $ 56,56,56 : chr [1:2] "gray22" "grey22" $ 59,59,59 : chr [1:2] "gray23" "grey23" $ 61,61,61 : chr [1:2] "gray24" "grey24" $ 64,64,64 : chr [1:2] "gray25" "grey25" $ 66,66,66 : chr [1:2] "gray26" "grey26" $ 69,69,69 : chr [1:2] "gray27" "grey27" $ 71,71,71 : chr [1:2] "gray28" "grey28" $ 74,74,74 : chr [1:2] "gray29" "grey29" $ 77,77,77 : chr [1:2] "gray30" "grey30" $ 79,79,79 : chr [1:2] "gray31" "grey31" $ 82,82,82 : chr [1:2] "gray32" "grey32" $ 84,84,84 : chr [1:2] "gray33" "grey33" $ 87,87,87 : chr [1:2] "gray34" "grey34" $ 89,89,89 : chr [1:2] "gray35" "grey35" $ 92,92,92 : chr [1:2] "gray36" "grey36" $ 94,94,94 : chr [1:2] "gray37" "grey37" $ 97,97,97 : chr [1:2] "gray38" "grey38" $ 99,99,99 : chr [1:2] "gray39" "grey39" $ 102,102,102: chr [1:2] "gray40" "grey40" $ 102,205,170: chr [1:2] "aquamarine3" "mediumaquamarine" $ 105,105,105: chr [1:4] "dimgray" "dimgrey" "gray41" "grey41" $ 107,107,107: chr [1:2] "gray42" "grey42" $ 110,110,110: chr [1:2] "gray43" "grey43" $ 112,112,112: chr [1:2] "gray44" "grey44" $ 112,128,144: chr [1:2] "slategray" "slategrey" $ 115,115,115: chr [1:2] "gray45" "grey45" $ 117,117,117: chr [1:2] "gray46" "grey46" $ 119,136,153: chr [1:2] "lightslategray" "lightslategrey" $ 120,120,120: chr [1:2] "gray47" "grey47" $ 122,122,122: chr [1:2] "gray48" "grey48" $ 125,125,125: chr [1:2] "gray49" "grey49" $ 127,127,127: chr [1:2] "gray50" "grey50" $ 127,255,0 : chr [1:2] "chartreuse" "chartreuse1" $ 127,255,212: chr [1:2] "aquamarine" "aquamarine1" $ 130,130,130: chr [1:2] "gray51" "grey51" $ 133,133,133: chr [1:2] "gray52" "grey52" $ 135,135,135: chr [1:2] "gray53" "grey53" $ 138,138,138: chr [1:2] "gray54" "grey54" $ 139,0,0 : chr [1:2] "darkred" "red4" $ 139,0,139 : chr [1:2] "darkmagenta" "magenta4" $ 139,69,19 : chr [1:2] "chocolate4" "saddlebrown" $ 140,140,140: chr [1:2] "gray55" "grey55" $ 143,143,143: chr [1:2] "gray56" "grey56" $ 144,238,144: chr [1:2] "lightgreen" "palegreen2" $ 145,145,145: chr [1:2] "gray57" "grey57" $ 148,148,148: chr [1:2] "gray58" "grey58" $ 150,150,150: chr [1:2] "gray59" "grey59" $ 153,153,153: chr [1:2] "gray60" "grey60" $ 154,205,50 : chr [1:2] "olivedrab3" "yellowgreen" $ 156,156,156: chr [1:2] "gray61" "grey61" $ 158,158,158: chr [1:2] "gray62" "grey62" $ 161,161,161: chr [1:2] "gray63" "grey63" $ 163,163,163: chr [1:2] "gray64" "grey64" $ 166,166,166: chr [1:2] "gray65" "grey65" $ 168,168,168: chr [1:2] "gray66" "grey66" $ 169,169,169: chr [1:2] "darkgray" "darkgrey" $ 171,171,171: chr [1:2] "gray67" "grey67" $ 173,173,173: chr [1:2] "gray68" "grey68" $ 176,176,176: chr [1:2] "gray69" "grey69" $ 179,179,179: chr [1:2] "gray70" "grey70" $ 181,181,181: chr [1:2] "gray71" "grey71" $ 184,184,184: chr [1:2] "gray72" "grey72" $ 186,186,186: chr [1:2] "gray73" "grey73" $ 189,189,189: chr [1:2] "gray74" "grey74" $ 190,190,190: chr [1:2] "gray" "grey" [list output truncated] > > ## Look at the color cube: > tc <- t(crgb[, !duplicated(ccodes)]) > cNms <- rownames(tc) > if(requireNamespace("lattice", quietly = TRUE)) + lattice::cloud(blue ~ red + green, data = as.data.frame(tc), col = cNms) > ## The 8 corners of the color cube: > isC <- rowSums(tc == 0 | tc == 255) == 3 > cNms[isC] # "white" "black" "blue" "cyan" "green" "magenta" "red" "yellow" [1] "white" "black" "blue" "cyan" "green" "magenta" "red" [8] "yellow" > ## Don't show: > stopifnot(setequal(cNms[isC], + c("white","black","blue","cyan","green","magenta","red","yellow"))) > ## End(Don't show) > table(is.gray <- tc[,1] == tc[,2] & tc[,2] == tc[,3]) # (397, 105) FALSE TRUE 397 105 > > ## Not run: > ##D ## Look at the color cube dynamically:##D > ##D if(require("rgl")) { > ##D open3d(windowRect = c(50,50, 950, 950)) # large, so we see details > ##D plot3d (tc, col = cNms, size = 11) # --> rotate w/ mouse; enlarged corners: > ##D points3d(tc[isC,], col = cNms[isC], size=22) > ##D bg3d("darkgray") # (to "see more"); rotate around gray-axis: > ##D play3d(spin3d(axis = c(1, 1, 1), rpm = 2), duration = 30) > ##D if(FALSE) # add all names {zoom in with 2nd mouse button!} > ##D text3d(tc[!is.gray,], texts = cNms[!is.gray], > ##D col = cNms[!is.gray], adj=-1/4, cex = 1/2) > ##D if(FALSE) { ## next version of {rgl} > ##D hover3d(tc, labels = cNms) > ##D message("Move mouse over plot to identify points.") > ##D } else { ## click on blob to see colors()' name: > ##D identify3d(tc, labels=cNms) > ##D } > ##D } > ## End(Not run) > > > > cleanEx() > nameEx("colorRamp") > ### * colorRamp > > flush(stderr()); flush(stdout()) > > ### Name: colorRamp > ### Title: Color interpolation > ### Aliases: colorRamp colorRampPalette > ### Keywords: color > > ### ** Examples > > ## Both return a *function* : > colorRamp(c("red", "green"))( (0:4)/4 ) ## (x) , x in [0,1] [,1] [,2] [,3] [1,] 255.00 0.00 0 [2,] 191.25 63.75 0 [3,] 127.50 127.50 0 [4,] 63.75 191.25 0 [5,] 0.00 255.00 0 > colorRampPalette(c("blue", "red"))( 4 ) ## (n) [1] "#0000FF" "#5500AA" "#AA0055" "#FF0000" > ## a ramp in opacity of blue values > colorRampPalette(c(rgb(0,0,1,1), rgb(0,0,1,0)), alpha = TRUE)(8) [1] "#0000FFFF" "#0000FFDA" "#0000FFB6" "#0000FF91" "#0000FF6D" "#0000FF48" [7] "#0000FF24" "#0000FF00" > > require(graphics) > > ## Here space="rgb" gives palettes that vary only in saturation, > ## as intended. > ## With space="Lab" the steps are more uniform, but the hues > ## are slightly purple. > filled.contour(volcano, + color.palette = + colorRampPalette(c("red", "white", "blue")), + asp = 1) > filled.contour(volcano, + color.palette = + colorRampPalette(c("red", "white", "blue"), + space = "Lab"), + asp = 1) > > ## Interpolating a 'sequential' ColorBrewer palette > YlOrBr <- c("#FFFFD4", "#FED98E", "#FE9929", "#D95F0E", "#993404") > filled.contour(volcano, + color.palette = colorRampPalette(YlOrBr, space = "Lab"), + asp = 1) > filled.contour(volcano, + color.palette = colorRampPalette(YlOrBr, space = "Lab", + bias = 0.5), + asp = 1) > > ## 'jet.colors' is "as in Matlab" > ## (and hurting the eyes by over-saturation) > jet.colors <- + colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", + "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000")) > filled.contour(volcano, color.palette = jet.colors, asp = 1) > > ## space="Lab" helps when colors don't form a natural sequence > m <- outer(1:20,1:20,function(x,y) sin(sqrt(x*y)/3)) > rgb.palette <- colorRampPalette(c("red", "orange", "blue"), + space = "rgb") > Lab.palette <- colorRampPalette(c("red", "orange", "blue"), + space = "Lab") > filled.contour(m, col = rgb.palette(20)) > filled.contour(m, col = Lab.palette(20)) > > > > cleanEx() > nameEx("colors") > ### * colors > > flush(stderr()); flush(stdout()) > > ### Name: colors > ### Title: Color Names > ### Aliases: colors colours > ### Keywords: color dplot sysdata > > ### ** Examples > > cl <- colors() > length(cl); cl[1:20] [1] 657 [1] "white" "aliceblue" "antiquewhite" "antiquewhite1" [5] "antiquewhite2" "antiquewhite3" "antiquewhite4" "aquamarine" [9] "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4" [13] "azure" "azure1" "azure2" "azure3" [17] "azure4" "beige" "bisque" "bisque1" > > length(cl. <- colors(TRUE)) [1] 502 > ## only 502 of the 657 named ones > > ## ----------- Show all named colors and more: > demo("colors") demo(colors) ---- ~~~~~~ > ### ----------- Show (almost) all named colors --------------------- > > ## 1) with traditional 'graphics' package: > showCols1 <- function(bg = "gray", cex = 0.75, srt = 30) { + m <- ceiling(sqrt(n <- length(cl <- colors()))) + length(cl) <- m*m; cm <- matrix(cl, m) + ## + require("graphics") + op <- par(mar=rep(0,4), ann=FALSE, bg = bg); on.exit(par(op)) + plot(1:m,1:m, type="n", axes=FALSE) + text(col(cm), rev(row(cm)), cm, col = cl, cex=cex, srt=srt) + } > showCols1() > ## 2) with 'grid' package: > showCols2 <- function(bg = "grey", cex = 0.75, rot = 30) { + m <- ceiling(sqrt(n <- length(cl <- colors()))) + length(cl) <- m*m; cm <- matrix(cl, m) + ## + require("grid") + grid.newpage(); vp <- viewport(width = .92, height = .92) + grid.rect(gp=gpar(fill=bg)) + grid.text(cm, x = col(cm)/m, y = rev(row(cm))/m, rot = rot, + vp=vp, gp=gpar(cex = cex, col = cm)) + } > showCols2() Loading required package: grid > showCols2(bg = "gray33") > ### > > ##' @title Comparing Colors > ##' @param col > ##' @param nrow > ##' @param ncol > ##' @param txt.col > ##' @return the grid layout, invisibly > ##' @author Marius Hofert, originally > plotCol <- function(col, nrow=1, ncol=ceiling(length(col) / nrow), + txt.col="black") { + stopifnot(nrow >= 1, ncol >= 1) + if(length(col) > nrow*ncol) + warning("some colors will not be shown") + require(grid) + grid.newpage() + gl <- grid.layout(nrow, ncol) + pushViewport(viewport(layout=gl)) + ic <- 1 + for(i in 1:nrow) { + for(j in 1:ncol) { + pushViewport(viewport(layout.pos.row=i, layout.pos.col=j)) + grid.rect(gp= gpar(fill=col[ic])) + grid.text(col[ic], gp=gpar(col=txt.col)) + upViewport() + ic <- ic+1 + } + } + upViewport() + invisible(gl) + } > ## A Chocolate Bar of colors: > plotCol(c("#CC8C3C", paste0("chocolate", 2:4), + paste0("darkorange", c("",1:2)), paste0("darkgoldenrod", 1:2), + "orange", "orange1", "sandybrown", "tan1", "tan2"), + nrow=2) > ##' Find close R colors() to a given color {original by Marius Hofert) > ##' using Euclidean norm in (HSV / RGB / ...) color space > nearRcolor <- function(rgb, cSpace = c("hsv", "rgb255", "Luv", "Lab"), + dist = switch(cSpace, "hsv" = 0.10, "rgb255" = 30, + "Luv" = 15, "Lab" = 12)) + { + if(is.character(rgb)) rgb <- col2rgb(rgb) + stopifnot(length(rgb <- as.vector(rgb)) == 3) + Rcol <- col2rgb(.cc <- colors()) + uniqC <- !duplicated(t(Rcol)) # gray9 == grey9 (etc) + Rcol <- Rcol[, uniqC] ; .cc <- .cc[uniqC] + cSpace <- match.arg(cSpace) + convRGB2 <- function(Rgb, to) + t(convertColor(t(Rgb), from="sRGB", to=to, scale.in=255)) + ## the transformation, rgb{0..255} --> cSpace : + TransF <- switch(cSpace, + "rgb255" = identity, + "hsv" = rgb2hsv, + "Luv" = function(RGB) convRGB2(RGB, "Luv"), + "Lab" = function(RGB) convRGB2(RGB, "Lab")) + d <- sqrt(colSums((TransF(Rcol) - as.vector(TransF(rgb)))^2)) + iS <- sort.list(d[near <- d <= dist])# sorted: closest first + setNames(.cc[near][iS], format(zapsmall(d[near][iS]), digits=3)) + } > nearRcolor(col2rgb("tan2"), "rgb") 0.0 21.1 25.8 29.5 "tan2" "tan1" "sandybrown" "sienna1" > nearRcolor(col2rgb("tan2"), "hsv") 0.0000 0.0410 0.0618 0.0638 0.0667 0.0766 "tan2" "sienna2" "coral2" "tomato2" "tan1" "coral" 0.0778 0.0900 0.0912 0.0918 "sienna1" "sandybrown" "coral1" "tomato" > nearRcolor(col2rgb("tan2"), "Luv") 0.00 7.42 7.48 12.41 13.69 "tan2" "tan1" "sandybrown" "orange3" "orange2" > nearRcolor(col2rgb("tan2"), "Lab") 0.00 5.56 8.08 11.31 "tan2" "tan1" "sandybrown" "peru" > nearRcolor("#334455") 0.0867 "darkslategray" > ## Now, consider choosing a color by looking in the > ## neighborhood of one you know : > > plotCol(nearRcolor("deepskyblue", "rgb", dist=50)) > plotCol(nearRcolor("deepskyblue", dist=.1)) > plotCol(nearRcolor("tomato", "rgb", dist= 50), nrow=3) > plotCol(nearRcolor("tomato", "hsv", dist=.12), nrow=3) > plotCol(nearRcolor("tomato", "Luv", dist= 25), nrow=3) > plotCol(nearRcolor("tomato", "Lab", dist= 18), nrow=3) > ## ----------- > > > > cleanEx() detaching ‘package:grid’ > nameEx("contourLines") > ### * contourLines > > flush(stderr()); flush(stdout()) > > ### Name: contourLines > ### Title: Calculate Contour Lines > ### Aliases: contourLines > ### Keywords: dplot > > ### ** Examples > > x <- 10*1:nrow(volcano) > y <- 10*1:ncol(volcano) > cl <- contourLines(x, y, volcano) > ## summarize the sizes of each the contour lines : > cbind(lev = vapply(cl, `[[`, .5, "level"), + n = vapply(cl, function(l) length(l$x), 1)) lev n [1,] 100 47 [2,] 100 16 [3,] 100 11 [4,] 110 45 [5,] 110 48 [6,] 110 126 [7,] 110 14 [8,] 120 270 [9,] 130 259 [10,] 140 245 [11,] 150 207 [12,] 150 13 [13,] 160 165 [14,] 160 31 [15,] 170 169 [16,] 170 5 [17,] 170 21 [18,] 180 105 [19,] 180 15 [20,] 190 49 > > z <- outer(-9:25, -9:25) > pretty(range(z), 10) # -300 -200 ... 600 700 [1] -300 -200 -100 0 100 200 300 400 500 600 700 > utils::str(c2 <- contourLines(z)) List of 12 $ :List of 3 ..$ level: num -200 ..$ x : num [1:4] 0 0.00895 0.01961 0.02844 ..$ y : num [1:4] 0.918 0.941 0.971 1 $ :List of 3 ..$ level: num -200 ..$ x : num [1:4] 0.918 0.941 0.971 1 ..$ y : num [1:4] 0 0.00895 0.01961 0.02844 $ :List of 3 ..$ level: num -100 ..$ x : num [1:19] 0 0.0196 0.0294 0.0385 0.0546 ... ..$ y : num [1:19] 0.592 0.618 0.632 0.647 0.676 ... $ :List of 3 ..$ level: num -100 ..$ x : num [1:19] 0.592 0.618 0.632 0.647 0.676 ... ..$ y : num [1:19] 0 0.0196 0.0294 0.0385 0.0546 ... $ :List of 3 ..$ level: num 0 ..$ x : num [1:34] 0 0.0294 0.0588 0.0882 0.1176 ... ..$ y : num [1:34] 0.267 0.268 0.268 0.268 0.269 ... $ :List of 3 ..$ level: num 0 ..$ x : num [1:34] 0.267 0.268 0.268 0.268 0.269 ... ..$ y : num [1:34] 0 0.0294 0.0588 0.0882 0.1176 ... $ :List of 3 ..$ level: num 100 ..$ x : num [1:44] 1 0.995 0.971 0.941 0.912 ... ..$ y : num [1:44] 0.381 0.382 0.387 0.393 0.398 ... $ :List of 3 ..$ level: num 200 ..$ x : num [1:36] 1 0.997 0.971 0.941 0.918 ... ..$ y : num [1:36] 0.499 0.5 0.51 0.52 0.529 ... $ :List of 3 ..$ level: num 300 ..$ x : num [1:28] 1 0.998 0.971 0.943 0.941 ... ..$ y : num [1:28] 0.617 0.618 0.632 0.647 0.648 ... $ :List of 3 ..$ level: num 400 ..$ x : num [1:20] 1 0.999 0.971 0.957 0.941 ... ..$ y : num [1:20] 0.734 0.735 0.755 0.765 0.776 ... $ :List of 3 ..$ level: num 500 ..$ x : num [1:12] 1 0.999 0.971 0.965 0.941 ... ..$ y : num [1:12] 0.852 0.853 0.877 0.882 0.904 ... $ :List of 3 ..$ level: num 600 ..$ x : num [1:4] 1 0.999 0.971 0.97 ..$ y : num [1:4] 0.97 0.971 0.999 1 > # no segments for {-300, 700}; > # 2 segments for {-200, -100, 0} > # 1 segment for 100:600 > > > > cleanEx() > nameEx("convertColor") > ### * convertColor > > flush(stderr()); flush(stdout()) > > ### Name: convertColor > ### Title: Convert between Colour Spaces > ### Aliases: convertColor colorspaces > ### Keywords: color > > ### ** Examples > > ## The displayable colors from four planes of Lab space > ab <- expand.grid(a = (-10:15)*10, + b = (-15:10)*10) > require(graphics); require(stats) # for na.omit > par(mfrow = c(2, 2), mar = .1+c(3, 3, 3, .5), mgp = c(2, .8, 0)) > > Lab <- cbind(L = 20, ab) > srgb <- convertColor(Lab, from = "Lab", to = "sRGB", clip = NA) > clipped <- attr(na.omit(srgb), "na.action") > srgb[clipped, ] <- 0 > cols <- rgb(srgb[, 1], srgb[, 2], srgb[, 3]) > image((-10:15)*10, (-15:10)*10, matrix(1:(26*26), ncol = 26), col = cols, + xlab = "a", ylab = "b", main = "Lab: L=20") > > Lab <- cbind(L = 40, ab) > srgb <- convertColor(Lab, from = "Lab", to = "sRGB", clip = NA) > clipped <- attr(na.omit(srgb), "na.action") > srgb[clipped, ] <- 0 > cols <- rgb(srgb[, 1], srgb[, 2], srgb[, 3]) > image((-10:15)*10, (-15:10)*10, matrix(1:(26*26), ncol = 26), col = cols, + xlab = "a", ylab = "b", main = "Lab: L=40") > > Lab <- cbind(L = 60, ab) > srgb <- convertColor(Lab, from = "Lab", to = "sRGB", clip = NA) > clipped <- attr(na.omit(srgb), "na.action") > srgb[clipped, ] <- 0 > cols <- rgb(srgb[, 1], srgb[, 2], srgb[, 3]) > image((-10:15)*10, (-15:10)*10, matrix(1:(26*26), ncol = 26), col = cols, + xlab = "a", ylab = "b", main = "Lab: L=60") > > Lab <- cbind(L = 80, ab) > srgb <- convertColor(Lab, from = "Lab", to = "sRGB", clip = NA) > clipped <- attr(na.omit(srgb), "na.action") > srgb[clipped, ] <- 0 > cols <- rgb(srgb[, 1], srgb[, 2], srgb[, 3]) > image((-10:15)*10, (-15:10)*10, matrix(1:(26*26), ncol = 26), col = cols, + xlab = "a", ylab = "b", main = "Lab: L=80") > > cols <- t(col2rgb(palette())); rownames(cols) <- palette(); cols red green blue black 0 0 0 #DF536B 223 83 107 #61D04F 97 208 79 #2297E6 34 151 230 #28E2E5 40 226 229 #CD0BBC 205 11 188 #F5C710 245 199 16 gray62 158 158 158 > zapsmall(lab <- convertColor(cols, from = "sRGB", to = "Lab", scale.in = 255)) L a b black 0.00000 0.00000 0.00000 #DF536B 55.16051 56.30900 16.18063 #61D04F 74.89688 -55.97739 53.00681 #2297E6 59.98342 -3.54255 -48.62932 #28E2E5 82.01645 -41.73498 -14.10432 #CD0BBC 48.23048 79.84315 -42.53326 #F5C710 82.05072 2.31748 81.63638 gray62 65.11425 0.00000 0.00000 > stopifnot(all.equal(cols, # converting back.. getting the original: + round(convertColor(lab, from = "Lab", to = "sRGB", scale.out = 255)), + check.attributes = FALSE)) > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("densCols") > ### * densCols > > flush(stderr()); flush(stdout()) > > ### Name: densCols > ### Title: Colors for Smooth Density Plots > ### Aliases: densCols blues9 > ### Keywords: dplot > > ### ** Examples > > > cleanEx() > nameEx("dev") > ### * dev > > flush(stderr()); flush(stdout()) > > ### Name: dev > ### Title: Control Multiple Devices > ### Aliases: dev.cur dev.list dev.next dev.prev dev.off dev.set dev.new > ### graphics.off > ### Keywords: device iplot > > ### ** Examples > > ## Not run: > ##D ## Unix-specific example > ##D x11() > ##D plot(1:10) > ##D x11() > ##D plot(rnorm(10)) > ##D dev.set(dev.prev()) > ##D abline(0, 1) # through the 1:10 points > ##D dev.set(dev.next()) > ##D abline(h = 0, col = "gray") # for the residual plot > ##D dev.set(dev.prev()) > ##D dev.off(); dev.off() #- close the two X devices > ## End(Not run) > > > > cleanEx() > nameEx("dev.capabilities") > ### * dev.capabilities > > flush(stderr()); flush(stdout()) > > ### Name: dev.capabilities > ### Title: Query Capabilities of the Current Graphics Device > ### Aliases: dev.capabilities > ### Keywords: dplot > > ### ** Examples > > dev.capabilities() $semiTransparency [1] TRUE $transparentBackground [1] "semi" $rasterImage [1] "yes" $capture [1] FALSE $locator [1] FALSE $events character(0) $patterns [1] "LinearGradient" "RadialGradient" "TilingPattern" $clippingPaths [1] TRUE $masks [1] "alpha" "luminance" $compositing [1] "multiply" "screen" "overlay" "darken" "lighten" [6] "color.dodge" "color.burn" "hard.light" "soft.light" "difference" [11] "exclusion" $transformations [1] TRUE $paths [1] TRUE $glyphs [1] TRUE > > > > cleanEx() > nameEx("dev.interactive") > ### * dev.interactive > > flush(stderr()); flush(stdout()) > > ### Name: dev.interactive > ### Title: Is the Current Graphics Device Interactive? > ### Aliases: dev.interactive deviceIsInteractive > ### Keywords: device > > ### ** Examples > > dev.interactive() [1] FALSE > print(deviceIsInteractive(NULL)) [1] "X11" "X11cairo" "quartz" "windows" "JavaGD" "CairoWin" "CairoX11" > > > > cleanEx() > nameEx("dev.size") > ### * dev.size > > flush(stderr()); flush(stdout()) > > ### Name: dev.size > ### Title: Find Size of Device Surface > ### Aliases: dev.size > ### Keywords: dplot > > ### ** Examples > > dev.size("cm") [1] 17.78 17.78 > > > > cleanEx() > nameEx("dev2") > ### * dev2 > > flush(stderr()); flush(stdout()) > > ### Name: dev2 > ### Title: Copy Graphics Between Multiple Devices > ### Aliases: dev.copy dev.print dev.copy2eps dev.copy2pdf dev.control > ### Keywords: device > > ### ** Examples > > ## Not run: > ##D x11() # on a Unix-alike > ##D plot(rnorm(10), main = "Plot 1") > ##D dev.copy(device = x11) > ##D mtext("Copy 1", 3) > ##D dev.print(width = 6, height = 6, horizontal = FALSE) # prints it > ##D dev.off(dev.prev()) > ##D dev.off() > ## End(Not run) > > > > cleanEx() > nameEx("extendrange") > ### * extendrange > > flush(stderr()); flush(stdout()) > > ### Name: extendrange > ### Title: Extend a Numerical Range by a Small Percentage > ### Aliases: extendrange > ### Keywords: dplot > > ### ** Examples > > x <- 1:5 > (r <- range(x)) # 1 5 [1] 1 5 > extendrange(x) # 0.8 5.2 [1] 0.8 5.2 > extendrange(x, f= 0.01) # 0.96 5.04 [1] 0.96 5.04 > > ## extend more to the right: > extendrange(x, f=c(.01,.03)) # 0.96 5.12 [1] 0.96 5.12 > > ## Use 'r' if you have it already: > stopifnot(identical(extendrange(r = r), + extendrange(x))) > > > > cleanEx() > nameEx("getGraphicsEvent") > ### * getGraphicsEvent > > flush(stderr()); flush(stdout()) > > ### Name: getGraphicsEvent > ### Title: Wait for a mouse or keyboard event from a graphics window > ### Aliases: getGraphicsEvent setGraphicsEventHandlers getGraphicsEventEnv > ### setGraphicsEventEnv > ### Keywords: iplot > > ### ** Examples > > # This currently only works on the Windows, X11(type = "Xlib"), and > # X11(type = "cairo") screen devices... > ## Not run: > ##D savepar <- par(ask = FALSE) > ##D dragplot <- function(..., xlim = NULL, ylim = NULL, xaxs = "r", yaxs = "r") { > ##D plot(..., xlim = xlim, ylim = ylim, xaxs = xaxs, yaxs = yaxs) > ##D startx <- NULL > ##D starty <- NULL > ##D prevx <- NULL > ##D prevy <- NULL > ##D usr <- NULL > ##D > ##D devset <- function() > ##D if (dev.cur() != eventEnv$which) dev.set(eventEnv$which) > ##D > ##D dragmousedown <- function(buttons, x, y) { > ##D startx <<- x > ##D starty <<- y > ##D prevx <<- 0 > ##D prevy <<- 0 > ##D devset() > ##D usr <<- par("usr") > ##D eventEnv$onMouseMove <- dragmousemove > ##D NULL > ##D } > ##D > ##D dragmousemove <- function(buttons, x, y) { > ##D devset() > ##D deltax <- diff(grconvertX(c(startx, x), "ndc", "user")) > ##D deltay <- diff(grconvertY(c(starty, y), "ndc", "user")) > ##D if (abs(deltax-prevx) + abs(deltay-prevy) > 0) { > ##D plot(..., xlim = usr[1:2]-deltax, xaxs = "i", > ##D ylim = usr[3:4]-deltay, yaxs = "i") > ##D prevx <<- deltax > ##D prevy <<- deltay > ##D } > ##D NULL > ##D } > ##D > ##D mouseup <- function(buttons, x, y) { > ##D eventEnv$onMouseMove <- NULL > ##D } > ##D > ##D keydown <- function(key) { > ##D if (key == "q") return(invisible(1)) > ##D eventEnv$onMouseMove <- NULL > ##D NULL > ##D } > ##D > ##D setGraphicsEventHandlers(prompt = "Click and drag, hit q to quit", > ##D onMouseDown = dragmousedown, > ##D onMouseUp = mouseup, > ##D onKeybd = keydown) > ##D eventEnv <- getGraphicsEventEnv() > ##D } > ##D > ##D dragplot(rnorm(1000), rnorm(1000)) > ##D getGraphicsEvent() > ##D par(savepar) > ## End(Not run) > > > > cleanEx() > nameEx("grSoftVersion") > ### * grSoftVersion > > flush(stderr()); flush(stdout()) > > ### Name: grSoftVersion > ### Title: Report Versions of Graphics Software > ### Aliases: grSoftVersion > > ### ** Examples > > > > > cleanEx() > nameEx("gray") > ### * gray > > flush(stderr()); flush(stdout()) > > ### Name: gray > ### Title: Gray Level Specification > ### Aliases: gray grey > ### Keywords: color > > ### ** Examples > > gray(0:8 / 8) [1] "#000000" "#202020" "#404040" "#606060" "#808080" "#9F9F9F" "#BFBFBF" [8] "#DFDFDF" "#FFFFFF" > > > > cleanEx() > nameEx("gray.colors") > ### * gray.colors > > flush(stderr()); flush(stdout()) > > ### Name: gray.colors > ### Title: Gray Color Palette > ### Aliases: gray.colors grey.colors > ### Keywords: color > > ### ** Examples > > require(graphics) > > pie(rep(1, 12), col = gray.colors(12)) > barplot(1:12, col = gray.colors(12)) > > > > cleanEx() > nameEx("hcl") > ### * hcl > > flush(stderr()); flush(stdout()) > > ### Name: hcl > ### Title: HCL Color Specification > ### Aliases: hcl > ### Keywords: color dplot > > ### ** Examples > > require(graphics) > > # The Foley and Van Dam PhD Data. > csd <- matrix(c( 4,2,4,6, 4,3,1,4, 4,7,7,1, + 0,7,3,2, 4,5,3,2, 5,4,2,2, + 3,1,3,0, 4,4,6,7, 1,10,8,7, + 1,5,3,2, 1,5,2,1, 4,1,4,3, + 0,3,0,6, 2,1,5,5), nrow = 4) > > csphd <- function(colors) + barplot(csd, col = colors, ylim = c(0,30), + names.arg = 72:85, xlab = "Year", ylab = "Students", + legend.text = c("Winter", "Spring", "Summer", "Fall"), + main = "Computer Science PhD Graduates", las = 1) > > # The Original (Metaphorical) Colors (Ouch!) > csphd(c("blue", "green", "yellow", "orange")) > > # A Color Tetrad (Maximal Color Differences) > csphd(hcl(h = c(30, 120, 210, 300))) > > # Same, but lighter and less colorful > # Turn off automatic correction to make sure > # that we have defined real colors. > csphd(hcl(h = c(30, 120, 210, 300), + c = 20, l = 90, fixup = FALSE)) > > # Analogous Colors > # Good for those with red/green color confusion > csphd(hcl(h = seq(60, 240, by = 60))) > > # Metaphorical Colors > csphd(hcl(h = seq(210, 60, length.out = 4))) > > # Cool Colors > csphd(hcl(h = seq(120, 0, length.out = 4) + 150)) > > # Warm Colors > csphd(hcl(h = seq(120, 0, length.out = 4) - 30)) > > # Single Color > hist(stats::rnorm(1000), col = hcl(240)) > > ## Exploring the hcl() color space {in its mapping to R's sRGB colors}: > demo(hclColors) demo(hclColors) ---- ~~~~~~~~~ > ### ------ hcl() explorations > > hcl.wheel <- + function(chroma = 35, lums = 0:100, hues = 1:360, asp = 1, + p.cex = 0.6, do.label = FALSE, rev.lum = FALSE, + fixup = TRUE) + { + ## Purpose: show chroma "sections" of hcl() color space; see ?hcl + ## ---------------------------------------------------------------------- + ## Arguments: chroma: can be vector -> multiple plots are done, + ## lums, hues, fixup : all corresponding to hcl()'s args + ## rev.lum: logical indicating if luminance + ## should go from outer to inner + ## ---------------------------------------------------------------------- + ## Author: Martin Maechler, Date: 24 Jun 2005 + + require("graphics") + stopifnot(is.numeric(lums), lums >= 0, lums <= 100, + is.numeric(hues), hues >= 0, hues <= 360, + is.numeric(chroma), chroma >= 0, (nch <- length(chroma)) >= 1) + if(is.unsorted(hues)) hues <- sort(hues) + if(nch > 1) { + op <- par(mfrow= n2mfrow(nch), mar = c(0,0,0,0), xpd = TRUE) + on.exit(par(op)) + } + for(i.c in 1:nch) { + plot(-1:1,-1:1, type="n", axes = FALSE, xlab="",ylab="", asp = asp) + ## main = sprintf("hcl(h = , c = %g)", chroma[i.c]), + text(0.4, 0.99, paste("chroma =", format(chroma[i.c])), + adj = 0, font = 4) + l.s <- (if(rev.lum) rev(lums) else lums) / max(lums) # <= 1 + for(ang in hues) { # could do all this using outer() instead of for()... + a. <- ang * pi/180 + z.a <- exp(1i * a.) + cols <- hcl(ang, c = chroma[i.c], l = lums, fixup = fixup) + points(l.s * z.a, pch = 16, col = cols, cex = p.cex) + ##if(do."text") : draw the 0,45,90,... angle "lines" + if(do.label) + text(z.a*1.05, labels = ang, col = cols[length(cols)/2], + srt = ang) + } + if(!fixup) ## show the outline + lines(exp(1i * hues * pi/180)) + } + invisible() + } > ## and now a few interesting calls : > > hcl.wheel() # and watch it redraw when you fiddle with the graphic window > hcl.wheel(rev.lum= TRUE) # ditto > hcl.wheel(do.label = TRUE) # ditto > ## Now watch: > hcl.wheel(chroma = c(25,35,45,55)) > hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.4) > hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, fixup = FALSE) > hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE) > if(dev.interactive()) # new "graphics window" -- to compare with previous : + dev.new() > hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE, fixup=FALSE) > > > > > cleanEx() > nameEx("hsv") > ### * hsv > > flush(stderr()); flush(stdout()) > > ### Name: hsv > ### Title: HSV Color Specification > ### Aliases: hsv > ### Keywords: color dplot > > ### ** Examples > > require(graphics) > > hsv(.5,.5,.5) [1] "#408080" > > ## Red tones: > n <- 20; y <- -sin(3*pi*((1:n)-1/2)/n) > op <- par(mar = rep(1.5, 4)) > plot(y, axes = FALSE, frame.plot = TRUE, + xlab = "", ylab = "", pch = 21, cex = 30, + bg = rainbow(n, start = .85, end = .1), + main = "Red tones") > par(op) > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("make.rgb") > ### * make.rgb > > flush(stderr()); flush(stdout()) > > ### Name: make.rgb > ### Title: Create colour spaces > ### Aliases: make.rgb colorConverter > ### Keywords: color > > ### ** Examples > > (pal <- make.rgb(red = c(0.6400, 0.3300), + green = c(0.2900, 0.6000), + blue = c(0.1500, 0.0600), + name = "PAL/SECAM RGB")) Color space converter: PAL/SECAM RGB Reference white: D65 display gamma = 2.2 > > ## converter for sRGB in #rrggbb format > hexcolor <- colorConverter(toXYZ = function(hex, ...) { + rgb <- t(col2rgb(hex))/255 + colorspaces$sRGB$toXYZ(rgb, ...) }, + fromXYZ = function(xyz, ...) { + rgb <- colorspaces$sRGB$fromXYZ(xyz, ...) + rgb <- round(rgb, 5) + if (min(rgb) < 0 || max(rgb) > 1) + as.character(NA) + else rgb(rgb[1], rgb[2], rgb[3])}, + white = "D65", name = "#rrggbb") > > (cols <- t(col2rgb(palette()))) red green blue [1,] 0 0 0 [2,] 223 83 107 [3,] 97 208 79 [4,] 34 151 230 [5,] 40 226 229 [6,] 205 11 188 [7,] 245 199 16 [8,] 158 158 158 > zapsmall(luv <- convertColor(cols, from = "sRGB", to = "Luv", scale.in = 255)) L u v [1,] 0.00000 0.00000 0.00000 [2,] 55.16051 99.94871 8.95299 [3,] 74.89688 -51.95694 73.49647 [4,] 59.98342 -36.43653 -76.74275 [5,] 82.01645 -61.64283 -15.85619 [6,] 48.23048 74.70628 -73.95136 [7,] 82.05072 40.07525 84.92489 [8,] 65.11425 0.00000 0.00000 > (hex <- convertColor(luv, from = "Luv", to = hexcolor, scale.out = NULL)) [,1] [1,] "#000000" [2,] "#DF536B" [3,] "#61D04F" [4,] "#2297E6" [5,] "#28E2E5" [6,] "#CD0BBC" [7,] "#F5C710" [8,] "#9E9E9E" > > ## must make hex a matrix before using it > (cc <- round(convertColor(as.matrix(hex), from = hexcolor, to = "sRGB", + scale.in = NULL, scale.out = 255))) [,1] [,2] [,3] [1,] 0 0 0 [2,] 223 83 107 [3,] 97 208 79 [4,] 34 151 230 [5,] 40 226 229 [6,] 205 11 188 [7,] 245 199 16 [8,] 158 158 158 > stopifnot(cc == cols) > > ## Internally vectorized version of hexcolor, notice the use > ## of `vectorized = TRUE`: > > hexcolorv <- colorConverter(toXYZ = function(hex, ...) { + rgb <- t(col2rgb(hex))/255 + colorspaces$sRGB$toXYZ(rgb, ...) }, + fromXYZ = function(xyz, ...) { + rgb <- colorspaces$sRGB$fromXYZ(xyz, ...) + rgb <- round(rgb, 5) + oob <- pmin(rgb[,1],rgb[,2],rgb[,3]) < 0 | + pmax(rgb[,1],rgb[,2],rgb[,3]) > 0 + res <- rep(NA_character_, nrow(rgb)) + res[!oob] <- rgb(rgb[!oob,,drop=FALSE])}, + white = "D65", name = "#rrggbb", + vectorized=TRUE) > (ccv <- round(convertColor(as.matrix(hex), from = hexcolor, to = "sRGB", + scale.in = NULL, scale.out = 255))) [,1] [,2] [,3] [1,] 0 0 0 [2,] 223 83 107 [3,] 97 208 79 [4,] 34 151 230 [5,] 40 226 229 [6,] 205 11 188 [7,] 245 199 16 [8,] 158 158 158 > stopifnot(ccv == cols) > > > > > cleanEx() > nameEx("n2mfrow") > ### * n2mfrow > > flush(stderr()); flush(stdout()) > > ### Name: n2mfrow > ### Title: Compute Default 'mfrow' From Number of Plots > ### Aliases: n2mfrow > ### Keywords: dplot utilities > > ### ** Examples > > require(graphics) > > n2mfrow(8) # 3 x 3 [1] 3 3 > > n <- 5 ; x <- seq(-2, 2, length.out = 51) > ## suppose now that 'n' is not known {inside function} > op <- par(mfrow = n2mfrow(n)) > for (j in 1:n) + plot(x, x^j, main = substitute(x^ exp, list(exp = j)), type = "l", + col = "blue") > > sapply(1:14, n2mfrow) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [1,] 1 2 3 2 3 3 3 3 3 4 4 4 4 4 [2,] 1 1 1 2 2 2 3 3 3 3 3 3 4 4 > sapply(1:14, n2mfrow, asp=16/9) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [1,] 1 2 2 2 2 2 2 3 3 3 3 3 3 3 [2,] 1 1 2 2 3 3 4 3 3 4 4 4 5 5 > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("nclass") > ### * nclass > > flush(stderr()); flush(stdout()) > > ### Name: nclass > ### Title: Compute the Number of Classes for a Histogram > ### Aliases: nclass.Sturges nclass.scott nclass.FD > ### Keywords: univar > > ### ** Examples > > set.seed(1) > x <- stats::rnorm(1111) > nclass.Sturges(x) [1] 12 > > ## Compare them: > NC <- function(x) c(Sturges = nclass.Sturges(x), + Scott = nclass.scott(x), FD = nclass.FD(x)) > NC(x) Sturges Scott FD 12 20 26 > onePt <- rep(1, 11) > NC(onePt) # no longer gives NaN Sturges Scott FD 5 1 1 > > > > cleanEx() > nameEx("palette") > ### * palette > > flush(stderr()); flush(stdout()) > > ### Name: palette > ### Title: Set or View the Graphics Palette > ### Aliases: palette palette.pals palette.colors > ### Keywords: color sysdata > > ### ** Examples > > require(graphics) > > palette() # obtain the current palette [1] "black" "#DF536B" "#61D04F" "#2297E6" "#28E2E5" "#CD0BBC" "#F5C710" [8] "gray62" > palette("R3");palette() # old default palette [1] "black" "red" "green3" "blue" "cyan" "magenta" "yellow" [8] "gray" > palette("ggplot2") # ggplot2-style palette > palette() [1] "black" "#F8766D" "#00BA38" "#619CFF" "#00BFC4" "#F564E3" "#B79F00" [8] "gray62" > > palette(hcl.colors(8, "viridis")) > > (palette(gray(seq(0,.9,length.out = 25)))) # gray scales; print old palette [1] "#4B0055" "#3C3777" "#006290" "#008A98" "#00AC8E" "#25C771" "#A6DA42" [8] "#FDE333" > matplot(outer(1:100, 1:30), type = "l", lty = 1,lwd = 2, col = 1:30, + main = "Gray Scales Palette", + sub = "palette(gray(seq(0, .9, len=25)))") > palette("default") # reset back to the default > > ## on a device where alpha transparency is supported, > ## use 'alpha = 0.3' transparency with the default palette : > mycols <- adjustcolor(palette(), alpha.f = 0.3) > opal <- palette(mycols) > x <- rnorm(1000); xy <- cbind(x, 3*x + rnorm(1000)) > plot (xy, lwd = 2, + main = "Alpha-Transparency Palette\n alpha = 0.3") > xy[,1] <- -xy[,1] > points(xy, col = 8, pch = 16, cex = 1.5) > palette("default") > > ## List available built-in palettes > palette.pals() [1] "R3" "R4" "ggplot2" "Okabe-Ito" [5] "Accent" "Dark 2" "Paired" "Pastel 1" [9] "Pastel 2" "Set 1" "Set 2" "Set 3" [13] "Tableau 10" "Classic Tableau" "Polychrome 36" "Alphabet" > > ## Demonstrate the colors 1:8 in different palettes using a custom matplot() > sinplot <- function(main=NULL, n = 8) { + x <- outer( + seq(-pi, pi, length.out = 50), + seq( 0, pi, length.out = n), + function(x, y) sin(x - y) + ) + matplot(x, type = "l", lwd = 4, lty = 1, col = 1:n, ylab = "", main=main) + } > sinplot("default palette") > > palette("R3"); sinplot("R3") > palette("Okabe-Ito"); sinplot("Okabe-Ito") > palette("Tableau") ; sinplot("Tableau", n = 10) > palROB <- colorRampPalette(c("red", "darkorange2", "blue"), space = "Lab") > palette(palROB(16)); sinplot("palROB(16)", n = 16) > palette("default") # reset > > ## color swatches for palette.colors() > palette.swatch <- function(palette = palette.pals(), n = 8, nrow = 8, + border = "black", cex = 1, ...) + { + cols <- sapply(palette, palette.colors, n = n, recycle = TRUE) + ncol <- ncol(cols) + nswatch <- min(ncol, nrow) + op <- par(mar = rep(0.1, 4), + mfrow = c(1, min(5, ceiling(ncol/nrow))), + cex = cex, ...) + on.exit(par(op)) + while (length(palette)) { + subset <- seq_len(min(nrow, ncol(cols))) + plot.new() + plot.window(c(0, n), c(0.25, nrow + 0.25)) + y <- rev(subset) + text(0, y + 0.1, palette[subset], adj = c(0, 0)) + y <- rep(y, each = n) + rect(rep(0:(n-1), n), y, rep(1:n, n), y - 0.5, + col = cols[, subset], border = border) + palette <- palette[-subset] + cols <- cols [, -subset, drop = FALSE] + } + } > > palette.swatch() > > palette.swatch(n = 26) # show full "Alphabet"; recycle most others > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("palettes") > ### * palettes > > flush(stderr()); flush(stdout()) > > ### Name: Palettes > ### Title: Color Palettes > ### Aliases: rainbow heat.colors terrain.colors topo.colors cm.colors > ### hcl.colors hcl.pals > ### Keywords: color dplot > > ### ** Examples > > require("graphics") > > # color wheels in RGB/HSV and HCL space > par(mfrow = c(2, 2)) > pie(rep(1, 12), col = rainbow(12), main = "RGB/HSV") > pie(rep(1, 12), col = hcl.colors(12, "Set 2"), main = "HCL") > par(mfrow = c(1, 1)) > > ## color swatches for RGB/HSV palettes > demo.pal <- + function(n, border = if (n < 32) "light gray" else NA, + main = paste("color palettes; n=", n), + ch.col = c("rainbow(n, start=.7, end=.1)", "heat.colors(n)", + "terrain.colors(n)", "topo.colors(n)", + "cm.colors(n)")) + { + nt <- length(ch.col) + i <- 1:n; j <- n / nt; d <- j/6; dy <- 2*d + plot(i, i+d, type = "n", yaxt = "n", ylab = "", main = main) + for (k in 1:nt) { + rect(i-.5, (k-1)*j+ dy, i+.4, k*j, + col = eval(str2lang(ch.col[k])), border = border) + text(2*j, k * j + dy/4, ch.col[k]) + } + } > demo.pal(16) > > ## color swatches for HCL palettes > hcl.swatch <- function(type = NULL, n = 5, nrow = 11, + border = if (n < 15) "black" else NA) { + palette <- hcl.pals(type) + cols <- sapply(palette, hcl.colors, n = n) + ncol <- ncol(cols) + nswatch <- min(ncol, nrow) + + par(mar = rep(0.1, 4), + mfrow = c(1, min(5, ceiling(ncol/nrow))), + pin = c(1, 0.5 * nswatch), + cex = 0.7) + + while (length(palette)) { + subset <- 1:min(nrow, ncol(cols)) + plot.new() + plot.window(c(0, n), c(0, nrow + 1)) + text(0, rev(subset) + 0.1, palette[subset], adj = c(0, 0)) + y <- rep(subset, each = n) + rect(rep(0:(n-1), n), rev(y), rep(1:n, n), rev(y) - 0.5, + col = cols[, subset], border = border) + palette <- palette[-subset] + cols <- cols[, -subset, drop = FALSE] + } + + par(mfrow = c(1, 1), mar = c(5.1, 4.1, 4.1, 2.1), cex = 1) + } > hcl.swatch() > hcl.swatch("qualitative") > hcl.swatch("sequential") > hcl.swatch("diverging") > hcl.swatch("divergingx") > > ## heat maps with sequential HCL palette (purple) > image(volcano, col = hcl.colors(11, "purples", rev = TRUE)) > filled.contour(volcano, nlevels = 10, + color.palette = function(n, ...) + hcl.colors(n, "purples", rev = TRUE, ...)) > > ## list available HCL color palettes > hcl.pals("qualitative") [1] "Pastel 1" "Dark 2" "Dark 3" "Set 2" "Set 3" "Warm" "Cold" [8] "Harmonic" "Dynamic" > hcl.pals("sequential") [1] "Grays" "Light Grays" "Blues 2" "Blues 3" [5] "Purples 2" "Purples 3" "Reds 2" "Reds 3" [9] "Greens 2" "Greens 3" "Oslo" "Purple-Blue" [13] "Red-Purple" "Red-Blue" "Purple-Orange" "Purple-Yellow" [17] "Blue-Yellow" "Green-Yellow" "Red-Yellow" "Heat" [21] "Heat 2" "Terrain" "Terrain 2" "Viridis" [25] "Plasma" "Inferno" "Rocket" "Mako" [29] "Dark Mint" "Mint" "BluGrn" "Teal" [33] "TealGrn" "Emrld" "BluYl" "ag_GrnYl" [37] "Peach" "PinkYl" "Burg" "BurgYl" [41] "RedOr" "OrYel" "Purp" "PurpOr" [45] "Sunset" "Magenta" "SunsetDark" "ag_Sunset" [49] "BrwnYl" "YlOrRd" "YlOrBr" "OrRd" [53] "Oranges" "YlGn" "YlGnBu" "Reds" [57] "RdPu" "PuRd" "Purples" "PuBuGn" [61] "PuBu" "Greens" "BuGn" "GnBu" [65] "BuPu" "Blues" "Lajolla" "Turku" [69] "Hawaii" "Batlow" > hcl.pals("diverging") [1] "Blue-Red" "Blue-Red 2" "Blue-Red 3" "Red-Green" [5] "Purple-Green" "Purple-Brown" "Green-Brown" "Blue-Yellow 2" [9] "Blue-Yellow 3" "Green-Orange" "Cyan-Magenta" "Tropic" [13] "Broc" "Cork" "Vik" "Berlin" [17] "Lisbon" "Tofino" > hcl.pals("divergingx") [1] "ArmyRose" "Earth" "Fall" "Geyser" "TealRose" "Temps" [7] "PuOr" "RdBu" "RdGy" "PiYG" "PRGn" "BrBG" [13] "RdYlBu" "RdYlGn" "Spectral" "Zissou 1" "Cividis" "Roma" > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("pdf") > ### * pdf > > flush(stderr()); flush(stdout()) > > ### Name: pdf > ### Title: PDF Graphics Device > ### Aliases: pdf > ### Keywords: device > > ### ** Examples > > > > cleanEx() > nameEx("pdf.options") > ### * pdf.options > > flush(stderr()); flush(stdout()) > > ### Name: pdf.options > ### Title: Auxiliary Function to Set/View Defaults for Arguments of pdf > ### Aliases: pdf.options > ### Keywords: device > > ### ** Examples > > pdf.options(bg = "pink") > utils::str(pdf.options()) List of 18 $ width : num 7 $ height : num 7 $ onefile : logi TRUE $ family : chr "Helvetica" $ title : chr "R Graphics Output" $ fonts : NULL $ version : chr "1.4" $ paper : chr "special" $ encoding : chr "default" $ bg : chr "pink" $ fg : chr "black" $ pointsize : num 12 $ pagecentre : logi TRUE $ colormodel : chr "srgb" $ useDingbats: logi FALSE $ useKerning : logi TRUE $ fillOddEven: logi FALSE $ compress : logi TRUE > pdf.options(reset = TRUE) # back to factory-fresh > > > > cleanEx() > nameEx("pictex") > ### * pictex > > flush(stderr()); flush(stdout()) > > ### Name: pictex > ### Title: A PicTeX Graphics Driver > ### Aliases: pictex > ### Keywords: device > > ### ** Examples > > require(graphics) > ## Don't show: > oldwd <- setwd(tempdir()) > ## End(Don't show) > > pictex() Warning in pictex() : 'pictex' is deprecated. Consider a TiKZ device instead. > plot(1:11, (-5:5)^2, type = "b", main = "Simple Example Plot") > dev.off() pdf 2 > ##-------------------- > ## Not run: > ##D %% LaTeX Example > ##D \documentclass{article} > ##D \usepackage{pictex} > ##D \usepackage{graphics} % for \rotatebox > ##D \begin{document} > ##D %... > ##D \begin{figure}[h] > ##D \centerline{\input{Rplots.tex}} > ##D \caption{} > ##D \end{figure} > ##D %... > ##D \end{document} > ## End(Not run) > ##-------------------- > unlink("Rplots.tex") > ## Don't show: > setwd(oldwd) > ## End(Don't show) > > > > cleanEx() > nameEx("plotmath") > ### * plotmath > > flush(stderr()); flush(stdout()) > > ### Name: plotmath > ### Title: Mathematical Annotation in R > ### Aliases: plotmath symbol plain bold italic bolditalic hat bar dot ring > ### widehat widetilde displaystyle textstyle scriptstyle > ### scriptscriptstyle underline phantom over frac atop integral inf sup > ### group bgroup > ### Keywords: aplot > > ### ** Examples > > require(graphics) > > x <- seq(-4, 4, length.out = 101) > y <- cbind(sin(x), cos(x)) > matplot(x, y, type = "l", xaxt = "n", + main = expression(paste(plain(sin) * phi, " and ", + plain(cos) * phi)), + ylab = expression("sin" * phi, "cos" * phi), # only 1st is taken + xlab = expression(paste("Phase Angle ", phi)), + col.main = "blue") > axis(1, at = c(-pi, -pi/2, 0, pi/2, pi), + labels = expression(-pi, -pi/2, 0, pi/2, pi)) > > > ## How to combine "math" and numeric variables : > plot(1:10, type="n", xlab="", ylab="", main = "plot math & numbers") > theta <- 1.23 ; mtext(bquote(hat(theta) == .(theta)), line= .25) > for(i in 2:9) + text(i, i+1, substitute(list(xi, eta) == group("(",list(x,y),")"), + list(x = i, y = i+1))) > ## note that both of these use calls rather than expressions. > ## > text(1, 10, "Derivatives:", adj = 0) > text(1, 9.6, expression( + " first: {f * minute}(x) " == {f * minute}(x)), adj = 0) > text(1, 9.0, expression( + " second: {f * second}(x) " == {f * second}(x)), adj = 0) > > > ## note the "{ .. }" trick to get "chained" equations: > plot(1:10, 1:10, main = quote(1 <= {1 < 2})) > text(4, 9, expression(hat(beta) == (X^t * X)^{-1} * X^t * y)) > text(4, 8.4, "expression(hat(beta) == (X^t * X)^{-1} * X^t * y)", + cex = .8) > text(4, 7, expression(bar(x) == sum(frac(x[i], n), i==1, n))) > text(4, 6.4, "expression(bar(x) == sum(frac(x[i], n), i==1, n))", + cex = .8) > text(8, 5, expression(paste(frac(1, sigma*sqrt(2*pi)), " ", + plain(e)^{frac(-(x-mu)^2, 2*sigma^2)})), + cex = 1.2) > > ## some other useful symbols > plot.new(); plot.window(c(0,4), c(15,1)) > text(1, 1, "universal", adj = 0); text(2.5, 1, "\\042") > text(3, 1, expression(symbol("\042"))) > text(1, 2, "existential", adj = 0); text(2.5, 2, "\\044") > text(3, 2, expression(symbol("\044"))) > text(1, 3, "suchthat", adj = 0); text(2.5, 3, "\\047") > text(3, 3, expression(symbol("\047"))) > text(1, 4, "therefore", adj = 0); text(2.5, 4, "\\134") > text(3, 4, expression(symbol("\134"))) > text(1, 5, "perpendicular", adj = 0); text(2.5, 5, "\\136") > text(3, 5, expression(symbol("\136"))) > text(1, 6, "circlemultiply", adj = 0); text(2.5, 6, "\\304") > text(3, 6, expression(symbol("\304"))) > text(1, 7, "circleplus", adj = 0); text(2.5, 7, "\\305") > text(3, 7, expression(symbol("\305"))) > text(1, 8, "emptyset", adj = 0); text(2.5, 8, "\\306") > text(3, 8, expression(symbol("\306"))) > text(1, 9, "angle", adj = 0); text(2.5, 9, "\\320") > text(3, 9, expression(symbol("\320"))) > text(1, 10, "leftangle", adj = 0); text(2.5, 10, "\\341") > text(3, 10, expression(symbol("\341"))) > text(1, 11, "rightangle", adj = 0); text(2.5, 11, "\\361") > text(3, 11, expression(symbol("\361"))) > > > > cleanEx() > nameEx("postscriptFonts") > ### * postscriptFonts > > flush(stderr()); flush(stdout()) > > ### Name: postscriptFonts > ### Title: PostScript and PDF Font Families > ### Aliases: postscriptFonts pdfFonts > ### Keywords: device > > ### ** Examples > > postscriptFonts() $serif $family [1] "Times" $metrics [1] "Times-Roman.afm" "Times-Bold.afm" "Times-Italic.afm" [4] "Times-BoldItalic.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $sans $family [1] "Helvetica" $metrics [1] "Helvetica.afm" "Helvetica-Bold.afm" [3] "Helvetica-Oblique.afm" "Helvetica-BoldOblique.afm" [5] "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $mono $family [1] "Courier" $metrics [1] "Courier.afm" "Courier-Bold.afm" [3] "Courier-Oblique.afm" "Courier-BoldOblique.afm" [5] "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $AvantGarde $family [1] "AvantGarde" $metrics [1] "agw_____.afm" "agd_____.afm" "agwo____.afm" "agdo____.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $Bookman $family [1] "Bookman" $metrics [1] "bkl_____.afm" "bkd_____.afm" "bkli____.afm" "bkdi____.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $Courier $family [1] "Courier" $metrics [1] "Courier.afm" "Courier-Bold.afm" [3] "Courier-Oblique.afm" "Courier-BoldOblique.afm" [5] "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $Helvetica $family [1] "Helvetica" $metrics [1] "Helvetica.afm" "Helvetica-Bold.afm" [3] "Helvetica-Oblique.afm" "Helvetica-BoldOblique.afm" [5] "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $`Helvetica-Narrow` $family [1] "Helvetica-Narrow" $metrics [1] "hvn_____.afm" "hvnb____.afm" "hvno____.afm" "hvnbo___.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $NewCenturySchoolbook $family [1] "NewCenturySchoolbook" $metrics [1] "ncr_____.afm" "ncb_____.afm" "nci_____.afm" "ncbi____.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $Palatino $family [1] "Palatino" $metrics [1] "por_____.afm" "pob_____.afm" "poi_____.afm" "pobi____.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $Times $family [1] "Times" $metrics [1] "Times-Roman.afm" "Times-Bold.afm" "Times-Italic.afm" [4] "Times-BoldItalic.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URWGothic $family [1] "URWGothic" $metrics [1] "a010013l.afm" "a010015l.afm" "a010033l.afm" "a010035l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URWBookman $family [1] "URWBookman" $metrics [1] "b018012l.afm" "b018015l.afm" "b018032l.afm" "b018035l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $NimbusMon $family [1] "NimbusMon" $metrics [1] "n022003l.afm" "n022004l.afm" "n022023l.afm" "n022024l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $NimbusSan $family [1] "NimbusSan" $metrics [1] "n019003l.afm" "n019004l.afm" "n019023l.afm" "n019024l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URWHelvetica $family [1] "URWHelvetica" $metrics [1] "n019003l.afm" "n019004l.afm" "n019023l.afm" "n019024l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $NimbusSanCond $family [1] "NimbusSanCond" $metrics [1] "n019043l.afm" "n019044l.afm" "n019063l.afm" "n019064l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $CenturySch $family [1] "CenturySch" $metrics [1] "c059013l.afm" "c059016l.afm" "c059033l.afm" "c059036l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URWPalladio $family [1] "URWPalladio" $metrics [1] "p052003l.afm" "p052004l.afm" "p052023l.afm" "p052024l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $NimbusRom $family [1] "NimbusRom" $metrics [1] "n021003l.afm" "n021004l.afm" "n021023l.afm" "n021024l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URWTimes $family [1] "URWTimes" $metrics [1] "n021003l.afm" "n021004l.afm" "n021023l.afm" "n021024l.afm" "s050000l.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URW2Helvetica $family [1] "URW2Helvetica" $metrics [1] "NimbusSans-Regular.afm" "NimbusSans-Bold.afm" [3] "NimbusSans-Oblique.afm" "NimbusSans-BoldOblique.afm" [5] "StandardSymbolsPS.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URW2HelveticaItalic $family [1] "URW2HelveticaItalic" $metrics [1] "NimbusSans-Regular.afm" "NimbusSans-Bold.afm" [3] "NimbusSans-Italic.afm" "NimbusSans-BoldItalic.afm" [5] "StandardSymbolsPS.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $URW2Times $family [1] "URW2Times" $metrics [1] "NimbusRoman-Regular.afm" "NimbusRoman-Bold.afm" [3] "NimbusRoman-Italic.afm" "NimbusRoman-BoldItalic.afm" [5] "StandardSymbolsPS.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $NimbusMonoPS $family [1] "NimbusMonoPS" $metrics [1] "NimbusMonoPS-Regular.afm" "NimbusMonoPS-Bold.afm" [3] "NimbusMonoPS-Italic.afm" "NimbusMonoPS-BoldItalic.afm" [5] "StandardSymbolsPS.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $ArialMT $family [1] "ArialMT" $metrics [1] "ArialMT.afm" "ArialMT-Bold.afm" "ArialMT-Italic.afm" [4] "ArialMT-BoldItalic.afm" "Symbol.afm" $encoding [1] "default" attr(,"class") [1] "Type1Font" $ComputerModern $family [1] "ComputerModern" $metrics [1] "CM_regular_10.afm" "CM_boldx_10.afm" "CM_italic_10.afm" [4] "CM_boldx_italic_10.afm" "CM_symbol_10.afm" $encoding [1] "TeXtext.enc" attr(,"class") [1] "Type1Font" $ComputerModernItalic $family [1] "ComputerModernItalic" $metrics [1] "CM_regular_10.afm" "CM_boldx_10.afm" "cmti10.afm" [4] "cmbxti10.afm" "CM_symbol_10.afm" $encoding [1] "TeXtext.enc" attr(,"class") [1] "Type1Font" $Japan1 $family [1] "HeiseiKakuGo-W5" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "EUC-H" $cmapEncoding [1] "EUC-JP" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $Japan1HeiMin $family [1] "HeiseiMin-W3" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "EUC-H" $cmapEncoding [1] "EUC-JP" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $Japan1GothicBBB $family [1] "GothicBBB-Medium" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "EUC-H" $cmapEncoding [1] "EUC-JP" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $Japan1Ryumin $family [1] "Ryumin-Light" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "EUC-H" $cmapEncoding [1] "EUC-JP" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $Korea1 $family [1] "Baekmuk-Batang" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "KSCms-UHC-H" $cmapEncoding [1] "CP949" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $Korea1deb $family [1] "Batang-Regular" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "KSCms-UHC-H" $cmapEncoding [1] "CP949" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $CNS1 $family [1] "MOESung-Regular" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "B5pc-H" $cmapEncoding [1] "CP950" $pdfresource [1] "" attr(,"class") [1] "CIDFont" $GB1 $family [1] "BousungEG-Light-GB" $metrics [1] "" "" "" "" "Symbol.afm" $cmap [1] "GBK-EUC-H" $cmapEncoding [1] "GBK" $pdfresource [1] "" attr(,"class") [1] "CIDFont" > ## This duplicates "ComputerModernItalic". > CMitalic <- Type1Font("ComputerModern2", + c("CM_regular_10.afm", "CM_boldx_10.afm", + "cmti10.afm", "cmbxti10.afm", + "CM_symbol_10.afm"), + encoding = "TeXtext.enc") > postscriptFonts(CMitalic = CMitalic) > > ## A CID font for Japanese using a different CMap and > ## corresponding cmapEncoding. > `Jp_UCS-2` <- CIDFont("TestUCS2", + c("Adobe-Japan1-UniJIS-UCS2-H.afm", + "Adobe-Japan1-UniJIS-UCS2-H.afm", + "Adobe-Japan1-UniJIS-UCS2-H.afm", + "Adobe-Japan1-UniJIS-UCS2-H.afm"), + "UniJIS-UCS2-H", "UCS-2") > pdfFonts(`Jp_UCS-2` = `Jp_UCS-2`) > names(pdfFonts()) [1] "serif" "sans" "mono" [4] "AvantGarde" "Bookman" "Courier" [7] "Helvetica" "Helvetica-Narrow" "NewCenturySchoolbook" [10] "Palatino" "Times" "URWGothic" [13] "URWBookman" "NimbusMon" "NimbusSan" [16] "URWHelvetica" "NimbusSanCond" "CenturySch" [19] "URWPalladio" "NimbusRom" "URWTimes" [22] "URW2Helvetica" "URW2HelveticaItalic" "URW2Times" [25] "NimbusMonoPS" "ArialMT" "Japan1" [28] "Japan1HeiMin" "Japan1GothicBBB" "Japan1Ryumin" [31] "Korea1" "Korea1deb" "CNS1" [34] "GB1" "Jp_UCS-2" > > > > cleanEx() > nameEx("pretty.Date") > ### * pretty.Date > > flush(stderr()); flush(stdout()) > > ### Name: pretty.Date > ### Title: Pretty Breakpoints for Date-Time Classes > ### Aliases: pretty.Date pretty.POSIXt > ### Keywords: dplot > > ### ** Examples > > ## IGNORE_RDIFF_BEGIN > pretty(Sys.Date()) [1] "2024-02-24" "2024-02-25" "2024-02-26" "2024-02-27" "2024-02-28" [6] "2024-02-29" > pretty(Sys.time(), n = 10) [1] "2024-02-26 13:27:03 CET" "2024-02-26 13:27:04 CET" [3] "2024-02-26 13:27:05 CET" "2024-02-26 13:27:06 CET" [5] "2024-02-26 13:27:07 CET" "2024-02-26 13:27:08 CET" [7] "2024-02-26 13:27:09 CET" "2024-02-26 13:27:10 CET" [9] "2024-02-26 13:27:11 CET" "2024-02-26 13:27:12 CET" [11] "2024-02-26 13:27:13 CET" > ## IGNORE_RDIFF_END > pretty(as.Date("2000-03-01")) # R 1.0.0 came in a leap year [1] "2000-02-28" "2000-02-29" "2000-03-01" "2000-03-02" "2000-03-03" [6] "2000-03-04" > > ## time ranges in diverse scales:% also in ../../../../tests/reg-tests-1c.R > steps <- stats::setNames(, + c("10 secs", "1 min", "5 mins", "30 mins", "6 hours", "12 hours", + "1 DSTday", "2 weeks", "1 month", "6 months", "1 year", + "10 years", "50 years", "1000 years")) > x <- as.POSIXct("2002-02-02 02:02") > lapply(steps, + function(s) { + at <- pretty(seq(x, by = s, length.out = 2), n = 5) + attr(at, "labels") + }) $`10 secs` [1] "00" "02" "04" "06" "08" "10" $`1 min` [1] "00" "10" "20" "30" "40" "50" "00" $`5 mins` [1] "02:02" "02:03" "02:04" "02:05" "02:06" "02:07" $`30 mins` [1] "02:00" "02:10" "02:20" "02:30" "02:40" $`6 hours` [1] "02:00" "03:00" "04:00" "05:00" "06:00" "07:00" "08:00" "09:00" $`12 hours` [1] "00:00" "03:00" "06:00" "09:00" "12:00" "15:00" $`1 DSTday` [1] "Feb 02 00:00" "Feb 02 06:00" "Feb 02 12:00" "Feb 02 18:00" "Feb 03 00:00" [6] "Feb 03 06:00" $`2 weeks` [1] "Jan 28" "Feb 04" "Feb 11" "Feb 18" $`1 month` [1] "Jan 28" "Feb 04" "Feb 11" "Feb 18" "Feb 25" "Mar 04" $`6 months` [1] "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" $`1 year` [1] "Jan" "Apr" "Jul" "Oct" "Jan" "Apr" $`10 years` [1] "2002" "2004" "2006" "2008" "2010" "2012" "2014" $`50 years` [1] "2000" "2010" "2020" "2030" "2040" "2050" "2060" $`1000 years` [1] "2000" "2200" "2400" "2600" "2800" "3000" "3200" > > > > cleanEx() > nameEx("ps.options") > ### * ps.options > > flush(stderr()); flush(stdout()) > > ### Name: ps.options > ### Title: Auxiliary Function to Set/View Defaults for Arguments of > ### postscript > ### Aliases: ps.options setEPS setPS > ### Keywords: device > > ### ** Examples > > ps.options(bg = "pink") > utils::str(ps.options()) List of 18 $ onefile : logi TRUE $ family : chr "Helvetica" $ title : chr "R Graphics Output" $ fonts : NULL $ encoding : chr "default" $ bg : chr "pink" $ fg : chr "black" $ width : num 0 $ height : num 0 $ horizontal : logi TRUE $ pointsize : num 12 $ paper : chr "default" $ pagecentre : logi TRUE $ print.it : logi FALSE $ command : chr "default" $ colormodel : chr "srgb" $ useKerning : logi TRUE $ fillOddEven: logi FALSE > > ### ---- error checking of arguments: ---- > ps.options(width = 0:12, onefile = 0, bg = pi) Warning: ‘mode(onefile)’ and ‘mode(bg)’ differ between new and previous ==> NOT changing ‘onefile’ & ‘bg’ Warning: ‘length(width)’ differs between new and previous ==> NOT changing ‘width’ > # override the check for 'width', but not 'bg': > ps.options(width = 0:12, bg = pi, override.check = c(TRUE,FALSE)) Warning: ‘mode(bg)’ differs between new and previous ==> NOT changing ‘bg’ Warning: ‘length(width)’ differs between new and previous > utils::str(ps.options()) List of 18 $ onefile : logi TRUE $ family : chr "Helvetica" $ title : chr "R Graphics Output" $ fonts : NULL $ encoding : chr "default" $ bg : chr "pink" $ fg : chr "black" $ width : int [1:13] 0 1 2 3 4 5 6 7 8 9 ... $ height : num 0 $ horizontal : logi TRUE $ pointsize : num 12 $ paper : chr "default" $ pagecentre : logi TRUE $ print.it : logi FALSE $ command : chr "default" $ colormodel : chr "srgb" $ useKerning : logi TRUE $ fillOddEven: logi FALSE > ps.options(reset = TRUE) # back to factory-fresh > > > > cleanEx() > nameEx("quartz") > ### * quartz > > flush(stderr()); flush(stdout()) > > ### Name: quartz > ### Title: macOS Quartz Device > ### Aliases: quartz quartz.options quartz.save > ### Keywords: device > > ### ** Examples > ## Not run: > ##D ## Only on a Mac, > ##D ## put something like this is your .Rprofile to customize the defaults > ##D setHook(packageEvent("grDevices", "onLoad"), > ##D function(...) grDevices::quartz.options(width = 8, height = 6, > ##D pointsize = 10)) > ## End(Not run) > > > cleanEx() > nameEx("quartzFonts") > ### * quartzFonts > > flush(stderr()); flush(stdout()) > > ### Name: quartzFonts > ### Title: Quartz Fonts Setup > ### Aliases: quartzFont quartzFonts > ### Keywords: device > > ### ** Examples > > > cleanEx() > nameEx("recordGraphics") > ### * recordGraphics > > flush(stderr()); flush(stdout()) > > ### Name: recordGraphics > ### Title: Record Graphics Operations > ### Aliases: recordGraphics > ### Keywords: device > > ### ** Examples > > require(graphics) > > plot(1:10) > # This rectangle remains 1inch wide when the device is resized > recordGraphics( + { + rect(4, 2, + 4 + diff(par("usr")[1:2])/par("pin")[1], 3) + }, + list(), + getNamespace("graphics")) > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("rgb") > ### * rgb > > flush(stderr()); flush(stdout()) > > ### Name: rgb > ### Title: RGB Color Specification > ### Aliases: rgb > ### Keywords: color > > ### ** Examples > > rgb(0, 1, 0) [1] "#00FF00" > > rgb((0:15)/15, green = 0, blue = 0, names = paste("red", 0:15, sep = ".")) red.0 red.1 red.2 red.3 red.4 red.5 red.6 red.7 "#000000" "#110000" "#220000" "#330000" "#440000" "#550000" "#660000" "#770000" red.8 red.9 red.10 red.11 red.12 red.13 red.14 red.15 "#880000" "#990000" "#AA0000" "#BB0000" "#CC0000" "#DD0000" "#EE0000" "#FF0000" > > rgb(0, 0:12, 0, maxColorValue = 255) # integer input [1] "#000000" "#000100" "#000200" "#000300" "#000400" "#000500" "#000600" [8] "#000700" "#000800" "#000900" "#000A00" "#000B00" "#000C00" > > ramp <- colorRamp(c("red", "white")) > rgb( ramp(seq(0, 1, length.out = 5)), maxColorValue = 255) [1] "#FF0000" "#FF3F3F" "#FF7F7F" "#FFBFBF" "#FFFFFF" > > > > cleanEx() > nameEx("rgb2hsv") > ### * rgb2hsv > > flush(stderr()); flush(stdout()) > > ### Name: rgb2hsv > ### Title: RGB to HSV Conversion > ### Aliases: rgb2hsv > ### Keywords: color dplot > > ### ** Examples > > ## These (saturated, bright ones) only differ by hue > (rc <- col2rgb(c("red", "yellow","green","cyan", "blue", "magenta"))) [,1] [,2] [,3] [,4] [,5] [,6] red 255 255 0 0 0 255 green 0 255 255 255 0 0 blue 0 0 0 255 255 255 > (hc <- rgb2hsv(rc)) [,1] [,2] [,3] [,4] [,5] [,6] h 0 0.1666667 0.3333333 0.5 0.6666667 0.8333333 s 1 1.0000000 1.0000000 1.0 1.0000000 1.0000000 v 1 1.0000000 1.0000000 1.0 1.0000000 1.0000000 > 6 * hc["h",] # the hues are equispaced [1] 0 1 2 3 4 5 > > ## Don't show: > set.seed(151) > ## End(Don't show) > (rgb3 <- floor(256 * matrix(stats::runif(3*12), 3, 12))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [1,] 122 137 116 244 20 153 191 250 134 117 27 202 [2,] 221 113 210 200 218 151 64 182 195 103 218 254 [3,] 199 157 88 76 39 91 80 146 22 105 17 239 > (hsv3 <- rgb2hsv(rgb3)) [,1] [,2] [,3] [,4] [,5] [,6] [,7] h 0.4629630 0.7575758 0.2950820 0.1230159 0.3493266 0.1612903 0.9790026 s 0.4479638 0.2802548 0.5809524 0.6885246 0.9082569 0.4052288 0.6649215 v 0.8666667 0.6156863 0.8235294 0.9568627 0.8549020 0.6000000 0.7490196 [,8] [,9] [,10] [,11] [,12] h 0.05769231 0.2254335 0.9761905 0.3250415 0.4519231 s 0.41600000 0.8871795 0.1196581 0.9220183 0.2047244 v 0.98039216 0.7647059 0.4588235 0.8549020 0.9960784 > ## Consistency : > stopifnot(rgb3 == col2rgb(hsv(h = hsv3[1,], s = hsv3[2,], v = hsv3[3,])), + all.equal(hsv3, rgb2hsv(rgb3/255, maxColorValue = 1))) > > ## A (simplified) pure R version -- originally by Wolfram Fischer -- > ## showing the exact algorithm: > rgb2hsvR <- function(rgb, gamma = 1, maxColorValue = 255) + { + if(!is.numeric(rgb)) stop("rgb matrix must be numeric") + d <- dim(rgb) + if(d[1] != 3) stop("rgb matrix must have 3 rows") + n <- d[2] + if(n == 0) return(cbind(c(h = 1, s = 1, v = 1))[,0]) + rgb <- rgb/maxColorValue + if(gamma != 1) rgb <- rgb ^ (1/gamma) + + ## get the max and min + v <- apply( rgb, 2, max) + s <- apply( rgb, 2, min) + D <- v - s # range + + ## set hue to zero for undefined values (gray has no hue) + h <- numeric(n) + notgray <- ( s != v ) + + ## blue hue + idx <- (v == rgb[3,] & notgray ) + if (any (idx)) + h[idx] <- 2/3 + 1/6 * (rgb[1,idx] - rgb[2,idx]) / D[idx] + ## green hue + idx <- (v == rgb[2,] & notgray ) + if (any (idx)) + h[idx] <- 1/3 + 1/6 * (rgb[3,idx] - rgb[1,idx]) / D[idx] + ## red hue + idx <- (v == rgb[1,] & notgray ) + if (any (idx)) + h[idx] <- 1/6 * (rgb[2,idx] - rgb[3,idx]) / D[idx] + + ## correct for negative red + idx <- (h < 0) + h[idx] <- 1+h[idx] + + ## set the saturation + s[! notgray] <- 0; + s[notgray] <- 1 - s[notgray] / v[notgray] + + rbind( h = h, s = s, v = v ) + } > > ## confirm the equivalence: > all.equal(rgb2hsv (rgb3), + rgb2hsvR(rgb3), tolerance = 1e-14) # TRUE [1] TRUE > > > > cleanEx() > nameEx("trans3d") > ### * trans3d > > flush(stderr()); flush(stdout()) > > ### Name: trans3d > ### Title: 3D to 2D Transformation for Perspective Plots > ### Aliases: trans3d > ### Keywords: dplot > > ### ** Examples > > ## See help(persp) {after attaching the 'graphics' package} > ## ----------- > > ## Example for 'continuous = TRUE' (vs default): > require(graphics) > x <- -10:10/10 # [-1, 1] > y <- -16:16/16 # [-1, 1] ==> z = fxy := outer(x,y) is also in [-1,1] > > p <- persp(x, y, fxy <- outer(x,y), phi = 20, theta = 15, r = 3, ltheta = -75, + shade = 0.8, col = "green3", ticktype = "detailed") > ## 5 axis-parallel auxiliary lines in x-y and y-z planes : > lines(trans3d(-.5 , y=-1:1, z=min(fxy), pmat=p), lty=2) > lines(trans3d( 0 , y=-1:1, z=min(fxy), pmat=p), lty=2) > lines(trans3d(-1:1, y= -.7, z=min(fxy), pmat=p), lty=2) > lines(trans3d( -1, y= -.7, z=c(-1,1) , pmat=p), lty=2) > lines(trans3d( -1, y=-1:1, z= -.5 , pmat=p), lty=2) > ## 2 pillars to carry the horizontals below: > lines(trans3d(-.5 , y= -.7, z=c(-1,-.5), pmat=p), lwd=1.5, col="gray10") > lines(trans3d( 0 , y= -.7, z=c(-1,-.5), pmat=p), lwd=1.5, col="gray10") > ## now some "horizontal rays" (going from center to very left or very right): > doHor <- function(x1, x2, z, CNT=FALSE, ...) + lines(trans3d(x=seq(x1, x2, by=0.5), y= -0.7, z = z, pmat = p, continuous = CNT), + lwd = 3, type="b", xpd=NA, ...) > doHor(-10, 0, z = -0.5, col = 2) # x in [-10, 0] -- to the very left : fine > doHor(-.5, 2, z = -0.52,col = 4) # x in [-0.5, 2] only {to the right} --> all fine > ## but now, x in [-0.5, 20] -- "too far" ==> "wrap around" problem (without 'continuous=TRUE'): > doHor(-.5, 20, z = -0.58, col = "steelblue", lty=2) > ## but it is fixed with continuous = CNT = TRUE: > doHor(-.5, 20, z = -0.55, CNT=TRUE, col = "skyblue") points cut off after point[39] > > > > cleanEx() > nameEx("windows") > ### * windows > > flush(stderr()); flush(stdout()) > > ### Name: windows > ### Title: Windows Graphics Devices > ### Aliases: windows win.graph win.metafile win.print print.SavedPlots > ### [.SavedPlots > ### Keywords: device > > ### ** Examples > ## Not run: > ##D ## A series of plots written to a sequence of metafiles > ##D if(.Platform$OS.type == "windows") > ##D win.metafile("Rplot%02d.wmf", pointsize = 10) > ## End(Not run) > > > cleanEx() > nameEx("windows.options") > ### * windows.options > > flush(stderr()); flush(stdout()) > > ### Name: windows.options > ### Title: Auxiliary Function to Set/View Defaults for Arguments of > ### windows() > ### Aliases: windows.options > ### Keywords: device > > ### ** Examples > ## Not run: > ##D ## put something like this is your .Rprofile to customize the defaults > ##D setHook(packageEvent("grDevices", "onLoad"), > ##D function(...) > ##D grDevices::windows.options(width = 8, height = 6, > ##D xpos = 0, pointsize = 10, > ##D bitmap.aa.win = "cleartype")) > ## End(Not run) > > > cleanEx() > nameEx("windowsFonts") > ### * windowsFonts > > flush(stderr()); flush(stdout()) > > ### Name: windowsFonts > ### Title: Windows Fonts > ### Aliases: windowsFont windowsFonts > ### Keywords: device > > ### ** Examples > > > cleanEx() > nameEx("x11") > ### * x11 > > flush(stderr()); flush(stdout()) > > ### Name: x11 > ### Title: X Window System Graphics (X11) > ### Aliases: x11 X11 X11.options > ### Keywords: device > > ### ** Examples > ## Not run: > ##D if(.Platform$OS.type == "unix") { # Only on unix-alikes, possibly Mac, > ##D ## put something like this is your .Rprofile to customize the defaults > ##D setHook(packageEvent("grDevices", "onLoad"), > ##D function(...) grDevices::X11.options(width = 8, height = 6, xpos = 0, > ##D pointsize = 10)) > ##D } > ## End(Not run) > > > cleanEx() > nameEx("x11Fonts") > ### * x11Fonts > > flush(stderr()); flush(stdout()) > > ### Name: X11Fonts > ### Title: X11 Fonts > ### Aliases: X11Font X11Fonts > ### Keywords: device > > ### ** Examples > ## IGNORE_RDIFF_BEGIN > if(capabilities("X11")) withAutoprint({ + X11Fonts() + X11Fonts("mono") + utopia <- X11Font("-*-utopia-*-*-*-*-*-*-*-*-*-*-*-*") + X11Fonts(utopia = utopia) + }) > X11Fonts() $serif [1] "-*-times-%s-%s-*-*-%d-*-*-*-*-*-*-*" $sans [1] "-*-helvetica-%s-%s-*-*-%d-*-*-*-*-*-*-*" $mono [1] "-*-courier-%s-%s-*-*-%d-*-*-*-*-*-*-*" $Times [1] "-adobe-times-%s-%s-*-*-%d-*-*-*-*-*-*-*" $Helvetica [1] "-adobe-helvetica-%s-%s-*-*-%d-*-*-*-*-*-*-*" $CyrTimes [1] "-cronyx-times-%s-%s-*-*-%d-*-*-*-*-*-*-*" $CyrHelvetica [1] "-cronyx-helvetica-%s-%s-*-*-%d-*-*-*-*-*-*-*" $Arial [1] "-monotype-arial-%s-%s-*-*-%d-*-*-*-*-*-*-*" $Mincho [1] "-*-mincho-%s-%s-*-*-%d-*-*-*-*-*-*-*" > X11Fonts("mono") $mono [1] "-*-courier-%s-%s-*-*-%d-*-*-*-*-*-*-*" > utopia <- X11Font("-*-utopia-*-*-*-*-*-*-*-*-*-*-*-*") > X11Fonts(utopia = utopia) > ## IGNORE_RDIFF_END > > > cleanEx() > nameEx("xy.coords") > ### * xy.coords > > flush(stderr()); flush(stdout()) > > ### Name: xy.coords > ### Title: Extracting Plotting Structures > ### Aliases: xy.coords > ### Keywords: dplot > > ### ** Examples > > ff <- stats::fft(1:9) > xy.coords(ff) $x [1] 45.0 -4.5 -4.5 -4.5 -4.5 -4.5 -4.5 -4.5 -4.5 $y [1] 0.0000000 12.3636484 5.3628912 2.5980762 0.7934714 -0.7934714 [7] -2.5980762 -5.3628912 -12.3636484 $xlab [1] "Re()" $ylab [1] "Im()" > xy.coords(ff, xlab = "fft") # labels "Re(fft)", "Im(fft)" $x [1] 45.0 -4.5 -4.5 -4.5 -4.5 -4.5 -4.5 -4.5 -4.5 $y [1] 0.0000000 12.3636484 5.3628912 2.5980762 0.7934714 -0.7934714 [7] -2.5980762 -5.3628912 -12.3636484 $xlab [1] "Re(fft)" $ylab [1] "Im(fft)" > ## Don't show: > stopifnot(identical(xy.coords(ff, xlab = "fft"), + xy.coords(ff, ylab = "fft"))) > xy.labs <- function(...) xy.coords(...)[c("xlab","ylab")] > stopifnot(identical(xy.labs(ff, xlab = "fft", setLab = FALSE), + list(xlab = "fft", ylab = "fft")), + identical(xy.labs(ff, ylab = "fft", setLab = FALSE), + list(xlab = NULL, ylab = "fft")), + identical(xy.labs(ff, xlab = "Re(fft)", ylab = "Im(fft)", setLab = FALSE), + list(xlab = "Re(fft)", ylab = "Im(fft)"))) > ## End(Don't show) > with(cars, xy.coords(dist ~ speed, NULL)$xlab ) # = "speed" [1] "speed" > > xy.coords(1:3, 1:2, recycle = TRUE) # otherwise error "lengths differ" $x [1] 1 2 3 $y [1] 1 2 1 $xlab NULL $ylab NULL > xy.coords(-2:10, log = "y") Warning in xy.coords(-2:10, log = "y") : 3 y values <= 0 omitted from logarithmic plot $x [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 $y [1] NA NA NA 1 2 3 4 5 6 7 8 9 10 $xlab [1] "Index" $ylab NULL > ##> xlab: "Index" \\ warning: 3 y values <= 0 omitted .. > op <- options(warn = 2)# ==> warnings would be errors, we suppress the one "we know": > suppressWarnings(xy.coords(-2:10, log = "y"), classes="log_le_0") -> xy > options(op) # revert > stopifnot(is.list(xy), identical (1:13 +0, xy$x), + identical(c(rep(NA, 3), 1:10 +0), xy$y)) > > > > cleanEx() > nameEx("xyTable") > ### * xyTable > > flush(stderr()); flush(stdout()) > > ### Name: xyTable > ### Title: Multiplicities of (x,y) Points, e.g., for a Sunflower Plot > ### Aliases: xyTable > ### Keywords: dplot > > ### ** Examples > > xyTable(iris[, 3:4], digits = 6) $x [1] 1.0 1.1 1.2 1.3 1.3 1.3 1.4 1.4 1.4 1.5 1.5 1.5 1.5 1.6 1.6 1.6 1.7 1.7 [19] 1.7 1.7 1.9 1.9 3.0 3.3 3.5 3.6 3.7 3.8 3.9 3.9 3.9 4.0 4.0 4.0 4.1 4.1 [37] 4.2 4.2 4.2 4.3 4.4 4.4 4.4 4.5 4.5 4.5 4.5 4.6 4.6 4.6 4.7 4.7 4.7 4.7 [55] 4.8 4.8 4.9 4.9 4.9 5.0 5.0 5.0 5.0 5.1 5.1 5.1 5.1 5.1 5.1 5.1 5.2 5.2 [73] 5.3 5.3 5.4 5.4 5.5 5.5 5.6 5.6 5.6 5.6 5.6 5.7 5.7 5.7 5.8 5.8 5.8 5.9 [91] 5.9 6.0 6.0 6.1 6.1 6.1 6.3 6.4 6.6 6.7 6.7 6.9 $y [1] 0.2 0.1 0.2 0.2 0.3 0.4 0.1 0.2 0.3 0.1 0.2 0.3 0.4 0.2 0.4 0.6 0.2 0.3 [19] 0.4 0.5 0.2 0.4 1.1 1.0 1.0 1.3 1.0 1.1 1.1 1.2 1.4 1.0 1.2 1.3 1.0 1.3 [37] 1.2 1.3 1.5 1.3 1.2 1.3 1.4 1.3 1.5 1.6 1.7 1.3 1.4 1.5 1.2 1.4 1.5 1.6 [55] 1.4 1.8 1.5 1.8 2.0 1.5 1.7 1.9 2.0 1.5 1.6 1.8 1.9 2.0 2.3 2.4 2.0 2.3 [73] 1.9 2.3 2.1 2.3 1.8 2.1 1.4 1.8 2.1 2.2 2.4 2.1 2.3 2.5 1.6 1.8 2.2 2.1 [91] 2.3 1.8 2.5 1.9 2.3 2.5 1.8 2.0 2.1 2.0 2.2 2.3 $number [1] 1 1 2 4 2 1 2 8 3 2 7 1 3 5 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 3 1 2 1 [38] 2 1 2 1 1 2 1 5 1 1 1 1 1 1 2 1 1 1 3 2 2 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 [75] 1 1 2 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 > > ## Discretized uncorrelated Gaussian: > ## Don't show: > set.seed(1) > ## End(Don't show) > xy <- data.frame(x = round(sort(stats::rnorm(100))), y = stats::rnorm(100)) > xyTable(xy, digits = 1) $x [1] -2 -2 -2 -2 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 [26] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 [51] 1 1 1 1 1 1 2 2 2 2 $y [1] -0.90 -0.60 0.04 0.20 -0.70 -0.60 -0.50 -0.40 -0.30 -0.20 -0.10 0.40 [13] 0.50 0.70 0.90 1.00 2.00 -2.00 -1.00 -0.90 -0.80 -0.70 -0.60 -0.50 [25] -0.30 -0.20 -0.07 -0.06 -0.04 -0.02 0.02 0.06 0.30 0.40 0.50 0.70 [37] 0.90 1.00 2.00 -1.00 -0.90 -0.80 -0.70 -0.40 -0.30 -0.20 -0.10 -0.08 [49] -0.03 0.10 0.20 0.40 0.50 0.80 1.00 2.00 -1.00 -0.40 0.40 1.00 $number [1] 1 1 1 1 2 1 2 1 2 4 1 1 1 1 1 2 2 5 5 1 1 2 3 2 3 1 1 1 1 1 1 1 1 1 2 1 1 3 [39] 3 3 1 1 1 1 2 2 1 1 1 1 2 1 2 2 4 2 3 1 1 1 > > > > cleanEx() > nameEx("xyz.coords") > ### * xyz.coords > > flush(stderr()); flush(stdout()) > > ### Name: xyz.coords > ### Title: Extracting Plotting Structures > ### Aliases: xyz.coords > ### Keywords: dplot > > ### ** Examples > > xyz.coords(data.frame(10*1:9, -4), y = NULL, z = NULL) $x [1] 1 2 3 4 5 6 7 8 9 $y [1] 10 20 30 40 50 60 70 80 90 $z [1] -4 -4 -4 -4 -4 -4 -4 -4 -4 $xlab [1] "Index" $ylab NULL $zlab NULL > > xyz.coords(1:5, stats::fft(1:5), z = NULL, xlab = "X", ylab = "Y") $x [1] 15.0 -2.5 -2.5 -2.5 -2.5 $y [1] 0.0000000 3.4409548 0.8122992 -0.8122992 -3.4409548 $z [1] 1 2 3 4 5 $xlab [1] "Re(Y)" $ylab [1] "Im(Y)" $zlab [1] "X" > > y <- 2 * (x2 <- 10 + (x1 <- 1:10)) > xyz.coords(y ~ x1 + x2, y = NULL, z = NULL) $x [1] 1 2 3 4 5 6 7 8 9 10 $y [1] 11 12 13 14 15 16 17 18 19 20 $z [1] 22 24 26 28 30 32 34 36 38 40 $xlab [1] "x1" $ylab [1] "x2" $zlab [1] "y" > > xyz.coords(data.frame(x = -1:9, y = 2:12, z = 3:13), y = NULL, z = NULL, + log = "xy") Warning in xyz.coords(data.frame(x = -1:9, y = 2:12, z = 3:13), y = NULL, : 2 x values <= 0 omitted from logarithmic plot $x [1] NA NA 1 2 3 4 5 6 7 8 9 $y [1] 2 3 4 5 6 7 8 9 10 11 12 $z [1] 3 4 5 6 7 8 9 10 11 12 13 $xlab [1] "x" $ylab [1] "y" $zlab [1] "z" > ##> Warning message: 2 x values <= 0 omitted ... > ## Suppress this specific warning: > suppressWarnings(xyz.coords(x = -1:9, y = 2:12, z = 3:13, log = "xy"), + classes = "log_le_0") $x [1] NA NA 1 2 3 4 5 6 7 8 9 $y [1] 2 3 4 5 6 7 8 9 10 11 12 $z [1] 3 4 5 6 7 8 9 10 11 12 13 $xlab NULL $ylab NULL $zlab NULL > > > > ### *