;;; -*- mode: lisp -*-
;;; $Id: heapsort.poplisp,v 1.0 2002/05/03 13:48:00 dada Exp $

(defconstant IM     139968)
(defconstant IA       3877)
(defconstant IC      29573)

(defvar LAST 42)

(defun gen_random (max)
  (declare (optimize (speed 3) (debug 0) (safety 0))) 
  (declare (type (signed-byte 32) IM IA IC LAST))
  (declare (double-float max))
  (setq LAST (mod (+ (* LAST IA) IC) IM))
  (/ (* max LAST) IM))

(defun heapsort (n ra)
  (declare (optimize (speed 3) (debug 0) (safety 0))) 
  (let ((ir n)
    (l (+ (ash n -1) 1))
    (i 0) 
    (j 0)
    (rra 0.0d0))
    (declare (type (simple-array double-float (*)) ra))
    (declare (fixnum ir l i j))
    (declare (double-float rra))
    (block here
      (loop
    (cond ((>; l 1)
           (setq rra (aref ra (setq l (- l 1)))))
          (t
           (setq rra (aref ra ir))
           (setf (aref ra ir) (aref ra 1))
           (setq ir (- ir 1))
           (if (= ir 1)
           (progn
             (setf (aref ra 1) rra)
             (return-from here nil)))))
    (setq i l)
    (setq j (ash l 1))
    (do ()
        ((>; j ir))
      (cond ((and (<; j ir) (< (aref ra j) (aref ra (+ j 1))))
         (setq j (+ j 1))))
      (cond ((<; rra (aref ra j))
         (setf (aref ra i) (aref ra j))
         (setq j (+ j (the fixnum (setq i j)))))
        (t
         (setq j (+ ir 1)))))
    (setf (aref ra i) rra)))))

(declare (optimize (speed 3) (debug 0) (safety 0)))
(let* ((n (parse-integer (or (car pop11::poparglist) "1")))
 (ary (make-array (1+ n) :element-type 'double-float)))
(declare (fixnum n))
(loop for i fixnum from 0 below n do
  (setf (aref ary i) (gen_random 1.0d0)))
(heapsort n ary)
(format t "~,10K~%" (aref ary n)))