remove math.blas.syntax and merge parsing words into math.blas.vectors/matrices
[factor/jcg.git] / extra / benchmark / backtrack / backtrack.factor
blobdf67872b1143ac8afc75cc2aa81356bcd94382c2
1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: backtrack shuffle math math.ranges quotations locals fry
4 kernel words io memoize macros io prettyprint sequences assocs
5 combinators namespaces ;
6 IN: benchmark.backtrack
8 ! This was suggested by Dr_Ford. Compute the number of quadruples
9 ! (a,b,c,d) with 1 <= a,b,c,d <= 10 such that we can make 24 by
10 ! placing them on the stack, and applying the operations
11 ! +, -, * and rot as many times as we wish.
13 : nop ;
15 : do-something ( a b -- c )
16     { + - * } amb-execute ;
18 : some-rots ( a b c -- a b c )
19     #! Try to rot 0, 1 or 2 times.
20     { nop rot -rot } amb-execute ;
22 MEMO: 24-from-1 ( a -- ? )
23     24 = ;
25 MEMO: 24-from-2 ( a b -- ? )
26     [ do-something 24-from-1 ] [ 2drop ] if-amb ;
28 MEMO: 24-from-3 ( a b c -- ? )
29     [ some-rots do-something 24-from-2 ] [ 3drop ] if-amb ;
31 MEMO: 24-from-4 ( a b c d -- ? )
32     [ some-rots do-something 24-from-3 ] [ 4drop ] if-amb ;
34 : find-impossible-24 ( -- n )
35     1 10 [a,b] [| a |
36         1 10 [a,b] [| b |
37             1 10 [a,b] [| c |
38                 1 10 [a,b] [| d |
39                     a b c d 24-from-4
40                 ] count
41             ] sigma
42         ] sigma
43     ] sigma ;
45 : words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
47 : backtrack-benchmark ( -- )
48     words [ reset-memoized ] each
49     find-impossible-24 pprint "/10000 quadruples can make 24." print
50     words [
51         dup pprint " tested " write "memoize" word-prop assoc-size pprint
52         " possibilities" print
53     ] each ;
55 MAIN: backtrack-benchmark