extra/project-euler/215/215.factor

   1 USING: accessors kernel locals math ;
   2 IN: project-euler.215
   3
   4 TUPLE: block two three ;
   5 TUPLE: end { ways integer } ;
   6
   7 C: <block> block
   8 C: <end> end
   9 : <failure> 0 <end> ; inline
  10 : <success> 1 <end> ; inline
  11
  12 : failure? ( t -- ? ) ways>> 0 = ; inline
  13
  14 : choice ( t p q -- t t ) [ [ two>> ] [ three>> ] bi ] 2dip bi* ; inline
  15
  16 GENERIC: merge ( t t -- t )
  17 GENERIC# block-merge 1 ( t t -- t )
  18 GENERIC# end-merge 1 ( t t -- t )
  19 M: block merge block-merge ;
  20 M: end   merge end-merge ;
  21 M: block block-merge [ [ two>>   ] bi@ merge ]
  22                      [ [ three>> ] bi@ merge ] 2bi <block> ;
  23 M: end   block-merge nip ;
  24 M: block end-merge drop ;
  25 M: end   end-merge [ ways>> ] bi@ + <end> ;
  26
  27 GENERIC: h-1 ( t -- t )
  28 GENERIC: h0 ( t -- t )
  29 GENERIC: h1 ( t -- t )
  30 GENERIC: h2 ( t -- t )
  31
  32 M: block h-1 [ h1 ] [ h2 ] choice merge ;
  33 M: block h0 drop <failure> ;
  34 M: block h1 [ [ h1 ] [ h2 ] choice merge ]
  35             [ [ h0 ] [ h1 ] choice merge ] bi <block> ;
  36 M: block h2 [ h1 ] [ h2 ] choice merge <failure> swap <block> ;
  37
  38 M: end h-1 drop <failure> ;
  39 M: end h0 ;
  40 M: end h1 drop <failure> ;
  41 M: end h2 dup failure? [ <failure> <block> ] unless ;
  42
  43 : next-row ( t -- t ) [ h-1 ] [ h1 ] choice swap <block> ;
  44
  45 : first-row ( n -- t )
  46   [ <failure> <success> <failure> ] dip
  47   1- [| a b c | b c <block> a b ] times 2drop ;
  48
  49 GENERIC: total ( t -- n )
  50 M: block total [ total ] dup choice + ;
  51 M: end   total ways>> ;
  52
  53 : solve ( width height -- ways )
  54   [ first-row ] dip 1- [ next-row ] times total ;
  55
  56 : euler215 ( -- ways ) 32 10 solve ;