steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up spectral-norm

db4
Slava Pestov 2008-04-20 06:15:24 -05:00
parent e9b9172a8e
commit 8ce5760fcc
1 changed files with 23 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
extra/benchmark/spectral-norm/spectral-norm.factor
View File

@ -1,48 +1,44 @@
! Factor port of ! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: float-arrays kernel math math.functions math.vectors 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 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 ) : eval-A ( i j -- n )
[ >float ] bi@ [ >float ] bi@
dupd + dup 1+ * 2 /f fast-truncate + 1+ [ drop ] [ + [ ] [ 1 + ] bi * 0.5 * ] 2bi
recip ; inline + 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x ) : (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 ) : eval-A-times-u ( n u -- seq )
over [ [ (eval-A-times-u) ] inner-loop ; inline
pick 0.0 [
swap >r >r 2dup r> (eval-A-times-u) r> +
] reduce nip
] F{ } map-as 2nip ; inline
: (eval-At-times-u) ( u i j -- x ) : (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 ) : eval-At-times-u ( u n -- seq )
over [ [ (eval-At-times-u) ] inner-loop ; inline
pick 0.0 [
swap >r >r 2dup r> (eval-At-times-u) r> +
] reduce nip
] F{ } map-as 2nip ; inline
: eval-AtA-times-u ( n u -- seq ) : eval-AtA-times-u ( u n -- seq )
dupd eval-A-times-u eval-At-times-u ; inline [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
: u/v ( n -- u v ) :: u/v ( n -- u v )
dup 1.0 <float-array> dup n 1.0 <float-array> dup
10 [ 10 [
drop drop
dupd eval-AtA-times-u n eval-AtA-times-u
2dup eval-AtA-times-u [ n eval-AtA-times-u ] keep
swap ] times ; inline
] times
rot drop ; inline
: spectral-norm ( n -- norm ) : spectral-norm ( n -- norm )
u/v [ v. ] keep norm-sq /f sqrt ; u/v [ v. ] keep norm-sq /f sqrt ;
@ -50,6 +46,6 @@ IN: benchmark.spectral-norm
HINTS: spectral-norm fixnum ; HINTS: spectral-norm fixnum ;
: spectral-norm-main ( -- ) : spectral-norm-main ( -- )
2000 spectral-norm . ; 5500 spectral-norm . ;
MAIN: spectral-norm-main MAIN: spectral-norm-main