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

http://github.com/abeaumont/factor · Factor · 75 lines · 34 code · 19 blank · 22 comment · 3 complexity · f5e675751e8c31c7024612d72af7594d MD5 · raw file

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