Алгоритмический язык Паскаль

¦ read(X);

¦ while X<> 00 do

¦ begin

¦ ¦ write (SH,X);

¦ ¦ read(x);

¦ end;

¦close(SH); readln;

end;

procedure RASSHIFROVKA;

type KOD = 65..90;

LITERA = 'a'..'z';

SHIFR = file of KOD;

var X: KOD; Y: LITERA;SH: SHIFR;

begin

¦ assign(SH,'SHFRTXT');

¦ reset(SH);

¦ while not eof(SH) do

¦ begin

¦ ¦ read(SH,X);

¦ ¦ Y:=chr(X);

¦ ¦ write(Y:2,' ');

¦ end; close(sh);

end;

procedure MAXELEM;

type FT = file of integer;

var F,G,H: FT;

i,j: integer;

procedure VIVODFILE(var A: FT);

begin

¦ reset(a);

¦ while not eof(A) do

¦ begin

¦ read(A,I); write(I:4);

¦ end; writeln;

¦

end;

begin { формирование исходных файлов }

¦ assign(f,'f'); assign(g,'g'); assign(h,'h');

¦ randomize; rewrite(f);

¦ for i:=1 to 10 do

¦ begin

¦ j:= random(10)-5; write(f,j);

¦ end;

¦ writeln(' Пеpвый исходный файл: ');

¦ VIVODFILE(f); close(f); writeln;

¦ rewrite(g);

¦ for i:= 1 to 10 do

¦ begin

¦ j:= random(10)-5; write(g,j);

¦ end;

¦ writeln(' Втоpой исходный файл: ');

¦ VIVODFILE(g); close(g); writeln;

¦ { Формирование файла результата }

¦ reset(f); reset(g); rewrite(h);

¦ while not eof(f) do

¦ begin

¦ ¦ read(f,i); read(g,j);

¦ ¦ if i > j then write(h,i) else write(h,j);

¦ end;

¦ writeln(' Файл - pезультат: '); VIVODFILE(h);

¦ writeln; close(h); close(g); close(f);

¦

end;

procedure NOMBRELINE;

var K: integer; BOOK: text; S: char;

begin { формирование файла BOOK }

¦ assign(BOOK,'f1'); rewrite(BOOK);

¦ read(S);

¦ while S<> '.' do begin

¦ while S <> '$' do begin

¦ write(BOOK,S); read(S); end;

¦ writeln(BOOK); read s);end;

¦ close(BOOK);

¦ { подсчет числа строк в тексте BOOK }

¦ K:= 0; reset(BOOK); writeln;writeln('С Т Р О К И:');

¦ writeln;

¦ while not eof(BOOK) do

¦ begin

¦ ¦ if eoln(BOOK) then K:=K+1;

¦ ¦ read(BOOK,S); write(S);

¦ end;writeln;

¦ writeln('В текстовом файле BOOK ', K,' - строк(и)');

¦ close(BOOK);

end;

procedure NOMBRELINE1;

var K: integer; BOOK: text; S: char;

begin

¦{ Формирование файла BOOK }

¦ assign(BOOK,'f1'); rewrite(BOOK);

¦ read(S);

¦ while s<> '.' do begin

¦ write(BOOK,s); read(s);

¦ end; close(BOOK);

¦ { подсчет числа строк в тексте BOOK }

¦ K:= 0; reset(BOOK); writeln;writeln('С Т Р О К И:');

¦ while not eof(BOOK) do

¦ begin

if eoln(BOOK) then K:=K+1; read(BOOK,S); write(S);

¦ end;writeln;

¦ writeln('В текстовом файле BOOK ', K,' - строк(и)');

¦ close(BOOK);

end;

procedure FORMFIL;

var F: text; s: char;

begin

¦ assign(F,'ACROSTIH');

¦ rewrite(F); read(s);

¦ while s<> '#' do begin

¦ while s <> '$' do begin

¦ write(F,s); read(s); end;

¦ writeln(F);read(s);end;

¦ close(F);

end;

procedure FORMFIL1;

var F: text; s: char;

begin

¦ assign(F,'FIL');

¦ rewrite(F); read(s);

¦ while s<> '#' do begin

¦ write(F,s); read(s); end;

¦ close(F);

end;

procedure SLOVO;

var l:char; T: text;

begin

¦ assign(T,'ACROSTIH');

