Некоторые дополнительные возможности работы с динамическими структурами

 

Как мы уже отмечали выше, все динамические структуры, образующиеся в памяти ЭВМ, могут рассматриваться в ОЗУ, отведенной для программы пользователя, как "КУЧА". Пользователь может работать с этой "кучей" с помощью специальных процедур. Среди них самыми важными являются запоминание состояния "кучи" и последующее воспроизведение ее. Это делается с помощью процедур MARK и RELASE.

Мы знаем, что для долговременного хранения информации в файлах используется внешняя память в виде диска или дискеты. Часто возникает необходимость записать на диск созданную динамическую структуру с целью ее сохранения и последующего воспроизведения в ОЗУ.

Для решения этой задачи необходимо представлять себе, что все динамические объекты (списки, стеки, деки, очереди, деревья), как и другие простые данные, лежат в некоторой, строго отведенной области ЭВМ. При этом начальный объект в структуре находится в ячейке памяти с номером N, образованным в результате работы процедуры NEW, а последний - в ячейке памяти с номером N+б (дельта), где б, в каком-то смысле, есть длина динамического объекта. Если знать эти числа, т.е. номера первой и последней ячеек, то можно, не обходя все дерево, переписать содержимое группы ячеек между адресами N и N+б на диск в виде файла. Затем при необходимости есть возможность списать с диска данные не куда-нибудь в память, а именно в ячейки с указанными адресами.

Для решения этой задачи используется функция HEAPPTR, которая возвращает так называемый текущий указатель "кучи", т.е. адрес ее конца. В этом случае достаточно запомнить адрес конца "кучи" в самом начале и по окончании работы с динамическими объектами.

Все эти операции реализованы в следующей программе:

procedure ZAPIS(F: file of integer);

var N,K,I,ZN: integer;

begin

N:= HEAPPTR; { Начало "кучи" }

................

{ Создание динамической структуры }

.................

K:= HEAPPTR; {Конец "кучи"}

rewrite(F); write(F, N);

for i:=1 to k do begin ZN:=MEM[i];

write(F, ZN); end;

close(F);

end.

ПОЯСНЕНИЕ. Первым в файл идет начальный адрес "кучи". Это необходимо для того, чтобы узнать потом, с какого адреса можно воспроизвести "кучу". Далее в процедуре идет имя MEM - стандартное имя массива-памяти. То есть вся память понимается как массив, а ее индексы есть адреса ее точек. Это делается в рамках Паскаля. Вся запись и чтение в памяти идет через одномерный массив.

Рассмотрим теперь процедуру воспроизведения, где данные считываются из файла и записываются в нужные адреса памяти:

procedure VOSPROIZV(F: file of integer; var NACH: SS;)

var ZN, N:integer;

begin reset (F); read(F, ZN);

NACH:= ptr(ZN); n:= zn;

{Начальный адрес заполнения памяти}

while not eof(F) do begin read(F, ZN);

mem[N]:= ZN;

N:= N+1; end;

close(F);

end.

ПРИМЕЧАНИЕ. Здесь PTR - функция, восстанавливающая ссылку на адрес ZN - первый адрес динамической структуры. Эта ссылка запоминается в переменной NACH, после чего процедура может обращаться к динамическому объекту по данной ссылке.

ЛИТЕРАТУРА

 

1. Йенсен К.В. Паскаль: руководство для пользователя и описание языка. - М.: Финансы и статистика, 1982.

2. Абрамов В.Г., Трифонов Н.П., Трифонова Г.Н. Введение в язык Паскаль.- М.: Наука, 1989.

3. Эрбс Х.Э., Штольц О. Введение в программирование на языке Паскаль.- М.: Наука, 1989.

4. Корноухов М.А., Пантелеев И.В. Справочное руководство по языку программирования TURBO-PASCAL.- М.: Изд-во МГУ им.Ломоносова, 1985.

5. Хершель Р. Турбо Паскаль.- Вологда: МП "МИК", 1991.

 

