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

1. Завдання
Розв’язати багатокритеріальну задачу лінійного програмуванняз отриманням компромісного розв’язку за допомогою теоретико-ігрового підходу.
Задача (варіант 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³
2. Теоретичні відомості
У цій роботі реалізовано вирішування таких задач лінійногопрограмування: розв’язування задач багатокритеріальної оптимізації, тобто пошуккомпромісного рішення для задач з кількома функціями мети.
Ця задача така:
Задано об’єкт управління, що має 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
Розв’язавши цю задачу і отримавши оптимальні значення max(Z)= min(W), що досягаються при значеннях змінних двоїстої задачі />, можна обчислити ваговікоефіцієнти /> для компромісного розв’язку багатокритеріальноїзадачі:
/>, />

Компромісний вектор значень змінних для багатокритеріальноїзадачі є лінійною комбінацією оптимальних векторів кожної функції мети. Це сумавекторів, що помножені кожен на свій ваговий коефіцієнт:
/>
Підставивши цей компромісний вектор в кожну функцію метибагатокритеріальної задачі отримуємо компромісні значення цих функцій.
3. Вирішування
Рівняння, нерівності та функції записуються у таблицю:
/>
Розв’язування задачі ЛП для кожної функції мети окремо:
Пошук оптимального розв’язку для функції Z1
/>
/>
 
Задача для симплекс-метода з функцією Z1
Незалежних змінних немає.
Виключення 0-рядків: немає.
Опорний розв’язок: готовий (усі вільні члени невід’ємні).
Пошук оптимального розв’язку:
/>                                           />
/>
/>
/>
/>
Результат для прямої задачі:
У рядку-заголовку:
– x1 = 0;
– y2 = 0;
– y1 = 0;
– y3 = 0;
У стовпці-заголовку:
x3 = 2,33333333333333;
x2 = 4,55555555555556;
x4 = 1,88888888888889;
Функція мети: Z1 = 11,4444444444444.
Пошук оптимального розв’язку для функції Z2
/>
/>
 
Функцію 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
Вирішування закінчено. Успішно.
4. Текст програми
Модуль опису класу, що виконує роботу з задачами ЛП:
unit UnMMDOpr;
interface
Uses SysUtils, Types, Classes, Forms,Controls, StdCtrls, Dialogs, Graphics,
Grids, UControlsSizes, Menus;
Const sc_CrLf=Chr(13)+Chr(10);
sc_Minus='-';
sc_Plus='+';
sc_Equal='=';
sc_NotEqual='';
sc_Mul='*';
sc_Space=' ';
sc_KrKm=';';
sc_BrOp=' ('; sc_BrCl=')';
sc_XVarName='x';
sc_YFuncName='y';
sc_DualTaskFuncNameStart='v';
sc_DualTaskVarNameStart='u';
sc_RightSideValsHdr='1';
sc_DestFuncHdr='Z';
sc_DualDestFuncHdr='W';
sc_TriSpot='…'; sc_Spot='.';
sc_DoubleSpot=':';
sc_DoubleQuot='"';
lwc_DependentColor:TColor=$02804000;
lwc_IndependentColor:TColor=$02FF8000;
lwc_RightSideColColor:TColor=$02FFD7AE;
lwc_HeadColColor:TColor=$02808040;
lwc_FuncRowColor:TColor=$02C080FF;
lwc_DestFuncToMaxNameColor:TColor=$024049FF;
lwc_DestFuncToMinNameColor:TColor=$02FF4940;
lwc_DestFuncValColor:TColor=$02A346FF;
lwc_ValInHeadColOrRowColor:TColor=$025A5A5A;
lwc_SolveColColor:TColor=$02AAFFFF;
lwc_SolveRowColor:TColor=$02AAFFFF;
lwc_SolveCellColor:TColor=$0200FFFF;
bc_FixedRows=2; bc_FixedCols=1;
{Кількість стовпців перед стовпцямизмінних та після них,
які можна редагувати, для редагування таблиці задачі
лінійного програмування (максимізації чи мінімізації функції):}
bc_LTaskColsBeforeVars=1;bc_LTaskColsAfterVars=1;
bc_LTaskRowsBeforeVars=bc_LTaskColsBeforeVars;
bc_LineEqM1ColsBeforeVars=1;
bc_LineEqM2ColsAfterVars=1;
bc_NotColored=-1;
bc_Negative=-1; bc_Zero=0;bc_Positive=1;
bc_MenuItemColorCircleDiameter=10;
sc_DependentVar='Залежна змінна(>=0)';
sc_IndependentVar='Незалежна змінна(будь-яке дійсне число)';
sc_FreeMembers='Вільні члени (правісторони рівнянь)';
sc_InequalFuncName='Назва функціїумови-нерівності';
sc_DestFuncCoefs='Рядок коефіцієнтівфункції мети';
sc_DestFuncName='Назва функції мети';
sc_DestFuncToMaxName=sc_DestFuncName+',що максимізується';
sc_DestFuncToMinName=sc_DestFuncName+',що мінімізується';
sc_OtherType='Інший тип';
sc_DestFuncVal='Значення функції мети';
sc_ValInHeadColOrRow='Число у заголовкутаблиці';
sc_SolveCol='Розв''язувальнийстовпець';
sc_SolveRow='Розв''язувальний рядок';
sc_SolveCell='Розв''язувальна комірка';
Type
TWorkFloat=Extended; {тип дійсних чисел, щовикористовуються}
TSignVal=-1..1;
{Ідентифікатор для типу елемента масиву чисел та імен змінних.
Типи змінних: залежні, незалежні, функції (умови-нерівності).
Залежні змінні – це змінні, для яких діє умова невід'ємності:}
THeadLineElmType=(bc_IndependentVar,bc_DependentVar, bc_FuncVal, bc_Number,
bc_DestFuncToMax, bc_DestFuncToMin,bc_OtherType);
THeadLineElmTypes=set ofTHeadLineElmType;
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; ConstSOptimFuncVals:TFloatArr;
SFirstDFuncRow: Integer);
Procedure CalcComprVec (Const SVarVecs:TFloatMatrix;
Const SWeightCoefs:TFloatArr; VarDComprVec: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;
{Властивість для керуання станом форматування:}
PropertyTableFormatState:TTableFormatState read CurFormatState
write SetNewState defaultfs_NoFormatting;
{Прапорець про те, що зараз задача у ході вирішування
(між кроками вирішування):}
Property Solving: Boolean readInSolving;
Property SolutionFound: Boolean readSolWasFound;
Property NoRoots: Boolean readWasNoRoots;
Property ManyRoots: Boolean readWasManyRoots;
{Властивість для задавання екранної таблиці:}
Property StringGrid:TGrowingStringGridread CurGrid write SetNewGrid
default Nil;
{Поле для відображення повідомлень:}
Property MemoForOutput:TMemo readCurOutConsole write SetNewMemo
default Nil;
{Номери стовпця і рядка-заголовків у CurGrid. Змінювати можна
тільки у режимі fs_FreeEdit. В інших режимах зміна ігнорується:}
Property HeadColNumInGrid: Integer readCHeadColNum write SetHeadColNum;
Property HeadRowNumInGrid: Integer readCHeadRowNum write SetHeadRowNum;
{Таблиця і її заголовки у пам'яті:}
Property Table:TFloatMatrix readCurTable;
Property HeadRow:TValOrNameMas readCurHeadRow;
Property HeadCol:TValOrNameMas readCurHeadCol;
{Читання і запис таблиці та режиму редагування у файл
(тільки у режимах редагування):}
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 (VarSDValOrName: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 (VarSDMatr: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
Else if Value>0 thenRes1:=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)=1then 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{якщо немаєелементів для видалення}
{Якщо є хоч один елемент із заданих для видалення:}
If Length(SArr)>=(Index+1) then
Begin
{Якщо у масиві немає так багато елементів, скільки холіливидалити, то
коригуємо кількість тих, що видаляємо:}
If (Index+Count)>Length(SArr) thenCount:=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{якщо немаєелементів для видалення}
{Якщо є хоч один елемент із заданих для видалення:}
If Length(SArr)>=(Index+1) then
Begin
{Якщо у масиві немає так багато елементів, скільки холіливидалити, то
коригуємо кількість тих, що видаляємо:}
If (Index+Count)>Length(SArr) thenCount:=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{якщо немаєелементів для видалення}
{Видаляємо елементи у вказаних стовпцях з кожного рядка. Так
видалимо стовпці:}
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{якщо немаєелементів для видалення}
{Якщо є хоч один рядок із заданих для видалення:}
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 (VarSDValOrName:TValOrName);
{Зміна знаку числа або перед іменем змінної:}
Begin
If SDValOrName. ElmType=bc_Number then {длячисла:}
SDValOrName. AsNumber:=-SDValOrName. AsNumber
Else {для рядка-назви:}
Begin
If Pos (sc_Minus, SDValOrName. AsVarName)=1then
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
ColCount:=Length (SDMatrix[0]);
If Length(SDHeadCol)
If Length(SDHeadRow)
If (RowCount
{Перевіряємо наявність розв'язуючого елемента у матриці (закоординатами):}
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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk],0);
GI:=False; Exit;
End;
{Якщо розв'язуючий елемент рівний нулю, то виконати Жордановевиключення
неможливо:}
If SDMatrix [RozElmRow, RozElmCol]=0then
Begin
CurMessage:=sc_ZeroResolvingElm+':['+IntToStr (RozElmCol+1)+';'+
IntToStr (RozElmRow+1)+']='+FloatToStr (SDMatrix[RozElmRow,RozElmCol]);
If Self. CurOutConsoleNil 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 (CurRowRozElmRow) and(CurColRozElmCol) 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 CurRowRozElmRow then
SDMatrix [CurRow,RozElmCol]:=MultiplierIfMGI*SDMatrix [CurRow, RozElmCol]/
SDMatrix [RozElmRow, RozElmCol];
{Елементи рядка розв'язуючого елемента(окрім його самого)
ділимо на розв'язуючий елемент з протилежним знаком:}
For CurCol:=0 to ColCount-1 do
If CurColRozElmCol 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) – 1do
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. GoToEndor Self. Stop) do
Application. ProcessMessages;
End;
Function TGridFormattingProcs. SearchNozeroSolveCell(CurRowNum,
CurColNum, MaxRow, MaxCol: Integer;
HeadRowNum, HeadColNum: Integer;
ToSearchInRightColsToo: Boolean=True):Boolean;
{Пошук ненульової розв'язувальноїкомірки для вирішування системи рівнянь
або при вирішуванні задачі максимізації/мінімізаціїлінійної форми
симплекс-методом (починаючи з комірки[CurRowNum, CurColNum]).}
Constsc_CurProcName='SearchNozeroSolveCell';
Var CurSearchRowNum, CurSearchColNum: Integer;
st1: String;
Begin
{Якщо комірка, що хотіли взятирозв'язувальною, рівна нулю:}
If Self. CurTable [CurRowNum,CurColNum]=0 then
Begin
If Self. CurOutConsoleNil 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 MaxColdo
Begin
{Шукаємо ненульову комірку знизу у тому ж стовпцю:}
For CurSearchRowNum:=CurRowNum+1 toMaxRow do
Begin
If Self. CurTable [CurSearchRowNum,CurSearchColNum]0 then Break;
End;
{Якщо немає ненульових, то зміннавільна:}
If CurSearchRowNum>MaxRow then
Begin
If Self. CurOutConsoleNil then
Begin
st1:=sc_CurProcName+sc_AllKoefIsZeroForVar;
If Self. CurHeadRow[CurSearchColNum].ElmType=bc_Numberthen
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) thenBreak; {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 CurColNumCurSearchColNum then
ChangeColsPlaces (Self. CurTable, Self. CurHeadRow,CurColNum,
CurSearchColNum);
Break; {ForCurSearchColNum:=CurColNum to MaxCol do…}
End;
End; {For CurSearchColNum:=CurColNumto MaxCol do…}
{Якщо ненульову комірку не знайдено:}
If (CurSearchColNum>MaxCol) or(CurSearchRowNum>MaxRow) then
Begin
If Self. CurOutConsoleNil 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;
{Відображає записи про обчисленнязначень змінних (у текстовому полі)
такого зказка:
=a11>* + a12>* +… + *;
…
=*+ * +… + *;
 
І підраховує значення, якщо можливо:
=;
…
m>=m>}
Var CurRowN, CurColN: Integer; ValueAvail: Boolean;
CurVal:TWorkFloat;
st2: String;
NotEqual, NoRoots: Boolean;
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Begin
{=…:}
If Self. CurHeadCol[CurRowN].ElmType=bc_Numberthen
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. CurOutConsoleNil then
st1:=st1+sc_BrOp+FloatToStr (Self. CurTable[CurRowN, CurColN])+sc_Mul;
{рядj:}
If Self. CurHeadRow[CurColN].ElmType=bc_Numberthen
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
st1:=st1+Self. CurHeadRow[CurColN].AsVarName;
ValueAvail:=False;
End;
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Begin
Self. CurOutConsole. Lines. Add(st1);
st1:=st2;
End;
If ValueAvail then
Begin
NotEqual:=False;
If Self. CurHeadCol[CurRowN].ElmType=bc_Numberthen
Begin
If Self. CurHeadCol[CurRowN].AsNumberCurValthen
Begin NoRoots:=True; NotEqual:=True;End;
End;
If Self. CurOutConsoleNil then
Begin
If NotEqual then
st1:=st1+sc_Space+sc_NotEqual+sc_Space {}
Elsest1:=st1+sc_Space+sc_Equal+sc_Space; {=}
st1:=st1+FloatToStr(CurVal)+sc_KrKm; {;}
End;
End
Else
Begin
If Self. CurOutConsoleNil thenst1:=st1+sc_Space+sc_ValNotAvail;
Self. WasManyRoots:=True;
End;
If Self. CurOutConsoleNil thenSelf. CurOutConsole. Lines. Add(st1);
End;
If NoRoots then
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_NoRoots);
Self. WasManyRoots:=False;
End
Else if Not (Self. WasManyRoots) thenSelf. SolWasFound:=True;
Self. WasNoRoots:=NoRoots;
End;
Label LStopLabel;
Begin
If Self. TaskWidth{Якщотаблиця пуста, то задача пуста:}
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_EmptyTable);
SolveEqsWithM1:=False;
Exit;
End;
HeadRowNum:=Self.CHeadRowNum;
HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_SolvingStopped);
SolveEqsWithM1:=False;
Exit;
End;
{Вирішування системи лінійних рівнянь способом 2:}
Function TGridFormattingProcs. SolveEqsWithM2:Boolean;
{Для таблиці виду:
x1 x2 x3… xn 1
…
0}
Const sc_CurProcName='SolveEqsWithM2';
Var CurRowNum, CurColNum: Integer;
st1: String;
HeadRowNum, HeadColNum: Integer;
ColDeleted: Boolean;
Procedure ShowResultCalc;
{Відображає записи значень змінних (у текстовому полі)
такого зказка:
 
=;
…
m>=m>;
та відображає повідомлення про наявність коренів і їхвизначеність.}
Var CurRowN, CurColN: Integer;
CurVal:TWorkFloat;
NotEqual, NoRoots, FreeRoots: Boolean;
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_ResultIs+sc_DoubleSpot);

