Data commit

Task/Superpermutation-minimisation/PureBasic/superpermutation-minimisation.basic

@@ -0,0 +1,40 @@
+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