]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorAaron Schaefer <aaron@elasticdog.com>
Tue, 5 May 2009 16:16:03 +0000 (12:16 -0400)
committerAaron Schaefer <aaron@elasticdog.com>
Tue, 5 May 2009 16:16:03 +0000 (12:16 -0400)
13 files changed:
extra/benchmark/pidigits/pidigits.factor
extra/poker/poker-tests.factor
extra/poker/poker.factor
extra/project-euler/001/001.factor
extra/project-euler/005/005.factor
extra/project-euler/018/018.factor
extra/project-euler/027/027.factor
extra/project-euler/030/030.factor
extra/project-euler/032/032.factor
extra/project-euler/048/048.factor
extra/project-euler/055/055.factor
extra/project-euler/057/057.factor
extra/project-euler/150/150.factor

index 5de5cc5e9945b1cee1ebd73ce90b3ee87bfacc82..0f8a98e6f9dede654385dd0e5472d0702acf1546 100644 (file)
@@ -18,7 +18,7 @@ IN: benchmark.pidigits
 : >matrix ( q s r t -- z )
     4array 2 group ;
 
-: produce ( z n -- z' )
+: produce ( z y -- z' )
     [ 10 ] dip -10 * 0 1 >matrix swap m. ;
 
 : gen-x ( x -- matrix )
index ad371a6bff6d8084d68e554bd7a71665eea9f12a..e2d89620e63e22de25b32b37ebdbee45c7b6c4db 100644 (file)
@@ -1,4 +1,4 @@
-USING: accessors poker poker.private tools.test math.order kernel ;
+USING: accessors kernel math.order poker poker.private tools.test ;
 IN: poker.tests
 
 [ 134236965 ] [ "KD" >ckf ] unit-test
index e8e9fa23c5e9cf25ded89c01c287ffe5c35eca2b..15e9a96d42f55d52d9a43f8ce991db7eca164fae 100644 (file)
@@ -1,7 +1,9 @@
-! Copyright (c) 2009 Aaron Schaefer.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii binary-search combinators kernel locals math
-    math.bitwise math.order poker.arrays sequences splitting ;
+! Copyright (c) 2009 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: accessors arrays ascii binary-search combinators kernel locals math
+    math.bitwise math.order poker.arrays random sequences sequences.product
+    splitting ;
 IN: poker
 
 ! The algorithm used is based on Cactus Kev's Poker Hand Evaluator with
@@ -57,6 +59,8 @@ CONSTANT: TWO_PAIR         7
 CONSTANT: ONE_PAIR         8
 CONSTANT: HIGH_CARD        9
 
+CONSTANT: SUIT_STR { "C" "D" "H" "S" }
+
 CONSTANT: RANK_STR { "2" "3" "4" "5" "6" "7" "8" "9" "T" "J" "Q" "K" "A" }
 
 CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
@@ -108,6 +112,9 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
     #! Cactus Kev Format
     >upper 1 cut (>ckf) ;
 
+: parse-cards ( str -- seq )
+    " " split [ >ckf ] map ;
+
 : flush? ( cards -- ? )
     HEX: F000 [ bitand ] reduce 0 = not ;
 
@@ -165,6 +172,9 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
         [ drop STRAIGHT_FLUSH ]                      !   10 straight-flushes
     } cond ;
 
+: card>string ( card -- str )
+    [ >card-rank ] [ >card-suit ] bi append ;
+
 PRIVATE>
 
 TUPLE: hand
@@ -176,13 +186,16 @@ M: hand equal?
     over hand? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
 
 : <hand> ( str -- hand )
-    " " split [ >ckf ] map
-    dup hand-value hand boa ;
+    parse-cards dup hand-value hand boa ;
 
 : >cards ( hand -- str )
-    cards>> [
-        [ >card-rank ] [ >card-suit ] bi append
-    ] map " " join ;
+    cards>> [ card>string ] map " " join ;
 
 : >value ( hand -- str )
     hand-rank VALUE_STR nth ;
+
+: <deck> ( -- deck )
+    RANK_STR SUIT_STR 2array [ concat >ckf ] product-map ;
+
+ALIAS: shuffle randomize
+
index 0d4f5fb1bdddbbc5e5fd92c50048be95cd4b49c5..204527418b2828de68ede1571adb1a49cdaf6111 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (c) 2007, 2008 Aaron Schaefer, Slava Pestov.
+! Copyright (c) 2007-2009 Aaron Schaefer, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions math.ranges project-euler.common sequences
     sets ;
@@ -47,14 +47,14 @@ PRIVATE>
 
 
 : euler001b ( -- answer )
-    1000 [ [ 5 mod ] [ 3 mod ] bi [ 0 = ] either? ] filter sum ;
+    1000 [0,b) [ [ 5 mod ] [ 3 mod ] bi [ 0 = ] either? ] filter sum ;
 
 ! [ euler001b ] 100 ave-time
 ! 0 ms ave run time - 0.06 SD (100 trials)
 
 
 : euler001c ( -- answer )
-    1000 [ { 3 5 } [ divisor? ] with any? ] filter sum ;
+    1000 [0,b) [ { 3 5 } [ divisor? ] with any? ] filter sum ;
 
 ! [ euler001c ] 100 ave-time
 ! 0 ms ave run time - 0.06 SD (100 trials)
index 7fef29a6b9d73be55a9c70923485db6c50df537e..8512bc97fa42aa3334edfc407e45d50a7b69c9eb 100644 (file)
@@ -1,6 +1,6 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2009 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math math.functions sequences project-euler.common ;
+USING: math math.functions math.ranges project-euler.common sequences ;
 IN: project-euler.005
 
 ! http://projecteuler.net/index.php?section=problems&id=5
@@ -18,7 +18,7 @@ IN: project-euler.005
 ! --------
 
 : euler005 ( -- answer )
-    20 1 [ 1+ lcm ] reduce ;
+    20 [1,b] 1 [ lcm ] reduce ;
 
 ! [ euler005 ] 100 ave-time
 ! 0 ms ave run time - 0.14 SD (100 trials)
index 9c7c4fee74d18667c27079fe4a954994480a99d0..9189323121a28479e0e881bb1da28d9ba36a688a 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math project-euler.common sequences ;
+USING: kernel math math.ranges project-euler.common sequences ;
 IN: project-euler.018
 
 ! http://projecteuler.net/index.php?section=problems&id=18
@@ -66,7 +66,7 @@ IN: project-euler.018
            91  71  52  38  17  14  91  43  58  50  27  29  48
          63  66  04  68  89  53  67  30  73  16  69  87  40  31
        04  62  98  27  23  09  70  98  73  93  38  53  60  04  23
-     } 15 iota [ 1+ cut swap ] map nip ;
+     } 15 [1,b] [ cut swap ] map nip ;
 
 PRIVATE>
 
