ATIASortBySizeEx()

[Janilabo]

Sorts ATIA items by size (array length), contains 2 ways to sort:

-Low-to-High

-High-to-Low

 

This procedure keeps the subarrays in order, which SortATIABySize doesn't.

 

Source code with test/example:

 

const
 INDEX_COUNT = 25;
 SIZE_MIN = 1; // Minimum length for subarrays?
 SIZE_MAX = 3; // Maximum length for subarrays?

var
 original, sorted: T2DIntArray;

procedure ATIASortBySizeEx(var ATIA: T2DIntArray; order: (so_LowToHigh, so_HighToLow));
var
 h, i, l, r, s, t, p, x: Integer;
 al: TIntegerArray;
 tmp: array of T2DIntArray;
begin
 l := Length(ATIA);
 SetLength(tmp, l);
 if (l > 0) then
 begin
   SetLength(al, l);
   for i := 0 to (l - 1) do
     al[i] := -1;
   for i := 0 to (l - 1) do
     if not TIAContains(al, Length(ATIA[i])) then
     begin
       al[r] := Length(ATIA[i]);
       Inc(r);
     end;
   SetLength(al, r);
   SortTIA(al);
   if (order = so_HighToLow) then
     ReverseTIA(al);
   SetLength(tmp, r);
   case order of
     so_LowToHigh:
     for i := 0 to (l - 1) do
     begin
       x := Length(ATIA[i]);
       p := TIAPos(al, x);
       for t := 0 to (Length(tmp[p]) - 1) do
       begin
         for s := 0 to (x - 1) do
           if (tmp[p][t][s] < ATIA[i][s]) then
             s := x
           else 
             if (tmp[p][t][s] > ATIA[i][s]) then
               Break;
         if (s < x) then
           Break;
       end;
       SetLength(tmp[p], (Length(tmp[p]) + 1));
       for s := (Length(tmp[p]) - 2) downto t do
         Swap(tmp[p][s], tmp[p][(s + 1)]);
       x := Length(ATIA[i]);
       SetLength(tmp[p][t], x);
       for s := 0 to (x - 1) do
         tmp[p][t][s] := Integer(ATIA[i][s]);
     end;
     so_HighToLow:
     for i := 0 to (l - 1) do
     begin
       x := Length(ATIA[i]);
       p := TIAPos(al, x);
       for t := 0 to (Length(tmp[p]) - 1) do
       begin
         for s := 0 to (x - 1) do
           if (tmp[p][t][s] > ATIA[i][s]) then
             s := x
           else 
             if (tmp[p][t][s] < ATIA[i][s]) then
               Break;
         if (s < x) then
           Break;
       end;
       SetLength(tmp[p], (Length(tmp[p]) + 1));
       for s := (Length(tmp[p]) - 2) downto t do
         Swap(tmp[p][s], tmp[p][(s + 1)]);
       x := Length(ATIA[i]);
       SetLength(tmp[p][t], x);
       for s := 0 to (x - 1) do
         tmp[p][t][s] := Integer(ATIA[i][s]);
     end;
   end;
   SetLength(al, 0);
   r := 0;
   h := High(tmp);
   for i := 0 to h do
     IncEx(r, (High(tmp[i]) + 1));
   SetLength(ATIA, r);
   r := 0;
   for i := 0 to h do
   begin
     p := High(tmp[i]);
     for s := 0 to p do
     begin
       SetLength(ATIA[r], Length(tmp[i][s]));
       for t := 0 to High(tmp[i][s]) do
         ATIA[r][t] := Integer(tmp[i][s][t]);
       Inc(r);
     end;
   end;
   SetLength(tmp, 0);
 end;
end;

{==============================================================================]
 Explanation: Returns copy ("clone") of ATIA safely
[==============================================================================}
function ATIAClone(ATIA: T2DIntArray): T2DIntArray;
var
 i, l, x, y: Integer;
begin
 l := Length(ATIA);
 SetLength(Result, l);
 for i := 0 to (l - 1) do
 begin
   y := Length(ATIA[i]);
   SetLength(Result[i], y);
   for x := 0 to (y - 1) do
     Result[i][x] := Integer(ATIA[i][x]);
 end;
end;

var
 h, i, t: Integer;
 tmp: string;

