Список литературы

1. Гольштейн, Е.Г. Линейное программирование./ Гольштейн, Е.Г., Юдин, Д.Б. Теория, методы и приложения. – М., Наука, 1969. – с. 424;

2. Грешилов, А.А. Прикладные задачи математического программирования: учебное пособие для ВУЗов./ Грешилов, А.А. – М., Логос, 2006. – с. 286;

3. Экономико-математическое и компьютерное моделирование:

Стариков А.В., Кущева И.С. – Воронеж 2008г.

4. Экономико-математические модели управления производством (теоретические аспекты). Учебное пособие. Ломкова Е.Н., Эпов А.А. – Волгоград 2005г.

5. Карманов В.Г. Математическое программирование. – М.; Наука, 2000. – 342 с.

6. Ларионов Ю.И., Хажмурадов М.А., Кутуев Р.А. Методы исследований операций: Часть 1, 2010. – 312 с.

7. Моисеев Н.Н., Иванов Ю.П., Столярова Е.М. Методы оптимизации. –М.; Наука, 2002. – 340 с.

8. Шикин Е.В., Чхартишвили А.Г. Математические методы и модели в управлении: Учеб. пособие. – М.: Дело, 2000. – 440 с.

Приложения

Приложение 1.

Приложение 2.

unit p1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, Math, ComCtrls, ExtCtrls, Spin, jpeg;

const

fFigSize: integer = 10; // half size

type

TFigure = class

public

x,y: integer;

num: integer;

flag: integer; // type

val: integer;

p: integer; // при выводе в стринггрид

end;

TLine = class

public

i1, i2: integer;

val: integer;

end;

TData = class

public

Width, Height: integer

Arr: array [0..99, 0..99] of integer;

Left, Top: array[0..99] of integer;

constructor Create;

procedure Reset;

procedure AssignLT( data: TData );

function Min: integer;

end;

TEquation = record

p1, p2: integer;

sum: integer;

solved: boolean;

end;

TVar = record

v: integer;

solved: boolean;

end;

TEqSolve = class

public

Eq: array [0..100] of TEquation;

fV: array [0..100] of TVar;

fEqCount, fVarCount, fH: integer;

function GetU( index: integer ): TVar;

function GetV( index: integer ): TVar;

procedure AddEq( p1, p2, s: integer );

// Количество уравнений динамическое.Количество переменных можно узнать

// сразу.

constructor Create( h, v_c: integer );

procedure Solve;

property U[index: integer]: TVar read GetU;

property V[index: integer]: TVar read GetV;

end; {}

TForm1 = class(TForm)

PageControl1: TPageControl;

TabSheet1: TTabSheet;

StringGrid1: TStringGrid;

Button2: TButton;

Memo1: TMemo;

Label2: TLabel;

Label3: TLabel;

Cols_e1: TEdit;

Rows_e1: TEdit;

UpDown1: TUpDown;

UpDown2: TUpDown;

Image1: TImage;

procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);

private

{ Private declarations }

public

fData: TData;

fFigures: TList;

fLines: TList;

fMouseState : integer;

fMouseInd: integer;

{ Public declarations }

procedure CalcNorthWest( data: TData; var plan: TData );

procedure CalcPotential( data: TData; var plan, x: TData );

procedure Dump( data: TData; fl: integer );

function CalcSum( data, plan: TData ): integer;

procedure ShiftPlan( var data, plan, potential: TData );

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses size;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if (StringGrid1.Col = 1) and (StringGrid1.Row = 1) then

begin

Key := #0;

exit;

end;

if (Key < '0') or (Key > '9') then

Key := #0;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

StringGrid1.Cells[1,0] := 'Магазины';

StringGrid1.Cells[0,1] := 'Склады';

StringGrid1.Cells[1,1] := 'Наличие \ Потребность';

FillChar( fData, sizeof(fData), 0 );

fFigures := TList.Create;

fLines := TList.Create;

fMouseState := 0;

end;

