Структуры и алгоритмы обработки данных

Размещено на http://www.allbest.ru/

Задача 1. Методы сортировки

Задание:

Составить программу, реализующую указанный вид сортировки для массива элементов размерности N (N?50) указанного типа сформированного случайным образом. Отчет должен содержать краткое объяснение алгоритма сортировки, листинг программы и результаты работы программы. Для варианта №10: сортировка массива целых чисел алгоритмом линейная вставка.

Решение:

Объяснение алгоритма сортировки «линейная вставка».

Сортировка линейной вставкой - самый простой алгоритм, реализующий ручную сортировку карт при игре в Бридж. Просматривая массив с одного конца до другого, каждый элемент массива ставится в правильную позицию по отношению к уже отсортированным элементам.

Эта сортировка работает со списком неупорядоченных положительных целых чисел, сортируя их в порядке возрастания.

Описание алгоритма:

Сортируется вектор A длиной N

Нач

Для i от 2 до N Цикл

X:= A[i];

j:= i-1;

Пока (j 1) и (A[j] > X) Цикл

A[j+1]:= A[j];{сдвиг элементов}

j:= j - 1;

КЦикл

A[j+1]:= X;{вставка элемента на свое место}

КЦикл

Кон

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

Покажем работу алгоритма на примере:

27 412 71 81 59 14 273 87

Итерация 0:

Неотсортированный: 412 71 81 59 14 273 87

Отсортированный: 27

Итерация 1:

Неотсортированный: 412 71 81 59 14 273 87

Отсортированный: 27412

Итерация 2:

Неотсортированный: 71 81 59 14 273 87

Отсортированный: 2771 412

Итерация 3:

Неотсортированный: 81 59 14 273 87

Отсортированный: 2771 81 412

Итерация 4:

Неотсортированный: 59 14 273 87

Отсортированный: 2759 71 81 412

Итерация 5:

Неотсортированный: 14 273 87

Отсортированный: 14 27 59 71 81 412

Итерация 6:

Неотсортированный: 273 87

Отсортированный: 14 27 59 71 81 273 412

Итерация 7:

Неотсортированный: 87

Отсортированный: 14 27 59 71 81 87 273 412

Листинг программы

{сортировка массива целых чисел алгоритмом линейная вставка}

Program Sort1;

uses crt, dos;

const

ARRAYSIZE=50; {максимальный размер вектора}

type

arrayType=array [1..ARRAYSIZE] of integer; {тип вектора}

var

a: arrayType; {сортируемый вектор}

n: integer; {количество элементов в векторе}

i,j: integer;

ch: char;

{процедура создания и вывода вектора theArray с размером SIZE}

Procedure Vector (SIZE, MAX: integer; var theArray:arrayType);

begin

randomize;

for i:=1 to SIZE do

theArray[i]:=random(MAX);

Writeln('Исходный массив: ');

for i:=1 to Size do

Write (theArray[i],' ');

end;

{процедура сортировки}

Procedure InsertSort (size: integer; var theArray: arrayType);

var

newPos: integer; {начальная позиция вставляемого на место элемента}

newValue: integer; {значение вставляемого на место элемента}

currentPos: integer; {позиция вставляемого в упорядоченном векторе}

begin

for newPos:=2 to SIZE do

begin

newValue:=theArray [newPos];

currentPos:=newPos-1;

while (currentPos>=1) and (theArray[currentPos]>newValue) do

begin

theArray[currentPos+1]:=theArray[currentPos];

currentPos:=currentPos-1;

end;

theArray[currentPos+1]:=newValue;

end;

end;

{главная программа}

begin

repeat

clrscr;

writeln('Введите желаемое количество элементов (до 50)');

Readln(n);

Vector(n,ARRAYSIZE,a);

InsertSort (n,a);

Writeln;

Writeln ('Отсортированный массив: ');

for i:=1 to n do

write (' ',a[i]);

Readln;

writeln ('Будете еще? (да - y; нет - n)');

ch:=ReadKey;

Until (ch='N') or (ch='n');

end.

Задача 2. Исследование методов сортировки

Задание:

Составить алгоритм и разработать программу, реализующую указанный вид сортировки. Исследовать работу программы на сортировке n целых чисел, если они:

расположены случайным образом;

отсортированы;

отсортированы в обратном порядке;

В результате исследований построить графики зависимости tср (время сортировки) от n (количество элементов) для всех 3-х случаев (случайный массив, отсортированный, отсортирован в обратном порядке). Отчет должен содержать краткое объяснение алгоритма сортировки, листинг программы, графики, построенные в результате работы программы, выводы. Для варианта №10: быстрая сортировка (обменная сортировка с разделением).

Решение:

Объяснение алгоритма быстрой сортировки

Это один из лучших алгоритмов сортировки. Основные особенности этого алгоритма покажем на примере сортировки произвольного вектора А:

Выбирается "центральный" элемент массива А - х. Массив делится на две части этим элементом.

Указатель i устанавливаем в начало левой части. Меняем этот указатель до тех пор, пока элемент Аi меньше центрального элемента х (Аi<х).

Указатель j устанавливаем в конец правой части. Меняем этот указатель до тех пор, пока элемент Аj больше центрального элемента х (Аj<х).

Если левый указатель i меньше правого указателя j, то элементы Аi и Аj меняем местами. Процесс продолжается до тех пор, пока произвольно выбранный вначале "центральный" элемент массива не займет свою позицию в массиве, то есть все элементы стоящие слева от этого элемента будут меньше его, а все элементы, стоящие справа - больше, а также все элементы левой части будут меньше каждого правого элемента.

Если слева от выбранного "центра" более одного элемента, то процедура повторяется для левой части массива.

Если справа от выбранного "центра" более одного элемента, то процедура повторяется для правой части массива.

Листинг программы

{сортировка массива целых чисел алгоритмом быстрая сортировка}

Program Sort2;

uses crt, dos;

const

ARRAYSIZE=5000; {максимальный размер вектора}

type

arrayType=array [1..ARRAYSIZE] of integer; {тип вектора}

var

a: arrayType; {сортируемый вектор}

n: integer; {количество элементов в векторе}

exp: integer;

point: byte;

step: integer;

i,j,k: integer;

c: integer;

f: text;

t: real;

aver_time:array[1..3] of real;

{процедура создания вектора theArray с размером SIZE}

Procedure Vector (SIZE, MAX: integer; var theArray:arrayType);

begin

randomize;

for i:=1 to SIZE do

theArray[i]:=random(MAX);

{Writeln('Исходный массив: ');

for i:=1 to Size do

Write (theArray[i],' ');}

end;

Procedure QSort (SIZE:integer; var theArray:arrayType; var time:real);

var

hour, min, sec, hund: word;

start_time, finish_time: real;

Procedure sort (L,R:integer);

var

B, Tmp: Integer;

begin

i:=L;

j:=R;

B:=theArray[(L+R) div 2];

while i<=j do

begin

while theArray[i]<B do i:=i+1;

while B<theArray[j] do j:=j-1;

if i<=j then

begin

Tmp:=theArray[i];

theArray[i]:=theArray[j];

TheArray[j]:=Tmp;

i:=i+1;

j:=j-1;

nd;

end;

if L<j then sort(L,j);

if i<R then sort(i,R);

end;

begin

GetTime (hour,min,sec,hund);

start_time:=sec+hund*0.01+min*60+hour*3600;

sort(1,Size);

GetTime (hour,min,sec,hund);

finish_time:=sec+hund*0.01+min*60+hour*3600;

time:= finish_time - start_time;

end;

{главная программа}

begin

clrscr;

assign (f, 'd:\Work\Ann\tp71\BIN\Serik');

rewrite (f);

write ('Введите необходимое количество точек для построения графики: ');

Readln(point);

step:=round(ARRAYSIZE/point);

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

Readln (exp);

writeln (f, ' Среднее время сортировки элементов ');

writeln (f, ' кол-во ',' обратно- ',' сортированные');

