Смекни!
smekni.com

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

sc_SearchingOther);

CurSearchRowNum:=MaxRow+1;

{Шукаємо ненульову комірку в заданій області (або в одному

її стовпці CurColNum, якщо ToSearchInRightColsToo=False):}

For CurSearchColNum:=CurColNum to MaxCol do

Begin

{Шукаємо ненульову комірку знизу у тому ж стовпцю:}

For CurSearchRowNum:=CurRowNum+1 to MaxRow do

Begin

If Self. CurTable [CurSearchRowNum, CurSearchColNum]<>0 then Break;

End;

{Якщо немає ненульових, то змінна вільна:}

If CurSearchRowNum>MaxRow then

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:=sc_CurProcName+sc_AllKoefIsZeroForVar;

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

st1:=st1+sc_Space+

FloatToStr (Self. CurHeadRow[CurSearchColNum].AsNumber)

Else st1:=st1+sc_Space+

sc_DoubleQuot+Self. CurHeadRow[CurSearchColNum].AsVarName+

sc_DoubleQuot;

Self. CurOutConsole. Lines. Add(st1);

End;

{Якщо потрібна комірка тільки у даному стовпці (для даної змінної),

то в інших стовцях не шукаємо:}

If Not(ToSearchInRightColsToo) then Break; {For CurSearchColNum…}

End

Else {Якщо знайдено ненульовий:}

Begin

Self. WaitForNewStep (HeadColNum, HeadRowNum);

{Якщо дано команду перервати розв'язування:}

If Self. Stop then

Begin

SearchNozeroSolveCell:=True; Exit;

End;

{Ставимо рядок із знайденим ненульовим замість поточного:}

ChangeRowsPlaces (Self. CurTable, Self. CurHeadCol, CurRowNum,

CurSearchRowNum);

{Якщо знайдена комірка у іншому стовпці, то міняємо місцями стовпці:}

If CurColNum<>CurSearchColNum then

ChangeColsPlaces (Self. CurTable, Self. CurHeadRow, CurColNum,

CurSearchColNum);

Break; {For CurSearchColNum:=CurColNum to MaxCol do…}

End;

End; {For CurSearchColNum:=CurColNum to MaxCol do…}

{Якщо ненульову комірку не знайдено:}

If (CurSearchColNum>MaxCol) or (CurSearchRowNum>MaxRow) then

Begin

If Self. CurOutConsole<>Nil then

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

SearchNozeroSolveCell:=False;

Exit; {задача не має розв'язків, або має їх безліч…}

End;

End; {If Self. CurTable [CurRowNum, CurColNum]=0 then…}

SearchNozeroSolveCell:=True;

End;

{Вирішування системи лінійних рівнянь способом 1:}

Function TGridFormattingProcs. SolveEqsWithM1: Boolean;

{Для таблиці виду:

x1 x2 x3… xn

a1

a2

a3

am}

Const sc_CurProcName='SolveEqsWithM1';

Var CurRowNum, CurColNum: Integer;

st1: String;

HeadRowNum, HeadColNum: Integer;

ColDeleted: Boolean;

Procedure ShowResultCalc;

{Відображає записи про обчислення значень змінних (у текстовому полі)

такого зказка:

<стовп1>=<a11>*<ряд1> + <a12>*<ряд2> +… + <a1n>*<рядn>;

<стовпm>=<am1>*<ряд1> + <am2>*<ряд2> +… + <amn>*<рядn>;

І підраховує значення, якщо можливо:

<стовп1>=<значення1>;

<стовпm>=<значенняm>}

VarCurRowN, CurColN: Integer; ValueAvail: Boolean;

CurVal:TWorkFloat;

st2: String;

NotEqual, NoRoots: Boolean;

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ResultIs+sc_DoubleSpot);

NoRoots:=False;

For CurRowN:=0 to Length (Self. CurHeadCol) – 1 do

Begin

st2:=''; ValueAvail:=True; CurVal:=0;

If Self. CurOutConsole<>Nil then

Begin

{<стовп i>=…:}

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

st2:=st2+FloatToStr (Self. CurHeadCol[CurRowN].AsNumber)

Else

st2:=st2+Self. CurHeadCol[CurRowN].AsVarName;

st1:=st2;

st1:=st1+sc_Space+sc_Equal+sc_Space; {=}

End;

For CurColN:=0 to Length (Self. CurHeadRow) – 1 do

Begin {(aij*:)

If Self. CurOutConsole<>Nil then

st1:=st1+sc_BrOp+FloatToStr (Self. CurTable [CurRowN, CurColN])+sc_Mul;

{рядj:}

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

Begin

If Self. CurOutConsole<>Nil then

st1:=st1+FloatToStr (Self. CurHeadRow[CurColN].AsNumber);

If ValueAvail then CurVal:=CurVal +

Self. CurTable [CurRowN, CurColN]*Self. CurHeadRow[CurColN].AsNumber;

End

Else

Begin

If Self. CurOutConsole<>Nil then

st1:=st1+Self. CurHeadRow[CurColN].AsVarName;

ValueAvail:=False;

End;

If Self. CurOutConsole<>Nil then

Begin

st1:=st1+sc_BrCl; {)}

If CurColN<>(Length (Self. CurHeadRow) – 1) then

st1:=st1+sc_Space+sc_Plus+sc_Space {+}

Else st1:=st1+sc_KrKm; {;}

End;

End;

If Self. CurOutConsole<>Nil then

Begin

Self. CurOutConsole. Lines. Add(st1);

st1:=st2;

End;

If ValueAvail then

Begin

NotEqual:=False;

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

Begin

If Self. CurHeadCol[CurRowN].AsNumber<>CurVal then

Begin NoRoots:=True; NotEqual:=True; End;

End;

If Self. CurOutConsole<>Nil then

Begin

If NotEqual then

st1:=st1+sc_Space+sc_NotEqual+sc_Space {<>}

Else st1:=st1+sc_Space+sc_Equal+sc_Space; {=}

st1:=st1+FloatToStr(CurVal)+sc_KrKm; {<стовп i><V><значення>;}

End;

End

Else

Begin

If Self. CurOutConsole<>Nil then st1:=st1+sc_Space+sc_ValNotAvail;

Self. WasManyRoots:=True;

End;

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add(st1);

End;

If NoRoots then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_NoRoots);

