Курсовая работа: Багатокритеріальна задача лінійного програмування
{Комірка значення функції мети:}
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;
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24
