steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://projects.elasticdog.com/git/factor

db4
Slava Pestov 2008-01-29 20:51:07 -06:00
parent 0cd2f857fe f86f36794f
commit 258a27432f
13 changed files with 358 additions and 36 deletions

1
extra/math/combinatorics/authors.txt
View File

@ -1,2 +1,3 @@
Slava Pestov
Doug Coleman
Aaron Schaefer

49
extra/math/combinatorics/combinatorics-docs.factor Normal file
View File

@ -0,0 +1,49 @@
USING: help.markup help.syntax kernel math sequences ;
IN: math.combinatorics
HELP: factorial
{ $values { "n" "a non-negative integer" } { "n!" integer } }
{ $description "Outputs the product of all positive integers less than or equal to " { $snippet "n" } "." }
{ $examples { $example "4 factorial ." "24" } } ;
HELP: nPk
{ $values { "n" "a non-negative integer" } { "k" "a non-negative integer" } { "nPk" integer } }
{ $description "Outputs the total number of unique permutations of size " { $snippet "k" } " (order does matter) that can be taken from a set of size " { $snippet "n" } "." }
{ $examples { $example "10 4 nPk ." "5040" } } ;
HELP: nCk
{ $values { "n" "a non-negative integer" } { "k" "a non-negative integer" } { "nCk" integer } }
{ $description "Outputs the total number of unique combinations of size " { $snippet "k" } " (order does not matter) that can be taken from a set of size " { $snippet "n" } ". Commonly written as \"n choose k\"." }
{ $examples { $example "10 4 nCk ." "210" } } ;
HELP: permutation
{ $values { "n" "a non-negative integer" } { "seq" sequence } { "seq" sequence } }
{ $description "Outputs the " { $snippet "nth" } " lexicographical permutation of " { $snippet "seq" } "." }
{ $notes "Permutations are 0-based and a bounds error will be thrown if " { $snippet "n" } " is larger than " { $snippet "seq length factorial 1-" } "." }
{ $examples { $example "1 3 permutation ." "{ 0 2 1 }" } { $example "5 { \"apple\" \"banana\" \"orange\" } permutation ." "{ \"orange\" \"banana\" \"apple\"}" } } ;
HELP: all-permutations
{ $values { "seq" sequence } { "seq" sequence } }
{ $description "Outputs a sequence containing all permutations of " { $snippet "seq" } " in lexicographical order." }
{ $examples { $example "3 all-permutations ." "{ { 0 1 2 } { 0 2 1 } { 1 0 2 } { 1 2 0 } { 2 0 1 } { 2 1 0 } }" } } ;
HELP: inverse-permutation
{ $values { "seq" sequence } { "permutation" sequence } }
{ $description "Outputs a sequence of indices representing the lexicographical permutation of " { $snippet "seq" } "." }
{ $notes "All items in " { $snippet "seq" } " must be comparable by " { $link <=> } "." }
{ $examples { $example "\"dcba\" inverse-permutation ." "{ 3 2 1 0 }" } { $example "{ 12 56 34 78 } inverse-permutation ." "{ 0 2 1 3 }" } } ;
IN: math.combinatorics.private
HELP: factoradic
{ $values { "n" integer } { "seq" sequence } }
{ $description "Converts a positive integer " { $snippet "n" } " to factoradic form. The factoradic of an integer is its representation based on a mixed radix numerical system that corresponds to the values of " { $snippet "n" } " factorial." }
{ $examples { $example "859 factoradic ." "{ 1 1 0 3 0 1 0 }" } } ;
HELP: >permutation
{ $values { "factoradic" sequence } { "permutation" sequence } }
{ $description "Converts an integer represented in factoradic form into its corresponding unique permutation (0-based)." }
{ $notes "For clarification, the following two statements are equivalent:" { $code "10 factoradic >permutation" "{ 1 2 0 0 } >permutation" } }
{ $examples { $example "{ 0 0 0 0 } >permutation ." "{ 0 1 2 3 }" } } ;

50
extra/math/combinatorics/combinatorics-tests.factor Normal file
View File

