write(' Введите новый элемент: '); readln(EL1);
DOBAV_OTCHERED(EL1,L,R);
VIVOD_OTCHERED(L, R);writeln; writeln;
UDALENIE_OTCHERED (L,R);
writeln(' Удаление элемента из очереди !');
VIVOD_OTCHERED(L, R); writeln;writeln;
writeln(' К О Н Е Ц Р А Б О Т Ы !');readln;
end.
program STACK; uses crt;
type SS = ^ZVENO;
ZVENO = record
elem: integer; next: SS;
end;
var ST: SS; {началоочереди}
R: SS; {конец очереди}
K: SS; {рабочий указатель}
el,sklad,kol: integer; {рабочий элемент}
procedure VIVOD(var ukstr: SS);
var ukzv: SS;
begin
¦ kol:=0; { распечаткастроки }
¦ ukzv:=ukstr;
¦ while ukzv<>nil do
¦ begin
¦ ¦ write(ukzv^.elem,' '); kol:=kol+1;
¦ ¦ ukzv:=ukzv^.next;
¦ end; writeln;
¦ writeln(' Стек содеpжит ',kol,' элемента(ов) !');
end;
procedure SOZDAN_STACK (var ST: SS;var kol:integer);
var K: SS;
EL: integer;
begin
¦ randomize; write(' Подаваемые в стек элементы: ');
¦ new(ST); ST:= nil; kol:=0;
¦ EL:= random(5); write(el,' ');
¦ while EL <> 0 do
¦ begin
¦ ¦ new(K); K^.elem:= EL;
¦ k^.next:= ST; ST:= K;
¦ ¦ EL:= random(5); write(el,' '); kol:=kol+1;
¦ end;
end;
procedure VSTAVKA_V_STACK(var ST:SS; EL:integer);
var K: SS;
begin
¦ new(K); K^.elem:= EL;
¦ K^.next:= ST; ST:= K
end;
procedure UDALENIE_IZ_STACK(var ST: SS;var SKLAD: integer);
begin
¦ SKLAD:= ST^.elem;
¦ ST:= ST^.next
end;
procedure UDALENIE_1(var ST: SS; var SKLAD: integer);
var K: SS;
begin
¦ if ST = nil then writeln(' Стекпустой !')
¦ else begin
¦ ¦ SKLAD:= ST^.elem; K:=ST;
¦ ¦ ST:= ST^.next; dispose(K);
¦ end;
end;
procedure VIBORKA_IZ_STACKA(var ST: SS; var SKLAD: integer;
N: integer);
var K: SS; i: integer;
begin
¦ K:= ST;
¦ for i:= 1 to N-1 do
¦ UDALENIE_IZ_STACK(K, sklad);
¦ SKLAD:= K^.elem;
end;
{ ОСНОВНАЯ ПРОГРАММА }
begin
clrscr; gotoxy(30,2); write(' СТЕК '); writeln;writeln;
writeln(' Внимание! Стек фоpмиpует сама ЭВМ');
SOZDAN_STACK(ST,kol); writeln;
write(' Исходный стек: ');
VIVOD(ST); writeln;
write(' Введите новый элемент стека: '); readln(el);
VSTAVKA_V_STACK(ST, el);
write(' Новыйстек: '); VIVOD(ST); writeln;
UDALENIE_IZ_STACK(ST, SKLAD); writeln;
write(' Новый стек после удаления веpшины: ');VIVOD(ST);
UDALENIE_1(ST, SKLAD); writeln('Удаляемыйэлемент: ',sklad);
write(' Новыйстек: '); VIVOD(ST); writeln;
write(' Укажите номер выбираемого из стека элемента: ');
readln(el); VIBORKA_IZ_STACKA(ST, sklad,el);
if el <= kol then writeln(' Выбранныйэлемент: ',sklad)
else
writeln(' Такого номеpа нет в стеке !');
writeln;write(' КОНЕЦРАБОТЫ! ');readln;
end.
program DEC; uses crt;
type SS=^ZVENO;
ZVENO=record
elem: integer;
next: SS;
pred: SS;
end;
var X,Y,A,B,W,F,G: SS; N,EL,ZN: integer;
procedure FORMIR_DEK_1(var X, Y: SS);
var Z: SS; EL: integer;
begin
¦ new(X); read(EL);
¦ X^.elem:= EL; X^.pred:= nil;
¦ Y:= X; Z:= X;
¦ WHILE Y^.elem <> 0 do
¦ begin
¦ ¦ new(Y^.next); Y:=Y^.next; read(Y^.elem);
¦ ¦ Y^.pred:= Z; Z:= Y;
¦ end;
¦ Y^.next:= nil;readln;
end;
procedure FORMIR_DEK_2(var X, Y: SS);
begin
¦ new(X); randomize;
¦ X^.elem:= random (10);
¦ X^.pred:= nil; Y:= X;
¦ while Y^.elem <> 0 do
¦ begin
¦ ¦ new(Y^.next);
¦ ¦ Y^.next^.elem:= random(10);
¦ Y^.next^.pred:= Y; Y:=Y^.NEXT
¦ end;
¦ Y^.pred^.next:= nil
end;
procedure VSTAVKA_V_DEK_POSLE(X,Y: SS);
begin
¦ y^.next:= x^.next; y^.pred:= x;
¦ x^.next:= y; y^.next^.pred:= y;
end;
procedure VSTAVKA_V_DEK_PERED(X, Y: SS);
begin
¦ Y^.next:= X^.pred^.next; X^.pred^.next:= y;
¦ Y^.pred:= X^.pred; x^.pred:= y;
end;
procedure UDAL_DEK(X: ss; VAR Y,Z: SS);
begin
if Y^.next=nil then writeln('Декпуст !') else
¦ if X=Y then Y:=Y^.next
¦ else begin
¦ ¦ X^.pred^.next:=X^.next;
¦ ¦ {Переброскассылки next вверху}
¦ ¦ X^.next^.pred:=X^.pred;
¦ end;{Переброска ссылки pred внизу}
end;
procedure VIVOD_SPISOK(var Y: SS);
var X: SS;
begin
¦ X:=Y;
¦ while X^.next<>nil do
¦ begin
¦ ¦ write(X^.elem,' ');
¦ ¦ X:=X^.next;
¦ end;
end;
procedure POISK_W_SPISKE(var Y: SS; znach:integer;
var n: integer);
var x:ss;
begin
¦ n:=1; x:=y;
¦ while (x^.elem <> znach) and (x^.next <> nil) do
¦ begin
¦ ¦ x:=x^.next;
¦ ¦ n:=n+1
¦ end;
¦ if x^.next=nil then n:= 0
end;
procedure SORTSPISOK (var X: SS);
var X1, Y1: SS; P: integer;
begin
X1:= X;
¦ while X1^.next <> nil do
¦ begin
¦ ¦ Y1:=X1^.next;
¦ ¦ while Y1^.next <> nil do
¦ ¦ begin
¦ ¦ ¦ if Y1^.elem < X1^.elem then
¦ ¦ ¦ begin
¦ ¦ ¦ ¦ P:= X1^.elem; X1^.elem:= Y1^.elem;
¦ ¦ ¦ ¦ y1^.elem:=p;
¦ ¦ ¦ end;
¦ ¦ ¦ Y1:= Y1^.next;
¦ ¦ end;
¦ ¦ X1:= X1^.next;
¦ end;
end;
{ ОСНОВНАЯПРОГРАММА }
begin
clrscr;gotoxy(30,2);writeln(' ДЕК ');writeln;
write(' Внимание! Дек фоpмиpуется ЭВМ '); writeln;
FORMIR_DEK_2(X, Y);
write(' Исходныйдек: ');
VIVOD_SPISOK(X); writeln; writeln;
write(' Введите элементы дека - числа, последнее - 0: ');
FORMIR_DEK_1(F,G); writeln;
write(' Исходный дек: ');
VIVOD_SPISOK(f); writeln; writeln;
write(' Введите элемент для вставки: ');
new(B); B^.next:=nil; readln(B^.elem);
write(' Вставка после пеpвого элемента: '); A:=F;
VSTAVKA_V_DEK_POSLE(A,B);
VIVOD_SPISOK(F); writeln; writeln;
write(' Введите элемент для вставки: ');
new(B);B^.next:=nil;readln(B^.elem);
write(' Вставка перед последним элементом: ');
A:=G^.pred; VSTAVKA_V_DEK_PERED(A,B);
VIVOD_SPISOK(F); writeln; writeln;
write(' Удаление втоpого элемента: ');
UDAL_DEK(F^.next,F,G);
VIVOD_SPISOK(F); writeln; writeln;
write(' Удаление пеpвого элемента: ');
UDAL_DEK(F,F,G);
VIVOD_SPISOK(F); writeln; writeln;
write(' Удаление последнего элемента: ');
UDAL_DEK(G,F,G);
VIVOD_SPISOK(F); writeln; writeln;
write(' Укажите элемент для поиска: '); readln(EL);
POISK_W_SPISKE(F,EL,N); writeln(' N = ',N);
writeln;
write(' Отсортирорванный дек 1: ');
SORTSPISOK (F); VIVOD_SPISOK(F); writeln;
write(' КОНЕЦ РАБОТЫ !');readln;
end.
program TREE; uses crt;
label 1,2,3;
type SS = ^ZVENO;
ZVENO = record
K: integer;
left, right: SS;
end;
var KOL,R,I,J,W: integer; Y:real; DER,EL, q,x: SS; O:char;
{KOL-число элементов дерева; DER-ссылка на корень дерева}
procedure PRINTTREE (Z: SS; X: integer; var Y: real);
var i: integer;
begin
¦ Y:=(x-1)/5-1;
¦ if Z <> nil then
¦ begin
¦ ¦ PRINTTREE(Z^.right, X+5,Y);
¦ ¦ for i:=1 to X do write(' ');
¦ ¦ writeln(Z^.k);
¦ ¦ PRINTTREE(Z^.left, X+5,Y);
¦ end;
end;
{ РЕКУРСИВНАЯ ФУНКЦИЯ ПОСТРОЕНИЯ ДЕРЕВА}
function FORMIRTREE (N: integer): SS;
var Z: SS; NL, NR: integer;
begin
¦ if N = 0 then Z:= nil {пустоедерево}
¦ else
¦ begin
¦ ¦ NL:= N div 2; NR:= N-Nl-1; new(Z);
¦ ¦ write('Введитевершину'); readln(Z^.k);
¦ ¦ Z^.left:= FORMIRTREE (NL);
¦ ¦ Z^.right:= FORMIRTREE (NR);
¦ end;
¦ FORMIRTREE:= Z; {запоминание ссылки на корень дерева}
end;
procedure POISK(S: SS; ZNACH: integer; var ELEM: SS);
begin
¦ if S <> nil then
¦ if S^.k = ZNACH then ELEM:= S
¦ else
¦ begin
¦ ¦ POISK(S^.left,ZNACH,ELEM);
¦ ¦ POISK(S^.right,ZNACH,ELEM);
¦ end;
end;
procedure POISK_v_OD(S: SS; ZNACH: integer; var ELEM: SS);
begin
¦ if (s^.k >=0) and (s^.k<=50) then
¦ begin write(s^.k:3);i:=i+1;end;
¦ if S^.k = ZNACH then begin j:=1;ELEM:= S end
¦ else if s<> nil then
¦ begin
¦ ¦ POISK_v_OD(S^.left,ZNACH,ELEM);
¦ ¦ if j=0 then
¦ ¦ POISK_v_OD(S^.right,ZNACH,ELEM);
¦ end;
end;
procedure VSTAVKA (S, S1, S2: SS);
begin
¦ if S^.left = S1 then
¦ begin
¦ ¦ S^.left:= S2;
¦ ¦ S2^.left:= S1;
¦ ¦ S2^.right:= nil;
¦ end
else
begin
S^.right:= S2;
¦ ¦ S2^.right:= S1;
¦ ¦ s2^.left:= nil;
¦ end
end;
{ ОСНОВНАЯ ПРОГРАММА }
begin
1:clrscr; gotoxy(20,2);write('ДЕРЕВЬЯ ОБЩЕГО ВИДА ');
writeln; writeln;
write(' Введите число элементов дерева: ');
y:= 0; {число уровней дерева*}
readln (KOL); DER:= FORMIRTREE (KOL); readln;clrscr;
writeln;writeln(' ДЕРЕВО:'); writeln;
PRINTTREE (DER,5,y); writeln;
writeln(' Всего', y:3:0,' уровня(ей) дерева');
write(' Еще?(y/n): ');readln(O);
if O='y' then goto 1;
2: clrscr;
writeln; writeln(' ПОИСКЭЛЕМЕHТАВДЕРЕВЕ ');writeln;
writeln; writeln(' 1. ПОИСК ВО ВСЕМ ДЕРЕВЕ');
writeln;writeln(' ДЕРЕВО: '); writeln;
PRINTTREE(DER,5,Y);writeln;
writeln;write(' Введитеэлементдляпоиска:');readln(R);
POISK(DER,R,EL); writeln;
if EL^.k <> R
then writeln(' Такогоэлементанет !') else begin
write(' Вотискомыйэлемент: ');writeln(El^.k); end;
write(' Еще?(y/n): ');readln(o);
if O='y' then goto 2; clrscr;
writeln; writeln(' 2. КОРОТКИЙПОИСК ');writeln;
writeln;writeln(' ДЕРЕВО '); writeln;
PRINTTREE(DER,5,Y);writeln;
write(' Введитеэлементдляпоиска: '); j:=0;
readln(W); write(' Пpоход по деpеву: ');
i:=0;POISK_V_OD(DER,W,X); writeln;if W=X^.k then begin
write('Поиск элемента',X^.k,'в дереве за ',i,' шагов:');
j:=0;POISK_V_OD(DER,W,X); END
else write(' Такого элемента нет в деpеве !'); readln;
3: clrscr; gotoxy(20,2);
write('ВСТАВКА ЭЛЕМЕHТА '); writeln;
writeln;writeln(' ДЕРЕВО '); writeln;
PRINTTREE(DER,5,Y);writeln;
write(' Введитеэлементдлявставки: ');
new(Q);readln(q^.k);
q^.left:=nil; q^.right:=nil;
VSTAVKA (DER^.left,DER^.left^.right,q);
writeln('Элемент вставляется после коpня в левую ветку !');
PRINTTREE (DER,5,y); write(' Еще?(y/n): '); readln(O);
if O ='y' then goto 3;
writeln; writeln(' Конец pаботы !');
end.
program TREEPOISK; uses crt;
label 1,2,3,4,5,6,7,8,9,10,11,12;
type SS = ^ZVENO;
ZVENO = record
K,n: integer;
left, right: SS;
end;
var DER,DER1,Z,X,EL1,T: SS; el,i,w,j:integer;
Q:array[1..20] of integer;
y:real; O:char;
procedure tree(var s:ss; znach:integer);
begin
¦ if s=nil
¦ then begin
¦ ¦ new(s); s^.k:=znach;
¦ ¦ s^.left:=nil;
¦ ¦ s^.right:=nil;
¦ ¦ s^.n:=1;
¦ end
¦ else
¦ if znach < s^.k then TREE(s^.left,znach)
¦ else
¦ if znach > s^.k
¦ then TREE(s^.right,znach)
¦ else s^.n:=s^.n+1;
end;
procedure POISK(S: SS; ZNACH: integer; var ELEM: SS);
begin
¦ if S <> nil then
¦ if S^.k = ZNACH then ELEM:= S
¦ else
¦ begin
¦ ¦ POISK(S^.left,ZNACH,ELEM);
¦ ¦ POISK(S^.right,ZNACH,ELEM);
¦ end;
end;
procedure POISK_v_OD(S: SS; ZNACH: integer; var ELEM: SS);
begin
¦ if (S^.k >=0) and (S^.k<=50) then
¦ begin write(S^.k:3);i:=i+1;end;
¦ if S^.k = ZNACH then begin j:=1;ELEM:= S end
¦ else if S<> nil then
¦ begin
¦ ¦ POISK_v_OD(S^.left,ZNACH,ELEM);
¦ ¦ if j=0 then
¦ ¦ POISK_v_OD(S^.right,ZNACH,ELEM);
¦ end;
end;
procedure POISK_v_DP(S: SS; ZNACH: integer; var ELEM: SS);
begin
¦ if (s^.k >=0) and (s^.k<=50) then
¦ begin write(s^.k:3);i:=i+1;end;
¦ if S <> nil then
¦ if S^.k = ZNACH then ELEM:= S
¦ else
¦ if znach < S^.k then
¦ POISK_v_DP(s^.left,ZNACH,ELEM)
¦ else
¦ if znach > S^.k
¦ then POISK_v_DP(S^.right,znach,elem)
end;
function FORMIRTREE (N: integer): SS;
var Z: SS; NL, NR: integer;
begin
¦ if N = 0 then Z:= nil {пустоедерево}
¦ else
¦ begin
¦ ¦ NL:= N div 2; NR:= N-Nl-1; new(Z);
¦ ¦ Z^.k:=q[i]; i:=i+1;
¦ ¦ Z^.left:= FORMIRTREE (NL);
¦ ¦ Z^.right:= FORMIRTREE (NR);
¦ end;
¦ FORMIRTREE:= Z; {запоминание ссылки на корень дерева}
end;
procedure VSTAVKA (S, S1, S2: SS);
begin
¦ if S^.left = S1 then
¦ begin
¦ ¦ S^.left:= S2;
¦ ¦ S2^.left:= S1;
¦ ¦ S2^.right:= nil;
end
else
¦ begin
¦ ¦ S^.right:= S2;
¦ ¦ S2^.right:= S1;
¦ ¦ s2^.left:= nil;
¦ end
end;
procedure PRINTTREE (q: ss; X: integer; var y: real);
var i: integer; z:ss;
begin
¦ y:=(x-1)/5-1; z:=q;
¦ if Z <> nil then
¦ begin
¦ ¦ PRINTTREE(Z^.right, X+5,y);
¦ ¦ for i:=1 to X do write(' ');
¦ ¦ writeln(Z^.k);
¦ ¦ PRINTTREE(Z^.left, X+5,y);
¦ end;
end;
procedure UDALEN(var z,x: SS);
{X-удаляемый элемент, Z - предшествующий}
var P,M: SS; {Вспомогательные вершины}
begin
¦ if x^.left=nil then
¦ if z^.left^.k=x^.k
¦ then z^.left:=x^.right
¦ else z^.right:=x^.right
¦ else
¦ if x^.left^.right=nil
¦ then
¦ if z^.left^.k = x^.k
¦ then
¦ begin
¦ ¦ z^.left:= x^.left;
¦ ¦ x^.left^.right:= x^.right;
¦ end
¦ else
¦ begin
¦ ¦ z^.right:= x^.left;
¦ ¦ x^.left^.right:= x^.right;
¦ end
¦ else
¦ begin
¦ ¦ p:=x^.left^.right; m:=x^.left;
¦ ¦ while p^.right <> nil do
¦ ¦ begin
¦ ¦ ¦ m:=p; p:=p^.right;
end;
x^.k:=p^.k;
¦ ¦ m^.right:=nil;
¦ end;
end;
{ ОСНОВНАЯПРОГРАММА}
begin
clrscr;gotoxy(10,2);write('ДЕРЕВОПОИСКА ');writeln;
writeln;write('Введитевеpшиныдеpева:');
1: read(EL); DER:=nil;
while EL<>0 do
begin
¦ TREE(DER,EL);
¦ read(EL);
end;readln;
writeln('ДЕРЕВО '); PRINTTREE(DER,3,y);
write('Еще ?(y/n): '); readln(O);if O='y' then begin clrscr;
goto 1; end;
2: clrscr;writeln('ВСТАВКАЭЛЕМЕHТОВ ');writeln;
writeln('ДЕРЕВО '); writeln;PRINTTREE(DER,3,y); writeln;