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

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

@@ -0,0 +1,57 @@
+Procedure.i deranged(depth,lenn,array d(1),show)
+Protected count.l,tmp,i
+        if (depth = lenn)
+                if (show)
+                        ; for i = 0 to lenn-1:so(chr(d(i) + 'a')):next
+                        for i = 0 to lenn-1:Debug chr(d(i) + 'a'):next
+                        ; cw("")
+                        Debug ""
+                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
+global dim a(1024)
+for i=0 to n-1:a(i)=i:next
+ProcedureReturn  deranged(0, n, a(), show)
+EndProcedure
+
+        ; cw("Deranged Four:")
+        Debug "Deranged Four:"
+        gen_n(4, 1)
+        ; cw("")
+        Debug ""
+
+        ; cw("Compare list vs calc:")
+        Debug "Compare list vs calc:"
+        for i = 0 to 9
+                ; cw(str(i)+" "+str(gen_n(i, 0))+" "+str(sub_fact(i)))
+                Debug str(i)+" "+str(gen_n(i, 0))+" "+str(sub_fact(i))
+        next
+        ; cw("")
+        Debug ""
+
+        ; cw("further calc:")
+        Debug "further calc:"
+        for i = 10 to 20
+                ; cw(str(i)+" "+str(sub_fact(i)))
+                Debug str(i)+" "+str(sub_fact(i))
+        next