September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -0,0 +1,252 @@
|
|||
* Permutations/Derangements 01/04/2017
|
||||
DERANGE CSECT
|
||||
USING DERANGE,R13 base register
|
||||
B 72(R15) skip savearea
|
||||
DC 17F'0' savearea
|
||||
STM R14,R12,12(R13) save previous context
|
||||
ST R13,4(R15) link backward
|
||||
ST R15,8(R13) link forward
|
||||
LR R13,R15 set addressability
|
||||
XPRNT PG1,L'PG1 print title
|
||||
LA R1,4 4
|
||||
LA R2,1 1 : combinations print
|
||||
BAL R14,DERGEN call dergen
|
||||
STH R0,COUNT count=dergen(4,1)
|
||||
XPRNT PG2,L'PG2 print table headings
|
||||
XPRNT PG3,L'PG3 print hyphens
|
||||
SR R4,R4
|
||||
STH R4,II ii=0
|
||||
DO WHILE=(CH,R4,LE,=H'9') do ii=0 to 9
|
||||
MVC PG,=CL80' ' clear buffer
|
||||
XDECO R4,PG edit ii
|
||||
LR R1,R4 ii
|
||||
LA R2,0 0 : no combination print
|
||||
BAL R14,DERGEN dergen(ii,0)
|
||||
XDECO R0,PG+12 edit
|
||||
LH R1,II ii
|
||||
BAL R14,SUBFACT subfact(ii)
|
||||
XDECO R0,PG+24 edit
|
||||
XPRNT PG,L'PG print
|
||||
LH R4,II ii
|
||||
LA R4,1(R4) i+1
|
||||
STH R4,II i=i+1
|
||||
ENDDO , enddo i
|
||||
LA R0,12 12
|
||||
STH R0,II ii=12
|
||||
MVC PG,=CL16'!xx=' init buffer
|
||||
XDECO R0,XDEC edit ii
|
||||
MVC PG+1(2),XDEC+10 output
|
||||
LH R1,II ii
|
||||
BAL R14,SUBFACT subfact(ii)
|
||||
XDECO R0,PG+4 edit subfact(ii)
|
||||
XPRNT PG,16 print
|
||||
L R13,4(0,R13) restore previous savearea pointer
|
||||
LM R14,R12,12(R13) restore previous context
|
||||
XR R15,R15 rc=0
|
||||
BR R14 exit
|
||||
*------- ---- -------------------------------------------
|
||||
DERGEN EQU * dergen(n,fprt)
|
||||
ST R14,SAVEDG
|
||||
ST R1,N n
|
||||
ST R2,FPRT fprt
|
||||
IF LTR,R1,Z,R1 THEN if n=0 then
|
||||
LA R0,1 1
|
||||
B RETDG return(1)
|
||||
ENDIF , endif
|
||||
MVC C,=F'0' c=0
|
||||
LA R6,1 i=1
|
||||
DO WHILE=(C,R6,LE,N) do i=1 to 2
|
||||
LR R1,R6 i
|
||||
SLA R1,1
|
||||
STH R6,A-2(R1) a(i)=i
|
||||
STH R6,AO-2(R1) ao(i)=i
|
||||
LA R6,1(R6) i++
|
||||
ENDDO , enddo i
|
||||
L R1,N n
|
||||
BAL R14,FACT
|
||||
ST R0,FACTNM1 fact(n)-1
|
||||
SR R6,R6 i=0
|
||||
DO WHILE=(C,R6,LE,FACTNM1) do i=0 to fact(n)-1
|
||||
L R1,N n
|
||||
BAL R14,NEXTPER call nextper(n)
|
||||
MVI D,X'01' d=true
|
||||
LA R7,1
|
||||
DO WHILE=(C,R7,LE,N) do j=1 to n
|
||||
LR R1,R7 j
|
||||
SLA R1,1
|
||||
LH R2,A-2(R1) a(j)
|
||||
LH R3,AO-2(R1) ao(j)
|
||||
IF CR,R2,EQ,R3 THEN if a(j)=ao(j) then
|
||||
MVI D,X'00' d=false
|
||||
ENDIF , endif
|
||||
LA R7,1(R7) j++
|
||||
ENDDO , enddo j
|
||||
IF CLI,D,EQ,X'01' THEN if d then
|
||||
L R2,C c
|
||||
LA R2,1(R2) c+1
|
||||
ST R2,C c=c+1
|
||||
IF CLI,FPRT+3,EQ,X'01' THEN if fprt=1 then
|
||||
MVC PG,=CL80' ' clear buffer
|
||||
LA R10,PG pgi=0
|
||||
LA R7,1 j=1
|
||||
DO WHILE=(C,R7,LE,N) do j=1 to n
|
||||
LR R1,R7 j
|
||||
SLA R1,1
|
||||
LH R2,A-2(R1) a(j)
|
||||
XDECO R2,XDEC edit
|
||||
MVC 0(1,R10),XDEC+11 output
|
||||
LA R10,2(R10) pgi=pgi+2
|
||||
LA R7,1(R7) j++
|
||||
ENDDO , enddo j
|
||||
XPRNT PG,L'PG print
|
||||
ENDIF , endif
|
||||
ENDIF , endif
|
||||
LA R6,1(R6) i++
|
||||
ENDDO , enddo i
|
||||
L R0,C c
|
||||
B RETDG return(c)
|
||||
RETDG L R14,SAVEDG
|
||||
BR R14
|
||||
SAVEDG DS A
|
||||
*------- ---- -------------------------------------------
|
||||
NEXTPER EQU * nextper(nk)
|
||||
ST R14,SAVENP
|
||||
ST R1,NK nk
|
||||
BCTR R1,0 nk-1
|
||||
ST R1,NELEM nelem=nk-1
|
||||
IF C,R1,LT,=F'1' THEN if nelem<1 then
|
||||
LA R0,0 return(0)
|
||||
B RETNP
|
||||
ENDIF , endif
|
||||
L R8,NELEM nelem
|
||||
BCTR R8,0 pos=nelem-1
|
||||
LOOPW1 EQU * while a(pos+1)>=a(pos+2)
|
||||
LR R1,R8 pos
|
||||
SLA R1,1
|
||||
LH R2,A(R1) a(pos+1)
|
||||
CH R2,A+2(R1) if a(pos+1)<a(pos+2)
|
||||
BL ELOOPW1 then exit while
|
||||
BCTR R8,0 pos=pos-1
|
||||
IF LTR,R8,M,R8 THEN if pos<0 then
|
||||
LA R1,0 0
|
||||
L R2,NELEM nelem
|
||||
BAL R14,PERMREV call permrev(0,nelem)
|
||||
LA R0,0 return(0)
|
||||
B RETNP
|
||||
ENDIF , endif
|
||||
B LOOPW1 endwhile
|
||||
ELOOPW1 L R9,NELEM last=nelem
|
||||
LOOPW2 EQU * do while a(last+1)<=a(pos+1)
|
||||
LR R1,R9 last
|
||||
SLA R1,1
|
||||
LH R2,A(R1) a(last+1)
|
||||
LR R1,R8 pos
|
||||
SLA R1,1
|
||||
CH R2,A(R1) if a(last+1)>a(pos+1)
|
||||
BH ELOOPW2 then exit while
|
||||
BCTR R9,0 last=last-1
|
||||
B LOOPW2 endwhile
|
||||
ELOOPW2 LR R1,R8 pos
|
||||
SLA R1,1 *2
|
||||
LA R2,A(R1) @a(pos+1)
|
||||
LR R1,R9 last
|
||||
SLA R1,1
|
||||
LA R3,A(R1) @a(last+1)
|
||||
LH R0,0(R2) w=a(pos+1)
|
||||
MVC 0(2,R2),0(R3) a(pos+1)=a(last+1)
|
||||
STH R0,0(R3) a(last+1)=w
|
||||
LA R1,1(R8) pos+1
|
||||
L R2,NELEM nelem
|
||||
BAL R14,PERMREV call permrev(pos+1,nelem)
|
||||
RETNP L R14,SAVENP
|
||||
BR R14
|
||||
SAVENP DS A
|
||||
*------- ---- -------------------------------------------
|
||||
PERMREV EQU * permrev(firstix,lastix)
|
||||
LR R4,R1 xfirst
|
||||
LR R5,R2 xlast
|
||||
DO WHILE=(CR,R4,LT,R5) do while(xfirst<xlast)
|
||||
LR R1,R4 xfirst
|
||||
SLA R1,1 *2
|
||||
LA R2,A(R1) @a(xfirst+1)
|
||||
LR R1,R5 xlast
|
||||
SLA R1,1 *2
|
||||
LA R3,A(R1) @a(xlast+1)
|
||||
LH R0,0(R2) w=a(xfirst+1)
|
||||
MVC 0(2,R2),0(R3) a(xfirst+1)=a(xlast+1)
|
||||
STH R0,0(R3) a(xlast+1)=w
|
||||
LA R4,1(R4) xfirst=xfirst+1
|
||||
BCTR R5,0 xlast=xlast-1
|
||||
ENDDO , enddo
|
||||
BR R14
|
||||
*------- ---- ----------------------------------------
|
||||
FACT EQU * fact(n)
|
||||
IF C,R1,LE,=F'1' THEN if n<=1 then
|
||||
LA R0,1 return(1)
|
||||
ELSE , else
|
||||
LA R5,1 f=1
|
||||
LA R2,1 i=1
|
||||
DO WHILE=(CR,R2,LE,R1) do i=1 to n
|
||||
MR R4,R2 f*i
|
||||
LA R2,1(R2) i++
|
||||
ENDDO , enddo
|
||||
LR R0,R5 return(f)
|
||||
ENDIF , endif
|
||||
BR R14
|
||||
*------- ---- -------------------------------------------
|
||||
SUBFACT EQU * subfact(n)
|
||||
ST R1,NY n
|
||||
IF LTR,R1,Z,R1 THEN if n=0 then
|
||||
LA R0,1 return(1)
|
||||
ELSE , else
|
||||
LA R4,1 1
|
||||
ST R4,TT tt(0)=1
|
||||
ST R4,IY i=1
|
||||
DO WHILE=(C,R4,LE,NY) do i=1 to n
|
||||
L R4,IY i
|
||||
SRDA R4,32
|
||||
D R4,=F'2' i/2
|
||||
IF LTR,R4,Z,R4 THEN if i//2=0 then
|
||||
LA R0,1 nn=1
|
||||
ELSE , else
|
||||
L R0,=F'-1' nn=-1
|
||||
ENDIF , endif
|
||||
L R1,IY i
|
||||
SLA R1,2
|
||||
L R3,TT-4(R1) tt(i-1)
|
||||
M R2,IY *i
|
||||
AR R3,R0 +nn
|
||||
L R1,IY i
|
||||
SLA R1,2
|
||||
ST R3,TT(R1) tt(i)=i*tt(i-1)+nn
|
||||
L R4,IY i
|
||||
LA R4,1(R4) i++
|
||||
ST R4,IY i
|
||||
ENDDO , enddo
|
||||
L R1,NY n
|
||||
SLA R1,2
|
||||
L R0,TT(R1) return(tt(n))
|
||||
ENDIF , endif
|
||||
BR R14
|
||||
* ---- -------------------------------------------
|
||||
A DS 12H A work
|
||||
AO DS 12H A origin
|
||||
II DS H
|
||||
COUNT DS H
|
||||
N DS F
|
||||
FPRT DS F flag for printing
|
||||
C DS F
|
||||
D DS X boolean : a(i) different ao(i)
|
||||
FACTNM1 DS F fact(n)-1
|
||||
NK DS F n in nextper
|
||||
NELEM DS F n elements in nextper
|
||||
NY DS F n in subfact
|
||||
IY DS F i in subfact
|
||||
TT DS 13F tt(0:12)
|
||||
PG1 DC CL44'derangements for the numbers : 1 2 3 4 are :'
|
||||
PG2 DC CL38' table of n counted calculated :'
|
||||
PG3 DC CL36' ----------- ----------- -----------'
|
||||
XDEC DS CL12 temp for xdeco
|
||||
PG DC CL80' ' buffer
|
||||
YREGS
|
||||
END DERANGE
|
||||
|
|
@ -1,75 +0,0 @@
|
|||
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))
|
||||
|
|
@ -1,26 +0,0 @@
|
|||
Derangements for the numbers 0,1,2,3 are:
|
||||
1 0 3 2
|
||||
1 2 3 0
|
||||
1 3 0 2
|
||||
2 0 3 1
|
||||
2 3 0 1
|
||||
2 3 1 0
|
||||
3 0 1 2
|
||||
3 2 0 1
|
||||
3 2 1 0
|
||||
|
||||
Table of n, counted derangements, calculated derangements :
|
||||
0 1 1
|
||||
1 0 0
|
||||
2 1 1
|
||||
3 2 2
|
||||
4 9 9
|
||||
5 44 44
|
||||
6 265 265
|
||||
7 1854 1854
|
||||
8 14833 14833
|
||||
9 133496 133496
|
||||
|
||||
There is no long int in BBC BASIC!
|
||||
!20 = 8.95014632E17
|
||||
>
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
' version 08-04-2017
|
||||
' compile with: fbc -s console
|
||||
|
||||
Sub Subfactorial(a() As ULongInt)
|
||||
|
||||
Dim As ULong i
|
||||
Dim As ULongInt num
|
||||
|
||||
For i = 0 To UBound(a)
|
||||
num = num * i
|
||||
If (i And 1) = 1 Then
|
||||
num -= 1
|
||||
Else
|
||||
num += 1
|
||||
End If
|
||||
a(i) = num
|
||||
Next
|
||||
|
||||
End Sub
|
||||
|
||||
' Heap's algorithm non-recursive
|
||||
Function perms_derange(n As ULong, flag As Long = 0) As ULongInt
|
||||
' fast upto n < 12
|
||||
If n = 0 Then Return 1
|
||||
|
||||
Dim As ULong i, j, c1, count
|
||||
Dim As ULong a(0 To n -1), c(0 To n -1)
|
||||
|
||||
For j = 0 To n -1
|
||||
a(j) = j
|
||||
Next
|
||||
|
||||
While i < n
|
||||
If c(i) < i Then
|
||||
If (i And 1) = 0 Then
|
||||
Swap a(0), a(i)
|
||||
Else
|
||||
Swap a(c(i)), a(i)
|
||||
End If
|
||||
For j = 0 To n -1
|
||||
If a(j) = j Then j = 99
|
||||
Next
|
||||
If j < 99 Then
|
||||
count += 1
|
||||
If flag = 0 Then
|
||||
c1 += 1
|
||||
For j = 0 To n -1
|
||||
Print a(j);
|
||||
Next
|
||||
If c1 > 12 Then
|
||||
Print : c1 = 0
|
||||
Else
|
||||
Print " ";
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
c(i) += 1
|
||||
i = 0
|
||||
Else
|
||||
c(i) = 0
|
||||
i += 1
|
||||
End If
|
||||
Wend
|
||||
If flag = 0 AndAlso c1 <> 0 Then Print
|
||||
Return count
|
||||
|
||||
End Function
|
||||
|
||||
' ------=< MAIN >=------
|
||||
|
||||
Dim As ULong i, n = 4
|
||||
Dim As ULongInt subfac(20)
|
||||
|
||||
Subfactorial(subfac())
|
||||
|
||||
Print "permutations derangements for n = "; n
|
||||
i = perms_derange(n)
|
||||
Print "count returned = "; i; " , !"; n; " calculated = "; subfac(n)
|
||||
|
||||
Print
|
||||
Print "count counted subfactorial"
|
||||
Print "---------------------------"
|
||||
For i = 0 To 9
|
||||
Print Using " ###: ######## ########"; i; perms_derange(i, 1); subfac(i)
|
||||
Next
|
||||
For i = 10 To 20
|
||||
Print Using " ###: ###################"; i; subfac(i)
|
||||
Next
|
||||
|
||||
' empty keyboard buffer
|
||||
While InKey <> "" : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
|
|
@ -1,24 +1,33 @@
|
|||
import Control.Monad
|
||||
import Data.List
|
||||
import Control.Monad (forM_)
|
||||
|
||||
import Data.List (permutations)
|
||||
|
||||
-- Compute all derangements of a list
|
||||
derangements xs = filter (and . zipWith (/=) xs) $ permutations xs
|
||||
derangements
|
||||
:: Eq a
|
||||
=> [a] -> [[a]]
|
||||
derangements = (\x -> filter (and . zipWith (/=) x)) <*> permutations
|
||||
|
||||
-- Compute the number of derangements of n elements
|
||||
subfactorial
|
||||
:: (Eq a, Num a)
|
||||
=> a -> a
|
||||
subfactorial 0 = 1
|
||||
subfactorial 1 = 0
|
||||
subfactorial n = (n-1) * (subfactorial (n-1) + subfactorial (n-2))
|
||||
subfactorial n = (n - 1) * (subfactorial (n - 1) + subfactorial (n - 2))
|
||||
|
||||
main = do
|
||||
-- Generate and show all the derangements of four integers
|
||||
print $ derangements [1..4]
|
||||
main :: IO ()
|
||||
main
|
||||
-- Generate and show all the derangements of four integers
|
||||
= do
|
||||
print $ derangements [1 .. 4]
|
||||
putStrLn ""
|
||||
|
||||
-- Print the count of derangements vs subfactorial
|
||||
forM_ [1..9] $ \i ->
|
||||
putStrLn $ show (length (derangements [1..i])) ++ " " ++
|
||||
show (subfactorial i)
|
||||
forM_ [1 .. 9] $
|
||||
\i ->
|
||||
putStrLn $
|
||||
mconcat
|
||||
[show (length (derangements [1 .. i])), " ", show (subfactorial i)]
|
||||
putStrLn ""
|
||||
|
||||
-- Print the number of derangements in a list of 20 items
|
||||
print $ subfactorial 20
|
||||
|
|
|
|||
|
|
@ -0,0 +1,34 @@
|
|||
# v0.6
|
||||
|
||||
using Combinatorics
|
||||
|
||||
derangements(n::Int) = (perm for perm in permutations(1:n)
|
||||
if all(indx != p for (indx, p) in enumerate(perm)))
|
||||
|
||||
function subfact(n::Integer)::Integer
|
||||
if n in (0, 2)
|
||||
return 1
|
||||
elseif n == 1
|
||||
return 0
|
||||
elseif 1 ≤ n ≤ 18
|
||||
return round(Int, factorial(n) / e)
|
||||
elseif n > 0
|
||||
return (n - 1) * ( subfact(n - 1) + subfact(n - 2) )
|
||||
else
|
||||
error()
|
||||
end
|
||||
end
|
||||
|
||||
println("Derangements of [1, 2, 3, 4]")
|
||||
for perm in derangements(4)
|
||||
println(perm)
|
||||
end
|
||||
|
||||
@printf("\n%5s%13s%13s\n", "n", "derangements", "!n")
|
||||
for n in 1:10
|
||||
ders = derangements(n)
|
||||
subf = subfact(n)
|
||||
@printf("%5i%13i%13i\n", n, length(collect(ders)), subf)
|
||||
end
|
||||
|
||||
println("\n!20 = ", subfact(20))
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
// version 1.1.2
|
||||
|
||||
fun <T> permute(input: List<T>): List<List<T>> {
|
||||
if (input.size == 1) return listOf(input)
|
||||
val perms = mutableListOf<List<T>>()
|
||||
val toInsert = input[0]
|
||||
for (perm in permute(input.drop(1))) {
|
||||
for (i in 0..perm.size) {
|
||||
val newPerm = perm.toMutableList()
|
||||
newPerm.add(i, toInsert)
|
||||
perms.add(newPerm)
|
||||
}
|
||||
}
|
||||
return perms
|
||||
}
|
||||
|
||||
fun derange(input: List<Int>): List<List<Int>> {
|
||||
if (input.isEmpty()) return listOf(input)
|
||||
return permute(input).filter { permutation ->
|
||||
permutation.filterIndexed { i, index -> i == index }.none()
|
||||
}
|
||||
}
|
||||
|
||||
fun subFactorial(n: Int): Long =
|
||||
when (n) {
|
||||
0 -> 1
|
||||
1 -> 0
|
||||
else -> (n - 1) * (subFactorial(n - 1) + subFactorial(n - 2))
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val input = listOf(0, 1, 2, 3)
|
||||
|
||||
val derangements = derange(input)
|
||||
println("There are ${derangements.size} derangements of $input, namely:\n")
|
||||
derangements.forEach(::println)
|
||||
|
||||
println("\nN Counted Calculated")
|
||||
println("- ------- ----------")
|
||||
for (n in 0..9) {
|
||||
val list = List(n) { it }
|
||||
val counted = derange(list).size
|
||||
println("%d %-9d %-9d".format(n, counted, subFactorial(n)))
|
||||
}
|
||||
println("\n!20 = ${subFactorial(20)}")
|
||||
}
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
function deranged(sequence s1, sequence s2)
|
||||
for i=1 to length(s1) do
|
||||
if s1[i]==s2[i] then return 0 end if
|
||||
end for
|
||||
return 1
|
||||
end function
|
||||
|
||||
function derangements(integer n)
|
||||
sequence ts = tagset(n)
|
||||
sequence res = {}
|
||||
for i=1 to factorial(n) do
|
||||
sequence s = permute(i,ts)
|
||||
if deranged(s,ts) then
|
||||
res = append(res,s)
|
||||
end if
|
||||
end for
|
||||
return res
|
||||
end function
|
||||
|
||||
function subfactorial(integer n)
|
||||
if n<=0 then return 1 end if
|
||||
if n=1 then return 0 end if
|
||||
return (n-1)*(subfactorial(n-1)+subfactorial(n-2))
|
||||
end function
|
||||
|
||||
?derangements(4)
|
||||
for n=0 to 9 do
|
||||
printf(1,"%d: counted:%d, calculated:%d\n",{n,length(derangements(n)),subfactorial(n)})
|
||||
end for
|
||||
printf(1,"!20=%d (incorrect!)\n",{subfactorial(20)})
|
||||
include builtins\bigatom.e
|
||||
function ba_subfactorial(integer n)
|
||||
if n<=0 then return 1 end if
|
||||
if n=1 then return 0 end if
|
||||
return ba_multiply(n-1,ba_add(ba_subfactorial(n-1),ba_subfactorial(n-2)))
|
||||
end function
|
||||
ba_printf(1,"!20=%B (bigatom)\n",ba_subfactorial(20))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
fcn subFact(n){
|
||||
if(n==0) return(1);
|
||||
if(n==1) return(0);
|
||||
(n-1)*(self.fcn(n-1) + self.fcn(n-2));
|
||||
}
|
||||
|
||||
fcn derangements(n){
|
||||
// All deranged permutations of the integers 0..n-1 inclusive
|
||||
enum:=[0..n-1].pump(List);
|
||||
Utils.Helpers.permuteW(enum).filter('wrap(perm){
|
||||
perm.zipWith('==,enum).sum(0) == 0
|
||||
});
|
||||
}
|
||||
fcn derangers(n){ // just count # of derangements
|
||||
enum:=[0..n-1].pump(List);
|
||||
Utils.Helpers.permuteW(enum).reduce('wrap(sum,perm){
|
||||
sum + (perm.zipWith('==,enum).sum(0) == 0)
|
||||
},0);
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
println("Derangements of 0,1,2,3:\n",derangements(4));
|
||||
println("\nTable of n vs counted vs calculated derangements:");
|
||||
foreach n in (10){
|
||||
println("%2d %-6d %-6d".fmt(n, derangers(n), subFact(n)));
|
||||
}
|
||||
|
||||
n:=20; println("\n!%d = %d".fmt(n, subFact(n)));
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
fcn derangements(n){ //-->Walker
|
||||
enum:=[0..n-1].pump(List);
|
||||
Utils.Helpers.permuteW(enum).tweak('wrap(perm){
|
||||
if(perm.zipWith('==,enum).sum(0)) Void.Skip
|
||||
else perm
|
||||
});
|
||||
}
|
||||
fcn derangers(n){ // just count # of derangements, w/o saving them
|
||||
derangements(n).reduce('+.fpM("10-",1),0); // ignore perm --> '+(1,sum)...
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
foreach d in (derangements(4)){ println(d) }
|
||||
//rest of test code remains the same
|
||||
Loading…
Add table
Add a link
Reference in a new issue