Lazarus

Free Pascal => Beginners => Topic started by: JLWest on June 14, 2022, 11:58:35 pm

Title: QuickSort Problem
Post by: JLWest on June 14, 2022, 11:58:35 pm
I copied this QuickSort Procedure posted by GetMan. I have tried to use it in a program but either my implementation is bad or the code is bad. My guess its me.
It doesn't  sort and adds a to the array.  zip demo attached.

Thanks
Code: Text  [Select][+][-]
  1.  of Integer;
  2.  
  3. var
  4.   Form1: TForm1;
  5.   SouthHand  : SouthHandArray;            
  6.  
  7. pascal]procedure TForm1.QuickSort(var AI: array of Integer; ALo, AHi: Integer);
  8.  var
  9.   Lo, Hi, Pivot, T: Integer;
  10.  begin
  11.   Lo := ALo;
  12.   Hi := AHi;
  13.   Pivot := AI[(Lo + Hi) div 2];
  14.   repeat
  15.     while AI[Lo] < Pivot do
  16.       Inc(Lo) ;
  17.     while AI[Hi] > Pivot do
  18.       Dec(Hi) ;
  19.     if Lo <= Hi then
  20.     begin
  21.       T := AI[Lo];
  22.       AI[Lo] := AI[Hi];
  23.       AI[Hi] := T;
  24.       Inc(Lo) ;
  25.       Dec(Hi) ;
  26.     end;
  27.   until Lo > Hi;
  28.   if Hi > ALo then
  29.     QuickSort(AI, ALo, Hi) ;
  30.   if Lo < AHi then
  31.     QuickSort(AI, Lo, AHi) ;
  32. end;                                                          
Title: Re: QuickSort Problem
Post by: dseligo on June 15, 2022, 03:40:26 am
Your array SouthHandArray is '1' based and parameter AI in QuickSort method is zero based.

You can change AI parameter to SouthHandArray or you could change SouthHandArray definition to:
Code: Pascal  [Select][+][-]
  1.   SouthHandArray = Array[0..12] of Integer;

And all fixed indexes decrease by 1.
Title: Re: QuickSort Problem
Post by: JLWest on June 15, 2022, 05:21:28 am
I understand what you are saying, however I don't know how to fix the problem.

I need the array to be 1..13 not 0 based The array represents a of bridge.

I call QuickSort      QuickSort(var SouthHand,1,13);

So how would I fix QuickSort?

