extra/project-euler/151/151.factor

   1 ! Copyright (c) 2008 Eric Mertens.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs combinators kernel math math.order namespaces sequences project-euler.common ;
   4 IN: project-euler.151
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=151
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! A printing shop runs 16 batches (jobs) every week and each batch requires a
  12 ! sheet of special color-proofing paper of size A5.
  13
  14 ! Every Monday morning, the foreman opens a new envelope, containing a large
  15 ! sheet of the special paper with size A1.
  16
  17 ! He proceeds to cut it in half, thus getting two sheets of size A2. Then he
  18 ! cuts one of them in half to get two sheets of size A3 and so on until he
  19 ! obtains the A5-size sheet needed for the first batch of the week.
  20
  21 ! All the unused sheets are placed back in the envelope.
  22
  23 ! At the beginning of each subsequent batch, he takes from the envelope one
  24 ! sheet of paper at random. If it is of size A5, he uses it. If it is larger,
  25 ! he repeats the 'cut-in-half' procedure until he has what he needs and any
  26 ! remaining sheets are always placed back in the envelope.
  27
  28 ! Excluding the first and last batch of the week, find the expected number of
  29 ! times (during each week) that the foreman finds a single sheet of paper in
  30 ! the envelope.
  31
  32 ! Give your answer rounded to six decimal places using the format x.xxxxxx .
  33
  34
  35 ! SOLUTION
  36 ! --------
  37
  38 SYMBOL: table
  39
  40 : (pick-sheet) ( seq i -- newseq )
  41     [
  42         <=>
  43         {
  44             { +lt+ [ ] }
  45             { +eq+ [ 1 - ] }
  46             { +gt+ [ 1 + ] }
  47         } case
  48     ] curry map-index ;
  49
  50 DEFER: (euler151)
  51
  52 : pick-sheet ( seq i -- res )
  53     2dup swap nth dup zero? [
  54         3drop 0
  55     ] [
  56         [ (pick-sheet) (euler151) ] dip *
  57     ] if ;
  58
  59 : (euler151) ( x -- y )
  60     table get [ {
  61         { { 0 0 0 1 } [ 0 ] }
  62         { { 0 0 1 0 } [ { 0 0 0 1 } (euler151) 1 + ] }
  63         { { 0 1 0 0 } [ { 0 0 1 1 } (euler151) 1 + ] }
  64         { { 1 0 0 0 } [ { 0 1 1 1 } (euler151) 1 + ] }
  65         [ [ dup length <iota> [ pick-sheet ] with map-sum ] [ sum ] bi / ]
  66      } case ] cache ;
  67
  68 : euler151 ( -- answer )
  69     [
  70         H{ } clone table set
  71         { 1 1 1 1 } (euler151)
  72     ] with-scope ;
  73
  74 ! [ euler151 ] 100 ave-time
  75 ! ? ms run time - 100 trials
  76
  77 SOLUTION: euler151