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