[R] imagenrgb: Function to display RGB images in R

[Agustin Lobo]

I've writen this function  (imagenrgb)
to display a (m,n,3) array
as a RGB image with ngris^3 colors and,optionally,
stretching. If option ver=F, it does not
display but saves a pseudocolor version of the image
as a list (so that subsequent displays are faster).

I'd appreciate feedback and improvements
and hope that it's useful for others. 


Example of use:

> dim(imatest)
[1] 100 400   3
> imagenrgb(imatest)
> imagenrgb(imatest,ngris=16,stretch="l")
> imagenrgb(imatest,ngris=16,stretch="n")
> imagenrgb(imatest,ngris=8,stretch="n")
> imatest.cod <- imagenrgb(imatest,ngris=16,stretch="n",ver=F)
> imagen(imatest.cod$ima, col=imatest.cod$cols)

Imatest is a subscene of a satellite image.
The imatest file saved with save(imatest,file="imatest")
is 469k. It's probably better not to send it to the list,
but I can send it to interested people fot testing.

The main problem
is that, at least with RAM up to 48Mb, the function is slow
for normally sized images (i.e., 1024 X 1024 x 3). I'd like 
to hear how this function works for people with large amounts
of RAM (>1Gb).

imatestrgb:

function (mat3d,ngris=64,stretch=" ",ver=T) 
{
# DISPLAYS A (m,n,3) ARRAY AS A RGB IMAGE
# From an idea by Ben Bolker. In particular I DO NOT USE:
#   apply(tstarr/256,c(1,2),function(z)do.call("rgb",as.list(z)))
# which is costly in memory and time.
# IF ver=F, saves the pseudocolor image as a list

# NOTE: if range(mat3d) is VERY different from |0,255|,
# stretch MUST BE "l" or "n"

  m <- dim(mat3d)[1]
  n <- dim(mat3d)[2]
	
#1. Color number reduction to ngris^3. Much better if a clustering were
#used, but should be a fast function.
  if(stretch=="l") {
    mini <- apply(mat3d,3,min)
    maxi <- apply(mat3d,3,max)
  }
  if(stretch=="n") {
	med <- apply(mat3d,3,median)
	ma  <- apply(mat3d,3,mad)
	mini <- med - 3*ma
	maxi <- med + 3*ma
  }
  if(stretch==" ") 
       mat3d <- round(rescale(mat3d,oldmin=0,oldmax=255,newmax=ngris-1))
  else {
       mat3d[,,1] <- round(rescale(mat3d[,,1],oldmin=mini[1],oldmax=maxi[1],newmax=ngris-1))
       mat3d[,,2] <- round(rescale(mat3d[,,2],oldmin=mini[2],oldmax=maxi[2],newmax=ngris-1))
       mat3d[,,3] <- round(rescale(mat3d[,,3],oldmin=mini[3],oldmax=maxi[2],newmax=ngris-1))
  } #stretching

#2. Generates z vectors from a (m,n,3) array.
  i1 <- rep(1:m,rep(n,m))
  i2 <- rep(1:n,m)
  tripletes <-cbind(mat3d[cbind(i1,i2,1)],mat3d[cbind(i1,i2,2)],mat3d[cbind(i1,i2,3)])
  #Note: triplets are ordered by rows

#3. Generates RGB colors:
  tripletes <- tripletes/ngris
  cols <- rgb(tripletes[,1],tripletes[,2],tripletes[,3])
  #Formats vector of color codes as (m,n) matrix:
  dim(cols) <- c(n,m) 
  cols <- t(cols)
  #Generates vector of unique colors:
  cols.unicos <- unique(cols)
  #(Assigns an integer code to each unique color and transforms the
  #char color matrix into an integer matrix):
  cols <-as.numeric(reclas(cols,cols.unicos,1:length(cols.unicos)),drop=F)
  dim(cols) <- c(m,n)

#4.Display or save

  if(ver) imagen(cols,col=cols.unicos)
  else
  list(ima=cols,cols=cols.unicos)
}


Functions called:

> rescale
function(vector, oldmin = min(vector), oldmax = max(vector), newmin = 0,
newmax = 255)
{
        rango <- oldmax - oldmin
        dimen <- dim(vector)    
        vector <- (vector - oldmin)/rango 
        vector <- newmin + (newmax - newmin) * vector   
        vector[vector<newmin]<- 0
        vector[vector>newmax]<- newmax
        dim(vector) <- dimen
        vector
}

> reclas
function(matriz, origen, imagen, directo = T)
{
        if(directo == F) {
                aux <- origen
                origen <- imagen
                imagen <- aux
        }
# As suggested by P.B.Ripley:
        m <- match(matriz, origen, 0)
        matriz[m > 0] <- imagen[m]
        matriz
}

> imagen
function(x,col="bn",add=F)
{
        w <- 9
        hw <- nrow(x)/ncol(x)
        x11(width=w,height=w*hw)
        par(mex=0.01)
        x <- t(x)
        if(col=="bn") col <- gray((0:255)/255)        
        image(x=1:nrow(x), y=1:ncol(x),x[,ncol(x):1],col=col,add=add,axes=F)
}

Agus

Dr. Agustin Lobo
Instituto de Ciencias de la Tierra (CSIC)
Lluis Sole Sabaris s/n
08028 Barcelona SPAIN
tel 34 93409 5410
fax 34 93411 0012
alobo at ija.csic.es


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._