Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

ФВТ (КХТП) / Материалы для КХТП - 2002 / 5_course / 1semester / АСР-ТАУ (Дубровский) / ЛИСТИНГ ПРОГРАММЫ фильтрации данных

.doc
Скачиваний:
8
Добавлен:
08.01.2014
Размер:
30.72 Кб
Скачать

ЛИСТИНГ ПРОГРАММЫ фильтрации данных «ExpFiltr»

Язык программирования – Паскаль, среда программирования – Borland Pascal 7.0

Program ExpFiltr;

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.

Результат прогона программы на экспериментальном наборе данных:

> Программа фильтрации данных функции отклика, v.1.0

Имя файла с данными : data.txt

Номер точки начала возмущения : 540

Номер точки окончания возмущения : 670

Ход прямой (1) или обратный (2) : 1

Схема фильтрации (1,2,3 - эксп., 4 - ск.среднее) : 1

Ширина полосы пропускания (в % от выборочной дисперсии) : 100

Чувствительность поиска постоянной времени (в %) : 10

> Отфильтровано 61 точек, ширина полосы пропускания 0.1252496243

Сохранить результат (1-да, 2-перефильтровать заново) : 1

Соседние файлы в папке АСР-ТАУ (Дубровский)