NoRoots:=False;
For CurRowN:=0 to Length (Self. CurHeadCol) –1 do
Begin
If Self. CurOutConsoleNil then
Begin
st1:='';
{=…:}
If Self. CurHeadCol[CurRowN].ElmType=bc_Numberthen
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_Numberthen
Begin
If Self. CurHeadCol[CurRowN].AsNumberCurValthen
Begin NoRoots:=True; NotEqual:=True;End;
End;
If Self. CurOutConsoleNil then
Begin
If NotEqual then
st1:=st1+sc_Space+sc_NotEqual+sc_Space {}
Elsest1:=st1+sc_Space+sc_Equal+sc_Space; {=}
st1:=st1+FloatToStr(CurVal)+sc_KrKm; {;}
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].ElmTypebc_Numberthen
Begin FreeRoots:=True; Break; End;
End;
If NoRoots then
Begin
If Self. CurOutConsoleNil thenSelf. CurOutConsole. Lines. Add (sc_NoRoots);
Self. WasNoRoots:=True;
End
Else if FreeRoots then
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_ManyRoots);
Self. WasManyRoots:=True;
End
Else
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_SolutionFound);
Self. SolWasFound:=True;
End;
End;
Label LStopLabel;
Begin
If Self. TaskWidth{Якщо таблиця пуста, тозадача пуста:}
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_EmptyTable);
SolveEqsWithM2:=False;
Exit;
End;
HeadRowNum:=Self.CHeadRowNum;
HeadColNum:=Self.CHeadColNum;
If Self. CurOutConsoleNil 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) – 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. CurOutConsoleNil 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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_NoSolveMode);
End;
End;
If Self. CurOutConsoleNil then
Begin
st1:='Вирішування закінчено.';
If Res1 then st1:=st1+' Успішно.' elsest1:=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 0x00000000read of address 0x00000000…}
End;
Function TGridFormattingProcs. GetColorByElmType(CurType:THeadLineElmType):TColor;
Constsc_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. CurGridNil thenCurColor:=Self. CurGrid. Color
else CurColor:=clWindow;
Else
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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. CurFormatStatefs_EnteringEqs)and
(Self. CurFormatStatefs_EnteringLTask)and
(Self. CurFormatStatefs_NoFormatting)and
(Self. CurFormatStatefs_FreeEdit))
or (Self. InSolving) then
Begin
CurMessage:=sc_CurProcName+sc_CantReadTaskInCurMode+sc_TriSpot;
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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 ControlSizeSystem. FileSize(CurFile)then
Begin
CurMessage:=sc_CurProcName+sc_FileNotFullOrHasWrongFormat+SPath+
sc_DoubleQuot;
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurFormatStatefs_EnteringEqs)and
(Self. CurFormatStatefs_EnteringLTask)and
(Self. CurFormatStatefs_FreeEdit))
or (Self. InSolving) then
Begin
CurMessage:=sc_CurProcName+sc_CantWriteTaskInCurMode;
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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 (CurElmTypebc_IndependentVar)and (CurElmTypebc_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 (CurElmTypebc_FuncVal) and(CurElmTypebc_DestFuncToMax) and
(CurElmTypebc_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;
Constsc_CurProcName='ReadTableFromGrid';
{Процедура для зчитування таблиці та їїзаголовків із CurGrid.
Для екранної таблиці використовуються координати рядка-заголовката
стовпця заголовка (верхнього лівого кута таблиці з заголовками):
HeadColNumInGrid (CHeadColNum) іHeadRowNumInGrid (CHeadRowNum).}
Var CurRow, CurCol, CurWidth, CurHeight:Integer;
CurFloatVal:TWorkFloat;
Begin
If Self. CurGrid=Nil then
Begin
If Self. CurOutConsoleNil 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
Begin
If Self. CurOutConsoleNil 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 doReadHeadRowCell(CurCol);
{Читаємо стовпець-заголовок:}
For CurRow:=0 to CurHeight-1 doReadHeadColCell(CurRow);
{Читаємо таблицю коефіцієнтів:}
ForCurRow:=Self.CHeadRowNum+bc_LTaskRowsBeforeVars to
Self. CurGrid. RowCount-1 do
Begin
ForCurCol:=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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+
': GrowingStringGrid не заданий!..');
WriteTableToGrid:=True;
Exit;
End;
{Ширина і висота таблиці:}
Self. GetTaskSizes (CurWidth,CurHeight);
If (CurHeight
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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. CurOutConsoleNil 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. CurFormatStatefs_NoFormattingthen
Begin
If Self. CurGrid=Nil then
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+':'+
sc_NoGrowingStringGrid);
Exit;
End;
Res1:=False;
{Якщо таблиця редагована або ще не читана, то запускаємо їїзчитування:}
If Self. CurGridModified or (Self. TaskWidth
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) thenExit;
{Збільшуємо розміри матриці до квадратних:}
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. CurFormatStatefs_EnteringLTaskthen
Begin
If Self. CurOutConsoleNil 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{Якщотаблиця пуста:}
Begin
If Self. CurOutConsoleNil 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_DestFuncToMaxthen
Begin
DualTType:=dt_MaxToMin;
OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;
Inc(DFuncCount);
End
Else if Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMinthen
Begin
DualTType:=dt_MinToMax;
OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;
Inc(DFuncCount);
End;
End;
{Якщо функцій мети декілька або жодної:}
If DFuncCount1 then
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+
sc_CanMakeDTaskOnlyForOneDFunc+IntToStr(DFuncCount));
MakeDualLTask:=False; Exit;
End;
If DualTType=dt_MaxToMin thenNewDFuncType:=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_DependentVarthen {Якщо змінна >=0:}
Begin {Ця комірка буде заголовкомфункції умови-нерівності зі знаком «>=»:}
Self. CurHeadRow[CurCol].ElmType:=bc_FuncVal;
Self. CurHeadRow[CurCol].VarInitInRow:=False;
{Формуємо назву функції:}
{якщо змінна має назву змінної двоїстоїзадачі, то дамо назву
функції прямої задачі, якщо назва прямої – назву двоїстої:}
If Pos (sc_DualTaskVarNameStart, Self. CurHeadRow[CurCol].AsVarName)>0then
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_IndependentVarthen
Begin {Ця комірка буде заголовкомумови-рівняння:}
Self. CurHeadRow[CurCol].ElmType:=bc_Number;
Self. CurHeadRow[CurCol].AsNumber:=0;
End {Якщо це число:}
Else if Self. CurHeadRow[CurCol].ElmType=bc_Numberthen
Begin
If Self. CurHeadRow[CurCol].AsNumber=1then {якщо це множник вільних членів}
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», (якщо для нерівність була зі знаком «
неї був додатний), тому змінюємо знак заголовка:}
If DualTType=dt_MinToMax then
ChangeSignForValOrVarName (Self. CurHeadCol[CurRow]);
End
Else if Self. CurHeadCol[CurRow].ElmType=bc_Numberthen
Begin
If Self. CurHeadCol[CurRow].AsNumber=0then {Якщо 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=OldDFuncTypethen
Begin
Self. CurHeadCol[CurRow].ElmType:=bc_Number;
Self. CurHeadCol[CurRow].AsNumber:=1; {будемножник стовпця вільних членів}
End;
End;
{Міняємо рядок і стовпець-заголовкитаблиці місцями:}
SafeMas:=Self. CurHeadRow;
Self. CurHeadRow:=Self. CurHeadCol;
Self. CurHeadCol:=SafeMas;
{У новому стовпці-заголовку шукаємокомірки-заголовки нерівностей «>=».
Їх заміняємо на «
For CurRow:=0 to Length (Self. CurHeadCol) –1 do
Begin
If Self. CurHeadCol[CurRow].ElmType=bc_FuncValthen
Begin
If ValSign (Self. CurHeadCol[CurRow])=bc_Negativethen
Self. ChangeSignsInRow(CurRow);
End;
End;
{У новому рядку-заголовку шукаємо комірки-заголовки залежнихзмінних,
які мають умову «=0» множеннямстовпця на -1:}
For CurCol:=0 to Length (Self. CurHeadRow) –1 do
Begin
If Self. CurHeadRow[CurCol].ElmType=bc_DependentVarthen
Begin
If ValSign (Self. CurHeadRow[CurCol])=bc_Negativethen
Self. ChangeSignsInCol(CurCol);
End;
End;
{Відображаємо отриману таблицю у екранній таблиці:}
Self. WriteTableToGrid (Self.CHeadColNum,Self.CHeadRowNum);

MakeDualLTask:=True;
End;
Function TGridFormattingProcs. PrepareToSolveEqsWithM1:Boolean;
Constsc_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{Якщотаблиця пуста:}
Begin
If Self. CurOutConsoleNil 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
Begin
PrepareToSolveEqsWithM1:=False;
Exit;
End;
Self. EqM1TaskPrepared:=True;
PrepareToSolveEqsWithM1:=True;
End
Else
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_WrongEditMode);
PrepareToSolveEqsWithM1:=False;
End;
End;
Function TGridFormattingProcs. PrepareToSolveEqsWithM2:Boolean;
Constsc_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{Якщотаблиця пуста:}
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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;
Constsc_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{Якщотаблиця пуста:}
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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;
Constsc_CurProcName='PrepareDFuncForSimplexMaximize';
Begin
CurWidth:=Length (Self. CurHeadRow);
DFuncRowNum:=Length (Self. CurHeadCol) –1;
Case Self. CurHeadCol[DFuncRowNum].ElmTypeof {перевіряємо тип функції мети:}
bc_DestFuncToMax: ToMax:=True;
bc_DestFuncToMin: ToMax:=False;
Else {якщо заданий рядок виявивсяне функцією мети:}
Begin
If Self. CurOutConsoleNil 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;
Constsc_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
(SFuncRowNum>=CurHeight) or(MinDestFuncRowNum>=CurHeight) then
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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_Numberthen
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_Numberthen
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].ElmTypein DestFuncsTypes) or
Not(DualTaskVals) then
st1:=st1+ FloatToStr (Self. CurTable [CurRowNum,LastColNum])
Else st1:=st1+'0';
If (Self. CurHeadCol[CurRowNum].ElmTypein DestFuncsTypes) then
st1:=sc_ResFunc+sc_Space+st1;
If CurRowNum=LastRowNum thenst1:=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].ElmTypein 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].ElmTypein WorkCellTypes) then
SDValVecs [SVecRow, Self. CurHeadCol[CurRowNum].VarInitPos]:=
Self. CurTable [CurRowNum, LastColNum];
End
End;
End;
Procedure TGridFormattingProcs. BuildPaymentTaskOfOptim(
Const SOptimXVecs:TFloatMatrix; ConstSOptimFuncVals: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;
Constsc_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) – 1do
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. CurOutConsoleNil 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 doFillHRowVarName(jCol);
For iRow:=0 to FuncCount-1 doFillHColFuncName(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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllMeasurIsZero);
MinQ:=1 {одиниця, якщо всі нулі(отримаємо матрицю із одиниць)}
End
Else if Length(SOptimFuncVals)=1 then {якщовсього одна функція мети:}
Begin
If Self. CurOutConsoleNil 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; VarDComprVec:TFloatArr);
{Обчислює компромісний вектор (масив) значень змінних із
із заданих векторів значень і вагових коефіцієнтів для кожного із
цих векторів.
Вхідні дані:
SVarVecs– вектори значень змінних;
SWeightCoefs– вагові коефіцієнти длякожного вектора.
Вихідні дані:
DComprVec– компромісний векторзначень змінних.}
Var VecNum, VarNum: Integer;CurComprVal:TWorkFloat;
Begin
DComprVec:=Nil;
If Length(SVarVecs)
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) – 1do {для кожної змінної:}
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;
Constsc_CurProcName='SolveMultiCritLTask';
sc_TextMarkRow='############';

