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
 | 
			
		||||
 | 
			
		||||
: (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! )
 | 
			
		||||
    dup 1 > [ [1,b] product ] [ drop 1 ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue