Продолжение приложения б

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;

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] );

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;

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);

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 );