Lazarus

Free Pascal => Windows => Topic started by: ratmalwer on November 11, 2017, 11:09:00 pm

Title: Universal Sort in Lazarus / Freepascal
Post by: ratmalwer on November 11, 2017, 11:09:00 pm
Hello

I was searching the net for an universal-sort for an array of records or some universal sort with tha ability to handle: miltiple fields, ASC /DESC, casesensitiity, and Unicode (UTF8)-support.

I did not find it so I started programming my own (code for a shellsort below - not finished but working fine).

Now I read in a old article: there are plenty or sortfunctions in Freepascal.

What did I miss??? Where is this documentation I did not find?

Code: Pascal  [Select][+][-]
  1. function Compare(const ARecord1, ARecord2:TArrayA):Integer;
  2. // EQ = 0 , GR = 1 , LESS = -1
  3.  
  4. // Tipp: für DESC  einfach das Result umkehren... ungetestet  mk.
  5. // Strings ev mit UTF8Compare vergleichen
  6. // Upper / Lowercase durchdenken und implementieren
  7.  
  8.  
  9. begin
  10.  
  11.   Result := 0;
  12.   // FELD 1
  13.   Result := UTF8CompareStr(Uppercase(ARecord1.String5),uppercase(Arecord2.string5));
  14.   if Result = 0 then
  15.   begin
  16.      if ARecord1.String5 < ARecord2.string5 then
  17.      begin
  18.         Result := -1
  19.      end else
  20.      // FELD 2
  21.      begin
  22.  
  23.         if ARecord1.Field2 > Arecord2.Field2 then
  24.         begin
  25.            Result := 1;
  26.         end else
  27.         begin
  28.            if ARecord1.Field2 < ARecord2.Field2 then
  29.            begin
  30.               Result := -1
  31.            end else
  32.            // FELD 3
  33.            begin
  34.  
  35.               if ARecord1.Field3 > Arecord2.Field3 then
  36.               begin
  37.                  Result := 1;
  38.               end else
  39.               begin
  40.                  if ARecord1.Field3 < ARecord2.Field3 then
  41.                  begin
  42.                     Result := -1
  43.                  end else
  44.                  // FELD 4 .....
  45.                  begin
  46.                      // ...... usw....
  47.                  end;
  48.               end;
  49.  
  50.            end;
  51.         end;
  52.  
  53.  
  54.      end;
  55.   end;
  56. end;
  57.  
  58. procedure qsort_2(lower,upper :integer);
  59. var left, right :integer;
  60. pivot :TArrayA;
  61. temp : TArrayA;
  62. begin
  63.     pivot:= ArrayA[(lower + upper) div 2];   //Pivot in mitte setzen
  64.     left := lower;
  65.     right := upper;
  66.  
  67.     while left<=right do
  68.     begin
  69.          while Compare(ArrayA[left],pivot) = -1 do left := left+1;    // kleiner: left erhöhen wenn bereits geordnet
  70.          while Compare(ArrayA[right],pivot) = 1 do right := right-1;  // grösser: right vermindern wenn bereits geordnet
  71.          if left<=right then                                          // dies vergleicht den index aber nicht den Wert!
  72.            begin
  73.              //SWAP Record
  74.              temp := ArrayA[left];
  75.              ArrayA[left] := ArrayA[right];
  76.              ArrayA[right] := temp;
  77.              left:=left+1;
  78.              right:=right-1
  79.            end;
  80.     end;
  81.     if right>lower then qsort_2(lower,right); { Sort the LEFT  part }
  82.     if upper>left  then qsort_2(left ,upper); { Sort the RIGHT part }
  83. end;

And a extraquestion:
Is there a function-summary with brief examples like in php-manual somewhere? At the moment I program by try and error and I am a bit tired to check each found functions to detrermie what the returnvalues could be.


Title: Re: Universal Sort in Lazarus / Freepascal
Post by: marcov on November 11, 2017, 11:18:21 pm
Some points wrt collection sorting:

- Afaik TArray<> has a sort routine. At least in Delphi it does. Might be only in FPC trunk  though. (packages/rtl-generics)
- TStringlist can be kept sorted, no need to do ad-hoc sorting.
- Compare routines should be configurable. E.g. to pick a natural compare over a normal one. Asc/desc is then just an inverted compare routine.
- I don't know PHP or its manual, and I like to keep it that way.
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: Mike.Cornflake on November 12, 2017, 12:13:05 am
You ask a good question (sorting for records)

Have a look at the following:

http://wiki.freepascal.org/Array_sort

As the header says, that was prior to generics.  The idea in this wiki is that there is a general sort function, you just pass it a specific function that determines the rules for how one array element should be compared to another.  (ie, based on two index, you return -1, 0 or 1).  The actual soft algorthm is handled in the AnySort code.  That idea gets used a lot.

