From a4efa8cb0861e5a7879037b95085beda72422883 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sun, 20 Jul 2008 21:52:39 -0400 Subject: [PATCH] Minor updates to standardize new Project Euler solutions --- extra/project-euler/014/014.factor | 4 +- extra/project-euler/021/021.factor | 5 +-- extra/project-euler/036/036.factor | 4 +- extra/project-euler/043/043.factor | 6 +-- extra/project-euler/052/052.factor | 4 +- extra/project-euler/076/076.factor | 18 +++++--- extra/project-euler/100/100.factor | 33 +++++++++++++- extra/project-euler/116/116.factor | 15 ++++--- extra/project-euler/117/117.factor | 19 +++++--- extra/project-euler/148/148.factor | 40 ++++++++++++++--- extra/project-euler/150/150.factor | 44 ++++++++++++++---- extra/project-euler/151/151.factor | 47 ++++++++++++++++++-- extra/project-euler/164/164.factor | 11 +++-- extra/project-euler/190/190.factor | 16 ++++--- extra/project-euler/ave-time/ave-time.factor | 2 +- extra/project-euler/project-euler.factor | 6 ++- 16 files changed, 214 insertions(+), 60 deletions(-) diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index b99e34d36f..4f17e855b7 100644 --- a/extra/project-euler/014/014.factor +++ b/extra/project-euler/014/014.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.lib kernel math math.ranges namespaces sequences - sorting combinators.short-circuit ; +USING: arrays combinators.lib combinators.short-circuit kernel math math.ranges + namespaces sequences sorting ; IN: project-euler.014 ! http://projecteuler.net/index.php?section=problems&id=14 diff --git a/extra/project-euler/021/021.factor b/extra/project-euler/021/021.factor index f09b0c0b42..9ae5f6af10 100644 --- a/extra/project-euler/021/021.factor +++ b/extra/project-euler/021/021.factor @@ -1,8 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib kernel math math.functions math.ranges namespaces - project-euler.common sequences sequences.lib - combinators.short-circuit ; +USING: combinators.lib combinators.short-circuit kernel math math.functions + math.ranges namespaces project-euler.common sequences sequences.lib ; IN: project-euler.021 ! http://projecteuler.net/index.php?section=problems&id=21 diff --git a/extra/project-euler/036/036.factor b/extra/project-euler/036/036.factor index 4a4f906467..f3a9f738bf 100644 --- a/extra/project-euler/036/036.factor +++ b/extra/project-euler/036/036.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib kernel math.parser math.ranges project-euler.common - sequences combinators.short-circuit ; +USING: combinators.lib combinators.short-circuit kernel math.parser math.ranges + project-euler.common sequences ; IN: project-euler.036 ! http://projecteuler.net/index.php?section=problems&id=36 diff --git a/extra/project-euler/043/043.factor b/extra/project-euler/043/043.factor index e095d94ead..a2f4ad5c61 100644 --- a/extra/project-euler/043/043.factor +++ b/extra/project-euler/043/043.factor @@ -1,8 +1,8 @@ ! 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 sequences.lib sorting - sets combinators.short-circuit ; +USING: combinators.lib combinators.short-circuit hashtables kernel math + math.combinatorics math.parser math.ranges project-euler.common sequences + sequences.lib sorting sets ; IN: project-euler.043 ! http://projecteuler.net/index.php?section=problems&id=43 diff --git a/extra/project-euler/052/052.factor b/extra/project-euler/052/052.factor index 194530ea78..aec8015f94 100644 --- a/extra/project-euler/052/052.factor +++ b/extra/project-euler/052/052.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib kernel math project-euler.common sequences -sorting combinators.short-circuit ; +USING: combinators.lib combinators.short-circuit kernel math + project-euler.common sequences sorting ; IN: project-euler.052 ! http://projecteuler.net/index.php?section=problems&id=52 diff --git a/extra/project-euler/076/076.factor b/extra/project-euler/076/076.factor index 782d6d0429..3530f2163a 100644 --- a/extra/project-euler/076/076.factor +++ b/extra/project-euler/076/076.factor @@ -1,7 +1,7 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays assocs combinators kernel math sequences -math.order math.ranges locals ; +USING: arrays assocs combinators kernel locals math math.order math.ranges + sequences ; IN: project-euler.076 ! http://projecteuler.net/index.php?section=problems&id=76 @@ -12,6 +12,7 @@ IN: project-euler.076 ! How many different ways can one hundred be written as a ! sum of at least two positive integers? + ! SOLUTION ! -------- @@ -43,12 +44,17 @@ IN: project-euler.076 :: each-subproblem ( n quot -- ) n [1,b] [ dup [1,b] quot with each ] each ; inline -PRIVATE> - : (euler076) ( n -- m ) dup init [ [ ways ] curry each-subproblem ] [ [ dup 2array ] dip at 1- ] 2bi ; -: euler076 ( -- m ) +PRIVATE> + +: euler076 ( -- answer ) 100 (euler076) ; + +! [ euler076 ] 100 ave-time +! 704 ms run time - 100 trials + +MAIN: euler076 diff --git a/extra/project-euler/100/100.factor b/extra/project-euler/100/100.factor index d2d396a0e1..fca1bf8af8 100644 --- a/extra/project-euler/100/100.factor +++ b/extra/project-euler/100/100.factor @@ -1,7 +1,36 @@ -USING: kernel sequences math.functions math ; +! Copyright (c) 2008 Eric Mertens. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions sequences ; IN: project-euler.100 -: euler100 ( -- n ) +! http://projecteuler.net/index.php?section=problems&id=100 + +! DESCRIPTION +! ----------- + +! If a box contains twenty-one coloured discs, composed of fifteen blue discs +! and six red discs, and two discs were taken at random, it can be seen that +! the probability of taking two blue discs, P(BB) = (15/21)*(14/20) = 1/2. + +! The next such arrangement, for which there is exactly 50% chance of taking +! two blue discs at random, is a box containing eighty-five blue discs and +! thirty-five red discs. + +! By finding the first arrangement to contain over 10^12 = 1,000,000,000,000 +! discs in total, determine the number of blue discs that the box would contain. + + +! SOLUTION +! -------- + +: euler100 ( -- answer ) 1 1 [ dup dup 1- * 2 * 10 24 ^ <= ] [ tuck 6 * swap - 2 - ] [ ] while nip ; + +! TODO: solution is incredibly slow (>30 minutes) and needs generalization + +! [ euler100 ] time +! ? ms run time + +MAIN: euler100 diff --git a/extra/project-euler/116/116.factor b/extra/project-euler/116/116.factor index d48cdf175c..5e2059ad9a 100644 --- a/extra/project-euler/116/116.factor +++ b/extra/project-euler/116/116.factor @@ -1,7 +1,6 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.ranges sequences sequences.lib ; - IN: project-euler.116 ! http://projecteuler.net/index.php?section=problems&id=116 @@ -24,6 +23,7 @@ IN: project-euler.116 ! length be replaced if colours cannot be mixed and at least one coloured tile ! must be used? + ! SOLUTION ! -------- @@ -46,10 +46,15 @@ IN: project-euler.116 : ways ( length colortile -- permutations ) V{ 1 } clone [ [ next ] 2curry times ] keep peek 1- ; -PRIVATE> - : (euler116) ( length -- permutations ) 3 [1,b] [ ways ] with sigma ; -: euler116 ( -- permutations ) +PRIVATE> + +: euler116 ( -- answer ) 50 (euler116) ; + +! [ euler116 ] 100 ave-time +! 0 ms run time - 100 trials + +MAIN: euler116 diff --git a/extra/project-euler/117/117.factor b/extra/project-euler/117/117.factor index 3a05261710..cc5dea8f37 100644 --- a/extra/project-euler/117/117.factor +++ b/extra/project-euler/117/117.factor @@ -1,7 +1,6 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.order splitting sequences ; - +USING: kernel math math.order sequences splitting ; IN: project-euler.117 ! http://projecteuler.net/index.php?section=problems&id=117 @@ -14,7 +13,8 @@ IN: project-euler.117 ! units, and blue tiles measuring four units, it is possible to tile a ! row measuring five units in length in exactly fifteen different ways. -! How many ways can a row measuring fifty units in length be tiled? +! How many ways can a row measuring fifty units in length be tiled? + ! SOLUTION ! -------- @@ -33,10 +33,15 @@ IN: project-euler.117 : next ( seq -- ) [ 4 short tail* sum ] keep push ; -PRIVATE> - : (euler117) ( n -- m ) V{ 1 } clone tuck [ next ] curry times peek ; -: euler117 ( -- m ) +PRIVATE> + +: euler117 ( -- answer ) 50 (euler117) ; + +! [ euler117 ] 100 ave-time +! 0 ms run time - 100 trials + +MAIN: euler117 diff --git a/extra/project-euler/148/148.factor b/extra/project-euler/148/148.factor index ead9a4e58d..49fd9a4895 100644 --- a/extra/project-euler/148/148.factor +++ b/extra/project-euler/148/148.factor @@ -1,9 +1,34 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.functions sequences sequences.lib ; - IN: project-euler.148 +! http://projecteuler.net/index.php?section=problems&id=148 + +! DESCRIPTION +! ----------- + +! We can easily verify that none of the entries in the first seven rows of +! Pascal's triangle are divisible by 7: + +! 1 +! 1 1 +! 1 2 1 +! 1 3 3 1 +! 1 4 6 4 1 +! 1 5 10 10 5 1 +! 1 6 15 20 15 6 1 + +! However, if we check the first one hundred rows, we will find that only 2361 +! of the 5050 entries are not divisible by 7. + +! Find the number of entries which are not divisible by 7 in the first one +! billion (10^9) rows of Pascal's triangle. + + +! SOLUTION +! -------- + - : (euler148) ( x -- y ) >base7 0 [ (use-digit) ] reduce-index ; -: euler148 ( -- y ) +PRIVATE> + +: euler148 ( -- answer ) 10 9 ^ (euler148) ; + +! [ euler148 ] 100 ave-time +! 0 ms run time - 100 trials + +MAIN: euler148 diff --git a/extra/project-euler/150/150.factor b/extra/project-euler/150/150.factor index 49de5dbc03..c7d878edcb 100644 --- a/extra/project-euler/150/150.factor +++ b/extra/project-euler/150/150.factor @@ -1,9 +1,33 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.order sequences sequences.private -locals hints ; +USING: hints kernel locals math math.order sequences sequences.private ; IN: project-euler.150 +! http://projecteuler.net/index.php?section=problems&id=150 + +! DESCRIPTION +! ----------- + +! In a triangular array of positive and negative integers, we wish to find a +! sub-triangle such that the sum of the numbers it contains is the smallest +! possible. + +! In the example below, it can be easily verified that the marked triangle +! satisfies this condition having a sum of -42. + +! We wish to make such a triangular array with one thousand rows, so we +! generate 500500 pseudo-random numbers sk in the range +/-2^19, using a type of +! random number generator (known as a Linear Congruential Generator) as +! follows: + +! ... + +! Find the smallest possible sub-triangle sum. + + +! SOLUTION +! -------- + + 0 1000 [ 1+ [ next ] replicate partial-sums ] map nip ; :: (euler150) ( m -- n ) [let | table [ sums-triangle ] | @@ -46,5 +67,12 @@ PRIVATE> HINTS: (euler150) fixnum ; -: euler150 ( -- n ) +PRIVATE> + +: euler150 ( -- answer ) 1000 (euler150) ; + +! [ euler150 ] 10 ave-time +! 32858 ms run time - 10 trials + +MAIN: euler150 diff --git a/extra/project-euler/151/151.factor b/extra/project-euler/151/151.factor index b2bbbcc0da..b64ae3d49f 100644 --- a/extra/project-euler/151/151.factor +++ b/extra/project-euler/151/151.factor @@ -1,9 +1,41 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences combinators kernel sequences.lib math math.order -assocs namespaces ; +USING: assocs combinators kernel math math.order namespaces sequences + sequences.lib ; IN: project-euler.151 +! http://projecteuler.net/index.php?section=problems&id=151 + +! DESCRIPTION +! ----------- + +! A printing shop runs 16 batches (jobs) every week and each batch requires a +! sheet of special colour-proofing paper of size A5. + +! Every Monday morning, the foreman opens a new envelope, containing a large +! sheet of the special paper with size A1. + +! He proceeds to cut it in half, thus getting two sheets of size A2. Then he +! cuts one of them in half to get two sheets of size A3 and so on until he +! obtains the A5-size sheet needed for the first batch of the week. + +! All the unused sheets are placed back in the envelope. + +! At the beginning of each subsequent batch, he takes from the envelope one +! sheet of paper at random. If it is of size A5, he uses it. If it is larger, +! he repeats the 'cut-in-half' procedure until he has what he needs and any +! remaining sheets are always placed back in the envelope. + +! Excluding the first and last batch of the week, find the expected number of +! times (during each week) that the foreman finds a single sheet of paper in +! the envelope. + +! Give your answer rounded to six decimal places using the format x.xxxxxx . + + +! SOLUTION +! -------- + SYMBOL: table : (pick-sheet) ( seq i -- newseq ) @@ -34,8 +66,15 @@ DEFER: (euler151) [ [ dup length [ pick-sheet ] with map sum ] [ sum ] bi / ] } case ] cache ; -: euler151 ( -- n ) +: euler151 ( -- answer ) [ H{ } clone table set { 1 1 1 1 } (euler151) ] with-scope ; + +! TODO: doesn't work currently, problem in area of 'with map' in (euler151) + +! [ euler151 ] 100 ave-time +! ? ms run time - 100 trials + +MAIN: euler151 diff --git a/extra/project-euler/164/164.factor b/extra/project-euler/164/164.factor index bf1f5dcf9b..9d88e49e0e 100644 --- a/extra/project-euler/164/164.factor +++ b/extra/project-euler/164/164.factor @@ -1,7 +1,6 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel math math.ranges sequences ; - IN: project-euler.164 ! http://projecteuler.net/index.php?section=problems&id=164 @@ -12,6 +11,7 @@ IN: project-euler.164 ! How many 20 digit numbers n (without any leading zero) exist such ! that no three consecutive digits of n have a sum greater than 9? + ! SOLUTION ! -------- @@ -29,5 +29,10 @@ IN: project-euler.164 PRIVATE> -: euler164 ( -- n ) +: euler164 ( -- answer ) init-table 19 [ next-table ] times values sum ; + +! [ euler164 ] 100 ave-time +! 8 ms run time - 100 trials + +MAIN: euler164 diff --git a/extra/project-euler/190/190.factor b/extra/project-euler/190/190.factor index 6fc15c9f30..35b9344362 100644 --- a/extra/project-euler/190/190.factor +++ b/extra/project-euler/190/190.factor @@ -1,13 +1,13 @@ -! Copyright (c) 2008 Eric Mertens +! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.lib math math.functions math.ranges locals ; IN: project-euler.190 -! PROBLEM -! ------- - ! http://projecteuler.net/index.php?section=problems&id=190 +! DESCRIPTION +! ----------- + ! Let Sm = (x1, x2, ... , xm) be the m-tuple of positive real numbers ! with x1 + x2 + ... + xm = m for which Pm = x1 * x22 * ... * xmm is ! maximised. @@ -17,6 +17,7 @@ IN: project-euler.190 ! Find Σ[Pm] for 2 ≤ m ≤ 15. + ! SOLUTION ! -------- @@ -44,5 +45,10 @@ PRIVATE> :: P_m ( m -- P_m ) m [1,b] [| i | 2 i * m 1+ / i ^ ] PI ; -: euler190 ( -- n ) +: euler190 ( -- answer ) 2 15 [a,b] [ P_m truncate ] sigma ; + +! [ euler150 ] 100 ave-time +! 7 ms run time - 100 trials + +MAIN: euler190 diff --git a/extra/project-euler/ave-time/ave-time.factor b/extra/project-euler/ave-time/ave-time.factor index c8212b4009..081ee2e8bb 100644 --- a/extra/project-euler/ave-time/ave-time.factor +++ b/extra/project-euler/ave-time/ave-time.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer +! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: arrays combinators io kernel math math.functions math.parser math.statistics namespaces sequences tools.time ; diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 3101c900e3..9dfaad0e7b 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -16,8 +16,10 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time project-euler.045 project-euler.046 project-euler.047 project-euler.048 project-euler.052 project-euler.053 project-euler.056 project-euler.059 project-euler.067 project-euler.075 project-euler.079 project-euler.092 - project-euler.097 project-euler.134 project-euler.169 project-euler.173 - project-euler.175 combinators.short-circuit ; + project-euler.097 project-euler.100 project-euler.116 project-euler.117 + project-euler.134 project-euler.148 project-euler.150 project-euler.151 + project-euler.164 project-euler.169 project-euler.173 project-euler.175 + project-euler.186 project-euler.190 ; IN: project-euler