@ -0,0 +1,50 @@
USING: math.combinatorics math.combinatorics.private tools.test ;
IN: temporary
[ { } ] [ 0 factoradic ] unit-test
[ { 1 0 } ] [ 1 factoradic ] unit-test
[ { 1 1 0 3 0 1 0 } ] [ 859 factoradic ] unit-test
[ { 0 1 2 3 } ] [ { 0 0 0 0 } >permutation ] unit-test
[ { 0 1 3 2 } ] [ { 0 0 1 0 } >permutation ] unit-test
[ { 1 2 0 6 3 5 4 } ] [ { 1 1 0 3 0 1 0 } >permutation ] unit-test
[ { 0 1 2 3 } ] [ 0 4 permutation-indices ] unit-test
[ { 0 1 3 2 } ] [ 1 4 permutation-indices ] unit-test
[ { 1 2 0 6 3 5 4 } ] [ 859 7 permutation-indices ] unit-test
[ { "b" "d" } ] [ { "a" "b" "c" "d" } { 1 3 } reorder ] unit-test
[ { "a" "b" "c" "d" } ] [ { "a" "b" "c" "d" } { 0 1 2 3 } reorder ] unit-test
[ { "d" "c" "b" "a" } ] [ { "a" "b" "c" "d" } { 3 2 1 0 } reorder ] unit-test
[ { "d" "a" "b" "c" } ] [ { "a" "b" "c" "d" } { 3 0 1 2 } reorder ] unit-test
[ 1 ] [ 0 factorial ] unit-test
[ 1 ] [ 1 factorial ] unit-test
[ 3628800 ] [ 10 factorial ] unit-test
[ 1 ] [ 3 0 nPk ] unit-test
[ 6 ] [ 3 2 nPk ] unit-test
[ 6 ] [ 3 3 nPk ] unit-test
[ 0 ] [ 3 4 nPk ] unit-test
[ 311875200 ] [ 52 5 nPk ] unit-test
[ 672151459757865654763838640470031391460745878674027315200000000000 ] [ 52 47 nPk ] unit-test
[ 1 ] [ 3 0 nCk ] unit-test
[ 3 ] [ 3 2 nCk ] unit-test
[ 1 ] [ 3 3 nCk ] unit-test
[ 0 ] [ 3 4 nCk ] unit-test
[ 2598960 ] [ 52 5 nCk ] unit-test
[ 2598960 ] [ 52 47 nCk ] unit-test
[ { "a" "b" "c" "d" } ] [ 0 { "a" "b" "c" "d" } permutation ] unit-test
[ { "d" "c" "b" "a" } ] [ 23 { "a" "b" "c" "d" } permutation ] unit-test
[ { "d" "a" "b" "c" } ] [ 18 { "a" "b" "c" "d" } permutation ] unit-test
[ { { "a" "b" "c" } { "a" "c" "b" }
{ "b" "a" "c" } { "b" "c" "a" }
{ "c" "a" "b" } { "c" "b" "a" } } ] [ { "a" "b" "c" } all-permutations ] unit-test
[ { 0 1 2 } ] [ { "a" "b" "c" } inverse-permutation ] unit-test
[ { 2 1 0 } ] [ { "c" "b" "a" } inverse-permutation ] unit-test
[ { 3 0 2 1 } ] [ { 12 45 34 2 } inverse-permutation ] unit-test

54
extra/math/combinatorics/combinatorics.factor
View File

@ -1,21 +1,53 @@
USING: kernel math math.ranges math.vectors
sequences sorting mirrors assocs ;
! Copyright (c) 2007, 2008 Slava Pestov, Doug Coleman, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math math.ranges mirrors namespaces sequences sorting ;
IN: math.combinatorics
: possible? 0 rot between? ; inline
<PRIVATE
: nPk ( n k -- n!/k! )
2dup possible? [ [a,b) product ] [ 2drop 0 ] if ;
: possible? ( n m -- ? )
0 rot between? ; inline
: factorial ( n -- n! ) 1 nPk ;
: twiddle ( n k -- n k )
2dup - dupd > [ dupd - ] when ; inline
: (nCk) ( n k -- nCk )
[ nPk ] 2keep - factorial / ;
! See this article for explanation of the factoradic-based permutation methodology:
! http://msdn2.microsoft.com/en-us/library/aa302371.aspx
: twiddle 2dup - dupd < [ dupd - ] when ; inline
: factoradic ( n -- factoradic )
0 [ over 0 > ] [ 1+ [ /mod ] keep swap ] [ ] unfold reverse 2nip ;
: (>permutation) ( seq n -- seq )
[ [ dupd >= [ 1+ ] when ] curry map ] keep add* ;
: >permutation ( factoradic -- permutation )
reverse 1 cut [ (>permutation) ] each ;
: permutation-indices ( n seq -- permutation )
length [ factoradic ] dip 0 pad-left >permutation ;
: reorder ( seq indices -- seq )
[ [ over nth , ] each drop ] { } make ;
PRIVATE>
: factorial ( n -- n! )
1 [ 1+ * ] reduce ;
: nPk ( n k -- nPk )
2dup possible? [ dupd - [a,b) product ] [ 2drop 0 ] if ;
: nCk ( n k -- nCk )
2dup possible? [ twiddle (nCk) ] [ 2drop 0 ] if ;
twiddle [ nPk ] keep factorial / ;
: inverse-permutation ( seq -- seq )
: permutation ( n seq -- seq )
tuck permutation-indices reorder ;
: all-permutations ( seq -- seq )
[
[ length factorial ] keep [ permutation , ] curry each
] { } make ;
: inverse-permutation ( seq -- permutation )
<enum> >alist sort-values keys ;

