diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index eabe4b8c2a..c4eeb98145 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -74,7 +74,7 @@ M: pair (bitfield-quot) ( spec -- quot ) dup tuple-size [ ] 2curry swap infer-quot ] [ - \ construct-empty declared-infer + \ construct-empty 1 1 make-call-node ] if ] "infer" set-word-prop diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor old mode 100644 new mode 100755 index 5c71714c64..cf867d7945 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -29,7 +29,6 @@ ARTICLE: "stdio" "The default stream" "Various words take an implicit stream parameter from a variable to reduce stack shuffling." { $subsection stdio } "Unless rebound in a child namespace, this variable will be set to a console stream for interacting with the user." -{ $subsection close } { $subsection read1 } { $subsection read } { $subsection read-until } @@ -178,10 +177,6 @@ $io-error ; HELP: stdio { $var-description "Holds a stream, used for various implicit stream operations. Rebound using " { $link with-stream } " and " { $link with-stream* } "." } ; -HELP: close -{ $contract "Closes the " { $link stdio } " stream." } -$io-error ; - HELP: readln { $values { "str/f" "a string or " { $link f } } } { $contract "Reads a line of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." } diff --git a/core/io/io.factor b/core/io/io.factor index 56b284eaaf..edd0fa938f 100755 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -38,8 +38,6 @@ SYMBOL: stdio ! Default error stream SYMBOL: stderr -: close ( -- ) stdio get stream-close ; - : readln ( -- str/f ) stdio get stream-readln ; : read1 ( -- ch/f ) stdio get stream-read1 ; : read ( n -- str/f ) stdio get stream-read ; @@ -56,7 +54,9 @@ SYMBOL: stderr stdio swap with-variable ; inline : with-stream ( stream quot -- ) - swap [ [ close ] [ ] cleanup ] with-stream* ; inline + swap [ + [ stdio get stream-close ] [ ] cleanup + ] with-stream* ; inline : tabular-output ( style quot -- ) swap >r { } make r> stdio get stream-write-table ; inline diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor index 9dd3a747ed..ef6f1ca4c2 100644 --- a/extra/golden-section/golden-section.factor +++ b/extra/golden-section/golden-section.factor @@ -1,28 +1,25 @@ -USING: kernel namespaces math math.constants math.functions -arrays sequences opengl opengl.gl opengl.glu ui ui.render -ui.gadgets ui.gadgets.theme ui.gadgets.slate colors ; +USING: kernel namespaces math math.constants math.functions arrays sequences + opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme + ui.gadgets.slate colors ; IN: golden-section ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! To run: -! -! "demos.golden-section" run +! "golden-section" run ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : disk ( quadric radius center -- ) -glPushMatrix -gl-translate -dup 0 glScalef -0 1 10 10 gluDisk -glPopMatrix ; + glPushMatrix + gl-translate + dup 0 glScalef + 0 1 10 10 gluDisk + glPopMatrix ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: phi ( -- phi ) 5 sqrt 1 + 2 / 1 - ; - -: omega ( i -- omega ) phi * 2 * pi * ; +: omega ( i -- omega ) phi 1- * 2 * pi * ; : x ( i -- x ) dup omega cos * 0.5 * ; @@ -35,10 +32,10 @@ glPopMatrix ; : color ( i -- color ) 360.0 / dup 0.25 1 4array ; : rim ( quadric i -- ) -black gl-color dup radius 1.5 * swap center disk ; + black gl-color dup radius 1.5 * swap center disk ; : inner ( quadric i -- ) -dup color gl-color dup radius swap center disk ; + dup color gl-color dup radius swap center disk ; : dot ( quadric i -- ) 2dup rim inner ; @@ -47,21 +44,21 @@ dup color gl-color dup radius swap center disk ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : with-quadric ( quot -- ) -gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline + gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline : display ( -- ) -GL_PROJECTION glMatrixMode -glLoadIdentity --400 400 -400 400 -1 1 glOrtho -GL_MODELVIEW glMatrixMode -glLoadIdentity -[ golden-section ] with-quadric ; + GL_PROJECTION glMatrixMode + glLoadIdentity + -400 400 -400 400 -1 1 glOrtho + GL_MODELVIEW glMatrixMode + glLoadIdentity + [ golden-section ] with-quadric ; : golden-section-window ( -- ) -[ - [ display ] - { 600 600 } over set-slate-dim - "Golden Section" open-window -] with-ui ; + [ + [ display ] + { 600 600 } over set-slate-dim + "Golden Section" open-window + ] with-ui ; -MAIN: golden-section-window \ No newline at end of file +MAIN: golden-section-window diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor index 57bbbe2481..6a91cd65c5 100644 --- a/extra/hexdump/hexdump.factor +++ b/extra/hexdump/hexdump.factor @@ -1,4 +1,6 @@ -USING: arrays io io.streams.string kernel math math.parser namespaces prettyprint sequences splitting strings ; +USING: arrays combinators.lib io io.streams.string +kernel math math.parser namespaces prettyprint +sequences splitting strings ; IN: hexdump hex write "h" write nl ; -: offset. ( lineno -- ) 16 * >hex 8 CHAR: 0 pad-left write "h: " write ; -: h-pad. ( digit -- ) >hex 2 CHAR: 0 pad-left write ; +: offset. ( lineno -- ) + 16 * >hex 8 CHAR: 0 pad-left write "h: " write ; + +: h-pad. ( digit -- ) + >hex 2 CHAR: 0 pad-left write ; + : line. ( str n -- ) offset. dup [ h-pad. " " write ] each - 16 over length - " " concat write + 16 over length - 3 * CHAR: \s write [ dup printable? [ drop CHAR: . ] unless write1 ] each nl ; @@ -19,9 +25,8 @@ PRIVATE> : hexdump ( seq -- str ) [ dup length header. - 16 dup length [ line. ] 2each + 16 [ line. ] each-index ] string-out ; : hexdump. ( seq -- ) hexdump write ; - diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 2c30431714..495894b25d 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -31,6 +31,36 @@ HELP: +environment-mode+ "Default value is " { $link append-environment } "." } ; +HELP: +stdin+ +{ $description "Launch descriptor key. Must equal one of the following:" + { $list + { { $link f } " - standard input is inherited" } + { { $link +closed+ } " - standard input is closed" } + { "a path name - standard input is read from the given file, which must exist" } + } +} ; + +HELP: +stdout+ +{ $description "Launch descriptor key. Must equal one of the following:" + { $list + { { $link f } " - standard output is inherited" } + { { $link +closed+ } " - standard output is closed" } + { "a path name - standard output is written to the given file, which is overwritten if it already exists" } + } +} ; + +HELP: +stderr+ +{ $description "Launch descriptor key. Must equal one of the following:" + { $list + { { $link f } " - standard error is inherited" } + { { $link +closed+ } " - standard error is closed" } + { "a path name - standard error is written to the given file, which is overwritten if it already exists" } + } +} ; + +HELP: +closed+ +{ $description "Possible value for " { $link +stdin+ } ", " { $link +stdout+ } ", and " { $link +stderr+ } " launch descriptors." } ; + HELP: prepend-environment { $description "Possible value of " { $link +environment-mode+ } " launch descriptor key. The child process environment consists of the value of the " { $link +environment+ } " key together with the current environment, with entries from the current environment taking precedence." $nl diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index c646358b2e..7cf9d51ed0 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -30,6 +30,10 @@ SYMBOL: +arguments+ SYMBOL: +detached+ SYMBOL: +environment+ SYMBOL: +environment-mode+ +SYMBOL: +stdin+ +SYMBOL: +stdout+ +SYMBOL: +stderr+ +SYMBOL: +closed+ SYMBOL: prepend-environment SYMBOL: replace-environment @@ -63,7 +67,7 @@ GENERIC: >descriptor ( obj -- desc ) M: string >descriptor +command+ associate ; M: sequence >descriptor +arguments+ associate ; -M: assoc >descriptor ; +M: assoc >descriptor >hashtable ; HOOK: run-process* io-backend ( desc -- handle ) diff --git a/extra/io/unix/bsd/bsd.factor b/extra/io/unix/bsd/bsd.factor index 3319324c3d..a4315ce5d0 100755 --- a/extra/io/unix/bsd/bsd.factor +++ b/extra/io/unix/bsd/bsd.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. IN: io.unix.bsd USING: io.backend io.unix.backend io.unix.kqueue io.unix.select -io.unix.launcher namespaces kernel assocs threads continuations -; +io.launcher io.unix.launcher namespaces kernel assocs threads +continuations ; ! On *BSD and Mac OS X, we use select() for the top-level ! multiplexer, and we hang a kqueue off of it but file change diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index f9d642d661..b56e62d3c4 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -4,13 +4,15 @@ USING: io.backend io.nonblocking io.unix.backend io.files io unix kernel math continuations ; IN: io.unix.files +: read-flags O_RDONLY ; inline + : open-read ( path -- fd ) O_RDONLY file-mode open dup io-error ; M: unix-io ( path -- stream ) open-read ; -: write-flags O_WRONLY O_CREAT O_TRUNC bitor bitor ; +: write-flags O_WRONLY O_CREAT O_TRUNC bitor bitor ; inline : open-write ( path -- fd ) write-flags file-mode open dup io-error ; @@ -18,7 +20,7 @@ M: unix-io ( path -- stream ) M: unix-io ( path -- stream ) open-write ; -: append-flags O_WRONLY O_APPEND O_CREAT bitor bitor ; +: append-flags O_WRONLY O_APPEND O_CREAT bitor bitor ; inline : open-append ( path -- fd ) append-flags file-mode open dup io-error diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor index 3df2d7cd57..19005df404 100755 --- a/extra/io/unix/kqueue/kqueue.factor +++ b/extra/io/unix/kqueue/kqueue.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.nonblocking io.unix.backend sequences assocs unix unix.kqueue unix.process math namespaces -combinators threads vectors ; +combinators threads vectors io.launcher io.unix.launcher ; IN: io.unix.kqueue TUPLE: kqueue-mx events ; @@ -50,15 +50,15 @@ M: kqueue-mx unregister-io-task ( task mx -- ) : kevent-write-task ( mx fd -- ) over mx-reads at handle-io-task ; -: kevent-proc-task ( mx pid -- ) - dup (wait-for-pid) swap find-process +: kevent-proc-task ( pid -- ) + dup wait-for-pid swap find-process dup [ notify-exit ] [ 2drop ] if ; : handle-kevent ( mx kevent -- ) dup kevent-ident swap kevent-filter { { [ dup EVFILT_READ = ] [ drop kevent-read-task ] } { [ dup EVFILT_WRITE = ] [ drop kevent-write-task ] } - { [ dup EVFILT_PROC = ] [ drop kevent-proc-task ] } + { [ dup EVFILT_PROC = ] [ drop kevent-proc-task drop ] } } cond ; : handle-kevents ( mx n -- ) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 3cd21e6c51..0135b55a7e 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.backend io.launcher io.unix.backend io.nonblocking -sequences kernel namespaces math system alien.c-types debugger -continuations arrays assocs combinators unix.process -parser-combinators memoize promises strings ; +USING: io io.backend io.launcher io.unix.backend io.unix.files +io.nonblocking sequences kernel namespaces math system + alien.c-types debugger continuations arrays assocs +combinators unix.process parser-combinators memoize +promises strings threads ; IN: io.unix.launcher ! Search unix first @@ -42,8 +43,25 @@ MEMO: 'arguments' ( -- parser ) : assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ; +: (redirect) ( path mode fd -- ) + >r file-mode open dup io-error dup + r> dup2 io-error close ; + +: redirect ( obj mode fd -- ) + { + { [ pick not ] [ 3drop ] } + { [ pick +closed+ eq? ] [ close 2drop ] } + { [ pick string? ] [ (redirect) ] } + } cond ; + +: setup-redirection ( -- ) + +stdin+ get read-flags 0 redirect + +stdout+ get write-flags 1 redirect + +stderr+ get write-flags 2 redirect ; + : spawn-process ( -- ) [ + setup-redirection get-arguments pass-environment? [ get-environment assoc>env exec-args-with-env ] @@ -78,13 +96,14 @@ M: unix-io process-stream* ] with-descriptor ; : find-process ( handle -- process ) - f process construct-boa processes get at ; + processes get swap [ nip swap process-handle = ] curry + assoc-find 2drop ; ! Inefficient process wait polling, used on Linux and Solaris. ! On BSD and Mac OS X, we use kqueue() which scales better. : wait-for-processes ( -- ? ) -1 0 tuck WNOHANG waitpid - dup zero? [ + dup 0 <= [ 2drop t ] [ find-process dup [ diff --git a/extra/math/constants/constants-docs.factor b/extra/math/constants/constants-docs.factor index 92c96985c3..653444376a 100755 --- a/extra/math/constants/constants-docs.factor +++ b/extra/math/constants/constants-docs.factor @@ -4,6 +4,8 @@ IN: math.constants ARTICLE: "math-constants" "Constants" "Standard mathematical constants:" { $subsection e } +{ $subsection gamma } +{ $subsection phi } { $subsection pi } "Various limits:" { $subsection most-positive-fixnum } @@ -15,6 +17,13 @@ ABOUT: "math-constants" HELP: e { $values { "e" "base of natural logarithm" } } ; +HELP: gamma +{ $values { "gamma" "Euler-Mascheroni constant" } } +{ $description "The Euler-Mascheroni constant, also called \"Euler's constant\" or \"the Euler constant\"." } ; + +HELP: phi +{ $values { "phi" "golden ratio" } } ; + HELP: pi { $values { "pi" "circumference of circle with diameter 1" } } ; diff --git a/extra/math/constants/constants.factor b/extra/math/constants/constants.factor index e2d7c4f433..7e2b8842ad 100755 --- a/extra/math/constants/constants.factor +++ b/extra/math/constants/constants.factor @@ -3,5 +3,7 @@ IN: math.constants : e ( -- e ) 2.7182818284590452354 ; inline +: gamma ( -- gamma ) 0.57721566490153286060 ; inline : pi ( -- pi ) 3.14159265358979323846 ; inline +: phi ( -- phi ) 1.61803398874989484820 ; inline : epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline diff --git a/extra/math/miller-rabin/miller-rabin-tests.factor b/extra/math/miller-rabin/miller-rabin-tests.factor index 42e4164ef3..f8bc9d4970 100644 --- a/extra/math/miller-rabin/miller-rabin-tests.factor +++ b/extra/math/miller-rabin/miller-rabin-tests.factor @@ -1,4 +1,5 @@ -USING: math.miller-rabin kernel math namespaces tools.test ; +USING: math.miller-rabin tools.test ; +IN: temporary [ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test [ t ] [ 2 miller-rabin ] unit-test @@ -7,4 +8,3 @@ USING: math.miller-rabin kernel math namespaces tools.test ; [ t ] [ 37 miller-rabin ] unit-test [ 101 ] [ 100 next-prime ] unit-test [ 100000000000031 ] [ 100000000000000 next-prime ] unit-test - diff --git a/extra/math/miller-rabin/summary.txt b/extra/math/miller-rabin/summary.txt new file mode 100644 index 0000000000..b2591a3182 --- /dev/null +++ b/extra/math/miller-rabin/summary.txt @@ -0,0 +1 @@ +Miller-Rabin probabilistic primality test diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor index a6179382bd..645d7e2054 100644 --- a/extra/math/text/english/english.factor +++ b/extra/math/text/english/english.factor @@ -12,10 +12,10 @@ IN: math.text.english "Seventeen" "Eighteen" "Nineteen" } nth ; : tens ( n -- str ) - { "" "" "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ; + { f f "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ; : scale-numbers ( n -- str ) ! up to 10^99 - { "" "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion" + { f "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion" "Sextillion" "Septillion" "Octillion" "Nonillion" "Decillion" "Undecillion" "Duodecillion" "Tredecillion" "Quattuordecillion" "Quindecillion" "Sexdecillion" "Septendecillion" "Octodecillion" "Novemdecillion" @@ -45,7 +45,7 @@ SYMBOL: and-needed? : tens-place ( n -- str ) 100 mod dup 20 >= [ - 10 /mod >r tens r> + 10 /mod [ tens ] dip dup zero? [ drop ] [ "-" swap small-numbers 3append ] if ] [ dup zero? [ drop "" ] [ small-numbers ] if @@ -97,3 +97,4 @@ PRIVATE> ] [ [ (number>text) ] with-scope ] if ; + diff --git a/extra/math/text/summary.txt b/extra/math/text/summary.txt new file mode 100644 index 0000000000..95dc6939e2 --- /dev/null +++ b/extra/math/text/summary.txt @@ -0,0 +1 @@ +Convert integers to text in multiple languages diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index b9375b7d1e..0b8f773887 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -1,6 +1,6 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2007 Aaron Schaefer, Alexander Solovyov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math sequences ; +USING: kernel math sequences shuffle ; IN: project-euler.002 ! http://projecteuler.net/index.php?section=problems&id=2 @@ -22,12 +22,12 @@ IN: project-euler.002 r add dup 2 tail* sum r> (fib-upto) ] [ 2drop ] if ; + 2dup <= [ [ over push dup 2 tail* sum ] dip (fib-upto) ] [ 2drop ] if ; PRIVATE> : fib-upto ( n -- seq ) - { 0 } 1 rot (fib-upto) ; + V{ 0 } clone 1 rot (fib-upto) ; : euler002 ( -- answer ) 1000000 fib-upto [ even? ] subset sum ; @@ -35,4 +35,18 @@ PRIVATE> ! [ euler002 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials -MAIN: euler002 + +! ALTERNATE SOLUTIONS +! ------------------- + +: fib-upto* ( n -- seq ) + 0 1 [ pick over >= ] [ tuck + dup ] [ ] unfold 3nip + 1 head-slice* { 0 1 } swap append ; + +: euler002a ( -- answer ) + 1000000 fib-upto* [ even? ] subset sum ; + +! [ euler002a ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler002a diff --git a/extra/project-euler/023/023.factor b/extra/project-euler/023/023.factor index 06f6555ea3..526bb4c446 100644 --- a/extra/project-euler/023/023.factor +++ b/extra/project-euler/023/023.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: hashtables kernel math math.ranges project-euler.common sequences sorting ; diff --git a/extra/project-euler/024/024.factor b/extra/project-euler/024/024.factor index 44434b4a88..230aea02b9 100644 --- a/extra/project-euler/024/024.factor +++ b/extra/project-euler/024/024.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.parser math.ranges namespaces sequences ; IN: project-euler.024 diff --git a/extra/project-euler/025/025.factor b/extra/project-euler/025/025.factor index 2819e210a7..2786d9f0e6 100644 --- a/extra/project-euler/025/025.factor +++ b/extra/project-euler/025/025.factor @@ -1,7 +1,7 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel math math.functions math.parser math.ranges memoize - project-euler.common sequences ; +USING: alien.syntax kernel math math.constants math.functions math.parser + math.ranges memoize project-euler.common sequences ; IN: project-euler.025 ! http://projecteuler.net/index.php?section=problems&id=25 @@ -67,9 +67,6 @@ PRIVATE> integer ; diff --git a/extra/project-euler/026/026.factor b/extra/project-euler/026/026.factor index d79effed02..3ad1908aa6 100644 --- a/extra/project-euler/026/026.factor +++ b/extra/project-euler/026/026.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.functions math.primes math.ranges sequences ; IN: project-euler.026 diff --git a/extra/project-euler/027/027.factor b/extra/project-euler/027/027.factor index c208caaf9e..2bc7894684 100644 --- a/extra/project-euler/027/027.factor +++ b/extra/project-euler/027/027.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.primes project-euler.common sequences ; IN: project-euler.027 diff --git a/extra/project-euler/028/028.factor b/extra/project-euler/028/028.factor index 5d20032ea9..c8ac19ef82 100644 --- a/extra/project-euler/028/028.factor +++ b/extra/project-euler/028/028.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: combinators.lib kernel math math.ranges ; IN: project-euler.028 diff --git a/extra/project-euler/029/029.factor b/extra/project-euler/029/029.factor index 47855c0bf1..459a3a4bd6 100644 --- a/extra/project-euler/029/029.factor +++ b/extra/project-euler/029/029.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007 Aaron Schaefer. +! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: hashtables kernel math.functions math.ranges project-euler.common sequences ; diff --git a/extra/project-euler/030/030.factor b/extra/project-euler/030/030.factor new file mode 100644 index 0000000000..22d05524b2 --- /dev/null +++ b/extra/project-euler/030/030.factor @@ -0,0 +1,46 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators.lib kernel math math.functions project-euler.common sequences ; +IN: project-euler.030 + +! http://projecteuler.net/index.php?section=problems&id=30 + +! DESCRIPTION +! ----------- + +! Surprisingly there are only three numbers that can be written as the sum of +! fourth powers of their digits: + +! 1634 = 1^4 + 6^4 + 3^4 + 4^4 +! 8208 = 8^4 + 2^4 + 0^4 + 8^4 +! 9474 = 9^4 + 4^4 + 7^4 + 4^4 + +! As 1 = 1^4 is not a sum it is not included. + +! The sum of these numbers is 1634 + 8208 + 9474 = 19316. + +! Find the sum of all the numbers that can be written as the sum of fifth +! powers of their digits. + + +! SOLUTION +! -------- + +! if n is the number of digits +! n * 9^5 = 10^n when n ≈ 5.513 +! 10^5.513 ≈ 325537 + +digits [ 5 ^ ] sigma ; + +PRIVATE> + +: euler030 ( -- answer ) + 325537 [ dup sum-fifth-powers = ] subset sum 1- ; + +! [ euler030 ] 100 ave-time +! 2537 ms run / 125 ms GC ave time - 100 trials + +MAIN: euler030 diff --git a/extra/project-euler/031/031.factor b/extra/project-euler/031/031.factor new file mode 100644 index 0000000000..4be866dc03 --- /dev/null +++ b/extra/project-euler/031/031.factor @@ -0,0 +1,63 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math ; +IN: project-euler.031 + +! http://projecteuler.net/index.php?section=problems&id=31 + +! DESCRIPTION +! ----------- + +! In England the currency is made up of pound, £, and pence, p, and there are +! eight coins in general circulation: + +! 1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) and £2 (200p). + +! It is possible to make £2 in the following way: + +! 1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p + +! How many different ways can £2 be made using any number of coins? + + + +! SOLUTION +! -------- + += [ [ 2 - 2p ] keep 1p + ] [ drop 0 ] if ; + +: 5p ( m -- n ) + dup 0 >= [ [ 5 - 5p ] keep 2p + ] [ drop 0 ] if ; + +: 10p ( m -- n ) + dup 0 >= [ [ 10 - 10p ] keep 5p + ] [ drop 0 ] if ; + +: 20p ( m -- n ) + dup 0 >= [ [ 20 - 20p ] keep 10p + ] [ drop 0 ] if ; + +: 50p ( m -- n ) + dup 0 >= [ [ 50 - 50p ] keep 20p + ] [ drop 0 ] if ; + +: 100p ( m -- n ) + dup 0 >= [ [ 100 - 100p ] keep 50p + ] [ drop 0 ] if ; + +: 200p ( m -- n ) + dup 0 >= [ [ 200 - 200p ] keep 100p + ] [ drop 0 ] if ; + +PRIVATE> + +: euler031 ( -- answer ) + 200 200p ; + +! [ euler031 ] 100 ave-time +! 4 ms run / 0 ms GC ave time - 100 trials + +! TODO: generalize to eliminate duplication; use a sequence to specify denominations? + +MAIN: euler031 diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor new file mode 100644 index 0000000000..67a8befb0a --- /dev/null +++ b/extra/project-euler/032/032.factor @@ -0,0 +1,81 @@ +! 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 project-euler.024 sequences sorting ; +IN: project-euler.032 + +! http://projecteuler.net/index.php?section=problems&id=32 + +! DESCRIPTION +! ----------- + +! The product 7254 is unusual, as the identity, 39 × 186 = 7254, containing +! multiplicand, multiplier, and product is 1 through 9 pandigital. + +! Find the sum of all products whose multiplicand/multiplier/product identity +! can be written as a 1 through 9 pandigital. + +! HINT: Some products can be obtained in more than one way so be sure to only +! include it once in your sum. + + +! SOLUTION +! -------- + +! Generate all pandigital numbers and then check if they fit the identity + +integer ] map ; + +: 1and4 ( n -- ? ) + number>string 1 cut-slice 4 cut-slice + [ 10 string>integer ] 3apply [ * ] dip = ; + +: 2and3 ( n -- ? ) + number>string 2 cut-slice 3 cut-slice + [ 10 string>integer ] 3apply [ * ] dip = ; + +: valid? ( n -- ? ) + dup 1and4 swap 2and3 or ; + +: products ( seq -- m ) + [ number>string 4 tail* 10 string>integer ] map ; + +PRIVATE> + +: euler032 ( -- answer ) + source-032 [ valid? ] subset products prune sum ; + +! [ euler032 ] 10 ave-time +! 27609 ms run / 2484 ms GC ave time - 10 trials + + +! ALTERNATE SOLUTIONS +! ------------------- + +! Generate all reasonable multiplicand/multiplier pairs, then multiply and see +! if the equation is pandigital + +string natural-sort "123456789" = ; + +! multiplicand/multiplier/product +: mmp ( pair -- n ) + first2 2dup * [ number>string ] 3apply 3append 10 string>integer ; + +PRIVATE> + +: euler032a ( -- answer ) + source-032a [ mmp ] map [ pandigital? ] subset products prune sum ; + +! [ euler032a ] 100 ave-time +! 5978 ms run / 327 ms GC ave time - 100 trials + +MAIN: euler032a diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index d21a780773..c875a440ba 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -11,7 +11,7 @@ IN: project-euler.common ! collect-consecutive - #8, #11 ! log10 - #25, #134 ! max-path - #18, #67 -! number>digits - #16, #20 +! number>digits - #16, #20, #30 ! propagate-all - #18, #67 ! sum-proper-divisors - #21 ! tau* - #12 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 513eeba020..329a1b9668 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -9,8 +9,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs project-euler.017 project-euler.018 project-euler.019 project-euler.020 project-euler.021 project-euler.022 project-euler.023 project-euler.024 project-euler.025 project-euler.026 project-euler.027 project-euler.028 - project-euler.029 project-euler.067 project-euler.134 project-euler.169 - project-euler.173 project-euler.175 ; + project-euler.029 project-euler.030 project-euler.067 project-euler.134 + project-euler.169 project-euler.173 project-euler.175 ; IN: project-euler