De Bruijn sequences: Difference between revisions
Added solution for Pascal.
(Ada version) |
(Added solution for Pascal.) |
||
Line 2,398:
PIN number 5814 missing
PIN number 8145 missing</pre>
=={{header|Pascal}}==
A console application in Free Pascal, created with the Lazarus IDE.
For a given word length n, constructs a de Bruijn sequence by concatenating, in lexicographic order, all the Lyndon words whose length divides n. (See Wikipedia article "de Bruijn sequence", section "Construction".)
<lang pascal>
program deBruijnSequence;
uses SysUtils;
// Create a de Bruijn sequence for the given word length and alphabet.
function deBruijn( const n : integer; // word length
const alphabet : string) : string;
var
d, k, m, s, t, seqLen : integer;
w : array of integer;
begin
k := Length( alphabet);
// de Bruijn sequence will have length k^n
seqLen := 1;
for t := 1 to n do seqLen := seqLen*k;
SetLength( result, seqLen);
d := 0; // index into de Bruijn sequence (will be pre-inc'd)
// Work through Lyndon words of length <= n, in lexicographic order.
SetLength( w, n); // w holds array of indices into the alphabet
w[0] := 1; // first Lyndon word
m := 1; // m = length of Lyndon word
repeat
// If m divides n, append the current Lyndon word to the output
if (m = n) or (m = 1) or (n mod m = 0) then begin
for t := 0 to m - 1 do begin
inc(d);
result[d] := alphabet[w[t]];
end;
end;
// Get next Lyndon word using Duval's algorithm:
// (1) Fill w with repetitions of current word
s := 0; t := m;
while (t < n) do begin
w[t] := w[s];
inc(t); inc(s);
if s = m then s := 0;
end;
// (2) Repeatedly delete highest index k from end of w, if present
m := n;
while (m > 0) and (w[m - 1] = k) do dec(m);
// (3) If word is now null, stop; else increment end value
if m > 0 then inc( w[m - 1]);
until m = 0;
Assert( d = seqLen); // check that the sequence is exactly filled in
end;
// Check a de Bruijn sequence, assuming that its alphabet consists
// of the digits '0'..'9' (in any order);
procedure CheckDecimal( const n : integer; // word length
const deB : string);
var
count : array of integer;
j, L, pin, nrErrors : integer;
wrap : string;
begin
L := Length( deB);
// The de Bruijn sequence is cyclic; make an array to handle wrapround.
SetLength( wrap, 2*n - 2);
for j := 1 to n - 1 do wrap[j] := deB[L + j - n + 1];
for j := n to 2*n - 2 do wrap[j] := deB[j - n + 1];
// Count occurrences of each PIN.
// PIN = -1 if character is not a decimal digit.
SetLength( count, L);
for j := 0 to L - 1 do count[L] := 0;
for j := 1 to L - n + 1 do begin
pin := SysUtils.StrToIntDef( Copy( deB, j, n), -1);
if pin >= 0 then inc( count[pin]);
end;
for j := 1 to n - 1 do begin
pin := SysUtils.StrToIntDef( Copy( wrap, j, n), -1);
if pin >= 0 then inc( count[pin]);
end;
// Check that all counts are 1
nrErrors := 0;
for j := 0 to L - 1 do begin
if count[j] <> 1 then begin
inc( nrErrors);
WriteLn( SysUtils.Format( ' PIN %d has count %d', [j, count[j]]));
end;
end;
WriteLn( SysUtils.Format( ' Number of errors = %d', [nrErrors]));
end;
// Main routine
var
deB, rev : string;
L, j : integer;
begin
deB := deBruijn( 4, '0123456789');
// deB := deBruijn( 4, '7368290514'); // any permutation would do
L := Length( deB);
WriteLn( SysUtils.Format( 'Length of de Bruijn sequence = %d', [L]));
if L >= 260 then begin
WriteLn;
WriteLn( 'First and last 130 characters are:');
WriteLn( Copy( deB, 1, 65));
WriteLn( Copy( deb, 66, 65));
WriteLn( '...');
WriteLn( Copy( deB, L - 129, 65));
WriteLn( Copy( deB, L - 64, 65));
end;
WriteLn;
WriteLn( 'Checking de Bruijn sequence:');
CheckDecimal( 4, deB);
// Check reversed sequence
SetLength( rev, L);
for j := 1 to L do rev[j] := deB[L + 1 - j];
WriteLn( 'Checking reversed sequence:');
CheckDecimal( 4, rev);
// Check sequence with '.' instad of decimal digit
if L >= 4444 then begin
deB[4444] := '.';
WriteLn( 'Checking vandalized sequence:');
CheckDecimal( 4, deB);
end;
end.
</lang>
{{out}}
<pre>
Length of de Bruijn sequence = 10000
First and last 130 characters are:
00001000200030004000500060007000800090011001200130014001500160017
00180019002100220023002400250026002700280029003100320033003400350
...
89768986899696977697869796987698869896997699869997777877797788778
97798779978787978887889789878997979887989799879998888988998989999
Checking de Bruijn sequence:
Number of errors = 0
Checking reversed sequence:
Number of errors = 0
Checking vandalized sequence:
PIN 1459 has count 0
PIN 4591 has count 0
PIN 5814 has count 0
PIN 8145 has count 0
Number of errors = 4
</pre>
=={{header|Perl}}==
| |||