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 dup +:: u/v ( n -- u v ) + n 1.0 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