writeln (f, 'элементов сортированные ');

for k:=1 to point do

begin

n:=step*k;

for i:=1 to 3 do

aver_time[i]:=0.0;

for j:=1 to exp do

begin

Vector (n,ARRAYSIZE,a);

QSort(n,a,t);

aver_time[i]:=aver_time[1]+t;

for i:=1 to n div 2 do

begin

c:=a[i];

a[i]:=a[n-i+1];

a[n-i+1]:=c;

end;

QSort(n,a,t);

aver_time[2]:=aver_time[2]+t;

QSort(n,a,t);

aver_time[3]:=aver_time[3]+t;

end;

for i:=1 to 3 do

aver_time[i]:=aver_time[i]/exp;

write (f,n:7,' ');

for i:=1 to 3 do

write (f, aver_time[i]:7:2,' ');

writeln (f);

end;

close(f);

end.

Задача 3. Циклические списки

Задание:

Описать указанный абстрактный тип данных и основные функции работы с ним на абстрактном уровне. Реализовать процедуры необходимые для вставки, удаления элемента в указанный вид АТД, процедуру печати содержимого АТД, а также дополнительно реализовать процедуру указанную в варианте, на конкретном языке программирования.

Для варианта №10: Однонаправленный циклический список символов. Реализовать процедуру подсчета суммы элементов.

Решение:

Теоретическое введение

Циклически связанный список (сокращенно - циклический список) обладает той особенностью, что связь его последнего узла не равна Л, а идет назад к первому узлу списка. В этом случае можно получить доступ к любому элементу, находящемуся в списке, отправляясь от любой заданной точки; одновременно мы достигаем также полной симметрии, и теперь нам уже не приходится различать в списке "последний" или "первый" узел. Типичная ситуация выглядит следующим образом:

Предположим, в узлах имеется два поля: INFO и LINK. Переменная связи PTR указывает на самый правый узел списка, a LINK (PTR) является адресом самого левого узла.

Размещено на http://www.allbest.ru/

Рис. 1

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

Листинг программы

program list;

uses CRT;

type pt = ^elem;

elem = record

info: byte;

next: pt;

end;

function getprelastel (list:pt):pt;

var nextel:pt;

begin

if (list<>NIL) then (* Если список не пуст *)

begin

nextel:=list;

repeat

list:=nextel; (* Перейти к следующему элементу списка *)

if (list^.next<>NIL) then

nextel:=list^.next;

until (nextel^.next=NIL); (* Пока следующий за данным элемент списка не будет последним *)

getprelastel:=list; (* Вернуть найденный элемент *)

end

else (* Иначе, если список пуст *)

getprelastel:=NIL; (* Вернуть указатель на пустой список *)

end;

function getlastel (list:pt):pt;

begin

if (list<>NIL) then (* Если список не пуст, то: *)

begin

while (list^.next<>NIL) do (*Пока текущий элемент списка не последний*)

list:=list^.next; (*Перейти к следующему элементу *)

getlastel:=list; (* Вернуть найденный элемент *)

end

else (* Иначе *)

getlastel:=NIL; (* Вернуть указатель на пустой список *)

end;

function searchel (list:pt;info:byte):pt;

begin

if (list<>NIL) then (* Если список не пуст *)

begin

while ((list^.next<>NIL) and (list^.info<>info)) do (* Пока текущий элемент не последний и не искомый *)

list:=list^.next; (* Переходить к следующему элементу списка *)

if (list^.info<>info) then (* если искомый элемент не найден *)

searchel:=NIL (*вернуть указатель на пустой список *)

else (* Иначе *)

searchel:=list; (*Вернуть указатель на этот элемент*)

end

else (* Иначе *)

begin

searchel:=NIL; (* Вернуть указатель на пустой список *)

end;

end;

function searchpreel (list:pt;info:byte):pt;

var nextel:pt;

begin

if (list<>NIL) then (* Если список не пуст *)

begin

nextel:=list;

repeat

list:=nextel; (* Переходить к следующему элементу списка *)

if (list^.next<>NIL) then