Instead of an array, you could use generics, where you use a collection class to handle your data.  Have a look at this post for instance
http://forum.lazarus.freepascal.org/index.php?topic=17772.0
http://wiki.freepascal.org/Generics

As for the help you are looking for, as a community there's been an effort to keep http://wiki.freepascal.org updated.

Welcome to the forum by the way :-)
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: BeniBela on November 12, 2017, 12:15:36 am
I made one, too  8-) https://github.com/benibela/bbutils/blob/master/bbutils.pas#L4541
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: Mike.Cornflake on November 12, 2017, 12:30:38 am
And time for a confession.  I've got lazy in my old age.  I generally just built up a TBufDataset and sort that.  Cause I know I'm going to want to filter that data a few different ways as well. 

TBufDataset is an in-memory data store.  Think of a Table in a database.

TBufDataset is memory overkill for for most of my uses, but my code in all the different apps is a darned site more consistent, and I've created a helper unit to simplify creation, population etc.

And I've only just started using SQLite.  Seriously thinking about switching over to that instead...
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: ratmalwer on November 12, 2017, 01:51:18 am
Thanks guys for your replies...
I glanced trough it an will look at the code more closely later.

But actually I am a bit disapointed of the capability of Freepascal. In other languages there are predefined functions for such matters that are reliable, easy to use and well and brief documented. When I red that only integes can be sorted, or that records are not supported and only one sortcriteria is accepted - that makes me whine.

So I probably go on with my solution (so I know at least whats going on) witch cost me tree days now for for something I was used to make in 5 minutes by a command like:    sort(array1,filed1,asc,field2,desc,field3,asc)
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: ratmalwer on November 12, 2017, 02:13:25 am
@BeniBela

your code look awful long.... Is it reliable?

If so could you send me an examle how to implement it. I am using Freepascal/Lazarus only since a month and struggle with implementing a lot.
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: Thaddy on November 12, 2017, 09:46:20 am
Quote from: ratmalwer on November 12, 2017, 01:51:18 am
Thanks guys for your replies...
I glanced trough it an will look at the code more closely later.

But actually I am a bit disapointed of the capability of Freepascal. In other languages there are predefined functions for such matters that are reliable, easy to use and well and brief documented. When I red that only integes can be sorted, or that records are not supported and only one sortcriteria is accepted - that makes me whine.

So I probably go on with my solution (so I know at least whats going on) witch cost me tree days now for for something I was used to make in 5 minutes by a command like:    sort(array1,filed1,asc,field2,desc,field3,asc)

Apart from rtl-generics, amongst other things, the fgl unit also has generic sorted lists, maps etc
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: guest58172 on November 12, 2017, 11:54:54 am
Quote from: ratmalwer on November 11, 2017, 11:09:00 pm
Hello

I was searching the net for an universal-sort for an array of records or some universal sort with tha ability to handle: miltiple fields, ASC /DESC, casesensitiity, and Unicode (UTF8)-support.

I did not find it so I started programming my own (code for a shellsort below - not finished but working fine).

Now I read in a old article: there are plenty or sortfunctions in Freepascal.

Universal sort would need an wider vision of algorithms, a vision that usually doesn't exist in the FPC libraries that is: more template and duck types. Maybe also closures. The idea is to sop making specialized members functions and rather start making free functions, that can be called with aggregates providing certain methods (aka duck types, concepts, compile-time interface etc), so that an built-int array, a TArray<>, a TList, etc couldbe sorted with the same free function.
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: munair on November 12, 2017, 01:11:18 pm
I wouldn't waste my time trying to find a universal sorting routine. If your type doesn't provide a sort function then simply implement your own. Shellsort is small and easy. Here is an example:
Code: Pascal  [Select][+][-]
  1. procedure SortMyElements(var arr: TMyElements);
  2. var
  3.   gap, i, j, lim, max, pos: longword;
  4.   tmp: TMyElement
  5. begin
  6.   max := high(arr);
  7.   if max < 1 then
  8.     exit;
  9.  
  10.   gap := (max div 2) + 1;
  11.  
  12.   while gap > 0 do
  13.     begin
  14.       lim := max - gap;
  15.       repeat
  16.         begin
  17.           pos := 0;
  18.           for i := 0 to lim do
  19.             begin
  20.               j := i + gap;
  21.               if arr[i].SortMe > arr[j].SortMe then
  22.                 begin
  23.                   { switch items }
  24.                   tmp := arr[i];
  25.                   arr[i] := arr[j];
  26.                   arr[j] := tmp;
  27.                   pos := i;
  28.                 end;
  29.             end;
  30.           lim := pos - gap;
  31.         end;
  32.       until pos = 0;
  33.       gap := gap div 2;
  34.     end;
  35. end;

