Wie auf unbekanntes Element eines Recorarrays zugreifen?

[mschnell]

Aber das geht wohl nur bei Zahlen. Bei Strings muß ich sicher byteweise vergleichen. Und bei booleans?

Bei Zahlen ist i.A. klar, welche größer ist. bei anderen Datentypen muss man (mathematisch ausgedrückt) eine für die Anwendung passende Ordnung auf der Menge definieren.

z.B True < False (oder auch umgekehrt, wenn Dir das lieber ist). :

Code: Alles auswählen

if logi then Result := -1 else Result := 1;

Bei Strings gibt es in Pascal eine Ordnung einfach mit "<" (lexikografische Ordnung).

Das kannst Du z.B. so anwenden

Code: Alles auswählen

if s1 < s2 then begin
  Result := -1;
 end else begin
  if s1 > s2 then begin
    Result := 1;
   end else begin
    Result := 0;
  end;
end;

Bei einem Komplexen Datentyp (Record) musst Du Dir natürlich selber einen (mathematischen) Ordnungs-Algorithmus definieren. Der Sortier-Algorithmus wertet das (integer) Ergebnis nur nach <0 / =0 / > 0 aus.

Manchmal ist es sinnvoll, über den Speicherberiech des Record einfach einen Hash (z.B. Summer aller Bytes, CRC oder was auch immer) zu rechnen. Das gibt dann "irgendeine" Sortierung.

Wenn es passieren kann, dass Elemente nicht gleich, aber "gleichwertig" (Vergleich ergibt 0) sind, ist die Sortierung nicht eindeutig. Das kann sinnvoll sein, muss aber nicht.

-Michael

[Socke]

Bei Strings gibt es in Pascal eine Ordnung einfach mit "<" (lexikografische Ordnung).

Das kannst Du z.B. so anwenden

Code: Alles auswählen

if s1 < s2 then begin
  Result := -1;
 end else begin
  if s1 > s2 then begin
    Result := 1;
   end else begin
    Result := 0;
  end;
end;

Da gibt es bereits fertige Funktionen: http://www.freepascal.org/docs-html/rtl ... tions.html

[mschnell]

Gut zu wissen !

Vermutlich ist das auch effektiver programmiert als mein Beispiel, das zwei String-Compare Aufrufe macht.

Vielen Dank !

-Michael

[br_klaus]

sortprogs.inc

weitere Sortroutinen

(6.54 KiB) 79-mal heruntergeladen

sort.inc

Meine Sortroutine(n)

(22.56 KiB) 64-mal heruntergeladen

Lieber Theo & Co.


Jetzt kapiere ich langsam, daß mit Pointer(<integer>) kein "Zeiger" im eigentlichen Sinne gesetzt wird (für mich waren Pointer immer Zeiger auf einen Speicherort), sondern dieser dann einfach als Platzhalter für diese Integerzahl dient. Daher dann natürlich auch in der Vergleichsfunktion result := word(p)-word(q) - wenn zB Word-Variablen.
Hat lang gedauert, bis der Groschen gefallen ist...


Da ich nicht direkt TList.Sort verfolgen konnte, mußte ich mich mit dem jeweilgen Aufruf der Vergleichsfunktion IntSort begnügen. Aber um da feststellen zu können, welche Werte bzw. Elemente im Array gerade miteinander verglichen werden, mußte ich doch auf "normale" Zeiger zurückgreifen. Und zur Ausgabe der Werte benütze ich eine (bereits initialisierte) TStringlist (namens NameList):

Code: Alles auswählen

 
TYPE IntWord = Word; // zum Ausprobieren
     array15 = array[0..14] of IntWord;
var aa:array15 = (4,1,1,2,5,2,3,1,2,8,4,1,6,9,2);
    ww:array15;
    SA: TArraySort;
 
procedure SortWerte(s:string); overload; // Speichern in StringList
     begin namelist.Add(s); end;
 
procedure SortWerte(x,y:dword; px,py:intword); overload;
     var s:string;
     begin s:= sysutils.format('%4d  %5d %3d  %5d %3d %6d',[sortcount, x,y, px,py, px-py]);
      SortWerte(s);
     end;
 
 
 
Function IntSort(p,q:pointer):integer;
  var n:integer;  pp,qq:intword; pofs,qofs:word;  s:string;
  begin
    pofs:=(p-@aa) div sizeof(aa[0]); qofs:=(q-@aa) div sizeof(aa[0]);
    inc(sortcount); pp:=intword(p^); qq:=intword(q^);
    SortWerte(pofs,qofs, pp,qq);
    result:=intWord(p^)-intword(q^);
  end;
 