nextel:=list^.next;

until ((nextel^.next=NIL) or (nextel^.info=info)); (* пока следующий за текущим элемент - не последний или искомый*)

if (nextel^.info<>info) or (nextel=list) then (* Если нужный нам элемент не найден или в списке 1 элемент *)

searchpreel:=NIL (* Вернуть указатель на пустой список *)

else (* Иначе *)

searchpreel:=list; (* Вернуть указатель на найденный элемент *)

end

else (* Иначе, если список пуст *)

begin

searchpreel:=NIL; (* Вернуть указатель на пустой список *)

end;

end;

function getelem(elname:string):byte;

var ret:byte;

begin

write('Введите ',elname,': ');

readln(ret);

getelem:=ret;

end;

procedure addtobegin (var list:pt;info:byte);

var newelem:pt;

begin

new(newelem); (* создать в памяти новый элемент *)

newelem^.info:=info;

newelem^.next:=list; (* Присоединить к этому элементу спиоск *)

list:=newelem; (* Вернуть его, как начало нового списка *)

end;

procedure addafter (listel:pt;info:byte);

var newelem:pt;

begin

if (listel<>NIL) then (* Если список не пуст *)

begin

new(newelem); (* Создать в памяти новый элемент *)

newelem^.info:=info;

newelem^.next:=listel^.next; (*Вставить элемент между заданным элементом и следующим *)

listel^.next:=newelem;

end;

end;

procedure addtoend (var list:pt;info:byte);

begin

if (list=NIL) then(*Если список пуст*)

addtobegin(list,info)(*Добавить элемент в начало, создав новый список *)

else(*Иначе*)

addafter(getlastel(list),info); (*Добавить элемент после последнего *)

end;

procedure addbefore (listel:pt;info:byte);

var newelem:pt;

begin

if (listel<>NIL) then (* Если список не пуст *)

begin

new(newelem); (* Создать в памяти новый элемент *)

newelem^.info:=listel^.info; (*Скопировать в него заданный элемент списка*)

listel^.info:=info; (*Записать в заданный элемент списка после добавленного*)

newelem^.next:=listel^.next; (*Вставить заданный элемент списка после добавленного*)

listel^.next:=newelem;

end;

end;

procedure delfirstel(var list:pt);

var temp:pt;

begin

if (list<>NIL) then (*Если список не пуст*)

begin

temp:=list; (*Сохранит в памяти адрес первого элемента*)

list:=list^.next; (*Отрезать от списка первый элемент*)

dispose(temp); (*Убрать первый элемент из памяти*)

end;

end;

procedure dellastel(var list:pt);

var temp:pt;

begin

if (list<>NIL) then (* Если список не пуст, то *)

if (list^.next=NIL) then (* Если в списке один элемент *)

delfirstel(list) (* Удалить его *)

else (* иначе *)

begin

temp:=getprelastel(list); (* Найти предпоследний элемент списка*)

dispose(temp^.next); (* Удалить следующий за ним *)

temp^.next:=NIL;

end;

end;

procedure delel(var list:pt;el:pt);

var temp:pt;

begin

if ((list<>NIL) and (el<>NIL)) then (* Если дан элемент для удаления и список не пуст *)

begin

if (el^.next=NIL) then (* Если элемент, который нужно удалить - последний в списке *)

if (list^.next=NIL) then (* И если он еще и единственный *)

delfirstel(list) (* Удалит его, то есть первый элемент*)

else (* Иначе, если он не единственный *)

dellastel(list) (*Удалит его, то есть последний элемент*)

else

begin

temp:=el^.next; (* Скопировать в этот элемент следующий за ним *)

el^.info:=temp^.info;

el^.next:=temp^.next;

dispose(temp); (* Удалить следующий за этим элемент *)

end;

end;

end;

procedure delbefore(var list:pt;info:byte);

var temp:pt;

begin

if (list<>NIL) then (* Если список не пуст *)

begin

temp:=searchpreel(list,info); (*Найти элемент, предшествующий искомому *)

delel(list,temp); (* И удалить его *)