Self. WasManyRoots:=False;

End

Else if Not (Self. WasManyRoots) then Self. SolWasFound:=True;

Self. WasNoRoots:=NoRoots;

End;

Label LStopLabel;

Begin

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

Begin

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM1:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;


If Self. CurOutConsole<>Nil then

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

CurRowNum:=0; {починаємо з першого рядка}

{Проходимо по усіх стовпцях (по усіх змінних), намагаючись брати

розв'язувальні комірки по головній діагоналі. Якщо серед таких зустрінеться

нуль, спробуємо знайти ненульову комірку нижче, і поміняти рядки нульової

з ненульовою, щоб ненульова стала на головній діагоналі:}

CurColNum:=0;

While (CurColNum<Length (Self. CurHeadRow)) and

(CurRowNum<Length (Self. CurHeadCol)) do

Begin

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

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Перевіряємо, чи не є поточна комірка нулем, і при потребі шукаємо

ненульову:}

If Not (Self. SearchNozeroSolveCell (CurRowNum, CurColNum,

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

HeadRowNum, HeadColNum)) then

Break; {якщо не знайдено…}

If Self. Stop then Goto LStopLabel;

WaitForNewStep (HeadColNum, HeadRowNum);

{Якщо дано команду перервати розв'язування:}

If Self. Stop then Goto LStopLabel;

ColDeleted:=False;

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

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

Self. CurTable, ColDeleted, False, True)) then

Begin

SolveEqsWithM1:=False;

Exit;

End;

{Переходимо до наступного рядка, так як у цьому вже виразили одну із

змінних:}

Inc(CurRowNum);

If Not(ColDeleted) then Inc(CurColNum);

End;

ShowResultCalc;

SolveEqsWithM1:=True;

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM1:=False;

Exit;

End;

{Вирішування системи лінійних рівнянь способом 2:}

Function TGridFormattingProcs. SolveEqsWithM2: Boolean;

{Для таблиці виду:

x1 x2 x3… xn 1

0

0

0

0}

Const sc_CurProcName='SolveEqsWithM2';

Var CurRowNum, CurColNum: Integer;

st1: String;

HeadRowNum, HeadColNum: Integer;

ColDeleted: Boolean;

ProcedureShowResultCalc;

{Відображає записи значень змінних (у текстовому полі)

такого зказка:

<стовп1>=<значення1>;

<стовпm>=<значенняm>;

та відображає повідомлення про наявність коренів і їх визначеність.}

Var CurRowN, CurColN: Integer;

CurVal:TWorkFloat;

NotEqual, NoRoots, FreeRoots: Boolean;

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ResultIs+sc_DoubleSpot);


NoRoots:=False;

For CurRowN:=0 to Length (Self. CurHeadCol) – 1 do

Begin

If Self. CurOutConsole<>Nil then

Begin

st1:='';

{<стовп i>=…:}

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

