pixmap/0000755000175200001440000000000011611320156011540 5ustar leischuserspixmap/R/0000755000175200001440000000000011611320156011741 5ustar leischuserspixmap/R/addlogo.R0000644000175200001440000000162611611320156013502 0ustar leischusers# setGeneric("addlogo", function(x, ...) standardGeneric("addlogo")) setMethod("addlogo", signature("pixmap"), function(x, px, py=NULL, asp=NULL) { if (is.list(px)) { py <- px$y px <- px$x } else if (is.null(py)) stop("missing py") if (!is.numeric(px) || !is.numeric(py)) stop("non-numeric coordinates") if ((nx <- length(px)) <= 1 || nx != length(py) || nx > 2) stop("invalid coordinate lengths") if (!is.null(asp) && asp <= 0) stop("asp must be greater than zero") obb <- x@bbox x@bbox[1] <- min(px) x@bbox[2] <- min(py) x@bbox[3] <- max(px) if (is.null(asp)) { x@bbox[4] <- max(py) } else { prop <- (x@bbox[3] - x@bbox[1]) / (obb[3] - obb[1]) x@bbox[4] <- x@bbox[2] + prop*asp*(obb[4] - obb[2]) } x@cellres[1] <- (x@bbox[3] - x@bbox[1]) / x@size[2] x@cellres[2] <- (x@bbox[4] - x@bbox[2]) / x@size[1] plot(x, add=TRUE) invisible(x) }) pixmap/R/AAA-classes.R0000644000175200001440000000201411611320156014076 0ustar leischuserssetClass("pixmap", representation(size="integer", cellres="numeric", bbox="numeric", bbcent="logical"), prototype(size=integer(2), cellres=numeric(2), bbox=numeric(4))) setClass("pixmapChannels", representation(channels="character"), contains="pixmap") setClass("pixmapGrey", representation(grey="matrix"), contains="pixmapChannels", prototype=prototype(new("pixmap"), channels="grey")) setClass("pixmapIndexed", representation(index="matrix", col="character"), contains="pixmap", prototype=prototype(new("pixmap"))) setClass("pixmapRGB", representation(red="matrix", green="matrix", blue="matrix"), contains="pixmapChannels", prototype=prototype(new("pixmap"), channels=c("red", "green", "blue"))) pixmap/R/pnmhead.R0000644000175200001440000000301511611320156013477 0ustar leischusersread.pnmhead <- function(con) { seek(con, 0) pm.getc <- function(con) { ch <- readChar(con, nchars=1) if (ch == "#") { ch <- readChar(con, nchars=1) while (ch != '\n' && ch != '\r') { ch <- readChar(con, nchars=1) } } ch } pm.getuint <- function(con) { ch <- pm.getc(con) while (ch == ' ' || ch == '\t' || ch == '\n' || ch == '\r') { ch <- pm.getc(con) } if (ch < '0' || ch > '9') stop("junk in file where an unsigned integer should be") i <- 0 while (ch >= '0' && ch <= '9') { digitVal <- as.integer(ch) i <- i * 10 + digitVal ch <- pm.getc(con) } i } pm.readmagicnumber <- function(con) { ch <- pm.getc(con) if (ch != "P") stop("Not a PNM format file") ch <- as.integer(pm.getc(con)) if (ch < 1 || ch > 6) stop("Unknown PNM format") ascii <- FALSE if (ch < 4) ascii <- TRUE if (ch == 1 || ch == 4) type <- "pbm" else if (ch == 2 || ch == 5) type <- "pgm" else if (ch == 3 || ch == 6) type <- "ppm" res <- list(type=type, ascii=ascii) res } magic <- pm.readmagicnumber(con) nc <- pm.getuint(con) nr <- pm.getuint(con) if (magic$type != "pbm") maxval <- pm.getuint(con) else maxval <- 1 datastart <- seek(con) seek(con, 0) if (nc < 0 || nr < 0 || maxval < 1 || maxval > 65535) warning(paste("Possible error reading heading: nc:", nc, "nr:", nr, "maxval:", maxval)) res <- list(nc = nc, nr = nr, maxval = maxval, type=magic$type, datastart=datastart, ascii=magic$ascii) invisible(res) } pixmap/R/pixmap.R0000644000175200001440000002005411611320156013363 0ustar leischusers setMethod("show", "pixmap", function(object){ cat("Pixmap image\n") cat(" Type :", class(object), "\n") cat(" Size :", paste(object@size, collapse="x"), "\n") cat(" Resolution :", paste(object@cellres, collapse="x"), "\n") cat(" Bounding box :", object@bbox, "\n") if(is(object, "pixmapIndexed")) cat(" Nr. of colors :", length(unique(as(object@index, "vector"))), "of", length(object@col), "\n") cat("\n") }) setMethod("plot", "pixmap", function(x, y, xlab="", ylab="", axes=FALSE, asp=1, ...){ x = as(x, "pixmapIndexed") X <- seq(x@bbox[1], x@bbox[3], by=x@cellres[1]) Y <- seq(x@bbox[2], x@bbox[4], by=x@cellres[2]) image(x=X, y=Y, z=t(x@index[nrow(x@index):1,,drop=FALSE]), col=x@col, xlab=xlab, ylab=ylab, axes=axes, asp=asp, ...) }) ###********************************************************** pixmap <- function(data=NULL, nrow=dim(data)[1], ncol=dim(data)[2], bbox=NULL, bbcent=FALSE, cellres=NULL) { cellres <- rep(cellres, length=2) if(is.null(bbox)){ if(is.null(cellres)) cellres <- c(1,1) if(is.null(nrow)){ if(!is.null(ncol)) nrow <- ceiling(length(data)/ncol) else stop("Too few dimension attributes (nrow, ncol, bbox)\n") } else if(is.null(ncol)) ncol <- ceiling(length(data)/nrow) if(bbcent) bbox <- c(1,1,cellres[1]*ncol, cellres[2]*nrow) else bbox <- c(0,0,cellres[1]*ncol, cellres[2]*nrow) } else{ if(is.null(cellres)){ if(is.null(nrow)){ if(!is.null(ncol)) nrow <- ceiling(length(data)/ncol) else stop("Too few dimension attributes (nrow, ncol, bbox)\n") } else if(is.null(ncol)) ncol <- ceiling(length(data)/nrow) cellres = .getCellres(bbox, bbcent, c(nrow, ncol)) } else{ if(bbcent){ ncol <- (bbox[3]-bbox[1])/cellres[1]+1 nrow <- (bbox[4]-bbox[2])/cellres[2]+1 } else{ ncol <- (bbox[3]-bbox[1])/cellres[1] nrow <- (bbox[4]-bbox[2])/cellres[2] } } } new("pixmap", size=as(c(nrow, ncol),"integer"), cellres=cellres, bbox=bbox, bbcent=bbcent) } pixmapGrey = function(data, ...) { z = new("pixmapGrey", pixmap(data, ...)) datamax <- max(data) datamin <- min(data) data <- as.numeric(data) if(datamax>1 || datamin<0) data <- (data - datamin)/(datamax-datamin) z@grey = matrix(data, nrow=z@size[1], ncol=z@size[2]) z } pixmapRGB = function(data, ...) { z = new("pixmapRGB", pixmap(data, ...)) datamax <- max(data) datamin <- min(data) data <- as.numeric(data) if(datamax>1 || datamin<0) data <- (data - datamin)/(datamax-datamin) data = array(data, dim=c(z@size[1], z@size[2], 3)) z@red = matrix(data[,,1], nrow=z@size[1], ncol=z@size[2]) z@green = matrix(data[,,2], nrow=z@size[1], ncol=z@size[2]) z@blue = matrix(data[,,3], nrow=z@size[1], ncol=z@size[2]) z } pixmapIndexed = function(data, col=NULL, ...) { z = new("pixmapIndexed", pixmap(data, ...)) data <- as(data, "integer") datamin <- min(data) if(datamin<=0) data <- data - datamin + 1 datamax <- max(data) z@index = matrix(data, nrow=z@size[1], ncol=z@size[2]) if(is.null(col)) col <- heat.colors(datamax) else{ if(is(col,"function")) col <- col(datamax) else { if(length(col) < datamax){ warning("number of of colors smaller than number of data values, recycling\n") col <- rep(col, length=datamax) } } } z@col = col z } ###********************************************************** setAs("pixmapGrey", "pixmapRGB", function(from, to){ z = new(to, as(from, "pixmap")) z@red = from@grey z@green = from@grey z@blue = from@grey z@channels = c("red", "green", "blue") z }) setAs("pixmapRGB", "pixmapGrey", function(from, to){ addChannels(from) }) setAs("pixmapRGB", "pixmapIndexed", function(from, to){ z = new(to, as(from, "pixmap")) x = rgb(from@red,from@green,from@blue) col <- unique(x) x <- match(x, col) z@index <- matrix(x, nrow=z@size[1], ncol=z@size[2]) z@col = col z }) setAs("pixmapGrey", "pixmapIndexed", function(from, to){ z = new(to, as(from, "pixmap")) x = grey(from@grey) col <- unique(x) x <- match(x, col) z@index <- matrix(x, nrow=z@size[1], ncol=z@size[2]) z@col = col z }) setAs("pixmapIndexed", "pixmapRGB", function(from, to){ z = new(to, as(from, "pixmap")) x <- col2rgb(from@col[from@index])/255 z@red <- matrix(x["red",], nrow=z@size[1], ncol=z@size[2]) z@green <- matrix(x["green",], nrow=z@size[1], ncol=z@size[2]) z@blue <- matrix(x["blue",], nrow=z@size[1], ncol=z@size[2]) z@channels = c("red", "green", "blue") z }) ## the fallbacks: convert to RGB and then to target setAs("ANY", "pixmapGrey", function(from, to){ as(as(from, "pixmapRGB"), to) }) setAs("ANY", "pixmapIndexed", function(from, to){ as(as(from, "pixmapRGB"), to) }) ###********************************************************** setGeneric("addChannels", function(object, coef=NULL) standardGeneric("addChannels")) ## coercion from RGB to Grey calls addChannels, hence be careful when ## using as() methods (danger of infinite loops). setMethod("addChannels", "pixmapRGB", function(object, coef=NULL){ if(is.null(coef)) coef = c(0.30, 0.59, 0.11) z = new("pixmapGrey", object) z@grey = coef[1] * object@red + coef[2] * object@green + coef[3] * object@blue z@channels = "grey" z }) setGeneric("getChannels", function(object, colors="all") standardGeneric("getChannels")) setMethod("getChannels", "pixmapChannels", function(object, colors="all"){ for(k in 1:length(colors)) colors[k] = match.arg(colors[k], c("all", object@channels)) if(any(colors=="all")) colors = object@channels colors = unique(colors) if(length(colors)>1){ z = array(0, dim=c(object@size, length(colors))) dimnames(z) = list(NULL, NULL, colors) for(k in colors){ z[,,k] = slot(object, k) } } else{ z = slot(object, colors) } z }) ###********************************************************** setMethod("[", "pixmap", function(x, i, j, ..., drop=FALSE){ if(missing(j)) j = TRUE if(missing(i)) i = TRUE osize = x@size if(is(x, "pixmapIndexed")){ x@index = x@index[i,j,drop=FALSE] x@size = dim(x@index) } else if(is(x, "pixmapChannels")){ for(k in x@channels) slot(x, k) = slot(x, k)[i,j,drop=FALSE] x@size = dim(slot(x, k)) } else stop(paste("Cannot subset objects of class", class(x))) ## now we re-calculate bounding box and cellres bbox = numeric(4) if(x@bbcent){ b = seq(x@bbox[1], x@bbox[3], length=osize[2]) bbox[c(1,3)] = range(b[j]) b = seq(x@bbox[2], x@bbox[4], length=osize[1]) bbox[c(2,4)] = range(b[i]) } else{ b = seq(x@bbox[1], x@bbox[3]-x@cellres[1], length=osize[2]) bbox[1] = min(b[j]) bbox[3] = max(b[j]) + x@cellres[1] b = seq(x@bbox[2], x@bbox[4]-x@cellres[2], length=osize[1]) bbox[2] = min(b[i]) bbox[4] = max(b[i]) + x@cellres[2] } x@bbox = bbox x@cellres <- .getCellres(bbox, x@bbcent, x@size) x }) .getCellres = function(bbox, bbcent, size) { if(bbcent) cellres = c((bbox[3]-bbox[1])/(size[2]-1), (bbox[4]-bbox[2])/(size[1]-1)) else cellres = c((bbox[3]-bbox[1])/size[2], (bbox[4]-bbox[2])/size[1]) cellres } pixmap/R/pnm.R0000644000175200001440000000746511611320156012672 0ustar leischusersread.pnm <- function(file, ...) { fsz <- file.info(file)$size con <- file(file, open="rb") pnmhead <- read.pnmhead(con) retval <- read.pnmdata(con, pnmhead, ...) if (fsz != seek(con)) warning("Possible reading error: file size ", fsz, " bytes, but ", seek(con), " bytes read") close(con) retval } read.pnmdata <- function(con, pnmhead, ...) { ds <- pnmhead$datastart seek(con, ds) type <- pnmhead$type nl <- ifelse(type == "ppm", 3, 1) nc <- pnmhead$nc nr <- pnmhead$nr ncells <- nl*nc*nr if (pnmhead$ascii) { xx <- scan(con, integer(0), n=ncells) } else { if (type == "pbm") { ## black & white, i.e. pixel = bit BytesPerRow <- ceiling(nc/8) bxx <- readBin(con, "integer", n=nr*BytesPerRow, size=1, signed=FALSE) as.integer.bytes <- function (x) { ## unpacks bytes in 0:255 into {0,1} integers n <- length(x <- as.integer(x)) if (any(x < 0) || any(x > 255)) stop("Not an unsigned byte (value outside 0:255)") ans <- matrix(integer(8 * n), 8, n) two <- as.integer(2) for (i in 8:1) { ans[i,] <- x %% two x <- x %/% two } ans } xx <- as.integer.bytes(bxx) ncb <- BytesPerRow*8 xx <- 1 - array(xx, c(nl, ncb, nr))[,1:nc,] } else { xx <- readBin(con, "integer", n=ncells, size=1, signed=FALSE) } } res <- array(xx, dim = c(nl, nc, nr)) / pnmhead$maxval if(nl==1) { ## non-RGB: ##FIXME(MM): use "indexed" for B&W z = pixmapGrey(t(res[1,,]), ...) } else{ z = pixmapRGB(0, ncol=dim(res)[2], nrow=dim(res)[3], ...) z@red = t(res[1,,]) z@green = t(res[2,,]) z@blue = t(res[3,,]) } z } write.pnm <- function(object, file=NULL, forceplain=FALSE, type=NULL, maxval=255) { if(!is(object, "pixmap")) stop("Can only write pixmap objects") if(is.null(type)) type <- if(is(object, "pixmapGrey")) "pgm" else "ppm" else type <- match.arg(type, c("pbm", "pgm", "ppm")) do <- object@size switch(type, "pbm" = { object <- as(object, "pixmapGrey") object <- t(object@grey < 0.5) storage.mode(object) <- "integer" code <- 4 forceplain <- TRUE }, "pgm" = { object <- as(object, "pixmapGrey") object <- t(round(object@grey*maxval, 0)) storage.mode(object) <- "integer" code <- 5 }, "ppm" = { object <- as(object, "pixmapRGB") object1 <- array(0, dim=c(3, do[2], do[1])) object1[1,,] <- t(object@red) object1[2,,] <- t(object@green) object1[3,,] <- t(object@blue) object <- object1 object <- round(object*maxval, 0) storage.mode(object) <- "integer" code <- 6 }) if (is.null(file)) file <- paste("Rimage.", type, sep="") comment <- "# R write.pnm output" if(forceplain) { con <- file(file, open="w") code <- code - 3 cat("P", code, "\n", file=con, sep="") cat(comment, "\n", file=con, sep="") cat(do[2], " ", do[1], "\n", file=con, sep="") if (type != "pbm") cat(maxval, "\n", file=con, sep="") write(object, ncolumns=3, file=con) } else { con <- file(file, open="wb") writeChar(paste("P", code, "\n", sep=""), con=con, eos=NULL) writeChar(paste(comment, "\n", sep=""), con=con, eos=NULL) writeChar(paste(do[2], " ", do[1], "\n", sep=""), con=con, eos=NULL) if (type != "pbm") writeChar(paste(maxval, "\n", sep=""), con=con, eos=NULL) writeBin(as.integer(as.vector(object)), con, size=1) } close(con) } pixmap/NEWS0000644000175200001440000000621011611320156012236 0ustar leischusersChanges in pixmap version 0.4-11 o Added dummy NAMESPACE file o Move class definitions to separate file, no Collate in DESCRIPTION Changes in pixmap version 0.4-10 o Explicitly mention in the help file that read.pnm() only works for files, not other conntection. o Fixed a bug in write.pnm() that tried to open the same connection twice. Changes in pixmap version 0.4-9 o Fixed a minor glitch in write.pnm. Changes in pixmap version 0.4-8 o Fixed a bug that prevented plotting images with only 1 row (bug report by Robert Esswein). Changes in pixmap version 0.4-7 o Use LazyLoad instead of SaveImage. Changes in pixmap version 0.4-6 o Modified one of the regression tests for changes in R 2.4: terrain.colors() now return transparency information -> do not use it in example. Changes in pixmap version 0.4-5 o standardized license filed in DESCRIPTION file. Changes in pixmap version 0.4-4 o Fixed a bug in the prototype of class "pixmap". Changes in pixmap version 0.4-3 o New example for overlaying plots in help(pixmap) submitted by Stephan Matthiesen. Changes in pixmap version 0.4-2 o Adjust for R 2.0.0. o Fixed a bug in coercion from pixmapIndexed to pixmapRGB. o There was a bug in the methods package of R 1.9.x which was triggered by functions in pixmap, hence this version of the package depends on R >= 2.0.0. Changes in pixmap version 0.4-1 o Fixed a bug in write.pnm() that wrote grey images in PPM format. o The channel information was not changed when converting between RGB and grey pixmaps. o The maxval in PNM headers must be less than 65536, not less than 256. Changes in pixmap version 0.4-0 o read.pnm(): vectorized (and renamed) as.integer.bytes() which provides a huge performance gain for reading "PBM" (B & W bitmaps). o new function addlogo() Changes in pixmap version 0.3-4 o Clarified documentation of read.pnm (file name extensions are ignored). Changes in pixmap version 0.3-3 o fixed some codoc problems (missing aliases) Changes in pixmap version 0.3-1 o read.pnm(): changes made to function reading and parsing PNM file headers to permit comments of arbitrary length. Changes in pixmap version 0.3-0 o The whole package has moved to S4 classes and methods, hence all classes have a new representation. This also means that the code and the API are not fully backwards compatible with earlier versions of the package. o Added support for subsetting (see example(pixmap)). o New: addChannels() and getChannels(). Changes in pixmap version 0.2-1 o pixmap(): - Added arguments bbcent and cellres - nrow and ncol default to the respective dimensions of the data argument (if present). Hence, pixmap does the expected when given a matrix or an array. - data is rescaled to [0,1] for rgb and grey, and coerced to positive integers for indexed. - col can also be a function like rainbow() Changes in pixmap version 0.1-2 o Fixed bugs in plotting, read.pnm and write.pnm which confused dimensions (rows versus columns), but together let plots look OK. pixmap/DESCRIPTION0000644000175200001440000000071011611320036013241 0ustar leischusersPackage: pixmap Version: 0.4-11 Date: 2011-07-19 Title: Bitmap Images (``Pixel Maps'') Depends: methods Author: Roger Bivand, Friedrich Leisch and Martin Maechler Maintainer: Friedrich Leisch Description: Functions for import, export, plotting and other manipulations of bitmapped images. License: GPL-2 LazyLoad: yes Packaged: 2011-07-19 15:19:10 UTC; leisch Repository: CRAN Date/Publication: 2011-07-19 15:17:50 pixmap/NAMESPACE0000644000175200001440000000006511611320156012760 0ustar leischusersimportFrom(graphics, plot) exportPattern("^[^\\.]") pixmap/man/0000755000175200001440000000000011611320156012313 5ustar leischuserspixmap/man/channels-methods.Rd0000644000175200001440000000265211611320156016043 0ustar leischusers\name{channels-methods} \docType{methods} \title{Methods for Channel Manipulation} \alias{addChannels} \alias{getChannels} \alias{addChannels-methods} \alias{getChannels-methods} \alias{addChannels,pixmapRGB-method} \alias{getChannels,pixmapChannels-method} \description{Functions for manipulation and extraction of colors from channel-based pixmap formats. Methods for generic \code{addChannels} adds the color channels of a colored pixmap and returns a grey version. Methods for generic \code{getChannels} return numeric matrices or arrays containing the specified channels.} \usage{ addChannels(object, coef = NULL) getChannels(object, colors = "all") } \arguments{ \item{object}{Object of class \code{"pixmap"}.} \item{coef}{Coefficients for the color channels, a numeric vercot with as many elements as there are color channels in the pixmap. The default for RGB is \code{c(0.30, 0.59, 0.11)}, which makes a luminance-based conversion from color to grey.} \item{colors}{Character vector naming the color channels that shall be extracted. The default of \code{"all"} returns all channels simultaneously.} } \keyword{methods} \author{Friedrich Leisch} \examples{ x <- pixmapRGB(rep(1:5, 3), nrow=4) plot(x) print(x) getChannels(x) getChannels(x, colors=c("red", "green")) y = addChannels(x) plot(y) print(y) ## extract only the red channel y = addChannels(x, coef=c(1,0,0)) plot(y) } pixmap/man/pixmap-class.Rd0000644000175200001440000000661411611320156015212 0ustar leischusers\name{pixmap-class} \docType{class} \alias{pixmap-class} \alias{pixmapRGB-class} \alias{pixmapGrey-class} \alias{pixmapIndexed-class} \alias{pixmapChannels-class} \alias{coerce,pixmapGrey,pixmapIndexed-method} \alias{coerce,pixmapGrey,pixmapRGB-method} \alias{coerce,pixmapRGB,pixmapGrey-method} \alias{coerce,pixmapRGB,pixmapIndexed-method} \alias{coerce,pixmapIndexed,pixmapRGB-method} \alias{coerce,ANY,pixmapGrey-method} \alias{coerce,ANY,pixmapIndexed-method} \title{Class Family "pixmap".} \description{The family \code{"pixmap"} (``pixel maps'') of classes provides methods for creating, plotting and converting bitmapped images in currently three different formats: RGB (\code{"pixmapRGB"}), grey (\code{"pixmapGrey"})and indexed pixmaps (\code{"pixmapIndexed"}).} \section{Objects from the Class}{ Objects can be created by calls of the form \code{new("pixmap", ...)} or using the creator functions \code{\link{pixmap}} (similar for all child classes of name (\code{"pixmapXXX"}). } \section{Slots}{ \describe{ \item{\code{size}:}{Object of class \code{"integer"} and length 2 (number of rows and columns).} \item{\code{cellres}:}{Object of class \code{"numeric"} and length 2 specifying the cell resolution of each pixel in user coordinates.} \item{\code{bbox}:}{Object of class \code{"numeric"} and length 4, the coordinates of the bounding box (x bottom, y bottom, x top, y top).} \item{\code{channels}:}{A character vector naming the channel slots of the object (\code{NULL} for indexed pixmaps).} \item{\code{red}, \code{green}, \code{blue}:}{Only for class \code{"pixmapRGB"} with matrices specifying the red, green and blue channel of the picture.} \item{\code{grey}:}{Only for class \code{"pixmapGrey"}, a matrix specifying the grey intensity (0=black, 1=white) of the picture.} \item{\code{col}:}{Only for class \code{"pixmapGrey"}, a character vector with a map of color names.} \item{\code{index}:}{Only for class \code{"pixmapIndexed"}, an integer matrix with codes from the color map. } } } \section{Details}{ Class \code{"pixmap"} specifies the basic geometry of a picture: the size in pixels together with information for an optional coordinate system, see \code{\link{pixmap}} for details. Grey and indexed pixmaps are besically matrices (contained in the \code{grey} or \code{index} slot, respectively). The element \code{[1,1]} corresponds to the upper left corner as usual. For grey pixmaps the elements must be between 0 (black) and 1 (white). Indexed pixmaps have integer elements, each giving the index number corresponding to the palette specified in slot \code{"col"}. Colors are given using the usual R color strings (either names like \code{"red"} or hex values like \code{"#FF0000"}). Alternatively, a function to create a color palette can be specified, see \code{\link{rainbow}} or \code{\link{heat.colors}} for examples. RGB pixmaps have three matrices for each of the three color channels. Elements of the matrices must be between 0 (=color off) and 1 (=color at maximum intensity). Methods for coercion between all formats are available. Class \code{"pixmapChannels"} is a helper parent class currently containing classes \code{"pixmapRGB"} and \code{"pixmapGrey"}. } \author{Friedrich Leisch} \seealso{\code{\link{pixmap}}} \keyword{classes} pixmap/man/addlogo-methods.Rd0000644000175200001440000000275511611320156015665 0ustar leischusers\name{addlogo-methods} \docType{methods} \title{Methods for Adding a Pixmap Logo to a Plot} \alias{addlogo} \alias{addlogo-methods} \alias{addlogo,pixmap-method} \description{ This method allows the addition of a re-scaled pixmap to an existing plot, possibly as a logo, optionally preserving aspect. It may be used interactively with \code{locator}, and is positioned in the coordinate system of the plot region. Since the logo is displayed using \code{image}, it does not yet seem possible to use the function outside this region. } \usage{ addlogo(x, \dots) \S4method{addlogo}{pixmap}(x, px, py, asp = NULL) } \arguments{ \item{x}{an object of class \code{pixmap}} \item{px}{a vector of two x coordinates, or a list with two named elements x and y, such as that returned by \code{\link{locator}}.} \item{py}{if px is not a list, a vector of two y coordinates} \item{asp}{if omitted or NULL (default), output respects both y coordinates, if a number greater than zero, aspect is preserved in proportion to the difference between x coordinates, multiplied by asp, and only the first y coordinate is respected.} \item{\dots}{potentially further arguments passed to and from methods.} } \value{The same pixmap object with changed bounding box and cell resolution} \author{Roger Bivand} \examples{ x <- read.pnm(system.file("pictures/logo.ppm", package="pixmap")[1]) plot(x) for (i in 1:7) addlogo(x, px=c(0, (101/77)*11), py=c((i-1)*11, i*11), asp=1) } \keyword{methods} pixmap/man/pixmap.Rd0000644000175200001440000000774411611320156014114 0ustar leischusers\name{pixmap} \title{Pixmap Images} \alias{pixmap} \alias{pixmapRGB} \alias{pixmapGrey} \alias{pixmapIndexed} \alias{plot,pixmap-method} \alias{show,pixmap-method} \alias{[,pixmap-method} \usage{ pixmap(data=NULL, nrow=dim(data)[1], ncol=dim(data)[2], bbox=NULL, bbcent=FALSE, cellres=NULL) pixmapRGB(data, ...) pixmapGrey(data, ...) pixmapIndexed(data, col, ...) } \description{ The family \code{"pixmap"} (``pixel maps'') of classes provides methods for creating, plotting and converting bitmapped images in three different formats: RGB, grey and indexed pixmaps.} \arguments{ \item{data}{An optional data vector.} \item{nrow}{Vertical size of the image in pixels.} \item{ncol}{Horizontal size of the image in pixels.} \item{bbox}{Bounding box of the image, vector of length 4 of form \code{c(x1, y1, x2, y2)} with coordinates for the lower left corner and upper right corner.} \item{bbcent}{Logical, if \code{TRUE} the bounding box specifies the coordinates of the centers of the lower left and upper right pixels, default is the coordinates of the lower left and upper right corner of the image.} \item{cellres}{Numeric vector of length 1 or 2, specifies the resolution of pixels in horizontal and vertical direction. If only one value is given, resolution in both directions is identical.} \item{col}{Character vector of colors to use for indexed pictures, or a function like \code{\link{rainbow}} which can be used to create a palette. Colors set to \code{NA} are transparent; this can be used,e.g., for overlaying plots.} \item{...}{Additional arguments passed to \code{pixmap()}.} } \details{ If the \code{data} argument is 2- or 3-dimensional, \code{nrow} and \code{ncol} default to the first two dimensions of \code{data}, such that \code{pixmap} does the expected when given a matrix or an array. The arguments \code{bbox}, \code{bbcent} and \code{cellres} can be used to specify a coordinate system for the image. Note that together with \code{nrow} and \code{ncol} the coordinate system is overspecified, hence not all parameters must be specified, the rest is computed or set to sensible defaults. For \code{bbcent=FALSE} we have \code{cellres[1] = (bbox[3]-bbox[1])/ncol} and \code{cellres[2] = (bbox[4]-bbox[2])/nrow}, for \code{bbcent=TRUE} we get \code{cellres[1] = (bbox[3]-bbox[1])/(ncol-1)} and \code{cellres[2] = (bbox[4]-bbox[2])/(nrow-1)}. The name \code{pixmap} was chosen because both \code{image} and \code{bitmap} are already used in R. } \author{Friedrich Leisch} \seealso{\code{\link{pixmap-class}}, \code{\link{read.pnm}}} \keyword{color} \examples{ ## A simple example x <- pixmapIndexed(rep(1:8, 9), nrow=6, col=terrain.colors(8)) plot(x) ## The same with different colors, and passing the function instead of ## a color vector x <- pixmapIndexed(rep(1:8, 9), nrow=6, col=rainbow) plot(x) plot(x, asp=.5, axes=TRUE) ## Read data from a file x <- read.pnm(system.file("pictures/logo.ppm", package="pixmap")[1]) plot(x) ## Another example that math can be beautiful x <- seq(-3,3,length=100) z1 <- outer(x,x,function(x,y) abs(sin(x)*sin(y))) z2 <- outer(x,x,function(x,y) abs(sin(2*x)*sin(y))) z3 <- outer(x,x,function(x,y) abs(sin(x)*sin(2*y))) ## Notice that we specify a bounding box to get the correct ## coordinates on the axes. z1, z2 and z3 are used as red, ## green and blue channel, respectively. z <- pixmapRGB(c(z1,z2,z3), 100, 100, bbox=c(-1,-1,1,1)) plot(z, axes=TRUE) ## look at a grey version plot(as(z, "pixmapGrey")) ## subsetting works as expected plot(z[1:20,]) plot(z[,1:40]) plot(z[1:20,10:40]) ## overlay different images using transparency ## base image as before x <- pixmapIndexed(rep(1:8, 9), nrow=6, col=terrain.colors(8)) plot(x) ## make a mask of vertical bars mask <- array(0,dim=c(6,12)) mask[,seq(1,12,3)] <- 1 ## plot this mask over existing image with transparent and black color plot(pixmapIndexed(mask,col=c("NA","#000000")),add=TRUE) } pixmap/man/pnm.Rd0000644000175200001440000000445711611320156013406 0ustar leischusers\name{pnm} \title{Read/Write Portable Anymap Images} \alias{write.pnm} \alias{read.pnm} \alias{read.pnmdata} \alias{read.pnmhead} \usage{ read.pnm(file, \dots) write.pnm(object, file= NULL, forceplain = FALSE, type = NULL, maxval = 255) } \description{Reading and writing of bitmap images in PBM (black/white), PGM (grey) and PPM (color) format.} \arguments{ \item{file}{name of the pnm file (general \code{\link[base]{connections}} do not work at the moment).} \item{\dots}{further arguments passed to \code{\link{pixmap}} (like \code{bbox}).} \item{object}{an object of class \code{"pixmap"}.} \item{forceplain}{logical; if true, an ASCII pnm file is written. Default is to write a binary (raw) file.} \item{type}{one of \code{"pbm"}, \code{"pgm"} or \code{"ppm"}. Default is to use \code{"pgm"} for grey images and \code{"ppm"} for color images.} \item{maxval}{the maximum color-component value; the default is a colour depth of 8 bits, i.e., the integer 255.} } \details{ \code{read.pnm} reads a pnm file and loads the image into an object of class \code{\link{pixmap}}. \code{write.pnm} writes an object of class \code{\link{pixmap}} to a pnm file, the \code{type} argument controls wheter the written image file is a black-and-white bitmap (pbm), grey (pgm) or color (ppm). \code{plot.pnm} plots a pnm object using the command \code{\link{image}}. The only difference is that the element \code{[1,1]} of \code{pnmobj} is plotted as the upper left corner (plain \code{\link{image}} would plot \code{[1,1]} as the lower left corner. } \value{ \code{read.pnm} returns an object of class \code{\link{pixmapRGB}} for color pixmaps (ppm), and an object of class \code{\link{pixmapGrey}} for pbm and pgm. Note that the \emph{type} of file as determined by the first two bytes according to pnm standards is important, \emph{not the extension} of the file. In fact, the file name extension is completely ignored. } \author{Roger Bivand and Friedrich Leisch} \seealso{\code{\link{pixmap}}} \keyword{file} \keyword{color} \examples{ x <- read.pnm(system.file("pictures/logo.ppm", package="pixmap")[1]) plot(x) print(x) x <- read.pnm(system.file("pictures/logo.pgm", package="pixmap")[1]) plot(x) x <- read.pnm(system.file("pictures/logo.pbm", package="pixmap")[1]) plot(x) } pixmap/inst/0000755000175200001440000000000011611320156012515 5ustar leischuserspixmap/inst/pictures/0000755000175200001440000000000011611320156014353 5ustar leischuserspixmap/inst/pictures/logo.pgm0000644000175200001440000001723411611320156016027 0ustar leischusersP5 # CREATOR: The GIMP's PNM Filter Version 1.0 101 77 255 ¾½̹ɶŜxohfca`_]\\]\dipz׮{vl[WOF?86513333578;=@DHUdozw̝{sx|~zgWI<5&#"$%)-25ԋRBLOi|{ehURUgv5нƼEWOiwupXULPVm;D̵޻^`Thz^hcjR@bwy7ݷɼndbztf_uǁTHZr{CмeokxZgގ[EFyӌ> y{|~{xz~yx}˰|jtkyfcpiMJUݥY(j]mmonlnz~}sjffl|{muu}yjTڈYLUmx1tyz{{}Ż~ywxvdtpr\ۼgNM_ԗQxŪ|}l_jc|lYז_HVnm*oq{ҠT9#$"#%-$$+6Ggz[URzo_ʼxbG`֞K yߎ/  '>dd?O[esҹsPQeu3r̹T$  ")7[zmGKW杘cpվ˯oPWpدf0 "sN$ _jjm^dZiuc;+7@6StvJGG󭚅fiϸţkQ_|ސ\'PsL(0?8GOnL;:ʤpcʴkSdԊQ"sM0-7q[l~K-9}갛}bǰoWeA +sO22>su{J'9rcȮu[j=sM0)Aي|K)4rgʬz`lŀG"rL-3NꗞuE)0zo̪}co¿uN&5rM.#Bꚭp>$/v㧖ph¿O%(2rN,*Fܳuy|ƴj:!,맓yjüX2+,rQ..Oʡ}uִZ)'zqx¶fB1,rU03Tndו9+lˍ}uvN77]rbD\pp{k"Rպ铊~X;ACr~rwyĸyi~Dǯw|kFG:srƆmM 7潎nې|[LDPrܿ~}bt\ &Ρ}~|nRSI`rӮ{knkڏVF޵׉wvpgTRIr|{|}}vwnigbbo͌^7 >켜kstqm~fZU`r~}sqvwy؊O%,Ϫhsgm|flMnrǬ2 Vܯ}khiivnqXxrìûʹ_+ $ˆw}Yd_fujwarԗD3#!,8FRĦN HެqvS_^`kycwrݏ0.5ZU/S̯eua_Y]rh}sy|rӻh%:Uxg?QyԜx{jO\SXf|{s{rW$#HjmS9/216Vj콍d|NNNSZivG/+2V0FP_{պdgږXTHNUWp줙oxH/-6RSXw|nj^mLaN7GQUhw}H0>GuKa`ygo\IgG>>BJSXaqnH/4GZdxxqk`M>6668>EKVanwH/1<¾γгvear}b]g҂SM9.3869ATTWe{vvH//?ȦhKn~mdYu|W889.+4*5BGIQan~G/(DüǼǤqq^ssYgIiA51+),,)&)29;wM1-?vueUms]jbSfoșb97,$%,,",oP2,9^XHKGDF9<8 1]jgl}a`jrC&"(+*jN-3E#1&*!)%%/QshanW^iѥqC)DoM.+<%"&!+gghq_VZuO28@ohdogzsYc_tK/%K{nck~Y`SvI*+FnghʻgY\k~֮M,*Gpllfо[[ZϼS')S_agcȶk]Rit`\o_ade`P9)(D|j]b\^]_bdb_[WTP_[oC$(/?^fB0#&/QSdiB  #9g/ &CWL% 8MI>0@Rǰpixmap/inst/pictures/logo.ppm0000644000175200001440000005553611611320156016047 0ustar leischusersP6 # CREATOR: The GIMP's PNM Filter Version 1.0 101 77 255 ʿȽĹƾļ·ööøʿļøĻźȽĹöŸĸ¶ʿźʿʿɾɾɾȽȽǿɿǿǿǿƼƼûɽǻǻȼþ¿Ŀþ½¿¿¿̾ʺʼʼĻļ˿~ǹzsx{josbik]eiZdfY`dVacV^bT^`S[_Q]_R\`R]_RegZjl_qsfz|qzþ˯yz}}sxyuyjkoaX_OVZKLSCEI:528.#) &"  ! !# #%"#'&&+'*/+130664<=8NMIda\xtq{zŒwppdnndssi~~tmni_a^RTS>@?-.0#$&     #!! %"#(#$)#$("""44243.880DC>QPKda\xup{vsytq~{ͥ}}sllbddZii_~~tɸ~{vfe`POK==;%%%      #"'! &#"(#"*%$,&%+('/)(0*)1&%-"!'! (#"*%$*#"'!!#((& !!!,,$761<;6IFAURMwto~{v~yuytp}jidǿ٨}}sgg]^^T``VxxpŽþwsp[ZVCB>('#! 0.3TRWvtwη}{b`eKIL869-+,..,+,&,-%12*-.&()!//'<<4DD5OLCc_Txti{ywkldbc]ឞxxpXXPTTL^^Vrrj̢qplED@%$" 00.qrmէNNLDC??>9DA:LIBUQHfcZxulyzryzrqrl]^X}|wݙ``VRRHTTJkkc~ŽXWS320 647oomCB@;:6DA?֍SRPDC?NMIQPKjkc}~v}{|vef`hicۘWWKTTJWWMii_z絴xws762޸귾贻岺᰺ްߺ춿貹㯸߱೻⵽곻ߪ԰ַFFDWXSOPJjkc{xyquvppqkXYSWWKNNBRRFXXNy幸onj=<8FDE͹冀۳笸⯺篺诹ꭷ謷嬷䯻崽讹殹殹箹箹箹筸殹窵㬷尻鱼걼鱼걼鳻驲ݧ٫ۮި؞˞ȩϟ⻼__]`a[UVNijbz{u^_Yhiccd^ll`STFAB4cdVyymﶵ{zv875·ػ߼鱼ܵ౻ަآ֣נԚЕɑÌnojde_bc]{{|tuvngh``aYuvpɿwVVJIJ<[\Nstf}|xDCA螬ٕҏ̍Ɏƃef`opjlmeyzr[\Tghb֐]]SGG;GH:z{mŹ̎@?; xΞ{xk|l}m}q}pyowqzu~pyv}}yw{}zxxyyxxnwq}xǚԬ̅p|_jtuolme|yztfgade]pqk˾Ϳ๹kkaOOELLBWWK֧[ZV(((Řʃӎ\lN_}^o]p`oam`kemqz|{u~s|q|gr]jYfYf^ll}}ޘ؂wq{dnvwovwo}~xyztkldUVNȻ҉ZZRNNDWWMoocཽzyt32. yЋfuk{l|m|m{p||ð嬴ⓞˊ~vq~kyiwjwwԎylv[enuqrj{stl]^VɾȻӾhh`OOGOOEaaWz̙SRMÝݍixwϲߣƈ|{y||y}ţԱ䫴ߦޚӌŁ{tn{o|tˌblW^{dk~_co{}~vmnfYZTøǺϘ``XIIAXXNppdȼ۹oni,+&  qopĚۊbqm|}“ͦNTl39O#95%:"8#9%=&,F#@#@%*H/5UAEh_e|ͧݨᛦӏȒ͑Њ˂mxu~SZwOUkORaz{upqi_`Zļƹzzpcc[HH@bbXuΟMLG ! Սkyt|ȟ۷'/F %    ),0!&D6<`[cәяȏʉ|ŋ̅ŌŊ]c9?WLO`X[d񱲬fg_stnûǻttlRQLSRMff^Żvvn54/Ǔ֑drsРKTs%:   !'  "&)"6#(F.6ZO[mzȌЎҐӋ˔͒fl@F`GJ]UWc᝞|cd_pqlпpphRQLYXSqqiɿаhgb21- """ǒՑdrsњܭﵿENo%: \adglodmljpn[a_ageW][ekkpxz^fi6=C(,528F:@X-6WGSygtĉ͌Г֎ϖіntDIfCFYEGTﭮfgbijeʹȻlldSRMa`[}}uג^]X)($RPQȓ֑drsҘڥ穳蚣CLk!)<)2;;@F𕙢38L?FcCOuanz~ȌИݕ֙ԛx~FKh8:O8:GŤpqlcd_ŴķlldUTOfe`~͌SRM$"#ǒՑdrsԚۥ奯╞DMj(1B&/838>jqO\_lq~yÌН✧ߝڟEJg*,A68G~|就}~ybc^°ķpphYXSgfaºCB= -+,Ǔ֑drs|Лܧ祯╞FPk,3F-3?;>Ggthun{t|̛❧⠧ޣڂDIg$&=68Gsq|cd_îövvn]\Xlkg?>9 œԑdrsx͚ۥ楯╟DNi*1D&)8@@LzwԀm{y~Ėݜᥬ㩱DIi&(?23Esq|ghcŬ{{sba]nmi|IHC#" œԑdrs{Κۥ楯CLi(-C03DNM[ljeuwȖݟ䫲譵䀅?Db%'@./Azxopkǫ~~ved_qpkþwvqPOJ'&$756œӑdrsқܥ楯╞DMl)-F!"6BAO֗ͱ~`pv͛य篹쮶y8=[!#:-.@¼vwrݨrrhjj`|ûQPK'&")(&320Ɠӑdrszì奯䙢ENo'+F();EEQٟՠfukyl|Ŧ誶aj3:V 7*+=º~姩{{oll`w¸ŻZYT43/,+)-,*œӐdrsƦ睨࣬㙡HPt'-G+.?NNZܱ਱o}fuxƤQZy"(B)&%5z{ussgzzpĺhgbDC?21/-,*œӑdrsɢ㛦ޤ䘠LTx)/I.3FPT`aoVd˞ն29U.)**6起lmgōswwmxwrPOK875875^][œӒdrsȝޜޣ㖞YaED@œӑdrs~ɘٗٚڔt}iqnvpxװߵష߻py^ir?C\.$ɾxyqſ|~s}mlhHGCIHD<;7utpœӑdrsˑҋΎΏƌĚΓ΢ݫ⬵ળܫ٨Է䱹ݸflvJLa* 77?ཿnoiՑ}~vx~]\WNMHFE@RQMœӒdrs|̎ϊˈDŽÕ˛ף߻v|u{[alsW\o  %&*Ȣ}~xw}}upojTSNUTOKJFba]œӑdrsz̏Ўψyvvݰ͊q{ajeldi銐RUh)  EGFٶ҉yxsxwrrqlhh`UUMTSNKJEœӑdrsČ͌ύ͎ār{nzl}m~quxup~iwjxao[iZgUaVaemvއ[^m47F >>>缽klfutpvuqsrnoniwgg_\[VWVQ`a[œӑdrsƑҕדҗɟˤКȓʎɋʼnÄzq~pn}esdpiuiukwyºJP` &4%  -,1˪z𜛙jieutpihdoni}tgg_mmeNOGophœӑdrs|Ĕա᯷ۚ֌̂ÅǂǏҴ~,2H "  &VU]ٯ}~y℃lkijiekjfkjewwooogrskYZRxysœӑdrszŗթ֦ČƠг﮺ꢮ⚥ݎԑף鬸V_~$+E)  ##/ÿwxs~}{[ZVfeaa`\hgbwwmkldxyqab\~œӑdrs}̜ڮꑘ?ES/3?#/"2&-=29K?GZJRivѦݡ۔ј٬BOq 1 )DHS٬|qrmwvtTSQa`\`_Zba\{lmeyztcd^wxrœӑdrtzˠ޶+0D!  !,(/?.6KQ[vwӔϓҠ㡱䡱⊛HVy%0LKSjǯefavvtab]a`[[ZU_^Ytsn}ijb~wtumz{s|}wœӑdrs}Ȟܶag* -%;1:WKUxlxđЎБפ阪܌Zh3@`HRkrz͝xys{|wjkfQPL^]XUTOZYThgb}}u{{}rsuj{|vœӒdrsɘٰPVx$: $#)IHMkjolmrRSX69B+/;-2E*1K-6ULU|y̎ЎҜєw^kv꼿de_|}xNOJNOJNOISTNZ[Uijd{zy~}û~ȔՌhvv~˟८央ᚣ>Gf)/E'+722:첵RVa+1A>F]GPoS_}ǐΏἈΎȊŠt{طde_ghb֖XYTTUPHIDNOJUVQWXSpql~ɑҋaoix~˟८央ᚣ?He)/E)-936?LScJTmMXxluǁюǀ}̣ߠڎp}ueoƢhlk]_\mniĿବMMKbb`OOM886HHFRRPUVQhicxyq|֘o}x~˟८央ᚣ?He*0F:>JFFPpvDLaXa~V`s˃…wyȖҘzoy^hipY]fFJMhhf==;SSQHHF775DDBLMHUVPbc[prg{}r~֎drq~˟࣮䤮ᛤ?He)0C!%199Als`gS\}bk}Ž~iuft{ˆZd`iu}ovZakNNL??=HHF??=>?:BC=KLDTUMYZRbc[rsk|~و`ns~˟य央ᚣ?He)0C04@EHORZq[dnxlxȈ~styhpdkZatzᏏNNL??=7756726719:2?@8FG?LMEWXPbc[ophyފiw{~˟य央ᘤ?He)0C+2<:=D¾˱׮pw\fVahrĂ~ŏ̙ͅs}YbU]tahz҃TTRMNI9:4./)45-9:26719:4BC;UVNTUOWXRef`{|vƋÖ׃gugv~͟य央ᘤ>Ie)0B)0:=@EźúӠai~BLgcnt~ÉŇŇȇȆw~dl\cQYppv}}{WXS8938939:4./)+,&45/*+%560BC=GHBIJDQRL`b_lot|֋yo~~͟८央ᘤ=Hd)0B#*2AFIƻŹџkriqU^{isȃώĊŚirPYz^hCJ]ફijeAB=56112-+,')*%,-(,-()*%&'")*%1307:?6Z``WYXHJEKLFHIAEF>FGA9;6:>=5:="(+2,5$,9CGPdo[i\ir|Ԣ߱㞬ә̂`fTXsYZojiy~ٞr}DNi&-@%+9DHQiqbmalZg➩|TZtXZqXYkϛϕǧ݆JTm!(;$*6QT[V`{Xa^fYcĚ̹魶՚ckW]sLSedjz~ksW_S[foV_~Xa~[d^eY`zIPj2:O$*:$(3CDIu}ciU\y[aS\}W]T]~X^~[a^c\a~X_yS[rPXmMUhIQdW`qU\lgn;B_:33101.-0%2#)5,09>?CY^q`f|~?|><'0x8'<??`>'`~p|p|0000000x |  `| 0|8@>p>@>|?0? >~80?~<`?8Fpx!`|1&=<?&@x|<?G$x???pixmap/tests/0000755000175200001440000000000011611320156012702 5ustar leischuserspixmap/tests/logo-ex.R0000644000175200001440000000106711611320156014403 0ustar leischuserslibrary("pixmap") x <- read.pnm(system.file("pictures/logo.ppm", package="pixmap")[1]) dx <- x@size chx <- getChannels(x) stopifnot(is(x, "pixmap"), is(x, "pixmapRGB"), dx == c(77, 101), dim(chx) == c(dx, 3)) par(mfrow = c(2,2)) plot(x, main = "R logo pixmap") for(j in 1:3) plot(pixmapGrey(chx[,, j]), main=paste("channel",j)) x1 <- as(x, "pixmapGrey") z <- getChannels(x1) stopifnot(is(z, "matrix"), dim(z) == dx) x2 <- as(x1, "pixmapRGB") z <- getChannels(x2) stopifnot(is(z, "array"), dim(z) == c(dx, 3)) pixmap/tests/bugs.R0000644000175200001440000000144611611320156013772 0ustar leischuserslibrary("pixmap") ## this triggered a bug in R <= 1.9.1 x <- pixmapIndexed(rep(1:8, 9), nrow=6, col=hsv(runif(8),runif(8),runif(8))) plot(x) print(x) file <- tempfile() write.pnm(x, file=file) unlink(file) ###********************************************************** # coercion of indexed -> RGB x1 <- as(x, "pixmapRGB") x2 <- as(x1, "pixmapIndexed") x3 <- as(x2, "pixmapRGB") stopifnot(all.equal(x, x2)) stopifnot(all.equal(x1, x3)) ###********************************************************** ## plotting images with only 1 column or row ## (from bug report by Robert Esswein) library(pixmap) ## Vertical colorbar: pm <- pixmapIndexed(matrix(1:16,ncol=1,nrow=16),col=palette()) plot(pm) ## Horizontal colorbar attempt: pm <- pixmapIndexed(matrix(1:16,ncol=16,nrow=1),col=palette()) plot(pm)