extra/project-euler/081/081.factor

   1 ! Copyright (c) 2009 Guillaume Nargeot.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: fry io.encodings.ascii io.files locals kernel math
   4 math.order math.parser math.ranges sequences splitting
   5 project-euler.common ;
   6 IN: 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
  67 PRIVATE>
  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
  75 SOLUTION: euler081