]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into new_ui
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 5 Mar 2009 19:59:55 +0000 (13:59 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 5 Mar 2009 19:59:55 +0000 (13:59 -0600)
basis/locals/errors/errors.factor
basis/locals/locals-tests.factor
basis/math/primes/factors/factors-tests.factor
basis/math/primes/factors/factors.factor
extra/math/continued-fractions/authors.txt [new file with mode: 0644]
extra/math/continued-fractions/continued-fractions-docs.factor [new file with mode: 0644]
extra/math/continued-fractions/continued-fractions-tests.factor [new file with mode: 0644]
extra/math/continued-fractions/continued-fractions.factor [new file with mode: 0644]
extra/math/continued-fractions/summary.txt [new file with mode: 0644]

index 95c8357939ce36395346d9f4c65a345b9c831ae2..d11405ddb5b0e9c7b34025ce02daea9419d19100 100644 (file)
@@ -37,4 +37,4 @@ M: bad-lambda-rewrite summary
 ERROR: bad-local args obj ;
 
 M: bad-local summary
-    drop "You have bound a bug in locals. Please report." ;
+    drop "You have found a bug in locals. Please report." ;
index bd9e7cf1030f097fcd5cd7254faa60abc917fa98..08c667447c1614e43e2ae95511fa07d3bfa63757 100644 (file)
@@ -500,4 +500,11 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test
 
-[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test
\ No newline at end of file
+[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test
+
+! erg found this problem
+:: erg's-:>-bug ( n ? -- n ) [ n :> n n ] [ n :> b b ] if ;
+
+[ 3 ] [ 3 f erg's-:>-bug ] unit-test
+    
+[ 3 ] [ 3 t erg's-:>-bug ] unit-test
\ No newline at end of file
index 983de512169c40b244ba9a057c68bacbfdc40d7e..8e2e10711a3766e80034f9e895b2c061b12acab8 100644 (file)
@@ -7,3 +7,4 @@ USING: math.primes.factors tools.test ;
 { 999967000236000612 } [ 999969000187000867 totient ] unit-test
 { 0 } [ 1 totient ] unit-test
 { { 425612003 } } [ 425612003 factors ] unit-test
+{ { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test
index beab0ac5a664c9aa40a63e9889768cc1afb996f9..199b72b7e146143f510a6752b4e8488db830b820 100644 (file)
@@ -10,21 +10,30 @@ IN: math.primes.factors
     [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] while drop
     swap ;
 
-: write-factor ( n d -- n' d )
-    2dup mod zero? [ [ [ count-factor ] keep swap 2array , ] keep ] when ;
-
-PRIVATE>
-
-: group-factors ( n -- seq )
+: write-factor ( n d -- n' d' )
+    2dup mod zero? [
+        [ [ count-factor ] keep swap 2array , ] keep
+        ! If the remainder is a prime number, increase d so that
+        ! the caller stops looking for factors.
+        over prime? [ drop dup ] when
+    ] when ;
+
+: (group-factors) ( n -- seq )
     [
         2
         [ 2dup sq < ] [ write-factor next-prime ] until
         drop dup 2 < [ drop ] [ 1 2array , ] if
     ] { } make ;
 
-: unique-factors ( n -- seq ) group-factors [ first ] map ;
+PRIVATE>
+
+: group-factors ( n -- seq )
+    dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
+
+: unique-factors ( n -- seq ) group-factors [ first ] map ; flushable
 
-: factors ( n -- seq ) group-factors [ first2 swap <array> ] map concat ;
+: factors ( n -- seq )
+    group-factors [ first2 swap <array> ] map concat ; flushable
 
 : totient ( n -- t )
     {
diff --git a/extra/math/continued-fractions/authors.txt b/extra/math/continued-fractions/authors.txt
new file mode 100644 (file)
index 0000000..f3b0233
--- /dev/null
@@ -0,0 +1 @@
+Samuel Tardieu
diff --git a/extra/math/continued-fractions/continued-fractions-docs.factor b/extra/math/continued-fractions/continued-fractions-docs.factor
new file mode 100644 (file)
index 0000000..667deb7
--- /dev/null
@@ -0,0 +1,14 @@
+USING: help.markup help.syntax ;
+IN: math.continued-fractions
+
+HELP: approx
+{ $values { "epsilon" "a positive floating point number representing the absolute acceptable error" } { "float" "a positive floating point number to approximate" } { "a/b" "a fractional number containing the approximation" } }
+{ $description "Give a rational approximation of " { $snippet "float" } " with a precision of " { $snippet "epsilon" } " using the smallest possible denominator." } ;
+
+HELP: >ratio
+{ $values { "seq" "a sequence representing a continued fraction" } { "a/b" "a fractional number" } }
+{ $description "Transform " { $snippet "seq" } " into its rational representation." } ;
+
+HELP: next-approx
+{ $values { "seq" "a mutable sequence" } }
+{ $description "Compute the next step in continued fraction calculation." } ;
diff --git a/extra/math/continued-fractions/continued-fractions-tests.factor b/extra/math/continued-fractions/continued-fractions-tests.factor
new file mode 100644 (file)
index 0000000..d8fac0b
--- /dev/null
@@ -0,0 +1,21 @@
+USING: kernel math.constants math.continued-fractions tools.test ;
+
+[ V{ 2 2.0 } ] [ V{ 2.5 } dup next-approx ] unit-test
+[ V{ 2 2 } ] [ V{ 2.5 } dup next-approx dup next-approx ] unit-test
+
+[ 5/2 ] [ V{ 2 2.1 } >ratio ] unit-test
+[ 5/2 ] [ V{ 2 1.9 } >ratio ] unit-test
+[ 5/2 ] [ V{ 2 2.0 } >ratio ] unit-test
+[ 5/2 ] [ V{ 2 2 } >ratio ] unit-test
+
+[ 3 ] [ 1 pi approx ] unit-test
+[ 22/7 ] [ 0.1 pi approx ] unit-test
+[ 355/113 ] [ 0.00001 pi approx ] unit-test
+
+[ 2 ] [ 1 2 approx ] unit-test
+[ 2 ] [ 0.1 2 approx ] unit-test
+[ 2 ] [ 0.00001 2 approx ] unit-test
+
+[ 3 ] [ 1 2.5 approx ] unit-test
+[ 5/2 ] [ 0.1 2.5 approx ] unit-test
+[ 5/2 ] [ 0.0001 2.5 approx ] unit-test
diff --git a/extra/math/continued-fractions/continued-fractions.factor b/extra/math/continued-fractions/continued-fractions.factor
new file mode 100644 (file)
index 0000000..26454a3
--- /dev/null
@@ -0,0 +1,24 @@
+! Copyright (C) 2009 Samuel Tardieu.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.functions sequences vectors ;
+IN: math.continued-fractions
+
+<PRIVATE
+
+: split-float ( f -- d i ) dup >integer [ - ] keep ;
+
+: closest ( seq -- newseq ) unclip-last round >integer suffix ;
+
+PRIVATE>
+
+: next-approx ( seq -- )
+    dup [ pop split-float ] [ push ] bi
+    dup zero? [ 2drop ] [ recip swap push ] if ;
+
+: >ratio ( seq -- a/b )
+    closest reverse unclip-slice [ swap recip + ] reduce ;
+
+: approx ( epsilon float -- a/b )
+    dup 1vector
+    [ 3dup >ratio - abs < ] [ dup next-approx ] while
+    2nip >ratio ;
diff --git a/extra/math/continued-fractions/summary.txt b/extra/math/continued-fractions/summary.txt
new file mode 100644 (file)
index 0000000..e8b2f66
--- /dev/null
@@ -0,0 +1 @@
+Continued fractions