Программное обеспечение КС

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

Национальный Технический Университет Украины «КПИ»

ФАКУЛЬТЕТ ИНФОРМАТИКИ И ВЫЧИСЛИТЕЛЬНОЙ ТЕХНИКИ

Курсовой проект

«Программное обеспечение КС»

Выполнила: студентка ФИВТ

VІ-курса гр. ЗИВ-01

Ангелейко Н.И.

Проверила: Русанова О.В.

Киев 2005

Техническое задание

Разработать программу автоматического преобразования (трансляции) арифметического выражения (АВ) в параллельную форму для оптимальной (критерий оптимизации - минимальное время выполнения) его реализации в ВС заданной архитектуры.

1. Произвести синтаксический анализ выражения на предмет его корректности.

2. Построить дерево параллельной формы.

3. Построить множество эквивалентных деревьев параллельной формы с учетом правил раскрытия скобок и правил вынесения за скобки.

4. Выполнить моделирование параллельного выполнения задачи по заданным алгоритмам формирования очереди. По заданию, очередь готовых вычислительных работ формируется при помощи трех алгоритмов:

4.1. Алгоритм формирования очереди в порядке убывания критического по времени путей до конца графа задачи

4.2. Алгоритм формирования очереди в порядке возрастания критического пути по количеству вершин путей от начала графа, а при равных значениях в порядке убывания времени исполнения

4.3. Алгоритм формирования очереди в порядке возрастания критического пути по количеству вершин путей от начала графа задач

4.4. Алгоритм формирования очереди случайным образом

5. Погрузить задачу на вычислительную систему, с учетом алгоритмов формирования очередей вычислительных работ

6. Отобразить состояния ВС потактово.

Исходные данные:

арифметическое выражение в скобочной записи;

конвейерная система со статической перестройкой такта;

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

Конвейерные системы - универсальный многофункциональный процессор. Состоят из одного или множества многофункциональных конвейерных процессоров. Эти системы относятся к классу синхронных. Конвейерные системы можно разделить на следующие классы:

Конвейер - с постоянным тактом.

Конвейер - со статической перестройкой такта.

Конвейер - с динамической перестройкой такта.

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

Модель конвейера

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

Каждая операция может находиться в четырех состояниях:

Вне рассмотрения (еще не готова к выполнению)

Ожидание (находится в очереди для выборки)

Выполнение (находится в конвейере)

Закончена (снята с конвейера)

Признаком окончания вычислений является пребывание корневой операции графа в состоянии "закончена".

2. Организация ввода вычислительного алгоритма и его анализ на корректность

2.1 Ввод нового алгоритма

Ввод выражения осуществляется путем нажатия соответствующих кнопок в окне программы с клавиатуры.

Информация о вычислительном алгоритме первично представляется в виде строки символов, в которой привычным образом описывается последовательность выполняемых операций. В числе разрешенных операций "+", "-", "*" и "/". В качестве аргументов могут выступать десятичные целые и дробные константы или переменные. Правила их написания соответствуют общепринятым. Выражение может содержать скобки.

2.2 Синтаксический и лексический анализ

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

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

3. Отображение арифметического выражения в параллельный граф алгоритма

3.1 Формирование вершин дерева

В основу формирования каждого узла дерева положен следующий принцип. Операция (вершина дерева) считается распознанной, если в списке подряд следуют лексемы: "Аргумент", "Оператор", "Аргумент". Причем в качестве лексемы "Аргумент" могут выступать "Константа", "Переменная" или "Операция", но не "Выражение в скобках". Это гарантирует, что в узел войдут только аргументы текущего уровня или уже объединенные в вершину. После распознания тройка лексем заменяется на одну ("Операция") и распознавание продолжается со следующего элемента списка. При достижении конца списка алгоритм повторяется. При нахождении лексемы "Выражение в скобках" осуществляется построение дерева для этого выражения. Признак завершения - наличие единственной лексемы "Операция", заключенной в скобки. процессор программа автоматический

3.2 Преобразование дерева выражения в очередь заявок для выполнения в конвейере

Преобразование дерева происходит следующим образом:

Производится поиск вершины, потомки которой являются "листьями дерева", т.е. не имеют потомков.

Формируется заявка состоящая из двух операндов ("листьев дерева") и операции, и указывается номер вершины, выполнение которой зависит от данной. Найденная вершина на первом шаге заменяется на вершину не имеющую потомков и состоящей из результата выполнение операции. Первый шаг повторяется до тех пор, пока в дереве останется одна вершина.

4. Применение правил раскрытия скобок и правил вынесения за скобки при вычислении арифметических выражений

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

4.1 Раскрытие скобок

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

Реализация этого метода осуществляется следующим образом:

1. Пусть мы имеем исходное выражение

(a+b)-x*(d-e)+q

2. На следующем шаге исходное выражение разбиваем на «лексемы», т.о. мы получаем следующий набор лексем:

1	2	3
(a+b)	x*(d-e)	q

3. Затем, начинаем просмотр всех подвыражений на предмет нахождения скобок.

4. Далее, анализируем наличие знаков (*,/) относительно скобок.

5. Если знаков (*,/) относительно скобок нет, то скобки отбрасываются и выражение переписывается без скобок. Если есть наличие знаков (*,/) перед скобками или за скобками, то тогда содержимое в скобках умножается(делится) на переменную(константу) стоящую перед(после) знака (*,/).

6. Избавление от скобок производится поэтапно:

1- (a+b)-x*(d-e)+q

2- a+b-x*(d-e)+q

