e14.adb

-- Euler 14
-- Collatz #s

with ada.text_io;
use ada.text_io;

procedure e14 is

    package int_io is new ada.text_io.integer_io(integer);
    use int_io;
    package long_int_io is new ada.text_io.integer_io(long_integer);
    use long_int_io;

    function collatz(n : long_integer) return long_integer is
    begin
        if n mod 2 = 0 then
            return n / 2;
        else
            return (3 * n) + 1;
        end if;
    end collatz;

    function collatz_count(n : long_integer) return integer is
        count : integer;
        x : long_integer;
    begin
        count := 1;
        x := n;
        loop
            count := count + 1;
            x := collatz(x);
            if x < 2 then
                exit;
            end if;
        end loop;
        return count;
    end collatz_count;

    highest_len : integer;
    highest_n   : long_integer;
    count       : integer;
begin
    put_line("Euler 14");
    put_line("finding longest collatz chain for N=1..1,000,000");
    highest_len := -1;
    highest_n := -1;
    for n in long_integer range 1..1000000 loop
        count := collatz_count(n);
        if count > highest_len then
            highest_len := count;
            highest_n := n;
        end if;
    end loop;
    put(item => highest_n);
    put(item => " creates the longest sequence, with length ");
    put(item => highest_len);
    new_line;
end e14;

euler14.factor

! Copyright (C) 2013 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel prettyprint math.ranges locals sequences ;
IN: euler14

: collatz ( x -- x ) dup even? [ 2 / ] [ 3 * 1 + ] if ;

: collatz-count-r ( x x -- x )
    dup
    2 <
    [ drop ] [ collatz swap 1 + swap collatz-count-r ] if ;

: collatz-count ( x -- x )
    0 swap collatz-count-r ;

: e14 ( x -- x x )
    -1 swap -1 swap ! highest collatz count and highest n
    2 swap [a,b]
    [
        [| highest_c highest_n cur_n |
            cur_n collatz-count
            dup highest_c
            > [ cur_n ] [ drop highest_c highest_n ] if
        ] call
    ] each ;

euler14.lisp

;;; The following iterative sequence is defined for the set of
;;; positive integers:

;;; n → n/2 (n is even)
;;; n → 3n + 1 (n is odd)

;;; Using the rule above and starting with 13, we generate the
;;; following sequence:

;;; 13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

;;; It can be seen that this sequence (starting at 13 and finishing at
;;; 1) contains 10 terms. Although it has not been proved yet (Collatz
;;; Problem), it is thought that all starting numbers finish at 1.

;;; Which starting number, under one million, produces the longest chain?

(defun range (start end)
  "Creates a list of numbers from start (inclusive) to end (exclusive)."
  (loop for i from start below end collect i))

(defparameter test-n 1000000)

(defun collatz (n)
  (cond ((evenp n) (/ n 2))
        ((oddp n) (+ 1 (* 3 n)))))

(defun collatz-count (n)
  (let ((acc 0))
    (do ((x n (collatz x)))
        ((equal x 1) (incf acc))
      (incf acc))))

(defun collatz-seq (n)
  (let (acc)
    (do ((x n (collatz x)))
        ((equal x 1) (push x acc))
      (push x acc))
    (nreverse acc)))

(defun longest-collatz ()
  (do ((i 1 (+ i 1))
       (highest 0)
       (highest-i)
       (cc 1 (collatz-count (+ i 1))))
      ((equal i test-n) highest-i)
    (if (> cc highest)
        (progn 
          (setf highest cc)
          (setf highest-i i)))))

(format t "~&~S~%" (longest-collatz))

;;; Result: 837,799 gives the longest sequence, with length 525
;;; Evaluation took:
;;;   7.054 seconds of real time
;;;   7.040440 seconds of total run time (7.040440 user, 0.000000 system)
;;;   99.80% CPU
;;;   14,779,706,077 processor cycles
;;;   0 bytes consed