index 4bcfb66a9405d73726179abfbca50f8d673c20ee..f7bffbf66587d55452c1015796e34c44d7953c46 100644 (file)
@@ -1,7 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.primes project-euler.common sequences
-project-euler.common ;
+USING: kernel math math.primes math.ranges project-euler.common sequences ;
 IN: project-euler.027
 
 ! http://projecteuler.net/index.php?section=problems&id=27
@@ -47,7 +46,7 @@ IN: project-euler.027
 <PRIVATE
 
 : source-027 ( -- seq )
-    1000 [ prime? ] filter [ dup [ neg ] map append ] keep
+    1000 [0,b) [ prime? ] filter [ dup [ neg ] map append ] keep
     cartesian-product [ first2 < ] filter ;
 
 : quadratic ( b a n -- m )
index 54d48660d5af251e7caf7124892f12c0bebd9122..2a75336a0d4c3c9e9ac8b45cea2d2f53a9217648 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions project-euler.common sequences ;
+USING: kernel math math.functions math.ranges project-euler.common sequences ;
 IN: project-euler.030
 
 ! http://projecteuler.net/index.php?section=problems&id=30
@@ -38,7 +38,7 @@ IN: project-euler.030
 PRIVATE>
 
 : euler030 ( -- answer )
-    325537 [ dup sum-fifth-powers = ] filter sum 1- ;
+    325537 [0,b) [ dup sum-fifth-powers = ] filter sum 1- ;
 
 ! [ euler030 ] 100 ave-time
 ! 1700 ms ave run time - 64.84 SD (100 trials)
index 64c9ec445e373a6b4c40b71d19c05bcef77a4cad..814f8a5a6382d92187e616db9901315fc33d8a6e 100755 (executable)
@@ -28,7 +28,7 @@ IN: project-euler.032
 
 : source-032 ( -- seq )
     9 factorial iota [
-        9 permutation [ 1+ ] map 10 digits>integer
+        9 permutation [ 1 + ] map 10 digits>integer
     ] map ;
 
 : 1and4 ( n -- ? )
index e56b9e9548bd99a70e19e4262234e9b183b6b3ce..640a3a68f69efe0549e752388b9dc10bf259e493 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions sequences project-euler.common ;
+USING: kernel math math.functions math.ranges project-euler.common sequences ;
 IN: project-euler.048
 
 ! http://projecteuler.net/index.php?section=problems&id=48