3- a+b-x*d+x*e+q

4.2 Вынесение за скобки

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

1. Разбивается исходное выражение на отдельные подвыражения («лексемы») относительно знаков « + » и « - ». Таким образом, получаем список выражений, в которых будем отыскивать общие члены.

2. Определяем список всех простейших переменных и числовых констант выражения в целом.

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

4. Затем мы циклически сдвигаем эти значения в списке и начинаем 3 шаг заново. Выполняем до тех пор, пока не получим исходный список значений.

5. Описание алгоритмов формирования очередей вычислительных работ

5.1 Алгоритм формирования очереди в порядке убывания критического по времени путей до конца графа задачи

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

a * (b +c ) - d / (e - f)

время выполнения операции +, - 1 такт

время выполнения операции *, / 2 такта

Алгоритм:

Создаем двумерный массив, с числом ячеек равным количеству вершин. Заполняем его номерами вершин, ячейки зарезервированные для времени критического пути оставляем пустыми.

Используя алгоритм Дейкстра из каждой вершины проходим до конца графа, записывая для каждой ячейки критический путь.

Простейшей сортировкой сортируем их по убыванию критического пути.

Выводим результат.

5.2 Алгоритм формирования очереди в порядке возрастания критического пути по количеству вершин путей от начала графа, а при равных значениях в порядке убывания времени исполнения

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

Возьмем пример, рассмотренный в п.5.1 рис.2.

1. Для каждой из вершин графа расчитываем N_kpi (критический путь і- тых вершин от начала графа по их количеству)

N_kpi1 = 1

N_kpi1 = 1

N_kpi1 = 2

N_kpi1 = 2

N_kpi1 = 3

2. Формируем очередь в порядке возрастания по N_kpi .

3. При равных значениях N_kpi, рассматриваем веса этих вершин, и ставим их по убыванию. 1(1), 2(1), 3(2), 4(2), 5(3)

Алгоритм:

1. Устанавливаем свойство N_kpi всех вершин в 0;

2. Находим вершины, из которых нет входящих связей, N_kpi этих вершин устанавливается равным 1;

3. Находим все вершины, для которых N_kpi всех вершин с которыми они связаны входящими связями не равно 0. N_kpi данных вершин присваиваем максимальное значение из N_kpi наследников + 1

4. Пункт 3 повторяется до тех пор, пока N_kpi для всех вершин не будет рассчитано.

5.3 Алгоритм формирования очереди в порядке возрстания критического пути по количеству вершин путей от начала графа задач

Для каждой из вершин графа расчитываем N_kpi (критический путь і- тых вершин от начала графа по их количеству). Затем, формируем очередь в порядке возрастания по N_kpi. 1(1), 2(1), 3(2), 4(2), 5(3)

5.4 Алгоритм формирования очереди случайным образом

1. Очередь формируется случайным образом.

2. Выбирается заявка из очереди.

3. Анализируется приоритет и Текущая операция в конвейере.

4. Если приоритет =0 и текущая операция совпадает с операцией заявки или конвейер пуст. Заявка поступает в конвейер. Если нет п.5.

5. Такт конвейера увеличивается на 1, если операция +,- нижний слой передает результат в верхний, если *,/ остается на 1 такт в своем слое.

6. После выхода заявки из конвейера, у заявки потомка (выполнение зависит от результата родителя). Приоритет уменьшается на 1. п.2.

6. Алгоритм погружения на вычислительную систему

Для реализации алгоритма погружения в качестве исходных данных используется дерево параллельной реализации задачи и очередь, сформированная одним из четырех алгоритмов;

Моделирование конвейера

Моделирование конвейера. Приняты следующие допущения. Количество слоев в конвейере 4. Время выполнения операции +,- 1 такт, время выполнения операции *,/ 2 такта. Значение приоритета может быть 0 ( заявка не зависит от результатов выполнения каких либо заявок), 1 (заявка зависит от выполнения одной заявки ), и 2 ( заявка зависит от выполнения двух заявок)

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

Результаты работы программы

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

Результаты работы модуля программы по построению параллельного графа введенного выражения и исследования эффективности применения правил раскрытия скобок и вынесения за скобки

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

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

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

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

Список литературы

1. Русанова О.В. Программное обеспечение компьютерных систем.- К.: «Корнійчук», 2003.-94 с.

2. Системы параллельной обработки /Под ред.Д.Ивенса.-М:Мир, 1985 - 413 с.

3. Корнеев В.В. Параллельные вычислительные системы.-М.: «Нолидж», 1999.-320 с.

4. Э.А.Трахтенгерц Программное обеспечение параллельных процессов.М.:Наука, 1987.-272 с.

Приложение

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

unit Prg_my;

interface

uses

Windows, SysUtils,Dialogs,ComCtrls;

type

Pinfo =^info;

serch = record

maxy : integer;

iNumer :word;

end;

info =record

sp1,sp2:string;

sgn:char;

Md:string;

end;

inf2 =record

S1:string;

Prior :word;

MyNum :word;

MyPar :word;

sgn :char;

end;

Ary=array of info;

Ar2=array of inf2;

procedure ClSk (lkS :string; var glS :string);

procedure OpSk (ST0: string;V : byte;var ST1 :string);

procedure Comt(i_St:string;var o_ST :string);

procedure Check_STR(var Str: string;var Fl:boolean);

procedure FormArr(var st:string;var Mas_Rec:Ary){ BuildTree(var st:string;var Mas_Rec:Ary)};

function Extr(St: string;var i:word):string;

