factor: trim using lists

[factor.git] / extra / benchmark / backtrack / backtrack.factor

diff --git a/extra/benchmark/backtrack/backtrack.factor b/extra/benchmark/backtrack/backtrack.factor
index e9a5ad0ed8bbfc11a20202ae2c6227bbae2a0e02..6074aae8433dd1902d624d0e386b0fedd7cc3447 100644 (file)
--- a/extra/benchmark/backtrack/backtrack.factor
+++ b/extra/benchmark/backtrack/backtrack.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: backtrack shuffle math math.ranges quotations locals fry
-kernel words io memoize macros io prettyprint sequences assocs
-combinators namespaces ;
+USING: assocs backtrack kernel math memoize ranges sequences
+words ;
 IN: benchmark.backtrack
 
 ! This was suggested by Dr_Ford. Compute the number of quadruples
@@ -10,25 +9,13 @@ IN: benchmark.backtrack
 ! placing them on the stack, and applying the operations
 ! +, -, * and rot as many times as we wish.
 
-: nop ;
-
-MACRO: amb-execute ( seq -- quot )
-    [ length ] [ <enum> [ 1quotation ] assoc-map ] bi
-    '[ , amb , case ] ;
-
-: if-amb ( true false -- )
-    [
-        [ { t f } amb ]
-        [ '[ @ require t ] ]
-        [ '[ @ f ] ]
-        tri* if
-    ] with-scope ; inline
+: nop ( -- ) ;
 
 : do-something ( a b -- c )
     { + - * } amb-execute ;
 
 : some-rots ( a b c -- a b c )
-    #! Try to rot 0, 1 or 2 times.
+    ! Try to rot 0, 1 or 2 times.
     { nop rot -rot } amb-execute ;
 
 MEMO: 24-from-1 ( a -- ? )
@@ -44,22 +31,22 @@ MEMO: 24-from-4 ( a b c d -- ? )
     [ some-rots do-something 24-from-3 ] [ 4drop ] if-amb ;
 
 : find-impossible-24 ( -- n )
-    1 10 [a,b] [| a |
-        1 10 [a,b] [| b |
-            1 10 [a,b] [| c |
-                1 10 [a,b] [| d |
+    10 [1..b] [| a |
+        10 [1..b] [| b |
+            10 [1..b] [| c |
+                10 [1..b] [| d |
                     a b c d 24-from-4
                 ] count
-            ] sigma
-        ] sigma
-    ] sigma ;
+            ] map-sum
+        ] map-sum
+    ] map-sum ;
 
-: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
+CONSTANT: 24-words { 24-from-1 24-from-2 24-from-3 24-from-4 }
 
 : backtrack-benchmark ( -- )
-    words [ reset-memoized ] each
-    find-impossible-24 pprint "/10000 quadruples can make 24." print
-    words [
-        dup pprint " tested " write "memoize" word-prop assoc-size pprint
-        " possibilities" print
-    ] each ;
+    24-words [ reset-memoized ] each
+    find-impossible-24 6479 assert=
+    24-words [ "memoize" word-prop assoc-size ] map
+    { 1588 5137 4995 10000 } assert= ;
+
+MAIN: backtrack-benchmark