Банк рефератов содержит более 364 тысяч рефератов, курсовых и дипломных работ, шпаргалок и докладов по различным дисциплинам: истории, психологии, экономике, менеджменту, философии, праву, экологии. А также изложения, сочинения по литературе, отчеты по практике, топики по английскому.
Полнотекстовый поиск
Всего работ:
364150
Теги названий
Разделы
Авиация и космонавтика (304)
Административное право (123)
Арбитражный процесс (23)
Архитектура (113)
Астрология (4)
Астрономия (4814)
Банковское дело (5227)
Безопасность жизнедеятельности (2616)
Биографии (3423)
Биология (4214)
Биология и химия (1518)
Биржевое дело (68)
Ботаника и сельское хоз-во (2836)
Бухгалтерский учет и аудит (8269)
Валютные отношения (50)
Ветеринария (50)
Военная кафедра (762)
ГДЗ (2)
География (5275)
Геодезия (30)
Геология (1222)
Геополитика (43)
Государство и право (20403)
Гражданское право и процесс (465)
Делопроизводство (19)
Деньги и кредит (108)
ЕГЭ (173)
Естествознание (96)
Журналистика (899)
ЗНО (54)
Зоология (34)
Издательское дело и полиграфия (476)
Инвестиции (106)
Иностранный язык (62792)
Информатика (3562)
Информатика, программирование (6444)
Исторические личности (2165)
История (21320)
История техники (766)
Кибернетика (64)
Коммуникации и связь (3145)
Компьютерные науки (60)
Косметология (17)
Краеведение и этнография (588)
Краткое содержание произведений (1000)
Криминалистика (106)
Криминология (48)
Криптология (3)
Кулинария (1167)
Культура и искусство (8485)
Культурология (537)
Литература : зарубежная (2044)
Литература и русский язык (11657)
Логика (532)
Логистика (21)
Маркетинг (7985)
Математика (3721)
Медицина, здоровье (10549)
Медицинские науки (88)
Международное публичное право (58)
Международное частное право (36)
Международные отношения (2257)
Менеджмент (12491)
Металлургия (91)
Москвоведение (797)
Музыка (1338)
Муниципальное право (24)
Налоги, налогообложение (214)
Наука и техника (1141)
Начертательная геометрия (3)
Оккультизм и уфология (8)
Остальные рефераты (21697)
Педагогика (7850)
Политология (3801)
Право (682)
Право, юриспруденция (2881)
Предпринимательство (475)
Прикладные науки (1)
Промышленность, производство (7100)
Психология (8694)
психология, педагогика (4121)
Радиоэлектроника (443)
Реклама (952)
Религия и мифология (2967)
Риторика (23)
Сексология (748)
Социология (4876)
Статистика (95)
Страхование (107)
Строительные науки (7)
Строительство (2004)
Схемотехника (15)
Таможенная система (663)
Теория государства и права (240)
Теория организации (39)
Теплотехника (25)
Технология (624)
Товароведение (16)
Транспорт (2652)
Трудовое право (136)
Туризм (90)
Уголовное право и процесс (406)
Управление (95)
Управленческие науки (24)
Физика (3463)
Физкультура и спорт (4482)
Философия (7216)
Финансовые науки (4592)
Финансы (5386)
Фотография (3)
Химия (2244)
Хозяйственное право (23)
Цифровые устройства (29)
Экологическое право (35)
Экология (4517)
Экономика (20645)
Экономико-математическое моделирование (666)
Экономическая география (119)
Экономическая теория (2573)
Этика (889)
Юриспруденция (288)
Языковедение (148)
Языкознание, филология (1140)

Курсовая работа: Багатокритеріальна задача лінійного програмування

Название: Багатокритеріальна задача лінійного програмування
Раздел: Рефераты по информатике, программированию
Тип: курсовая работа Добавлен 06:38:58 07 мая 2011 Похожие работы
Просмотров: 244 Комментариев: 1 Оценило: 0 человек Средний балл: 0 Оценка: неизвестно     Скачать

1. Завдання

Розв’язати багатокритеріальну задачу лінійного програмування з отриманням компромісного розв’язку за допомогою теоретико-ігрового підходу.

Задача (варіант 1):

Z 1 = x 1 +2 x 2 + x 3 ® max

Z2 = – x1 –2x2 +x3 +x4 ® min

Z3 = –2x1 –x2 +x3 +x4 ® max

з обмеженнями

2 x 1 x 2 +3 x 3 +4 x 4 £ 10

x 1 + x 2 + x 3 x 4 £ 5

x 1 +2 x 2 –2 x 3 +4 x 4 £ 12

" x ³ 0

2. Теоретичні відомості

У цій роботі реалізовано вирішування таких задач лінійного програмування: розв’язування задач багатокритеріальної оптимізації, тобто пошук компромісного рішення для задач з кількома функціями мети.

Ця задача така:

Задано об’єкт управління, що має n входів і k виходів. Вхідні параметри складають вектор X = {xj }, . Кожен з вхідних параметрів може мати обмеження, що накладене на область його значень. В програмі підтримуються параметри без обмежень на значення, і з обмеженнями невід’ємності (з областю ). Також на комбінації вхідних значень можуть бути накладені обмеження як система лінійних рівнянь або нерівностей:


Вихідні сигнали об’єкта є лінійними комбінаціями вхідних сигналів. Для досягнення ефективності роботи об’єкта управління частину вихідних сигналів треба максимізувати, інші – мінімізувати, змінюючи вхідні сигнали і дотримуючись обмежень на ці сигнали (задоволення усіх нерівностей, рівнянь і обмежень області значень кожного з вхідних параметрів). Тобто вихідні сигнали є функціями мети від вхідних:

Як правило, для багатокритеріальної задачі не існує розв’язку, який би був найкращим (оптимальним) для усіх функцій мети одночасно. Проте можна підібрати такий розв’язок, який є компромісним для усіх функцій мети (в точці цього розв’язку кожна з функцій мети якнайменше відхиляється від свого оптимального значення в заданій системі умов (обмежень).

Тут реалізовано пошук компромісного розв’язку за допомогою теоретико-ігрового підходу, що був розроблений під керівництвом доцента ХАІ Яловкіна Б.Д. Цей підхід дозволяє знайти компромісний розв’язок з мінімальним сумарним відхиленням всіх виходів (значень функцій мети) від їхніх екстремальних значень за даної системи обмежень.

Йде пошук компромісного вектора значень змінних в такому вигляді:


тут – вектор, що оптимальний для i -го критерію(функції мети); l i – вагові коефіцієнти.

Для отримання цього вектора виконуються такі кроки розв’язування:

1) Розв’язується k однокритеріальних задач ЛП за допомогою симплекс-методу (для кожної з функцій мети окремо, з тією самою системою обмежень, що задана для багатокритеріальної задачі). Так отримуємо k оптимальних векторів значень змінних (для кожної з цільових функцій – свій).

2) Підраховуються міри неоптимальності для всіх можливих підстановок кожного вектора значень змінних у кожну з функцій мети, за такою формулою:

де Cj – вектор коефіцієнтів j -ої функції мети;

X* i – вектор, що оптимальний для i - ої функції мети;

X* j – вектор, що оптимальний для j - ої функції мети;

Всі ці міри неоптимальності складають квадратну матрицю, рядки якої відповідають k оптимальним векторам X* i для кожної функції мети, а стовпці – k функціям мети Cj . Ця матриця розглядається як платіжна матриця матричної гри двох партнерів X* і Z , що визначена множиною стратегій X*={X*1 , …, X*k } першого гравця, і Z={C1 X, …, Ck X} другого. Всі міри неоптимальності є недодатними, і є коефіцієнтами програшу першого гравця. На головній діагоналі вони рівні нулю (бо є мірами неоптимальності оптимального вектора для своєї ж функції).

3) Матриця мір неоптимальності заміняється еквівалентною їй матрицею додаванням до кожної міри неоптимальності , тобто найбільшого з абсолютних значень всіх мір. Якщо таке найбільше значення рівне нулю, то всі міри рівні нулю, і в такому випадку замість нього до усіх мір додається число 1. В результаті отримуємо матрицю з невід’ємними елементами. На головній діагоналі усі вони рівні максимальному значенню. Така заміна матриці не змінює рішення гри, змінює тільки її ціна. Тобто тепер гра має вигляд не гри програшів, а гри з пошуком максимального виграшу. Для пошуку оптимальної стратегії для першого гравця гра подається як пара взаємнодвоїстих однокритеріальних задач ЛП. Для першого гравця потрібні значення змінних двоїстої задачі :

v1 = v2 = vk = W=
- - - 1
-u1 = 1
-u2 = 1
. . . . .
-uk = 1
1 Z = -1 -1 -1 0

Розв’язавши цю задачу і отримавши оптимальні значення max(Z) = min(W) , що досягаються при значеннях змінних двоїстої задачі , можна обчислити вагові коефіцієнти для компромісного розв’язку багатокритеріальної задачі:

,


Компромісний вектор значень змінних для багатокритеріальної задачі є лінійною комбінацією оптимальних векторів кожної функції мети. Це сума векторів, що помножені кожен на свій ваговий коефіцієнт:

Підставивши цей компромісний вектор в кожну функцію мети багатокритеріальної задачі отримуємо компромісні значення цих функцій.

3. Вирішування

Рівняння, нерівності та функції записуються у таблицю:

Розв’язування задачі ЛП для кожної функції мети окремо:

Пошук оптимального розв’язку для функції Z1

Задача для симплекс-метода з функцією Z1

Незалежних змінних немає.

Виключення 0-рядків: немає.

Опорний розв’язок: готовий (усі вільні члени невід’ємні).

Пошук оптимального розв’язку:

Результат для прямої задачі:

У рядку-заголовку:

– x1 = 0;

– y2 = 0;

– y1 = 0;

– y3 = 0;

У стовпці-заголовку:

x3 = 2,33333333333333;

x2 = 4,55555555555556;

x4 = 1,88888888888889;

Функція мети: Z1 = 11,4444444444444.

Пошук оптимального розв’язку для функції Z2

Функцію Z 2, що мінімізується, замінили на протилежну їй – Z 2, що максимізується. Запис для вирішування симплекс-методом максимізації

Незалежних змінних немає.

0-рядків немає.

Опорний розв’язок: готовий.

Пошук оптимального:

Після отримання розв’язку максимізації для Z 2 , взято протилежну до неї функцію Z 2 , і отримано розв’язок мінімізації для неї

Результат для прямої задачі:

У рядку-заголовку:

– x1 = 0;

– y2 = 0;

– x3 = 0;

– y3 = 0;

У стовпці-заголовку:

y1 = 14;

x2 = 5,33333333333333;

x4 = 0,333333333333333;

Функція мети: Z2 = -10,3333333333333.

Пошук оптимального розв’язку для функції Z3

Задача для симплекс-методу максимізації

Незалежних змінних і 0-рядків немає.

Опорний розв’язок вже готовий.

Пошук оптимального:

Результат для прямої задачі:

У рядку-заголовку:

– x1 = 0;

– x2 = 0;

– y1 = 0;

– x4 = 0;

У стовпці-заголовку:

x3 = 3,33333333333333;

y2 = 1,66666666666667;

y3 = 18,6666666666667;

Функція мети: Z3 = 3,33333333333333.

Підрахунок мір неоптимальності

Матриця мір неоптимальності та рядок функції мети, стовпець вільних членів і заголовки задачі ЛП, що будуть використані далі

До мір додана найбільша за модулем міра . Матриця у формі задачі ЛП

Розв’язування ігрової задачі:

Незалежних змінних немає.

0-рядків немає.

Опорний розв’язок вже готовий.

Пошук оптимального розв’язку:


Результат для двоїстої задачі (відносно розв'язаної):

У рядку-заголовку:

u1 = 0,402684563758389;

u3 = 0,174496644295302;

v1 = 0,319280641167655;

У стовпці-заголовку:

– v3 = 0;

– v2 = 0;

– u2 = 0;

Функція мети: Z = 0,577181208053691.

############

Вагові коефіцієнти (Li[Func]=ui/W(U)):

l[Z1] = 0,697674418604651

l[Z2] = 0

l[Z3] = 0,302325581395349

Компромісні значення змінних

x1 = 0

x2 = 3,17829457364341

x3 = 2,63565891472868

x4 = 1,31782945736434

Компромісні значення функцій мети:

Z1 = 8,9922480620155

Z2 = -2,4031007751938

Z3 = 0,775193798449612

Вирішування закінчено. Успішно.

4. Текст програми

Модуль опису класу, що виконує роботу з задачами ЛП:

unit UnMMDOpr;

interface

Uses SysUtils, Types, Classes, Forms, Controls, StdCtrls, Dialogs, Graphics,

Grids, UControlsSizes, Menus;

Const sc_CrLf=Chr(13)+Chr(10);

sc_Minus='-';

sc_Plus='+';

sc_Equal='=';

sc_NotEqual='<>';

sc_Mul='*';

sc_Space=' ';

sc_KrKm=';';

sc_BrOp=' ('; sc_BrCl=')';

sc_XVarName='x';

sc_YFuncName='y';

sc_DualTaskFuncNameStart='v';

sc_DualTaskVarNameStart='u';

sc_RightSideValsHdr='1';

sc_DestFuncHdr='Z';

sc_DualDestFuncHdr='W';

sc_TriSpot='…'; sc_Spot='.';

sc_DoubleSpot=':';

sc_DoubleQuot='"';

lwc_DependentColor:TColor=$02804000;

lwc_IndependentColor:TColor=$02FF8000;

lwc_RightSideColColor:TColor=$02FFD7AE;

lwc_HeadColColor:TColor=$02808040;

lwc_FuncRowColor:TColor=$02C080FF;

lwc_DestFuncToMaxNameColor:TColor=$024049FF;

lwc_DestFuncToMinNameColor:TColor=$02FF4940;

lwc_DestFuncValColor:TColor=$02A346FF;

lwc_ValInHeadColOrRowColor:TColor=$025A5A5A;

lwc_SolveColColor:TColor=$02AAFFFF;

lwc_SolveRowColor:TColor=$02AAFFFF;

lwc_SolveCellColor:TColor=$0200FFFF;

bc_FixedRows=2; bc_FixedCols=1;

{Кількість стовпців перед стовпцями змінних та після них,

які можна редагувати, для редагування таблиці задачі

лінійного програмування (максимізації чи мінімізації функції):}

bc_LTaskColsBeforeVars=1; bc_LTaskColsAfterVars=1;

bc_LTaskRowsBeforeVars=bc_LTaskColsBeforeVars;

bc_LineEqM1ColsBeforeVars=1;

bc_LineEqM2ColsAfterVars=1;

bc_NotColored=-1;

bc_Negative=-1; bc_Zero=0; bc_Positive=1;

bc_MenuItemColorCircleDiameter=10;

sc_DependentVar='Залежна змінна (>=0)';

sc_IndependentVar='Незалежна змінна (будь-яке дійсне число)';

sc_FreeMembers='Вільні члени (праві сторони рівнянь)';

sc_InequalFuncName='Назва функції умови-нерівності';

sc_DestFuncCoefs='Рядок коефіцієнтів функції мети';

sc_DestFuncName='Назва функції мети';

sc_DestFuncToMaxName=sc_DestFuncName+', що максимізується';

sc_DestFuncToMinName=sc_DestFuncName+', що мінімізується';

sc_OtherType='Інший тип';

sc_DestFuncVal='Значення функції мети';

sc_ValInHeadColOrRow='Число у заголовку таблиці';

sc_SolveCol='Розв''язувальний стовпець';

sc_SolveRow='Розв''язувальний рядок';

sc_SolveCell='Розв''язувальна комірка';

Type

TWorkFloat=Extended; {тип дійсних чисел, що використовуються}

TSignVal=-1..1;

{Ідентифікатор для типу елемента масиву чисел та імен змінних.

Типи змінних: залежні, незалежні, функції (умови-нерівності).

Залежні змінні – це змінні, для яких діє умова невід'ємності:}

THeadLineElmType=(bc_IndependentVar, bc_DependentVar, bc_FuncVal, bc_Number,

bc_DestFuncToMax, bc_DestFuncToMin, bc_OtherType);

THeadLineElmTypes=set of THeadLineElmType;

TVarNameStr=String[7]; {короткий рядок для імені змінної}

TValOrName=record {Елемент-число або назва змінної:}

ElmType:THeadLineElmType;

Case byte of

1: (AsNumber:TWorkFloat); {для запису числа}

2: (AsVarName:TVarNameStr; {для запису назви змінної}

{Для запису номера змінної по порядку в умові задачі (в рядку

чи стовпці-заголовку):}

VarInitPos: Integer;

{Відмітка про те, що змінна була у рядку-заголовку ( True ), або

у стовпцю-заголовку ( False ):}

VarInitInRow: Boolean);

End;

TValOrNameMas=arrayofTValOrName; {тип масиву для заголовків матриці}

TFloatArr=arrayofTWorkFloat; {тип масиву дійсних чисел}

TFloatMatrix=array of TFloatArr; {тип матриці чисел}

TByteArr=array of Byte; {масив байтів – для поміток для змінних}

TByteMatrix=array of TByteArr;

{Стани об'єкта форматування таблиці у GrowingStringGrid:}

TTableFormatState=(fs_EnteringEqs, fs_EnteringLTask, fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask,

fs_NoFormatting, fs_FreeEdit);

{Тип переходу до двоїстої задачі: від задачі максимізації до

задачі мінімізації, або навпаки. Ці два переходи виконуються за

різними правилами (різні правила зміни знаків «<=» та «>=»

при переході від нерівностей до залежних змінних, і від залежних змінних

до нерівностей). І двоїсті задачі для максимізації і мінімізації

виходять різні…}

TDualTaskType=(dt_MaxToMin, dt_MinToMax);

{Процедури для форматування екранної таблиці GrowingStringGrid під час

роботи з нею у потрібному форматі, а також для вирішування

задач ЛП і відображення проміжних чи кінцевих результатів у

такій таблиці:}

TGridFormattingProcs=class(TObject)

Private

{Робочі масиви:}

CurHeadRow, CurHeadCol:TValOrNameMas; {заголовки таблиці}

CurTable:TFloatMatrix; {таблиця}

{Масиви для зберігання умови (використовуються для

багатокритеріальної задачі):}

CopyHeadRow, CopyHeadCol:TValOrNameMas; {заголовки таблиці}

CopyTable:TFloatMatrix; {таблиця}

InSolving, SolWasFound, WasNoRoots, WasManyRoots,

EqM1TaskPrepared, EqM2TaskPrepared, LTaskPrepared: Boolean;

{Прапорець про те, що вміст CurGrid ще не був прочитаний

даним об'єктом з часу останнього редагування його користуваем:}

CurGridModified: Boolean;

{В режимах розв'язування (CurFormatState=fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask)

– координати розв'язувальної комірки у GrowingStringGrid

(відносно екранної таблиці);

в режимах редагування (CurFormatState=fs_EnteringEqs, fs_EnteringLTask)

координати комірки, для якої викликано контекстне меню

(відносно верхньої лівої комірки таблиці коефіцієнтів (що має

тут координати [0,0])):}

CurGridSolveCol, CurGridSolveRow: Integer;

{Номери стовпця і рядка-заголовків у CurGrid :}

CHeadColNum, CHeadRowNum: Integer;

{Режим форматування і редагування чи розв'язування задачі:}

CurFormatState:TTableFormatState;

{Екранна таблиця для редагування чи відображення результатів:}

CurGrid:TGrowingStringGrid;

CurOutConsole:TMemo; {поле для відображення повідомлень}

{Адреси обробників подій екранної таблиці CurGrid , які цей

об'єкт заміняє своїми власними:}

OldOnNewCol:TNewColEvent;

OldOnNewRow:TNewRowEvent;

OldOnDrawCell:TDrawCellEvent;

OldOnDblClick:TNotifyEvent;

OldOnMouseUp:TMouseEvent;

OldOnSetEditText:TSetEditEvent;

{Процедура встановлює довжину рядка-заголовка CurHeadRow відповідно

до ширини екранної таблиці CurGrid і заповнює нові елементи

значеннями за змовчуванням. Використовується при зміні розмірів

екранної таблиці. Після її виклику можна вказувати типи змінних

у рядку-заголовку (користувач вибирає залежні та незалежні):}

ProcedureUpdateLTaskHeadRowToStrGrid (SGrid:TStringGrid);

{Процедура для підтримки масиву стовпця-заголовка під час

редагування таблиці. Встановлює довжину масиву відповідно до висоти

екранної таблиці і координат вписування в неї таблиці задачі,

заповнює нові комірки значеннями за змовчуванням:}

Procedure UpdateLTaskHeadColToStrGrid (SGrid:TStringGrid;

NewRows: array of Integer);

{Функції для переходів з одного режиму до іншого:}

Procedure SetNewState (Value:TTableFormatState);

Function PrepareToSolveEqsWithM1: Boolean;

Function PrepareToSolveEqsWithM2: Boolean;

Function PrepareToSolveLTask: Boolean;

Procedure SetNewGrid (Value:TGrowingStringGrid); {перехід до нового CurGrid}

Procedure SetNewMemo (Value:TMemo); {перехід до нового CurOutConsole}

{Процедури форматування GrowingStringGrid для набору таблиці

лінійних рівнянь:}

procedure EditLineEqsOnNewRow (Sender: TObject; NewRows: array of Integer);

procedure EditLineEqsOnNewCol (Sender: TObject; NewCols: array of Integer);

procedure EditLineEqsOnDrawCell (Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

{Процедура форматування GrowingStringGrid відображення таблиці

у процесі розв'язання системи рівнянь способом 1 і 2:}

procedure SolveLineEqsM1OrM2OnDrawCell (Sender: TObject;

ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедури форматування GrowingStringGrid для набору таблиці

задачі максимізації чи мінімізації лінійної форми (функції з

умовами-нерівностями чи рівняннями):}

procedure EdLineTaskOnNewRow (Sender: TObject; NewRows: array of Integer);

procedure EdLineTaskOnNewCol (Sender: TObject; NewCols: array of Integer);

procedure EdLineTaskOnDrawCell (Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure EdLineTaskOnDblClick (Sender: TObject);

{Процедура реагує на відпускання правої кнопки миші на

комірках рядка-заголовка та стовпця-заголовка таблиці.

Формує та відкриває контекстне меню для вибору типу комірки із можливих

типів для цієї комірки:}

procedure EdLineTaskOnMouseUp (Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

{Процедура перевіряє наявність об'єкта TPopupMenu. Якщо його немає

(SGrid. PopupMenu=Nil), то створює новий.

Видаляє усі пунтки (елементи, теми) з меню:}

ProcedureInitGridPopupMenu (SGrid:TStringGrid);

{Додає пункт меню для вибору типу комірки в таблиці з заданим

написом SCaption і кругом того кольору, що асоційований з даним

типом SAssocType . Для нового пункту меню настроює виклик

процедури обробки комірки для задавання їй обраного типу SAssocType .

Значення SAssocType записує у поле Tag об'єкта пункту меню:}

Procedure AddCellTypeItemToMenu (SMenu:TPopupMenu;

SCaption: String; IsCurrentItem: Boolean; SAssocType:THeadLineElmType;

ToSetReactOnClick: Boolean=True);

{Обробник вибору пункту в меню типів для комірки

рядка – чи стовпця-заголовка.}

Procedure ProcOnCellTypeSelInMenu (Sender: TObject);

{Процедури для нумерації рядків і стовпців при відображенні

таблиць у ході вирішення задачі, або з результатами. Лише

проставляють номери у першому стовпцю і першому рядку:}

procedure NumerationOnNewRow (Sender: TObject; NewRows: array of Integer);

procedure NumerationOnNewCol (Sender: TObject; NewCols: array of Integer);

{Процедура для реагування на редагування вмісту комірок

під час редагування вхідних даних. Встановлює прапорець

CurGridModified := True про те, що екранна таблиця має зміни:}

procedure ReactOnSetEditText (Sender: TObject; ACol, ARow: Longint;

const Value: string);

{Зчитує комірку з екранної таблиці в рядок-заголовок.

Вхідні дані:

SCol – номер комірки у рядку-заголовку.

Для екранної таблиці використовуються координати комірки відповідно до

координат рядка-заголовка та стовпця заголовка (верхнього лівого кута

таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid :}

ProcedureReadHeadRowCell (SCol: Integer);

{Зчитує комірку з екранної таблиці в стовпець-заголовок.

Вхідні дані:

SRow – номер комірки у стовпці-заголовку.

Для екранної таблиці використовуються координати комірки відповідно до

координат рядка-заголовка та стовпця заголовка (верхнього лівого кута

таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid :}

ProcedureReadHeadColCell (SRow: Integer);

{Процедура для зчитування таблиці та її заголовків із CurGrid :}

FunctionReadTableFromGrid: Boolean;

{Процедура для відображення таблиці та її заголовків у CurGrid :}

Function WriteTableToGrid (SHeadColNum, SHeadRowNum: Integer;

ToTuneColWidth: Boolean=True):Boolean;

{Визначення розмірів таблиці задачі, і корегування довжини

заголовків таблиці та зовнішнього масиву таблиці (масиву масивів):}

Procedure GetTaskSizes (Var DWidth, DHeight: Integer);

{Жорданове виключення за заданим розв'язувальним елементом матриці:}

Function GI (RozElmCol, RozElmRow: Integer;

Var SDHeadRow, SDHeadCol:TValOrNameMas; Var SDMatrix:TFloatMatrix;

Var DColDeleted: Boolean; ToDoMGI: Boolean=False;

ToDelColIfZeroInHRow: Boolean=True):Boolean;

{Відображення таблиці, обробка віконних подій доки користувач не

скомандує наступний крок (якщо користувач не скомандував вирішувати

до кінця):}

Procedure WaitForNewStep (HeadColNum, HeadRowNum: Integer);

{Пошук ненульової розв'язувальної комірки для вирішування системи

рівнянь (починаючи з комірки [ CurRowNum , CurColNum ]):}

Function SearchNozeroSolveCell (CurRowNum,

CurColNum, MaxRow, MaxCol: Integer;

HeadRowNum, HeadColNum: Integer;

ToSearchInRightColsToo: Boolean=True):Boolean;

{Зміна знаків у рядку таблиці і відповідній комірці у

стовпці-заголовку:}

Procedure ChangeSignsInRow (CurRowNum: Integer);

{Зміна знаків у стовпці таблиці і відповідній комірці у

рядку-заголовку:}

Procedure ChangeSignsInCol (CurColNum: Integer);

{Функція переміщує рядки таблиці CurTable (разом із відповідними

комірками у стовпці-заголовку CurHeadCol ) з заданими типами комірок

стовпця-заголовка вгору.

Повертає номер найвищого рядка із тих, що не було задано

переміщувати вгору (вище нього – ті, що переміщені вгору):}

Function ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

{Аналогічна до ShiftRowsUp , але переміщує вниз.

Повертає номер найвищого рядка із тих, що переміщені вниз (вище

нього – рядки тих типів, що не було задано переміщувати донизу):}

Function ShiftRowsDown (

SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

{Вирішування системи лінійних рівнянь способом 1:}

FunctionSolveEqsWithM1: Boolean;

{Вирішування системи лінійних рівнянь способом 2:}

FunctionSolveEqsWithM2: Boolean;

{Вирішування задачі максимізації лінійної форми (що містить

умови-нерівності, рівняння та умови на невід'ємність окремих

змінних і одну функцію мети, для якої треба знайти максимальне

значення):}

Function SolveLTaskToMax (DualTaskVals: Boolean):Boolean;

Function PrepareDFuncForSimplexMaximize: Boolean;

Function PrepareDestFuncInMultiDFuncLTask (SFuncRowNum,

MinDestFuncRowNum: Integer):Boolean;

{Процедура зчитує значення функції мети у таблиці розв'язаної

однокритеріальної задачі, і значення усіх змінних або функцій

в цьому розв'язку. Відображає значення цих змінних,

функцій-нерівностей, і функції мети в Self . CurOutConsole:}

Procedure ShowLTaskResultCalc (DualTaskVals: Boolean);

{Процедура зчитує значення функції мети у таблиці розв'язаної

однокритеріальної задачі, і значення усіх змінних або функцій в

цьому розв'язку:}

Procedure ReadCurFuncSolution (Var SDValVecs:TFloatMatrix;

Var SDDestFuncVals:TFloatArr; SVecRow: Integer;

ToReadFuncVals: Boolean; DualTaskVals: Boolean);

Procedure BuildPaymentTaskOfOptim (

Const SOptimXVecs:TFloatMatrix; Const SOptimFuncVals:TFloatArr;

SFirstDFuncRow: Integer);

Procedure CalcComprVec (Const SVarVecs:TFloatMatrix;

Const SWeightCoefs:TFloatArr; Var DComprVec:TFloatArr);

Function CalcDFuncVal (Const SVarVec:TFloatArr;

SDestFuncRowNum: Integer):TWorkFloat;

{Вирішування задачі багатокритеріальної оптимізації лінійної

форми з використанням теоретико-ігрового підходу.

Умовою задачі є умови-нерівності, рівняння та умови на

невід'ємність окремих змінних, і декілька функцій мети, для

яких треба знайти якомога більші чи менші значення.

Функція повертає ознаку успішності вирішування:}

FunctionSolveMultiCritLTask: Boolean;

{Процедури для зміни позиціювання таблиці з заголовками у

екранній таблиці CurGrid . Працюють лише у режимі fs _ FreeEdit :}

Procedure SetHeadColNum (Value: Integer);

Procedure SetHeadRowNum (Value: Integer);

public

{Прапорці для керування кроками вирішування:

Continue – продовжити на один крок;

GoToEnd – при продовженні йти всі кроки до кінця вирішування без

відображення таблиці на кожному кроці;

Stop – припинити вирішування.

Для керування прапорці можуть встановлюватися іншими потоками

програми, або і тим самим потоком (коли процедури даного класу

викликають Application. ProcessMessages):}

Continue, GoToEnd, Stop: Boolean;

{Властивість для керуання станом форматування:}

Property TableFormatState:TTableFormatState read CurFormatState

write SetNewState default fs_NoFormatting;

{Прапорець про те, що зараз задача у ході вирішування

(між кроками вирішування):}

Property Solving: Boolean read InSolving;

Property SolutionFound: Boolean read SolWasFound;

Property NoRoots: Boolean read WasNoRoots;

Property ManyRoots: Boolean read WasManyRoots;

{Властивість для задавання екранної таблиці:}

Property StringGrid:TGrowingStringGrid read CurGrid write SetNewGrid

defaultNil;

{Поле для відображення повідомлень:}

Property MemoForOutput:TMemo read CurOutConsole write SetNewMemo

defaultNil;

{Номери стовпця і рядка-заголовків у CurGrid . Змінювати можна

тільки у режимі fs _ FreeEdit . В інших режимах зміна ігнорується:}

Property HeadColNumInGrid: Integer read CHeadColNum write SetHeadColNum;

Property HeadRowNumInGrid: Integer read CHeadRowNum write SetHeadRowNum;

{Таблиця і її заголовки у пам'яті:}

Property Table:TFloatMatrix read CurTable;

Property HeadRow:TValOrNameMas read CurHeadRow;

Property HeadCol:TValOrNameMas read CurHeadCol;

{Читання і запис таблиці та режиму редагування у файл

(тільки у режимах редагування):}

Function ReadFromFile (Const SPath: String):Boolean;

Function SaveToFile (Const SPath: String):Boolean;

{Процедури для читання і зміни таблиці і її заголовків.

Не рекомендується застосовувати під час вирішування

(при Solving=True):}

Procedure SetTable (Const SHeadRow, SHeadCol:TValOrNameMas;

Const STable:TFloatMatrix);

Procedure GetTable (Var DHeadRow, DHeadCol:TValOrNameMas;

Var DTable:TFloatMatrix);

{Вибір кольору для фону комірки за типом елемента

стовпця – або рядка-заголовка:}

Function GetColorByElmType (CurType:THeadLineElmType):TColor;

{Вибір назви комірки за типом елемента

стовпця – або рядка-заголовка:}

Function GetNameByElmType (CurType:THeadLineElmType):String;

{Зчитування умови задачі із CurGrid та відображення прочитаного

на тому ж місці, де воно було. Працює у режимах

fs_EnteringEqs і fs_EnteringLTask.}

Function GetTask (ToPrepareGrid: Boolean=True):Boolean;

{Приймає останні зміни при редагуванні і відображає таблицю:}

Procedure Refresh;

Procedure ResetModified; {скидає прапорець зміненого стану}

Procedure UndoChanges; {відкидає останні зміни (ResetModified+Refresh)}

{Перехід від зчитаної умови задачі максимізації чи мінімізації

лінійної форми до двоїстої задачі. Працює у режимі редагування

задачі максимізації-мінімізації ( fs _ EnteringLTask ):}

FunctionMakeDualLTask: Boolean;

{Розміри прочитаної таблиці задачі:}

Function TaskWidth: Integer;

Function TaskHeight: Integer;

{Запускач вирішування. Працює у режимах fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask:}

Function Solve (ToGoToEnd: Boolean=False):Boolean;

Constructor Create;

Destructor Free;

End;

{Визначає знак дійсного числа:}

Function ValSign (Const Value:TWorkFloat):TSignVal; overload;

Function ValSign (Const Value:TValOrName):TSignVal; overload;

Function GetValOrNameAsStr (Const Value:TValOrName):String;

Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);

Procedure DeleteFromArr (Var SArr:TValOrNameMas; Index, Count: Integer);

overload;

Procedure DeleteFromArr (Var SArr:TFloatArr; Index, Count: Integer); overload;

Procedure DelColsFromMatr (Var SDMatrix:TFloatMatrix; ColIndex, Count: Integer);

Procedure DelRowsFromMatr (Var SDMatrix:TFloatMatrix; RowIndex, Count: Integer);

Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix; Row1, Row2: Integer);

overload;

Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix;

Var SDHeadCol:TValOrNameMas; Row1, Row2: Integer;

ToChangeInitPosNums: Boolean=False); overload;

Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix; Col1, Col2: Integer);

overload;

Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix;

Var SDHeadRow:TValOrNameMas; Col1, Col2: Integer;

ToChangeInitPosNums: Boolean=False); overload;

{Транспонування двовимірної матриці:}

Procedure Transpose (Var SDMatrix:TFloatMatrix);

implementation

const

sc_InvCoordsOfResolvingElm=

'Немає розв''язуючого елемента з такими координатами';

sc_ZeroResolvingElm='Розв''язуючий елемент рівний нулю';

sc_MatrixSize='Розміри матриці';

sc_NoGrowingStringGrid='GrowingStringGrid не заданий' + sc_TriSpot;

sc_UnknownVarType='Невідомий тип змінної';

sc_TableIsNotReady=': таблиця не готова' + sc_TriSpot;

sc_WrongEditMode=': не той режим редагування'+

' задачі. Не можу перейти до розв''язування' + sc_TriSpot;

sc_EmptyTable=': таблиця пуста' + sc_TriSpot;

sc_CantReadTaskInCurMode=

': у поточному режимі умова задачі не зчитується';

sc_CantWriteTaskInCurMode=

': не можу записати умову задачі з поточного режиму'+sc_TriSpot;

sc_CantCloseFile=': не можу закрити файл:'+sc_DoubleQuot;

sc_StartSolving=': починаю розв''язування' + sc_TriSpot;

sc_ZeroKoef=': нульовий коефіцієнт';

sc_SearchingOther=' шукаю інший' + sc_TriSpot;

sc_AllKoefIsZeroForVar=': усі коефіцієнти є нулі для змінної';

sc_AllKoefIsZero=': усі коефіцієнти для потрібних змінних є нулі'+sc_TriSpot;

sc_FreeVar=': вільна змінна (у її стовпці лише нулі, не впливає на результат)';

sc_NoRoots='Коренів немає.';

sc_NoVals='Значень немає.';

sc_ManyRoots='Коренів безліч.';

sc_UnlimitedFunc='Функція мети не обмежена.';

sc_SolutionFound='Корені знайдено.';

sc_ValFound='Значення знайдено.';

sc_SolvingStopped=': розв''язування припинено' + sc_TriSpot;

sc_ExcludingFreeVars=': виключаю незалежні змінні' + sc_TriSpot;

sc_CantExcludeFreeVars=': не можу виключити усі незалежні змінні.'+

sc_Space+sc_UnlimitedFunc;

sc_AllFreeVarsExcluded=': усі незалежні змінні виключені.';

sc_NoTableAreaToWork=

': Увага! У таблиці більше немає комірок для наступної обробки'+sc_TriSpot;

sc_ExcludingZeroRows=': виключаю 0-рядки' + sc_TriSpot;

sc_AllZeroInRow=': усі елементи – нулі у рядку';

sc_NoMNN=': не можу знайти МНВ для стовпця';

sc_AllZeroRowsExcluded=': усі 0-рядки виключені.';

sc_SearchingBaseSolve=': шукаю опорний розв''язок' + sc_TriSpot;

sc_BaseSolveFound=': опорний розв''язок знайдено.';

sc_SearchingOptimSolve=': шукаю оптимальний розв''язок' + sc_TriSpot;

sc_NoSolveMode=': поточний режим не є режимом для розв''язування'+sc_TriSpot;

sc_ValNotAvail='значення не доступно' + sc_TriSpot;

sc_ResultIs='Результат ';

sc_ForDualTask='для двоїстої задачі (відносно розв''язаної):';

sc_ForDirectTask='для прямої задачі:';

sc_InHeadRow='У рядку-заголовку:';

sc_InHeadCol='У стовпці-заголовку:';

sc_ResFunc='Функція мети:';

sc_CanMakeOnlyInELTaskMode='до двоїстої задачі можна переходити лише у '+

'режимі fs_EnteringLTask' + sc_TriSpot;

sc_CanMakeDTaskOnlyForOneDFunc=': можу переходити до двоїстої задачі ' +

'тільки від однокритеріальної задачі ЛП (з одною функцією мети). '+

'Всього функцій мети: ';

sc_CantChangeStateInSolving=

': не можу міняти режим під час розв''язування…';

sc_CantDetMenuItem=': не визначено пункт меню, який викликав процедуру…';

sc_UnknownObjectCall=': невідомий об''єкт, який викликав процедуру: клас ';

sc_NoCellOrNotSupported=': комірка не підтримується або не існує: ';

sc_Row='Рядок'; sc_Col='Стовпець';

sc_CantOpenFile=': не можу відкрити файл: «';

sc_EmptyFileOrCantRead=': файл пустий або не читається: «';

sc_FileNotFullOrHasWrongFormat=': файл не повний або не того формату: «';

sc_CantReadFile=': файл не читається: «';

sc_CantCreateFile=': не можу створити файл: «';

sc_CantWriteFile=': файл не вдається записати: «';

sc_CurRowNotMarkedAsDestFunc=

': заданий рядок не помічений як функція мети: рядок ';

sc_RowNumsIsOutOfTable=': задані номери рядків виходять за межі таблиці!..';

sc_NoDestFuncs=': немає рядків функцій мети! Задачу не розумію…';

sc_OnlyDestFuncsPresent=': у таблиці всі рядки є записами функцій мети!..';

sc_ForDestFunc=': для функції: ';

sc_SearchingMin='шукаю мінімум';

sc_SearchingMax='шукаю максимум';

sc_CalculatingNoOptMeasures=': підраховую міри неоптимальності…';

sc_AllMeasurIsZero=': усі міри рівні нулю, додаю до них одиницю…';

sc_UniqueMeasureCantSetZero=': є тільки одна міра оптимальності (і одна'+

' функція мети). Максимальна за модулем – вона ж. Додавання цієї'+

' максимальної величини замінить її на нуль. Тому заміняю на одиницю…';

sc_WeightCoefs='Вагові коефіцієнти (Li[Func]=ui/W(U)):';

sc_ComprVarVals='Компромісні значення змінних';

sc_DestFuncComprVals='Компромісні значення функцій мети:';

Function ValSign (Const Value:TWorkFloat):TSignVal; overload;

Var Res1:TSignVal;

Begin

Res1:=bc_Zero;

If Value<0 then Res1:=bc_Negative

Else if Value>0 then Res1:=bc_Positive;

ValSign:=Res1;

End;

Function ValSign (Const Value:TValOrName):TSignVal; overload;

Var Res1:TSignVal;

Begin

If Value. ElmType=bc_Number then

Res1:=ValSign (Value. AsNumber)

Else

Begin

If Pos (sc_Minus, Value. AsVarName)=1 then Res1:=bc_Negative

Else Res1:=bc_Positive;

End;

ValSign:=Res1;

End;

Function GetValOrNameAsStr (Const Value:TValOrName):String;

Begin

If Value. ElmType=bc_Number then

GetValOrNameAsStr:=FloatToStr (Value. AsNumber)

Else GetValOrNameAsStr:=Value. AsVarName;

End;

Procedure DeleteFromArr (Var SArr:TValOrNameMas; Index, Count: Integer); overload;

{Процедура для видалення з одновимірного масиву чисел чи назв змінних

SArr одного або більше елементів, починаючи з елемента з номером Index .

Видаляється Count елементів (якщо вони були у масиві починаючи із елемента

з номером Index).}

Var CurElm: Integer;

Begin

If Count<=0 then Exit; {якщо немає елементів для видалення}

{Якщо є хоч один елемент із заданих для видалення:}

If Length(SArr)>=(Index+1) then

Begin

{Якщо у масиві немає так багато елементів, скільки холіли видалити, то

коригуємо кількість тих, що видаляємо:}

If (Index+Count)>Length(SArr) then Count:=Length(SArr) – Index;

{Зсуваємо елементи масиву вліво, що залишаються справа після видалення

заданих:}

For CurElm:=Index to (Length(SArr) – 1-Count) do

SArr[CurElm]:=SArr [CurElm+Count];

{Видаляємо з масиву зайві елементи справа:}

SetLength (SArr, Length(SArr) – Count);

End;

End;

Procedure DeleteFromArr (Var SArr:TFloatArr; Index, Count: Integer); overload;

{Процедура для видалення з одновимірного масиву дійсних чисел

SArr одного або більше елементів, починаючи з елемента з номером Index .

Видаляється Count елементів (якщо вони були у масиві починаючи із елемента

з номером Index).}

Var CurElm: Integer;

Begin

If Count<=0 then Exit; {якщо немає елементів для видалення}

{Якщо є хоч один елемент із заданих для видалення:}

If Length(SArr)>=(Index+1) then

Begin

{Якщо у масиві немає так багато елементів, скільки холіли видалити, то

коригуємо кількість тих, що видаляємо:}

If (Index+Count)>Length(SArr) then Count:=Length(SArr) – Index;

{Зсуваємо елементи масиву вліво, що залишаються справа після видалення

заданих:}

For CurElm:=Index to (Length(SArr) – 1-Count) do

SArr[CurElm]:=SArr [CurElm+Count];

{Видаляємо з масиву зайві елементи справа:}

SetLength (SArr, Length(SArr) – Count);

End;

End;

Procedure DelColsFromMatr (Var SDMatrix:TFloatMatrix; ColIndex, Count: Integer);

{Процедура для видалення із матриці дійсних чисел

SHeadArr одного або більше стовпців, починаючи зі стовпця з номером ColIndex .

Видаляється Count стовпців (якщо вони були у матриці починаючи зі стовпця

з номером ColIndex).}

Var CurRow: Integer;

Begin

If Count<=0 then Exit; {якщо немає елементів для видалення}

{Видаляємо елементи у вказаних стовпцях з кожного рядка. Так

видалимо стовпці:}

For CurRow:=0 to (Length(SDMatrix) – 1) do

Begin

DeleteFromArr (SDMatrix[CurRow], ColIndex, Count);

End;

End;

Procedure DelRowsFromMatr (Var SDMatrix:TFloatMatrix; RowIndex, Count: Integer);

{Процедура для видалення із матриці дійсних чисел

SHeadArr одного або більше рядків, починаючи з рядка з номером RowIndex .

Видаляється Count рядків (якщо вони були у матриці починаючи з рядка

з номером RowIndex).}

Var CurElm: Integer;

Begin

If Count<=0 then Exit; {якщо немає елементів для видалення}

{Якщо є хоч один рядок із заданих для видалення:}

If Length(SDMatrix)>=(RowIndex+1) then

Begin

{Якщо у матриці немає так багато рядків, скільки холіли видалити, то

коригуємо кількість тих, що видаляємо:}

If (RowIndex+Count)>Length(SDMatrix) then Count:=Length(SDMatrix) – RowIndex;

{Зсуваємо рядки матриці вгору, що залишаються знизу після видалення

заданих:}

For CurElm:=RowIndex to (Length(SDMatrix) – 1-Count) do

SDMatrix[CurElm]:=SDMatrix [CurElm+Count];

{Видаляємо з матриці зайві рядки знизу:}

SetLength (SDMatrix, Length(SDMatrix) – Count);

End;

End;

Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);

{Зміна знаку числа або перед іменем змінної:}

Begin

If SDValOrName. ElmType=bc_Number then {для числа:}

SDValOrName. AsNumber:=-SDValOrName. AsNumber

Else {для рядка-назви:}

Begin

If Pos (sc_Minus, SDValOrName. AsVarName)=1 then

Delete (SDValOrName. AsVarName, 1, Length (sc_Minus))

Else SDValOrName. AsVarName:=sc_Minus+SDValOrName. AsVarName;

End;

End;

{Жорданове виключення за заданим розв'язувальним елементом матриці:}

Function TGridFormattingProcs.GI (RozElmCol, RozElmRow: Integer;

Var SDHeadRow, SDHeadCol:TValOrNameMas; Var SDMatrix:TFloatMatrix;

Var DColDeleted: Boolean;

ToDoMGI: Boolean=False; {прапорець на модифіковане Жорданове виключення}

ToDelColIfZeroInHRow: Boolean=True):Boolean;

{Функція виконує Жорданове виключення для елемента матриці

SDMatrix з координатами (RozElmCol, RozElmRow). Окрім обробки матриці,

здійснюється заміна місцями елементів у рядку і стовпцю-заголовках

матриці (SDHeadRow, SDHeadCol).

Вхідні дані:

RozElmCol – номер стовпця матриці, у якому лежить розв'язувальний елемент.

нумерація з нуля;

RozElmRow – номер рядка матриці, у якому лежить розв'язувальний елемент.

нумерація з нуля.

Розв'язувальний елемент не повинен бути рівним нулю, інакше виконання

Жорданового виключення не можливе;

SDHeadRow , SDHeadCol – рядок і стовпець-заголовки матриці. Рядок-заголовок

SDHeadRow повинен мати не менше елементів, ніж є ширина матриці. Він

містить множники. Стовпець-заголовок SDHeadCol повинен бути не коротшим

за висоту матриці. Він містить праві частини рівнянь (чи нерівностей)

системи. Рівняння полягають у тому що значення елементів

стовпця-заголовка прирівнюються до суми добутків елементів відповідного

рядка матриці і елементів рядка-заголовка. Елементи у цих заголовках

можуть бути числами або рядками-іменами змінних. Якщо довжина

рядка-заголовка менша за ширину або стовпця-заголовка менша за висоту

матриці, то частина комірок матриці, що виходять за ці межі, буде

проігнорована;

SDMatrix – матриця, у якій виконується Жорданове виключення;

ToDoMGI – прапорець, що вмикає режим модифікованого Жорданового виключення

(при ToDoMGI = True здійснюється модифіковане, інакше – звичайне).

Модифіковане Жорданове виключення використовується для матриці, у якій

було змінено знак початкових елементів, і змінено знаки елементів-

множників у рядку-заголовку. Використовується для симплекс-методу.

ToDelColIfZeroInHRow – прапорець, що вмикає видалення стовпця матриці із

розв'язувальним елементом, якщо після здійснення жорданівського

виключення у рядок-заголовок зі стовпця-заголовка записується число нуль.

Вихідні дані:

SDHeadRow , SDHeadCol – змінені рядок та стовпець-заголовки. У них

міняються місцями елементи, що стоять навпроти розв'язувального елемента

(у його стовпці (для заголовка-рядка) і рядку (для заголовка-стовпця).

У заголовку-рядку такий елемент після цього може бути видалений, якщо

він рівний нулю і ToDelColIfZeroInHRow = True .

Тобто Жорданове виключення змінює ролями ці елементи (виражає один

через інший у лінійних рівняннях чи нерівностях);

SDMatrix – матриця після виконання Жорданового виключення;

DColDeleted – ознака того, що при виконанні Жорданового виключення

був видалений розв'язувальний стовпець із матриці (у його комірці

у рядку-заголовку став був нуль).

Функція повертає ознаку успішності виконання Жорданового виключення.

}


Var CurRow, CurCol, RowCount, ColCount: Integer;

SafeHeadElm:TValOrName;

MultiplierIfMGI:TWorkFloat;

CurMessage: String;

Begin

{Визначаємо кількість рядків і стовпців, які можна обробити:}

RowCount:=Length(SDMatrix);

If RowCount<=0 then Begin GI:=False; Exit; End;

ColCount:=Length (SDMatrix[0]);

If Length(SDHeadCol)<RowCount then RowCount:=Length(SDHeadCol);

If Length(SDHeadRow)<ColCount then ColCount:=Length(SDHeadRow);

If (RowCount<=0) or (ColCount<=0) then Begin GI:=False; Exit; End;

{Перевіряємо наявність розв'язуючого елемента у матриці (за координатами):}

If (RozElmCol>(ColCount-1)) or (RozElmRow>(RowCount-1)) then

Begin

CurMessage:=sc_InvCoordsOfResolvingElm+': ['+IntToStr (RozElmCol+1)+';'+

IntToStr (RozElmRow+1)+']'+sc_CrLf+

sc_MatrixSize+': ['+IntToStr(ColCount)+';'+IntToStr(RowCount)+']';

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

GI:=False; Exit;

End;

{Якщо розв'язуючий елемент рівний нулю, то виконати Жорданове виключення

неможливо:}

If SDMatrix [RozElmRow, RozElmCol]=0 then

Begin

CurMessage:=sc_ZeroResolvingElm+': ['+IntToStr (RozElmCol+1)+';'+

IntToStr (RozElmRow+1)+']='+FloatToStr (SDMatrix[RozElmRow, RozElmCol]);

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

GI:=False; Exit;

End;

{Виконуємо Жорданове виключення у матриці:}

{Обробляємо усі елементи матриці, що не належать до рядка і стовпця

розв'язуючого елемента:}

For CurRow:=0 to RowCount-1 do

For CurCol:=0 to ColCount-1 do

If (CurRow<>RozElmRow) and (CurCol<>RozElmCol) then

Begin

SDMatrix [CurRow, CurCol]:=

(SDMatrix [CurRow, CurCol]*SDMatrix [RozElmRow, RozElmCol] –

SDMatrix [CurRow, RozElmCol]*SDMatrix [RozElmRow, CurCol]) /

SDMatrix [RozElmRow, RozElmCol];

End;

{+1, якщо задано зробити звичайне Жорданове виключення;

-1 – якщо задано модифіковане:}

MultiplierIfMGI:=(1–2*Abs (Ord(ToDoMGI)));

{Елементи стовпця розв'язуючого елемента (окрім його самого)

ділимо на розв'язуючий елемент:}

For CurRow:=0 to RowCount-1 do

If CurRow<>RozElmRow then

SDMatrix [CurRow, RozElmCol]:=MultiplierIfMGI*SDMatrix [CurRow, RozElmCol]/

SDMatrix [RozElmRow, RozElmCol];

{Елементи рядка розв'язуючого елемента (окрім його самого)

ділимо на розв'язуючий елемент з протилежним знаком:}

For CurCol:=0 to ColCount-1 do

If CurCol<>RozElmCol then

SDMatrix [RozElmRow, CurCol]:=-MultiplierIfMGI*SDMatrix [RozElmRow, CurCol]/

SDMatrix [RozElmRow, RozElmCol];

{Заміняємо розв'язуючий елемент на обернене до нього число:}

SDMatrix [RozElmRow, RozElmCol]:=1/SDMatrix [RozElmRow, RozElmCol];

{Міняємо місцями елементи рядка і стовпця-заголовків, що стоять у

стовпці і рядку розв'язуючого елемента:}

SafeHeadElm:= SDHeadRow[RozElmCol];

SDHeadRow[RozElmCol]:=SDHeadCol[RozElmRow];

SDHeadCol[RozElmRow]:=SafeHeadElm;

{Якщо виконуємо модиівковане Жорданове виключення, то змінюють

знаки і ці елементи, що помінялись місцями:}

If ToDoMGI then

Begin

ChangeSignForValOrVarName (SDHeadRow[RozElmCol]);

ChangeSignForValOrVarName (SDHeadCol[RozElmRow]);

End;

DColDeleted:=False;

{Якщо у рядку-заголовку навпроти розв'язуючого елемента опинився нуль,

і задано видаляти у такому випадку цей елемент разом із стовпцем

розв'язуючого елемента у матриці, то видаляємо:}

If ToDelColIfZeroInHRow and (SDHeadRow[RozElmCol].ElmType=bc_Number) then

If SDHeadRow[RozElmCol].AsNumber=0 then

Begin

DeleteFromArr (SDHeadRow, RozElmCol, 1);

DelColsFromMatr (SDMatrix, RozElmCol, 1);

DColDeleted:=True;

End;

GI:=True;

End;

Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix; Row1, Row2: Integer);

overload;

Var SafeCurRow:TFloatArr;

Begin

SafeCurRow:=SDMatr[Row1];

SDMatr[Row1]:=SDMatr[Row2];

SDMatr[Row2]:=SafeCurRow;

End;

Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix; Var SDHeadCol:TValOrNameMas;

Row1, Row2: Integer; ToChangeInitPosNums: Boolean=False); overload;

{Процедура міняє місцями рядки у таблиці зі стовпцем-заголовком.

Вхідні дані:

SDMatr – таблиця;

SDHeadCol – стовпець-заголовок таблиці;

Row 1, Row 2 – рядки, що треба поміняти місцями;

ToChangeInitPosNums – вмикач зміни номерів по порядку у

стовпці-заголовку. Якщо рівний True , то рядки, що помінялися місцями,

міняються також і позначками про номер по порядку та розміщення

як рядка чи стовпця (що присвоювалися їм при створенні).

Вихідні дані:

SDMatr – таблиця;

SDHeadCol – стовпець-заголовок таблиці.}

Var SafeCurHeadCell:TValOrName;

Begin

SafeCurHeadCell:=SDHeadCol[Row1];

SDHeadCol[Row1]:=SDHeadCol[Row2];

SDHeadCol[Row2]:=SafeCurHeadCell;

If ToChangeInitPosNums then

Begin

SDHeadCol[Row2].VarInitPos:=SDHeadCol[Row1].VarInitPos;

SDHeadCol[Row2].VarInitInRow:=SDHeadCol[Row1].VarInitInRow;

SDHeadCol[Row1].VarInitPos:=SafeCurHeadCell. VarInitPos;

SDHeadCol[Row1].VarInitInRow:=SafeCurHeadCell. VarInitInRow;

End;

ChangeRowsPlaces (SDMatr, Row1, Row2);

End;

Procedure ChangePlaces (Var SDMas:TFloatArr; Elm1, Elm2: Integer);

Var SafeElm:TWorkFloat;

Begin

SafeElm:=SDMas[Elm1];

SDMas[Elm1]:=SDMas[Elm2];

SDMas[Elm2]:=SafeElm;

End;

Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix; Col1, Col2: Integer);

overload;

Var CurRow: Integer;

Begin

For CurRow:=0 to Length(SDMatr) – 1 do

ChangePlaces (SDMatr[CurRow], Col1, Col2);

End;

Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix; Var SDHeadRow:TValOrNameMas;

Col1, Col2: Integer; ToChangeInitPosNums: Boolean=False); overload;

{Процедура міняє місцями стовпці у таблиці з рядком-заголовком.

Вхідні дані:

SDMatr – таблиця;

SDHeadRow – рядок-заголовок таблиці;

Row 1, Row 2 – рядки, що треба поміняти місцями;

ToChangeInitPosNums – вмикач зміни номерів по порядку у

стовпці-заголовку. Якщо рівний True , то рядки, що помінялися місцями,

міняються також і позначками про номер по порядку та розміщення

як рядка чи стовпця (що присвоювалися їм при створенні).

Вихідні дані:

SDMatr – таблиця;

SDHeadCol – рядок-заголовок таблиці.}

Var SafeCurHeadCell:TValOrName;

Begin

SafeCurHeadCell:=SDHeadRow[Col1];

SDHeadRow[Col1]:=SDHeadRow[Col2];

SDHeadRow[Col2]:=SafeCurHeadCell;

If ToChangeInitPosNums then

Begin

SDHeadRow[Col2].VarInitPos:=SDHeadRow[Col1].VarInitPos;

SDHeadRow[Col2].VarInitInRow:=SDHeadRow[Col1].VarInitInRow;

SDHeadRow[Col1].VarInitPos:=SafeCurHeadCell. VarInitPos;

SDHeadRow[Col1].VarInitInRow:=SafeCurHeadCell. VarInitInRow;

End;

ChangeColsPlaces (SDMatr, Col1, Col2);

End;

Procedure TGridFormattingProcs. WaitForNewStep (HeadColNum, HeadRowNum: Integer);

{Зупиняє хід вирішування, відображає поточний стан таблиці, і чекає,

доки не буде встановлений один з прапорців:

Self. Continue, Self. GoToEnd або Self. Stop.

Якщо прапорці Self. GoToEnd або Self. Stop вже були встановлені до

виклику цієї процедури, то процедура не чекає встановлення прапорців.}

Begin

{Якщо процедуру викликали, то треба почекати, доки не встановиться

Self . Continue = True , незважаючи на поточний стан цього прапорця:}

Self. Continue:=False;

{Відображаємо поточний стан таблиці, якщо не ввімкнено режим

роботи без зупинок:}

If Not (Self. GoToEnd) then

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

{Чекаємо підтвердження для наступного кроку, або переривання

розв'язування:}

While Not (Self. Continue or Self. GoToEnd or Self. Stop) do

Application. ProcessMessages;

End;

Function TGridFormattingProcs. SearchNozeroSolveCell (CurRowNum,

CurColNum, MaxRow, MaxCol: Integer;

HeadRowNum, HeadColNum: Integer;

ToSearchInRightColsToo: Boolean=True):Boolean;

{Пошук ненульової розв'язувальної комірки для вирішування системи рівнянь

або при вирішуванні задачі максимізації/мінімізації лінійної форми

симплекс-методом (починаючи з комірки [CurRowNum, CurColNum]).}

Const sc_CurProcName='SearchNozeroSolveCell';

Var CurSearchRowNum, CurSearchColNum: Integer;

st1: String;

Begin

{Якщо комірка, що хотіли взяти розв'язувальною, рівна нулю:}

If Self. CurTable [CurRowNum, CurColNum]=0 then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_ZeroKoef+

' ['+IntToStr (CurColNum+1)+'; '+IntToStr (CurRowNum+1)+']'+

sc_SearchingOther);

CurSearchRowNum:=MaxRow+1;

{Шукаємо ненульову комірку в заданій області (або в одному

її стовпці CurColNum, якщо ToSearchInRightColsToo=False):}

For CurSearchColNum:=CurColNum to MaxCol do

Begin

{Шукаємо ненульову комірку знизу у тому ж стовпцю:}

For CurSearchRowNum:=CurRowNum+1 to MaxRow do

Begin

If Self. CurTable [CurSearchRowNum, CurSearchColNum]<>0 then Break;

End;

{Якщо немає ненульових, то змінна вільна:}

If CurSearchRowNum>MaxRow then

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_AllKoefIsZeroForVar;

If Self. CurHeadRow[CurSearchColNum].ElmType=bc_Number then

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurSearchColNum].AsNumber)

Else st1:=st1+sc_Space+

sc_DoubleQuot+Self. CurHeadRow[CurSearchColNum].AsVarName+

sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

{Якщо потрібна комірка тільки у даному стовпці (для даної змінної),

то в інших стовцях не шукаємо:}

If Not(ToSearchInRightColsToo) then Break; {For CurSearchColNum…}

End

Else {Якщо знайдено ненульовий:}

Begin

Self. WaitForNewStep (HeadColNum, HeadRowNum);

{Якщо дано команду перервати розв'язування:}

If Self. Stop then

Begin

SearchNozeroSolveCell:=True; Exit;

End;

{Ставимо рядок із знайденим ненульовим замість поточного:}

ChangeRowsPlaces (Self. CurTable, Self. CurHeadCol, CurRowNum,

CurSearchRowNum);

{Якщо знайдена комірка у іншому стовпці, то міняємо місцями стовпці:}

If CurColNum<>CurSearchColNum then

ChangeColsPlaces (Self. CurTable, Self. CurHeadRow, CurColNum,

CurSearchColNum);

Break; {For CurSearchColNum:=CurColNum to MaxCol do…}

End;

End; {For CurSearchColNum:=CurColNum to MaxCol do…}

{Якщо ненульову комірку не знайдено:}

If (CurSearchColNum>MaxCol) or (CurSearchRowNum>MaxRow) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllKoefIsZero);

SearchNozeroSolveCell:=False;

Exit; {задача не має розв'язків, або має їх безліч…}

End;

End; {If Self. CurTable [CurRowNum, CurColNum]=0 then…}

SearchNozeroSolveCell:=True;

End;

{Вирішування системи лінійних рівнянь способом 1:}

Function TGridFormattingProcs. SolveEqsWithM1: Boolean;

{Для таблиці виду:

x1 x2 x3… xn

a1

a2

a3

am}

Const sc_CurProcName='SolveEqsWithM1';

Var CurRowNum, CurColNum: Integer;

st1: String;

HeadRowNum, HeadColNum: Integer;

ColDeleted: Boolean;

Procedure ShowResultCalc;

{Відображає записи про обчислення значень змінних (у текстовому полі)

такого зказка:

<стовп1>=< a 11>*<ряд1> + < a 12>*<ряд2> +… + <a1n>*<рядn>;

<стовпm>=<am1>*<ряд1> + <am2>*<ряд2> +… + <amn>*<рядn>;

І підраховує значення, якщо можливо:

<стовп1>=<значення1>;

<стовп m >=<значення m >}

VarCurRowN, CurColN: Integer; ValueAvail: Boolean;

CurVal:TWorkFloat;

st2: String;

NotEqual, NoRoots: Boolean;

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ResultIs+sc_DoubleSpot);

NoRoots:=False;

For CurRowN:=0 to Length (Self. CurHeadCol) – 1 do

Begin

st2:=''; ValueAvail:=True; CurVal:=0;

If Self. CurOutConsole<>Nil then

Begin

{<стовп i>=…:}

If Self. CurHeadCol[CurRowN].ElmType=bc_Number then

st2:=st2+FloatToStr (Self. CurHeadCol[CurRowN].AsNumber)

Else

st2:=st2+Self. CurHeadCol[CurRowN].AsVarName;

st1:=st2;

st1:=st1+sc_Space+sc_Equal+sc_Space; {=}

End;

For CurColN:=0 to Length (Self. CurHeadRow) – 1 do

Begin {(aij*:)

If Self. CurOutConsole<>Nil then

st1:=st1+sc_BrOp+FloatToStr (Self. CurTable [CurRowN, CurColN])+sc_Mul;

{рядj:}

If Self. CurHeadRow[CurColN].ElmType=bc_Number then

Begin

If Self. CurOutConsole<>Nil then

st1:=st1+FloatToStr (Self. CurHeadRow[CurColN].AsNumber);

If ValueAvail then CurVal:=CurVal +

Self. CurTable [CurRowN, CurColN]*Self. CurHeadRow[CurColN].AsNumber;

End

Else

Begin

If Self. CurOutConsole<>Nil then

st1:=st1+Self. CurHeadRow[CurColN].AsVarName;

ValueAvail:=False;

End;

If Self. CurOutConsole<>Nil then

Begin

st1:=st1+sc_BrCl; {)}

If CurColN<>(Length (Self. CurHeadRow) – 1) then

st1:=st1+sc_Space+sc_Plus+sc_Space {+}

Else st1:=st1+sc_KrKm; {;}

End;

End;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add(st1);

st1:=st2;

End;

If ValueAvail then

Begin

NotEqual:=False;

If Self. CurHeadCol[CurRowN].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRowN].AsNumber<>CurVal then

Begin NoRoots:=True; NotEqual:=True; End;

End;

If Self. CurOutConsole<>Nil then

Begin

If NotEqual then

st1:=st1+sc_Space+sc_NotEqual+sc_Space {<>}

Else st1:=st1+sc_Space+sc_Equal+sc_Space; {=}

st1:=st1+FloatToStr(CurVal)+sc_KrKm; {<стовп i><V><значення>;}

End;

End

Else

Begin

If Self. CurOutConsole<>Nil then st1:=st1+sc_Space+sc_ValNotAvail;

Self. WasManyRoots:=True;

End;

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add(st1);

End;

If NoRoots then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_NoRoots);

Self. WasManyRoots:=False;

End

Else if Not (Self. WasManyRoots) then Self. SolWasFound:=True;

Self. WasNoRoots:=NoRoots;

End;

Label LStopLabel;

Begin

If Self. TaskWidth<=0 then {Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

SolveEqsWithM1:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;


If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

CurRowNum:=0; {починаємо з першого рядка}

{Проходимо по усіх стовпцях (по усіх змінних), намагаючись брати

розв'язувальні комірки по головній діагоналі. Якщо серед таких зустрінеться

нуль, спробуємо знайти ненульову комірку нижче, і поміняти рядки нульової

з ненульовою, щоб ненульова стала на головній діагоналі:}

CurColNum:=0;

While (CurColNum<Length (Self. CurHeadRow)) and

(CurRowNum<Length (Self. CurHeadCol)) do

Begin

{Координати розв'язувальної комірки для помітки кольором в екранній

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Перевіряємо, чи не є поточна комірка нулем, і при потребі шукаємо

ненульову:}

If Not (Self. SearchNozeroSolveCell (CurRowNum, CurColNum,

Length (Self. CurHeadCol) – 1, Length (Self. CurHeadRow) – 1,

HeadRowNum, HeadColNum)) then

Break; {якщо не знайдено…}

If Self. Stop then Goto LStopLabel;

WaitForNewStep (HeadColNum, HeadRowNum);

{Якщо дано команду перервати розв'язування:}

If Self. Stop then Goto LStopLabel;

ColDeleted:=False;

{Обробляємо таблицю звичайним Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRowNum, Self. CurHeadRow, Self. CurHeadCol,

Self. CurTable, ColDeleted, False, True)) then

Begin

SolveEqsWithM1:=False;

Exit;

End;

{Переходимо до наступного рядка, так як у цьому вже виразили одну із

змінних:}

Inc(CurRowNum);

If Not(ColDeleted) then Inc(CurColNum);

End;

ShowResultCalc;

SolveEqsWithM1:=True;

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_SolvingStopped);

SolveEqsWithM1:=False;

Exit;

End;

{Вирішування системи лінійних рівнянь способом 2:}

Function TGridFormattingProcs. SolveEqsWithM2: Boolean;

{Для таблиці виду:

x1 x2 x3… xn 1

0

0

0

0}

Const sc_CurProcName='SolveEqsWithM2';

Var CurRowNum, CurColNum: Integer;

st1: String;

HeadRowNum, HeadColNum: Integer;

ColDeleted: Boolean;

ProcedureShowResultCalc;

{Відображає записи значень змінних (у текстовому полі)

такого зказка:

<стовп1>=<значення1>;

<стовп m >=<значення m >;

та відображає повідомлення про наявність коренів і їх визначеність.}

Var CurRowN, CurColN: Integer;

CurVal:TWorkFloat;

NotEqual, NoRoots, FreeRoots: Boolean;

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ResultIs+sc_DoubleSpot);


NoRoots:=False;

For CurRowN:=0 to Length (Self. CurHeadCol) – 1 do

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:='';

{<стовп i>=…:}

If Self. CurHeadCol[CurRowN].ElmType=bc_Number then

st1:=st1+FloatToStr (Self. CurHeadCol[CurRowN].AsNumber)

Else

st1:=st1+Self. CurHeadCol[CurRowN].AsVarName;

End;

NotEqual:=False;

CurVal:=Self. CurTable [CurRowN, Length (Self. CurHeadRow) – 1];

If Self. CurHeadCol[CurRowN].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRowN].AsNumber<>CurVal then

Begin NoRoots:=True; NotEqual:=True; End;

End;

If Self. CurOutConsole<>Nil then

Begin

If NotEqual then

st1:=st1+sc_Space+sc_NotEqual+sc_Space {<>}

Else st1:=st1+sc_Space+sc_Equal+sc_Space; {=}

st1:=st1+FloatToStr(CurVal)+sc_KrKm; {<стовп i><V><значення>;}

Self. CurOutConsole. Lines. Add(st1);

End;

End; {For CurRowN:=0 to Length (Self. CurHeadCol) – 1 do…}

{Переріряємо, чи залишилися змінні у рядку-заголовку. Якщо так, то

корені вільні, і якщо система сумісна, то їх безліч:}

FreeRoots:=False;

For CurColN:=0 to Length (Self. CurHeadRow) – 1 do

Begin

If Self. CurHeadRow[CurColN].ElmType<>bc_Number then

Begin FreeRoots:=True; Break; End;

End;

If NoRoots then

Begin

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_NoRoots);

Self. WasNoRoots:=True;

End

Else if FreeRoots then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ManyRoots);

Self. WasManyRoots:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_SolutionFound);

Self. SolWasFound:=True;

End;

End;

Label LStopLabel;

Begin

If Self. TaskWidth<=0 then{Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

SolveEqsWithM2:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

CurRowNum:=0; {починаємо з першого рядка}

{Проходимо по усіх стовпцях (по усіх змінних), намагаючись брати

розв'язувальні комірки по головній діагоналі. Якщо серед таких зустрінеться

нуль, спробуємо знайти ненульову комірку нижче, і поміняти рядки нульової

з ненульовою, щоб ненульова стала на головній діагоналі.

При цьому останній стовпець не беремо (у ньому вільні члени –

праві частини рівнянь):}

CurColNum:=0;

While (CurColNum<(Length (Self. CurHeadRow) – 1)) and{останній стовпець не беремо}

(CurRowNum<Length (Self. CurHeadCol)) do

Begin

{Координати розв'язувальної комірки для помітки кольором в екранній

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Перевіряємо, чи не є поточна комірка нулем, і при потребі шукаємо

ненульову серед коефіцієнтів, окрім стовпця вільних членів

(що є останнім):}

If Not (Self. SearchNozeroSolveCell (CurRowNum, CurColNum,

Length (Self. CurHeadCol) – 1, Length (Self. CurHeadRow) – 2,

HeadRowNum, HeadColNum)) then

Break; {якщо не знайдено…}

If Self. Stop then Goto LStopLabel;

WaitForNewStep (HeadColNum, HeadRowNum);

{Якщо дано команду перервати розв'язування:}

If Self. Stop then Goto LStopLabel;

ColDeleted:=False;

{Обробляємо таблицю звичайним Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRowNum, Self. CurHeadRow, Self. CurHeadCol,

Self. CurTable, ColDeleted, False, True)) then

Begin

SolveEqsWithM2:=False;

Exit;

End;

{Переходимо до наступного рядка, так як у цьому вже виразили одну із

змінних:}

Inc(CurRowNum);

If Not(ColDeleted) then Inc(CurColNum);

End;

ShowResultCalc;

SolveEqsWithM2:=True;

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_SolvingStopped);

SolveEqsWithM2:=False;

Exit;

End;

{Запускач вирішування. Працює у режимах fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask:}

Function TGridFormattingProcs. Solve (ToGoToEnd: Boolean=False):Boolean;

Const sc_CurProcName='Solve';

Var

Res1: Boolean;

st1: String;

Begin

Self. InSolving:=True;

Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;

Self. Stop:=False; Self. GoToEnd:=ToGoToEnd;

Res1:=False;

Case Self. CurFormatState of

fs_SolvingEqsM1: Res1:=Self. SolveEqsWithM1;

fs_SolvingEqsM2: Res1:=Self. SolveEqsWithM2;

fs_SolvingLTask: Res1:=Self. SolveMultiCritLTask;

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoSolveMode);

End;

End;

If Self. CurOutConsole<>Nil then

Begin

st1:='Вирішування закінчено.';

If Res1 then st1:=st1+' Успішно.' else st1:=st1+' З помилками' + sc_TriSpot;

Self. CurOutConsole. Lines. Add(st1);

End;

Self. InSolving:=False;

{Відображаємо таблицю вкінці вирішування:}

Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum, True);

Solve:=Res1;

End;

Constructor TGridFormattingProcs. Create;

Begin

Inherited Create;

InSolving:=False;

SolWasFound:=False; WasNoRoots:=False; WasManyRoots:=False;

EqM1TaskPrepared:=False; EqM2TaskPrepared:=False; LTaskPrepared:=False;

Continue:=False; GoToEnd:=False; Stop:=False;

CurGridModified:=False;

CurGridSolveCol:=0; CurGridSolveRow:=0;

TableFormatState:=fs_NoFormatting;

StringGrid:=Nil;

OldOnNewCol:=Nil;

OldOnNewRow:=Nil;

OldOnDrawCell:=Nil;

OldOnDblClick:=Nil;

OldOnMouseUp:=Nil;

OldOnSetEditText:=Nil;

{SetLength (CurHeadRow, 0); SetLength (CurHeadCol, 0);

SetLength (CurTable, 0);}

Self. CurHeadRow:=Nil;

Self. CurHeadCol:=Nil;

Self. CurTable:=Nil;

Self. CopyHeadRow:=Nil;

Self. CopyHeadCol:=Nil;

Self. CopyTable:=Nil;

CurOutConsole:=Nil;

End;

Destructor TGridFormattingProcs. Free;

Begin

{Inherited Free;} {inaccessible value;

…raised too many consecutive exceptions:

access violation at address 0x00000000 read of address 0x00000000…}

End;

Function TGridFormattingProcs. GetColorByElmType (CurType:THeadLineElmType):TColor;

Const sc_CurProcName='GetColorByElmType';

Var CurColor:TColor;

Begin

Case CurType of

bc_IndependentVar: CurColor:=lwc_IndependentColor;

bc_DependentVar: CurColor:=lwc_DependentColor;

bc_FuncVal: CurColor:=lwc_HeadColColor;

bc_Number: CurColor:=lwc_ValInHeadColOrRowColor;

bc_DestFuncToMax: CurColor:=lwc_DestFuncToMaxNameColor;

bc_DestFuncToMin: CurColor:=lwc_DestFuncToMinNameColor;

bc_OtherType:

If Self. CurGrid<>Nil then CurColor:=Self. CurGrid. Color

else CurColor:=clWindow;

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+':'+sc_Space+

sc_UnknownVarType+sc_Space+IntToStr (Ord(CurType))+

sc_Space+sc_TriSpot);

CurColor:=bc_NotColored;

End;

End;

GetColorByElmType:=CurColor;

End;

Function TGridFormattingProcs. GetNameByElmType (CurType:THeadLineElmType):String;

Const sc_CurProcName='GetNameByElmType';

Var CurName: String;

Begin

Case CurType of

bc_IndependentVar: CurName:=sc_IndependentVar;

bc_DependentVar: CurName:=sc_DependentVar;

bc_FuncVal: CurName:=sc_InequalFuncName;

bc_Number: CurName:=sc_ValInHeadColOrRow;

bc_DestFuncToMax: CurName:=sc_DestFuncToMaxName;

bc_DestFuncToMin: CurName:=sc_DestFuncToMinName;

bc_OtherType: CurName:=sc_OtherType;

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+':'+sc_Space+

sc_UnknownVarType+sc_Space+IntToStr (Ord(CurType))+sc_Space+

sc_TriSpot);

CurName:=sc_UnknownVarType;

End;

End;

GetNameByElmType:=CurName;

End;

Function TGridFormattingProcs. ReadFromFile (Const SPath: String):Boolean;

{Читання умови задачі із файла.}

Const sc_CurProcName='ReadFromFile';

Var CurFile: File; CurColCount, CurRowCount, CurCol, CurRow, ControlSize: Integer;

GotFormatState:TTableFormatState;

CurMessage: String;

Begin

If ((Self. CurFormatState<>fs_EnteringEqs) and

(Self. CurFormatState<>fs_EnteringLTask) and

(Self. CurFormatState<>fs_NoFormatting) and

(Self. CurFormatState<>fs_FreeEdit))

or (Self. InSolving) then

Begin

CurMessage:=sc_CurProcName+sc_CantReadTaskInCurMode+sc_TriSpot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

System. AssignFile (CurFile, SPath);

System. FileMode:=fmOpenRead;

try {Пробуємо відкрити файл:}

System. Reset (CurFile, 1);

except

CurMessage:=sc_CurProcName+sc_CantOpenFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

try {Пробуємо прочитати дескриптори кількості рядків і стовпців у задачі:}

System. BlockRead (CurFile, CurColCount, SizeOf(CurColCount));

System. BlockRead (CurFile, CurRowCount, SizeOf(CurRowCount));

Except

CurMessage:=sc_CurProcName+sc_EmptyFileOrCantRead+SPath+

sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

{Обчислюємо розмір, який повинні займати усі дані у файлі:}

ControlSize:=SizeOf(CurColCount)+SizeOf(CurRowCount)+

+SizeOf (Self. CurFormatState)+

SizeOf(TValOrName)*CurColCount+ SizeOf(TValOrName)*CurRowCount+

SizeOf(TWorkFloat)*CurColCount*CurRowCount;

{Перевіряємо, чи має файл такий розмір:}

If ControlSize<>System. FileSize(CurFile) then

Begin

CurMessage:=sc_CurProcName+sc_FileNotFullOrHasWrongFormat+SPath+

sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

Try

System. BlockRead (CurFile, GotFormatState, SizeOf(GotFormatState));

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

{Встановлюємо режим, що був збережений у файлі разом з умовою задачі:}

Self. TableFormatState:=GotFormatState;

{Читаємо рядок-заголовок:}

SetLength (Self. CurHeadRow, CurColCount);

For CurCol:=0 to CurColCount-1 do

Begin

Try

System. BlockRead (CurFile, Self. CurHeadRow[CurCol], SizeOf(TValOrName));

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

End;

{Читаємо стовпець-заголовок:}

SetLength (Self. CurHeadCol, CurRowCount);

For CurRow:=0 to CurRowCount-1 do

Begin

Try

System. BlockRead (CurFile, Self. CurHeadCol[CurRow], SizeOf(TValOrName));

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

End;

{Читаємо таблицю коефіцієнтів і вільних членів:}

SetLength (Self. CurTable, CurRowCount, CurColCount);

For CurRow:=0 to CurRowCount-1 do

Begin

For CurCol:=0 to CurColCount-1 do

Begin

Try

System. BlockRead (CurFile, Self. CurTable [CurRow, CurCol],

SizeOf(TWorkFloat));

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

ReadFromFile:=False; Exit;

End;

End;

End;

Try

System. Close(CurFile);

Except

CurMessage:=sc_CurProcName + sc_CantCloseFile + SPath + sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

End;

Self. CurGridModified:=False;

Self. Refresh;

{Відмічаємо, що прочитана умова задачі не підготована ще до вирішування

жодним із методів вирішування:}

Self. EqM1TaskPrepared:=False;

Self. EqM2TaskPrepared:=False;

Self.LTaskPrepared:=False;

ReadFromFile:=True;

End;

Function TGridFormattingProcs. SaveToFile (Const SPath: String):Boolean;

{Запис умови задачі у файл.}

Const sc_CurProcName='SaveToFile';

Var CurFile: File; CurColCount, CurRowCount, CurCol, CurRow: Integer;

CurMessage: String;

Begin

If ((Self. CurFormatState<>fs_EnteringEqs) and

(Self. CurFormatState<>fs_EnteringLTask) and

(Self. CurFormatState<>fs_FreeEdit))

or (Self. InSolving) then

Begin

CurMessage:=sc_CurProcName+sc_CantWriteTaskInCurMode;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

{Якщо таблиця модифікована, умова не прочитана з неї, то читаємо:}

If Self. CurGridModified then

Begin

If Not (Self. GetTask(True)) then

Begin

SaveToFile:=False; Exit;

End;

End;

System. AssignFile (CurFile, SPath);

System. FileMode:=fmOpenWrite;

try {Пробуємо створити новий файл:}

System. Rewrite (CurFile, 1);

except

CurMessage:=sc_CurProcName+sc_CantCreateFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

Self. GetTaskSizes (CurColCount, CurRowCount);

try {Пробуємо прочитати дескриптори кількості рядків і стовпців у задачі:}

System. BlockWrite (CurFile, CurColCount, SizeOf(CurColCount));

System. BlockWrite (CurFile, CurRowCount, SizeOf(CurRowCount));

System. BlockWrite (CurFile, Self. CurFormatState,

SizeOf (Self. CurFormatState));

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

{Записуємо рядок-заголовок:}

For CurCol:=0 to CurColCount-1 do

Begin

Try

System. BlockWrite (CurFile, Self. CurHeadRow[CurCol], SizeOf(TValOrName));

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

End;

{Записуємо стовпець-заголовок:}

For CurRow:=0 to CurRowCount-1 do

Begin

Try

System. BlockWrite (CurFile, Self. CurHeadCol[CurRow], SizeOf(TValOrName));

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

End;

{Записуємо таблицю коефіцієнтів і вільних членів:}

For CurRow:=0 to CurRowCount-1 do

Begin

For CurCol:=0 to CurColCount-1 do

Begin

Try

System. BlockWrite (CurFile, Self. CurTable [CurRow, CurCol],

SizeOf(TWorkFloat));

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

End;

End;

Try

System. Close(CurFile);

Except

CurMessage:=sc_CurProcName + sc_CantCloseFile + SPath + sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

MessageDlg (CurMessage, mtError, [mbOk], 0);

SaveToFile:=False; Exit;

End;

SaveToFile:=True;

End;

Procedure TGridFormattingProcs. SetTable (Const SHeadRow, SHeadCol:TValOrNameMas;

Const STable:TFloatMatrix);

{Задає нову таблицю і загноловки (що могли бути сформовані поза об'єктом):}

Begin

Self. CurTable:=STable;

Self. CurHeadRow:=SHeadRow;

Self. CurHeadCol:=SHeadCol;

Self. TaskWidth; {перевіряємо розміри нової таблиці і її заголовків}

End;

Procedure TGridFormattingProcs. GetTable (Var DHeadRow, DHeadCol:TValOrNameMas;

Var DTable:TFloatMatrix);

{Повертає посилання на таблицю і її заголовки.}

Begin

DTable:=Self. CurTable;

DHeadRow:=Self. CurHeadRow;

DHeadCol:=Self. CurHeadCol;

End;

Procedure TGridFormattingProcs. ReadHeadRowCell (SCol: Integer);

{Зчитує комірку з екранної таблиці в рядок-заголовок.

Вхідні дані:

SCol – номер комірки у рядку-заголовку.

Для екранної таблиці використовуються координати комірки відповідно до

координат рядка-заголовка та стовпця заголовка (верхнього лівого кута

таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid .}

Var CurFloatVal:TWorkFloat; CurElmType:THeadLineElmType;

Begin

CurElmType:=CurHeadRow[SCol].ElmType;

CurFloatVal:=0;

Try {Пробуємо розпізнати число:}

CurFloatVal:=StrToFloat (CurGrid. Cells [SCol+bc_LTaskColsBeforeVars+

Self.CHeadColNum, Self.CHeadRowNum]);

CurElmType:=bc_Number; {якщо число розпізналося, то це число}

Except{Якщо рядок не інтерпретується як число, але під час редагування

була зроблена помітка про те, що це є число або функція, то вважаємо

його назвою незалежної змінної (бо всі функції в умові задачі мають

бути в стовпці-заголовку, а не в рядку):}

If (CurElmType<>bc_IndependentVar) and (CurElmType<>bc_DependentVar) then

CurElmType:=bc_IndependentVar;

End; {Виправлений тип елемента:}

CurHeadRow[SCol].ElmType:=CurElmType;

If CurElmType=bc_Number then {записуємо число, якщо розпізналося:}

CurHeadRow[SCol].AsNumber:=CurFloatVal

Else

Begin {якщо число не розпізналося, то записуємо як назву змінної:}

With CurHeadRow[SCol] do

Begin

AsVarName:=CurGrid. Cells [SCol+bc_LTaskColsBeforeVars+Self.CHeadColNum,

Self.CHeadRowNum]; {назва}

VarInitPos:=SCol; {номер п/п у рядку в умові задачі}

VarInitInRow:=True; {ознака, що змінна спочатку була у рядку-заголовку}

End;

End;

End;

Procedure TGridFormattingProcs. ReadHeadColCell (SRow: Integer);

{Зчитує комірку з екранної таблиці в стовпець-заголовок.

Вхідні дані:

SRow – номер комірки у стовпці-заголовку.

Для екранної таблиці використовуються координати комірки відповідно до

координат рядка-заголовка та стовпця заголовка (верхнього лівого кута

таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid .}

Var CurFloatVal:TWorkFloat; CurElmType:THeadLineElmType;

Begin

CurElmType:=CurHeadCol[SRow].ElmType;

CurFloatVal:=0;

Try {Пробуємо розпізнати число:}

CurFloatVal:=StrToFloat (CurGrid. Cells [Self.CHeadColNum,

SRow+bc_LTaskRowsBeforeVars+Self.CHeadRowNum]);

CurElmType:=bc_Number; {якщо число розпізналося, то це число}

Except{Якщо рядок не інтерпретується як число, але комірка вважалася

такою, що містить число або змінну, то вважаємо його назвою функції

(бо це не число, і не повинно бути змінною – усі змінні спочатку

у рядку-заголовку):}

If (CurElmType<>bc_FuncVal) and (CurElmType<>bc_DestFuncToMax) and

(CurElmType<>bc_DestFuncToMin) then

CurElmType:=bc_FuncVal;

End; {Виправлений тип елемента:}

CurHeadCol[SRow].ElmType:=CurElmType;

If CurElmType=bc_Number then {записуємо число, якщо розпізналося:}

CurHeadCol[SRow].AsNumber:=CurFloatVal

Else

Begin {якщо число не розпізналося, то записуємо як назву змінної:}

With CurHeadCol[SRow] do

Begin

AsVarName:=CurGrid. Cells [Self.CHeadColNum,

SRow+bc_LTaskRowsBeforeVars+Self.CHeadRowNum]; {назва}

VarInitPos:=SRow; {номер п/п у стовпці в умові задачі}

{Ознака, що змінна спочатку була у стовпці-заголовку:}

VarInitInRow:=False;

End;

End;

End;

Function TGridFormattingProcs. ReadTableFromGrid: Boolean;

Const sc_CurProcName='ReadTableFromGrid';

{Процедура для зчитування таблиці та її заголовків із CurGrid.

Для екранної таблиці використовуються координати рядка-заголовка та

стовпця заголовка (верхнього лівого кута таблиці з заголовками):

HeadColNumInGrid (CHeadColNum) і HeadRowNumInGrid (CHeadRowNum).}

Var CurRow, CurCol, CurWidth, CurHeight: Integer;

CurFloatVal:TWorkFloat;

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

': '+sc_NoGrowingStringGrid);

ReadTableFromGrid:=False;

Exit;

End;

{Ширина і висота таблиці з заголовками:}

CurWidth:=Self. CurGrid. ColCount-Self.CHeadColNum-bc_LTaskColsBeforeVars;

CurHeight:=Self. CurGrid. RowCount-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

If (CurHeight<=0) or (CurWidth<=0) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

': починаючи з комірки ['+IntToStr (Self.CHeadColNum+1)+'; '+

IntToStr (Self.CHeadRowNum+1)+'] таблиці не знайдено' + sc_TriSpot);

ReadTableFromGrid:=False;

Exit;

End;

{Виділяємо пам'ять:}

SetLength (Self. CurHeadRow, CurWidth); {рядок-заголовок}

SetLength (Self. CurHeadCol, CurHeight); {стовпець-заголовок}

SetLength (Self. CurTable, CurHeight, CurWidth); {таблиця}

{Читаємо рядок-заголовок:}

For CurCol:=0 to CurWidth-1 do ReadHeadRowCell(CurCol);

{Читаємо стовпець-заголовок:}

For CurRow:=0 to CurHeight-1 do ReadHeadColCell(CurRow);

{Читаємо таблицю коефіцієнтів:}

For CurRow:=Self.CHeadRowNum+bc_LTaskRowsBeforeVars to

Self. CurGrid. RowCount-1 do

Begin

For CurCol:=Self.CHeadColNum+bc_LTaskColsBeforeVars to

Self. CurGrid. ColCount-1 do

Begin

Try {Пробуємо інтерпретувати рядок із комірки як число:}

CurFloatVal:=StrToFloat (CurGrid. Cells [CurCol, CurRow]);

Except{Якщо не вдалося, то вважаємо це число нулем:}

CurFloatVal:=0;

End;

Self. CurTable [CurRow-bc_LTaskRowsBeforeVars-Self.CHeadRowNum,

CurCol-bc_LTaskColsBeforeVars-Self.CHeadColNum]:=CurFloatVal;

End;

End;

{Після читання зміни в екранній таблиці враховані:}

Self. CurGridModified:=False;

ReadTableFromGrid:=True;

End;

Function TGridFormattingProcs. WriteTableToGrid (SHeadColNum,

SHeadRowNum: Integer; ToTuneColWidth: Boolean=True):Boolean;

{Процедура для відображення таблиці та її заголовків у CurGrid .}

Const sc_CurProcName='WriteTableToGrid';

Var CurRow, CurCol, CurWidth, CurHeight: Integer;

CurElmType:THeadLineElmType;

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

': GrowingStringGrid не заданий!..');

WriteTableToGrid:=True;

Exit;

End;

{Ширина і висота таблиці:}

Self. GetTaskSizes (CurWidth, CurHeight);

If (CurHeight<=0) or (CurWidth<=0) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_EmptyTable);

WriteTableToGrid:=False;

Exit;

End;

{Виділяємо комірки для таблиці у екранному CurGrid:}

Self. CurGrid. ColCount:=CurWidth+SHeadColNum+1;

Self. CurGrid. RowCount:=CurHeight+SHeadRowNum+1;

{Відображаємо рядок-заголовок:}

For CurCol:=SHeadColNum+1 to Self. CurGrid. ColCount-1 do

Begin

CurElmType:=CurHeadRow [CurCol-1-SHeadColNum].ElmType;

If CurElmType=bc_Number then {записуємо число, якщо є числом:}

CurGrid. Cells [CurCol, SHeadRowNum]:=

FloatToStr (CurHeadRow[CurCol-1-SHeadColNum].AsNumber)

Else{Якщо це не число, то це рядок з якоюсь назвою. Записуємо:}

Self. CurGrid. Cells [CurCol, SHeadRowNum]:=

CurHeadRow [CurCol-1-SHeadColNum].AsVarName;

End;

{Відображаємо стовпець-заголовок:}

For CurRow:=SHeadRowNum+1 to Self. CurGrid. RowCount-1 do

Begin

CurElmType:=CurHeadCol [CurRow-1-SHeadRowNum].ElmType;

If CurElmType=bc_Number then {записуємо число, якщо є числом:}

CurGrid. Cells [SHeadColNum, CurRow]:=

FloatToStr (CurHeadCol[CurRow-1-SHeadRowNum].AsNumber)

Else{Якщо це не число, то це рядок з якоюсь назвою. Записуємо:}

Self. CurGrid. Cells [SHeadColNum, CurRow]:=

CurHeadCol [CurRow-1-SHeadRowNum].AsVarName;

End;

{Відображаємо таблицю коефіцієнтів:}

For CurRow:=SHeadRowNum+1 to Self. CurGrid. RowCount-1 do

Begin

For CurCol:=SHeadColNum+1 to Self. CurGrid. ColCount-1 do

CurGrid. Cells [CurCol, CurRow]:=

FloatToStr (Self. CurTable [CurRow-1-SHeadRowNum, CurCol-1-SHeadColNum]);

End;

{Комірка на перехресті заголовків пуста:}

If (SHeadRowNum<Self. CurGrid. RowCount) and

(SHeadColNum<Self. CurGrid. ColCount) then

CurGrid. Cells [SHeadColNum, SHeadRowNum]:='';

{Після запису в екранну таблицю: зміни, що могли бути у ній, вважаємо

затертими:}

Self. CurGridModified:=False;

{Якщо задано, настроюємо ширини стовпців по довжині тексту у комірках:}

If ToTuneColWidth then Self. CurGrid. TuneColWidth;

WriteTableToGrid:=True;

End;

Procedure TGridFormattingProcs. GetTaskSizes (Var DWidth, DHeight: Integer);

{Визначення розмірів таблиці задачі, і корегування довжини заголовків

таблиці та зовнішнього масиву таблиці (масиву масивів).}

Begin

DHeight:=Length (Self. CurTable);

If DHeight>0 then

DWidth:=Length (Self. CurTable[0])

Else DWidth:=0;

If DWidth=0 then DHeight:=0;

If DWidth>Length (Self. CurHeadRow) then

DWidth:=Length (Self. CurHeadRow);

If DHeight>Length (Self. CurHeadCol) then

DHeight:=Length (Self. CurHeadCol);

{Якщо комірок немає, то:}

If DWidth=0 then

Begin

{Зовнійшій масив встановлюємо у нульову довжину:}

SetLength (Self. CurTable, 0);

{Заголовки теж:}

SetLength (Self. CurHeadRow, 0);

SetLength (Self. CurHeadCol, 0);

End;

End;

{Розміри прочитаної таблиці задачі:}

Function TGridFormattingProcs. TaskWidth: Integer;

Var CurWidth, CurHeight: Integer;

Begin

Self. GetTaskSizes (CurWidth, CurHeight);

TaskWidth:=CurWidth;

End;

Function TGridFormattingProcs. TaskHeight: Integer;

Var CurWidth, CurHeight: Integer;

Begin

Self. GetTaskSizes (CurWidth, CurHeight);

TaskHeight:=CurHeight;

End;

Function TGridFormattingProcs. GetTask (ToPrepareGrid: Boolean=True):Boolean;

{Зчитування умови задачі із CurGrid та відображення прочитаного

на тому ж місці, де воно було. Працює у режимах

fs_EnteringEqs і fs_EnteringLTask.}

Const sc_CurProcName='GetTask';

Var Res1: Boolean;

Procedure DoGetTask;

Begin

If ToPrepareGrid then

CurGrid. ShrinkToFilled (Self.CHeadColNum+1, Self.CHeadRowNum+1);

{Читаємо комірки таблиці:}

Res1:=Self. ReadTableFromGrid;

{Відображаємо те, що вийшло прочитати, у тих самих комірках на екрані:}

If Not (Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum)) then

Res1:=False;

End;

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+': '+sc_NoGrowingStringGrid);

GetTask:=False;

Exit;

End;

Case Self. CurFormatState of

fs_EnteringEqs: {режим редагування системи лінійних рівнянь:}

Begin

{Зчитуємо таблицю. Як рядок-заголовок зчитуємо автоматично

сформовані назви змінних x 1… xn та множник вільних членів (1).

Як стовпець-заголовок зчитуємо стовпець нумерації.

При переході до режиму вирішування задачі у цей стовпець

будуть скопійовані вільні члени (режим способу 1, fs _ SolvingEqsM 1),

або нулі (режим способу 2, fs _ SolvingEqsM 2):}

DoGetTask;

If Not(Res1) then Begin GetTask:=False; Exit; End;

End;

fs_EnteringLTask: {режим редагування форми задачі лінійного програмування:}

Begin

{Зчитуємо таблицю умови для задачі ЛП максимізації або

мінімізації лінійної форми (функції з умовами-нерівностями,

рівняннями та обмеженнями невід'ємності, імена змінних, нерівностей,

функцій):}

DoGetTask;

If Not(Res1) then Begin GetTask:=False; Exit; End;

End;

fs_FreeEdit: {режим вільного редагування:}

Begin

{Читаємо таблицю, рядок-заголовок, стовпець-заголовок:}

DoGetTask;

If Not(Res1) then Begin GetTask:=False; Exit; End;

End;

Else {інші режими:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_CantReadTaskInCurMode

+ sc_TriSpot);

GetTask:=False;

Exit;

End;

End;

{If ToPrepareGrid then CurGrid. TuneColWidth;}

Self. EqM1TaskPrepared:=False;

Self. EqM2TaskPrepared:=False;

Self.LTaskPrepared:=False;

GetTask:=True;

End;

Procedure TGridFormattingProcs. Refresh;

Const sc_CurProcName='Refresh';

Var Res1: Boolean;

Begin

If Self. CurFormatState<>fs_NoFormatting then

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+': '+

sc_NoGrowingStringGrid);

Exit;

End;

Res1:=False;

{Якщо таблиця редагована або ще не читана, то запускаємо її зчитування:}

If Self. CurGridModified or (Self. TaskWidth<=0) then Res1:=Self. GetTask;

If Not(Res1) then {Якщо таблиця не була віджображена у GetTask, відображаємо:}

Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum);