function SupExtr(St: string;var i:word):string;

procedure F_MulArr(var st:string;var Mar:Ary;var sSt:string);

function Half(i:byte):byte;

procedure SubZero(var SPT: string;const c:byte);

procedure Sgnl(var S : string);

function Cl(S0:string):word;

procedure Comt2(inST:string;var outST :string);

procedure SortArr(var B: ar2);

implementation

Uses Tree,classes;

procedure SortArr(var B: ar2);

var i,j: word;

tmp :inf2;

begin

for i:=low(B) to High(B)-1 do

for j:=i+1 to High(B) do

if B[j].Prior<=b[i].Prior then

begin

tmp:=B[i];

B[i]:=B[j];

B[j]:=tmp;

end;

end;

function SupExtr(St: string;var i:word):string;

var tm_I:string;

begin

tm_I:=extr(ST,i);

while (ST[i]='/')or(ST[i]='*') do begin

tm_I:=tm_I+Extr(ST,i);

end;

Result:=tm_I;

finalize(tm_I);

end;

procedure Comt2(inST:string;var outST :string);

var i,j :word;

tm_I:String;

begin

i:=1;

j:=i;

tm_I:=Supextr(inST,j);

if tm_I[1]<>'-' then begin

tm_I:='+'+tm_I;

if inST[j]='-' then inST:='-'+inST;

end;

if (tm_I[1]='-')and(inST[j]='+') then delete(inST,1,1);

delete(inST,i,length(tm_I));

insert(tm_I,inST,length(inST)+1);

outST:=inST;

end;

procedure Comt(i_St:string;var o_ST :string);

var i,j : word;

tmpS1,tmpS2 : string;

sgn: char;

begin

i:=1;

while i<=length(i_ST) do begin

j:=i;

tmpS1:=Supextr(i_ST,j);

if (i=1)and(tmpS1[i]<>'-') then tmpS1:='+'+tmpS1;

if j>= length(i_ST) then begin o_ST:=i_ST;exit;end;

tmpS2:=SupExtr(i_ST,j);

if (i=1)and(tmpS2[1]<>'-') then begin delete(tmpS2,1,1);end;

if (i=1)and(tmpS2[1]='-')and(tmpS1[1]='+') then begin i_ST:='!'+i_ST;inc(j);end;

if (i=1)and(tmpS2[1]<>'-')and(tmpS1[1]='-') then begin delete(i_ST,1,1);dec(j);end;

begin

tmpS1:=tmpS2+tmpS1;

delete(i_ST,i,length(tmpS1));

insert(tmpS1,i_ST,i);

end;

i:=j;

end;

o_ST:=i_ST;

end;

function Cl(S0:string):word;

var i,j:word;

begin

j:=0;

for i:=1 to length(S0) do begin

if S0[i]='(' then inc(j);

end;

result:=j;

end;

procedure ClSk (lkS :string; var glS :string);

var List1: TStringList;

tmS : string;

i,j : word;

begin

list1:=TStringList.Create;

i:=1;

while i<=length(lkS) do begin

j:=i;

tmS:=Extr(lkS,j);

list1.Add(tmS);

inc(j);

i:=j;

end;

//Form1.memo2.lines.assign(list1);

list1.Free;

end;

procedure Sgnl(var S: string);

var j:word;

begin

j:=1;

while j<>0 do begin

j:=Pos('+-',S);

if j<>0 then begin

delete(S,j,2);

insert('-',S,j);

end;

j:=Pos('-+',S);

if j<>0 then begin

delete(S,j,2);

insert('-',S,j);

end;

j:=Pos('--',S);

if j<>0 then begin

delete(S,j,2);

insert('+',S,j);

end;

end;

end;

procedure OpSk (ST0: string;V : byte;var ST1 :string);

var i,y,j,k,f,Sizer : word;

tmp1,t0 : string;

tmpST,sgn : string;

begin

i:=1;

j:=1;

tmpST:='';

ST1:=ST0;

Sizer:=length(ST0);

if (Pos('(',ST0)=1)or(Pos('+(',ST0)<>0)or(Pos('-(',ST0)<>0) then begin

while i<=length(ST0) do

begin

if (i=1)and(ST0[i]='(') then begin

j:=i;

tmpST:=Extr(ST0,j);

if ST0[j] in ['*','/'] then break;

Delete(ST0,i,length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST,length(tmpST),1);

insert(tmpST,ST0,i);

if Sizer<>length(ST0) then begin Sgnl(ST0);ST1:=ST0;exit;end;

end;

j:=1;

tmpST:='';

if (ST0[i]='(')and((i>1)and(ST0[i-1]in['+','-','('])) then

begin

j:=i;

tmpST:=Extr(ST0,j);

if ST0[j] in ['*','/'] then break;

if ST0[i-1]='-' then

Subzero(tmpST,1);

Delete(ST0,i,length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST,length(tmpST),1);

insert(tmpST,ST0,i);

if Sizer<>length(ST0) then begin Sgnl(ST0);ST1:=ST0;exit;end;

dec(i);

end;

inc(i);

end;

Sgnl(ST0);

if Sizer<>length(ST0) then begin ST1:=ST0;exit;end;

end;

//---------------------------

i:=1;

j:=1;

k:=1;

if (Pos('*(',ST0)<>0)or(Pos(')*',ST0)<>0) then begin

while i<=length(ST0) do begin

j:=i;

tmp1:='';

tmpST:=Extr(ST0,j);

f:=j+1;

t0:=Extr(ST0,F);

