Автор: Пользователь скрыл имя, 25 Февраля 2013 в 20:55, курсовая работа
В настоящее время нельзя назвать область человеческой деятельности, в которой в той или иной степени не использовались бы методы моделирования. Особенно это относится к сфере управления различными производствами и системами, где основными являются процессы принятия решений на основе получаемой информации.
Определим через слово "объект" все то, на что направлена человеческая деятельность (лат.Objectum-предмет). Выработка методологии направлена на упорядочение получения и обработки информации об объектах, которые существуют вне нашего сознания и взаимодействуют между собой и внешней средой.
var
s, index: integer;
begin
s := 0;
for index := 0 to data.Width-1 do
s := s + data.Top[index];
for index := 0 to data.Height-1 do
s := s - data.Left[index];
Result := s = 0; // Или тут больше поставить ?
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;
procedure TForm1.Button3Click(Sender: TObject);
procedure c( x, y: integer; s: string );
begin
StringGrid1.Cells[ x, y ] := s;
end;
begin
StringGrid1.ColCount := 6;
StringGrid1.RowCount := 5;
// top
c( 2, 1, '5' );
c( 3, 1, '9' );
c( 4, 1, '9' );
c( 5, 1, '7' );
// left
c( 1, 2, '11' );
c( 1, 3, '11' );
c( 1, 4, '8' );
// mid
c( 2, 2, '7' );
c( 3, 2, '8' );
c( 4, 2, '5' );
c( 5, 2, '3' );
c( 2, 3, '2' );
c( 3, 3, '4' );
c( 4, 3, '5' );
c( 5, 3, '9' );
c( 2, 4, '6' );
c( 3, 4, '3' );
c( 4, 4, '1' );
c( 5, 4, '2' );
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;
procedure TForm1.Button4Click(Sender: TObject);
procedure c( x, y: integer; s: string );
begin
StringGrid1.Cells[ x, y ] := s;
end;
begin
StringGrid1.ColCount := 7;
StringGrid1.RowCount := 5;
// top
c( 2, 1, '20' );
c( 3, 1, '12' );
c( 4, 1, '5' );
c( 5, 1, '8' );
c( 6, 1, '15' );
// left
c( 1, 2, '15' );
c( 1, 3, '25' );
c( 1, 4, '20' );
// mid
c( 2, 2, '1' );
c( 3, 2, '0' );
c( 4, 2, '3' );
c( 5, 2, '4' );
c( 6, 2, '2' );
c( 2, 3, '5' );
c( 3, 3, '1' );
c( 4, 3, '2' );
c( 5, 3, '3' );
c( 6, 3, '3' );
c( 2, 4, '4' );
c( 3, 4, '8' );
c( 4, 4, '1' );
c( 5, 4, '4' );
c( 6, 4, '3' );
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;
function TData.NoNulls: integer;
var
index, index2, c: integer;
begin
c := 0;
for index := 0 to Height-1 do
for index2:= 0 to Width-1 do
if (Arr[index2,index] > 0) then
inc(c);
Result := c;
end;
procedure TForm1.CalcMinEl( data: TData; var plan: TData );
var
index, index2, x_m, y_m, v_m, s, v: integer;
begin
s := 0;
plan.AssignLT( data );
for index := 0 to plan.Width-1 do
s := s + data.Top[index];
while (s > 0) do
begin
v_m := MaxInt;
x_m := -1;
y_m := -1;
for index := 0 to plan.Height-1 do
for index2 := 0 to plan.Width-1 do
if ((v_m > data.Arr[index2,index]) and
(plan.Arr[index2,index] = 0) and
(plan.Top[index2] > 0) and (plan.Left[index] > 0)) then
begin
v_m := data.Arr[index2,index];
x_m := index2;
y_m := index;
end;
if (v_m = MaxInt) then
break;
v := min( plan.Top[ x_m ], plan.Left[ y_m ] );
plan.Top[ x_m ] := plan.Top[ x_m ] - v;
plan.Left[ y_m ] := plan.Left[ y_m ] - v;
plan.Arr[ x_m, y_m ] := v;
s := s - v;
end;
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: ');