TSAToParts

[Janilabo]

This function breaks TSA to parts (TSA => ATSA).

 

Contains 2 methods:

-pm_PartSize (Breaks TSA to ATSA by size of the parts) [x = size]

-pm_PartAmount (Breaks TSA to ATSA by amount of the parts) [x = amount]

 

Included example to show the power of this function.

 

function TSAToParts(TSA: TStrArray; method: (pm_PartSize, pm_PartAmount); x: Integer): T2DStrArray;
var
 a, e, h, h2, i, i2, p: Integer;
begin
 h := High(TSA);
 case ((h > -1) and (x > 0)) of
   True:
   case method of
     pm_PartSize:
     if (x <= h) then
     begin
       Inc(h);
       p := (h div x);
       if ((p * x) < h) then
         Inc(p);
       SetLength(Result, p);
       for i := 0 to (p - 1) do
         for i2 := 0 to (x - 1) do
         begin
           SetLength(Result[i], x);
           if (a < h) then
           begin
             Result[i][i2] := TSA[a];
             Inc(a);
           end else
           begin
             SetLength(Result[i], i2);
             Exit;
           end;
         end;
     end else
       Result := [TSA];      
     pm_PartAmount:
     case (h <= 0) of
       False:
       begin
         if (h < (x - 1)) then
           x := (h + 1);
         p := Floor((h + 1) / x);
         if (p = 0) then
           p := 1;
         e := ((h + 1) - (p * x));
         if (e >= (h + 1)) then
           e := 0;
         SetLength(Result, x);
         for i := 0 to (x - 1) do
         begin
           if ((e >= (i + 1)) and (e > 0)) then
             SetLength(Result[i], (p + 1))
           else
             if (i <= h) then
               SetLength(Result[i], p);
           h2 := High(Result[i]);
           for i2 := 0 to h2 do
           begin
             Result[i][i2] := TSA[a];
             Inc(a);
           end;
         end;      
       end;
       True: Result := [TSA];
     end;
   end;    
   False: SetLength(Result, 0);          
 end;
end;

var
 str: string;
 TSA: TStrArray;
 ATSA: T2DStrArray;
 x, h, h2, i, i2: Integer;

begin
 ClearDebug;
 TSA := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6',
         'Test7', 'Test8', 'Test9', 'Test10', 'Test11', 'Test12', 'Test13',
         'Test14', 'Test15', 'Test16', 'Test17', 'Test18', 'Test19', 'Test20'];
 for x := 10 downto 3 do
 begin
   WriteLn('TSAToParts(TSA, pm_PartAmount, ' + IntToStr(x) + '):');
   ATSA := TSAToParts(TSA, pm_PartAmount, x);
   h := High(ATSA);
   for i := 0 to h do
   begin
     h2 := High(ATSA[i]);
     str := '';
     str := 'ATSA[' + IntToStr(i) + ']: ';
     for i2 := 0 to h2 do
       if (i2 < h2) then
         str := (str + '''' + ATSA[i][i2] + ''', ')
       else
         str := (str + '''' + ATSA[i][i2] + '''');
     WriteLn(str);
     SetLength(ATSA[i], 0);
   end;
   SetLength(ATSA, 0);
   WriteLn('');
   WriteLn('TSAToParts(TSA, pm_PartSize, ' + IntToStr(x) + '):');
   ATSA := TSAToParts(TSA, pm_PartSize, x);
   h := High(ATSA);
   for i := 0 to h do
   begin
     h2 := High(ATSA[i]);
     str := '';
     str := 'ATSA[' + IntToStr(i) + ']: ';
     for i2 := 0 to h2 do
       if (i2 < h2) then
         str := (str + '''' + ATSA[i][i2] + ''', ')
       else
         str := (str + '''' + ATSA[i][i2] + '''');
     WriteLn(str);
     SetLength(ATSA[i], 0);
   end;
   SetLength(ATSA, 0);
   WriteLn('');
 end;
 SetLength(TSA, 0);
end.

Edited March 31, 2013 by Janilabo
Logical side fixed and tweaked!

[LordJashin]

Nice! So now just to translate it to TBA.

[Janilabo]

Fixed and tweaked logic of this sexy function, because the old one had small problems.

Works like charm now!