@@ -17,7 +17,7 @@ IN: project-euler.048
 ! --------
 
 : euler048 ( -- answer )
-    1000 [ 1+ dup ^ ] sigma 10 10 ^ mod ;
+    1000 [1,b] [ dup ^ ] sigma 10 10 ^ mod ;
 
 ! [ euler048 ] 100 ave-time
 ! 276 ms run / 1 ms GC ave time - 100 trials
index 43f380b3ba820de37a836288f8b00fbd213eceae..07525fe6a49fdfaee5940b219b2ecbc060af2907 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.parser project-euler.common sequences ;
+USING: kernel math math.parser math.ranges project-euler.common sequences ;
 IN: project-euler.055
 
 ! http://projecteuler.net/index.php?section=problems&id=55
@@ -61,7 +61,7 @@ IN: project-euler.055
 PRIVATE>
 
 : euler055 ( -- answer )
-    10000 [ lychrel? ] count ;
+    10000 [0,b) [ lychrel? ] count ;
 
 ! [ euler055 ] 100 ave-time
 ! 478 ms ave run time - 30.63 SD (100 trials)
index 681a17dd9ec2fe17434d74e380e77e868be72996..97789944fe9b74ced76c1bfa7c19f53110f55273 100644 (file)
@@ -1,6 +1,7 @@
 ! Copyright (c) 2008 Samuel Tardieu
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.parser sequences project-euler.common ;
+USING: kernel math math.functions math.parser math.ranges project-euler.common
+    sequences ;
 IN: project-euler.057
 
 ! http://projecteuler.net/index.php?section=problems&id=57
@@ -11,14 +12,14 @@ IN: project-euler.057
 ! It is possible to show that the square root of two can be expressed
 ! as an infinite continued fraction.
 
-! √ 2 = 1 + 1/(2 + 1/(2 + 1/(2 + ... ))) = 1.414213...
+!     √ 2 = 1 + 1/(2 + 1/(2 + 1/(2 + ... ))) = 1.414213...
 
 ! By expanding this for the first four iterations, we get:
 
-! 1 + 1/2 = 3/2 = 1.5
-! 1 + 1/(2 + 1/2) = 7/5 = 1.4
-! 1 + 1/(2 + 1/(2 + 1/2)) = 17/12 = 1.41666...
-! 1 + 1/(2 + 1/(2 + 1/(2 + 1/2))) = 41/29 = 1.41379...
+!     1 + 1/2 = 3/2 = 1.5
+!     1 + 1/(2 + 1/2) = 7/5 = 1.4
+!     1 + 1/(2 + 1/(2 + 1/2)) = 17/12 = 1.41666...
+!     1 + 1/(2 + 1/(2 + 1/(2 + 1/2))) = 41/29 = 1.41379...
 
 ! The next three expansions are 99/70, 239/169, and 577/408, but the
 ! eighth expansion, 1393/985, is the first example where the number of
@@ -35,9 +36,9 @@ IN: project-euler.057
     >fraction [ number>string length ] bi@ > ; inline
 
 : euler057 ( -- answer )
-    0 1000 [ drop 2 + recip dup 1+ longer-numerator? ] count nip ;
+    0 1000 [0,b) [ drop 2 + recip dup 1 + longer-numerator? ] count nip ;
 
-! [ euler057 ] time
-! 3.375118 seconds
+! [ euler057 ] 100 ave-time
+! 1728 ms ave run time - 80.81 SD (100 trials)
 
 SOLUTION: euler057
index 314698534fe8dfc0e8b2845d3cf644a5b6ddf0bd..eeb4b0c315eb82420b8db813dd3c1d1ddacf650b 100644 (file)
@@ -1,6 +1,7 @@
 ! Copyright (c) 2008 Eric Mertens.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: hints kernel locals math math.order sequences sequences.private project-euler.common ;
+USING: hints kernel locals math math.order math.ranges project-euler.common
+    sequences sequences.private ;
 IN: project-euler.150
 
 ! http://projecteuler.net/index.php?section=problems&id=150
@@ -50,13 +51,13 @@ IN: project-euler.150
     615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
 
 : sums-triangle ( -- seq )
-    0 1000 iota [ 1+ [ next ] replicate partial-sums ] map nip ;
+    0 1000 [1,b] [ [ next ] replicate partial-sums ] map nip ;
 
 :: (euler150) ( m -- n )
     [let | table [ sums-triangle ] |
         m [| x |
             x 1+ [| y |
-                m x - iota [| z |
+                m x - [0,b) [| z |
                     x z + table nth-unsafe
                     [ y z + 1+ swap nth-unsafe ]
                     [ y        swap nth-unsafe ] bi -