Another way to switch elements would be:
Code: Pascal  [Select][+][-]
  1. Move(arr1, tmp, SizeOf(TMyElement));
  2. Move(arr2, arr1, SizeOf(TMyElement));
  3. Move(tmp, arr2, SizeOf(TMyElement));
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: BeniBela on November 12, 2017, 02:56:08 pm
Quote from: ratmalwer on November 12, 2017, 02:13:25 am
@BeniBela

your code look awful long.... Is it reliable?

If so could you send me an examle how to implement it. I am using Freepascal/Lazarus only since a month and struggle with implementing a lot.

Should be reliable, but could be faster

Implement it? You can see how the sort is implemented there

It can take a pointer to a custom comparison function and uses to CompareByte if no custom function is given

Title: Re: Universal Sort in Lazarus / Freepascal
Post by: marcov on November 12, 2017, 03:00:35 pm
Quote from: ratmalwer on November 12, 2017, 01:51:18 am
But actually I am a bit disapointed of the capability of Freepascal. In other languages there are predefined functions for such matters that are reliable, easy to use and well and brief documented.

No beating around the bush Freepascal is relatively late.  While some basics were always covered ( e.g. for strings, one can simple use tstringlist, with custom sorting sorting, and there is a generalized qsort in the FPC examples and many circulate on the web).

And SQL-like sorting using custom datasets (like Mike Cornflake says) already works for ages , because there sorting rules are more fixed

