Курсовая работа: Багатокритеріальна задача лінійного програмування
процедури обробки комірки для задавання їй обраного типу SAssocType.
Значення SAssocType записує у поле Tag об'єкта пункту меню:}
Procedure AddCellTypeItemToMenu (SMenu:TPopupMenu;
SCaption: String; IsCurrentItem: Boolean; SAssocType:THeadLineElmType;
ToSetReactOnClick: Boolean=True);
{Обробник вибору пункту в меню типів для комірки
рядка – чи стовпця-заголовка.}
Procedure ProcOnCellTypeSelInMenu (Sender: TObject);
{Процедури для нумерації рядків і стовпців при відображенні
таблиць у ході вирішення задачі, або з результатами. Лише
проставляють номери у першому стовпцю і першому рядку:}
procedure NumerationOnNewRow (Sender: TObject; NewRows: array of Integer);
procedure NumerationOnNewCol (Sender: TObject; NewCols: array of Integer);
{Процедура для реагування на редагування вмісту комірок
під час редагування вхідних даних. Встановлює прапорець
CurGridModified:=True про те, що екранна таблиця має зміни:}
procedure ReactOnSetEditText (Sender: TObject; ACol, ARow: Longint;
const Value: string);
{Зчитує комірку з екранної таблиці в рядок-заголовок.
Вхідні дані:
SCol – номер комірки у рядку-заголовку.
Для екранної таблиці використовуються координати комірки відповідно до
координат рядка-заголовка та стовпця заголовка (верхнього лівого кута
таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid:}
Procedure ReadHeadRowCell (SCol: Integer);
{Зчитує комірку з екранної таблиці в стовпець-заголовок.
Вхідні дані:
SRow – номер комірки у стовпці-заголовку.
Для екранної таблиці використовуються координати комірки відповідно до
координат рядка-заголовка та стовпця заголовка (верхнього лівого кута
таблиці з заголовками): HeadColNumInGrid і HeadRowNumInGrid:}
Procedure ReadHeadColCell (SRow: Integer);
{Процедура для зчитування таблиці та її заголовків із CurGrid:}
Function ReadTableFromGrid: Boolean;
{Процедура для відображення таблиці та її заголовків у CurGrid:}
Function WriteTableToGrid (SHeadColNum, SHeadRowNum: Integer;
ToTuneColWidth: Boolean=True):Boolean;
{Визначення розмірів таблиці задачі, і корегування довжини
заголовків таблиці та зовнішнього масиву таблиці (масиву масивів):}
Procedure GetTaskSizes (Var DWidth, DHeight: Integer);
{Жорданове виключення за заданим розв'язувальним елементом матриці:}
Function GI (RozElmCol, RozElmRow: Integer;
Var SDHeadRow, SDHeadCol:TValOrNameMas; Var SDMatrix:TFloatMatrix;
Var DColDeleted: Boolean; ToDoMGI: Boolean=False;
ToDelColIfZeroInHRow: Boolean=True):Boolean;
{Відображення таблиці, обробка віконних подій доки користувач не
скомандує наступний крок (якщо користувач не скомандував вирішувати
до кінця):}
Procedure WaitForNewStep (HeadColNum, HeadRowNum: Integer);
{Пошук ненульової розв'язувальної комірки для вирішування системи
рівнянь (починаючи з комірки [CurRowNum, CurColNum]):}
Function SearchNozeroSolveCell (CurRowNum,
CurColNum, MaxRow, MaxCol: Integer;
HeadRowNum, HeadColNum: Integer;
ToSearchInRightColsToo: Boolean=True):Boolean;
{Зміна знаків у рядку таблиці і відповідній комірці у
стовпці-заголовку:}
Procedure ChangeSignsInRow (CurRowNum: Integer);
{Зміна знаків у стовпці таблиці і відповідній комірці у
рядку-заголовку:}
Procedure ChangeSignsInCol (CurColNum: Integer);
{Функція переміщує рядки таблиці CurTable (разом із відповідними
комірками у стовпці-заголовку CurHeadCol) з заданими типами комірок
стовпця-заголовка вгору.
Повертає номер найвищого рядка із тих, що не було задано
переміщувати вгору (вище нього – ті, що переміщені вгору):}
Function ShiftRowsUp (SHeadColElmTypes:THeadLineElmTypes;
ToChangeInitPosNums: Boolean=False):Integer;
{Аналогічна до ShiftRowsUp, але переміщує вниз.
Повертає номер найвищого рядка із тих, що переміщені вниз (вище
нього – рядки тих типів, що не було задано переміщувати донизу):}
Function ShiftRowsDown (
SHeadColElmTypes:THeadLineElmTypes;
ToChangeInitPosNums: Boolean=False):Integer;
{Вирішування системи лінійних рівнянь способом 1:}
Function SolveEqsWithM1: Boolean;
{Вирішування системи лінійних рівнянь способом 2:}
Function SolveEqsWithM2: Boolean;
{Вирішування задачі максимізації лінійної форми (що містить
умови-нерівності, рівняння та умови на невід'ємність окремих
змінних і одну функцію мети, для якої треба знайти максимальне
значення):}
Function SolveLTaskToMax (DualTaskVals: Boolean):Boolean;
Function PrepareDFuncForSimplexMaximize: Boolean;
Function PrepareDestFuncInMultiDFuncLTask (SFuncRowNum,
MinDestFuncRowNum: Integer):Boolean;
{Процедура зчитує значення функції мети у таблиці розв'язаної
однокритеріальної задачі, і значення усіх змінних або функцій
в цьому розв'язку. Відображає значення цих змінних,
функцій-нерівностей, і функції мети в Self. CurOutConsole:}
Procedure ShowLTaskResultCalc (DualTaskVals: Boolean);
{Процедура зчитує значення функції мети у таблиці розв'язаної
однокритеріальної задачі, і значення усіх змінних або функцій в
цьому розв'язку:}
Procedure ReadCurFuncSolution (Var SDValVecs:TFloatMatrix;
Var SDDestFuncVals:TFloatArr; SVecRow: Integer;
ToReadFuncVals: Boolean; DualTaskVals: Boolean);
Procedure BuildPaymentTaskOfOptim (
Const SOptimXVecs:TFloatMatrix; Const SOptimFuncVals:TFloatArr;
SFirstDFuncRow: Integer);
Procedure CalcComprVec (Const SVarVecs:TFloatMatrix;
Const SWeightCoefs:TFloatArr; Var DComprVec:TFloatArr);
Function CalcDFuncVal (Const SVarVec:TFloatArr;
SDestFuncRowNum: Integer):TWorkFloat;
{Вирішування задачі багатокритеріальної оптимізації лінійної
форми з використанням теоретико-ігрового підходу.
Умовою задачі є умови-нерівності, рівняння та умови на
невід'ємність окремих змінних, і декілька функцій мети, для
яких треба знайти якомога більші чи менші значення.
Функція повертає ознаку успішності вирішування:}
Function SolveMultiCritLTask: Boolean;
{Процедури для зміни позиціювання таблиці з заголовками у
екранній таблиці CurGrid. Працюють лише у режимі fs_FreeEdit:}
Procedure SetHeadColNum (Value: Integer);
Procedure SetHeadRowNum (Value: Integer);
public
{Прапорці для керування кроками вирішування:
Continue – продовжити на один крок;
GoToEnd – при продовженні йти всі кроки до кінця вирішування без
відображення таблиці на кожному кроці;
Stop – припинити вирішування.
Для керування прапорці можуть встановлюватися іншими потоками
програми, або і тим самим потоком (коли процедури даного класу
викликають Application. ProcessMessages):}
Continue, GoToEnd, Stop: Boolean;
{Властивість для керуання станом форматування:}
Property TableFormatState:TTableFormatState read CurFormatState
write SetNewState default fs_NoFormatting;
{Прапорець про те, що зараз задача у ході вирішування
(між кроками вирішування):}
Property Solving: Boolean read InSolving;
Property SolutionFound: Boolean read SolWasFound;
Property NoRoots: Boolean read WasNoRoots;
Property ManyRoots: Boolean read WasManyRoots;
{Властивість для задавання екранної таблиці:}
Property StringGrid:TGrowingStringGrid read CurGrid write SetNewGrid
default Nil;
{Поле для відображення повідомлень:}
Property MemoForOutput:TMemo read CurOutConsole write SetNewMemo
default Nil;
{Номери стовпця і рядка-заголовків у CurGrid. Змінювати можна
тільки у режимі fs_FreeEdit. В інших режимах зміна ігнорується:}
Property HeadColNumInGrid: Integer read CHeadColNum write SetHeadColNum;
Property HeadRowNumInGrid: Integer read CHeadRowNum write SetHeadRowNum;
{Таблиця і її заголовки у пам'яті:}
Property Table:TFloatMatrix read CurTable;
Property HeadRow:TValOrNameMas read CurHeadRow;
Property HeadCol:TValOrNameMas read CurHeadCol;
{Читання і запис таблиці та режиму редагування у файл
(тільки у режимах редагування):}
Function ReadFromFile (Const SPath: String):Boolean;
Function SaveToFile (Const SPath: String):Boolean;
{Процедури для читання і зміни таблиці і її заголовків.
Не рекомендується застосовувати під час вирішування
(при Solving=True):}
Procedure SetTable (Const SHeadRow, SHeadCol:TValOrNameMas;
Const STable:TFloatMatrix);
Procedure GetTable (Var DHeadRow, DHeadCol:TValOrNameMas;
Var DTable:TFloatMatrix);
{Вибір кольору для фону комірки за типом елемента
стовпця – або рядка-заголовка:}
Function GetColorByElmType (CurType:THeadLineElmType):TColor;
{Вибір назви комірки за типом елемента
стовпця – або рядка-заголовка:}
Function GetNameByElmType (CurType:THeadLineElmType):String;
{Зчитування умови задачі із CurGrid та відображення прочитаного
на тому ж місці, де воно було. Працює у режимах
fs_EnteringEqs і fs_EnteringLTask.}
Function GetTask (ToPrepareGrid: Boolean=True):Boolean;
{Приймає останні зміни при редагуванні і відображає таблицю:}
Procedure Refresh;
Procedure ResetModified; {скидає прапорець зміненого стану}
Procedure UndoChanges; {відкидає останні зміни (ResetModified+Refresh)}
{Перехід від зчитаної умови задачі максимізації чи мінімізації
лінійної форми до двоїстої задачі. Працює у режимі редагування
задачі максимізації-мінімізації (fs_EnteringLTask):}
Function MakeDualLTask: Boolean;
{Розміри прочитаної таблиці задачі:}
Function TaskWidth: Integer;
Function TaskHeight: Integer;
{Запускач вирішування. Працює у режимах fs_SolvingEqsM1,
fs_SolvingEqsM2, fs_SolvingLTask:}
Function Solve (ToGoToEnd: Boolean=False):Boolean;
Constructor Create;
Destructor Free;
End;
{Визначає знак дійсного числа:}
Function ValSign (Const Value:TWorkFloat):TSignVal; overload;
Function ValSign (Const Value:TValOrName):TSignVal; overload;
Function GetValOrNameAsStr (Const Value:TValOrName):String;
Procedure ChangeSignForValOrVarName (Var SDValOrName:TValOrName);
Procedure DeleteFromArr (Var SArr:TValOrNameMas; Index, Count: Integer);
overload;
Procedure DeleteFromArr (Var SArr:TFloatArr; Index, Count: Integer); overload;
Procedure DelColsFromMatr (Var SDMatrix:TFloatMatrix; ColIndex, Count: Integer);
Procedure DelRowsFromMatr (Var SDMatrix:TFloatMatrix; RowIndex, Count: Integer);
Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix; Row1, Row2: Integer);
overload;
Procedure ChangeRowsPlaces (Var SDMatr:TFloatMatrix;
Var SDHeadCol:TValOrNameMas; Row1, Row2: Integer;
ToChangeInitPosNums: Boolean=False); overload;
Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix; Col1, Col2: Integer);
overload;
Procedure ChangeColsPlaces (Var SDMatr:TFloatMatrix;
Var SDHeadRow:TValOrNameMas; Col1, Col2: Integer;
ToChangeInitPosNums: Boolean=False); overload;
{Транспонування двовимірної матриці:}
Procedure Transpose (Var SDMatrix:TFloatMatrix);
implementation
const
sc_InvCoordsOfResolvingElm=
'Немає розв''язуючого елемента з такими координатами';
sc_ZeroResolvingElm='Розв''язуючий елемент рівний нулю';
sc_MatrixSize='Розміри матриці';
sc_NoGrowingStringGrid='GrowingStringGrid не заданий' + sc_TriSpot;
sc_UnknownVarType='Невідомий тип змінної';
sc_TableIsNotReady=': таблиця не готова' + sc_TriSpot;
sc_WrongEditMode=': не той режим редагування'+
' задачі. Не можу перейти до розв''язування' + sc_TriSpot;
sc_EmptyTable=': таблиця пуста' + sc_TriSpot;
sc_CantReadTaskInCurMode=
': у поточному режимі умова задачі не зчитується';
sc_CantWriteTaskInCurMode=
': не можу записати умову задачі з поточного режиму'+sc_TriSpot;
sc_CantCloseFile=': не можу закрити файл:'+sc_DoubleQuot;
sc_StartSolving=': починаю розв''язування' + sc_TriSpot;
sc_ZeroKoef=': нульовий коефіцієнт';
sc_SearchingOther=' шукаю інший' + sc_TriSpot;
sc_AllKoefIsZeroForVar=': усі коефіцієнти є нулі для змінної';
sc_AllKoefIsZero=': усі коефіцієнти для потрібних змінних є нулі'+sc_TriSpot;
sc_FreeVar=': вільна змінна (у її стовпці лише нулі, не впливає на результат)';
sc_NoRoots='Коренів немає.';
sc_NoVals='Значень немає.';
sc_ManyRoots='Коренів безліч.';
sc_UnlimitedFunc='Функція мети не обмежена.';
sc_SolutionFound='Корені знайдено.';
sc_ValFound='Значення знайдено.';
sc_SolvingStopped=': розв''язування припинено' + sc_TriSpot;
sc_ExcludingFreeVars=': виключаю незалежні змінні' + sc_TriSpot;
sc_CantExcludeFreeVars=': не можу виключити усі незалежні змінні.'+
sc_Space+sc_UnlimitedFunc;
sc_AllFreeVarsExcluded=': усі незалежні змінні виключені.';
sc_NoTableAreaToWork=
': Увага! У таблиці більше немає комірок для наступної обробки'+sc_TriSpot;
sc_ExcludingZeroRows=': виключаю 0-рядки' + sc_TriSpot;
sc_AllZeroInRow=': усі елементи – нулі у рядку';
sc_NoMNN=': не можу знайти МНВ для стовпця';
sc_AllZeroRowsExcluded=': усі 0-рядки виключені.';
sc_SearchingBaseSolve=': шукаю опорний розв''язок' + sc_TriSpot;
sc_BaseSolveFound=': опорний розв''язок знайдено.';
sc_SearchingOptimSolve=': шукаю оптимальний розв''язок' + sc_TriSpot;
sc_NoSolveMode=': поточний режим не є режимом для розв''язування'+sc_TriSpot;
sc_ValNotAvail='значення не доступно' + sc_TriSpot;
sc_ResultIs='Результат ';
sc_ForDualTask='для двоїстої задачі (відносно розв''язаної):';
sc_ForDirectTask='для прямої задачі:';
sc_InHeadRow='У рядку-заголовку:';
sc_InHeadCol='У стовпці-заголовку:';
sc_ResFunc='Функція мети:';
sc_CanMakeOnlyInELTaskMode='до двоїстої задачі можна переходити лише у '+
'режимі fs_EnteringLTask' + sc_TriSpot;
sc_CanMakeDTaskOnlyForOneDFunc=': можу переходити до двоїстої задачі ' +
'тільки від однокритеріальної задачі ЛП (з одною функцією мети). '+
'Всього функцій мети: ';
sc_CantChangeStateInSolving=
': не можу міняти режим під час розв''язування…';
sc_CantDetMenuItem=': не визначено пункт меню, який викликав процедуру…';
sc_UnknownObjectCall=': невідомий об''єкт, який викликав процедуру: клас ';
sc_NoCellOrNotSupported=': комірка не підтримується або не існує: ';
sc_Row='Рядок'; sc_Col='Стовпець';
sc_CantOpenFile=': не можу відкрити файл: «';
sc_EmptyFileOrCantRead=': файл пустий або не читається: «';
sc_FileNotFullOrHasWrongFormat=': файл не повний або не того формату: «';
sc_CantReadFile=': файл не читається: «';
sc_CantCreateFile=': не можу створити файл: «';
sc_CantWriteFile=': файл не вдається записати: «';
sc_CurRowNotMarkedAsDestFunc=
': заданий рядок не помічений як функція мети: рядок ';
sc_RowNumsIsOutOfTable=': задані номери рядків виходять за межі таблиці!..';
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14