Смекни!
smekni.com

Багатокритеріальна задача лінійного програмування (стр. 13 из 17)

End;

End;

ShiftRowsUp:=HiNotInSetRow;

End;

Function TGridFormattingProcs. ShiftRowsDown (

SHeadColElmTypes:THeadLineElmTypes;

ToChangeInitPosNums: Boolean=False):Integer;

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

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

стовпця-заголовка вниз.

Вхідні дані:

SHeadColElmTypes– множина типів комірок, що мають бути переміщені вниз

(у стовпці-заголовку);

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

позначки розташування в таблиці як рядка чи стовпця.

Якщо рівний True, то рядки при переміщенні змінюють ці позначки

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

Self. CurTable– таблиця коефіцієнтів;

Self. CurHeadCol– стовпець-заголовок.

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

Self. CurTable і Self. CurHeadCol– таблиця коефіцієнтів і

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

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

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

VarAllOtherHeadTypes:THeadLineElmTypes;

Begin

{Отримуємо протилежну множину типів комірок:}

AllOtherHeadTypes:=[bc_IndependentVar..bc_OtherType] – SHeadColElmTypes;

{Зсуваємо рядки з усіма іншими типами вгору (і рядки з заданими

типами залишаються внизу):}

ShiftRowsDown:=Self. ShiftRowsUp (AllOtherHeadTypes, ToChangeInitPosNums);

End;

Function TGridFormattingProcs. SolveLTaskToMax (DualTaskVals: Boolean):Boolean;

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

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

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

Вхідні дані:

DualTaskVals– вмикач режиму відображення змінних двоїстої задачі

(після завершення розв'язування, якщо оптимальне значення знайдено):

читаються значення змінних і функцій двоїстої задачі. Їхні

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

коефіцієнтів функції мети (функції мети прямої задачі). Вони є

значеннями змінних чи функцій, імена яких у рядку-заголовку.

Змінні чи функції-нерівності двоїстої задачі з іменами у

стовпці-заголовку є рівними нулю.

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

DResult– тип результату вирішування, який досягнутий (у випадку

успішного вирішування);

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

Const sc_CurProcName='SolveLTaskToMax';

Var CurRowNum, CurRow2N, CurColNum: Integer;

HeadRowNum, HeadColNum: Integer;

HiNoIndepRow: Integer;

ColDeleted, RowDeleted, AllExcluded, WasNothingToDo: Boolean;

st1: String;

Procedure SearchMNNCellForCol (CurColNum: Integer;

StartRowNum, EndRowNum: Integer;

Var DRowNum: Integer; AllowNegatCellIfZero: Boolean=False);

{Пошук у стовпці CurColNum комірки з МНВ (мінімального невід'ємного

відношення вільного члена до значення комірки у стовпці).

AllowNegatCellIfZero– дозволити від'ємне значення комірки і при

нульовому вільному члені.}

Var CurRowNum, FoundRow: Integer; MNN, CurRelat:TWorkFloat;

Begin

{Шукаємо МНВ у заданому інтервалі рядків:}

FoundRow:=-1; MNN:=-1;

For CurRowNum:=StartRowNum to EndRowNum do

Begin {Перевірка виконання умов невід'ємного відношення:}

If (CurTable [CurRowNum, CurColNum]<>0) and

(AllowNegatCellIfZero or

(CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<>0) or

(CurTable [CurRowNum, CurColNum]>0)) and

((ValSign (CurTable[CurRowNum, Length (Self. CurHeadRow) – 1])*

ValSign (CurTable[CurRowNum, CurColNum]))>=0) then

Begin

CurRelat:=CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]/

CurTable [CurRowNum, CurColNum];

{Якщо знайшли менше, або знайшли перше значення:}

If (CurRelat<MNN) or (FoundRow=-1) then

Begin

MNN:=CurRelat; FoundRow:=CurRowNum;

End;

End;

End;

If (Self. CurOutConsole<>Nil) and (FoundRow<0) then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoMNN+sc_Space+

IntToStr (CurColNum+1)+sc_Space+sc_TriSpot);