Procedure SortInt;
  var n,i:integer; liste:TList;
  begin
    n:=length(aa); liste:=TList.create;  sortcount:=0;
    SortWerte('TList-Sort');
    for i:=0 to n-1 do Liste.Add(@aa[i]);
    Liste.sort(@IntSort);
    for i:=0 to n-1 do ww[i]:=intWord(Liste.Items[i]^);
  end;
 

Meine SortierProzedur (mit den verschiedenen möglichen Algorithmen) habe ich wieder etwas geändert, um auch dynamische Arrays einlesen zu können. Ich brauche dazu aber die Angabe eines Ptr-arrays mit Zeigern auf dieses. In varinta sehe ich keine Möglichkeit, vom Programm selber erkennen zu lassen, ob es sich bei der Variablen um ein RangedArray handelt oder ein Openarray, obwohl der Compiler das ja sehr wohl unterscheidet (der liest aber auch den Quelltext, und das geht ja jetzt nicht). Oder gibt es da doch eine Möglichkeit?

Auch intern bin ich auf FPtr: array of pointer umgestiegen. Es könnte ja sein, daß sonst das REcordarray als Block grüßer wird als die gerade noch mögliche maximale Blockgröße im Speicher.



Die beiden Prozeduren (für einfache Arrays bzw RecordArrays) lauten jetzt:

Code: Alles auswählen

  procedure SortArray(a:PChar; zg: array of pointer; cnt:dword; size:integer; // nur 1 Feld
         v:variant; modus:array of integer);
            // modus = [SortProc, Skip_doubles, ReverseCount]
 
  procedure SortRecords(a:Pchar; zg: array of pointer; cnt:dword; size:integer;
         v:array of word; offs:array of pchar; seq:array of integer;
         modus:array of integer);
 
 

Dabei sind

Code: Alles auswählen

var a = der Array selber; cnt = Anzahl Records; size = Größe eines Records
v = variant des/der zu vergleichenden Feldes/Felder
offs = die dazugehörigen Offsets im Record
seq = Sortierreihenfolge als IntegerArray (beginnend mit 1), wenn negativ, dann Sortierrichtung abwärts
modus = [SortProc, Skip_doubles, ReverseCount] mit
Sortproc: 0 = KOLQSort, 1 = LazQSort, 2 = JumpSort
Skip_doubles: 1, wenn Verdoppelungen gelöscht werden sollen
ReverseCount: integer = (bei JumpSort) minimale Anzahl aufeinander folgender Elemente in absteigender Linie ( a[n]>a[n+1] ), die dann umgedreht wird
 

und dann der Aufruf mit

Code: Alles auswählen

 
Type intword = word; // zum Ausprobieren
Type array15 = array[0..14] of intword;
var aa:array15 = (4,1,1,2,5,2,3,1,2,8,4,1,6,9,2);
    ww:array15;
 
 
 
Type
  TSortType = (LazQ, KOLQ, Jump, Bubble, Shaker, Selection, Insertion, Shell,
          Quick, UsualInsertion, UsualQuick);
 
