[Rd] speedup for as.matrix.dist

[Romain Francois]

Hello,

I am trying to patch as.matrix.dist to achieve some speedup.

 > m <- expand.grid( x = 1:20, y = 1:20, z = 1:20 )
 > d <- dist( m )
 > system.time( out <- stats:::as.matrix.dist( d ) )
   user  system elapsed
 15.355   3.110  19.123
 > system.time( out <- as.matrix.dist( d ) )
   user  system elapsed
  3.153   0.480   3.782

The code below works if I deploy it in an additional package, but not 
when I patch the "stats" package, I get that kind of message:
  C symbol name "as_matrix_dist" not in load table

Romain


as.matrix.dist <- function(x, ...) {
    size <- as.integer(attr(x, "Size"))
    if( !is.numeric(x) ){
        storage.mode(x) <- "numeric"
    }
    df <- .External( "as_matrix_dist",
        x = x, size = size, PACKAGE = "stats" )
    labels <- attr(x, "Labels")
    dimnames(df) <- if(is.null(labels)) list(1L:size,1L:size) else 
list(labels,labels)
    df
}



/**
 * as.matrix.dist( d )
 */
SEXP as_matrix_dist(SEXP args){
   
    args = CDR( args ) ; SEXP x = CAR( args );
    args = CDR( args ) ; SEXP size = CAR( args );
   
    int i,j,k;
    int s = INTEGER(size)[0];
    SEXP d ;
    PROTECT( d = allocVector( REALSXP, s*s) );
    double element;
    for( i=0,k=0; i<s; i++){
        REAL(d)[i+s*i] = 0.0 ;
        for( j=i+1; j<s; j++,k++){
            element = REAL(x)[k] ;
            REAL( d )[ i + s*j ] = element ;
            REAL( d )[ j + s*i ] = element ;
        }
    }
    SEXP dims ;
    PROTECT( dims = allocVector(INTSXP, 2 ) );
    INTEGER(dims)[0] = s ;
    INTEGER(dims)[1] = s ;
    setAttrib( d, mkString("dim"), dims );
    UNPROTECT(2); /* d, dims */
    return( d ) ;
}



-- 
Romain Francois
Independent R Consultant
+33(0) 6 28 91 30 30
http://romainfrancois.blog.free.fr