Главная      Учебники - Разные     Лекции (разные) - часть 34

 

Поиск            

 

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

 

             

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

1. Завдання

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

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

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

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

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

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

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

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

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

" x ³ 0

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

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

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

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


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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

,


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

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

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

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

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

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

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

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

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

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

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

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

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

– x1 = 0;

– y2 = 0;

– y1 = 0;

– y3 = 0;

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

x3 = 2,33333333333333;

x2 = 4,55555555555556;

x4 = 1,88888888888889;

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

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

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

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

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

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

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

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

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

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

– x1 = 0;

– y2 = 0;

– x3 = 0;

– y3 = 0;

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

y1 = 14;

x2 = 5,33333333333333;

x4 = 0,333333333333333;

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

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

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

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

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

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

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

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

– x1 = 0;

– x2 = 0;

– y1 = 0;

– x4 = 0;

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

x3 = 3,33333333333333;

y2 = 1,66666666666667;

y3 = 18,6666666666667;

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

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

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

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

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

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

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

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

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


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

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

u1 = 0,402684563758389;

u3 = 0,174496644295302;

v1 = 0,319280641167655;

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

– v3 = 0;

– v2 = 0;

– u2 = 0;

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

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

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

l[Z1] = 0,697674418604651

l[Z2] = 0

l[Z3] = 0,302325581395349

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

x1 = 0

x2 = 3,17829457364341

x3 = 2,63565891472868

x4 = 1,31782945736434

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

Z1 = 8,9922480620155

Z2 = -2,4031007751938

Z3 = 0,775193798449612

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

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

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

unit UnMMDOpr;

interface

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

Grids, UControlsSizes, Menus;

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

sc_Minus='-';

sc_Plus='+';

sc_Equal='=';

sc_NotEqual='<>';

sc_Mul='*';

sc_Space=' ';

sc_KrKm=';';

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

sc_XVarName='x';

sc_YFuncName='y';

sc_DualTaskFuncNameStart='v';

sc_DualTaskVarNameStart='u';

sc_RightSideValsHdr='1';

sc_DestFuncHdr='Z';

sc_DualDestFuncHdr='W';

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

sc_DoubleSpot=':';

sc_DoubleQuot='"';

lwc_DependentColor:TColor=$02804000;

lwc_IndependentColor:TColor=$02FF8000;

lwc_RightSideColColor:TColor=$02FFD7AE;

lwc_HeadColColor:TColor=$02808040;

lwc_FuncRowColor:TColor=$02C080FF;

lwc_DestFuncToMaxNameColor:TColor=$024049FF;

lwc_DestFuncToMinNameColor:TColor=$02FF4940;

lwc_DestFuncValColor:TColor=$02A346FF;

lwc_ValInHeadColOrRowColor:TColor=$025A5A5A;

lwc_SolveColColor:TColor=$02AAFFFF;

lwc_SolveRowColor:TColor=$02AAFFFF;

lwc_SolveCellColor:TColor=$0200FFFF;

bc_FixedRows=2; bc_FixedCols=1;

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

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

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

bc_LTaskColsBeforeVars=1; bc_LTaskColsAfterVars=1;

bc_LTaskRowsBeforeVars=bc_LTaskColsBeforeVars;

bc_LineEqM1ColsBeforeVars=1;

bc_LineEqM2ColsAfterVars=1;

bc_NotColored=-1;

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

bc_MenuItemColorCircleDiameter=10;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Type

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

TSignVal=-1..1;

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

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

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

THeadLineElmType=(bc_IndependentVar, bc_DependentVar, bc_FuncVal, bc_Number,

bc_DestFuncToMax, bc_DestFuncToMin, bc_OtherType);

THeadLineElmTypes=set of THeadLineElmType;

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

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

ElmType:THeadLineElmType;

Case byte of

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

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

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

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

VarInitPos: Integer;

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

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

VarInitInRow: Boolean);

End;

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

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

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

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

TByteMatrix=array of TByteArr;

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

TTableFormatState=(fs_EnteringEqs, fs_EnteringLTask, fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask,

fs_NoFormatting, fs_FreeEdit);

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

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

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

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

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

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

TDualTaskType=(dt_MaxToMin, dt_MinToMax);

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

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

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

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

TGridFormattingProcs=class(TObject)

Private

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

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

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

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

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

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

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

InSolving, SolWasFound, WasNoRoots, WasManyRoots,

EqM1TaskPrepared, EqM2TaskPrepared, LTaskPrepared: Boolean;

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

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

CurGridModified: Boolean;

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

fs_SolvingEqsM2, fs_SolvingLTask)

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

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

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

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

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

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

CurGridSolveCol, CurGridSolveRow: Integer;

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

CHeadColNum, CHeadRowNum: Integer;

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