end;

end;

procedure delafter(var list:pt;info:byte);

var temp:pt;

begin

if (list<>NIL) then (* Если список, не пуст *)

begin

temp:=searchel(list,info); (* Найти искомый элемент *)

temp:=temp^.next; (* И удалить следующий за ним *)

delel(list,temp)

end;

end;

procedure printlist (list:pt);

begin

clrscr;

if (list=NIL) then (* Если список пуст *)

writeln('Список пуст!') (* Сообщить об этом *)

else

while (list<>NIL) do(* Пока текущий элемент списка не последний *)

begin

write(list^.info); (* Распечатать его *)

list:=list^.next;(* Перецти к следующему элементу *)

if (list<>NIL) then

write(',')

else

write('.');

end;

readkey;

end;

procedure checkel(list:pt;info:byte);

begin

if (searchel(list,info)<>NIL) then

writeln('Элемент ',info,' существует.')

else

writeln('Элемент ',info,' не существует.');

readkey;

end;

{процедура подсчета summi элементов}

Procedure Col (List: pt; var S:byte);

var

L: pt;

begin

S:=0;

L:= List; {указатель на начало списка}

while L<>nil do begin

S:=S+L^.info;

L:=L^.next;

end;

Writeln ('Сумма элементов списка ', S);

ReadKey;

end;

procedure showmenu;

begin

clrscr;

Writeln('1) Добавить элемент в начало списка');

Writeln('2) Добавить элемент в конец списка');

Writeln('3) Распечатать список');

Writeln('4) Удалить первый элемент из списка');

Writeln('5) Удалить последний элемент из списка');

Writeln('6) Найти, существует ли указанный элемент в списке');

Writeln('7) Удалить указанный элемент из списка');

Writeln('8) Добавить элемент после указанного');

Writeln('9) Добавить элемент перед указанного');

Writeln('10) Удалить после указанного');

Writeln('11) Удалить перед указанным');

Writeln('12 Сумма элементов списка');

Writeln('13) Выход из программы');

Writeln;

Write(' Ваш выбор:');

end;

var root: pt;

selection: byte;

Sum:byte;

begin

root:=NIL;(* Создать пустой список *)

repeat

showmenu;(* Показать меню *)

readln(selection);(* Ввести с клавиатуры пункт меню *)

writeln;

case selection of(* выполнить действие, затребованное пользователем *)

1: addtobegin(root,getelem('значение элемента'));

2: addtoend(root,getelem('значение элемента'));

3: printlist(root);

4: delfirstel(root);

5: dellastel(root);

6: checkel(root,getelem('значение искомого элемента'));

7: вудуд(кщщебыуфксруд(кщщебпуеудуь(эзначение элемента для удалениия э)));

8: addafter (searchel(root,getelem ('значение искомого элемента')), getelem ('значение элемента для добавления '));

9: addbefore (searchel(root,getelem('значение искомого элемента')), getelem ('значение элемента для добавления '));

10: delafter(root,getelem('значение искомого элемента'));

11: delbefore(root,getelem('значение искомого элемента'));

12: begin

col(root,Sum);

Writeln ('Сумма элементов списка', Sum);

end;

13: clrscr;

end;

until selection=13;(* Если пользователь выбрал не выход *)

end.

Задача 4. Деревья

сортировка алгоритм список дерево

Задание:

Описать абстрактный тип данных «дерево» и основные функции работы с ним на абстрактном уровне. Реализовать процедуры необходимые для создания дерева и печати содержимого дерева согласно варианта на конкретном языке программирования. Представить арифметическое выражение, указанное в варианте в виде дерева и вывести его на экран в виде согласно варианту. Для варианта №9: Прямое представление дерева. Арифметическое выражение представить в виде префиксной записи.

c/4 - d

X=

a*a - 1

Решение:

Теоретическое введение

Дерево - это граф, который характеризуется следующими свойствами:

1. Существует единственный элемент (узел или вершина), на который не ссылается никакой другой элемент - и который называется КОРНЕМ.

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

3. На каждый элемент, кроме корня, имеется единственная ссылка, т.е. каждый элемент адресуется единственным указателем.

Наше выражение: X = (c/4 - d)/(a*a - 1) представляется в виде следующего графа на рис. 2:

Размещено на http://www.allbest.ru/

Рис. 2 - Выражение, представленное в виде дерева

Существует несколько способов представления абстрактной древовидной структуры. Мы рассмотрим следующие способы представления:

1. С помощью средств динамического размещения компонент и указания их с помощью ссылок. Следовательно, дерево на рис.1 состоит из компонент такого типа:

Type node = record

op: char;

left, right:^node;

end;

2. С помощью массива:

T: array [1..11] of

record

op:char;

left, right: integer;

end;

Существует три способа обхода деревьев:

1. Сверху вниз: R, A, B;

2. Слева направо: A, R, B;

3. Снизу вверх: A, B, R.

Преобразование дерева в бинарное (двоичное) дерево

Любое m-арное дерево можно хранить в виде двоичного дерева. Алгоритм преобразования m-арного дерева в двоичное состоит в следующем:

1. Первый потомок вершины размещается по вертикали вниз, а его братья - по горизонтали. Эту операцию повторяют для каждой отдельно взятой вершины.

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

Рассмотрим предложенный алгоритм на примере:

При последовательном размещении дерева один из указателей отсутствует. При фамильном размещении отсутствует правый указатель. При этом братья, если они есть, всегда находятся рядом. Вместо правого указателя введем логический признак: равный true, если у вершины есть правое поддерево и false - нет. Для хранения дерева можно воспользоваться массивом.

Листинг программы

{$M 65500, 0, 100000}

Program MathExpr; {программа вычисляет математическое выражение, строит дерево }

Uses crt;

type tr=^rec;

rec=record

pole:string; {Информационное поле}

sym: boolean; {Флаг символа}

zn:real; {Значение переменной}

rend: boolean; {Вспомогательный флаг}

l,r:tr; {Указатели на потомка}

end;

Var root,el: tr; {вершина и узлы дерева}

st: string; {вспомогательная переменная}

i,j:byte; {}

x,y:integer; {координаты для вывода дерева}

g:byte; {вспомогательная переменная}

yn: char; {}

code: integer; {для процедуры VAL}

{процедура преобразования арифметического выражения в бинарное дерево}

{процедура использует рекурсивный нисходящий обход}

Procedure Tree (p:tr);

Procedure undertree (c:char); {создает поддеревья}

Procedure Skob; {учитывает скобки}

begin i:=i+1;

repeat

if p^.pole[i]='(' then Skob;

i:=i+1;

until p^.pole[i]=')';

end; {Skob}

begin

for i:=1 to length(p^.pole) do

begin

if p^.pole[i]='(' then

begin

g:=i;

Skob;

if (p^.pole[i+1]<>'+') and (p^.pole[i+1]<>'-')

and (p^.pole[i+1]<>'*') and (p^.pole[i+1]<>'/')

and (p^.pole[g-1]<>'*') and (p^.pole[g-1]<>'/')

and (p^.pole[g-1]<>'-') and (p^.pole[g-1]<>'+')

and (p^.pole[i+1]<>'^') and (p^.pole[g-1]<>'^')

then

begin

delete (p^.pole,i,1);

delete (p^.pole,1,1);

i:=0;

end;

end;

if p^.pole[i]=c then

begin

New(p^.l);

p^.l^.l:=nil;

p^.l^.r:=nil;

p^.l^.pole:=copy(p^.pole,1,i-1);

p^.l^.zn:=0;

p^.l^.sym:=false;

new(p^.r);

p^.r^.l:=nil;

p^.r^.r:=nil;

p^.r^.pole:=copy(p^.pole, i+1, ord(p^.pole[0]));

p^.r^.zn:=0;

p^.r^.sym:=false;

i:=ord(p^.pole[0]);

p^.pole:=c;

end;

end;

end; {UnderTree}

begin

if p<>nil then

{Строятся поддеревья в зависимости от приоритета арифметической операции}

