Revert "math.statistics: change cum-mean to use v/."
This reverts commit 9df2235d8983da67d106a6d5fb297134e5e2a58e.db4
parent
b01b14c0e2
commit
0d806e0b69
|
@ -17,72 +17,6 @@ IN: math.combinatorics
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: (binary-reduce2) ( ... seq start quot: ( ... elt1 elt2 -- ... newelt ) from length -- ... value )
|
|
||||||
#! We can't use case here since combinators depends on
|
|
||||||
#! sequences
|
|
||||||
dup 4 < [
|
|
||||||
integer>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 ;
|
|
||||||
: <factorials> ( 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! )
|
MEMO: factorial ( n -- n! )
|
||||||
dup 1 > [ [1,b] product ] [ drop 1 ] if ;
|
dup 1 > [ [1,b] product ] [ drop 1 ] if ;
|
||||||
|
|
||||||
|
|
|
@ -350,9 +350,9 @@ ALIAS: std sample-std
|
||||||
|
|
||||||
: cum-product ( seq -- seq' )
|
: cum-product ( seq -- seq' )
|
||||||
1 [ * ] cum-map ;
|
1 [ * ] cum-map ;
|
||||||
|
|
||||||
: cum-mean ( seq -- seq' )
|
: cum-mean ( seq -- seq' )
|
||||||
[ cum-sum ] [ length [1,b] ] bi v/ ;
|
[ cum-sum ] [ length [1,b] ] bi [ / ] 2map ;
|
||||||
|
|
||||||
: cum-count ( seq quot -- seq' )
|
: cum-count ( seq quot -- seq' )
|
||||||
[ 0 ] dip '[ _ call [ 1 + ] when ] cum-map ; inline
|
[ 0 ] dip '[ _ call [ 1 + ] when ] cum-map ; inline
|
||||||
|
|
Loading…
Reference in New Issue