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

for i:=1 to length(mas)-1 do

s:=s+'+'+floattostr(mas[i]);

if Sign=less then s2:=' < ';

if Sign=Greater then s2:=' > ';

if Sign=Equal then s2:=' = ';

form1.memo1.lines.Add(s+s2+floattostr(a));

end;

//==============================================================================

//==============================================================================

//замена в строке всех вхождений одной подстроки на другую

function StrReplace(Str, Str1, Str2 : string):string;

var

p, L : integer;

s:string;

begin

s:=str;

L:=length(str1);

repeat

p:=pos(str1, s);

if p>0 then begin

Delete(s,p,L);

insert(str2, s, P);

end;

until P = 0;

StrReplace:=s;

end;

//==============================================================================

//==============================================================================

//========================= считывание таблиц влияния таблиц источников на точки

procedure get_pointfunnel(s:string;countPoint:integer;countfunnel:integer;funnel_name:tsArray;funnel_m:tExtArray;

var pointfunnelx2:tExtArrayx2; var point_cf:tExtArray);

var

h:textfile;

k,m:integer;

s_temp,s_temp2,s_temp3:string;

flag:boolean;

begin

SetLength(PointFunnelx2,countPoint,countFunnel);

SetLength(point_cf,countPoint);

for k:=0 to countPoint-1 do begin

point_cf[k]:=0;

for m:=0 to countFunnel-1 do

PointFunnelx2[k,m]:=0;

end;

AssignFile(h,dir_path+'\RESULT\'+'10pd'+s+'.ppp');

reset(h);

for k:=1 to 22 do readln(h,s_temp);

s_temp:=StrReplace(s_temp,'|',' ');

s_temp2:=s_temp;

for m:= 0 to CountPoint-1 do begin //общий цикл

flag:=true;

while flag do begin

if ReturnSubString(s_temp2)='Фоновая' then begin

point_cf[m]:=strtofloat(copy(s_temp,pos('%',s_temp)-4,4));

end else begin

s_temp3:=ReturnSubString(s_temp);

s_temp3:=ReturnSubString(s_temp);

s_temp3:=ReturnSubString(s_temp);

for k:=1 to 6 do s_temp2:=ReturnSubString(s_temp);

//showmessage(s_temp2);

for k:=0 to countFunnel-1 do

if s_temp3=copy(funnel_name[k],8,4) then

PointFunnelx2[m,k]:=strtofloat(s_temp2);//*funnel_m[k];

end;

readln(h,s_temp);

s_temp:=StrReplace(s_temp,'|',' ');

s_temp2:=s_temp;

if ReturnSubString(s_temp2)='В' then flag:=false;

end;

for k:=1 to 16 do readln(h,s_temp);

s_temp:=StrReplace(s_temp,'|',' ');

s_temp2:=s_temp;

end;

closefile(h);

end;

//==============================================================================

//==============================================================================

//========================================================= получение источников

procedure get_funnel(s:string; var countFunnel:integer;var funnel_name:tsArray;

var funnel_m:tExtArray;var funnel_min:tExtArray);

var

h,h2 : textfile;

index_funnel : integer;

i,j : integer;

s_temp,s_temp2:string;

begin

AssignFile(h,dir_path+'\DAT\'+'ist_'+s+'.txt');

reset(h);

index_funnel:=-11;

while s_temp<>'endI' do begin //чтение файла (установка размера массива)

readln(h,s_temp);

inc(index_funnel);

end;

closefile(h);

CountFunnel:=index_funnel;

setLength(funnel_m,CountFunnel);

setLength(funnel_min,CountFunnel);

setLength(funnel_name,CountFunnel);

for i:=0 to countFunnel-1 do begin

funnel_m[i]:=0;

funnel_min[i]:=0;

funnel_name[i]:='';

end;

AssignFile(h2,dir_path+'\DAT\'+'ist_'+s+'.txt');

reset(h2);

for j:=1 to 9 do

readln(h2,s_temp);

for i:= 0 to CountFunnel-1 do begin

readln(h2,s_temp);

funnel_name[i]:=ReturnSubString(s_temp);

for j:=1 to 14 do

s_temp2:=ReturnSubString(s_temp);

funnel_m[i]:=strtofloat(ReturnSubString(s_temp));

if DelSpaceAndCap(s_temp)<>'' then

funnel_min[i]:=strtofloat(DelSpaceAndCap(s_temp))

else funnel_min[i]:=0;

end;

closefile(h2);

end;

//==============================================================================

//==============================================================================

//============================================================= получение точек

procedure get_point (s:string;var countPoint:integer;var point_pdk:tExtArray);

var

index_point : integer;

i,j : integer;

h,h2 : textfile;

s_temp : string;

begin

index_point:=-2; // переменная для подсчета кол-ва точек

AssignFile(h,dir_path+'\WORK\'+'htop'+s+'.ppp');

reset(h);

while s_temp<>'000' do begin//чтение файла (установка размера массива)

readln(h,s_temp);

inc(index_point);

end;

closefile(h);

CountPoint:=index_point;

setLength(point_pdk,countPoint);

for i:=0 to countPoint-1 do

point_pdk[i]:=0; //зануление

AssignFile(h2,dir_path+'\WORK\'+'htop'+s+'.ppp');

reset(h2);

readln(h2,s_temp);

for i:= 0 to countPoint-1 do begin

readln(h2,s_temp);

for j:=1 to 8 do

point_pdk[i]:=strtofloat(ReturnSubString(s_temp));

end;

closefile(h2);

end;

//==============================================================================

//==============================================================================

//=========================================== решение при помощи симплекс метода

procedure get_simplexsolve(countPoint:integer;countFunnel:integer;point_pdk:tExtArray;

point_cf:tExtArray;funnel_m:tExtArray;funnel_min:tExtArray;

pointfunnelx2:tExtArrayx2;var x:tExtArray;var s_temp:string);

var

mas_temp : tExtArrayx2;

i,j : integer;

sim : TSimplex;

L : tExtArray;

begin

setLength(mas_temp,countFunnel,countFunnel);

setLength(L,countFunnel);

setLength(x,countFunnel);

for i:=0 to countFunnel-1 do

for j:=0 to countFunnel-1 do begin

if i=j then mas_temp[i,j]:=1 else mas_temp[i,j]:=0;

L[j]:=1;

end;

Sim:=TSimplex.Create(L,true);

for i:=0 to countPoint-1 do begin

//showmessage(vv(point_pdk[i],pointfunnelx2[i]));

Sim.AddCons(point_pdk[i],pointfunnelx2[i],less);

if form1.CheckBox1.Checked then vv(point_pdk[i],pointfunnelx2[i],less);

end;

for i:=0 to countFunnel-1 do begin

Sim.AddCons(funnel_m[i],mas_temp[i],less);

if funnel_min[i]>0 then begin

Sim.AddCons(funnel_min[i],mas_temp[i],Greater);

if form1.CheckBox1.Checked then vv(funnel_min[i],mas_temp[i],Greater);

end;

end;

if (Sim.Solve=SIMPLEX_DONE) then begin

s_temp:='решение найдено';

x:=Sim.GetSolution;

end

else s_temp:='Решения не существует';

end;

//==============================================================================

//==============================================================================

//==================================================== общий модуль для подсчета

procedure TForm1.Button3Click(Sender: TObject);

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