extra/project-euler/150/150.factor

   1 ! Copyright (c) 2008 Eric Mertens.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: hints kernel locals math math.order sequences sequences.private ;
   4 IN: project-euler.150
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=150
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! In a triangular array of positive and negative integers, we wish to find a
  12 ! sub-triangle such that the sum of the numbers it contains is the smallest
  13 ! possible.
  14
  15 ! In the example below, it can be easily verified that the marked triangle
  16 ! satisfies this condition having a sum of -42.
  17
  18 ! We wish to make such a triangular array with one thousand rows, so we
  19 ! generate 500500 pseudo-random numbers sk in the range +/-2^19, using a type of
  20 ! random number generator (known as a Linear Congruential Generator) as
  21 ! follows:
  22
  23 ! ...
  24
  25 ! Find the smallest possible sub-triangle sum.
  26
  27
  28 ! SOLUTION
  29 ! --------
  30
  31 <PRIVATE
  32
  33 ! sequence helper functions
  34
  35 : partial-sums ( seq -- sums )
  36     0 [ + ] accumulate swap suffix ; inline
  37
  38 : (partial-sum-infimum) ( inf sum elt -- inf sum )
  39     + [ min ] keep ; inline
  40
  41 : partial-sum-infimum ( seq -- seq )
  42     0 0 rot [ (partial-sum-infimum) ] each drop ; inline
  43
  44 : map-infimum ( seq quot -- min )
  45     [ min ] compose 0 swap reduce ; inline
  46
  47 ! triangle generator functions
  48
  49 : next ( t -- new-t s )
  50     615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
  51
  52 : sums-triangle ( -- seq )
  53     0 1000 [ 1+ [ next ] replicate partial-sums ] map nip ;
  54
  55 :: (euler150) ( m -- n )
  56     [let | table [ sums-triangle ] |
  57         m [| x |
  58             x 1+ [| y |
  59                 m x - [| z |
  60                     x z + table nth-unsafe
  61                     [ y z + 1+ swap nth-unsafe ]
  62                     [ y        swap nth-unsafe ] bi -
  63                 ] map partial-sum-infimum
  64             ] map-infimum
  65         ] map-infimum
  66     ] ;
  67
  68 HINTS: (euler150) fixnum ;
  69
  70 PRIVATE>
  71
  72 : euler150 ( -- answer )
  73     1000 (euler150) ;
  74
  75 ! [ euler150 ] 10 ave-time
  76 ! 30208 ms ave run time - 593.45 SD (10 trials)
  77
  78 MAIN: euler150