permutation neu in lowlevelunit.pas

1 files changed, 78 insertions, 0 deletions

diff --git a/lowlevelunit.pas b/lowlevelunit.pas
index c818d96..1017ab6 100644
--- a/lowlevelunit.pas
+++ b/lowlevelunit.pas
@@ -95,6 +95,8 @@ function mirrorBits(b: byte): byte; overload;
 function zusammenfassen(s1,s2: string): string;
 function intervallAusrollen(s: string): string;
 function myUtf8Encode(s: string): string;
+function permutation(len: longint): tLongintArray;
+procedure llPermutation(len,offset: longint; var ar: tLongintArray); inline;
 
 var
   base64Chars: array[0..63] of char;
@@ -846,6 +848,82 @@ begin
       result:=leftStr(result,pos(falsch[i],result)-1)+richtig[i]+rightStr(result,length(result)-pos(falsch[i],result));
 end;
 
+function permutation(len: longint): tLongintArray;
+var
+  mantisse,exponent,
+    block,position,element: longint;
+  mergePerm:                tLongintArray;
+  werte:                    array[boolean] of tLongintArray;
+  aWerte:                   boolean;
+const
+  basis = 8;
+begin
+  mantisse:=len;
+  exponent:=0;
+  while ((mantisse mod 8) = 0) and (mantisse>0) do begin
+    inc(exponent);
+    mantisse:=mantisse div basis;
+  end;
+
+  // len = mantisse * basis^exponent
+
+  for aWerte:=false to true do
+    setlength(werte[aWerte],len);
+
+  aWerte:=false;
+
+  for block:=0 to (len div mantisse)-1 do          // Initialisierung der $basis^exponent$ Blöcke zu je $mantisse$ permutierten Zahlen
+    llPermutation(mantisse,block*mantisse,werte[aWerte]);
+
+  setlength(mergePerm,basis);
+
+  while exponent>0 do begin
+    for block:=0 to (len div (mantisse*basis))-1 do begin
+      for position:=0 to mantisse-1 do begin
+        llPermutation(basis,0,mergePerm);
+        for element:=0 to basis-1 do
+          werte[not aWerte,block*mantisse*basis + position*basis + mergePerm[element]]:=
+            werte[aWerte,block*mantisse*basis + element*mantisse + position] + element*mantisse;
+      end;
+    end;
+
+    aWerte:=not aWerte;
+    mantisse:=mantisse*basis;
+    dec(exponent);
+  end;
+
+  setlength(mergePerm,0);
+
+  setlength(result,length(werte[aWerte]));
+  if length(result)>0 then
+    move(werte[aWerte][0],result[0],length(result)*sizeof(result[0]));
+
+  for aWerte:=false to true do
+    setlength(werte[aWerte],0);
+end;
+
+procedure llPermutation(len,offset: longint; var ar: tLongintArray);
+var
+  wert,i,j: longint;
+begin
+  for i:=0 to len-1 do
+    ar[i+offset]:=-1;
+  for i:=0 to len-1 do begin
+    wert:=random(len-i);
+    j:=0;
+    while j<=wert do begin
+      wert:=wert + byte(ar[j+offset]>=0);
+      inc(j);
+    end;
+    ar[wert+offset]:=i;
+  end;
+  for i:=0 to len-1 do
+    if ar[i+offset]=-1 then begin
+      writeln(stderr,'permutation: '+inttostr(i)+' wurde nicht verteilt!');
+      raise exception.create('permutation: '+inttostr(i)+' wurde nicht verteilt!');
+    end;
+end;
+
 var b: byte;
 
 begin