[plt-scheme] Number crunching -> Matthias, Eli

I think that number crunching is so important that it should receive ad hoc optimization, if a more general approach fails. To bring the discussion to a concrete example, I attached a small benchmark to this article.  PLT, Bigloo and Gambit take about the same time to run the program below. However, Bigloo and Gambit become ten times faster with a very simple optimization.

 (define-syntax $

     (syntax-rules ()

       ( ($ m c i j) (vector-ref m (+fx (*fx c i) j)))

     )

  )

  

  (define-syntax $!

     (syntax-rules ()

       ( ($! m c i j v) (vector-set! m (+fx (*fx c i) j) v))

     )

   )


BTW, use the option -Obench to compile Bigloo. When one uses the *fx, +fx, *fl, +fl and /fl in few other places, Bigloo speed is multiplied by 20 (the time is divided by 20). It would be great if PLT had similar directives to control optimization. 

If I missed something, and there is a way to make PLT approach the speed of Bigloo and Gambit in the example below, please let me know.  However, I read an article in this list, where you people suggest exactly this, to add unsafe arithmetic operators to improve performance. 



(module matplt scheme
   (require (lib "4.ss" "srfi"))
  
  (define iii 0)

 (define-syntax $mk
    (syntax-rules ()
       ( ($mk c v) (make-vector c v)) ))

 (define-syntax $
     (syntax-rules ()
       ( ($ m c i j) (vector-ref m (+ (* c i) j)))
     )
  )
  
  (define-syntax $!
     (syntax-rules ()
       ( ($! m c i j v) (vector-set! m (+ (* c i) j) v))
     )
   )
  
 


(define (prt m r c)
   (do ( (i 0 (+  i 1)) ) ( (>=  i r) )
      (newline)
      (do ((j 0 (+  j 1)) )  ( (>=  j c) )
         (printf " %4.3f " ($ m c i j) ) )))

(define (make-system r)
  (let* ( (c (+  r 1))
          (m ($mk (*  r c) 0.0 )) 
          (xx 0.0)
          (s 0.0) )

    (do ( (i 0 (+  i 1))  ) ( (>=  i r) m)
       (set! s 0.0)
       (do ((j 0 (+  j 1) ) ) ( (>=  j r) ($! m c i j  s) )
          (set! xx (exact->inexact (random 3873)))
          (set! s (+ s xx))
          ($! m c i j xx )) )  ))

(define (swapit m c k l)
  (let ((t 0.0))
   (set! iii (+  iii 1))
   (do ( (j 0 (+  j 1)) ) ( (>=  j c) )
      (set! t ($ m c k j ) )
      ($! m c k j  ($ m c l j) )
      ($! m c l j t) )  )  )

(define (find-max m c k i)
    (do ( (l (+  k 1) (+  l 1)) ) 
        ( (>=  l (-  c 1)) (when (not (= i k))  (swapit m  c k i )))
      (when (> (abs ($ m c l k)) (abs ($ m c i k)) )
            (set! i l) )  ))

(define (solvit m r)
   (let ( (c (+  r 1)) 
           (rat 0.0)
           (mkk 0.0))
      
      (do ( (k 0 (+  k 1)) ) ( (>=  k (-  r 1)))
        (find-max m c k k)
        (set! mkk ($ m c  k k) ) 
        
        (do ( ( i (+  k 1)(+  i 1)) ) ( (>=  i r))
           (set! rat (/  ($ m c i k) mkk  ))
             (do ( (j  k  (+  j 1))) ( (>=  j c) )
                 ($! m c i j (- ($ m c i j) 
                                   (* rat ($ m c k j ) ) ) )
             ) 
          ) 
       ) 
      
     (do ( (i (-  r 1) (-  i 1) ) ) ((<  i 0) m)
        (do ( (j (+  i 1) (+  j 1)) 
              (tx 0.0 (- tx (* ($ m c i j) 
                               ($ m c j r    )) )) )
            ( (>=  j r)
              ($! m c i r  
                 (/ (+ ($ m c  i r ) tx)
                       ($ m c i i)) ) ) ))
   )
)              
 
(define (elms argv)
  (cond ( (<  (length argv) 2) 2000)
        ( (string->number (cadr argv)) (string->number (cadr argv)) )
        (else 2000)))

(define (main argv)
   (let* ( (r (elms argv)) (c (+  r 1)) (m (solvit (make-system r) r) ) ) 
      (do ( (i 0 (+  i 1))) ( (>=  i (min r 10)) )
          (display  (list($ m c i r)) )  ) 
   (newline) 
   (newline) (display iii)) )
   
   (time (main '(xx "500")))
   
)





      __________________________________________________________________
Yahoo! Canada Toolbar: Search from anywhere on the web, and bookmark your favourite sites. Download it now
http://ca.toolbar.yahoo.com.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20090702/223b0794/attachment.html>