Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

That weird shuffle sort (or desort might be a better term) does amazingly well on speed, and surprisingly, under at least some circumstances can actually also produce all possible combinations. Analyzing the distribution shows it real weakness. The story being told by the standard deviation figures below.

thraxil and aristotles corrected forms do much here, but at the expense of the loss of speed. I didn't see japhy's version till my tests were complete so I haven't included it.

However, a well crafted Fischer-Yates shuffles out does both of the "random sort" solutions for sheer performance by a good margin, being twice as fast with with arrays of 1000 elements and nearly 5 times as fast once you get to 100,000 elements.

It also seems to do the best on the distribution test, but that maybe simply down to the random number generator rather then the algorithm. That's too deep statistical voodoo for me to determine.

Update: Forgot to mention, the Fischer-Yates is an in-place sort so minimum memory usage too.

#!/usr/bin/perl -w use strict; use Benchmark qw(cmpthese); use Data::Dumper; sub xform { map {$_->[0]} sort { $a->[1] <=> $b->[1]} map {[$_, rand(1)]} @_; } sub slice { my @random; push @random, rand 1 for 0 .. $#_; @_[ sort { $random[$a] <=> $random[$b] } 0 .. $#_ ]; } sub shufl { $a = $_ + rand @_ - $_ and @_[$_, $a] = @_[$a, $_] for (0..$#_); return @_; } sub qshuf { sort { .5 <=> rand(1) } @_; } my @array = 1 .. 1000; cmpthese(10, { slice => sub { slice @array }, xform => sub { xform @array }, shufl => sub { shufl @array }, qshuf => sub { qshuf @array }, }); my (%buckets, %d, @temp);; my @set = qw(A B C D); for (1 .. 100_000 ) { $buckets{"@{[slice @temp=@set]}"}{slice}++; $buckets{"@{[xform @temp=@set]}"}{xform}++; $buckets{"@{[shufl @temp=@set]}"}{shufl}++; $buckets{"@{[qshuf @temp=@set]}"}{qshuf}++; } print "\npermutation | slice | xform | shufl | qshuf \n"; print "--------------------------------------------------\n"; for my $key (sort keys %buckets) { printf "%8.8s: | %4d | %4d | %4d | %4d\n", $key, $buckets{$key}{slice}, $buckets{$key}{xform}, $buckets{$key}{shufl}, $buckets{$key}{qshuf}; $d{slice}{Ex} += $buckets{$key}{slice}; $d{slice}{Ex2} += $buckets +{$key}{slice}**2; $d{xform}{Ex} += $buckets{$key}{xform}; $d{xform}{Ex2} += $buckets +{$key}{xform}**2; $d{shufl}{Ex} += $buckets{$key}{shufl}; $d{shufl}{Ex2} += $buckets +{$key}{shufl}**2; $d{qshuf}{Ex} += $buckets{$key}{qshuf}; $d{qshuf}{Ex2} += $buckets +{$key}{qshuf}**2; } print "---------------------------------------------------\n"; printf "Std. Dev. | %0.3f | %0.3f | %0.3f | %0.3f\n", sqrt( ($d{slice}{Ex2} - ($d{slice}{Ex}**2/24))/23 ), sqrt( ($d{xform}{Ex2} - ($d{xform}{Ex}**2/24))/23 ), sqrt( ($d{shufl}{Ex2} - ($d{shufl}{Ex}**2/24))/23 ), sqrt( ($d{qshuf}{Ex2} - ($d{qshuf}{Ex}**2/24))/23 ); __END__ C:\test>199981 Benchmark: timing 10000 iterations of qshuf, shufl, slice, xform... qshuf: 3 wallclock secs ( 3.04 usr + 0.01 sys = 3.04 CPU) @ 32 +84.07/s (n=10000) shufl: 217 wallclock secs (209.08 usr + 0.01 sys = 209.09 CPU) @ + 47.83/s (n=10000) slice: 435 wallclock secs (429.57 usr + 0.01 sys = 429.58 CPU) @ + 23.28/s (n=10000) xform: 716 wallclock secs (693.68 usr + 0.00 sys = 693.68 CPU) @ + 14.42/s (n=10000) Rate xform slice shufl qshuf xform 14.4/s -- -38% -70% -100% slice 23.3/s 61% -- -51% -99% shufl 47.8/s 232% 105% -- -99% qshuf 3284/s 22681% 14008% 6767% -- permutation | slice | xform | shufl | qshuf -------------------------------------------------- A B C D: | 4322 | 4277 | 4127 | 12320 A B D C: | 4127 | 4115 | 4143 | 6134 A C B D: | 4284 | 4185 | 4156 | 6430 A C D B: | 4246 | 4083 | 4272 | 3094 A D B C: | 4205 | 4192 | 4062 | 3167 A D C B: | 4182 | 4128 | 4125 | 1597 B A C D: | 4143 | 4287 | 4246 | 12478 B A D C: | 4146 | 4156 | 4154 | 6273 B C A D: | 4027 | 4133 | 4133 | 6354 B C D A: | 4171 | 4153 | 4163 | 3092 B D A C: | 4191 | 4128 | 4201 | 3170 B D C A: | 4187 | 4233 | 4143 | 1546 C A B D: | 4088 | 4163 | 4170 | 6217 C A D B: | 4044 | 4197 | 4127 | 3190 C B A D: | 4214 | 4228 | 4114 | 6261 C B D A: | 4169 | 4021 | 4260 | 3080 C D A B: | 4069 | 4075 | 4185 | 1480 C D B A: | 4120 | 4102 | 4185 | 1533 D A B C: | 4177 | 4151 | 4199 | 3037 D A C B: | 4248 | 4207 | 4198 | 1608 D B A C: | 4175 | 4252 | 4203 | 3087 D B C A: | 4135 | 4173 | 4198 | 1641 D C A B: | 4203 | 4157 | 4098 | 1620 D C B A: | 4127 | 4204 | 4138 | 1591 --------------------------------------------------- Std. Dev. | 70.671 | 64.372 | 50.640 | 3127.055

Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!

In reply to Re: When the Best Solution Isn't by BrowserUk
in thread When the Best Solution Isn't by sauoq

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



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (5)
As of 2024-03-28 20:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found