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 math math.order math.ranges sequences ;
   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
  15 ! SOLUTION
  16 ! --------
  17
  18 ! This solution uses dynamic programming and the following
  19 ! recurence relation:
  20
  21 ! ways(0,_) = 1
  22 ! ways(_,0) = 0
  23 ! ways(n,i) = ways(n-i,i) + ways(n,i-1)
  24
  25 <PRIVATE
  26
  27 : init ( n -- table )
  28     [1,b] [ 0 2array 0 ] H{ } map>assoc
  29     1 { 0 0 } pick set-at ;
  30
  31 : use ( n i -- n i )
  32     [ - dup ] keep min ; inline
  33
  34 : ways ( n i table -- )
  35     over zero? [
  36         3drop
  37     ] [
  38         [ [ 1-  2array ] dip at     ]
  39         [ [ use 2array ] dip at +   ]
  40         [ [     2array ] dip set-at ] 3tri
  41     ] if ;
  42
  43 :: each-subproblem ( n quot -- )
  44     n [1,b] [ dup [1,b] quot with each ] each ; inline
  45
  46 : (euler076) ( n -- m )
  47     dup init
  48     [ [ ways ] curry each-subproblem ]
  49     [ [ dup 2array ] dip at 1- ] 2bi ;
  50
  51 PRIVATE>
  52
  53 : euler076 ( -- answer )
  54     100 (euler076) ;
  55
  56 ! [ euler076 ] 100 ave-time
  57 ! 560 ms ave run time - 17.74 SD (100 trials)
  58
  59 MAIN: euler076