Thanks
Title: Re: QuickSort Problem
Post by: Handoko on June 15, 2022, 06:26:39 am
Bug fixed. I checked the code, GetMem's code has no bug and it supports non-zero-based array. But you cannot simply copy/paste to use it, some adaptations are needed.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
  9.   ExtCtrls, StdCtrls,Buttons,ComCtrls,
  10.   Menus, Types, LCLType, ActnList;
  11.  
  12. type
  13.  
  14.   SouthHandArray = Array[1..13] of Integer;
  15.  
  16.   { TForm1 }
  17.  
  18.   TForm1 = class(TForm)
  19.    btnGo: TButton;
  20.    ListBox1: TListBox;
  21.    ListBox2: TListBox;
  22.     procedure btnGoClick(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure QuickSort(var AI: SouthHandArray; ALo, AHi: Integer);
  25.     procedure ShowSouthHand;
  26.  
  27.   private
  28.  
  29.   public
  30.  
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.   SouthHand  : SouthHandArray;
  36. implementation
  37.  
  38. {$R *.lfm}
  39.  
  40. { TForm1 }
  41.  
  42. procedure TForm1.FormCreate(Sender: TObject);
  43. begin
  44.  Form1.Height:=1050;
  45.  Form1.Width:=1552;
  46.  ListBox1.Width := 80;
  47. end;
  48.  
  49. procedure TForm1.btnGoClick(Sender: TObject);
  50. begin
  51.  Listbox1.Clear;
  52.  SouthHand[1]:=27;
  53.  SouthHand[2]:=17;
  54.  SouthHand[3]:=7;
  55.  SouthHand[4]:=52;
  56.  SouthHand[5]:=5;
  57.  SouthHand[6]:=49;
  58.  SouthHand[7]:=33;
  59.  SouthHand[8]:=29;
  60.  SouthHand[9]:=21;
  61.  SouthHand[10]:=14;
  62.  SouthHand[11]:=38;
  63.  SouthHand[12]:=3;
  64.  SouthHand[13]:=23;
  65.  QuickSort(SouthHand, 1, 13) ;
  66.  ShowSouthHand;
  67.  
  68. end;
  69.  
  70. procedure TForm1.QuickSort(var AI: SouthHandArray; ALo, AHi: Integer);
  71.  var
  72.   Lo, Hi, Pivot, T: Integer;
  73.  begin
  74.   Lo := ALo;
  75.   Hi := AHi;
  76.   Pivot := AI[(Lo + Hi) div 2];
  77.   repeat
  78.     while AI[Lo] < Pivot do
  79.       Inc(Lo) ;
  80.     while AI[Hi] > Pivot do
  81.       Dec(Hi) ;
  82.     if Lo <= Hi then
  83.     begin
  84.       T := AI[Lo];
  85.       AI[Lo] := AI[Hi];
  86.       AI[Hi] := T;
  87.       Inc(Lo) ;
  88.       Dec(Hi) ;
  89.     end;
  90.   until Lo > Hi;
  91.   if Hi > ALo then
  92.     QuickSort(AI, ALo, Hi) ;
  93.   if Lo < AHi then
  94.     QuickSort(AI, Lo, AHi) ;
  95. end;
  96.  
  97.  
  98. procedure TForm1.ShowSouthHand;
  99.  begin
  100.  Listbox1.Clear;
  101.  Listbox1.Items.add(IntToStr(SouthHand[1]));
  102.  Listbox1.Items.add(IntToStr(SouthHand[2]));
  103.  Listbox1.Items.add(IntToStr(SouthHand[3]));
  104.  Listbox1.Items.add(IntToStr(SouthHand[4]));
  105.  Listbox1.Items.add(IntToStr(SouthHand[5]));
  106.  Listbox1.Items.add(IntToStr(SouthHand[6]));
  107.  Listbox1.Items.add(IntToStr(SouthHand[7]));
  108.  Listbox1.Items.add(IntToStr(SouthHand[8]));
  109.  Listbox1.Items.add(IntToStr(SouthHand[9]));
  110.  Listbox1.Items.add(IntToStr(SouthHand[10]));
  111.  Listbox1.Items.add(IntToStr(SouthHand[11]));
  112.  Listbox1.Items.add(IntToStr(SouthHand[12]));
  113.  Listbox1.Items.add(IntToStr(SouthHand[13]));
  114.  end;
  115.  
  116. end.

The code above is the fixed version. I only made modifications on:
- Line #24
- Line #70
- Line #46 (not important, only cosmetic issue on my system)

Lazarus/Pascal is strict but it is not strict enough to prevent you to supply wrong data type for the parameter. In this case, dynamic array vs static lenght array. And that was the cause of the issue.

Edit:

Actually the problem was you're trying to provide non-zero-based array as an open array. Open array always count from 0 but your array (SouthHandArray) start from 1.

The code above solve the problem by using exact data type on the parameter. Alternatively, you can fix the problem simply changing the line #65 in the code above to QuickSort(SouthHand, 0, 12);  , but keeping the open array in the line #24 & #70.
Title: Re: QuickSort Problem
Post by: JLWest on June 15, 2022, 07:58:19 am
Thanks Handoko

It late here, I'll try it in the morning.
Title: Re: QuickSort Problem
Post by: avk on June 15, 2022, 08:32:20 am
Just in case, I would like to add a few remarks.
1. Since the FPC currently supports array slices well, there is no particular need to pass the start and end indexes to the QuickSort() procedure:
Code: Pascal  [Select][+][-]
  1. procedure QuickSort(var AI: array of Integer);
  2. var
  3.   Lo, Hi, Pivot, T: Integer;
  4. begin
  5.   Lo := Low(AI);
  6.   Hi := High(AI);
  7.   Pivot := AI[(Lo + Hi) div 2];
  8.   repeat
  9.     while AI[Lo] < Pivot do
  10.       Inc(Lo);
  11.     while AI[Hi] > Pivot do
  12.       Dec(Hi);
  13.     if Lo <= Hi then
  14.     begin
  15.       T := AI[Lo];
  16.       AI[Lo] := AI[Hi];
  17.       AI[Hi] := T;
  18.       Inc(Lo);
  19.       Dec(Hi);
  20.     end;
  21.   until Lo > Hi;
  22.   if Hi > Low(AI) then
  23.     QuickSort(AI[Low(AI)..Hi]);
  24.   if Lo < High(AI) then
  25.     QuickSort(AI[Lo..High(AI)]);
  26. end;
  27.  

2. For sorting arrays of several dozen elements, such QuickSort() is inefficient, it is better to use InsertionSort().
3. For large arrays, this implementation guarantees neither O(n log n) time complexity nor O(log n) space complexity.
Title: Re: QuickSort Problem
Post by: PascalDragon on June 15, 2022, 08:51:15 am
1. Since the FPC currently supports array slices well, there is no particular need to pass the start and end indexes to the QuickSort() procedure:

Though array slices only work if it's declared as an open array like you (and JLWest) did and not as a dynamic array like Handoko adjusted it. (And “currently” is a bit of a misnomer, as FPC supports these for quite some time already)
Title: Re: QuickSort Problem
Post by: avk on June 15, 2022, 10:49:53 am
...
 (And “currently” is a bit of a misnomer, as FPC supports these for quite some time already)

As you wish, but "for quite some time already" is somewhat of a relative term, how often do you come across examples of using array slices in the wild?
I haven't checked for a while, but it seems that Delphi still has some problems with this?
Title: Re: QuickSort Problem
Post by: PascalDragon on June 15, 2022, 01:51:00 pm
...
 (And “currently” is a bit of a misnomer, as FPC supports these for quite some time already)

As you wish, but "for quite some time already" is somewhat of a relative term, how often do you come across examples of using array slices in the wild?

Then if you want an absolute time: array slices where introduced in October 2006, thus are available since FPC 2.2.0.

I haven't checked for a while, but it seems that Delphi still has some problems with this?

Delphi supports array slices only in the form of the Slice (https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.Slice#Code_Examples) intrinsic (which FPC (https://www.freepascal.org/docs-html/rtl/system/slice.html) supports as well).
Title: Re: QuickSort Problem
Post by: avk on June 15, 2022, 02:40:10 pm
...
Then if you want an absolute time: array slices where introduced in October 2006, thus are available since FPC 2.2.0.
...

Thanks, but still curious, how often do you see this very handy feature being used in some code?

...
Delphi supports array slices only in the form of the Slice (https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.Slice#Code_Examples) intrinsic
...

That is, everything there is the same as it was many years ago.
Title: Re: QuickSort Problem
Post by: Zoran on June 15, 2022, 02:56:30 pm
Actually the problem was you're trying to provide non-zero-based array as an open array. Open array always count from 0 but your array (SouthHandArray) start from 1.

No! You got it quite wrong. The whole idea about open arrays is that you can safely pass static non-zero based arrays to a procedure which accepts open array parameter, as well as dynamic arrays.

But, inside that procedure, where it is accessed as an open array, you have to treat it as a zero-based array.

So, this works perfectly:

Code: Pascal  [Select][+][-]
  1. program Project1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. // You can safely call this procedure with any dynamic or static array whose index need not be zero-based.
  6. procedure PrintArray(A: Array of Int32);
  7. var
  8.   I: Integer;
  9. begin
  10.   for I := Low(A) to High(A) do begin
  11.     Write(A[I], ', ');
  12.   end;
  13.   WriteLn;
  14. end;
  15.  
  16. procedure QuickSortInt32(var A: array of Int32);
  17. var
  18.   Pivot, N: Int32;
  19.  
  20.   procedure InternalQSort(PFirst, PLast: PInt32);
  21.   var
  22.     PLeft, PRight: PInt32;
  23.   begin
  24.     PLeft := PFirst;
  25.     PRight := PLast;
  26.  
  27.     Pivot := (PLeft + (PRight - PLeft) div 2)^;
  28.  
  29.     repeat
  30.       while PLeft^ < Pivot do
  31.         Inc(PLeft);
  32.       while PRight^ > Pivot do
  33.         Dec(PRight);
  34.       if PLeft <= PRight then begin
  35.         N := PLeft^;
  36.         PLeft^ := PRight^;
  37.         PRight^ := N;
  38.  
  39.         Inc(PLeft);
  40.         Dec(PRight);
  41.       end;
  42.     until PLeft > PRight;
  43.  
  44.     if PRight > PFirst then
  45.       InternalQSort(PFirst, PRight);
  46.     if PLeft < PLast then
  47.       InternalQSort(PLeft, PLast);
  48.   end;
  49.  
  50. var
  51.   P: PInt32;
  52. begin
  53.   if Length(A) >= 2 then begin // if array has less then two elements it's surely sorted already :)
  54.     P := PInt32(A);
  55.     InternalQSort(P, P + Length(A) - 1);
  56.   end;
  57. end;
  58.  
  59. var
  60.   X: Array[1..20] of Int32;
  61.   I: Integer;
  62.  
  63. begin
  64.   Randomize;
  65.   for I := Low(X) to High(X) do
  66.     X[I] := Random(200);
  67.  
  68.   WriteLn('Array before sort:');
  69.   PrintArray(X); // send X as open array here!
  70.   QuickSortInt32(X); // again, send X as open array!
  71.   WriteLn('Array after sort:');
  72.   PrintArray(X); // and again!
  73.   ReadLn;
  74. end.
  75.  
Title: Re: QuickSort Problem
Post by: JLWest on June 15, 2022, 06:40:36 pm
Hi All
This is a lot to go through. I think Zoran is close to understanding the problem I have.
Writing a bridge simulator. Need to sort bridge hands of 13 cards which are held in 1 to 13 arrays. The first card in the deck is the 2 clubs and is 1 and the last is the Ace of spades is 52.
.
Title: Re: QuickSort Problem
Post by: JLWest on June 15, 2022, 06:45:09 pm
@Handoko

Works great.
Title: Re: QuickSort Problem
Post by: BobDog on June 16, 2022, 05:15:56 pm

Here is a general quicksort by pointer.
Code: Pascal  [Select][+][-]
  1. // {$rangeChecks on}
  2. uses
  3. sysutils;
  4. type
  5.  direction =(up,down);
  6.  
  7.  
  8.  generic procedure quicksort<Z>(lp:pointer;rp:pointer;dr:direction);
  9.   var
  10.   p,i,l,r:^Z;
  11.   t:Z;
  12.   begin
  13.   l:=lp;
  14.   r:=rp;
  15.   if (r - l < 1) then exit;
  16.   p:=l+1;
  17.   i:=p;
  18.   while (p <= r) do
  19.   begin
  20.   if (dr=up) then
  21.      if (p^ < Z(l^)) then
  22.      begin
  23.      t:=p^;p^:=i^; i^:=t; i:=i+1;
  24.      end;
  25.    if (dr=down) then  
  26.       if (p^ > Z(l^)) then
  27.      begin
  28.      t:=p^;p^:=i^; i^:=t; i:=i+1;
  29.      end;
  30.       p:=p+1;
  31.   end;
  32.   p:=i-1;
  33.   t:=Z(l^);Z(l^):=p^; p^:=t;
  34.  specialize quicksort<Z>(l, p,dr);
  35.  specialize quicksort<Z>(i, r,dr);
  36. end;
  37.  
  38.  
  39. var
  40. a:array [3..23] of double;
  41. b:array of int32=nil;
  42. c:array [1..6] of ansistring=('abc','zxe','work','freepascal','zzq','aba');
  43. i:int32;
  44. t,t2:int64;
  45. begin
  46. for i:=low(a) to high(a) do a[i]:=random*20;
  47.  
  48. specialize quicksort<double>(@a[low(a)],@a[high(a)],down);
  49. writeln('Double [3..23] of random*20 sorted down');
  50. for i:=low(a) to high(a) do writeln(i,'   ',a[i]);
  51. writeln();
  52.  
  53. setlength (b,1000000);
  54.  
  55. for i:=low(b) to high(b) do b[i]:=random(10000000);
  56.  
  57. t:=gettickcount64;
  58.  specialize quicksort<int32>(@b[low(b)],@b[high(b)],down);
  59.  t2:=gettickcount64;
  60.  writeln('Dynamic array of length 1000 Int32 of random(1000000) sorted down');
  61. for i:=low(b) to low(b) +10 do writeln(i,'   ',b[i]);
  62. writeln('...');
  63. writeln('...');
  64. for i:=high(b) -10 to high(b) do writeln(i,'   ',b[i]);
  65. writeln();
  66. writeln('Time taken for 1000000 int32 ',t2-t);
  67. writeln;
  68.  
  69. specialize quicksort<ansistring>(@c[low(c)],@c[high(c)],up);
  70. writeln('ansistring [1..6] of preset values sorted up');
  71. for i:=low(c) to high(c) do writeln(i,'   ',c[i]);
  72. writeln;
  73. writeln('Press return to finish . . .');
  74.  
  75. readln;
  76. end.
  77.  
  78.  
TinyPortal © 2005-2018