3.4 Результаты тестирования
Сначала пользователь вводит количество элементов дерева, затем отрезок, на котором необходимо удалить элементы. Результат данных действий показан на рисунке 6.
Рисунок 6 – Результат удаления элементов АВЛ дерева
4 Задача 4.21
4.1 Постановка задачи и ее анализ
Задание: Нахождение наибольшей общей подпоследовательности. Использовать алгоритм из книги Кормена, стр 318.
Данный алгоритм основан на двумерном динамическом программировании. Заключается он в следующем:
Пусть даны две последовательности. Для нахождения НОП необходимо:
Последовательность 1 записать перед строками матрицы, а последовательность 2 над столбцами матрицы. 2) Матрица будет иметь нулевыми первый столбец и первую строку. 3) Саму матрицу назовем a. 4) В элементе матрицы a[i,j] будет хранится длина наибольшей общей подпоследовательности для последовательностей x[1..i] и y[1..j].
Элемент матрицы a[i,j] будем находить по рекуррентной формуле:
3.2 Описание структур данных
В данной программе необходимо реализовать двумерный массив, который будет содержать количество совпавших элементов
var x,y,z:string;//x и y –последовательности, z – будет содержать НОП
a:array[0..100,0..100] of byte;//т. к в задании не указан максимальный размер последовательностей, то будем считать что последовательности не превышают 100 элементов
i,j:byte;//значение строки и столбца
4.3 Проектирование программы
Реализуем данную задачу следующим образом: пользователь вводит две последовательности с клавиатуры (тип каждой - строка). Затем входные данные передаются в процедуру lcs, в которой мы заполняем таблицу по рекуррентной формуле приведенной выше и также «собираем» НОП обратным заполнению способом.
Листинг процедуры lcs:
procedure lcs(a:array[0..100,0..100] of byte; x,y: string);
begin
for j:=1 to length(x)+1 do //зануляем первую строку и столбец нулями
begin
a[1,j]:=0;
end;
for i1:=2 to length(y) do
begin
a[i1,1]:=0;
end;
for i:=2 to (length(x)+1) do
for j:=1 to (length(y)+1) do
begin
if (x[i]=y[j]) then
a[i,j]:=a[i-1,j-1]+1
else
if (a[i-1,j]>=a[i,j-1]) then
a[i,j]:=a[i-1,j]
else
a[i,j]:=a[i,j-1];//длина ноп находится в последнем элементе
end;
z:='';//получаем ноп
i:=length(x);
j:=length(y);
while (i>0) and (j>0) do
if x[i]=y[j] then
begin
z:=x[i]+z; i:=i-1; j:=j-1
end
else
if a[i-1,j]>=a[i,j-1] then
i:=i-1
else j:=j-1;
writeln('НОП----> ');
write(z);
end;
4.4 Результаты тестирования
Результат тестирования – Рисунок 7.
Рисунок
7 – Нахождение НОП двух последовательностей
Приложение
Листинг задачи 1.7
uses crt;
type sp=^uk;
uk=record;
data: integer;
next,pred:sp;
end;
var head,end_sp,spis: sp;
el,k,n,zn: integer;
i:byte;
procedure create_twodirectlist(var head,ends: sp;s: integer);
var x,p: sp;
begin
if head=nil then
begin
new(x);
x^.data:=s;
x^.next:=nil;
x^.pred:=nil;
head:=x;
end_sp:=x;
p:=head;
end
else
begin
new(x^.next);
x:=x^.next;
x^.data:=s;
x^.next:=nil;
x^.pred:=p;
p:=x^.next;
end_sp^.next^.pred:=end_sp;
end_sp:=end_sp^.next;
end_sp^.next:=nil;
end;
end;
procedure printf(p:sp);
begin
writeln('После сортировки');
while p<>nil do
begin
write(p^.data,' ');
p:=p^.next;
end;
end;
procedure printf_reverse(var end_sp:sp);
var p: sp;
begin
p:=end_sp;
while p<>nil do
begin
write(p^.data,' ');
p:=p^.pred;
end;
end;
procedure sort(p: sp);
var buf:sp;
inf: integer;
begin
while p<>nil do
begin
buf:=p^.next;
while buf<>nil do
begin
if p^.data>buf^.data then
begin
inf:=buf^.data;
buf^.data:=p^.data;
p^.data:=inf;
end;
buf:=buf^.next;
end;
p:=p^.next;
end;
printf(spis);
end;
begin
head:=nil;
writeln('Введите элементы списка - числа. Окончание ввода 0...');
read(zn);
while zn<>0 do
begin
create_twodirectlist(spis,end_sp,zn);
readln(zn);
end;
sort(spis);
end.
Листинг задачи 2.45
unit operations;
interface
implementation
type long=^el;
el = record
data:integer;
next,pred:long;
end;
procedure insert(var b:long; c:integer);
var t:long;
begin
new(t);
t^.data:=c;
t^.next:=b;
t^.pred:=nil;
b:=t;
end;
procedure summ(a,b:long; var up:long);
var x,y,z:integer;
begin
z:=0;
up:=nil;
while (a<>nil) or (b<>nil) or (z<>0) do
begin
if a<>nil then
begin
x:=a^.data;
a:=a^.next;
end
else
x:=0;
if b<>nil then
begin
y:=b^.data;
b:=b^.next;
end
else
y:=0;
insert(up,(x+y+z) mod 10);
z:=(x+y+z) div 10;
end;
end;
procedure dec(a,b:long; var up:long);
var x,y,z:integer;
begin
z:=0;
up:=nil;
while (a<>nil) or (b<>nil) or (z<>0) do
begin
if a<>nil then
begin
x:=a^.data;
a:=a^.next;
end
else
x:=0;
if b<>nil then
begin
y:=b^.data;
b:=b^.next;
end
else
y:=0;
insert(up,(x-y-z) mod 10);
z:=(x-y-z) div 10;
end;
end;
procedure double(a:long; b:byte; var up:long);
var x,y,z:integer;
begin
z:=0;
up:=nil;
while (a<>nil) do
begin
if a<>nil then
begin
x:=a^.data;
a:=a^.next;
end;
y:=b;
insert(up,(x*y+z) mod 10);
z:=(x*y+z) div 10;
end;
if z<>0 then insert(up,z);
end;
procedure delenie(a,b:long; var up:long);
var x,y,z:integer;
begin
z:=0;
up:=nil;
while (a<>nil) or (b<>nil) or (z<>0) do
begin
if a<>nil then
begin
x:=a^.data;
a:=a^.next;
end
else
x:=0;
if b<>nil then
begin
y:=b^.data;
b:=b^.next;
end
else
insert(up,(x div y+z) mod 10);
z:=(x div y+z) div 10;
end;
end;
begin
end.
program long_num;
uses crt,operations;
var p,d1,d2,a,b:long;
r,w: integer;
procedure init(var b:long);
var c:string;
i:integer;
begin
readln(c);
for i:=1 to length(c) do
insert(b,ord(c[i])-ord('0'));
end;
procedure printlong(p:long);
begin
while p<>nil do
begin
write(p^.data);
p:=p^.next;
end;
writeln;
end;
begin
clrscr;
write('Chislo 1: '); init(d1);
write('Chislo 2: '); init(d2);
writeln('Какую операцию выполнить?');
writeln('1 - Сложение');
writeln('2 - Вычитание');
writeln('3 - Умножение');
writeln('4 - Деление');
readln(w);
case w of
1: begin writeln('Результат вычислений = '); summ(a,b,p); printlong(p); end;
2: begin writeln('Результат вычислений = '); dec(a,b,p); printlong(p); end;
3: begin writeln('Результат вычислений = '); double(a,r,p); printlong(p); end;
4: begin writeln('Результат вычислений = ');delenie(a,b,p); printlong(p); end;
end;
end.
Листинг задачи 3.14
uses
crt;
type
type_data=integer;
type_balance=-1..1;
AVLTree=^AVLNode;
AVLNode=record
left,right:AVLTree;
data:type_data;
balance:type_balance;//Поле сбалансированности вершины
end;
var
tree:avltree;
i,n,dat,a,b,k:integer;
flag:boolean;
Procedure DelTree(a,b: integer; var tree:AVLTree);
Var
q,o:AVLTree;
node1,node2: AVLTree;
Begin
flag:=false;
if tree<>nil then
begin
q:=tree^.right;
if (tree^.data>a) and (tree^.data<b)then
begin
o:=tree;
dispose(tree);
tree:=o;
flag:=true;
if flag then
case tree^.balance of
1: begin tree^.balance:=0; flag:=false; end;
0: tree^.balance:=-1;
-1://нарушен баланс
begin
node1:=tree^.left;
if node1^.balance=-1 then //вид дисбаланса LL
begin
tree^.left:=node1^.right;
node1^.right:=tree;
tree^.balance:=0;
tree:=node1;
end
else //иначе LR
begin
node2:=node1^.right;
node1^.right:=node2^.left;
node2^.left:=node1;
tree^.left:=node2^.right;
node2^.right:=tree;
if node2^.balance=-1 then
tree^.balance:=1
else
tree^.balance:=0;
if node2^.balance=1 then
node1^.balance:=-1
else
node1^.balance:=0;
tree:=node2;
end;
tree^.balance:=0;
flag:=false;
end;
end;
end
else
if tree^.data<q then
begin
q:=tree^.right;
dispose(tree);
tree:=q;
if flag then
case tree^.balance of
-1: begin tree^.balance := 0; flag := false; end;
0: tree^.balance := 1;
1: //нарушен баланс
begin
node1:=tree^.right;
if node1^.balance=1 then //вид дисбаланса RR
begin
tree^.right:=node1^.left;
node1^.left:=tree;
tree^.balance:=0;
tree:=node1;
end
else //иначе RL
begin
node2:=node1^.left;
node1^.left:=node2^.right;
node2^.right:=node1;
tree^.right:=node2^.left;
node2^.left:=tree;
if node2^.balance=1 then
tree^.balance:=-1
else
tree^.balance:=0;
if node2^.balance=-1 then
node1^.balance:=1
else
node1^.balance:=0;
tree:=node2;
end;
tree^.balance:=0;
flag:=false;
end;
end;
end;
end;
end;
procedure InsertNode(var Tree: AVLTree; const dat: type_data; var flag: Boolean);
var
node1,node2:AVLTree;
begin
if tree=nil then
begin
new(tree);
flag:=true;
with tree^ do
begin
data:=dat;
left:=nil;
right:=nil;
balance:=0;
end;
end
else
if tree^.data>dat then
begin
InsertNode(tree^.left,dat,flag);
if flag then
case tree^.balance of
1: begin tree^.balance:=0; flag:=false; end;
0: tree^.balance:=-1;
-1: //нарушен баланс
begin
node1:=tree^.left;
if node1^.balance=-1 then //вид дисбаланса LL
begin
tree^.left:=node1^.right;
node1^.right:=tree;
tree^.balance:=0;
tree:=node1;
end
else
//иначе LR
begin
node2:=node1^.right;
node1^.right:=node2^.left;
node2^.left:=node1;
tree^.left:=node2^.right;
node2^.right:=tree;
if node2^.balance=-1 then
tree^.balance:=1
else
tree^.balance:=0;
if node2^.balance=1 then
node1^.balance:=-1
else
node1^.balance:=0;
tree:=node2;
end;
tree^.balance:=0;
flag:=false;
end
end
end
else if tree^.data<dat then
begin
InsertNode(tree^.right,dat,flag);
if flag then
case tree^.balance of
-1: begin tree^.balance:=0; flag:=false; end;
0: tree^.balance:=1;
1: //нарушен баланс
begin
node1:=tree^.right;
if node1^.balance=1 then// вид дисбаланса RR
begin
tree^.right:=node1^.left;
node1^.left:=tree;
tree^.balance:=0;
tree:=node1;
end
else // иначе RL
begin
node2:=node1^.left;
node1^.left:=node2^.right;
node2^.right:=node1;
tree^.right:=node2^.left;
node2^.left:=tree;
if node2^.balance=1 then
tree^.balance:=-1
else
tree^.balance:=0;
if node2^.balance=-1 then
node1^.balance:=1
else
node1^.balance:=0;
tree:=node2;
end;
tree^.balance:=0;
flag:=false
end
end
end
end;
procedure lkp(tree:AvLTree);
begin
if tree=nil then exit;
lkp(tree^.left);
write(' ',tree^.data);
lkp(tree^.right);
end;
begin
writeln('Кол-во элементов');
readln(n);
for i:=1 to n do
begin
writeln('Введите',' ',i,'-e',' ','число');
readln(dat);
InsertNode(tree,dat,flag);
end;
writeln('');
lkp(tree);
writeln;
writeln('Введите отрезок на котором удалить элементы:');
write('a= ');
read(a);
write('b= ');
read(b);
DelTree(a,b,tree);
writeln('АВЛ дерево после удаления:');
writeln('');
lkp(tree);
end.
Листинг задачи 4.21
uses crt;
var x,y,z:string;
a:array[0..100,0..100] of byte;
i,j,i1:byte;
procedure lcs(a:array[0..100,0..100] of byte; x,y: string);
begin
for j:=1 to length(x)+1 do //зануляем первую строку и столбец нулями
begin
a[1,j]:=0;
end;
for i1:=2 to length(y) do
begin
a[i1,1]:=0;
end;
for i:=2 to (length(x)+1) do
for j:=1 to (length(y)+1) do
begin
if (x[i]=y[j]) then
a[i,j]:=a[i-1,j-1]+1
else
if (a[i-1,j]>=a[i,j-1]) then
a[i,j]:=a[i-1,j]
else
a[i,j]:=a[i,j-1];//длина ноп находится в последнем элементе таблицы a[length(x),length(y)]
end;
z:='';//получаем ноп
i:=length(x);
j:=length(y);
while (i>0) and (j>0) do
if x[i]=y[j] then
begin
z:=x[i]+z; i:=i-1; j:=j-1
end
else
if a[i-1,j]>=a[i,j-1] then
i:=i-1
else j:=j-1;
writeln('НОП----> ');
write(z);
end;
begin
writeln('подпоследовательность 1:');
readln(x);
writeln('подпоследовательность 2:');
readln(y);
lcs(a,x,y);
end.