extra/project-euler/076/076.factor

   1 ! Copyright (c) 2008 Eric Mertens
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays assocs combinators kernel math sequences math.ranges locals ;
   4 IN: project-euler.076
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=76
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! How many different ways can one hundred be written as a
  12 ! sum of at least two positive integers?
  13
  14 ! SOLUTION
  15 ! --------
  16
  17 ! This solution uses dynamic programming and the following
  18 ! recurence relation:
  19
  20 ! ways(0,_) = 1
  21 ! ways(_,0) = 0
  22 ! ways(n,i) = ways(n-i,i) + ways(n,i-1)
  23
  24 <PRIVATE
  25
  26 : init ( n -- table )
  27     [1,b] [ 0 2array 0 ] H{ } map>assoc
  28     1 { 0 0 } pick set-at ;
  29
  30 : use ( n i -- n i )
  31     [ - dup ] keep min ; inline
  32
  33 : ways ( n i table -- )
  34     over zero? [
  35         3drop
  36     ] [
  37         [ [ 1-  2array ] dip at     ]
  38         [ [ use 2array ] dip at +   ]
  39         [ [     2array ] dip set-at ] 3tri
  40     ] if ;
  41
  42 :: each-subproblem ( n quot -- )
  43     n [1,b] [ dup [1,b] quot with each ] each ; inline
  44
  45 PRIVATE>
  46
  47 : (euler076) ( n -- m )
  48     dup init
  49     [ [ ways ] curry each-subproblem ]
  50     [ [ dup 2array ] dip at 1- ] 2bi ;
  51
  52 : euler076 ( -- m )
  53     100 (euler076) ;