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