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

1. Завдання

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

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

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

Z>2>= – x>1 >–2x>2>+x>3>+x>4 > min

Z>3>= –2x>1 >–x>2>+x>3>+x>4 > max

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

2x>1 >–x>2>+3x>3>+4x>4 > 10

x>1>+x>2>+x>3 >–x>4 > 5

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

x 0

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

v>1>=

v>2>=

…

v>k>=

W=

-

-

…

-

1

-u>1>

=

…

1

-u>2>

=

…

1

…

…

.

.

.

.

.

-u>k>

=

…

1

1
Z =

-1

-1

…

-1

0

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

,

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

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

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

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

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

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

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

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

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

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

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

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

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

– x1 = 0;

– y2 = 0;

– y1 = 0;

– y3 = 0;

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

x3 = 2,33333333333333;

x2 = 4,55555555555556;

x4 = 1,88888888888889;

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

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

Функцію 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 of THeadLineElmType;

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

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

ElmType:THeadLineElmType;

Case byte of

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

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

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

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

VarInitPos: Integer;

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

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

VarInitInRow: Boolean);

End;

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

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

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

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

TByteMatrix=array of TByteArr;

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

TTableFormatState=(fs_EnteringEqs, fs_EnteringLTask, fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask,

fs_NoFormatting, fs_FreeEdit);

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

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

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

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

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

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

TDualTaskType=(dt_MaxToMin, dt_MinToMax);

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

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

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

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

TGridFormattingProcs=class(TObject)

Private

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

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

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

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

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

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

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

InSolving, SolWasFound, WasNoRoots, WasManyRoots,

EqM1TaskPrepared, EqM2TaskPrepared, LTaskPrepared: Boolean;

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

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

CurGridModified: Boolean;

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

fs_SolvingEqsM2, fs_SolvingLTask)

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

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

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

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

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

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

CurGridSolveCol, CurGridSolveRow: Integer;

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

CHeadColNum, CHeadRowNum: Integer;

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

CurFormatState:TTableFormatState;

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

CurGrid:TGrowingStringGrid;

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

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

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

OldOnNewCol:TNewColEvent;

OldOnNewRow:TNewRowEvent;

OldOnDrawCell:TDrawCellEvent;

OldOnDblClick:TNotifyEvent;

OldOnMouseUp:TMouseEvent;

OldOnSetEditText:TSetEditEvent;

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

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

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

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

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

Procedure UpdateLTaskHeadRowToStrGrid (SGrid:TStringGrid);

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

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

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

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

Procedure UpdateLTaskHeadColToStrGrid (SGrid:TStringGrid;

NewRows: array of Integer);

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

Procedure SetNewState (Value:TTableFormatState);

Function PrepareToSolveEqsWithM1: Boolean;

Function PrepareToSolveEqsWithM2: Boolean;

Function PrepareToSolveLTask: Boolean;

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

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

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

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

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

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

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

Rect: TRect; State: TGridDrawState);

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

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

procedure SolveLineEqsM1OrM2OnDrawCell (Sender: TObject;

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

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

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

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

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

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

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

Rect: TRect; State: TGridDrawState);

procedure EdLineTaskOnDblClick (Sender: TObject);

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

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

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

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

procedure EdLineTaskOnMouseUp (Sender: TObject;

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

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

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

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

Procedure InitGridPopupMenu (SGrid:TStringGrid);

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

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

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

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

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

Procedure AddCellTypeItemToMenu (SMenu:TPopupMenu;

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

ToSetReactOnClick: Boolean=True);

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

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

Procedure ProcOnCellTypeSelInMenu (Sender: TObject);

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

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

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

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

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

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

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

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

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

const Value: string);

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

Вхідні дані:

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

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

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

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

Procedure ReadHeadRowCell (SCol: Integer);

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

Вхідні дані:

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

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

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

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

Procedure ReadHeadColCell (SRow: Integer);

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

Function ReadTableFromGrid: Boolean;

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

Function WriteTableToGrid (SHeadColNum, SHeadRowNum: Integer;

ToTuneColWidth: Boolean=True):Boolean;

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

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

Procedure GetTaskSizes (Var DWidth, DHeight: Integer);

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

Function GI (RozElmCol, RozElmRow: Integer;

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

Var DColDeleted: Boolean; ToDoMGI: Boolean=False;

ToDelColIfZeroInHRow: Boolean=True):Boolean;

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

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

до кінця):}

Procedure WaitForNewStep (HeadColNum, HeadRowNum: Integer);

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

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

Function SearchNozeroSolveCell (CurRowNum,

CurColNum, MaxRow, MaxCol: Integer;

HeadRowNum, HeadColNum: Integer;

ToSearchInRightColsToo: Boolean=True):Boolean;

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

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

Procedure ChangeSignsInRow (CurRowNum: Integer);

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

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

Procedure ChangeSignsInCol (CurColNum: Integer);

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

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

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

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

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

Function ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

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

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

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

Function ShiftRowsDown (

SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

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

Function SolveEqsWithM1: Boolean;

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

Function SolveEqsWithM2: Boolean;

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

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

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

значення):}

Function SolveLTaskToMax (DualTaskVals: Boolean):Boolean;

Function PrepareDFuncForSimplexMaximize: Boolean;

Function PrepareDestFuncInMultiDFuncLTask (SFuncRowNum,

MinDestFuncRowNum: Integer):Boolean;

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

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

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

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

Procedure ShowLTaskResultCalc (DualTaskVals: Boolean);

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

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

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

Procedure ReadCurFuncSolution (Var SDValVecs:TFloatMatrix;

Var SDDestFuncVals:TFloatArr; SVecRow: Integer;

ToReadFuncVals: Boolean; DualTaskVals: Boolean);

Procedure BuildPaymentTaskOfOptim (

Const SOptimXVecs:TFloatMatrix; Const SOptimFuncVals:TFloatArr;

SFirstDFuncRow: Integer);

Procedure CalcComprVec (Const SVarVecs:TFloatMatrix;

Const SWeightCoefs:TFloatArr; Var DComprVec:TFloatArr);

Function CalcDFuncVal (Const SVarVec:TFloatArr;

SDestFuncRowNum: Integer):TWorkFloat;

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

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

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

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

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

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

Function SolveMultiCritLTask: Boolean;

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

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

Procedure SetHeadColNum (Value: Integer);

Procedure SetHeadRowNum (Value: Integer);

public

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

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

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

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

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

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

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

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

Continue, GoToEnd, Stop: Boolean;

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

Property TableFormatState:TTableFormatState read CurFormatState

write SetNewState default fs_NoFormatting;

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

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

Property Solving: Boolean read InSolving;

Property SolutionFound: Boolean read SolWasFound;

Property NoRoots: Boolean read WasNoRoots;

Property ManyRoots: Boolean read WasManyRoots;

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

Property StringGrid:TGrowingStringGrid read CurGrid write SetNewGrid

default Nil;

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

Property MemoForOutput:TMemo read CurOutConsole write SetNewMemo

default Nil;

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

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

Property HeadColNumInGrid: Integer read CHeadColNum write SetHeadColNum;

Property HeadRowNumInGrid: Integer read CHeadRowNum write SetHeadRowNum;

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

Property Table:TFloatMatrix read CurTable;

Property HeadRow:TValOrNameMas read CurHeadRow;

Property HeadCol:TValOrNameMas read CurHeadCol;

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

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

Function ReadFromFile (Const SPath: String):Boolean;

Function SaveToFile (Const SPath: String):Boolean;

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

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

(при Solving=True):}

Procedure SetTable (Const SHeadRow, SHeadCol:TValOrNameMas;

Const STable:TFloatMatrix);

Procedure GetTable (Var DHeadRow, DHeadCol:TValOrNameMas;

Var DTable:TFloatMatrix);

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

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

Function GetColorByElmType (CurType:THeadLineElmType):TColor;

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

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

Function GetNameByElmType (CurType:THeadLineElmType):String;

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

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

fs_EnteringEqs і fs_EnteringLTask.}

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

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

Procedure Refresh;

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

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

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

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

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

Function MakeDualLTask: Boolean;

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

Function TaskWidth: Integer;

Function TaskHeight: Integer;

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

fs_SolvingEqsM2, fs_SolvingLTask:}

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

Constructor Create;

Destructor Free;

End;

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

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

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

Function GetValOrNameAsStr (Const Value:TValOrName):String;

Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);

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

overload;

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

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

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

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

overload;

Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix;

Var SDHeadCol:TValOrNameMas; Row1, Row2: Integer;

ToChangeInitPosNums: Boolean=False); overload;

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

overload;

Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix;

Var SDHeadRow:TValOrNameMas; Col1, Col2: Integer;

ToChangeInitPosNums: Boolean=False); overload;

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

Procedure Transpose (Var SDMatrix:TFloatMatrix);

implementation

const

sc_InvCoordsOfResolvingElm=

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

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

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

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

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

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

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

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

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

sc_CantReadTaskInCurMode=

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

sc_CantWriteTaskInCurMode=

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sc_Space+sc_UnlimitedFunc;

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

sc_NoTableAreaToWork=

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sc_CantChangeStateInSolving=

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

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

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

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

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

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

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

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

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

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

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

sc_CurRowNotMarkedAsDestFunc=

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Var Res1:TSignVal;

Begin

Res1:=bc_Zero;

If Value<0 then Res1:=bc_Negative

Else if Value>0 then Res1:=bc_Positive;

ValSign:=Res1;

End;

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

Var Res1:TSignVal;

Begin

If Value. ElmType=bc_Number then

Res1:=ValSign (Value. AsNumber)

Else

Begin

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

Else Res1:=bc_Positive;

End;

ValSign:=Res1;

End;

Function GetValOrNameAsStr (Const Value:TValOrName):String;

Begin

If Value. ElmType=bc_Number then

GetValOrNameAsStr:=FloatToStr (Value. AsNumber)

Else GetValOrNameAsStr:=Value. AsVarName;

End;

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

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

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

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

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

Var CurElm: Integer;

Begin

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

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

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

Begin

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

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

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

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

заданих:}

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

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

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

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

End;

End;

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

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

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

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

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

Var CurElm: Integer;

Begin

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

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

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

Begin

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

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

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

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

заданих:}

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

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

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

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

End;

End;

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

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

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

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

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

Var CurRow: Integer;

Begin

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

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

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

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

Begin

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

End;

End;

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

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

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

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

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

Var CurElm: Integer;

Begin

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

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

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

Begin

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

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

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

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

заданих:}

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

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

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

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

End;

End;

Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);

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

Begin

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

SDValOrName. AsNumber:=-SDValOrName. AsNumber

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

Begin

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

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

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

End;

End;

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

Function TGridFormattingProcs.GI (RozElmCol, RozElmRow: Integer;

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

Var DColDeleted: Boolean;

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

ToDelColIfZeroInHRow: Boolean=True):Boolean;

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

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

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

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

Вхідні дані:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

}

Var CurRow, CurCol, RowCount, ColCount: Integer;

SafeHeadElm:TValOrName;

MultiplierIfMGI:TWorkFloat;

CurMessage: String;

Begin

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

RowCount:=Length(SDMatrix);

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

ColCount:=Length (SDMatrix[0]);

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

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

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

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

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

Begin

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

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

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

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

GI:=False; Exit;

End;

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

неможливо:}

If SDMatrix [RozElmRow, RozElmCol]=0 then

Begin

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

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

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

GI:=False; Exit;

End;

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

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

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

For CurRow:=0 to RowCount-1 do

For CurCol:=0 to ColCount-1 do

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

Begin

SDMatrix [CurRow, CurCol]:=

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

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

SDMatrix [RozElmRow, RozElmCol];

End;

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

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

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

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

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

For CurRow:=0 to RowCount-1 do

If CurRow<>RozElmRow then

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

SDMatrix [RozElmRow, RozElmCol];

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

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

For CurCol:=0 to ColCount-1 do

If CurCol<>RozElmCol then

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

SDMatrix [RozElmRow, RozElmCol];

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

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

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

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

SafeHeadElm:= SDHeadRow[RozElmCol];

SDHeadRow[RozElmCol]:=SDHeadCol[RozElmRow];

SDHeadCol[RozElmRow]:=SafeHeadElm;

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

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

If ToDoMGI then

Begin

ChangeSignForValOrVarName (SDHeadRow[RozElmCol]);

ChangeSignForValOrVarName (SDHeadCol[RozElmRow]);

End;

DColDeleted:=False;

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

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

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

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

If SDHeadRow[RozElmCol].AsNumber=0 then

Begin

DeleteFromArr (SDHeadRow, RozElmCol, 1);

DelColsFromMatr (SDMatrix, RozElmCol, 1);

DColDeleted:=True;

End;

GI:=True;

End;

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

overload;

Var SafeCurRow:TFloatArr;

Begin

SafeCurRow:=SDMatr[Row1];

SDMatr[Row1]:=SDMatr[Row2];

SDMatr[Row2]:=SafeCurRow;

End;

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

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

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

Вхідні дані:

SDMatr – таблиця;

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

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

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

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

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

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

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

SDMatr – таблиця;

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

Var SafeCurHeadCell:TValOrName;

Begin

SafeCurHeadCell:=SDHeadCol[Row1];

SDHeadCol[Row1]:=SDHeadCol[Row2];

SDHeadCol[Row2]:=SafeCurHeadCell;

If ToChangeInitPosNums then

Begin

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

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

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

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

End;

ChangeRowsPlaces (SDMatr, Row1, Row2);

End;

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

Var SafeElm:TWorkFloat;

Begin

SafeElm:=SDMas[Elm1];

SDMas[Elm1]:=SDMas[Elm2];

SDMas[Elm2]:=SafeElm;

End;

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

overload;

Var CurRow: Integer;

Begin

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

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

End;

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

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

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

Вхідні дані:

SDMatr – таблиця;

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

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

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

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

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

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

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

SDMatr – таблиця;

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

Var SafeCurHeadCell:TValOrName;

Begin

SafeCurHeadCell:=SDHeadRow[Col1];

SDHeadRow[Col1]:=SDHeadRow[Col2];

SDHeadRow[Col2]:=SafeCurHeadCell;

If ToChangeInitPosNums then

Begin

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

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

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

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

End;

ChangeColsPlaces (SDMatr, Col1, Col2);

End;

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

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

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

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

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

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

Begin

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

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

Self. Continue:=False;

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

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

If Not (Self. GoToEnd) then

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

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

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

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

Application. ProcessMessages;

End;

Function TGridFormattingProcs. SearchNozeroSolveCell (CurRowNum,

CurColNum, MaxRow, MaxCol: Integer;

HeadRowNum, HeadColNum: Integer;

ToSearchInRightColsToo: Boolean=True):Boolean;

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

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

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

Const sc_CurProcName='SearchNozeroSolveCell';

Var CurSearchRowNum, CurSearchColNum: Integer;

st1: String;

Begin

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

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

Begin

If Self. CurOutConsole<>Nil then

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

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

sc_SearchingOther);

CurSearchRowNum:=MaxRow+1;

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

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

For CurSearchColNum:=CurColNum to MaxCol do

Begin

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

For CurSearchRowNum:=CurRowNum+1 to MaxRow do

Begin

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

End;

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

If CurSearchRowNum>MaxRow then

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_AllKoefIsZeroForVar;

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

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurSearchColNum].AsNumber)

Else st1:=st1+sc_Space+

sc_DoubleQuot+Self. CurHeadRow[CurSearchColNum].AsVarName+

sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

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

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

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

End

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

Begin

Self. WaitForNewStep (HeadColNum, HeadRowNum);

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

If Self. Stop then

Begin

SearchNozeroSolveCell:=True; Exit;

End;

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

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

CurSearchRowNum);

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

If CurColNum<>CurSearchColNum then

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

CurSearchColNum);

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

End;

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

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

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

Begin

If Self. CurOutConsole<>Nil then

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

SearchNozeroSolveCell:=False;

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

End;

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

SearchNozeroSolveCell:=True;

End;

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

Function TGridFormattingProcs. SolveEqsWithM1: Boolean;

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

x1 x2 x3… xn

a1

a2

a3

…

am}

Const sc_CurProcName='SolveEqsWithM1';

Var CurRowNum, CurColNum: Integer;

st1: String;

HeadRowNum, HeadColNum: Integer;

ColDeleted: Boolean;

Procedure ShowResultCalc;

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

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

<стовп1>=<a11>*<ряд1> + <a12>*<ряд2> +… + <a1n>*<рядn>;

…

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

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

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

…

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

Var CurRowN, CurColN: Integer; ValueAvail: Boolean;

CurVal:TWorkFloat;

st2: String;

NotEqual, NoRoots: Boolean;

Begin

If Self. CurOutConsole<>Nil then

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

NoRoots:=False;

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

Begin

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

If Self. CurOutConsole<>Nil then

Begin

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

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

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

Else

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

st1:=st2;

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

End;

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

Begin {(aij*:)

If Self. CurOutConsole<>Nil then

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

{рядj:}

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

Begin

If Self. CurOutConsole<>Nil then

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

If ValueAvail then CurVal:=CurVal +

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

End

Else

Begin

If Self. CurOutConsole<>Nil then

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

ValueAvail:=False;

End;

If Self. CurOutConsole<>Nil then

Begin

st1:=st1+sc_BrCl; {)}

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

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

Else st1:=st1+sc_KrKm; {;}

End;

End;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add(st1);

st1:=st2;

End;

If ValueAvail then

Begin

NotEqual:=False;

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

Begin

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

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

End;

If Self. CurOutConsole<>Nil then

Begin

If NotEqual then

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

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

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

End;

End

Else

Begin

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

Self. WasManyRoots:=True;

End;

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

End;

If NoRoots then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_NoRoots);

Self. WasManyRoots:=False;

End

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

Self. WasNoRoots:=NoRoots;

End;

Label LStopLabel;

Begin

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

Begin

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM1:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

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

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

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

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

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

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

CurColNum:=0;

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

(CurRowNum<Length (Self. CurHeadCol)) do

Begin

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

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

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

ненульову:}

If Not (Self. SearchNozeroSolveCell (CurRowNum, CurColNum,

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

HeadRowNum, HeadColNum)) then

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

If Self. Stop then Goto LStopLabel;

WaitForNewStep (HeadColNum, HeadRowNum);

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

If Self. Stop then Goto LStopLabel;

ColDeleted:=False;

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

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

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

Begin

SolveEqsWithM1:=False;

Exit;

End;

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

змінних:}

Inc(CurRowNum);

If Not(ColDeleted) then Inc(CurColNum);

End;

ShowResultCalc;

SolveEqsWithM1:=True;

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM1:=False;

Exit;

End;

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

Function TGridFormattingProcs. SolveEqsWithM2: Boolean;

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

x1 x2 x3… xn 1

0

0

0

…

0}

Const sc_CurProcName='SolveEqsWithM2';

Var CurRowNum, CurColNum: Integer;

st1: String;

HeadRowNum, HeadColNum: Integer;

ColDeleted: Boolean;

Procedure ShowResultCalc;

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

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

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

…

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

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

Var CurRowN, CurColN: Integer;

CurVal:TWorkFloat;

NotEqual, NoRoots, FreeRoots: Boolean;

Begin

If Self. CurOutConsole<>Nil then

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

NoRoots:=False;

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

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:='';

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

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

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

Else

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