ПРИЛОЖЕНИЕ

 

Настоящее приложение содержит в себе сборник программ практически по всем темам данного учебного пособия. Каждая программа написана с использованием материала, включенного в текст пособия. Большая часть из них представляет собой интегрированный пакет, в который входят рассмотренные в курсе самостоятельные программы, а также процедуры и функции, объединенные в единое целое и посвященные одному разделу учебного пособия. Каждый пакет иллюстрирует работу включенных в нее программных продуктов в их взаимосвязи и при различных исходных данных. Вынесенный в приложение учебный материал поможет студентам лучше разобраться в тонкостях языка Паскаль, а преподавателям использовать его в качестве демонстрационной поддержки читаемого курса.

program RABMAS; uses crt;

const M=10; N=10;

type LINE = array[1..n ] of integer;

TAB = array[1..m] of LINE;

var S,I,J,X,Y:integer; MAS:TAB;

{ ВХОЖДЕНИЕ БКУВ В ТЕКСТ }

procedure COUNTER;

var COUNT: array['a'..'z'] of integer;

CH: char; N: integer;

begin

¦ for CH:= 'a' to 'z' do

¦ COUNT [CH]:= 0; N:= 0;

¦ repeat

¦ ¦ read(CH); N:= N+1;

¦ ¦ if (CH >= 'a') and (CH <= 'z') then

¦ ¦ COUNT [CH]:= COUNT [CH]+1;

¦ until CH = '.'; readln; writeln;

¦ writeln('Частота вхождения букв: '); writeln;

¦ for CH:= 'a' to 'z' do

begin

¦ ¦write(CH,COUNT[CH]:10,COUNT[CH]*100/N:10:2,' ':15);

¦ ¦CH:=succ(CH);

¦ ¦writeln(ch,count[ch]:10,count[CH]*100/N:10:2);

¦ end;

end;

{ ЧИСЛО ДНЕЙ В МЕСЯЦЕ }

procedure NUMBRDAY;

type MONAT = (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,

SEP, OKT, NOV, DEC);

var DAY: array [MONAT] of 28..31;

T: MONAT; k:integer;

begin

¦ for T:= JAN to DEC do

¦ case T of

¦ JAN, MAR, MAY, JUL, AUG, OKT, DEC: DAY[T]:= 31;

¦ APR, JUN, SEP, NOV: DAY[T]:= 30;

¦ FEB: DAY[T]:= 28;

¦ end;

¦ writeln(' Число дней в месяцах: '); K:=1;

¦ for T:= JAN to DEC do begin

¦ writeln(' ',K:2,'-й',' месяц ',day[t],' дней ');

¦ K:=K+1;

¦ end;

end;

{ ВВОД, ПЕЧАТЬ И ОБРАБОТКА МАССИВА }

procedure VVODMASSIV(M,N:integer;var MAS:TAB);

begin

¦ for I:=1 to M do

¦ for J:=1 to N do

¦ read(MAS[I][J]); readln;

end;

procedure VIVODMASSIV(M,N:integer;var MAS:TAB);

begin

¦ for I:=1 to M do

¦ begin

¦ ¦ for J:=1 to N do

¦ ¦ write(MAS[I][J]:5,' ');

¦ ¦ writeln;

¦ end;

end;

procedure OBRABOTKA(M,N:integer; MAS:TAB; var SUM:integer);

begin

¦ SUM:= 0;

¦ for I:=1 to M do

¦ for J:=1 to n do

¦ if J > I then SUM:= SUM+MAS[I][J];

end;

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

begin

clrscr; writeln(' ПОДСЧЕТ ЧИСЛА ВХОЖДЕНИЙ БУКВ В ТЕКСТ');

writeln; write('Введите текст с точкой на конце: ');COUNTER;

readln;clrscr;

writeln(' ЧИСЛО ДHЕЙ В МЕСЯЦАХ ГОДА !');

writeln; NUMBRDAY; READLN;

