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

52 lines
1.2 KiB
Plaintext

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