Розв^язати багатокритеріальну задачу лінійного програмування з отриманням компромісного розв^язку за допомогою теоретико-ігрового підходу.
Задача (варіант 1):
Z1= x1+2x2+x3 ® max
Z2= – x1 –2x2+x3+x4 ® min
Z3= –2x1 –x2+x3+x4 ® max
з обмеженнями
2x1 –x2+3x3+4x4 £ 10
x1+x2+x3 –x4 £ 5
x1+2x2 –2x3+4x4 £ 12
"x ³ 0
У цій роботі реалізовано вирішування таких задач лінійного програмування: розв^язування задач багатокритеріальної оптимізації, тобто пошук компромісного рішення для задач з кількома функціями мети.
Ця задача така:
Задано об^єкт управління, що має n входів і k виходів. Вхідні параметри складають вектор X = {xj}, . Кожен з вхідних параметрів може мати обмеження, що накладене на область його значень. В програмі підтримуються параметри без обмежень на значення, і з обмеженнями невід^ємності (з областю ). Також на комбінації вхідних значень можуть бути накладені обмеження як система лінійних рівнянь або нерівностей:
Вихідні сигнали об^єкта є лінійними комбінаціями вхідних сигналів. Для досягнення ефективності роботи об^єкта управління частину вихідних сигналів треба максимізувати, інші – мінімізувати, змінюючи вхідні сигнали і дотримуючись обмежень на ці сигнали (задоволення усіх нерівностей, рівнянь і обмежень області значень кожного з вхідних параметрів). Тобто вихідні сигнали є функціями мети від вхідних:
Як правило, для багатокритеріальної задачі не існує розв^язку, який би був найкращим (оптимальним) для усіх функцій мети одночасно. Проте можна підібрати такий розв^язок, який є компромісним для усіх функцій мети (в точці цього розв^язку кожна з функцій мети якнайменше відхиляється від свого оптимального значення в заданій системі умов (обмежень).
Тут реалізовано пошук компромісного розв^язку за допомогою теоретико-ігрового підходу, що був розроблений під керівництвом доцента ХАІ Яловкіна Б.Д. Цей підхід дозволяє знайти компромісний розв^язок з мінімальним сумарним відхиленням всіх виходів (значень функцій мети) від їхніх екстремальних значень за даної системи обмежень.
Йде пошук компромісного вектора значень змінних в такому вигляді:
тут – вектор, що оптимальний для i-го критерію (функції мети); li – вагові коефіцієнти.
Для отримання цього вектора виконуються такі кроки розв^язування:
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={C1X, …, CkX} другого. Всі міри неоптимальності є недодатними, і є коефіцієнтами програшу першого гравця. На головній діагоналі вони рівні нулю (бо є мірами неоптимальності оптимального вектора для своєї ж функції).
3) Матриця мір неоптимальності заміняється еквівалентною їй матрицею додаванням до кожної міри неоптимальності , тобто найбільшого з абсолютних значень всіх мір. Якщо таке найбільше значення рівне нулю, то всі міри рівні нулю, і в такому випадку замість нього до усіх мір додається число 1. В результаті отримуємо матрицю з невід^ємними елементами. На головній діагоналі усі вони рівні максимальному значенню. Така заміна матриці не змінює рішення гри, змінює тільки її ціна. Тобто тепер гра має вигляд не гри програшів, а гри з пошуком максимального виграшу. Для пошуку оптимальної стратегії для першого гравця гра подається як пара взаємнодвоїстих однокритеріальних задач ЛП. Для першого гравця потрібні значення змінних двоїстої задачі :
|
|
v1= |
v2= |
… |
vk= |
W= |
|
|
- |
- |
… |
- |
1 |
-u1 |
= |
|
|
… |
|
1 |
-u2 |
= |
|
|
… |
|
1 |
… |
… |
. |
. |
. |
. |
. |
-uk |
= |
|
|
… |
|
1 |
1 |
Z = |
-1 |
-1 |
… |
-1 |
0 |
Розв^язавши цю задачу і отримавши оптимальні значення max(Z) = min(W), що досягаються при значеннях змінних двоїстої задачі , можна обчислити вагові коефіцієнти для компромісного розв^язку багатокритеріальної задачі:
,
Компромісний вектор значень змінних для багатокритеріальної задачі є лінійною комбінацією оптимальних векторів кожної функції мети. Це сума векторів, що помножені кожен на свій ваговий коефіцієнт:
Підставивши цей компромісний вектор в кожну функцію мети багатокритеріальної задачі отримуємо компромісні значення цих функцій.
Рівняння, нерівності та функції записуються у таблицю:
Розв^язування задачі ЛП для кожної функції мети окремо:
Пошук оптимального розв^язку для функції Z1
Задача для симплекс-метода з функцією Z1
Незалежних змінних немає.
Виключення 0-рядків: немає.
Опорний розв^язок: готовий (усі вільні члени невід^ємні).
Пошук оптимального розв^язку:
Результат для прямої задачі:
У рядку-заголовку:
– x1 = 0;
– y2 = 0;
– y1 = 0;
– y3 = 0;
У стовпці-заголовку:
x3 = 2,33333333333333;
x2 = 4,55555555555556;
x4 = 1,88888888888889;
Функція мети: Z1 = 11,4444444444444.
Пошук оптимального розв^язку для функції Z2
Функцію Z2, що мінімізується, замінили на протилежну їй – Z2, що максимізується. Запис для вирішування симплекс-методом максимізації
Незалежних змінних немає.
0-рядків немає.
Опорний розв^язок: готовий.
Пошук оптимального:
Після отримання розв^язку максимізації для – Z2, взято протилежну до неї функцію Z2, і отримано розв^язок мінімізації для неї
Результат для прямої задачі:
У рядку-заголовку:
– 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
Вирішування закінчено. Успішно.
Модуль опису класу, що виконує роботу з задачами ЛП:
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=array of TValOrName; {тип масиву для заголовків матриці}
TFloatArr=array of TWorkFloat; {тип масиву дійсних чисел}
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 і заповнює нові елементи
значеннями за змовчуванням. Використовується при зміні розмірів
екранної таблиці. Після її виклику можна вказувати типи змінних
у рядку-заголовку (користувач вибирає залежні та незалежні):}
Procedure UpdateLTaskHeadRowToStrGrid (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), то створює новий.
Видаляє усі пунтки (елементи, теми) з меню:}
Procedure InitGridPopupMenu (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:}
Procedure ReadHeadRowCell (SCol: Integer);
{Зчитує комірку з екранної таблиці в стовпець-заголовок.
Вхідні дані:
SRow – номер комірки у стовпці-заголовку.
Для екранної таблиці використовуються координати комірки відповідно до
координат рядка-заголовка та стовпця заголовка (верхнього лівого кута
таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid:}
Procedure ReadHeadColCell (SRow: Integer);
{Процедура для зчитування таблиці та її заголовків із CurGrid:}
Function ReadTableFromGrid: 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:}
Function SolveEqsWithM1: Boolean;
{Вирішування системи лінійних рівнянь способом 2:}
Function SolveEqsWithM2: 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;
{Вирішування задачі багатокритеріальної оптимізації лінійної
форми з використанням теоретико-ігрового підходу.
Умовою задачі є умови-нерівності, рівняння та умови на
невід"ємність окремих змінних, і декілька функцій мети, для
яких треба знайти якомога більші чи менші значення.
Функція повертає ознаку успішності вирішування:}
Function SolveMultiCritLTask: 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
default Nil;
{Поле для відображення повідомлень:}
Property MemoForOutput:TMemo read CurOutConsole write SetNewMemo
default Nil;
{Номери стовпця і рядка-заголовків у 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):}
Function MakeDualLTask: 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) If 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 – стовпець-заголовок
таблиці; Row1, Row2 – рядки, що треба поміняти
місцями; 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 – рядок-заголовок таблиці; Row1, Row2 – рядки, що треба поміняти
місцями; 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>=<a11>*<ряд1> + <a12>*<ряд2> +… + … <стовпm>= І підраховує значення, якщо можливо: <стовп1>=<значення1>; … <стовпm>=<значенняm>} Var CurRowN, 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> 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 (CurRowNum 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; Procedure ShowResultCalc; {Відображає записи значень змінних (у текстовому полі) такого зказка: <стовп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> 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 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 (SHeadColNum 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 {Зчитуємо таблицю. Як рядок-заголовок зчитуємо автоматично сформовані назви змінних x1…xn та множник вільних членів
(1). Як стовпець-заголовок зчитуємо стовпець нумерації. При переході до режиму вирішування задачі у цей стовпець будуть скопійовані вільні члени (режим способу 1, fs_SolvingEqsM1), або нулі (режим способу 2, fs_SolvingEqsM2):} 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; {Збільшуємо розміри матриці до квадратних:} If CurWidth>CurHeight then {Якщо ширина була більша за
висоту:} Begin SetLength (SDMatrix, CurWidth, CurWidth); {збільшуємо висоту} End Else if CurWidth 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). За правилом двоїсту задачу потрібно мінімізувати, якщо для прямої потрібно було знайти максимум, і максимізувати, якщо для прямої
потрібно було знайти мінімум. } Const sc_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», і заголовок для неї був
додатний), тому змінюємо знак заголовка:} If DualTType=dt_MaxToMin then 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 {Проходимо по усіх елементах-заголовках рядків, і останньому
елементу – заголовку рядка функції мети:} If Self. CurHeadCol[CurRow].ElmType=bc_FuncVal then {Якщо нерівність «<=»:} 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 (окрім вільгого члена), бо помножили і усі x1…xn на -1. Якщо треба мінімум, то ці коефіцієнти не множимо (бо x1…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-го стовпця матриці неоптимальності. Вихідні дані: міра неоптимальності.} Var VarNum: 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 – матриця коефіцієнтів умови багатокритеріальної лінійної задачі оптимізації. Вихідні дані: Повертає значення функції мети.} Var VarNum: 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) 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; {Якщо таких рядків не знайдено, то усі вони вже вгорі:} If CurRowToUp<=CurRowNum then Break 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 – таблиця коефіцієнтів і стовпець-заголовок з перенесеними донизу рядками і комірками; функція повертає номер найвищого рядка із тих, що переміщені вниз (вище нього – рядки тих типів, що не було задано переміщувати
донизу).} Var AllOtherHeadTypes: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 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 {якщо рядки для виключення
ще залишились:} {Шукаємо ненульову комірку серед коефіцієнтів поточної незалежної змінної (окрім останнього рядка, що є рядком поточної функції мети):} If SearchNozeroSolveCell (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 x1 x2 x3 x4 x5… 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 у режимі набору вхідних даних системи лінійних рівнянь. Зафарбовує в інший колір останній стовпець – стовпець правих частин рівнянь.} Var CurGrid: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 y1 2 y2 3 y3 4 y4 5 y5 … 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 x1 x2 x3 x4… 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; {Останній елемент є числом, а не змінною: це множник стовпця вільних членів (правих частин):} If CurLTaskVarCount>0 then Begin Self. CurHeadRow [CurLTaskVarCount-1].ElmType:=bc_Number; Self. CurHeadRow [CurLTaskVarCount-1].AsNumber:=1; {Колишній останній елемент тепер буде
змінною:} If (OldCount>0) and
(OldCount 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); {Обробник вибору пункту в меню типів для комірки рядка – чи стовпця-заголовка.} Const sc_CurProcName="ProcOnCellTypeSelInMenu"; Procedure ReportUnsupportedCell; 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; {Якщо тип комірки змінено, то
перемальовуємо екранну таблицю для відображення нового типу комірки:} If Self. 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); {Процедура реагує на відпускання правої кнопки миші на комірках рядка-заголовка та стовпця-заголовка таблиці. Формує та відкриває контекстне меню для вибору типу комірки із
можливих типів для цієї комірки.} Const sc_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 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 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; {Якщо задано новий режим:} If Self. CurFormatState<>Value then 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 CurGrid. ColCount:=bc_FixedCols+1; If CurGrid. RowCount 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 CurGrid. ColCount:=bc_FixedCols+1; If CurGrid. RowCount 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.