view release on metacpan or  search on metacpan

lib/Acme/Sort/Bogosort.pm  view on Meta::CPAN

package Acme::Sort::Bogosort;

use 5.010;

use strict;
use warnings;

use parent qw/Exporter/;
use Carp 'croak';

use List::Util qw/shuffle/;

our @EXPORT = qw/bogosort/;

our $VERSION = '0.05';



#   bogosort()
#   Usage:
#   Sort a list in standard string comparison order.
#
#   my @sorted = bogosort( @unsorted );
#
#   Sort a list in ascending numerical order:
#   sub compare { return $_[0] <=> $_[1] };
#   my @sorted = bogosort( \&compare, @unsorted );
#
#   Warning: Average case is O( (e-1) * n! ).
#   Warning: Worst case approaches O(INF).
#
#   bogosort() is exported automatically upon use.

sub bogosort {
    my $compare = ref( $_[0] ) =~ /CODE/ 
        ?   shift
        :   \&compare;
    return @_ if @_ < 2;
    my @list = @_;
    @list = shuffle( @list ) while not is_ordered( $compare, \@list );
    return @list;
}



# Internal use, not exported.  Verifies order based on $compare->().
sub is_ordered {
    my ( $compare, $listref ) = @_;
    ref( $compare ) =~ /CODE/ 
        or croak "is_ordered() expects a coderef as first arg.";
    ref( $listref ) =~ /ARRAY/
        or croak "is_ordered() expects an arrayref as second arg.";
    foreach( 0 .. $#{$listref} - 1 ) {
        return 0 
            if $compare->( $listref->[ $_ ], $listref->[ $_ + 1 ] ) > 0;
    }
    return 1;
}

# Default compare() is ascending standard string comparison order.
sub compare {
    croak "compare() requires two args."
        unless scalar @_ == 2;
    return $_[0] cmp $_[1];
}


=head1 NAME