End;

NotEqual:=False;

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

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

Begin

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

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

End;

If Self. CurOutConsole<>Nil then

Begin

If NotEqual then

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

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

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

Self. CurOutConsole. Lines. Add(st1);

End;

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

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

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

FreeRoots:=False;

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

Begin

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

Begin FreeRoots:=True; Break; End;

End;

If NoRoots then

Begin

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

Self. WasNoRoots:=True;

End

Else if FreeRoots then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ManyRoots);

Self. WasManyRoots:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_SolutionFound);

Self. SolWasFound:=True;

End;

End;

Label LStopLabel;

Begin

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

Begin

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM2:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

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

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

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

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

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

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

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

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

CurColNum:=0;

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

(CurRowNum<Length (Self. CurHeadCol)) do

Begin

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

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

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

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

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

If Not (Self. SearchNozeroSolveCell (CurRowNum, CurColNum,

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

HeadRowNum, HeadColNum)) then

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

If Self. Stop then Goto LStopLabel;

WaitForNewStep (HeadColNum, HeadRowNum);

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

If Self. Stop then Goto LStopLabel;

ColDeleted:=False;

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

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

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

Begin

SolveEqsWithM2:=False;

Exit;

End;

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

змінних:}

Inc(CurRowNum);

If Not(ColDeleted) then Inc(CurColNum);

End;

ShowResultCalc;

SolveEqsWithM2:=True;

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM2:=False;

Exit;

End;

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

fs_SolvingEqsM2, fs_SolvingLTask:}

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

Const sc_CurProcName='Solve';

Var

Res1: Boolean;

st1: String;

Begin

Self. InSolving:=True;

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

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

Res1:=False;

Case Self. CurFormatState of

fs_SolvingEqsM1: Res1:=Self. SolveEqsWithM1;

fs_SolvingEqsM2: Res1:=Self. SolveEqsWithM2;

fs_SolvingLTask: Res1:=Self. SolveMultiCritLTask;

Else

Begin

If Self. CurOutConsole<>Nil then

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

End;

End;

If Self. CurOutConsole<>Nil then

Begin

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

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

Self. CurOutConsole. Lines. Add(st1);

End;

Self. InSolving:=False;

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

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

Solve:=Res1;

End;

Constructor TGridFormattingProcs. Create;

Begin

Inherited Create;

InSolving:=False;

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

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

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

CurGridModified:=False;

CurGridSolveCol:=0; CurGridSolveRow:=0;

TableFormatState:=fs_NoFormatting;

StringGrid:=Nil;

OldOnNewCol:=Nil;

OldOnNewRow:=Nil;

OldOnDrawCell:=Nil;

OldOnDblClick:=Nil;

OldOnMouseUp:=Nil;

OldOnSetEditText:=Nil;

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

SetLength (CurTable, 0);}

Self. CurHeadRow:=Nil;

Self. CurHeadCol:=Nil;

Self. CurTable:=Nil;

Self. CopyHeadRow:=Nil;

Self. CopyHeadCol:=Nil;

Self. CopyTable:=Nil;

CurOutConsole:=Nil;

End;

Destructor TGridFormattingProcs. Free;

Begin

{Inherited Free;} {inaccessible value;

…raised too many consecutive exceptions:

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

End;

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

Const sc_CurProcName='GetColorByElmType';

Var CurColor:TColor;

Begin

Case CurType of

bc_IndependentVar: CurColor:=lwc_IndependentColor;

bc_DependentVar: CurColor:=lwc_DependentColor;

bc_FuncVal: CurColor:=lwc_HeadColColor;

bc_Number: CurColor:=lwc_ValInHeadColOrRowColor;

bc_DestFuncToMax: CurColor:=lwc_DestFuncToMaxNameColor;

bc_DestFuncToMin: CurColor:=lwc_DestFuncToMinNameColor;

bc_OtherType:

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

else CurColor:=clWindow;

Else

Begin

If Self. CurOutConsole<>Nil then

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

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

sc_Space+sc_TriSpot);

CurColor:=bc_NotColored;

End;

End;

GetColorByElmType:=CurColor;

End;

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

Const sc_CurProcName='GetNameByElmType';

Var CurName: String;

Begin

Case CurType of

bc_IndependentVar: CurName:=sc_IndependentVar;

bc_DependentVar: CurName:=sc_DependentVar;

bc_FuncVal: CurName:=sc_InequalFuncName;

bc_Number: CurName:=sc_ValInHeadColOrRow;

bc_DestFuncToMax: CurName:=sc_DestFuncToMaxName;

bc_DestFuncToMin: CurName:=sc_DestFuncToMinName;

bc_OtherType: CurName:=sc_OtherType;

Else

Begin

If Self. CurOutConsole<>Nil then

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

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

sc_TriSpot);

CurName:=sc_UnknownVarType;

End;

End;

GetNameByElmType:=CurName;

End;

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

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

Const sc_CurProcName='ReadFromFile';

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

GotFormatState:TTableFormatState;

CurMessage: String;

Begin

If ((Self. CurFormatState<>fs_EnteringEqs) and

(Self. CurFormatState<>fs_EnteringLTask) and

(Self. CurFormatState<>fs_NoFormatting) and

(Self. CurFormatState<>fs_FreeEdit))

or (Self. InSolving) then

Begin

CurMessage:=sc_CurProcName+sc_CantReadTaskInCurMode+sc_TriSpot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

System. AssignFile (CurFile, SPath);

System. FileMode:=fmOpenRead;

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

System. Reset (CurFile, 1);

except

CurMessage:=sc_CurProcName+sc_CantOpenFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

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

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

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

Except

CurMessage:=sc_CurProcName+sc_EmptyFileOrCantRead+SPath+

sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

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

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

+SizeOf (Self. CurFormatState)+

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

SizeOf(TWorkFloat)*CurColCount*CurRowCount;

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

If ControlSize<>System. FileSize(CurFile) then

Begin

CurMessage:=sc_CurProcName+sc_FileNotFullOrHasWrongFormat+SPath+

sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

Try

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

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

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

Self. TableFormatState:=GotFormatState;

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

SetLength (Self. CurHeadRow, CurColCount);

For CurCol:=0 to CurColCount-1 do

Begin

Try

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

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

End;

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

SetLength (Self. CurHeadCol, CurRowCount);

For CurRow:=0 to CurRowCount-1 do

Begin

Try

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

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

End;

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

SetLength (Self. CurTable, CurRowCount, CurColCount);

For CurRow:=0 to CurRowCount-1 do

Begin

For CurCol:=0 to CurColCount-1 do

Begin

Try

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

SizeOf(TWorkFloat));

Except

CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

ReadFromFile:=False; Exit;

End;

End;

End;

Try

System. Close(CurFile);

Except

CurMessage:=sc_CurProcName + sc_CantCloseFile + SPath + sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

End;

Self. CurGridModified:=False;

Self. Refresh;

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

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

Self. EqM1TaskPrepared:=False;

Self. EqM2TaskPrepared:=False;

Self.LTaskPrepared:=False;

ReadFromFile:=True;

End;

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

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

Const sc_CurProcName='SaveToFile';

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

CurMessage: String;

Begin

If ((Self. CurFormatState<>fs_EnteringEqs) and

(Self. CurFormatState<>fs_EnteringLTask) and

(Self. CurFormatState<>fs_FreeEdit))

or (Self. InSolving) then

Begin

CurMessage:=sc_CurProcName+sc_CantWriteTaskInCurMode;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

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

If Self. CurGridModified then

Begin

If Not (Self. GetTask(True)) then

Begin

SaveToFile:=False; Exit;

End;

End;

System. AssignFile (CurFile, SPath);

System. FileMode:=fmOpenWrite;

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

System. Rewrite (CurFile, 1);

except

CurMessage:=sc_CurProcName+sc_CantCreateFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

Self. GetTaskSizes (CurColCount, CurRowCount);

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

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

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

System. BlockWrite (CurFile, Self. CurFormatState,

SizeOf (Self. CurFormatState));

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

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

For CurCol:=0 to CurColCount-1 do

Begin

Try

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

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

End;

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

For CurRow:=0 to CurRowCount-1 do

Begin

Try

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

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

End;

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

For CurRow:=0 to CurRowCount-1 do

Begin

For CurCol:=0 to CurColCount-1 do

Begin

Try

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

SizeOf(TWorkFloat));

Except

CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

End;

End;

Try

System. Close(CurFile);

Except

CurMessage:=sc_CurProcName + sc_CantCloseFile + SPath + sc_DoubleQuot;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

SaveToFile:=False; Exit;

End;

SaveToFile:=True;

End;

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

Const STable:TFloatMatrix);

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

Begin

Self. CurTable:=STable;

Self. CurHeadRow:=SHeadRow;

Self. CurHeadCol:=SHeadCol;

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

End;

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

Var DTable:TFloatMatrix);

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

Begin

DTable:=Self. CurTable;

DHeadRow:=Self. CurHeadRow;

DHeadCol:=Self. CurHeadCol;

End;

Procedure TGridFormattingProcs. ReadHeadRowCell (SCol: Integer);

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

Вхідні дані:

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

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

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

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

Var CurFloatVal:TWorkFloat; CurElmType:THeadLineElmType;

Begin

CurElmType:=CurHeadRow[SCol].ElmType;

CurFloatVal:=0;

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

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

Self.CHeadColNum, Self.CHeadRowNum]);

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

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

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

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

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

If (CurElmType<>bc_IndependentVar) and (CurElmType<>bc_DependentVar) then

CurElmType:=bc_IndependentVar;

End; {Виправлений тип елемента:}

CurHeadRow[SCol].ElmType:=CurElmType;

If CurElmType=bc_Number then {записуємо число, якщо розпізналося:}

CurHeadRow[SCol].AsNumber:=CurFloatVal

Else

Begin {якщо число не розпізналося, то записуємо як назву змінної:}

With CurHeadRow[SCol] do

Begin

AsVarName:=CurGrid. Cells [SCol+bc_LTaskColsBeforeVars+Self.CHeadColNum,

Self.CHeadRowNum]; {назва}

VarInitPos:=SCol; {номер п/п у рядку в умові задачі}

VarInitInRow:=True; {ознака, що змінна спочатку була у рядку-заголовку}

End;

End;

End;

Procedure TGridFormattingProcs. ReadHeadColCell (SRow: Integer);

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

Вхідні дані:

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

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

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

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

Var CurFloatVal:TWorkFloat; CurElmType:THeadLineElmType;

Begin

CurElmType:=CurHeadCol[SRow].ElmType;

CurFloatVal:=0;

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

CurFloatVal:=StrToFloat (CurGrid. Cells [Self.CHeadColNum,

SRow+bc_LTaskRowsBeforeVars+Self.CHeadRowNum]);

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

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

такою, що містить число або змінну, то вважаємо його назвою функції

(бо це не число, і не повинно бути змінною – усі змінні спочатку

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

If (CurElmType<>bc_FuncVal) and (CurElmType<>bc_DestFuncToMax) and

(CurElmType<>bc_DestFuncToMin) then

CurElmType:=bc_FuncVal;

End; {Виправлений тип елемента:}

CurHeadCol[SRow].ElmType:=CurElmType;

If CurElmType=bc_Number then {записуємо число, якщо розпізналося:}

CurHeadCol[SRow].AsNumber:=CurFloatVal

Else

Begin {якщо число не розпізналося, то записуємо як назву змінної:}

With CurHeadCol[SRow] do

Begin

AsVarName:=CurGrid. Cells [Self.CHeadColNum,

SRow+bc_LTaskRowsBeforeVars+Self.CHeadRowNum]; {назва}

VarInitPos:=SRow; {номер п/п у стовпці в умові задачі}

{Ознака, що змінна спочатку була у стовпці-заголовку:}

VarInitInRow:=False;

End;

End;

End;

Function TGridFormattingProcs. ReadTableFromGrid: Boolean;

Const sc_CurProcName='ReadTableFromGrid';

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

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

стовпця заголовка (верхнього лівого кута таблиці з заголовками):

HeadColNumInGrid (CHeadColNum) і HeadRowNumInGrid (CHeadRowNum).}

Var CurRow, CurCol, CurWidth, CurHeight: Integer;

CurFloatVal:TWorkFloat;

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

': '+sc_NoGrowingStringGrid);

ReadTableFromGrid:=False;

Exit;

End;

{Ширина і висота таблиці з заголовками:}

CurWidth:=Self. CurGrid. ColCount-Self.CHeadColNum-bc_LTaskColsBeforeVars;

CurHeight:=Self. CurGrid. RowCount-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

If (CurHeight<=0) or (CurWidth<=0) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

': починаючи з комірки ['+IntToStr (Self.CHeadColNum+1)+'; '+

IntToStr (Self.CHeadRowNum+1)+'] таблиці не знайдено' + sc_TriSpot);

ReadTableFromGrid:=False;

Exit;

End;

{Виділяємо пам'ять:}

SetLength (Self. CurHeadRow, CurWidth); {рядок-заголовок}

SetLength (Self. CurHeadCol, CurHeight); {стовпець-заголовок}

SetLength (Self. CurTable, CurHeight, CurWidth); {таблиця}

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

For CurCol:=0 to CurWidth-1 do ReadHeadRowCell(CurCol);

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

For CurRow:=0 to CurHeight-1 do ReadHeadColCell(CurRow);

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

For CurRow:=Self.CHeadRowNum+bc_LTaskRowsBeforeVars to

Self. CurGrid. RowCount-1 do

Begin

For CurCol:=Self.CHeadColNum+bc_LTaskColsBeforeVars to

Self. CurGrid. ColCount-1 do

Begin

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

CurFloatVal:=StrToFloat (CurGrid. Cells [CurCol, CurRow]);

Except {Якщо не вдалося, то вважаємо це число нулем:}

CurFloatVal:=0;

End;

Self. CurTable [CurRow-bc_LTaskRowsBeforeVars-Self.CHeadRowNum,

CurCol-bc_LTaskColsBeforeVars-Self.CHeadColNum]:=CurFloatVal;

End;

End;

{Після читання зміни в екранній таблиці враховані:}

Self. CurGridModified:=False;

ReadTableFromGrid:=True;

End;

Function TGridFormattingProcs. WriteTableToGrid (SHeadColNum,

SHeadRowNum: Integer; ToTuneColWidth: Boolean=True):Boolean;

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

Const sc_CurProcName='WriteTableToGrid';

Var CurRow, CurCol, CurWidth, CurHeight: Integer;

CurElmType:THeadLineElmType;

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

': GrowingStringGrid не заданий!..');

WriteTableToGrid:=True;

Exit;

End;

{Ширина і висота таблиці:}

Self. GetTaskSizes (CurWidth, CurHeight);

If (CurHeight<=0) or (CurWidth<=0) then

Begin

If Self. CurOutConsole<>Nil then

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

WriteTableToGrid:=False;

Exit;

End;

{Виділяємо комірки для таблиці у екранному CurGrid:}

Self. CurGrid. ColCount:=CurWidth+SHeadColNum+1;

Self. CurGrid. RowCount:=CurHeight+SHeadRowNum+1;

{Відображаємо рядок-заголовок:}

For CurCol:=SHeadColNum+1 to Self. CurGrid. ColCount-1 do

Begin

CurElmType:=CurHeadRow [CurCol-1-SHeadColNum].ElmType;

If CurElmType=bc_Number then {записуємо число, якщо є числом:}

CurGrid. Cells [CurCol, SHeadRowNum]:=

FloatToStr (CurHeadRow[CurCol-1-SHeadColNum].AsNumber)

Else {Якщо це не число, то це рядок з якоюсь назвою. Записуємо:}

Self. CurGrid. Cells [CurCol, SHeadRowNum]:=

CurHeadRow [CurCol-1-SHeadColNum].AsVarName;

End;

{Відображаємо стовпець-заголовок:}

For CurRow:=SHeadRowNum+1 to Self. CurGrid. RowCount-1 do

Begin

CurElmType:=CurHeadCol [CurRow-1-SHeadRowNum].ElmType;

If CurElmType=bc_Number then {записуємо число, якщо є числом:}

CurGrid. Cells [SHeadColNum, CurRow]:=

FloatToStr (CurHeadCol[CurRow-1-SHeadRowNum].AsNumber)

Else {Якщо це не число, то це рядок з якоюсь назвою. Записуємо:}

Self. CurGrid. Cells [SHeadColNum, CurRow]:=

CurHeadCol [CurRow-1-SHeadRowNum].AsVarName;

End;

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

For CurRow:=SHeadRowNum+1 to Self. CurGrid. RowCount-1 do

Begin

For CurCol:=SHeadColNum+1 to Self. CurGrid. ColCount-1 do

CurGrid. Cells [CurCol, CurRow]:=

FloatToStr (Self. CurTable [CurRow-1-SHeadRowNum, CurCol-1-SHeadColNum]);

End;

{Комірка на перехресті заголовків пуста:}

If (SHeadRowNum<Self. CurGrid. RowCount) and

(SHeadColNum<Self. CurGrid. ColCount) then

CurGrid. Cells [SHeadColNum, SHeadRowNum]:='';

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

затертими:}

Self. CurGridModified:=False;

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

If ToTuneColWidth then Self. CurGrid. TuneColWidth;

WriteTableToGrid:=True;

End;

Procedure TGridFormattingProcs. GetTaskSizes (Var DWidth, DHeight: Integer);

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

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

Begin

DHeight:=Length (Self. CurTable);

If DHeight>0 then

DWidth:=Length (Self. CurTable[0])

Else DWidth:=0;

If DWidth=0 then DHeight:=0;

If DWidth>Length (Self. CurHeadRow) then

DWidth:=Length (Self. CurHeadRow);

If DHeight>Length (Self. CurHeadCol) then

DHeight:=Length (Self. CurHeadCol);

{Якщо комірок немає, то:}

If DWidth=0 then

Begin

{Зовнійшій масив встановлюємо у нульову довжину:}

SetLength (Self. CurTable, 0);

{Заголовки теж:}

SetLength (Self. CurHeadRow, 0);

SetLength (Self. CurHeadCol, 0);

End;

End;

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

Function TGridFormattingProcs. TaskWidth: Integer;

Var CurWidth, CurHeight: Integer;

Begin

Self. GetTaskSizes (CurWidth, CurHeight);

TaskWidth:=CurWidth;

End;

Function TGridFormattingProcs. TaskHeight: Integer;

Var CurWidth, CurHeight: Integer;

Begin

Self. GetTaskSizes (CurWidth, CurHeight);

TaskHeight:=CurHeight;

End;

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

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

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

fs_EnteringEqs і fs_EnteringLTask.}

Const sc_CurProcName='GetTask';

Var Res1: Boolean;

Procedure DoGetTask;

Begin

If ToPrepareGrid then

CurGrid. ShrinkToFilled (Self.CHeadColNum+1, Self.CHeadRowNum+1);

{Читаємо комірки таблиці:}

Res1:=Self. ReadTableFromGrid;

{Відображаємо те, що вийшло прочитати, у тих самих комірках на екрані:}

If Not (Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum)) then

Res1:=False;

End;

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+': '+sc_NoGrowingStringGrid);

GetTask:=False;

Exit;

End;

Case Self. CurFormatState of

fs_EnteringEqs: {режим редагування системи лінійних рівнянь:}

Begin

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