begin

UnderTree('+');

UnderTree('-');

UnderTree('*');

UnderTree('/');

UnderTree('^');

Tree(p^.l);

Tree(p^.r);

end;

end; {Tree}

{Вычисление значения арифметической функции}

{процедура использует рекурсивный нисходящий обход}

Procedure Calc(p:tr);

begin

if p<>nil then begin

if p^.l^.sym and p^.r^.sym then

begin

case p^.pole[1] of

'+': begin

p^.zn:=p^.l^.zn+p^.r^.zn;

p^.sym:=true;

end;

'-': begin

p^.zn:=p^.l^.zn-p^.r^.zn;

p^.sym:=true;

end;

'*': begin

p^.zn:=p^.l^.zn*p^.r^.zn;

p^.sym:=true;

end;

'/': begin

p^.zn:=p^.l^.zn/p^.r^.zn;

p^.sym:=true;

end;

'^': begin

p^.zn:=EXP(p^.r^.zn*LN(p^.l^.zn));

p^.sym:=true;

end;

end; {case}

end;

Calc(p^.l);

Calc(p^.r);

end;

end;{calc}

{процедура определяет где в дереве переменная или значение, и где

знак операции. Используется рекурсивный нисходящий обход}

Procedure Symb(p:tr);

begin

if p<>nil then

begin

if p^.pole[1] in ['a'..'z'] then

begin

p^.sym:=true;

Write(p^.pole,'= ');

Readln(p^.zn);

end;

if p^.pole[1] in ['0'..'9'] then

begin

p^.sym:=true;

Val(p^.pole,p^.zn,code);

end;

Symb(p^.l);

Symb(p^.r);

end;

end; {Symb}

{процедура выводит на экран, полученное дерево }

{процедура использует рекурсивный нисходящий обход}

Procedure OutTree (pr:tr; f:byte);

begin

y:=y+2;

if pr<>nil then

begin

if f=1 then

begin

x:=x-5;

end;

if f=2 then

begin

x:=x+9;

end;

GotoXY (X,Y);

{Если f=0 то выводится корневая вершина}

if f=0 then writeln ('[',pr^.pole,']');

{Если f=1 то выводится левое поддерево}

if f=1 then writeln ('[',pr^.pole,']/');

{Если f=2 то выводится правое поддерево}

if f=2 then writeln ('\[',pr^.pole,']/');

OutTree(pr^.l,1);

OutTree(pr^.r,2);

end;

y:=y-2;

end; {OutTree}

begin{главная прога}

repeat

Window(1,1,80,25);

x:=22;

y:=0;

TextColor(Blue);

Clrscr;

{Ввод выражения, которое нужно посчитать}

Writeln ('Введите ваше выражение: ');

GotoXY(40,4);

Write('Используйте следующие опреации: ');

GotoXY(50,5);

Write('+, -, *, /, ^ ');

GotoXY(40,7);

Write('Программа применяет деревья для ');

GotoXY(40,8);

Write('вычисления математического выражения: ');

GotoXY(1,2);

Readln(st);

{root - концевая вершина/ ее создание}

New(el);

el^.l:=nil;

el^.r:=nil;

el^.pole:=st;

el^.zn:=0;

el^.sym:=false;

el^.rend:=false;

root:=el;

{end of root}

Tree(root); {Создается дерево}

{Ввод значений переменных}

Writeln('Введите значения: ');

Symb(root);

Window(30,1,80,25);

TextBackGround(Blue);

TextColor(White);

Clrscr;

Writeln('Дерево выглядет так: ');

OutTree (root,0);

repeat

if root^.l^.sym and root^.r^.sym

then

begin

Calc(root);

root^.rend:=true;

end

else calc(root);

until root^.rend;

Window (1,23,29,25);

TextBackGround(Red);

TextColor(Green);

ClrScr;

Writeln ('Результат = ', root^.zn:2:3); {вывод результата}

Write ('Еще? (y/n)');

Readln(yn);

until yn='n';

end.

Размещено на Allbest.ru