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

Move map-reduce combinator to core, re-implement norm-sq and v. for better performance

db4
Slava Pestov 2008-09-12 11:29:12 -05:00
parent 45425fccd7
commit f497c7e151
5 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/math/vectors/vectors-tests.factor
View File

@ -5,3 +5,7 @@ USING: math.vectors tools.test ;
[ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
[ { 1 2 3 } ] [ { 2 4 6 } 2 v/n ] unit-test
[ { 1/1 1/2 1/3 } ] [ 1 { 1 2 3 } n/v ] unit-test
[ 4 ] [ { 1 2 } norm-sq ] unit-test
[ 36 ] [ { 2 3 } norm-sq ] unit-test

6
basis/math/vectors/vectors.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel sequences math math.functions hints
math.order ;
@ -19,8 +19,8 @@ IN: math.vectors
: vmax ( u v -- w ) [ max ] 2map ;
: vmin ( u v -- w ) [ min ] 2map ;
: v. ( u v -- x ) 0 [ * + ] 2reduce ;
: norm-sq ( v -- x ) 0 [ absq + ] reduce ;
: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
: norm ( v -- x ) norm-sq sqrt ;
: normalize ( u -- v ) dup norm v/n ;

11
core/sequences/sequences.factor
View File

@ -747,6 +747,17 @@ PRIVATE>
: unclip-slice ( seq -- rest first )
[ rest-slice ] [ first ] bi ; inline
: map-reduce ( seq map-quot reduce-quot -- result )
[ [ unclip-slice ] dip [ call ] keep ] dip
compose reduce ; inline
: 2map-reduce ( seq1 seq2 map-quot reduce-quot -- result )
[ [ 2unclip-slice ] dip [ call ] keep ] dip
compose 2reduce ; inline
: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
[ unclip-slice ] bi@ swapd ; inline
: unclip-last-slice ( seq -- butlast last )
[ but-last-slice ] [ peek ] bi ; inline

3
extra/sequences/lib/lib-tests.factor
View File

@ -10,9 +10,6 @@ IN: sequences.lib.tests
{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
[ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test
[ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test

3
extra/sequences/lib/lib.factor
View File

@ -31,9 +31,6 @@ IN: sequences.lib
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: map-reduce ( seq map-quot reduce-quot -- result )
>r [ unclip ] dip [ call ] keep r> compose reduce ; inline
: reduce* ( seq quot -- result ) [ ] swap map-reduce ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!