diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index cbaf37daf8..a06a67e4a1 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -134,3 +134,6 @@ IN: math.functions.tests [ -4.0 ] [ -4.4 round ] unit-test [ 5.0 ] [ 4.5 round ] unit-test [ 4.0 ] [ 4.4 round ] unit-test + +[ 6 59967 ] [ 3837888 factor-2s ] unit-test +[ 6 -59967 ] [ -3837888 factor-2s ] unit-test diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 8516292e9d..0444998bec 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel math.constants math.private -math.libm combinators math.order ; +math.libm combinators math.order math.ratios sequences ; IN: math.functions r >r >r odd? r> call r> 2/ r> each-bit ] if ; inline recursive -: ^n ( z w -- z^w ) - 1 swap [ - [ dupd * ] when >r sq r> - ] each-bit nip ; inline +: map-bits ( n quot: ( ? -- obj ) -- seq ) + accumulator [ each-bit ] dip ; inline + +: factor-2s ( n -- r s ) + #! factor an integer into 2^r * s + dup 0 = [ 1 ] [ + 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while + ] if ; inline + +fraction ] dip tuck [ ^n ] 2bi@ / ; + +M: float ^n + (^n) ; : integer^ ( x y -- z ) dup 0 > [ ^n ] [ neg ^n recip ] if ; inline +PRIVATE> + : >rect ( z -- x y ) [ real-part ] [ imaginary-part ] bi ; inline @@ -52,6 +73,8 @@ M: real sqrt : polar> ( abs arg -- z ) cis * ; inline +r >r >float-rect swap r> swap fpow r> rot * fexp /f ; inline @@ -68,6 +91,8 @@ M: real sqrt : 0^ ( x -- z ) dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline +PRIVATE> + : ^ ( x y -- z ) { { [ over zero? ] [ nip 0^ ] } diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index 3045a35836..def8a04738 100755 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -11,13 +11,6 @@ IN: math.miller-rabin TUPLE: positive-even-expected n ; -: (factor-2s) ( r s -- r s ) - dup even? [ -1 shift [ 1+ ] dip (factor-2s) ] when ; - -: factor-2s ( n -- r s ) - #! factor an integer into s * 2^r - 0 swap (factor-2s) ; - :: (miller-rabin) ( n trials -- ? ) [let | r [ n 1- factor-2s drop ] s [ n 1- factor-2s nip ]