сформовані назви змінних x1…xn та множник вільних членів (1).

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

При переході до режиму вирішування задачі у цей стовпець

будуть скопійовані вільні члени (режим способу 1, fs_SolvingEqsM1),

або нулі (режим способу 2, fs_SolvingEqsM2):}

DoGetTask;

If Not(Res1) then Begin GetTask:=False; Exit; End;

End;

fs_EnteringLTask: {режим редагування форми задачі лінійного програмування:}

Begin

{Зчитуємо таблицю умови для задачі ЛП максимізації або

мінімізації лінійної форми (функції з умовами-нерівностями,

рівняннями та обмеженнями невід'ємності, імена змінних, нерівностей,

функцій):}

DoGetTask;

If Not(Res1) then Begin GetTask:=False; Exit; End;

End;

fs_FreeEdit: {режим вільного редагування:}

Begin

{Читаємо таблицю, рядок-заголовок, стовпець-заголовок:}

DoGetTask;

If Not(Res1) then Begin GetTask:=False; Exit; End;

End;

Else {інші режими:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_CantReadTaskInCurMode

+ sc_TriSpot);

GetTask:=False;

Exit;

End;

End;

{If ToPrepareGrid then CurGrid. TuneColWidth;}

Self. EqM1TaskPrepared:=False;

Self. EqM2TaskPrepared:=False;

Self.LTaskPrepared:=False;

GetTask:=True;

End;

Procedure TGridFormattingProcs. Refresh;

Const sc_CurProcName='Refresh';

Var Res1: Boolean;

Begin

If Self. CurFormatState<>fs_NoFormatting then

Begin

If Self. CurGrid=Nil then

Begin

If Self. CurOutConsole<>Nil then

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

sc_NoGrowingStringGrid);

Exit;

End;

Res1:=False;

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

If Self. CurGridModified or (Self. TaskWidth<=0) then Res1:=Self. GetTask;

If Not(Res1) then {Якщо таблиця не була віджображена у GetTask, відображаємо:}

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

End;

End;

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

Begin

Self. CurGridModified:=False;

End;

Procedure TGridFormattingProcs. UndoChanges;

{Відкидає останні зміни (ResetModified+Refresh).}

Begin

Self. ResetModified; Self. Refresh;

End;

Procedure Transpose (Var SDMatrix:TFloatMatrix);

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

Var CurCol, CurRow, CurWidth, CurHeight: Integer;

SafeElm:TWorkFloat;

Begin

CurHeight:=Length(SDMatrix);

If CurHeight>0 then CurWidth:=Length (SDMatrix[0])

Else CurWidth:=0;

If (CurHeight=0) or (CurWidth=0) then Exit;

{Збільшуємо розміри матриці до квадратних:}

If CurWidth>CurHeight then {Якщо ширина була більша за висоту:}

Begin

SetLength (SDMatrix, CurWidth, CurWidth); {збільшуємо висоту}

End

Else if CurWidth<CurHeight then {Якщо висота була більша за ширину:}

Begin

SetLength (SDMatrix, CurHeight, CurHeight); {збільшуємо ширину}

End;

{Міняємо елементи місцями: рядки будуть стовпцями, а стовпці – рядками:}

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

Begin

For CurCol:=CurRow + 1 to Length (SDMatrix[CurRow]) – 1 do

Begin

SafeElm:=SDMatrix [CurRow, CurCol];

SDMatrix [CurRow, CurCol]:=SDMatrix [CurCol, CurRow];

SDMatrix [CurCol, CurRow]:=SafeElm;

End;

End;

{Ширина тепер буде така як була висота, а висота – як була ширина:}

SetLength (SDMatrix, CurWidth, CurHeight);

End;

Function TGridFormattingProcs. MakeDualLTask: Boolean;

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

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

задачі максимізації-мінімізації (fs_EnteringLTask).

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

потрібно було знайти максимум, і максимізувати, якщо для прямої потрібно

було знайти мінімум.

}

Const sc_CurProcName='MakeDualLTask';

Var SafeMas:TValOrNameMas; CurCol, CurRow, DFuncCount: Integer;

DualTType:TDualTaskType; NewDFuncType, OldDFuncType:THeadLineElmType;

Begin

SafeMas:=Nil;

If Self. CurFormatState<>fs_EnteringLTask then

Begin

If Self. CurOutConsole<>Nil then

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

MakeDualLTask:=False; Exit;

End;

If Self. CurGridModified then

Begin

If Not (Self. GetTask(True)) then

Begin

MakeDualLTask:=False; Exit;

End;

End;

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

Begin

If Self. CurOutConsole<>Nil then

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

MakeDualLTask:=False; Exit;

End;

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

(для максимізації чи мінімізації):}

DFuncCount:=0; DualTType:=dt_MaxToMin; OldDFuncType:=bc_DestFuncToMax;

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

Begin

If Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMax then

Begin

DualTType:=dt_MaxToMin;

OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;

Inc(DFuncCount);

End

Else if Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMin then

Begin

DualTType:=dt_MinToMax;

OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;

Inc(DFuncCount);

End;

End;

{Якщо функцій мети декілька або жодної:}

If DFuncCount<>1 then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

sc_CanMakeDTaskOnlyForOneDFunc+IntToStr(DFuncCount));

MakeDualLTask:=False; Exit;

End;

If DualTType=dt_MaxToMin then NewDFuncType:=bc_DestFuncToMin

Else NewDFuncType:=bc_DestFuncToMax;

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

рядків залишаємо на тих самих місцях (і присвоюємо тим рядкам, які

стають на ці місця):}

Self. ShiftRowsDown([bc_DestFuncToMax, bc_DestFuncToMin], True);

Transpose (Self. CurTable); {транспонуємо таблицю коефіцієнтів}

{Обробляємо заголовки таблиці у відповідність до двоїстої задачі:}

{Для рядка-заголовка, що стане стовпцем-заголовком:}

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

Begin {Проходимо по усіх змінних і останньому елементу –

множнику стовпця вільних членів – одиниці:}

If Self. CurHeadRow[CurCol].ElmType=bc_DependentVar then {Якщо змінна >=0:}

Begin {Ця комірка буде заголовком функції умови-нерівності зі знаком «>=»:}

Self. CurHeadRow[CurCol].ElmType:=bc_FuncVal;

Self. CurHeadRow[CurCol].VarInitInRow:=False;

{Формуємо назву функції:}

{якщо змінна має назву змінної двоїстої задачі, то дамо назву

функції прямої задачі, якщо назва прямої – назву двоїстої:}

If Pos (sc_DualTaskVarNameStart, Self. CurHeadRow[CurCol].AsVarName)>0 then

Self. CurHeadRow[CurCol].AsVarName:=sc_YFuncName + IntToStr (CurCol+1)

Else Self. CurHeadRow[CurCol].AsVarName:=sc_DualTaskFuncNameStart +

IntToStr (CurCol+1);

{Якщо переходимо від задачі максимізації до двоїстої задачі

мінімізації, то для нерівності треба буде змінити знак «>=» на «<=»,

(якщо для змінної була умова «>=0», і заголовок для неї був додатний),

тому змінюємо знак заголовка:}

If DualTType=dt_MaxToMin then

ChangeSignForValOrVarName (Self. CurHeadRow[CurCol]);

End {Якщо змінна вільна:}

Else if Self. CurHeadRow[CurCol].ElmType=bc_IndependentVar then

Begin {Ця комірка буде заголовком умови-рівняння:}

Self. CurHeadRow[CurCol].ElmType:=bc_Number;

Self. CurHeadRow[CurCol].AsNumber:=0;

End {Якщо це число:}

Else if Self. CurHeadRow[CurCol].ElmType=bc_Number then

Begin

If Self. CurHeadRow[CurCol].AsNumber=1 then {якщо це множник вільних членів}

Begin

Self. CurHeadRow[CurCol].ElmType:=NewDFuncType;

Self. CurHeadRow[CurCol].VarInitInRow:=False;

{Формуємо назву функції мети двоїстої задачі

(залежно від назви функції мети поданої задачі):}

If Pos (sc_DualDestFuncHdr,

Self. CurHeadCol [Length(Self. CurHeadCol) – 1].AsVarName)>0 then

Self. CurHeadRow[CurCol].AsVarName:=sc_DestFuncHdr

Else Self. CurHeadRow[CurCol].AsVarName:=sc_DualDestFuncHdr;

End;

End;

End;

{Для стовпця-заголовка, що стане рядком-заголовком:}

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

Begin

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

заголовку рядка функції мети:}

If Self. CurHeadCol[CurRow].ElmType=bc_FuncVal then {Якщо нерівність «<=»:}

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_DependentVar; {буде змінна >=0}

Self. CurHeadCol[CurRow].VarInitInRow:=True;

{Формуємо назву змінної:

якщо функція-нерівність має назву функції двоїстої задачі, то

дамо назву змінної прямої задачі, якщо назва прямої – назву двоїстої:}

If Pos (sc_DualTaskFuncNameStart, CurHeadCol[CurRow].AsVarName)>0 then

Self. CurHeadCol[CurRow].AsVarName:=sc_XVarName + IntToStr (CurRow+1)

Else Self. CurHeadCol[CurRow].AsVarName:=sc_DualTaskVarNameStart +

IntToStr (CurRow+1);

{Якщо переходимо від задачі мінімізації до двоїстої задачі

максимізації, то для змінної треба буде змінити знак і умову «<=0»

на «>=0», (якщо для нерівність була зі знаком «<=», і заголовок для

неї був додатний), тому змінюємо знак заголовка:}

If DualTType=dt_MinToMax then

ChangeSignForValOrVarName (Self. CurHeadCol[CurRow]);

End

Else if Self. CurHeadCol[CurRow].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRow].AsNumber=0 then {Якщо 0, заголовок рівняння:}

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_IndependentVar;

Self. CurHeadCol[CurRow].VarInitInRow:=True;

{Формуємо назву змінної двоїстої задачі

(залежно від назви функції мети поданої задачі):}

If Pos (sc_DualDestFuncHdr,

Self. CurHeadCol [Length(Self. CurHeadCol) – 1].AsVarName)>0 then

Self. CurHeadCol[CurRow].AsVarName:=sc_XVarName+IntToStr (CurRow+1)

Else Self. CurHeadCol[CurRow].AsVarName:=sc_DualTaskVarNameStart+

IntToStr (CurRow+1);

End;

End {Якщо заголовок рядка функції мети:}

Else if Self. CurHeadCol[CurRow].ElmType=OldDFuncType then

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_Number;

Self. CurHeadCol[CurRow].AsNumber:=1; {буде множник стовпця вільних членів}

End;

End;

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

SafeMas:=Self. CurHeadRow;

Self. CurHeadRow:=Self. CurHeadCol;

Self. CurHeadCol:=SafeMas;

{У новому стовпці-заголовку шукаємо комірки-заголовки нерівностей «>=».

Їх заміняємо на «<=» множенням рядка на -1:}

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

Begin

If Self. CurHeadCol[CurRow].ElmType=bc_FuncVal then

Begin

If ValSign (Self. CurHeadCol[CurRow])=bc_Negative then

Self. ChangeSignsInRow(CurRow);

End;

End;

{У новому рядку-заголовку шукаємо комірки-заголовки залежних змінних,

які мають умову «<=0». Змінюємо цю умову на «>=0» множенням стовпця на -1:}

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

Begin

If Self. CurHeadRow[CurCol].ElmType=bc_DependentVar then

Begin

If ValSign (Self. CurHeadRow[CurCol])=bc_Negative then

Self. ChangeSignsInCol(CurCol);

End;

End;

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

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

MakeDualLTask:=True;

End;

Function TGridFormattingProcs. PrepareToSolveEqsWithM1: Boolean;

Const sc_CurProcName='PrepareToSolveEqsWithM1';

Var CurRow, ColToDel: Integer;

Begin

If (Self. CurFormatState=fs_EnteringEqs) or

(Self. CurFormatState=fs_NoFormatting) then

Begin

{Якщо таблиця не зчитана, то читаємо:}

If (Self. CurGridModified) and (Self. CurFormatState=fs_EnteringEqs) then

Begin

If Not (Self. GetTask) then

Begin

PrepareToSolveEqsWithM1:=False; Exit;

End;

End;

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

Begin

If Self. CurOutConsole<>Nil then

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

PrepareToSolveEqsWithM1:=False;

Exit;

End;

If Not (Self. EqM1TaskPrepared) then

Begin

{Копіюємо стовпець вільних членів (правих частин рівнянь) із

останнього стовпця таблиці до стовпця-заголовка:}

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

Begin

Self. CurHeadCol[CurRow].ElmType:=bc_Number;

Self. CurHeadCol[CurRow].AsNumber:=

Self. CurTable [CurRow, Length (CurTable[CurRow]) – 1];

End;

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

ColToDel:=Length (Self. CurTable[0]) – 1;

DelColsFromMatr (Self. CurTable, ColToDel, 1);

DeleteFromArr (Self. CurHeadRow, ColToDel, 1);

End;

{Позиціювання відображення таблиці у даному режимі вирішування:}

Self.CHeadColNum:=CurGrid. FixedCols;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Відображаємо таблицю, що підготована для розв'язування:}

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

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

стовпець-заголовок:}

If Self. TaskHeight<=0 then

Begin

PrepareToSolveEqsWithM1:=False;

Exit;

End;

Self. EqM1TaskPrepared:=True;

PrepareToSolveEqsWithM1:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

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

PrepareToSolveEqsWithM1:=False;

End;

End;

Function TGridFormattingProcs. PrepareToSolveEqsWithM2: Boolean;

Const sc_CurProcName='PrepareToSolveEqsWithM2';

Var CurRow: Integer;

Begin

If (Self. CurFormatState=fs_EnteringEqs) or

(Self. CurFormatState=fs_NoFormatting) then

Begin {Якщо таблиця не зчитана, то читаємо:}

If (Self. CurGridModified) and (Self. CurFormatState=fs_EnteringEqs) then

Begin

If Not (Self. GetTask) then

Begin

PrepareToSolveEqsWithM2:=False; Exit;

End;

End;

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

Begin

If Self. CurOutConsole<>Nil then

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

PrepareToSolveEqsWithM2:=False; Exit;

End;

If Not (Self. EqM2TaskPrepared) then

Begin

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

Begin

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

Self. CurHeadCol[CurRow].ElmType:=bc_Number;

Self. CurHeadCol[CurRow].AsNumber:=0;

{Змінюємо знаки у останньому стовпці таблиці – стовпці вільних

членів. Так як вони у правих частинах рівнянь, то знаходячись у

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

знаками:}

Self. CurTable [CurRow, Length (CurTable[CurRow]) – 1]:=

– Self. CurTable [CurRow, Length (CurTable[CurRow]) – 1];

End;

End;

{Позиціювання відображення таблиці у даному режимі вирішування:}

Self.CHeadColNum:=CurGrid. FixedCols;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Відображаємо таюдицю, що підготована для розв'язування:}

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

Self. EqM2TaskPrepared:=True;

PrepareToSolveEqsWithM2:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

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

PrepareToSolveEqsWithM2:=False;

End;

End;

{TTableFormatState=(fs_EnteringEqs, fs_EnteringLTask, fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask,

fs_NoFormatting, fs_FreeEdit);}

Function TGridFormattingProcs. PrepareToSolveLTask: Boolean;

Const sc_CurProcName='PrepareToSolveLTask';

Begin

If (Self. CurFormatState=fs_EnteringLTask) or

(Self. CurFormatState=fs_NoFormatting) then

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

If (Self. CurGridModified) and (Self. CurFormatState=fs_EnteringLTask) then

Begin

If Not (Self. GetTask) then {зчитуємо таблицю (умову) з екранної таблиці}

Begin

PrepareToSolveLTask:=False; Exit;

End;

End;

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

Begin

If Self. CurOutConsole<>Nil then

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

PrepareToSolveLTask:=False; Exit;

End;

If Not (Self.LTaskPrepared) then {якщо ця підготовка ще не виконувалася:}

Begin

{Зсуваємо рядки цільових функцій вниз. При цьому позначки порядку

рядків залишаємо на тих самих місцях (і присвоюємо тим рядкам, які

стають на ці місця):}

Self. ShiftRowsDown([bc_DestFuncToMax, bc_DestFuncToMin], True);

{Позиціювання відображення таблиці у даному режимі вирішування:}

Self.CHeadColNum:=CurGrid. FixedCols;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Відображаємо таблицю, що підготована для розв'язування:}

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

Self.LTaskPrepared:=True;

End;

PrepareToSolveLTask:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

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

PrepareToSolveLTask:=False;

End;

End;

Function TGridFormattingProcs. PrepareDFuncForSimplexMaximize: Boolean;

Var ToMax: Boolean; Row, Col, CurWidth, DFuncRowNum: Integer;

Const sc_CurProcName='PrepareDFuncForSimplexMaximize';

Begin

CurWidth:=Length (Self. CurHeadRow);

DFuncRowNum:=Length (Self. CurHeadCol) – 1;

Case Self. CurHeadCol[DFuncRowNum].ElmType of {перевіряємо тип функції мети:}

bc_DestFuncToMax: ToMax:=True;

bc_DestFuncToMin: ToMax:=False;

Else {якщо заданий рядок виявився не функцією мети:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+

sc_CurRowNotMarkedAsDestFunc+IntToStr (DFuncRowNum+1));

PrepareDFuncForSimplexMaximize:=False; Exit;

End;

End;

{Готуємо умову для вирішування симплекс-методом максимізації:}

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

комірки – то множник для стовпця правих частин. Це є

інтерпретацією перенесення усіх доданків у праву частину, і

форматом для виконання модифікованих Жорданових виключень:}

For Col:=0 to CurWidth-2 do

ChangeSignForValOrVarName (Self. CurHeadRow[Col]);

{Якщо треба шукати максимум, то множимо коефіцієнти функції мети

на -1 (окрім вільгого члена), бо помножили і усі x1…xn на -1.

Якщо треба мінімум, то ці коефіцієнти не множимо

(бо x1…xn вже помножені), але множимо вільний член функції. Тоді

отримаємо протилежну функцію, щоб знайти її максимум

(це протилежний мінімум заданої функції):}

Row:=Length (Self. CurHeadCol) – 1; {рядок функції мети}

If ToMax then

Begin

For Col:=0 to CurWidth-2 do {коефіцієнти функції мети міняють знаки:}

Self. CurTable [Row, Col]:=-Self. CurTable [Row, Col];

End

Else {Якщо треба знайти мінімум:}

Begin {Множимо вільний член функції мети на -1:}

Self. CurTable [Row, CurWidth-1]:=-Self. CurTable [Row, CurWidth-1];

{Назва функції теж міняє знак:}

ChangeSignForValOrVarName (Self. CurHeadCol[Row]);

{Тепер це протилежна функція для максимізації:}

Self. CurHeadCol[Row].ElmType:=bc_DestFuncToMax;

End;

PrepareDFuncForSimplexMaximize:=True;

End;

Function TGridFormattingProcs. PrepareDestFuncInMultiDFuncLTask (

SFuncRowNum, MinDestFuncRowNum: Integer):Boolean;

