PageRenderTime 20ms CodeModel.GetById 15ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/extra/project-euler/076/076.factor

http://github.com/abeaumont/factor
Unknown | 59 lines | 42 code | 17 blank | 0 comment | 0 complexity | 964b591fdc55039aac892bfe2728191d MD5 | raw file
 1! Copyright (c) 2008 Eric Mertens.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: arrays assocs kernel locals math math.order math.ranges sequences project-euler.common ;
 4IN: 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
51PRIVATE>
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
59SOLUTION: euler076