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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-02-07 18:56:00 -06:00
parent 3883dca17e ba467a39c4
commit 3a3f57b188
16 changed files with 501 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/project-euler/012/012.factor
View File

@ -33,9 +33,6 @@ IN: project-euler.012
! SOLUTION
! --------
: nth-triangle ( n -- n )
dup 1+ * 2 / ;
: euler012 ( -- answer )
8 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;

11
extra/project-euler/022/022.factor
View File

@ -1,7 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel math math.parser namespaces sequences sorting splitting
strings system vocabs ascii ;
USING: ascii io.files kernel math project-euler.common sequences sorting splitting ;
IN: project-euler.022
! http://projecteuler.net/index.php?section=problems&id=22
@ -31,9 +30,6 @@ IN: project-euler.022
"extra/project-euler/022/names.txt" resource-path
file-contents [ quotable? ] subset "," split ;
: alpha-value ( str -- n )
[ string>digits sum ] keep length 9 * - ;
: name-scores ( seq -- seq )
dup length [ 1+ swap alpha-value * ] 2map ;
@ -43,9 +39,6 @@ PRIVATE>
source-022 natural-sort name-scores sum ;
! [ euler022 ] 100 ave-time
! 59 ms run / 1 ms GC ave time - 100 trials
! source-022 [ natural-sort name-scores sum ] curry 100 ave-time
! 45 ms run / 1 ms GC ave time - 100 trials
! 123 ms run / 4 ms GC ave time - 100 trials
MAIN: euler022

8
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 sequences ;
USING: combinators.lib hashtables kernel math math.combinatorics math.functions
math.parser math.ranges project-euler.common sequences ;
IN: project-euler.032
! http://projecteuler.net/index.php?section=problems&id=32
@ -41,7 +41,7 @@ IN: project-euler.032
dup 1and4 swap 2and3 or ;
: products ( seq -- m )
[ number>string 4 tail* string>number ] map ;
[ 10 4 ^ mod ] map ;
PRIVATE>
@ -49,7 +49,7 @@ PRIVATE>
source-032 [ valid? ] subset products prune sum ;
! [ euler032 ] 10 ave-time
! 27609 ms run / 2484 ms GC ave time - 10 trials
! 23922 ms run / 1505 ms GC ave time - 10 trials
! ALTERNATE SOLUTIONS

40
extra/project-euler/041/041.factor Normal file
View File

@ -0,0 +1,40 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.combinatorics math.parser math.primes sequences ;
IN: project-euler.041
! http://projecteuler.net/index.php?section=problems&id=41
! DESCRIPTION
! -----------
! We shall say that an n-digit number is pandigital if it makes use of all the
! digits 1 to n exactly once. For example, 2143 is a 4-digit pandigital and is
! also prime.
! What is the largest n-digit pandigital prime that exists?
! SOLUTION
! --------
! Check 7-digit pandigitals because if the sum of the digits in any number add
! up to a multiple of three, then it is a multiple of three and can't be prime.
! I assumed there would be a 7-digit answer, but technically a higher 4-digit
! pandigital than the one given in the description was also possible.
! 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 = 45
! 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 = 36
! 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28 *** not divisible by 3 ***
! 1 + 2 + 3 + 4 + 5 + 6 = 21
! 1 + 2 + 3 + 4 + 5 = 15
! 1 + 2 + 3 + 4 = 10 *** not divisible by 3 ***
: euler041 ( -- answer )
{ 7 6 5 4 3 2 1 } all-permutations
[ 10 swap digits>integer ] map [ prime? ] find nip ;
! [ euler041 ] 100 ave-time
! 107 ms run / 7 ms GC ave time - 100 trials
MAIN: euler041

74
extra/project-euler/042/042.factor Normal file
View File

