![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Приложение. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ⇐ ПредыдущаяСтр 5 из 5
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ComCtrls, Menus;
type TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; TabSheet3: TTabSheet; strGrdTrade: TStringGrid; Label1: TLabel; edt1: TEdit; Label2: TLabel; edt2: TEdit; Button1: TButton; Button2: TButton; strGrdPlan: TStringGrid; Label3: TLabel; Edit1: TEdit; Button3: TButton; StrGrdPotentials: TStringGrid; StrGrdZakaz: TStringGrid; StrGrdTarif: TStringGrid; Label4: TLabel; Button4: TButton; Button5: TButton; Button7: TButton; Label5: TLabel; MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; Label7: TLabel; Edit2: TEdit;
procedure Button1Click(Sender: TObject); procedure strGrdTradeSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure StrGrdZakazSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure edt1Change(Sender: TObject); procedure edt2Change(Sender: TObject); procedure Button2Click(Sender: TObject); procedure TabSheet2Show(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure TabSheet3Show(Sender: TObject); procedure strGrdPlanSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); procedure Button7Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N4Click(Sender: TObject);
private function CheckTabsheet1(): boolean; function CheckTabSheet2(): boolean; procedure CheckVirojdennost(); function EvaluatePlan(): real; procedure SetupPotentials_UnV(); procedure SetupRating(); function IsRatingGreaterThenZero(): boolean; //procedure RebuildInCycle(); procedure GetPlan(); public { Public declarations } end; const epsilon = 0.000001; var Form1: TForm1;
implementation
{$R *.dfm} ///формирование плана перевозок procedure TForm1.Button1Click(Sender: TObject); var row: integer; begin
row: = strToInt(Edt1.Text); if(row < 1) then ShowMessage('Строк должно быть больше 1') else StrGrdZakaz.RowCount: = row;
StrGrdTarif.ColCount: = StrGrdTrade.RowCount +1; StrGrdTarif.RowCount: = StrGrdTrade.RowCount +1;
end; ///курорты procedure TForm1.strGrdTradeSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); Var str: string; begin str: =strGrdTrade.Cells[1, ARow]; StrGrdTarif.Cells[0, ARow+1]: = str; end; //аэропорты procedure TForm1.StrGrdZakazSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String); Var str: string; begin str: =strGrdZakaz.Cells[1, ARow]; StrGrdTarif.Cells[ARow+1, 0]: = str; end; //указываем кол-во курортов и формируется таблица strgrdtrade procedure TForm1.edt1Change(Sender: TObject); var row: integer; begin if(length(Edt1.Text) > 0) then begin row: = strToInt(Edt1.Text); if(row < 1) then ShowMessage('Строк должно быть больше 1') else StrGrdTrade.RowCount: = row; end; StrGrdTarif.RowCount: = StrGrdTrade.RowCount +1; end; //указываем кол-во аэропортов и формируется таблица strgrdzakaz procedure TForm1.edt2Change(Sender: TObject); var row: integer; begin if(length(Edt2.Text) > 0) then begin row: = strToInt(Edt2.Text); if(row < 1) then ShowMessage('Строк должно быть больше 1') else StrGrdZakaz.RowCount: = row; end; StrGrdTarif.ColCount: = StrGrdZakaz.RowCount +1;
end; /// переход на вкладку мин элемента и формирование там таблицы procedure TForm1.Button2Click(Sender: TObject); var row, col: integer; begin if CheckTabsheet1() then begin for row: = 1 to strGrdPlan.RowCount -1 do for col: = 1 to strGrdPlan.ColCount -1 do strGrdPlan.Cells[col, row]: = '';
TabSheet2.Show(); end;
end;
function TForm1.CheckTabsheet1(): boolean; var i, j: integer; sumTrade, sumZakaz, n: Extended; tarif_setted: boolean; begin
tarif_setted: = true; for j: = 1 to StrGrdTarif.RowCount-1 do for i: = 1 to StrGrdTarif.ColCount-1 do if not TryStrToFloat(StrGrdTarif.Cells[i, j], n) then begin tarif_setted: = false; break; end;
if not tarif_setted then begin ShowMessage('Один или несколько тарифов не указаны. Заполните все тарифы.'); CheckTabSheet1: = false; exit; end;
sumTrade: = 0; for i: = 0 to strGrdTrade.RowCount-1 do if TryStrToFloat(strGrdTrade.Cells[1, i], n) then sumTrade: = sumTrade + n else begin ShowMessage('Полностью заполните таблицу поставщики'); CheckTabSheet1: = false; Exit; end;
sumZakaz: = 0; for i: = 0 to strGrdZakaz.RowCount-1 do if TryStrToFloat(strGrdZakaz.Cells[1, i], n) then sumZakaz: = sumZakaz + n else begin ShowMessage('Полностью заполните таблицу заказчики'); CheckTabSheet1: = false; Exit; end;
if(abs(sumTrade - SumZakaz) > epsilon) then begin ShowMessage('Задача открытого типа. Сумма поставок(' + FloatToStr(SumTrade) + ') Сумма потребностей('+ FloatToStr(sumZakaz)+')'); CheckTabSheet1: = false; Exit; end;
CheckTabSheet1: = true; end; //передаем данныу из таблицы тариф и таблицу план procedure TForm1.TabSheet2Show(Sender: TObject); Var col, row: Integer; begin
if(CheckTabSheet1()) then begin strGrdPlan.RowCount: = StrGrdTarif.RowCount; strGrdPlan.ColCount: = StrGrdTarif.ColCount;
for row: = 0 to strGrdPlan.RowCount -1 do strGrdPlan.Cells[0, row]: = strGrdTarif.Cells[0, row];
for col: = 0 to strGrdPlan.ColCount -1 do strGrdPlan.Cells[col, 0]: = strGrdTarif.Cells[col, 0]; end else TabSheet1.Show(); end;
procedure TForm1.Button4Click(Sender: TObject); begin GetPlan(); Edit1.Text: = FloatToStr(EvaluatePlan()); CheckVirojdennost(); end;
////расчет опорного плана procedure TForm1.GetPlan(); Var min: TPoint; i, j, matrHeight, matrWidth: integer; buf: real; trade, zakaz: array of real; matrix: array of array of real; exit, firstSearch: boolean; begin
SetLength(trade, strGrdTrade.RowCount); ////SetLength размерность массивов for i: = 0 to strGrdTrade.RowCount-1 do trade[i]: = StrToFloat(strGrdTrade.Cells[1, i]);
SetLength(zakaz, strGrdZakaz.RowCount); for i: = 0 to strGrdZakaz.RowCount-1 do zakaz[i]: = StrToFloat(strGrdZakaz.Cells[1, i]);
matrHeight: = strGrdTarif.RowCount-1; //кол-строк matrWidth: = strGrdTarif.ColCount-1; //кол-во столбцов
SetLength(matrix, matrWidth, matrHeight); for j: = 0 to matrHeight-1 do for i: = 0 to matrWidth-1 do matrix[i, j]: = StrToFloat(strGrdTarif.Cells[i+1, j+1]);
repeat //min firstSearch: = true; for j: = 0 to matrHeight-1 do if trade[j] > 0 then // пропуск исключенных строк for i: = 0 to matrWidth-1 do if zakaz[i] > 0 then // пропуск столбцов if (matrix[i, j] < matrix[min.X, Min.Y]) or (firstSearch) then begin min.X: = i; min.Y: = j; firstSearch: = false; end;
//определить число buf: = trade[min.Y] - zakaz[min.X];
if buf < 0 then begin // склад пуст StrGrdPlan.Cells[min.X+1, min.Y+1]: = FloatToStr(trade[min.Y]); trade[min.Y]: = 0; zakaz[min.X]: = abs(buf); end else if buf > 0 then begin // spros udovletvoren StrGrdPlan.Cells[min.X+1, min.Y+1]: = FloatToStr(zakaz[min.X]); trade[min.Y]: = buf; zakaz[min.X]: = 0; end else if buf = 0 then begin // oboim xopoiiio StrGrdPlan.Cells[min.X+1, min.Y+1]: = FloatToStr(trade[min.Y]); trade[min.Y]: = 0; zakaz[min.X]: = 0; end;
// Условие окончания exit: = true; for i: = 0 to strGrdTrade.RowCount-1 do if trade[i] < > 0 then begin exit: = false; break; end;
if not(exit) then continue;
for i: = 0 to strGrdZakaz.RowCount-1 do if zakaz[i] < > 0 then begin exit: = false; break; end;
Until exit; end; // Оценка плана. Вычисление общих затрат на перевозку function TForm1.EvaluatePlan(): real; var buf: real; i, j: integer; begin
// вычисление стоимости buf: = 0; for j: = 1 to strGrdPlan.RowCount-1 do for i: = 1 to strGrdPlan.ColCount-1 do begin if strGrdPlan.Cells[i, j] = '' then strGrdPlan.Cells[i, j]: = '0'; buf: = buf + StrToFloat(strGrdPlan.Cells[i, j]) * StrToFloat(strGrdTarif.Cells[i, j]); end;
EvaluatePlan: = buf;
end;
procedure TForm1.CheckVirojdennost(); var i, j, count: integer; begin count: = 0; for j: = 1 to StrGrdPlan.RowCount-1 do for i: = 1 to StrGrdPlan.ColCount-1 do if StrToFloat(strGrdPlan.Cells[i, j]) > epsilon then count: = count +1;
if count < (StrGrdTrade.RowCount +StrGrdZakaz.RowCount-1) then ShowMessage('План считается вырожденным. Базисных ячеек ' + intToStr(count) + ', что меньше чем необходимые ' + intToSTr(StrGrdTrade.RowCount + StrGrdZakaz.RowCount -1)+ '. Для исключения вырожденности добавьте к одному из поставщиков 0.00001 и к одному из заказчиков 0.00001.'); end;
procedure TForm1.Button5Click(Sender: TObject); var col, row: integer; begin
for row: = 0 to strGrdPotentials.RowCount-1 do for col: = 0 to strGrdPotentials.ColCount-1 do strGrdPotentials.Cells[col, row]: = '';
SetupPotentials_UnV();
// Проверка решения на оптимальность // Проставляем оценки SetupRating();
// поиск отрицательных оценок if IsRatingGreaterThenZero() then begin Label5.Caption: = 'Найден оптимальный план'; ShowMessage('Найден оптимальный план'); Edit2.Text: = FloatToStr(EvaluatePlan()); end else begin ShowMessage('План не оптимален, пересмотрите тариф'); Label5.Caption: = 'План не оптимален';
{RebuildInCycle(); } end;
end;
// проставим потенциалы(шапка) procedure TForm1.SetupPotentials_UnV(); var i, j: integer; V, U: Extended; complete: bool; begin // задаём U1 = 0 (альфа1 = 0) StrGrdPotentials.Cells[0, 1]: = '0';
repeat // повторять пока не найдём все потенциалы complete: = true;
// Вычисление потенциалов U и V. Делаем проход по таблице и вычисляем что можем for j: = 1 to StrGrdPotentials.RowCount-1 do for i: = 1 to StrGrdPotentials.ColCount-1 do begin if StrToFloat(strGrdPlan.Cells[i, j]) > epsilon then begin // Такая же ячейка в плане > 0... if not TryStrToFloat(StrGrdPotentials.Cells[i, 0], V) then begin // И мы ещё не вычислили Vi(столбец), то вычисляем... if TryStrToFloat(StrGrdPotentials.Cells[0, j], U) then begin // и для этой ячейки уже известен Ui(строка) StrGrdPotentials.Cells[i, 0]: = FloatToStr(StrToFloat(strGrdTarif.Cells[i, j]) - U); // V = с - U complete: = false; end; // else для ячейки оба параметра ещё не известны!!! end else if not TryStrToFloat(StrGrdPotentials.Cells[0, j], U) then begin //... и мы ещё не вычислили Ui(строка), вычисляем StrGrdPotentials.Cells[0, j]: = FloatToStr(StrToFloat(strGrdTarif.Cells[i, j]) - V); // U = C -V complete: = false; end else begin // для ячейки оба параметра ещё не известны, пока пропустим её end; // второй else end; end; // end for until complete; end;
///////////////////////////// //Проставляем оценки ячейкам procedure TForm1.SetupRating(); var i, j: integer; num: real; begin // Пробежимся по всем ячейкам в таблице потенциалов... for j: = 1 to StrGrdPotentials.RowCount-1 do for i: = 1 to StrGrdPotentials.ColCount-1 do begin num: = StrToFloat(strGrdPlan.Cells[i, j]); if num < epsilon then begin // для такая же ячейка в плане больше нуля, поэтому вычислим оценку = C -U -V StrGrdPotentials.Cells[i, j]: = FloatToStr(StrToFloat(strGrdTarif.Cells[i, j]) - StrToFloat(StrGrdPotentials.Cells[0, j]) - StrToFloat(StrGrdPotentials.Cells[i, 0])); end else begin StrGrdPotentials.Cells[i, j]: = '0'; // поставим оценку 0 end; end; end;
//////////////////////////////////////////////////////// // Проверка оценок потенциалов. Если они все больше нуля, // то это означает, что план оптимальный. true - оптимальный, false -нет function TForm1.IsRatingGreaterThenZero(): boolean; var i, j: integer; begin for j: = 1 to StrGrdPotentials.RowCount-1 do for i: = 1 to StrGrdPotentials.ColCount-1 do if strToFloat(StrGrdPotentials.Cells[i, j]) < 0 then begin IsRatingGreaterThenZero: = false; exit; end;
IsRatingGreaterThenZero: = true; end;
|