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 kernel locals.backend math math.order math.ranges
   4     sequences ;
   5 IN: project-euler.076
   6
   7 ! http://projecteuler.net/index.php?section=problems&id=76
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! How many different ways can one hundred be written as a
  13 ! sum of at least two positive integers?
  14
  15
  16 ! SOLUTION
  17 ! --------
  18
  19 ! This solution uses dynamic programming and the following
  20 ! recurence relation:
  21
  22 ! ways(0,_) = 1
  23 ! ways(_,0) = 0
  24 ! ways(n,i) = ways(n-i,i) + ways(n,i-1)
  25
  26 <PRIVATE
  27
  28 : init ( n -- table )
  29     [1,b] [ 0 2array 0 ] H{ } map>assoc
  30     1 { 0 0 } pick set-at ;
  31
  32 : use ( n i -- n i )
  33     [ - dup ] keep min ; inline
  34
  35 : ways ( n i table -- )
  36     over zero? [
  37         3drop
  38     ] [
  39         [ [ 1-  2array ] dip at     ]
  40         [ [ use 2array ] dip at +   ]
  41         [ [     2array ] dip set-at ] 3tri
  42     ] if ;
  43
  44 :: each-subproblem ( n quot -- )
  45     n [1,b] [ dup [1,b] quot with each ] each ; inline
  46
  47 : (euler076) ( n -- m )
  48     dup init
  49     [ [ ways ] curry each-subproblem ]
  50     [ [ dup 2array ] dip at 1- ] 2bi ;
  51
  52 PRIVATE>
  53
  54 : euler076 ( -- answer )
  55     100 (euler076) ;
  56
  57 ! [ euler076 ] 100 ave-time
  58 ! 560 ms ave run time - 17.74 SD (100 trials)
  59
  60 MAIN: euler076