
Добавил:
Mendeleev
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:ФВТ (КХТП) / Материалы для КХТП - 2002 / 5_course / 1semester / АСР-ТАУ (Дубровский) / EXPFILTR
.PAS const
MaxN = 1000; {Њ ЄбЁ¬ «м®Ґ Є®«ЁзҐбвў® ®Ўа Ў влў Ґ¬ле в®зҐЄ}
type
real=single;
var
T:text;
y,ya:array[1..MaxN] of real;
bo:array[1..MaxN] of boolean;
N,N1,N2,sch,i,R1,R2,nb,nm:integer;
K,B,max,min,s:real;
oh:boolean;
fn:string;
procedure Find_Ta;
var r,i:integer;
km,xm:real;
begin
r:=round((N-1)*(1-R1/100)); if r<1 then r:=1; km:=0; nm:=0;
for i:=r+1 to N do begin k:=(y[i]-y[i-r])/r;
if k>km then begin km:=k; nm:=i; end;
end;
nm:=nm-(r div 2);
K:=km; B:=y[nm]-nm*K;
end;
procedure Check_1;
var I:integer; Tob:real;
begin
s:=0; Tob:=nm-B/K;
for i:=1 to N do begin ya[i]:=1-exp(-1/Tob*i); s:=s+sqr(y[i]-ya[i]); end;
s:=sqrt(s/N)*R2/100;
for i:=1 to N do
bo[i]:=(abs(y[i]-ya[i])<s)
end;
procedure Check_2;
var i:integer; theta:real;
begin
s:=0; theta:=0.632/K;
for i:=1 to N do begin ya[i]:=1-exp(-1/theta*i); s:=s+sqr(y[i]-ya[i]); end;
s:=sqrt(s/N)*R2/100;
for i:=1 to N do bo[i]:=(abs(y[i]-ya[i])<s)
end;
procedure Check_3;
var i:integer; t1,t2,T:real;
begin
s:=0; t1:=0.283/K; t2:=0.632/K; T:=1.5*(t2-t1);
for i:=1 to N do begin ya[i]:=1-exp(-1/T*i); s:=s+sqr(y[i]-ya[i]); end;
s:=sqrt(s/N)*R2/100;
for i:=1 to N do bo[i]:=(abs(y[i]-ya[i])<s)
end;
procedure Check_4;
var i,j,r:integer; s,ss:real;
begin
for i:=1 to N do begin bo[i]:=true; ya[i]:=0; end;
r:=round(N*(1-R1/100)); if r<3 then r:=3;
for i:=r to N do begin
ss:=0; for j:=i-r+1 to i do ss:=ss+y[j]; ss:=ss/r;
s:=0; for j:=i-r+1 to i do s:=s+sqr(y[j]-ss);
s:=sqrt(s/N)*R2/100;
for j:=i-r+1 to i do if abs(y[j]-ss)>s then bo[j]:=false;
end;
end;
begin
writeln(#10#13'> Џа®Ја ¬¬ дЁ«мва жЁЁ ¤ ле дгЄжЁЁ ®вЄ«ЁЄ , v.1.0, (б)2000 ЊЁваЁзҐў ‘ҐаЈҐ© *');
write(' €¬п д ©« б ¤ л¬Ё : '); readln(fn);
Write(' Ќ®¬Ґа в®зЄЁ з « ў®§¬г饨п : '); readln(N1);
Write(' Ќ®¬Ґа в®зЄЁ ®Є®з Ёп ў®§¬г饨п : '); readln(N2);
N:=N2-N1+1;
if N<2 then begin writeln('> ЋиЁЎЄ : Ґ¤®ЇгбвЁ¬®Ґ Є®«ЁзҐбвў® в®зҐЄ!'); exit end;
assign(t,fn);
{$I-} reset(t); {$I+} if ioresult<>0 then begin writeln('> ЋиЁЎЄ : ҐЇа ўЁ«м®Ґ Ё¬п д ©« !'); exit end;
while (not eof(t)) and (N1>1) do begin readln(t); dec(N1); end;
i:=1;
while (not eof(t)) and (i<=N) and (i<=MaxN) do begin readln(t,y[i]); inc(i); end;
close(t); dec(i);
if i<>N then begin N:=i; writeln('> ЋиЁЎЄ : ҐЄ®а४влҐ ¤ лҐ, § Ја㦥® ',N,' в®зҐЄ!'); end;
write(' •®¤ Їаאַ© (1) Ё«Ё ®Ўа вл© (2) : '); Readln(i);
if i=2 then for i:=1 to N do y[i]:=-y[i];
max:=y[1]; min:=y[1];
for i:=2 to N do begin
if y[i]>max then max:=y[i];
if y[i]<min then min:=y[i];
end;
for i:=1 to N do y[i]:=(y[i]-min)/(max-min);
repeat
write(' ‘奬 дЁ«мва жЁЁ (1,2,3 - нЄбЇ., 4 - бЄ.б।ҐҐ) : '); readln(sch);
write(' ЁаЁ Ї®«®бл Їа®ЇгбЄ Ёп (ў % ®в ўлЎ®а®з®© ¤ЁбЇҐабЁЁ) : '); readln(r2); r2:=abs(r2);
if sch in [1..3] then begin
write(' —гўб⢨⥫м®бвм Ї®ЁбЄ Ї®бв®п®© ўаҐ¬ҐЁ (ў %) : '); readln(r1); r1:=abs(r1);
if R1>100 then R1:=100;
Find_Ta;
end else
begin
write(' —гўб⢨⥫м®бвм б奬л (ў % ®в ўлЎ®аЄЁ) : '); readln(r1); r1:=abs(r1);
if R1>100 then R1:=100;
end;
Case sch of
1: Check_1;
2: Check_2;
3: Check_3;
4: Check_4;
end;
nb:=0; for i:=1 to N do if not bo[i] then inc(nb);
writeln('> ЋвдЁ«мва®ў ® ',nb,' в®зҐЄ, иЁаЁ Ї®«®бл Їа®ЇгбЄ Ёп ',s:10:10);
write(' ‘®еа Ёвм १г«мв в (1-¤ , 2-ЇҐаҐдЁ«мва®ў вм § ®ў®) : '); readln(i);
until i=1;
assign(t,'result.txt'); rewrite(t);
for i:=1 to N do
if bo[i] then writeln(t,y[i],', ',ya[i]);
close(t);
end.
MaxN = 1000; {Њ ЄбЁ¬ «м®Ґ Є®«ЁзҐбвў® ®Ўа Ў влў Ґ¬ле в®зҐЄ}
type
real=single;
var
T:text;
y,ya:array[1..MaxN] of real;
bo:array[1..MaxN] of boolean;
N,N1,N2,sch,i,R1,R2,nb,nm:integer;
K,B,max,min,s:real;
oh:boolean;
fn:string;
procedure Find_Ta;
var r,i:integer;
km,xm:real;
begin
r:=round((N-1)*(1-R1/100)); if r<1 then r:=1; km:=0; nm:=0;
for i:=r+1 to N do begin k:=(y[i]-y[i-r])/r;
if k>km then begin km:=k; nm:=i; end;
end;
nm:=nm-(r div 2);
K:=km; B:=y[nm]-nm*K;
end;
procedure Check_1;
var I:integer; Tob:real;
begin
s:=0; Tob:=nm-B/K;
for i:=1 to N do begin ya[i]:=1-exp(-1/Tob*i); s:=s+sqr(y[i]-ya[i]); end;
s:=sqrt(s/N)*R2/100;
for i:=1 to N do
bo[i]:=(abs(y[i]-ya[i])<s)
end;
procedure Check_2;
var i:integer; theta:real;
begin
s:=0; theta:=0.632/K;
for i:=1 to N do begin ya[i]:=1-exp(-1/theta*i); s:=s+sqr(y[i]-ya[i]); end;
s:=sqrt(s/N)*R2/100;
for i:=1 to N do bo[i]:=(abs(y[i]-ya[i])<s)
end;
procedure Check_3;
var i:integer; t1,t2,T:real;
begin
s:=0; t1:=0.283/K; t2:=0.632/K; T:=1.5*(t2-t1);
for i:=1 to N do begin ya[i]:=1-exp(-1/T*i); s:=s+sqr(y[i]-ya[i]); end;
s:=sqrt(s/N)*R2/100;
for i:=1 to N do bo[i]:=(abs(y[i]-ya[i])<s)
end;
procedure Check_4;
var i,j,r:integer; s,ss:real;
begin
for i:=1 to N do begin bo[i]:=true; ya[i]:=0; end;
r:=round(N*(1-R1/100)); if r<3 then r:=3;
for i:=r to N do begin
ss:=0; for j:=i-r+1 to i do ss:=ss+y[j]; ss:=ss/r;
s:=0; for j:=i-r+1 to i do s:=s+sqr(y[j]-ss);
s:=sqrt(s/N)*R2/100;
for j:=i-r+1 to i do if abs(y[j]-ss)>s then bo[j]:=false;
end;
end;
begin
writeln(#10#13'> Џа®Ја ¬¬ дЁ«мва жЁЁ ¤ ле дгЄжЁЁ ®вЄ«ЁЄ , v.1.0, (б)2000 ЊЁваЁзҐў ‘ҐаЈҐ© *');
write(' €¬п д ©« б ¤ л¬Ё : '); readln(fn);
Write(' Ќ®¬Ґа в®зЄЁ з « ў®§¬г饨п : '); readln(N1);
Write(' Ќ®¬Ґа в®зЄЁ ®Є®з Ёп ў®§¬г饨п : '); readln(N2);
N:=N2-N1+1;
if N<2 then begin writeln('> ЋиЁЎЄ : Ґ¤®ЇгбвЁ¬®Ґ Є®«ЁзҐбвў® в®зҐЄ!'); exit end;
assign(t,fn);
{$I-} reset(t); {$I+} if ioresult<>0 then begin writeln('> ЋиЁЎЄ : ҐЇа ўЁ«м®Ґ Ё¬п д ©« !'); exit end;
while (not eof(t)) and (N1>1) do begin readln(t); dec(N1); end;
i:=1;
while (not eof(t)) and (i<=N) and (i<=MaxN) do begin readln(t,y[i]); inc(i); end;
close(t); dec(i);
if i<>N then begin N:=i; writeln('> ЋиЁЎЄ : ҐЄ®а४влҐ ¤ лҐ, § Ја㦥® ',N,' в®зҐЄ!'); end;
write(' •®¤ Їаאַ© (1) Ё«Ё ®Ўа вл© (2) : '); Readln(i);
if i=2 then for i:=1 to N do y[i]:=-y[i];
max:=y[1]; min:=y[1];
for i:=2 to N do begin
if y[i]>max then max:=y[i];
if y[i]<min then min:=y[i];
end;
for i:=1 to N do y[i]:=(y[i]-min)/(max-min);
repeat
write(' ‘奬 дЁ«мва жЁЁ (1,2,3 - нЄбЇ., 4 - бЄ.б।ҐҐ) : '); readln(sch);
write(' ЁаЁ Ї®«®бл Їа®ЇгбЄ Ёп (ў % ®в ўлЎ®а®з®© ¤ЁбЇҐабЁЁ) : '); readln(r2); r2:=abs(r2);
if sch in [1..3] then begin
write(' —гўб⢨⥫м®бвм Ї®ЁбЄ Ї®бв®п®© ўаҐ¬ҐЁ (ў %) : '); readln(r1); r1:=abs(r1);
if R1>100 then R1:=100;
Find_Ta;
end else
begin
write(' —гўб⢨⥫м®бвм б奬л (ў % ®в ўлЎ®аЄЁ) : '); readln(r1); r1:=abs(r1);
if R1>100 then R1:=100;
end;
Case sch of
1: Check_1;
2: Check_2;
3: Check_3;
4: Check_4;
end;
nb:=0; for i:=1 to N do if not bo[i] then inc(nb);
writeln('> ЋвдЁ«мва®ў ® ',nb,' в®зҐЄ, иЁаЁ Ї®«®бл Їа®ЇгбЄ Ёп ',s:10:10);
write(' ‘®еа Ёвм १г«мв в (1-¤ , 2-ЇҐаҐдЁ«мва®ў вм § ®ў®) : '); readln(i);
until i=1;
assign(t,'result.txt'); rewrite(t);
for i:=1 to N do
if bo[i] then writeln(t,y[i],', ',ya[i]);
close(t);
end.
Соседние файлы в папке АСР-ТАУ (Дубровский)