From 9760eb4fb197d265eb04a8c1a00432987c3153f2 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 28 Dec 2007 14:17:31 +0100
Subject: [PATCH 1/4] Update collect-benchmarks so that it does not rely onto
computed stack effect
---
extra/project-euler/ave-time/ave-time.factor | 12 +++++-------
1 file changed, 5 insertions(+), 7 deletions(-)
diff --git a/extra/project-euler/ave-time/ave-time.factor b/extra/project-euler/ave-time/ave-time.factor
index d481b30c84..b908dbd7b0 100644
--- a/extra/project-euler/ave-time/ave-time.factor
+++ b/extra/project-euler/ave-time/ave-time.factor
@@ -1,23 +1,21 @@
! Copyright (c) 2007 Aaron Schaefer
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays effects inference io kernel math math.functions math.parser
+USING: arrays combinators io kernel math math.functions math.parser
math.statistics namespaces sequences tools.time ;
IN: project-euler.ave-time
<PRIVATE
-: clean-stack ( quot -- )
- infer dup effect-out swap effect-in - [ drop ] times ;
-
: ave-benchmarks ( seq -- pair )
flip [ mean round ] map ;
PRIVATE>
: collect-benchmarks ( quot n -- seq )
- [
- 1- [ [ benchmark ] keep -rot 2array , [ clean-stack ] keep ] times
- ] curry { } make >r benchmark 2array r> swap add ; inline
+ [
+ >r >r datastack r> [ benchmark 2array , ] curry tuck
+ [ with-datastack drop ] 2curry r> swap times call
+ ] { } make ;
: ave-time ( quot n -- )
[ collect-benchmarks ] keep swap ave-benchmarks [
From a9903e1bdc59f2810df1e94a87faf676204e3237 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 28 Dec 2007 13:44:00 +0100
Subject: [PATCH 2/4] Remove some words in math.algebra and change
implementation
---
extra/math/algebra/algebra-docs.factor | 8 ------
extra/math/algebra/algebra-tests.factor | 2 --
extra/math/algebra/algebra.factor | 33 ++-----------------------
3 files changed, 2 insertions(+), 41 deletions(-)
diff --git a/extra/math/algebra/algebra-docs.factor b/extra/math/algebra/algebra-docs.factor
index 14fdc9a505..a623268403 100644
--- a/extra/math/algebra/algebra-docs.factor
+++ b/extra/math/algebra/algebra-docs.factor
@@ -1,14 +1,6 @@
USING: help.markup help.syntax ;
IN: math.algebra
-HELP: ext-euclidian
-{ $values { "a" "a positive integer" } { "b" "a positive integer" } { "gcd" "a positive integer" } { "u" "an integer" } { "v" "an integer" } }
-{ $description "Compute the greatest common divisor " { $snippet "gcd" } " of integers " { $snippet "a" } " and " { $snippet "b" } " using the extended Euclidian algorithm. In addition, this word also computes two other values " { $snippet "u" } " and " { $snippet "v" } " such that " { $snippet "a*u + b*v = gcd" } "." } ;
-
-HELP: ring-inverse
-{ $values { "a" "a positive integer" } { "b" "a positive integer" } { "i" "a positive integer" } }
-{ $description "If " { $snippet "a" } " and " { $snippet "b" } " are coprime, " { $snippet "i" } " is the smallest positive integer such as " { $snippet "a*i = 1" } " in ring " { $snippet "Z/bZ" } "." } ;
-
HELP: chinese-remainder
{ $values { "aseq" "a sequence of integers" } { "nseq" "a sequence of positive integers" } { "x" "an integer" } }
{ $description "If " { $snippet "nseq" } " integers are pairwise coprimes, " { $snippet "x" } " is the smallest positive integer congruent to each element in " { $snippet "aseq" } " modulo the corresponding element in " { $snippet "nseq" } "." } ;
diff --git a/extra/math/algebra/algebra-tests.factor b/extra/math/algebra/algebra-tests.factor
index 86b513aecd..51aa97995c 100644
--- a/extra/math/algebra/algebra-tests.factor
+++ b/extra/math/algebra/algebra-tests.factor
@@ -1,5 +1,3 @@
USING: math.algebra tools.test ;
-{ 2 5 -2 } [ 10 24 ext-euclidian ] unit-test
-{ 17 } [ 19 23 ring-inverse ] unit-test
{ 11 } [ { 2 3 1 } { 3 4 5 } chinese-remainder ] unit-test
diff --git a/extra/math/algebra/algebra.factor b/extra/math/algebra/algebra.factor
index 0dfd086e70..8bb8420d1a 100644
--- a/extra/math/algebra/algebra.factor
+++ b/extra/math/algebra/algebra.factor
@@ -1,37 +1,8 @@
! Copyright (c) 2007 Samuel Tardieu
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.ranges namespaces sequences vars ;
+USING: kernel math math.functions sequences ;
IN: math.algebra
-<PRIVATE
-
-! The traditional name for the first variable is "r", but we want to avoid
-! a redefinition of "r>" and ">r", so we chose to use "s" instead.
-
-VARS: s-1 u-1 v-1 s u v ;
-
-: init ( a b -- )
- >s >s-1 0 >u 1 >u-1 1 >v 0 >v-1 ;
-
-: advance ( r u v -- )
- v> >v-1 >v u> >u-1 >u s> >s-1 >s ; inline
-
-: step ( -- )
- s-1> s> 2dup /mod drop [ * - ] keep u-1> over u> * - v-1> rot v> * -
- advance ;
-
-PRIVATE>
-
-! Extended Euclidian: http://en.wikipedia.org/wiki/Extended_Euclidean_algorithm
-: ext-euclidian ( a b -- gcd u v )
- [ init [ s> 0 > ] [ step ] [ ] while s-1> u-1> v-1> ] with-scope ; foldable
-
-! Inverse a in ring Z/bZ
-: ring-inverse ( a b -- i )
- [ ext-euclidian drop nip ] keep rem ; foldable
-
-! Chinese remainder: http://en.wikipedia.org/wiki/Chinese_remainder_theorem
: chinese-remainder ( aseq nseq -- x )
dup product
- [ [ over / [ ext-euclidian ] keep * 2nip * ] curry 2map sum ] keep rem ;
- foldable
+ [ [ over / [ swap gcd drop ] keep * * ] curry 2map sum ] keep rem ; foldable
From a680c3abc5e4ebc55fa3bc5727a767687670004b Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 28 Dec 2007 14:18:15 +0100
Subject: [PATCH 3/4] Fix bug in project Euler 134 and update timings wrt
math.algebra code changes
---
extra/project-euler/134/134.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor
index 90d8404760..55f8a8dab8 100644
--- a/extra/project-euler/134/134.factor
+++ b/extra/project-euler/134/134.factor
@@ -34,9 +34,9 @@ IN: project-euler.134
over 0 2array rot next-power-of-10 rot 2array chinese-remainder ;
: euler134 ( -- answer )
- 5 lprimes-from [ 1000000 > ] luntil [ [ s + ] keep ] leach drop ;
+ 0 5 lprimes-from uncons [ 1000000 > ] luntil [ [ s + ] keep ] leach drop ;
! [ euler134 ] 10 ave-time
-! 6743 ms run / 79 ms GC ave time - 10 trials
+! 3797 ms run / 30 ms GC ave time - 10 trials
MAIN: euler134
From 483028cc518581dca0a236b1accea700957519a2 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 28 Dec 2007 14:52:11 +0100
Subject: [PATCH 4/4] Update problems list and simplify code
---
extra/project-euler/project-euler.factor | 25 +++++++++++-------------
1 file changed, 11 insertions(+), 14 deletions(-)
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index c35101785a..601acb70b5 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -1,11 +1,14 @@
! 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
+USING: definitions io io.files kernel math.parser sequences strings
+ vocabs vocabs.loader
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.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 ;
IN: project-euler
<PRIVATE
@@ -15,22 +18,16 @@ IN: project-euler
print readln string>number ;
: number>euler ( n -- str )
- number>string string>digits 3 0 pad-left [ number>string ] map concat ;
+ number>string 3 CHAR: 0 pad-left ;
-: solution-path ( n -- str )
- number>euler dup [
- "project-euler" vocab-root ?resource-path %
- os "windows" = [
- "\\project-euler\\" % % "\\" % % ".factor" %
- ] [
- "/project-euler/" % % "/" % % ".factor" %
- ] if
- ] "" make ;
+: solution-path ( n -- str/f )
+ number>euler "project-euler." swap append vocab where
+ dup [ first ?resource-path ] when ;
PRIVATE>
: problem-solved? ( n -- ? )
- solution-path exists? ;
+ solution-path ;
: run-project-euler ( -- )
problem-prompt dup problem-solved? [