DRowNum:=FoundRow;

End;

Label LStopLabel;

Begin

If Self. TaskWidth<=0 then {Якщо таблиця пуста, то задача пуста:}

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_EmptyTable);

SolveLTaskToMax:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_StartSolving);

Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_ExcludingFreeVars);

End;

{############## Виключаємо незалежні змінні: ##############}

CurRowNum:=0;

Repeat

WasNothingToDo:=True; AllExcluded:=True;

CurColNum:=0;

While CurColNum<(Length (Self. CurHeadRow) – 1) do {усі стовпці окрім останнього}

Begin

ColDeleted:=False;

{Координати розв'язувальної комірки для помітки кольором в екранній

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Якщо поточна змінна незалежна:}

If Self. CurHeadRow[CurColNum].ElmType=bc_IndependentVar then

Begin{Перевіряємо, чи не дійшли до рядка функції

(або взагалі за низ таблиці):}

If CurRowNum<(Length (Self. CurHeadCol) – 1) then

Begin{якщо рядки для виключення ще залишились:}

{Шукаємо ненульову комірку серед коефіцієнтів поточної

незалежної змінної (окрім останнього рядка, що є

рядком поточної функції мети):}

IfSearchNozeroSolveCell (CurRowNum, CurColNum,

Length (Self. CurHeadCol) – 2, Length (Self. CurHeadRow) – 2,

HeadRowNum, HeadColNum, False) then

Begin {якщо змінну можна виключити:}

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

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

If Not (Self.GI (CurColNum, CurRowNum, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

WasNothingToDo:=False;

{Переходимо до наступного рядка, бо даний рядок тепер вже є

рядком виключеної вільної змінної (і змінна виражена як

функція-нерівність):}

Inc(CurRowNum);

End

Else{якщо для незалежної змінної усі коефіцієнти обмежень – нулі}

Begin{то змінна зовсім незалежна:}

{І якщо в рядку функції мети теж нуль, то:}

If Self. CurTable [Length(Self. CurHeadCol) – 1, CurColNum]=0 then

Begin {хоч змінна й незалежна, від неї теж нічого тут не залежить:}

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_FreeVar;

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

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurColNum].AsNumber)

Else st1:=st1+sc_Space+sc_DoubleQuot+

Self. CurHeadRow[CurColNum].AsVarName+sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Видаляємо стовпець цієї змінної:}

DeleteFromArr (Self. CurHeadRow, CurColNum, 1);

DelColsFromMatr (Self. CurTable, CurColNum, 1);

ColDeleted:=True;

WasNothingToDo:=False;

End

Else AllExcluded:=False; {не усі вільні вдалося виключити}

End;

End

Else AllExcluded:=False; {не усі вільні вдалося виключити}

End;

If Not(ColDeleted) then Inc(CurColNum);

End; {While (CurColNum<(Length (Self. CurHeadRow) – 1)) do…}

Until AllExcluded or WasNothingToDo;

If Not(AllExcluded) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CantExcludeFreeVars);

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

{Переміщаємо рядки з усіма незалежними змінними вгору:}

HiNoIndepRow:=Self. ShiftRowsUp([bc_IndependentVar], False);

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllFreeVarsExcluded);

{Ховаємо розв'язувальну комірку у екранній таблиці:}

Self. CurGridSolveCol:=0; Self. CurGridSolveRow:=0;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Якщо усі рядки є рядками незалежних змінних, то номер найвищого рядка

іншого типу вважаємо нижче таблиці (бо нема таких рядків):}

If HiNoIndepRow<0 then HiNoIndepRow:=Length (Self. CurHeadCol);

{Якщо після виключення незалежних змінних не залишилося рядків, окрім

рядка функції:}

