Merge git://projects.elasticdog.com/git/factor into public
* git://projects.elasticdog.com/git/factor: Add standard deviation to output of ave-time benchmarking word Minor updates to standardize new Project Euler solutions Alternative solution to Project Euler problem 1 Conflicts: extra/project-euler/ave-time/ave-time.factordb4
						commit
						fe24f3e82a
					
				| 
						 | 
				
			
			@ -19,8 +19,17 @@ IN: project-euler.001
 | 
			
		|||
 | 
			
		||||
! Inclusion-exclusion principle
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: sum-divisible-by ( target n -- m )
 | 
			
		||||
    [ /i dup 1+ * ] keep * 2 /i ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: euler001 ( -- answer )
 | 
			
		||||
    0 999 3 <range> sum 0 999 5 <range> sum + 0 999 15 <range> sum - ;
 | 
			
		||||
    999 3 sum-divisible-by
 | 
			
		||||
    999 5 sum-divisible-by +
 | 
			
		||||
    999 15 sum-divisible-by - ;
 | 
			
		||||
 | 
			
		||||
! [ euler001 ] 100 ave-time
 | 
			
		||||
! 0 ms run / 0 ms GC ave time - 100 trials
 | 
			
		||||
| 
						 | 
				
			
			@ -30,9 +39,16 @@ IN: project-euler.001
 | 
			
		|||
! -------------------
 | 
			
		||||
 | 
			
		||||
: euler001a ( -- answer )
 | 
			
		||||
    1000 [ dup 5 mod swap 3 mod [ zero? ] either? ] filter sum ;
 | 
			
		||||
    0 999 3 <range> sum 0 999 5 <range> sum + 0 999 15 <range> sum - ;
 | 
			
		||||
 | 
			
		||||
! [ euler001a ] 100 ave-time
 | 
			
		||||
! 0 ms run / 0 ms GC ave time - 100 trials
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
: euler001b ( -- answer )
 | 
			
		||||
    1000 [ dup 5 mod swap 3 mod [ zero? ] either? ] filter sum ;
 | 
			
		||||
 | 
			
		||||
! [ euler001b ] 100 ave-time
 | 
			
		||||
! 0 ms run / 0 ms GC ave time - 100 trials
 | 
			
		||||
 | 
			
		||||
MAIN: euler001
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
! --------
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: sum-1toN ( n -- sum )
 | 
			
		||||
| 
						 | 
				
			
			@ -15,10 +40,15 @@ IN: project-euler.148
 | 
			
		|||
