extra/project-euler/215/215.factor

   1 ! Copyright (c) 2008 Eric Mertens.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel locals math ;
   4 IN: project-euler.215
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=215
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! Consider the problem of building a wall out of 2x1 and 3x1 bricks
  12 ! (horizontal x vertical dimensions) such that, for extra strength, the gaps
  13 ! between horizontally-adjacent bricks never line up in consecutive layers,
  14 ! i.e. never form a "running crack".
  15
  16 ! For example, the following 93 wall is not acceptable due to the running crack
  17 ! shown in red:
  18
  19 !     See problem site for image...
  20
  21 ! There are eight ways of forming a crack-free 9x3 wall, written W(9,3) = 8.
  22
  23 ! Calculate W(32,10).
  24
  25
  26 ! SOLUTION
  27 ! --------
  28
  29 <PRIVATE
  30
  31 TUPLE: block two three ;
  32 TUPLE: end { ways integer } ;
  33
  34 C: <block> block
  35 C: <end> end
  36 : <failure> ( -- end ) 0 <end> ; inline
  37 : <success> ( -- end ) 1 <end> ; inline
  38
  39 : failure? ( t -- ? ) ways>> 0 = ; inline
  40
  41 : choice ( t p q -- t t )
  42     [ [ two>> ] [ three>> ] bi ] 2dip bi* ; inline
  43
  44 GENERIC: merge ( t t -- t )
  45 GENERIC# block-merge 1 ( t t -- t )
  46 GENERIC# end-merge 1 ( t t -- t )
  47 M: block merge block-merge ;
  48 M: end   merge end-merge ;
  49 M: block block-merge [ [ two>>   ] bi@ merge ]
  50                      [ [ three>> ] bi@ merge ] 2bi <block> ;
  51 M: end   block-merge nip ;
  52 M: block end-merge drop ;
  53 M: end   end-merge [ ways>> ] bi@ + <end> ;
  54
  55 GENERIC: h-1 ( t -- t )
  56 GENERIC: h0 ( t -- t )
  57 GENERIC: h1 ( t -- t )
  58 GENERIC: h2 ( t -- t )
  59
  60 M: block h-1 [ h1 ] [ h2 ] choice merge ;
  61 M: block h0 drop <failure> ;
  62 M: block h1 [ [ h1 ] [ h2 ] choice merge ]
  63             [ [ h0 ] [ h1 ] choice merge ] bi <block> ;
  64 M: block h2 [ h1 ] [ h2 ] choice merge <failure> swap <block> ;
  65
  66 M: end h-1 drop <failure> ;
  67 M: end h0 ;
  68 M: end h1 drop <failure> ;
  69 M: end h2 dup failure? [ <failure> <block> ] unless ;
  70
  71 : next-row ( t -- t ) [ h-1 ] [ h1 ] choice swap <block> ;
  72
  73 : first-row ( n -- t )
  74     [ <failure> <success> <failure> ] dip
  75     1- [| a b c | b c <block> a b ] times 2drop ;
  76
  77 GENERIC: total ( t -- n )
  78 M: block total [ total ] dup choice + ;
  79 M: end   total ways>> ;
  80
  81 : solve ( width height -- ways )
  82     [ first-row ] dip 1- [ next-row ] times total ;
  83
  84 PRIVATE>
  85
  86 : euler215 ( -- answer )
  87     32 10 solve ;
  88
  89 ! [ euler215 ] 100 ave-time
  90 ! 208 ms ave run time - 9.06 SD (100 trials)
  91
  92 MAIN: euler215