Курсовая работа: Багатокритеріальна задача лінійного програмування
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
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
