Алгоритмический язык Паскаль (стр. 30 из 31)

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);