extra/project-euler/151/151.factor

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