Курсовая работа: Багатокритеріальна задача лінійного програмування
overload;
Var CurRow: Integer;
Begin
For CurRow:=0 to Length(SDMatr) – 1 do
ChangePlaces (SDMatr[CurRow], Col1, Col2);
End;
Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix; Var SDHeadRow:TValOrNameMas;
Col1, Col2: Integer; ToChangeInitPosNums: Boolean=False); overload;
{Процедура міняє місцями стовпці у таблиці з рядком-заголовком.
Вхідні дані:
SDMatr – таблиця;
SDHeadRow – рядок-заголовок таблиці;
Row1, Row2 – рядки, що треба поміняти місцями;
ToChangeInitPosNums – вмикач зміни номерів по порядку у
стовпці-заголовку. Якщо рівний True, то рядки, що помінялися місцями,
міняються також і позначками про номер по порядку та розміщення
як рядка чи стовпця (що присвоювалися їм при створенні).
Вихідні дані:
SDMatr – таблиця;
SDHeadCol – рядок-заголовок таблиці.}
Var SafeCurHeadCell:TValOrName;
Begin
SafeCurHeadCell:=SDHeadRow[Col1];
SDHeadRow[Col1]:=SDHeadRow[Col2];
SDHeadRow[Col2]:=SafeCurHeadCell;
If ToChangeInitPosNums then
Begin
SDHeadRow[Col2].VarInitPos:=SDHeadRow[Col1].VarInitPos;
SDHeadRow[Col2].VarInitInRow:=SDHeadRow[Col1].VarInitInRow;
SDHeadRow[Col1].VarInitPos:=SafeCurHeadCell. VarInitPos;
SDHeadRow[Col1].VarInitInRow:=SafeCurHeadCell. VarInitInRow;
End;
ChangeColsPlaces (SDMatr, Col1, Col2);
End;
Procedure TGridFormattingProcs. WaitForNewStep (HeadColNum, HeadRowNum: Integer);
{Зупиняє хід вирішування, відображає поточний стан таблиці, і чекає,
доки не буде встановлений один з прапорців:
Self. Continue, Self. GoToEnd або Self. Stop.
Якщо прапорці Self. GoToEnd або Self. Stop вже були встановлені до
виклику цієї процедури, то процедура не чекає встановлення прапорців.}
Begin
{Якщо процедуру викликали, то треба почекати, доки не встановиться
Self. Continue=True, незважаючи на поточний стан цього прапорця:}
Self. Continue:=False;
{Відображаємо поточний стан таблиці, якщо не ввімкнено режим
роботи без зупинок:}
If Not (Self. GoToEnd) then
Self. WriteTableToGrid (HeadColNum, HeadRowNum, True);
{Чекаємо підтвердження для наступного кроку, або переривання
розв'язування:}
While Not (Self. Continue or Self. GoToEnd or Self. Stop) do
Application. ProcessMessages;
End;
Function TGridFormattingProcs. SearchNozeroSolveCell (CurRowNum,
CurColNum, MaxRow, MaxCol: Integer;
HeadRowNum, HeadColNum: Integer;
ToSearchInRightColsToo: Boolean=True):Boolean;
{Пошук ненульової розв'язувальної комірки для вирішування системи рівнянь
або при вирішуванні задачі максимізації/мінімізації лінійної форми
симплекс-методом (починаючи з комірки [CurRowNum, CurColNum]).}
Const sc_CurProcName='SearchNozeroSolveCell';
Var CurSearchRowNum, CurSearchColNum: Integer;
st1: String;
Begin
{Якщо комірка, що хотіли взяти розв'язувальною, рівна нулю:}
If Self. CurTable [CurRowNum, CurColNum]=0 then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_ZeroKoef+
' ['+IntToStr (CurColNum+1)+'; '+IntToStr (CurRowNum+1)+']'+
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>}
Var CurRowN, 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;
Procedure ShowResultCalc;
{Відображає записи значень змінних (у текстовому полі)
такого зказка:
<стовп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; {починаємо з першого рядка}
{Проходимо по усіх стовпцях (по усіх змінних), намагаючись брати
розв'язувальні комірки по головній діагоналі. Якщо серед таких зустрінеться
нуль, спробуємо знайти ненульову комірку нижче, і поміняти рядки нульової
з ненульовою, щоб ненульова стала на головній діагоналі.
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