CurFormatState:TTableFormatState;

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

CurGrid:TGrowingStringGrid;

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

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

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

OldOnNewCol:TNewColEvent;

OldOnNewRow:TNewRowEvent;

OldOnDrawCell:TDrawCellEvent;

OldOnDblClick:TNotifyEvent;

OldOnMouseUp:TMouseEvent;

OldOnSetEditText:TSetEditEvent;

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

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

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

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

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

ProcedureUpdateLTaskHeadRowToStrGrid (SGrid:TStringGrid);

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

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

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

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

Procedure UpdateLTaskHeadColToStrGrid (SGrid:TStringGrid;

NewRows: array of Integer);

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

Procedure SetNewState (Value:TTableFormatState);

Function PrepareToSolveEqsWithM1: Boolean;

Function PrepareToSolveEqsWithM2: Boolean;

Function PrepareToSolveLTask: Boolean;

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

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

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

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

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

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

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

Rect: TRect; State: TGridDrawState);

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

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

procedure SolveLineEqsM1OrM2OnDrawCell (Sender: TObject;

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

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

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

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

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

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

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

Rect: TRect; State: TGridDrawState);

procedure EdLineTaskOnDblClick (Sender: TObject);

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

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

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

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

procedure EdLineTaskOnMouseUp (Sender: TObject;

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

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

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

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

ProcedureInitGridPopupMenu (SGrid:TStringGrid);

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

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

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

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

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

Procedure AddCellTypeItemToMenu (SMenu:TPopupMenu;

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

ToSetReactOnClick: Boolean=True);

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

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

Procedure ProcOnCellTypeSelInMenu (Sender: TObject);

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

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

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

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

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

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

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

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

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

const Value: string);

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

Вхідні дані:

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

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

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

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

ProcedureReadHeadRowCell (SCol: Integer);

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

Вхідні дані:

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

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

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

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

ProcedureReadHeadColCell (SRow: Integer);

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

FunctionReadTableFromGrid: Boolean;

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

Function WriteTableToGrid (SHeadColNum, SHeadRowNum: Integer;

ToTuneColWidth: Boolean=True):Boolean;

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

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

Procedure GetTaskSizes (Var DWidth, DHeight: Integer);

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

Function GI (RozElmCol, RozElmRow: Integer;

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

Var DColDeleted: Boolean; ToDoMGI: Boolean=False;

ToDelColIfZeroInHRow: Boolean=True):Boolean;

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

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

до кінця):}

Procedure WaitForNewStep (HeadColNum, HeadRowNum: Integer);

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

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

Function SearchNozeroSolveCell (CurRowNum,

CurColNum, MaxRow, MaxCol: Integer;

HeadRowNum, HeadColNum: Integer;

ToSearchInRightColsToo: Boolean=True):Boolean;

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

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

Procedure ChangeSignsInRow (CurRowNum: Integer);

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

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

Procedure ChangeSignsInCol (CurColNum: Integer);

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

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

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

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

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

Function ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

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

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

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

Function ShiftRowsDown (

SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

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

FunctionSolveEqsWithM1: Boolean;

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

FunctionSolveEqsWithM2: Boolean;

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

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

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

значення):}

Function SolveLTaskToMax (DualTaskVals: Boolean):Boolean;

Function PrepareDFuncForSimplexMaximize: Boolean;

Function PrepareDestFuncInMultiDFuncLTask (SFuncRowNum,

MinDestFuncRowNum: Integer):Boolean;

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

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

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

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

Procedure ShowLTaskResultCalc (DualTaskVals: Boolean);

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

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

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

Procedure ReadCurFuncSolution (Var SDValVecs:TFloatMatrix;

Var SDDestFuncVals:TFloatArr; SVecRow: Integer;

ToReadFuncVals: Boolean; DualTaskVals: Boolean);

Procedure BuildPaymentTaskOfOptim (

Const SOptimXVecs:TFloatMatrix; Const SOptimFuncVals:TFloatArr;

SFirstDFuncRow: Integer);

Procedure CalcComprVec (Const SVarVecs:TFloatMatrix;

Const SWeightCoefs:TFloatArr; Var DComprVec:TFloatArr);

Function CalcDFuncVal (Const SVarVec:TFloatArr;

SDestFuncRowNum: Integer):TWorkFloat;

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

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

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

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

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

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

FunctionSolveMultiCritLTask: Boolean;

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

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

Procedure SetHeadColNum (Value: Integer);

Procedure SetHeadRowNum (Value: Integer);

public

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

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

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

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

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

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

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

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

Continue, GoToEnd, Stop: Boolean;

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

Property TableFormatState:TTableFormatState read CurFormatState

write SetNewState default fs_NoFormatting;

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

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

