aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

124
Task/Permutations-Derangements/PureBasic/permutations-derangements-1.purebasic
View file

@ -1,7 +1,7 @@
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)
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"
@ -15,109 +15,109 @@ 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)
If CreateFile(0,f.s)
WriteStringN(0,"1.2")
WriteStringN(0,"2.1")
CloseFile(0)
Else
Debug "not createfile :"+f.s
EndIf
showfactorial=#FALSE
showfactorial=#False
if showfactorial
If showfactorial
; cw("nfactorial n ="+str(n))
Debug "nfactorial n ="+str(n)
endif
Debug "nfactorial n ="+Str(n)
EndIf
; build up the factorial combinations
for l=1 to n-2
gosub nfactorial
next
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
Debug "derangements["+Str(Subfactoral(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
For i=0 To 20
Debug "derangements["+Str(Subfactoral(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)
If ReadFile(0,factFile.s) And CreateFile(1,drngFile.s)
Repeat
r.s = ReadString(0)
cs=CountString(r.s,".")
if cs
If cs
hit=0
t.s=""
; scan for numbers at their index
for i=1 to cs+1
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,".")
If Val(s.s)=i:hit+1:EndIf
Next
t.s=RTrim(t.s,".")
; show only those which are valid
if not hit
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)
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
Return
nfactorial:
x=0
If ReadFile(2112,factFile.s) and CreateFile(2113,tempFile.s)
repeat
r.s = ReadString(2112)
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
If cs
For j=1 To cs+2
t.s=""
for i=1 to cs+1
For i=1 To cs+1
s.s=StringField(r.s,i,".")
if i=j
t.s+"."+str(cs+2)+"."+s.s
else
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,".")
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
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)
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
Return