2
extra/math/constants/constants.factor
View File

@ -4,6 +4,6 @@ IN: math.constants
: e ( -- e ) 2.7182818284590452354 ; inline
: gamma ( -- gamma ) 0.57721566490153286060 ; inline
: pi ( -- pi ) 3.14159265358979323846 ; inline
: phi ( -- phi ) 1.61803398874989484820 ; inline
: pi ( -- pi ) 3.14159265358979323846 ; inline
: epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline

19
extra/project-euler/024/024.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.parser math.ranges namespaces sequences ;
USING: kernel math.combinatorics math.parser ;
IN: project-euler.024
! http://projecteuler.net/index.php?section=problems&id=24
@ -22,23 +22,6 @@ IN: project-euler.024
! SOLUTION
! --------
<PRIVATE
: (>permutation) ( seq n -- seq )
[ [ dupd >= [ 1+ ] when ] curry map ] keep add* ;
PRIVATE>
: >permutation ( factoradic -- permutation )
reverse 1 cut [ (>permutation) ] each ;
: factoradic ( k order -- factoradic )
[ [1,b] [ 2dup mod , /i ] each ] { } make reverse nip ;
: permutation ( k seq -- seq )
dup length swapd factoradic >permutation
[ [ dupd swap nth , ] each drop ] { } make ;
: euler024 ( -- answer )
999999 10 permutation 10 swap digits>integer ;

2
extra/project-euler/032/032.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib hashtables kernel math math.combinatorics math.parser
math.ranges project-euler.common project-euler.024 sequences sorting ;
math.ranges project-euler.common sequences sorting ;
IN: project-euler.032
! http://projecteuler.net/index.php?section=problems&id=32

55
extra/project-euler/033/033.factor Normal file
View File

@ -0,0 +1,55 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.ranges project-euler.common sequences ;
IN: project-euler.033
! http://projecteuler.net/index.php?section=problems&id=33
! DESCRIPTION
! -----------
! The fraction 49/98 is a curious fraction, as an inexperienced mathematician
! in attempting to simplify it may incorrectly believe that 49/98 = 4/8, which
! is correct, is obtained by cancelling the 9s.
! We shall consider fractions like, 30/50 = 3/5, to be trivial examples.
! There are exactly four non-trivial examples of this type of fraction, less
! than one in value, and containing two digits in the numerator and
! denominator.
! If the product of these four fractions is given in its lowest common terms,
! find the value of the denominator.
! SOLUTION
! --------
! Through analysis, you only need to check fractions fitting the pattern ax/xb
<PRIVATE
: source-033 ( -- seq )
10 99 [a,b] dup cartesian-product [ first2 < ] subset ;
: safe? ( ax xb -- ? )
[ 10 /mod ] 2apply -roll = rot zero? not and nip ;
: ax/xb ( ax xb -- z/f )
2dup safe? [ [ 10 /mod ] 2apply 2nip / ] [ 2drop f ] if ;
: curious? ( m n -- ? )
2dup / [ ax/xb ] dip = ;
: curious-fractions ( seq -- seq )
[ first2 curious? ] subset [ first2 / ] map ;
PRIVATE>
: euler033 ( -- answer )
source-033 curious-fractions product denominator ;
! [ euler033 ] 100 ave-time
! 5 ms run / 0 ms GC ave time - 100 trials
MAIN: euler033

47
extra/project-euler/034/034.factor Normal file
View File

