[R] How to get rid of loop? [SOLVED]

[Ken-JP]

Thanks, Uwe, Peter, and Ray, for taking the time to look into this.

Just to wrap up this thread, and so that others may benefit,
I tried writing both a R code version and an inline C version.

Tested on a 8GB Ubuntu 64amd box, R 2.81, the speed difference was:
104secs vs 0.534secs, or the C version was about 200 times faster.

#
-------------------------------------------------------------------------------------

require( inline )
require( RUnit )

set.seed(1)
x <- runif(1e+7)

.c.code <-
                " SEXP res, inp;
                int cnt = 0, i;
                PROTECT(inp = AS_NUMERIC(p));     cnt++;
                PROTECT(res = Rf_duplicate(inp)); cnt++;
                int nx = INTEGER(GET_DIM(inp))[0], ny =
INTEGER(GET_DIM(inp))[1];
                double* pdata = REAL(AS_NUMERIC(inp));
                double* rdata = REAL(res); double last;
                for (int y = 0; y < ny; y++) {
                        last = 0.0;
                        for (int x = 0; x < nx; x++) {
                                i = x + y*nx;
                                if ( pdata[i]>0.75 ) {
                                        rdata[i] = 1.0;
                                } else if ( pdata[i]<0.25 ) {
                                        rdata[i] = -1.0;
                                } else if ( last==1 && pdata[i]<0.5 ) {
                                        rdata[i] = 0.0;
                                } else if ( last==-1 && pdata[i]>0.5 ) {
                                        rdata[i] = 0.0;
                                } else {
                                        rdata[i] = last;
                                }
                                last = rdata[i];
                        }
                }

                UNPROTECT(cnt);
                return res;";
.c.code.raw <- cfunction(signature(p="matrix"), .c.code);
# NOTE: I converted to matrix because I actually want to do many columns,
one at a time
ccode <- function( x ) { as.vector( .c.code.raw( p=as.matrix( x ) )); }

rcode <- function( x ) {
        n <- length( x )
        y <- rep(NA, n)
        yprev <- 0;
        for ( i in (1:n)) {
                if ( x[i]>0.75 ) {
                        y[i] <- 1;
                } else if ( x[i]<0.25 ) {
                        y[i] <- -1;
                } else if ( yprev==1 & x[i]<0.5) {
                        y[i] <- 0;
                } else if ( yprev==-1 & x[i]>0.5) {
                        y[i] <- 0;
                } else {
                        y[i] <- yprev
                }
                yprev <- y[i];
        }
        y;
}

system.time( r.result <- rcode( x ));
system.time( c.result <- ccode( x ));
checkEquals( r.result, c.result );


-- 
View this message in context: http://www.nabble.com/How-to-get-rid-of-loop--tp23226779p23253747.html
Sent from the R help mailing list archive at Nabble.com.