If HiNoIndepRow>=(Length (Self. CurHeadCol) – 1) then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_NoTableAreaToWork);

End;

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_ExcludingZeroRows);

{############## Виключаємо 0-рядки. Шукаємо їх: ##############}

CurRowNum:=HiNoIndepRow;

While CurRowNum<=(Length (Self. CurHeadCol) – 2) do

Begin

RowDeleted:=False;

If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then

Begin

If Self. CurHeadCol[CurRowNum].AsNumber=0 then {якщо знайшли 0-рядок:}

Begin{Для помітки 0-рядка на екранній таблиці:}

Self. CurGridSolveCol:=HeadColNum;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

{Перевіряємо вільний член рядка, чи він невід'ємний.

Якщо від'ємний, то множимо обидві частини рівняння на -1:}

If CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]<0 then

ChangeSignsInRow(CurRowNum);

{Шукаємо у рядку перший додатний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]>0 then Break;

If CurColNum>(Length (Self. CurHeadRow) – 2) then {Якщо усі недодатні:}

Begin

If CurTable [CurRowNum, Length (Self. CurHeadRow) – 1]=0 then

Begin {Якщо вільний член рівний нулю, то помножимо рівняння на -1:}

ChangeSignsInRow(CurRowNum);

{Шукаємо у рядку перший додатний коефіцієнт:}

For CurColNum:=0 to Length (Self. CurHeadRow) – 2 do

If CurTable [CurRowNum, CurColNum]>0 then Break;

{Якщо знову додатних нема, значить усі нулі. Видаляємо рядок:}

If CurColNum>(Length (Self. CurHeadRow) – 2) then

Begin

If Self. CurOutConsole<>Nil then

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

sc_Space+IntToStr (CurRowNum+1));

DelRowsFromMatr (CurTable, CurRowNum, 1);

DeleteFromArr (Self. CurHeadCol, CurRowNum, 1);

System. Continue; {переходимо одразу до наступного рядка}

End;

End

Else{Якщо вільний член додатній, а коефіцієнти недодатні, то

система несумісна:}

Begin

If Self. CurOutConsole<>Nil then

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

sc_Space+sc_NoVals);

Self. WasNoRoots:=True;

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=True; Exit;

End;

End;

{Якщо додатний коефіцієнт у 0-рядку обрано, шукаємо МНВ

(мінімальне невід'ємне серед відношень вільних членів до членів

стовпця, у якому обрали цей коефіцієнт):}

SearchMNNCellForCol (CurColNum, HiNoIndepRow, Length (Self. CurHeadCol) – 2,

CurRow2N, False);

If CurRow2N<0 then {Якщо МНВ не знайдено:}

Begin

Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);

SolveLTaskToMax:=False; Exit;

End;

{Якщо МНВ знайдено:}

Self. CurGridSolveCol:=CurColNum + HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRow2N + HeadRowNum+bc_LTaskRowsBeforeVars;

WaitForNewStep (HeadColNum, HeadRowNum);

If Self. Stop then Goto LStopLabel;

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

If Not (Self.GI (CurColNum, CurRow2N, Self. CurHeadRow,

Self. CurHeadCol, Self. CurTable, ColDeleted, True,

True)) then

Begin

SolveLTaskToMax:=False; Exit;

End;

If CurRow2N<>CurRowNum then {Якщо виключили не цей 0-рядок:}

System. Continue; {продовжуємо працювати з цим рядком}

End; {If Self. CurHeadCol[CurRowNum].AsNumber=0 then…}

End; {If Self. CurHeadCol[CurRowNum].ElmType=bc_Number then…}

If Not(RowDeleted) then Inc(CurRowNum);

End; {While CurRowNum<=(Length (Self. CurHeadCol) – 2) do…}

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_AllZeroRowsExcluded);

{Ховаємо розв'язувальну комірку у екранній таблиці:}