st1:=st1+FloatToStr (Self. CurHeadCol[CurRowN].AsNumber)

Else

st1:=st1+Self. CurHeadCol[CurRowN].AsVarName;

End;

NotEqual:=False;

CurVal:=Self. CurTable [CurRowN, Length (Self. CurHeadRow) – 1];

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

Begin

If Self. CurHeadCol[CurRowN].AsNumber<>CurVal then

Begin NoRoots:=True; NotEqual:=True; End;

End;

If Self. CurOutConsole<>Nil then

Begin

If NotEqual then

st1:=st1+sc_Space+sc_NotEqual+sc_Space {<>}

Else st1:=st1+sc_Space+sc_Equal+sc_Space; {=}

st1:=st1+FloatToStr(CurVal)+sc_KrKm; {<стовп i><V><значення>;}

Self. CurOutConsole. Lines. Add(st1);

End;

End; {For CurRowN:=0 to Length (Self. CurHeadCol) – 1 do…}

{Переріряємо, чи залишилися змінні у рядку-заголовку. Якщо так, то

корені вільні, і якщо система сумісна, то їх безліч:}

FreeRoots:=False;

For CurColN:=0 to Length (Self. CurHeadRow) – 1 do

Begin

If Self. CurHeadRow[CurColN].ElmType<>bc_Number then

Begin FreeRoots:=True; Break; End;

End;

If NoRoots then

Begin

If Self. CurOutConsole<>Nil then Self. CurOutConsole. Lines. Add (sc_NoRoots);

Self. WasNoRoots:=True;

End

Else if FreeRoots then

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_ManyRoots);

Self. WasManyRoots:=True;

End

Else

Begin

If Self. CurOutConsole<>Nil then

Self. CurOutConsole. Lines. Add (sc_SolutionFound);

Self. SolWasFound:=True;

End;

End;

Label LStopLabel;

Begin

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

Begin

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM2:=False;

Exit;

End;

HeadRowNum:=Self.CHeadRowNum;

HeadColNum:=Self.CHeadColNum;

If Self. CurOutConsole<>Nil then

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

CurRowNum:=0; {починаємо з першого рядка}

{Проходимо по усіх стовпцях (по усіх змінних), намагаючись брати

розв'язувальні комірки по головній діагоналі. Якщо серед таких зустрінеться

нуль, спробуємо знайти ненульову комірку нижче, і поміняти рядки нульової

з ненульовою, щоб ненульова стала на головній діагоналі.

При цьому останній стовпець не беремо (у ньому вільні члени –

праві частини рівнянь):}

CurColNum:=0;

While (CurColNum<(Length (Self. CurHeadRow) – 1)) and{останній стовпець не беремо}

(CurRowNum<Length (Self. CurHeadCol)) do

Begin

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

таблиці:}

Self. CurGridSolveCol:=CurColNum+HeadColNum+bc_LTaskColsBeforeVars;

Self. CurGridSolveRow:=CurRowNum+HeadRowNum+bc_LTaskRowsBeforeVars;

{Перевіряємо, чи не є поточна комірка нулем, і при потребі шукаємо

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

(що є останнім):}

If Not (Self. SearchNozeroSolveCell (CurRowNum, CurColNum,

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

HeadRowNum, HeadColNum)) then

Break; {якщо не знайдено…}

If Self. Stop then Goto LStopLabel;

WaitForNewStep (HeadColNum, HeadRowNum);

{Якщо дано команду перервати розв'язування:}

If Self. Stop then Goto LStopLabel;

ColDeleted:=False;

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

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

Self. CurTable, ColDeleted, False, True)) then

Begin

SolveEqsWithM2:=False;

Exit;

End;

{Переходимо до наступного рядка, так як у цьому вже виразили одну із

змінних:}

Inc(CurRowNum);

If Not(ColDeleted) then Inc(CurColNum);

End;

ShowResultCalc;

SolveEqsWithM2:=True;

Exit;

LStopLabel:

If Self. CurOutConsole<>Nil then

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

SolveEqsWithM2:=False;

Exit;

End;

{Запускач вирішування. Працює у режимах fs_SolvingEqsM1,

fs_SolvingEqsM2, fs_SolvingLTask:}

Function TGridFormattingProcs. Solve (ToGoToEnd: Boolean=False):Boolean;

Const sc_CurProcName='Solve';

Var

Res1: Boolean;

st1: String;

Begin

Self. InSolving:=True;

Self. WasNoRoots:=False; Self. WasManyRoots:=False; Self. SolWasFound:=False;

Self. Stop:=False; Self. GoToEnd:=ToGoToEnd;