Property Solving: Boolean read InSolving;

Property SolutionFound: Boolean read SolWasFound;

Property NoRoots: Boolean read WasNoRoots;

Property ManyRoots: Boolean read WasManyRoots;

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

Property StringGrid:TGrowingStringGrid read CurGrid write SetNewGrid

defaultNil;

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

Property MemoForOutput:TMemo read CurOutConsole write SetNewMemo

defaultNil;

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

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

Property HeadColNumInGrid: Integer read CHeadColNum write SetHeadColNum;

Property HeadRowNumInGrid: Integer read CHeadRowNum write SetHeadRowNum;

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

Property Table:TFloatMatrix read CurTable;

Property HeadRow:TValOrNameMas read CurHeadRow;

Property HeadCol:TValOrNameMas read CurHeadCol;

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

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

Function ReadFromFile (Const SPath: String):Boolean;

Function SaveToFile (Const SPath: String):Boolean;

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

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

(при Solving=True):}

Procedure SetTable (Const SHeadRow, SHeadCol:TValOrNameMas;

Const STable:TFloatMatrix);

Procedure GetTable (Var DHeadRow, DHeadCol:TValOrNameMas;

Var DTable:TFloatMatrix);

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

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

Function GetColorByElmType (CurType:THeadLineElmType):TColor;

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

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

Function GetNameByElmType (CurType:THeadLineElmType):String;

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

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

fs_EnteringEqs і fs_EnteringLTask.}

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

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

Procedure Refresh;

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

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

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

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

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

FunctionMakeDualLTask: Boolean;

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

Function TaskWidth: Integer;

Function TaskHeight: Integer;

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

fs_SolvingEqsM2, fs_SolvingLTask:}

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

Constructor Create;

Destructor Free;

End;

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

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

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

Function GetValOrNameAsStr (Const Value:TValOrName):String;

Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);

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

overload;

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

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

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

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

overload;

Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix;

Var SDHeadCol:TValOrNameMas; Row1, Row2: Integer;

ToChangeInitPosNums: Boolean=False); overload;

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

overload;

Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix;

Var SDHeadRow:TValOrNameMas; Col1, Col2: Integer;

ToChangeInitPosNums: Boolean=False); overload;

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

Procedure Transpose (Var SDMatrix:TFloatMatrix);

implementation

const

sc_InvCoordsOfResolvingElm=

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

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

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

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

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

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

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

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

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

sc_CantReadTaskInCurMode=

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

sc_CantWriteTaskInCurMode=

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sc_Space+sc_UnlimitedFunc;

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

sc_NoTableAreaToWork=

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sc_CantChangeStateInSolving=

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

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

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

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

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

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

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

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

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

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

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

sc_CurRowNotMarkedAsDestFunc=

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Var Res1:TSignVal;

Begin

Res1:=bc_Zero;

If Value<0 then Res1:=bc_Negative

Else if Value>0 then Res1:=bc_Positive;

ValSign:=Res1;

End;

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

Var Res1:TSignVal;

Begin

If Value. ElmType=bc_Number then

Res1:=ValSign (Value. AsNumber)

Else

Begin

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

Else Res1:=bc_Positive;

End;

ValSign:=Res1;

End;

Function GetValOrNameAsStr (Const Value:TValOrName):String;

Begin

If Value. ElmType=bc_Number then

GetValOrNameAsStr:=FloatToStr (Value. AsNumber)

Else GetValOrNameAsStr:=Value. AsVarName;

End;

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

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

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

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

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

Var CurElm: Integer;

Begin

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

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

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

Begin

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

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

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

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

заданих:}

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

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

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

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

End;

End;

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

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

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

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

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

Var CurElm: Integer;

Begin

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

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

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

Begin

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

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

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

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

заданих:}

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

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

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

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

End;

End;

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

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

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

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

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

Var CurRow: Integer;

Begin

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

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

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

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

Begin

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

End;

End;

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

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

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

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

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

Var CurElm: Integer;

Begin

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

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

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

Begin

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

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

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

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

заданих:}

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

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

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

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

End;

End;

Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);

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

Begin

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

SDValOrName. AsNumber:=-SDValOrName. AsNumber

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

Begin

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

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

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

End;

End;

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

Function TGridFormattingProcs.GI (RozElmCol, RozElmRow: Integer;

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

Var DColDeleted: Boolean;

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

ToDelColIfZeroInHRow: Boolean=True):Boolean;

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

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

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

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

Вхідні дані:

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

}


Var CurRow, CurCol, RowCount, ColCount: Integer;

SafeHeadElm:TValOrName;

MultiplierIfMGI:TWorkFloat;

CurMessage: String;

Begin

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

RowCount:=Length(SDMatrix);

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