{Готує таблицю для розв'язування задачі ЛП відносно одної заданої функції

мети із багатокритеріальної задачі.

Вхідні дані:

SFuncRowNum – номер рядка у таблиці Self. CopyTable (і комірки у

стовпці-заголовку Self. CopyHeadCol), в якому записана портібна

функція мети;

DestFuncMinRowNum – номер найвищого (з найменшим номером) рядка

функції мети. Усі функції мети мають бути зібрані внизу таблиці;

Self. CopyTable – таблиця коефіцієнтів та вільних членів;

Self. CopyHeadRow – рядок-заголовок зі змінними та одиницею-множником

стовпця вільних членів (має бути останнім);

Self. CopyHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

нулями (заголовки рядків-рівнянь), іменами функцій мети

(що максимізуються (тип комірки bc_DestFuncToMax) або мінімізуються

(тип bc_DestFuncToMin)).

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

Умова для одної функції:

Self. CurTable – таблиця коефіцієнтів та вільних членів з одною

функцією мети в останньому рядку, для максимізації симплекс-методом;

Self. CurHeadRow – рядок-заголовок;

Self. CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

нулями (заголовки рядків-рівнянь), і одною коміркою функції мети

(остання, найнижча комірка), яку треба максимізувати. Якщо у цій

комірці перед назвою функції стоїть знак «–», то після максимізації

її треба замінити на протилежну функцію (і отримати мінімізацію

тої функції, яка була задана в умові).

Підпрограма повертає ознаку успішності підготовки умови із одною

заданою функцією мети.}

Var Row, Col, CurWidth, CurHeight: Integer;

Const sc_CurProcName='PrepareDestFuncInMultiDFuncLTask';

Label LStopLabel;

Begin

If Not (Self. GoToEnd) then

Begin {Демонструємо функцію мети у таблиці, з якою будемо працювати:}

{Таблиця багатокритеріальної задачі для відображення:}

Self. CurHeadRow:=Self. CopyHeadRow; Self. CurHeadCol:=Self. CopyHeadCol;

Self. CurTable:=Self. CopyTable;

{Координати рядка функції для помітки його кольором:}

Self. CurGridSolveCol:=Self.CHeadColNum;

Self. CurGridSolveRow:=SFuncRowNum+Self.CHeadRowNum+bc_LTaskRowsBeforeVars;

{Відображаємо і чекаємо реакції користувача:}

WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum);

If Self. Stop then Goto LStopLabel;

End;

CurWidth:=Length (Self. CopyHeadRow);

CurHeight:=Length (Self. CopyHeadCol);

If (SFuncRowNum<0) or (MinDestFuncRowNum<0) or

(SFuncRowNum>=CurHeight) or (MinDestFuncRowNum>=CurHeight) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_RowNumsIsOutOfTable);

PrepareDestFuncInMultiDFuncLTask:=False; Exit;

End;

{Формуємо умову однокритеріальної задачі лінійного програмування із

копії умови багатокритеріальної задачі:}

{Копіюємо заголовки і таблицю коефіцієнтів:}

SetLength (Self. CurHeadRow, CurWidth); {довжина для рядка заголовка така сама}

For Col:=0 to CurWidth-1 do Self. CurHeadRow[Col]:=Self. CopyHeadRow[Col];

{Стовпець-заголовок і висота таблиці мають усі рядки умов (рівнянь

та нерівностей) і один рядок функції мети:}

SetLength (Self. CurHeadCol, MinDestFuncRowNum+1);

SetLength (Self. CurTable, MinDestFuncRowNum+1, CurWidth);

For Row:=0 to MinDestFuncRowNum-1 do {копіюємо рядки умов:}

Begin

Self. CurHeadCol[Row]:=Self. CopyHeadCol[Row];

For Col:=0 to CurWidth-1 do

Self. CurTable [Row, Col]:=Self. CopyTable [Row, Col];

End;

{В останній рядок таблиці однокритеріальної задачі копіюємо заданий

рядок функції мети із багатокритеріальної задачі:}

Row:=MinDestFuncRowNum; {номер останнього рядка у однокритеріальній задачі}

Self. CurHeadCol[Row]:=Self. CopyHeadCol[SFuncRowNum];

For Col:=0 to CurWidth-1 do

Self. CurTable [Row, Col]:=Self. CopyTable [SFuncRowNum, Col];

PrepareDestFuncInMultiDFuncLTask:=Self. PrepareDFuncForSimplexMaximize;

Exit;

LStopLabel:

PrepareDestFuncInMultiDFuncLTask:=False; Exit;

End;

Procedure TGridFormattingProcs. ShowLTaskResultCalc (DualTaskVals: Boolean);

{Процедура зчитує значення функції мети у таблиці розв'язаної

однокритеріальної задачі, і значення усіх змінних або функцій в цьому

розв'язку. Відображає значення цих змінних, функцій-нерівностей, і

функції мети в Self. CurOutConsole.

Вхідні дані:

DualTaskVals – вмикач режиму відображення значень двоїстої задачі:

читаються значення змінних і функцій двоїстої задачі. Їхні

значення розміщені не на місці стовпця вільних членів, а у рядку

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

Таблиця розв'язаної однокритеріальної (з одною функцією мети) задачі:

Self. CurTable – таблиця коефіцієнтів та вільних членів;

Self. CurHeadRow – рядок-заголовок з іменами змінних, іменами

функцій-нерівностей (що перейшли в рядок-заголовок) та

одиницею-множником стовпця вільних членів (має бути останнім);

Self. CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

іменами змінних (виключених), іменем функції мети.}

Const DestFuncsTypes=[bc_DestFuncToMax, bc_DestFuncToMin];

Var st1: String; CurColNum, CurRowNum, LastColNum, LastRowNum: Integer;

Begin

If Self. CurOutConsole<>Nil then

Begin

LastColNum:=Length (Self. CurHeadRow) – 1;

LastRowNum:=Length (Self. CurHeadCol) – 1;

st1:=sc_ResultIs;

If DualTaskVals then

st1:=st1+sc_ForDualTask

Else st1:=st1+sc_ForDirectTask;

Self. CurOutConsole. Lines. Add(st1);

Self. CurOutConsole. Lines. Add (sc_InHeadRow);

{Показуємо значення змінних (або функцій) у рядку-заголовку:}

For CurColNum:=0 to LastColNum-1 do

Begin

st1:='';

If Self. CurHeadRow[CurColNum].ElmType=bc_Number then

st1:=st1+FloatToStr (Self. CurHeadRow[CurColNum].AsNumber)

Else st1:=st1+Self. CurHeadRow[CurColNum].AsVarName;

st1:=st1 + sc_Space+sc_Equal+sc_Space;

{Усі змінні прямої задачі (або функції) у рядку-заголовку в точці

задачі рівні нулю, а змінні двоїстої – у рядку коефіцієнтів функції

мети:}

If DualTaskVals then

st1:=st1+ FloatToStr (Self. CurTable [LastRowNum, CurColNum])

Else st1:=st1+'0';

st1:=st1+sc_KrKm;

Self. CurOutConsole. Lines. Add(st1);

End;

Self. CurOutConsole. Lines. Add (sc_InHeadCol);

For CurRowNum:=0 to LastRowNum do

Begin

st1:='';

If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then

st1:=st1+FloatToStr (Self. CurHeadCol[CurRowNum].AsNumber)

Else st1:=st1+Self. CurHeadCol[CurRowNum].AsVarName;

st1:=st1 + sc_Space+sc_Equal+sc_Space;

{Усі змінні прямої задачі (або функції) у стовпці-заголовку в точці

задачі мають свої значення у стовпці вільних членів,

а змінні двоїстої – рівні нулю:}

If (Self. CurHeadCol[CurRowNum].ElmType in DestFuncsTypes) or

Not(DualTaskVals) then

st1:=st1+ FloatToStr (Self. CurTable [CurRowNum, LastColNum])

Else st1:=st1+'0';

If (Self. CurHeadCol[CurRowNum].ElmType in DestFuncsTypes) then

st1:=sc_ResFunc+sc_Space+st1;

If CurRowNum=LastRowNum then st1:=st1+sc_Spot

Else st1:=st1+sc_KrKm;

Self. CurOutConsole. Lines. Add(st1);

End;

End;

End;

Procedure TGridFormattingProcs. ReadCurFuncSolution (Var SDValVecs:TFloatMatrix;

Var SDDestFuncVals:TFloatArr; SVecRow: Integer;

ToReadFuncVals: Boolean; DualTaskVals: Boolean);

{Процедура зчитує значення функції мети у таблиці розв'язаної

однокритеріальної задачі, і значення усіх змінних або функцій в цьому

розв'язку.

Вхідні дані:

SVecRow – номер поточної функції мети (нумерація з нуля) у масивах

SDValVecs і SDDestFuncVals;

ToReadFuncVals – перемикач: якщо рівний False, то зчитуються значення

змінних (і значення функції мети); True – зчитуються значення

функцій-нерівностей (і значення функції мети);

DualTaskVals – вмикач режиму читання змінних двоїстої задачі:

читаються значення змінних і функцій двоїстої задачі. Їхні

значення розміщені не на місці стовпця вільних членів, а у рядку

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

Таблиця розв'язаної однокритеріальної (з одною функцією мети) задачі:

Self. CurTable – таблиця коефіцієнтів та вільних членів;

Self. CurHeadRow – рядок-заголовок з іменами змінних, іменами

функцій-нерівностей (що перейшли в рядок-заголовок) та

одиницею-множником стовпця вільних членів (має бути останнім);

Self. CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

іменами змінних (виключених), іменем функції мети. Функція мети

має бути в останньому рядку, і бути одна;

SDValVecs – масив для запису векторів значень змінних;

SDDestFuncVals – масив для запису значень функцій мети

(для цих двох останніх масивів пам'ять має бути вже виділеною).

Вихідні дані:

SDValVecs – масив векторів значень змінних із заповненим вектором

номер SVecRow. Змінні, яких немає в таблиці розв'язку, вважаються

такими що можуть мати будь-яке значення, і приймаються рівними нулю;

SDDestFuncVals – масив значень функцій мети з поточни значенням

у комірці номер SVecRow.}

Var CurColNum, CurRowNum, LastColNum, LastRowNum: Integer;

WorkCellTypes:THeadLineElmTypes;

Begin

{Ініціюємо нулями поточний вектор значень.

Змінні чи функції, імена яких у рядку-заголовку, рівні нулю

для прямої задачі (для двоїстої – у стовпці-заголовку).

Змінні і функції, яких немає в таблиці, теж вважаємо рівними нулю:}

For CurColNum:=0 to Length (SDValVecs[SVecRow]) – 1 do

SDValVecs [SVecRow, CurColNum]:=0;

{Читаємо стовпець-заголовок і значення із останнього стовпця таблиці:}

LastColNum:=Length (Self. CurHeadRow) – 1;

LastRowNum:=Length (Self. CurHeadCol) – 1;

{Значення функції мети:}

SDDestFuncVals[SVecRow]:=Self. CurTable [LastRowNum, LastColNum];

{Функції-нерівності прямої задачі відповідають змінним двоїстої задачі

за позиціюванням в заголовках (не за значеннями, значення різні!),

змінні прямої – функціям двоїстої:}

If (ToReadFuncVals) xor (DualTaskVals) then

WorkCellTypes:=[bc_FuncVal]

Else WorkCellTypes:=[bc_IndependentVar, bc_DependentVar];

{Читаємо змінні або функції-нерівності (в залежності від того, що

задано прочитати):}

If DualTaskVals then

Begin

For CurColNum:=0 to LastColNum-1 do {усі стовпці крім стовпця вільних членів}

Begin {значення записуємо у заданий вектор (SVecRow):}

If (Self. CurHeadRow[CurColNum].ElmType in WorkCellTypes) then

SDValVecs [SVecRow, Self. CurHeadRow[CurColNum].VarInitPos]:=

Self. CurTable [LastRowNum, CurColNum];

End

End

Else

Begin

For CurRowNum:=0 to LastRowNum-1 do {усі рядки крім рядка функції мети}

Begin {значення записуємо у заданий вектор (SVecRow):}

If (Self. CurHeadCol[CurRowNum].ElmType in WorkCellTypes) then

SDValVecs [SVecRow, Self. CurHeadCol[CurRowNum].VarInitPos]:=

Self. CurTable [CurRowNum, LastColNum];

End

End;

End;

Procedure TGridFormattingProcs. BuildPaymentTaskOfOptim (

Const SOptimXVecs:TFloatMatrix; Const SOptimFuncVals:TFloatArr;

SFirstDFuncRow: Integer);

{Будує однокритеріальну задачу максимізації для пошуку вагових

коефіцієнтів і компромісного вектора значень змінних для

усіх заданих функцій мети.

Вхідні дані:

SOptimXVecs – масив векторів оптимальних значень змінних для

кожної з фунуцій мети;

SOptimFuncVals – масив оптимальних значень функцій мети;

SFirstDFuncRow – номер першої (найвищої) функції мети

у Self. CopyTable і Self. CopyHeadCol;

Self. CopyTable – матриця коефіцієнтів умови багатокритеріальної задачі;

Вихідні дані:

Однокритеріальна задача ЛП для максимізації:

Self. CurTable – матриця коефіцієнтів оптимальності,

вільних членів і коефіцієнтів функції мети;

Self. CurHeadCol – імена змінних двоїстої задачі (як

функції-нерівності прямої задачі);

Self. CurHeadRow – імена функцій-нерівностей двоїстої задачі

(як залежні (тільки більше нуля) змінні прямої задачі).}

Var jCol, iRow, FuncCount, FuncRow: Integer; MinQ, CurQ:TWorkFloat;

Const sc_CurProcName='BuildPaymentTaskOfOptim';

Function CalcQ (ZjFuncRow: Integer; Const XiVals:TFloatArr;

Const ZjXj:TWorkFloat):TWorkFloat;

{Підраховує міру неоптимальності.

Вхідні дані:

ZjFuncRow – номер рядка j-ої функції мети у таблиці Self. CopyTable;

Self. CopyTable – таблиця коефіцієнтів умови багатокритеріальної

задачі ЛП;

XiVals – оптимальні значення змінних для i-ої функції мети

(для формування i-го рядка матриці неоптимальності);

ZjXj – значення j-ої функції мети за j-го набору оптимальних

значень змінних (тобто оптимальне значення цієї функції). Для

формування j-го стовпця матриці неоптимальності.

Вихідні дані: міра неоптимальності.}

Var VarNum: Integer; ZjXi:TWorkFloat;

Begin

ZjXi:=0;

{Шукаємо суму добутків значень змінних і коефіцієнтів при них –

значення функції у точці, координатами якої є подані значення змінних:}

For VarNum:=0 to Length(XiVals) – 1 do

ZjXi:=ZjXi + Self. CopyTable [ZjFuncRow, VarNum]*XiVals[VarNum];

CalcQ:=-Abs((ZjXi/ZjXj) – 1); {qij=-|(ZjXi-ZjXj)/(ZjXj)|}

End;

{Заповнення імен змінних – імен фукнцій двоїстої задачі у рядку-заголовку:}

Procedure FillHRowVarName (SCol: Integer);

Begin

Self. CurHeadRow[SCol].VarInitPos:=SCol;

Self. CurHeadRow[SCol].VarInitInRow:=True;

Self. CurHeadRow[SCol].ElmType:=bc_DependentVar;

Self. CurHeadRow[SCol].AsVarName:=sc_Minus+sc_DualTaskFuncNameStart+

IntToStr (SCol+1);

End;

{Заповнення у комірки рядка-заголовка числом:}

Procedure FillHRowWithNum (SCol: Integer; Const SNumber:TWorkFloat);

Begin

Self. CurHeadRow[SCol].VarInitPos:=SCol;

Self. CurHeadRow[SCol].VarInitInRow:=True;

Self. CurHeadRow[SCol].ElmType:=bc_Number;

Self. CurHeadRow[SCol].AsNumber:=SNumber;

End;

{Заповнення імен функцій – імен змінних двоїстої задачі у стовпці-заголовку:}

Procedure FillHColFuncName (SRow: Integer);

Begin

Self. CurHeadCol[SRow].VarInitPos:=SRow;

Self. CurHeadCol[SRow].VarInitInRow:=False;

Self. CurHeadCol[SRow].ElmType:=bc_FuncVal;

Self. CurHeadCol[SRow].AsVarName:=sc_Minus+sc_DualTaskVarNameStart+

IntToStr (SRow+1);

End;

{Заповнення імені функції мети:}

Procedure FillHColDFuncName (SRow: Integer);

Begin

Self. CurHeadCol[SRow].VarInitPos:=SRow;

Self. CurHeadCol[SRow].VarInitInRow:=False;

Self. CurHeadCol[SRow].ElmType:=bc_DestFuncToMax;

Self. CurHeadCol[SRow].AsVarName:=sc_DestFuncHdr;

End;

Label LStopLabel;

Begin

FuncCount:=Length(SOptimFuncVals);

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CalculatingNoOptMeasures);

{Таблиця мір неоптимальності квадратна: кількість стовпців рівна

кількості функцій мети; кількість рядків рівна кількості оптимальних

векторів значень змінних для кожної з цих функцій (тобто тій же самій

кількості). Додатково виділимо один стовпець для вільних членів

і один рядок для коефіцієнтів функції мети задачі-інтерпретації

гри двох гравців з нульовою сумою, що буде сформована далі:}

SetLength (Self. CurTable, FuncCount + 1, FuncCount + 1);

{Відповідну довжину задаємо і заголовкам таблиці:}

SetLength (Self. CurHeadCol, FuncCount + 1);

SetLength (Self. CurHeadRow, FuncCount + 1);

{Підраховуємо міри неоптимальності векторів значень змінних для

кожної функції мети, і записуємо їх у таблицю коефіцієнтів –

формуємо матрицю неоптимальності:}

{Шукаємо мінімальну (найбільшу за модулем) міру неоптимальності.

Спочатку за неї беремо міру у верхньому лівому куті матриці:}

MinQ:=CalcQ (SFirstDFuncRow, SOptimXVecs[0], SOptimFuncVals[0]);

Self. CurTable [0, 0]:=MinQ; {записуємо одразу цю міру в матрицю}

For jCol:=0 to FuncCount-1 do

Begin

FuncRow:=SFirstDFuncRow+jCol;

{Комірка [0, 0] вже порахована, її обходимо. Для всіх інших виконуємо:}

For iRow:=Ord (jCol=0) to FuncCount-1 do {Ord (0=0)=1; Ord (<не нуль>=0)=0}

Begin {Підраховуємо міру неоптимальності:}

CurQ:=CalcQ (FuncRow, SOptimXVecs[iRow], SOptimFuncVals[jCol]);

If MinQ>CurQ then MinQ:=CurQ; {шукаємо найбільшу за модулем міру}

Self. CurTable [iRow, jCol]:=CurQ; {записуємо міру в матрицю неоптимальності}

End;

End;

MinQ:=-MinQ; {найбільше абсолютне значення (модуль) усіх мір в матриці}

{Заповнюємо заголовки таблиці (це будуть заголовки задачі ЛП):}

For jCol:=0 to FuncCount-1 do FillHRowVarName(jCol);

For iRow:=0 to FuncCount-1 do FillHColFuncName(iRow);

FillHRowWithNum (FuncCount, 1);

FillHColDFuncName(FuncCount);

