1--  Generic algorithms
2--  Copyright (C) 2016 Tristan Gingold
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16
17package body Grt.Algos is
18   procedure Heap_Sort (N : Natural) is
19      --  An heap is an almost complete binary tree whose each edge is less
20      --  than or equal as its decendent.
21
22      --  Bubble down element I of a partially ordered heap of length N in
23      --  array ARR.
24      procedure Bubble_Down (I, N : Natural)
25      is
26         Child : Natural;
27         Parent : Natural := I;
28      begin
29         loop
30            Child := 2 * Parent;
31            if Child < N and then Lt (Child, Child + 1) then
32               Child := Child + 1;
33            end if;
34            exit when Child > N;
35            exit when not Lt (Parent, Child);
36            Swap (Parent, Child);
37            Parent := Child;
38         end loop;
39      end Bubble_Down;
40
41   begin
42      --  Heapify
43      for I in reverse 1 .. N / 2 loop
44         Bubble_Down (I, N);
45      end loop;
46
47      --  Sort
48      for I in reverse 2 .. N loop
49         Swap (1, I);
50         Bubble_Down (1, I - 1);
51      end loop;
52   end Heap_Sort;
53end Grt.Algos;
54