tasks a-s

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

@@ -0,0 +1,123 @@
+Procedure.q perm(n)
+if n=0:ProcedureReturn 1:endif
+if n=1:ProcedureReturn 0:endif
+ProcedureReturn (perm(n-1)+perm(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(2113,f.s)
+WriteStringN(2113,"1.2")
+WriteStringN(2113,"2.1")
+CloseFile(2113)
+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(perm(n))+"] for n="+str(n)
+gosub derangements
+; cw("")
+Debug ""
+
+; show the first 20 derangements
+for i=0 to 20
+; cw("derangements["+str(perm(i))+"] for n="+str(i))
+Debug "derangements["+str(perm(i))+"] for n="+str(i)
+next
+end
+
+derangements:
+x=0
+If ReadFile(2112,factFile.s) and CreateFile(2113,drngFile.s)
+repeat
+r.s = ReadString(2112)
+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(2113,t.s+" "+str(x))
+endif
+endif
+until eof(2112)
+CloseFile(2112)
+CloseFile(2113)
+Else
+Debug "not readfile :"+factFile.s
+Debug "not createfile :"+drngFile.s
+EndIf
+; cw("")
+Debug ""
+return
+
+nfactorial:
+x=0
+If ReadFile(2112,factFile.s) and CreateFile(2113,tempFile.s)
+repeat
+r.s = ReadString(2112)
+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(2113,t.s)
+next
+endif
+until eof(2112)
+CloseFile(2112)
+CloseFile(2113)
+Else
+Debug "not readfile :"+factFile.s
+Debug "not createfile :"+tempFile.s
+EndIf
+CopyFile(tempFile.s,factFile.s)
+DeleteFile(tempFile.s)
+return