Смекни!
smekni.com
Экология

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

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+'&bsol;DAT&bsol;'+'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+'&bsol;WORK&bsol;'+'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+'&bsol;WORK&bsol;'+'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+'&bsol;RESULT&bsol;'+'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;

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

//поиск файла по маске

procedure FindFiles(StartFolder, Mask: string; List: TStrings;

ScanSubFolders: Boolean = True);

var

SearchRec: TSearchRec;

FindResult: Integer;

begin

List.BeginUpdate;

try

StartFolder := IncludeTrailingBackslash(StartFolder);

FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);

try

while FindResult = 0 do

with SearchRec do

begin

if (Attr and faDirectory) <> 0 then

begin

if ScanSubFolders and (Name <> '.') and (Name <> '..') then

FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);

end

else

begin

if MatchesMask(Name, Mask) then begin

List.Add(copy(Name,5,4));

//showmessage(StartFolder + Name);

end;

end;

FindResult := FindNext(SearchRec);

end;

finally

FindClose(SearchRec);

end;

finally

List.EndUpdate;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

DecimalSeparator:=MyDecimalSeparator;

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

dir_path:=ReadIni;

edit1.Text:=dir_path;

{--}

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

h,h2:textfile;

i,j,k,n:integer;

s_temp:string;

s: array of array of string;

begin

dir_path:=edit1.Text;

checklistbox1.Items.Clear;

i:=0;

AssignFile(h,dir_path+'&bsol;WORK&bsol;activ2.txt');

reset(h);

//readln(h,s_temp);

while not EOF(h) do begin//чтение файла (установка размера массива)

readln(h,s_temp);

inc(i);

end;

closefile(h);

setlength(s,i,2);

AssignFile(h2,dir_path+'&bsol;WORK&bsol;activ2.txt');

reset(h2);

for j:=0 to i-1 do begin

readln(h2,s_temp);

s[j,0]:=copy(s_temp,24,4);

s[j,1]:=copy(s_temp,30,55);

end;

closefile(h2);

FindFiles(dir_path, 'htop*.ppp', checklistbox1.items, true);

n:=checklistbox1.items.Count-1;

for j:=0 to n do begin

for k:=0 to i-1 do begin

//showmessage(s[k,0]+' -| ');

if checklistbox1.items[0]=s[k,0] then begin

//showmessage(s[j,0]+' | '+s[j,1]);

checklistbox1.items.Delete(0);

checklistbox1.items.Add(s[k,0]+' '+s[k,1]);

end;

end;

end;

end;

procedure TForm1.N2Click(Sender: TObject);

var

TitleName : string;

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.SpeedButton1Click(Sender: TObject);

var

TitleName : string;

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; { направление оптимизации: минимизация или максимизация }

 
назад
читать дальше
1
2
3
4
5
6
7
8
9
10
НАПИШИТЕ НАМ
Copyright © Smekni.com. All rigths reserved.