procedure TForm1.Button2Click(Sender: TObject);

function GetInt( x, y: integer ): integer;

begin

Result := StrToInt( StringGrid1.Cells[ x, y ] );

end;

var

index, index2, s, old_s: integer;

data, plan, potential: TData;

begin

Memo1.Lines.Clear;

// Прочитать данные из грида

data := TData.Create;

data.Width := StringGrid1.ColCount-2;

data.Height := StringGrid1.RowCount-2;

for index := 0 to data.Height-1 do

for index2 := 0 to data.Width-1 do

data.Arr[index2,index] := GetInt( index2+2, index+2 );

for index := 0 to data.Width-1 do

data.Top[index] := GetInt( index+2, 1 );

for index := 0 to data.Height-1 do

data.Left[index] := GetInt( 1, index+2 );

plan := TData.Create;

potential := TData.Create;

Memo1.Lines.Add( 'Data' );

Dump( data, 7 );

Memo1.Lines.Add( 'Plan:' );

CalcNorthWest( data, plan );

Dump( plan, 1 );

Memo1.Lines.Add( 'Sum: ' + IntToStr( CalcSum(data, plan) ) ); {}

old_s := 0;

while (true) do

begin

CalcPotential( data, plan, potential );

Memo1.Lines.Add( 'Potential:' );

Dump( potential, 1 ); {}

if (potential.Min >= 0) then

begin

Memo1.Lines.Add( 'Finished' );

break;

end;

ShiftPlan( data, plan, potential );

s := CalcSum(data, plan);

Memo1.Lines.Add( 'res:' );

Dump( plan, 1 );

Memo1.Lines.Add( 'Sum: ' + IntToStr(s) ); {}

if (old_s = s) then

break

else

old_s := s;

end;

end;

{ TData }

procedure TData.AssignLT(data: TData);

var

index: integer;

begin

Reset;

Width := data.Width;

Height := data.Height;

for index := 0 to Width-1 do

Top[index] := data.Top[index];

for index := 0 to Height-1 do

Left[index] := data.Left[index];

end;

constructor TData.Create;

begin

Reset;

end;

procedure TForm1.CalcNorthWest( data: TData; var plan: TData);

var

index, index2, t: integer;

begin

index := 0;

index2 := 0;

plan.AssignLT( data );

while (index < plan.Height) and (index2 < plan.Width) do

begin

t := min( plan.Left[index], plan.Top[index2] );

plan.Arr[index2,index] := t;

plan.Top[index2] := plan.Top[index2]-t;

plan.Left[index] := plan.Left[index]-t;

if (plan.Top[index2] = 0) then

index2 := index2+1;

if (plan.Left[index] = 0) then

index := index+1;

end;

end;

procedure TForm1.Dump(data: TData; fl: integer);

function i2s( i: integer ): string;

var

r: string;

begin

r := IntToStr( i );

while( length(r) < 3 ) do

r := ' ' + r;

Result := r;

end;

var

index, index2: integer;

s: string;

begin

// top

if ((fl and 2) <> 0) then

begin

s := ' ';

for index := 0 to data.Width-1 do

s := s + i2s( data.Top[index] );

Memo1.Lines.Add( s );

end;

if ((fl and 5) = 0) then

exit;

for index := 0 to data.Height-1 do

begin

// left

if ((fl and 4) <> 0) then

s := i2s( data.Left[index] )

else

s := '';

// arr

if ((fl and 1) <> 0) then

for index2 := 0 to data.Width-1 do

s := s + i2s( data.Arr[index2,index] );

Memo1.Lines.Add( s );

end;

end;

function TForm1.CalcSum(data, plan: TData): integer;

var

index, index2, s: integer;

begin

s := 0;

for index := 0 to data.Height-1 do

for index2 := 0 to data.Width-1 do

s := s + data.Arr[index2,index] * plan.Arr[index2, index];

Result := s;

end;

function TData.Min: integer;

var

index, index2, m: integer;

