From ab7849f71105559a337f81f408cdecccb48bc8f9 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Fri, 18 Jan 2008 17:11:06 -0500 Subject: [PATCH 01/20] Use vectors instead of arrays in solution to Project Euler problem 2 --- extra/project-euler/002/002.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index b9375b7d1e..55c1b153cc 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -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 ; From 827faa205c661af763dd916385330475a2dac8b0 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Fri, 18 Jan 2008 20:07:41 -0500 Subject: [PATCH 02/20] Alternate solution to Project Euler problem 2 --- extra/project-euler/002/002.factor | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index 55c1b153cc..b0b21e76e1 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! 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 @@ -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 From 3355b075bbd3b5c3f68162e92835bcdffc70686b Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 19 Jan 2008 15:19:21 -0500 Subject: [PATCH 03/20] Add attribution for alternate solution on PE problem 2 --- extra/project-euler/002/002.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index b0b21e76e1..0b8f773887 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -1,4 +1,4 @@ -! 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 shuffle ; IN: project-euler.002 From 654574181b0c3e5fd481192cc7c10fdfd44018c4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 20 Jan 2008 09:52:50 -0700 Subject: [PATCH 04/20] fix up some old code --- extra/hexdump/hexdump.factor | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) 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 ; - From 6812eac271fa5beea592ef9630e5371f4e3ca168 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sun, 20 Jan 2008 19:20:28 -0500 Subject: [PATCH 05/20] Solution to Project Euler problem 30 --- extra/project-euler/030/030.factor | 46 ++++++++++++++++++++++++ extra/project-euler/common/common.factor | 2 +- extra/project-euler/project-euler.factor | 4 +-- 3 files changed, 49 insertions(+), 3 deletions(-) create mode 100644 extra/project-euler/030/030.factor diff --git a/extra/project-euler/030/030.factor b/extra/project-euler/030/030.factor new file mode 100644 index 0000000000..854b7ca5ca --- /dev/null +++ b/extra/project-euler/030/030.factor @@ -0,0 +1,46 @@ +! Copyright (c) 2007 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/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 Date: Sun, 20 Jan 2008 22:30:58 -0500 Subject: [PATCH 06/20] Solution to Project Euler problem 31 --- extra/project-euler/031/031.factor | 63 ++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 extra/project-euler/031/031.factor diff --git a/extra/project-euler/031/031.factor b/extra/project-euler/031/031.factor new file mode 100644 index 0000000000..b4402d8904 --- /dev/null +++ b/extra/project-euler/031/031.factor @@ -0,0 +1,63 @@ +! Copyright (c) 2007 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 From 62415768cad61332ea1768e3bb6ee6a1405807dc Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 21 Jan 2008 22:36:20 -0500 Subject: [PATCH 07/20] Minor tweak to math.text.english --- extra/math/text/english/english.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) 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 ; + From 7fbee3e810fc8598f899ca74c198461270f91450 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 22 Jan 2008 00:08:27 -0500 Subject: [PATCH 08/20] Solutions to Project Euler problem 32 --- extra/project-euler/032/032.factor | 81 ++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100644 extra/project-euler/032/032.factor diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor new file mode 100644 index 0000000000..f4d5704e21 --- /dev/null +++ b/extra/project-euler/032/032.factor @@ -0,0 +1,81 @@ +! Copyright (c) 2007 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 From cd92504288148cf80310bd553372bf9421d4a2c7 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 22 Jan 2008 17:02:02 -0500 Subject: [PATCH 09/20] Fix copyright date on PE solutions after the new year --- extra/project-euler/023/023.factor | 2 +- extra/project-euler/024/024.factor | 2 +- extra/project-euler/025/025.factor | 2 +- extra/project-euler/026/026.factor | 2 +- extra/project-euler/027/027.factor | 2 +- extra/project-euler/028/028.factor | 2 +- extra/project-euler/029/029.factor | 2 +- extra/project-euler/030/030.factor | 2 +- extra/project-euler/031/031.factor | 2 +- extra/project-euler/032/032.factor | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) 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..4eed8b55cb 100644 --- a/extra/project-euler/025/025.factor +++ b/extra/project-euler/025/025.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: alien.syntax kernel math math.functions math.parser math.ranges memoize project-euler.common sequences ; 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 index 854b7ca5ca..22d05524b2 100644 --- a/extra/project-euler/030/030.factor +++ b/extra/project-euler/030/030.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.functions project-euler.common sequences ; IN: project-euler.030 diff --git a/extra/project-euler/031/031.factor b/extra/project-euler/031/031.factor index b4402d8904..4be866dc03 100644 --- a/extra/project-euler/031/031.factor +++ b/extra/project-euler/031/031.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 ; IN: project-euler.031 diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor index f4d5704e21..67a8befb0a 100644 --- a/extra/project-euler/032/032.factor +++ b/extra/project-euler/032/032.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 hashtables kernel math math.combinatorics math.parser math.ranges project-euler.common project-euler.024 sequences sorting ; From 817dfbfbbe18e67da2ee361fc1045e862b1aa34b Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 22 Jan 2008 17:17:04 -0500 Subject: [PATCH 10/20] Add summary for Miller-Rabin vocab, and cleanup tests --- extra/math/miller-rabin/miller-rabin-tests.factor | 4 ++-- extra/math/miller-rabin/summary.txt | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) create mode 100644 extra/math/miller-rabin/summary.txt 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 From cf670bd2348fa84cdd51d94de9b67e54a514a0b1 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 22 Jan 2008 17:37:54 -0500 Subject: [PATCH 11/20] Add summary for math.text --- extra/math/text/summary.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 extra/math/text/summary.txt 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 From 6d5c1bf1d2ce420da8b9ceafe4a396e6acfec361 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Thu, 24 Jan 2008 18:12:39 -0500 Subject: [PATCH 12/20] Add more math.constants --- extra/math/constants/constants-docs.factor | 9 +++++++++ extra/math/constants/constants.factor | 2 ++ 2 files changed, 11 insertions(+) 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 From 6df78419b9930e3d3a95a39a8abb533c333a63e8 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Thu, 24 Jan 2008 18:18:12 -0500 Subject: [PATCH 13/20] Fix uses of new math constants --- extra/golden-section/golden-section.factor | 53 ++++++++++------------ extra/project-euler/025/025.factor | 7 +-- 2 files changed, 27 insertions(+), 33 deletions(-) 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/project-euler/025/025.factor b/extra/project-euler/025/025.factor index 4eed8b55cb..2786d9f0e6 100644 --- a/extra/project-euler/025/025.factor +++ b/extra/project-euler/025/025.factor @@ -1,7 +1,7 @@ ! 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 ; From b5a337bb2a72c6daa5a64127a78ba483dd800a68 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 24 Jan 2008 21:10:17 -0400 Subject: [PATCH 14/20] Fix Linux I/O --- extra/io/unix/launcher/launcher.factor | 2 +- extra/unix/unix.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 3cd21e6c51..769e905b6e 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -84,7 +84,7 @@ M: unix-io process-stream* ! 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/unix/unix.factor b/extra/unix/unix.factor index 16b279765f..f5c484568e 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -13,7 +13,7 @@ TYPEDEF: longlong quad_t TYPEDEF: uint gid_t TYPEDEF: uint in_addr_t TYPEDEF: uint ino_t -TYPEDEF: uint pid_t +TYPEDEF: int pid_t TYPEDEF: uint socklen_t TYPEDEF: uint time_t TYPEDEF: uint uid_t From 0b4be5f0a2e30f9879e9b3106bf79fa7866700d3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Jan 2008 22:41:55 -0600 Subject: [PATCH 15/20] Fix Unix io.launcher --- extra/io/unix/bsd/bsd.factor | 4 ++-- extra/io/unix/kqueue/kqueue.factor | 8 ++++---- extra/io/unix/launcher/launcher.factor | 5 +++-- 3 files changed, 9 insertions(+), 8 deletions(-) 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/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 769e905b6e..50c41380d0 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -3,7 +3,7 @@ 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 ; +parser-combinators memoize promises strings threads ; IN: io.unix.launcher ! Search unix first @@ -78,7 +78,8 @@ 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. From 9cc5f5c78ed1ed0013fab524081de5b95ce7252a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Jan 2008 23:07:14 -0600 Subject: [PATCH 16/20] Fix construct-empty transform --- core/inference/transforms/transforms.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 00d2122a4c3f10419a0a379e0d2861c73ce4c5e5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 24 Jan 2008 23:45:56 -0400 Subject: [PATCH 17/20] Working on Unix io.launcher redirection --- extra/io/launcher/launcher-docs.factor | 30 ++++++++++++++++++++++++++ extra/io/launcher/launcher.factor | 4 ++++ extra/io/unix/files/files.factor | 6 ++++-- extra/io/unix/launcher/launcher.factor | 13 +++++++++++ 4 files changed, 51 insertions(+), 2 deletions(-) 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..fe3244916d 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 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/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 50c41380d0..6439fc0848 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -42,8 +42,21 @@ MEMO: 'arguments' ( -- parser ) : assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ; +: redirect ( obj mode fd -- ) + { + { [ pick not ] [ 3drop ] } + { [ pick +closed+ eq? ] [ close 3drop ] } + { [ t ] [ >r file-mode open dup io-error r> dup2 io-error ] } + } cond ; + +: setup-redirection ( -- ) + +stdin+ get read-flags 0 redirect + +stdout+ get write-flags 1 redirect + +stderr+ get read-flags 2 redirect ; + : spawn-process ( -- ) [ + setup-redirection get-arguments pass-environment? [ get-environment assoc>env exec-args-with-env ] From 62f076d0c3fa2fe1f880449d7473689b9e39e9a8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 24 Jan 2008 23:48:28 -0400 Subject: [PATCH 18/20] Fix FD leak --- extra/io/unix/launcher/launcher.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 6439fc0848..1e4d5fab52 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -42,11 +42,15 @@ MEMO: 'arguments' ( -- parser ) : assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ; +: (redirect) + >r file-mode open dup io-error dup + r> dup2 io-error close drop ; + : redirect ( obj mode fd -- ) { { [ pick not ] [ 3drop ] } { [ pick +closed+ eq? ] [ close 3drop ] } - { [ t ] [ >r file-mode open dup io-error r> dup2 io-error ] } + { [ t ] [ (redirect) ] } } cond ; : setup-redirection ( -- ) From 35f390e8ca17adaa3e277e479e03b135631b49cd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 24 Jan 2008 23:50:00 -0400 Subject: [PATCH 19/20] Remove unnecessary word --- core/io/io-docs.factor | 5 ----- core/io/io.factor | 6 +++--- 2 files changed, 3 insertions(+), 8 deletions(-) mode change 100644 => 100755 core/io/io-docs.factor 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 From d09bc942ac96acbeb1287dd4e143176c4e7f2b56 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Jan 2008 00:21:49 -0600 Subject: [PATCH 20/20] Get file redirection working in Unix io.launcher --- extra/io/launcher/launcher.factor | 2 +- extra/io/unix/launcher/launcher.factor | 19 ++++++++++--------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index fe3244916d..7cf9d51ed0 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -67,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/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 1e4d5fab52..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 threads ; +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,21 +43,21 @@ MEMO: 'arguments' ( -- parser ) : assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ; -: (redirect) +: (redirect) ( path mode fd -- ) >r file-mode open dup io-error dup - r> dup2 io-error close drop ; + r> dup2 io-error close ; : redirect ( obj mode fd -- ) { { [ pick not ] [ 3drop ] } - { [ pick +closed+ eq? ] [ close 3drop ] } - { [ t ] [ (redirect) ] } + { [ 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 read-flags 2 redirect ; + +stderr+ get write-flags 2 redirect ; : spawn-process ( -- ) [