End;

End;

Procedure TGridFormattingProcs. ResetModified; {скидає прапорець зміненого стану}

Begin

Self. CurGridModified:=False;

End;

Procedure TGridFormattingProcs. UndoChanges;

{Відкидає останні зміни (ResetModified+Refresh).}

Begin

Self. ResetModified; Self. Refresh;

End;

Procedure Transpose (Var SDMatrix:TFloatMatrix);

{Транспонування двовимірної матриці.}

Var CurCol, CurRow, CurWidth, CurHeight: Integer;

SafeElm:TWorkFloat;

Begin

CurHeight:=Length(SDMatrix);

If CurHeight>0 then CurWidth:=Length (SDMatrix[0])

Else CurWidth:=0;

If (CurHeight=0) or (CurWidth=0) then Exit;

{Збільшуємо розміри матриці до квадратних:}

IfCurWidth>CurHeightthen{Якщо ширина була більша за висоту:}

Begin

SetLength (SDMatrix, CurWidth, CurWidth); {збільшуємо висоту}

End

ElseifCurWidth<CurHeightthen{Якщо висота була більша за ширину:}

Begin

SetLength (SDMatrix, CurHeight, CurHeight); {збільшуємо ширину}

End;

{Міняємо елементи місцями: рядки будуть стовпцями, а стовпці – рядками:}

For CurRow:=0 to Length(SDMatrix) – 1 do

Begin

For CurCol:=CurRow + 1 to Length (SDMatrix[CurRow]) – 1 do

Begin

SafeElm:=SDMatrix [CurRow, CurCol];

SDMatrix [CurRow, CurCol]:=SDMatrix [CurCol, CurRow];

SDMatrix [CurCol, CurRow]:=SafeElm;

End;

End;

{Ширина тепер буде така як була висота, а висота – як була ширина:}

SetLength (SDMatrix, CurWidth, CurHeight);

End;

Function TGridFormattingProcs. MakeDualLTask: Boolean;

{Перехід від зчитаної умови задачі максимізації чи мінімізації

лінійної форми до двоїстої задачі. Працює у режимі редагування

задачі максимізації-мінімізації (fs_EnteringLTask).

За правилом двоїсту задачу потрібно мінімізувати, якщо для прямої

потрібно було знайти максимум, і максимізувати, якщо для прямої потрібно

було знайти мінімум.

}

Constsc_CurProcName='MakeDualLTask';

Var SafeMas:TValOrNameMas; CurCol, CurRow, DFuncCount: Integer;

DualTType:TDualTaskType; NewDFuncType, OldDFuncType:THeadLineElmType;

Begin

SafeMas:=Nil;

If Self. CurFormatState<>fs_EnteringLTask then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CanMakeOnlyInELTaskMode);

MakeDualLTask:=False; Exit;

End;

If Self. CurGridModified then

Begin

If Not (Self. GetTask(True)) then

Begin

MakeDualLTask:=False; Exit;

End;

End;

If Self. TaskHeight<=0 then {Якщо таблиця пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_EmptyTable);

MakeDualLTask:=False; Exit;

End;

{Перевіряємо, чи функція мети лише одна, і визначаємо її тип

(для максимізації чи мінімізації):}

DFuncCount:=0; DualTType:=dt_MaxToMin; OldDFuncType:=bc_DestFuncToMax;

For CurRow:=0 to Length (Self. CurHeadCol) – 1 do

Begin

If Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMax then

Begin

DualTType:=dt_MaxToMin;

OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;

Inc(DFuncCount);

End

Else if Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMin then

Begin

DualTType:=dt_MinToMax;

OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;

Inc(DFuncCount);

End;

End;

{Якщо функцій мети декілька або жодної:}

If DFuncCount<>1 then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

sc_CanMakeDTaskOnlyForOneDFunc+IntToStr(DFuncCount));

MakeDualLTask:=False; Exit;

End;

If DualTType=dt_MaxToMin then NewDFuncType:=bc_DestFuncToMin

Else NewDFuncType:=bc_DestFuncToMax;

{Зсуваємо рядок функції мети вниз таблиці. При цьому позначки порядку

рядків залишаємо на тих самих місцях (і присвоюємо тим рядкам, які

стають на ці місця):}

Self. ShiftRowsDown([bc_DestFuncToMax, bc_DestFuncToMin], True);

Transpose (Self. CurTable); {транспонуємо таблицю коефіцієнтів}

{Обробляємо заголовки таблиці у відповідність до двоїстої задачі:}

{Для рядка-заголовка, що стане стовпцем-заголовком:}

For CurCol:=0 to Length (Self. CurHeadRow) – 1 do

Begin {Проходимо по усіх змінних і останньому елементу –

множнику стовпця вільних членів – одиниці:}

If Self. CurHeadRow[CurCol].ElmType=bc_DependentVar then {Якщо змінна >=0:}

Begin {Ця комірка буде заголовком функції умови-нерівності зі знаком «>=»:}

Self. CurHeadRow[CurCol].ElmType:=bc_FuncVal;

Self. CurHeadRow[CurCol].VarInitInRow:=False;

{Формуємо назву функції:}

{якщо змінна має назву змінної двоїстої задачі, то дамо назву

функції прямої задачі, якщо назва прямої – назву двоїстої:}

If Pos (sc_DualTaskVarNameStart, Self. CurHeadRow[CurCol].AsVarName)>0 then

Self. CurHeadRow[CurCol].AsVarName:=sc_YFuncName + IntToStr (CurCol+1)

Else Self. CurHeadRow[CurCol].AsVarName:=sc_DualTaskFuncNameStart +

IntToStr (CurCol+1);

{Якщо переходимо від задачі максимізації до двоїстої задачі

мінімізації, то для нерівності треба буде змінити знак «>=» на «<=»,

(якщо для змінної була умова «>=0», і заголовок для неї був додатний),

тому змінюємо знак заголовка:}

IfDualTType=dt_MaxToMinthen

ChangeSignForValOrVarName (Self. CurHeadRow[CurCol]);

End {Якщо змінна вільна:}

Else if Self. CurHeadRow[CurCol].ElmType=bc_IndependentVar then

Begin{Ця комірка буде заголовком умови-рівняння:}

Self. CurHeadRow[CurCol].ElmType:=bc_Number;

Self. CurHeadRow[CurCol].AsNumber:=0;

End {Якщо це число:}

Else if Self. CurHeadRow[CurCol].ElmType=bc_Number then

Begin

If Self. CurHeadRow[CurCol].AsNumber=1 then {якщо це множник вільних членів}

Begin

Self. CurHeadRow[CurCol].ElmType:=NewDFuncType;

Self. CurHeadRow[CurCol].VarInitInRow:=False;

{Формуємо назву функції мети двоїстої задачі

(залежно від назви функції мети поданої задачі):}

If Pos (sc_DualDestFuncHdr,

Self. CurHeadCol [Length(Self. CurHeadCol) – 1].AsVarName)>0 then

Self. CurHeadRow[CurCol].AsVarName:=sc_DestFuncHdr

Else Self. CurHeadRow[CurCol].AsVarName:=sc_DualDestFuncHdr;

End;

End;

End;


{Для стовпця-заголовка, що стане рядком-заголовком:}

For CurRow:=0 to Length (Self. CurHeadCol) – 1 do

Begin

{Проходимо по усіх елементах-заголовках рядків, і останньому елементу –

заголовку рядка функції мети:}

IfSelf. CurHeadCol[CurRow].ElmType=bc_FuncValthen{Якщо нерівність «<=»:}

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_DependentVar; {буде змінна >=0}

Self. CurHeadCol[CurRow].VarInitInRow:=True;

{Формуємо назву змінної:

якщо функція-нерівність має назву функції двоїстої задачі, то

дамо назву змінної прямої задачі, якщо назва прямої – назву двоїстої:}

If Pos (sc_DualTaskFuncNameStart, CurHeadCol[CurRow].AsVarName)>0 then

Self. CurHeadCol[CurRow].AsVarName:=sc_XVarName + IntToStr (CurRow+1)

Else Self. CurHeadCol[CurRow].AsVarName:=sc_DualTaskVarNameStart +

IntToStr (CurRow+1);

{Якщо переходимо від задачі мінімізації до двоїстої задачі

максимізації, то для змінної треба буде змінити знак і умову «<=0»

на «>=0», (якщо для нерівність була зі знаком «<=», і заголовок для

неї був додатний), тому змінюємо знак заголовка:}

If DualTType=dt_MinToMax then

ChangeSignForValOrVarName (Self. CurHeadCol[CurRow]);

End

Else if Self. CurHeadCol[CurRow].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRow].AsNumber=0 then {Якщо 0, заголовок рівняння:}

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_IndependentVar;

Self. CurHeadCol[CurRow].VarInitInRow:=True;

{Формуємо назву змінної двоїстої задачі

(залежно від назви функції мети поданої задачі):}

If Pos (sc_DualDestFuncHdr,

Self. CurHeadCol [Length(Self. CurHeadCol) – 1].AsVarName)>0 then

Self. CurHeadCol[CurRow].AsVarName:=sc_XVarName+IntToStr (CurRow+1)

Else Self. CurHeadCol[CurRow].AsVarName:=sc_DualTaskVarNameStart+

IntToStr (CurRow+1);

End;

End {Якщо заголовок рядка функції мети:}

Else if Self. CurHeadCol[CurRow].ElmType=OldDFuncType then

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_Number;

Self. CurHeadCol[CurRow].AsNumber:=1; {буде множник стовпця вільних членів}

End;

End;

{Міняємо рядок і стовпець-заголовки таблиці місцями:}

SafeMas:=Self. CurHeadRow;

Self. CurHeadRow:=Self. CurHeadCol;

Self. CurHeadCol:=SafeMas;

{У новому стовпці-заголовку шукаємо комірки-заголовки нерівностей «>=».

Їх заміняємо на «<=» множенням рядка на -1:}

For CurRow:=0 to Length (Self. CurHeadCol) – 1 do

Begin

If Self. CurHeadCol[CurRow].ElmType=bc_FuncVal then

Begin

If ValSign (Self. CurHeadCol[CurRow])=bc_Negative then

Self. ChangeSignsInRow(CurRow);

End;

End;

{У новому рядку-заголовку шукаємо комірки-заголовки залежних змінних,

які мають умову «<=0». Змінюємо цю умову на «>=0» множенням стовпця на -1:}

For CurCol:=0 to Length (Self. CurHeadRow) – 1 do

Begin

If Self. CurHeadRow[CurCol].ElmType=bc_DependentVar then

Begin

If ValSign (Self. CurHeadRow[CurCol])=bc_Negative then

Self. ChangeSignsInCol(CurCol);

End;

End;

{Відображаємо отриману таблицю у екранній таблиці:}

Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum);


MakeDualLTask:=True;

End;

Function TGridFormattingProcs. PrepareToSolveEqsWithM1: Boolean;

Const sc_CurProcName='PrepareToSolveEqsWithM1';

Var CurRow, ColToDel: Integer;

Begin

If (Self. CurFormatState=fs_EnteringEqs) or

(Self. CurFormatState=fs_NoFormatting) then

Begin

{Якщо таблиця не зчитана, то читаємо:}

If (Self. CurGridModified) and (Self. CurFormatState=fs_EnteringEqs) then

Begin

If Not (Self. GetTask) then

Begin

PrepareToSolveEqsWithM1:=False; Exit;

End;

End;

If Self. TaskHeight<=0 then {Якщо таблиця пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_EmptyTable);

PrepareToSolveEqsWithM1:=False;

Exit;

End;

If Not (Self. EqM1TaskPrepared) then

Begin

{Копіюємо стовпець вільних членів (правих частин рівнянь) із

останнього стовпця таблиці до стовпця-заголовка:}

For CurRow:=0 to Length (Self. CurHeadCol) – 1 do

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_Number;

Self. CurHeadCol[CurRow].AsNumber:=

Self. CurTable [CurRow, Length (CurTable[CurRow]) – 1];

End;

{Видаляємо цей останній стовпець із таблиці:}

ColToDel:=Length (Self. CurTable[0]) – 1;

DelColsFromMatr (Self. CurTable, ColToDel, 1);

DeleteFromArr (Self. CurHeadRow, ColToDel, 1);

End;

{Позиціювання відображення таблиці у даному режимі вирішування:}

Self.CHeadColNum:=CurGrid. FixedCols;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Відображаємо таблицю, що підготована для розв'язування:}

Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum);

{Якщо таблиця пуста після перенесення останнього стовпця у

стовпець-заголовок:}

If Self. TaskHeight<=0 then

Begin

PrepareToSolveEqsWithM1:=False;

Exit;

End;

Self. EqM1TaskPrepared:=True;

PrepareToSolveEqsWithM1:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_WrongEditMode);

PrepareToSolveEqsWithM1:=False;

End;

End;

Function TGridFormattingProcs. PrepareToSolveEqsWithM2: Boolean;

Const sc_CurProcName='PrepareToSolveEqsWithM2';

Var CurRow: Integer;

Begin

If (Self. CurFormatState=fs_EnteringEqs) or

(Self. CurFormatState=fs_NoFormatting) then

Begin {Якщо таблиця не зчитана, то читаємо:}

If (Self. CurGridModified) and (Self. CurFormatState=fs_EnteringEqs) then

Begin

If Not (Self. GetTask) then

Begin

PrepareToSolveEqsWithM2:=False; Exit;

End;

End;

If Self. TaskHeight<=0 then {Якщо таблиця пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_TableIsNotReady);

PrepareToSolveEqsWithM2:=False; Exit;

End;

If Not (Self. EqM2TaskPrepared) then

Begin

For CurRow:=0 to Length (Self. CurHeadCol) – 1 do

Begin

{Заповнюємо стовпець-заголовок нулями:}

Self. CurHeadCol[CurRow].ElmType:=bc_Number;

Self. CurHeadCol[CurRow].AsNumber:=0;

{Змінюємо знаки у останньому стовпці таблиці – стовпці вільних

членів. Так як вони у правих частинах рівнянь, то знаходячись у

таблиці коефіцієнтів лівих частин, повинні бути з протилежними

знаками:}

Self. CurTable [CurRow, Length (CurTable[CurRow]) – 1]:=

– Self. CurTable [CurRow, Length (CurTable[CurRow]) – 1];

End;

End;

{Позиціювання відображення таблиці у даному режимі вирішування:}

Self.CHeadColNum:=CurGrid. FixedCols;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Відображаємо таюдицю, що підготована для розв'язування:}

Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum);

Self. EqM2TaskPrepared:=True;

PrepareToSolveEqsWithM2:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_WrongEditMode);

PrepareToSolveEqsWithM2:=False;

End;

End;

{TTableFormatState=(fs_EnteringEqs, fs_EnteringLTask, fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask,

fs_NoFormatting, fs_FreeEdit);}

Function TGridFormattingProcs. PrepareToSolveLTask: Boolean;

Const sc_CurProcName='PrepareToSolveLTask';

Begin

If (Self. CurFormatState=fs_EnteringLTask) or

(Self. CurFormatState=fs_NoFormatting) then

Begin {Якщо таблиця у режимі редагування задачі, і модифікована, то зчитуємо:}

If (Self. CurGridModified) and (Self. CurFormatState=fs_EnteringLTask) then

Begin

If Not (Self. GetTask) then {зчитуємо таблицю (умову) з екранної таблиці}

Begin

PrepareToSolveLTask:=False; Exit;

End;

End;

If Self. TaskHeight<=0 then {Якщо таблиця пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_TableIsNotReady);

PrepareToSolveLTask:=False; Exit;

End;

If Not (Self.LTaskPrepared) then {якщо ця підготовка ще не виконувалася:}

Begin

{Зсуваємо рядки цільових функцій вниз. При цьому позначки порядку

рядків залишаємо на тих самих місцях (і присвоюємо тим рядкам, які

стають на ці місця):}

Self. ShiftRowsDown([bc_DestFuncToMax, bc_DestFuncToMin], True);

{Позиціювання відображення таблиці у даному режимі вирішування:}

Self.CHeadColNum:=CurGrid. FixedCols;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Відображаємо таблицю, що підготована для розв'язування:}

Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum);

Self.LTaskPrepared:=True;

End;

PrepareToSolveLTask:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_WrongEditMode);

PrepareToSolveLTask:=False;

End;

End;

Function TGridFormattingProcs. PrepareDFuncForSimplexMaximize: Boolean;

Var ToMax: Boolean; Row, Col, CurWidth, DFuncRowNum: Integer;

Const sc_CurProcName='PrepareDFuncForSimplexMaximize';

Begin

CurWidth:=Length (Self. CurHeadRow);

DFuncRowNum:=Length (Self. CurHeadCol) – 1;

Case Self. CurHeadCol[DFuncRowNum].ElmType of {перевіряємо тип функції мети:}

bc_DestFuncToMax: ToMax:=True;

bc_DestFuncToMin: ToMax:=False;

Else{якщо заданий рядок виявився не функцією мети:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

sc_CurRowNotMarkedAsDestFunc+IntToStr (DFuncRowNum+1));

PrepareDFuncForSimplexMaximize:=False; Exit;

End;

End;

{Готуємо умову для вирішування симплекс-методом максимізації:}

{Міняємо знаки у елементів рядка-заголовка, окрім знака останньої

комірки – то множник для стовпця правих частин. Це є

інтерпретацією перенесення усіх доданків у праву частину, і

форматом для виконання модифікованих Жорданових виключень:}

For Col:=0 to CurWidth-2 do

ChangeSignForValOrVarName (Self. CurHeadRow[Col]);

{Якщо треба шукати максимум, то множимо коефіцієнти функції мети

на -1 (окрім вільгого члена), бо помножили і усі x 1… xn на -1.

Якщо треба мінімум, то ці коефіцієнти не множимо

(бо x 1… xn вже помножені), але множимо вільний член функції. Тоді

отримаємо протилежну функцію, щоб знайти її максимум

(це протилежний мінімум заданої функції):}

Row:=Length (Self. CurHeadCol) – 1; {рядок функції мети}

If ToMax then

Begin

For Col:=0 to CurWidth-2 do {коефіцієнти функції мети міняють знаки:}

Self. CurTable [Row, Col]:=-Self. CurTable [Row, Col];

End

Else {Якщо треба знайти мінімум:}

Begin{Множимо вільний член функції мети на -1:}

Self. CurTable [Row, CurWidth-1]:=-Self. CurTable [Row, CurWidth-1];

{Назва функції теж міняє знак:}

ChangeSignForValOrVarName (Self. CurHeadCol[Row]);

{Тепер це протилежна функція для максимізації:}

Self. CurHeadCol[Row].ElmType:=bc_DestFuncToMax;

End;

PrepareDFuncForSimplexMaximize:=True;

End;

Function TGridFormattingProcs. PrepareDestFuncInMultiDFuncLTask (

SFuncRowNum, MinDestFuncRowNum: Integer):Boolean;

{Готує таблицю для розв'язування задачі ЛП відносно одної заданої функції

мети із багатокритеріальної задачі.

Вхідні дані:

SFuncRowNum – номер рядка у таблиці Self . CopyTable (і комірки у

стовпці-заголовку Self . CopyHeadCol ), в якому записана портібна

функція мети;

DestFuncMinRowNum – номер найвищого (з найменшим номером) рядка

функції мети. Усі функції мети мають бути зібрані внизу таблиці;

Self . CopyTable – таблиця коефіцієнтів та вільних членів;

Self . CopyHeadRow – рядок-заголовок зі змінними та одиницею-множником

стовпця вільних членів (має бути останнім);

Self . CopyHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

нулями (заголовки рядків-рівнянь), іменами функцій мети

(що максимізуються (тип комірки bc _ DestFuncToMax ) або мінімізуються

(тип bc _ DestFuncToMin )).

Вихідні дані:

Умова для одної функції:

Self . CurTable – таблиця коефіцієнтів та вільних членів з одною

функцією мети в останньому рядку, для максимізації симплекс-методом;

Self . CurHeadRow – рядок-заголовок;

Self . CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

нулями (заголовки рядків-рівнянь), і одною коміркою функції мети

(остання, найнижча комірка), яку треба максимізувати. Якщо у цій

комірці перед назвою функції стоїть знак «–», то після максимізації

її треба замінити на протилежну функцію (і отримати мінімізацію

тої функції, яка була задана в умові).

Підпрограма повертає ознаку успішності підготовки умови із одною

заданою функцією мети.}

Var Row, Col, CurWidth, CurHeight: Integer;

Const sc_CurProcName='PrepareDestFuncInMultiDFuncLTask';

Label LStopLabel;

Begin

If Not (Self. GoToEnd) then

Begin{Демонструємо функцію мети у таблиці, з якою будемо працювати:}

{Таблиця багатокритеріальної задачі для відображення:}

Self. CurHeadRow:=Self. CopyHeadRow; Self. CurHeadCol:=Self. CopyHeadCol;

Self. CurTable:=Self. CopyTable;

{Координати рядка функції для помітки його кольором:}

Self. CurGridSolveCol:=Self.CHeadColNum;

Self. CurGridSolveRow:=SFuncRowNum+Self.CHeadRowNum+bc_LTaskRowsBeforeVars;

{Відображаємо і чекаємо реакції користувача:}

WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum);

If Self. Stop then Goto LStopLabel;

End;

CurWidth:=Length (Self. CopyHeadRow);

CurHeight:=Length (Self. CopyHeadCol);

If (SFuncRowNum<0) or (MinDestFuncRowNum<0) or

(SFuncRowNum>=CurHeight) or (MinDestFuncRowNum>=CurHeight) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_RowNumsIsOutOfTable);

PrepareDestFuncInMultiDFuncLTask:=False; Exit;

End;

{Формуємо умову однокритеріальної задачі лінійного програмування із

копії умови багатокритеріальної задачі:}

{Копіюємо заголовки і таблицю коефіцієнтів:}

SetLength (Self. CurHeadRow, CurWidth); {довжина для рядка заголовка така сама}

For Col:=0 to CurWidth-1 do Self. CurHeadRow[Col]:=Self. CopyHeadRow[Col];

{Стовпець-заголовок і висота таблиці мають усі рядки умов (рівнянь

та нерівностей) і один рядок функції мети:}

SetLength (Self. CurHeadCol, MinDestFuncRowNum+1);

SetLength (Self. CurTable, MinDestFuncRowNum+1, CurWidth);

For Row:=0 to MinDestFuncRowNum-1 do {копіюємо рядки умов:}

Begin

Self. CurHeadCol[Row]:=Self. CopyHeadCol[Row];

For Col:=0 to CurWidth-1 do

Self. CurTable [Row, Col]:=Self. CopyTable [Row, Col];

End;

{В останній рядок таблиці однокритеріальної задачі копіюємо заданий

рядок функції мети із багатокритеріальної задачі:}

Row:=MinDestFuncRowNum; {номер останнього рядка у однокритеріальній задачі}

Self. CurHeadCol[Row]:=Self. CopyHeadCol[SFuncRowNum];

For Col:=0 to CurWidth-1 do

Self. CurTable [Row, Col]:=Self. CopyTable [SFuncRowNum, Col];

PrepareDestFuncInMultiDFuncLTask:=Self. PrepareDFuncForSimplexMaximize;

Exit;

LStopLabel:

PrepareDestFuncInMultiDFuncLTask:=False; Exit;

End;

Procedure TGridFormattingProcs. ShowLTaskResultCalc (DualTaskVals: Boolean);

{Процедура зчитує значення функції мети у таблиці розв'язаної

однокритеріальної задачі, і значення усіх змінних або функцій в цьому

розв'язку. Відображає значення цих змінних, функцій-нерівностей, і

функції мети в Self. CurOutConsole.

Вхідні дані:

DualTaskVals – вмикач режиму відображення значень двоїстої задачі:

читаються значення змінних і функцій двоїстої задачі. Їхні

значення розміщені не на місці стовпця вільних членів, а у рядку

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

Таблиця розв'язаної однокритеріальної (з одною функцією мети) задачі:

Self . CurTable – таблиця коефіцієнтів та вільних членів;

Self . CurHeadRow – рядок-заголовок з іменами змінних, іменами

функцій-нерівностей (що перейшли в рядок-заголовок) та

одиницею-множником стовпця вільних членів (має бути останнім);

Self . CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

іменами змінних (виключених), іменем функції мети.}

Const DestFuncsTypes=[bc_DestFuncToMax, bc_DestFuncToMin];

Var st1: String; CurColNum, CurRowNum, LastColNum, LastRowNum: Integer;

Begin

If Self. CurOutConsole<>Nil then

Begin

LastColNum:=Length (Self. CurHeadRow) – 1;

LastRowNum:=Length (Self. CurHeadCol) – 1;

st1:=sc_ResultIs;

If DualTaskVals then

st1:=st1+sc_ForDualTask

Else st1:=st1+sc_ForDirectTask;

Self. CurOutConsole. Lines. Add(st1);

Self. CurOutConsole. Lines. Add (sc_InHeadRow);

{Показуємо значення змінних (або функцій) у рядку-заголовку:}

For CurColNum:=0 to LastColNum-1 do

Begin

st1:='';

If Self. CurHeadRow[CurColNum].ElmType=bc_Number then

st1:=st1+FloatToStr (Self. CurHeadRow[CurColNum].AsNumber)

Else st1:=st1+Self. CurHeadRow[CurColNum].AsVarName;

st1:=st1 + sc_Space+sc_Equal+sc_Space;

{Усі змінні прямої задачі (або функції) у рядку-заголовку в точці

задачі рівні нулю, а змінні двоїстої – у рядку коефіцієнтів функції

мети:}

If DualTaskVals then

st1:=st1+ FloatToStr (Self. CurTable [LastRowNum, CurColNum])

Else st1:=st1+'0';

st1:=st1+sc_KrKm;

Self. CurOutConsole. Lines. Add(st1);

End;

Self. CurOutConsole. Lines. Add (sc_InHeadCol);

For CurRowNum:=0 to LastRowNum do

Begin

st1:='';

If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then

st1:=st1+FloatToStr (Self. CurHeadCol[CurRowNum].AsNumber)

Else st1:=st1+Self. CurHeadCol[CurRowNum].AsVarName;

st1:=st1 + sc_Space+sc_Equal+sc_Space;

{Усі змінні прямої задачі (або функції) у стовпці-заголовку в точці

задачі мають свої значення у стовпці вільних членів,

а змінні двоїстої – рівні нулю:}

If (Self. CurHeadCol[CurRowNum].ElmType in DestFuncsTypes) or

Not(DualTaskVals) then

st1:=st1+ FloatToStr (Self. CurTable [CurRowNum, LastColNum])

Else st1:=st1+'0';

If (Self. CurHeadCol[CurRowNum].ElmType in DestFuncsTypes) then

st1:=sc_ResFunc+sc_Space+st1;

If CurRowNum=LastRowNum then st1:=st1+sc_Spot

Else st1:=st1+sc_KrKm;

Self. CurOutConsole. Lines. Add(st1);

End;

End;

End;

Procedure TGridFormattingProcs. ReadCurFuncSolution (Var SDValVecs:TFloatMatrix;

Var SDDestFuncVals:TFloatArr; SVecRow: Integer;

ToReadFuncVals: Boolean; DualTaskVals: Boolean);

{Процедура зчитує значення функції мети у таблиці розв'язаної

однокритеріальної задачі, і значення усіх змінних або функцій в цьому

розв'язку.

Вхідні дані:

SVecRow – номер поточної функції мети (нумерація з нуля) у масивах

SDValVecs і SDDestFuncVals ;

ToReadFuncVals – перемикач: якщо рівний False , то зчитуються значення

змінних (і значення функції мети); True – зчитуються значення

функцій-нерівностей (і значення функції мети);

DualTaskVals – вмикач режиму читання змінних двоїстої задачі:

читаються значення змінних і функцій двоїстої задачі. Їхні

значення розміщені не на місці стовпця вільних членів, а у рядку

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

Таблиця розв'язаної однокритеріальної (з одною функцією мети) задачі:

Self . CurTable – таблиця коефіцієнтів та вільних членів;

Self . CurHeadRow – рядок-заголовок з іменами змінних, іменами

функцій-нерівностей (що перейшли в рядок-заголовок) та

одиницею-множником стовпця вільних членів (має бути останнім);

Self . CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

іменами змінних (виключених), іменем функції мети. Функція мети

має бути в останньому рядку, і бути одна;

SDValVecs – масив для запису векторів значень змінних;

SDDestFuncVals – масив для запису значень функцій мети

(для цих двох останніх масивів пам'ять має бути вже виділеною).

Вихідні дані:

SDValVecs – масив векторів значень змінних із заповненим вектором

номер SVecRow . Змінні, яких немає в таблиці розв'язку, вважаються

такими що можуть мати будь-яке значення, і приймаються рівними нулю;

SDDestFuncVals – масив значень функцій мети з поточни значенням

у комірці номер SVecRow.}

Var CurColNum, CurRowNum, LastColNum, LastRowNum: Integer;

WorkCellTypes:THeadLineElmTypes;

Begin

{Ініціюємо нулями поточний вектор значень.

Змінні чи функції, імена яких у рядку-заголовку, рівні нулю

для прямої задачі (для двоїстої – у стовпці-заголовку).

Змінні і функції, яких немає в таблиці, теж вважаємо рівними нулю:}

For CurColNum:=0 to Length (SDValVecs[SVecRow]) – 1 do

SDValVecs [SVecRow, CurColNum]:=0;

{Читаємо стовпець-заголовок і значення із останнього стовпця таблиці:}

LastColNum:=Length (Self. CurHeadRow) – 1;

LastRowNum:=Length (Self. CurHeadCol) – 1;

{Значення функції мети:}

SDDestFuncVals[SVecRow]:=Self. CurTable [LastRowNum, LastColNum];

{Функції-нерівності прямої задачі відповідають змінним двоїстої задачі

за позиціюванням в заголовках (не за значеннями, значення різні!),

змінні прямої – функціям двоїстої:}

If (ToReadFuncVals) xor (DualTaskVals) then

WorkCellTypes:=[bc_FuncVal]

Else WorkCellTypes:=[bc_IndependentVar, bc_DependentVar];

{Читаємо змінні або функції-нерівності (в залежності від того, що

задано прочитати):}

If DualTaskVals then

Begin

For CurColNum:=0 to LastColNum-1 do {усі стовпці крім стовпця вільних членів}

Begin{значення записуємо у заданий вектор ( SVecRow ):}

If (Self. CurHeadRow[CurColNum].ElmType in WorkCellTypes) then

SDValVecs [SVecRow, Self. CurHeadRow[CurColNum].VarInitPos]:=

Self. CurTable [LastRowNum, CurColNum];

End

End

Else

Begin

For CurRowNum:=0 to LastRowNum-1 do {усі рядки крім рядка функції мети}

Begin{значення записуємо у заданий вектор ( SVecRow ):}

If (Self. CurHeadCol[CurRowNum].ElmType in WorkCellTypes) then

SDValVecs [SVecRow, Self. CurHeadCol[CurRowNum].VarInitPos]:=

Self. CurTable [CurRowNum, LastColNum];

End

End;

End;

Procedure TGridFormattingProcs. BuildPaymentTaskOfOptim (

Const SOptimXVecs:TFloatMatrix; Const SOptimFuncVals:TFloatArr;

SFirstDFuncRow: Integer);

{Будує однокритеріальну задачу максимізації для пошуку вагових

коефіцієнтів і компромісного вектора значень змінних для

усіх заданих функцій мети.

Вхідні дані:

SOptimXVecs – масив векторів оптимальних значень змінних для

кожної з фунуцій мети;

SOptimFuncVals – масив оптимальних значень функцій мети;

SFirstDFuncRow – номер першої (найвищої) функції мети

у Self. CopyTable і Self. CopyHeadCol;

Self. CopyTable – матриця коефіцієнтів умови багатокритеріальної задачі;

Вихідні дані:

Однокритеріальна задача ЛП для максимізації:

Self . CurTable – матриця коефіцієнтів оптимальності,

вільних членів і коефіцієнтів функції мети;

Self . CurHeadCol – імена змінних двоїстої задачі (як

функції-нерівності прямої задачі);

Self . CurHeadRow – імена функцій-нерівностей двоїстої задачі

(як залежні (тільки більше нуля) змінні прямої задачі).}

Var jCol, iRow, FuncCount, FuncRow: Integer; MinQ, CurQ:TWorkFloat;

Const sc_CurProcName='BuildPaymentTaskOfOptim';

Function CalcQ (ZjFuncRow: Integer; Const XiVals:TFloatArr;

Const ZjXj:TWorkFloat):TWorkFloat;

{Підраховує міру неоптимальності.

Вхідні дані:

ZjFuncRow – номер рядка j-ої функції мети у таблиці Self. CopyTable;

Self. CopyTable – таблиця коефіцієнтів умови багатокритеріальної

задачі ЛП;

XiVals – оптимальні значення змінних для i-ої функції мети

(для формування i -го рядка матриці неоптимальності);

ZjXj – значення j -ої функції мети за j -го набору оптимальних

значень змінних (тобто оптимальне значення цієї функції). Для

формування j -го стовпця матриці неоптимальності.

Вихідні дані: міра неоптимальності.}

VarVarNum: Integer; ZjXi:TWorkFloat;

Begin

ZjXi:=0;

{Шукаємо суму добутків значень змінних і коефіцієнтів при них –

значення функції у точці, координатами якої є подані значення змінних:}

For VarNum:=0 to Length(XiVals) – 1 do

ZjXi:=ZjXi + Self. CopyTable [ZjFuncRow, VarNum]*XiVals[VarNum];

CalcQ:=-Abs((ZjXi/ZjXj) – 1); {qij=-|(ZjXi-ZjXj)/(ZjXj)|}

End;

{Заповнення імен змінних – імен фукнцій двоїстої задачі у рядку-заголовку:}

Procedure FillHRowVarName (SCol: Integer);

Begin

Self. CurHeadRow[SCol].VarInitPos:=SCol;

Self. CurHeadRow[SCol].VarInitInRow:=True;

Self. CurHeadRow[SCol].ElmType:=bc_DependentVar;

Self. CurHeadRow[SCol].AsVarName:=sc_Minus+sc_DualTaskFuncNameStart+

IntToStr (SCol+1);

End;

{Заповнення у комірки рядка-заголовка числом:}

Procedure FillHRowWithNum (SCol: Integer; Const SNumber:TWorkFloat);

Begin

Self. CurHeadRow[SCol].VarInitPos:=SCol;

Self. CurHeadRow[SCol].VarInitInRow:=True;

Self. CurHeadRow[SCol].ElmType:=bc_Number;

Self. CurHeadRow[SCol].AsNumber:=SNumber;

End;

{Заповнення імен функцій – імен змінних двоїстої задачі у стовпці-заголовку:}

Procedure FillHColFuncName (SRow: Integer);

Begin

Self. CurHeadCol[SRow].VarInitPos:=SRow;

Self. CurHeadCol[SRow].VarInitInRow:=False;

Self. CurHeadCol[SRow].ElmType:=bc_FuncVal;

Self. CurHeadCol[SRow].AsVarName:=sc_Minus+sc_DualTaskVarNameStart+

IntToStr (SRow+1);

End;

{Заповнення імені функції мети:}

Procedure FillHColDFuncName (SRow: Integer);

Begin

Self. CurHeadCol[SRow].VarInitPos:=SRow;

Self. CurHeadCol[SRow].VarInitInRow:=False;

Self. CurHeadCol[SRow].ElmType:=bc_DestFuncToMax;

Self. CurHeadCol[SRow].AsVarName:=sc_DestFuncHdr;

End;

Label LStopLabel;

Begin

FuncCount:=Length(SOptimFuncVals);

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CalculatingNoOptMeasures);

{Таблиця мір неоптимальності квадратна: кількість стовпців рівна

кількості функцій мети; кількість рядків рівна кількості оптимальних

векторів значень змінних для кожної з цих функцій (тобто тій же самій

кількості). Додатково виділимо один стовпець для вільних членів

і один рядок для коефіцієнтів функції мети задачі-інтерпретації

гри двох гравців з нульовою сумою, що буде сформована далі:}

SetLength (Self. CurTable, FuncCount + 1, FuncCount + 1);

{Відповідну довжину задаємо і заголовкам таблиці:}

SetLength (Self. CurHeadCol, FuncCount + 1);

SetLength (Self. CurHeadRow, FuncCount + 1);

{Підраховуємо міри неоптимальності векторів значень змінних для

кожної функції мети, і записуємо їх у таблицю коефіцієнтів –

формуємо матрицю неоптимальності:}

{Шукаємо мінімальну (найбільшу за модулем) міру неоптимальності.

Спочатку за неї беремо міру у верхньому лівому куті матриці:}

MinQ:=CalcQ (SFirstDFuncRow, SOptimXVecs[0], SOptimFuncVals[0]);

Self. CurTable [0, 0]:=MinQ; {записуємо одразу цю міру в матрицю}

For jCol:=0 to FuncCount-1 do

Begin

FuncRow:=SFirstDFuncRow+jCol;

{Комірка [0, 0] вже порахована, її обходимо. Для всіх інших виконуємо:}

For iRow:=Ord (jCol=0) to FuncCount-1 do {Ord (0=0)=1; Ord (<не нуль>=0)=0}

Begin {Підраховуємо міру неоптимальності:}

CurQ:=CalcQ (FuncRow, SOptimXVecs[iRow], SOptimFuncVals[jCol]);

If MinQ>CurQ then MinQ:=CurQ; {шукаємо найбільшу за модулем міру}

Self. CurTable [iRow, jCol]:=CurQ; {записуємо міру в матрицю неоптимальності}

End;

End;

MinQ:=-MinQ; {найбільше абсолютне значення (модуль) усіх мір в матриці}

{Заповнюємо заголовки таблиці (це будуть заголовки задачі ЛП):}

For jCol:=0 to FuncCount-1 do FillHRowVarName(jCol);

For iRow:=0 to FuncCount-1 do FillHColFuncName(iRow);

FillHRowWithNum (FuncCount, 1);

FillHColDFuncName(FuncCount);

{Коефіцієнти функції мети: усі однакові і рівні одиниці (бо

відхилення чи наближення будь-якої з цільових функцій від свого

оптимального значення пропорційно (у відсотках) має однакову ціну):}

For jCol:=0 to FuncCount-1 do Self. CurTable [FuncCount, jCol]:=1;

{Вільні члени: усі рівні одиниці:}

For iRow:=0 to FuncCount-1 do Self. CurTable [iRow, FuncCount]:=1;

{Комірка значення функції мети:}

Self. CurTable [FuncCount, FuncCount]:=0;

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum); {показуємо матрицю}

If Self. Stop then Goto LStopLabel;

{Якщо MinQ=0, то усі міри рівні нулю (бо MinQ тут насправді є

максимальним абсолютним значенням). Якщо кількість функцій мети

багатокритеріальної задачі рівна одній (тобто задача однокритеріальна),

то і міра є лише одна, і для неї MinQ =- q [0,0], тому при додаванні

q [0,0]+ MinQ = q [0,0] q [0,0]=0.

Щоб в обох цих випадках розв'язування симплекс-методом працювало

коректно, замінимо MinQ на інше число:}

If MinQ=0 then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllMeasurIsZero);

MinQ:=1 {одиниця, якщо всі нулі (отримаємо матрицю із одиниць)}

End

Else if Length(SOptimFuncVals)=1 then {якщо всього одна функція мети:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_UniqueMeasureCantSetZero);

MinQ:=MinQ+1; {збільшимо на 1 – отримаємо матрицю з одною одиницею.}

End;

{Додаємо до усіх мір неоптимальності максимальну за модулем, і

отримуємо матрицю коефіцієнтів, до якої можна застосувати

симплекс-метод:}

For iRow:=0 to FuncCount-1 do

For jCol:=0 to FuncCount-1 do

Self. CurTable [iRow, jCol]:=Self. CurTable [iRow, jCol]+MinQ;

LStopLabel:

End;

Procedure TGridFormattingProcs. CalcComprVec (Const SVarVecs:TFloatMatrix;

Const SWeightCoefs:TFloatArr; Var DComprVec:TFloatArr);

{Обчислює компромісний вектор (масив) значень змінних із

із заданих векторів значень і вагових коефіцієнтів для кожного із

цих векторів.

Вхідні дані:

SVarVecs – вектори значень змінних;

SWeightCoefs – вагові коефіцієнти для кожного вектора.

Вихідні дані:

DComprVec – компромісний вектор значень змінних.}

Var VecNum, VarNum: Integer; CurComprVal:TWorkFloat;

Begin

DComprVec:=Nil;

If Length(SVarVecs)<=0 then Exit;

SetLength (DComprVec, Length (SVarVecs[0]));

For VarNum:=0 to Length(DComprVec) – 1 do {для кожної змінної:}

Begin

CurComprVal:=0;

{Множимо значення змінної з кожного вектора на свій ваговий

коефіцієнт, і знаходимо суму:}

For VecNum:=0 to Length(SVarVecs) – 1 do

CurComprVal:=CurComprVal + SVarVecs [VecNum, VarNum]*SWeightCoefs[VecNum];

DComprVec[VarNum]:=CurComprVal;

End;

End;

Function TGridFormattingProcs. CalcDFuncVal (Const SVarVec:TFloatArr;

SDestFuncRowNum: Integer):TWorkFloat;

{Обчислює значення функції мети за заданих значень змінних.

Вхідні дані:

SVarVec – вектор значень змінних (в такому порядку, в якому змінні

йдуть в рядку-заголовку умови багатокритеріальної задачі);

SDestFuncRowNum – номер рядка функції мети в умові задачі у

Self . CopyTable ;

Self . CopyTable – матриця коефіцієнтів умови

багатокритеріальної лінійної задачі оптимізації.

Вихідні дані:

Повертає значення функції мети.}

VarVarNum: Integer; FuncVal:TWorkFloat;

Begin

FuncVal:=0;

For VarNum:=0 to Length(SVarVec) – 1 do {для кожної змінної:}

Begin

FuncVal:=FuncVal + SVarVec[VarNum]*Self. CopyTable [SDestFuncRowNum, VarNum];

End;

CalcDFuncVal:=FuncVal;

End;

Function TGridFormattingProcs. SolveMultiCritLTask: Boolean;

{Вирішування задачі багатокритеріальної оптимізації лінійної форми

з використанням теоретико-ігрового підходу.

Умовою задачі є умови-нерівності, рівняння та умови на невід'ємність

окремих змінних, і декілька функцій мети, для яких треба знайти

якомога більші чи менші значення.

Вхідні дані:

Self . CurTable – таблиця коефіцієнтів та вільних членів;

Self . CurHeadRow – рядок-заголовок зі змінними та одиницею-множником

стовпця вільних членів (має бути останнім);

Self . CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

нулями (заголовки рядків-рівнянь), іменами функцій мети

(що максимізуються (тип комірки bc _ DestFuncToMax ) або мінімізуються

(тип bc _ DestFuncToMin )).

Функція повертає ознаку успішності вирішування.}

Var Row, CurWidth, CurHeight, FirstDestFuncRow,

DestFuncCount, VarCount: Integer;

Res1: Boolean;

st1: String;

OptimXVecs, DualUVec:TFloatMatrix;

OptimFuncVals, OptGTaskVal, ComprXVec:TFloatArr;

Const sc_CurProcName='SolveMultiCritLTask';

sc_TextMarkRow='############';


Procedure ShowWeightCoefs (Const SCoefs:TFloatArr; FirstDestFuncRow: Integer);

Var i: Integer;

Begin

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_WeightCoefs);

For i:=0 to Length(SCoefs) – 1 do

Begin

{Відображаємо вагові коефіцієнти для кожної з функцій мети

багатокритеріальної задачі:}

Self. CurOutConsole. Lines. Add ('l['+

Self. CopyHeadCol [FirstDestFuncRow+i].AsVarName+'] = '+

FloatToStr (SCoefs[i]));

End;

End;

End;

Procedure ShowComprVarVec (Const ComprXVec:TFloatArr);

Var Col: Integer; st1: String;

Begin

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_ComprVarVals);

For Col:=0 to Length(ComprXVec) – 1 do

Begin

st1:=Self. CopyHeadRow[Col].AsVarName + ' = ';

st1:=st1 + FloatToStr (ComprXVec[Col]);

Self. CurOutConsole. Lines. Add(st1);

End;

End;

End;

Procedure ShowDFuncVals (Const ComprXVec:TFloatArr; FirstDFuncRow: Integer);

Var Row: Integer; st1: String;

Begin

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_DestFuncComprVals);

For Row:=FirstDFuncRow to Length (Self. CopyTable) – 1 do

Begin

st1:=Self. CopyHeadCol[Row].AsVarName + ' = ';

st1:=st1 + FloatToStr (Self. CalcDFuncVal (ComprXVec, Row));

Self. CurOutConsole. Lines. Add(st1);

End;

End;

End;

Label LStopLabel, LFinish;

Begin

Res1:=True; {прапорець успішності}

Self. GetTaskSizes (CurWidth, CurHeight);

If CurWidth<=0 then {Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

Self. WasNoRoots:=True;

SolveMultiCritLTask:=False;

Exit;

End;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add('');

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

End;

{Зберігаємо посилання на масиви умови багатокритеріальної задачі:}

Self. CopyHeadRow:=Self. CurHeadRow;

Self. CopyHeadCol:=Self. CurHeadCol;

Self. CopyTable:=Self. CurTable;

{Шукаємо цільові функції внизу таблиці:}

For Row:=CurHeight-1 downto 0 do

Begin

Case Self. CopyHeadCol[Row].ElmType of

bc_DestFuncToMax:;

bc_DestFuncToMin:;

{Якщо знизу вгору дійшли до рядка, що не є функцією мети – завершуємо:}

Else Break;

End;

End;

If Row>=CurHeight-1 then {якщо рядків функцій мети взагалі немає:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoDestFuncs);

Self. WasNoRoots:=True;

Res1:=False; Goto LFinish;

End

Else if Row<0 then {якщо в таблиці є тільки рядки функцій мети:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_OnlyDestFuncsPresent);

Res1:=False; Goto LFinish;

(* Row:=-1; *)

End;

FirstDestFuncRow:=Row+1; {найвищий у таблиці рядок функції мети}

DestFuncCount:=CurHeight-FirstDestFuncRow; {кількість функцій мети}

{Змінні: усі стовпці окрім останнього (стовпця вільних членів з

одиницею в заголовку):}

VarCount:=CurWidth-1;

{Вектори змінних в оптимальних розв'язках задач:}

SetLength (OptimXVecs, DestFuncCount, VarCount);

{Оптимальні значення функцій (максимальні або мінімальні значення):}

SetLength (OptimFuncVals, DestFuncCount);

{############ Шукаємо min або max кожної функції мети окремо: ############}

For Row:=FirstDestFuncRow to CurHeight-1 do {для усіх функцій мети:}

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_TextMarkRow+sc_CurProcName + sc_ForDestFunc+

sc_DoubleQuot+ Self. CopyHeadCol[Row].AsVarName +sc_DoubleQuot+sc_Space;

If Self. CopyHeadCol[Row].ElmType=bc_DestFuncToMin then

st1:=st1+sc_SearchingMin

Else st1:=st1+sc_SearchingMax;

st1:=st1+sc_TriSpot+sc_TextMarkRow;

Self. CurOutConsole. Lines. Add(st1);

End;

{Формуємо умову однокритеріальної задачі максимізації:}

If Not (Self. PrepareDestFuncInMultiDFuncLTask (Row, FirstDestFuncRow)) then

Begin

Res1:=False; Break;

End;

If Self. Stop then Break;

{Ховаємо розв'язувальну комірку у екранній таблиці (її нема тут):}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

{Відображаємо підготовану однокритеріальну задачу:}

WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum);

If Self. Stop then Break;

{Запускаємо вирішування однокритеріальної задачі максимізації лінійної

форми (так як поточна функція є функцією максимізації, або зведена

до такої):}

Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;

If Not (Self. SolveLTaskToMax(False)) then

Begin

Res1:=False; Break;

End;

{Якщо функція мети необмежена або система умов несумісна:}

If Not (Self. SolWasFound) then

Begin

{Якщо функцій мети більше одної, то так як компромісний вектор

через необмеженість принаймні одної з функцій мети знайти неможливо:}

If (FirstDestFuncRow+1)<CurHeight then Res1:=False

Else Res1:=True;

Goto LFinish;

End;

If Self. Stop then Break;

{Читаємо вектор значень змінних та оптимальне значення функції мети

з таблиці:}

Self. ReadCurFuncSolution (OptimXVecs, OptimFuncVals, Row-FirstDestFuncRow,

False, False);

End;

If Not(Res1) then Goto LFinish;

If Self. Stop then Goto LStopLabel;

{############ Шукаємо міри неоптимальності і будуємо задачу: ############}

{######## пошуку компромісних вагових коефіцієнтів, вирішуємо її: ########}

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_TextMarkRow);

BuildPaymentTaskOfOptim (OptimXVecs, OptimFuncVals, FirstDestFuncRow);

If Self. Stop then Goto LStopLabel;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_TextMarkRow);

{Готуємо задачу до максимізації симплекс-методом:}

Res1:=Self. PrepareDFuncForSimplexMaximize;

If Not(Res1) then Goto LFinish;

{Запускаємо вирішування цієї задачі:}

Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;

{«True» – з відображенням значень двоїстої:}

If Not (Self. SolveLTaskToMax(True)) then

Begin

Res1:=False; Goto LFinish;

End;

{Якщо функція мети необмежена або система умов несумісна:}

If Not (Self. SolWasFound) then

Begin

Res1:=False; Goto LFinish;

End;

If Self. Stop then Goto LStopLabel;

{############ Обчислюємо вагові коефіцієнти: ############}

{Якщо задача-інтерпретація гри вирішена і знайдено оптимальне

значення функції, то читаємо це значення і значення змінних

двоїстої задачі:}

SetLength (OptGTaskVal, 1); {для запису значення функції мети}

SetLength (DualUVec, 1, DestFuncCount); {для запису значень змінних}

Self. ReadCurFuncSolution (DualUVec, OptGTaskVal, 0, False, True);

{Обчислюємо вагові коефіцієнти:}

For Row:=0 to DestFuncCount-1 do

DualUVec [0, Row]:=(DualUVec [0, Row]/OptGTaskVal[0]); {Li=ui/(W(U))}

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_TextMarkRow);

ShowWeightCoefs (DualUVec[0], FirstDestFuncRow);

{############ Обчислюємо компромісний вектор: ############}

Self. CalcComprVec (OptimXVecs, DualUVec[0], ComprXVec);

ShowComprVarVec(ComprXVec);

ShowDFuncVals (ComprXVec, FirstDestFuncRow);

Goto LFinish;

LStopLabel: {Якщо вирішування було перервано:}

{Повертаємо початкову умову на попереднє місце:}

Self. CurHeadRow:=Self. CopyHeadRow;

Self. CurHeadCol:=Self. CopyHeadCol;

Self. CurTable:=Self. CopyTable;

LFinish:

{Обнуляємо посилання на копію умови. Так як це динамічні масиви і

щодо них йде відлік кількості посилань, то для них не створюватимуться

зайві копії у пам'яті, і при роботі з CurHeadRow , CurHeadCol , CurTable

пам'ять буде виділена завжди тільки для їхніх поточних даних:}

Self. CopyHeadRow:=Nil;

Self. CopyHeadCol:=NIl;

Self. CopyTable:=Nil;

SolveMultiCritLTask:=Res1;

End;

Procedure TGridFormattingProcs. ChangeSignsInRow (CurRowNum: Integer);

{Зміна знаків у рядку таблиці і відповідній комірці у стовпці-заголовку.}

Var CurColNum: Integer;

Begin

For CurColNum:=0 to Length (Self. CurHeadRow) – 1 do

CurTable [CurRowNum, CurColNum]:=-CurTable [CurRowNum, CurColNum];

ChangeSignForValOrVarName (Self. CurHeadCol[CurRowNum]);

End;

Procedure TGridFormattingProcs. ChangeSignsInCol (CurColNum: Integer);

{Зміна знаків у стовпці таблиці і відповідній комірці у рядку-заголовку.}

Var CurRowNum: Integer;

Begin

For CurRowNum:=0 to Length (Self. CurHeadCol) – 1 do

CurTable [CurRowNum, CurColNum]:=-CurTable [CurRowNum, CurColNum];

ChangeSignForValOrVarName (Self. CurHeadRow[CurColNum]);

End;

Function TGridFormattingProcs. ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

{Функція переміщує рядки таблиці CurTable (разом із відповідними

комірками у стовпці-заголовку CurHeadCol ) з заданими типами комірок

стовпця-заголовка вгору.

Вхідні дані:

SHeadColElmTypes – множина типів комірок, що мають бути переміщені вгору

(у стовпці-заголовку);

ToChangeInitPosNums – вмикач зміни позначок номера по порядку та

позначки розташування в таблиці як рядка чи стовпця.

Якщо рівний True , то рядки при переміщенні змінюють ці позначки

на позначки тих рядків, що були в тих місцях, на які рядки переміщені;

Self . CurTable – таблиця коефіцієнтів;

Self . CurHeadCol – стовпець-заголовок.

Вихідні дані:

Self . CurTable і Self . CurHeadCol – таблиця коефіцієнтів і

стовпець-заголовок з перенесеними вгору рядками і комірками;

функція повертає номер найвищого рядка із тих, що не було задано

переміщувати вгору (вище нього – ті, що переміщені вгору).}

Var HiNotInSetRow, CurRowToUp, CurRowNum: Integer;

Begin

{Номер найвищого рядка, що не є в множині тих, які переміщуються вгору.

Спочатку ставимо тут номер неіснуючого рядка:}

HiNotInSetRow:=-1;

{Йдемо по рядкам згори вниз:}

For CurRowNum:=0 to Length (Self. CurHeadCol) – 1 do

Begin {Шукаємо перший рядок з типом комірки, що не має переміщуватися вгору:}

If Not (Self. CurHeadCol[CurRowNum].ElmType in SHeadColElmTypes) then

Begin

HiNotInSetRow:=CurRowNum;

{шукаємо найнижчий рядок, який портібно переміщувати вгору:}

For CurRowToUp:=Length (Self. CurHeadCol) – 1 downto CurRowNum+1 do

Begin

If Self. CurHeadCol[CurRowToUp].ElmType in SHeadColElmTypes then Break;

End;

{Якщо таких рядків не знайдено, то усі вони вже вгорі:}

IfCurRowToUp<=CurRowNumthenBreak

Else{Міняємо місцями рядок, що має бути вгорі, і рядок, що не має,

але розташований вище:}

ChangeRowsPlaces (Self. CurTable, Self. CurHeadCol, CurRowNum,

CurRowToUp, ToChangeInitPosNums);

End;

End;

ShiftRowsUp:=HiNotInSetRow;

End;

Function TGridFormattingProcs. ShiftRowsDown (

SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

{Функція переміщує рядки таблиці CurTable (разом із відповідними

комірками у стовпці-заголовку CurHeadCol ) з заданими типами комірок

стовпця-заголовка вниз.

Вхідні дані:

SHeadColElmTypes – множина типів комірок, що мають бути переміщені вниз

(у стовпці-заголовку);

ToChangeInitPosNums – вмикач зміни позначок номера по порядку та

позначки розташування в таблиці як рядка чи стовпця.

Якщо рівний True , то рядки при переміщенні змінюють ці позначки

на позначки тих рядків, що були в тих місцях, на які рядки переміщені;

Self . CurTable – таблиця коефіцієнтів;

Self . CurHeadCol – стовпець-заголовок.

Вихідні дані:

Self . CurTable і Self . CurHeadCol – таблиця коефіцієнтів і

стовпець-заголовок з перенесеними донизу рядками і комірками;

функція повертає номер найвищого рядка із тих, що переміщені вниз

(вище нього – рядки тих типів, що не було задано переміщувати донизу).}

VarAllOtherHeadTypes:THeadLineElmTypes;

Begin

{Отримуємо протилежну множину типів комірок:}

AllOtherHeadTypes:=[bc_IndependentVar..bc_OtherType] – SHeadColElmTypes;

{Зсуваємо рядки з усіма іншими типами вгору (і рядки з заданими

типами залишаються внизу):}

ShiftRowsDown:=Self. ShiftRowsUp (AllOtherHeadTypes, ToChangeInitPosNums);

End;

Function TGridFormattingProcs. SolveLTaskToMax (DualTaskVals: Boolean):Boolean;

{Вирішування задачі максимізації лінійної форми (що містить умови-

нерівності, рівняння та умови на невід'ємність окремих змінних і

одну функцію мети, для якої треба знайти максимальне значення).

Вхідні дані:

DualTaskVals – вмикач режиму відображення змінних двоїстої задачі

(після завершення розв'язування, якщо оптимальне значення знайдено):

читаються значення змінних і функцій двоїстої задачі. Їхні

значення розміщені не на місці стовпця вільних членів, а у рядку

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

Вихідні дані:

DResult – тип результату вирішування, який досягнутий (у випадку

успішного вирішування);

Функція повертає ознаку успішності вирішування.}

Const sc_CurProcName='SolveLTaskToMax';

Var CurRowNum, CurRow2N, CurColNum: Integer;

HeadRowNum, HeadColNum: Integer;

HiNoIndepRow: Integer;

ColDeleted, RowDeleted, AllExcluded, WasNothingToDo: Boolean;

st1: String;

Procedure SearchMNNCellForCol (CurColNum: Integer;

StartRowNum, EndRowNum: Integer;

Var DRowNum: Integer; AllowNegatCellIfZero: Boolean=False);

{Пошук у стовпці CurColNum комірки з МНВ (мінімального невід'ємного

відношення вільного члена до значення комірки у стовпці).

AllowNegatCellIfZero – дозволити від'ємне значення комірки і при

нульовому вільному члені.}

Var CurRowNum, FoundRow: Integer; MNN, CurRelat:TWorkFloat;

Begin

{Шукаємо МНВ у заданому інтервалі рядків:}

FoundRow:=-1; MNN:=-1;

For CurRowNum:=StartRowNum to EndRowNum do

Begin {Перевірка виконання умов невід'ємного відношення:}

If (CurTable [CurRowNum, CurColNum]<>0) and

(AllowNegatCellIfZero or

(CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<>0) or

(CurTable [CurRowNum, CurColNum]>0)) and

((ValSign (CurTable[CurRowNum, Length (Self. CurHeadRow) – 1])*

ValSign (CurTable[CurRowNum, CurColNum]))>=0) then

Begin

CurRelat:=CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]/

CurTable [CurRowNum, CurColNum];

{Якщо знайшли менше, або знайшли перше значення:}

If (CurRelat<MNN) or (FoundRow=-1) then

Begin

MNN:=CurRelat; FoundRow:=CurRowNum;

End;

End;

End;

If (Self. CurOutConsole<>Nil) and (FoundRow<0) then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoMNN+sc_Space+

IntToStr (CurColNum+1)+sc_Space+sc_TriSpot);

DRowNum:=FoundRow;

End;

Label LStopLabel;

Begin

If Self. TaskWidth<=0 then {Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

SolveLTaskToMax:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_ExcludingFreeVars);

End;

{############## Виключаємо незалежні змінні: ##############}

CurRowNum:=0;

Repeat

WasNothingToDo:=True; AllExcluded:=True;

CurColNum:=0;

While CurColNum<(Length (Self. CurHeadRow) – 1) do {усі стовпці окрім останнього}

Begin

ColDeleted:=False;

{Координати розв'язувальної комірки для помітки кольором в екранній

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Якщо поточна змінна незалежна:}

If Self. CurHeadRow[CurColNum].ElmType=bc_IndependentVar then

Begin{Перевіряємо, чи не дійшли до рядка функції

(або взагалі за низ таблиці):}

If CurRowNum<(Length (Self. CurHeadCol) – 1) then

Begin{якщо рядки для виключення ще залишились:}

{Шукаємо ненульову комірку серед коефіцієнтів поточної

незалежної змінної (окрім останнього рядка, що є

рядком поточної функції мети):}

IfSearchNozeroSolveCell (CurRowNum, CurColNum,

Length (Self. CurHeadCol) – 2, Length (Self. CurHeadRow) – 2,

HeadRowNum, HeadColNum, False) then

Begin {якщо змінну можна виключити:}

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRowNum, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

WasNothingToDo:=False;

{Переходимо до наступного рядка, бо даний рядок тепер вже є

рядком виключеної вільної змінної (і змінна виражена як

функція-нерівність):}

Inc(CurRowNum);

End

Else{якщо для незалежної змінної усі коефіцієнти обмежень – нулі}

Begin{то змінна зовсім незалежна:}

{І якщо в рядку функції мети теж нуль, то:}

If Self. CurTable [Length(Self. CurHeadCol) – 1, CurColNum]=0 then

Begin {хоч змінна й незалежна, від неї теж нічого тут не залежить:}

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_FreeVar;

If Self. CurHeadRow[CurColNum].ElmType=bc_Number then

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurColNum].AsNumber)

Else st1:=st1+sc_Space+sc_DoubleQuot+

Self. CurHeadRow[CurColNum].AsVarName+sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Видаляємо стовпець цієї змінної:}

DeleteFromArr (Self. CurHeadRow, CurColNum, 1);

DelColsFromMatr (Self. CurTable, CurColNum, 1);

ColDeleted:=True;

WasNothingToDo:=False;

End

Else AllExcluded:=False; {не усі вільні вдалося виключити}

End;

End

Else AllExcluded:=False; {не усі вільні вдалося виключити}

End;

If Not(ColDeleted) then Inc(CurColNum);

End; {While (CurColNum<(Length (Self. CurHeadRow) – 1)) do…}

Until AllExcluded or WasNothingToDo;

If Not(AllExcluded) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CantExcludeFreeVars);

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Переміщаємо рядки з усіма незалежними змінними вгору:}

HiNoIndepRow:=Self. ShiftRowsUp([bc_IndependentVar], False);

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllFreeVarsExcluded);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Якщо усі рядки є рядками незалежних змінних, то номер найвищого рядка

іншого типу вважаємо нижче таблиці (бо нема таких рядків):}

If HiNoIndepRow<0 then HiNoIndepRow:=Length (Self. CurHeadCol);

{Якщо після виключення незалежних змінних не залишилося рядків, окрім

рядка функції:}

If HiNoIndepRow>=(Length (Self. CurHeadCol) – 1) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoTableAreaToWork);

End;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_ExcludingZeroRows);

{############## Виключаємо 0-рядки. Шукаємо їх: ##############}

CurRowNum:=HiNoIndepRow;

While CurRowNum<=(Length (Self. CurHeadCol) – 2) do

Begin

RowDeleted:=False;

If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRowNum].AsNumber=0 then {якщо знайшли 0-рядок:}

Begin{Для помітки 0-рядка на екранній таблиці:}

Self. CurGridSolveCol:=HeadColNum;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Перевіряємо вільний член рядка, чи він невід'ємний.

Якщо від'ємний, то множимо обидві частини рівняння на -1:}

If CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then

ChangeSignsInRow(CurRowNum);

{Шукаємо у рядку перший додатний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]>0 then Break;

If CurColNum>(Length (Self. CurHeadRow) – 2) then {Якщо усі недодатні:}

Begin

If CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]=0 then

Begin {Якщо вільний член рівний нулю, то помножимо рівняння на -1:}

ChangeSignsInRow(CurRowNum);

{Шукаємо у рядку перший додатний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]>0 then Break;

{Якщо знову додатних нема, значить усі нулі. Видаляємо рядок:}

If CurColNum>(Length (Self. CurHeadRow) – 2) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllZeroInRow+

sc_Space+IntToStr (CurRowNum+1));

DelRowsFromMatr (CurTable, CurRowNum, 1);

DeleteFromArr (Self. CurHeadCol, CurRowNum, 1);

System. Continue; {переходимо одразу до наступного рядка}

End;

End

Else{Якщо вільний член додатній, а коефіцієнти недодатні, то

система несумісна:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+

sc_Space+sc_NoVals);

Self. WasNoRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

End;

{Якщо додатний коефіцієнт у 0-рядку обрано, шукаємо МНВ

(мінімальне невід'ємне серед відношень вільних членів до членів

стовпця, у якому обрали цей коефіцієнт):}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=False; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

If CurRow2N<>CurRowNum then {Якщо виключили не цей 0-рядок:}

System. Continue; {продовжуємо працювати з цим рядком}

End; {If Self. CurHeadCol[CurRowNum].AsNumber=0 then…}

End; {If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then…}

If Not(RowDeleted) then Inc(CurRowNum);

End; {While CurRowNum<=(Length (Self. CurHeadCol) – 2) do…}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllZeroRowsExcluded);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum); {відмічаємо новий крок}

If Self. Stop then Goto LStopLabel;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_SearchingBaseSolve);

{############## Шукаємо опорний розв'язок задачі: ##############}

CurRowNum:=HiNoIndepRow;

While CurRowNum<=(Length (Self. CurHeadCol) – 2) do

Begin

{Якщо знайшли від'ємний елемент у стовпці вільних членів:}

If Self. CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then

Begin

{Для помітки поточного рядка на екранній таблиці:}

Self. CurGridSolveCol:=HeadColNum;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Шукаємо у рядку перший від'ємний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]<0 then Break;

If CurColNum>(Length (Self. CurHeadRow) – 2) then {Якщо усі невід'ємні:}

Begin

{Якщо вільний член від'ємний, а коефіцієнти невід'ємні, то

система несумісна:}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+sc_Space+

sc_NoVals);

Self. WasNoRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Якщо від'ємний коефіцієнт у рядку обрано, шукаємо МНВ

(мінімальне невід'ємне серед відношень вільних членів до членів

стовпця, у якому обрали цей коефіцієнт):}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=False; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

If CurRow2N<>CurRowNum then {Якщо виключили не цей рядок:}

System. Continue; {продовжуємо працювати з цим рядком}

End; {If Self. CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then…}

Inc(CurRowNum);

End; {While CurRowNum<=(Length (Self. CurHeadCol) – 2) do…}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_BaseSolveFound);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum); {відмічаємо новий крок}

If Self. Stop then Goto LStopLabel;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_SearchingOptimSolve);

{############## Шукаємо оптимальний розв'язок задачі: ##############}

CurColNum:=0;

While CurColNum<=(Length (Self. CurHeadRow) – 2) do

Begin

ColDeleted:=False;

{Якщо знайшли від'ємний коефіцієнт у рядку функції мети:}

If CurTable [Length(Self. CurHeadCol) – 1, CurColNum]<0 then

Begin

{Шукаємо МНВ (мінімальне невід'ємне серед відношень вільних членів

до членів стовпця, у якому обрали цей коефіцієнт) серед усіх рядків

умов, окрім рядків вільних змінних і рядка функції мети:}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin{то функція мети не обмежена зверху, максимальне значення безмежне:}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+sc_Space+

sc_UnlimitedFunc);

Self. WasManyRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

CurColNum:=0; {після виключення могли з'явитися нові від'ємні комірки}

System. Continue;

End;

If Not(ColDeleted) then Inc(CurColNum);

End;

{Якщо назва функції мети вказана зі знаком «–», то це протилежна

функція мети. Змінимо знаки у її рядку, і отримаємо шукану

мінімізацію функції:}

CurRowNum:=Length (Self. CurHeadCol) – 1;

If ValSign (Self. CurHeadCol[CurRowNum])=bc_Negative then

Begin

ChangeSignsInRow(CurRowNum);

Self. CurHeadCol[CurRowNum].ElmType:=bc_DestFuncToMin;

End;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+sc_Space+

sc_ValFound);

Self. ShowLTaskResultCalc(DualTaskVals);

Self. SolWasFound:=True;

SolveLTaskToMax:=True;

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum);

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_SolvingStopped);

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

SolveLTaskToMax:=False;

Exit;

End;

procedure TGridFormattingProcs. EditLineEqsOnNewRow (Sender: TObject;

NewRows: array of Integer);

{Підтримує форматування стовпця нумерації таблиці у такому вигляді:

1

2

3

4

5

m}

Var CurNum: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewRow<>Nil then Self. OldOnNewRow (Sender, NewRows);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewRows) – 1 do

Begin

{Нумерація з третього рядка, бо два перших – заголовки:}

If NewRows[CurNum]>=(Self.CHeadRowNum+1) then

Begin

CurGrid. Cells [0, NewRows[CurNum]]:=IntToStr (NewRows[CurNum]-

Self.CHeadRowNum);

End;

End;

End;

End;

procedure TGridFormattingProcs. EditLineEqsOnNewCol (Sender: TObject;

NewCols: array of Integer);

{Підтримує форматування рядка нумерації та рядка-заголовка таблиці у

такому вигляді:

1 2 3 4 5… n n +1

x 1 x 2 x 3 x 4 x 5… xn 1

}

Var CurNum: Integer; CurGrid:TStringGrid;

CurColNumStr: String;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewCol<>Nil then Self. OldOnNewCol (Sender, NewCols);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewCols) – 1 do

Begin

{Заголовки лише для комірок, які можна редагувати:}

If NewCols[CurNum]>=(Self.CHeadColNum+1) then

Begin

CurColNumStr:=IntToStr (NewCols[CurNum] – Self.CHeadColNum);

CurGrid. Cells [NewCols[CurNum], 0]:=CurColNumStr;

{Останній стовпець – числа у правих частинах рівнянь:}

If (NewCols[CurNum]+1)=CurGrid. ColCount then

CurGrid. Cells [NewCols[CurNum], 1]:=sc_RightSideValsHdr

{в усіх інших – коефіцієнти при змінних X1…Xn:}

Else

CurGrid. Cells [NewCols[CurNum], 1]:=sc_XVarName+CurColNumStr;

End;

End;

If Length(NewCols)>0 then

Begin

{Якщо перед оновленими або новими стовпцями були інші стовпці, то

в останному з них оновлюємо підпис: тепер він буде з іменем змінної

xn »), а не з іменем стовпця правих частин рівнянь ( a ).

(Тут покладаємося на те, що номери оновлених стовпців сортовані

за зростанням):}

If NewCols[0]>(Self.CHeadColNum+1) then

CurGrid. Cells [NewCols[0] – 1, 1]:=sc_XVarName+IntToStr (NewCols[0]-

(Self.CHeadColNum+1));

End

Else {Якщо нових стовпців немає (тобто кількість стовпців зменшилася):}

Begin {Оновлюємо підпис останнього стовпця (праві частини рівнянь):}

CurGrid. Cells [CurGrid. ColCount-1, 1]:=sc_RightSideValsHdr;

End;

End;

End;

procedure TGridFormattingProcs. EditLineEqsOnDrawCell (Sender: TObject; ACol,

ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедура виконується при малюванні кожної комірки StringGrid

у режимі набору вхідних даних системи лінійних рівнянь.

Зафарбовує в інший колір останній стовпець – стовпець

правих частин рівнянь.}

VarCurGrid:TStringGrid; SafeBrushColor:TColor;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDrawCell<>Nil then Self. OldOnDrawCell (Sender, ACol, ARow, Rect,

State);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

SafeBrushColor:=CurGrid. Canvas. Brush. Color;

{Комірки останнього стовпця є стовпцем правих сторін рівнянь.

Фарбуємо їх у блакитний колір (окрім комірок заголовка):}

If (ACol>=(CurGrid. ColCount-bc_LineEqM2ColsAfterVars)) and

(Not (gdFixed in State)) then

Begin

CurGrid. Canvas. Brush. Color:=lwc_RightSideColColor;

{Малюємо текст на фоні з кольором Brush :}

CurGrid. Canvas. TextRect (Rect, Rect. Left, Rect. Top,

CurGrid. Cells [ACol, ARow]);

End;

CurGrid. Canvas. Brush. Color:=SafeBrushColor;

End;

End;

procedure TGridFormattingProcs. SolveLineEqsM1OrM2OnDrawCell (Sender: TObject;

ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедура фарбує комірки (їхній фон) таблиці вирішування системи лінійних

рівнянь у стовпці правих частин (вільних членів). У залежності від

методу розв'язання цей стопець може бути першим стовпцем-заголовком

(1-ий спосіб, з отриманням оберненої матриці коефіцієнтів), або останнім

стовпцем (2-ий спосіб, з отриманням нулів у рядку-заголовку і видаленням

стовпців цих нулів).}

Var CurGrid:TStringGrid; SafeBrushColor:TColor; CurColor:TColor;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDrawCell<>Nil then Self. OldOnDrawCell (Sender, ACol, ARow, Rect,

State);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

SafeBrushColor:=CurGrid. Canvas. Brush. Color;

CurColor:=bc_NotColored;

If Not (gdFixed in State) then {якщо комірка не у заголовках StringGrid}

Begin

{У режимі розв'язування способом 1 відмічаємо перший стовпець

кольором, а у режимі способу 2 – відмічаємо останній

(стовпець правих частин – вільних членів):}

If ((Self. CurFormatState=fs_SolvingEqsM1) and

(ACol<(Self.CHeadColNum+bc_LineEqM1ColsBeforeVars))) or

((Self. CurFormatState=fs_SolvingEqsM2) and

(ACol>=(CurGrid. ColCount-bc_LineEqM2ColsAfterVars))) then

CurColor:=lwc_RightSideColColor

{Якщо це комірка коефіцієнта при змінній, і задача у ході вирішування:}

Else if InSolving then

Begin

If Self. CurGridSolveCol=ACol then {якщо це розв'язувальний стовпець:}

Begin

If Self. CurGridSolveRow=ARow then {якщо це розв'язувальна комірка:}

CurColor:=lwc_SolveCellColor

Else CurColor:=lwc_SolveColColor;

End{Якщо це розв'язувальний рядок (але не розв'язувальна комірка):}

Else if Self. CurGridSolveRow=ARow then CurColor:=lwc_SolveRowColor;

End;

End;

If CurColor<>bc_NotColored then {якщо комірку треба пофарбувати:}

Begin {Малюємо текст на фоні з кольором CurColor:}

CurGrid. Canvas. Brush. Color:=CurColor;

CurGrid. Canvas. TextRect (Rect, Rect. Left, Rect. Top,

CurGrid. Cells [ACol, ARow]);

End;

CurGrid. Canvas. Brush. Color:=SafeBrushColor;

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnNewRow (Sender: TObject;

NewRows: array of Integer);

{Процедура працює при виникненні події оновлення рядка чи додавання нового

рядка у GrowingStringGrid.

Підтримує форматування стовпця нумерації і стовпця-заголовка таблиці у

такому вигляді:

1 y 1

2 y 2

3 y 3

4 y 4

5 y 5

m ym

Стовпець-заголовок (нові комірки стовпця-заголовка за змовчуванням

заповнюються значеннями типу «функції-нерівності»).}

Var CurNum, CurTableRow: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewRow<>Nil then Self. OldOnNewRow (Sender, NewRows);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

{Освіжаємо масив стовпця-заголовка відповідно до висоти таблиці:}

UpdateLTaskHeadColToStrGrid (CurGrid, NewRows);

{Відображаємо заголовки оновлених або нових рядків:}

For CurNum:=0 to Length(NewRows) – 1 do

Begin

{Нумерація з першого рядка, що не є рядком заголовків:}

If NewRows[CurNum]>=(Self.CHeadRowNum+1) then

Begin {Нумерація рядків:}

CurGrid. Cells [Self.CHeadColNum-1, NewRows[CurNum]]:=

IntToStr (NewRows[CurNum] – Self.CHeadRowNum);

{Заголовки із масиву стовпця-заголовка:}

CurTableRow:=NewRows[CurNum] – Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

CurGrid. Cells [Self.CHeadColNum, NewRows[CurNum]]:=

GetValOrNameAsStr (Self. CurHeadCol[CurTableRow]);

End;

End;

{Якщо нові або змінені рядки були, то вважаємо таблицю зміненою:}

If Length(NewRows)>0 then Self. CurGridModified:=True;

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnNewCol (Sender: TObject;

NewCols: array of Integer);

{Підтримує форматування рядка нумерації та рядка-заголовка таблиці у

такому вигляді:

1 2 3 4 5… n n +1

y x 1 x 2 x 3 x 4… xn 1

}

Var CurNum, CurTableCol: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewCol<>Nil then Self. OldOnNewCol (Sender, NewCols);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

{Освіжаємо масив поміток залежності змінних x:}

Self. UpdateLTaskHeadRowToStrGrid(CurGrid);

{Відображаємо заголовки оновлених або нових стовпців:}

For CurNum:=0 to Length(NewCols) – 1 do

Begin

{Заголовки лише для комірок, які можна редагувати:}

If NewCols[CurNum]>=Self.CHeadColNum then

Begin {Нумерація стовпців:}

CurGrid. Cells [NewCols[CurNum], Self.CHeadRowNum-1]:=

IntToStr (NewCols[CurNum] – Self.CHeadColNum);

{Заголовки із масиву рядка-заголовка:}

CurTableCol:=NewCols[CurNum] – Self.CHeadColNum-bc_LTaskColsBeforeVars;

CurGrid. Cells [NewCols[CurNum], Self.CHeadRowNum]:=

GetValOrNameAsStr (Self. CurHeadRow[CurTableCol]);

End;

End;

If Length(NewCols)>0 then

Begin

{Якщо нові або змінені стовпці були, то вважаємо таблицю зміненою:}

Self. CurGridModified:=True;

{Якщо перед оновленими або новими стовпцями були інші стовпці, то

в останному з них оновлюємо підпис: тепер він буде з іменем змінної

xn ») або, якщо це перший стовпець-то з підписом стовпця імен

функцій та констант рівнянь.

(Тут покладаємося на те, що номери оновлених стовпців сортовані

за зростанням):}

If NewCols[0]>Self.CHeadColNum+bc_LTaskColsBeforeVars then

Begin

CurTableCol:=NewCols[0] – 1-Self.CHeadColNum-bc_LTaskColsBeforeVars;

CurGrid. Cells [NewCols[0] – 1, Self.CHeadRowNum]:=

GetValOrNameAsStr (Self. CurHeadRow[CurTableCol]);

End;

End

Else {Якщо нових стовпців нема (кількість стовпців зменшилася):}

{відображаємо останню (найправішу) комірку}

CurGrid. Cells [CurGrid. ColCount-1, 1]:=

GetValOrNameAsStr (Self. CurHeadRow [CurGrid. ColCount-1-

Self.CHeadColNum-bc_LTaskColsBeforeVars]);

End;

End;

procedure TGridFormattingProcs. NumerationOnNewRow (Sender: TObject;

NewRows: array of Integer);

{Процедура працює при виникненні події оновлення рядка чи додавання нового

рядка у GrowingStringGrid.

Підтримує форматування стовпця нумерації таблиці у

такому вигляді:

1

2

3

4

5

m}

Var CurNum: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewRow<>Nil then Self. OldOnNewRow (Sender, NewRows);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewRows) – 1 do

Begin

{Нумерація з першого рядка, що не є рядком заголовків

GrowingStringGrid:}

If NewRows[CurNum]>=(Self.CHeadRowNum+1) then

CurGrid. Cells [0, NewRows[CurNum]]:=

IntToStr (NewRows[CurNum] – Self.CHeadRowNum);

End; {For CurNum:=0 to Length(NewRows) – 1 do…}

End; {If Sender is TStringGrid then…}

End;

procedure TGridFormattingProcs. NumerationOnNewCol (Sender: TObject;

NewCols: array of Integer);

{Процедура працює при виникненні події оновлення чи додавання нового

стовпця у GrowingStringGrid.

Підтримує форматування рядка нумерації таблиці у такому вигляді:

1 2 3 4 5… n}

Var CurNum: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewCol<>Nil then Self. OldOnNewCol (Sender, NewCols);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewCols) – 1 do

Begin

{Заголовки лише для нефіксованих комірок:}

If NewCols[CurNum]>=(Self.CHeadColNum+1) then

CurGrid. Cells [NewCols[CurNum], 0]:=

IntToStr (NewCols[CurNum] – Self.CHeadColNum);

End;

End;

End;

Procedure TGridFormattingProcs. UpdateLTaskHeadRowToStrGrid (SGrid:TStringGrid);

{Процедура для підтримки масиву рядка-заголовка під час редагування

таблиці. Встановлює довжину масиву відповідно до ширини екранної таблиці

і координат вписування в неї таблиці задачі, заповнює нові комірки

значеннями за змовчуванням, а також змінює останню комірку перед новими.}

Var CurLTaskVarCount, OldCount, CurVarMark: Integer;

Begin

{Кількість стовпців для коефіцієнтів змінних у таблиці:}

CurLTaskVarCount:=SGrid. ColCount-Self.CHeadColNum-

bc_LTaskColsBeforeVars {-bc_LTaskColsAfterVars} ;

{Якщо таблиця має надто малу ширину, то нічого тут не робимо:}

If CurLTaskVarCount<0 then Exit;

{Масив видовжуємо до кількості стовпців у StringGrid, у яких

редагуємо коєфіцієнти при змінних:}

OldCount:=Length (Self. CurHeadRow);

If OldCount<>CurLTaskVarCount then

Begin

SetLength (Self. CurHeadRow, CurLTaskVarCount); {змінюємо довжину}

{Заповнюємо нові елементи масиву значеннями за змовчуванням:

вільні змінні:}

For CurVarMark:=OldCount to CurLTaskVarCount-2 do

Begin

Self. CurHeadRow[CurVarMark].ElmType:=bc_IndependentVar;

Self. CurHeadRow[CurVarMark].VarInitInRow:=True;

Self. CurHeadRow[CurVarMark].VarInitPos:=CurVarMark;

Self. CurHeadRow[CurVarMark].AsVarName:=sc_XVarName+IntToStr (CurVarMark+1);

End;

{Останній елемент є числом, а не змінною: це множник стовпця

вільних членів (правих частин):}

IfCurLTaskVarCount>0 then

Begin

Self. CurHeadRow [CurLTaskVarCount-1].ElmType:=bc_Number;

Self. CurHeadRow [CurLTaskVarCount-1].AsNumber:=1;

{Колишній останній елемент тепер буде змінною:}

If (OldCount>0) and (OldCount<CurLTaskVarCount) then

Begin

Self. CurHeadRow [OldCount-1].ElmType:=bc_IndependentVar;

Self. CurHeadRow [OldCount-1].AsVarName:=sc_XVarName+IntToStr(OldCount)

End;

End;

End;

End;

Procedure TGridFormattingProcs. UpdateLTaskHeadColToStrGrid (SGrid:TStringGrid;

NewRows: array of Integer);

{Процедура для підтримки масиву стовпця-заголовка під час редагування

таблиці. Встановлює довжину масиву відповідно до висоти екранної таблиці

і координат вписування в неї таблиці задачі, заповнює нові комірки

значеннями за змовчуванням.

Вхідні дані:

SGrid – екранна таблиця, під яку треба настроїти масив;

NewRows – масив номерів рядків таблиці, що були додані чи змінені

(що зазнали змін з часу останнього виклику цієї процедури під час

редагування).}

Var CurHeight, OldHeight, CurRow: Integer;

Procedure FillWithDefVal (SElmNum: Integer);

Begin

Self. CurHeadCol[SElmNum].ElmType:=bc_FuncVal;

Self. CurHeadCol[SElmNum].VarInitInRow:=False;

Self. CurHeadCol[SElmNum].VarInitPos:=SElmNum;

Self. CurHeadCol[SElmNum].AsVarName:=sc_YFuncName+

IntToStr (SElmNum+1);

End;

Begin {Висота таблиці за поточною висотою екранної таблиці:}

CurHeight:=SGrid. RowCount-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

OldHeight:=Length (Self. CurHeadCol); {попередня висота таблиці}

If (OldHeight<>CurHeight) and (CurHeight>=0) then

Begin

{Змінюємо довжину масиву стовпця-заголовка:}

SetLength (Self. CurHeadCol, CurHeight);

For CurRow:=OldHeight to CurHeight-1 do

FillWithDefVal(CurRow); {заповнюємо нові комірки за змовчуванням}

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnDrawCell (Sender: TObject; ACol,

ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедура виконується при малюванні кожної комірки StringGrid.

Зафарбовує в інший колір фону комірок:

перший стовпець комірок (стовпець-заголовок таблиці задачі лінійного

програмування). Комірки цього стовпця зафарбовуються відповідно до типів

елементів у масиві стовпця-заголовка (якщо цей масив створений для цих

комірок, інакше – за змовчуванням: кольором назв функцій умов-нерівностей,

і найнижчу комірку – кольором для назви функції мети);

останній стовпець (стовпець значень правих сторін рівнянь або

нерівностей та комірка значення цільової функції);

найнижчий рядок (рядок коефіцієнтів цільової функції);

відмічає кольором комірки-заголовки стовпців коефіцієнтів змінних

за відмітками про залежність змінних (рядок-заголовок таблиці задачі ЛП).}

Var CurGrid:TStringGrid; SafeBrushColor:TColor;

CurVarColState:THeadLineElmType; CurColor:TColor;

ArrRowNum: Integer;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDrawCell<>Nil then Self. OldOnDrawCell (Sender, ACol, ARow, Rect,

State);

ArrRowNum:=ARow – (Self.CHeadRowNum+bc_LTaskRowsBeforeVars);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

SafeBrushColor:=CurGrid. Canvas. Brush. Color;

CurColor:=bc_NotColored;

{Комірки останнього стовпця є стовпцем правих сторін рівнянь.

Фарбуємо їх у блакитний колір (окрім комірок заголовків):}

If Not (gdFixed in State) then {якщо комірка не у заголовках StringGrid}

Begin

If ACol>=(CurGrid. ColCount-bc_LTaskColsAfterVars) then {останні стовпці:}

Begin

{Якщо це комірка значення цільової функції – для неї свій колір:}

Case Self. CurHeadCol[ArrRowNum].ElmType of

bc_DestFuncToMax: CurColor:=lwc_DestFuncValColor;

bc_DestFuncToMin: CurColor:=lwc_DestFuncValColor;

Else CurColor:=lwc_RightSideColColor;

End;

End

Else if ACol<(Self.CHeadColNum+bc_LTaskColsBeforeVars) then

Begin {Якщо перші стовпці (стовпець-заголовок):}

{Якщо для цієї комірки задано елемент у масиві стовпця-заголовка,

то фарбуємо її залежно від типу цього елемента:}

If Length (Self. CurHeadCol)>

(ARow – (Self.CHeadRowNum + bc_LTaskRowsBeforeVars)) then

Begin{Тип елемента у комірці:}

CurVarColState:=Self. CurHeadCol [ARow – (Self.CHeadRowNum+

bc_LTaskRowsBeforeVars)].ElmType;

CurColor:=GetColorByElmType(CurVarColState); {колір за типом}

End

Else{Якщо масив стовпця-заголовка не визначено для комірки –

фарбуємо за змовчуванням – як назву функції умови-нерівності:}

CurColor:=lwc_HeadColColor;

End{Якщо рядок коефіцієнтів при змінних цільової функції:}

Else if (Self. CurHeadCol[ArrRowNum].ElmType=bc_DestFuncToMax) or

(Self. CurHeadCol[ArrRowNum].ElmType=bc_DestFuncToMin) then

Begin

{Якщо рядок функції виділений, то виділяємо кольором:}

If InSolving and (Self. CurGridSolveRow=ARow) then

CurColor:=lwc_SolveRowColor

Else CurColor:=lwc_FuncRowColor; {інакше – колір рядка функції мети}

End{Якщо це розв'язувальна комірка, чи рядок або стовпець з такою

коміркою, і треба відображати хід вирішування задачі:}

Else if InSolving then

