R/ColorChart.R

   1 # efg, Stowers Institute for Medical Research\r
   2 # efg's Research Notes:\r
   3 #   http://research.stowers-institute.org/efg/R/Color/Chart\r
   4 #\r
   5 # 6 July 2004.  Modified 23 May 2005.\r
   6 \r
   7 pdf("ColorChart.pdf", width=6, height=10)\r
   8 \r
   9 # save to reset at end\r
  10 oldparameters <- par(mar=c(1,1,2,1), mfrow=c(2,1))\r
  11 \r
  12 # Be cautious in case definition of "colors" changes.\r
  13 # Use some hard-coded constants since this is not expected\r
  14 # to change.\r
  15 stopifnot(length(colors()) == 657)\r
  16 \r
  17 # 0. Setup\r
  18 \r
  19 # For a given color, define a text color that will have good contrast.\r
  20 #   Examples:\r
  21 #     > SetTextContrastColor("white")\r
  22 #     [1] "black"\r
  23 #     > SetTextContrastColor("black")\r
  24 #     [1] "white"\r
  25 #     > SetTextContrastColor("red")\r
  26 #     [1] "white"\r
  27 #     > SetTextContrastColor("yellow")\r
  28 #     [1] "black"\r
  29 SetTextContrastColor <- function(color)\r
  30 {\r
  31   ifelse( mean(col2rgb(color)) > 127, "black", "white")\r
  32 }\r
  33 \r
  34 # Define this array of text contrast colors that correponds to each\r
  35 # member of the colors() array.\r
  36 TextContrastColor <- unlist( lapply(colors(), SetTextContrastColor) )\r
  37 \r
  38 \r
  39 # 1a. Plot matrix of R colors, in index order, 25 per row.\r
  40 # This example plots each row of rectangles one at a time.\r
  41 colCount <- 25  # number per row\r
  42 rowCount <- 27\r
  43 \r
  44 plot( c(1,colCount), c(0,rowCount), type="n", ylab="", xlab="",\r
  45      axes=FALSE, ylim=c(rowCount,0))\r
  46 title("R colors")\r
  47 mtext("http://research.stowers-institute.org/efg/R/Color/Chart",\r
  48       cex=0.6)\r
  49 \r
  50 for (j in 0:(rowCount-1))\r
  51 {\r
  52   base <- j*colCount\r
  53   remaining <- length(colors()) - base\r
  54   RowSize <- ifelse(remaining < colCount, remaining, colCount)\r
  55   rect((1:RowSize)-0.5,j-0.5, (1:RowSize)+0.5,j+0.5,\r
  56     border="black",\r
  57     col=colors()[base + (1:RowSize)])\r
  58   text((1:RowSize), j, paste(base + (1:RowSize)), cex=0.7,\r
  59        col=TextContrastColor[base + (1:RowSize)])\r
  60 }\r
  61 \r
  62 # 1b.  Plot matrix of R colors, in "hue" order, 25 per row.\r
  63 # This example plots each rectangle one at a time.\r
  64 RGBColors <- col2rgb(colors()[1:length(colors())])\r
  65 HSVColors <- rgb2hsv( RGBColors[1,], RGBColors[2,], RGBColors[3,], maxColorValue=255)\r
  66 HueOrder  <- order( HSVColors[1,], HSVColors[2,], HSVColors[3,] )\r
  67 \r
  68 plot(0, type="n", ylab="", xlab="",\r
  69      axes=FALSE, ylim=c(rowCount,0), xlim=c(1,colCount))\r
  70 \r
  71 title("R colors -- Sorted by Hue, Saturation, Value")\r
  72 \r
  73 for (j in 0:(rowCount-1))\r
  74 {\r
  75   for (i in 1:colCount)\r
  76   {\r
  77     k <- j*colCount + i\r
  78     if (k <= length(colors()))\r
  79     {\r
  80       rect(i-0.5,j-0.5, i+0.5,j+0.5, border="black", col=colors()[ HueOrder[k] ])\r
  81       text(i,j, paste(HueOrder[k]), cex=0.7, col=TextContrastColor[ HueOrder[k] ])\r
  82     }\r
  83   }\r
  84 }\r
  85 \r
  86 \r
  87 # 2. Create 7-page color chart showing rectangle block of color, along with\r
  88 # index, color name, and RGB constants in hex and decimal.\r
  89 \r
  90 # Define string vector of RGB hex and decimal constants for given color\r
  91 # as a string.\r
  92 #   Example:\r
  93 #     > GetColorHexAndDecimal("yellow")\r
  94 #     [1] "#FFFF00   255 255   0"\r
  95 GetColorHexAndDecimal <- function(color)\r
  96 {\r
  97   c <- col2rgb(color)\r
  98   sprintf("#%02X%02X%02X   %3d %3d %3d", c[1],c[2],c[3], c[1], c[2], c[3])\r
  99 }\r
 100 \r
 101 # Restore, change and save graphics parameters\r
 102 par(oldparameters)\r
 103 oldparameters <- par(mar=c(1,1,1,1))\r
 104 \r
 105 # Prepare text vectors to be displayed, in addition to color names.\r
 106 index <- paste(1:length(colors()))\r
 107 HexAndDec <- unlist( lapply(colors(), GetColorHexAndDecimal) )\r
 108 \r
 109 PerColumn <- 50\r
 110 PerPage   <- 2*PerColumn\r
 111 \r
 112 # Plot a column of color rectangles at a time for each page.\r
 113 for (page in 1: (trunc( (length(colors()) + (PerPage-1)) / PerPage) )  )\r
 114 {\r
 115 \r
 116   plot(0, type="n", ylab="", xlab="",\r
 117        axes=FALSE, ylim=c(PerColumn,0), xlim=c(0,1))\r
 118   title("R colors")\r
 119   mtext(paste("page ", page), SOUTH<-1, adj=1, line=-1)\r
 120 \r
 121   base <- PerPage*(page-1)\r
 122 \r
 123   # Column 1\r
 124   remaining <- length(colors()) - base\r
 125   ColumnSize <- ifelse(remaining < PerColumn, remaining, PerColumn)\r
 126 \r
 127   rect(0.00, 0:(ColumnSize-1),\r
 128        0.49, 1:ColumnSize,\r
 129        border="black",\r
 130        col=colors()[(base+1):(base+ColumnSize)])\r
 131   text(0.045, 0.45+(0:(ColumnSize-1)), adj=1,\r
 132        index[(base+1):(base+ColumnSize)], cex=0.6,\r
 133        col=TextContrastColor[(base+1):(base+ColumnSize)])\r
 134   text(0.06, 0.45+(0:(ColumnSize-1)), adj=0,\r
 135        colors()[(base+1):(base+ColumnSize)], cex=0.6,\r
 136        col=TextContrastColor[(base+1):(base+ColumnSize)])\r
 137   save <- par(family="mono")  # use mono-spaced font with number columns\r
 138   text(0.25, 0.45+(0:(ColumnSize-1)), adj=0,\r
 139        HexAndDec[(base+1):(base+ColumnSize)], cex=0.6,\r
 140        col=TextContrastColor[(base+1):(base+ColumnSize)])\r
 141   par(save)\r
 142 \r
 143   # Column 2\r
 144   if (remaining > PerColumn)\r
 145   {\r
 146     remaining <- remaining - PerColumn\r
 147     ColumnSize <- ifelse(remaining < PerColumn, remaining, PerColumn)\r
 148     rect(0.51, 0:(ColumnSize-1),\r
 149          1.00, 1:ColumnSize,\r
 150          border="black",\r
 151          col=colors()[(base+PerColumn+1):(base+PerColumn+ColumnSize)])\r
 152     text(0.545, 0.45+(0:(ColumnSize-1)), adj=1,\r
 153          index[(base+PerColumn+1):(base+PerColumn+ColumnSize)], cex=0.6,\r
 154          col=TextContrastColor[(base+PerColumn+1):(base+PerColumn+ColumnSize)])\r
 155     text(0.56, 0.45+(0:(ColumnSize-1)), adj=0,\r
 156          colors()[(base+PerColumn+1):(base+PerColumn+ColumnSize)], cex=0.6,\r
 157          col=TextContrastColor[(base+PerColumn+1):(base+PerColumn+ColumnSize)])\r
 158     save <- par(family="mono")\r
 159     text(0.75, 0.45+(0:(ColumnSize-1)), adj=0,\r
 160          HexAndDec[(base+PerColumn+1):(base+PerColumn+ColumnSize)], cex=0.6,\r
 161          col=TextContrastColor[(base+PerColumn+1):(base+PerColumn+ColumnSize)])\r
 162     par(save)\r
 163   }\r
 164 \r
 165 }\r
 166 \r
 167 par(oldparameters)\r
 168 dev.off()\r