extra/project-euler/081/081.factor

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