Just another update

This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions

View file

@ -2,7 +2,8 @@ A [http://mathworld.wolfram.com/Derangement.html derangement] is a permutation o
For example, the only two derangements of the three items (0, 1, 2) are (1, 2, 0), and (2, 0, 1).
The number of derangements of ''n'' distinct items is known as the subfactorial of ''n'', sometimes written as !''n''. There are various ways to [[wp:Derangement#Counting_derangements|calculate]] !''n''.
The number of derangements of ''n'' distinct items is known as the subfactorial of ''n'', sometimes written as !''n''.
There are various ways to [[wp:Derangement#Counting_derangements|calculate]] !''n''.
;Task
The task is to:

View file

@ -0,0 +1,75 @@
PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE)
PRINT'"Table of n, counted derangements, calculated derangements :"
FOR I% = 0 TO 9
PRINT I%, FN_Derangement_Generate(I%,FALSE), FN_SubFactorial(I%)
NEXT
PRINT'"There is no long int in BBC BASIC!"
PRINT"!20 = ";FN_SubFactorial(20)
END
DEF FN_Derangement_Generate(N%, fPrintOut)
LOCAL A%(), O%(), C%, D%, I%, J%
IF N% = 0 THEN = 1
DIM A%(N%-1), O%(N%-1)
FOR I% = 0 TO N%-1 : A%(I%) = I% : NEXT
O%() = A%()
FOR I% = 0 TO FN_Factorial(DIM(A%(),1)+1)-1
PROC_NextPermutation(A%())
D% = TRUE
FOR J%=0 TO N%-1
IF A%(J%) = O%(J%) THEN D% = FALSE
NEXT
IF D% THEN
C% += 1
IF fPrintOut THEN
FOR K% = 0 TO N%-1
PRINT ;A%(K%);" ";
NEXT
PRINT
ENDIF
ENDIF
NEXT
= C%
DEF PROC_NextPermutation(A%())
LOCAL first, last, elementcount, pos
elementcount = DIM(A%(),1)
IF elementcount < 1 THEN ENDPROC
pos = elementcount-1
WHILE A%(pos) >= A%(pos+1)
pos -= 1
IF pos < 0 THEN
PROC_Permutation_Reverse(A%(), 0, elementcount)
ENDPROC
ENDIF
ENDWHILE
last = elementcount
WHILE A%(last) <= A%(pos)
last -= 1
ENDWHILE
SWAP A%(pos), A%(last)
PROC_Permutation_Reverse(A%(), pos+1, elementcount)
ENDPROC
DEF PROC_Permutation_Reverse(A%(), firstindex, lastindex)
LOCAL first, last
first = firstindex
last = lastindex
WHILE first < last
SWAP A%(first), A%(last)
first += 1
last -= 1
ENDWHILE
ENDPROC
DEF FN_Factorial(N) : IF (N = 1) OR (N = 0) THEN =1 ELSE = N * FN_Factorial(N-1)
DEF FN_SubFactorial(N) : IF N=0 THEN =1 ELSE =N*FN_SubFactorial(N-1)+-1^N
REM Or you could use:
REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))

View file

@ -0,0 +1,52 @@
( ( calculated-!n
= memo answ
. (memo==)
& ( !arg:0&1
| !arg:1&0
| !(memo.):? (!arg.?answ) ?&!answ
| (!arg+-1)
* (calculated-!n$(!arg+-1)+calculated-!n$(!arg+-2))
: ?answ
& (!arg.!answ) !(memo.):?(memo.)
& !answ
)
)
& ( counted-!n
= p P h H A Z L
. !arg:(%?p ?P.?H.?L)
& !H
: ?A
(%@?h:~!p)
(?Z&counted-!n$(!P.!A !Z.!h !L))
| !arg:(..?L)
& 1+!count:?count
& (!count.!L) !D:?D
& ~
)
& out$"Derangements of 1 2 3 4"
& :?D
& 0:?count
& ( counted-!n$(4 3 2 1.4 3 2 1.)
| out$!D
)
& ( pad
= len w
. @(!arg:? [?len)
& @(" ":? [!len ?w)
& !w !arg
)
& :?K
& -1:?N
& out$(str$(N pad$List pad$Calc))
& whl
' ( !N+1:<10:?N
& ( 0:?count
& :?D
& counted-!n$(!K.!K.)
| out$(str$(!N pad$!count pad$(calculated-!n$!N)))
)
& !N !K:?K
)
& out$("!20 =" calculated-!n$20)
& lst$calculated-!n
)

View file

@ -1,22 +1,23 @@
import std.stdio, std.algorithm, std.typecons, std.conv, std.range;
import std.stdio, std.algorithm, std.typecons, std.conv,
std.range, std.traits;
T factorial(T)(in T n) pure nothrow {
T factorial(T)(in T n) pure nothrow @safe @nogc {
Unqual!T result = 1;
foreach (immutable i; 2 .. n + 1)
result *= i;
return result;
}
T subfact(T)(in T n) pure nothrow {
T subfact(T)(in T n) pure nothrow @safe @nogc {
if (0 <= n && n <= 2)
return n != 1;
return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
auto derangements(in size_t n, in bool countOnly=false)
pure /*nothrow*/ {
pure nothrow @safe {
size_t[] seq = n.iota.array;
auto ori = seq.idup; // Not nothrow.
auto ori = seq.idup;
size_t[][] all;
size_t cnt = n == 0;
@ -44,14 +45,14 @@ pure /*nothrow*/ {
if (countOnly)
cnt++;
else
all ~= seq.dup; // Not nothrow.
all ~= seq.dup;
}
}
return tuple(all, cnt);
}
void main() {
void main() @safe {
"Derangements for n = 4:".writeln;
foreach (const d; 4.derangements[0])
d.writeln;

View file

@ -13,10 +13,10 @@ T subfact(T)(in T n) pure nothrow {
return (n - 1) * (subfact(n - 1) + subfact(n - 2));
}
auto derangementsR(in size_t n, in bool countOnly=false)
pure /*nothrow*/ {
auto derangementsR(in size_t n, in bool countOnly=false) pure
/*nothrow*/ {
auto seq = n.iota.array;
immutable ori = seq.idup; // Not nothrow.
immutable ori = seq.idup;
const(size_t[])[] res;
size_t cnt;

View file

@ -4,6 +4,6 @@ subfact = { BigInteger n -> (n == 0) ? 1 : (n == 1) ? 0 : ((n-1) * (subfact(n-1)
def derangement = { List l ->
def d = []
l.eachPermutation { p -> if ([p,l].transpose().every{ it[0] != it[1] }) d << p }
if (l) l.eachPermutation { p -> if ([p,l].transpose().every{ pp, ll -> pp != ll }) d << p }
d
}

View file

@ -1,57 +1,51 @@
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
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
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
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
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)
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)
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
; cw("Deranged Four:")
Debug "Deranged Four:"
gen_n(4, 1)
; cw("")
Debug ""
If OpenConsole()
PrintN("Deranged Four:")
gen_n(4, 1)
; 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 ""
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
; 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
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

View file

@ -37,7 +37,7 @@ return #
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end
if i==0 then return 0
if i==0 then return 0
do j=i+1 while @.j<@.i; end
parse value @.j @.i with @.i @.j
return 1

View file

@ -0,0 +1,15 @@
def derangements(n: Int) =
(1 to n).permutations.filter(_.zipWithIndex.forall{case (a, b) => a - b != 1})
def subfactorial(n: Long): Long = n match {
case 0 => 1
case 1 => 0
case _ => (n - 1) * (subfactorial(n - 1) + subfactorial(n - 2))
}
println(s"Derangements for n = 4")
println(derangements(4) mkString "\n")
println("\n%2s%10s%10s".format("n", "derange", "subfact"))
(0 to 9).foreach(n => println("%2d%10d%10d".format(n, derangements(n).size, subfactorial(n))))
(10 to 20).foreach(n => println(f"$n%2d${subfactorial(n)}%20d"))