бесплатные рефераты

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

Если поставить вопрос о вставке нового элемента перед указанным, то, казалось бы, ситуация выглядит проще. Но это на самом деле не так. Ведь при вставке элемента перед указанным также следует держать ссылку на предыдущее звено. Поэтому задача имеет тот же вариант, что и раньше:

предыдущее звено;

новое звено;

фиксированное звено;

Кроме того, необходимо знать, с какого из полей (левого или правого) вставляемого элемента надо делать ссылку на оставшуюся часть дерева, а какое поле оставить незаполненным, т.е. сделать его терминальным (листом).

Чтобы избежать этой неопределенности, условились делать процедуру вставки по следующему алгоритму:

1) вставлять новый элемент S2 между S и S1;

2) если S ссылается на S1 левым полем, то вставляемый элемент S2 будет также ссылаться на S1 левым полем;

3) если S ссылается на S1 правым полем, то и вставляемый элемент должен ссылаться на S1 правым полем.

а). Левое

б). Правое

S

S

S2

S2

nil

nil

S1

S1

Отсюда следует процедура вставки (нерекурсивная):

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.

ЗАМЕЧАНИЕ. В отличие от процедуры POISK здесь нет на входе явного указания на корень дерева. Однако при указании двух соседних вершин в ссылках на них фигурирует ссылка на корень дерева. Например, для вставки в дерево DER некоего элемента EL между вторым и третьим элементами левого поддерева необходимо выполнить следующие операторы:

new(Z); write ('Введите вставляемый элемент: ');

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

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

На практике ссылка S чаще всего есть результат работы процедуры поиска, т.е. получена путем применения POISK(DER,ZNACH,S). Тогда для вставки элемента Z в левое поддерево вершины S в качестве S1 надо взять S^.left, в противном случае - положить S1=S^.right.

Удаление звена из дерева осуществляется по разным правилам и зависит от характеристики дерева и предметной области его вершин. Здесь возможны различные варианты.

Если вершина Si является терминальной (листом) или из нее выходит только одна ветвь, то удаление реализуется довольно просто - для этого надо скорректировать соответствующую ссылку у вершины предшественника:

а).

б).

Si-1

Si-1

Si

Si

Si-1

NIL

Si-1

Si+1

Si-1

NIL

Некоторые деревья по своей семантике допускают удаление вершины вместе с выходящими из нее поддеревьями. В этом случае ссылке вершины - предшественницы присваивается значение NIL.

Однако для большинства деревьев удаление одной из вершин не должно приводить к потере остальных. Чтобы избежать этого, надо найти в дереве звено, которое можно вставить на место удаленного, причем подходящее звено должно быть листом. Такое звено всегда существует - это либо самый правый элемент левого поддерева, либо самый левый элемент правого.

Для первого случая надо перейти в следующее звено по левой ветви, а потом все время идти по правой, пока не найдется NIL.

Для второго - надо перейти в следующее звено по правой ветви, а потом идти все время по левой до NIL.

ПРИМЕР. Пусть требуется удалить в дереве вершину 50.

Для решения этой задачи переходим в правое поддерево на вершину 55 и затем идем все время по левым ветвям к вершине 33, которую ставим на место 50.

Заметим, что такой способ удаления звена с замещением его на другое не нарушает упорядоченности (в смысле отношения порядка в множестве целых чисел). Особенно это важно для дерева поиска, в котором и будет рассмотрена процедура удаления звена.

100 | 100

/ \ | / \

20 120 | 20 120

/ \ \ | / \ \

15 50 130 | 15 33 130

/ \ | / \

30 55 | 30 55

/ / \ | / / \

28 35 60 | 28 35 60

/ \ |

33 50 |

Вид дерева |

ДО удаления | Вид дерева ПОСЛЕ удаления 50

15.4 Дерево поиска

До сих пор мы рассматривали построение идеально сбалансированных деревьев с произвольным расположением элементов в вершинах. Напомним, что идеально сбалансированным называется дерево, у которого разница между числом вершин в левом и правом поддеревьях не более 1:

a) A б) A

/ \ / \

B C C B

/ / \

D D E

Сбалансированное Несбалансированное

Организация ИДЕАЛЬНО СБАЛАНСИРОВАННЫХ деревьев не всегда оправдана, т.к. деревья часто строят для поиска того или иного элемента в структуре данных. В дереве общего вида для поиска одного элемента иногда приходится перебрать и все другие, если этот элемент является листом. Такой путь нерационален, т.к. теряется сама идея построения дерева. Лучше создать линейный список в виде стека, дека или очереди. Вот почему для упрощения поиска при организации дерева его строят в виде ДЕРЕВА ПОИСКА, т.к. число переборов для нахождения нужного элемента здесь значительно меньше.

Принцип построения такого дерева состоит в следующем: новый элемент добавляется в левое поддерево, если его значение меньше данного, и в правое, если оно больше данного; элемент не входит в дерево, если он равен данному элементу.

Например, пусть заданы элементы: 10,5,7,12,15,3,7,9. Расположить их в виде дерева поиска с корнем 10.

10

/ \

5 12

/ \ \

3 7 15

\

9

Можно заметить, что в дереве поиска, как и в упорядоченном дереве общего вида, самая левая ветвь состоит из убывающих вершин, а самая правая - из возрастающих.

Рассмотрим теперь процедуру формирования дерева поиска с учетом принципа его построения:

procedure TREEPOISK(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 TREEPOISK(S^.left,ZNACH)

¦ else

¦ if ZNACH > S^.k then TREEPOISK(S^.right,ZNACH)

¦ else S^.n:= S^.n + 1;

end.

ЗАМЕЧАНИЕ. Из этой процедуры видно, что звено дерева поиска уже состоит из четырех полей: К, LEFT, RIGHT и N. Целочисленное поле N добавлено для того, чтобы увеличивать его значение при появлении в дереве нескольких одинаковых элементов. Поле S^.n позволяет узнать для каждой вершины число породивших ее элементов (кратность вершины). Дело в том, что в отличие от сбалансированного дерева, в дерево поиска элемент входит только один раз. Например, если подавать на вход процедуры TREEPOISK элементы 7,5,3,2,8,4,3,1,7,9, то сформируется дерево из вершин 7,5,3,2,8,4,1,9, а в 4-м поле звена 7 (в нашем случае корень дерева) будет находиться 2.

Заметим также, что указанная процедура построения дерева поиска добавляет лишь один элемент к дереву. Для организации же всего дерева (от корня до его листьев) надо предусмотреть программу, в которой идет обращение к этой процедуре. Основная часть этой программы может выглядеть так:

var DER: SS; EL: integer;

begin write('Введите элемент: '); readln(EL);

¦ DER:=nil;

¦ while EL <> 0 do begin TREEPOISK(DER, EL);

¦ readln(EL); end;

end.

15.5 Операции над деревом поиска

В дереве поиска возможны те же операции, что и в дереве общего вида (поиск, вставка, удаление). Однако здесь уже поиск осуществляется быстрее (проходит по одному маршруту), процедура печати дерева совпадает с процедурой его построения.

Вставка нового элемента осуществляется по тому же принципу, что и построение. Эта процедура напоминает поиск, т.к. для вставки нового элемента необходимо пройти по нужному маршруту.

Например, пусть в дерево надо вставить элемент 4:

10

/ \

5 12

/ \ / \

3 7 11 15

1) т.к. 4 < 10, то нужно идти в левое поддерево(т.е. на 5);

2) т.к. 4 < 5, следует спуститься ниже 5;

3) т.к. 4 > 3, необходимо вставить этот элемент в правое поддерево.

СХЕМА ВСТАВКИ

10

/ \

5 12

/ \ / \

3 7 11 15

\

4

Итак, для вставки в дерево DER элемента 4 надо записать оператор TREEPOISK(DER,4).

Заметим еще раз, что рассмотренная выше процедура TREEPOISK, используемая для формирования дерева, может быть применена и для поиска в нем данного элемента. Действительно, если на вход этой процедуры подать элемент, не содержащийся в дереве, то он будет добавлен к этому дереву. Если же элемент S входит в дерево, то его нового добавления не произойдет, а по значению поля S^.n можно узнать о вхождении данного элемента в дерево (S^.n > 1).

Например, для поиска некоторого элемента EL в дереве DER необходимо выполнить TREEPOISK(DER, EL), добавив в процедуре TREEPOISK оператор WRITELN(DER^.N), который следует поставить в начало ее тела (после слова BEGIN). Наличие в этом списке числа 2 говорит о вхождении элемента EL в дерево, причем можно даже узнать его порядковый номер.

Рассмотренные выше процедуры поиска и вставки элементов в дерево часто используются совместно. Например, с помощью этих процедур можно решать следующие комплексные задачи:

1) поместить данный элемент (не принадлежащий дереву) после указанного элемента дерева;

2) вставить определенный элемент дерева после некоторого элемента того же дерева (переместить элемент).

Следует отметить, что эти операции в дереве поиска надо проводить осторожно, чтобы не нарушить его упорядоченность.

Решение второй задачи может быть реализовано с помощью следующей программы:

program POISK_I_VSTAVKA;

label 1,2,3;

type SS = ^ZVENO;

ZVENO = record

k,n: integer;

left, right: SS;

end;

var DER1,Z,X,T:ss; I,J:integer;

Y:real; O:char;

begin

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

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

PRINTTREE(DER1,3,Y); writeln;

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

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

POISK(DER1,I,X);

if X^.k <> I then begin

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

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

POISK(DER1,J,Z); if Z^.k <> J then begin

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

readln;goto 3 end; clrscr;

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

PRINTTREE(DER1,3,Y);

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

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

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

PRINTTREE(DER1,3,Y); writeln;

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

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

end.

Дерево поиска есть упорядоченное дерево, поэтому для удаления его некоторого элемента необходимо применить принцип удаления, рассмотренный в 15.3.3.

Напомним, что согласно этому принципу, при удалении элемента из дерева на его место ставится любой крайний правый элемент левого поддерева, следующий за удаленным, или любой крайний левый элемент правого поддерева.

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;

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

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

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

ЛИТЕРАТУРА

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

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

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

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

Хершель Р. Турбо Паскаль.- Вологда: МП "МИК", 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);

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


© 2010 РЕФЕРАТЫ