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