@ -0,0 +1,47 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math.ranges project-euler.common sequences ;
IN: project-euler.034
! http://projecteuler.net/index.php?section=problems&id=34
! DESCRIPTION
! -----------
! 145 is a curious number, as 1! + 4! + 5! = 1 + 24 + 120 = 145.
! Find the sum of all numbers which are equal to the sum of the factorial of
! their digits.
! Note: as 1! = 1 and 2! = 2 are not sums they are not included.
! SOLUTION
! --------
! We can reduce the upper bound a little by calculating 7 * 9! = 2540160, and
! then reducing one of the 9! to 2! (since the 7th digit cannot exceed 2), so we
! get 2! + 6 * 9! = 2177282 as an upper bound.
! We can then take that one more step, and notice that the largest factorial
! sum a 7 digit number starting with 21 or 20 is 2! + 1! + 5 * 9! or 1814403.
! So there can't be any 7 digit solutions starting with 21 or 20, and therefore
! our numbers must be less that 2000000.
<PRIVATE
: digit-factorial ( n -- n! )
{ 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
: factorion? ( n -- ? )
dup number>digits [ digit-factorial ] sigma = ;
PRIVATE>
: euler034 ( -- answer )
3 2000000 [a,b] [ factorion? ] subset sum ;
! [ euler034 ] 10 ave-time
! 15089 ms run / 725 ms GC ave time - 10 trials
MAIN: euler034

61
extra/project-euler/035/035.factor Normal file
View File

@ -0,0 +1,61 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.combinatorics math.parser math.primes
project-euler.common sequences ;
IN: project-euler.035
! http://projecteuler.net/index.php?section=problems&id=35
! DESCRIPTION
! -----------
! The number, 197, is called a circular prime because all rotations of the
! digits: 197, 971, and 719, are themselves prime.
! There are thirteen such primes below 100:
! 2, 3, 5, 7, 11, 13, 17, 31, 37, 71, 73, 79, and 97.
! How many circular primes are there below one million?
! SOLUTION
! --------
<PRIVATE
: source-035 ( -- seq )
1000000 primes-upto [ number>digits ] map ;
: possible? ( seq -- ? )
dup length 1 > [
dup { 0 2 4 5 6 8 } swap seq-diff =
] [
drop t
] if ;
: rotate ( seq n -- seq )
cut* swap append ;
: (circular?) ( seq n -- ? )
dup 0 > [
2dup rotate 10 swap digits>integer
prime? [ 1- (circular?) ] [ 2drop f ] if
] [
2drop t
] if ;
: circular? ( seq -- ? )
dup length 1- (circular?) ;
PRIVATE>
: euler035 ( -- answer )
source-035 [ possible? ] subset [ circular? ] count ;
! [ euler035 ] 100 ave-time
! 904 ms run / 86 ms GC ave time - 100 trials
! TODO: try using bit arrays or other methods outlined here:
! http://home.comcast.net/~babdulbaki/Circular_Primes.html
MAIN: euler035

42
extra/project-euler/036/036.factor Normal file
View File

@ -0,0 +1,42 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math.parser math.ranges sequences ;
IN: project-euler.036
! http://projecteuler.net/index.php?section=problems&id=36
! DESCRIPTION
! -----------
! The decimal number, 585 = 1001001001 (binary), is palindromic in both bases.
! Find the sum of all numbers, less than one million, which are palindromic in
! base 10 and base 2.
! (Please note that the palindromic number, in either base, may not include
! leading zeros.)
! SOLUTION
! --------
! Only check odd numbers since the binary number must begin and end with 1
<PRIVATE
: palindrome? ( str -- ? )
dup reverse = ;
: both-bases? ( n -- ? )
{ [ dup number>string palindrome? ]
[ dup >bin palindrome? ] } && nip ;
PRIVATE>
: euler036 ( -- answer )
1 1000000 2 <range> [ both-bases? ] subset sum ;
! [ euler036 ] 100 ave-time
! 3891 ms run / 173 ms GC ave time - 100 trials
MAIN: euler036

4
extra/project-euler/common/common.factor
View File

@ -7,11 +7,11 @@ IN: project-euler.common
! Problems using each public word
! -------------------------------
! cartesian-product - #4, #27
! cartesian-product - #4, #27, #29, #32, #33
! collect-consecutive - #8, #11
! log10 - #25, #134
! max-path - #18, #67
! number>digits - #16, #20, #30
! number>digits - #16, #20, #30, #34
! propagate-all - #18, #67
! sum-proper-divisors - #21
! tau* - #12

8
extra/project-euler/project-euler.factor
View File

@ -1,4 +1,4 @@
! Copyright (c) 2007 Aaron Schaefer.
! Copyright (c) 2007, 2008 Aaron Schaefer, Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: definitions io io.files kernel math.parser sequences vocabs
vocabs.loader project-euler.ave-time project-euler.common math
@ -9,8 +9,10 @@ USING: definitions io io.files kernel math.parser sequences vocabs
project-euler.017 project-euler.018 project-euler.019 project-euler.020
project-euler.021 project-euler.022 project-euler.023 project-euler.024
project-euler.025 project-euler.026 project-euler.027 project-euler.028
project-euler.029 project-euler.030 project-euler.067 project-euler.134
project-euler.169 project-euler.173 project-euler.175 ;
project-euler.029 project-euler.030 project-euler.031 project-euler.032
project-euler.033 project-euler.034 project-euler.035 project-euler.036
project-euler.067 project-euler.134 project-euler.169 project-euler.173
project-euler.175 ;
IN: project-euler
<PRIVATE