/extra/project-euler/081/081.factor

 1! Copyright (c) 2009 Guillaume Nargeot.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: fry io.encodings.ascii io.files locals kernel math
 4math.order math.parser math.ranges sequences splitting
 5project-euler.common ;
 6IN: project-euler.081
 7
 8! http://projecteuler.net/index.php?section=problems&id=081
 9
10! DESCRIPTION
11! -----------
12
13! In the 5 by 5 matrix below, the minimal path sum from the top
14! left to the bottom right, by only moving to the right and
15! down, is indicated in bold red and is equal to 2427.
16
17! 131 673 234 103  18
18! 201  96 342 965 150
19! 630 803 746 422 111
20! 537 699 497 121 956
21! 805 732 524  37 331
22
23! Find the minimal path sum, in matrix.txt (right click and
24! 'Save Link/Target As...'), a 31K text file containing a 80 by
25! 80 matrix, from the top left to the bottom right by only
26! moving right and down.
27
28
29! SOLUTION
30! --------
31
32! Shortest path problem solved using Dijkstra algorithm.
33
34<PRIVATE
35
36: source-081 ( -- matrix )
37    "resource:extra/project-euler/081/matrix.txt"
38    ascii file-lines [ "," split [ string>number ] map ] map ;
39
40: get-matrix ( x y matrix -- n ) nth nth ;
41
42: change-matrix ( x y matrix quot -- )
43    [ nth ] dip change-nth ; inline
44
45:: minimal-path-sum-to ( x y matrix -- n )
46    x y + zero? [ 0 ] [
47        x zero? [ 0 y 1 - matrix get-matrix
48        ] [ 
49            y zero? [
50                x 1 - 0 matrix get-matrix
51            ] [
52                x 1 - y matrix get-matrix
53                x y 1 - matrix get-matrix
54                min
55            ] if
56        ] if
57    ] if ;
58
59: update-minimal-path-sum ( x y matrix -- )
60    3dup minimal-path-sum-to '[ _ + ] change-matrix ;
61
62: (euler081) ( matrix -- n )
63    dup first length iota dup
64    [ pick update-minimal-path-sum ] cartesian-each
65    last last ;
66
67PRIVATE>
68
69: euler081 ( -- answer )
70    source-081 (euler081) ;
71
72! [ euler081 ] 100 ave-time
73! 9 ms ave run time - 0.39 SD (100 trials)
74
75SOLUTION: euler081