From 94a1ef83567c4f63638f83b0dc328ef9c3291464 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Tue, 15 Jul 2008 22:40:33 -0400
Subject: [PATCH 1/3] Alternative solution to Project Euler problem 1
---
extra/project-euler/001/001.factor | 20 ++++++++++++++++++--
1 file changed, 18 insertions(+), 2 deletions(-)
diff --git a/extra/project-euler/001/001.factor b/extra/project-euler/001/001.factor
index 843f8b87ba..344b0f1209 100644
--- a/extra/project-euler/001/001.factor
+++ b/extra/project-euler/001/001.factor
@@ -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
From a4efa8cb0861e5a7879037b95085beda72422883 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sun, 20 Jul 2008 21:52:39 -0400
Subject: [PATCH 2/3] 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
+! --------
+
<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
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
+! --------
+
<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
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
<PRIVATE
From d986b30eb68fa93c963d7e692719a7cc10db480b Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sun, 27 Jul 2008 17:46:43 -0400
Subject: [PATCH 3/3] Add standard deviation to output of ave-time benchmarking
word
---
.../ave-time/ave-time-docs.factor | 25 +++++++++++++------
extra/project-euler/ave-time/ave-time.factor | 12 ++++++---
2 files changed, 25 insertions(+), 12 deletions(-)
diff --git a/extra/project-euler/ave-time/ave-time-docs.factor b/extra/project-euler/ave-time/ave-time-docs.factor
index d8ee0846b0..f2d6b89afc 100644
--- a/extra/project-euler/ave-time/ave-time-docs.factor
+++ b/extra/project-euler/ave-time/ave-time-docs.factor
@@ -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)" }
} ;
diff --git a/extra/project-euler/ave-time/ave-time.factor b/extra/project-euler/ave-time/ave-time.factor
index 081ee2e8bb..ecf308ec11 100644
--- a/extra/project-euler/ave-time/ave-time.factor
+++ b/extra/project-euler/ave-time/ave-time.factor
@@ -1,7 +1,7 @@
! 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 ;
+USING: combinators 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