169102 (595713), страница 7

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 7)

end;

//--------- Удаляет пробел или запятую с краёв строки --------------------------

Function DelSpaceAndCap(s:string):string;

begin

while pos(copy(s,1,1),' ')<>0 do delete(s,1,1);

while pos(copy(s,length(s),1),' ')<>0 do delete(s,length(s),1);

result:=s;

end;

//--------- вырезает из строки имя ---------------------------------------------

Function ReturnSubString(Var s:string):string;

var

position,i : integer;

begin

s:=DelSpaceAndCap(s);

position:=0;

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

if (pos(copy(s,i,1),' ')<>0) and (position=0) then

position:=i;

if position=0 then begin

result:=s;

s:='';

end else begin

result := DelSpaceAndCap(copy(s,1,position));

Delete(s,1,position);

s:=DelSpaceAndCap(s);

end;

end;

//вывод ограничений

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

procedure vv(a:real;mas:tExtArray; Sign: TOperation);

var

i:integer;

s,s2,s3:string;

begin

s:=floattostr(mas[0]);

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

var

s,s_temp,ss : string;

countPoint : integer;

countfunnel : integer;

point_pdk : tExtArray;

point_cf : tExtArray;

funnel_m : tExtArray;

funnel_min : tExtArray;

funnel_name : tsArray;

pointfunnelx2 : tExtArrayx2;

i,j : integer;

x : tExtArray;

empty : boolean;

h : textfile;

funnelSumM,sumX:real;

begin

funnelSumM:=0;

sumX:=0;

memo1.Clear;

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

if CheckListBox1.Checked[i] then begin

application.ProcessMessages;

s:=checklistbox1.Items.Strings[i];

s:=returnSubString(s);

application.ProcessMessages;

get_point (s,countPoint,point_pdk);

get_funnel(s,countFunnel,funnel_name,funnel_m,funnel_min);

get_pointfunnel(s,countPoint,countfunnel,funnel_name,funnel_m,pointfunnelx2,point_cf);

get_simplexsolve(countPoint,CountFunnel,point_pdk,point_cf,funnel_m,funnel_min,pointfunnelx2,x,s_temp);

AssignFile(h,dir_path+'\RESULT\'+'h_pd'+s+'.gpv');

rewrite(h);

if s_temp='решение найдено' then begin

memo1.lines.Add('');

memo1.lines.Add(' Результаты расчета ПДВ (симплекс метод):');

memo1.lines.Add(' ПРИМЕСЬ='+s);

memo1.lines.Add('');

memo1.lines.Add('---------------------------------------------------------');

memo1.lines.Add('| Код |Существую-|Минимально| Расчетное | коэфф. |');

memo1.lines.Add('| источника |щий выброс|возможный | значение | норми- |');

memo1.lines.Add('| выброса | г/с | выброс | П Д В | рования |');

memo1.lines.Add('|-----------|----------|---г/с----|----г/с----|---------|');

writeln(h,'');

writeln(h,' Результаты расчета ПДВ (симплекс метод):');

writeln(h,' ПРИМЕСЬ='+s);

writeln(h,'');

writeln(h,'---------------------------------------------------------');

writeln(h,'| Код |Существую-|Минимально| Расчетное | коэфф. |');

writeln(h,'| источника |щий выброс|возможный | значение | норми- |');

writeln(h,'| выброса | г/с | выброс | П Д В | рования |');

writeln(h,'|-----------|----------|---г/с----|----г/с----|---------|');

empty:=true;

for j:=0 to countFunnel-1 do begin

funnelSumM:=FunnelSumM+funnel_m[j];

sumX:=SumX+x[j];

if abs(x[j]-funnel_m[j])>0.0000001 then

begin

ss:='|'+funnel_name[j]+'| '+FloatToStrF(funnel_m[j],ffFixed,1000,6)+' | '+FloatToStrF(funnel_min[j],ffFixed,1000,6);

ss:=ss+' | '+FloatToStrF(x[j],ffFixed,1000,7)+' | '+FloatToStrF(x[j]/funnel_m[j],ffFixed,1000,5)+' |';

memo1.lines.Add(ss);

writeln(h,ss);

empty:=false;

end;

end;

ss:='| в сумме: '+FloatToStrF(funnelSumM,ffFixed,1000,6)+' ';

ss:=ss+FloatToStrF(sumX,ffFixed,1000,6)+' | '+ FloatToStrF(sumX/funnelSumM,ffFixed,1000,5)+' |';

if empty then begin

memo1.lines.Add('| Нет выбросов для снижения |');

writeln(h,'| Нет выбросов для снижения |');

end;

if not empty then begin

memo1.lines.Add('- - - - - - - - - - - - - - - - - - - - - - - - - - - - -');

memo1.lines.Add(ss);

writeln(h,'- - - - - - - - - - - - - - - - - - - - - - - - - - - - -');

writeln(h,ss);

end;

memo1.lines.Add('---------------------------------------------------------');

memo1.lines.Add('');

memo1.lines.Add('');

writeln(h,'---------------------------------------------------------');

writeln(h,'');

writeln(h,'');

end else begin

memo1.lines.Add('');

memo1.lines.Add(' Результаты расчета ПДВ (симплекс метод):');

memo1.lines.Add(' ПРИМЕСЬ='+s);

memo1.lines.Add('');

memo1.lines.Add('---------------------------------------------------------');

memo1.lines.Add('| Решение не найдено |');

memo1.lines.Add('---------------------------------------------------------');

writeln(h,'');

writeln(h,' Результаты расчета ПДВ (симплекс метод):');

writeln(h,' ПРИМЕСЬ='+s);

writeln(h,'');

writeln(h,'---------------------------------------------------------');

writeln(h,'| Решение не найдено |');

writeln(h,'---------------------------------------------------------');

end;

closefile(h);

end;

// closefile(h);

end;

end;

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

Характеристики

Список файлов ВКР