diff options
Diffstat (limited to 'lowlevelunit.pas')
-rw-r--r-- | lowlevelunit.pas | 78 |
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 |