ColCount:=Length (SDMatrix[0]);

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

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

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

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

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

Begin

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

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

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

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

GI:=False; Exit;

End;

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

неможливо:}

If SDMatrix [RozElmRow, RozElmCol]=0 then

Begin

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

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

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add(CurMessage);

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

GI:=False; Exit;

End;

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

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

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

For CurRow:=0 to RowCount-1 do

For CurCol:=0 to ColCount-1 do

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

Begin

SDMatrix [CurRow, CurCol]:=

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

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

SDMatrix [RozElmRow, RozElmCol];

End;

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

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

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

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

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

For CurRow:=0 to RowCount-1 do

If CurRow<>RozElmRow then

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

SDMatrix [RozElmRow, RozElmCol];

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

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

For CurCol:=0 to ColCount-1 do

If CurCol<>RozElmCol then

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

SDMatrix [RozElmRow, RozElmCol];

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

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

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

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

SafeHeadElm:= SDHeadRow[RozElmCol];

SDHeadRow[RozElmCol]:=SDHeadCol[RozElmRow];

SDHeadCol[RozElmRow]:=SafeHeadElm;

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

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

If ToDoMGI then

Begin

ChangeSignForValOrVarName (SDHeadRow[RozElmCol]);

ChangeSignForValOrVarName (SDHeadCol[RozElmRow]);

End;

DColDeleted:=False;

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

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

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

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

If SDHeadRow[RozElmCol].AsNumber=0 then

Begin

DeleteFromArr (SDHeadRow, RozElmCol, 1);

DelColsFromMatr (SDMatrix, RozElmCol, 1);

DColDeleted:=True;

End;

GI:=True;

End;

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

overload;

Var SafeCurRow:TFloatArr;

Begin

SafeCurRow:=SDMatr[Row1];

SDMatr[Row1]:=SDMatr[Row2];

SDMatr[Row2]:=SafeCurRow;

End;

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

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

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

Вхідні дані:

SDMatr – таблиця;

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

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

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

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

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

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

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

SDMatr – таблиця;

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

Var SafeCurHeadCell:TValOrName;

Begin

SafeCurHeadCell:=SDHeadCol[Row1];

SDHeadCol[Row1]:=SDHeadCol[Row2];

SDHeadCol[Row2]:=SafeCurHeadCell;

If ToChangeInitPosNums then

Begin

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

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

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

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

End;

ChangeRowsPlaces (SDMatr, Row1, Row2);

End;

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

Var SafeElm:TWorkFloat;

Begin

SafeElm:=SDMas[Elm1];

SDMas[Elm1]:=SDMas[Elm2];

SDMas[Elm2]:=SafeElm;

End;

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

overload;

Var CurRow: Integer;

Begin

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

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

End;

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

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

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

Вхідні дані:

SDMatr – таблиця;

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

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

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

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

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

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

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

SDMatr – таблиця;

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

Var SafeCurHeadCell:TValOrName;

Begin

SafeCurHeadCell:=SDHeadRow[Col1];

SDHeadRow[Col1]:=SDHeadRow[Col2];

SDHeadRow[Col2]:=SafeCurHeadCell;

If ToChangeInitPosNums then

Begin

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

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

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

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

End;

ChangeColsPlaces (SDMatr, Col1, Col2);

End;

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

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

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

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

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

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

Begin

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

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

Self. Continue:=False;

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

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

If Not (Self. GoToEnd) then

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

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

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

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

Application. ProcessMessages;

End;

Function TGridFormattingProcs. SearchNozeroSolveCell (CurRowNum,

CurColNum, MaxRow, MaxCol: Integer;

HeadRowNum, HeadColNum: Integer;

ToSearchInRightColsToo: Boolean=True):Boolean;

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

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

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

Const sc_CurProcName='SearchNozeroSolveCell';

Var CurSearchRowNum, CurSearchColNum: Integer;

st1: String;

Begin

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

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

Begin

If Self. CurOutConsole<>Nil then

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

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

sc_SearchingOther);

CurSearchRowNum:=MaxRow+1;

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

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

For CurSearchColNum:=CurColNum to MaxCol do

Begin

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

For CurSearchRowNum:=CurRowNum+1 to MaxRow do

Begin

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

End;

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

If CurSearchRowNum>MaxRow then

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_AllKoefIsZeroForVar;

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

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurSearchColNum].AsNumber)

Else st1:=st1+sc_Space+

sc_DoubleQuot+Self. CurHeadRow[CurSearchColNum].AsVarName+

sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

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

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

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

End

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

Begin

Self. WaitForNewStep (HeadColNum, HeadRowNum);

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

If Self. Stop then

Begin

SearchNozeroSolveCell:=True; Exit;

End;

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

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

CurSearchRowNum);