if (t0[1]='(')and(ST0[j]='*')and(Pos('(',tmpST)=0) then begin

if tmpST[1] in ['-','+'] then begin delete(tmpST,1,1);inc(i);end;

tmp1:=t0+ST0[j]+tmpST;

delete(ST0,i,length(tmp1));

insert(tmp1,ST0,i);

tmp1 := t0;

t0 := tmpST;

tmpST:= tmp1;

tmp1:='';

j:=i+length(tmpST);

end;

if (tmpST[1]='(') and (ST0[j]='*')and(ST0[i-1]<>'*') then begin

repeat

tmp1:=tmp1+Extr(ST0,j);

until ST0[j]<>'*';

if ST0[i-1]='-' then begin

Subzero(tmpST,1);

end;

Delete(ST0,i,length(tmpSt));

Delete(tmpSt,1,1);

Delete(tmpSt,length(tmpSt),1);

k:=1;

y:=0;

if (tmpST[k]in ['-','+']) then inc(k);

while k<=length(tmpST) do begin

if tmpST[k]='(' then inc(y);

if tmpST[k]=')' then dec(y);

if y=0 then begin

case tmpSt[k] of

'+':begin insert(tmp1,tmpST,k);inc(k,length(tmp1));end;

'-':begin insert(tmp1,tmpST,k);inc(k,length(tmp1));end;

end;

end;

inc(k);

end;

insert(tmpST,ST0,i);

j:=i+length(tmpST)+length(tmp1);

if Sizer<>length(ST0) then begin Sgnl(ST0);ST1:=ST0;exit;end;

end;

inc(j);

i:=j;

end;

Sgnl(ST0);

end;

if ST0[1]='+' then delete(ST0,1,1);

//------------

ST1:=ST0;

end;

procedure OpenSK (ST0: string;V : byte;var ST1 :string);

var i,j,T0,k : word;

tmpST : string;

muler : string;

begin

T0:=0;

i:=1;

muler:='*XX';

while i<=length(ST0) do

begin

if (ST0[i]='(')and((i=1)or(ST0[i-1]in['+','-','('])) then

begin

tmpST:=Copy(ST0,i,length(ST0)+1-i);

j:=i;

tmpST:=Extr(ST0,j);

Delete(ST0,i,length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST,length(tmpST),1);

insert(tmpST,ST0,i);

dec(i);

//i:=j;

ST1:=ST0;

end;

if (ST0[i]='(')and(ST0[i-1]='*') then

begin

j:=i;

tmpST:=Extr(ST0,j);

Delete(ST0,i,length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST,length(tmpST),1);

k:=1;

if tmpST[k]='-' then inc(k);

while k<=length(tmpST) do begin

case tmpST[k] of

'+':begin insert(muler,tmpST,k);inc(k,length(muler));end;

'-':begin insert(muler,tmpST,k);inc(k,length(muler));end;

end;

inc(k);

end;

insert(muler,tmpST,k);

insert(tmpST,ST0,i);

ST1:=ST0;

end;

inc(i);

end;

end;

procedure SubZero (var SPT :string;const c:byte);

var i,y : byte;

begin

y:=0;

for i:=1 to length(SPT) do begin

if SPT[i]='(' then inc(y);

if SPT[i]=')' then dec(y);

if y=1 then

case SPT[i] of

'+':SPT[i]:='-';

'-':SPT[i]:='+';

end;

end;

if C=0 then begin

if SPT[2]<>'+' then insert('-',SPT,2)

else delete(SPT,2,1);

end;

if C=1 then begin

if SPT[2]='+' then begin delete(SPT,2,1);

insert('-',SPT,2);

end;

end;

end;

function Half(i:byte):byte;

begin

if i=1 then Half:=1

else if (i mod 2)=1 then Result:=(i div 2)+1

else Result:=(i div 2);

end;

function Extr (St:string;var i:word):string;

var tmp : string;

ct,f : byte;

begin

ct:=0;

f:=0;

Repeat

if St[i]='(' then begin inc(ct);f:=1;end;

if St[i]=')' then begin dec(ct);end;

tmp:=tmp+St[i];

INC(i);

Until not(St[i] in ['0'..'9','(','a'..'z'])and(f=0)or(ct=0)and(f=1);

Result:=tmp;

end;

procedure FormArr (var st:string;var Mas_Rec:Ary);

var from : byte;

tmp1,tmp2,St1 : string;

Sgn,Z1 : char;

k : 0..10;

i:word;

begin

if (length(st)=0) then begin exit;end;

k :=0;

St1 :='';

from :=1;

Repeat

I :=1;

tmp1 :='';

tmp2 :='';

if St[i]='+' then inc(i);

tmp1:=Extr(St,i);

Mas_Rec[k].Md:='';

if i<=length(st) then

begin

Sgn :=St[i];

inc(i);

tmp2:=Extr(St,i);

if St[i]='-' then dec(i);

Z1:=St[i];

if (z1 in ['*','/'])

then

begin

if (sgn in ['-','+'])then from:=length(tmp1)+1

else tmp2:=tmp1+sgn+tmp2;

if sgn='-' then tmp2:=sgn+tmp2;

Mas_Rec[k].Md:=tmp2;

repeat

Mas_Rec[k].Md:=Mas_Rec[k].Md+Extr(St,i);

until not(st[i] in ['*','/'])or(i>=length(st));

i:=i-from;

end;

Mas_Rec[k].sp1:=tmp1;

Mas_Rec[k].sp2:=tmp2;

Mas_Rec[k].sgn:=sgn;

