math.extras: adding map-kahan-sum.

2013-10-13 08:40:50 -07:00 · 2013-10-13 08:40:50 -07:00 · d06dc0996d
parent b9df0a7582
commit d06dc0996d
1 changed files with 12 additions and 3 deletions
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@ -290,7 +290,16 @@ M: real round-away-from-zero
        ] reduce nip max
    ] if ; inline

+<PRIVATE
+
+: kahan+ ( c n elt -- c' n' )
+    rot - 2dup + [ -rot [ - ] bi@ ] keep ;
+
+PRIVATE>
+
 : kahan-sum ( seq -- n )
-    [ 0.0 0.0 ] dip [
-        rot - 2dup + [ -rot [ - ] bi@ ] keep
-    ] each nip ;
+    [ 0.0 0.0 ] dip [ kahan+ ] each nip ;
+
+: map-kahan-sum ( ... seq quot: ( ... elt -- ... n ) -- ... n )
+    [ 0.0 0.0 ] 2dip [ 2dip rot kahan+ ] curry
+    [ -rot ] prepose each nip ; inline