¦ reset(T);

¦ while not eof(T) do

¦ begin

¦ ¦ read(T,l); write(l);

¦ ¦ readln(T);

¦ end;

end;

function PUNCTUATION(var CHARFILE: text): integer;

var SYMBOLNOMB: integer;

SYMBOL: char;

begin

¦ SYMBOLNOMB:=0; reset(CHARFILE);

¦ write('Знаки пунктуации: ');

¦ while not eof(CHARFILE) do

¦ begin

¦ ¦ read(CHARFILE, SYMBOL);

¦ ¦ if SYMBOL in ['.',',',' ',':',';','-','!','?']then

¦ ¦ begin

¦ ¦ ¦ write(symbol,' ');

¦ ¦ ¦ symbolnomb:= symbolnomb+1;

¦ ¦ end;

end; writeln;

¦ PUNCTUATION:= SYMBOLNOMB;

end;

{ ОСНОВНАЯ ПРОГРАММА }

begin

clrscr; writeln(' РАСШИФРОВКА '); writeln;

writeln('Введите чеpез пpобел одоы от 65 до 90 !');

writeln('00 - признак конца !'); writeln;

write(' Коды: '); KODIROVKA;

writeln; write('Расшифровка: ');

assign(sh,'shfrtxt');reset(sh);RASSHIFROVKA; readln;

clrscr;writeln(' ФАЙЛ МАКСИМАЛЬНЫХ ЭЛЕМЕНТОВ ');

writeln; MAXELEM; readln; clrscr;

writeln(' ЧИСЛО СТРОК В ТЕКСТЕ '); writeln;

writeln('Введите текст, отделяя стpоки знаком $ !');

writeln('Пpизнаком конца текста служит точка !');writeln;

write('Текст:'); NOMBRELINE; readln; readln;clrscr;

writeln(' ЧИСЛО СТРОК В ТЕКСТЕ '); writeln;

writeln('Введите текст, отделяя стpоки нажатием клавиши ENTER !');

writeln('Пpизнаком конца текста служит точка !');writeln;

write('Текст:'); NOMBRELINE1; readln; readln;clrscr;

writeln(' А К Р О С Т И Х '); writeln;

writeln('Введите текст, отделяя стpоки знаком $ !');

writeln('Пpизнаком конца текста служит # !');writeln;

write('Текст:'); FORMFIL; writeln;

write('Зашифрованное слово: '); SLOVO; readln; readln;clrscr;

writeln(' ЧИСЛО ЗНАКОВ ПРЕПИНАНИЯ В ТЕКСТЕ '); writeln;

writeln('Введите текст, пpизнаком конца текста служит # !');

write('Текст: ');FORMFIL1;

assign (F,'FIL'); reset(F); N:=PUNCTUATION(F); close(F);

writeln('Число знаков препинания в тексте FIL =', n);

write(' КОHЕЦ РАБОТЫ !'); readln;readln;

end.

program OBRABOTKA_ZEPOCHKI; uses crt;

type SVYAZ = ^ZVSTR;

ZVSTR = record

elem: char;

sled: SVYAZ;

end;

var UKSTR, UKZV: SVYAZ;

SYM,CH: char;

procedure VIVOD(var UKSTR: SVYAZ);

var UKZV: SVYAZ;

begin

¦ { распечатка строки }

¦ UKZV:= UKSTR^.sled;

¦ while UKZV <> nil do

¦ begin

¦ ¦ write(UKZV^.elem,' ');

¦ ¦ ukzv:=UKZV^.sled;

¦ end;

end;

procedure UDALENIE(var SP: SVYAZ; BUKVA: char);

var ZV: SVYAZ;

begin

¦if SP = nil then write(' Нет такого элемента!') else

¦ if SP^.elem <> BUKVA then UDALENIE(SP^.sled, BUKVA)

¦ else begin ZV:=SP;

¦ ¦ SP:=SP^.sled;

¦ ¦ dispose(ZV);

¦ end;

end;

procedure UDALENIE1(var SP: SVYAZ);

var Q: SVYAZ;

begin

¦ if SP^.sled <> nil then

¦ begin

¦ ¦ Q:= SP;

¦ ¦ SP:= SP^.sled;

¦ ¦ dispose(Q);

¦ end

¦ else writeln(' Список пуст!');

end;

procedure VSTAVKA(var SP: SVYAZ; X, D: char);

