September Morn Update
This commit is contained in:
Ingy döt Net
parent
4e2d22a71d
commit
aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
1
Task/Permutations-Derangements/00META.yaml
Normal file
1
Task/Permutations-Derangements/00META.yaml
Normal file
|
|
@ -0,0 +1 @@
|
|||
--- {}
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
(ns derangements.core
|
||||
(:require [clojure.set :as s]))
|
||||
|
||||
(defn subfactorial [n]
|
||||
(case n
|
||||
0 1
|
||||
1 0
|
||||
(* (dec n) (+ (subfactorial (dec n)) (subfactorial (- n 2))))))
|
||||
|
||||
(defn no-fixed-point
|
||||
"f : A -> B must be a biyective function written as a hash-map, returns
|
||||
all g : A -> B such that (f(a) = b) => not(g(a) = b)"
|
||||
[f]
|
||||
(case (count f)
|
||||
0 [{}]
|
||||
1 []
|
||||
(let [g (s/map-invert f)
|
||||
a (first (keys f))
|
||||
a' (f a)]
|
||||
(mapcat
|
||||
(fn [b'] (let [b (g b')
|
||||
f' (dissoc f a b)]
|
||||
(concat (map #(reduce conj % [[a b'] [b a']])
|
||||
(no-fixed-point f'))
|
||||
(map #(conj % [a b'])
|
||||
(no-fixed-point (assoc f' b a'))))))
|
||||
(filter #(not= a' %) (keys g))))))
|
||||
|
||||
(defn derangements [xs]
|
||||
{:pre [(= (count xs) (count (set xs)))]}
|
||||
(map (fn [f] (mapv f xs))
|
||||
(no-fixed-point (into {} (map vector xs xs)))))
|
||||
|
||||
(defn -main []
|
||||
(do
|
||||
(doall (map println (derangements [0,1,2,3])))
|
||||
(doall (map #(println (str (subfactorial %) " " (count (derangements (range %)))))
|
||||
(range 10)))
|
||||
(println (subfactorial 20))))
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
USING: combinators formatting io kernel math math.combinatorics
|
||||
prettyprint sequences ;
|
||||
IN: rosetta-code.derangements
|
||||
|
||||
: !n ( n -- m )
|
||||
{
|
||||
{ 0 [ 1 ] }
|
||||
{ 1 [ 0 ] }
|
||||
[ [ 1 - !n ] [ 2 - !n + ] [ 1 - * ] tri ]
|
||||
} case ;
|
||||
|
||||
: derangements ( n -- seq )
|
||||
<iota> dup [ [ = ] 2map [ f = ] all? ] with
|
||||
filter-permutations ;
|
||||
|
||||
"4 derangements" print 4 derangements . nl
|
||||
"n count calc\n= ====== ======" print
|
||||
10 <iota> [
|
||||
dup [ derangements length ] [ !n ] bi
|
||||
"%d%8d%8d\n" printf
|
||||
] each nl
|
||||
"!20 = " write 20 !n .
|
||||
|
|
@ -18,8 +18,7 @@ function derangements(integer n)
|
|||
end function
|
||||
|
||||
function subfactorial(integer n)
|
||||
if n<=0 then return 1 end if
|
||||
if n=1 then return 0 end if
|
||||
if n<2 then return 1-n end if
|
||||
return (n-1)*(subfactorial(n-1)+subfactorial(n-2))
|
||||
end function
|
||||
|
||||
|
|
@ -27,11 +26,19 @@ end function
|
|||
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)))
|
||||
string msg = iff(machine_bits()=32?" (incorrect on 32-bit!)":"") -- (fine on 64-bit)
|
||||
printf(1,"!20=%d%s\n",{subfactorial(20),msg})
|
||||
|
||||
include mpfr.e
|
||||
function mpz_sub_factorial(integer n)
|
||||
-- probably not the most efficient way to do this!
|
||||
if n<2 then return sprintf("%d",{1-n}) end if
|
||||
mpz f = mpz_init(mpz_sub_factorial(n-1)),
|
||||
g = mpz_init(mpz_sub_factorial(n-2))
|
||||
mpz_add(f,f,g)
|
||||
mpz_mul_si(f,f,n-1)
|
||||
string res = mpz_get_str(f)
|
||||
{f,g} = mpz_free({f,g})
|
||||
return res
|
||||
end function
|
||||
ba_printf(1,"!20=%B (bigatom)\n",ba_subfactorial(20))
|
||||
printf(1,"!20=%s (mpfr)\n",{mpz_sub_factorial(20)})
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
include mpfr.e
|
||||
|
||||
function subfactorial(integer n)
|
||||
sequence res = repeat(0,n)
|
||||
mpz num = mpz_init(1)
|
||||
|
||||
for i=1 to n do
|
||||
mpz_mul_si(num,num,i)
|
||||
if mpz_odd(num) then
|
||||
mpz_sub_ui(num,num,1)
|
||||
else
|
||||
mpz_add_ui(num,num,1)
|
||||
end if
|
||||
res[i] = mpz_get_str(num)
|
||||
-- res[i] = mpz_init_set(num)
|
||||
end for
|
||||
return res
|
||||
end function
|
||||
|
||||
?extract(subfactorial(20),tagset(9)&20)
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue