extra/benchmark/backtrack/backtrack.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs backtrack kernel math memoize ranges sequences
   4 words ;
   5 IN: benchmark.backtrack
   6
   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.
  11
  12 : nop ( -- ) ;
  13
  14 : do-something ( a b -- c )
  15     { + - * } amb-execute ;
  16
  17 : some-rots ( a b c -- a b c )
  18     ! Try to rot 0, 1 or 2 times.
  19     { nop rot -rot } amb-execute ;
  20
  21 MEMO: 24-from-1 ( a -- ? )
  22     24 = ;
  23
  24 MEMO: 24-from-2 ( a b -- ? )
  25     [ do-something 24-from-1 ] [ 2drop ] if-amb ;
  26
  27 MEMO: 24-from-3 ( a b c -- ? )
  28     [ some-rots do-something 24-from-2 ] [ 3drop ] if-amb ;
  29
  30 MEMO: 24-from-4 ( a b c d -- ? )
  31     [ some-rots do-something 24-from-3 ] [ 4drop ] if-amb ;
  32
  33 : find-impossible-24 ( -- n )
  34     10 [1..b] [| a |
  35         10 [1..b] [| b |
  36             10 [1..b] [| c |
  37                 10 [1..b] [| d |
  38                     a b c d 24-from-4
  39                 ] count
  40             ] map-sum
  41         ] map-sum
  42     ] map-sum ;
  43
  44 CONSTANT: 24-words { 24-from-1 24-from-2 24-from-3 24-from-4 }
  45
  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= ;
  51
  52 MAIN: backtrack-benchmark