summaryrefslogtreecommitdiff
path: root/werteunit.pas
diff options
context:
space:
mode:
Diffstat (limited to 'werteunit.pas')
-rw-r--r--werteunit.pas91
1 files changed, 76 insertions, 15 deletions
diff --git a/werteunit.pas b/werteunit.pas
index 1044fd4..28b434f 100644
--- a/werteunit.pas
+++ b/werteunit.pas
@@ -51,8 +51,8 @@ type
procedure kopiereLOVerzerrt(original: pTLLWerteExtended; xMin,xMax,tMin,tMax: longint; verhHo,verhVe: extended); overload;
destructor destroy; override;
function liesDateien(dateien: tGenerischeInputDateiInfoArray): boolean;
- function fft(senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: extended; out pvFehler: extended): boolean; overload; inline;
- function fft(sMin,sMax: longint; senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: extended; out pvFehler: extended): boolean; overload;
+ function fft(senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: tExtendedArray; out pvFehler: extended): boolean; overload; inline;
+ function fft(sMin,sMax: longint; senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: tExtendedArray; out pvFehler: extended): boolean; overload;
procedure spiegle; overload;
procedure spiegle(tMin,tMax: longint); overload;
procedure fft2dNachbearbeitungA(nB: tFFTDatenordnung);
@@ -76,9 +76,10 @@ type
function ermittleRandDurchschnitt: extended;
function ermittleRandMinimum: extended;
function ermittleRandPerzentil(p: extended): extended;
+ procedure integriereVertikal(xMi,xMa,tMi,tMa: int64; hg: pTExtendedArray);
procedure kantenFilter(betraege: tLLWerte; xFak,yFak: extended; filterTyp: tKantenFilterTyp); overload;
procedure kantenFilter(betraege: tLLWerte; xFak,yFak: extended; filterTyp: tKantenFilterTyp; einseitig: boolean; out maxPos: tInt64Point); overload;
- procedure fenstereWerte(xMi,xMa,tMi,tMa: int64; xFen,tFen: tFenster; hg: extended);
+ procedure fenstereWerte(xMi,xMa,tMi,tMa: int64; xFen,tFen: tFenster; hg: tExtendedArray);
procedure verschiebe(richtung: tInt64Point; xV,xB,tV,tB: longint);
procedure ermittlePhasenWinkel(xMi,xMa: longint);
procedure macheKomplex(tMi,tMa: int64; kmm: tKomplexMachModus; mT: tMersenneTwister);
@@ -708,7 +709,7 @@ begin
end;
end;
-function tLLWerte.fft(senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: extended; out pvFehler: extended): boolean;
+function tLLWerte.fft(senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: tExtendedArray; out pvFehler: extended): boolean;
begin
if senkrecht then
result:=fft(0,params.xSteps-1,senkrecht,invers,algo,fen,hg,pvFehler)
@@ -716,7 +717,7 @@ begin
result:=fft(0,params.tSiz-1,senkrecht,invers,algo,fen,hg,pvFehler);
end;
-function tLLWerte.fft(sMin,sMax: longint; senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: extended; out pvFehler: extended): boolean;
+function tLLWerte.fft(sMin,sMax: longint; senkrecht,invers: boolean; algo: tFFTAlgorithmus; fen: tFenster; hg: tExtendedArray; out pvFehler: extended): boolean;
var
i,j,pMax,pStep,sStep,imShift: longint;
in0,out0,imPart,vollKomplex: boolean;
@@ -739,7 +740,25 @@ begin
if assigned(fen) and fen.aktiv then begin
if invers then
gibAus('fft: Warnung, hier wird bei einer inversen FFT gefenstert - soll das so sein?',1);
- offset:=byte(not invers)*hg;
+ offset:=0;
+ if not invers then begin
+ if length(hg)=1 then
+ offset:=hg[0]
+ else if length(hg)<>0 then begin
+ if length(hg)<>params.xSteps then begin
+ gibAus('fft: Der abzuziehende Hintergrund hat die falsche Länge: '+intToStr(length(hg))+' vs. '+intToStr(params.xSteps),1);
+ exit;
+ end;
+ if senkrecht then
+ for j:=0 to pMax do
+ for i:=sMin to sMax do
+ werte[i+j*params.xSteps]:=werte[i+j*params.xSteps] - hg[i]
+ else
+ for j:=sMin to sMax do
+ for i:=0 to pMax do
+ werte[i+j*params.xSteps]:=werte[i+j*params.xSteps] - hg[i];
+ end;
+ end;
if length(fen.werte)<>pMax+1 then begin
gibAus('Die Breite des FFT-Fensters ('+intToStr(length(fen.werte))+') ist nicht gleich der Breite der Werte ('+intToStr(pMax+1)+')!',1);
exit;
@@ -821,11 +840,27 @@ begin
if (nachher=0) and (vorher=0) then pvFehler:=0
else pvFehler:=abs(nachher-vorher)/(nachher+vorher);
- if invers and (hg<>0) then
- for i:=sMin to sMax do // Hintergrund addieren
- for j:=0 to pMax do
- werte[i*sStep+j*pStep]:=
- werte[i*sStep+j*pStep]+hg;
+ if invers and (length(hg)<>0) then begin // Hintergrund addieren
+ if length(hg)=1 then
+ for i:=sMin to sMax do
+ for j:=0 to pMax do
+ werte[i*sStep+j*pStep]:=
+ werte[i*sStep+j*pStep]+hg[0]
+ else if length(hg)<>0 then begin
+ if length(hg)<>params.xSteps then begin
+ gibAus('fft: Der zu addierende Hintergrund hat die falsche Länge: '+intToStr(length(hg))+' vs. '+intToStr(params.xSteps),1);
+ exit;
+ end;
+ if senkrecht then
+ for j:=0 to pMax do
+ for i:=sMin to sMax do
+ werte[i+j*params.xSteps]:=werte[i+j*params.xSteps] + hg[i]
+ else
+ for j:=sMin to sMax do
+ for i:=0 to pMax do
+ werte[i+j*params.xSteps]:=werte[i+j*params.xSteps] + hg[i];
+ end;
+ end;
gibAus(intToStr(byte(senkrecht))+' '+intToStr(byte(invers))+' (Parseval-Fehler = '+floatToStr(pvFehler)+') ... nämlich von '+floatToStr(vorher)+' zu '+floatToStr(nachher),1);
if in0 then gibAus('Nur Nullen im Input der FFT!',1);
@@ -1506,6 +1541,18 @@ begin
result:=werte[posi[i]['x']+posi[i]['y']*params.xSteps];
end;
+procedure tLLWerte.integriereVertikal(xMi,xMa,tMi,tMa: int64; hg: pTExtendedArray);
+var
+ i,j: int64;
+begin
+ for i:=xMi to xMa do begin
+ hg^[i]:=0;
+ for j:=tMi to tMa do
+ hg^[i]:=hg^[i]+werte[i+j*params.xSteps];
+ hg^[i]:=hg^[i]/(tMa+1-tMi);
+ end;
+end;
+
procedure tLLWerte.kantenFilter(betraege: tLLWerte; xFak,yFak: extended; filterTyp: tKantenFilterTyp);
var
dummy: tInt64Point;
@@ -1644,14 +1691,28 @@ begin
end;
end;
-procedure tLLWerte.fenstereWerte(xMi,xMa,tMi,tMa: int64; xFen,tFen: tFenster; hg: extended);
+procedure tLLWerte.fenstereWerte(xMi,xMa,tMi,tMa: int64; xFen,tFen: tFenster; hg: tExtendedArray);
var
- i,j: int64;
+ i,j: int64;
+ offset: extended;
begin
+ offset:=0;
+ if length(hg)=1 then
+ offset:=hg[0]
+ else if length(hg)<>0 then begin
+ if length(hg)<>params.xSteps then begin
+ gibAus('Der abzuziehende Hintergrund hat die falsche Länge: '+intToStr(length(hg))+' vs. '+intToStr(params.xSteps),1);
+ exit;
+ end;
+ for j:=tMi to tMa do
+ for i:=xMi to xMa do
+ werte[i+j*params.xSteps]:=werte[i+j*params.xSteps] - hg[i];
+ end;
+
for j:=tMi to tMa do
for i:=xMi to xMa do
werte[i+j*params.xSteps]:=
- (werte[i+j*params.xSteps]-hg)*xFen.werte[i]*tFen.werte[j];
+ (werte[i+j*params.xSteps]-offset)*xFen.werte[i]*tFen.werte[j];
end;
procedure tLLWerte.verschiebe(richtung: tInt64Point; xV,xB,tV,tB: longint);
@@ -1885,7 +1946,7 @@ begin
end;
gibAus(intToStr(werte.params.xSteps)+' '+intToStr(werte.params.tSiz)+' '+intToStr(length(werte.werte)),1);
tmpFFTAlgo:=createFFTAlgorithmus(2*hLen,doRes,doResIms);
- werte.fft(true,false,tmpFFTAlgo,nil,0,pvFehler);
+ werte.fft(true,false,tmpFFTAlgo,nil,nil,pvFehler);
tmpFFTAlgo.free;
end;
wtFrequenzfenster: begin