From 8ce5760fcc97cf49d182f190bed5de33ef8fa60b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 20 Apr 2008 06:15:24 -0500
Subject: [PATCH] Clean up spectral-norm
---
.../spectral-norm/spectral-norm.factor | 50 +++++++++----------
1 file changed, 23 insertions(+), 27 deletions(-)
diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor
index 7eddeefc1b..5d36aa25bd 100644
--- a/extra/benchmark/spectral-norm/spectral-norm.factor
+++ b/extra/benchmark/spectral-norm/spectral-norm.factor
@@ -1,48 +1,44 @@
! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: float-arrays kernel math math.functions math.vectors
-sequences sequences.private prettyprint words tools.time hints ;
+sequences sequences.private prettyprint words
+hints locals ;
IN: benchmark.spectral-norm
-: fast-truncate >fixnum >float ; inline
+:: inner-loop ( u n quot -- seq )
+ n [| i |
+ n 0.0 [| j |
+ u i j quot call +
+ ] reduce
+ ] F{ } map-as ; inline
: eval-A ( i j -- n )
[ >float ] bi@
- dupd + dup 1+ * 2 /f fast-truncate + 1+
- recip ; inline
+ [ drop ] [ + [ ] [ 1 + ] bi * 0.5 * ] 2bi
+ + 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x )
- tuck eval-A >r swap nth-unsafe r> * ; inline
+ tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline
: eval-A-times-u ( n u -- seq )
- over [
- pick 0.0 [
- swap >r >r 2dup r> (eval-A-times-u) r> +
- ] reduce nip
- ] F{ } map-as 2nip ; inline
+ [ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x )
- tuck swap eval-A >r swap nth-unsafe r> * ; inline
+ tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline
-: eval-At-times-u ( n u -- seq )
- over [
- pick 0.0 [
- swap >r >r 2dup r> (eval-At-times-u) r> +
- ] reduce nip
- ] F{ } map-as 2nip ; inline
+: eval-At-times-u ( u n -- seq )
+ [ (eval-At-times-u) ] inner-loop ; inline
-: eval-AtA-times-u ( n u -- seq )
- dupd eval-A-times-u eval-At-times-u ; inline
+: eval-AtA-times-u ( u n -- seq )
+ [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
-: u/v ( n -- u v )
- dup 1.0 <float-array> dup
+:: u/v ( n -- u v )
+ n 1.0 <float-array> dup
10 [
drop
- dupd eval-AtA-times-u
- 2dup eval-AtA-times-u
- swap
- ] times
- rot drop ; inline
+ n eval-AtA-times-u
+ [ n eval-AtA-times-u ] keep
+ ] times ; inline
: spectral-norm ( n -- norm )
u/v [ v. ] keep norm-sq /f sqrt ;
@@ -50,6 +46,6 @@ IN: benchmark.spectral-norm
HINTS: spectral-norm fixnum ;
: spectral-norm-main ( -- )
- 2000 spectral-norm . ;
+ 5500 spectral-norm . ;
MAIN: spectral-norm-main