begin
 ClearDebug;
 case ((SIZE_MIN > SIZE_MAX) or (SIZE_MIN < 1) or (INDEX_COUNT < 1)) of
   False:
   begin
     SetLength(original, INDEX_COUNT); 
     tmp := ('Original:' + #13#10);
     for i := 0 to (INDEX_COUNT - 1) do    
     begin
       SetLength(original[i], RandomRange(SIZE_MIN, (SIZE_MAX + 1)));
       for h := 0 to (Length(original[i]) - 1) do
         original[i][h] := Random(10);
     end;
     h := High(original);
     for i := 0 to h do
       tmp := (tmp + '[' + TIAToStr(original[i]) + ']'); 
     tmp := (tmp + #13#10 + 'ATIASortBySizeEx() [so_LowToHigh]: ' + #13#10);
     sorted := ATIAClone(original);
     t := GetSystemTime;
     ATIASortBySizeEx(sorted, so_LowToHigh);
     WriteLn('ATIASortBySizeEx [so_LowToHigh]: ' + IntToStr(GetSystemTime - t) + ' ms.');
     h := High(sorted);
     for i := 0 to h do
       tmp := (tmp + '[' + TIAToStr(sorted[i]) + ']');
     tmp := (tmp + #13#10 + 'ATIASortBySizeEx() [so_HighToLow]:' + #13#10); 
     SetLength(sorted, 0);
     sorted := ATIAClone(original);
     t := GetSystemTime;
     ATIASortBySizeEx(sorted, so_HighToLow);
     WriteLn('ATIASortBySizeEx [so_HighToLow]: ' + IntToStr(GetSystemTime - t) + ' ms.');
     h := High(sorted);
     for i := 0 to h do
       tmp := (tmp + '[' + TIAToStr(sorted[i]) + ']');
     tmp := (tmp + #13#10 + 'SortATIABySize():' + #13#10); 
     SetLength(sorted, 0);  
     sorted := ATIAClone(original);
     t := GetSystemTime;
     SortATIABySize(sorted);
     h := High(sorted);
     for i := 0 to h do
       tmp := (tmp + '[' + TIAToStr(sorted[i]) + ']'); 
     WriteLn('SortATIABySize: ' + IntToStr(GetSystemTime - t) + ' ms.');
     SetLength(sorted, 0);
     WriteLn(''); 
     WriteLn(tmp);
     tmp := '';
     SetLength(original, 0);
   end;
   True: WriteLn('Setup constants correctly, please... TERMINATING!');
 end;
end.

 

Which outputs something like this to debug box (the arrays are randomized) - with this you can easily see/notice the difference in comparison to SCAR's SortATIABySize():

 

ATIASortBySizeEx [so_LowToHigh]: 0 ms.
ATIASortBySizeEx [so_HighToLow]: 0 ms.
SortATIABySize: 0 ms.

Original:
[6,6,5][5,1][0,8][8,7][0][7,5][1,9,7][7,2,5][4,9][1,2][8][8,6][8][5,6,9][3][5,0][4,1,7][7][9,8][3,6,7][6,7,4][3,4,7][5,9,9][8,8,1][3]

ATIASortBySizeEx() [so_LowToHigh]: 
[0][3][3][7][8][8][0,8][1,2][4,9][5,0][5,1][7,5][8,6][8,7][9,8][1,9,7][3,4,7][3,6,7][4,1,7][5,6,9][5,9,9][6,6,5][6,7,4][7,2,5][8,8,1]

ATIASortBySizeEx() [so_HighToLow]:
[8,8,1][7,2,5][6,7,4][6,6,5][5,9,9][5,6,9][4,1,7][3,6,7][3,4,7][1,9,7][9,8][8,7][8,6][7,5][5,1][5,0][4,9][1,2][0,8][8][8][7][3][3][0]

SortATIABySize():
[3][0][8][3][8][7][1,2][5,1][0,8][7,5][4,9][5,0][8,6][9,8][8,7][6,6,5][5,6,9][4,1,7][7,2,5][3,6,7][6,7,4][1,9,7][5,9,9][8,8,1][3,4,7]
Successfully executed (37.75 ms)

[LordJashin]

Very nice! Good work Jani!

[Janilabo]

Very nice! Good work Jani!

Thanks LJ.

[slacky]

Good job, Jani It's nice to be able to sort by the length, don't see why SCAR does not have this feature.

Edited June 17, 2013 by slacky

[Janilabo]

Good job, Jani It's nice to be able to sort by the length, don't see why SCAR does not have this feature.

Thanks, Slacky.

 

By the way, I would love to see you write some badass array-related algorithms for SCAR!

[slacky]

Care to elaborate? It would seem that you got the most useful array-related functions covered.

Only thing I miss, is a fast dictionary/map like implementation, which is quite complicated to do in Delphi.

Edited June 18, 2013 by slacky

[Janilabo]

Care to elaborate? It would seem that you got the most useful array-related functions covered.

Only thing I miss, is a fast dictionary/map like implementation, which is quite complicated to do in Delphi.

Well mate, I am sure there's still plenty of functions/procedures that I haven't got covered OR even thought of.

..and I mean a lot of em... There's just so many ways how you can play around with arrays!

 

But also, I do enjoy seeing other people write some big functions with smart algorithms.

 

There is not nearly enough stuff posted to here @Code Bin - whereas, for example, at SRL Forums there's several people posting some cool snippets and commands to SRL Snippets section.

Would love to see a little more activity around these boards over here at SCAR forums..

Although, the main reason could/might be that most of us are currently dropping those snippets/commands to the include files, so thats why it doesn't really show up around these sections really.

 

My mind is a little bit too abstract in a way - this can be easily noticed/seen (especially) with the development cycles of MSSL.

Quite often, the ideas that I get, just keep coming up from absolutely nowhere!

[slacky]

True that, I will keep it in mind! But I have not been very productive, nor creative lately, and I believe it will continue for a lil' while..

I believe the correct term for this is burned-out (at least in my case)

[LordJashin]

Yeah it takes time, and thought to be creative. And sweat and tears or just bordom

[Janilabo]

True that, I will keep it in mind! But I have not been very productive, nor creative lately, and I believe it will continue for a lil' while..

I believe the correct term for this is burned-out (at least in my case)

Yeah, I know what you mean mate, I have every now and then those "dark" days, weeks or EVEN months sometimes... Man, I really hate em! :\

Sure hope yours wont last too long.