{Коефіцієнти функції мети: усі однакові і рівні одиниці (бо

відхилення чи наближення будь-якої з цільових функцій від свого

оптимального значення пропорційно (у відсотках) має однакову ціну):}

For jCol:=0 to FuncCount-1 do Self. CurTable [FuncCount, jCol]:=1;

{Вільні члени: усі рівні одиниці:}

For iRow:=0 to FuncCount-1 do Self. CurTable [iRow, FuncCount]:=1;

{Комірка значення функції мети:}

Self. CurTable [FuncCount, FuncCount]:=0;

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum); {показуємо матрицю}

If Self. Stop then Goto LStopLabel;

{Якщо MinQ=0, то усі міри рівні нулю (бо MinQ тут насправді є

максимальним абсолютним значенням). Якщо кількість функцій мети

багатокритеріальної задачі рівна одній (тобто задача однокритеріальна),

то і міра є лише одна, і для неї MinQ=-q [0,0], тому при додаванні

q [0,0]+MinQ=q [0,0] – q [0,0]=0.

Щоб в обох цих випадках розв'язування симплекс-методом працювало

коректно, замінимо MinQ на інше число:}

If MinQ=0 then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllMeasurIsZero);

MinQ:=1 {одиниця, якщо всі нулі (отримаємо матрицю із одиниць)}

End

Else if Length(SOptimFuncVals)=1 then {якщо всього одна функція мети:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_UniqueMeasureCantSetZero);

MinQ:=MinQ+1; {збільшимо на 1 – отримаємо матрицю з одною одиницею.}

End;

{Додаємо до усіх мір неоптимальності максимальну за модулем, і

отримуємо матрицю коефіцієнтів, до якої можна застосувати

симплекс-метод:}

For iRow:=0 to FuncCount-1 do

For jCol:=0 to FuncCount-1 do

Self. CurTable [iRow, jCol]:=Self. CurTable [iRow, jCol]+MinQ;

LStopLabel:

End;

Procedure TGridFormattingProcs. CalcComprVec (Const SVarVecs:TFloatMatrix;

Const SWeightCoefs:TFloatArr; Var DComprVec:TFloatArr);

{Обчислює компромісний вектор (масив) значень змінних із

із заданих векторів значень і вагових коефіцієнтів для кожного із

цих векторів.

Вхідні дані:

SVarVecs – вектори значень змінних;

SWeightCoefs – вагові коефіцієнти для кожного вектора.

Вихідні дані:

DComprVec – компромісний вектор значень змінних.}

Var VecNum, VarNum: Integer; CurComprVal:TWorkFloat;

Begin

DComprVec:=Nil;

If Length(SVarVecs)<=0 then Exit;

SetLength (DComprVec, Length (SVarVecs[0]));

For VarNum:=0 to Length(DComprVec) – 1 do {для кожної змінної:}

Begin

CurComprVal:=0;

{Множимо значення змінної з кожного вектора на свій ваговий

коефіцієнт, і знаходимо суму:}

For VecNum:=0 to Length(SVarVecs) – 1 do

CurComprVal:=CurComprVal + SVarVecs [VecNum, VarNum]*SWeightCoefs[VecNum];

DComprVec[VarNum]:=CurComprVal;

End;

End;

Function TGridFormattingProcs. CalcDFuncVal (Const SVarVec:TFloatArr;

SDestFuncRowNum: Integer):TWorkFloat;

{Обчислює значення функції мети за заданих значень змінних.

Вхідні дані:

SVarVec – вектор значень змінних (в такому порядку, в якому змінні

йдуть в рядку-заголовку умови багатокритеріальної задачі);

SDestFuncRowNum – номер рядка функції мети в умові задачі у

Self. CopyTable;

Self. CopyTable – матриця коефіцієнтів умови

багатокритеріальної лінійної задачі оптимізації.

Вихідні дані:

Повертає значення функції мети.}

Var VarNum: Integer; FuncVal:TWorkFloat;

Begin

FuncVal:=0;

For VarNum:=0 to Length(SVarVec) – 1 do {для кожної змінної:}

Begin

FuncVal:=FuncVal + SVarVec[VarNum]*Self. CopyTable [SDestFuncRowNum, VarNum];

End;

CalcDFuncVal:=FuncVal;

End;

Function TGridFormattingProcs. SolveMultiCritLTask: Boolean;

{Вирішування задачі багатокритеріальної оптимізації лінійної форми

з використанням теоретико-ігрового підходу.

Умовою задачі є умови-нерівності, рівняння та умови на невід'ємність

окремих змінних, і декілька функцій мети, для яких треба знайти

якомога більші чи менші значення.

Вхідні дані:

Self. CurTable – таблиця коефіцієнтів та вільних членів;

Self. CurHeadRow – рядок-заголовок зі змінними та одиницею-множником

стовпця вільних членів (має бути останнім);

Self. CurHeadCol – стовпець-заголовок з іменами функцій-нерівностей,

нулями (заголовки рядків-рівнянь), іменами функцій мети

(що максимізуються (тип комірки bc_DestFuncToMax) або мінімізуються

(тип bc_DestFuncToMin)).

Функція повертає ознаку успішності вирішування.}

Var Row, CurWidth, CurHeight, FirstDestFuncRow,

DestFuncCount, VarCount: Integer;

Res1: Boolean;

st1: String;

OptimXVecs, DualUVec:TFloatMatrix;

OptimFuncVals, OptGTaskVal, ComprXVec:TFloatArr;

Const sc_CurProcName='SolveMultiCritLTask';

sc_TextMarkRow='############';

Procedure ShowWeightCoefs (Const SCoefs:TFloatArr; FirstDestFuncRow: Integer);

Var i: Integer;

Begin

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_WeightCoefs);

For i:=0 to Length(SCoefs) – 1 do

Begin

{Відображаємо вагові коефіцієнти для кожної з функцій мети

багатокритеріальної задачі:}

Self. CurOutConsole. Lines. Add ('l['+

Self. CopyHeadCol [FirstDestFuncRow+i].AsVarName+'] = '+

FloatToStr (SCoefs[i]));

End;

End;

End;

Procedure ShowComprVarVec (Const ComprXVec:TFloatArr);

Var Col: Integer; st1: String;

Begin

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_ComprVarVals);

For Col:=0 to Length(ComprXVec) – 1 do

Begin

st1:=Self. CopyHeadRow[Col].AsVarName + ' = ';

st1:=st1 + FloatToStr (ComprXVec[Col]);

Self. CurOutConsole. Lines. Add(st1);

End;

End;

End;

Procedure ShowDFuncVals (Const ComprXVec:TFloatArr; FirstDFuncRow: Integer);

Var Row: Integer; st1: String;

Begin

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_DestFuncComprVals);

For Row:=FirstDFuncRow to Length (Self. CopyTable) – 1 do

Begin

st1:=Self. CopyHeadCol[Row].AsVarName + ' = ';

st1:=st1 + FloatToStr (Self. CalcDFuncVal (ComprXVec, Row));

Self. CurOutConsole. Lines. Add(st1);

End;

End;

End;

Label LStopLabel, LFinish;

Begin

Res1:=True; {прапорець успішності}

Self. GetTaskSizes (CurWidth, CurHeight);

If CurWidth<=0 then {Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

Self. WasNoRoots:=True;

SolveMultiCritLTask:=False;

Exit;

End;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add('');

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

End;

{Зберігаємо посилання на масиви умови багатокритеріальної задачі:}

Self. CopyHeadRow:=Self. CurHeadRow;

Self. CopyHeadCol:=Self. CurHeadCol;

Self. CopyTable:=Self. CurTable;

{Шукаємо цільові функції внизу таблиці:}

For Row:=CurHeight-1 downto 0 do

Begin

Case Self. CopyHeadCol[Row].ElmType of

bc_DestFuncToMax:;

bc_DestFuncToMin:;

{Якщо знизу вгору дійшли до рядка, що не є функцією мети – завершуємо:}

Else Break;

End;

End;

If Row>=CurHeight-1 then {якщо рядків функцій мети взагалі немає:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoDestFuncs);

Self. WasNoRoots:=True;

Res1:=False; Goto LFinish;

End

Else if Row<0 then {якщо в таблиці є тільки рядки функцій мети:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_OnlyDestFuncsPresent);

Res1:=False; Goto LFinish;

(* Row:=-1; *)

End;

FirstDestFuncRow:=Row+1; {найвищий у таблиці рядок функції мети}

DestFuncCount:=CurHeight-FirstDestFuncRow; {кількість функцій мети}

{Змінні: усі стовпці окрім останнього (стовпця вільних членів з

одиницею в заголовку):}

VarCount:=CurWidth-1;

{Вектори змінних в оптимальних розв'язках задач:}

SetLength (OptimXVecs, DestFuncCount, VarCount);

{Оптимальні значення функцій (максимальні або мінімальні значення):}

SetLength (OptimFuncVals, DestFuncCount);

{############ Шукаємо min або max кожної функції мети окремо: ############}

For Row:=FirstDestFuncRow to CurHeight-1 do {для усіх функцій мети:}

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_TextMarkRow+sc_CurProcName + sc_ForDestFunc+

sc_DoubleQuot+ Self. CopyHeadCol[Row].AsVarName +sc_DoubleQuot+sc_Space;

If Self. CopyHeadCol[Row].ElmType=bc_DestFuncToMin then

st1:=st1+sc_SearchingMin

Else st1:=st1+sc_SearchingMax;

st1:=st1+sc_TriSpot+sc_TextMarkRow;

Self. CurOutConsole. Lines. Add(st1);

End;

{Формуємо умову однокритеріальної задачі максимізації:}

If Not (Self. PrepareDestFuncInMultiDFuncLTask (Row, FirstDestFuncRow)) then

Begin

Res1:=False; Break;

End;

If Self. Stop then Break;

{Ховаємо розв'язувальну комірку у екранній таблиці (її нема тут):}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

{Відображаємо підготовану однокритеріальну задачу:}

WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum);

If Self. Stop then Break;

{Запускаємо вирішування однокритеріальної задачі максимізації лінійної

форми (так як поточна функція є функцією максимізації, або зведена

до такої):}

Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;

If Not (Self. SolveLTaskToMax(False)) then

Begin

Res1:=False; Break;

End;

{Якщо функція мети необмежена або система умов несумісна:}

If Not (Self. SolWasFound) then

Begin

{Якщо функцій мети більше одної, то так як компромісний вектор

через необмеженість принаймні одної з функцій мети знайти неможливо:}

If (FirstDestFuncRow+1)<CurHeight then Res1:=False

Else Res1:=True;

Goto LFinish;

End;

If Self. Stop then Break;

{Читаємо вектор значень змінних та оптимальне значення функції мети

з таблиці:}

Self. ReadCurFuncSolution (OptimXVecs, OptimFuncVals, Row-FirstDestFuncRow,

False, False);

End;

If Not(Res1) then Goto LFinish;

If Self. Stop then Goto LStopLabel;

{############ Шукаємо міри неоптимальності і будуємо задачу: ############}

{######## пошуку компромісних вагових коефіцієнтів, вирішуємо її: ########}

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_TextMarkRow);

BuildPaymentTaskOfOptim (OptimXVecs, OptimFuncVals, FirstDestFuncRow);

If Self. Stop then Goto LStopLabel;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_TextMarkRow);

{Готуємо задачу до максимізації симплекс-методом:}

Res1:=Self. PrepareDFuncForSimplexMaximize;

If Not(Res1) then Goto LFinish;

{Запускаємо вирішування цієї задачі:}

Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;

{«True» – з відображенням значень двоїстої:}

If Not (Self. SolveLTaskToMax(True)) then

Begin

Res1:=False; Goto LFinish;

End;

{Якщо функція мети необмежена або система умов несумісна:}

If Not (Self. SolWasFound) then

Begin

Res1:=False; Goto LFinish;

End;

If Self. Stop then Goto LStopLabel;

{############ Обчислюємо вагові коефіцієнти: ############}

{Якщо задача-інтерпретація гри вирішена і знайдено оптимальне

значення функції, то читаємо це значення і значення змінних

двоїстої задачі:}

SetLength (OptGTaskVal, 1); {для запису значення функції мети}

SetLength (DualUVec, 1, DestFuncCount); {для запису значень змінних}

Self. ReadCurFuncSolution (DualUVec, OptGTaskVal, 0, False, True);

{Обчислюємо вагові коефіцієнти:}

For Row:=0 to DestFuncCount-1 do

DualUVec [0, Row]:=(DualUVec [0, Row]/OptGTaskVal[0]); {Li=ui/(W(U))}

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_TextMarkRow);

ShowWeightCoefs (DualUVec[0], FirstDestFuncRow);

{############ Обчислюємо компромісний вектор: ############}

Self. CalcComprVec (OptimXVecs, DualUVec[0], ComprXVec);

ShowComprVarVec(ComprXVec);

ShowDFuncVals (ComprXVec, FirstDestFuncRow);

Goto LFinish;

LStopLabel: {Якщо вирішування було перервано:}

{Повертаємо початкову умову на попереднє місце:}

Self. CurHeadRow:=Self. CopyHeadRow;

Self. CurHeadCol:=Self. CopyHeadCol;

Self. CurTable:=Self. CopyTable;

LFinish:

{Обнуляємо посилання на копію умови. Так як це динамічні масиви і

щодо них йде відлік кількості посилань, то для них не створюватимуться

зайві копії у пам'яті, і при роботі з CurHeadRow, CurHeadCol, CurTable

пам'ять буде виділена завжди тільки для їхніх поточних даних:}

Self. CopyHeadRow:=Nil;

Self. CopyHeadCol:=NIl;

Self. CopyTable:=Nil;

SolveMultiCritLTask:=Res1;

End;

Procedure TGridFormattingProcs. ChangeSignsInRow (CurRowNum: Integer);

{Зміна знаків у рядку таблиці і відповідній комірці у стовпці-заголовку.}

Var CurColNum: Integer;

Begin

For CurColNum:=0 to Length (Self. CurHeadRow) – 1 do

CurTable [CurRowNum, CurColNum]:=-CurTable [CurRowNum, CurColNum];

ChangeSignForValOrVarName (Self. CurHeadCol[CurRowNum]);

End;

Procedure TGridFormattingProcs. ChangeSignsInCol (CurColNum: Integer);

{Зміна знаків у стовпці таблиці і відповідній комірці у рядку-заголовку.}

Var CurRowNum: Integer;

Begin

For CurRowNum:=0 to Length (Self. CurHeadCol) – 1 do

CurTable [CurRowNum, CurColNum]:=-CurTable [CurRowNum, CurColNum];

ChangeSignForValOrVarName (Self. CurHeadRow[CurColNum]);

End;

Function TGridFormattingProcs. ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

{Функція переміщує рядки таблиці CurTable (разом із відповідними

комірками у стовпці-заголовку CurHeadCol) з заданими типами комірок

стовпця-заголовка вгору.

Вхідні дані:

SHeadColElmTypes – множина типів комірок, що мають бути переміщені вгору

(у стовпці-заголовку);

ToChangeInitPosNums – вмикач зміни позначок номера по порядку та

позначки розташування в таблиці як рядка чи стовпця.

Якщо рівний True, то рядки при переміщенні змінюють ці позначки

на позначки тих рядків, що були в тих місцях, на які рядки переміщені;

Self. CurTable – таблиця коефіцієнтів;

Self. CurHeadCol – стовпець-заголовок.

Вихідні дані:

Self. CurTable і Self. CurHeadCol – таблиця коефіцієнтів і

стовпець-заголовок з перенесеними вгору рядками і комірками;

функція повертає номер найвищого рядка із тих, що не було задано

переміщувати вгору (вище нього – ті, що переміщені вгору).}

Var HiNotInSetRow, CurRowToUp, CurRowNum: Integer;

Begin

{Номер найвищого рядка, що не є в множині тих, які переміщуються вгору.

Спочатку ставимо тут номер неіснуючого рядка:}

HiNotInSetRow:=-1;

{Йдемо по рядкам згори вниз:}

For CurRowNum:=0 to Length (Self. CurHeadCol) – 1 do

Begin {Шукаємо перший рядок з типом комірки, що не має переміщуватися вгору:}

If Not (Self. CurHeadCol[CurRowNum].ElmType in SHeadColElmTypes) then

Begin

HiNotInSetRow:=CurRowNum;

{шукаємо найнижчий рядок, який портібно переміщувати вгору:}

For CurRowToUp:=Length (Self. CurHeadCol) – 1 downto CurRowNum+1 do

Begin

If Self. CurHeadCol[CurRowToUp].ElmType in SHeadColElmTypes then Break;

End;

{Якщо таких рядків не знайдено, то усі вони вже вгорі:}

If CurRowToUp<=CurRowNum then Break

Else {Міняємо місцями рядок, що має бути вгорі, і рядок, що не має,

але розташований вище:}

ChangeRowsPlaces (Self. CurTable, Self. CurHeadCol, CurRowNum,

CurRowToUp, ToChangeInitPosNums);

End;

End;

ShiftRowsUp:=HiNotInSetRow;

End;

Function TGridFormattingProcs. ShiftRowsDown (

SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

{Функція переміщує рядки таблиці CurTable (разом із відповідними

комірками у стовпці-заголовку CurHeadCol) з заданими типами комірок

стовпця-заголовка вниз.

Вхідні дані:

SHeadColElmTypes – множина типів комірок, що мають бути переміщені вниз

(у стовпці-заголовку);

ToChangeInitPosNums – вмикач зміни позначок номера по порядку та

позначки розташування в таблиці як рядка чи стовпця.

Якщо рівний True, то рядки при переміщенні змінюють ці позначки

на позначки тих рядків, що були в тих місцях, на які рядки переміщені;

Self. CurTable – таблиця коефіцієнтів;

Self. CurHeadCol – стовпець-заголовок.

Вихідні дані:

Self. CurTable і Self. CurHeadCol – таблиця коефіцієнтів і

стовпець-заголовок з перенесеними донизу рядками і комірками;

функція повертає номер найвищого рядка із тих, що переміщені вниз

(вище нього – рядки тих типів, що не було задано переміщувати донизу).}

Var AllOtherHeadTypes:THeadLineElmTypes;

Begin

{Отримуємо протилежну множину типів комірок:}

AllOtherHeadTypes:=[bc_IndependentVar..bc_OtherType] – SHeadColElmTypes;

{Зсуваємо рядки з усіма іншими типами вгору (і рядки з заданими

типами залишаються внизу):}

ShiftRowsDown:=Self. ShiftRowsUp (AllOtherHeadTypes, ToChangeInitPosNums);

End;

Function TGridFormattingProcs. SolveLTaskToMax (DualTaskVals: Boolean):Boolean;

{Вирішування задачі максимізації лінійної форми (що містить умови-

нерівності, рівняння та умови на невід'ємність окремих змінних і

одну функцію мети, для якої треба знайти максимальне значення).

Вхідні дані:

DualTaskVals – вмикач режиму відображення змінних двоїстої задачі

(після завершення розв'язування, якщо оптимальне значення знайдено):

читаються значення змінних і функцій двоїстої задачі. Їхні

значення розміщені не на місці стовпця вільних членів, а у рядку

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

Вихідні дані:

DResult – тип результату вирішування, який досягнутий (у випадку

успішного вирішування);

Функція повертає ознаку успішності вирішування.}

Const sc_CurProcName='SolveLTaskToMax';

Var CurRowNum, CurRow2N, CurColNum: Integer;

HeadRowNum, HeadColNum: Integer;

HiNoIndepRow: Integer;

ColDeleted, RowDeleted, AllExcluded, WasNothingToDo: Boolean;

st1: String;

Procedure SearchMNNCellForCol (CurColNum: Integer;

StartRowNum, EndRowNum: Integer;

Var DRowNum: Integer; AllowNegatCellIfZero: Boolean=False);

{Пошук у стовпці CurColNum комірки з МНВ (мінімального невід'ємного

відношення вільного члена до значення комірки у стовпці).

AllowNegatCellIfZero – дозволити від'ємне значення комірки і при

нульовому вільному члені.}

Var CurRowNum, FoundRow: Integer; MNN, CurRelat:TWorkFloat;

Begin

{Шукаємо МНВ у заданому інтервалі рядків:}

FoundRow:=-1; MNN:=-1;

For CurRowNum:=StartRowNum to EndRowNum do

Begin {Перевірка виконання умов невід'ємного відношення:}

If (CurTable [CurRowNum, CurColNum]<>0) and

(AllowNegatCellIfZero or

(CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<>0) or

(CurTable [CurRowNum, CurColNum]>0)) and

((ValSign (CurTable[CurRowNum, Length (Self. CurHeadRow) – 1])*

ValSign (CurTable[CurRowNum, CurColNum]))>=0) then

Begin

CurRelat:=CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]/

CurTable [CurRowNum, CurColNum];

{Якщо знайшли менше, або знайшли перше значення:}

If (CurRelat<MNN) or (FoundRow=-1) then

Begin

MNN:=CurRelat; FoundRow:=CurRowNum;

End;

End;

End;

If (Self. CurOutConsole<>Nil) and (FoundRow<0) then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoMNN+sc_Space+

IntToStr (CurColNum+1)+sc_Space+sc_TriSpot);

DRowNum:=FoundRow;

End;

Label LStopLabel;

Begin

If Self. TaskWidth<=0 then {Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

SolveLTaskToMax:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_ExcludingFreeVars);

End;

{############## Виключаємо незалежні змінні: ##############}

CurRowNum:=0;

Repeat

WasNothingToDo:=True; AllExcluded:=True;

CurColNum:=0;

While CurColNum<(Length (Self. CurHeadRow) – 1) do {усі стовпці окрім останнього}

Begin

ColDeleted:=False;

{Координати розв'язувальної комірки для помітки кольором в екранній

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Якщо поточна змінна незалежна:}

If Self. CurHeadRow[CurColNum].ElmType=bc_IndependentVar then

Begin {Перевіряємо, чи не дійшли до рядка функції

(або взагалі за низ таблиці):}

If CurRowNum<(Length (Self. CurHeadCol) – 1) then

Begin {якщо рядки для виключення ще залишились:}

{Шукаємо ненульову комірку серед коефіцієнтів поточної

незалежної змінної (окрім останнього рядка, що є

рядком поточної функції мети):}

If SearchNozeroSolveCell (CurRowNum, CurColNum,

Length (Self. CurHeadCol) – 2, Length (Self. CurHeadRow) – 2,

HeadRowNum, HeadColNum, False) then

Begin {якщо змінну можна виключити:}

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRowNum, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

WasNothingToDo:=False;

{Переходимо до наступного рядка, бо даний рядок тепер вже є

рядком виключеної вільної змінної (і змінна виражена як

функція-нерівність):}

Inc(CurRowNum);

End

Else {якщо для незалежної змінної усі коефіцієнти обмежень – нулі}

Begin {то змінна зовсім незалежна:}

{І якщо в рядку функції мети теж нуль, то:}

If Self. CurTable [Length(Self. CurHeadCol) – 1, CurColNum]=0 then

Begin {хоч змінна й незалежна, від неї теж нічого тут не залежить:}

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_FreeVar;

If Self. CurHeadRow[CurColNum].ElmType=bc_Number then

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurColNum].AsNumber)

Else st1:=st1+sc_Space+sc_DoubleQuot+

Self. CurHeadRow[CurColNum].AsVarName+sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Видаляємо стовпець цієї змінної:}

DeleteFromArr (Self. CurHeadRow, CurColNum, 1);

DelColsFromMatr (Self. CurTable, CurColNum, 1);

ColDeleted:=True;

WasNothingToDo:=False;

End

Else AllExcluded:=False; {не усі вільні вдалося виключити}

End;

End

Else AllExcluded:=False; {не усі вільні вдалося виключити}

End;

If Not(ColDeleted) then Inc(CurColNum);

End; {While (CurColNum<(Length (Self. CurHeadRow) – 1)) do…}

Until AllExcluded or WasNothingToDo;

If Not(AllExcluded) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CantExcludeFreeVars);

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Переміщаємо рядки з усіма незалежними змінними вгору:}

HiNoIndepRow:=Self. ShiftRowsUp([bc_IndependentVar], False);

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllFreeVarsExcluded);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Якщо усі рядки є рядками незалежних змінних, то номер найвищого рядка

іншого типу вважаємо нижче таблиці (бо нема таких рядків):}

