ХЕШ-ФУНКЦИИ. ОТКРЫТОЕ И ЗАКРЫТОЕ ХЕШИРОВАНИЕ
Листинг 4.7. Простая хеш-функция
function h ( x: nametype ): 0..B-1;
var
i, sum: integer;
begin
sum:= 0;
for i:= 1 to 10 do
sum:= sum + ord(x[i]);
h:= sum mod B
end; { h }
Листинг 4.8. Реализация словарей посредством открытой хеш-таблицы
const
В = { подходящая константа };
type
celltype = record
elеment: nametype;
next:^celltype
end;
DICTIONARY = array[0..B-l] of ^celltype;
procedure MAKENULL ( var A: DICTIONARY );
var
i:= integer;
begin
for i:= 0 to В - 1 do
A[i]:= nil
end; { MAKENULL }
function MEMBER ( X: nametype; var A: DICTIONARY ): boolean;
var
current: ^celltype;
begin
current:= А[h(х)];
{ начальное значение current равно заголовку сегмента,
которому принадлежит элемент х }
while current <> nil do
if current^.element = x then
return(true)
else
current:= current^.next;
return(false) { элемент х не найден }
end; { MEMBER }
procedure INSERT ( x: nametype; var A: DICTIONARY );
var
bucket: integer; { для номера сегмента }
oldheader:^celltype;
begin
if not MEMBER(x, A) then begin
bucket:= h(х);
oldheader:= A[bucket];
new(A[bucket]);
A[bucket]^.element: = x;
A[bucket]^.next:= oldheader
end
end; { INSERT }
procedure DELETE ( x: nametype; var A: DICTIONARY );
var
bucket: integer;
current: ^celltype;
begin
bucket:= h(х) ;
if A[bucket] <> nil then begin
if A[bucket]^.element = x then { x в первой ячейке }
A[bucket]:= A[bucket]^.next { удаление х из списка }
else begin { x находится не в первой ячейке }
current:= A[bucket];
{ current указывает на предыдущую ячейку }
while currentT.next <> nil do
if current^.next^.element = x then begin
current^. next: = current^. Next^.next; ;
{ удаление х из списка }
return { останов }
end
else { x пока не найден }
current:= current^.next
end
end
end; { DELETE }
Листинг 4.9. Реализация словаря посредством закрытого хеширования
const
empty = ' '; { 10 пробелов }
deleted = '**********'; { 10 символов * }
type
DICTIONARY = array[0..B-1] of nametype;
procedure MAKENULL ( var A: DICTIONARY );
var
i: integer;
begin
for i:= 0 to B - 1 do
A[i]:= empty
end; { MAKENULL }
function locate ( x: nametype; A: DICTIONARY ): integer;
{ Функция просматривает A начиная от сегмента h(x) до тех
пор, пока не будет найден элемент x или не встретится
пустой сегмент или пока не будет достигнут конец таблицы
(в последних случаях принимается, что таблица не содержит
элемент x). Функция возвращает позицию, в которой
остановился поиск. }
var
initial, i: integer;
begin
initial:= h(x);
i:= 0;
while (i<B) and (A[(initial + i) mod B] <> x) and
(A[(initial + i) mod B] <> empty) do
i:= i + 1;
return((initial + i) mod B)
end; { locate }
function locate1 ( x:nametype; A: DICTIONARY ): integer;
{ То же самое, что и функция locate, но останавливается и при
достижении значения deleted }
function MEMBER ( x:nametype; var A: DICTIONARY ):boolean;
begin
if A[locate(x)] = x then
return(true)
else
return(false)
end; { MEMBER }
procedure INSERT ( x:nametype; var A: DICTIONARY );
var
bucket: integer;
begin
if A[locate(x)] = x then return; { x уже есть в A }
bucket:= locate1(x);
if (A[bucket] = empty) or (A[bucket] = deleted) then
A[bucket]:= x
else
error('Опреация INSERT невозможна: таблица полна')
end; { INSERT }
procedure DELETE ( x: nametype; var A: DICTIONARY );
var
bucket: integer;
begin
bucket:= locate(x);
if A[locate(x)] = x then
A[bucket]:= deleted
end; { DELETE }
Деревья двоичного поиска
Листинг 5.1. Процедура MEMBER для дерева двоичного поиска
function MEMBER ( х: elementtype; A: SET ): boolean;
{ возвращает true, если элемент х принадлежит множеству А, false — в противном случае }
begin
if A = nil then
return(false) { x не может принадлежать Ø }
else if x = A^.element then
return (true)
else if x < A^.element then
return (MEMBER(x, A^.leftchild))
else { x > A^.element }
return(MEMBER(x, A^.rightchild))
end; { MEMBER }
Листинг 5.2. Вставка нового элемента в дерево двоичного поиска
procedure INSERT ( x:elementtype;var A:SET);
begin
if A = nil then begin
new(A);
A^.element:=x;
A^.leftchild:=nil;
A^.rightchid:=nil;
end;
else if x < A^.element then
INSERT (x,A^.leftchild)
else if x > A^.element then
INSERT (x,A^.rightchild)
{если x = A^.element, то никаких действий
не производится, т.к. х уже есть в множестве А}
end; { INSERT }
Листинг 5.3. Удаление наименьшего элемента
function DELETEMIN ( var A:SET ) : elementtype;
begin
if A^. leftchild = nil then begin
{А указывает на наименьший элемент}
DELETEMIN:=A^.element;
A:=A^.rightchild;
{замена узла, указанного А, его правым сыном}
end
else {узел,указанный А, имеет левого сына}
DELETEMIN:= DELETEMIN(A^.leftchild)
end; { DELETEMIN }
Листинг 5.4. Удаление элемента из дерева двоичного поиска
procedure DELETE ( x: elementtype; var A:SET );
begin
if A <> nil then
if x < A^.element then
DELETE (x, A^.leftchild)
else if x > A^.element then
DELETE (x, A^.rightchild)
else if (A^.leftchild= nil ) or (A^.rightchild= nil ) then
A:=nil {удаление листа, содержащего х}
else if A^.leftchild= nil then
A:= A^.rightchild
else if A^.rightchild= nil then
A:= A^.leftchild
else {у узла есть оба сына }
A^.element:= DELETEMIN (A^.rightchild)
end; {DELETE}
Поиск кратчайших путей в графе. Транзитивное замыкание.
Листинг 6.3. Алгоритм Дейкстры (эскиз).
procedure Dijkstra;
begin
(1) S:= {1};
(2) for i:= 2 to n do
(3) D[i]:= C [1, i] ; P[i]≔1; { инициализация D }
(4) for i:= 1 to n - 1 do begin
(5) выбор из множества V\S такой вершины w,
что значение D[w] минимально;
(6) добавить w к множеству S;
(7) for каждая вершина v из множества V\S do
(8) D[v]:= min (D[v], D[w] + C[w, v] );
(9) if D[w] + C[w, v]< D[v] then P[v]≔w;
end
end; { Dijkstra }
Листинг 6.4. Реализация алгоритма Флойда
procedure Floyd ( var A: array[1..n, 1..n] of real;
С: array[1..n, 1..n] of real);
var
i, j, k: integer;
begin
for i:= 1 to n do
for j:= 1 to n do
A[i,j]:= C[i,j];
for i:= 1 to n do
A[i,i]:= 0;
for k:= 1 to n do
for i:= 1 to n do
for j:= 1 to n do
if A[i,k] + A[k,j] < A[i,j] then
A[i,j]:= A[i,k] + A[k,j]
end; {Floyd}
Листинг 6.5. Программа нахождения кратчайших путей
procedure Floyd (var A: array[1..n, 1..n] of real;
C:array[1..n, 1..n] of real; P:array[1..n, 1..n] of integer);
var
i, j, к: integer;
begin
for i:= 1 to n do
for j:= 1 to n do begin
A[i, j]:= C[i, j];
P[i, j]:= 0
end;
for i:= 1 to n do
A[i,i]:= 0;
for k:= 1 to n do
for i: = 1 to n do
for j:= 1 to n do
if A[i, k] + A[k, j] < A[i, j] then begin
A[i, j]:= A[i, k] + A[k, j];
P[i, j]:= k
end
end; {Floyd}
Листинг 6.6. Процедура печати кратчайшего пути
procedure раth (i, j: integer);
var
k: integer ;
begin
k:= P[i, j];
if k = 0 then
return;
path (i, k);
writeln (k);
path (k, j)
end; {path}
Листинг 6.7. Программа Warshall для вычисления транзитивного замыкания
procedure Warshall ( var A: array[1..n, 1..n] of boolean;
C: array[1..n, 1..n] of boolean );
var
i, j, к: integer;
begin
for i:= 1 to n do
for j:= 1 to n do
A [i, j]:= C[i, j];
for k:= 1 to n do
for i:= 1 to n do
for j:= 1 to n do
if A[i, j] = false then
A[i, j] := A[i, k] and A[k, j]
end; { Warshall }