RosettaCodeData/Task/Superpermutation-minimisation/PureBasic/superpermutation-minimisati...

41 lines
1.0 KiB
Plaintext

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