fork download 
  1. program ideone;
  2.  
  3. type
  4.   TBytes2D = array of array of Byte;
  5.  
  6.   function NextPerm(var Data: array of Byte): Boolean;
  7.   var
  8.     i, j: Byte;
  9.  
  10.     procedure Swap(var a, b: Byte);
  11.     var
  12.       t: Byte;
  13.     begin
  14.       t := a;
  15.       a := b;
  16.       b := t;
  17.     end;
  18.  
  19.   begin
  20.     i := High(Data);
  21.     while (i > 0) and (Data[i - 1] >= Data[i]) do
  22.       Dec(i);
  23.  
  24.     if (i <= 0) then
  25.       Exit(False);
  26.  
  27.     j := High(Data);
  28.     while Data[j] <= Data[i - 1] do
  29.       Dec(j);
  30.  
  31.     Swap(Data[i - 1], Data[j]);
  32.     j := High(Data);
  33.     while i < j do begin
  34.       Swap(Data[i], Data[j]);
  35.       Inc(i);
  36.       Dec(j)
  37.     end;
  38.     Exit(True);
  39.   end;
  40.  
  41.   procedure PrintOut(const a: TBytes2D);
  42.   var
  43.     i, j: Integer;
  44.   begin
  45.     for i := 0 to High(a) do begin
  46.       Write('[');
  47.       for j := 0 to High(a[i]) do begin
  48.         Write(a[i, j]);
  49.         if j < High(a[i]) then 
  50.           Write(', ');
  51.       end;
  52.       Write('] ');
  53.     end;
  54.     Writeln;
  55.   end;
  56.  
  57.  
  58.   //https://stackoverflow.com/questions/47376466/algorithm-for-permutation-with-buckets
  59.   procedure GenDistributions(N: Integer);
  60.   var
  61.     seq, t, i, j, mx: Integer;
  62.     Data: array of Byte;
  63.     Dist: TBytes2D;
  64.   begin
  65.     SetLength(Data, N);
  66.  
  67.     //there are n-1 places for incrementing
  68.     //so 2^(n-1) possible sequences
  69.     for seq := 0 to 1 shl (N - 1) - 1 do begin
  70.       t := seq;
  71.       mx := 0;
  72.       Data[0] := mx;
  73.       for i := 1 to N - 1 do begin
  74.         mx := mx + (t and 1); //check for the lowest bit
  75.         Data[i] := mx;
  76.         t := t shr 1;
  77.       end;
  78.  
  79.       //here Data contains nondecreasing sequqnce 0..mx, increment is 0 or 1
  80.       //Data[i] corresponds to the number of sublist which item i belongs to
  81.  
  82.       repeat
  83.         Dist := nil;
  84.         SetLength(Dist, mx + 1); // reset result array
  85.  
  86.         for i := 0 to N - 1 do begin
  87.           j := Length(Dist[Data[i]]);
  88.           SetLength(Dist[Data[i]], j+1);
  89.           Dist[Data[i]] [j] := i; //add item to calculated sublist
  90.         end;  
  91.  
  92.         PrintOut(Dist);
  93.       until not NextPerm(Data);  //generates next permutation if possible
  94.  
  95.     end;
  96.  
  97.   end;
  98.  
  99. begin
  100.   GenDistributions(3);
  101. end.
Success #stdin #stdout 0s 328KB
comments (?)
stdin 
Standard input is empty
stdout 
[0, 1, 2] 
[0] [1, 2] 
[1] [0, 2] 
[2] [0, 1] 
[0, 1] [2] 
[0, 2] [1] 
[1, 2] [0] 
[0] [1] [2] 
[0] [2] [1] 
[1] [0] [2] 
[2] [0] [1] 
[1] [2] [0] 
[2] [1] [0]
https://ideone.com/oTqUAo
language:
Pascal (fpc 3.0.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!