CLRSCR;writeln('СУММА ЭЛ-ОВ МАССИВА HАД ГЛАВHОЙ ДИАГHАЛЬЮ ');

writeln; write(' Введите число стpок матpицы: '); readln(X);

write(' Введите число столбцов матpицы: ');readln(Y);

write(' Введите чеpез пpобел ',X*Y,' чисел(ла): ');

VVODMASSIV(X,Y,MAS); writeln; writeln;

writeln(' ИСХОДНЫЙ МАССИВ');

VIVODMASSIV(X,Y,MAS); OBRABOTKA(X,Y,MAS,S);writeln;

writeln(' Сумма элементов = ',s);

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

end.

program LITERI; uses crt;

procedure SKOBKI;

var c: char; i: integer;

begin

¦ i:=0; read(c); writeln;

¦ write('Строка без скобок: ');

¦ while c <> '.' do

¦ begin

¦ ¦ if c='(' then i:=1

¦ ¦ else if c = ')' then i:=0

¦ ¦ else if i=0 then write(c);

¦ ¦ read(c);

¦ end;

end;

procedure SUITE;

var c,d: char;

b¦gin

¦for c:='a' to 't' do

¦ begin

¦ ¦for d:='a' to c do write(d);

¦ ¦writeln(' ');

¦ end;

end;

procedure SOWPADENIE;

label 1;

type t = array[1..5] of char;

var s:t; y:char; i:integer;

begin

¦ write('Введите пеpвые 5 символов: ');

¦ for i:=1 to 5 do read(s[i]); readln;

¦ write('Введите последние 5 символов:');

¦ for i:=1 to 5 do

¦ begin

¦ ¦ read(y);

¦ ¦ if s[i] <> y then

¦ ¦ begin writeln;

¦ ¦ ¦ write('ОТВЕТ: не совпадает');

¦ ¦ ¦ goto 1;

¦ ¦ end;

¦ end;

¦ writeln;write('ОТВЕТ: совпадает'); 1:;

end;

procedure REVERSE;

var OLD_LINE, NEW_LINE: string[50];

PROBEL: integer; WORD: string[50];

begin

¦ NEW_LINE:= ''; readln(OLD_LINE);

¦ OLD_LINE:= concat(OLD_LINE,' ');

¦ while OLD_LINE <> '' do

¦ begin

¦ ¦ PROBEL:= pos(' ', OLD_LINE);

¦ ¦ WORD:= copy(OLD_LINE, 1, PROBEL);

¦ ¦ NEW_LINE:= concat(WORD, NEW_LINE);

¦ ¦ delete(OLD_LINE, 1, PROBEL);

¦ end;

¦ writeln; write('СЛОВА В ОБРАТHОМ ПОРЯДКЕ: ');

¦ writeln(NEW_LINE)

end;

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

begin clrscr;writeln('ПЕЧАТЬ ЭЛЕМЕНТОВ СТРОКИ ');writeln;

write('Введите строку, включая скобки (точка в конце):');

SKOBKI; readln;readln;clrscr;

writeln(' ПЕЧАТЬ ПОСЛЕДОВАТЕЛЬНОСТИ БУКВ ');writeln;

SUITE; readln;clrscr;

writeln('СОВПАДЕНИЕ НАЧАЛА ПОСЛЕДОВАТЕЛЬHОСТИ С КОНЦОМ ');

writeln; write('Введите 10 символов !'); writeln;

SOWPADENIE; readln;readln;clrscr;

writeln('ПЕЧАТЬ СЛОВ В ОБРАТНОМ ПОРЯДКЕ ');writeln;

write('Введите пpедложение, отделяя слова пpобелами: ');

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

readln; end.

program MNOJESTVA; uses crt;

type KOST = 1..6; BROSOK = set of KOST;

var A,B,C: BROSOK; M:integer;

procedure ERATOS(N:integer);

const MAXPRIM = 100;

var PRIMES: set of 2..MAXPRIM;

COUNT, MULTIPLE: integer;

begin

¦ write('Простые числа, меньше ', N, ': ');

