EnableExplicit
#MAX=10
Declare.i fact_sum(n.i) : Declare.i r(n.i) : Declare superperm(n.i)
Global pos.i, Dim cnt.i(#MAX), Dim super.s{1}(fact_sum(#MAX))

If OpenConsole() ;- MAIN: Superpermutation_minimisation
  Define.i n
  For n=0 To #MAX
    superperm(n) : Print("superperm("+RSet(Str(n),2)+") len = "+LSet(Str(pos),10))
    If n<=4      : Print(~"\t"+PeekS(@super(),pos)) : EndIf
    PrintN("")
  Next
  Input()
EndIf
End ;- END: Superpermutation_minimisation

Procedure.i fact_sum(n.i)
  Define.i s=0,f=1,x=0
  While x<n : x+1 : f*x : s+f : Wend
  ProcedureReturn s
EndProcedure

Procedure.i r(n.i)
  If Not n             : ProcedureReturn 0 : EndIf
  Define c.s{1}=super(pos-n)
  cnt(n)-1
  If Not cnt(n)
    cnt(n)=n
    If Not r(n-1)      : ProcedureReturn 0 : EndIf
  EndIf
  super(pos)=c : pos+1 : ProcedureReturn 1
EndProcedure

Procedure superperm(n.i)
  pos=n
  Define.i len=fact_sum(n),i
  For i=0 To n : cnt(i)=i              : Next
  For i=1 To n : super(i-1)=Chr('0'+i) : Next
  While r(n)   : Wend
EndProcedure