var SLPart, SRPart : string;
SVar : string;
begin
GetLeftAndRightParts(Constraint,SLPart,SRPart,Prior,CType);
GetVarList(Constraint,Variables,VarCount,SVar);
LPart:=TMathParser.create;
RPart:=TMathParser.create;
LPart.Translate(SLPart,SVar);
RPart.Translate(SRPart,SVar);
end;
destructor TConstraint.Free;
begin
VarCount:=0;
Variables:=nil;
LPart.Free;
RPart.Free;
end;
// возвращает указатель на переменную с именем Name
Function GetPVariable(Name : string) : TVariable;
var i : integer;
begin
i:=0;
while VariableList.List[i].VarName <> Name do
inc(i);
Result:=VariableList.List[i];
end;
Function Svertka(var OldL, OldR: extended; NewL, NewR: extended): boolean;
var tempL, tempR : extended;
begin
tempL:=OldL;
tempR:=OldR;
if NewL <= NewR then
begin
if NewR < OldL then
OldR:=OldL
else
if OldR < NewL then
OldL:=OldR // свертка
else
begin
OldL:=max(OldL,NewL);
OldR:=min(OldR,NewR);
end;
end;
if (tempL <> OldL) or (tempR <> OldR) then
Result:=true
else
Result:=false;
end;
// СЖАТИЕ ПЕРЕМЕННЫХ ДЛЯ РАВЕНСТВА
Function TConstraint.TightenBoundsForEqual(V : string) : boolean;
type ArrayOfE = array of extended;
var Number : integer; // номер переменной v в списке переменных
i : integer;
NumberArray : ArrayOfE;
IndexMassiv : ArrayOfE;
Svob : extended; // свободный член
PVar,tempP : TVariable;
tempLBound, tempRBound, Coef : extended;
Function FillArray(Place : integer; Chislo : integer) : ArrayOfE;
var i : integer;
begin
for i:=0 to VarCount-1 do
NumberArray[i]:=0;
NumberArray[Place]:=Chislo;
Result:=NumberArray;
end;
begin
Number:=0;
while Variables[Number] <> V do
inc(Number);
SetLength(NumberArray,VarCount);
SetLength(IndexMassiv,VarCount); // получаем коэффициенты
for i:=0 to VarCount-1 do
IndexMassiv[i]:=LPart.Get(FillArray(i,1)) - LPart.Get(FillArray(i,0)) -
RPart.Get(FillArray(i,1)) + RPart.Get(FillArray(i,0));
Svob:=LPart.Get(FillArray(0,0)) - RPart.Get(FillArray(0,0));
if IndexMassiv[Number] < 0 then
begin
for i:=0 to VarCount-1 do
IndexMassiv[i]:=-IndexMassiv[i];
Svob:=-Svob;
end;
Coef:=IndexMassiv[Number];
PVar:=GetPVariable(V);
tempLBound:=-Svob/Coef;
tempRBound:=-Svob/Coef;
for i:=0 to VarCount-1 do
if i <> Number then
begin
tempP:=GetPVariable(Variables[i]);
if IndexMassiv[i] > 0 then
begin
tempLBound:=tempLBound - IndexMassiv[i]*tempP.RBound/coef;
tempRBound:=tempRBound - IndexMassiv[i]*tempP.LBound/coef;
end
else
begin
tempLBound:=tempLBound - IndexMassiv[i]*tempP.LBound/coef;
tempRBound:=tempRBound - IndexMassiv[i]*tempP.RBound/coef;
end;
end;
Result:=Svertka(PVar.LBound,PVar.RBound,tempLBound,tempRBound);
end;
// СЖАТИЕ ПЕРЕМЕННЫХ ДЛЯ НЕРАВЕНСТВА
Function TConstraint.TightenBoundsForNoEqual(V : string) : boolean;
var PVar : TVariable;
begin
PVar:=GetPVariable(V);
if CType = 'l' then
PVar.RBound:=RPart.Get([1])
else
PVar.LBound:=RPart.Get([1]);
Result:=True;
end;
// СЖАТИЕ ПЕРЕМЕННЫХ ДЛЯ СЛАБЫХ РАВЕНСТВ
Function TConstraint.TightenBoundsForWeakEqual(V : string) : boolean;
var PVar : TVariable;
begin
PVar:=GetPVariable(V);
Result:=Svertka(PVar.LBound,PVar.RBound,RPart.Get([1]),
RPart.Get([1]));
end;
// СЖАТИЕ ПЕРЕМЕННЫХ
Function TConstraint.TightenBoundsFor(V : string) : boolean;
var t : TVariable;
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;
begin
temp:=False;
for i:=0 to Count-1 do
if Constraints[i] = Elem then
begin
temp:=True;
break;
end;
Result:=temp;
end;
Procedure TSetOfC.Delete(cn : TConstraint);
var i,j : integer;
begin
for i:=0 to Count-1 do
if cn = Constraints[i] then
begin
for j:=i to Count-2 do
Constraints[j]:=Constraints[j+1];
Dec(Count);
SetLength(Constraints,Count);
break;
end;
end;
end.
{=============================================================================}
unit CQueue;
interface
uses Unit1;
type
TQueueOfC = class
Count : integer;
Constraints : array of TConstraint;
constructor Create;
destructor Free;
procedure Add(Elem : TConstraint);
procedure Dequeue;
function IsEmpty : boolean;
function Front : TConstraint;
function IsElemIn(Elem : TConstraint) : boolean;
end;
implementation
Constructor TQueueOfC.Create;
begin
Count:=0;
end;
Destructor TQueueOfC.Free;
begin
Count:=0;
Constraints:=nil;
end;
Procedure TQueueOfC.Add(Elem : TConstraint);
begin
inc(Count);
SetLength(Constraints,Count);
Constraints[Count-1]:=Elem;
end;
Procedure TQueueOfC.Dequeue;
var i : integer;
begin
for i:=0 to Count-2 do
Constraints[i]:=Constraints[i+1];
dec(Count);
SetLength(Constraints,Count);
end;
Function TQueueOfC.IsEmpty : boolean;
begin
if Count = 0 then
Result:=True
else
Result:=False;
end;
Function TQueueOfC.Front : TConstraint;
begin
Result:=Constraints[0];
end;
Function TQueueOfC.IsElemIn(Elem : TConstraint) : boolean;
var i : integer;
temp : boolean;
begin
temp:=False;
for i:=0 to Count-1 do
if Constraints[i] = Elem then
begin
temp:=True;
break;
end;
Result:=temp;
end;
end.
{=============================================================================}
unit VSet;
interface
uses Unit1;
type
TSetOfV = class
Count : integer;
Variables : array of TVariable;
constructor Create;
destructor Free;
procedure Add(Elem : TVariable);
function IsElemIn(v : string) : boolean;
end;
implementation
Constructor TSetOfV.Create;
begin
Count:=0;
end;
Destructor TSetOfV.Free;
begin
Count:=0;
Variables:=nil;
end;
Procedure TSetOfV.Add(Elem : TVariable);
begin
inc(Count);
SetLength(Variables,Count);
Variables[Count-1]:=Elem;
end;
function TSetOfV.IsElemIn(v : string) : boolean;
var i : integer;
temp : boolean;
begin
temp:=False;
for i:=0 to Count-1 do
begin
if Variables[i].VarName = v then
temp:=True;
break;
end;
Result:=temp;
end;
end.