von einer auf mehere Basen und ggf. Erweiterung umgestellt in permutation in lowlevelunit.pas

1 files changed, 60 insertions, 26 deletions

diff --git a/lowlevelunit.pas b/lowlevelunit.pas
index 1017ab6..aa17bf2 100644
--- a/lowlevelunit.pas
+++ b/lowlevelunit.pas
@@ -95,7 +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;
+function permutation(len: longint): tLongintArray; overload;
+function permutation(len,rest,maxBasis: longint; basen: tLongintArray): tLongintArray; overload;
 procedure llPermutation(len,offset: longint; var ar: tLongintArray); inline;
 
 var
@@ -850,46 +851,79 @@ end;
 
 function permutation(len: longint): tLongintArray;
 var
-  mantisse,exponent,
-    block,position,element: longint;
-  mergePerm:                tLongintArray;
-  werte:                    array[boolean] of tLongintArray;
-  aWerte:                   boolean;
+  basen:                tLongintArray;
+  rest,i,ilen,best,off: longint;
 const
-  basis = 8;
+  maxBasis = 8;
 begin
-  mantisse:=len;
-  exponent:=0;
-  while ((mantisse mod 8) = 0) and (mantisse>0) do begin
-    inc(exponent);
-    mantisse:=mantisse div basis;
-  end;
+  rest:=len;
+  ilen:=len;
+  setlength(basen,0);
 
-  // len = mantisse * basis^exponent
+  repeat
+    for i:=maxBasis downto 2 do
+      while ((rest mod i) = 0) and (rest>maxBasis) do begin
+        setlength(basen,length(basen)+1);
+        basen[length(basen)-1]:=i;
+        rest:=rest div i;
+      end;
+    if rest>maxBasis then begin
+      best:=maxBasis;
+      for i:=maxBasis-1 downto 2 do
+        if i*((rest+i-1) div i)-rest < best*((rest+best-1) div best)-rest then
+          best:=i;
+      off:=best*((rest+best-1) div best)-rest;  // Bedeutung von off: rest -> rest + off
+      ilen:=(ilen div rest)*(rest+off);
+      rest:=rest+off;
+    end;
+  until rest<=maxBasis;
 
+  // len = rest * \prod_i basis[i]
+  result:=permutation(ilen,rest,maxBasis,basen);
+
+  if ilen>len then begin
+    off:=0;
+    i:=0;
+    while i+off<ilen do
+      if result[i+off]>=len then
+        inc(off)
+      else begin
+        result[i]:=result[i+off];
+        inc(i);
+      end;
+    setlength(result,len);
+  end;
+end;
+
+function permutation(len,rest,maxBasis: longint; basen: tLongintArray): tLongintArray;
+var
+  i,block,position,element: longint;
+  mergePerm:                tLongintArray;
+  werte:                    array[boolean] of tLongintArray;
+  aWerte:                   boolean;
+begin
   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]);
+  for block:=0 to (len div rest)-1 do          // Initialisierung der $\prod_i basis[i]$ Blöcke zu je $rest$ permutierten Zahlen
+    llPermutation(rest,block*rest,werte[aWerte]);
 
-  setlength(mergePerm,basis);
+  setlength(mergePerm,maxBasis);
 
-  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;
+  for i:=0 to length(basen)-1 do begin
+    for block:=0 to (len div (rest*basen[i]))-1 do begin
+      for position:=0 to rest-1 do begin
+        llPermutation(basen[i],0,mergePerm);
+        for element:=0 to basen[i]-1 do
+          werte[not aWerte,block*rest*basen[i] + position*basen[i] + mergePerm[element]]:=
+            werte[aWerte,block*rest*basen[i] + element*rest + position] + element*rest;
       end;
     end;
 
     aWerte:=not aWerte;
-    mantisse:=mantisse*basis;
-    dec(exponent);
+    rest:=rest*basen[i];
   end;
 
   setlength(mergePerm,0);