1 ! Copyright (C) 2008 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: assocs backtrack kernel math memoize ranges sequences
5 IN: benchmark.backtrack
7 ! This was suggested by Dr_Ford. Compute the number of quadruples
8 ! (a,b,c,d) with 1 <= a,b,c,d <= 10 such that we can make 24 by
9 ! placing them on the stack, and applying the operations
10 ! +, -, * and rot as many times as we wish.
14 : do-something ( a b -- c )
15 { + - * } amb-execute ;
17 : some-rots ( a b c -- a b c )
18 ! Try to rot 0, 1 or 2 times.
19 { nop rot -rot } amb-execute ;
21 MEMO: 24-from-1 ( a -- ? )
24 MEMO: 24-from-2 ( a b -- ? )
25 [ do-something 24-from-1 ] [ 2drop ] if-amb ;
27 MEMO: 24-from-3 ( a b c -- ? )
28 [ some-rots do-something 24-from-2 ] [ 3drop ] if-amb ;
30 MEMO: 24-from-4 ( a b c d -- ? )
31 [ some-rots do-something 24-from-3 ] [ 4drop ] if-amb ;
33 : find-impossible-24 ( -- n )
44 CONSTANT: 24-words { 24-from-1 24-from-2 24-from-3 24-from-4 }
46 : backtrack-benchmark ( -- )
47 24-words [ reset-memoized ] each
48 find-impossible-24 6479 assert=
49 24-words [ "memoize" word-prop assoc-size ] map
50 { 1588 5137 4995 10000 } assert= ;
52 MAIN: backtrack-benchmark