begin

m := MaxInt;

for index := 0 to Height-1 do

for index2 := 0 to Width-1 do

if (m > Arr[index2,index]) then

m := Arr[index2,index];

Result := m;

end;

procedure TData.Reset;

begin

FillChar( Left, sizeof(Left), 0 );

FillChar( Top, sizeof(Top), 0 );

FillChar( Arr, sizeof(Arr), 0 );

end;

{ TEqSolve }

procedure TEqSolve.AddEq( p1,p2,s : integer );

begin

Eq[ fEqCount ].p1 := p1;

Eq[ fEqCount ].p2 := p2 + fH;

Eq[ fEqCount ].sum := s;

Eq[ fEqCount ].solved := false;

Form1.Memo1.Lines.Add( 'u' + IntToStr(p1+1) + ' + v' + IntToStr(p2+1) +

' = ' + IntToStr( s ) ); {}

inc( fEqCount );

end;

constructor TEqSolve.Create( h, v_c: integer );

begin

FillChar( Eq, sizeof(Eq), 0 );

FillChar( fV, sizeof(fV), 0 );

fEqCount := 0;

fVarCount := v_c;

fH := h;

end;

function TEqSolve.GetU(index: integer): TVar;

begin

Result := fV[index];

end;

function TEqSolve.GetV(index: integer): TVar;

begin

Result := fV[index+fH];

end;

procedure TEqSolve.Solve;

var

non_solved, index, c: integer;

ceq: ^TEquation;

begin

FillChar( fV, sizeof(fV), 0 );

non_solved := fVarCount-1;

fV[0].v := 0;

fV[0].solved := true;

while (non_solved > 0) do

begin

c := 0;

for index := 0 to fEqCount-1 do

begin

ceq := @Eq[index];

if (ceq.solved) then continue;

if (fV[ ceq.p1 ].solved) then

begin

fV[ ceq.p2 ].v := ceq.sum - fV[ ceq.p1 ].v;

fV[ ceq.p2 ].solved := true;

inc(c);

ceq.solved := true;

end

else if (fV[ ceq.p2 ].solved) then

begin

fV[ ceq.p1 ].v := ceq.sum - fV[ ceq.p2 ].v;

fv[ ceq.p1 ].solved := true;

inc(c);

ceq.solved := true;

end;

end; // for

if (c = 0) then

exit;

end;

end;

procedure TForm1.CalcPotential(data: TData; var plan, x: TData);

function to_sign( v: integer ): integer;

begin

if (v = 0) then

Result := 1

else

Result := -1;

end;

var

index, index2, t: integer;

solve: TEqSolve;

s: string;

begin

// Создать систему уравнений и решить ее

solve := TEqSolve.Create( plan.Height, plan.Height + plan.Width );

for index := 0 to plan.Height-1 do

for index2 := 0 to plan.Width-1 do

if (plan.Arr[index2,index] > 0) then

solve.AddEq( index, index2, data.Arr[index2,index] );

// Не хватает уравнений - достроить их

{ solve.AddEq( 0, 1, data.Arr[1,0] ); {}

index := 0;

index2 := 0;

while (solve.fEqCount < plan.Height + plan.Width-1) do

begin

inc(index2);

if (index2 = plan.Width) then

begin

index2 := 0;

inc( index );

if (index = plan.Height) then

break; // wtf ?

end;

if (plan.Arr[index2,index] = 0) then

solve.AddEq( index, index2, data.Arr[index2,index] );

end; {}

solve.Solve;

{ debug }

s := 'u: ';

for index := 0 to plan.Height-1 do

s := s + ' ' + IntToStr( solve.U[index].v );

Form1.Memo1.Lines.Add( s );

s := 'v: ';

for index := 0 to plan.Width-1 do

s := s + ' ' + IntToStr( solve.V[index].v );

Form1.Memo1.Lines.Add( s );

x.Reset;

x.AssignLT( data );

for index := 0 to plan.Height-1 do

for index2 := 0 to plan.Width-1 do

if (plan.Arr[index2,index] = 0) then

begin

t := (solve.V[index2].v + solve.U[index].v); // * to_sign( (index+index2) and 1 );

x.Arr[index2,index] := data.Arr[index2,index] - t;

end; {}

end;

procedure TForm1.ShiftPlan(var data, plan, potential: TData );

var

x_m, y_m, v_m, f, f2: integer;

a: TData;

flag: boolean;

procedure Line( x, y, vert, val: integer );

begin

if (vert = 1) then y := plan.Width-1

else x := 0;

while (x < plan.Width) and (y >= 0) { plan.Height) } and (not flag) do

