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

[Agustin Lobo]

Sure I agree, but this seems to be, by now, too
involved for me (the time that I have for
writing code is very limited, actually I've done
this during vacation time). 
By now, I just would like a 
version as fast as possible in R code. If there
is a significant number of users interested
on this type of functioality, perhaps the developing
team would consider creating a function
from scratch in C code. Or perhaps
an experienced C/R programmer will do it.
Hopefully, this version
will show the interest of this type of display
within R. We can always call xv from within
R, but then there is no way to overlay
other R plots.

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


On Thu, 30 Aug 2001 ben at zoo.ufl.edu wrote:

> 
>   It does seem that this is a place where hacking C code might be
> worthwhile, if you're going to do a lot of this.  (Of course, it limits
> portability somewhat -- either you have to make binary packages for
> people, or they have to be able to compile packages from source
> themselves.)
>   The "best" way, I would guess, is to actually hack the internal R code
> -- I don't know if there are entry points for things like the image code.
> Short of that, though, you might be able to speed this up considerably
> without the pain of figuring out the internal R stuff just by rewriting
> some of the critical utility functions in C.  Have you tried R profiling
> (see the "R Extensions" manual)?
> 
>   Ben Bolker
> 
> 
> On Thu, 30 Aug 2001, Agustin Lobo wrote:
> 
> >
> > 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
> > _._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
> >
> 
> -- 
> 318 Carr Hall                                bolker at zoo.ufl.edu
> Zoology Department, University of Florida    http://www.zoo.ufl.edu/bolker
> Box 118525                                   (ph)  352-392-5697
> Gainesville, FL 32611-8525                   (fax) 352-392-3704
> 
> 

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