summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorErich Eckner <git@eckner.net>2019-01-24 15:46:44 +0100
committerErich Eckner <git@eckner.net>2019-01-24 15:46:44 +0100
commit0bc5b2f119fb48cf3914ca5bb8816e626cc1993c (patch)
tree401e8f02538c9c6ef51842038c5b908de9318e60
parent4a380091d7170b5f4b016388ffac5ff841b8f167 (diff)
downloadunits-0bc5b2f119fb48cf3914ca5bb8816e626cc1993c.tar.xz
matheunit.pas: sortiereNachWert und sortiereNachDominanz neu
-rw-r--r--matheunit.pas136
1 files changed, 136 insertions, 0 deletions
diff --git a/matheunit.pas b/matheunit.pas
index 5974e4b..9ee4f4b 100644
--- a/matheunit.pas
+++ b/matheunit.pas
@@ -66,6 +66,8 @@ function berechneEinheitsZelle(invarianz,modulus: tInt64Point): tInt64Point;
function ggT(a,b: int64): int64;
function ermittleAnstieg(dat: string; xSpalte,ySpalte: longestOrdinal): extended;
function ermittleMittelwert(dat: string; werteSpalte,gewichteSpalte: longestOrdinal): extended;
+procedure sortiereNachWert(var maxima: tLongintArray; werte: tExtendedArray; logarithmischesPivot: boolean);
+procedure sortiereNachDominanz(var maxima: tLongintArray; werte: tExtendedArray; nullteSpektrometerordnung: extended);
implementation
@@ -1102,5 +1104,139 @@ begin
result:=wSum/gSum;
end;
+procedure sortiereNachWert(var maxima: tLongintArray; werte: tExtendedArray; logarithmischesPivot: boolean);
+var
+ mins,maxs: tExtendedArray;
+ pivot,wert,wertLi,wertRe: extended;
+ vons,biss: tLongintArray;
+ i,li,re,cnt,tmp: int64;
+begin
+ setLength(vons,1);
+ vons[0]:=0;
+ setLength(biss,1);
+ biss[0]:=length(maxima)-1;
+ setLength(mins,1);
+ setLength(maxs,1);
+ mins[0]:=0;
+ maxs[0]:=0;
+ for i:=vons[0] to biss[0] do begin
+ wert:=werte[maxima[i]];
+ if (i=vons[0]) or (wert>maxs[0]) then
+ maxs[0]:=wert;
+ if (i=vons[0]) or (wert<mins[0]) then
+ mins[0]:=wert;
+ end;
+ cnt:=1;
+
+ while cnt>0 do begin
+ li:=vons[cnt-1];
+ re:=biss[cnt-1];
+
+ if (li>=re) or (mins[cnt-1]=maxs[cnt-1]) then begin
+ dec(cnt);
+ continue;
+ end;
+
+ if cnt>=length(vons) then begin
+ setLength(vons,cnt+100);
+ setLength(biss,cnt+100);
+ setLength(mins,cnt+100);
+ setLength(maxs,cnt+100);
+ end;
+
+ if logarithmischesPivot and (maxs[cnt-1]*mins[cnt-1]>0) then begin
+ pivot:=sqrt(maxs[cnt-1]*mins[cnt-1]);
+ if (pivot<=mins[cnt-1]) or (pivot>=maxs[cnt-1]) then
+ pivot:=(maxs[cnt-1]+mins[cnt-1])/2;
+ end
+ else
+ pivot:=(maxs[cnt-1]+mins[cnt-1])/2;
+ if pivot>=maxs[cnt-1] then
+ pivot:=mins[cnt-1];
+
+ mins[cnt]:=mins[cnt-1];
+ biss[cnt]:=biss[cnt-1];
+ maxs[cnt]:=mins[cnt];
+ mins[cnt-1]:=maxs[cnt-1];
+
+ while li<=re do begin
+ wertLi:=werte[maxima[li]];
+ if wertLi>pivot then begin
+ if wertLi<mins[cnt-1] then
+ mins[cnt-1]:=wertLi;
+ inc(li);
+ continue;
+ end;
+ wertRe:=werte[maxima[re]];
+ if wertRe<=pivot then begin
+ if wertRe>maxs[cnt] then
+ maxs[cnt]:=wertRe;
+ dec(re);
+ continue;
+ end;
+ if wertLi>maxs[cnt] then
+ maxs[cnt]:=wertLi;
+ if wertRe<mins[cnt-1] then
+ mins[cnt-1]:=wertRe;
+ tmp:=maxima[re];
+ maxima[re]:=maxima[li];
+ maxima[li]:=tmp;
+ inc(li);
+ dec(re);
+ end;
+
+ vons[cnt]:=li;
+ biss[cnt-1]:=re;
+
+ inc(cnt);
+ end;
+
+ for i:=1 to length(maxima)-1 do
+ if werte[maxima[i-1]]<werte[maxima[i]] then
+ fehler('Interner Fehler: Werte sind nicht sortiert, sollten sie aber sein!');
+end;
+
+procedure sortiereNachDominanz(var maxima: tLongintArray; werte: tExtendedArray; nullteSpektrometerordnung: extended);
+var
+ i,j,dom,schranke: int64;
+ dominanzen: tExtendedArray;
+ tmp: tLongintArray;
+begin
+ // zuerst sortieren wir die Maxima nach Höhe
+ sortiereNachWert(maxima,werte,true);
+ // dann berechnen wir die Dominanzen aller Maxima
+ setLength(dominanzen,length(maxima));
+ for i:=0 to length(dominanzen)-1 do begin
+ schranke:=length(werte);
+ for j:=0 to i-1 do
+ schranke:=min(schranke,abs(maxima[i]-maxima[j]));
+ dom:=1;
+ while (dom<schranke) and
+ ((maxima[i]+dom>=length(werte)) or (werte[maxima[i]+dom]<=werte[maxima[i]])) and
+ ((maxima[i]-dom<0) or (werte[maxima[i]-dom]<=werte[maxima[i]])) do
+ inc(dom);
+ dominanzen[i]:=dom;
+ if (maxima[i]+dom < length(werte)) and (werte[maxima[i]]<werte[maxima[i]+dom]) then // der rechte Rand hat getriggert
+ dominanzen[i]:=dom - 1 + 1 / (1 - (werte[maxima[i]+dom]-werte[maxima[i]])/(werte[maxima[i]+dom-1]-werte[maxima[i]]));
+ if (maxima[i]-dom >= 0) and (werte[maxima[i]]<werte[maxima[i]-dom]) then // der linke Rand hat getriggert
+ dominanzen[i]:=min(dominanzen[i],dom - 1 + 1 / (1 - (werte[maxima[i]-dom]-werte[maxima[i]])/(werte[maxima[i]-dom+1]-werte[maxima[i]])));
+ if not isNaN(nullteSpektrometerordnung) then
+ dominanzen[i]:=dominanzen[i] / sqr(i - nullteSpektrometerordnung);
+ end;
+
+ // und sortieren nach Dominanz
+ setLength(tmp,length(maxima));
+ for i:=0 to length(tmp)-1 do begin
+ tmp[i]:=maxima[i];
+ maxima[i]:=i;
+ end;
+ sortiereNachWert(maxima,dominanzen,false);
+
+ for i:=0 to length(tmp)-1 do
+ maxima[i]:=tmp[maxima[i]];
+ setLength(tmp,0);
+ setLength(dominanzen,0);
+end;
+
end.