extra/project-euler/151/151.factor

   1 ! Copyright (c) 2008 Eric Mertens
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: sequences combinators kernel sequences.lib math assocs namespaces ;
   4 IN: project-euler.151
   5
   6 SYMBOL: table
   7
   8 : (pick-sheet) ( seq i -- newseq )
   9     [
  10         <=> sgn
  11         {
  12             { -1 [ ] }
  13             {  0 [ 1- ] }
  14             {  1 [ 1+ ] }
  15         } case
  16     ] curry map-index ;
  17
  18 DEFER: (euler151)
  19
  20 : pick-sheet ( seq i -- res )
  21     2dup swap nth dup zero? [
  22         3drop 0
  23     ] [
  24         [ (pick-sheet) (euler151) ] dip *
  25     ] if ;
  26
  27 : (euler151) ( x -- y )
  28     table get [ {
  29         { { 0 0 0 1 } [ 0 ] }
  30         { { 0 0 1 0 } [ { 0 0 0 1 } (euler151) 1+ ] }
  31         { { 0 1 0 0 } [ { 0 0 1 1 } (euler151) 1+ ] }
  32         { { 1 0 0 0 } [ { 0 1 1 1 } (euler151) 1+ ] }
  33         [ [ dup length [ pick-sheet ] with map sum ] [ sum ] bi / ]
  34      } case ] cache ;
  35
  36 : euler151 ( -- n )
  37     [
  38         H{ } clone table set
  39         { 1 1 1 1 } (euler151)
  40     ] with-scope ;