For sorts parameterized with functions, you need two (sort and compare, and having generics eliminates the swap, but that only emerged late.

Note that such features are different for dynamically typed languages like PHP than for statically compiled languages like FPC. PHP is an interpreter, and its datastructures are more interpreter like, and aligned with SQL thinking.

FPC's datastructures are not, and thus database components are a more closer relative to PHP there than "normal"  pascal datastructures, which are a level more lowlevel. So  if you just want normal database like operation, use datasets.

Title: Re: Universal Sort in Lazarus / Freepascal
Post by: guest58172 on November 12, 2017, 03:47:12 pm
data structures should not matter. "What does something need to define as function to be sorted ?" that's all that matters. Things that can be sorted should implement these functions and it works.
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: soerensen3 on November 12, 2017, 04:58:07 pm
How about using an object instead of a record. You could implement a Compare function like this:

Code: Pascal  [Select][+][-]
  1. TTestObj = object
  2.   Field1: String;
  3.   Field2: String;
  4.   Field3: String;
  5.   Field4: Integer;
  6.   function Compare( AObj: TTestObj ): Integer;
  7. end;
  8. ...
  9. function TTestObj.Compare( AObj: TTestObj ): Integer;
  10.   function CompareStringField( Field1, Field2: String ): Integer;
  11.   begin
  12.     if ( Field1 < Field2 ) then
  13.       Result:= -1
  14.     else if ( Field1 > Field2 ) then
  15.       Result:= 1
  16.     else
  17.       Result:= 0;
  18.   end;
  19.   function CompareIntField( Field1, Field2: Integer ): Integer;
  20.   ... // Same as above
  21. begin
  22.   Result:= CompareStringField( Field1, AObj.Field1 );
  23.   if ( Result = 0 ) then
  24.     Result:= CompareStringField( Field2, AObj.Field2 );
  25.   if ( Result = 0 ) then
  26.     Result:= CompareStringField( Field3, AObj.Field3 );
  27.   if ( Result = 0 ) then
  28.     Result:= CompareIntField( Field4, AObj.Field4 );
  29. end;
You only need one sort function with this method. If you really need you can also use RTTI with properties on the object for a dynamic solution to have also only one compare function to work with different objects.
You could use a string array with the field names to implement a switchable sort order.

Another option instead of using an object would be to overload the compare operators in fpc for your record. There are examples on how to do that.
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: lainz on November 12, 2017, 05:04:57 pm
Quote from: BBasile on November 12, 2017, 03:47:12 pm
data structures should not matter. "What does something need to define as function to be sorted ?" that's all that matters. Things that can be sorted should implement these functions and it works.

I agree.

I do always in JavaScript

Code: Javascript  [Select][+][-]
  1. something.sort((a, b) => { if(a.someField > b.someField) return 1; if (b.someField < b.someField) return -1; return 0; })

or just something.sort() if it is a string or a number array, already works.

Basically just implementing the comparator method, as it is done in Java for example (Comparable or Comparator).
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: Mike.Cornflake on November 12, 2017, 05:29:46 pm
Quote from: ratmalwer on November 11, 2017, 11:09:00 pm
Code: [Select]
  if Result = 0 then
  begin
     if ARecord1.String5 < ARecord2.string5 then
     begin
        Result := -1
     end else
     // FELD 2
     begin
        if ARecord1.Field2 > Arecord2.Field2 then
        begin
           Result := 1;
        end else
        begin
           if ARecord1.Field2 < ARecord2.Field2 then
           begin
              Result := -1
           end else

Looking at your code I see you're implementing a Quick Sort and an external compare function already.    So right from the start you're on the track that myself and several others have suggested.  Oops, apologies for missing that in your first post.

In order to use BeniBela's code you just to make small changes to your Compare function (change paramters etc).

But now I've looked at your code closely, I think there may be errors in your Compare function (which is why I highlighted it above).   Your compare function is going to result in a dataset that would not look sorted to me.  You're falling from one case to the next if one string is not less than the other.  For traditional sort implementations you usually only compare subsequent strings when the previous strings are identical.  You do this for Field2, but not for Field5

Have a look at @soerensen3's implementation for an example.

Quote from: soerensen3 on November 12, 2017, 04:58:07 pm
  Result:= CompareStringField( Field1, AObj.Field1 );
  if ( Result = 0 ) then
    Result:= CompareStringField( Field2, AObj.Field2 );
  if ( Result = 0 ) then
    Result:= CompareStringField( Field3, AObj.Field3 );
  if ( Result = 0 ) then
    Result:= CompareIntField( Field4, AObj.Field4 );
end;[/code]

I think if you refactor your Compare function so it's got same general shape as @soerensen3's, you'll find you've been on a good track all along. 

And I don't think you'll need the internal CompareStringField.  Freepascal already comes with string comparison routines.
https://www.freepascal.org/docs-html/rtl/sysutils/comparestr.html (see also the See Also's :-) )
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: marcov on November 12, 2017, 09:54:27 pm
Quote from: BBasile on November 12, 2017, 03:47:12 pm
data structures should not matter. "What does something need to define as function to be sorted ?"

Sorted how? And how about multi key sorting, like the OP hints on?

Quote
that's all that matters. Things that can be sorted should implement these functions and it works.

Oversimplification. 
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: lainz on November 12, 2017, 11:08:32 pm
Quote from: marcov on November 12, 2017, 09:54:27 pm
Quote from: BBasile on November 12, 2017, 03:47:12 pm
data structures should not matter. "What does something need to define as function to be sorted ?"

Sorted how? And how about multi key sorting, like the OP hints on?

Quote
that's all that matters. Things that can be sorted should implement these functions and it works.

Oversimplification. 

Well, I don't want to reply in the name of the quoted user.

But...

Actually with something like JavaScript array sort or Java Comparable / Comparator the method decides how to sort.

You can sort by many fields you need. Like

if (a.field1 > b.field1)
return 1
if (a.field1 < b.field1)
return -1
if (a.field2 < b.field2)
return 1
if (a.field2 > b.field2)
return -1
return 0

that's by two fields, and one can be in one order and the other in another order. the order of "asc" or "desc" you define in the method.

You can have descending by name and ascending by a number, for example. So if you have 2 duplicate product names and want to sort by name also by higher price first, you can do that simply.
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: marcov on November 13, 2017, 10:17:19 am
Quote from: lainz on November 12, 2017, 11:08:32 pm
Quote from: marcov on November 12, 2017, 09:54:27 pm
Quote from: BBasile on November 12, 2017, 03:47:12 pm
data structures should not matter. "What does something need to define as function to be sorted ?"

Sorted how? And how about multi key sorting, like the OP hints on?

Quote
that's all that matters. Things that can be sorted should implement these functions and it works.

Oversimplification. 

Well, I don't want to reply in the name of the quoted user.

But...

Actually with something like JavaScript array sort or Java Comparable / Comparator the method decides how to sort.

or with https://www.freepascal.org/docs-html/rtl/classes/tlist.sort.html

It is just that you need to define a method/comparator.  Tlist doesn't require a swap because the sizes are uniform (all pointers)
Title: Re: Universal Sort in Lazarus / Freepascal
Post by: lainz on November 13, 2017, 03:04:51 pm
Quote from: marcov on November 13, 2017, 10:17:19 am
or with https://www.freepascal.org/docs-html/rtl/classes/tlist.sort.html

It is just that you need to define a method/comparator.  Tlist doesn't require a swap because the sizes are uniform (all pointers)

That's it. In fact the main problem here was how to implement the compare function, not a missing feature.

Pointers or Object is just OK. But we have generics also?, something like supply the type and implement a typed method, I know that only adds sugar to the code, it's just an idea. But having already working code in the rtl is enough.

So again, the way I do is returning the function when the first condition becomes true, instead of putting a lot of concatenated if like in the first post code. It is faster that way.

Edit: I mean returning like this
https://stackoverflow.com/questions/9641652/returning-a-value-in-pascal
TinyPortal © 2005-2018