If HiNoIndepRow<0 then HiNoIndepRow:=Length (Self. CurHeadCol);

{Якщо після виключення незалежних змінних не залишилося рядків, окрім

рядка функції:}

If HiNoIndepRow>=(Length (Self. CurHeadCol) – 1) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoTableAreaToWork);

End;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_ExcludingZeroRows);

{############## Виключаємо 0-рядки. Шукаємо їх: ##############}

CurRowNum:=HiNoIndepRow;

While CurRowNum<=(Length (Self. CurHeadCol) – 2) do

Begin

RowDeleted:=False;

If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRowNum].AsNumber=0 then {якщо знайшли 0-рядок:}

Begin {Для помітки 0-рядка на екранній таблиці:}

Self. CurGridSolveCol:=HeadColNum;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Перевіряємо вільний член рядка, чи він невід'ємний.

Якщо від'ємний, то множимо обидві частини рівняння на -1:}

If CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then

ChangeSignsInRow(CurRowNum);

{Шукаємо у рядку перший додатний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]>0 then Break;

If CurColNum>(Length (Self. CurHeadRow) – 2) then {Якщо усі недодатні:}

Begin

If CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]=0 then

Begin {Якщо вільний член рівний нулю, то помножимо рівняння на -1:}

ChangeSignsInRow(CurRowNum);

{Шукаємо у рядку перший додатний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]>0 then Break;

{Якщо знову додатних нема, значить усі нулі. Видаляємо рядок:}

If CurColNum>(Length (Self. CurHeadRow) – 2) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllZeroInRow+

sc_Space+IntToStr (CurRowNum+1));

DelRowsFromMatr (CurTable, CurRowNum, 1);

DeleteFromArr (Self. CurHeadCol, CurRowNum, 1);

System. Continue; {переходимо одразу до наступного рядка}

End;

End

Else {Якщо вільний член додатній, а коефіцієнти недодатні, то

система несумісна:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+

sc_Space+sc_NoVals);

Self. WasNoRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

End;

{Якщо додатний коефіцієнт у 0-рядку обрано, шукаємо МНВ

(мінімальне невід'ємне серед відношень вільних членів до членів

стовпця, у якому обрали цей коефіцієнт):}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=False; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

If CurRow2N<>CurRowNum then {Якщо виключили не цей 0-рядок:}

System. Continue; {продовжуємо працювати з цим рядком}

End; {If Self. CurHeadCol[CurRowNum].AsNumber=0 then…}

End; {If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then…}

If Not(RowDeleted) then Inc(CurRowNum);

End; {While CurRowNum<=(Length (Self. CurHeadCol) – 2) do…}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllZeroRowsExcluded);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum); {відмічаємо новий крок}

If Self. Stop then Goto LStopLabel;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_SearchingBaseSolve);

{############## Шукаємо опорний розв'язок задачі: ##############}

CurRowNum:=HiNoIndepRow;

While CurRowNum<=(Length (Self. CurHeadCol) – 2) do

Begin

{Якщо знайшли від'ємний елемент у стовпці вільних членів:}

If Self. CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then

Begin

{Для помітки поточного рядка на екранній таблиці:}

Self. CurGridSolveCol:=HeadColNum;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Шукаємо у рядку перший від'ємний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]<0 then Break;

If CurColNum>(Length (Self. CurHeadRow) – 2) then {Якщо усі невід'ємні:}

Begin

{Якщо вільний член від'ємний, а коефіцієнти невід'ємні, то

система несумісна:}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+sc_Space+

sc_NoVals);

Self. WasNoRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Якщо від'ємний коефіцієнт у рядку обрано, шукаємо МНВ

(мінімальне невід'ємне серед відношень вільних членів до членів

стовпця, у якому обрали цей коефіцієнт):}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=False; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

If CurRow2N<>CurRowNum then {Якщо виключили не цей рядок:}

System. Continue; {продовжуємо працювати з цим рядком}

End; {If Self. CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then…}

Inc(CurRowNum);

End; {While CurRowNum<=(Length (Self. CurHeadCol) – 2) do…}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_BaseSolveFound);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum); {відмічаємо новий крок}

If Self. Stop then Goto LStopLabel;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_SearchingOptimSolve);

{############## Шукаємо оптимальний розв'язок задачі: ##############}

CurColNum:=0;

While CurColNum<=(Length (Self. CurHeadRow) – 2) do

Begin

ColDeleted:=False;

{Якщо знайшли від'ємний коефіцієнт у рядку функції мети:}

If CurTable [Length(Self. CurHeadCol) – 1, CurColNum]<0 then

Begin

{Шукаємо МНВ (мінімальне невід'ємне серед відношень вільних членів

до членів стовпця, у якому обрали цей коефіцієнт) серед усіх рядків

умов, окрім рядків вільних змінних і рядка функції мети:}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin {то функція мети не обмежена зверху, максимальне значення безмежне:}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+sc_Space+

sc_UnlimitedFunc);

Self. WasManyRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Обробляємо таблицю модифікованим Жордановим виключенням:}

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

CurColNum:=0; {після виключення могли з'явитися нові від'ємні комірки}

System. Continue;

End;

If Not(ColDeleted) then Inc(CurColNum);

End;

{Якщо назва функції мети вказана зі знаком «–», то це протилежна

функція мети. Змінимо знаки у її рядку, і отримаємо шукану

мінімізацію функції:}

CurRowNum:=Length (Self. CurHeadCol) – 1;

If ValSign (Self. CurHeadCol[CurRowNum])=bc_Negative then

Begin

ChangeSignsInRow(CurRowNum);

Self. CurHeadCol[CurRowNum].ElmType:=bc_DestFuncToMin;

End;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_DoubleSpot+sc_Space+

sc_ValFound);

Self. ShowLTaskResultCalc(DualTaskVals);

Self. SolWasFound:=True;

SolveLTaskToMax:=True;

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum);

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_SolvingStopped);

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

SolveLTaskToMax:=False;

Exit;

End;

procedure TGridFormattingProcs. EditLineEqsOnNewRow (Sender: TObject;

NewRows: array of Integer);

{Підтримує форматування стовпця нумерації таблиці у такому вигляді:

1

2

3

4

5

…

m}

Var CurNum: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewRow<>Nil then Self. OldOnNewRow (Sender, NewRows);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewRows) – 1 do

Begin

{Нумерація з третього рядка, бо два перших – заголовки:}

If NewRows[CurNum]>=(Self.CHeadRowNum+1) then

Begin

CurGrid. Cells [0, NewRows[CurNum]]:=IntToStr (NewRows[CurNum]-

Self.CHeadRowNum);

End;

End;

End;

End;

procedure TGridFormattingProcs. EditLineEqsOnNewCol (Sender: TObject;

NewCols: array of Integer);

{Підтримує форматування рядка нумерації та рядка-заголовка таблиці у

такому вигляді:

1 2 3 4 5… n n+1

x1 x2 x3 x4 x5… xn 1

}

Var CurNum: Integer; CurGrid:TStringGrid;

CurColNumStr: String;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewCol<>Nil then Self. OldOnNewCol (Sender, NewCols);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewCols) – 1 do

Begin

{Заголовки лише для комірок, які можна редагувати:}

If NewCols[CurNum]>=(Self.CHeadColNum+1) then

Begin

CurColNumStr:=IntToStr (NewCols[CurNum] – Self.CHeadColNum);

CurGrid. Cells [NewCols[CurNum], 0]:=CurColNumStr;

{Останній стовпець – числа у правих частинах рівнянь:}

If (NewCols[CurNum]+1)=CurGrid. ColCount then

CurGrid. Cells [NewCols[CurNum], 1]:=sc_RightSideValsHdr

{в усіх інших – коефіцієнти при змінних X1…Xn:}

Else

CurGrid. Cells [NewCols[CurNum], 1]:=sc_XVarName+CurColNumStr;

End;

End;

If Length(NewCols)>0 then

Begin

{Якщо перед оновленими або новими стовпцями були інші стовпці, то

в останному з них оновлюємо підпис: тепер він буде з іменем змінної

(«xn»), а не з іменем стовпця правих частин рівнянь (a).

(Тут покладаємося на те, що номери оновлених стовпців сортовані

за зростанням):}

If NewCols[0]>(Self.CHeadColNum+1) then

CurGrid. Cells [NewCols[0] – 1, 1]:=sc_XVarName+IntToStr (NewCols[0]-

(Self.CHeadColNum+1));

End

Else {Якщо нових стовпців немає (тобто кількість стовпців зменшилася):}

Begin {Оновлюємо підпис останнього стовпця (праві частини рівнянь):}

CurGrid. Cells [CurGrid. ColCount-1, 1]:=sc_RightSideValsHdr;

End;

End;

End;

procedure TGridFormattingProcs. EditLineEqsOnDrawCell (Sender: TObject; ACol,

ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедура виконується при малюванні кожної комірки StringGrid

у режимі набору вхідних даних системи лінійних рівнянь.

Зафарбовує в інший колір останній стовпець – стовпець

правих частин рівнянь.}

Var CurGrid:TStringGrid; SafeBrushColor:TColor;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDrawCell<>Nil then Self. OldOnDrawCell (Sender, ACol, ARow, Rect,

State);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

SafeBrushColor:=CurGrid. Canvas. Brush. Color;

{Комірки останнього стовпця є стовпцем правих сторін рівнянь.

Фарбуємо їх у блакитний колір (окрім комірок заголовка):}

If (ACol>=(CurGrid. ColCount-bc_LineEqM2ColsAfterVars)) and

(Not (gdFixed in State)) then

Begin

CurGrid. Canvas. Brush. Color:=lwc_RightSideColColor;

{Малюємо текст на фоні з кольором Brush:}

CurGrid. Canvas. TextRect (Rect, Rect. Left, Rect. Top,

CurGrid. Cells [ACol, ARow]);

End;

CurGrid. Canvas. Brush. Color:=SafeBrushColor;

End;

End;

procedure TGridFormattingProcs. SolveLineEqsM1OrM2OnDrawCell (Sender: TObject;

ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедура фарбує комірки (їхній фон) таблиці вирішування системи лінійних

рівнянь у стовпці правих частин (вільних членів). У залежності від

методу розв'язання цей стопець може бути першим стовпцем-заголовком

(1-ий спосіб, з отриманням оберненої матриці коефіцієнтів), або останнім

стовпцем (2-ий спосіб, з отриманням нулів у рядку-заголовку і видаленням

стовпців цих нулів).}

Var CurGrid:TStringGrid; SafeBrushColor:TColor; CurColor:TColor;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDrawCell<>Nil then Self. OldOnDrawCell (Sender, ACol, ARow, Rect,

State);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

SafeBrushColor:=CurGrid. Canvas. Brush. Color;

CurColor:=bc_NotColored;

If Not (gdFixed in State) then {якщо комірка не у заголовках StringGrid}

Begin

{У режимі розв'язування способом 1 відмічаємо перший стовпець

кольором, а у режимі способу 2 – відмічаємо останній

(стовпець правих частин – вільних членів):}

If ((Self. CurFormatState=fs_SolvingEqsM1) and

(ACol<(Self.CHeadColNum+bc_LineEqM1ColsBeforeVars))) or

((Self. CurFormatState=fs_SolvingEqsM2) and

(ACol>=(CurGrid. ColCount-bc_LineEqM2ColsAfterVars))) then

CurColor:=lwc_RightSideColColor

{Якщо це комірка коефіцієнта при змінній, і задача у ході вирішування:}

Else if InSolving then

Begin

If Self. CurGridSolveCol=ACol then {якщо це розв'язувальний стовпець:}

Begin

If Self. CurGridSolveRow=ARow then {якщо це розв'язувальна комірка:}

CurColor:=lwc_SolveCellColor

Else CurColor:=lwc_SolveColColor;

End {Якщо це розв'язувальний рядок (але не розв'язувальна комірка):}

Else if Self. CurGridSolveRow=ARow then CurColor:=lwc_SolveRowColor;

End;

End;

If CurColor<>bc_NotColored then {якщо комірку треба пофарбувати:}

Begin {Малюємо текст на фоні з кольором CurColor:}

CurGrid. Canvas. Brush. Color:=CurColor;

CurGrid. Canvas. TextRect (Rect, Rect. Left, Rect. Top,

CurGrid. Cells [ACol, ARow]);

End;

CurGrid. Canvas. Brush. Color:=SafeBrushColor;

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnNewRow (Sender: TObject;

NewRows: array of Integer);

{Процедура працює при виникненні події оновлення рядка чи додавання нового

рядка у GrowingStringGrid.

Підтримує форматування стовпця нумерації і стовпця-заголовка таблиці у

такому вигляді:

1 y1

2 y2

3 y3

4 y4

5 y5

…

m ym

Стовпець-заголовок (нові комірки стовпця-заголовка за змовчуванням

заповнюються значеннями типу «функції-нерівності»).}

Var CurNum, CurTableRow: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewRow<>Nil then Self. OldOnNewRow (Sender, NewRows);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

{Освіжаємо масив стовпця-заголовка відповідно до висоти таблиці:}

UpdateLTaskHeadColToStrGrid (CurGrid, NewRows);

{Відображаємо заголовки оновлених або нових рядків:}

For CurNum:=0 to Length(NewRows) – 1 do

Begin

{Нумерація з першого рядка, що не є рядком заголовків:}

If NewRows[CurNum]>=(Self.CHeadRowNum+1) then

Begin {Нумерація рядків:}

CurGrid. Cells [Self.CHeadColNum-1, NewRows[CurNum]]:=

IntToStr (NewRows[CurNum] – Self.CHeadRowNum);

{Заголовки із масиву стовпця-заголовка:}

CurTableRow:=NewRows[CurNum] – Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

CurGrid. Cells [Self.CHeadColNum, NewRows[CurNum]]:=

GetValOrNameAsStr (Self. CurHeadCol[CurTableRow]);

End;

End;

{Якщо нові або змінені рядки були, то вважаємо таблицю зміненою:}

If Length(NewRows)>0 then Self. CurGridModified:=True;

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnNewCol (Sender: TObject;

NewCols: array of Integer);

{Підтримує форматування рядка нумерації та рядка-заголовка таблиці у

такому вигляді:

1 2 3 4 5… n n+1

y x1 x2 x3 x4… xn 1

}

Var CurNum, CurTableCol: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewCol<>Nil then Self. OldOnNewCol (Sender, NewCols);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

{Освіжаємо масив поміток залежності змінних x:}

Self. UpdateLTaskHeadRowToStrGrid(CurGrid);

{Відображаємо заголовки оновлених або нових стовпців:}

For CurNum:=0 to Length(NewCols) – 1 do

Begin

{Заголовки лише для комірок, які можна редагувати:}

If NewCols[CurNum]>=Self.CHeadColNum then

Begin {Нумерація стовпців:}

CurGrid. Cells [NewCols[CurNum], Self.CHeadRowNum-1]:=

IntToStr (NewCols[CurNum] – Self.CHeadColNum);

{Заголовки із масиву рядка-заголовка:}

CurTableCol:=NewCols[CurNum] – Self.CHeadColNum-bc_LTaskColsBeforeVars;

CurGrid. Cells [NewCols[CurNum], Self.CHeadRowNum]:=

GetValOrNameAsStr (Self. CurHeadRow[CurTableCol]);

End;

End;

If Length(NewCols)>0 then

Begin

{Якщо нові або змінені стовпці були, то вважаємо таблицю зміненою:}

Self. CurGridModified:=True;

{Якщо перед оновленими або новими стовпцями були інші стовпці, то

в останному з них оновлюємо підпис: тепер він буде з іменем змінної

(«xn») або, якщо це перший стовпець-то з підписом стовпця імен

функцій та констант рівнянь.

(Тут покладаємося на те, що номери оновлених стовпців сортовані

за зростанням):}

If NewCols[0]>Self.CHeadColNum+bc_LTaskColsBeforeVars then

Begin

CurTableCol:=NewCols[0] – 1-Self.CHeadColNum-bc_LTaskColsBeforeVars;

CurGrid. Cells [NewCols[0] – 1, Self.CHeadRowNum]:=

GetValOrNameAsStr (Self. CurHeadRow[CurTableCol]);

End;

End

Else {Якщо нових стовпців нема (кількість стовпців зменшилася):}

{відображаємо останню (найправішу) комірку}

CurGrid. Cells [CurGrid. ColCount-1, 1]:=

GetValOrNameAsStr (Self. CurHeadRow [CurGrid. ColCount-1-

Self.CHeadColNum-bc_LTaskColsBeforeVars]);

End;

End;

procedure TGridFormattingProcs. NumerationOnNewRow (Sender: TObject;

NewRows: array of Integer);

{Процедура працює при виникненні події оновлення рядка чи додавання нового

рядка у GrowingStringGrid.

Підтримує форматування стовпця нумерації таблиці у

такому вигляді:

1

2

3

4

5

…

m}

Var CurNum: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewRow<>Nil then Self. OldOnNewRow (Sender, NewRows);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewRows) – 1 do

