diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor index 482c0a92c0..7136982e1b 100644 --- a/basis/math/combinatorics/combinatorics.factor +++ b/basis/math/combinatorics/combinatorics.factor @@ -17,72 +17,6 @@ IN: math.combinatorics PRIVATE> -fixnum { - [ 2drop nip ] - [ 2nip swap nth-unsafe ] - [ -rot [ drop swap nth2-unsafe ] dip call ] - [ -rot [ drop swap nth3-unsafe ] dip bi@ ] - } dispatch - ] [ - [ 2/ ] [ over - ] bi [ 2dup + ] dip - [ (binary-reduce) ] [ 2curry ] curry 2bi@ - pick [ - [ 3curry ] bi-curry@ 3bi - [ call ] dip swap [ call ] dip - ] dip call - ] if ; inline recursive - -PRIVATE> - -: binary-reduce2 ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) -- ... value ) - pick length 0 max 0 swap (binary-reduce2) ; inline - -GENERIC: sum2 ( seq -- n ) -M: object sum2 0 [ + ] binary-reduce2 ; - -GENERIC: sum3 ( seq -- n ) -M: object sum3 0 [ + ] binary-reduce ; - -: product2 ( seq -- n ) - 0 swap 1 [ - dup even? [ 2/ * [ 1 + ] dip ] [ * ] if - ] binary-reduce2 swap shift ; - -TUPLE: factorials n length ; -: ( n -- factorials ) - dup dup odd? [ 1 + ] when 2/ factorials boa ; inline -M: factorials length length>> ; inline -M: factorials nth-unsafe - n>> swap [ - ] keep 1 + 2dup = [ drop ] [ * ] if ; inline -INSTANCE: factorials sequence - -: factorial-product ( n -- n! ) - dup 1 > [ [1,b] product2 ] [ drop 1 ] if ; - -: factorial1 ( n -- n! ) - dup 1 > [ - [ 0 1 ] dip [ dup 1 > ] [ - [ dup even? [ 2/ [ 1 + ] 2dip ] when * ] - [ 1 - ] bi - ] while drop swap shift - ] [ drop 1 ] if ; - -: factorial0 ( n -- n! ) - dup 1 > [ [1,b] product ] [ drop 1 ] if ; - -:: factorial2 ( n -- n! ) - n n n [ 2 - dup 1 > ] [ - [ + [ * ] keep ] keep - ] while nip 1 = [ n 1 + 2/ * ] when ; - -! http://www.luschny.de/math/factorial/scala/FactorialScalaCsharp.htm - MEMO: factorial ( n -- n! ) dup 1 > [ [1,b] product ] [ drop 1 ] if ; diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index 10245675f1..65606c9e46 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -350,9 +350,9 @@ ALIAS: std sample-std : cum-product ( seq -- seq' ) 1 [ * ] cum-map ; - + : cum-mean ( seq -- seq' ) - [ cum-sum ] [ length [1,b] ] bi v/ ; + [ cum-sum ] [ length [1,b] ] bi [ / ] 2map ; : cum-count ( seq quot -- seq' ) [ 0 ] dip '[ _ call [ 1 + ] when ] cum-map ; inline