Применение методов распространения ограничений при поиске допустимых решений

   Procedure ShowSteps;

   var NewString : string;

       i : integer;

       IsNew : boolean;

    begin

     IsNew:=True;

     t:=GetPVariable(V);

     NewString:=t.VarName + ': [' + FloatToStr(t.LBound) + '; ' 
     + FloatToStr(t.RBound) + ']';

     for i:=0 to Form1.ListBox1.Count-1 do

      if Form1.ListBox1.Items.Strings[i] = NewString then

       begin

        IsNew:=False;

        break;

       end;

     if IsNew then

      Form1.ListBox1.Items.Append(NewString);

    end;

begin

  if (CType = 'l') or (CType = 'm') then

   Result:=TightenBoundsForNoEqual(V)

  else

   if Prior <> 'w' then

    Result:=TightenBoundsForEqual(V)

     else

      Result:=TightenBoundsForWeakEqual(V);

  ShowSteps;

end; 

Function TConstraint.IsElemInVars(Elem : string) : boolean;

 var temp : boolean;

    i : integer;

  begin

  temp:=False;

   for i:=0 to VarCount-1 do

     if Variables[i] = Elem then

     begin

       temp:=true;

       break;

      end;

  Result:=temp;

end; 

Procedure TVariable.SetBounds(pLBound, pRBound : extended);

 begin

  LBound:=pLBound;

  RBound:=pRBound;

end; 

 

constructor TVariable.Create(pName : string; pLBound, pRBound : extended);

begin

  VarName:=pName;

  LBound:=pLBound;

  RBound:=pRBound;

end; 

destructor TVariable.Free;

begin

end; 

Procedure GetConstraintList(FileName : string; var List : TConstraintList);

 var i : integer;

    s : string;

  begin

  List.Count:=Form1.Memo1.Lines.Count;

  SetLength(List.List,List.Count);

  for i:=0 to List.Count-1 do

  begin

    s:=Form1.Memo1.Lines.Strings[i];

    List.List[i]:=TConstraint.Create(s);

  end;

  end; 

Procedure GetVariablesList(CList : TConstraintList; var VarList : TVariableList);

 var i,j : integer; 

   Function IsNewVar : boolean;

   var k : integer;

       temp : boolean;

    begin

     temp:=true;

     for k:=0 to VarList.Count-1 do

      if VarList.List[k].VarName = CList.List[i].Variables[j] then

       temp:=False;

     Result:=temp;

    end;

begin

  VarList.Count:=CList.List[0].VarCount;

  SetLength(VarList.List,VarList.Count+1);

  for i:=0 to VarList.Count - 1 do

   VarList.List[i]:=TVariable.Create(CList.List[0].Variables[i],

   LInfinity,RInfinity);

  for i:=1 to CList.Count-1 do

   for j:=0 to CList.List[i].VarCount-1 do

    if IsNewVar then

     begin

      inc(VarList.Count);

      SetLength(VarList.List,VarList.Count);

      VarList.List[VarList.Count-1]:= 
      Variable.Create(CList.List[i].Variables[j],LInfinity,RInfinity);

     end;

end; 

Procedure TightenBounds(cn : TConstraint; var Queue : TQueueOfC;

   var TightVariables : TSetOfV; var ActiveConstraints : TSetOfC);

 var i,j : integer;

    TightenFlag : boolean;

    v : string;

begin

  for i:=0 to cn.VarCount-1 do

   if not TightVariables.IsElemIn(cn.Variables[i]) then

    begin

      v:=cn.Variables[i];

      TightenFlag:=cn.TightenBoundsFor(v);

      TightVariables.Add(GetPVariable(v));

      if TightenFlag then

       for j:=0 to ConstraintList.Count-1 do

        begin

         if ConstraintList.List[j].IsElemInVars(v) then

          if (ActiveConstraints.IsElemIn(ConstraintList.List[j]))

   and (not Queue.IsElemIn(ConstraintList.List[j])) then

                         Queue.Add(ConstraintList.List[j]);

        end;

    end;

end; 

Procedure CheckConstraints(cn : TConstraint; var ActiveConstraints : TSetOfC);

 var i : integer;

    temp : boolean;

    v : TVariable;

  begin

  temp:=False;       // не все переменные имеют уникальные значения

  for i:=0 to cn.VarCount-1 do

   begin

    v:=GetPVariable(cn.Variables[i]);

    if v.LBound <> v.RBound then

     temp:=True;

   end;

  if temp then

   ActiveConstraints.Add(cn)

  else

   ActiveConstraints.Delete(cn);

  if cn.VarCount = 1 then

   ActiveConstraints.Delete(cn);

  end; 

procedure TForm1.Button1Click(Sender: TObject);

 var Queue : TQueueOfC; // очередь ограничений

    ActiveConstraints : TSetOfC; // активное множество ограничений

    TightVariables : TSetOfV; //

    cn : TConstraint;

    i : integer;

    Procedure ShowDecision;

    var i : integer;

     begin

      for i:=0 to VariableList.Count-1 do

       Form2.ListBox2.Items.Append(VariableList.List[i].VarName + ' = ' 
                            + FloatToStr(VariableList.List[i].LBound));

     end;

 begin

  ListBox1.Clear;

  Form2.Show;

  Form2.ListBox2.Clear;

  GetConstraintList('Data.txt',ConstraintList);

  GetVariablesList(ConstraintList,VariableList);

  ActiveConstraints:=TSetOfC.Create; 

  for i:=0 to ConstraintList.Count-1 do

  begin

   TightVariables:=TSetOfV.Create;

   Queue:=TQueueOfC.Create;

   Queue.Add(ConstraintList.List[i]);

   while not Queue.IsEmpty do

    begin

    cn:=Queue.Front;

    TightenBounds(cn,Queue,TightVariables,ActiveConstraints);

     CheckConstraints(cn,ActiveConstraints);

     Queue.Dequeue;

    end;

  end;

  ShowDecision;

 end;

end. 

{=============================================================================}

unit Unit2;

interface

uses

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

  Dialogs, StdCtrls; 

type

  TForm2 = class(TForm)

    GroupBox2: TGroupBox;

    ListBox2: TListBox;

  private { Private declarations }

  public  { Public declarations }

  end;

var

  Form2: TForm2;

implementation

{$R *.dfm}

end. 

{=============================================================================}

unit MyFunctions;

interface

type

  TSArray = array of string; 

Procedure GetLeftAndRightParts(var Constraint : string;

                            var LPart, RPart: string; var Prior, CType: char);

Procedure GetVarList(Constraint : string; var Variables : TSArray;

                                     var VarCount: integer; var SVar: string);                           

implementation 

//  ВЫРЕЗАЕМ  ЛЕВУЮ И ПРАВУЮ ЧАСТЬ В ОГРАНИЧЕНИИ,  ОПРЕДЕЛЯЕМ ПРИОРИТЕТ И ТИП

Procedure GetLeftAndRightParts(var Constraint : string;

                            var LPart, RPart: string; var Prior, CType: char);

var i : integer;

begin

  Prior:=Constraint[1];  // приоритет

  Delete(Constraint,1,2);

  i:=pos('<=',Constraint);

  if i>0 then

   begin

    CType:='l';

    LPart:=Copy(Constraint,1,i-1);

    RPart:=Copy(Constraint,i+2,Length(Constraint)-i-1);

   end

  else

   begin

    i:=pos('>=',Constraint);

    if i>0 then

     begin

      CType:='m';

      LPart:=Copy(Constraint,1,i-1);

      RPart:=Copy(Constraint,i+2,Length(Constraint)-i-1);

     end

    else

     begin

      i:=pos('=',Constraint);

      CType:='e';

      LPart:=Copy(Constraint,1,i-1);

      RPart:=Copy(Constraint,i+1,Length(Constraint)-i);

     end;

   end;

end; 

//                       ПОЛУЧАЕМ СПИСОК ПЕРЕМЕННЫХ

Procedure GetVarList(Constraint : string; var Variables : TSArray;

                                     var VarCount: integer; var SVar: string);

var NumbersSet : set of char;

    s : string;

    LengthS, i, j : integer;

begin

  NumbersSet:=['0'..'9','<','=','>','-','+','*',' '];

  VarCount:=0;

  s:=Constraint + '+';

  lengthS:=length(s);

  i:=1;

  while i<lengthS do

   begin

    while (s[i] in NumbersSet) and (i<lengthS) do

     inc(i);

    j:=i;

    while (not(s[i] in NumbersSet)) and (i<lengthS) do

     inc(i);

    if i > j then

     begin

      inc(VarCount);

      SetLength(Variables,VarCount);

      Variables[VarCount-1]:=Copy(s,j,i-j);

     end;

   end;

  SVar:='';

  for i:=0 to VarCount-1 do

   SVar:=SVar + ',' + Variables[i];

  Delete(SVar,1,1);

end;

end. 

{=============================================================================}

unit CSet;

interface

uses Unit1; 

type

  TSetOfC = class

   Count : integer;

   Constraints : array of TConstraint;

   constructor Create;

   destructor Free;

   procedure Add(Elem : TConstraint);

   function IsElemIn(Elem : TConstraint) : boolean;

   procedure Delete(cn : TConstraint);

  end; 

implementation 

 

Constructor TSetOfC.Create;

begin

  Count:=0;

end; 

Destructor TSetOfC.Free;

begin

  Count:=0;

  Constraints:=nil;

end; 

Procedure TSetOfC.Add(Elem : TConstraint);

 begin

  inc(Count);

  SetLength(Constraints,Count);

  Constraints[Count-1]:=Elem;

end; 

Function TSetOfC.IsElemIn(Elem : TConstraint) : boolean;

var i : integer;

    temp : boolean;