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 -" 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 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 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 : 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 [ 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 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? [