[R] Large continuous color palette {was `about image and rgb'}
Henrik Bengtsson
hb at maths.lth.se
Tue Jul 9 00:40:51 CEST 2002
What about
% R --vanilla
intToHex <- function(x) {
y <- as.integer(x)
class(y) <- "hexmode"
y <- as.character(y)
dim(y) <- dim(x)
y
}
as.character.hexmode <- function(x) {
hexDigit <- c(0:9, "A", "B", "C", "D", "E", "F")
isna <- is.na(x)
y <- x[!isna]
ans0 <- character(length(y))
z <- NULL
while (any(y > 0) | is.null(z)) {
z <- y%%16
y <- floor(y/16)
ans0 <- paste(hexDigit[z + 1], ans0, sep = "")
}
ans <- rep(NA, length(x))
ans[!isna] <- ans0
ans
}
rgb256 <- function(r, g, b) {
r <- intToHex(r %% 256)
g <- intToHex(g %% 256)
b <- intToHex(b %% 256)
rgb <- cbind(r, g, b)
# Pad a zero to all value less than 10.
idx <- (nchar(rgb) == 1)
rgb[idx] <- paste("0", rgb[idx], sep="")
rgb <- apply(rgb, MARGIN=1, FUN=paste, collapse="")
paste("#", rgb, sep="")
}
mirror.matrix <- function(x) {
x <- as.data.frame(x)
x <- rev(x)
as.matrix(x)
}
rotate270.matrix <- function(x) {
mirror.matrix(t(x))
}
image.matrix <- function(z, ...) {
image(rotate270.matrix(z), ...)
}
imageToPNG <- function(z, colorTable, filename, transparent=NULL) {
width <- ncol(z)
height <- nrow(z)
if (!is.null(transparent))
z[z == transparent] <- NA
x <- 1:width
y <- 1:height
png(filename, width=width, height=height, bg="transparent")
on.exit(dev.off())
par(mar = c(0, 0, 0, 0))
image.matrix(x=x, y=y, z=z, col=colorTable, axes=FALSE)
}
# Create a palette of all nuances of red combined with 256^2 different
# shades of gray. Was this what you wanted? I don't really get that or
# if it was just an example. BTW, it is only possible to create 256
# different red nuances.
r <- as.vector(matrix(0:255, nrow=256, ncol=256, byrow=TRUE))
g <- b <- 0:255
rgb <- rgb256(r,g,b)
# Create an "image" of 2^16 different color values
ncolors <- 2**16
z <- matrix(0:(ncolors-1), nrow=256, ncol=256)
# Write the "image" to a PNG file
imageToPNG(z, colorTable=rgb, filename="foo.png")
# Or just red nuances
imageToPNG(z, colorTable=rgb256(0:255,0,0), filename="bar.png")
(This code was verify on R v1.5.1/WinMe).
Then, as suggested, use ImageMagick's convert or something to convert this
to TIFF.
Henrik Bengtsson
Dept. of Mathematical Statistics @ Centre for Mathematical Sciences
Lund Institute of Technology/Lund University, Sweden (+2h UTC)
+46 46 2229611 (off), +46 708 909208 (cell), +46 46 2224623 (fax)
h b @ m a t h s . l t h . s e, http://www.maths.lth.se/~hb/
> -----Original Message-----
> From: owner-r-help at stat.math.ethz.ch
> [mailto:owner-r-help at stat.math.ethz.ch]On Behalf Of Martin Maechler
> Sent: Monday, July 08, 2002 6:20 PM
> To: Olivier Martin
> Cc: R-help at stat.math.ethz.ch
> Subject: [R] Large continuous color palette {was `about image and rgb'}
>
>
> [Answer re-diverted to R-help !]
>
> >>>>> "Olivier" == Olivier Martin <olivier.martin at inrialpes.fr> writes:
>
> Olivier> Hi Martin,
>
> Olivier> Thanks for your help. I try explain more precisely
> my problem.
> Olivier> First, i have a matrix which values are between 0 and 2^16-1.
>
> Olivier> So, this what i would like to do.
>
> Olivier> 1 Is it possible to convert this matrix into a TIFF
> format file.
>
> yes:
> 1) Use the `pixmap' package to produce a "pnm" (portable anymap format)
> file
> 2) Use a conversion tool to translate this to tiff.
> There are many of those I think.
> On Unix/Linux, there's the ImageMagick software package, with
> a "convert" program.
>
> On my Linux (redhat), there's also pnmtotiff with help page
> {excerpts!}
>
> >> NAME
> >> pnmtotiff - convert a a portable anymap into a TIFF file
> >>
> >> SYNOPSIS
> >> pnmtotiff [-none|-packbits| -lzw|-g3|-g4] [-2d] [-fill]
> >> [-predictor n] [-msb2lsb|-lsb2msb] [-rowsperstrip n] [-X
> >> res| -Y res| -R res] [pnmfile]
> >>
> >> DESCRIPTION
> >> Reads a portable anymap as input. Produces a TIFF file as
> >> output.
> >>
> >> ............
> >>
> >> NOTES
> >> There are myriad variations of the TIFF format, and this
> >> program generates only a few of them. pnmtotiff creates a
> >> grayscale TIFF file if its input is a PBM (monochrome) or
> >> PGM (grayscale) file. If the input is a PPM (color) file
> >> and there are 256 colors or fewer, pnmtotiff generates a
> >> color palette TIFF file. If there are more colors than
> >> that, pnmtotiff generates an RGB (not RGBA) single plane
> >> TIFF file. Use pnmtotiffcmyk to generate the cyan-
> >> magenta-yellow-black ink color separation TIFF format.
> >>
> >> ...
>
> read the "NOTES" section above!
>
> Olivier> 2 Some R functions are available to represent
> Olivier> images. So, i would like to represent my matrix
> Olivier> (in the red channel for exemple) but i don't know
> Olivier> how i can use the rgb function to represent it. I
> Olivier> am not familar with image analysis and my problem
> Olivier> is that i don't know how i can take into account
> Olivier> the large scale of my values with only the red
> Olivier> colours.
>
> Olivier> I can use the rgb function with something like
> Olivier> reds <- rgb(r=1, g=(255:0)/255,b=(255:0)/255) and
> Olivier> image(mat,col=reds).
>
> Olivier> But the image is not very "good" (all the image is
> Olivier> red) and may be it should be better with more
> Olivier> levels of red colors.
>
> Now I see clearer. I think in principle, you shouldn't use
> rgb() at all but rather one of the functions
>
> rainbow(), heat.colors(), ..... {see the help page for rainbow}
>
> for creating a larger number of *continuous* colours.
> However, it seems you don't come close to 2^16 ~= 65000 different colors
> easily, using these (e.g. length(unique(rainbow(2^16))) is only 1530).
> {{actually I think you don't want to come really close to 65000,
> I'd guess a few thousands would always suffice in statistics,
> but that's not the point here ...}}
>
> ---> Challenge to all : Have you found nice easily constructed
> continuous color palettes scheme with substantionally more
> different colors?
> One approach could start combining rainbow(n, v, s) with
> non-default values of `v' and `s'.
> The more general problem could be stated as :
> >>> Find a ``cube-filling'' curve through the HSV (better than RGB)
> >>> color cube { touching enough different places -- depending on n }.
> Maybe restricting yourself to a close neigborhood of a 2-d
> surface in that cube (to have only points of
> approximately similar luminance, eg) would be an important option.
>
> So, yes as a matter of fact, we got a nice fun problem to play
> around with thanks to your enquiry.
>
> In any case, get the pixmap package and read the (only two) help
> pages from it!
>
> Olivier> For now, i use a log transformation on my data
> Olivier> (image(log(mat),col=2)) and i obtain an image with
> Olivier> more "structures". I have also change my object
> Olivier> reds by using a non linear function for the g and b
> Olivier> values . But maybe , there is another way to
> Olivier> represent this image.
>
> Olivier> I hope my problem is more clear.
> yes, it has become.
>
>
> Olivier> Martin Maechler wrote:
>
> >>>>>>> "Olivier" == Olivier Martin
> <olivier.martin at inrialpes.fr> writes:
> >>>>>>>
> >>
> Olivier> I have a 16 bit image (TIFF) and i want to analyse
> Olivier> the pixels distribution. So, i obtain a matrix
> Olivier> which values are between 0 and 2^16 -1.
> >> ok
> >>
> Olivier> Now i would like to represnt this image with the
> Olivier> fucntions rgb() and image().
> >> `perfect'
> >>
> Olivier> I am not sure , but i think that only 256 colors
> Olivier> are available.
> >>
> >> what makes you think so? It's not true.
> >>
> >> There are (2^8)^3 (i.e 24-bit) colors in R, as you can see
> >> quickly from looking at the result of rgb(), e.g.
> >>
> >> Now the for viewing thing is devices, i.e. hardware and
> >> device-driver software.
> >> A few years ago, still many Sun Workstations came with graphics
> >> cards that only permitted 8-bit (i.e. 256 different colors
> at a time).
> >>
> >> Can you be more specific about your problems?
> >>
> Olivier> So is there a solution to represent all the palette
> Olivier> of the colors or i have to limit the
> Olivier> representations with 256 colors.
> >>
> >> Martin Maechler <maechler at stat.math.ethz.ch>
http://stat.ethz.ch/~maechler/
>> Seminar fuer Statistik, ETH-Zentrum LEO C16 Leonhardstr. 27
>> ETH (Federal Inst. Technology) 8092 Zurich SWITZERLAND
>> phone: x-41-1-632-3408 fax: ...-1228 <><
Martin
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._.
_._
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list