extra/project-euler/014/014.factor

   1 ! Copyright (c) 2007 Aaron Schaefer.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators.short-circuit kernel make math math.ranges sequences ;
   4 IN: project-euler.014
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=14
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! The following iterative sequence is defined for the set of positive integers:
  12
  13 !     n -> n / 2  (n is even)
  14 !     n -> 3n + 1 (n is odd)
  15
  16 ! Using the rule above and starting with 13, we generate the following
  17 ! sequence:
  18
  19 !     13 -> 40 -> 20 -> 10 -> 5 -> 16 -> 8 -> 4 -> 2 -> 1
  20
  21 ! It can be seen that this sequence (starting at 13 and finishing at 1)
  22 ! contains 10 terms. Although it has not been proved yet (Collatz Problem), it
  23 ! is thought that all starting numbers finish at 1.
  24
  25 ! Which starting number, under one million, produces the longest chain?
  26
  27 ! NOTE: Once the chain starts the terms are allowed to go above one million.
  28
  29
  30 ! SOLUTION
  31 ! --------
  32
  33 ! Brute force
  34
  35 <PRIVATE
  36
  37 : next-collatz ( n -- n )
  38     dup even? [ 2 / ] [ 3 * 1+ ] if ;
  39
  40 : longest ( seq seq -- seq )
  41     2dup [ length ] bi@ > [ drop ] [ nip ] if ;
  42
  43 PRIVATE>
  44
  45 : collatz ( n -- seq )
  46     [ [ dup 1 > ] [ dup , next-collatz ] [ ] while , ] { } make ;
  47
  48 : euler014 ( -- answer )
  49     1000000 [1,b] 0 [ collatz longest ] reduce first ;
  50
  51 ! [ euler014 ] time
  52 ! 52868 ms run / 483 ms GC time
  53
  54
  55 ! ALTERNATE SOLUTIONS
  56 ! -------------------
  57
  58 <PRIVATE
  59
  60 : worth-calculating? ( n -- ? )
  61     1- 3 { [ mod 0 = ] [ / even? ] } 2&& ;
  62
  63 PRIVATE>
  64
  65 : euler014a ( -- answer )
  66     500000 1000000 [a,b] 1 [
  67         dup worth-calculating? [ collatz longest ] [ drop ] if
  68     ] reduce first ;
  69
  70 ! [ euler014a ] 10 ave-time
  71 ! 4821 ms run / 41 ms GC time
  72
  73 ! TODO: try using memoization
  74
  75 MAIN: euler014a