Багатокритеріальна задача лінійного програмування
Розв’язок багатокритеріальної задачі лінійного програмування з отриманням компромісного рішення (для задач з кількома функціями мети) за допомогою теоретико-ігрового підходу. Матриця мір неоптимальності та рядок функції мети. Модуль опису класу.
Рубрика | Программирование, компьютеры и кибернетика |
Вид | курсовая работа |
Язык | русский |
Дата добавления | 15.05.2011 |
Размер файла | 588,8 K |
Отправить свою хорошую работу в базу знаний просто. Используйте форму, расположенную ниже
Студенты, аспиранты, молодые ученые, использующие базу знаний в своей учебе и работе, будут вам очень благодарны.
ToChangeInitPosNums - вмикач зміни номерів по порядку у
стовпці-заголовку. Якщо рівний True, то рядки, що помінялися місцями,
міняються також і позначками про номер по порядку та розміщення
як рядка чи стовпця (що присвоювалися їм при створенні).
Вихідні дані:
SDMatr - таблиця;
SDHeadCol - стовпець-заголовок таблиці.}
Var SafeCurHeadCell:TValOrName;
Begin
SafeCurHeadCell:=SDHeadCol[Row1];
SDHeadCol[Row1]:=SDHeadCol[Row2];
SDHeadCol[Row2]:=SafeCurHeadCell;
If ToChangeInitPosNums then
Begin
SDHeadCol[Row2].VarInitPos:=SDHeadCol[Row1].VarInitPos;
SDHeadCol[Row2].VarInitInRow:=SDHeadCol[Row1].VarInitInRow;
SDHeadCol[Row1].VarInitPos:=SafeCurHeadCell. VarInitPos;
SDHeadCol[Row1].VarInitInRow:=SafeCurHeadCell. VarInitInRow;
End;
ChangeRowsPlaces (SDMatr, Row1, Row2);
End;
Procedure ChangePlaces (Var SDMas:TFloatArr; Elm1, Elm2: Integer);
Var SafeElm:TWorkFloat;
Begin
SafeElm:=SDMas[Elm1];
SDMas[Elm1]:=SDMas[Elm2];
SDMas[Elm2]:=SafeElm;
End;
Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix; Col1, Col2: Integer);
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; {починаємо з першого рядка}
{Проходимо по усіх стовпцях (по усіх змінних), намагаючись брати
розв'язувальні комірки по головній діагоналі. Якщо серед таких зустрінеться
нуль, спробуємо знайти ненульову комірку нижче, і поміняти рядки нульової
з ненульовою, щоб ненульова стала на головній діагоналі.
При цьому останній стовпець не беремо (у ньому вільні члени -
праві частини рівнянь):}
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;
Res1:=False;
Case Self. CurFormatState of
fs_SolvingEqsM1: Res1:=Self. SolveEqsWithM1;
fs_SolvingEqsM2: Res1:=Self. SolveEqsWithM2;
fs_SolvingLTask: Res1:=Self. SolveMultiCritLTask;
Else
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_NoSolveMode);
End;
End;
If Self. CurOutConsole<>Nil then
Begin
st1:='Вирішування закінчено.';
If Res1 then st1:=st1+' Успішно.' else st1:=st1+' З помилками' + sc_TriSpot;
Self. CurOutConsole. Lines. Add(st1);
End;
Self. InSolving:=False;
{Відображаємо таблицю вкінці вирішування:}
Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum, True);
Solve:=Res1;
End;
Constructor TGridFormattingProcs. Create;
Begin
Inherited Create;
InSolving:=False;
SolWasFound:=False; WasNoRoots:=False; WasManyRoots:=False;
EqM1TaskPrepared:=False; EqM2TaskPrepared:=False; LTaskPrepared:=False;
Continue:=False; GoToEnd:=False; Stop:=False;
CurGridModified:=False;
CurGridSolveCol:=0; CurGridSolveRow:=0;
TableFormatState:=fs_NoFormatting;
StringGrid:=Nil;
OldOnNewCol:=Nil;
OldOnNewRow:=Nil;
OldOnDrawCell:=Nil;
OldOnDblClick:=Nil;
OldOnMouseUp:=Nil;
OldOnSetEditText:=Nil;
{SetLength (CurHeadRow, 0); SetLength (CurHeadCol, 0);
SetLength (CurTable, 0);}
Self. CurHeadRow:=Nil;
Self. CurHeadCol:=Nil;
Self. CurTable:=Nil;
Self. CopyHeadRow:=Nil;
Self. CopyHeadCol:=Nil;
Self. CopyTable:=Nil;
CurOutConsole:=Nil;
End;
Destructor TGridFormattingProcs. Free;
Begin
{Inherited Free;} {inaccessible value;
…raised too many consecutive exceptions:
access violation at address 0x00000000 read of address 0x00000000…}
End;
Function TGridFormattingProcs. GetColorByElmType (CurType:THeadLineElmType):TColor;
Const sc_CurProcName='GetColorByElmType';
Var CurColor:TColor;
Begin
Case CurType of
bc_IndependentVar: CurColor:=lwc_IndependentColor;
bc_DependentVar: CurColor:=lwc_DependentColor;
bc_FuncVal: CurColor:=lwc_HeadColColor;
bc_Number: CurColor:=lwc_ValInHeadColOrRowColor;
bc_DestFuncToMax: CurColor:=lwc_DestFuncToMaxNameColor;
bc_DestFuncToMin: CurColor:=lwc_DestFuncToMinNameColor;
bc_OtherType:
If Self. CurGrid<>Nil then CurColor:=Self. CurGrid. Color
else CurColor:=clWindow;
Else
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+':'+sc_Space+
sc_UnknownVarType+sc_Space+IntToStr (Ord(CurType))+
sc_Space+sc_TriSpot);
CurColor:=bc_NotColored;
End;
End;
GetColorByElmType:=CurColor;
End;
Function TGridFormattingProcs. GetNameByElmType (CurType:THeadLineElmType):String;
Const sc_CurProcName='GetNameByElmType';
Var CurName: String;
Begin
Case CurType of
bc_IndependentVar: CurName:=sc_IndependentVar;
bc_DependentVar: CurName:=sc_DependentVar;
bc_FuncVal: CurName:=sc_InequalFuncName;
bc_Number: CurName:=sc_ValInHeadColOrRow;
bc_DestFuncToMax: CurName:=sc_DestFuncToMaxName;
bc_DestFuncToMin: CurName:=sc_DestFuncToMinName;
bc_OtherType: CurName:=sc_OtherType;
Else
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+':'+sc_Space+
sc_UnknownVarType+sc_Space+IntToStr (Ord(CurType))+sc_Space+
sc_TriSpot);
CurName:=sc_UnknownVarType;
End;
End;
GetNameByElmType:=CurName;
End;
Function TGridFormattingProcs. ReadFromFile (Const SPath: String):Boolean;
{Читання умови задачі із файла.}
Const sc_CurProcName='ReadFromFile';
Var CurFile: File; CurColCount, CurRowCount, CurCol, CurRow, ControlSize: Integer;
GotFormatState:TTableFormatState;
CurMessage: String;
Begin
If ((Self. CurFormatState<>fs_EnteringEqs) and
(Self. CurFormatState<>fs_EnteringLTask) and
(Self. CurFormatState<>fs_NoFormatting) and
(Self. CurFormatState<>fs_FreeEdit))
or (Self. InSolving) then
Begin
CurMessage:=sc_CurProcName+sc_CantReadTaskInCurMode+sc_TriSpot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
System. AssignFile (CurFile, SPath);
System. FileMode:=fmOpenRead;
try {Пробуємо відкрити файл:}
System. Reset (CurFile, 1);
except
CurMessage:=sc_CurProcName+sc_CantOpenFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
try {Пробуємо прочитати дескриптори кількості рядків і стовпців у задачі:}
System. BlockRead (CurFile, CurColCount, SizeOf(CurColCount));
System. BlockRead (CurFile, CurRowCount, SizeOf(CurRowCount));
Except
CurMessage:=sc_CurProcName+sc_EmptyFileOrCantRead+SPath+
sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
{Обчислюємо розмір, який повинні займати усі дані у файлі:}
ControlSize:=SizeOf(CurColCount)+SizeOf(CurRowCount)+
+SizeOf (Self. CurFormatState)+
SizeOf(TValOrName)*CurColCount+ SizeOf(TValOrName)*CurRowCount+
SizeOf(TWorkFloat)*CurColCount*CurRowCount;
{Перевіряємо, чи має файл такий розмір:}
If ControlSize<>System. FileSize(CurFile) then
Begin
CurMessage:=sc_CurProcName+sc_FileNotFullOrHasWrongFormat+SPath+
sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
Try
System. BlockRead (CurFile, GotFormatState, SizeOf(GotFormatState));
Except
CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
{Встановлюємо режим, що був збережений у файлі разом з умовою задачі:}
Self. TableFormatState:=GotFormatState;
{Читаємо рядок-заголовок:}
SetLength (Self. CurHeadRow, CurColCount);
For CurCol:=0 to CurColCount-1 do
Begin
Try
System. BlockRead (CurFile, Self. CurHeadRow[CurCol], SizeOf(TValOrName));
Except
CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
End;
{Читаємо стовпець-заголовок:}
SetLength (Self. CurHeadCol, CurRowCount);
For CurRow:=0 to CurRowCount-1 do
Begin
Try
System. BlockRead (CurFile, Self. CurHeadCol[CurRow], SizeOf(TValOrName));
Except
CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
End;
{Читаємо таблицю коефіцієнтів і вільних членів:}
SetLength (Self. CurTable, CurRowCount, CurColCount);
For CurRow:=0 to CurRowCount-1 do
Begin
For CurCol:=0 to CurColCount-1 do
Begin
Try
System. BlockRead (CurFile, Self. CurTable [CurRow, CurCol],
SizeOf(TWorkFloat));
Except
CurMessage:=sc_CurProcName+sc_CantReadFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
ReadFromFile:=False; Exit;
End;
End;
End;
Try
System. Close(CurFile);
Except
CurMessage:=sc_CurProcName + sc_CantCloseFile + SPath + sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
End;
Self. CurGridModified:=False;
Self. Refresh;
{Відмічаємо, що прочитана умова задачі не підготована ще до вирішування
жодним із методів вирішування:}
Self. EqM1TaskPrepared:=False;
Self. EqM2TaskPrepared:=False;
Self.LTaskPrepared:=False;
ReadFromFile:=True;
End;
Function TGridFormattingProcs. SaveToFile (Const SPath: String):Boolean;
{Запис умови задачі у файл.}
Const sc_CurProcName='SaveToFile';
Var CurFile: File; CurColCount, CurRowCount, CurCol, CurRow: Integer;
CurMessage: String;
Begin
If ((Self. CurFormatState<>fs_EnteringEqs) and
(Self. CurFormatState<>fs_EnteringLTask) and
(Self. CurFormatState<>fs_FreeEdit))
or (Self. InSolving) then
Begin
CurMessage:=sc_CurProcName+sc_CantWriteTaskInCurMode;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
{Якщо таблиця модифікована, умова не прочитана з неї, то читаємо:}
If Self. CurGridModified then
Begin
If Not (Self. GetTask(True)) then
Begin
SaveToFile:=False; Exit;
End;
End;
System. AssignFile (CurFile, SPath);
System. FileMode:=fmOpenWrite;
try {Пробуємо створити новий файл:}
System. Rewrite (CurFile, 1);
except
CurMessage:=sc_CurProcName+sc_CantCreateFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
Self. GetTaskSizes (CurColCount, CurRowCount);
try {Пробуємо прочитати дескриптори кількості рядків і стовпців у задачі:}
System. BlockWrite (CurFile, CurColCount, SizeOf(CurColCount));
System. BlockWrite (CurFile, CurRowCount, SizeOf(CurRowCount));
System. BlockWrite (CurFile, Self. CurFormatState,
SizeOf (Self. CurFormatState));
Except
CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
{Записуємо рядок-заголовок:}
For CurCol:=0 to CurColCount-1 do
Begin
Try
System. BlockWrite (CurFile, Self. CurHeadRow[CurCol], SizeOf(TValOrName));
Except
CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
End;
{Записуємо стовпець-заголовок:}
For CurRow:=0 to CurRowCount-1 do
Begin
Try
System. BlockWrite (CurFile, Self. CurHeadCol[CurRow], SizeOf(TValOrName));
Except
CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
End;
{Записуємо таблицю коефіцієнтів і вільних членів:}
For CurRow:=0 to CurRowCount-1 do
Begin
For CurCol:=0 to CurColCount-1 do
Begin
Try
System. BlockWrite (CurFile, Self. CurTable [CurRow, CurCol],
SizeOf(TWorkFloat));
Except
CurMessage:=sc_CurProcName+sc_CantWriteFile+SPath+sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
End;
End;
Try
System. Close(CurFile);
Except
CurMessage:=sc_CurProcName + sc_CantCloseFile + SPath + sc_DoubleQuot;
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add(CurMessage);
MessageDlg (CurMessage, mtError, [mbOk], 0);
SaveToFile:=False; Exit;
End;
SaveToFile:=True;
End;
Procedure TGridFormattingProcs. SetTable (Const SHeadRow, SHeadCol:TValOrNameMas;
Const STable:TFloatMatrix);
{Задає нову таблицю і загноловки (що могли бути сформовані поза об'єктом):}
Begin
Self. CurTable:=STable;
Self. CurHeadRow:=SHeadRow;
Self. CurHeadCol:=SHeadCol;
Self. TaskWidth; {перевіряємо розміри нової таблиці і її заголовків}
End;
Procedure TGridFormattingProcs. GetTable (Var DHeadRow, DHeadCol:TValOrNameMas;
Var DTable:TFloatMatrix);
{Повертає посилання на таблицю і її заголовки.}
Begin
DTable:=Self. CurTable;
DHeadRow:=Self. CurHeadRow;
DHeadCol:=Self. CurHeadCol;
End;
Procedure TGridFormattingProcs. ReadHeadRowCell (SCol: Integer);
{Зчитує комірку з екранної таблиці в рядок-заголовок.
Вхідні дані:
SCol - номер комірки у рядку-заголовку.
Для екранної таблиці використовуються координати комірки відповідно до
координат рядка-заголовка та стовпця заголовка (верхнього лівого кута
таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid.}
Var CurFloatVal:TWorkFloat; CurElmType:THeadLineElmType;
Begin
CurElmType:=CurHeadRow[SCol].ElmType;
CurFloatVal:=0;
Try {Пробуємо розпізнати число:}
CurFloatVal:=StrToFloat (CurGrid. Cells [SCol+bc_LTaskColsBeforeVars+
Self.CHeadColNum, Self.CHeadRowNum]);
CurElmType:=bc_Number; {якщо число розпізналося, то це число}
Except {Якщо рядок не інтерпретується як число, але під час редагування
була зроблена помітка про те, що це є число або функція, то вважаємо
його назвою незалежної змінної (бо всі функції в умові задачі мають
бути в стовпці-заголовку, а не в рядку):}
If (CurElmType<>bc_IndependentVar) and (CurElmType<>bc_DependentVar) then
CurElmType:=bc_IndependentVar;
End; {Виправлений тип елемента:}
CurHeadRow[SCol].ElmType:=CurElmType;
If CurElmType=bc_Number then {записуємо число, якщо розпізналося:}
CurHeadRow[SCol].AsNumber:=CurFloatVal
Else
Begin {якщо число не розпізналося, то записуємо як назву змінної:}
With CurHeadRow[SCol] do
Begin
AsVarName:=CurGrid. Cells [SCol+bc_LTaskColsBeforeVars+Self.CHeadColNum,
Self.CHeadRowNum]; {назва}
VarInitPos:=SCol; {номер п/п у рядку в умові задачі}
VarInitInRow:=True; {ознака, що змінна спочатку була у рядку-заголовку}
End;
End;
End;
Procedure TGridFormattingProcs. ReadHeadColCell (SRow: Integer);
{Зчитує комірку з екранної таблиці в стовпець-заголовок.
Вхідні дані:
SRow - номер комірки у стовпці-заголовку.
Для екранної таблиці використовуються координати комірки відповідно до
координат рядка-заголовка та стовпця заголовка (верхнього лівого кута
таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid.}
Var CurFloatVal:TWorkFloat; CurElmType:THeadLineElmType;
Begin
CurElmType:=CurHeadCol[SRow].ElmType;
CurFloatVal:=0;
Try {Пробуємо розпізнати число:}
CurFloatVal:=StrToFloat (CurGrid. Cells [Self.CHeadColNum,
SRow+bc_LTaskRowsBeforeVars+Self.CHeadRowNum]);
CurElmType:=bc_Number; {якщо число розпізналося, то це число}
Except {Якщо рядок не інтерпретується як число, але комірка вважалася
такою, що містить число або змінну, то вважаємо його назвою функції
(бо це не число, і не повинно бути змінною - усі змінні спочатку
у рядку-заголовку):}
If (CurElmType<>bc_FuncVal) and (CurElmType<>bc_DestFuncToMax) and
(CurElmType<>bc_DestFuncToMin) then
CurElmType:=bc_FuncVal;
End; {Виправлений тип елемента:}
CurHeadCol[SRow].ElmType:=CurElmType;
If CurElmType=bc_Number then {записуємо число, якщо розпізналося:}
CurHeadCol[SRow].AsNumber:=CurFloatVal
Else
Begin {якщо число не розпізналося, то записуємо як назву змінної:}
With CurHeadCol[SRow] do
Begin
AsVarName:=CurGrid. Cells [Self.CHeadColNum,
SRow+bc_LTaskRowsBeforeVars+Self.CHeadRowNum]; {назва}
VarInitPos:=SRow; {номер п/п у стовпці в умові задачі}
{Ознака, що змінна спочатку була у стовпці-заголовку:}
VarInitInRow:=False;
End;
End;
End;
Function TGridFormattingProcs. ReadTableFromGrid: Boolean;
Const sc_CurProcName='ReadTableFromGrid';
{Процедура для зчитування таблиці та її заголовків із CurGrid.
Для екранної таблиці використовуються координати рядка-заголовка та
стовпця заголовка (верхнього лівого кута таблиці з заголовками):
HeadColNumInGrid (CHeadColNum) і HeadRowNumInGrid (CHeadRowNum).}
Var CurRow, CurCol, CurWidth, CurHeight: Integer;
CurFloatVal:TWorkFloat;
Begin
If Self. CurGrid=Nil then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+
': '+sc_NoGrowingStringGrid);
ReadTableFromGrid:=False;
Exit;
End;
{Ширина і висота таблиці з заголовками:}
CurWidth:=Self. CurGrid. ColCount-Self.CHeadColNum-bc_LTaskColsBeforeVars;
CurHeight:=Self. CurGrid. RowCount-Self.CHeadRowNum-bc_LTaskRowsBeforeVars;
If (CurHeight<=0) or (CurWidth<=0) then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+
': починаючи з комірки ['+IntToStr (Self.CHeadColNum+1)+'; '+
IntToStr (Self.CHeadRowNum+1)+'] таблиці не знайдено' + sc_TriSpot);
ReadTableFromGrid:=False;
Exit;
End;
{Виділяємо пам'ять:}
SetLength (Self. CurHeadRow, CurWidth); {рядок-заголовок}
SetLength (Self. CurHeadCol, CurHeight); {стовпець-заголовок}
SetLength (Self. CurTable, CurHeight, CurWidth); {таблиця}
{Читаємо рядок-заголовок:}
For CurCol:=0 to CurWidth-1 do ReadHeadRowCell(CurCol);
{Читаємо стовпець-заголовок:}
For CurRow:=0 to CurHeight-1 do ReadHeadColCell(CurRow);
{Читаємо таблицю коефіцієнтів:}
For CurRow:=Self.CHeadRowNum+bc_LTaskRowsBeforeVars to
Self. CurGrid. RowCount-1 do
Begin
For CurCol:=Self.CHeadColNum+bc_LTaskColsBeforeVars to
Self. CurGrid. ColCount-1 do
Begin
Try {Пробуємо інтерпретувати рядок із комірки як число:}
CurFloatVal:=StrToFloat (CurGrid. Cells [CurCol, CurRow]);
Except {Якщо не вдалося, то вважаємо це число нулем:}
CurFloatVal:=0;
End;
Self. CurTable [CurRow-bc_LTaskRowsBeforeVars-Self.CHeadRowNum,
CurCol-bc_LTaskColsBeforeVars-Self.CHeadColNum]:=CurFloatVal;
End;
End;
{Після читання зміни в екранній таблиці враховані:}
Self. CurGridModified:=False;
ReadTableFromGrid:=True;
End;
Function TGridFormattingProcs. WriteTableToGrid (SHeadColNum,
SHeadRowNum: Integer; ToTuneColWidth: Boolean=True):Boolean;
{Процедура для відображення таблиці та її заголовків у CurGrid.}
Const sc_CurProcName='WriteTableToGrid';
Var CurRow, CurCol, CurWidth, CurHeight: Integer;
CurElmType:THeadLineElmType;
Begin
If Self. CurGrid=Nil then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+
': GrowingStringGrid не заданий!..');
WriteTableToGrid:=True;
Exit;
End;
{Ширина і висота таблиці:}
Self. GetTaskSizes (CurWidth, CurHeight);
If (CurHeight<=0) or (CurWidth<=0) then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_EmptyTable);
WriteTableToGrid:=False;
Exit;
End;
{Виділяємо комірки для таблиці у екранному CurGrid:}
Self. CurGrid. ColCount:=CurWidth+SHeadColNum+1;
Self. CurGrid. RowCount:=CurHeight+SHeadRowNum+1;
{Відображаємо рядок-заголовок:}
For CurCol:=SHeadColNum+1 to Self. CurGrid. ColCount-1 do
Begin
CurElmType:=CurHeadRow [CurCol-1-SHeadColNum].ElmType;
If CurElmType=bc_Number then {записуємо число, якщо є числом:}
CurGrid. Cells [CurCol, SHeadRowNum]:=
FloatToStr (CurHeadRow[CurCol-1-SHeadColNum].AsNumber)
Else {Якщо це не число, то це рядок з якоюсь назвою. Записуємо:}
Self. CurGrid. Cells [CurCol, SHeadRowNum]:=
CurHeadRow [CurCol-1-SHeadColNum].AsVarName;
End;
{Відображаємо стовпець-заголовок:}
For CurRow:=SHeadRowNum+1 to Self. CurGrid. RowCount-1 do
Begin
CurElmType:=CurHeadCol [CurRow-1-SHeadRowNum].ElmType;
If CurElmType=bc_Number then {записуємо число, якщо є числом:}
CurGrid. Cells [SHeadColNum, CurRow]:=
FloatToStr (CurHeadCol[CurRow-1-SHeadRowNum].AsNumber)
Else {Якщо це не число, то це рядок з якоюсь назвою. Записуємо:}
Self. CurGrid. Cells [SHeadColNum, CurRow]:=
CurHeadCol [CurRow-1-SHeadRowNum].AsVarName;
End;
{Відображаємо таблицю коефіцієнтів:}
For CurRow:=SHeadRowNum+1 to Self. CurGrid. RowCount-1 do
Begin
For CurCol:=SHeadColNum+1 to Self. CurGrid. ColCount-1 do
CurGrid. Cells [CurCol, CurRow]:=
FloatToStr (Self. CurTable [CurRow-1-SHeadRowNum, CurCol-1-SHeadColNum]);
End;
{Комірка на перехресті заголовків пуста:}
If (SHeadRowNum<Self. CurGrid. RowCount) and
(SHeadColNum<Self. CurGrid. ColCount) then
CurGrid. Cells [SHeadColNum, SHeadRowNum]:='';
{Після запису в екранну таблицю: зміни, що могли бути у ній, вважаємо
затертими:}
Self. CurGridModified:=False;
{Якщо задано, настроюємо ширини стовпців по довжині тексту у комірках:}
If ToTuneColWidth then Self. CurGrid. TuneColWidth;
WriteTableToGrid:=True;
End;
Procedure TGridFormattingProcs. GetTaskSizes (Var DWidth, DHeight: Integer);
{Визначення розмірів таблиці задачі, і корегування довжини заголовків
таблиці та зовнішнього масиву таблиці (масиву масивів).}
Begin
DHeight:=Length (Self. CurTable);
If DHeight>0 then
DWidth:=Length (Self. CurTable[0])
Else DWidth:=0;
If DWidth=0 then DHeight:=0;
If DWidth>Length (Self. CurHeadRow) then
DWidth:=Length (Self. CurHeadRow);
If DHeight>Length (Self. CurHeadCol) then
DHeight:=Length (Self. CurHeadCol);
{Якщо комірок немає, то:}
If DWidth=0 then
Begin
{Зовнійшій масив встановлюємо у нульову довжину:}
SetLength (Self. CurTable, 0);
{Заголовки теж:}
SetLength (Self. CurHeadRow, 0);
SetLength (Self. CurHeadCol, 0);
End;
End;
{Розміри прочитаної таблиці задачі:}
Function TGridFormattingProcs. TaskWidth: Integer;
Var CurWidth, CurHeight: Integer;
Begin
Self. GetTaskSizes (CurWidth, CurHeight);
TaskWidth:=CurWidth;
End;
Function TGridFormattingProcs. TaskHeight: Integer;
Var CurWidth, CurHeight: Integer;
Begin
Self. GetTaskSizes (CurWidth, CurHeight);
TaskHeight:=CurHeight;
End;
Function TGridFormattingProcs. GetTask (ToPrepareGrid: Boolean=True):Boolean;
{Зчитування умови задачі із CurGrid та відображення прочитаного
на тому ж місці, де воно було. Працює у режимах
fs_EnteringEqs і fs_EnteringLTask.}
Const sc_CurProcName='GetTask';
Var Res1: Boolean;
Procedure DoGetTask;
Begin
If ToPrepareGrid then
CurGrid. ShrinkToFilled (Self.CHeadColNum+1, Self.CHeadRowNum+1);
{Читаємо комірки таблиці:}
Res1:=Self. ReadTableFromGrid;
{Відображаємо те, що вийшло прочитати, у тих самих комірках на екрані:}
If Not (Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum)) then
Res1:=False;
End;
Begin
If Self. CurGrid=Nil then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+': '+sc_NoGrowingStringGrid);
GetTask:=False;
Exit;
End;
Case Self. CurFormatState of
fs_EnteringEqs: {режим редагування системи лінійних рівнянь:}
Begin
{Зчитуємо таблицю. Як рядок-заголовок зчитуємо автоматично
сформовані назви змінних x1…xn та множник вільних членів (1).
Як стовпець-заголовок зчитуємо стовпець нумерації.
При переході до режиму вирішування задачі у цей стовпець
будуть скопійовані вільні члени (режим способу 1, fs_SolvingEqsM1),
або нулі (режим способу 2, fs_SolvingEqsM2):}
DoGetTask;
If Not(Res1) then Begin GetTask:=False; Exit; End;
End;
fs_EnteringLTask: {режим редагування форми задачі лінійного програмування:}
Begin
{Зчитуємо таблицю умови для задачі ЛП максимізації або
мінімізації лінійної форми (функції з умовами-нерівностями,
рівняннями та обмеженнями невід'ємності, імена змінних, нерівностей,
функцій):}
DoGetTask;
If Not(Res1) then Begin GetTask:=False; Exit; End;
End;
fs_FreeEdit: {режим вільного редагування:}
Begin
{Читаємо таблицю, рядок-заголовок, стовпець-заголовок:}
DoGetTask;
If Not(Res1) then Begin GetTask:=False; Exit; End;
End;
Else {інші режими:}
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName + sc_CantReadTaskInCurMode
+ sc_TriSpot);
GetTask:=False;
Exit;
End;
End;
{If ToPrepareGrid then CurGrid. TuneColWidth;}
Self. EqM1TaskPrepared:=False;
Self. EqM2TaskPrepared:=False;
Self.LTaskPrepared:=False;
GetTask:=True;
End;
Procedure TGridFormattingProcs. Refresh;
Const sc_CurProcName='Refresh';
Var Res1: Boolean;
Begin
If Self. CurFormatState<>fs_NoFormatting then
Begin
If Self. CurGrid=Nil then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+': '+
sc_NoGrowingStringGrid);
Exit;
End;
Res1:=False;
{Якщо таблиця редагована або ще не читана, то запускаємо її зчитування:}
If Self. CurGridModified or (Self. TaskWidth<=0) then Res1:=Self. GetTask;
If Not(Res1) then {Якщо таблиця не була віджображена у GetTask, відображаємо:}
Self. WriteTableToGrid (Self.CHeadColNum, Self.CHeadRowNum);
End;
End;
Procedure TGridFormattingProcs. ResetModified; {скидає прапорець зміненого стану}
Begin
Self. CurGridModified:=False;
End;
Procedure TGridFormattingProcs. UndoChanges;
{Відкидає останні зміни (ResetModified+Refresh).}
Begin
Self. ResetModified; Self. Refresh;
End;
Procedure Transpose (Var SDMatrix:TFloatMatrix);
{Транспонування двовимірної матриці.}
Var CurCol, CurRow, CurWidth, CurHeight: Integer;
SafeElm:TWorkFloat;
Begin
CurHeight:=Length(SDMatrix);
If CurHeight>0 then CurWidth:=Length (SDMatrix[0])
Else CurWidth:=0;
If (CurHeight=0) or (CurWidth=0) then Exit;
{Збільшуємо розміри матриці до квадратних:}
If CurWidth>CurHeight then {Якщо ширина була більша за висоту:}
Begin
SetLength (SDMatrix, CurWidth, CurWidth); {збільшуємо висоту}
End
Else if CurWidth<CurHeight then {Якщо висота була більша за ширину:}
Begin
SetLength (SDMatrix, CurHeight, CurHeight); {збільшуємо ширину}
End;
{Міняємо елементи місцями: рядки будуть стовпцями, а стовпці - рядками:}
For CurRow:=0 to Length(SDMatrix) - 1 do
Begin
For CurCol:=CurRow + 1 to Length (SDMatrix[CurRow]) - 1 do
Begin
SafeElm:=SDMatrix [CurRow, CurCol];
SDMatrix [CurRow, CurCol]:=SDMatrix [CurCol, CurRow];
SDMatrix [CurCol, CurRow]:=SafeElm;
End;
End;
{Ширина тепер буде така як була висота, а висота - як була ширина:}
SetLength (SDMatrix, CurWidth, CurHeight);
End;
Function TGridFormattingProcs. MakeDualLTask: Boolean;
{Перехід від зчитаної умови задачі максимізації чи мінімізації
лінійної форми до двоїстої задачі. Працює у режимі редагування
задачі максимізації-мінімізації (fs_EnteringLTask).
За правилом двоїсту задачу потрібно мінімізувати, якщо для прямої
потрібно було знайти максимум, і максимізувати, якщо для прямої потрібно
було знайти мінімум.
}
Const sc_CurProcName='MakeDualLTask';
Var SafeMas:TValOrNameMas; CurCol, CurRow, DFuncCount: Integer;
DualTType:TDualTaskType; NewDFuncType, OldDFuncType:THeadLineElmType;
Begin
SafeMas:=Nil;
If Self. CurFormatState<>fs_EnteringLTask then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_CanMakeOnlyInELTaskMode);
MakeDualLTask:=False; Exit;
End;
If Self. CurGridModified then
Begin
If Not (Self. GetTask(True)) then
Begin
MakeDualLTask:=False; Exit;
End;
End;
If Self. TaskHeight<=0 then {Якщо таблиця пуста:}
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+sc_EmptyTable);
MakeDualLTask:=False; Exit;
End;
{Перевіряємо, чи функція мети лише одна, і визначаємо її тип
(для максимізації чи мінімізації):}
DFuncCount:=0; DualTType:=dt_MaxToMin; OldDFuncType:=bc_DestFuncToMax;
For CurRow:=0 to Length (Self. CurHeadCol) - 1 do
Begin
If Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMax then
Begin
DualTType:=dt_MaxToMin;
OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;
Inc(DFuncCount);
End
Else if Self. CurHeadCol[CurRow].ElmType=bc_DestFuncToMin then
Begin
DualTType:=dt_MinToMax;
OldDFuncType:=Self. CurHeadCol[CurRow].ElmType;
Inc(DFuncCount);
End;
End;
{Якщо функцій мети декілька або жодної:}
If DFuncCount<>1 then
Begin
If Self. CurOutConsole<>Nil then
Self. CurOutConsole. Lines. Add (sc_CurProcName+
sc_CanMakeDTaskOnlyForOneDFunc+IntToStr(DFuncCount));
MakeDualLTask:=False; Exit;
End;
If DualTType=dt_MaxToMin then NewDFuncType:=bc_DestFuncToMin
Else NewDFuncType:=bc_DestFuncToMax;
{Зсуваємо рядок функції мети вниз таблиці. При цьому позначки порядку
рядків залишаємо на тих самих місцях (і присвоюємо тим рядкам, які
стають на ці місця):}
Self. ShiftRowsDown([bc_DestFuncToMax, bc_DestFuncToMin], True);
Transpose (Self. CurTable); {транспонуємо таблицю коефіцієнтів}
{Обробляємо заголовки таблиці у відповідність до двоїстої задачі:}
{Для рядка-заголовка, що стане стовпцем-заголовком:}
For CurCol:=0 to Length (Self. CurHeadRow) - 1 do
Begin {Проходимо по усіх змінних і останньому елементу -
множнику стовпця вільних членів - одиниці:}
If Self. CurHeadRow[CurCol].ElmType=bc_DependentVar then {Якщо змінна >=0:}
Begin {Ця комірка буде заголовком функції умови-нерівності зі знаком «>=»:}
Self. CurHeadRow[CurCol].ElmType:=bc_FuncVal;
Self. CurHeadRow[CurCol].VarInitInRow:=False;
{Формуємо назву функції:}
{якщо змінна має назву змінної двоїстої задачі, то дамо назву
функції прямої задачі, якщо назва прямої - назву двоїстої:}
If Pos (sc_DualTaskVarNameStart, Self. CurHeadRow[CurCol].AsVarName)>0 then
Self. CurHeadRow[CurCol].AsVarName:=sc_YFuncName + IntToStr (CurCol+1)
Else Self. CurHeadRow[CurCol].AsVarName:=sc_DualTaskFuncNameStart +
IntToStr (CurCol+1);
{Якщо переходимо від задачі максимізації до двоїстої задачі
мінімізації, то для нерівності треба буде змінити знак «>=» на «<=»,
(якщо для змінної була умова «>=0», і заголовок для неї був додатний),
тому змінюємо знак заголовка:}
If DualTType=dt_MaxToMin then
ChangeSignForValOrVarName (Self. CurHeadRow[CurCol]);
End {Якщо змінна вільна:}
Else if Self. CurHeadRow[CurCol].ElmType=bc_IndependentVar then
Begin {Ця комірка буде заголовком умови-рівняння:}
Self. CurHeadRow[CurCol].ElmType:=bc_Number;
Self. CurHeadRow[CurCol].AsNumber:=0;
End {Якщо це число:}
Else if Self. CurHeadRow[CurCol].ElmType=bc_Number then
Begin
If Self. CurHeadRow[CurCol].AsNumber=1 then {якщо це множник вільних членів}
Begin
Self. CurHeadRow[CurCol].ElmType:=NewDFuncType;
Self. CurHeadRow[CurCol].VarInitInRow:=False;
{Формуємо назву функції мети двоїстої задачі
(залежно від назви функції мети поданої задачі):}
If Pos (sc_DualDestFuncHdr,
Self. CurHeadCol [Length(Self. CurHeadCol) - 1].AsVarName)>0 then
Self. CurHeadRow[CurCol].AsVarName:=sc_DestFuncHdr
Else Self. CurHeadRow[CurCol].AsVarName:=sc_DualDestFuncHdr;
End;
End;
End;
{Для стовпця-заголовка, що стане рядком-заголовком:}
For CurRow:=0 to Length (Self. CurHeadCol) - 1 do
Begin
{Проходимо по усіх елементах-заголовках рядків, і останньому елементу -
заголовку рядка функції мети:}
If Self. CurHeadCol[CurRow].ElmType=bc_FuncVal then {Якщо нерівність «<=»:}
Begin
Self. CurHeadCol[CurRow].ElmType:=bc_DependentVar; {буде змінна >=0}
Self. CurHeadCol[CurRow].VarInitInRow:=True;
{Формуємо назву змінної:
якщо функція-нерівність має назву функції двоїстої задачі, то
дамо назву змінної прямої задачі, якщо назва прямої - назву двоїстої:}
If Pos (sc_DualTaskFuncNameStart, CurHeadCol[CurRow].AsVarName)>0 then
Self. CurHeadCol[CurRow].AsVarName:=sc_XVarName + IntToStr (CurRow+1)
Else Self. CurHeadCol[CurRow].AsVarName:=sc_DualTaskVarNameStart +
IntToStr (CurRow+1);
{Якщо переходимо від задачі мінімізації до двоїстої задачі
максимізації, то для змінної треба буде змінити знак і умову «<=0»
на «>=0», (якщо для нерівність була зі знаком «<=», і заголовок для
неї був додатний), тому змінюємо знак заголовка:}
If DualTType=dt_MinToMax then
ChangeSignForValOrVarName (Self. CurHeadCol[CurRow]);
End
Else if Self. CurHeadCol[CurRow].ElmType=bc_Number then
Begin
If Self. CurHeadCol[CurRow].AsNumber=0 then {Якщо 0, заголовок рівняння:}
Подобные документы
Задача лінійного програмування. Розв’язання задачі геометричним методом. Приведення системи рівнянь до канонічного вигляду. Розв’язання симплекс-методом. Розв’язок двоїстої задачі. Задача цілочислового програмування і дробово-лінійного програм.
контрольная работа [385,2 K], добавлен 04.06.2009Лінійне програмування як один з найбільш популярних апаратів математичної теорії оптимального управління рішень. Опис існуючих методів розв’язку задач лінійного програмування. Завдання, основні принципи, алгоритми і головна мета лінійного програмування.
курсовая работа [363,8 K], добавлен 03.12.2009Теоретичні основи та приклади економічних задач лінійного програмування. Розробка математичної моделі задачі (запис цільової функції і системи обмежень) і програмного забезпечення її вирішення за допомогою "Пошуку рішень" в Excel симплекс-методом.
курсовая работа [993,9 K], добавлен 10.12.2010Використання мови програмуванння Java при виконанні "задачі лінійного програмування": її лексична структура і типи даних. Методи розв’язання задачі. Особливості логічної структури програми, побудова її зручного інтерфейсу за допомогою симплекс методу.
курсовая работа [437,9 K], добавлен 24.01.2011Загальний вид двовимірного завдання лінійного програмування. Алгоритм рішення задач графічним методом. Максимізація (мінімізація) цільової функції. Послідовність рішення завдань лінійного програмування симплексом-методом. Принцип перетворення Гауса.
контрольная работа [149,8 K], добавлен 24.11.2010Початковий опорний план, перехід від одного до іншого. Оптимальний розв’язок, його головні критерії. Знаходження опорного плану задачі, складання симплексної таблиці. Приклад оформлення першої та другої таблиці для розв’язку задач лінійного програмування.
лекция [479,7 K], добавлен 10.10.2013Застосування симплекс-методу для розв’язання оптимізаційних задач лінійного програмування, що містять три змінні. Функції ітераційної обчислювальної процедури, що виконують приведення до зручного для розв’язання оптимального вигляду ЗЛП за кілька кроків.
курсовая работа [359,5 K], добавлен 18.09.2013Основні визначення дослідження операцій. Модель "затрати-випуск" В.В. Леонтьєва. Загальний вигляд задачі лінійного програмування. Розв'язання за допомогою симплекс-методу. Економічна інтерпретація основної та спряженої задач. Поліпшення плану перевезень.
учебное пособие [1,1 M], добавлен 27.12.2010Метод Якобі є узагальненням симплекса-методу лінійного програмування. Він використовується для дослідження чутливості оптимального значення функції до змін у правих частинах обмежень. Умови існування екстремумів функцій при відсутності обмежень.
курсовая работа [326,6 K], добавлен 09.01.2009Постановка задачі багатокритеріальної оптимізації та її та математична модель. Проблеми і класифікація методів вирішення таких задач, способи їх зведення до однокритеріальних. Метод послідовних поступок. Приклад розв'язування багатокритеріальної задачі.
курсовая работа [207,3 K], добавлен 22.12.2013