Begin

If Self. CurGridSolveCol=ACol then {якщо це розв'язувальний стовпець:}

Begin

If Self. CurGridSolveRow=ARow then {якщо це розв'язувальна комірка:}

CurColor:=lwc_SolveCellColor

Else CurColor:=lwc_SolveColColor;

End{Якщо це розв'язувальний рядок (але не розв'язувальна комірка):}

Else if Self. CurGridSolveRow=ARow then CurColor:=lwc_SolveRowColor;

End;

End;

{Зафарбовуємо комірки-заголовки стовпців коефіцієнтів при змінних

відповідно до масиву поміток про залежність:}

If (ARow=Self.CHeadRowNum) and

(Not (ACol<(Self.CHeadColNum+bc_LTaskColsBeforeVars))) then

Begin

CurVarColState:=Self. CurHeadRow [ACol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType;

CurColor:=GetColorByElmType(CurVarColState)

End;

If CurColor<>bc_NotColored then {якщо комірку треба пофарбувати:}

Begin {Малюємо текст на фоні з кольором CurColor:}

CurGrid. Canvas. Brush. Color:=CurColor;

CurGrid. Canvas. TextRect (Rect, Rect. Left, Rect. Top,

CurGrid. Cells [ACol, ARow]);

End;

CurGrid. Canvas. Brush. Color:=SafeBrushColor;

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnDblClick (Sender: TObject);

{Процедура реагує на подвійне натискання лівою кнопкою миші на

комірки рядка-заголовка таблиці (другий рядок StringGrid ).

Редагує масив позначок про обрані стовпці ( SipmlexVarsDependencyRec )

залежних змінних. Залежні змінні – це змінні, для яких є умова

невід'ємності. Тобто вони не повинні бути менше нуля.}

Var CurGrid:TStringGrid; CurCol, CurRow: Integer;

MouseCoordsInGrid:TPoint;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDblClick<>Nil then Self. OldOnDblClick(Sender);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

{Пробуємо узнати, на яку комірку двічі натиснула миша:}

MouseCoordsInGrid:=CurGrid. ScreenToClient (Mouse. CursorPos);

CurCol:=-1; CurRow:=-1;

CurGrid. MouseToCell (MouseCoordsInGrid.X, MouseCoordsInGrid.Y, CurCol, CurRow);

{Якщо натиснуто на комірку-заголовок стовпця коефіцієнтів при змінній, то:}

If ((CurCol>=(Self.CHeadColNum+bc_LTaskColsBeforeVars)) and

(CurCol<(CurGrid. ColCount-bc_LTaskColsAfterVars))) and

(CurRow=Self.CHeadRowNum) then

Begin

{Змінюємо ознаку залежності відповідної змінної:}

If CurHeadRow [CurCol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType=bc_IndependentVar then

CurHeadRow [CurCol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType:=bc_DependentVar

Else

CurHeadRow [CurCol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType:=bc_IndependentVar;

{Задаємо перемалювання комірок, щоб відобразилася зміна позначки

для змінної:}

CurGrid. Invalidate;

End;

End;

End;

Procedure TGridFormattingProcs. InitGridPopupMenu (SGrid:TStringGrid);

{Процедура перевіряє наявність об'єкта TPopupMenu. Якщо його немає

(SGrid. PopupMenu=Nil), то створює новий.

Видаляє усі пунтки (елементи, теми) з меню.}

Begin

If SGrid. PopupMenu=Nil then

Begin

SGrid. PopupMenu:=TPopupMenu. Create(Application);

End;

SGrid. PopupMenu. AutoPopup:=False;

SGrid. PopupMenu. Items. Clear;

End;

Procedure TGridFormattingProcs. ProcOnCellTypeSelInMenu (Sender: TObject);

{Обробник вибору пункту в меню типів для комірки

рядка – чи стовпця-заголовка.}

Constsc_CurProcName='ProcOnCellTypeSelInMenu';

ProcedureReportUnsupportedCell;

Begin

{Відображає координати комірки з повідомленням про те, що вона

не підтримується:}

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoCellOrNotSupported+

' ['+IntToStr (Self. CurGridSolveCol)+';'+IntToStr (Self. CurGridSolveRow)+

']… ');

End;

End;

Var CurMenuItem:TMenuItem; TypeForCell:THeadLineElmType;

Begin

If (Sender=Nil) or (Not (Sender is TMenuItem)) then

Begin

If Self. MemoForOutput<>Nil then

Self. MemoForOutput. Lines. Add (sc_CurProcName + sc_CantDetMenuItem);

Exit;

End;

{Читаємо тип, що обраний для комірки:}

CurMenuItem:=TMenuItem(Sender);

TypeForCell:=THeadLineElmType (CurMenuItem. Tag);

If (Self. CurGridSolveCol<0) and (Self. CurGridSolveRow<0) then

Begin {якщо комірка вище чи лівіше заголовків таблиці:}

ReportUnsupportedCell; Exit;

End;

{Перевіряємо координати комірки і змінюємо її тип:}

{координати комірки мають бути записані у CurGridSolveRow і CurGridSolveCol:}

If Self. CurGridSolveRow=-bc_LTaskRowsBeforeVars then

Begin{якщо це комірка рядка-заголовка:}

If Length (Self. CurHeadRow)>Self. CurGridSolveCol then {якщо комірка існує:}

Begin {задаємо тип комірки:}

Self. CurHeadRow [Self. CurGridSolveCol].ElmType:=TypeForCell;

End

Else{якщо в рядку-заголовку немає такої комірки:}

Begin

ReportUnsupportedCell; Exit;

End;

End

Else if Self. CurGridSolveCol=-bc_LTaskColsBeforeVars then

Begin {якщо це комірка стовпця-заголовка:}

If Length (Self. CurHeadCol)>Self. CurGridSolveRow then {якщо комірка існує:}

Begin {задаємо тип комірки:}

Self. CurHeadCol [Self. CurGridSolveRow].ElmType:=TypeForCell;

End

Else {якщо в стовпці-заголовку немає такої комірки:}

Begin

ReportUnsupportedCell; Exit;

End;

End

Else {якщо комірка у таблиці коефіцієнтів або правіше чи нижче неї:}

Begin

ReportUnsupportedCell; Exit;

End;

{Якщо тип комірки змінено, то перемальовуємо екранну таблицю для

відображення нового типу комірки:}

IfSelf. CurGrid<>Nil then Self. CurGrid. Invalidate;

End;

Procedure TGridFormattingProcs. AddCellTypeItemToMenu (SMenu:TPopupMenu;

SCaption: String; IsCurrentItem: Boolean; SAssocType:THeadLineElmType;

ToSetReactOnClick: Boolean=True);

{Додає пункт меню для вибору типу комірки в таблиці з заданим

написом SCaption і кругом того кольору, що асоційований з даним

типом SAssocType . Для нового пункту меню настроює виклик процедури обробки

комірки для задавання їй обраного типу SAssocType . Значення SAssocType

записує у поле Tag об'єкта пункту меню.

Вхідні дані:

SMenu – контекстне меню для комірки, що формується;

SCaption – підпис для пункту меню (назва типу комірки);

IsCurrentItem – ознака того, що даний пункт меню має бути поточним

(ввімкненим, відміченим) – що це поточний тип комірки;

SAssocType – тип комірки, що прив'язаний до цього пункта меню, і буде

присвоєний комірці при виборі цього пункту;

ToSetReactOnClick – вмикач настройки виклику процедури задавання нового

типу комірки (при виборі елемента меню). При ToSetReactOnClick = False

це не виконується, і натискання елемента меню не викликає ніяких дій.}

Var CurMenuItem:TMenuItem;

SAssocColor:TColor;

Begin

If SMenu=Nil then Exit; {якщо меню не задано – елемент не додаємо в нього}

{Створюємо новий тункт меню:}

CurMenuItem:=TMenuItem. Create(Application);

{Отримуємо колір для даного типу комірки:}

SAssocColor:=Self. GetColorByElmType(SAssocType);

{Біля тексту малюємо круг такого кольору, який асоційований

з типом комірки, і буде присвоєний їй у разі вибору цього пунтку

меню:}

CurMenuItem. Bitmap. Height:=bc_MenuItemColorCircleDiameter;

CurMenuItem. Bitmap. Width:=bc_MenuItemColorCircleDiameter;

CurMenuItem. Bitmap. Canvas. Pen. Color:=SAssocColor;

CurMenuItem. Bitmap. Canvas. Brush. Color:=SAssocColor;

CurMenuItem. Bitmap. Canvas. Ellipse (CurMenuItem. Bitmap. Canvas. ClipRect);

{0 – картинка задана у самому об'єкті, а не в SMenu . Images :}

CurMenuItem. ImageIndex:=0;

CurMenuItem. RadioItem:=True; {промальовувати перемикач, якщо не буде картинки}

{Текст пункту меню:}

CurMenuItem. Caption:=SCaption;

CurMenuItem. Checked:=IsCurrentItem;

If ToSetReactOnClick then {якщо обробка вибору елемента меню ввімкнена}

Begin

{Тип для комірки у випадку вибору цього пунтку меню:}

CurMenuItem. Tag:=Integer(SAssocType);

{Процедура-обробник вибору пункта меню:}

CurMenuItem. OnClick:=Self. ProcOnCellTypeSelInMenu;

CurMenuItem. AutoCheck:=True;

End;

SMenu. Items. Add(CurMenuItem);

End;

(* {Ідентифікатор для типу елемента масиву чисел та імен змінних.

Типи змінних: залежні, незалежні, функції (умови-нерівності).

Залежні змінні – це змінні, для яких діє умова невід'ємності:}

THeadLineElmType=(bc_IndependentVar, bc_DependentVar, bc_FuncVal, bc_Number,

bc_DestFuncToMax);} *)

procedure TGridFormattingProcs. EdLineTaskOnMouseUp (Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

{Процедура реагує на відпускання правої кнопки миші на

комірках рядка-заголовка та стовпця-заголовка таблиці.

Формує та відкриває контекстне меню для вибору типу комірки із можливих

типів для цієї комірки.}

Constsc_CurProcName='EdLineTaskOnMouseUp';

Var CurCol, CurRow, ArrayRow, ArrayCol: Integer; CurElmType:THeadLineElmType;

MouseScrCoords:TPoint;

Begin

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnMouseUp<>Nil then Self. OldOnMouseUp (Sender, Button, Shift, X, Y);

If Sender=Nil then Exit;

{Якщо задано екранну таблицю даного об'єкта TGridFormattingProcs:}

If Sender = Self. CurGrid then

Begin

If Button=mbRight then {якщо була відпущена права кнопка миші}

Begin

{Пробуємо узнати, на яку комірку натиснула миша:}

CurCol:=-1; CurRow:=-1;

Self. CurGrid. MouseToCell (X, Y, CurCol, CurRow);

MouseScrCoords:=Self. CurGrid. ClientToScreen (Point(X, Y));

{Координати комірки у масивах таблиці і її заголовків:}

ArrayRow:=CurRow-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

ArrayCol:=CurCol-Self.CHeadColNum-bc_LTaskColsBeforeVars;

{Якщо натиснуто на комірку рядка-заголовка:}

If (CurRow=Self.CHeadRowNum) and (ArrayCol>=0) and

(ArrayCol<Length (Self. CurHeadRow)) then

Begin {очищаємо меню перед заповненням:}

Self. InitGridPopupMenu (Self. CurGrid);

{Якщо в екранній таблиці були зміни з часу останнього її читання,

то читаємо комірку, для якої треба сформувати меню:}

If Self. CurGridModified then Self. ReadHeadRowCell(ArrayCol);

{Читаємо поточний тип комірки:}

CurElmType:=Self. CurHeadRow[ArrayCol].ElmType;

{Додаємо пункти меню:}

{Якщо в комірці число-то тип комірки може бути тільки числовий:}

If CurElmType=bc_Number then

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_ValInHeadColOrRow, True, CurElmType)

Else{якщо в комірці не число:}

Begin

{незалежна змінна:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_IndependentVar,

CurElmType = bc_IndependentVar, bc_IndependentVar);

{залежна змінна:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_DependentVar,

CurElmType = bc_DependentVar, bc_DependentVar);

End;

End

Else If (CurCol=Self.CHeadColNum) and (ArrayRow>=0) and

(ArrayRow<Length (Self. CurHeadCol)) then

Begin {якщо натиснуто на комірку стовпця-заголовка:}

Self. InitGridPopupMenu (Self. CurGrid);

{Якщо в екранній таблиці були зміни з часу останнього її читання,

то читаємо комірку, для якої треба сформувати меню:}

If Self. CurGridModified then Self. ReadHeadColCell(ArrayRow);

{Читаємо поточний тип комірки:}

CurElmType:=Self. CurHeadCol[ArrayRow].ElmType;

{Додаємо пункти меню:}

{Якщо в комірці число-то тип комірки може бути тільки числовий:}

If CurElmType=bc_Number then

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_ValInHeadColOrRow, True, CurElmType)

Else{якщо в комірці не число:}

Begin

{назва фінкції – рядка нерівності:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_InequalFuncName, CurElmType = bc_FuncVal, bc_FuncVal);

{назва функції мети, що максимізується:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_DestFuncToMaxName, CurElmType = bc_DestFuncToMax,

bc_DestFuncToMax);

{назва функції мети, що мінімізується:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_DestFuncToMinName, CurElmType = bc_DestFuncToMin,

bc_DestFuncToMin);

End;

End

Else {якщо для даної комірки вибір типу не передбачено}

Begin{ставимо в меню координати комірки

(щоб користувач взагалі помітив, що меню є…)}

Self. InitGridPopupMenu (Self. CurGrid);

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_Row+sc_DoubleSpot+sc_Space+IntToStr (ArrayRow+1)+sc_KrKm+

sc_Space+sc_Col+sc_DoubleSpot+sc_Space+IntToStr (ArrayCol+1),

True, bc_OtherType);

End;

{Записуємо координати комірки для обробника вибору типу з меню:}

Self. CurGridSolveCol:=ArrayCol;

Self. CurGridSolveRow:=ArrayRow;

{Відображаємо меню:}

Self. CurGrid. PopupMenu. Popup (MouseScrCoords.X, MouseScrCoords.Y);

End; {If Button=mbRight then…}

End {If Sender = Self. CurGrid then…}

Else {якщо обробник викликала «чужа» таблиця або невідомий об'єкт:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_UnknownObjectCall+

sc_DoubleQuot+Sender. ClassName+sc_DoubleQuot);

End;

End;

procedure TGridFormattingProcs. ReactOnSetEditText (Sender: TObject; ACol,

ARow: Longint; const Value: string);

{Процедура для реагування на редагування вмісту комірок

під час редагування вхідних даних. Встановлює прапорець

CurGridModified := True про те, що екранна таблиця має зміни.}

Begin

{Старий обробник теж викликаємо, якщо він є:}

If @Self. OldOnSetEditText<>Nil then

Self. OldOnSetEditText (Sender, ACol, ARow, Value);

Self. CurGridModified:=True;

End;

Procedure TGridFormattingProcs. SetNewState (Value:TTableFormatState);

Const sc_CurProcName='SetNewState';

Var StateSafe:TTableFormatState;

OldHColPos, OldHRowPos: Integer;

{Процедура для зміни режиму форматування GrowingStringGrid}

Procedure GoSolveLTask;

Begin {Вирішування задачі ЛП симплекс-методом:}

CurGrid. ColCount:=bc_FixedCols+1;

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

If Not (Self. PrepareToSolveLTask) then

Begin {Якщо не вдається підготувати таблицю до вирішування задачі:}

StateSafe:=Self. CurFormatState;

{Перемикаємо на режим fs_NoFormatting, і назад у поточний,

щоб встановити усі настройки цього режиму (повернутися до них):}

Self. TableFormatState:=fs_NoFormatting;

Self. TableFormatState:=StateSafe;

Exit;

End;

CurGrid. OnNewCol:=NumerationOnNewCol;

CurGrid. OnNewRow:=NumerationOnNewRow;

CurGrid. OnDrawCell:=EdLineTaskOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

CurGrid. OnSetEditText:=OldOnSetEditText;

{Вимикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options – [goEditing];

End;

Begin

If InSolving then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CantChangeStateInSolving);

Exit;

End;

If Self. CurGrid=Nil then {Якщо екранну таблицю не задано:}

Begin{запам'ятовуємо поточний режим, і більше нічого не робимо тут:}

Self. CurFormatState:=Value; Exit;

End;

{Якщо задано новий режим:}

IfSelf. CurFormatState<>Valuethen

Begin{Якщо форматування було вимкнене:}

If Self. CurFormatState=fs_NoFormatting then

Begin {Запам'ятовуємо обробники подій, які замінимо на свої

форматувальники:}

OldOnNewCol:=CurGrid. OnNewCol;

OldOnNewRow:=CurGrid. OnNewRow;

OldOnDrawCell:=CurGrid. OnDrawCell;

OldOnDblClick:=CurGrid. OnDblClick;

OldOnSetEditText:=CurGrid. OnSetEditText;

OldOnMouseUp:=CurGrid. OnMouseUp;

End;

{Якщо таблиця редагована, то приймаємо останні зміни перед

зміною режиму:}

If Self. CurGridModified then Self. Refresh;

Case Value of

fs_EnteringEqs: {редагування таблиці системи лінійних рівнянь:}

Begin

{Встановлюємо потрібну кількість рядків і стовпців екранної

таблиці для фіксованих заголовків («тільки для читання»).

Для цього забезпечуємо щоб кількість рядків і стовпців не була

меншою за потрібну кількість фіксованих, плюс хоч один

стовпець / рядок (хоч одна комірка) для редагування:}

If CurGrid. ColCount<bc_FixedCols+1 then

CurGrid. ColCount:=bc_FixedCols+1;

If CurGrid. RowCount<bc_FixedRows+1 then

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Позиціювання таблиці до зміни режиму:}

OldHColPos:=Self.CHeadColNum; OldHRowPos:=Self.CHeadRowNum;

{Позиціювання відображення таблиці у даному режимі редагування:}

Self.CHeadColNum:=CurGrid. FixedCols-1;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Якщо позиціювання змінилося, то відображаємо таблицю

в новому місці:}

If (OldHColPos<>Self.CHeadColNum) or

(OldHRowPos<>Self.CHeadRowNum) then Self. Refresh;

CurGrid. OnNewCol:=EditLineEqsOnNewCol;

CurGrid. OnNewRow:=EditLineEqsOnNewRow;

CurGrid. OnDrawCell:=EditLineEqsOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

{Вмикаємо можливість редагування:}

CurGrid. Options:=CurGrid. Options+[goEditing];

CurGrid. OnSetEditText:=ReactOnSetEditText;

InSolving:=False;

End;

fs_EnteringLTask:

Begin {Редагування таблиці задачі ЛП (максимізації/мінімізації):}

{Встановлюємо потрібну кількість рядків і стовпців екранної

таблиці для фіксованих заголовків («тільки для читання»).

Для цього забезпечуємо щоб кількість рядків і стовпців не була

меншою за потрібну кількість фіксованих, плюс хоч один

стовпець / рядок (хоч одна комірка) для редагування:}

If CurGrid. ColCount<bc_FixedCols+1 then

CurGrid. ColCount:=bc_FixedCols+1;

If CurGrid. RowCount<bc_FixedRows+1 then

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Позиціювання таблиці до зміни режиму:}

OldHColPos:=Self.CHeadColNum; OldHRowPos:=Self.CHeadRowNum;

{Позиціювання відображення таблиці у даному режимі редагування:}

Self.CHeadColNum:=CurGrid. FixedCols-1 + bc_LTaskColsBeforeVars;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Якщо позиціювання змінилося, то відображаємо таблицю

в новому місці:}

If (OldHColPos<>Self.CHeadColNum) or

(OldHRowPos<>Self.CHeadRowNum) then Self. Refresh;

CurGrid. OnNewCol:=EdLineTaskOnNewCol;

CurGrid. OnNewRow:=EdLineTaskOnNewRow;

CurGrid. OnDrawCell:=EdLineTaskOnDrawCell;

CurGrid. OnDblClick:=EdLineTaskOnDblClick;

CurGrid. OnMouseUp:=EdLineTaskOnMouseUp;


{Вмикаємо можливість редагування:}

CurGrid. Options:=CurGrid. Options+[goEditing];

CurGrid. OnSetEditText:=ReactOnSetEditText;

InSolving:=False;

End;

fs_SolvingEqsM1: {вирішування системи лінійних рівнянь способом 1:}

Begin

CurGrid. ColCount:=bc_FixedCols+1;

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Пробуємо підготувати таблицю до вирішування. Якщо не

вдається, то залишаємось у режимі, який був до спроби його

змінити:}

If Not (Self. PrepareToSolveEqsWithM1) then

Begin

StateSafe:=Self. CurFormatState;

{Перемикаємо на режим fs_NoFormatting, і назад у поточний,

щоб встановити усі настройки цього режиму:}

Self. TableFormatState:=fs_NoFormatting;

Self. TableFormatState:=StateSafe;

Exit;

End;

CurGrid. OnNewCol:=NumerationOnNewCol;

CurGrid. OnNewRow:=NumerationOnNewRow;

CurGrid. OnDrawCell:=SolveLineEqsM1OrM2OnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

{Вимикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options – [goEditing];

CurGrid. OnSetEditText:=OldOnSetEditText;

End;

fs_SolvingEqsM2: {вирішування системи лінійних рівнянь способом 2:}

Begin

CurGrid. ColCount:=bc_FixedCols+1;

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Пробуємо підготувати таблицю до вирішування. Якщо не

вдається, то залишаємось у режимі, який був до спроби його

змінити:}

If Not (Self. PrepareToSolveEqsWithM2) then

Begin

StateSafe:=Self. CurFormatState;

{Перемикаємо на режим fs_NoFormatting, і назад у поточний,

щоб встановити усі настройки цього режиму:}

Self. TableFormatState:=fs_NoFormatting;

Self. TableFormatState:=StateSafe;

Exit;

End;

CurGrid. OnNewCol:=NumerationOnNewCol;

CurGrid. OnNewRow:=NumerationOnNewRow;

CurGrid. OnDrawCell:=SolveLineEqsM1OrM2OnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

CurGrid. OnSetEditText:=OldOnSetEditText;

{Вимикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options – [goEditing];

End;

fs_SolvingLTask: GoSolveLTask;

fs_FreeEdit: {Режим вільного редагування таблиці:}

Begin

CurGrid. OnNewCol:=OldOnNewCol;

CurGrid. OnNewRow:=OldOnNewRow;

CurGrid. OnDrawCell:=OldOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

{Вмикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options+[goEditing];

{Вмикаємо стеження за змінами в екнанній таблиці:}

CurGrid. OnSetEditText:=ReactOnSetEditText;

InSolving:=False;

End;

Else {Без форматування (fs_NoFormatting), або невідомий режим:}

Begin

CurGrid. OnNewCol:=OldOnNewCol;

CurGrid. OnNewRow:=OldOnNewRow;

CurGrid. OnDrawCell:=OldOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

CurGrid. OnSetEditText:=OldOnSetEditText;

InSolving:=False;

End;

End;

CurGrid. Invalidate; {перемальовуємо таблицю з новими форматувальниками}

Self. CurFormatState:=Value; {запам'ятовуємо новий режим форматування}

End;

End;

Procedure TGridFormattingProcs. SetNewGrid (Value:TGrowingStringGrid);

Var SafeFormatState:TTableFormatState;

Begin

If Self. CurGrid<>Value then {якщо задано новий об'єкт таблиці:}

Begin

SafeFormatState:=Self. TableFormatState;

{Знімаємо усі процедури-форматувальники, перемальовуємо таблицю

(якщо вона була) перед заміною її на задану:}

Self. TableFormatState:=fs_NoFormatting;

Self. CurGrid:=Value; {запам'ятовуємо вказівник на новий об'єкт таблиці}

{Застосовуємо форматування для нової таблиці (якщо вона не відсутня,

вказівник на неї не рівний Nil ):}

Self. TableFormatState:=SafeFormatState;

Self. Refresh;

End;

End;

Procedure TGridFormattingProcs. SetHeadColNum (Value: Integer);

Begin

If Self. CurFormatState=fs_FreeEdit then

Begin

If Value<0 then Value:=0;

Self.CHeadColNum:=Value;

End;

End;

Procedure TGridFormattingProcs. SetHeadRowNum (Value: Integer);

Begin

If Self. CurFormatState=fs_FreeEdit then

Begin

If Value<0 then Value:=0;

Self.CHeadRowNum:=Value;

End;

End;

Procedure TGridFormattingProcs. SetNewMemo (Value:TMemo);

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (Self. ClassName+': повідомлення вимкнені.');

Self. CurOutConsole:=Value;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (Self. ClassName+': повідомлення ввімкнені.');

End;

end.


Висновки

лінійний програмування компромісний розв'язок

Хоч кожній залежній змінній одної задачі відповідає функція-умова (нерівність) двоїстої, і кожній функції-умові відповідає залежна змінна, ці пари величин приймають різні значення у розв’язку пари задач.

Компромісний розв’язок багатокритеріальної задачі ЛП зручно застосовувати для об’єктів управління з такими вихідними параметрами (функціями мети), які є практично рівноправними (мають однаковий пріоритет до оптимізації, або їх пріоритети складно оцінити). За допомогою нього можна отримати розв’язок з мінімальним сумарним програшем оптимізації параметрів.


Використана література

1. Левин С.В., Александрова В.В.: «БАГАТОКРИТЕРІАЛЬНА ОПТИМІЗАЦІЯ З ВИКОРИСТАННЯМ ТЕОРЕТИКО-ІГРОВОГО ПІДХОДУ»: методичні вказівки до виконання курсової роботи з курсу «Математичні методи дослідження операцій» – Харків, Національний аерокосмічний університет ім. М.Є. Жуковського «Харківський авіаційний інститут», 2008 р.

2. Довідка з Borland Delphi 6.

Оценить/Добавить комментарий
Имя
Оценка
Комментарии:
Где скачать еще рефератов? Здесь: letsdoit777.blogspot.com
Евгений08:28:59 19 марта 2016

Работы, похожие на Курсовая работа: Багатокритеріальна задача лінійного програмування

Назад
Меню
Главная
Рефераты
Благодарности
Опрос
Станете ли вы заказывать работу за деньги, если не найдете ее в Интернете?

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



Результаты(150117)
Комментарии (1830)
Copyright © 2005-2016 BestReferat.ru bestreferat@mail.ru       реклама на сайте

Рейтинг@Mail.ru