Data commit

Task/Permutations-Derangements/PureBasic/permutations-derangements-1.basic

@@ -0,0 +1,123 @@
+Procedure.q Subfactoral(n)
+If n=0:ProcedureReturn 1:EndIf
+If n=1:ProcedureReturn 0:EndIf
+ProcedureReturn (Subfactoral(n-1)+Subfactoral(n-2))*(n-1)
+EndProcedure
+
+factFile.s="factorials.txt"
+tempFile.s="temp.txt"
+drngFile.s="derangements.txt"
+DeleteFile(factFile.s)
+DeleteFile(tempFile.s)
+DeleteFile(drngFile.s)
+
+n=4
+
+; create our storage file
+f.s=factFile.s
+If CreateFile(0,f.s)
+WriteStringN(0,"1.2")
+WriteStringN(0,"2.1")
+CloseFile(0)
+Else
+Debug "not createfile :"+f.s
+EndIf
+
+showfactorial=#False
+
+If showfactorial
+; cw("nfactorial n ="+str(n))
+Debug "nfactorial n ="+Str(n)
+EndIf
+
+; build up the factorial combinations
+For l=1 To n-2
+Gosub nfactorial
+Next
+
+; extract the derangements
+; cw("derangements["+str(perm(n))+"] for n="+str(n))
+Debug "derangements["+Str(Subfactoral(n))+"] for n="+Str(n)
+Gosub derangements
+; cw("")
+Debug ""
+
+; show the first 20 derangements
+For i=0 To 20
+Debug "derangements["+Str(Subfactoral(i))+"] for n="+Str(i)
+Next
+
+End
+
+derangements:
+x=0
+If ReadFile(0,factFile.s) And CreateFile(1,drngFile.s)
+Repeat
+r.s = ReadString(0)
+cs=CountString(r.s,".")
+If cs
+hit=0
+t.s=""
+; scan for numbers at their index
+For i=1 To cs+1
+s.s=StringField(r.s,i,".")
+t.s+s.s+"."
+If Val(s.s)=i:hit+1:EndIf
+Next
+t.s=RTrim(t.s,".")
+; show only those which are valid
+If Not hit
+x+1
+; cw(t.s+" "+str(x))
+Debug t.s+" "+Str(x)
+WriteStringN(1,t.s+" "+Str(x))
+EndIf
+EndIf
+Until Eof(0)
+CloseFile(0)
+CloseFile(1)
+Else
+Debug "not readfile :"+factFile.s
+Debug "not createfile :"+drngFile.s
+EndIf
+; cw("")
+Debug ""
+Return
+
+nfactorial:
+x=0
+If ReadFile(0,factFile.s) And CreateFile(1,tempFile.s)
+Repeat
+r.s = ReadString(0)
+cs=CountString(r.s,".")
+If cs
+For j=1 To cs+2
+t.s=""
+For i=1 To cs+1
+s.s=StringField(r.s,i,".")
+If i=j
+t.s+"."+Str(cs+2)+"."+s.s
+Else
+t.s+"."+s.s
+EndIf
+Next
+If j=cs+2:t.s+"."+Str(cs+2):EndIf
+t.s=Trim(t.s,".")
+x+1
+If cs+2=n And showfactorial
+; cw(t.s+" "+str(x))
+Debug t.s+" "+Str(x)
+EndIf
+WriteStringN(1,t.s)
+Next
+EndIf
+Until Eof(0)
+CloseFile(0)
+CloseFile(1)
+Else
+Debug "not readfile :"+factFile.s
+Debug "not createfile :"+tempFile.s
+EndIf
+CopyFile(tempFile.s,factFile.s)
+DeleteFile(tempFile.s)
+Return

Task/Permutations-Derangements/PureBasic/permutations-derangements-2.basic

@@ -0,0 +1,51 @@
+Procedure.i deranged(depth, lenn, Array d(1), show)
+  Protected count, tmp, i
+  If depth = lenn
+    If show
+      For i = 0 To lenn - 1: Print(Chr(d(i) + 'a')): Next
+      PrintN("")
+    EndIf
+    ProcedureReturn  1
+  EndIf
+
+  For i = lenn - 1 To depth Step -1
+    If i = d(depth): Continue: EndIf
+
+    tmp = d(i): d(i) = d(depth): d(depth) = tmp
+    count + deranged(depth + 1, lenn, d(), show)
+    tmp = d(i): d(i) = d(depth): d(depth) = tmp
+  Next
+
+  ProcedureReturn count
+EndProcedure
+
+Procedure.q sub_fact(n)
+  If n = 0: ProcedureReturn 1: EndIf
+  If n = 1: ProcedureReturn 0: EndIf
+  ProcedureReturn (sub_fact(n - 1) + sub_fact(n - 2)) * (n - 1)
+EndProcedure
+
+Procedure.i gen_n(n, show)
+  Protected r.i
+  Dim a(1024)
+  For i = 0 To n - 1: a(i) = i: Next
+  ProcedureReturn  deranged(0, n, a(), show)
+EndProcedure
+
+If OpenConsole()
+  PrintN("Deranged Four:")
+  gen_n(4, 1)
+
+  PrintN(#CRLF$ + "Compare list vs calc:")
+  For i = 0 To 9
+    PrintN(Str(i) + ":" + #TAB$ + Str(gen_n(i, 0)) + #TAB$ + Str(sub_fact(i)))
+  Next
+
+  PrintN(#CRLF$ + "further calc:")
+  For i = 10 To 20
+    PrintN(Str(i) + ": " + Str(sub_fact(i)))
+  Next
+
+  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
+  CloseConsole()
+EndIf