newlib/heap.ajla

   1 {*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 unit heap;
  20
  21 type heap(key : type, cls : class_ord(key));
  22
  23 fn heap_init(key : type, const cls : class_ord(key)) : heap(key, cls);
  24 fn heap_size(key : type, const cls : class_ord(key), h : heap(key, cls)) : int;
  25 fn heap_is_nonempty(key : type, const cls : class_ord(key), h : heap(key, cls)) : bool;
  26 fn heap_peek(key : type, const cls : class_ord(key), h : heap(key, cls)) : key;
  27 fn heap_extract(key : type, const cls : class_ord(key), h : heap(key, cls)) : (heap(key, cls), key);
  28 fn heap_insert(key : type, const cls : class_ord(key), h : heap(key, cls), k : key) : heap(key, cls);
  29 fn heap_from_list(key : type, const cls : class_ord(key), l : list(key)) : heap(key, cls);
  30
  31 implementation
  32
  33 type heap(key : type, cls : class_ord(key)) := list(key);
  34
  35 fn heap_init(key : type, const cls : class_ord(key)) : heap(key, cls)
  36 [
  37         return empty(key);
  38 ]
  39
  40 fn heap_size(key : type, const cls : class_ord(key), h : heap(key, cls)) : int
  41 [
  42         return len(h);
  43 ]
  44
  45 fn heap_is_nonempty(key : type, const cls : class_ord(key), h : heap(key, cls)) : bool
  46 [
  47         return len_greater_than(h, 0);
  48 ]
  49
  50 fn heap_peek(key : type, const cls : class_ord(key), h : heap(key, cls)) : key
  51 [
  52         return h[0];
  53 ]
  54
  55 fn heap_left~inline(i : int) : int := i + i + 1;
  56 fn heap_right~inline(i : int) : int := i + i + 2;
  57 fn heap_parent~inline(i : int) : int := (i - 1) shr 1;
  58
  59 fn heap_extract(key : type, const implicit cls : class_ord(key), h : heap(key, cls)) : (heap(key, cls), key)
  60 [
  61         var val := h[0];
  62         var ins := h[len(h) - 1];
  63         h := h[ .. len(h) - 1];
  64         if len(h) = 0 then
  65                 goto ret;
  66         h[0] := ins;
  67         var idx := 0;
  68 again:
  69         var left := heap_left(idx);
  70         var right := heap_right(idx);
  71         if left >= len(h) then
  72                 goto ret;
  73         if h[left] >= h[idx] then [
  74                 if right >= len(h) then
  75                         goto ret;
  76                 if h[right] >= h[idx] then
  77                         goto ret;
  78 go_right:
  79                 h[idx], h[right] := h[right], h[idx];
  80                 idx := right;
  81                 goto again;
  82         ] else [
  83                 if right < len(h), h[right] <= h[left] then
  84                         goto go_right;
  85                 h[idx], h[left] := h[left], h[idx];
  86                 idx := left;
  87                 goto again;
  88         ]
  89 ret:
  90         return h, val;
  91 ]
  92
  93 fn heap_insert(key : type, const implicit cls : class_ord(key), h : heap(key, cls), k : key) : heap(key, cls)
  94 [
  95         h +<= k;
  96         var idx := len(h) - 1;
  97         while idx > 0 do [
  98                 var parent := heap_parent(idx);
  99                 if h[parent] < h[idx] then
 100                         break;
 101                 h[idx], h[parent] := h[parent], h[idx];
 102                 idx := parent;
 103         ]
 104         return h;
 105 ]
 106
 107 fn heap_from_list(key : type, const implicit cls : class_ord(key), l : list(key)) : heap(key, cls)
 108 [
 109         var h := heap_init(key, cls);
 110         for f in l do
 111                 h := heap_insert(h, f);
 112         return h;
 113 ]