: (use-digit) ( prev x index -- next )
 | 
			
		||||
    [ [ 1+ * ] [ sum-1toN 7 sum-1toN ] bi ] dip ^ * + ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: (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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
! --------
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
! sequence helper functions
 | 
			
		||||
| 
						 | 
				
			
			@ -20,16 +44,13 @@ IN: project-euler.150
 | 
			
		|||
: map-infimum ( seq quot -- min )
 | 
			
		||||
    [ min ] compose 0 swap reduce ; inline
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
! triangle generator functions
 | 
			
		||||
 | 
			
		||||
: next ( t -- new-t s )
 | 
			
		||||
    615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
 | 
			
		||||
 | 
			
		||||
: sums-triangle ( -- seq )
 | 
			
		||||
    0 1000 [ 1+ [ next ] replicate partial-sums ] map nip ; 
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
    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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,22 +1,31 @@
 | 
			
		|||
USING: arrays help.markup help.syntax math memory quotations sequences system tools.time ;
 | 
			
		||||
USING: arrays help.markup help.syntax math math.parser memory quotations
 | 
			
		||||
    sequences system tools.time ;
 | 
			
		||||
IN: project-euler.ave-time
 | 
			
		||||
 | 
			
		||||
HELP: collect-benchmarks
 | 
			
		||||
{ $values { "quot" quotation } { "n" integer } { "seq" sequence } }
 | 
			
		||||
{ $description "Runs a quotation " { $snippet "n" } " times, collecting the wall clock time and the time spent in the garbage collector into pairs inside of a sequence." }
 | 
			
		||||
{ $notes "The stack effect of " { $snippet "quot" } " is inferred and only one set of outputs will remain on the stack no matter how many trials are run."
 | 
			
		||||
{ $description "Runs a quotation " { $snippet "n" } " times, collecting the wall clock time inside of a sequence." }
 | 
			
		||||
{ $notes "The stack effect of " { $snippet "quot" } " is accounted for and only one set of outputs will remain on the stack no matter how many trials are run."
 | 
			
		||||
    $nl
 | 
			
		||||
    "A nicer word for interactive use is " { $link ave-time } "." } ;
 | 
			
		||||
 | 
			
		||||
HELP: nth-place
 | 
			
		||||
{ $values { "x" float } { "n" integer } { "y" float } }
 | 
			
		||||
{ $description "Rounds a floating point number to " { $snippet "n" } " decimal places." }
 | 
			
		||||
{ $examples
 | 
			
		||||
    "This word is useful for display purposes when showing 15 decimal places is not desired:"
 | 
			
		||||
    { $unchecked-example "3.141592653589793 3 nth-place number>string" "\"3.142\"" }
 | 
			
		||||
} ;
 | 
			
		||||
 | 
			
		||||
HELP: ave-time
 | 
			
		||||
{ $values { "quot" quotation } { "n" integer } }
 | 
			
		||||
{ $description "Runs a quotation " { $snippet "n" } " times, then prints the average run time and the average time spent in the garbage collector." }
 | 
			
		||||
{ $notes "The stack effect of " { $snippet "quot" } " is inferred and only one set of outputs will remain on the stack no matter how many trials are run." }
 | 
			
		||||
{ $description "Runs a quotation " { $snippet "n" } " times, then prints the average run time and standard deviation." }
 | 
			
		||||
{ $notes "The stack effect of " { $snippet "quot" } " is accounted for and only one set of outputs will remain on the stack no matter how many trials are run." }
 | 
			
		||||
{ $examples
 | 
			
		||||
    "This word can be used to compare performance of the non-optimizing and optimizing compilers."
 | 
			
		||||
    $nl
 | 
			
		||||
    "First, we time a quotation directly; quotations are compiled by the non-optimizing quotation compiler:"
 | 
			
		||||
    { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] 10 ave-time" "1116 ms run time - 10 trials" }
 | 
			
		||||
    "Now we define a word and compile it with the optimizing word compiler. This results is faster execution:"
 | 
			
		||||
    { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] 10 ave-time" "202 ms run time - 10 trials" }
 | 
			
		||||
    { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] 10 ave-time" "465 ms ave run time - 13.37 SD (10 trials)" }
 | 
			
		||||
    "Now we define a word and compile it with the optimizing word compiler. This results in faster execution:"
 | 
			
		||||
    { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] 10 ave-time" "202 ms ave run time - 22.73 SD (10 trials)" }
 | 
			
		||||
} ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! 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 continuations ;
 | 
			
		||||
USING: continuations io kernel math math.functions math.parser math.statistics
 | 
			
		||||
    namespaces tools.time ;
 | 
			
		||||
IN: project-euler.ave-time
 | 
			
		||||
 | 
			
		||||
: collect-benchmarks ( quot n -- seq )
 | 
			
		||||
| 
						 | 
				
			
			@ -10,7 +10,11 @@ IN: project-euler.ave-time
 | 
			
		|||
    [ with-datastack drop ] 2curry r> swap times call
 | 
			
		||||
  ] { } make ;
 | 
			
		||||
 | 
			
		||||
: nth-place ( x n -- y )
 | 
			
		||||
    10 swap ^ [ * round ] keep / ;
 | 
			
		||||
 | 
			
		||||
: ave-time ( quot n -- )
 | 
			
		||||
    [ collect-benchmarks ] keep swap mean round [
 | 
			
		||||
        # " ms run time - " % # " trials" %
 | 
			
		||||
    [ collect-benchmarks ] keep
 | 
			
		||||
    swap [ std 2 nth-place ] [ mean round ] bi [
 | 
			
		||||
        # " ms ave run time - " % # " SD (" % # " trials)" %
 | 
			
		||||
    ] "" make print flush ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue