¦ 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;
¦ ¦ Z^.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.
Рассмотренная выше процедура позволяет удалить элемент дерева, для которого известны ссылки на него самого и на предшествующий ему элемент. Однако часто приходится удалять элемент дерева по его значению, а не по ссылке. В этом случае сначала необходимо с помощью процедуры POISK найти ссылку на данный элемент (если он есть в дереве), ссылку на предшествующий ему элемент, а затем по двум ссылкам удалить указанный элемент с помощью процедуры UDALEN.
Все это показано в следующей программе:
program POISK_I_UDALENIE;
label 1,2,3;
type SS = ^ZVENO;
ZVENO = record
k,n: integer;
left, right: SS; end;
var DER,Z,X,T:ss; I,J:integer;
Y:real; O:char;
begin
1:clrscr; gotoxy(20,2); write('ПОИСКИУДАЛЕНИЕ');
writeln(' ДЕРЕВОПОИСКА '); PRINTTREE(DER,3,Y);
writeln(' УДАЛЕНИЕ УКАЗАННОГО ЭЛЕМЕНТА ');
2:writeln;write('Укажите элемент для удаления: '); readln(I);
POISK(DER,I,X); if X^.k <> I then begin
{ X - ссылка на вершину I }
write('Такого элемента нет в деpеве ! '); readln;goto 2 end;
if X^.k = DER^.k then begin
writeln('ВHИМАHИЕ ! Это - коpеньдеpева !'); goto 2 end;
3:write('Укажите элемент, перед которым идет удаление:');
readln(J); POISK(DER,J,Z);
{ Z - ссылка на вершину J}
if Z^.k <> J then begin
write('Такого элемента нет в деpеве ! '); goto 3 end;
if (Z^.left^.k <> I) and (Z^.right^.k <> I) then
begin write('Такой паpы элементов нет в деpеве ! ');
goto 3 end; clrscr;
gotoxy(41,3); write(' ДЕРЕВОдоудаления '); writeln;
PRINTTREE(der,43,y); UDALEN(Z,X);
gotoxy(3,3);write(' ДЕРЕВО после удаления ');writeln;
PRINTTREE(der,3,y); writeln;
writeln('Удален элемент',i:3,' после элемента ',j:3);writeln;
write('Еще ?(y/n): '); readln(o); if O='y' then goto 1;
end.
Как мы уже отмечали выше, все динамические структуры, образующиеся в памяти ЭВМ, могут рассматриваться в ОЗУ, отведенной для программы пользователя, как "КУЧА". Пользователь может работать с этой "кучей" с помощью специальных процедур. Среди них самыми важными являются запоминание состояния "кучи" и последующее воспроизведение ее. Это делается с помощью процедур 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