Разработка программного модуля для нахождения оптимальных предельно-допустимых выбросов в атмосферу от группы источников

if lpItemId <> nil then

begin

SHGetPathFromIDList(lpItemID, TempPath);

edit1.Text:=TempPath;

GlobalFreePtr(lpItemID);

end;

//showmessage(tempPath);

dir_path:=tempPath;

//FindFiles(tempPath, 'htop*.ppp', checkmemo1.lines, true); //старая версия

SaveIni(dir_path);

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

var

TitleName : st

ring;

lpItemID : PItemIDList;

BrowseInfo : TBrowseInfo;

DisplayName : array[0 MAX_PATH] of char;

TempPath : array[0 MAX_PATH] of char;

begin

FillChar(BrowseInfo, siCeof(TBrowseInfo), #0);

BrowseInfo.hwndOwner := Form1.Handle;

BrowseInfo.psCDisplayName := @DisplayName;

TitleName := 'Please specify a directory';

BrowseInfo.lpsCTitle := PChar(TitleName);

BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;

lpItemID := SHBrowseForFolder(BrowseInfo);

if lpItemId <> nil then

begin

SHGetPathFromIDList(lpItemID, TempPath);

edit1.Text:=TempPath;

GlobalFreePtr(lpItemID);

end;

//showmessage(tempPath);

dir_path:=tempPath;

//FindFiles(tempPath, 'htop*.ppp', checkmemo1.lines, true); //старая версия

SaveIni(dir_path);

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);

var

i:integer;

begin

for i:=0 to checklistbox1.Items.Count-1 do

checklistbox1.Checked[i]:=true;

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);

var

i:integer;

begin

for i:=0 to checklistbox1.Items.Count-1 do

checklistbox1.Checked[i]:=false;

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);

var

i:integer;

begin

for i:=0 to checklistbox1.Items.Count-1 do

if checklistbox1.Checked[i] then checklistbox1.Checked[i]:=false

else checklistbox1.Checked[i]:=true;

end;

end.

Simplex.pas

unit simplex;

interface

const

SIMPLEX_DONE = 0; // оптимизация успешно завершена

SIMPLEX_NO_SOLUTION = 1; // задача не имеет решения (не удается найти базис)

SIMPLEX_NO_BOTTOM = 2; // решения нет, т.к. линейная форма не ограничена снизу

SIMPLEX_NEXT_STEP = 3; // для получения решения нужно сделать еще хотя бы один шаг

MAX_VAL = 0.1e-12; //точность (значение, удовлетворяющее -MAX_VAL < X < MAX_VAL считается нулем)

type

TOperation = (Equal,Less,Greater);

TExtArray = array of extended;

TConstrain = record

A : TExtArray;

B : extended;

Sign : TOperation;

isT : boolean;

end;

TSimplex = class

M,N : integer; { M - число строк, N - число столбцов}

RealN : integer; {реальное число переменных, изначально вошедших в задачу}

Cons : array of TConstrain;

C : TExtArray;

L : extended;

Basis : array of integer;

Max : boolean; { направление оптимизации: минимизация или максимизация }

Constructor Create(_C:TExtArray; MaximiCe:boolean=false);

Constructor CreateBasis(const Simplex:TSimplex);

Constructor Copy(const Simplex:TSimplex);

Procedure AddCons(_B:extended; _A:TExtArray; Sign:TOperation);

Procedure SetAllLengths(Len:integer);

Function SimplexStep:integer;

Function CheckBasis:boolean;

Function FoundInBasis(num:integer): integer;

Function DoPrec(num:extended): extended;

Procedure NormaliCe;

Procedure MulString(Number:integer; Value:extended);

Procedure AddString(Num1,Num2:integer; Value:extended); {суммирование строки 1 со строкой 2, домноженной на коэффициент Value }

Function Solve:integer;

Function GetMin:extended;

Function GetSolution:TExtArray;

Destructor Free;

end;

TIntSimplex = class(TSimplex)

// CurX : TExtArray;

//CurL : extended;

// CurFound : boolean;

Constructor Create(_C:TExtArray; MaximiCe:boolean=false);