Procedure ShowWeightCoefs (Const SCoefs:TFloatArr;FirstDestFuncRow: Integer);
Var i: Integer;
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Begin
Self. CurOutConsole. Lines. Add (sc_ComprVarVals);
For Col:=0 to Length(ComprXVec) – 1do
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. CurOutConsoleNil 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{Якщо таблицяпуста, то задача пуста:}
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_EmptyTable);
Self. WasNoRoots:=True;
SolveMultiCritLTask:=False;
Exit;
End;
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_NoDestFuncs);
Self. WasNoRoots:=True;
Res1:=False; Goto LFinish;
End
Else if Row{якщо в таблиціє тільки рядки функцій мети:}
Begin
If Self. CurOutConsoleNil 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-1do {для усіх функцій мети:}
Begin
If Self. CurOutConsoleNil 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_DestFuncToMinthen
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. CurOutConsoleNil thenSelf. CurOutConsole. Lines. Add (sc_TextMarkRow);
BuildPaymentTaskOfOptim (OptimXVecs,OptimFuncVals, FirstDestFuncRow);
If Self. Stop then Goto LStopLabel;
If Self. CurOutConsoleNil 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. CurOutConsoleNil thenSelf. 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].ElmTypein SHeadColElmTypes) then
Begin
HiNotInSetRow:=CurRowNum;
{шукаємо найнижчий рядок, який портібнопереміщувати вгору:}
For CurRowToUp:=Length (Self. CurHeadCol) –1 downto CurRowNum+1 do
Begin
If Self. CurHeadCol[CurRowToUp].ElmTypein SHeadColElmTypes then Break;
End;
{Якщо таких рядків не знайдено, то усі вони вже вгорі:}
If CurRowToUp
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 EndRowNumdo
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. CurOutConsoleNil) and(FoundRow
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{Якщотаблиця пуста, то задача пуста:}
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+ sc_EmptyTable);
SolveLTaskToMax:=False;
Exit;
End;
HeadRowNum:=Self.CHeadRowNum;
HeadColNum:=Self.CHeadColNum;
If Self. CurOutConsoleNil 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{усі стовпці окрім останнього}
Begin
ColDeleted:=False;
{Координати розв'язувальної комірки дляпомітки кольором в екранній
таблиці:}
Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;
Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;
{Якщо поточна змінна незалежна:}
If Self. CurHeadRow[CurColNum].ElmType=bc_IndependentVarthen
Begin {Перевіряємо, чи не дійшлидо рядка функції
(або взагалі за низ таблиці):}
If CurRowNum
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. CurOutConsoleNil then
Begin
st1:=sc_CurProcName+sc_FreeVar;
If Self. CurHeadRow[CurColNum].ElmType=bc_Numberthen
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
Until AllExcluded or WasNothingToDo;
If Not(AllExcluded) then
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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
{Якщо після виключення незалежних змінних не залишилося рядків,окрім
рядка функції:}
If HiNoIndepRow>=(Length (Self. CurHeadCol) –1) then
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoTableAreaToWork);
End;
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_ExcludingZeroRows);
{############## Виключаємо 0-рядки.Шукаємо їх: ##############}
CurRowNum:=HiNoIndepRow;
While CurRowNum
Begin
RowDeleted:=False;
If Self. CurHeadCol[CurRowNum].ElmType=bc_Numberthen
Begin
If Self. CurHeadCol[CurRowNum].AsNumber=0then {якщо знайшли 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]
ChangeSignsInRow(CurRowNum);
{Шукаємо у рядку перший додатнийкоефіцієнт:}
For CurColNum:=0 to Length (Self. CurHeadRow) –2 do
If CurTable [CurRowNum, CurColNum]>0then 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]>0then Break;
{Якщо знову додатних нема, значить усі нулі. Видаляємо рядок:}
If CurColNum>(Length (Self. CurHeadRow) –2) then
Begin
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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{Якщо МНВ незнайдено:}
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 CurRow2NCurRowNum then {Якщовиключили не цей 0-рядок:}
System. Continue; {продовжуємопрацювати з цим рядком}
End; {If Self. CurHeadCol[CurRowNum].AsNumber=0then…}
End; {If Self. CurHeadCol[CurRowNum].ElmType=bc_Numberthen…}
If Not(RowDeleted) then Inc(CurRowNum);
End; {While CurRowNum
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_SearchingBaseSolve);
{############## Шукаємо опорнийрозв'язок задачі: ##############}
CurRowNum:=HiNoIndepRow;
While CurRowNum
Begin
{Якщо знайшли від'ємний елемент устовпці вільних членів:}
If Self. CurTable [CurRowNum, Length (Self.CurHeadRow) – 1]
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]
If CurColNum>(Length (Self. CurHeadRow) –2) then {Якщо усі невід'ємні:}
Begin
{Якщо вільний член від'ємний, акоефіцієнти невід'ємні, то
система несумісна:}
If Self. CurOutConsoleNil 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{Якщо МНВ незнайдено:}
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 CurRow2NCurRowNum then {Якщовиключили не цей рядок:}
System. Continue; {продовжуємопрацювати з цим рядком}
End; {If Self. CurTable [CurRowNum,Length (Self. CurHeadRow) – 1]
Inc(CurRowNum);
End; {While CurRowNum
If Self. CurOutConsoleNil 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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_SearchingOptimSolve);
{############## Шукаємо оптимальнийрозв'язок задачі: ##############}
CurColNum:=0;
While CurColNum
Begin
ColDeleted:=False;
{Якщо знайшли від'ємний коефіцієнт урядку функції мети:}
If CurTable [Length(Self. CurHeadCol) –1, CurColNum]
Begin
{Шукаємо МНВ (мінімальне невід'ємнесеред відношень вільних членів
до членів стовпця, у якому обрали цей коефіцієнт) серед усіх рядків
умов, окрім рядків вільних змінних і рядка функції мети:}
SearchMNNCellForCol (CurColNum,HiNoIndepRow, Length (Self. CurHeadCol) – 2,
CurRow2N, False);
If CurRow2N{Якщо МНВ незнайдено:}
Begin {то функція мети не обмеженазверху, максимальне значення безмежне:}
If Self. CurOutConsoleNil 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_Negativethen
Begin
ChangeSignsInRow(CurRowNum);
Self. CurHeadCol[CurRowNum].ElmType:=bc_DestFuncToMin;
End;
If Self. CurOutConsoleNil 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. CurOutConsoleNil 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. OldOnNewRowNil thenSelf. OldOnNewRow (Sender, NewRows);
If Sender is TStringGrid then
Begin
CurGrid:=TStringGrid(Sender);
For CurNum:=0 to Length(NewRows) – 1do
Begin
{Нумерація з третього рядка, бо два перших – заголовки:}
IfNewRows[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… nn+1
x1 x2 x3 x4 x5… xn1
}
Var CurNum: Integer;CurGrid:TStringGrid;
CurColNumStr: String;
Begin
If Sender=Nil then Exit;
{Якщо до вмикання форматування був якийсь обробник події,запускаємо його:}
If @Self. OldOnNewColNil thenSelf. OldOnNewCol (Sender, NewCols);
If Sender is TStringGrid then
Begin
CurGrid:=TStringGrid(Sender);
For CurNum:=0 to Length(NewCols) – 1do
Begin
{Заголовки лише для комірок, які можна редагувати:}
IfNewCols[CurNum]>=(Self.CHeadColNum+1) then
Begin
CurColNumStr:=IntToStr (NewCols[CurNum] –Self.CHeadColNum);
CurGrid. Cells [NewCols[CurNum],0]:=CurColNumStr;
{Останній стовпець – числа у правих частинах рівнянь:}
If (NewCols[CurNum]+1)=CurGrid. ColCountthen
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. OldOnDrawCellNil thenSelf. 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. OldOnDrawCellNil thenSelf. 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. 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 thenCurColor:=lwc_SolveRowColor;
End;
End;
If CurColorbc_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
…
mym
Стовпець-заголовок (нові комірки стовпця-заголовка за змовчуванням
заповнюються значеннями типу «функції-нерівності»).}
Var CurNum, CurTableRow: Integer;CurGrid:TStringGrid;
Begin
If Sender=Nil then Exit;
{Якщо до вмикання форматування був якийсь обробник події,запускаємо його:}
If @Self. OldOnNewRowNil thenSelf. OldOnNewRow (Sender, NewRows);
If Sender is TStringGrid then
Begin
CurGrid:=TStringGrid(Sender);
{Освіжаємо масив стовпця-заголовкавідповідно до висоти таблиці:}
UpdateLTaskHeadColToStrGrid (CurGrid,NewRows);
{Відображаємо заголовки оновлених абонових рядків:}
For CurNum:=0 to Length(NewRows) – 1do
Begin
{Нумерація з першого рядка, що не є рядком заголовків:}
IfNewRows[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… nn+1
yx1 x2 x3 x4… xn1
}
Var CurNum, CurTableCol: Integer;CurGrid:TStringGrid;
Begin
If Sender=Nil then Exit;
{Якщо до вмикання форматування був якийсь обробник події,запускаємо його:}
If @Self. OldOnNewColNil thenSelf. OldOnNewCol (Sender, NewCols);
If Sender is TStringGrid then
Begin
CurGrid:=TStringGrid(Sender);
{Освіжаємо масив поміток залежностізмінних x:}
Self. UpdateLTaskHeadRowToStrGrid(CurGrid);
{Відображаємо заголовки оновлених абонових стовпців:}
For CurNum:=0 to Length(NewCols) – 1do
Begin
{Заголовки лише для комірок, які можна редагувати:}
If NewCols[CurNum]>=Self.CHeadColNumthen
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») або, якщо це перший стовпець-то з підписом стовпця імен
функцій та констант рівнянь.
(Тут покладаємося на те, що номери оновлених стовпців сортовані
за зростанням):}
IfNewCols[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. OldOnNewRowNil thenSelf. OldOnNewRow (Sender, NewRows);
If Sender is TStringGrid then
Begin
CurGrid:=TStringGrid(Sender);
For CurNum:=0 to Length(NewRows) – 1do
Begin
{Нумерація з першого рядка, що не є рядком заголовків
GrowingStringGrid:}
IfNewRows[CurNum]>=(Self.CHeadRowNum+1) then
CurGrid. Cells [0, NewRows[CurNum]]:=
IntToStr (NewRows[CurNum] – Self.CHeadRowNum);
End; {For CurNum:=0 toLength(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. OldOnNewColNil thenSelf. OldOnNewCol (Sender, NewCols);
If Sender is TStringGrid then
Begin
CurGrid:=TStringGrid(Sender);
For CurNum:=0 to Length(NewCols) – 1do
Begin
{Заголовки лише для нефіксованих комірок:}
IfNewCols[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
{Масив видовжуємо до кількості стовпціву StringGrid, у яких
редагуємо коєфіцієнти при змінних:}
OldCount:=Length (Self. CurHeadRow);
If OldCountCurLTaskVarCount then
Begin
SetLength (Self. CurHeadRow,CurLTaskVarCount); {змінюємо довжину}
{Заповнюємо нові елементи масиву значеннями за змовчуванням:
вільні змінні:}
For CurVarMark:=OldCount toCurLTaskVarCount-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 (OldHeightCurHeight) 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. OldOnDrawCellNil thenSelf. 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].ElmTypeof
bc_DestFuncToMax: CurColor:=lwc_DestFuncValColor;
bc_DestFuncToMin: CurColor:=lwc_DestFuncValColor;
Else CurColor:=lwc_RightSideColColor;
End;
End
Else ifACol
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 thenCurColor:=lwc_SolveRowColor;
End;
End;
{Зафарбовуємо комірки-заголовки стовпцівкоефіцієнтів при змінних
відповідно до масиву поміток про залежність:}
If (ARow=Self.CHeadRowNum) and
(Not (ACol
Begin
CurVarColState:=Self. CurHeadRow [ACol –Self.CHeadColNum-
bc_LTaskColsBeforeVars].ElmType;
CurColor:=GetColorByElmType(CurVarColState)
End;
If CurColorbc_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. OldOnDblClickNil thenSelf. 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
(CurRow=Self.CHeadRowNum) then
Begin
{Змінюємо ознаку залежності відповідноїзмінної:}
If CurHeadRow [CurCol – Self.CHeadColNum-
bc_LTaskColsBeforeVars].ElmType=bc_IndependentVarthen
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. CurOutConsoleNil 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 isTMenuItem)) then
Begin
If Self. MemoForOutputNil then
Self. MemoForOutput. Lines. Add (sc_CurProcName+ sc_CantDetMenuItem);
Exit;
End;
{Читаємо тип, що обраний для комірки:}
CurMenuItem:=TMenuItem(Sender);
TypeForCell:=THeadLineElmType (CurMenuItem.Tag);
If (Self. CurGridSolveCol
Begin {якщо комірка вище чи лівішезаголовків таблиці:}
ReportUnsupportedCell; Exit;
End;
{Перевіряємо координати комірки ізмінюємо її тип:}
{координати комірки мають бути записаніу CurGridSolveRow і CurGridSolveCol:}
If Self. CurGridSolveRow=-bc_LTaskRowsBeforeVarsthen
Begin {якщо це коміркарядка-заголовка:}
If Length (Self. CurHeadRow)>Self. CurGridSolveColthen {якщо комірка існує:}
Begin {задаємо тип комірки:}
Self. CurHeadRow [Self. CurGridSolveCol].ElmType:=TypeForCell;
End
Else {якщо в рядку-заголовкунемає такої комірки:}
Begin
ReportUnsupportedCell; Exit;
End;
End
Else if Self. CurGridSolveCol=-bc_LTaskColsBeforeVarsthen
Begin {якщо це коміркастовпця-заголовка:}
If Length (Self. CurHeadCol)>Self. CurGridSolveRowthen {якщо комірка існує:}
Begin {задаємо тип комірки:}
Self. CurHeadCol [Self. CurGridSolveRow].ElmType:=TypeForCell;
End
Else {якщо в стовпці-заголовку немаєтакої комірки:}
Begin
ReportUnsupportedCell; Exit;
End;
End
Else {якщо комірка у таблицікоефіцієнтів або правіше чи нижче неї:}
Begin
ReportUnsupportedCell; Exit;
End;
{Якщо тип комірки змінено, топеремальовуємо екранну таблицю для
відображення нового типу комірки:}
If Self. CurGridNil thenSelf. 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. OldOnMouseUpNil thenSelf. 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. CurOutConsoleNil 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. OldOnSetEditTextNilthen
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. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CantChangeStateInSolving);
Exit;
End;
If Self. CurGrid=Nil then {Якщоекранну таблицю не задано:}
Begin {запам'ятовуємо поточнийрежим, і більше нічого не робимо тут:}
Self. CurFormatState:=Value; Exit;
End;
{Якщо задано новий режим:}
If Self. CurFormatStateValue then
Begin {Якщо форматування буловимкнене:}
If Self. CurFormatState=fs_NoFormattingthen
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 (OldHColPosSelf.CHeadColNum)or
(OldHRowPosSelf.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 (OldHColPosSelf.CHeadColNum)or
(OldHRowPosSelf.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. CurGridValue 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
Self.CHeadColNum:=Value;
End;
End;
Procedure TGridFormattingProcs. SetHeadRowNum(Value: Integer);
Begin
If Self. CurFormatState=fs_FreeEdit then
Begin
If Value
Self.CHeadRowNum:=Value;
End;
End;
Procedure TGridFormattingProcs. SetNewMemo(Value:TMemo);
Begin
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (Self. ClassName+':повідомлення вимкнені.');
Self. CurOutConsole:=Value;
If Self. CurOutConsoleNil then
Self. CurOutConsole. Lines. Add (Self. ClassName+':повідомлення ввімкнені.');
End;
end.

Висновки
лінійний програмування компромісний розв'язок
Хоч кожній залежній змінній одної задачі відповідаєфункція-умова (нерівність) двоїстої, і кожній функції-умові відповідає залежназмінна, ці пари величин приймають різні значення у розв’язку пари задач.
Компромісний розв’язок багатокритеріальної задачі ЛП зручнозастосовувати для об’єктів управління з такими вихідними параметрами (функціямимети), які є практично рівноправними (мають однаковий пріоритет до оптимізації,або їх пріоритети складно оцінити). За допомогою нього можна отримати розв’язокз мінімальним сумарним програшем оптимізації параметрів.

Використана література
1. Левин С.В., Александрова В.В.: «БАГАТОКРИТЕРІАЛЬНА ОПТИМІЗАЦІЯ ЗВИКОРИСТАННЯМ ТЕОРЕТИКО-ІГРОВОГО ПІДХОДУ»: методичні вказівки до виконаннякурсової роботи з курсу «Математичні методи дослідження операцій» – Харків, Національнийаерокосмічний університет ім. М.Є. Жуковського «Харківський авіаційнийінститут», 2008 р.
2. Довідка з Borland Delphi 6.