Procedure SortVergleich;
   var i: TSortType; n:integer; s:string;
   begin
     namelist.clear;
    move(aa,ww, sizeof(aa));
     Sortint;
     move(aa,ww, sizeof(aa));
 
   for i:= low(TSortType) to high(TSortType) do
    begin
       move(ww,aa, sizeof(aa));
     SA.SortArray(@aa, nil, length(aa), sizeof(aa[0]), aa[0], [byte(i)]); // LazQSort
     s:=''; for n:=0 to length(aa)-1 do s:= s + intToStr(aa[n]) + ' ';
     namelist.add(s+#13#10);
    end;
   namelist.SaveToFile(LazDocs+'SortArray.txt');
   halt;
 
   end;
 

Habe jetzt auch den Fehler in meiner Quicksort-Portierung entdeckt:
Ich hatte übersehen, daß Lazarus beim Bestimmen des Pivot- (Dreh-, Angelpunkt) Elements p der Liste wohl auf die (schon geordnete) Liste zugreift:
p := Liste^[(L+R) div 2],
dann aber während des ganzen Prozedurdurchlaufs, auch wenn zwischendrin Liste^[(L+R) div 2] selbst verändert wird (mit einem anderen ListenElement vertauscht), es selber unverändert bleibt. Bei meinem Programm nahme ich beide zu vergleichenden Elemente jeweils aus der sortierten Liste.
Ich mußte also nur in meinem Programm eine neue Vergleichsfunktion LSort(x,y:integer):integer einfügen, in der nur das zweite Element aus der sich ändernden Liste genommen wird.


So sieht meine Sortierfunktion nun folgendermaßen aus (schon angepaßt an Sortierung beliebiger Records mit array[variants] und array[offsets] zur Bestimmung des Ortes der zu vergleichenden Record-Felder:

Code: Alles auswählen

Function TSortArrayType.SeqSort(seq:array of word; p,q:PChar):integer;
         // sortieren gemäß SortierSequenz
      var n:word; i:integer; POffs,QOffs:Pchar;
      begin
        result:=0; i:=0;
        repeat
           n:=seq[i];
           POffs:=p+Foffsets[n]; QOffs:=q+ Foffsets[n];
           result:= aufab[n]*VarTypeSort(Ftypes[n], poffs,qoffs);
             if result<>0 then
                          exit;
           inc(i);
        until i>=length(seq);
      end;
 
   function TSortArrayType.Sort(x,y:dword):integer; // Vergleich zweier Elemente
     var p,q:pchar;
     begin
       p:= FPtr[x]; q:= Fptr[y];
       //p:=FData+x*FSize; q :=FData +y*FSize;
 
       if Felder = 1 then
        result:= VarTypeSort(Ftype, p, q)
       else
        result:= SeqSort(FSeq, p, q);
 
     end;
 
   function TSortArrayType.LSort(x,y:dword):integer; // Lazarus Quicksort
      begin result:= sort(x, pp^[y]); end;
 
   function TSortArrayType.PPSort(x,y:dword):integer;
     begin result:= sort(pp^[x], pp^[y]); end;
 

Wenn ich jetzt hiermit LazQSort aufrufe, dann stimmt das Ergebnis mit dem von Tlist.Sort überein.
Dann brauche ich auch die gleichen 61 Vergleichsoperationen...


Ich dachte, mein Sortieralgorithmus würde weniger Vergleiche benötigen, aber der braucht auch 53, KOL hingegen nur 44!


Übrigens, mit der Einfügung von if p<>FList^ bzw p<>FList^[j] bei den beiden while's

Code: Alles auswählen

 
     while Compare(P, FList^[i]) > 0 do
       I := I + 1;
     while Compare(P, FList^[J]) < 0 do
       J := J - 1;
 
 

konnte ich auch gleich 10 compare's vermeiden (damit hätte dann Lazarus doch wieder weniger als mein Programm)

Und mit der Abfrage zu Beginn, wenn R-L = 1, dann nur Tausch (falls [L]>[R]), wurde es noch ein compare weniger (also 50):

Code: Alles auswählen

   if R-L=1 then
    begin
      if Compare(Flistt^[L], Flist[R]>0) then swap(L,R);
      exit;
    end; 
 
 

Es würde sich wohl fast lohnen, die KOL-Version in Lazarus zu übernehmen...

Habe noch eine ganze Reihe anderer Sortieralgorithmen gefunden, die ich an mein Programm angepasst habe (v.a. mußte ich einige Male auch dort PPsort durch LSort ersetzen). Da gibt es auch eine eigene Quicksort-Routine, die sogar auf nur 47 Compare-Aufrufe kommt.
Aber am wenigsten (zumindest bei diesem Array) braucht KOL.

[mse]

Meine SortierProzedur (mit den verschiedenen möglichen Algorithmen) habe ich wieder etwas geändert, um auch dynamische Arrays einlesen zu können.

Fals es dich interessiert, MSEgui hat auch solche Funktionen:
http://gitorious.org/mseide-msegui/msei ... yutils.pas
Die MSEgui Array-Sortierfunktionen arbeiten mit Mergesort, welches gegenüber Quicksort den Vorteil hat die ursprüngliche Ordnung der Elemente beizubehalten, wenn beim Vergleich eine Null resultiert. Zudem hat Quicksort die unangenehme Eigenschaft, für spezielle Mengen sehr langsam zu werden und der rekursive Aufruf der Prozeduren braucht viel CPU-Zeit. MSEgui verwendete früher eine stabile Quicksort Version, der Wechsel auf einen optimierten Mergesort brachte in der Praxis etwa eine Halbierung der Sortierzeiten.

http://de.wikipedia.org/wiki/Quicksort#Laufzeit
http://de.wikipedia.org/wiki/Mergesort#Komplexit.C3.A4t

Martin

[br_klaus]

Herzlichen Dank!

Mit den Angaben bei MESGui kann ich nicht allzuviel anfangen, das ist mir zu komplex. Aber die beiden anderen Seiten sind recht informativ.


Habe inzwischen noch eine Möglichkeit gefunden, die Anzahl der Vergleichsaufrufe teilweise signifikant zu verringern:
indem ich in einem Recordarray VRec = array[TVgl], TVgl = record cx,cy:dword; comp:integer; end; den Vergleich von Element x mit Element y speichere. Sobald dieser dann wieder gemacht werden soll (oft auch in der umgekehrten Reihenfolge), dann brauche ich nur auf diesen Record zuzugreifen und das Ergebnis einzulesen (negieren falls umgekerte Reihenfolge),
Durch zusätzliches Anlegen eines DwordArrays beg[] mit dem Beginn der Records für die jeweiligen Elemente kann ich die Abfrage des Programms noch mehr verkürzen.

Das Ganze sieht so aus:

Code: Alles auswählen

{$IFDEF VGL}
Type
  TVgl = record cx,cy:dword; comp:integer; end;
 
  TVglRec = object
     vRec: array of TVgl; 
     vlg, VRecLg,vnr:qword;
     beg: array of qword; beglg:dword;
     v: TVgl; 
     vcomp, faktor:integer;  
 
     procedure GetValues(x,y:dword); // ==> cx,cy, faktor
     function InVgl(x,y:dword; out vgl:integer):boolean;
     procedure Insert(v:TVgl; idx:qword);
     function compare(v: TVgl; idx:qword):integer;
     procedure Init(lg:integer);
     procedure free;
 
  end;
 
   procedure TVglRec.init(lg:integer);
     begin
       VRecLg:=0; setlength(Vrec,0); vlg:=0; setlength(beg, lg);
       beglg:=length(beg);
     end;
   procedure TVglRec.GetValues(x,y:dword);  // ==> cx,cy,faktor
     begin
        with v do
          begin
              if x>y then begin cx:=y; cy:=x; faktor:=-1; end
            else
              begin cx:=x; cy:=y; faktor:=1; end;
              comp:=0;
          end;
     end;
   function TVglRec.compare(v: TVgl; idx:qword):integer;
     Label Ende;
     begin result:=0;  if vlg=0 then exit;
       with VRec[idx] do
           begin
             if v.cx < cx then dec(result) else if v.cx > cx then inc(result);
               vcomp:=result;
               if result<>0 then exit;
             if v.cy < cy then dec(result) else if v.cy > cy then inc(result);
           end;
       vcomp:=result;
     end;
 
   procedure TVglRec.Insert(v:TVgl; idx:qword);
    var k:qword; Label Einfg;
    begin
      if idx>=VRecLg then begin setlength(VRec, VRecLg+$1000); VRecLg:=length(VRec); end;
      if idx=vlg then goto Einfg;
      k:=vlg;
      repeat Vrec[k]:=VRec[k-1]; dec(k); until k=idx;
  Einfg:
      VRec[idx]:=v; inc(vlg);
 
  // Erweitern von beg
     with v do
      if beg[cx]=0 then beg[cx]:=idx+1 else
        begin
          k:=cx; repeat inc(k);
             if beg[k]>0 then inc(beg[k]);
          until k>=beglg-1;
        end;
    end;
  function TVglRec.InVgl(x,y:dword; out vgl:integer):boolean;
        var i:qword;
      begin
       result:=false;
       GetValues(x,y); // -> faktor, v
        if VRecLg=0 then begin vnr:=0; exit; end;
 
      with v do
        begin
    // Bestimmen von beg[cx]    (enthält Indizes + 1
          i:=cx;
          while (i>0) and (beg[i]=0) do dec(i);
          if beg[i]>0 then i:= beg[i]-1 else i:=0;
          while (i<vlg) and (compare(v, i)>0) do inc(i);
          vnr:=i;
          if vcomp = 0 then
              begin
                result:=true; vgl:=faktor*VRec[i].comp;
              end;
        end;
      end;
 
   procedure TVglRec.free;
     begin init(0); end;
{$Endif Vgl}
 
 

Und dann beim Aufruf der Vergleiche:

Code: Alles auswählen

   function TSortArrayType.LSort(x,y:dword):integer; // Lazarus QSort
     var px,py:qword; res:integer;
      begin
  {$IFDEF VGL}
       with VglRec do
        begin
         if InVgl(x,pp^[y],result) then
            exit;
   {$Endif}
         result:= sort(x, pp^[y]);
   {$IFDEF Vgl}
         v.comp:=faktor*result;
         Insert(v,vnr);
        end;
   {$Endif}
 
// Werte zeigen
       inc(SortCount);  px:=0; py:=0;
       move(Fptr[x]^, px, FSize); move(FPtr[y]^,py, FSize);
       SortWerte(x, y, x, pp^[y], px,py);
      end;
 
 

Hier ein kurzer Vergleich der Anzahl der Vergleichsaufrufe bei den verschiedenen SortierAlgorithmen ohne / mit TVgl

KOLQ: 44 - 35
LazQ: 50 - 44
Jump: 53 - 43
Bubble 105 - 46
Shaker 105 - 45
Selection 105 - 85
Insertion 59 - 58
Shell 49 - 43
Quick 47 - 45
UsualInsertion 46 - 46
UsualQuick 50 - 39

Auch hier bleibt KOL Sieger!
Warum das nicht in Lazarus übernehmen?

Mir bleibt noch eine Frage: ich habe hier qword genommen für die Anzahl der Records, denn diese kann maximal n^2 sein. Kann das je größer als Dword werden? Gibt es ünerhaupt eine Beschränkung für offene Arrays, außer natürlich die vorhandene Speichergröße?