extra/project-euler/175/175.factor

   1 ! Copyright (c) 2007 Samuel Tardieu.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators kernel math math.parser math.ranges sequences vectors ;
   4 IN: project-euler.175
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=175
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! Define f(0)=1 and f(n) to be the number of ways to write n as a sum of
  12 ! powers of 2 where no power occurs more than twice.
  13
  14 ! For example, f(10)=5 since there are five different ways to express
  15 ! 10: 10 = 8+2 = 8+1+1 = 4+4+2 = 4+2+2+1+1 = 4+4+1+1
  16
  17 ! It can be shown that for every fraction p/q (p0, q0) there exists at
  18 ! least one integer n such that f(n)/f(n-1)=p/q.
  19
  20 ! For instance, the smallest n for which f(n)/f(n-1)=13/17 is 241.  The
  21 ! binary expansion of 241 is 11110001.  Reading this binary number from
  22 ! the most significant bit to the least significant bit there are 4
  23 ! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the
  24 ! Shortened Binary Expansion of 241.
  25
  26 ! Find the Shortened Binary Expansion of the smallest n for which
  27 ! f(n)/f(n-1)=123456789/987654321.
  28
  29 ! Give your answer as comma separated integers, without any whitespaces.
  30
  31 ! SOLUTION
  32 ! --------
  33
  34 : add-bits ( vec n b -- )
  35   over zero? [
  36     3drop
  37   ] [
  38     pick length 1 bitand = [ over pop + ] when swap push
  39   ] if ;
  40
  41 : compute ( vec ratio -- )
  42   {
  43     { [ dup integer? ] [ 1- 0 add-bits ] }
  44     { [ dup 1 < ] [ 1 over - / dupd compute 1 1 add-bits ] }
  45     { [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] }
  46   } cond ;
  47
  48 : euler175 ( -- result )
  49   V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ;
  50
  51 ! [ euler175 ] 100 ave-time
  52 ! 0 ms run / 0 ms GC ave time - 100 trials
  53
  54 MAIN: euler175