/extra/project-euler/014/014.factor

http://github.com/abeaumont/factor · Factor · 76 lines · 22 code · 28 blank · 26 comment · 6 complexity · 0bf115eac65d433bad0ef471a8dfe277 MD5 · raw file

  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.functions math.ranges
  4. sequences project-euler.common ;
  5. IN: project-euler.014
  6. ! http://projecteuler.net/index.php?section=problems&id=14
  7. ! DESCRIPTION
  8. ! -----------
  9. ! The following iterative sequence is defined for the set of positive integers:
  10. ! n -> n / 2 (n is even)
  11. ! n -> 3n + 1 (n is odd)
  12. ! Using the rule above and starting with 13, we generate the following
  13. ! sequence:
  14. ! 13 -> 40 -> 20 -> 10 -> 5 -> 16 -> 8 -> 4 -> 2 -> 1
  15. ! It can be seen that this sequence (starting at 13 and finishing at 1)
  16. ! contains 10 terms. Although it has not been proved yet (Collatz Problem), it
  17. ! is thought that all starting numbers finish at 1.
  18. ! Which starting number, under one million, produces the longest chain?
  19. ! NOTE: Once the chain starts the terms are allowed to go above one million.
  20. ! SOLUTION
  21. ! --------
  22. ! Brute force
  23. <PRIVATE
  24. : next-collatz ( n -- n )
  25. dup even? [ 2 / ] [ 3 * 1 + ] if ;
  26. : longest ( seq seq -- seq )
  27. 2dup [ length ] bi@ > [ drop ] [ nip ] if ;
  28. PRIVATE>
  29. : collatz ( n -- seq )
  30. [ [ dup 1 > ] [ dup , next-collatz ] while , ] { } make ;
  31. : euler014 ( -- answer )
  32. 1000000 [1,b] { } [ collatz longest ] reduce first ;
  33. ! [ euler014 ] time
  34. ! 52868 ms run / 483 ms GC time
  35. ! ALTERNATE SOLUTIONS
  36. ! -------------------
  37. <PRIVATE
  38. : worth-calculating? ( n -- ? )
  39. 1 - 3 { [ divisor? ] [ / even? ] } 2&& ;
  40. PRIVATE>
  41. : euler014a ( -- answer )
  42. 500000 1000000 [a,b] { 1 } [
  43. dup worth-calculating? [ collatz longest ] [ drop ] if
  44. ] reduce first ;
  45. ! [ euler014a ] 10 ave-time
  46. ! 4821 ms run / 41 ms GC time
  47. ! TODO: try using memoization
  48. SOLUTION: euler014a