4089
Структуры и алгоритмы обработки данных. Расчет БД Жизнь замечательных людей
Курсовая
Информатика, кибернетика и программирование
Хранящуюся в файле базу данных (БД) Жизнь замечательных людей загрузить в оперативную память компьютера, выполнить сортировку записей методом прямого слияния с использованием очередей. Построить индексный массив, провести поиск...
Русский
2015-01-15
352 KB
43 чел.
Задание
При работе с базой данных (БД) учесть следующие замечания:
Библиографическая БД «Жизнь замечательных людей» хранит записи следующей стpуктуpы:
Автоp: текстовое поле 12 символов
фоpмат <Фамилия>_<буква>_<буква>
Заглавие: текстовое поле 32 символа
фоpмат <Имя>_<Отчество>_<Фамилия>
Издательство: текстовое поле 16 символов
Год издания: целое число
Кол-во стpаниц: целое число
Пpимеp записи из БД:
Кловский_В_Б
Лев_Hиколаевич_Толстой_________
Молодая_гваpдия_
1963
864
Постановка задачи
Согласно заданию программа должна последовательно выполнить следующие действия:
Кроме того, программа должна протоколировать результаты работы в файле журнала программы KR.LOG, создаваемого в каталоге с исполняемым файлом программы.
После выполнения перечисленных действий программа должна завершать работу.
Требования к подпрограммам, реализующим действия программы:
Действие |
Загрузка записей БД в оперативную память |
Тип подпрограммы |
Функция |
Описание |
Размещает в динамически создаваемых структурах, организованных в очередь, записи, последовательно считываемые из БД. |
Входные параметры |
нет |
Выходные параметры |
нет |
Результат |
указатель на созданную очередь |
Действие |
Сортировка очереди |
Тип подпрограммы |
Процедура |
Описание |
Сортирует очередь методом прямого слияния |
Вх./вых. параметры |
указатель на сортируемую очередь |
Действие |
Построение индексного массива |
Тип подпрограммы |
Функция |
Описание |
Распределяет динамическую память для размещения элементов массива в количестве, равном числу записей БД. Сохраняет в элементах массива адреса записей. |
Входные параметры |
указатель на отсортированную очередь |
Выходные параметры |
нет |
Результат |
указатель на созданный индексный массив |
Действие |
Поиск по ключу в упорядоченной БД |
Тип подпрограммы |
Функция |
Описание |
Последовательно перебирает элементы массива, сравнивает первые 3 символа названия книги с ключом, в случае совпадения сохраняет указатель на запись в динамически создаваемом элементе очереди результатов поиска. |
Входные параметры |
указатель на индексный массив |
Выходные параметры |
нет |
Результат |
указатель на созданную очередь или пустой |
Действие |
Вывод на экран очереди результатов поиска |
Тип подпрограммы |
Процедура |
Описание |
Последовательно перебирает элементы очереди, выводит на экран запись, адресуемую элементом очереди. При заполнении экрана запрашивает продолжение вывода, в случае подтверждения выводит следующий экран или остаток записей, в случае отказа прекращает вывод. |
Входные параметры |
указатель на очередь результатов поиска |
Выходные параметры |
нет |
Действие |
Построение массива, упорядоченного по году издания книг |
Тип подпрограммы |
Функция |
Описание |
Обойти АВЛ-дерево слева направо, сохраняя в элементах массива указатели на вершины АВЛ-дерева. |
Входные параметры |
указатель на вершину АВЛ-дерева количество элементов массива |
Выходные параметры |
нет |
Результат |
указатель на созданный массив, упорядоченный по году издания книг, содержащий указатели на вершины АВЛ-дерева с рассчитанными весами |
Действие |
Построение АВЛ-дерева |
Тип подпрограммы |
Функция (вспомогательная) |
Описание |
Последовательно перебирая элементы очереди результатов поиска, добавить в АВЛ-дерево вершину, если год издания не найден в АВЛ-дереве, увеличить вес вершины, если год ее год совпадает с годом элемента очереди. |
Входные параметры |
указатель на вершину АВЛ-дерева, количество элементов массива |
Выходные параметры |
нет |
Результат |
указатель на корень АВЛ-дерева |
Действие |
Построение ДОП (алгоритм А2) |
Тип подпрограммы |
Функция |
Описание |
Добавлять вершины, адресуемые элементами массива, в соответствии с приближенным алгоритмом А2. |
Входные параметры |
указатель на массив вершин, упорядоченный по году издания книг, с рассчитанными весами |
Выходные параметры |
нет |
Результат |
указатель на корень ДОП |
Действие |
Поиск по ключу в ДОП с выводом информации о количестве найденных изданий |
Тип подпрограммы |
Функция |
Описание |
Спускаясь по ветвям ДОП, найти вершину с годом равным ключу. Вывести на экран вес вершины. |
Входные параметры |
указатель на корень ДОП, ключ поиска |
Выходные параметры |
нет |
Результат |
указатель на найденную вершину или пустой |
Основные алгоритмы
Сортировка последовательностей методом прямого слияния
В основе метода прямого слияния лежит операция слияния серий. р-серией называется упорядоченная последовательность из р элементов.
Пусть имеются две упорядоченные серии a и b длины q и r соответственно. Необходимо получить упорядоченную последовательность с, которая состоит из элементов серий a и b. Сначала сравниваем первые элементы последовательностей a и b. Минимальный элемент перемещаем в последовательность с. Повторяем действия до тех пор, пока одна из последовательностей a и b не станет пустой, оставшиеся элементы из другой последовательности переносим в последовательность с. В результате получим (q+r)-серию.
Пусть длина списка S равна степени двойки, т.е. 2k, для некоторого натурального k. Разобьем последовательность S на два списка a и b, записывая поочередно элементы S в списки а и b. Сливаем списки a и b с образованием двойных серий, то есть одиночные элементы сливаются в упорядоченные пары, которые записываются попеременно в очереди c0 и c1. Переписываем очередь c0 в список a, очередь c1 в список b. Вновь сливаем a и b с образованием серий длины 4 и т. д. На каждом итерации размер серий увеличивается вдвое. Сортировка заканчивается, когда длина серии превысит общее количество элементов в обоих списках. Если длина списка S не является степенью двойки, то некоторые серии в процессе сортировки могут быть короче.
Трудоёмкость метода прямого слияния определяется сложностью операции слияния серий. На каждой итерации происходит ровно n перемещений элементов списка и не более n сравнений. Количество итераций равно . Тогда
C < n, M=n
+n.
Дополнительные n перемещений происходят во время начального расщепления исходного списка. Асимптотические оценки для М и С имеют следующий вид
С=О(n log n), М=О(n log n) при n → ∞.
Метод обеспечивает устойчивую сортировку. При реализации для массивов, метод требует наличия второго вспомогательного массива, равного по размеру исходному массиву. При реализации со списками дополнительной памяти не требуется.
Обход дерева слева направо
При обходе дерева слева направо выполняется обход левого поддерева, корня, правого поддерева.
Результат обхода: 4 2 5 1 3 6.
Алгоритм на псевдокоде
Обход слева направо(p: pVertex)
IF(p NIL)
Обход слева направо (pLeft)
Печать(pData)
Обход слева направо (pRight)
FI
Приближенный алгоритм А2 построения ДОП
Дерево поиска, имеющее минимальную средневзвешенную высоту, называется деревом оптимального поиска (ДОП). Средневзвешенная высота дерева с n вершинами:
hср=(w1h1+w2h2+...+wnhn)/W, где
wn вес вершины Vn,пропорциональный частоте ее поиска
hn высота, на к-рой расположена вершина Vn
W вес дерева (сумма весов всех вершин)
Алгоритм (А2) использует предварительно упорядоченный набор вершин. В качестве корня выбирается такая вершина, что разность весов левого и правого поддеревьев была минимальна. Для этого путем последовательного суммирования весов определяем вершину Vk, для которой справедливы неравенства:
,
.
Тогда в качестве "центра тяжести" может быть выбрана вершина Vk, Vk-1 или Vk+1, т. е. вершина, для которой разность весов левого и правого поддерева минимальна. Далее действия повторяются для каждого поддерева.
Сложность алгоритма как функция от n (количество элементов) зависит следующим образом: время Т = О(n log n), память М = О(n) при n. (Время определяется трудоемкостью сортировки элементов, а память - размером массива для хранения элементов). Дерево, построенное приближенным алгоритмом А2, асимптотически приближается к оптимальному (с точки зрения средней высоты) при n
.
Поиск вершины в дереве поиска
Двоичное дерево называется деревом поиска, если ключ в каждой его вершине больше ключа любой вершины в левом поддереве и меньше ключа любой вершины в правом поддереве, в дереве нет вершин с одинаковыми данными.
В основном деревья поиска используются для организации быстрого и удобного поиска элемента с заданным ключом во множестве данных, которое динамически изменяется. Приведенная ниже процедура поиска элемента в дереве поиска возвращает указатель на вершину с заданным ключом, в противном случае возвращаемое значение равно пустому указателю.
Алгоритм на псевдокоде
Поиск вершины с ключом Х
p: = Root
DO (p NIL)
IF(pData < x) p:= p
Right
ELSEIF (pData >x) p: = p
Left
ELSE
OD { pData = x }
OD
IF (p NIL) <вершина найдена>
ELSE <вершина не найдена>
OD
Максимальное количество сравнений при поиске равно Сmax = 2h, где h высота дерева.
Построение АВЛ-дерева
Дерево поиска называется сбалансированным по высоте, или АВЛ-деревом, если для каждой его вершины высоты левого и правого поддеревьев отличаются не более чем на 1.
Добавление новой вершины в АВЛ-дерево происходит следующим образом. Вначале добавляем новую вершину в дерево так же как в случайное дерево поиска (проход по пути поиска до нужного места). Затем, двигаясь назад по пути поиска от новой вершины к корню дерева, ищем вершину, в которой нарушился баланс (т. е. высоты левого и правого поддеревьев стали отличаться более чем на 1). Если такая вершина найдена, то изменяем структуру дерева для восстановления баланса с помощью процедур поворотов:
Адельсон - Вельский и Ландис доказали теорему, гарантирующую, что АВЛ-дерево никогда не будет в среднем по высоте превышать ИСДП более, чем на 45% независимо от количества вершин: log(n+1) hАВЛ(n) < 1,44 log(n+2) - 0,328 при n
.
Поиск элемента с заданным ключом, включение нового элемента, удаление элемента - каждое из этих действий в АВЛ-дереве можно произвести в худшем случае за О(log n) операций.
Основные структуры данных
Запись БД tRow
Структура хранит информацию о книге, считанную из БД (автор, название, издатель, год издания, количество страниц).
tAuthor = array [1 .. 12] of char;
tTitle = array [1 .. 32] of char;
tPublisher = array [1 .. 16] of char;
pRow = ^tRow;
tRow = record
Author: tAuthor;
Title: tTitle;
Publisher: tPublisher;
Year: Word;
PageCount: Word;
end;
Элемент очереди tQueueItem
Структура хранит указатели на следующую структуру tQueueItem и на структуру tRow.
pQueueItem = ^tQueueItem;
tQueueItem = record
Next: pQueueItem;
Data: pRow;
end;
Очередь tQueue
Структура хранит указатели на первую и последние структуры списка tQueueItem. Используется при загрузке БД в память, поиске в БД.
pQueue = ^tQueue;
tQueue = record
Head,
Tail: pQueueItem;
end;
Вершина дерева tVertex
Структура хранит указатели на левую и правую дочерние вернины, данные, вес и баланс. Используется при работе с ДОП и АВЛ-деревом.
pVertex = ^tVertex;
tVertex = record
Data: Word;
Weight: Word;
Balance: Integer;
Left,
Right: pVertex;
end;
Динамический массив tArrayOfpRow
Массив хранит указатели на структуры tRow. Используется при поиске в упорядоченной БД.
pArrayOfpRow = ^tArrayOfpRow;
tArrayOfpRow = array [1 .. cMaxCount] of pRow;
Динамический массив tArrayOfpVertex
Массив хранит указатели на структуры tVertex. Используется при построении ДОП.
pArrayOfpVertex = ^tArrayOfpVertex;
tArrayOfpVertex = array [1 .. cMaxCount] of pVertex;
Исходный текст программы
program KR;
uses
Crt, Dos;
const
cMaxCount = 10000;
{константа, определяющая максимальное число элементов в динамическом массиве}
cPersonKeyLength = 3;
{длина ключа поиска по названию книги}
cYearKeyLength = 4;
{длина ключа поиска по году издания книги}
cMaxKeyLength = cYearKeyLength;
{максимальная длина ключа поиска}
type
tAuthor = array [1 .. 12] of char;
{тип данных автора книги}
tTitle = array [1 .. 32] of char;
{тип данных названия книги}
tPublisher = array [1 .. 16] of char;
{тип данных издательства книги}
pRow = ^tRow;
{указатель на тип данных книги}
tRow = record
{тип данных книги}
Author: tAuthor;
Title: tTitle;
Publisher: tPublisher;
Year: Word;
PageCount: Word;
end;
tKey = array [1 .. cMaxKeyLength] of char;
{тип данных ключа поиска}
pQueueItem = ^tQueueItem;
{указатель на элемент очереди}
tQueueItem = record
{тип элемента очереди}
Next: pQueueItem;
Data: pRow;
end;
pQueue = ^tQueue;
{указатель на очередь}
tQueue = record
{тип очереди}
Head,
Tail: pQueueItem;
end;
pArrayOfpRow = ^tArrayOfpRow;
tArrayOfpRow = array [1 .. cMaxCount] of pRow;
{типы для динамического массива}
pVertex = ^tVertex;
{указатель на вершину}
tVertex = record
{тип вершины дерева}
Data: Word;
Weight: Word;
Balance: Integer;
Left,
Right: pVertex;
end;
FuncIsValidKeyChar = function(const c: char): Boolean;
{процедурный тип для функции проверки допустимости введенного символа ключа поиска}
var
Log: Text;
{файл журнала программы}
Count,
{количество записей в БД}
IndexSearchCount: Integer;
{количество записей, найденных с помощью индексного массива}
function GetQueue: pQueue; forward;
{функция загрузки в динамическую память базы данных, формирования очереди записей}
procedure SortQueue(var s: pQueue); forward;
{процедура сортировки очереди методом слияния}
procedure AddItemToQueue(var s: pQueue; const r: pRow); forward;
{функция добавления элемента в очередь}
procedure DelQueue(var s: pQueue); forward;
{процедура освобождения памяти, занимаемой очередью}
function GetIndexArray(const q: pQueue): pArrayOfpRow; forward;
{процедура создания индексного массива}
procedure DelIndexArray(var a: pArrayOfpRow); forward;
{процедура освобождения памяти, занимаемой индексным массивом}
function FindKeyInArray(const a: pArrayOfpRow; const Key: array of char): pQueue; forward;
{функция поиска в базе данных с помощью индексного массива}
function GetTree(const q: pQueue): pVertex; forward;
{функция построения дерева оптимального поиска (ДОП)}
function FindKeyInTree(const Root: pVertex; const Key: Word): pVertex; forward;
{функция поиска в ДОП}
procedure DelTree(var p: pVertex); forward;
{процедура освобождения памяти, занимаемой деревом}
procedure PrintQueue(const q: pQueue); forward;
{процедура вывода на экран очереди результатов поиска}
procedure PrintQueueToLog(const q: pQueue); forward;
{процедура вывода в файл жернала очереди результатов поиска}
function IsValidPersonKeyChar(const c: char): Boolean; far; forward;
{функция проверки валидности символа, введеного для ключа поиска по названию книги}
function IsValidYearKeyChar(const c: char): Boolean; far; forward;
{функция проверки валидности символа, введеного для ключа поиска по году издания книги}
procedure GetKey(var Key: tKey;
const KeyLength: Byte;
const Msg: String;
IsValidKeyChar: FuncIsValidKeyChar); forward;
{процедура получения ключа поиска по названию или году издания в зависимости переданной
функции проверки символа}
function YearKeyToWord(const Year: tKey): Word; forward;
{функция конвертации массива символов (ключ поиска - год издания) в тип Word}
procedure OpenLog(var F: Text); forward;
{процедура открытия файла журнала}
procedure CloseLog(var F: Text); forward;
{процедура закрытия файла журнала}
procedure OpenLog(var F: Text);
{процедура открытия файла журнала}
var
fPath: String;
fDir: DirStr;
fName: NameStr;
fExt: ExtStr;
begin
fPath := ParamStr(0);
FSplit(fPath, fDir, fName, fExt);
Assign(F, fDir + 'KR.LOG');
Rewrite(F);
end;
procedure CloseLog(var F: Text);
{процедура закрытия файла журнала}
begin
Close(F);
end;
procedure AddItemToQueue(var s: pQueue; const r: pRow);
{процедура добавления элемента в очередь}
var
p: pQueueItem;
begin
New(p);
p^.Next := nil;
p^.Data := r;
s^.Tail^.Next := p;
s^.Tail := p;
end; {AddItemToQueue}
function GetQueue: pQueue;
{функция загрузки в динамическую память базы данных, формирования очереди записей}
type
tDBFile = file of tRow;
var
s: pQueue;
procedure OpenDB(var F: tDBFile);
{процедура открытия файла базы данных}
var
fPath: String;
fDir: DirStr;
fName: NameStr;
fExt: ExtStr;
begin
fPath := ParamStr(0);
FSplit(fPath, fDir, fName, fExt);
Assign(F, fDir + 'BASE1.DAT');
Reset(F);
end; {OpenDB}
procedure CloseDB(var F: tDBFile);
{процедура закрытия файла базы данных}
begin
Close(F);
end; {CloseDB}
var
db: tDBFile;
row: pRow;
begin
WriteLn('Загрузка БД в оперативную память ... ');
New(s);
s^.Tail := @s^.Head;
OpenDB(db);
Count := FileSize(db);
while not Eof(db) do
begin
New(row);
Read(db, row^);
AddItemToQueue(s, row);
end;
CloseDB(db);
GetQueue := s;
WriteLn(' Загружено записей: ', Count);
WriteLn(Log, 'Загружено в оперативную память записей: ', Count);
end; {GetQueue}
procedure SortQueue(var s: pQueue);
{процедура сортировки очереди методом слияния}
function Greater(const i1, i2: pQueueItem): Boolean;
{функция сравнения элементов очереди;
возвращает True если i1 > i2, иначе False}
var
i, l: Integer;
s1, s2: tTitle;
begin
s1 := i1^.Data^.Title;
s2 := i2^.Data^.Title;
l := High(s1);
i := 1;
while (s1[i] = s2[i]) and (i < l) do
Inc(i);
Greater := s1[i] > s2[i];
end; {Greater}
procedure MoveItem(var i: pQueueItem; var q: tQueue);
{процедура перемещения элемента в активную очередь}
begin
q.Tail^.Next := i;
q.Tail := i;
i := i^.Next;
q.Tail^.Next := nil;
end; {MoveItem}
var
a, b, {рабочие списки}
x, y: pQueueItem; {рабочие указатели}
c: array [0 .. 1] of tQueue; {массив из 2х очередей}
i, {номер активной очереди}
p, {предполагаемый размер серии}
q, {фактический размер серии в списке a}
r, {фактический размер серии в списке b}
m: Integer; {текущее количество элементов в списках a и b}
begin
WriteLn('Сортировка БД');
{расщепление очереди}
a := s^.Head;
b := s^.Head^.Next;
x := a;
y := b;
while y <> nil do
begin
x^.Next := y^.Next;
x := y;
y := y^.Next;
end;
p := 1;
while p < Count do
begin
c[0].Tail := pQueueItem(@c[0].Head);
c[1].Tail := pQueueItem(@c[1].Head);
i := 0;
m := Count;
while m > 0 do
begin
if m >= p then q := p else q := m;
Dec(m, q);
if m >= p then r := p else r := m;
Dec(m, r);
while (q <> 0) and (r <> 0) do
{Слияние q-серии из списка а с r-серией из списка b, запись результата в активную очередь с}
begin
if Greater(a, b) then
begin
MoveItem(b, c[i]);
Dec(r);
end
else
begin
MoveItem(a, c[i]);
Dec(q);
end;
end; {while (q <> 0) and (r <> 0)}
while q > 0 do
begin
MoveItem(a, c[i]);
Dec(q);
end;
while r > 0 do
begin
MoveItem(b, c[i]);
Dec(r);
end;
i := 1 - i;
end; {while(m > 0)}
a := c[0].Head;
b := c[1].Head;
p := p * 2;
end; {while(p < Count)}
s^.Head := c[1 - i].Head;
WriteLn(' Выполнено');
end; {SortQueue}
procedure DelQueue(var s: pQueue);
{процедура освобождения памяти, занимаемой очередью}
var
p: pQueueItem;
begin
p := s^.Head;
while p <> nil do
begin
s^.Head := s^.Head^.Next;
Dispose(p);
p := s^.Head;
end;
Dispose(s);
s := nil;
end; {DelQueue}
function GetIndexArray(const q: pQueue): pArrayOfpRow;
{процедура создания индексного массива}
var
a: pArrayOfpRow;
i: Integer;
p: pQueueItem;
begin
WriteLn('Построение индексного массива');
GetMem(a, SizeOf(pRow) * Count);
p := q^.Head;
for i := 1 to Count do
begin
a^[i] := p^.Data;
p := p^.Next;
end;
GetIndexArray := a;
WriteLn(' Выполнено');
end; {GetIndexArray}
procedure DelIndexArray(var a: pArrayOfpRow);
{процедура освобождения памяти, занимаемой индексным массивом}
begin
FreeMem(a, SizeOf(pRow) * Count);
end; {DelIndexArray}
function FindKeyInArray(const a: pArrayOfpRow; const Key: array of char): pQueue;
{функция поиска в базе данных с помощью индексного массива}
function Equals(const s1, s2: array of char): Boolean;
{функция сравнения массивов символов;
возвращает True s1 = s2, иначе False}
var
i: Integer;
begin
i := 0;
while s1[i] = s2[i] do
Inc(i);
Equals := i = cPersonKeyLength;
end;
var
i: Integer;
s: pQueue;
begin
IndexSearchCount := 0;
New(s);
s^.Head := nil;
s^.Tail := @s^.Head;
for i := 1 to Count do
if Equals(a^[i]^.Title, Key) then
begin
AddItemToQueue(s, a^[i]);
Inc(IndexSearchCount);
end;
FindKeyInArray := s;
WriteLn(' Найдено книг: ', IndexSearchCount);
WriteLn(Log, 'Найдено книг: ', IndexSearchCount);
end; {FindKey}
function GetTree(const q: pQueue): pVertex;
{функция построения дерева оптимального поиска (ДОП)}
type
pArrayOfpVertex = ^tArrayOfpVertex;
tArrayOfpVertex = array [1 .. cMaxCount] of pVertex;
{типы для динамического массива, исаользуемого при построении ДОП}
var
a: pArrayOfpVertex;
procedure A2(var Root: pVertex; const L, R: Integer);
{процедура построения ДОП}
procedure AddVertex(var r: pVertex; const v: pVertex);
{процедура добавления вершины в ДОП}
begin
if r <> nil then
if v^.Data < r^.Data then
AddVertex(r^.Left, v)
else
AddVertex(r^.Right, v)
else
r := v;
end; {AddVertex}
var
i, w, s: Integer;
begin
w := 0;
s := 0;
if L <= R then
begin
for i := L to R do
w := w + a^[i]^.Weight;
i := L;
while i < R do
begin
if (s < w / 2) and ((s + a^[i]^.Weight) >= w / 2) then
Break;
s := s + a^[i]^.Weight;
Inc(i);
end;
AddVertex(Root, a^[i]);
A2(Root, L, i - 1);
A2(Root, i + 1, R);
end;
end; {A2}
function GetAVLTree(const q: pQueue): pVertex;
{функция построения АВЛ-дерева}
var
flag: Boolean; {признак роста АВЛ-дерева}
procedure AddVertex(var p: pVertex; const d: Word);
{процедура добавления вершины в АВЛ-дерево}
var
v1, v2 : pVertex;
begin
if p = nil then
begin
New(p);
with p^ do
begin
Data := d;
Left := nil;
Right := nil;
Balance := 0;
Weight := 1;
end;
flag := True;
end {if p = nil}
else
if d < p^.Data then
begin
AddVertex(p^.Left, d);
if flag then
case p^.Balance of
1: begin
p^.Balance := 0;
flag := false;
end;
0: p^.Balance := -1;
-1: begin {балансировка дерева}
v1 := p^.Left;
if v1^.Balance = -1 then
begin {LL-поворот}
p^.Left := v1^.Right;
v1^.Right := p;
p^.Balance := 0;
p := v1;
end {LL}
else
begin {LR-поворот}
v2 := v1^.Right;
v1^.Right := v2^.Left;
v2^.Left := v1;
p^.Left := v2^.Right;
v2^.Right := p;
if v2^.Balance = -1 then
p^.Balance := 1
else
p^.Balance := 0;
if v2^.Balance = 1 then
v1^.Balance := -1
else
v1^.Balance := 0;
p := v2;
end; {LR}
p^.Balance := 0;
flag := false
end {балансировка дерева}
end {case p^.Balance}
end {if d < p^.Data}
else if d > p^.Data then
begin
AddVertex(p^.Right, d);
if flag then
case p^.Balance of
-1: begin
p^.Balance := 0;
flag := false;
end;
0: p^.Balance := 1;
1: begin {балансировка дерева}
v1 := p^.Right;
if v1^.Balance = 1 then
begin {RR-поворот}
p^.Right := v1^.Left;
v1^.Left := p;
p^.Balance := 0;
p := v1;
end {RR}
else
begin {RL-поворот}
v2 := v1^.Left;
v1^.Left := v2^.Right;
v2^.Right := v1;
p^.Right := v2^.Left;
v2^.Left := p;
if v2^.Balance = 1 then
p^.Balance := -1
else
p^.Balance := 0;
if v2^.Balance = -1 then
v1^.Balance := 1
else
v1^.Balance := 0;
p := v2;
end; {RL}
p^.Balance := 0;
flag := false
end {балансировка дерева}
end {case p^.Balance}
end {if d > p^.Data}
else {if d = p^.Data}
Inc(p^.Weight);
end; {AddVertex}
var
Root: pVertex;
Item: pQueueItem;
begin
Root := nil;
Item := q^.Head;
flag := False;
while Item <> nil do
begin
AddVertex(Root, Item^.Data^.Year);
Item := Item^.Next;
end;
GetAVLTree := Root;
end; {GetAVLTree}
procedure DelAVLTree(const a: pArrayOfpVertex; const ItemCount: Integer);
{процедура удаления АВЛ-дерева}
var
i: Integer;
begin
for i := 1 to ItemCount do
begin
a^[i]^.Left := nil;
a^[i]^.Right := nil;
end;
end; {DelAVLTree}
function GetIndexArray(const Root: pVertex; const ItemCount: Integer): pArrayOfpVertex;
{процедура построения индексного массива, используемого при построении ДОП}
var
a: pArrayOfpVertex;
i: Integer;
procedure WalkTreeL2R(const p: pVertex);
{процедура обхода дерева слева направо и
инициализации упорядоченного индексного массива}
begin
if p <> nil then
begin
WalkTreeL2R(p^.Left);
a^[i] := p;
Inc(i);
WalkTreeL2R(p^.Right);
end;
end;
begin
i := 1;
GetMem(a, SizeOf(pVertex) * ItemCount);
WalkTreeL2R(Root);
GetIndexArray := a;
end; {GetIndexArray}
procedure DelIndexArray(var a: pArrayOfpVertex; const ItemCount: Integer);
{процедура удаления индексного массива}
begin
FreeMem(a, SizeOf(pVertex) * ItemCount);
end; {DelIndexArray}
function GetSize(const p: pVertex): Integer;
{функция для расчета размера дерева}
begin
if p = nil then
GetSize := 0
else
GetSize := 1 + GetSize(p^.Left) + GetSize(p^.Right);
end; {GetSize}
procedure PrintIndexArray(const a: pArrayOfpVertex; const ItemCount: Integer);
{процедура вывода в журнал индексного массива}
var
i: Integer;
begin
WriteLn(Log, 'Массив для построения ДОП (', ItemCount, ' элементов):');
for i := 1 to ItemCount do
with a^[i]^ do
WriteLn(Log, Data:5, '(', Weight:2, ')');
WriteLn(Log);
end; {PrintIndexArray}
procedure PrintTree(const p: pVertex; const Msg: String);
{процедура вывода дерева в журнал}
procedure _PrintTree(p: pVertex; Level: Integer);
var
i: Integer;
begin
if p <> nil then
begin
_PrintTree(p^.Right, Level + 1);
for i := 1 to Level do
Write(Log, ' ');
WriteLn(Log, p^.Data:4, '(', p^.Weight:2, ')');
_PrintTree(p^.Left, Level + 1);
end;
end;
begin
WriteLn(Log, Msg);
_PrintTree(p, 1);
WriteLn(Log);
end; {PrintTree}
var
Root: pVertex;
Size: Word;
begin
WriteLn('Построение дерева оптимального поиска (ДОП)');
Root := GetAVLTree(q);
PrintTree(Root, 'АВЛ-дерево:');
Size := GetSize(Root);
a := GetIndexArray(Root, Size);
PrintIndexArray(a, Size);
DelAVLTree(a, Size);
Root := nil;
A2(Root, 1, Size);
DelIndexArray(a, Size);
PrintTree(Root, 'ДОП (алгоритм А2):');
GetTree := Root;
WriteLn(' Выполнено');
end; {GetTree}
function FindKeyInTree(const Root: pVertex; const Key: Word): pVertex;
{функция поиска в дереве вершины по заданному ключу}
var
p: pVertex;
c: Word;
begin
p := Root;
while (p^.Data <> Key) and (p <> nil) do
begin
if p^.Data < Key then
p := p^.Right
else
if p^.Data > Key then
p := p^.Left;
end;
if p <> nil then c := p^.Weight else c := 0;
WriteLn(' Найдено книг, изданных в ', Key, ' году: ', c);
WriteLn(Log, 'Найдено книг, изданных в ', Key, ' году: ', c);
FindKeyInTree := p;
end; {FindKeyInTree}
procedure DelTree(var p: pVertex);
{процедура освобождения памяти, занимаемой деревом поиска}
begin
if p <> nil then
begin
DelTree(p^.Left);
DelTree(p^.Right);
Dispose(p);
p := nil;
end;
end; {DelTree}
procedure PrintBookInfo(var F: Text; const BI: pRow);
{процедура вывода в заданный файл информации о книге}
begin
with BI^ do
WriteLn(F,
Author,
' "', Title, '": ',
Publisher, ',',
Year:5, ',',
PageCount:4, ' с.')
end; {PrintBookInfo}
procedure PrintQueue(const q: pQueue);
{процедура вывод на экран очереди с результатами поиска}
var
p: pQueueItem;
RowNo: Integer;
procedure PrintHorLine;
begin
WriteLn('-------------------------------------------------------------------------------');
end; {PrintHorLine}
function NeedsToContinue: Boolean;
{функция проверки необходимости продолжения вывода на экран результатов поиска и печати "шапки" результатов}
procedure PrintTableHeader;
begin
clrscr;
PrintHorLine;
WriteLn(' Автор Заглавие Издательство Год Ч.стр.');
PrintHorLine;
end;
const
cRowsPerScreen = 19;
begin
if RowNo = cRowsPerScreen then
begin
Write(#13#10'Для продолжения просмотра нажмите любую клавишу (ESC для прекращения) ...');
if ReadKey = #27 then
NeedsToContinue := False
else
begin
WriteLn;
RowNo := 0;
NeedsToContinue := True;
end;
end
else
NeedsToContinue := True;
if RowNo = 0 then
PrintTableHeader;
end;
begin
p := q^.Head;
RowNo := 0;
while (p <> nil) and NeedsToContinue do
begin
PrintBookInfo(Output, p^.Data);
p := p^.Next;
Inc(RowNo);
end;
PrintHorLine;
end; {PrintQueue}
procedure PrintQueueToLog(const q: pQueue);
{вывод очереди в файл журнала}
var
p: pQueueItem;
begin
p := q^.Head;
while p <> nil do
begin
PrintBookInfo(Log, p^.Data);
p := p^.Next;
end;
WriteLn(Log);
end; {PrintQueueToLog}
function IsValidPersonKeyChar(const c: char): Boolean;
{функция проверки валидности символа, введенного для ключа поиска по названию книги}
begin
case c of
#65 .. #90 {A .. Z},
#97 .. #122 {a .. z},
#128 .. #159 {А .. Я},
#160 .. #239 {а .. я}:
IsValidPersonKeyChar := True
else
IsValidPersonKeyChar := False;
end;
end; {IsValidPersonKeyChar}
function IsValidYearKeyChar(const c: char): Boolean;
{функция проверки валидности символа, введенного для ключа поиска по года издания книги}
begin
case c of
#48 .. #57: {0 .. 9}
IsValidYearKeyChar := True
else
IsValidYearKeyChar := False;
end;
end; {IsValidYearKeyChar}
procedure GetKey(
var Key: tKey;
const KeyLength: Byte;
const Msg: String;
IsValidKeyChar: FuncIsValidKeyChar);
{процедура получения ключа поиска по названию или году издания в зависимости переданной
функции проверки символа}
var
c: char;
i: Integer;
procedure Error;
begin
Sound(500);
Delay(50);
NoSound;
c := #0;
end; {Error}
begin
Write(Msg);
i := 1;
repeat
c := ReadKey;
if IsValidKeyChar(c) then
if i <= KeyLength then
begin
Write(c);
Key[i] := c;
Inc(i);
end
else
Error
else
case c of
#13: if i <= KeyLength then
Error;
#8: if i > 1 then
begin
Write(c);
Key[i] := #0;
Dec(i);
clreol;
end
else
Error;
else
Error;
end;
until c = #13;
WriteLn;
end; {GetKey}
function YearKeyToWord(const Year: tKey): Word;
{функция конвертации массива символов (ключ поиска - год издания) в тип Word}
var
i, k: Word;
begin
k := 0;
for i := 1 to cMaxKeyLength do
k := k + Trunc((Ord(Year[i]) - 48) * Exp(Ln(10) * (cMaxKeyLength - i)));
YearKeyToWord := k;
end; {YearKeyToWord}
procedure PrintKRInfo;
{процедура вывода на экран информации о работе}
begin
clrscr;
WriteLn(' Курсовая работа'#13#10);
WriteLn(' (вариант 3)'#13#10);
end;
var
q: pQueue;
a: pArrayOfpRow;
t: pVertex;
Key: tKey;
begin
OpenLog(Log);
PrintKRInfo;
q := GetQueue;
SortQueue(q);
a := GetIndexArray(q);
DelQueue(q);
GetKey(Key,
cPersonKeyLength,
'Введите ключ поиска в массиве по названию книги (3 первые буквы фамилии): ',
IsValidPersonKeyChar);
q := FindKeyInArray(a, Key);
DelIndexArray(a);
if IndexSearchCount <> 0 then
begin
PrintQueueToLog(q);
Write(' Для просмотра результатов поиска нажмите любую клашу (ESC для продолжения) ...');
if ReadKey <> #27 then
PrintQueue(q);
t := GetTree(q);
GetKey(Key,
cYearKeyLength,
'Введите ключ поиска в ДОП (год издания): ',
IsValidYearKeyChar);
FindKeyInTree(t, YearKeyToWord(Key));
DelTree(t);
end;
DelQueue(q);
CloseLog(Log);
end.
Результаты работы программы
Действия, выполняемые программой, последовательно выводятся на экран:
Результаты поиска в упорядоченной базе данных выводятся на экран, если это согласовано пользователем:
Содержимое файла протокола программы KR.LOG:
Загружено в оперативную память записей: 4000
Найдено книг: 125
Зосимова Т М "Зосим Ромуальдович Хасанов