diff options
Diffstat (limited to 'werteunit.pas')
-rw-r--r-- | werteunit.pas | 91 |
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 |