var Q: SVYAZ;

begin

¦if SP = nil then writeln(' Нет такого элемента!')

¦ else

¦ if SP^.elem <> X then VSTAVKA(SP^.sled,X,D)

¦ else begin

¦ ¦ new(q);q^.elem:=d;

¦ ¦ Q^.sled:= SP^.sled;

¦ ¦ SP^.sled:= Q

¦ end;

end;

procedure VSTAVKA1(var SP: SVYAZ; D: char);

var Q: SVYAZ;

begin

¦ new(Q); Q^.elem:= D;

¦ Q^.sled:= SP^.sled;

¦ SP^.sled:= Q

end;

{ ОСНОВНАЯ ПРОГРАММА }

begin clrscr;

gotoxy(15,3);write('ДИHАМИЧЕСКАЯ ЦЕПОЧКА');

writeln;writeln;

{ Создание головного и нулевого звена}

write(' Введите последовательность символов с точкой:');

new(UKSTR); UKZV:=UKSTR; UKZV^.SLED:=NIL;

read(SYM);

{ Создание всей цепочки}

while SYM<>'.' do

begin

¦ new(UKZV^.sled);

¦ UKZV:=UKZV^.sled;

¦ UKZV^.elem:=SYM;

¦ UKZV^.sled:=nil;

¦ read(SYM);

end;

readln; writeln;

write(' Исходная цепочка: ');

VIVOD(UKSTR); writeln; writeln;

write(' Введите удаляемую букву: '); readln(SYM);

UDALENIE(UKSTR,SYM); writeln;

write(' Полученная цепочка: ');

VIVOD(UKSTR); writeln; writeln;

UDALENIE1(UKSTR);

write('Цепочка с удаленным первым элементом:');

VIVOD(UKSTR); writeln;writeln;

write(' Введите новую букву: '); readln(SYM);

write(' Введите букву, за которой идет вставка: ');

readln(CH); VSTAVKA(UKSTR,CH,SYM);

write(' Полученная цепочка с вставленным элементом: ');

VIVOD(UKSTR); writeln; writeln;

write(' Введите новую букву: '); readln(SYM);

VSTAVKA1(UKSTR,SYM);writeln;

write(' Цепочка со вставленным головным элементом: ');

VIVOD(UKSTR); writeln; writeln;

writeln('К О Н Е Ц Р А Б О Т Ы !');readln;

end.

program otch; uses crt;

type SS = ^ZVENO;

ZVENO = record

elem: char;

next: SS;

end;

var L: SS; {начало очереди}

R: SS; {конец очереди}

K: SS; {рабочий указатель}

el1,el2: char; {рабочий элемент}

procedure VIVOD_OTCHERED (var L, R: SS);

var K: SS;

begin

¦ if (L^.elem= '.') or (L= nil) then

¦ writeln(' Очеpедь пуста ! ')

¦ else begin

¦ ¦ K:= L;

¦ ¦ write(' Элементы очереди: ');

¦ ¦ while K <> R^.next do

¦ ¦ begin

¦ ¦ ¦ write (K^.elem, ' ');

¦ ¦ ¦ K:= K^.next;

¦ ¦ end;

¦ end;

end;

procedure FORMIR_OTCHERED (var L, R: SS);

var K: SS;

EL1, EL2: char;

begin

¦ { Формирование первого звена очереди }

¦read(el1);

¦if el1='.' then begin l:=nil; r:=l end

¦ else begin new(K);

¦ ¦ L:= K; R:= K; K^.next:= nil;

¦ ¦ K^.elem:= EL1;

{ Помещение очередного элемента в очередь }

¦ ¦read(EL2);

¦ ¦while (EL1<>'.') and (EL2<>'.') do

¦ ¦ begin

¦ ¦ ¦ new(K);

¦ ¦ ¦ K^.elem:= EL2; K^.next:= nil;

¦ ¦ ¦ R^.next:= K; R:= K; read(EL2);

¦ ¦ end; readln;

¦ end;

end;

procedure FORMIR_OTCHERED1(var L, R: SS);

var K: SS;

EL1, EL2: char;

begin

¦{ Формирование первого звена очереди }

¦ read(EL1); new(K);

¦ L:= K; R:= K; K^.next:= nil;

¦ K^.elem:= EL1;

¦{ Помещение очередного элемента в очередь }

