Problem Statement

A superpermutation of N different characters is a string consisting of an arrangement of multiple copies of those N different characters in which every permutation of those characters can be found as a substring. For example, representing the characters as A..Z, using N=2 we choose to use the first two characters 'AB'. The permutations of 'AB' are the two, (i.e. two-factorial), strings: 'AB' and 'BA'. A too obvious method of generating a superpermutation is to just join all the permutations together forming 'ABBA'. A little thought will produce the shorter (in fact the shortest) superpermutation of 'ABA' - it contains 'AB' at the beginning and contains 'BA' from the middle to the end. The "too obvious" method of creation generates a string of length N!*N. Using this as a yardstick, the task is to investigate other methods of generating superpermutations of N from 1-to-7 characters, that never generate larger superpermutations. Show descriptions and comparisons of algorithms used here, and select the "Best" algorithm as being the one generating shorter superpermutations. The problem of generating the shortest superpermutation for each N might be NP complete, although the minimal strings for small values of N have been found by brute -force searches.

Let's start with the solution:

program Superpermutation_minimisation;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

const
  Max = 12;

var
  super: ansistring;
  pos: Integer;
  cnt: TArray;

function factSum(n: Integer): Uint64;
begin
  var s: Uint64 := 0;
  var f := 1;
  var x := 0;

  while x < n do
  begin
    inc(x);
    f := f * x;
    inc(s, f);
  end;

  Result := s;
end;

function r(n: Integer): Boolean;
begin
  if n = 0 then
    exit(false);

  var c := super[pos - n];

  dec(cnt[n]);

  if cnt[n] = 0 then
  begin
    cnt[n] := n;
    if not r(n - 1) then
      exit(false);
  end;
  super[pos] := c;
  inc(pos);
  result := true;
end;

procedure SuperPerm(n: Integer);
begin
  var pos := n;
  var le: Uint64 := factSum(n);
  SetLength(super, le);

  for var i := 0 to n do
    cnt[i] := i;

  for var i := 1 to n do
    super[i] := ansichar(i + ord('0'));

  while r(n) do
    ;
end;

begin
  SetLength(cnt, max);

  for var n := 0 to max - 1 do
  begin
    write('superperm(', n: 2, ') ');
    SuperPerm(n);
    writeln('len = ', length(super));
  end;
  {$IFNDEF UNIX}   readln; {$ENDIF}
end.