Begin

{Нумерація з першого рядка, що не є рядком заголовків

GrowingStringGrid:}

If NewRows[CurNum]>=(Self.CHeadRowNum+1) then

CurGrid. Cells [0, NewRows[CurNum]]:=

IntToStr (NewRows[CurNum] – Self.CHeadRowNum);

End; {For CurNum:=0 to Length(NewRows) – 1 do…}

End; {If Sender is TStringGrid then…}

End;

procedure TGridFormattingProcs. NumerationOnNewCol (Sender: TObject;

NewCols: array of Integer);

{Процедура працює при виникненні події оновлення чи додавання нового

стовпця у GrowingStringGrid.

Підтримує форматування рядка нумерації таблиці у такому вигляді:

1 2 3 4 5… n}

Var CurNum: Integer; CurGrid:TStringGrid;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnNewCol<>Nil then Self. OldOnNewCol (Sender, NewCols);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

For CurNum:=0 to Length(NewCols) – 1 do

Begin

{Заголовки лише для нефіксованих комірок:}

If NewCols[CurNum]>=(Self.CHeadColNum+1) then

CurGrid. Cells [NewCols[CurNum], 0]:=

IntToStr (NewCols[CurNum] – Self.CHeadColNum);

End;

End;

End;

Procedure TGridFormattingProcs. UpdateLTaskHeadRowToStrGrid (SGrid:TStringGrid);

{Процедура для підтримки масиву рядка-заголовка під час редагування

таблиці. Встановлює довжину масиву відповідно до ширини екранної таблиці

і координат вписування в неї таблиці задачі, заповнює нові комірки

значеннями за змовчуванням, а також змінює останню комірку перед новими.}

Var CurLTaskVarCount, OldCount, CurVarMark: Integer;

Begin

{Кількість стовпців для коефіцієнтів змінних у таблиці:}

CurLTaskVarCount:=SGrid. ColCount-Self.CHeadColNum-

bc_LTaskColsBeforeVars {-bc_LTaskColsAfterVars};

{Якщо таблиця має надто малу ширину, то нічого тут не робимо:}

If CurLTaskVarCount<0 then Exit;

{Масив видовжуємо до кількості стовпців у StringGrid, у яких

редагуємо коєфіцієнти при змінних:}

OldCount:=Length (Self. CurHeadRow);

If OldCount<>CurLTaskVarCount then

Begin

SetLength (Self. CurHeadRow, CurLTaskVarCount); {змінюємо довжину}

{Заповнюємо нові елементи масиву значеннями за змовчуванням:

вільні змінні:}

For CurVarMark:=OldCount to CurLTaskVarCount-2 do

Begin

Self. CurHeadRow[CurVarMark].ElmType:=bc_IndependentVar;

Self. CurHeadRow[CurVarMark].VarInitInRow:=True;

Self. CurHeadRow[CurVarMark].VarInitPos:=CurVarMark;

Self. CurHeadRow[CurVarMark].AsVarName:=sc_XVarName+IntToStr (CurVarMark+1);

End;

{Останній елемент є числом, а не змінною: це множник стовпця

вільних членів (правих частин):}

If CurLTaskVarCount>0 then

Begin

Self. CurHeadRow [CurLTaskVarCount-1].ElmType:=bc_Number;

Self. CurHeadRow [CurLTaskVarCount-1].AsNumber:=1;

{Колишній останній елемент тепер буде змінною:}

If (OldCount>0) and (OldCount<CurLTaskVarCount) then

Begin

Self. CurHeadRow [OldCount-1].ElmType:=bc_IndependentVar;

Self. CurHeadRow [OldCount-1].AsVarName:=sc_XVarName+IntToStr(OldCount)

End;

End;

End;

End;

Procedure TGridFormattingProcs. UpdateLTaskHeadColToStrGrid (SGrid:TStringGrid;

NewRows: array of Integer);

{Процедура для підтримки масиву стовпця-заголовка під час редагування

таблиці. Встановлює довжину масиву відповідно до висоти екранної таблиці

і координат вписування в неї таблиці задачі, заповнює нові комірки

значеннями за змовчуванням.

Вхідні дані:

SGrid – екранна таблиця, під яку треба настроїти масив;

NewRows – масив номерів рядків таблиці, що були додані чи змінені

(що зазнали змін з часу останнього виклику цієї процедури під час

редагування).}

Var CurHeight, OldHeight, CurRow: Integer;

Procedure FillWithDefVal (SElmNum: Integer);

Begin

Self. CurHeadCol[SElmNum].ElmType:=bc_FuncVal;

Self. CurHeadCol[SElmNum].VarInitInRow:=False;

Self. CurHeadCol[SElmNum].VarInitPos:=SElmNum;

Self. CurHeadCol[SElmNum].AsVarName:=sc_YFuncName+

IntToStr (SElmNum+1);

End;

Begin {Висота таблиці за поточною висотою екранної таблиці:}

CurHeight:=SGrid. RowCount-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

OldHeight:=Length (Self. CurHeadCol); {попередня висота таблиці}

If (OldHeight<>CurHeight) and (CurHeight>=0) then

Begin

{Змінюємо довжину масиву стовпця-заголовка:}

SetLength (Self. CurHeadCol, CurHeight);

For CurRow:=OldHeight to CurHeight-1 do

FillWithDefVal(CurRow); {заповнюємо нові комірки за змовчуванням}

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnDrawCell (Sender: TObject; ACol,

ARow: Integer; Rect: TRect; State: TGridDrawState);

{Процедура виконується при малюванні кожної комірки StringGrid.

Зафарбовує в інший колір фону комірок:

– перший стовпець комірок (стовпець-заголовок таблиці задачі лінійного

програмування). Комірки цього стовпця зафарбовуються відповідно до типів

елементів у масиві стовпця-заголовка (якщо цей масив створений для цих

комірок, інакше – за змовчуванням: кольором назв функцій умов-нерівностей,

і найнижчу комірку – кольором для назви функції мети);

– останній стовпець (стовпець значень правих сторін рівнянь або

нерівностей та комірка значення цільової функції);

– найнижчий рядок (рядок коефіцієнтів цільової функції);

– відмічає кольором комірки-заголовки стовпців коефіцієнтів змінних

за відмітками про залежність змінних (рядок-заголовок таблиці задачі ЛП).}

Var CurGrid:TStringGrid; SafeBrushColor:TColor;

CurVarColState:THeadLineElmType; CurColor:TColor;

ArrRowNum: Integer;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDrawCell<>Nil then Self. OldOnDrawCell (Sender, ACol, ARow, Rect,

State);

ArrRowNum:=ARow – (Self.CHeadRowNum+bc_LTaskRowsBeforeVars);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

SafeBrushColor:=CurGrid. Canvas. Brush. Color;

CurColor:=bc_NotColored;

{Комірки останнього стовпця є стовпцем правих сторін рівнянь.

Фарбуємо їх у блакитний колір (окрім комірок заголовків):}

If Not (gdFixed in State) then {якщо комірка не у заголовках StringGrid}

Begin

If ACol>=(CurGrid. ColCount-bc_LTaskColsAfterVars) then {останні стовпці:}

Begin

{Якщо це комірка значення цільової функції – для неї свій колір:}

Case Self. CurHeadCol[ArrRowNum].ElmType of

bc_DestFuncToMax: CurColor:=lwc_DestFuncValColor;

bc_DestFuncToMin: CurColor:=lwc_DestFuncValColor;

Else CurColor:=lwc_RightSideColColor;

End;

End

Else if ACol<(Self.CHeadColNum+bc_LTaskColsBeforeVars) then

Begin {Якщо перші стовпці (стовпець-заголовок):}

{Якщо для цієї комірки задано елемент у масиві стовпця-заголовка,

то фарбуємо її залежно від типу цього елемента:}

If Length (Self. CurHeadCol)>

(ARow – (Self.CHeadRowNum + bc_LTaskRowsBeforeVars)) then

Begin {Тип елемента у комірці:}

CurVarColState:=Self. CurHeadCol [ARow – (Self.CHeadRowNum+

bc_LTaskRowsBeforeVars)].ElmType;

CurColor:=GetColorByElmType(CurVarColState); {колір за типом}

End

Else {Якщо масив стовпця-заголовка не визначено для комірки –

фарбуємо за змовчуванням – як назву функції умови-нерівності:}

CurColor:=lwc_HeadColColor;

End {Якщо рядок коефіцієнтів при змінних цільової функції:}

Else if (Self. CurHeadCol[ArrRowNum].ElmType=bc_DestFuncToMax) or

(Self. CurHeadCol[ArrRowNum].ElmType=bc_DestFuncToMin) then

Begin

{Якщо рядок функції виділений, то виділяємо кольором:}

If InSolving and (Self. CurGridSolveRow=ARow) then

CurColor:=lwc_SolveRowColor

Else CurColor:=lwc_FuncRowColor; {інакше – колір рядка функції мети}

End {Якщо це розв'язувальна комірка, чи рядок або стовпець з такою

коміркою, і треба відображати хід вирішування задачі:}

Else if InSolving then

Begin

