extra/project-euler/175/175.factor

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