begin

if (plan.Arr[x,y] <> 0) and (a.Arr[x,y] = 0) then

begin

a.Arr[x,y] := val;

if (x = x_m) and (vert = 0) then

flag := true;

end;

if (vert = 1) then dec(y)

else inc(x);

end; {}

end;

// Найти значение в строке/столбце

procedure Find( var x, y: integer; vert, val: integer );

begin

if (vert = 1) then y := 0

else x := 0;

while (x < plan.Width) and (y < plan.Height) do

begin

if a.Arr[x,y] = val then

break;

if (vert = 1) then inc(y)

else inc(x);

end;

end;

var

index, index2, x1, y1: integer;

path: array [0..100] of TPoint;

begin

FillChar( path, sizeof(path), 0 );

// Ищем минимальный элемент в C

x_m := -1;

y_m := -1;

v_m := MaxInt;

for index := 0 to plan.Height-1 do

for index2 := 0 to plan.Width-1 do

if (potential.Arr[index2,index] < v_m) then

begin

x_m := index2;

y_m := index;

v_m := potential.Arr[index2,index];

end;

// Ищем путь

a := TData.Create;

a.AssignLT( plan );

a.Arr[x_m,y_m] := 1;

// Строим путь (вперед)

flag := false;

f := 1;

while not flag do

begin

for index := 0 to plan.Height-1 do

for index2 := 0 to plan.Width-1 do

if (a.Arr[index2,index] = f) then

begin

Line( index2, index, (f+1) and 1, f+1 );

{ Memo1.Lines.Add( 'path (' + IntToStr(f) + '):' );

Dump( a, 1 ); {}

end;

inc( f );

end; {}

Memo1.Lines.Add( 'path: ');

Dump( a, 1 );

// Строим путь (назад)

x1 := x_m;

y1 := y_m;

f2 := f;

while (f >= 0) do

begin

path[f].x := x1;

path[f].y := y1;

Find( x1, y1, (f+1) and 1, f );

dec(f);

end;

v_m := MaxInt;

x_m := -1;

index := 1;

while (index < f2) do

begin

f := plan.Arr[ path[index].x, path[index].y ];

if (f < v_m) then

begin

v_m := f;

x_m := index;

end;

inc(index,2);

end;

// add/sub vals

for index := 0 to f2-1 do

begin

f := plan.Arr[ path[index].x, path[index].y ];

if ( (index and 1) = 0 ) then f := f + v_m

else f := f - v_m;

plan.Arr[ path[index].x, path[index].y ] := f;

end;

end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

Cols_e1.Text:=IntToStr(UpDown1.Position);

StringGrid1.ColCount:=UpDown1.Position+2;

StringGrid1.Cells[StringGrid1.ColCount-2,0]:='B'+IntToStr(StringGrid1.ColCount-2);

StringGrid1.Cells[StringGrid1.ColCount-1,0]:='Запас(шт)';

end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);

begin

Rows_e1.Text:=IntToStr(UpDown2.Position);

StringGrid1.RowCount:=UpDown2.Position+2;

StringGrid1.Cells[0,StringGrid1.RowCount-2]:='A'+IntToStr(StringGrid1.RowCount-2);

StringGrid1.Cells[0,StringGrid1.RowCount-1]:='Потребность(шт)';

end;

end.