If Self. CurGridSolveCol=ACol then {якщо це розв'язувальний стовпець:}

Begin

If Self. CurGridSolveRow=ARow then {якщо це розв'язувальна комірка:}

CurColor:=lwc_SolveCellColor

Else CurColor:=lwc_SolveColColor;

End {Якщо це розв'язувальний рядок (але не розв'язувальна комірка):}

Else if Self. CurGridSolveRow=ARow then CurColor:=lwc_SolveRowColor;

End;

End;

{Зафарбовуємо комірки-заголовки стовпців коефіцієнтів при змінних

відповідно до масиву поміток про залежність:}

If (ARow=Self.CHeadRowNum) and

(Not (ACol<(Self.CHeadColNum+bc_LTaskColsBeforeVars))) then

Begin

CurVarColState:=Self. CurHeadRow [ACol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType;

CurColor:=GetColorByElmType(CurVarColState)

End;

If CurColor<>bc_NotColored then {якщо комірку треба пофарбувати:}

Begin {Малюємо текст на фоні з кольором CurColor:}

CurGrid. Canvas. Brush. Color:=CurColor;

CurGrid. Canvas. TextRect (Rect, Rect. Left, Rect. Top,

CurGrid. Cells [ACol, ARow]);

End;

CurGrid. Canvas. Brush. Color:=SafeBrushColor;

End;

End;

procedure TGridFormattingProcs. EdLineTaskOnDblClick (Sender: TObject);

{Процедура реагує на подвійне натискання лівою кнопкою миші на

комірки рядка-заголовка таблиці (другий рядок StringGrid).

Редагує масив позначок про обрані стовпці (SipmlexVarsDependencyRec)

залежних змінних. Залежні змінні – це змінні, для яких є умова

невід'ємності. Тобто вони не повинні бути менше нуля.}

Var CurGrid:TStringGrid; CurCol, CurRow: Integer;

MouseCoordsInGrid:TPoint;

Begin

If Sender=Nil then Exit;

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnDblClick<>Nil then Self. OldOnDblClick(Sender);

If Sender is TStringGrid then

Begin

CurGrid:=TStringGrid(Sender);

{Пробуємо узнати, на яку комірку двічі натиснула миша:}

MouseCoordsInGrid:=CurGrid. ScreenToClient (Mouse. CursorPos);

CurCol:=-1; CurRow:=-1;

CurGrid. MouseToCell (MouseCoordsInGrid.X, MouseCoordsInGrid.Y, CurCol, CurRow);

{Якщо натиснуто на комірку-заголовок стовпця коефіцієнтів при змінній, то:}

If ((CurCol>=(Self.CHeadColNum+bc_LTaskColsBeforeVars)) and

(CurCol<(CurGrid. ColCount-bc_LTaskColsAfterVars))) and

(CurRow=Self.CHeadRowNum) then

Begin

{Змінюємо ознаку залежності відповідної змінної:}

If CurHeadRow [CurCol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType=bc_IndependentVar then

CurHeadRow [CurCol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType:=bc_DependentVar

Else

CurHeadRow [CurCol – Self.CHeadColNum-

bc_LTaskColsBeforeVars].ElmType:=bc_IndependentVar;

{Задаємо перемалювання комірок, щоб відобразилася зміна позначки

для змінної:}

CurGrid. Invalidate;

End;

End;

End;

Procedure TGridFormattingProcs. InitGridPopupMenu (SGrid:TStringGrid);

{Процедура перевіряє наявність об'єкта TPopupMenu. Якщо його немає

(SGrid. PopupMenu=Nil), то створює новий.

Видаляє усі пунтки (елементи, теми) з меню.}

Begin

If SGrid. PopupMenu=Nil then

Begin

SGrid. PopupMenu:=TPopupMenu. Create(Application);

End;

SGrid. PopupMenu. AutoPopup:=False;

SGrid. PopupMenu. Items. Clear;

End;

Procedure TGridFormattingProcs. ProcOnCellTypeSelInMenu (Sender: TObject);

{Обробник вибору пункту в меню типів для комірки

рядка – чи стовпця-заголовка.}

Const sc_CurProcName='ProcOnCellTypeSelInMenu';

Procedure ReportUnsupportedCell;

Begin

{Відображає координати комірки з повідомленням про те, що вона

не підтримується:}

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoCellOrNotSupported+

' ['+IntToStr (Self. CurGridSolveCol)+';'+IntToStr (Self. CurGridSolveRow)+

']… ');

End;

End;

Var CurMenuItem:TMenuItem; TypeForCell:THeadLineElmType;

Begin

If (Sender=Nil) or (Not (Sender is TMenuItem)) then

Begin

If Self. MemoForOutput<>Nil then

Self. MemoForOutput. Lines. Add (sc_CurProcName + sc_CantDetMenuItem);

Exit;

End;

{Читаємо тип, що обраний для комірки:}

CurMenuItem:=TMenuItem(Sender);

TypeForCell:=THeadLineElmType (CurMenuItem. Tag);

If (Self. CurGridSolveCol<0) and (Self. CurGridSolveRow<0) then

Begin {якщо комірка вище чи лівіше заголовків таблиці:}

ReportUnsupportedCell; Exit;

End;

{Перевіряємо координати комірки і змінюємо її тип:}

{координати комірки мають бути записані у CurGridSolveRow і CurGridSolveCol:}

If Self. CurGridSolveRow=-bc_LTaskRowsBeforeVars then

Begin {якщо це комірка рядка-заголовка:}

If Length (Self. CurHeadRow)>Self. CurGridSolveCol then {якщо комірка існує:}

Begin {задаємо тип комірки:}

Self. CurHeadRow [Self. CurGridSolveCol].ElmType:=TypeForCell;

End

Else {якщо в рядку-заголовку немає такої комірки:}

Begin

ReportUnsupportedCell; Exit;

End;

End

Else if Self. CurGridSolveCol=-bc_LTaskColsBeforeVars then

Begin {якщо це комірка стовпця-заголовка:}

If Length (Self. CurHeadCol)>Self. CurGridSolveRow then {якщо комірка існує:}

Begin {задаємо тип комірки:}

Self. CurHeadCol [Self. CurGridSolveRow].ElmType:=TypeForCell;

End

Else {якщо в стовпці-заголовку немає такої комірки:}

Begin

ReportUnsupportedCell; Exit;

End;

End

Else {якщо комірка у таблиці коефіцієнтів або правіше чи нижче неї:}

Begin

ReportUnsupportedCell; Exit;

End;

{Якщо тип комірки змінено, то перемальовуємо екранну таблицю для

відображення нового типу комірки:}

If Self. CurGrid<>Nil then Self. CurGrid. Invalidate;

End;

Procedure TGridFormattingProcs. AddCellTypeItemToMenu (SMenu:TPopupMenu;

SCaption: String; IsCurrentItem: Boolean; SAssocType:THeadLineElmType;

ToSetReactOnClick: Boolean=True);

{Додає пункт меню для вибору типу комірки в таблиці з заданим

написом SCaption і кругом того кольору, що асоційований з даним

типом SAssocType. Для нового пункту меню настроює виклик процедури обробки

комірки для задавання їй обраного типу SAssocType. Значення SAssocType

записує у поле Tag об'єкта пункту меню.

Вхідні дані:

SMenu – контекстне меню для комірки, що формується;

SCaption – підпис для пункту меню (назва типу комірки);

IsCurrentItem – ознака того, що даний пункт меню має бути поточним

(ввімкненим, відміченим) – що це поточний тип комірки;

SAssocType – тип комірки, що прив'язаний до цього пункта меню, і буде

присвоєний комірці при виборі цього пункту;

ToSetReactOnClick – вмикач настройки виклику процедури задавання нового

типу комірки (при виборі елемента меню). При ToSetReactOnClick=False

це не виконується, і натискання елемента меню не викликає ніяких дій.}

Var CurMenuItem:TMenuItem;

SAssocColor:TColor;

Begin

If SMenu=Nil then Exit; {якщо меню не задано – елемент не додаємо в нього}

{Створюємо новий тункт меню:}

CurMenuItem:=TMenuItem. Create(Application);

{Отримуємо колір для даного типу комірки:}

SAssocColor:=Self. GetColorByElmType(SAssocType);

{Біля тексту малюємо круг такого кольору, який асоційований

з типом комірки, і буде присвоєний їй у разі вибору цього пунтку

меню:}

CurMenuItem. Bitmap. Height:=bc_MenuItemColorCircleDiameter;

CurMenuItem. Bitmap. Width:=bc_MenuItemColorCircleDiameter;

CurMenuItem. Bitmap. Canvas. Pen. Color:=SAssocColor;

CurMenuItem. Bitmap. Canvas. Brush. Color:=SAssocColor;

CurMenuItem. Bitmap. Canvas. Ellipse (CurMenuItem. Bitmap. Canvas. ClipRect);

{0 – картинка задана у самому об'єкті, а не в SMenu. Images:}

CurMenuItem. ImageIndex:=0;

CurMenuItem. RadioItem:=True; {промальовувати перемикач, якщо не буде картинки}

{Текст пункту меню:}

CurMenuItem. Caption:=SCaption;

CurMenuItem. Checked:=IsCurrentItem;

If ToSetReactOnClick then {якщо обробка вибору елемента меню ввімкнена}

Begin

{Тип для комірки у випадку вибору цього пунтку меню:}

CurMenuItem. Tag:=Integer(SAssocType);

{Процедура-обробник вибору пункта меню:}

CurMenuItem. OnClick:=Self. ProcOnCellTypeSelInMenu;

CurMenuItem. AutoCheck:=True;

End;

SMenu. Items. Add(CurMenuItem);

End;

(* {Ідентифікатор для типу елемента масиву чисел та імен змінних.

Типи змінних: залежні, незалежні, функції (умови-нерівності).

Залежні змінні – це змінні, для яких діє умова невід'ємності:}

THeadLineElmType=(bc_IndependentVar, bc_DependentVar, bc_FuncVal, bc_Number,

bc_DestFuncToMax);} *)

procedure TGridFormattingProcs. EdLineTaskOnMouseUp (Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

{Процедура реагує на відпускання правої кнопки миші на

комірках рядка-заголовка та стовпця-заголовка таблиці.

Формує та відкриває контекстне меню для вибору типу комірки із можливих

типів для цієї комірки.}

Const sc_CurProcName='EdLineTaskOnMouseUp';

Var CurCol, CurRow, ArrayRow, ArrayCol: Integer; CurElmType:THeadLineElmType;

MouseScrCoords:TPoint;

Begin

{Якщо до вмикання форматування був якийсь обробник події, запускаємо його:}

If @Self. OldOnMouseUp<>Nil then Self. OldOnMouseUp (Sender, Button, Shift, X, Y);

If Sender=Nil then Exit;

{Якщо задано екранну таблицю даного об'єкта TGridFormattingProcs:}

If Sender = Self. CurGrid then

Begin

If Button=mbRight then {якщо була відпущена права кнопка миші}

Begin

{Пробуємо узнати, на яку комірку натиснула миша:}

CurCol:=-1; CurRow:=-1;

Self. CurGrid. MouseToCell (X, Y, CurCol, CurRow);

MouseScrCoords:=Self. CurGrid. ClientToScreen (Point(X, Y));

{Координати комірки у масивах таблиці і її заголовків:}

ArrayRow:=CurRow-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;

ArrayCol:=CurCol-Self.CHeadColNum-bc_LTaskColsBeforeVars;

{Якщо натиснуто на комірку рядка-заголовка:}

If (CurRow=Self.CHeadRowNum) and (ArrayCol>=0) and

(ArrayCol<Length (Self. CurHeadRow)) then

Begin {очищаємо меню перед заповненням:}

Self. InitGridPopupMenu (Self. CurGrid);

{Якщо в екранній таблиці були зміни з часу останнього її читання,

то читаємо комірку, для якої треба сформувати меню:}

If Self. CurGridModified then Self. ReadHeadRowCell(ArrayCol);

{Читаємо поточний тип комірки:}

CurElmType:=Self. CurHeadRow[ArrayCol].ElmType;

{Додаємо пункти меню:}

{Якщо в комірці число-то тип комірки може бути тільки числовий:}

If CurElmType=bc_Number then

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_ValInHeadColOrRow, True, CurElmType)

Else {якщо в комірці не число:}

Begin

{незалежна змінна:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_IndependentVar,

CurElmType = bc_IndependentVar, bc_IndependentVar);

{залежна змінна:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_DependentVar,

CurElmType = bc_DependentVar, bc_DependentVar);

End;

End

Else If (CurCol=Self.CHeadColNum) and (ArrayRow>=0) and

(ArrayRow<Length (Self. CurHeadCol)) then

Begin {якщо натиснуто на комірку стовпця-заголовка:}

Self. InitGridPopupMenu (Self. CurGrid);

{Якщо в екранній таблиці були зміни з часу останнього її читання,

то читаємо комірку, для якої треба сформувати меню:}

If Self. CurGridModified then Self. ReadHeadColCell(ArrayRow);

{Читаємо поточний тип комірки:}

CurElmType:=Self. CurHeadCol[ArrayRow].ElmType;

{Додаємо пункти меню:}

{Якщо в комірці число-то тип комірки може бути тільки числовий:}

If CurElmType=bc_Number then

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_ValInHeadColOrRow, True, CurElmType)

Else {якщо в комірці не число:}

Begin

{назва фінкції – рядка нерівності:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_InequalFuncName, CurElmType = bc_FuncVal, bc_FuncVal);

{назва функції мети, що максимізується:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_DestFuncToMaxName, CurElmType = bc_DestFuncToMax,

bc_DestFuncToMax);

{назва функції мети, що мінімізується:}

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_DestFuncToMinName, CurElmType = bc_DestFuncToMin,

bc_DestFuncToMin);

End;

End

Else {якщо для даної комірки вибір типу не передбачено}

Begin {ставимо в меню координати комірки

(щоб користувач взагалі помітив, що меню є…)}

Self. InitGridPopupMenu (Self. CurGrid);

Self. AddCellTypeItemToMenu (Self. CurGrid. PopupMenu,

sc_Row+sc_DoubleSpot+sc_Space+IntToStr (ArrayRow+1)+sc_KrKm+

sc_Space+sc_Col+sc_DoubleSpot+sc_Space+IntToStr (ArrayCol+1),

True, bc_OtherType);

End;

{Записуємо координати комірки для обробника вибору типу з меню:}

Self. CurGridSolveCol:=ArrayCol;

Self. CurGridSolveRow:=ArrayRow;

{Відображаємо меню:}

Self. CurGrid. PopupMenu. Popup (MouseScrCoords.X, MouseScrCoords.Y);

End; {If Button=mbRight then…}

End {If Sender = Self. CurGrid then…}

Else {якщо обробник викликала «чужа» таблиця або невідомий об'єкт:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_UnknownObjectCall+

sc_DoubleQuot+Sender. ClassName+sc_DoubleQuot);

End;

End;

procedure TGridFormattingProcs. ReactOnSetEditText (Sender: TObject; ACol,

ARow: Longint; const Value: string);

{Процедура для реагування на редагування вмісту комірок

під час редагування вхідних даних. Встановлює прапорець

CurGridModified:=True про те, що екранна таблиця має зміни.}

Begin

{Старий обробник теж викликаємо, якщо він є:}

If @Self. OldOnSetEditText<>Nil then

Self. OldOnSetEditText (Sender, ACol, ARow, Value);

Self. CurGridModified:=True;

End;

Procedure TGridFormattingProcs. SetNewState (Value:TTableFormatState);

Const sc_CurProcName='SetNewState';

Var StateSafe:TTableFormatState;

OldHColPos, OldHRowPos: Integer;

{Процедура для зміни режиму форматування GrowingStringGrid}

Procedure GoSolveLTask;

Begin {Вирішування задачі ЛП симплекс-методом:}

CurGrid. ColCount:=bc_FixedCols+1;

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

If Not (Self. PrepareToSolveLTask) then

Begin {Якщо не вдається підготувати таблицю до вирішування задачі:}

StateSafe:=Self. CurFormatState;

{Перемикаємо на режим fs_NoFormatting, і назад у поточний,

щоб встановити усі настройки цього режиму (повернутися до них):}

Self. TableFormatState:=fs_NoFormatting;

Self. TableFormatState:=StateSafe;

Exit;

End;

CurGrid. OnNewCol:=NumerationOnNewCol;

CurGrid. OnNewRow:=NumerationOnNewRow;

CurGrid. OnDrawCell:=EdLineTaskOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

CurGrid. OnSetEditText:=OldOnSetEditText;

{Вимикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options – [goEditing];

End;

Begin

If InSolving then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CantChangeStateInSolving);

Exit;

End;

If Self. CurGrid=Nil then {Якщо екранну таблицю не задано:}

Begin {запам'ятовуємо поточний режим, і більше нічого не робимо тут:}

Self. CurFormatState:=Value; Exit;

End;

{Якщо задано новий режим:}

If Self. CurFormatState<>Value then

Begin {Якщо форматування було вимкнене:}

If Self. CurFormatState=fs_NoFormatting then

Begin {Запам'ятовуємо обробники подій, які замінимо на свої

форматувальники:}

OldOnNewCol:=CurGrid. OnNewCol;

OldOnNewRow:=CurGrid. OnNewRow;

OldOnDrawCell:=CurGrid. OnDrawCell;

OldOnDblClick:=CurGrid. OnDblClick;

OldOnSetEditText:=CurGrid. OnSetEditText;

OldOnMouseUp:=CurGrid. OnMouseUp;

End;

{Якщо таблиця редагована, то приймаємо останні зміни перед

зміною режиму:}

If Self. CurGridModified then Self. Refresh;

Case Value of

fs_EnteringEqs: {редагування таблиці системи лінійних рівнянь:}

Begin

{Встановлюємо потрібну кількість рядків і стовпців екранної

таблиці для фіксованих заголовків («тільки для читання»).

Для цього забезпечуємо щоб кількість рядків і стовпців не була

меншою за потрібну кількість фіксованих, плюс хоч один

стовпець / рядок (хоч одна комірка) для редагування:}

If CurGrid. ColCount<bc_FixedCols+1 then

CurGrid. ColCount:=bc_FixedCols+1;

If CurGrid. RowCount<bc_FixedRows+1 then

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Позиціювання таблиці до зміни режиму:}

OldHColPos:=Self.CHeadColNum; OldHRowPos:=Self.CHeadRowNum;

{Позиціювання відображення таблиці у даному режимі редагування:}

Self.CHeadColNum:=CurGrid. FixedCols-1;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Якщо позиціювання змінилося, то відображаємо таблицю

в новому місці:}

If (OldHColPos<>Self.CHeadColNum) or

(OldHRowPos<>Self.CHeadRowNum) then Self. Refresh;

CurGrid. OnNewCol:=EditLineEqsOnNewCol;

CurGrid. OnNewRow:=EditLineEqsOnNewRow;

CurGrid. OnDrawCell:=EditLineEqsOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

{Вмикаємо можливість редагування:}

CurGrid. Options:=CurGrid. Options+[goEditing];

CurGrid. OnSetEditText:=ReactOnSetEditText;

InSolving:=False;

End;

fs_EnteringLTask:

Begin {Редагування таблиці задачі ЛП (максимізації/мінімізації):}

{Встановлюємо потрібну кількість рядків і стовпців екранної

таблиці для фіксованих заголовків («тільки для читання»).

Для цього забезпечуємо щоб кількість рядків і стовпців не була

меншою за потрібну кількість фіксованих, плюс хоч один

стовпець / рядок (хоч одна комірка) для редагування:}

If CurGrid. ColCount<bc_FixedCols+1 then

CurGrid. ColCount:=bc_FixedCols+1;

If CurGrid. RowCount<bc_FixedRows+1 then

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Позиціювання таблиці до зміни режиму:}

OldHColPos:=Self.CHeadColNum; OldHRowPos:=Self.CHeadRowNum;

{Позиціювання відображення таблиці у даному режимі редагування:}

Self.CHeadColNum:=CurGrid. FixedCols-1 + bc_LTaskColsBeforeVars;

Self.CHeadRowNum:=CurGrid. FixedRows-1;

{Якщо позиціювання змінилося, то відображаємо таблицю

в новому місці:}

If (OldHColPos<>Self.CHeadColNum) or

(OldHRowPos<>Self.CHeadRowNum) then Self. Refresh;

CurGrid. OnNewCol:=EdLineTaskOnNewCol;

CurGrid. OnNewRow:=EdLineTaskOnNewRow;

CurGrid. OnDrawCell:=EdLineTaskOnDrawCell;

CurGrid. OnDblClick:=EdLineTaskOnDblClick;

CurGrid. OnMouseUp:=EdLineTaskOnMouseUp;

{Вмикаємо можливість редагування:}

CurGrid. Options:=CurGrid. Options+[goEditing];

CurGrid. OnSetEditText:=ReactOnSetEditText;

InSolving:=False;

End;

fs_SolvingEqsM1: {вирішування системи лінійних рівнянь способом 1:}

Begin

CurGrid. ColCount:=bc_FixedCols+1;

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Пробуємо підготувати таблицю до вирішування. Якщо не

вдається, то залишаємось у режимі, який був до спроби його

змінити:}

If Not (Self. PrepareToSolveEqsWithM1) then

Begin

StateSafe:=Self. CurFormatState;

{Перемикаємо на режим fs_NoFormatting, і назад у поточний,

щоб встановити усі настройки цього режиму:}

Self. TableFormatState:=fs_NoFormatting;

Self. TableFormatState:=StateSafe;

Exit;

End;

CurGrid. OnNewCol:=NumerationOnNewCol;

CurGrid. OnNewRow:=NumerationOnNewRow;

CurGrid. OnDrawCell:=SolveLineEqsM1OrM2OnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

{Вимикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options – [goEditing];

CurGrid. OnSetEditText:=OldOnSetEditText;

End;

fs_SolvingEqsM2: {вирішування системи лінійних рівнянь способом 2:}

Begin

CurGrid. ColCount:=bc_FixedCols+1;

CurGrid. RowCount:=bc_FixedRows+1;

CurGrid. FixedRows:=bc_FixedRows;

CurGrid. FixedCols:=bc_FixedCols;

{Пробуємо підготувати таблицю до вирішування. Якщо не

вдається, то залишаємось у режимі, який був до спроби його

змінити:}

If Not (Self. PrepareToSolveEqsWithM2) then

Begin

StateSafe:=Self. CurFormatState;

{Перемикаємо на режим fs_NoFormatting, і назад у поточний,

щоб встановити усі настройки цього режиму:}

Self. TableFormatState:=fs_NoFormatting;

Self. TableFormatState:=StateSafe;

Exit;

End;

CurGrid. OnNewCol:=NumerationOnNewCol;

CurGrid. OnNewRow:=NumerationOnNewRow;

CurGrid. OnDrawCell:=SolveLineEqsM1OrM2OnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

CurGrid. OnSetEditText:=OldOnSetEditText;

{Вимикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options – [goEditing];

End;

fs_SolvingLTask: GoSolveLTask;

fs_FreeEdit: {Режим вільного редагування таблиці:}

Begin

CurGrid. OnNewCol:=OldOnNewCol;

CurGrid. OnNewRow:=OldOnNewRow;

CurGrid. OnDrawCell:=OldOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

{Вмикаємо редагування екранної таблиці:}

CurGrid. Options:=CurGrid. Options+[goEditing];

{Вмикаємо стеження за змінами в екнанній таблиці:}

CurGrid. OnSetEditText:=ReactOnSetEditText;

InSolving:=False;

End;

Else {Без форматування (fs_NoFormatting), або невідомий режим:}

Begin

CurGrid. OnNewCol:=OldOnNewCol;

CurGrid. OnNewRow:=OldOnNewRow;

CurGrid. OnDrawCell:=OldOnDrawCell;

CurGrid. OnDblClick:=OldOnDblClick;

CurGrid. OnMouseUp:=OldOnMouseUp;

CurGrid. OnSetEditText:=OldOnSetEditText;

InSolving:=False;

End;

End;

CurGrid. Invalidate; {перемальовуємо таблицю з новими форматувальниками}

Self. CurFormatState:=Value; {запам'ятовуємо новий режим форматування}

End;

End;

Procedure TGridFormattingProcs. SetNewGrid (Value:TGrowingStringGrid);

Var SafeFormatState:TTableFormatState;

Begin

If Self. CurGrid<>Value then {якщо задано новий об'єкт таблиці:}

Begin

SafeFormatState:=Self. TableFormatState;

{Знімаємо усі процедури-форматувальники, перемальовуємо таблицю

(якщо вона була) перед заміною її на задану:}

Self. TableFormatState:=fs_NoFormatting;

Self. CurGrid:=Value; {запам'ятовуємо вказівник на новий об'єкт таблиці}

{Застосовуємо форматування для нової таблиці (якщо вона не відсутня,

вказівник на неї не рівний Nil):}

Self. TableFormatState:=SafeFormatState;

Self. Refresh;

End;

End;

Procedure TGridFormattingProcs. SetHeadColNum (Value: Integer);

Begin

If Self. CurFormatState=fs_FreeEdit then

Begin

If Value<0 then Value:=0;

Self.CHeadColNum:=Value;

End;

End;

Procedure TGridFormattingProcs. SetHeadRowNum (Value: Integer);

Begin

If Self. CurFormatState=fs_FreeEdit then

Begin

If Value<0 then Value:=0;

Self.CHeadRowNum:=Value;

End;

End;

Procedure TGridFormattingProcs. SetNewMemo (Value:TMemo);

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (Self. ClassName+': повідомлення вимкнені.');

Self. CurOutConsole:=Value;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (Self. ClassName+': повідомлення ввімкнені.');

End;

end.

Висновки

лінійний програмування компромісний розв'язок

Хоч кожній залежній змінній одної задачі відповідає функція-умова (нерівність) двоїстої, і кожній функції-умові відповідає залежна змінна, ці пари величин приймають різні значення у розв’язку пари задач.

Компромісний розв’язок багатокритеріальної задачі ЛП зручно застосовувати для об’єктів управління з такими вихідними параметрами (функціями мети), які є практично рівноправними (мають однаковий пріоритет до оптимізації, або їх пріоритети складно оцінити). За допомогою нього можна отримати розв’язок з мінімальним сумарним програшем оптимізації параметрів.

Використана література

    Левин С.В., Александрова В.В.: «БАГАТОКРИТЕРІАЛЬНА ОПТИМІЗАЦІЯ З ВИКОРИСТАННЯМ ТЕОРЕТИКО-ІГРОВОГО ПІДХОДУ»: методичні вказівки до виконання курсової роботи з курсу «Математичні методи дослідження операцій» – Харків, Національний аерокосмічний університет ім. М.Є. Жуковського «Харківський авіаційний інститут», 2008 р.

    Довідка з Borland Delphi 6.