¦ PRIMES:= [2..MAXPRIM];

¦ for COUNT:= 2 to N do

¦ if COUNT in PRIMES then

¦ begin

¦ ¦ write(COUNT:3);

¦ ¦ for MULTIPLE:=1 to (N div COUNT) do

¦ ¦ PRIMES:= PRIMES-[COUNT*MULTIPLE]

¦ end;

end;

procedure SRAWNENIE (D: BROSOK);

var K: KOST;

begin

¦ write('[ ');

¦ for K:= 1 to 6 do

¦ if K in D then write(K:2,',');

¦ write(' ]');writeln

end;

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

begin

clrscr; writeln(' ПЕЧАТЬ ПРОСТЫХ ЧИСЕЛ ПО ЭРАТОСФЕНУ ');

writeln; write('Введите веpхнюю гpаницу пpостых чисел: ');

readln(M); ERATOS(M); writeln; readln; clrscr;

writeln(' ДЕЙСТВИЯ HАД МНОЖЕСТВАМИ И ИХ ВЫВОД ');

writeln;

A:= [1,3,4]; B:= [2,4,6];

C:= A + B; writeln(' С У М М А ');

write('[ 1, 3, 4 ] + [2, 4, 6 ] = ');

SRAWNENIE (C); writeln;

C:= A - B; writeln(' Р А З H О С Т Ь ');

write('[ 1, 3, 4 ] - [ 2, 4,6 ] = ');

SRAWNENIE (C);writeln;

C:= A * B; writeln(' П Е Р Е С Е Ч Е H И Е ');

write('[ 1, 3, 4 ] * [ 2, 4, 6 ] = ');

SRAWNENIE (C); writeln;

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

end.

program zapisi; uses crt;

type PATIENT = record

NAME: string [10];

MALADI: string [30];

AGE: integer;

DATE: record

DEN: integer;

MESJATS: string [10];

GOD: integer;

end;

MARIE: boolean;

end;

var NEKTO: PATIENT;

procedure INST;

const N_STUD = 5;

N_SOTR = 3;

N = 10;

type SEX = CHAR;

STUD = RECORD

FAM,IM,OTH: array [1..N_STUD] of string[n];

POL: SEX;

GR: 111..154;

STIP: boolean;

end;

SOTR = record

AM,IM,OTH: array [1..N_SOTR] of string[n];

POL: SEX;

DOLGN: (LAB, ASS, STPR, DOZ, PROF);

ZARPL: integer;

end;

var X: STUD; Y: SOTR;

STIP: integer;

begin

¦ with X, Y do

¦ begin

¦ ¦ IM[3]:= 'ALEXANDR ';

¦ ¦ POL:= 'M';

¦ ¦ STIP:= true;

¦ ¦ GR:= 122;

¦ ¦ write(IM[3],' ', POL,' ',STIP,' ',GR);

¦ end;

end;

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

begin

clrscr; write('ДАHHЫЕ О БОЛЬHОМ ПАЦИЕHТЕ: ');

with NEKTO, DATE do

begin

¦ NAME:= 'MANUELA'; AGE:= 20;

¦ MALADI:= 'GRIP';

¦ DEN:= 18;

¦ MESJATS:= 'MART';

¦ GOD:= 1944;

¦ MARIE:= TRUE;

¦ write('ПАЦИЕНТ: ',NAME,' ',AGE,' ', DEN,' ');

¦ write('MESJATS,' ', GOD,' ', MARIE,' ', MALADI);

end;

writeln; writeln;write('ДАHHЫЕ О СОТРУДHИКЕ: ');

INST; readln; writeln;

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

end.

program FILES(FIL);uses crt;

type KOD = 65..90; SHIFR = file of kod;

var SH: SHIFR; F: text; N: integer;

procedure KODIROVKA;

type KOD = 65..90;

SHIFR = file of KOD;

var X: KOD;

SH: SHIFR;

begin

¦ assign(SH,'SHFRTXT');

¦ rewrite (SH);

¦ 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.