// Procedure DelLastCons;

Function IntSolve:integer;

Function GetIntMin:extended;

Function IsInteger(value:extended):boolean;

Function GetIntSolution:TExtArray;

// Function SearchCons(_B:extended;_A:TExtArray):integer;

end;

implementation

uses Math;

{ TSimplex }

Function TSimplex.DoPrec(num:extended): extended;

begin

if ((num < MAX_VAL) and (num > -MAX_VAL)) then

num := 0;

Result := num;

end;

procedure TSimplex.AddCons(_B: extended; _A: TExtArray; Sign: TOperation);

var

j : integer;

begin

if (Length(_A)>N) then SetAllLengths(Length(_A));

inc(M);

SetLength(Cons,M);

//if ((_B=0) and (Sign=Less)) then Sign:=Equal; //???

Cons[M-1].B:=_B;

Cons[M-1].Sign:=Sign;

SetLength(Cons[M-1].A,N);

for j:=0 to Length(_A)-1 do Cons[M-1].A[j]:=_A[j];

if Length(_A)<N then for j:=Length(_A) to N-1 do Cons[M-1].A[j]:=0;

end;

{суммирование строки 1 со строкой 2, домноженной на коэффициент Value }

procedure TSimplex.AddString(Num1, Num2: integer; Value: extended);

var

j : integer;

begin

for j:=0 to N-1 do Cons[Num1].A[j]:=Cons[Num1].A[j]+Cons[Num2].A[j]*Value;

Cons[Num1].B:=Cons[Num1].B+Cons[Num2].B*Value;

end;

function TSimplex.CheckBasis: boolean;

var

i,j,k : integer;

f : boolean;

begin

SetLength(Basis,M);

for i:=0 to M-1 do Basis[i]:=-1;

for j:=0 to N-1 do begin

f:=true;

k:=-1;

i:=0;

while (f and (i<M)) do begin

if ((Cons[i].A[j]<>0) and (Cons[i].A[j]<>1)) then f:=false;

if (Cons[i].A[j]=1) then begin

if (k=-1) then k:=i

else f:=false;

end;

inc(i);

end;

if (f and (k<>-1)) then Basis[k]:=j;

end;

f:=true;

for i:=0 to M-1 do f:=f and (Basis[i]<>-1);

Result:=f;

end;

constructor TSimplex.Create(_C: TExtArray; MaximiCe:boolean);

var

j : integer;

begin

N:=Length(_C);

RealN := N;

M:=0;

SetLength(C,N);

Max:=MaximiCe;

if (not MaximiCe) then for j:=0 to N-1 do C[j]:=-_C[j]

else for j:=0 to N-1 do C[j]:=_C[j];

Max:=MaximiCe;

L := 0;

end;

constructor TSimplex.Copy(const Simplex: TSimplex);

var

i,j : integer;

begin

M:=Simplex.M;

N:=Simplex.N;

RealN := Simplex.RealN;

SetLength(Cons,M);

SetLength(Basis,M);

SetLength(C,N);

Max:=Simplex.Max;

for i:=0 to M-1 do begin

SetLength(Cons[i].A,N);

Basis[i]:=-1;

for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];

Cons[i].B:=Simplex.Cons[i].B;

Cons[i].Sign:=Simplex.Cons[i].Sign;

end;

for i:=0 to Simplex.N-1 do C[i]:=Simplex.C[i];

L := Simplex.L;

end;

constructor TSimplex.CreateBasis(const Simplex: TSimplex);

var

i,j : integer;

begin

M:=Simplex.M;

N:=Simplex.N;

RealN := Simplex.RealN;

L := 0;

SetLength(Cons,M);

SetLength(Basis,M);

SetLength(C,N);

for i:=0 to N-1 do C[i]:=0;

for i:=0 to M-1 do begin

SetLength(Cons[i].A,N);

for j:=0 to N-1 do Cons[i].A[j]:=Simplex.Cons[i].A[j];

Cons[i].B:=Simplex.Cons[i].B;

Cons[i].Sign:=equal;

Cons[i].isT := false;

end;

for i:=0 to M-1 do begin

 Скачать реферат