extra/project-euler/148/148.factor

   1 ! Copyright (c) 2008 Eric Mertens
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.functions sequences sequences.lib ;
   4
   5 IN: project-euler.148
   6
   7 <PRIVATE
   8
   9 : sum-1toN ( n -- sum )
  10     dup 1+ * 2/ ; inline
  11
  12 : >base7 ( x -- y )
  13     [ dup 0 > ] [ 7 /mod ] [ ] unfold nip ;
  14
  15 : (use-digit) ( prev x index -- next )
  16     [ [ 1+ * ] [ sum-1toN 7 sum-1toN ] bi ] dip ^ * + ;
  17
  18 PRIVATE>
  19
  20 : (euler148) ( x -- y )
  21     >base7 0 [ (use-digit) ] reduce-index ;
  22
  23 : euler148 ( -- y )
  24     10 9 ^ (euler148) ;