Повертає значення функції мети.}
VarVarNum: Integer; FuncVal:TWorkFloat;
Begin
FuncVal:=0;
For VarNum:=0 to Length(SVarVec) – 1 do {для кожної змінної:}
Begin
FuncVal:=FuncVal + SVarVec[VarNum]*Self. CopyTable [SDestFuncRowNum, VarNum];
End;
CalcDFuncVal:=FuncVal;
End;
Function TGridFormattingProcs. SolveMultiCritLTask: Boolean;
{Вирішування задачі багатокритеріальної оптимізації лінійної форми
з використанням теоретико-ігрового підходу.
Умовою задачі є умови-нерівності, рівняння та умови на невід'ємність
окремих змінних, і декілька функцій мети, для яких треба знайти
якомога більші чи менші значення.
Вхідні дані:
Self. CurTable– таблиця коефіцієнтів та вільних членів;
Self. CurHeadRow– рядок-заголовок зі змінними та одиницею-множником
стовпця вільних членів (має бути останнім);
Self. CurHeadCol– стовпець-заголовок з іменами функцій-нерівностей,
нулями (заголовки рядків-рівнянь), іменами функцій мети
(що максимізуються (тип комірки bc_DestFuncToMax) або мінімізуються
(тип bc_DestFuncToMin)).
Функція повертає ознаку успішності вирішування.}
Var Row, CurWidth, CurHeight, FirstDestFuncRow,
DestFuncCount, VarCount: Integer;
Res1: Boolean;
st1: String;
OptimXVecs, DualUVec:TFloatMatrix;
OptimFuncVals, OptGTaskVal, ComprXVec:TFloatArr;
Const sc_CurProcName='SolveMultiCritLTask';
sc_TextMarkRow='############';
Procedure ShowWeightCoefs (Const SCoefs:TFloatArr; FirstDestFuncRow: Integer);
Var i: Integer;
Begin
If Self. CurOutConsole<>Nil then
Begin
Self. CurOutConsole. Lines. Add (sc_WeightCoefs);
For i:=0 to Length(SCoefs) – 1 do
Begin
{Відображаємо вагові коефіцієнти для кожної з функцій мети
багатокритеріальної задачі:}
Self. CurOutConsole. Lines. Add ('l['+
Self. CopyHeadCol [FirstDestFuncRow+i].AsVarName+'] = '+
FloatToStr (SCoefs[i]));
End;
End;
End;
Procedure ShowComprVarVec (Const ComprXVec:TFloatArr);
Var Col: Integer; st1: String;
Begin
If Self. CurOutConsole<>Nil then
Begin
Self. CurOutConsole. Lines. Add (sc_ComprVarVals);
For Col:=0 to Length(ComprXVec) – 1 do
Begin
st1:=Self. CopyHeadRow[Col].AsVarName + ' = ';
st1:=st1 + FloatToStr (ComprXVec[Col]);
Self. CurOutConsole. Lines. Add(st1);
End;
End;
End;
Procedure ShowDFuncVals (Const ComprXVec:TFloatArr; FirstDFuncRow: Integer);
Var Row: Integer; st1: String;
Begin
If Self. CurOutConsole<>Nil then
Begin
Self. CurOutConsole. Lines. Add (sc_DestFuncComprVals);
For Row:=FirstDFuncRow to Length (Self. CopyTable) – 1 do
Begin
st1:=Self. CopyHeadCol[Row].AsVarName + ' = ';
st1:=st1 + FloatToStr (Self. CalcDFuncVal (ComprXVec, Row));
Self. CurOutConsole. Lines. Add(st1);
End;
End;
End;
Label LStopLabel, LFinish;
Begin
Res1:=True; {прапорець успішності}
Self. GetTaskSizes (CurWidth, CurHeight);
If CurWidth<=0 then {Якщо таблиця пуста, то задача пуста:}
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);
Self. WasNoRoots:=True;
SolveMultiCritLTask:=False;
Exit;
End;
If Self. CurOutConsole<>Nil then
Begin
Self. CurOutConsole. Lines. Add('');
Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);
End;
{Зберігаємо посилання на масиви умови багатокритеріальної задачі:}
Self. CopyHeadRow:=Self. CurHeadRow;
Self. CopyHeadCol:=Self. CurHeadCol;
Self. CopyTable:=Self. CurTable;
{Шукаємо цільові функції внизу таблиці:}
For Row:=CurHeight-1 downto 0 do
Begin
Case Self. CopyHeadCol[Row].ElmType of
bc_DestFuncToMax:;
bc_DestFuncToMin:;
{Якщо знизу вгору дійшли до рядка, що не є функцією мети – завершуємо:}
Else Break;
End;
End;
If Row>=CurHeight-1 then {якщо рядків функцій мети взагалі немає:}
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoDestFuncs);
Self. WasNoRoots:=True;
Res1:=False; Goto LFinish;
End
Else if Row<0 then {якщо в таблиці є тільки рядки функцій мети:}
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_OnlyDestFuncsPresent);
Res1:=False; Goto LFinish;
(* Row:=-1; *)
End;
FirstDestFuncRow:=Row+1; {найвищий у таблиці рядок функції мети}
DestFuncCount:=CurHeight-FirstDestFuncRow; {кількість функцій мети}
{Змінні: усі стовпці окрім останнього (стовпця вільних членів з
одиницею в заголовку):}
VarCount:=CurWidth-1;
{Вектори змінних в оптимальних розв'язках задач:}
SetLength (OptimXVecs, DestFuncCount, VarCount);
{Оптимальні значення функцій (максимальні або мінімальні значення):}
SetLength (OptimFuncVals, DestFuncCount);
{############ Шукаємо min або max кожної функції мети окремо: ############}
For Row:=FirstDestFuncRow to CurHeight-1 do {для усіх функцій мети:}
Begin
If Self. CurOutConsole<>Nil then
Begin
st1:=sc_TextMarkRow+sc_CurProcName + sc_ForDestFunc+
sc_DoubleQuot+ Self. CopyHeadCol[Row].AsVarName +sc_DoubleQuot+sc_Space;
If Self. CopyHeadCol[Row].ElmType=bc_DestFuncToMin then
st1:=st1+sc_SearchingMin
Else st1:=st1+sc_SearchingMax;
st1:=st1+sc_TriSpot+sc_TextMarkRow;
Self. CurOutConsole. Lines. Add(st1);
End;
{Формуємо умову однокритеріальної задачі максимізації:}
If Not (Self. PrepareDestFuncInMultiDFuncLTask (Row, FirstDestFuncRow)) then
Begin
Res1:=False; Break;
End;
If Self. Stop then Break;
{Ховаємо розв'язувальну комірку у екранній таблиці (її нема тут):}
Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;
{Відображаємо підготовану однокритеріальну задачу:}
WaitForNewStep (Self.CHeadColNum, Self.CHeadRowNum);
If Self. Stop then Break;
{Запускаємо вирішування однокритеріальної задачі максимізації лінійної
форми (так як поточна функція є функцією максимізації, або зведена
до такої):}
Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;
If Not (Self. SolveLTaskToMax(False)) then
Begin
Res1:=False; Break;
End;
{Якщо функція мети необмежена або система умов несумісна:}
If Not (Self. SolWasFound) then
Begin
{Якщо функцій мети більше одної, то так як компромісний вектор
через необмеженість принаймні одної з функцій мети знайти неможливо:}
If (FirstDestFuncRow+1)<CurHeight then Res1:=False
Else Res1:=True;
Goto LFinish;
End;
If Self. Stop then Break;
{Читаємо вектор значень змінних та оптимальне значення функції мети
з таблиці:}
Self. ReadCurFuncSolution (OptimXVecs, OptimFuncVals, Row-FirstDestFuncRow,
False, False);
End;
If Not(Res1) then Goto LFinish;
If Self. Stop then Goto LStopLabel;
{############ Шукаємо міри неоптимальності і будуємо задачу: ############}
{######## пошуку компромісних вагових коефіцієнтів, вирішуємо її: ########}
If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_TextMarkRow);
BuildPaymentTaskOfOptim (OptimXVecs, OptimFuncVals, FirstDestFuncRow);
If Self. Stop then Goto LStopLabel;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_TextMarkRow);
{Готуємо задачу до максимізації симплекс-методом:}
Res1:=Self. PrepareDFuncForSimplexMaximize;
If Not(Res1) then Goto LFinish;
{Запускаємо вирішування цієї задачі:}
Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;
{«True» – з відображенням значень двоїстої:}
If Not (Self. SolveLTaskToMax(True)) then
Begin
Res1:=False; Goto LFinish;
End;
{Якщо функція мети необмежена або система умов несумісна:}
If Not (Self. SolWasFound) then
Begin
Res1:=False; Goto LFinish;
End;
If Self. Stop then Goto LStopLabel;
{############ Обчислюємо вагові коефіцієнти: ############}
{Якщо задача-інтерпретація гри вирішена і знайдено оптимальне
значення функції, то читаємо це значення і значення змінних
двоїстої задачі:}
SetLength (OptGTaskVal, 1); {для запису значення функції мети}
SetLength (DualUVec, 1, DestFuncCount); {для запису значень змінних}
Self. ReadCurFuncSolution (DualUVec, OptGTaskVal, 0, False, True);
{Обчислюємо вагові коефіцієнти:}
For Row:=0 to DestFuncCount-1 do
DualUVec [0, Row]:=(DualUVec [0, Row]/OptGTaskVal[0]); {Li=ui/(W(U))}
If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_TextMarkRow);
ShowWeightCoefs (DualUVec[0], FirstDestFuncRow);
{############ Обчислюємо компромісний вектор: ############}
Self. CalcComprVec (OptimXVecs, DualUVec[0], ComprXVec);
ShowComprVarVec(ComprXVec);
ShowDFuncVals (ComprXVec, FirstDestFuncRow);
Goto LFinish;
LStopLabel: {Якщо вирішування було перервано:}
{Повертаємо початкову умову на попереднє місце:}
Self. CurHeadRow:=Self. CopyHeadRow;
Self. CurHeadCol:=Self. CopyHeadCol;
Self. CurTable:=Self. CopyTable;
LFinish:
{Обнуляємо посилання на копію умови. Так як це динамічні масиви і
щодо них йде відлік кількості посилань, то для них не створюватимуться
зайві копії у пам'яті, і при роботі з CurHeadRow, CurHeadCol, CurTable
пам'ять буде виділена завжди тільки для їхніх поточних даних:}
Self. CopyHeadRow:=Nil;
Self. CopyHeadCol:=NIl;
Self. CopyTable:=Nil;
SolveMultiCritLTask:=Res1;
End;
Procedure TGridFormattingProcs. ChangeSignsInRow (CurRowNum: Integer);
{Зміна знаків у рядку таблиці і відповідній комірці у стовпці-заголовку.}
Var CurColNum: Integer;
Begin
For CurColNum:=0 to Length (Self. CurHeadRow) – 1 do
CurTable [CurRowNum, CurColNum]:=-CurTable [CurRowNum, CurColNum];
ChangeSignForValOrVarName (Self. CurHeadCol[CurRowNum]);
End;
Procedure TGridFormattingProcs. ChangeSignsInCol (CurColNum: Integer);
{Зміна знаків у стовпці таблиці і відповідній комірці у рядку-заголовку.}
Var CurRowNum: Integer;
Begin
For CurRowNum:=0 to Length (Self. CurHeadCol) – 1 do
CurTable [CurRowNum, CurColNum]:=-CurTable [CurRowNum, CurColNum];
ChangeSignForValOrVarName (Self. CurHeadRow[CurColNum]);
End;
Function TGridFormattingProcs. ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;
ToChangeInitPosNums: Boolean=False):Integer;
{Функція переміщує рядки таблиці CurTable (разом із відповідними
комірками у стовпці-заголовку CurHeadCol) з заданими типами комірок
стовпця-заголовка вгору.
Вхідні дані:
SHeadColElmTypes– множина типів комірок, що мають бути переміщені вгору
(у стовпці-заголовку);
ToChangeInitPosNums– вмикач зміни позначок номера по порядку та
позначки розташування в таблиці як рядка чи стовпця.
Якщо рівний True, то рядки при переміщенні змінюють ці позначки
на позначки тих рядків, що були в тих місцях, на які рядки переміщені;
Self. CurTable– таблиця коефіцієнтів;
Self. CurHeadCol– стовпець-заголовок.
Вихідні дані:
Self. CurTable і Self. CurHeadCol– таблиця коефіцієнтів і
стовпець-заголовок з перенесеними вгору рядками і комірками;
функція повертає номер найвищого рядка із тих, що не було задано
переміщувати вгору (вище нього – ті, що переміщені вгору).}
Var HiNotInSetRow, CurRowToUp, CurRowNum: Integer;
Begin
{Номер найвищого рядка, що не є в множині тих, які переміщуються вгору.
Спочатку ставимо тут номер неіснуючого рядка:}
HiNotInSetRow:=-1;
{Йдемо по рядкам згори вниз:}
For CurRowNum:=0 to Length (Self. CurHeadCol) – 1 do
Begin {Шукаємо перший рядок з типом комірки, що не має переміщуватися вгору:}
If Not (Self. CurHeadCol[CurRowNum].ElmType in SHeadColElmTypes) then
Begin
HiNotInSetRow:=CurRowNum;
{шукаємо найнижчий рядок, який портібно переміщувати вгору:}
For CurRowToUp:=Length (Self. CurHeadCol) – 1 downto CurRowNum+1 do
Begin
If Self. CurHeadCol[CurRowToUp].ElmType in SHeadColElmTypes then Break;
End;
{Якщо таких рядків не знайдено, то усі вони вже вгорі:}
IfCurRowToUp<=CurRowNumthenBreak
Else{Міняємо місцями рядок, що має бути вгорі, і рядок, що не має,
але розташований вище:}
ChangeRowsPlaces (Self. CurTable, Self. CurHeadCol, CurRowNum,
CurRowToUp, ToChangeInitPosNums);