[Back to OOP SWAG index] [Back to Main SWAG index] [Original]

    {
     DC> I'm setting up a directory list with some extra bells and whistles,
     DC> including descriptions. I want to be able to have different sort criteria
     DC> for the list, and the list should be in a
     DC> TSortedCollection.

     DC> 1. The most simple-minded. instantiate four different lists, and use just
     DC> one,

     DC> 2. Alternate procedures for each type of sort, calling common routines, or
     DC> passing the current collection type.

     DC> 3. A variant record to save the collection in.

     DC> The Question: Would this idea work, and do you think it's the best way to
     DC> do it?

    I have one program with the same problem, and I can suggest two more ways to do
    what you want:
    4.  A field in the collection saying which kind of sort you want, and a Resort
    method.  The KeyOf and/or Compare methods look at this field to decide how two
    records compare, and the Resort method re-inserts everything after you change
    the field, so it ends up in the correct order.
    5.  A non-method SortCollection function, that takes a Compare function as a
    procedural parameter.  You can use a TCollection if you're not interested in
    the search functions, or some variation on 4 if you are.

    I don't know which you'll find best.  Depends on your taste.  Here's some code
    that I use; you may want to borrow from it.
      {$N-,Q-}
      unit sorts;

      interface

      uses objects,base3;  { base3 can also be found in the SWAG collection !! }

      type
        comparison = function(a,b:pointer):boolean;
        { Returns true if a^ > b^ }

        local_comparison = function(a,b:pointer;frame:word):boolean;
        { A far local version of a comparison }

      procedure list_sort(var start:pointer; greater:comparison);
      { Procedure to do list insertion sort on the linked list pointed to by start.
        Greater points to the entry for a far function with declaration
          function greater^(i,j:pointer):boolean which returns true if i^ > j^
          and false otherwise.
        Assumes that pointers point to pointers, i.e. links should be the first
        element of records in the list.
        N.B.  If enough memory is available, it seems to be faster to make the list
        into an array, use arr_sort, and then un_make the array when there are
        more than about 100 records.
        }

      procedure arr_sort(var arr;size:word;greater:comparison);
      { Procedure to do a Quicksort on the array of pointers pointed to by arr.
        Greater is as in list_sort.  Makes no assumptions about what pointers
        point to.
        Based on Quicksort as given in Steal This Code, by F.D. Boswell, Watcom
    1986.  }

      procedure SortCollection(var Coll:TCollection;GreaterP:pointer);
      { Sorts a collection's pointers.  Greater should be a pointer to
        a local_comparison }

      function count_list(list:pointer):longint;
      { Counts the number of elements in the list}

      function make_array(list:pointer;size:longint;var arr:pointer):boolean;
      { Attempts to make an array of pointers from the list.  Returns true on
        success, false if it failed because not enough memory is available.  Always
        creates an array with size elements, but only fills those up to the
        smaller of the actual size of the list or size. }

      procedure un_make_array(var list:pointer;size:integer;var arr);
      { Adjusts the pointers in the list to reflect the ordering in the array.
        Doesn't check that they are all valid - be sure size reflects the
        true number of pointers in the array. }

      type
        PSortableCollection = ^TSortableCollection;
        TSortableCollection = object(TSortedCollection)
          procedure Sort;
          { Puts the elements of the collection in order.  This is only necessary
            if something about the sort order has changed, or elements were
    inserted        out of order. }
        end;

      implementation

      type
        list_ptr = ^list_rec;
        list_rec = record
          next : list_ptr;
        end;
        ptr_array = array[1..16380] of pointer;

      procedure list_sort(var start:pointer; greater:comparison);
      var
        first,rest,current,next:list_ptr;
      begin
        rest := list_ptr(start)^.next;     { Rest points to the uninserted part of
    the list }    first := start;          { first is a fake first entry in the new
    list }    first^.next := nil;
        start := @first;
        while rest <> nil do
        begin
          current := start;
          next := current^.next;
          while (next <> nil) and (not greater(next,rest)) do
          begin
            current := next;
            next := current^.next;
          end;
          current^.next := rest;
          current := rest;
          rest := rest^.next;
          current^.next := next;
        end;
        start := first;
      end;

      procedure arr_sort(var arr;size:word;greater:comparison);
      { Procedure to do a Quicksort on the array of pointers pointed to by arr.
        Greater is as in list_sort.  Makes no assumptions about what pointers
        point to.
        Based on Quicksort as given in Steal This Code, by F.D. Boswell, Watcom
    1986.  }
      var
        a:ptr_array absolute arr;

        procedure quick(first,last : word);
        var
          pivot : pointer;
          temp : pointer;
          scanright, scanleft : word;
        begin
          if (first < last) then
          begin
            pivot := a[first];
            scanright := first;
            scanleft := last;
            while scanright < scanleft do
            begin
              if greater(a[scanright+1], pivot) then
              begin
                if not greater(a[scanleft], pivot) then
                begin
                  temp := a[scanleft];
                  inc(scanright);
                  a[scanleft] := a[scanright];
                  a[scanright] := temp;
                  dec(scanleft);
                end
                else
                  dec(scanleft);
              end
              else
                inc(scanright);
            end;
            temp := a[scanright];
            a[scanright] := a[first];
            a[first] := temp;
            quick(first, scanright-1);
            quick(scanright+1, last);
          end;
        end;
      begin  {arr_sort}
        quick(1, size);
      end;

      function count_list(list:pointer):longint;
      { Counts the number of elements in a list }
      var
        l:list_ptr absolute list;
        size:longint;
      begin
        size := 0;
        while l <> nil do
        begin
          inc(size);
          l := l^.next;
        end;
        count_list := size;
      end;

      function make_array(list:pointer;size:longint;var arr:pointer):boolean;
      { Attempts to make an array of pointers from the list.  Returns true on
        success, false if it failed because not enough memory is available }
      var
        l:list_ptr absolute list;
        mem_needed:longint;
        a:^ptr_array absolute arr;
        i:integer;
      begin
        mem_needed := size*sizeof(pointer);
        if (mem_needed > 65520) or (mem_needed > MemAvail) then
        begin
          make_array := false;
          exit;
        end;
        GetMem(a,mem_needed);
        i := 0;
        while (i<size) and (l <> nil) do
        begin
          inc(i);
          a^[i] := l;
          l := l^.next;
        end;
        make_array := true;
      end;

      procedure un_make_array(var list:pointer;size:integer;var arr);
      { Adjusts the pointers in the list to reflect the ordering in the array.
        Doesn't check that they are all valid - be sure size reflects the
        true number of pointers in the array. }
      var
        l:list_ptr absolute list;
        current,next:list_ptr;
        a:ptr_array absolute arr;
        i:integer;
      begin
        l := a[1];
        current := l;
        for i := 2 to size do
        begin
          next := a[i];
          current^.next := next;
          current := next;
        end;
        current^.next := nil;
      end;

      procedure TSortableCollection.Sort;
      { Procedure to do a Quicksort on the collection elements.
        Based on Quicksort as given in Steal This Code, by F.D. Boswell, Watcom
    1986.  }
        procedure quick(first,last : word);
        var
          pivot : pointer;
          temp : pointer;
          scanright, scanleft, tielimit : word;
          direction : integer;
        begin
          if (first+1) < (last+1) then  { This allows for last=-1 }
          begin
            { First, choose a random pivot }
            scanright := first+random(last-first);
            pivot := items^[scanright];
            items^[scanright] := items^[first];
            items^[first] := pivot;

            scanright := first;
            scanleft := last;
            tielimit := (first+last) div 2;
            while scanright < scanleft do
            begin
              direction := compare(items^[scanright+1], pivot);
              if (direction>0) or ((direction = 0) and (scanright > tielimit)) then
              begin
                if compare(items^[scanleft], pivot)<=0 then
                begin
                  temp := items^[scanleft];
                  inc(scanright);
                  items^[scanleft] := items^[scanright];
                  items^[scanright] := temp;
                  dec(scanleft);
                end
                else
                  dec(scanleft);
              end
              else
                inc(scanright);
            end;
            temp := items^[scanright];
            items^[scanright] := items^[first];
            items^[first] := temp;
            quick(first, scanright-1);
            quick(scanright+1, last);
          end;
        end;
      begin  {sort}
        quick(0, pred(count));
      end;

      procedure SortCollection(var Coll:TCollection;GreaterP:pointer);
      { Procedure to do a Quicksort on the collection elements.
        Based on Quicksort as given in Steal This Code, by F.D. Boswell, Watcom
    1986.  }
      var
        Greater : local_comparison absolute GreaterP;
        Frame : word;

        procedure quick(first,last : word);
        var
          pivot : pointer;
          temp : pointer;
          scanright, scanleft : word;
        begin
          with Coll do
          begin
            if (first+1) < (last+1) then  { This allows for last=-1 }
            begin
              pivot := items^[first];
              scanright := first;
              scanleft := last;
              while scanright < scanleft do
              begin
                if greater(items^[scanright+1], pivot, Frame) then
                begin
                  if not greater(items^[scanleft], pivot, Frame) then
                  begin
                    temp := items^[scanleft];
                    inc(scanright);
                    items^[scanleft] := items^[scanright];
                    items^[scanright] := temp;
                    dec(scanleft);
                  end
                  else
                    dec(scanleft);
                end
                else
                  inc(scanright);
              end;
              temp := items^[scanright];
              items^[scanright] := items^[first];
              items^[first] := temp;
              quick(first, scanright-1);
              quick(scanright+1, last);
            end;
          end;
        end;
      begin  {sort}
        frame := CallerFrame;
        quick(0, pred(coll.count));
      end;

      end.

[Back to OOP SWAG index] [Back to Main SWAG index] [Original]