matheunit.pas: sortiereNachWert und sortiereNachDominanz neu

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.