/extra/project-euler/002/002.factor

http://github.com/abeaumont/factor · Factor · 80 lines · 32 code · 28 blank · 20 comment · 5 complexity · 7d901ca8bf11c10c62887454d505e4e3 MD5 · raw file

  1. ! Copyright (c) 2007, 2008 Aaron Schaefer, Alexander Solovyov, Vishal Talwar.
  2. ! See http://factorcode.org/license.txt for BSD license.
  3. USING: kernel math sequences project-euler.common ;
  4. IN: project-euler.002
  5. ! http://projecteuler.net/index.php?section=problems&id=2
  6. ! DESCRIPTION
  7. ! -----------
  8. ! Each new term in the Fibonacci sequence is generated by adding the previous
  9. ! two terms. By starting with 1 and 2, the first 10 terms will be:
  10. ! 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
  11. ! Find the sum of all the even-valued terms in the sequence which do not exceed
  12. ! four million.
  13. ! SOLUTION
  14. ! --------
  15. <PRIVATE
  16. : (fib-upto) ( seq n limit -- seq )
  17. 2dup <= [ [ over push dup 2 tail* sum ] dip (fib-upto) ] [ 2drop ] if ;
  18. PRIVATE>
  19. : fib-upto ( n -- seq )
  20. V{ 0 } clone 1 rot (fib-upto) ;
  21. : euler002 ( -- answer )
  22. 4,000,000 fib-upto [ even? ] filter sum ;
  23. ! [ euler002 ] 100 ave-time
  24. ! 0 ms ave run time - 0.22 SD (100 trials)
  25. ! ALTERNATE SOLUTIONS
  26. ! -------------------
  27. : fib-upto* ( n -- seq )
  28. 0 1 [ pick over >= ] [ [ nip ] 2keep + dup ] produce [ 3drop ] dip
  29. but-last-slice { 0 1 } prepend ;
  30. : euler002a ( -- answer )
  31. 4,000,000 fib-upto* [ even? ] filter sum ;
  32. ! [ euler002a ] 100 ave-time
  33. ! 0 ms ave run time - 0.2 SD (100 trials)
  34. <PRIVATE
  35. : next-fibs ( x y -- y x+y )
  36. [ nip ] [ + ] 2bi ;
  37. : ?retotal ( total fib- fib+ -- retotal fib- fib+ )
  38. dup even? [ [ nip + ] 2keep ] when ;
  39. : (sum-even-fibs-below) ( partial fib- fib+ max -- total )
  40. 2dup > [
  41. 3drop
  42. ] [
  43. [ ?retotal next-fibs ] dip (sum-even-fibs-below)
  44. ] if ;
  45. PRIVATE>
  46. : sum-even-fibs-below ( max -- sum )
  47. [ 0 0 1 ] dip (sum-even-fibs-below) ;
  48. : euler002b ( -- answer )
  49. 4000000 sum-even-fibs-below ;
  50. ! [ euler002b ] 100 ave-time
  51. ! 0 ms ave run time - 0.0 SD (100 trials)
  52. SOLUTION: euler002b