extra/project-euler/014/014.factor

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