[The Original Shootout]   [NEWS]   [FAQ]   [Methodology]   [Platform Details]   [Acknowledgements]   [Scorecard]
All Source For Heapsort
heapsort.awka
```# \$Id: heapsort.gawk,v 1.3 2001/05/20 06:13:00 doug Exp \$
# http://www.bagley.org/~doug/shootout/

function gen_random(n) { return( (n * (LAST = (LAST * IA + IC) % IM)) / IM ); }

function heapsort (n, ra) {
l = int(0.5+n/2) + 1
ir = n;
for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l * 2;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

BEGIN {
IM = 139968;
IA = 3877;
IC = 29573;
LAST = 42;

n = (ARGV[1] < 1) ? 1 : ARGV[1];
ary[0] = 0;
for (i=1; i<=n; i++) {
ary[i] = gen_random(1.0);
}

heapsort(n, ary);

printf("%.10f\n", ary[n]);

exit;
}
```
heapsort.bcc
```/* -*- mode: c -*-
* \$Id: heapsort.gcc,v 1.10 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
*/

#include <stdlib.h>
#include <math.h>
#include <stdio.h>

#define IM 139968
#define IA   3877
#define IC  29573

double
gen_random(double max) {
static long last = 42;
return( max * (last = (last * IA + IC) % IM) / IM );
}

void
heapsort(int n, double *ra) {
int i, j;
int ir = n;
int l = (n >> 1) + 1;
double rra;

for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

int
main(int argc, char *argv[]) {
int N = ((argc == 2) ? atoi(argv[1]) : 1);
double *ary;
int i;

ary = (double *)malloc((N+1) * sizeof(double));
for (i=1; i<=N; i++) {
ary[i] = gen_random(1);
}

heapsort(N, ary);

printf("%.10g\n", ary[N]);

free(ary);
return(0);
}

```
heapsort.csharp
```// \$Id: heapsort.csharp,v 1.0 2002/09/28 10:21:00 dada Exp \$
// contributed by Erik Saltwell

using System;

namespace HeapSort
{
class App
{
public const long IM = 139968;
public const long IA =   3877;
public const long IC =  29573;

public static long last = 42;

public static double gen_random(double max)
{
return( max * (last = (last * IA + IC) % IM) / IM );
}

public static int count =0;

static void Main(string[] args)
{
count = int.Parse(args[0]);
double[] ary = new double[count+1];
unsafe
{
for(int i=0;i<=count;++i)
{
ary[i]=gen_random(1);
}
}
heapsort(ary);
Console.WriteLine(ary[count]);
}

public static void heapsort(double[] ra)
{
unsafe
{
int l, j, ir, i;
double rra;

l = (count >> 1) + 1;
ir = count;
for (;;)
{
if (l > 1)
{
rra = ra[--l];
}
else
{
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1)
{
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir)
{
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j])
{
ra[i] = ra[j];
j += (i = j);
}
else
{
j = ir + 1;
}
}
ra[i] = rra;
}
}
}

}
}
```
heapsort.cygperl
```#!/usr/local/bin/perl
# \$Id: heapsort.perl,v 1.11 2001/05/08 02:46:59 doug Exp \$
# http://www.bagley.org/~doug/shootout/
# Matt Harris suggested passing the array via typeglob

use strict;

use constant IM => 139968;
use constant IA =>   3877;
use constant IC =>  29573;

use vars qw(@ra);

my \$LAST = 42;
sub gen_random { (\$_[0] * (\$LAST = (\$LAST * IA + IC) % IM)) / IM }

sub heapsort (\$\@) {
my \$n = shift;
# use typeglob ra to refer to array.
local *ra = shift;

my(\$rra, \$i, \$j);

my \$l = (\$n >> 1) + 1;
my \$ir = \$n;
while (1) {
if (\$l > 1) {
\$rra = \$ra[--\$l];
} else {
\$rra = \$ra[\$ir];
# print('ir=1  ', \$ir, ' <- ', 1, ' (', sprintf("%.10g", \$ra[1]), ')', "\n" );
\$ra[\$ir] = \$ra[1];
if (--\$ir == 1) {
# print('1=rra ', 1, ' <- ', sprintf("%.10g", \$rra), "\n" );
\$ra[1] = \$rra;
return;
}
}
\$i = \$l;
\$j = \$l << 1;
# print "      l=\$l i=\$i j=\$j ir=\$ir\n";
while (\$j <= \$ir) {
\$j++ if ((\$j < \$ir) && (\$ra[\$j] < \$ra[\$j+1]));
# print("      in2while, j=\$j rra=", sprintf("%.10g", \$rra), ' ra(j)=', sprintf("%.10g", \$ra[\$j]), "\n");
if (\$rra < \$ra[\$j]) {
# print('i=j   ', \$i, ' <- ', \$j, ' (', sprintf("%.10g", \$ra[\$j]), ')', "\n" );
\$ra[\$i] = \$ra[\$j];
\$j += (\$i = \$j);
} else {
\$j = \$ir + 1;
}
}
# print('i=rra ', \$i, ' <- ', sprintf("%.10g", \$rra), "\n" );
\$ra[\$i] = \$rra;
}
}

my \$N = \$ARGV[0];
\$N = 1 if (\$N < 1);

# create an array of N random doubles
my @ary = ();
for (my \$i=1; \$i<=\$N; \$i++) {
\$ary[\$i] = gen_random(1.0);
}

heapsort(\$N, @ary);

printf("%.10g\n", \$ary[-1]);

```
heapsort.delphi
```program heapsort;

const
IM = 139968;
IA =   3877;
IC =  29573;

var
LAST: integer = 42;
function gen_random(n: double): double;
begin
LAST := (LAST * IA + IC) mod IM;
result := n * LAST / IM;
end;

// 1:1 translation of Java-version, error if n=1
procedure sort(n: integer; var a: array of double);
var
rra: double;
i, j, l, ir: integer;
begin
l:=(n shr 1)+1;
ir:=n;
while True do begin
if l>1 then begin
dec(l);
rra:=a[l];
end else begin
rra:=a[ir];
a[ir]:=a[1];
dec(ir);
if (ir=1) then begin
a[1]:=rra; exit;
end;
end;
i:=l;
j:=l shl 1;
while (j<=ir) do begin
if (j<ir)and(a[j]<a[j+1]) then
inc(j);
if (rra<a[j]) then begin
a[i]:=a[j];
i:=j;
inc(j,j);
end else
j:=ir+1;
end;
a[i]:=rra;
end;
end;

var NUM, code, i: integer;
ary: array of double;
begin
NUM:=1;
if ParamCount=1 then Val(ParamStr(1),NUM,code);

setLength(ary,NUM+1);
ary[0]:=0.0;
for i:=1 to NUM do
ary[i]:=gen_random(1);

sort(NUM, ary);

WriteLn(ary[NUM]:10:10);
end.

```
heapsort.elastic
```// \$Id: heapsort.elastic,v 1.0 2002/05/17 09:57:00 dada Exp \$
package heapsort;

import basic;
import sys;
import array;

local IM = 139968;
local IA = 3877;
local IC = 29573;

private function gen_random( n )
{
static LAST = 42.0;
LAST = (LAST * IA + IC) % IM;
return(n * LAST / IM);
}

private function heapsort( n, ra )
{
local rra;
local i;
local j;

local l = (n / 2) + 1;
local ir = n;

while (1) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l * 2;
while (j <= ir) {
if ( (j < ir) && (ra[j] < ra[j+1]) ) {
j++;
}
if (rra < ra[j]) {
ra[i] = ra[j];
i = j;
j = j + i;
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

private n = 1;
private i;
private result = 0;
private ary = #[];
if(array.length(sys.args) > 0) {
n = basic.int(sys.args[0]);
} else {
n = 1;
}
for(i=1; i<=n; i++) {
ary[i] = gen_random(1.0);
}
heapsort(n, ary);

basic.print(ary[-1]);
```
heapsort.erlang
```%% \$Id: heapsort.erlang,v 1.0 2002/09/24 12:16:00 dada Exp \$
%%
%% contributed by Isaac Gouy
%%
%% Quick and Dirty transliteration from the Mercury solution
%% with +1 adjustment for array indexes.
%% Mercury uses 0..N-1 and Erlang uses 1..N
%%
%% Usage: start from command line with
%%     erlc heapsort.erl
%%     erl -noinput -s heapsort main 10000

-module(heapsort).
-export([main/1]).

random_heap(I, Seed, H) ->
if
I < size(H) ->
{NextSeed, R} = gen_random(Seed),
random_heap(I+1, NextSeed, up_heap(I, R, H));
true -> H
end.

up_heap(N, Y, H) ->
HalfN = N div 2,
X = element(HalfN+1, H), %%%% +1
Condition = 0 < N andalso X < Y,
if
Condition -> up_heap(HalfN, Y, setelement(N+1, H, X)); %%%% +1
true -> setelement(N+1, H, Y) %%%% +1
end.

heapsort(0, H) -> H;
heapsort(N, H) -> heapsort(N-1, remove_greatest(N, H)).

remove_greatest(N, H) ->
X = element(0+1, H), %%%% +1
Y = element(N+1, H), %%%% +1
down_heap(0, N-1, Y, setelement(N+1, H, X)). %%%% +1

down_heap(I, N, X, H) ->
L = I + I + 1,
R = L + 1,
if
N < L ->
setelement(I+1, H, X); %%%% +1
true ->
Condition = R < N andalso element(R+1, H) > element(L+1, H), %%%% +1
J = if
Condition -> R;
true -> L
end,
Y = element(J+1, H),
if
X > Y -> setelement(I+1, H, X); %%%% +1
true -> down_heap(J, N, X, setelement(I+1, H, Y)) %%%% +1
end
end.

gen_random(Seed) ->
IM = 139968, IA = 3877, IC = 29573,
S = ((Seed * IA) + IC) rem IM,
{S, S/IM}.

main([Arg]) ->
N = list_to_integer(atom_to_list(Arg)),
Seed = 42,
RandomHeap = random_heap(0, Seed, erlang:make_tuple(N, 0.0)),
SortedHeap = heapsort(N-1, RandomHeap),
io:fwrite("~.10f~n", [element(N, SortedHeap)]),
halt(0).

```
heapsort.fpascal
```program heapsort;
uses SysUtils, Classes;

const
IM = 139968;
IA =   3877;
IC =  29573;

var
ary: TList;
r : real;
rr : ^real;
N, i, LAST : longint;

function gen_random(n : longint) : real;
begin
LAST := (LAST * IA + IC) mod IM;
gen_random := n * LAST / IM;
end;

procedure myheapsort(n : longint; var ra : TList);
var
rr : ^real;
rra : real;
i, j, l, ir : longint;
begin
rra := 0;
i := 0;
j := 0;
l := n shr 1 + 1;
ir := n;

while 1 = 1 do
begin
if l > 1 then begin
Dec(l);
rra := real(ra.Items[l]^);
end
else begin
rra := real(ra.Items[ir]^);

GetMem(rr, SizeOf(real));
rr^ := real(ra.Items[1]^);
ra.items[ir] := rr;

Dec(ir);
if ir = 1 then
begin

GetMem(rr, SizeOf(real));
rr^ := rra;
ra.items[1] := rr;

exit;
end;
end;

i := l;
j := l shl 1;

while j <= ir do begin
if (j < ir) and (real(ra.items[j]^) < real(ra.items[j+1]^)) then Inc(j);

if rra < real(ra.items[j]^) then begin

GetMem(rr, SizeOf(real));
rr^ := real(ra.items[j]^);
ra.items[i] := rr;

i := j;
Inc(j, i);
end
else begin
j := ir + 1;
end;
end;

GetMem(rr, SizeOf(real));
rr^ := rra;
ra.items[i] := rr;

end;
end;

begin
if ParamCount = 0 then
N := 1
else
N := StrToInt(ParamStr(1));
if N < 1 then N := 1;
LAST := 42;
ary := TList.Create;
ary.Capacity := N;
r := 0.0;
GetMem( rr, SizeOf(real) );
rr^ := r;
for i:= 1 to N do begin
r := gen_random(1);
GetMem( rr, SizeOf(real) );
rr^ := r;

end;
for i:= 1 to N do begin
r := real(ary.items[i]^);

end;
myheapsort(N, ary);
r := real(ary.items[N]^);
WriteLn( r:10:10 );
ary.Free;
end.

```
heapsort.gawk
```# \$Id: heapsort.gawk,v 1.3 2001/05/20 06:13:00 doug Exp \$
# http://www.bagley.org/~doug/shootout/

function gen_random(n) { return( (n * (LAST = (LAST * IA + IC) % IM)) / IM ); }

function heapsort (n, ra) {
l = int(0.5+n/2) + 1
ir = n;
for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l * 2;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

BEGIN {
IM = 139968;
IA = 3877;
IC = 29573;
LAST = 42;

n = (ARGV[1] < 1) ? 1 : ARGV[1];
ary[0] = 0;
for (i=1; i<=n; i++) {
ary[i] = gen_random(1.0);
}

heapsort(n, ary);

printf("%.10f\n", ary[n]);

exit;
}
```
heapsort.gcc
```/* -*- mode: c -*-
* \$Id: heapsort.gcc,v 1.10 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
*/

#include <stdlib.h>
#include <math.h>
#include <stdio.h>

#define IM 139968
#define IA   3877
#define IC  29573

double
gen_random(double max) {
static long last = 42;
return( max * (last = (last * IA + IC) % IM) / IM );
}

void
heapsort(int n, double *ra) {
int i, j;
int ir = n;
int l = (n >> 1) + 1;
double rra;

for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

int
main(int argc, char *argv[]) {
int N = ((argc == 2) ? atoi(argv[1]) : 1);
double *ary;
int i;

ary = (double *)malloc((N+1) * sizeof(double));
for (i=1; i<=N; i++) {
ary[i] = gen_random(1);
}

heapsort(N, ary);

printf("%.10g\n", ary[N]);

free(ary);
return(0);
}

```
heapsort.gforth
```\ -*- mode: forth -*-
\ \$Id: heapsort.gforth,v 1.1 2001/05/26 16:07:27 doug Exp \$
\ http://www.bagley.org/~doug/shootout/
\ from Anton Ertl

0. argc @ 1- arg >number 2drop drop constant NUM

139968 constant IM
3877 constant IA
29573 constant IC

variable SEED
42 SEED !

: format-float
f\$ dup >r 0<=
IF    '0 emit
ELSE  scratch r@ min type  r@ precision - zeros  THEN
'. emit r@ negate zeros
scratch r> 0 max /string 0 max -zeros type ;

: gen_random
IA SEED @ * IC + IM mod dup SEED ! s>d d>f
f* [ IM s>d d>f ] fliteral f/ ;

: heap-sort
swap { ra }
dup 2/ 1+ begin
dup 1 > if
1- dup floats ra + f@
else
over floats ra + dup >r f@
1 floats ra + f@ r> f!
swap 1- dup 1 = if
1 floats ra + f!
2drop exit
endif
swap endif
{ ir l }
l l 2* begin
dup ir <=
while
dup ir < if
dup floats ra + dup f@ float+ f@ f< if
1+
endif
endif
dup floats ra + f@ fover fover f< if
over floats ra + f!
nip dup 2*
else
fdrop drop ir 1+
endif
repeat
drop floats ra + f!
ir l
again ;

: main
NUM 1+ floats allocate throw
dup NUM floats bounds ?do
1e gen_random i f!
1 floats +loop
dup NUM heap-sort
NUM floats + f@ format-float cr ;

10 set-precision main bye

```
heapsort.ghc
```-- \$Id: heapsort.ghc,v 1.2 2001/05/08 02:46:59 doug Exp \$
-- http://www.bagley.org/~doug/shootout/
-- from Julian Assange

module Main(main) where
import System(getArgs, exitWith, ExitCode(..))
import Numeric(showFFloat)

main = do
arg <- getArgs
case arg of
[num] -> putStrLn (showFFloat (Just 10) answer "")
where
answer = last . heapsort .
take (read num) . random \$ 1.0
_     -> exitWith (ExitFailure 1)

-- construct an infinite list of random numbers
random :: Double -> [Double]
random max = map norm . rand \$ 42
where norm x = (fromIntegral x) * (max / (fromIntegral im))
rand x = x' : (rand x')
where x' = (x * ia + ic) `mod` im
im     = 139968
ia     = 3877
ic     = 29573

-- fold up a list like a tree
treefold f z []      = z
treefold f z [x]     = x
treefold f z (a:b:l) = treefold f z (f a b : pairfold l)
where pairfold (x:y:rest) = f x y : pairfold rest
pairfold l          = l

data Heap a = Nil | Node a [Heap a]
heapsort :: Ord a => [a] -> [a]
heapsort = flatten_heap . merge_heaps . map heapify

where heapify x   = Node x []

merge_heaps :: Ord a => [Heap a] -> Heap a
merge_heaps = treefold merge_heap Nil

flatten_heap Nil            = []
flatten_heap (Node x heaps) = x:flatten_heap (merge_heaps heaps)

merge_heap Nil                     Nil = Nil
merge_heap heap@(Node _ _)         Nil = heap
merge_heap node_a@(Node a heaps_a) node_b@(Node b heaps_b)
| a < b     = Node a (node_b : heaps_a)
| otherwise = Node b (node_a : heaps_b)
```
heapsort.gnat
```-- \$Id: heapsort.gnat,v 1.0 2003/06/11 12:10:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Heapsort is
type Real is digits Positive'Max (15, System.Max_Digits);
package Rio is new Text_IO.Float_IO (Num => Real);

package Random_Real is
function Gen_Random (Supr : Real) return Real;
pragma Inline (Gen_Random);
end Random_Real;

package body Random_Real is
IM          : constant Positive := 139968;
IA          : constant Integer := 3877;
IC          : constant Integer := 29573;
Last        : Integer := 42;

function Gen_Random (Supr : Real) return Real is
pragma Suppress (Overflow_Check);
pragma Suppress (Range_Check);
begin
Last := (Last * IA + IC) mod IM;
return Supr * Real (Last) / Real (IM);
end Gen_Random;
end Random_Real;

type Range_Int is new Integer;
subtype Offset_Int is Range_Int;

type Real_Array is array (Range_Int range <>) of Real;
type Real_Array_Ptr is access Real_Array;

procedure Heapsort (A : in out Real_Array) is
pragma Suppress (Overflow_Check);
pragma Suppress (Index_Check);
pragma Suppress (Range_Check);
subtype Range_Positive is Range_Int;
First          : constant Range_Int := A'First;    --  might be <= -1
IR             : Range_Positive;
One            : constant Offset_Int := 1;
Minus_One      : constant Offset_Int := -1;
First_Minus_1  : constant Range_Int := First + Minus_One;
First_Plus_1   : constant Range_Int := First + One;
RRA            : Real;
L              : Offset_Int := One + (A'Length / 2);
begin
if A'Length <= 0 then
return;
end if;
IR := A'Last;
loop
if L > One then
L := L - One;
RRA := A (First_Minus_1 + L);
else
RRA := A (IR);
A (IR) := A (First);
if IR <= First_Plus_1 then
A (First) := RRA;
exit;
else
IR := IR + Minus_One;
end if;
end if;
declare
K1    : Range_Positive := First_Minus_1 + L;
K2    : Range_Positive := K1 + L;
begin
while K2 <= IR loop
if K2 < IR then
if A (K2) < A (K2 + One) then
K2 := K2 + One;
end if;
end if;
if RRA < A (K2) then
A (K1) := A (K2);
K1 := K2;
K2 := K1 + (K1 - First_Minus_1);
else
K2 := IR + One;
end if;
end loop;
A (K1) := RRA;
end;
end loop;
end Heapsort;

N           : Range_Int;
No_Verify   : constant Boolean := True;
Chk         : Real := 0.0;
X           : Real_Array_Ptr;
begin
begin
N := Range_Int'Max (1, Range_Int'Value (Ada.Command_Line.Argument (1)));
exception
when Constraint_Error => N := 1;
end;
X := new Real_Array (0 .. N - 1);   --  3% slower than 'declare' (stack)
for Iter in X'Range loop
X (Iter) := Random_Real.Gen_Random (Supr => 1.0);
end loop;
if No_Verify then
Heapsort (A => X.all);
Rio.Put (X (X'Last), Fore => 0, Aft => 10, Exp => 0);
Text_IO.New_Line;
else
for Iter in X'Range loop Chk := Chk + X (Iter); end loop;
Heapsort (A => X.all);
for K in X'Range loop
pragma Assert (K + 1 = X'Last or else X (K) <= X (K + 1));
Chk := Chk - X (K);
end loop;
pragma Assert (abs Chk < 50.0 * Real (N) * Real'Model_Epsilon);
end if;
end Heapsort;

```
heapsort.guile
```#!/usr/local/bin/guile \
-e main -s
!#

;;; \$Id: heapsort.guile,v 1.4 2001/06/29 23:12:37 doug Exp \$
;;; http://www.bagley.org/~doug/shootout/

(use-modules (ice-9 format))

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

(define LAST 42)
(define (gen_random max)
(set! LAST (modulo (+ (* LAST IA) IC) IM))
(/ (* max LAST) IM))

(define (heapsort n ra)
(let ((ir n)
(l (+ (ash n -1) 1))
(i 0)
(j 0)
(rra 0.0))
(define (heapsortloop)
(while #t
(cond ((>; l 1)
(set! l (- l 1))
(set! rra (vector-ref ra l)))
(else
(set! rra (vector-ref ra ir))
(vector-set! ra ir (vector-ref ra 1))
(set! ir (- ir 1))
(cond ((= ir 1)
(vector-set! ra 1 rra)
(throw 'return)))))
(set! i l)
(set! j (ash l 1))
(while (<;= j ir)
(cond ((and (<; j ir) (< (vector-ref ra j) (vector-ref ra (+ j 1))))
(set! j (+ j 1))))
(cond ((<; rra (vector-ref ra j))
(vector-set! ra i (vector-ref ra j))
(set! i j)
(set! j (+ j i)))
(else
(set! j (+ ir 1)))))
(vector-set! ra i rra)))
(catch 'return
heapsortloop
(lambda args #t))))

(define (main args)
(let* ((n (or (and (= (length args) 2) (string->;number (cadr args))) 1))
(last (+ n 1))
(ary (make-vector last 0)))
(do ((i 1 (+ i 1)))
((= i last))
(vector-set! ary i (gen_random 1.0)))
(heapsort n ary)
(display (format "~,10F\n" (vector-ref ary n)))))
```
heapsort.ici
```// \$Id: heapsort.ici,v 1.0 2003/01/03 12:19:00 dada Exp \$
//
// contributed by Tim Long

static IM = 139968;
static IA = 3877;
static IC = 29573;

static
gen_random(max)
{
static last = 42;

return max * (last = (last * IA + IC) % IM) / IM ;
}

static
heapsort(n, ra)
{
ir = n;
l = (n >> 1) + 1;
for (;;)
{
if (l > 1)
{
rra = ra[--l];
}
else
{
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1)
{
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir)
{
if (j < ir && ra[j] < ra[j+1])
++j;
if (rra < ra[j])
{
ra[i] = ra[j];
j += (i = j);
}
else
{
j = ir + 1;
}
}
ra[i] = rra;
}
}

N = argv[1] ? int(argv[1]) : 1;
ary = array();
for (i = 0; i <= N; ++i)
ary[i] = gen_random(1.0);
heapsort(N, ary);
printf("%.10f\n", ary[N]);
```
heapsort.icon
```# -*- mode: icon -*-
# \$Id: heapsort.icon,v 1.1 2001/05/08 02:46:59 doug Exp \$
# http://www.bagley.org/~doug/shootout/

\$define IM 139968
\$define IA 3877
\$define IC 29573

procedure gen_random(max)
static LAST; initial LAST := 42;
repeat { suspend((max * (LAST := (LAST * IA + IC) % IM)) / IM) }
end

procedure heapsort(n, ra)
local l, j, ir, i, rra

l := ishift(n, -1) + 1
ir := n
repeat {
if (l > 1) then {
l := l - 1
rra := ra[l]
} else {
rra := ra[ir]
ra[ir] := ra[1]
ir := ir - 1
if (ir == 1) then {
ra[1] := rra
return
}
}
i := l
j := ishift(l, 1)
while (j <= ir) do {
if ((j < ir) & (ra[j] < ra[j+1])) then {
j := j + 1
}
if (rra < ra[j]) then {
ra[i] := ra[j]
i := j
j := j + i
} else {
j := ir + 1
}
}
ra[i] := rra
}
end

procedure main(argv)
n := argv[1] | 1
ary := list(n)
every i := 1 to n do ary[i] := gen_random(1.0)
heapsort(n, ary)
write(ary[n])
end

```
heapsort.java
```// \$Id: heapsort.java,v 1.6 2001/05/08 02:46:59 doug Exp \$
// http://www.bagley.org/~doug/shootout/

import java.text.*;
import java.lang.reflect.Array;

public class heapsort {

public static final long IM = 139968;
public static final long IA =   3877;
public static final long IC =  29573;

public static void main(String args[]) {
int N = Integer.parseInt(args[0]);
NumberFormat nf = NumberFormat.getInstance();
nf.setMaximumFractionDigits(10);
nf.setMinimumFractionDigits(10);
nf.setGroupingUsed(false);
double []ary = (double[])Array.newInstance(double.class, N+1);
for (int i=1; i<=N; i++) {
ary[i] = gen_random(1);
}
heapsort(N, ary);
System.out.print(nf.format(ary[N]) + "\n");
}

public static long last = 42;
public static double gen_random(double max) {
return( max * (last = (last * IA + IC) % IM) / IM );
}

public static void heapsort(int n, double ra[]) {
int l, j, ir, i;
double rra;

l = (n >> 1) + 1;
ir = n;
for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}
}
```
heapsort.jscript
```// -*- mode: java -*-
// \$Id: heapsort.njs,v 1.1 2001/07/31 17:21:30 doug Exp \$
// http://www.bagley.org/~doug/shootout/
// from: David Hedbor

var IM = 139968;
var IA = 3877;
var IC = 29573;

var last = 42;

function gen_random(max) { return(max * (last = (last * IA + IC) % IM) / IM); }

function heapsort(n, ra) {
var l, j, ir, i;
var rra;

l = (n >> 1) + 1;
ir = n;
for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

var n;

ARGS = WScript.Arguments;
if(ARGS.length > 0) {
n = parseInt(ARGS.Item(0), "10");
if(n < 1) n = 1;
} else {
n = 1;
}

var ary, i;

// create an array of N random floats
ary = Array(n+1);
for (i=1; i<=n; i++) {
ary[i] = gen_random(1.0);
}
heapsort(n, ary);
WScript.Echo(ary[n].valueOf().toFixed(10));

```
heapsort.lcc
```/* -*- mode: c -*-
* \$Id: heapsort.gcc,v 1.10 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
*/

#include <stdlib.h>
#include <math.h>
#include <stdio.h>

#define IM 139968
#define IA   3877
#define IC  29573

double
gen_random(double max) {
static long last = 42;
return( max * (last = (last * IA + IC) % IM) / IM );
}

void
heapsort(int n, double *ra) {
int i, j;
int ir = n;
int l = (n >> 1) + 1;
double rra;

for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

int
main(int argc, char *argv[]) {
int N = ((argc == 2) ? atoi(argv[1]) : 1);
double *ary;
int i;

ary = (double *)malloc((N+1) * sizeof(double));
for (i=1; i<=N; i++) {
ary[i] = gen_random(1);
}

heapsort(N, ary);

printf("%.10g\n", ary[N]);

free(ary);
return(0);
}

```
heapsort.lua
```#!/usr/local/bin/lua-- \$Id: heapsort.lua,v 1.10 2001/05/08 02:46:59 doug Exp \$
-- http://www.bagley.org/~doug/shootout/

local IM = 139968
local IA =   3877
local IC =  29573

LAST = 42
function gen_random(max)
LAST = mod((LAST * %IA + %IC), %IM)
return( (max * LAST) / %IM )
end

function heapsort(n, ra)
local j, i, rra
local l = floor(n/2) + 1
local ir = n;
while 1 do
if l > 1 then
l = l - 1
rra = ra[l]
else
rra = ra[ir]
ra[ir] = ra[1]
ir = ir - 1
if (ir == 1) then
ra[1] = rra
return
end
end
i = l
j = l * 2
while j <= ir do
if (j < ir) and (ra[j] < ra[j+1]) then
j = j + 1
end
if rra < ra[j] then
ra[i] = ra[j]
i = j
j = j + i
else
j = ir + 1
end
end
ra[i] = rra
end
end

local ary = {}
local N = (tonumber((arg and arg[1])) or 1)

for i=1, N do
ary[i] = gen_random(1.0)
end

heapsort(N, ary)

write(format("%0.10f\n", ary[N]))
```
heapsort.lua5
```#!/usr/local/bin/lua-- http://www.bagley.org/~doug/shootout/
-- contributed by Roberto Ierusalimschy

local IM = 139968
local IA =   3877
local IC =  29573

local LAST = 42
function gen_random(max)
LAST = math.mod((LAST * IA + IC), IM)
return( (max * LAST) / IM )
end

function heapsort(n, ra)
local j, i, rra
local l = math.floor(n/2) + 1
local ir = n;
while 1 do
if l > 1 then
l = l - 1
rra = ra[l]
else
rra = ra[ir]
ra[ir] = ra[1]
ir = ir - 1
if (ir == 1) then
ra[1] = rra
return
end
end
i = l
j = l * 2
while j <= ir do
if (j < ir) and (ra[j] < ra[j+1]) then
j = j + 1
end
if rra < ra[j] then
ra[i] = ra[j]
i = j
j = j + i
else
j = ir + 1
end
end
ra[i] = rra
end
end

local ary = {}
local N = (tonumber((arg and arg[1])) or 1)

for i=1, N do
ary[i] = gen_random(1.0)
end

heapsort(N, ary)

io.write(string.format("%0.10f\n", ary[N]))

```
heapsort.mawk
```# \$Id: heapsort.mawk,v 1.2 2001/05/20 06:13:00 doug Exp \$
# http://www.bagley.org/~doug/shootout/

function gen_random(n) { return( (n * (LAST = (LAST * IA + IC) % IM)) / IM ); }

function heapsort (n, ra) {
l = int(0.5+n/2) + 1
ir = n;
for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l * 2;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

BEGIN {
IM = 139968;
IA = 3877;
IC = 29573;
LAST = 42;

n = (ARGV[1] < 1) ? 1 : ARGV[1];
ary[0] = 0;
for (i=1; i<=n; i++) {
ary[i] = gen_random(1.0);
}

heapsort(n, ary);

printf("%.10f\n", ary[n]);

exit;
}
```
heapsort.mercury
```% ---------------------------------------------------------------------------- %
% heapsort.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan  9 14:18:19 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% ---------------------------------------------------------------------------- %

:- module mytest.

:- interface.

:- import_module io.

:- pred main(io__state, io__state).
:- mode main(di, uo) is det.

:- implementation.

:- import_module float, int, array, random, list, string, require.

:- type heap == array(float).

main -->
io__command_line_arguments(ArgV),
(   { ArgV = [],        N = 1 }
;   { ArgV = [Arg],     N = string__det_to_int(Arg) }
;   { ArgV = [_,_|_],   error("usage: heapsort [N]") }
),
{ A = heapsort(N - 1, random_heap(0, seed, array__init(N, 0.0))) },
io__format("%.10f", [f(array__lookup(A, N - 1))]),
io__nl.

:- func random_heap(int, int, heap) = heap.
:- mode random_heap(in, in, array_di) = array_uo is det.

random_heap(I, S0, H0) = H :-
( if I =< array__max(H0) then
gen_random(R, S0, S),
H = random_heap(I + 1, S, up_heap(I, R, H0))
else
H = H0
).

:- func up_heap(int, float, heap) = heap.
:- mode up_heap(in, in, array_di) = array_uo is det.

up_heap(N, Y, H) =
( if 0 < N, X < Y then
up_heap(HalfN, Y, array__set(H, N, X))
else
array__set(H, N, Y)
)
:-
HalfN = N // 2,
X = array__lookup(H, HalfN).

:- func heapsort(int, heap) = heap.
:- mode heapsort(in, array_di) = array_uo is det.

heapsort(N, H) =
( if N = 0 then H else heapsort(N - 1, remove_greatest(N, H)) ).

:- func remove_greatest(int, heap) = heap.
:- mode remove_greatest(in, array_di) = array_uo is det.

remove_greatest(N, H) = down_heap(0, N - 1, Y, array__set(H, N, X)) :-
X = array__lookup(H, 0),
Y = array__lookup(H, N).

:- func down_heap(int, int, float, heap) = heap.
:- mode down_heap(in, in, in, array_di) = array_uo is det.

down_heap(I, N, X, H0) = H :-
L = I + I + 1,
R = L + 1,
( if N < L then
H = array__set(H0, I, X)
else
J = ( if R < N, array__lookup(H0, R) > array__lookup(H0, L) then R
else L ),
Y = array__lookup(H0, J),
( if X > Y then
H = array__set(H0, I, X)
else
H = down_heap(J, N, X, array__set(H0, I, Y))
)
).

:- pred gen_random(float, int, int).
:- mode gen_random(out, in, out) is det.

gen_random(R, S0, S) :-
S = (S0 * ia + ic) `mod` im,
R = float(S) / float(im).

:- func im = int.   im = 139968.
:- func ia = int.   ia =   3877.
:- func ic = int.   ic =  29573.
:- func seed = int. seed =   42.
```
heapsort.mingw32
```/* -*- mode: c -*-
* \$Id: heapsort.gcc,v 1.10 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
*/

#include <stdlib.h>
#include <math.h>
#include <stdio.h>

#define IM 139968
#define IA   3877
#define IC  29573

double
gen_random(double max) {
static long last = 42;
return( max * (last = (last * IA + IC) % IM) / IM );
}

void
heapsort(int n, double *ra) {
int i, j;
int ir = n;
int l = (n >> 1) + 1;
double rra;

for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

int
main(int argc, char *argv[]) {
int N = ((argc == 2) ? atoi(argv[1]) : 1);
double *ary;
int i;

ary = (double *)malloc((N+1) * sizeof(double));
for (i=1; i<=N; i++) {
ary[i] = gen_random(1);
}

heapsort(N, ary);

printf("%.10g\n", ary[N]);

free(ary);
return(0);
}

```
heapsort.nice
```/* The Great Win32 Language Shootout http://dada.perl.it/shootout/
contributed by Isaac Gouy (Nice novice)

Transliterated from the Java implementation

To compile:
nicec --sourcepath=.. -d=. -a heapsort.jar heapsort

To run:
java -jar heapsort.jar 80000
*/

import random; // reuse gen_random & floatFormat & toSingleInt

void main(String[] args){
let n = toSingleInt(args);

let numbers = new double[n+1];
for (var i = 1; i <= n; i++) numbers[i] = gen_random(1);

heapsort(n, numbers);

println(floatFormat(10).format(numbers[n]));
}

void heapsort(int n, double[] ra) {
int l, j, ir, i;
double rra;

if (n < 2) return;
l = (n >> 1) + 1;
ir = n;
for (;;) {
if (l > 1) rra = ra[--l];
else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
}
else j = ir + 1;
}
ra[i] = rra;
}
}```
heapsort.ocaml
```(*
* \$Id: heapsort.ocaml,v 1.9 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)

let im = 139968
let ia =   3877
let ic =  29573
let last = ref 42

let gen_random max =
last := (!last * ia + ic) mod im;
max *. float_of_int !last /. float_of_int im

let heapsort n ra =
let l = ref ((n lsr 1) + 1)
and rra = ref 0.0
and i = ref 0
and j = ref 0
and ir = ref n in
try
while true do
if !l > 1 then begin
decr l;
rra := ra.(!l)
end
else begin
rra := ra.(!ir);
ra.(!ir) <- ra.(1);
decr ir;
if !ir = 1 then begin
ra.(1) <- !rra;
raise Exit
end
end;
i := !l;
j := !l lsl 1;
while !j <= !ir do
if !j < !ir && ra.(!j) < ra.(!j+1) then incr j;
if !rra < ra.(!j) then begin
ra.(!i) <- ra.(!j);
i := !j;
j := !j + !i
end
else j := !ir + 1;
done;
ra.(!i) <- !rra;
done
with Exit -> ()

let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let ary = Array.make (n + 1) 0.0 in
for i = 1 to n do
ary.(i) <- gen_random 1.0
done;
heapsort n ary;
Printf.printf "%.10f\n" ary.(n)
```
heapsort.ocamlb
```(*
* \$Id: heapsort.ocaml,v 1.9 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)

let im = 139968
let ia =   3877
let ic =  29573
let last = ref 42

let gen_random max =
last := (!last * ia + ic) mod im;
max *. float_of_int !last /. float_of_int im

let heapsort n ra =
let l = ref ((n lsr 1) + 1)
and rra = ref 0.0
and i = ref 0
and j = ref 0
and ir = ref n in
try
while true do
if !l > 1 then begin
decr l;
rra := ra.(!l)
end
else begin
rra := ra.(!ir);
ra.(!ir) <- ra.(1);
decr ir;
if !ir = 1 then begin
ra.(1) <- !rra;
raise Exit
end
end;
i := !l;
j := !l lsl 1;
while !j <= !ir do
if !j < !ir && ra.(!j) < ra.(!j+1) then incr j;
if !rra < ra.(!j) then begin
ra.(!i) <- ra.(!j);
i := !j;
j := !j + !i
end
else j := !ir + 1;
done;
ra.(!i) <- !rra;
done
with Exit -> ()

let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let ary = Array.make (n + 1) 0.0 in
for i = 1 to n do
ary.(i) <- gen_random 1.0
done;
heapsort n ary;
Printf.printf "%.10f\n" ary.(n)
```
heapsort.oz
```%%% \$Id: strcat.oz,v 1.0 2002/11/05 12:21:00 dada Exp \$
%%%
%%% contributed by Isaac Gouy

%%  Transliterated from the Mercury solution
%%
%%  Usage: start from command line with
%%     ozc -x heapsort.oz -o heapsort.oz.exe
%%     heapsort.oz.exe 1000

functor
import System Application

define
IM = 139968
IA = 3877
IC = 29573
Seed = 42

fun {Random_heap H I S0}
local R S in
if I =< {Array.high H} then
{Gen_random R S0 S}
{Random_heap {Up_heap H I R} I+1 S}
else
H
end
end
end

fun {Up_heap H N Y}
local HalfN X in
HalfN = N div 2
X = {Get H HalfN}
if 0 < N andthen X < Y then
{Put H N X}
{Up_heap H HalfN Y}
else
{Put H N Y}
H
end
end
end

fun {Heapsort H N}
if N == 0 then H
else {Heapsort {Remove_greatest H N} N-1} end
end

fun {Remove_greatest H N}
local X Y in
X = {Get H 0}
Y = {Get H N}
{Put H N X}
{Down_heap H 0 N-1 Y}
end
end

fun {Down_heap H I N X}
local L R J Y in
L = I + I + 1
R = L + 1
if N < L then
{Put H I X}
H
else
J = if R < N andthen {Get H R} > {Get H L}
then  R else L end
Y = {Get H J}
if X > Y then
{Put H I X}
H
else
{Put H I Y}
{Down_heap H J N X}
end
end
end
end

proc {Gen_random R S0 S}
S = (S0 * IA + IC) mod IM
R = {IntToFloat S} / {IntToFloat IM}
end

in
local Args N RandomHeap SortedHeap in
[Args] = {Application.getArgs plain}
N = {String.toInt Args}
RandomHeap = {Random_heap {NewArray 0 N-1 0.0} 0 Seed}
SortedHeap = {Heapsort RandomHeap N-1}
{System.showInfo {Get SortedHeap N-1}}
end
{Application.exit 0}
end

```
heapsort.perl
```#!/usr/local/bin/perl
# \$Id: heapsort.perl,v 1.11 2001/05/08 02:46:59 doug Exp \$
# http://www.bagley.org/~doug/shootout/
# Matt Harris suggested passing the array via typeglob

use strict;

use constant IM => 139968;
use constant IA =>   3877;
use constant IC =>  29573;

use vars qw(@ra);

my \$LAST = 42;
sub gen_random { (\$_[0] * (\$LAST = (\$LAST * IA + IC) % IM)) / IM }

sub heapsort (\$\@) {
my \$n = shift;
# use typeglob ra to refer to array.
local *ra = shift;

my(\$rra, \$i, \$j);

my \$l = (\$n >> 1) + 1;
my \$ir = \$n;
while (1) {
if (\$l > 1) {
\$rra = \$ra[--\$l];
} else {
\$rra = \$ra[\$ir];
# print('ir=1  ', \$ir, ' <- ', 1, ' (', sprintf("%.10g", \$ra[1]), ')', "\n" );
\$ra[\$ir] = \$ra[1];
if (--\$ir == 1) {
# print('1=rra ', 1, ' <- ', sprintf("%.10g", \$rra), "\n" );
\$ra[1] = \$rra;
return;
}
}
\$i = \$l;
\$j = \$l << 1;
# print "      l=\$l i=\$i j=\$j ir=\$ir\n";
while (\$j <= \$ir) {
\$j++ if ((\$j < \$ir) && (\$ra[\$j] < \$ra[\$j+1]));
# print("      in2while, j=\$j rra=", sprintf("%.10g", \$rra), ' ra(j)=', sprintf("%.10g", \$ra[\$j]), "\n");
if (\$rra < \$ra[\$j]) {
# print('i=j   ', \$i, ' <- ', \$j, ' (', sprintf("%.10g", \$ra[\$j]), ')', "\n" );
\$ra[\$i] = \$ra[\$j];
\$j += (\$i = \$j);
} else {
\$j = \$ir + 1;
}
}
# print('i=rra ', \$i, ' <- ', sprintf("%.10g", \$rra), "\n" );
\$ra[\$i] = \$rra;
}
}

my \$N = \$ARGV[0];
\$N = 1 if (\$N < 1);

# create an array of N random doubles
my @ary = ();
for (my \$i=1; \$i<=\$N; \$i++) {
\$ary[\$i] = gen_random(1.0);
}

heapsort(\$N, @ary);

printf("%.10g\n", \$ary[-1]);

```
heapsort.php
```<?php
/*
\$Id: heapsort.php,v 1.1 2001/05/08 03:25:55 doug Exp \$
http://www.bagley.org/~doug/shootout/
*/
define("IM", 139968);
define("IA", 3877);
define("IC", 29573);

\$LAST = 42;
function gen_random (\$n) {
global \$LAST;
return( (\$n * (\$LAST = (\$LAST * IA + IC) % IM)) / IM );
}

function heapsort (\$n, &\$ra) {
\$l = (\$n >> 1) + 1;
\$ir = \$n;

while (1) {
if (\$l > 1) {
\$rra = \$ra[--\$l];
} else {
\$rra = \$ra[\$ir];
\$ra[\$ir] = \$ra[1];
if (--\$ir == 1) {
\$ra[1] = \$rra;
return;
}
}
\$i = \$l;
\$j = \$l << 1;
while (\$j <= \$ir) {
if ((\$j < \$ir) && (\$ra[\$j] < \$ra[\$j+1])) {
\$j++;
}
if (\$rra < \$ra[\$j]) {
\$ra[\$i] = \$ra[\$j];
\$j += (\$i = \$j);
} else {
\$j = \$ir + 1;
}
}
\$ra[\$i] = \$rra;
}
}

\$N = (\$argc == 2) ? \$argv[1] : 1;

for (\$i=1; \$i<=\$N; \$i++) {
\$ary[\$i] = gen_random(1);
}

/*
for (\$i=0; \$i<\$N; \$i++) {
printf("%4d %.15f\n", \$i, \$ary[\$i]);
}
*/

heapsort(\$N, \$ary);

printf("%.10f\n", \$ary[\$N]);
?>
```
heapsort.pike
```#!/usr/local/bin/pike// -*- mode: pike -*-
// \$Id: heapsort.pike,v 1.9 2001/05/08 02:46:59 doug Exp \$
// http://www.bagley.org/~doug/shootout/
// from: Fredrik Noring

#define IM 139968
#define IA   3877
#define IC  29573

int last = 42;

float
gen_random(float max) { return(max * (last = (last * IA + IC) % IM) / IM); }

void heapsort(int n, array(float) ra) {
int l, j, ir, i;
float rra;

l = (n >> 1) + 1;
ir = n;
for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

void main(int argc, array(string) argv) {
int N = (int)argv[-1] || 1;
array(float) ary;
int i;

// create an array of N random floats
ary = allocate(N+1);
for (i=1; i<=N; i++) {
ary[i] = gen_random(1.0);
}

heapsort(N, ary);

write("%.10g\n", ary[N]);
}
```
heapsort.pliant
```# \$Id: heapsort.pliant,v 1.0 2002/02/07 15:44:00 dada Exp \$

module "/pliant/language/context.pli"

gvar Int IM := 139968
gvar Int IA :=   3877
gvar Int IC :=  29573

gvar Int LAST := 42

function gen_random n -> r
arg Float n ; arg Float r
LAST := (LAST * IA + IC) % IM
r := (n * LAST) / IM
return r

function heapsort n ra
arg Int n ; arg_rw Array:Float ra
var Float rra
var Int i
var Int j
var Int l := (n\2) + 1
var Int ir := n

part heapsort_loop
if l>1
l := l - 1
rra := ra:l
else
rra := ra:ir
ra:ir := ra:1
ir := ir - 1
if ir=1
ra:1 := rra
leave heapsort_loop
i := l
j := l*2

while j<=ir
if j<ir and ra:j < ra:(j+1)
j := j + 1
if rra < ra:j
ra:i := ra:j
i := j
j := j + i
else
j := ir + 1
ra:i := rra
restart heapsort_loop

gvar Float result

gvar Int i

gvar Array:Float ary

gvar Str s_n := cast ((pliant_script_args translate Address 1) map CStr) Str
if (s_n parse (gvar Int n))
for (i) 1 n
ary += gen_random(1.0)
heapsort n-1 ary
console (string ary:(ary:size-1) "fixed 9") eol
else
console "usage: heapsort.pliant <number>" eol

```
heapsort.poplisp
```;;; -*- 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)))
```
heapsort.python
```#!/usr/local/bin/python -O
# \$Id: heapsort.python,v 1.10 2001/09/09 01:57:21 doug Exp \$
# http://www.bagley.org/~doug/shootout/

import sys

IM = 139968
IA =   3877
IC =  29573

LAST = 42
def gen_random(max):
global LAST
LAST = (LAST * IA + IC) % IM
return( (max * LAST) / IM )

def heapsort(n, ra):
rra = i = j = 0
l = (n >> 1) + 1
ir = n

while (1):
if (l > 1):
l -= 1
rra = ra[l]
else:
rra = ra[ir]
ra[ir] = ra[1]
ir -= 1
if (ir == 1):
ra[1] = rra
return
i = l
j = l << 1
while (j <= ir):
if ((j < ir) and (ra[j] < ra[j+1])):
j += 1
if (rra < ra[j]):
ra[i] = ra[j]
i = j
j += i
else:
j = ir + 1
ra[i] = rra

def main():
N = int(sys.argv[1])
if N < 1:
N = 1

ary = range(N+1)
for i in xrange(1,N+1):
ary[i] = gen_random(1.0)

heapsort(N, ary)

print "%.10f" % ary[N]

main()

```
heapsort.rebol
```REBOL [
Title:   "Heapsort"
Author:  "Aldo Calpini"
Date:    03-Jul-2001
File:    %heapsort.r
]

IM: 139968
IA:   3877
IC:  29573

LAST: 42

gen_random: func [N] [
LAST: (LAST * IA + IC) // IM
return N * LAST / IM
]

heapsort: func [
n ra
/local
rra [decimal!]
l [integer!]
ir [integer!]
j [integer!]
k [integer!]
] [
l: n / 2 + 1
ir: n
while [1] [

either l > 1 [
l: l - 1
rra: pick ra l
] [
rra: pick ra ir
v: pick ra 1
change at ra ir v
ir: ir - 1
if [ir = 1] [
change at ra 1 rra
return
]
]
i: l
j: l * 2

while [ j <= ir ] [
if j < ir [
v1: pick ra j
v2: pick ra (j + 1)
if v1 < v2 [
j: j + 1
]
]
v: pick ra j
either rra < v [
change at ra i v
i: j
j: j + i
] [
j: ir + 1
]
]
change at ra i rra
]
]

NUM: to-integer to-string system/script/args
NUM: either NUM < 1 [ 1 ] [ NUM ]

ary: copy []
for i 1 NUM 1 [
insert tail ary gen_random 1
]

heapsort NUM ary

probe ary

v: pick ary NUM

print v
write %output.rebol v

```
heapsort.rexx
```NUMERIC DIGITS 10

vIM=139968
vIA=3877
vIC=29573

LAST=42

parse arg n
If n < 1 Then Do
n = 1
End

Do i = 1 TO N
ary.i = gen_random(1)
End

CALL heapsort N

SAY ary.N

EXIT

gen_random:
PROCEDURE EXPOSE LAST vIM vIA vIC
PARSE ARG n
LAST = (LAST * vIA + vIC) // vIM
return n * LAST / vIM

heapsort:
PARSE ARG n
rra = 0
i = 0
j = 0
l = (n % 2) + 1
ir = n

Do While 1
If l > 1 Then Do
l = l - 1
rra = ary.l
End
Else Do
rra = ary.ir
ary.ir = ary.1
ir = ir - 1
If ir = 1 Then Do
ary.1 = rra
return
End
End

i = l
j = l * 2

Do While  j <= ir
If j < ir Then Do
jj = j+1
If ary.j < ary.jj Then Do
j = j + 1
End
End

If rra < ary.j Then Do
ary.i = ary.j
i = j
j = j + i
End
Else Do
j = ir + 1
End
End
ary.i = rra
End

```
heapsort.ruby
```#!/usr/local/bin/ruby
# -*- mode: ruby -*-
# \$Id: heapsort.ruby,v 1.7 2001/05/08 02:46:59 doug Exp \$
# http://www.bagley.org/~doug/shootout/

IM = 139968
IA =   3877
IC =  29573

\$last = 42.0
def gen_random (max) (max * (\$last = (\$last * IA + IC) % IM)) / IM end

def heapsort(n, ra)
j = i = rra = 0
l = (n >> 1) + 1
ir = n

while (1) do
if (l > 1) then
rra = ra[(l -= 1)]
else
rra = ra[ir]
ra[ir] = ra[1]
if ((ir -= 1) == 1) then
ra[1] = rra
return
end
end
i = l
j = l << 1
while (j <= ir) do
if ((j < ir) and (ra[j] < ra[j+1])) then
j += 1
end
if (rra < ra[j]) then
ra[i] = ra[j]
j += (i = j)
else
j = ir + 1
end
end
ra[i] = rra
end
end

N = Integer(ARGV.shift || 1)
ary = []
for i in 1 .. N
ary[i] = gen_random(1.0)
end

heapsort(N, ary)

printf "%.10f\n", ary[N]
```
heapsort.se
```-- -*- mode: eiffel -*-
-- \$Id: heapsort.se,v 1.1 2001/05/21 18:18:41 doug Exp \$
-- http://www.bagley.org/~doug/shootout/

class HEAPSORT

creation make

feature

make is
local
array: ARRAY[DOUBLE]
n: INTEGER
do
n := argument(1).to_integer
!!array.make(1, n)
fill_array(array)
sort_array(n, array)
io.put_string(array.item(n).to_string_format(10))
io.put_new_line
end

sort_array(n: INTEGER; ra: ARRAY[DOUBLE]) is
local
i, j, ir, l: INTEGER
rra: DOUBLE
done: BOOLEAN
do
j := 0
i := 0
rra := 0.0
ir := n
l := n // 2
done := false

from until done loop
if l > 1 then
l := l - 1
rra := ra.item(l)
else
rra := ra.item(ir)
ra.put(ra.item(1), ir)
ir := ir - 1
if ir = 1 then
ra.put(rra, 1)
-- should throw exception out of here instead of
-- using boolean
done := true
end
end

if not done then
i := l
j := l * 2

from until j > ir loop
if (j < ir) and (ra.item(j) < ra.item(j+1)) then
j := j + 1
end
if rra < ra.item(j) then
ra.put(ra.item(j), i)
i := j
j := j + i
else
j := ir + 1
end
end
ra.put(rra, i)
end
end
end

fill_array(an_array: ARRAY[DOUBLE]) is
local
rand: RANDOMNUMBER
index: INTEGER
do
from
!!rand.make
index := an_array.lower
until
index > an_array.upper
loop
an_array.put(rand.next(1), index)
index := index + 1
end
end

end

```
heapsort.slang
```% \$Id: heapsort.slang,v 1.0 2003/01/03 14:39:00 dada Exp \$
%
% contributed by John E. Davis

variable IM = 139968;
variable IA =   3877;
variable IC =  29573;

variable LAST = 42;
define gen_random(max)
{
LAST = (LAST * IA + IC) mod IM;
return (max * LAST) / IM;
}

define heapsort(n, ra)
{
variable rra = 0, i = 0, j = 0;
variable l = (n shr 1) + 1;
variable ir = n;

forever
{
if (l > 1)
{
l--;
rra = ra[l];
}
else
{
rra = ra[ir];
ra[ir] = ra[1];
ir--;
if (ir == 1)
{
ra[1] = rra;
return;
}
}
i = l;
j = mul2(l);
while (j <= ir)
{
variable raj = ra[j];
if (j < ir)
{
variable raj1 = ra[j+1];
if (raj < raj1)
{
j++;
raj=raj1;
}
}
#iffalse
if (rra < raj)
{
ra[i] = raj;
i = j;
j = mul2 (j);
continue;
}
j = ir + 1;
#else
if (rra >= raj)
{
j = ir + 1;
break;
}

ra[i] = raj;
i = j;
j = mul2 (j);
#endif
}

ra[i] = rra;
}
}

define main()
{
variable N = integer (__argv[1]);
if (N < 1)
N = 1;
variable ary = array_map (Double_Type, &gen_random, [0:N]*0+1.0);
heapsort(N, ary);

vmessage ("%.10f", ary[N]);
}

main();
```
heapsort.smlnj
```(* -*- mode: sml -*-
* \$Id: heapsort.smlnj,v 1.3 2001/07/09 00:25:28 doug Exp \$
* http://www.bagley.org/~doug/shootout/
* Based on cdoe from Stephen Weeks, improved by Henry Cejtin.
*)

structure Test : sig
val main : (string * string list) -> OS.Process.status
end = struct

val sub = Array.sub
val update = Array.update

local
val im = 139968
val ia =   3877
val ic =  29573
val last = ref 42
val scale = 1.0 / Real.fromInt im
in
fun gen_random max =
let val last' = (! last * ia + ic) mod im
in last := last';
max * scale * Real.fromInt last'
end
end

fun heapSort (n, ra: real array) =
let fun inner (l, ir, rra) =
let fun loop (i, j) =
if j <= ir
then let val j =
if j < ir
andalso sub (ra, j) < sub (ra, j + 1)
then j + 1
else j
val (i, j) =
if rra < sub (ra, j)
then (update (ra, i, sub (ra, j));
(j, j + j))
else (i, ir + 1)
in loop (i, j)
end
else update (ra, i, rra)
in loop (l, l + l)
end
fun outer1 l =
let val l' = l - 1
in if l' > 0
then (inner (l', n, sub (ra, l'));
outer1 l')
else ()
end
fun outer2 ir =
let val rra = sub (ra, ir)
val _ = update (ra, ir, sub (ra, 1))
val ir = ir - 1
in if ir = 1
then update (ra, 1, rra)
else (inner (1, ir, rra);
outer2 ir)
end
in outer1 (n div 2 + 1);
outer2 n
end

fun atoi s = case Int.fromString s of SOME num => num | NONE => 0;
fun printl [] = print "\n" | printl(h::t) = ( print h ; printl t );

fun main (name, args) =
let val n = atoi (hd (args @ ["1"]))
val ary = Array.tabulate (n + 1, fn _ => gen_random 1.0)
in
heapSort (n, ary);
print (concat [Real.fmt (StringCvt.FIX (SOME 10)) (sub (ary, n)),
"\n"]);
OS.Process.success
end
end

val _ = SMLofNJ.exportFn("heapsort", Test.main);
```
heapsort.tcl
```#!/usr/local/bin/tclsh
# \$Id: heapsort.tcl,v 1.4 2001/05/08 02:46:59 doug Exp \$
# http://www.bagley.org/~doug/shootout/
# sped up by Miguel Sofer's function generator

set IM 139968
set IA   3877
set IC  29573

set last 42

proc make_gen_random {} {
global IM IA IC
set params [list IM \$IM IA \$IA IC \$IC]
set body [string map \$params {
global last
expr {(\$max * [set last [expr {(\$last * IA + IC) % IM}]]) / IM}
}]
proc gen_random {max} \$body
}

proc heapsort {n ra_name} {
upvar \$ra_name ra

set j 0
set i 0
set rra 0.0
set l [expr {(\$n >> 1) + 1}]
set ir \$n
while 1 {
if {\$l > 1} {
incr l -1
set rra \$ra(\$l)
} else {
set rra \$ra(\$ir)
set ra(\$ir) \$ra(1)
incr ir -1
if {\$ir == 1} {
set ra(1) \$rra
return
}
}
set i \$l
set j [expr {\$l << 1}]
while {\$j <= \$ir} {
if {(\$j < \$ir) && (\$ra(\$j) < \$ra([expr {\$j + 1}]))} {
incr j
}
if {\$rra < \$ra(\$j)} {
set ra(\$i) \$ra(\$j)
set i \$j
set j [expr {\$j + \$i}]
} else {
set j [expr {\$ir + 1}]
}
}
set ra(\$i) \$rra
}
}

proc main {} {
global argv
set n [lindex \$argv 0]
make_gen_random

for {set i 1} {\$i <= \$n} {incr i} {
set ary(\$i) [gen_random 1.0]
}
heapsort \$n ary
puts [format "%.10g" \$ary(\$n)]
}

main
```
heapsort.vbscript
```Const IM = 139968
Const IA =   3877
Const IC =  29573

LAST = 42

Function gen_random(n)
LAST = (LAST * IA + IC) Mod IM
gen_random = n * LAST / IM
End Function

Sub heapsort(n, ra)
rra = 0
i = 0
j = 0
l = CLng((n / 2) + 1)
ir = n

While 1
If l > 1 Then
l = l - 1
rra = ra(l)
Else
rra = ra(ir)
ra(ir) = ra(1)
ir = ir - 1
If ir = 1 Then
ra(1) = rra
Exit Sub
End If
End If

i = l
j = l * 2

While  CLng(j) <= CLng(ir)
If CLng(j) < CLng(ir) Then
If ra(j) < ra(j+1) Then j = j + 1
End If

If rra < ra(j) Then
ra(i) = ra(j)
i = j
j = j + i
Else
j = ir + 1
End If
Wend
ra(i) = rra
Wend

End Sub

n = WScript.Arguments(0)
If n < 1 Then n = 1

Redim ary(N+1)

For i = 1 To N
ary(i) = gen_random(1)
Next

heapsort N, ary

WScript.Echo FormatNumber(ary(N), 10)

```
heapsort.vc
```/* -*- mode: c -*-
* \$Id: heapsort.gcc,v 1.10 2001/05/08 02:46:59 doug Exp \$
* http://www.bagley.org/~doug/shootout/
*/

#include <stdlib.h>
#include <math.h>
#include <stdio.h>

#define IM 139968
#define IA   3877
#define IC  29573

double
gen_random(double max) {
static long last = 42;
return( max * (last = (last * IA + IC) % IM) / IM );
}

void
heapsort(int n, double *ra) {
int i, j;
int ir = n;
int l = (n >> 1) + 1;
double rra;

for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

int
main(int argc, char *argv[]) {
int N = ((argc == 2) ? atoi(argv[1]) : 1);
double *ary;
int i;

ary = (double *)malloc((N+1) * sizeof(double));
for (i=1; i<=N; i++) {
ary[i] = gen_random(1);
}

heapsort(N, ary);

printf("%.10g\n", ary[N]);

free(ary);
return(0);
}

```
heapsort.vc++
```// -*- mode: c++ -*-
// \$Id: heapsort.g++,v 1.4 2001/06/20 03:20:02 doug Exp \$
// http://www.bagley.org/~doug/shootout/

#include <iostream>
#include <stdlib.h>
#include <math.h>

using namespace std;

#define IM 139968
#define IA   3877
#define IC  29573

double
gen_random(double max) {
static long last = 42;
return( max * (last = (last * IA + IC) % IM) / IM );
}

void
heapsort(int n, double *ra) {
int i, j;
int ir = n;
int l = (n >> 1) + 1;
double rra;

for (;;) {
if (l > 1) {
rra = ra[--l];
} else {
rra = ra[ir];
ra[ir] = ra[1];
if (--ir == 1) {
ra[1] = rra;
return;
}
}
i = l;
j = l << 1;
while (j <= ir) {
if (j < ir && ra[j] < ra[j+1]) { ++j; }
if (rra < ra[j]) {
ra[i] = ra[j];
j += (i = j);
} else {
j = ir + 1;
}
}
ra[i] = rra;
}
}

int
main(int argc, char *argv[]) {
int N = ((argc == 2) ? atoi(argv[1]) : 1);
double *ary;
int i;

ary = (double *)malloc((N+1) * sizeof(double));
for (i=1; i<=N; i++) {
ary[i] = gen_random(1);
}

heapsort(N, ary);

cout.precision(10);
cout << ary[N] << endl;

free(ary);
return(0);
}

```
heapsort.vpascal
```program heapsort;

uses SysUtils, Classes;

const
IM = 139968;
IA =   3877;
IC =  29573;

var
ary: TList;
r : real;
rr : ^real;
N, i, LAST : integer;

function gen_random(n : integer) : real;
begin
LAST := (LAST * IA + IC) mod IM;
gen_random := n * LAST / IM;
end;

procedure myheapsort(n : integer; var ra : TList);
var
rr : ^real;
rra : real;
i, j, l, ir : integer;
begin
rra := 0;
i := 0;
j := 0;
l := n shr 1 + 1;
ir := n;

while 1 = 1 do
begin
if l > 1 then begin
Dec(l);
rra := real(ra.Items[l]^);
end
else begin
rra := real(ra.Items[ir]^);

GetMem(rr, SizeOf(real));
rr^ := real(ra.Items[1]^);
ra.items[ir] := rr;

Dec(ir);
if ir = 1 then
begin

GetMem(rr, SizeOf(real));
rr^ := rra;
ra.items[1] := rr;

exit;
end;
end;

i := l;
j := l shl 1;

while j <= ir do begin
if (j < ir) and (real(ra.items[j]^) < real(ra.items[j+1]^)) then Inc(j);

if rra < real(ra.items[j]^) then begin

GetMem(rr, SizeOf(real));
rr^ := real(ra.items[j]^);
ra.items[i] := rr;

i := j;
Inc(j, i);
end
else begin
j := ir + 1;
end;
end;

GetMem(rr, SizeOf(real));
rr^ := rra;
ra.items[i] := rr;

end;
end;

begin
if ParamCount = 0 then
N := 1
else
N := StrToInt(ParamStr(1));
if N < 1 then N := 1;
LAST := 42;
ary := TList.Create;
ary.Capacity := N;
r := 0.0;
GetMem( rr, SizeOf(real) );
rr^ := r;
for i:= 1 to N do begin
r := gen_random(1);
GetMem( rr, SizeOf(real) );
rr^ := r;