@ -0,0 +1,74 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: ascii combinators.lib io.files kernel math math.functions namespaces
project-euler.common sequences splitting ;
IN: project-euler.042
! http://projecteuler.net/index.php?section=problems&id=42
! DESCRIPTION
! -----------
! The nth term of the sequence of triangle numbers is given by,
! tn = n * (n + 1) / 2; so the first ten triangle numbers are:
! 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
! By converting each letter in a word to a number corresponding to its
! alphabetical position and adding these values we form a word value. For
! example, the word value for SKY is 19 + 11 + 25 = 55 = t10. If the word value
! is a triangle number then we shall call the word a triangle word.
! Using words.txt (right click and 'Save Link/Target As...'), a 16K text file
! containing nearly two-thousand common English words, how many are triangle
! words?
! SOLUTION
! --------
<PRIVATE
: source-042 ( -- seq )
"extra/project-euler/042/words.txt" resource-path
file-contents [ quotable? ] subset "," split ;
: (triangle-upto) ( limit n -- )
2dup nth-triangle > [
dup nth-triangle , 1+ (triangle-upto)
] [
2drop
] if ;
: triangle-upto ( n -- seq )
[ 1 (triangle-upto) ] { } make ;
PRIVATE>
: euler042 ( -- answer )
source-042 [ alpha-value ] map dup supremum
triangle-upto [ member? ] curry count ;
! [ euler042 ] 100 ave-time
! 27 ms run / 1 ms GC ave time - 100 trials
! ALTERNATE SOLUTIONS
! -------------------
! Use the inverse function of n * (n + 1) / 2 and test if the result is an integer
<PRIVATE
: triangle? ( n -- ? )
8 * 1+ sqrt 1- 2 / 1 mod zero? ;
PRIVATE>
: euler042a ( -- answer )
source-042 [ alpha-value ] map [ triangle? ] count ;
! [ euler042a ] 100 ave-time
! 25 ms run / 1 ms GC ave time - 100 trials
MAIN: euler042a

1
extra/project-euler/042/words.txt Normal file
View File

File diff suppressed because one or more lines are too long

97
extra/project-euler/043/043.factor Normal file
View File

@ -0,0 +1,97 @@
! 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 sequences sorting ;
IN: project-euler.043
! http://projecteuler.net/index.php?section=problems&id=43
! DESCRIPTION
! -----------
! The number, 1406357289, is a 0 to 9 pandigital number because it is made up
! of each of the digits 0 to 9 in some order, but it also has a rather
! interesting sub-string divisibility property.
! Let d1 be the 1st digit, d2 be the 2nd digit, and so on. In this way, we note
! the following:
! * d2d3d4 = 406 is divisible by 2
! * d3d4d5 = 063 is divisible by 3
! * d4d5d6 = 635 is divisible by 5
! * d5d6d7 = 357 is divisible by 7
! * d6d7d8 = 572 is divisible by 11
! * d7d8d9 = 728 is divisible by 13
! * d8d9d10 = 289 is divisible by 17
! Find the sum of all 0 to 9 pandigital numbers with this property.
! SOLUTION
! --------
! Brute force generating all the pandigitals then checking 3-digit divisiblity
! properties...this is very slow!
<PRIVATE
: subseq-divisible? ( n index seq -- ? )
[ 1- dup 3 + ] dip subseq 10 swap digits>integer swap mod zero? ;
: interesting? ( seq -- ? )
{
[ 17 8 pick subseq-divisible? ]
[ 13 7 pick subseq-divisible? ]
[ 11 6 pick subseq-divisible? ]
[ 7 5 pick subseq-divisible? ]
[ 5 4 pick subseq-divisible? ]
[ 3 3 pick subseq-divisible? ]
[ 2 2 pick subseq-divisible? ]
} && nip ;
PRIVATE>
: euler043 ( -- answer )
1234567890 number>digits all-permutations
[ interesting? ] subset [ 10 swap digits>integer ] map sum ;
! [ euler043 ] time
! 125196 ms run / 19548 ms GC time
! ALTERNATE SOLUTIONS
! -------------------
! Build the number from right to left, generating the next 3-digits according
! to the divisiblity rules and combining them with the previous digits if they
! overlap and still have all unique digits. When done with that, add whatever
! missing digit is needed to make the number pandigital.
<PRIVATE
: candidates ( n -- seq )
1000 over <range> [ number>digits 3 0 pad-left ] map [ all-unique? ] subset ;
: overlap? ( seq -- ? )
dup first 2 tail* swap second 2 head = ;
: clean ( seq -- seq )
[ unclip 1 head add* concat ] map [ all-unique? ] subset ;
: add-missing-digit ( seq -- seq )
dup natural-sort 10 seq-diff first add* ;
: interesting-pandigitals ( -- seq )
17 candidates { 13 11 7 5 3 2 } [
candidates swap cartesian-product [ overlap? ] subset clean
] each [ add-missing-digit ] map ;
PRIVATE>
: euler043a ( -- answer )
interesting-pandigitals [ 10 swap digits>integer ] sigma ;
! [ euler043a ] 100 ave-time
! 19 ms run / 1 ms GC ave time - 100 trials
MAIN: euler043a