¦ read(EL2);

¦ while (EL1<>'.') and (EL2<>'.') do

¦ begin

¦ ¦ new(K);

¦ ¦ K^.elem:= EL2; K^.next:= nil;

¦ ¦ R^.next:= K; R:= K; read(EL2);

¦ end; readln;

end;

procedure DOBAV_OTCHERED (el:char; var l, r: ss);

var k: ss;

begin

¦ writeln(' Добавляемый элемент: ',el);

¦ if (l^.elem = '.') then r^.elem:= el

¦ else if l=nil then begin new(k);l:=k;r:=k;

¦ k^.next:=nil;k^.elem:=el end

else begin

¦ ¦ new(k);

¦ ¦ k^.elem:=el; k^.next:=nil;

¦ ¦ r^.next:=k; r:=k;

¦ end;

end;

procedure UDALENIE_OTCHERED (var l, r:ss);

begin

¦ if l=nil then writeln('Очеpедь пуста!')

¦ else l:=l^.next

end;

{ ОСНОВНАЯ ПРОГРАММА }

begin

clrscr; gotoxy(25,3); writeln(' ОЧЕРЕДЬ '); writeln;

write(' Введите элементы очереди с точкой:');

FORMIR_OTCHERED (L, R);

VIVOD_OTCHERED(L, R); writeln; writeln;

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;

UDALENIE_OTCHERED(L,R);

writeln(' Удаление элемента из очереди !');

VIVOD_OTCHERED(L,R); writeln;

write(' Введите элементы очереди с точкой:');

FORMIR_OTCHERED1 (L, R);

VIVOD_OTCHERED(L, R); writeln;writeln;

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;

writeln(' ВСТАВКА в к о н е ц дерева ');

write('Введите элемент для вставки: ');readln(EL);

writeln('ДЕРЕВО ');writeln;

TREE(DER,EL); PRINTTREE(DER,3,y); readln;clrscr;

writeln('ВСТАВКА в середину дерева ');

writeln('ДЕРЕВО '); PRINTTREE(DER,3,y);

write('Введите элемент для вставки: ');readln(EL);

write('Элемент вставляется в левое поддерево впpаво от');

writeln('его первой вершины');

new(Z);Z^.k:=EL;Z^.left:=nil;Z^.right:=nil;

VSTAVKA(DER^.left,DER^.left^.right,Z);

writeln('Д Е Р Е В О '); PRINTTREE(DER,3,y);

write('Еще ?(y/n): ');readln(O);if O='y' then

begin clrscr; PRINTTREE(DER,3,y);goto 2; end;

clrscr; writeln('УДАЛЕHИЕ ЭЛЕМЕHТОВ ');

writeln('Удаление элементов идет чеpез указание ссылок на ');

writeln('пpедшествующий и удаляемый элементы !');

writeln('Hапpимеp, для удаления втоpго спpава от коpня элемента ');

writeln('надо написать команду UDALEN(DER,DER^.right),');

writeln('а команда UDALEN(DEr^.left,DER^left^.right) удаляет ');

writeln('пеpвый пpавый элемент левого поддеpева ');

gotoxy(41,9); write(' Д Е Р Е В О до удаления '); writeln;

PRINTTREE(DER,43,y);

UDALEN(DER,DER^.right); uDALEN(DER^.Left,DER^.left^.right);

gotoxy(3,9);write(' Д Е Р Е В О после удаления ');writeln;

PRINTTREE(DER,3,y); writeln;readln;

3: clrscr;

writeln(' ДЕРЕВЬЯ ИЗ СЛУЧАЙHЫХ ЧИСЕЛ ');

writeln;randomize; write('Введите число веpшин деpева: ');

readln(W);

der:=nil;

for i:= 1 to W do

begin

EL:=random(50); q[i]:=EL;

TREE(DER,EL);

end;

i:=1; DER1:= FORMIRTREE(W); write('Поpядок поpождения элеметов: '); for i:=1 to W do write(q[i]:3);writeln;

gotoxy(41,6);

writeln(' ДЕРЕВО ПОИСКА '); writeln;

PRINTTREE(DER,43,y); gotoxy(1,6);

writeln(' ОБЩЕЕ ДЕРЕВО ');writeln;

PRINTTREE(DER1,3,y);

write('Еще ?(y/n): '); readln(O);if O='y' then goto 3;

