]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorAaron Schaefer <aaron@elasticdog.com>
Sun, 19 Apr 2009 17:01:40 +0000 (13:01 -0400)
committerAaron Schaefer <aaron@elasticdog.com>
Sun, 19 Apr 2009 17:01:40 +0000 (13:01 -0400)
extra/poker/poker.factor
extra/project-euler/001/001-tests.factor
extra/project-euler/001/001.factor
extra/project-euler/069/069.factor

index 2a7fe73762e6fdcd501b20d6fccc0b10b29a66be..e8e9fa23c5e9cf25ded89c01c287ffe5c35eca2b 100644 (file)
@@ -117,9 +117,6 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
 : lookup ( cards table -- value )
     [ rank-bits ] dip nth ;
 
-: unique5? ( cards -- ? )
-    unique5-table lookup 0 > ;
-
 : map-product ( seq quot -- n )
     [ 1 ] 2dip [ dip * ] curry [ swap ] prepose each ; inline
 
@@ -138,11 +135,11 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
     bitxor values-table nth ;
 
 : hand-value ( cards -- value )
-    {
-        { [ dup flush?   ] [ flushes-table lookup ] }
-        { [ dup unique5? ] [ unique5-table lookup ] }
-        [ prime-bits perfect-hash-find ]
-    } cond ;
+    dup flush? [ flushes-table lookup ] [
+        dup unique5-table lookup dup 0 > [ nip ] [
+            drop prime-bits perfect-hash-find
+        ] if
+    ] if ;
 
 : >card-rank ( card -- str )
     -8 shift HEX: F bitand RANK_STR nth ;
index 1cab2756192b690b3ded1aa9fb4a207714873760..32a72dfaf0d735df8b88b4fbc3147a69653e5f73 100644 (file)
@@ -5,3 +5,4 @@ IN: project-euler.001.tests
 [ 233168 ] [ euler001a ] unit-test
 [ 233168 ] [ euler001b ] unit-test
 [ 233168 ] [ euler001c ] unit-test
+[ 233168 ] [ euler001d ] unit-test
index 20e08242c5e3a0f00091f7e6a5d6e36a0cd5a20a..0d4f5fb1bdddbbc5e5fd92c50048be95cd4b49c5 100644 (file)
@@ -1,6 +1,7 @@
 ! Copyright (c) 2007, 2008 Aaron Schaefer, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.ranges sequences project-euler.common ;
+USING: kernel math math.functions math.ranges project-euler.common sequences
+    sets ;
 IN: project-euler.001
 
 ! http://projecteuler.net/index.php?section=problems&id=1
@@ -32,7 +33,7 @@ PRIVATE>
     999 15 sum-divisible-by - ;
 
 ! [ euler001 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.0 SD (100 trials)
 
 
 ! ALTERNATE SOLUTIONS
@@ -42,14 +43,14 @@ PRIVATE>
     0 999 3 <range> sum 0 999 5 <range> sum + 0 999 15 <range> sum - ;
 
 ! [ euler001a ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.03 SD (100 trials)
 
 
 : euler001b ( -- answer )
     1000 [ [ 5 mod ] [ 3 mod ] bi [ 0 = ] either? ] filter sum ;
 
 ! [ euler001b ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.06 SD (100 trials)
 
 
 : euler001c ( -- answer )
@@ -58,4 +59,11 @@ PRIVATE>
 ! [ euler001c ] 100 ave-time
 ! 0 ms ave run time - 0.06 SD (100 trials)
 
+
+: euler001d ( -- answer )
+    { 3 5 } [ [ 999 ] keep <range> ] gather sum ;
+
+! [ euler001d ] 100 ave-time
+! 0 ms ave run time - 0.08 SD (100 trials)
+
 SOLUTION: euler001
index eae1d82ece729175c6e9bb45af93e313362efa5c..3a59d665224ba24c13d67a1a6f9169bd6f01b68c 100644 (file)
@@ -69,12 +69,9 @@ PRIVATE>
         [ nth-prime primes-upto ]
     } cond product ;
 
-: (primorial-upto) ( count limit -- m )
-    '[ dup primorial _ <= ] [ 1+ dup primorial ] produce
-    nip penultimate ;
-
 : primorial-upto ( limit -- m )
-    1 swap (primorial-upto) ;
+    1 swap '[ dup primorial _ <= ] [ 1+ dup primorial ] produce
+    nip penultimate ;
 
 PRIVATE>