50
extra/project-euler/044/044.factor Normal file
View File

@ -0,0 +1,50 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.ranges project-euler.common sequences ;
IN: project-euler.044
! http://projecteuler.net/index.php?section=problems&id=44
! DESCRIPTION
! -----------
! Pentagonal numbers are generated by the formula, Pn=n(3n−1)/2. The first ten
! pentagonal numbers are:
! 1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ...
! It can be seen that P4 + P7 = 22 + 70 = 92 = P8. However, their difference,
! 70 − 22 = 48, is not pentagonal.
! Find the pair of pentagonal numbers, Pj and Pk, for which their sum and
! difference is pentagonal and D = |Pk − Pj| is minimised; what is the value of D?
! SOLUTION
! --------
! Brute force using a cartesian product and an arbitrarily chosen limit.
<PRIVATE
: nth-pentagonal ( n -- seq )
dup 3 * 1- * 2 / ;
: pentagonal? ( n -- ? )
dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
: sum-and-diff? ( m n -- ? )
2dup + -rot - [ pentagonal? ] 2apply and ;
PRIVATE>
: euler044 ( -- answer )
2500 [1,b] [ nth-pentagonal ] map dup cartesian-product
[ first2 sum-and-diff? ] subset [ first2 - abs ] map infimum ;
! [ euler044 ] 10 ave-time
! 8924 ms run / 2872 ms GC ave time - 10 trials
! TODO: this solution is ugly and not very efficient...find a better algorithm
MAIN: euler044

25
extra/project-euler/048/048.factor Normal file
View File

@ -0,0 +1,25 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.functions ;
IN: project-euler.048
! http://projecteuler.net/index.php?section=problems&id=48
! DESCRIPTION
! -----------
! The series, 1^1 + 2^2 + 3^3 + ... + 10^10 = 10405071317.
! Find the last ten digits of the series, 1^1 + 2^2 + 3^3 + ... + 1000^1000.
! SOLUTION
! --------
: euler048 ( -- answer )
1000 [ 1+ dup ^ ] sigma 10 10 ^ mod ;
! [ euler048 ] 100 ave-time
! 276 ms run / 1 ms GC ave time - 100 trials
MAIN: euler048

50
extra/project-euler/052/052.factor Normal file
View File

@ -0,0 +1,50 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math project-euler.common sequences sorting ;
IN: project-euler.052
! http://projecteuler.net/index.php?section=problems&id=52
! DESCRIPTION
! -----------
! It can be seen that the number, 125874, and its double, 251748, contain
! exactly the same digits, but in a different order.
! Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x,
! contain the same digits.
! SOLUTION
! --------
! Analysis shows the number must be odd, divisible by 3, and larger than 123456
<PRIVATE
: map-nx ( n x -- seq )
[ 1+ * ] with map ; inline
: all-same-digits? ( seq -- ? )
[ number>digits natural-sort ] map all-equal? ;
: candidate? ( n -- ? )
{ [ dup odd? ] [ dup 3 mod zero? ] } && nip ;
: next-all-same ( x n -- n )
dup candidate? [
2dup swap map-nx all-same-digits?
[ nip ] [ 1+ next-all-same ] if
] [
1+ next-all-same
] if ;
PRIVATE>
: euler052 ( -- answer )
6 123456 next-all-same ;
! [ euler052 ] 100 ave-time
! 403 ms run / 7 ms GC ave time - 100 trials
MAIN: euler052

3
extra/project-euler/067/067.factor
View File

@ -58,7 +58,4 @@ PRIVATE>
! [ euler067a ] 100 ave-time
! 14 ms run / 0 ms GC ave time - 100 trials
! source-067 [ max-path ] curry 100 ave-time
! 3 ms run / 0 ms GC ave time - 100 trials
MAIN: euler067a

65
extra/project-euler/079/079.factor Normal file
View File

@ -0,0 +1,65 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs hashtables io.files kernel math math.parser namespaces sequences ;
IN: project-euler.079
! http://projecteuler.net/index.php?section=problems&id=79
! DESCRIPTION
! -----------
! A common security method used for online banking is to ask the user for three
! random characters from a passcode. For example, if the passcode was 531278,
! they may asked for the 2nd, 3rd, and 5th characters; the expected reply would
! be: 317.
! The text file, keylog.txt, contains fifty successful login attempts.
! Given that the three characters are always asked for in order, analyse the
! file so as to determine the shortest possible secret passcode of unknown
! length.
! SOLUTION
! --------
<PRIVATE
: source-079 ( -- seq )
"extra/project-euler/079/keylog.txt" resource-path file-lines ;
: >edges ( seq -- seq )
[
[ string>digits [ 2 head , ] keep 2 tail* , ] each
] { } make ;
: find-source ( seq -- elt )
dup values swap keys [ prune ] 2apply seq-diff
dup empty? [ "Topological sort failed" throw ] [ first ] if ;
: remove-source ( seq elt -- seq )
[ swap member? not ] curry subset ;
: (topological-sort) ( seq -- )
dup length 1 > [
dup find-source dup , remove-source (topological-sort)
] [
dup empty? [ drop ] [ first [ , ] each ] if
] if ;
PRIVATE>
: topological-sort ( seq -- seq )
[ [ (topological-sort) ] { } make ] keep
concat prune dupd seq-diff append ;
: euler079 ( -- answer )
source-079 >edges topological-sort 10 swap digits>integer ;
! [ euler079 ] 100 ave-time
! 2 ms run / 0 ms GC ave time - 100 trials
! TODO: prune and seq-diff are relatively slow; topological sort could be
! cleaned up and generalized much better, but it works for this problem
MAIN: euler079

50
extra/project-euler/079/keylog.txt Normal file
View File

@ -0,0 +1,50 @@
319
680
180
690
129
620
762
689
762
318
368
710
720
710
629
168
160
689
716
731
736
729
316
729
729
710
769
290
719
680
318
389
162
289
162
718
729
319
790
680
890
362
319
760
316
729
380
319
728
716

31
extra/project-euler/097/097.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: math math.functions ;
IN: project-euler.097
! http://projecteuler.net/index.php?section=problems&id=97
! DESCRIPTION
! -----------
! The first known prime found to exceed one million digits was discovered in
! 1999, and is a Mersenne prime of the form 2^6972593 − 1; it contains exactly
! 2,098,960 digits. Subsequently other Mersenne primes, of the form 2p − 1,
! have been found which contain more digits.
! However, in 2004 there was found a massive non-Mersenne prime which contains
! 2,357,207 digits: 28433 * 2^7830457 + 1.
! Find the last ten digits of this prime number.
! SOLUTION
! --------
: euler097 ( -- answer )
2 7830457 10 10 ^ ^mod 28433 * 10 10 ^ mod 1+ ;
! [ euler097 ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler097

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

@ -1,6 +1,6 @@
USING: arrays combinators.lib kernel math math.functions math.miller-rabin
math.matrices math.parser math.primes.factors math.ranges namespaces
sequences sorting ;
sequences sorting unicode.case ;
IN: project-euler.common
! A collection of words used by more than one Project Euler solution
@ -8,10 +8,12 @@ IN: project-euler.common
! Problems using each public word
! -------------------------------
! alpha-value - #22, #42
! cartesian-product - #4, #27, #29, #32, #33
! collect-consecutive - #8, #11
! log10 - #25, #134
! max-path - #18, #67
! nth-triangle - #12, #42
! number>digits - #16, #20, #30, #34
! pandigital? - #32, #38
! propagate-all - #18, #67
@ -52,6 +54,9 @@ IN: project-euler.common
PRIVATE>
: alpha-value ( str -- n )
>lower [ CHAR: a - 1+ ] sigma ;
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
swap [ swap [ 2array ] map-with ] map-with concat ;
@ -73,6 +78,9 @@ PRIVATE>
: number>digits ( n -- seq )
number>string string>digits ;
: nth-triangle ( n -- n )
dup 1+ * 2 / ;
: pandigital? ( n -- ? )
number>string natural-sort "123456789" = ;

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

@ -12,7 +12,9 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
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.037 project-euler.038 project-euler.039 project-euler.040
project-euler.067 project-euler.075 project-euler.134 project-euler.169
project-euler.041 project-euler.042 project-euler.043 project-euler.044
project-euler.048 project-euler.052 project-euler.067 project-euler.075
project-euler.079 project-euler.097 project-euler.134 project-euler.169
project-euler.173 project-euler.175 ;
IN: project-euler