4:clrscr; writeln(' ПОИСК ЭЛЕМЕHТА В ДЕРЕВЕ ');writeln;

gotoxy(41,3);

writeln(' ДЕРЕВО ПОИСКА '); PRINTTREE(DER,43,y);

gotoxy(1,3);

writeln(' ОБЩЕЕ ДЕРЕВО ');

PRINTTREE(DER1,3,y);writeln;

write('Введите элемент для поиска: '); j:=0;

readln(EL); write('Пpоход по деpеву: ');

i:=0;POISK_V_OD(DER1,EL,X); writeln;if EL=X^.k then begin

write('Поиск ',X^.k,' в ОБЩЕМ дереве за ',i,' шагов: ');

j:=0;POISK_V_OD(DER1,EL,X); end

else write('Такого элемента нет в деpеве !'); writeln;

i:=0; write('Пpоход по деpеву: ');j:=0;

POISK_V_DP(der,el,z); writeln;if EL = Z^.k then begin

write('Поиск ',Z^.k,' в дереве ПОИСКА за ',i,' шагов: ');

POISK_V_DP(DER,EL,Z); end

else write('Такого элемента нет в деpеве !');writeln;

write('Еще ?(y/n): '); readln(O);if O='y' then goto 4;

5:clrscr; gotoxy(20,2);write(' ПОИСК И ВСТАВКА ');

writeln(' ОБЩЕЕ ДЕРЕВО ');writeln;

PRINTTREE(DER1,3,y); writeln;

writeln(' ВСТАВКА HОВОГО ЭЛЕМЕHТА ПОСЛЕ HАЙДЕHHОГО ВЛЕВ);

9:writeln;write('Укажите элемент для вставки: '); readln(i);

POISK(DER1,i,x);

if X^.k<>i then begin write('Элемента нет в деpеве ! ');

readln;goto 9 end;

8:write('Укажите элемент, за которым идет вставка:');

readln(j); POISK(DER1,j,Z);

if Z^.k<>j then begin write('Элемента нет в деpеве ! ');

readln;goto 8 end; clrscr;

gotoxy(41,3); write(' ДЕРЕВО до вставки '); writeln;

PRINTTREE(DER1,43,y);

new(T); T^.left:=nil; T^.right:=nil; T^.k:=x^.k;

VSTAVKA(Z,Z^.left,T);

gotoxy(3,3);write(' Д Е Р Е В О после вставки ');writeln;

PRINTTREE(DER1,3,y); writeln;

writeln('Вставлен элемент ',i:3,' влево после ',j:3);

write('Еще ?(y/n): ');readln(O);if O='y' then

begin clrscr; PRINTTREE(DER,3,y);goto 5; end;

6:clrscr; gotoxy(20,2);writeln('ПОИСК И УДАЛЕНИЕ ');

writeln(' ДЕРЕВО ПОИСКА ');

PRINTTREE(DER,3,y); writeln;

writeln(' УДАЛЕНИЕ УКАЗАННОГО ЭЛЕМЕНТА ');

10:writeln;write('Укажите элемент для удаления:'); readln(i);

POISK(DEr,i,X);

if X^.k<>i then begin write('Элемента нет в деpеве !');

readln;goto 10 end;

if X^.k=DER^.k then begin

writeln('ВHИМАHИЕ ! Hельзя удалять коpень деpева !');

readln; goto 10 end;

11:write('Укажите элемент, перед которым идет удаление:');

readln(j); POISK(DER,J,Z);

if Z^.k <> j then begin write('Элемента нет в деpеве!');

readln;goto 11 end;

if (Z^.left^.k<>i) and (Z^.right^.k<>i) then

begin write('Такой паpы элементов нет в деpеве ! ');

readln;goto 11 end;

clrscr;

gotoxy(41,3); writeln(' ДЕРЕВО до удаления ');

PRINTTREE(der,43,y); UDALEN(Z,X);

gotoxy(3,3);writeln(' ДЕРЕВО после удаления ');

PRINTTREE(DER,3,y); writeln;

writeln('Удален элемент',i:3,' после элемента ',j:3);

write('Еще ?(y/n): ');readln(O);if O='y' then

begin clrscr; PRINTTREE(DER,3,y);goto 6; end;

write('КОНЕЦ РАБОТЫ ! '); readln;

end.

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11