(для цих двох останніх масивів пам'ять має бути вже виділеною).
Вихідні дані:
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-го стовпця матриці неоптимальності.
Вихідні дані: міра неоптимальності.}
VarVarNum: 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– матриця коефіцієнтів умови
багатокритеріальної лінійної задачі оптимізації.
Вихідні дані: