Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

Try this.

Update: Corrected the rand() calls. It now produces all the possible derangements.

I'm not sure about the statistical performance. Ie. Whether all derangements are equally probably?

#! perl -slw use strict; use Data::Dump qw[ pp ]; $Data::Dump::MAX_WIDTH = 1000; sub derange { my $n = shift; my @x = 0 .. $n; for my $p ( 0 .. $#x ) { my $q = int( rand @x ); $q = int( rand @x ) while $x[ $q ] == $p or $x[ $p ] == $q; @x[ $p, $q ] = @x[ $q, $p ]; } return @x; } our $N ||= 10; our $S ||= 1e4; my @arrange = 0 .. $N; my %stats; for( 1.. $S ) { my @derange = @arrange[ derange( $#arrange ) ]; $arrange[ $_ ] == $derange[ $_ ] and warn "Bad at $_\n" for 0 .. $ +#arrange; ++$stats{ "@derange" }; # print "@arrange\n@derange"; } print "Unique derangements generated: " . keys %stats; pp \%stats if keys( %stats ) < 50; my %stats2; ++$stats2{ $_ } for values %stats; print "Distribution by number of occurances:\n", pp \%stats2 if keys( %stats2 ) < 50; __END__ c:\test>695750 -S=1e3 -N=2 Unique derangements generated: 2 { "1 2 0" => 651, "2 0 1" => 349 } Distribution by number of occurances: { 349 => 1, 651 => 1 } c:\test>695750 -S=1e4 -N=3 Unique derangements generated: 9 { "1 0 3 2" => 1854, "1 2 3 0" => 1744, "1 3 0 2" => 979, "2 0 3 1" => 1028, "2 3 0 1" => 1109, "2 3 1 0" => 1000, "3 0 1 2" => 585, "3 2 0 1" => 1016, "3 2 1 0" => 685 } Distribution by number of occurances: { 585 => 1, 685 => 1, 979 => 1, 1000 => 1, 1016 => 1, 1028 => 1, 1109 => 1, 1744 => 1, 1854 => 1 } c:\test>695750 -S=1e4 -N=4 Unique derangements generated: 44 { "1 0 3 4 2" => 551, "1 0 4 2 3" => 372, "1 2 0 4 3" => 504, "1 2 3 4 0" => 382, "1 2 4 0 3" => 259, "1 3 0 4 2" => 234, "1 3 4 0 2" => 322, "1 3 4 2 0" => 265, "1 4 0 2 3" => 132, "1 4 3 0 2" => 217, "1 4 3 2 0" => 230, "2 0 1 4 3" => 358, "2 0 3 4 1" => 269, "2 0 4 1 3" => 161, "2 3 0 4 1" => 347, "2 3 1 4 0" => 219, "2 3 4 0 1" => 204, "2 3 4 1 0" => 220, "2 4 0 1 3" => 263, "2 4 1 0 3" => 173, "2 4 3 0 1" => 227, "2 4 3 1 0" => 235, "3 0 1 4 2" => 175, "3 0 4 1 2" => 254, "3 0 4 2 1" => 160, "3 2 0 4 1" => 221, "3 2 1 4 0" => 239, "3 2 4 0 1" => 243, "3 2 4 1 0" => 226, "3 4 0 1 2" => 152, "3 4 0 2 1" => 166, "3 4 1 0 2" => 172, "3 4 1 2 0" => 124, "4 0 1 2 3" => 84, "4 0 3 1 2" => 157, "4 0 3 2 1" => 177, "4 2 0 1 3" => 137, "4 2 1 0 3" => 182, "4 2 3 0 1" => 258, "4 2 3 1 0" => 171, "4 3 0 1 2" => 162, "4 3 0 2 1" => 142, "4 3 1 0 2" => 131, "4 3 1 2 0" => 123 } Distribution by number of occurances: { 84 => 1, 123 => 1, 124 => 1, 131 => 1, 132 => 1, 137 => 1, 142 => 1, 152 => 1, 157 => 1, 160 => 1, 161 => 1, 162 => 1, 166 => 1, 171 => 1, 172 => 1, 173 => 1, 175 => 1, 177 => 1, 182 => 1, 204 => 1, 217 => 1, 219 => 1, 220 => 1, 221 => 1, 226 => 1, 227 => 1, 230 => 1, 234 => 1, 235 => 1, 239 => 1, 243 => 1, 254 => 1, 258 => 1, 259 => 1, 263 => 1, 265 => 1, 269 => 1, 322 => 1, 347 => 1, 358 => 1, 372 => 1, 382 => 1, 504 => 1, 551 => 1 } c:\test>695750 -S=1e5 -N=5 Unique derangements generated: 265 c:\test>695750 -S=1e5 -N=6 Unique derangements generated: 1854 c:\test>695750 -S=1e5 -N=7 Unique derangements generated: 14544 c:\test>695750 -S=1e6 -N=7 Unique derangements generated: 14833 c:\test>695750 -S=5e6 -N=8 Unique derangements generated: 133496 }

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

In reply to Re: Random Derangement Of An Array (Correct out-by-one error) by BrowserUk
in thread Random Derangement Of An Array by Limbic~Region

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others having an uproarious good time at the Monastery: (2)
    As of 2021-02-28 04:19 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?