end

else

begin

Mas_Rec[k].sp1:=tmp1;

Mas_Rec[k].sp2:='0';

Mas_Rec[k].sgn:=sgn;

end;

inc(k);

Delete(St,from,i);

i:=1;

from:=1;

until i>length(st);

SetLength(Mas_Rec,k);

end;

//-----------------------------------------

procedure Check_STR (var Str:String;var Fl:boolean);

var

k,i : word;

Flag : Boolean;

tmpstr : String;

Sign : array[0..50] of char;

begin

K :=0;

tmpstr :='0';

Flag :=true;

if str[1] in ['+','*','/'] then begin ShowMessage('Error in '+IntToStr(1));exit;end;

if str[length(str)] in ['+','*','/','-'] then begin ShowMessage('Error in '+IntToStr(length(str)));exit;end;

try

for i:=1 to length(str) do

begin

if (str[i] in ['0'..'9',',','a'..'z']) then tmpstr:=tmpstr+Str[i]

else

begin

sign[k]:=Str[i];

if (sign[k]='(')and(tmpstr<>'0') then begin ShowMessage('Error in '+IntToStr(i));exit;end;

if (sign[k]=')')and(str[i+1] in ['0'..'9','a'..'z','('])and(i<length(str)) then begin ShowMessage('Error in '+IntToStr(i+1));exit;end;

if (sign[k]=')')and(str[i-1] in ['+','-','*','/'])and(i>1) then begin ShowMessage('Error in '+IntToStr(i-1));exit;end;

if (sign[k]='(')and(i<length(str))and(str[i+1] in ['+','*','/']) then begin ShowMessage('Error in '+IntToStr(i+1));exit;end;

if (sign[k] in ['+','-','*','/'])and(i<length(str))and(str[i+1] in ['+','-','*','/'])then begin ShowMessage('Error in '+IntToStr(i+1));exit;end;

tmpstr:='0';

k:=k+1;

Flag:=not(Flag);

end;

end;

FL:=true;

except

end;

end;

procedure F_MulArr (var st:string;var Mar:Ary;var sSt:string);

var from : byte;

tmp1,tmp2,St1 : string;

Sgn,s2 : char;

k : 0..10;

i: word;

begin

if (length(st)=0) then begin exit;end;

k :=0;

St1 :='';

from :=1;

sst :='';

Repeat

I :=1;

tmp1 :='';

tmp2 :='';

tmp1:=Extr(St,i);

if i<=length(st) then

begin

Sgn :=St[i];

inc(i);

tmp2:=Extr(St,i);

MaR[k].sp1:=tmp1;

MaR[k].sp2:=tmp2;

MaR[k].sgn:=sgn;

s2:=st[i];

sSt:=sSt+s2;

end

else

begin

MaR[k].sp1:=tmp1;

MaR[k].sp2:='0';

MaR[k].sgn:=s2;

sSt:=sSt+s2;

end;

inc(k);

Delete(St,from,i);

i:=1;

from:=1;

until i>length(st);

SetLength(MaR,k);

end;

end.

Лексический анализ-----

unit check;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Memo1: TMemo;

Button1: TButton;

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Edit1Change(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

s:string[80];

GlobStr,tmp :string;

x,kol_sk,z:integer;

Form1: TForm1;

LevelTree:integer;

implementation

uses Tree;

{$R *.DFM}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if ord(key) = 13 then

begin

kol_sk:=0;

z:=0;

s:=Edit1.Text;

Globstr:=Edit1.Text;

Memo1.Clear;

for x:=1 to Edit1.GetTextLen-1 do

begin

//----------Два знака подряд--------------

if ((s[x] in ['+','-','*','/']) and (s[x+1] in ['+','-','*','/']))

then

begin

tmp :='Два знака подряд - '+s[x]+s[x+1];

Memo1.Lines.Add(tmp);

end;

//----------Пустые скобки--------------

if (((s[x]='(') and (s[x+1]=')')) or ((s[x]=')') and (s[x+1]='(')))

then

begin

tmp :='Пустые скобки (),)( - '+s[x]+s[x+1];

Memo1.Lines.Add(tmp);

end;

//----------Знак перед скобкой или знак после скобки--------------

if (((s[x]='(') and (s[x+1] in ['+','*','/'])) or ((s[x+1]=')') and (s[x]in ['+','-','*','/'])))

then

begin

tmp :='Знак перед скобкой или знак после скобки - '+s[x]+s[x+1];

Memo1.Lines.Add(tmp);

end;

//----------Число перед скобкой или число после скобки--------------

if (((s[x]=')') and (s[x+1] in ['0'..'9'])) or ((s[x+1]='(') and (s[x]in ['0'..'9'])))

then

begin

tmp :='Число перед скобкой или число после скобки - '+s[x]+s[x+1];

Memo1.Lines.Add(tmp);

end;

end;

for x:=1 to Edit1.GetTextLen do

begin

//----------Недопустимый символ--------------

if s[x] in ['A'..'Z','a'..'z','+','-','*','/','(',')','0'..'9']

then

else

begin

tmp :='Недопустимый символ - '+s[x];

Memo1.Lines.Add(tmp);

end;

//---------количество скобок )---------------

if s[x]=')'

then

begin

kol_sk :=kol_sk-1;

end;

//---------количество скобок (---------------

if s[x]='('

then

begin

kol_sk :=kol_sk+1;

end;

//------------------------Закрывающая скобка без открывающей

if ((kol_sk < 0) and (z = 0)) then

begin

z:=z+1;

tmp :='Закрывающая скобка без открывающей - ';

Memo1.Lines.Add(tmp);

end;

end;

if kol_sk <> 0 then

begin

tmp :='Не одинаковое количество откр. и закр. скобок - ';

Memo1.Lines.Add(tmp);

end;

if s[1] in ['+','*','/']

then

begin

tmp :='Первый знак';

Memo1.Lines.Add(tmp);

end;

if s[Edit1.GetTextLen] in ['+','*','/','-']

then

begin

tmp :='Последний знак - ';

Memo1.Lines.Add(tmp);

end;

if Memo1.GetTextLen =0 then

begin

Memo1.Lines.Add('ВЫРАЖЕНИЕ СИСНТАКСИЧЕСКИ ВЕРНО!');

Button1.Enabled:=true;

end;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Button1.Enabled:=false;

kol_sk:=0;

z:=0;

for x:=1 to Edit1.GetTextLen

do s[x]:=' ';

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form2.Show;

Form2.BildClick(Sender);

end;

procedure TForm1.Edit1Change(Sender: TObject);

begin

form1.Button1.Enabled:=false;

end;

end.

Построение дерева ------

unit tree;

interface

uses

Windows, Messages, SysUtils,Forms, Dialogs,

StdCtrls, Buttons, Prg_my,

ComCtrls, ExtCtrls, Classes, Controls, Grids;

type

Tlayer = record

Parent :word;

Str :string;

sop :char;

end;

PTint=^word;

Tconv = class(TObject)

layer: array[0..4] of Tlayer;

actOper :char;

actTimer :word;

empty :boolean;

procedure inCon(St1:string;sgn :char;Num :word);

procedure Tik(var B :Ar2; ti :word);

procedure cDraw(var Ts1,Ts2,TS3,Ts4: TStaticText);

end;

TForm2 = class(TForm)

Panel1: TPanel;

BitBtn1: TBitBtn;

LB1: TListBox;

TreeView1: TTreeView;

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure BildClick(Sender: TObject);

procedure CloseClick(Sender: TObject);

procedure OnMoClick(Sender: TObject);

procedure Memo1KeyPress(Sender: TObject; var Key: Char);

procedure BitBtn1Click(Sender: TObject);

procedure Memo1Enter(Sender: TObject);

procedure comClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure LB1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn5Click(Sender: TObject);

procedure BitBtn4Click(Sender: TObject);

private

procedure TreeBld(Ar: Ary;var TN:TTreeNode;Ssn:string);

procedure BuildTree(Ar: Ary;var TN:TTreeNode);

procedure Scobc(var swp:TTreeNode;ch_st:string);

procedure BAll(BA_Str: string; var TN:TTreeNode; Ar :Ary);

procedure BB2C( iNum :word);

public

Flag:boolean;

Ar_Node: array[0..1] of TTreeNode;

g_str,op_str : string;

cou_str: byte;

BigArray :TStringlist;

BigA :Ar2;

aCount : word;

Maximum: serch;

end;

var

Form2: TForm2;

Conv: Tconv;

pint: PTint;

implementation

uses check;

{$R *.DFM}

procedure Tconv.cDraw(var Ts1,Ts2,TS3,Ts4: TStaticText);

begin

TS1.Caption:=layer[0].Str;

TS2.Caption:=layer[1].Str;

tS3.Caption:=layer[2].Str;

Ts4.Caption:=layer[3].Str;

end;

procedure Tconv.Tik(var B :Ar2; ti :word);

var j: byte;

gh: byte;

begin

if actTimer>0 then dec(actTimer);

if (actOper in ['*','/'])and((ti) mod 2 =0) then exit;

for j:=4 downto 1 do begin

layer[j]:=layer[j-1];

end;

layer[0].Str:='';

layer[0].Parent:=0;

layer[0].sop:=#11;

gh:=0;

if layer[4].Str<>'' then begin

dec(B[layer[4].Parent].Prior);

if (layer[3].Str='')and(layer[3].Parent=0) then actOper:=#11;

for j:=0 to 3 do begin

if layer[j].sop='*' then gh:=2;

if layer[j].sop='/' then gh:=2;

end;

if gh=2 then actOper:='*';

if gh=0 then actOper:=#11;

layer[4].Str:='';

layer[4].Parent:=0;

layer[4].sop:=#11;

end;

end;

procedure Tconv.inCon(st1 :string;sgn: char;Num :word);

begin

if (layer[0].Str='') then begin

layer[0].Parent:=Num;

layer[0].Str:=St1;

layer[0].sop:=sgn;

case sgn of

'+','-':inc(actTimer,4);

'/','*':begin inc(actTimer,8); actOper:='*'; end;

end;

end;

end;

procedure TForm2.BB2C( iNum :word);

var Item,Del :TTreeNode;

tr:TTreeNodes;

i,j,mul,Icount :word;

Flg,Fl :boolean;

ChecFlag: boolean;

Ar0:Ary;

begin

SetLength(BigA,25);

ChecFlag:=(iNum=0);

item:=Form2.treeview1.Items[0];

Acount:=0;

New(Pint);

bigarray.Clear;

Icount:=1;

Form2.treeview1.Visible:=false;

while Form2.treeview1.Items.Count>2 do begin

if Item.GetNext<> nil then Item:=Item.GetNext

else item:=Form2.treeview1.Items[0];

if item.HasChildren then begin

if (not(item.Item[0].HasChildren))and(not(item.Item[1].HasChildren)) then begin

bigArray.Add(item.Item[0].text+item.text+item.Item[1].Text);

BigA[Acount].S1:=item.Item[0].text+item.text+item.Item[1].Text;

BigA[Acount].Prior:=0;

BigA[Acount].sgn:=item.text[1];

BigA[Acount].MyNum:=Acount;

inc(Icount);

if item.item[0].Data<>nil then begin

PTint(item.item[0].Data)^:=Acount;

inc(BigA[Acount].Prior);

end;

if item.item[1].data<>nil then begin

pTint(item.item[1].Data)^:=Acount;

inc(BigA[Acount].Prior);

end;

inc(Acount);

Del:=item;

pint:=@(BigA[Acount-1].MyPar);

del:=Form2.treeview1.items.InsertObject(del,'['+BigA[aCount-1].S1+']',pint);

item.Delete;

item:=del;

end;

end;

end;

Ball(GlobStr,AR_Node[0],Ar0);

Form2.treeview1.Visible:=true;

if Acount=0 then begin finalize(BigA);exit;end;

SetLength(BigA,Acount);

j:=0;

Flg:=true;

Fl:=True;

conv.layer[0].Str:='';

conv.actTimer:=0;

mul:=1;

for i:=1 to 100 do begin

if (BigA[j].Prior=0)then begin

Flg:=(Conv.layer[0].Str='');

Conv.inCon(BigA[j].S1,BigA[j].sgn,BigA[j].MyPar);

if Flg then inc(j);

end;

if (conv.layer[0].Str='')and(conv.layer[1].Str='')and(conv.layer[2].Str='')and(conv.layer[3].Str='') then conv.actTimer:=0;

if (j>=ACount)and(conv.actTimer=0) then break;

if conv.actOper in['*','/'] then inc(mul);

if Fl and(conv.actOper in['*','/']) then begin mul:=2;Fl:=false; end;

if conv.actOper in['+','-'] then Fl:=true;

Conv.Tik(BigA,mul);

end;

if i<maximum.maxy then

begin

maximum.maxy:=i;

maximum.iNumer:=iNum;

end;

finalize(BigA);

end;

procedure TForm2.Scobc(var swp:TTreeNode;ch_st:string);

var TM_A: Ary;

begin

swp.text:='+';

Delete(ch_st,1,1);

Delete(ch_st,length(ch_st),1);

Setlength(TM_A,25);

FormArr(ch_st,TM_A);

BuildTree(TM_A,swp);

finalize(TM_A);

end;

procedure TForm2.BuildTree(Ar: Ary;var TN:TTreeNode);

var TM_A,u_m: Ary;

jk :byte;

sgnSt:string;

T_t,swpT:TTreeNode;

begin

if high(Ar)=low(Ar) then

begin

if Ar[low(Ar)].sp2='0' then

begin

tn.Text:=Ar[low(Ar)].sp1;

with Ar[low(Ar)] do begin

if (sp1[1]='-')and(sp1[2]='(') then

begin

Delete(sp1,1,1);

SubZero(sp1,0);

end;

if sp1[1]='(' then Scobc(Tn,sp1);

end;

end

else begin

if Ar[low(Ar)].Md<>'' then

begin

SetLength(u_m,15);

F_MulArr(Ar[low(Ar)].Md,u_m,sgnSt);

jk:=Half(length(sgnSt));

tn.Text:=sgnst[jk];

TreeBld(u_m,Tn,sgnSt);

finalize(u_m);

end

else begin

Tn.Text:=Ar[low(Ar)].sgn;

with Ar[low(Ar)] do begin

swpT:=Form2.TreeView1.Items.addChild(Tn,sp1);

if (sp1[1]='-')and(sp1[2]='(') then

begin

Delete(sp1,1,1);

SubZero(sp1,0);

end;

if sp1[1]='(' then begin

Scobc(swpT,sp1);

end;

swpT:=Form2.TreeView1.Items.addChild(Tn,sp2);

if sp2[1]='(' then begin

Scobc(swpT,sp2);

end;

end;

end;

end;

exit

end

else

begin

TM_A:=Copy(Ar,low(Ar),((low(Ar)+high(Ar)) div 2)+1);

t_t:=Form2.TreeView1.Items.addChild(Tn,'+');

BuildTree(TM_A,t_t);

TM_A:=Copy(Ar,((low(Ar)+high(Ar)) div 2)+1,((low(Ar)+high(Ar)) div 2)+1);

t_t:=Form2.TreeView1.Items.addChild(Tn,'+');

BuildTree(TM_A,t_t);

finalize(TM_A);

end;

end;

procedure TForm2.TreeBld(Ar: Ary;var TN:TTreeNode;Ssn:string);

var TM_A: Ary;

jk,sco :byte;

locSt:string;

T_t,swpT:TTreeNode;

begin

if high(Ar)=low(Ar) then

begin

if Ar[low(Ar)].sp2='0' then begin tn.Text:=Ar[low(Ar)].sp1;

if Ar[low(Ar)].sp1[1]='(' then

Scobc(Tn,Ar[low(Ar)].sp1);

end

else begin

Tn.Text:=Ar[low(Ar)].sgn;

with Ar[low(Ar)] do begin

swpT:=Form2.TreeView1.Items.addChild(Tn,sp1);

if (sp1[1]='-')and(sp1[2]='(') then

begin

Delete(sp1,1,1);

SubZero(sp1,0);

end;

if sp1[1]='(' then begin

Scobc(swpT,sp1);

end;

swpT:=Form2.TreeView1.Items.addChild(Tn,sp2);

if sp2[1]='(' then begin

Scobc(swpT,sp2);

end;

end;

end;

exit

end

else

begin

jk:=Half(length(SSn));

sco:=((low(Ar)+high(Ar)) div 2)+1;

TM_A:=Copy(Ar,low(Ar),sco);

locst:=Copy(SSn,low(Ar),((low(Ar)+high(Ar)) div 2)+1);

sco:=((low(Tm_A)+high(Tm_A))div 2)+1;

t_t:=Form2.TreeView1.Items.addChild(Tn,locst[sco]);

TreeBld(TM_A,t_t,SSn);

//--------------------------------

sco:=((low(Ar)+high(Ar)) div 2)+1;

TM_A:=Copy(Ar,((low(Ar)+high(Ar)) div 2)+1,sco);

locst:=Copy(SSn,jk,high(Ar)+1);

sco:=Half(length(locst));

t_t:=Form2.TreeView1.Items.addChild(Tn,locst[sco]);

TreeBld(TM_A,t_t,SSn);

end;

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

maximum.maxy:=1000;

cou_str:=1;

Conv:=Tconv.Create;

Conv.actOper:=#11;

Conv.empty:=false;

BigArray:=TstringList.Create;

aCount:=0;

end;

procedure TForm2.BildClick(Sender: TObject);

var

A:Ary;

lin:string;

begin

Form2.TreeView1.Items.Clear;

lin:=trim(Form1.Edit1.text);

op_STR:=lin;

lb1.Clear;

lb1.Items.Add(lin);

AR_Node[0]:=Form2.TreeView1.Items.add(nil,'Корень дерева');

AR_Node[0]:=Form2.TreeView1.Items.add(AR_Node[0],'+');

Setlength(A,25);

FormArr(lin,A);

BuildTree(A,AR_Node[0]);

AR_Node[0].Expand(True);

finalize(A);

finalize(lin);

BitBtn1.Enabled:=true;

end;

procedure TForm2.CloseClick(Sender: TObject);

begin

Close;

end;

procedure TForm2.OnMoClick(Sender: TObject);

var STR: string;

begin

Str:=trim(Form1.Edit1.Text);

end;

procedure TForm2.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

if Key=#13 then

begin

BildClick(Sender);

BitBtn1.SetFocus;

end;

end;

procedure TForm2.BitBtn1Click(Sender: TObject);

var A0 : Ary;

STR : string;

c0,c1 : byte;

begin

STR:=trim(form1.Edit1.Text);

if Pos('(',STR)=0 then begin showmessage('Скобок больше нет');exit;end;

if STR='' then begin showmessage('Пустая строка');exit;end;

c0:=cl(STR);

c1:=length(STR);

repeat

OpSK(STR,0,STR);

until (c0<>cl(STR))or(c1<>length(STR));

form1.Edit1.Text:=STR;

LB1.Items.Add(STR);

inc(cou_str);

BALL(STR,AR_Node[1],A0);

//---------------------

finalize(A0);

finalize(STR);

end;

procedure TForm2.BAll(BA_Str: string; var TN:TTreeNode; Ar :Ary);

begin

Form2.TreeView1.Items.Clear;

TN:=Form2.TreeView1.Items.add(nil,':'+'Результат');

TN:=Form2.TreeView1.Items.add(TN,'+');

Setlength(Ar,25);

FormArr(BA_STR,Ar);

BuildTree(Ar,TN);

TN.Expand(True);

end;

procedure TForm2.Memo1Enter(Sender: TObject);

begin

BitBtn1.Enabled:=false;

end;

procedure TForm2.comClick(Sender: TObject);

var A0: Ary;

STR: string;

data,res: string;

StrTmp,StrTmp1:string;

begin

StrTmp:=Form1.Edit1.Text;

repeat

data :=Form1.Edit1.Text;

Comt2(data,res);

StrTmp1:=res;

Form1.Edit1.Text :=res;

LB1.Items.Add(res);

Comt(res,res);

LB1.Items.Add(res);

until StrTmp = StrTmp1;

finalize(A0);

finalize(STR);

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Conv.Free;

Bigarray.Free;

end;

procedure TForm2.LB1Click(Sender: TObject);

var i,K: word;

Ar0: Ary;

Loc_Str: string;

begin

for i := 0 to (LB1.Items.Count - 1) do begin

if LB1.Selected[i] then

begin

Loc_Str:=LB1.Items.Strings[i];

GlobStr:=loc_str;

k:=Pos(' ;',Loc_Str);

if k<>0 then delete(Loc_Str,k,length(loc_str)-(k-1));

Ball(Loc_Str,AR_Node[0],Ar0);

end;

end;

finalize(Ar0);

finalize(Loc_Str);

end;

procedure TForm2.BitBtn2Click(Sender: TObject);

begin

BB2c(0);

end;

procedure TForm2.BitBtn5Click(Sender: TObject);

begin

Close;

end;

procedure TForm2.BitBtn4Click(Sender: TObject);

var i,k: word;

Ar0:Ary;

loc_Str: string;

begin

if lb1.Items.Count=0 then exit;

for i:=0 to lb1.Items.Count-1 do begin

Loc_Str:=LB1.Items.Strings[i];

k:=Pos(' ;',Loc_Str);

if k<>0 then delete(Loc_Str,k,length(loc_str)-(k-1));

Ball(Loc_Str,AR_Node[0],Ar0);

BB2C(1);

end;

finalize(Ar0);

maximum.maxy:=1000;

end;

end.

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