June 2018 Update
This commit is contained in:
Ingy döt Net
parent
ba8067c3b7
commit
22f33d4004
5278 changed files with 84726 additions and 14379 deletions
|
|
@ -1,24 +1,15 @@
|
|||
sub is-derangement(List $l) {
|
||||
return not grep { $l[$_] == $_ }, 0..($l.elems - 1);
|
||||
sub derangements(@l) {
|
||||
@l.permutations.grep(-> @p { none(@p Zeqv @l) })
|
||||
}
|
||||
|
||||
# task 1
|
||||
sub derangements(Range $x) {
|
||||
$x.permutations.grep( *.&is-derangement )
|
||||
sub prefix:<!>(Int $n) {
|
||||
(1, 0, 1, -> $a, $b { ($++ + 2) × ($b + $a) } ... *)[$n]
|
||||
}
|
||||
|
||||
# task 2
|
||||
.say for (0..4).&derangements;
|
||||
say 'derangements([1, 2, 3, 4])';
|
||||
say derangements([1, 2, 3, 4]), "\n";
|
||||
|
||||
# task 3
|
||||
sub prefix:<!>(Int $x) {
|
||||
return +derangements(^$x);
|
||||
}
|
||||
|
||||
# task 4
|
||||
for ^9 -> $n {
|
||||
say "number: " ~ $n;
|
||||
say "count: " ~ !$n;
|
||||
say "derangements: ";
|
||||
.say for (0..$n-1).&derangements;
|
||||
say 'n == !n == derangements(^n).elems';
|
||||
for 0 .. 9 -> $n {
|
||||
say "!$n == { !$n } == { derangements(^$n).elems }"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,25 @@
|
|||
use ntheory ":all";
|
||||
|
||||
# Count derangements using derangement iterator
|
||||
sub countderange {
|
||||
my($n,$s) = (shift,0);
|
||||
forderange { $s++ } $n;
|
||||
$s;
|
||||
}
|
||||
# Count derangements using inclusion-exclusion
|
||||
sub subfactorial1 {
|
||||
my $n = shift;
|
||||
vecsum(map{ vecprod((-1)**($n-$_),binomial($n,$_),factorial($_)) }0..$n);
|
||||
}
|
||||
# Count derangements using simple recursion without special functions
|
||||
sub subfactorial2 {
|
||||
my $n = shift;
|
||||
use bigint; no warnings 'recursion';
|
||||
($n < 1) ? 1 : $n * subfactorial2($n-1) + (-1)**$n;
|
||||
}
|
||||
|
||||
print "Derangements of 4 items:\n";
|
||||
forderange { print "@_\n" } 4;
|
||||
printf "\n%3s %15s %15s\n","N","List count","!N";
|
||||
printf "%3d %15d %15d %15d\n",$_,countderange($_),subfactorial1($_),subfactorial2($_) for 0..9;
|
||||
printf "%3d %15s %s\n",$_,"",subfactorial2($_) for 20,200;
|
||||
|
|
@ -1,43 +1,42 @@
|
|||
/*REXX pgm generates all permutations of N derangements & subfactorial #*/
|
||||
numeric digits 1000 /*be able to handle big subfacts.*/
|
||||
parse arg N .; if N=='' then N=4 /*Not specified? Assume default*/
|
||||
d=derangementsSet(N) /*go & build the derangements set*/
|
||||
say d 'derangements for' N "items are:"
|
||||
/*REXX program generates all permutations of N derangements and subfactorial # */
|
||||
numeric digits 1000 /*be able to handle large subfactorials*/
|
||||
parse arg N .; if N=='' | N=="," then N=4 /*Not specified? Then use the default.*/
|
||||
d= derangeSet(N) /*go and build the derangements set. */
|
||||
say d 'derangements for' N "items are:"
|
||||
say
|
||||
do i=1 for d /*show derangements for N items.*/
|
||||
say right('derangement',22) right(i,length(d)) '───►' $.i
|
||||
do i=1 for d /*display the derangements for N items.*/
|
||||
say right('derangement', 22) right(i, length(d) ) '───►' $.i
|
||||
end /*i*/
|
||||
say /* [↓] count and calculate !L. */
|
||||
do L=0 to 9; d=derangementsSet(L)
|
||||
say L 'items: derangement count='right(d,6)", !"L'='right(!s(L),6)
|
||||
say /* [↓] count and calculate subfact !L.*/
|
||||
do L=0 to 2; d= derangeSet(L)
|
||||
say L 'items: derangement count='right(d, 6)", !"L'='right( !s(L), 6)
|
||||
end /*L*/
|
||||
say
|
||||
say right('!20=' , 40) !s( 20)
|
||||
say right('!100=', 40) !s(100)
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────!S subroutine───────────────────────*/
|
||||
!s: _=1; do j=1 for arg(1);if j//2 then _=-1+j*_;else _=1+j*_;end;return _
|
||||
/*──────────────────────────────────DERANGEMENTSSET subroutine──────────*/
|
||||
derangementsSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
|
||||
if x==0 then return 1; if x==1 then return 0
|
||||
/*populate the first derangement.*/
|
||||
@.1=2; @.2=1; do i=3 to x; @.i=i; end
|
||||
parse value @.p @.x with @.x @.p; call .buildD x /*swap & build.*/
|
||||
/*build others.*/
|
||||
do while .nextD(x,0); call .buildD x; end
|
||||
return #
|
||||
/*──────────────────────────────────.BUILDD subroutine──────────────────*/
|
||||
.buildD: do j=1 for arg(1); if @.j==j then return; end
|
||||
#=#+1; do j=1 for arg(1); $.#=$.# @.j; end; return
|
||||
/*──────────────────────────────────.NEXTD subroutine───────────────────*/
|
||||
.nextD: procedure expose @.; parse arg n,i; nm=n-1
|
||||
say right('!20=' , 22) !s( 20)
|
||||
say right('!200=', 22) !s(200)
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
!s: _=1; do j=1 for arg(1); if j//2 then _= j*_ - 1; else _=j*_ + 1
|
||||
end /*j*/; return _
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
derangeSet: procedure expose $.; parse arg x; $.=; #=0; p=x-1
|
||||
if x==0 then return 1; if x==1 then return 0
|
||||
@.1=2; @.2=1 /*populate 1st derangement.*/
|
||||
do i=3 to x; @.i=i; end /*i*/ /* " the rest of 'em.*/
|
||||
parse value @.p @.x with @.x @.p; call .buildD x /*swap & build.*/
|
||||
/*build others.*/
|
||||
do while .nextD(x, 0); call .buildD x; end; return #
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
.buildD: do j=1 for arg(1); if @.j==j then return; end
|
||||
#=#+1; do j=1 for arg(1); $.#= $.# @.j; end; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
.nextD: procedure expose @.; parse arg n,i
|
||||
|
||||
do k=nm by -1 for nm; kp=k+1; if @.k<@.kp then do; i=k; leave; end
|
||||
end /*k*/
|
||||
do k=n-1 by -1 for n-1; kp=k+1; if @.k<@.kp then do; i=k; leave; end
|
||||
end /*k*/
|
||||
|
||||
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end
|
||||
|
||||
if i==0 then return 0
|
||||
do j=i+1 while @.j<@.i; end
|
||||
parse value @.j @.i with @.i @.j
|
||||
return 1
|
||||
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1
|
||||
end /*j*/
|
||||
if i==0 then return 0
|
||||
do m=i+1 while @.m<@.i; end /*m*/ /* [↓] swap two values. */
|
||||
parse value @.m @.i with @.i @.m; return 1
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue