! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
- USING: arrays kernel lazy-lists math math.erato math.functions math.ranges
- namespaces sequences ;
-USING: math.primes sequences ;
++USING: kernel math.primes sequences ;
IN: project-euler.010
! http://projecteuler.net/index.php?section=problems&id=10
! SOLUTION
! --------
- ! Sieve of Eratosthenes and lazy summing
-! Summing of prime numbers
--
: euler010 ( -- answer )
- 0 1000000 lerato [ + ] leach ;
- 1000000 primes-upto sum ;
++ 1000000 primes-upto sum ;
- ! [ euler010 ] time
- ! 765 ms run / 7 ms GC time
+ ! [ euler010 ] 100 ave-time
+ ! 14 ms run / 0 ms GC ave time - 100 trials
MAIN: euler010
- ! Copyright (c) 2007 Aaron Schaefer.
-! Copyright (c) 2007 Samuel Tardieu.
++! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
- USING: kernel project-euler.common ;
-USING: kernel math sequences ;
++USING: kernel math project-euler.common sequences ;
IN: project-euler.018
! http://projecteuler.net/index.php?section=problems&id=18
! SOLUTION
! --------
+ ! Propagate from bottom to top the longest cumulative path. This is very
+ ! efficient and will be reused in problem 67.
+
<PRIVATE
- : source-018 ( -- triangle )
+ : pyramid ( -- seq )
- {
- 75
- 95 64
- 17 47 82
- 18 35 87 10
- 20 04 82 47 65
- 19 01 23 75 03 34
- 88 02 77 73 07 63 67
- 99 65 04 28 06 16 70 92
- 41 41 26 56 83 40 80 70 33
- 41 48 72 33 47 32 37 16 94 29
- 53 71 44 65 25 43 91 52 97 51 14
- 70 11 33 28 77 73 17 78 39 68 17 57
- 91 71 52 38 17 14 91 43 58 50 27 29 48
- 63 66 04 68 89 53 67 30 73 16 69 87 40 31
- 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
- }
- 15 [ 1+ cut swap ] map nip ;
++ {
++ 75
++ 95 64
++ 17 47 82
++ 18 35 87 10
++ 20 04 82 47 65
++ 19 01 23 75 03 34
++ 88 02 77 73 07 63 67
++ 99 65 04 28 06 16 70 92
++ 41 41 26 56 83 40 80 70 33
++ 41 48 72 33 47 32 37 16 94 29
++ 53 71 44 65 25 43 91 52 97 51 14
++ 70 11 33 28 77 73 17 78 39 68 17 57
++ 91 71 52 38 17 14 91 43 58 50 27 29 48
++ 63 66 04 68 89 53 67 30 73 16 69 87 40 31
++ 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
++ }
++ 15 [ 1+ cut swap ] map nip ;
+
+ PRIVATE>
+
+ ! Propagate one row into the upper one
+ : propagate ( bottom top -- newtop )
- [ over 1 tail rot first2 max rot + ] map nip ;
++ [ over 1 tail rot first2 max rot + ] map nip ;
+
+ ! Not strictly needed, but it is nice to be able to dump the pyramid after
+ ! the propagation
+ : propagate-all ( pyramid -- newpyramid )
- reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
++ reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
+
-: euler018 ( -- best )
- pyramid propagate-all first first ;
++: euler018 ( -- answer )
++ pyramid propagate-all first first ;
+
+ ! [ euler018 ] 100 ave-time
-! 0 ms run / 0 ms GC time
++! 0 ms run / 0 ms GC ave time - 100 trials
++
++
++! ALTERNATE SOLUTIONS
++! -------------------
++
++<PRIVATE
++
++: source-018a ( -- triangle )
+ { { 75 }
+ { 95 64 }
+ { 17 47 82 }
+ { 18 35 87 10 }
+ { 20 04 82 47 65 }
+ { 19 01 23 75 03 34 }
+ { 88 02 77 73 07 63 67 }
+ { 99 65 04 28 06 16 70 92 }
+ { 41 41 26 56 83 40 80 70 33 }
+ { 41 48 72 33 47 32 37 16 94 29 }
+ { 53 71 44 65 25 43 91 52 97 51 14 }
+ { 70 11 33 28 77 73 17 78 39 68 17 57 }
+ { 91 71 52 38 17 14 91 43 58 50 27 29 48 }
+ { 63 66 04 68 89 53 67 30 73 16 69 87 40 31 }
+ { 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 } } ;
+
+PRIVATE>
+
- : euler018 ( -- answer )
- source-018 max-path ;
++: euler018a ( -- answer )
++ source-018a max-path ;
+
- ! [ euler018 ] 100 ave-time
++! [ euler018a ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
MAIN: euler018
- ! Copyright (c) 2007 Aaron Schaefer.
-! Copyright (c) 2007 Samuel Tardieu.
++! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
- USING: calendar combinators.lib kernel math namespaces ;
-USING: calendar combinators combinators.lib kernel math.ranges sequences ;
++USING: calendar combinators combinators.lib kernel math math.ranges namespaces
++ sequences ;
IN: project-euler.019
! http://projecteuler.net/index.php?section=problems&id=19
! SOLUTION
! --------
- : euler019 ( -- answer )
+ ! Use Zeller congruence, which is implemented in the "calendar" module
+ ! already, as "zeller-congruence ( year month day -- n )" where n is
+ ! the day of the week (Sunday is 0).
+
+ : euler019 ( -- count )
+ 1901 2000 [a,b] [ 12 [1,b] [ 1 zeller-congruence ] 1 map-withn ] map concat
+ [ 0 = ] subset length ;
+
+ ! [ euler019 ] 100 ave-time
+ ! 1 ms run / 0 ms GC ave time - 100 trials
+
++
++! ALTERNATE SOLUTIONS
++! -------------------
++
+<PRIVATE
+
+: start-date ( -- timestamp )
+ 1901 1 1 0 0 0 0 make-timestamp ;
+
+: end-date ( -- timestamp )
+ 2000 12 31 0 0 0 0 make-timestamp ;
+
+: (first-days) ( end-date start-date -- )
+ 2dup timestamp- 0 >= [
+ dup day-of-week , 1 +month (first-days)
+ ] [
+ 2drop
+ ] if ;
+
+: first-days ( start-date end-date -- seq )
+ [ swap (first-days) ] { } make ;
+
+PRIVATE>
+
- ! [ euler019 ] 100 ave-time
++: euler019a ( -- answer )
+ start-date end-date first-days [ zero? ] count ;
+
++! [ euler019a ] 100 ave-time
+! 131 ms run / 3 ms GC ave time - 100 trials
+
MAIN: euler019
- ! Copyright (c) 2007 Aaron Schaefer.
-! Copyright (c) 2007 Samuel Tardieu.
++! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
- USING: io io.files kernel math.parser namespaces project-euler.common sequences
- splitting system vocabs ;
-USING: io io.files math.parser project-euler.018 sequences splitting ;
++USING: io io.files kernel math.parser namespaces project-euler.018
++ project-euler.common sequences splitting system vocabs ;
IN: project-euler.067
! http://projecteuler.net/index.php?section=problems&id=67
! SOLUTION
! --------
- pyramid propagate-all first first ;
+ ! Propagate from bottom to top the longest cumulative path as is done in
+ ! problem 18.
+
+ <PRIVATE
+
+ : pyramid ( -- seq )
+ "resource:extra/project-euler/067/triangle.txt" ?resource-path <file-reader>
+ lines [ " " split [ string>number ] map ] map ;
+
+ PRIVATE>
+
+ : euler067 ( -- best )
-MAIN: euler067
++ pyramid propagate-all first first ;
+
+ ! [ euler067 ] 100 ave-time
+ ! 18 ms run / 0 ms GC time
+
- : (source-067) ( -- path )
++
++! ALTERNATE SOLUTIONS
++! -------------------
++
+<PRIVATE
+
- : source-067 ( -- triangle )
- (source-067) <file-reader> lines [ " " split [ string>number ] map ] map ;
++: (source-067a) ( -- path )
+ [
+ "project-euler.067" vocab-root ?resource-path %
+ os "windows" = [
+ "\\project-euler\\067\\triangle.txt" %
+ ] [
+ "/project-euler/067/triangle.txt" %
+ ] if
+ ] "" make ;
+
- : euler067 ( -- answer )
- source-067 max-path ;
++: source-067a ( -- triangle )
++ (source-067a) <file-reader> lines [ " " split [ string>number ] map ] map ;
+
+PRIVATE>
+
- ! [ euler067 ] 100 ave-time
++: euler067a ( -- answer )
++ source-067a max-path ;
+
- ! source-067 [ max-path ] curry 100 ave-time
++! [ euler067a ] 100 ave-time
+! 15 ms run / 0 ms GC ave time - 100 trials
+
- MAIN: euler067
++! source-067a [ max-path ] curry 100 ave-time
+! 3 ms run / 0 ms GC ave time - 100 trials
+
++MAIN: euler067a
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
- USING: io io.files kernel math.parser namespaces sequences strings
- vocabs vocabs.loader system project-euler.ave-time project-euler.common
-USING: definitions io io.files kernel math.parser sequences strings
- vocabs vocabs.loader
++USING: definitions io io.files kernel math.parser sequences vocabs
++ vocabs.loader project-euler.ave-time project-euler.common
project-euler.001 project-euler.002 project-euler.003 project-euler.004
project-euler.005 project-euler.006 project-euler.007 project-euler.008
project-euler.009 project-euler.010 project-euler.011 project-euler.012
project-euler.013 project-euler.014 project-euler.015 project-euler.016
- project-euler.017 project-euler.018 project-euler.019
- project-euler.067
- project-euler.134 ;
+ project-euler.017 project-euler.018 project-euler.019 project-euler.020
- project-euler.021 project-euler.022 project-euler.067 ;
++ project-euler.021 project-euler.022 project-euler.067 project-euler.134 ;
IN: project-euler
<PRIVATE
print readln string>number ;
: number>euler ( n -- str )
- number>digits 3 0 pad-left [ number>string ] map concat ;
-
- : solution-path ( n -- str )
- number>euler dup [
- "project-euler" vocab-root ?resource-path %
- os "windows" = [
- "\\project-euler\\" % % "\\" % % ".factor" %
- ] [
- "/project-euler/" % % "/" % % ".factor" %
- ] if
- ] "" make ;
+ number>string 3 CHAR: 0 pad-left ;
+
+ : solution-path ( n -- str/f )
- number>euler "project-euler." swap append vocab where
- dup [ first ?resource-path ] when ;
++ number>euler "project-euler." swap append
++ vocab where dup [ first ?resource-path ] when ;
PRIVATE>
projects / factor.git / commitdiff