Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Sort::LOH

by ignatz (Vicar)
on Jul 22, 2002 at 23:28 UTC ( #184288=sourcecode: print w/ replies, xml ) Need Help??

Category: Text Processing
Author/Contact Info ignatz
Description: Takes in a LOH (List of Hashes) and an array of keys to sort by and returns a new, sorted LOH. This module closely relates to Sort::Fields. in terms of it's interface and how it does things. One of it's main differences is that it is OO, so one can create a Sort::LOH object and perform multiple sorts on it.

Comments and hash criticism are most welcome. I tried to find something here or on CPAN that did this, but the closest that I got was Sort::Fields. Close, but no cigar. Perhaps there is some simple way to do this with a one liner. Even so, it was fun and educational to write.

package Sort::LOH;

use strict;
use Carp;

use vars qw($VERSION);
$VERSION = '0.01';

######################################################################
+#####
# D O C U M E N T A T I O N

=head1 NAME

Sort::LOH - Sorter for List of Hashes

=head1 SYNOPSIS

    use strict;
    use Sort::LOH;
    my @SAMPLE_DATA = (
        {F1 => "1", F2 => "2",  F3 => "3",   
            FLOAT => "2",    ST => "123 Main Street"},
        {F1 => "2", F2 => "3",  F3 => "4",   
            FLOAT => "9",    ST => "45 Main Street",},
        {F1 => "3", F2 => "4",  F3 => "4",   
            FLOAT => "045",  ST => "2459 Main St"},
        {F1 => "4", F2 => "5",  F3 => "6",   
            FLOAT => "1.3",  ST => "2580 Main Street"},
        {F1 => "5", F2 => "6",  F3 => "7",   
            FLOAT => "9",    ST => "39 Main Street"},
        {F1 => "6", F2 => "7",  F3 => "8",   
            FLOAT => "8.8",  ST => "1888 Main Street"}
    );

    my $sorter = Sort::LOH->new(\@LOH);
    my @sorted = $sorter->sortMe(["F3", "ST"]);

Sorting in reverse order:
    
    my @sorted = $sorter->sortMe(["-F3", "-ST"]);
    
Sorting numerically, as opposed to the default alphabetical:

    my @sorted = $sorter->sortMe(["FLOAT n"]);


=head1 DESCRIPTION

Takes in a LOH (List of Hashes) and an array of keys to sort
by and returns a new, sorted LOH. This module closely relates
to Sort::Fields in terms of it's interface how it does things.
On of it's main differences is that it is OO, so one can create
a Sort::LOH object and perform multiple sorts on it.

=cut

=head1 PUBLIC METHODS

=cut

# D O C U M E N T A T I O N
######################################################################
+#####

######################################################################
+#####
# C O N S T R U C T O R

=head2 new(\@LOH_to_sort) 

The class constructor. To create a Sort::LOH object, simply call:
    
    my $sorter = Sort::LOH->new(\@LOH);

=cut

sub new
{
    my $class = shift;
    my $self  = {};
    bless $self, $class;
    
    unless (ref($self->{LOH} = shift) eq 'ARRAY') {
        croak 'LOH needs a reference to a List of Hashes';
    }
    
    $self->{SORT_BY} = undef;
    return $self;
}

# C O N S T R U C T O R
######################################################################
+#####

######################################################################
+#####
# S T A T I C   M E T H O D S

=head2 element_class() 

The name of the class for use in calling methods. This is a trick to 
simplify inheritance of static factory methods that I got from Perlmon
+ks:
http://www.perlmonks.org/index.pl?node_id=74924 Inheriting classes wou
+ld 
create override element_class with the name of their class.

=cut

sub element_class
{
    return "Sort::LOH";
}

=head2 static(@sort_by, \@LOH_to_sort)

A static method that allows caller to make the class do all the work 
with one swell foop:

    my @sorted = Sort::LOH->static(["F1", "F2"], \@SAMPLE_DATA);

as opposed to
    
    my $sorter = Sort::LOH->new(\@LOH);
    my @sorted = $sorter->sortMe(["F1", "F2"]);

If caller wants to do multiple sorts, one should use the constructor, 
+and
create a Sort::LOH object, since then one only has to pass in the data
+ once:

    my $sorter  = Sort::LOH->new(\@LOH);
    my @sorted  = $sorter->sortMe(["F1", "F2"]); 
    my @revSort = $sorter->sortMe(["-F1", "-F2"]); 

=cut

sub static
{
    my $self    = shift;
    my @sortby  = shift || croak 'USAGE: Sort::LOH->factory(@LIST, \@L
+OH)';
    my @loh     = shift || croak 'Sort::LOH::factory() needs 2 args';

    my $sorter = $self->element_class()->new(@loh); 
    return $sorter->sortMe(@sortby);
}

# S T A T I C   M E T H O D S
######################################################################
+#####

######################################################################
+#####
# C L A S S   M E T H O D S

=head2 sortMe(@sort_by)

The workhorse of this class. Expects a list of the LOH keys to determi
+ne
the sort order for the returned LOH. 

    my @sorted = $sorter->sortMe(["F1", "F2"]);

It is possible to do a reverse sort for a particular key by placing a 
+minus 
sign at the front of it:

    my @sorted = $sorter->sortMe(["-F1", "-F2"]);

If one wants to do a numeric sort, instead of a alphabetical sort, pla
+ce 
" n" after the key in the list:

    my @sorted = $sorter->sortMe(["F1 n", "F2 n"]);

=cut

sub sortMe
{
    my $self  = shift;
    $self->{SORT_BY} = shift || croak 'LOH needs a list of fields to s
+ort by';
    my (@sortcode, @sortedLOH);

    for (@{$self->{SORT_BY}}) {

        unless (/^-?\w+\s*n?$/) {
            croak "improperly formatted sort column specifier '$_'";
        }
        
        # Logic from Sort::Fields
        # Set a and b depending on '-' flag at the start of a key
        my ($a, $b) = /^-/ ? qw(b a) : qw(a b);
        
        # Is it a string or numeric sort?
        my $op = /\s+n$/ ? '<=>' : 'cmp';
        
        # Get the actual column name
        my ($col) = /^-?(\w+)/;

        # Make sure that the sort key being passed in exists.
        if (exists($self->{LOH}[0]{$col})) {
            push @sortcode, "\$${a}->{${col}} $op \$${b}->{${col}}";
        }
    }

    # Croak if there were no valid sort keys specified.
    unless ($sortcode[0]) {
        croak "No valid key match to sort LOH.";
    }
    
    my $sortcode = join " or ", @sortcode;
    $sortcode = "sort { $sortcode } \@{\$self->{LOH}};";

    @sortedLOH = eval "$sortcode";

    if ($@) {
        croak "Sort Failure of LOH\n$@";
    }

    return @sortedLOH;
}

# C L A S S   M E T H O D S
######################################################################
+#####

1;

__END__

=head1 BUGS

=over

=item *

When a LOH is passed in that has a key that isn't present in each
row in the list, and the class is sorted on that key, sort will print
out errors for comparing with undefined values. For instance:

    my @the_data = (
        {ID => "a", CITY => "f1 f"},
        {ID => "b", CITY => "f2 a"},
        {ID => "c"},
        {ID => "f", CITY => "f6 e"}
    );

    my $lohSorter   = Sort::LOH->new(\@the_data);
    my @sorted      = $lohSorter->sortMe(["CITY"]);

Making sure that each key has an empty string as a defined value will 
solve this:

    my @better_data = (
        {ID => "a", CITY => "f1 f"},
        {ID => "b", CITY => "f2 a"},
        {ID => "c", CITY => ""},
        {ID => "f", CITY => "f6 e"}
    );

I haven't figured out a way to trap this error as of yet.

=back

=head1 SUPPORT

The author always welcomes your comments, critiques, suggestions or 
requests.

=head1 AUTHOR

Christopher Baker
<ignatz@ignatzmouse.com>

http://www.ignatzmouse.com

=head1 COPYRIGHT

Copyright (c) 2002 Christopher Baker. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=head1 SEE ALSO

Sort::File, Data::Table

=cut

Comment on Sort::LOH
Download Code
Re: Sort::LOH
by ignatz (Vicar) on Jul 22, 2002 at 23:41 UTC
    Here's the test script (as if you cared) that I'm using on this sucka:
    package Sort::Test::LOH_test; use strict; use base qw(Test::Unit::TestCase); my @SAMPLE_DATA = ( {ID => "a1 a", F_NAME => "asd b1 b", L_NAME => "ggfsdf +c1 c", STREET => "5", ADDRESS => "2", CITY => "f1 f"}, {ID => "a2 b", F_NAME => "zxczxc b2 c", L_NAME => "sdvwevc +2 d", STREET => "2", ADDRESS => "9", CITY => "f2 a"}, {ID => "a3 c", F_NAME => "cdaer b3 d", L_NAME => "sdfwbbf + c3 e", STREET => "4", ADDRESS => "045", CITY => "f3 b"}, {ID => "a4 d", F_NAME => "aaaa asdafsdf b4 e", L_NAME => "asdferw +v c6 b", STREET => "4", ADDRESS => "1.3", CITY => "f4 c"}, {ID => "a5 e", F_NAME => "vdasdvqd43 b5 f", L_NAME => "aaaaa c +5 a", STREET => "1", ADDRESS => "9", CITY => "f5 d"}, {ID => "a6 f", F_NAME => "eee ecasd b6 a", L_NAME => "asdferw +v c6 b", STREET => "6", ADDRESS => "8.8", CITY => "f6 e"} ); my @WACKY_DATA = ( {ID => "a1 a", NAMES => ["BOB", "ELLEN"], STREET => "5", + ADDRESS => "2", CITY => "f1 f"}, {ID => "a2 b", NAMES => ["SUE", "ROB"], STREET => [@SAMPLE_DAT +A], ADDRESS => "9", CITY => "f2 a"}, {ID => "a3 c", NAMES => ["JOHN", "JANE"], STREET => "4", + ADDRESS => "045", CITY => "f3 b"}, {ID => "a4 d", NAMES => ["LOUIS", "ELLA"], STREET => "4", + ADDRESS => "1.3", CITY => "f4 c"}, {ID => "a5 e", NAMES => ["RICK", "MARK"], STREET => "1", + ADDRESS => "9", CITY => "f5 d"}, {ID => "a6 f", NAMES => ["IGNATZ", "CRAZY"],STREET => "6", + ADDRESS => "8.8", CITY => "f6 e"} ); sub test_lohsorter { my $self = shift; my $lohSorter = Sort::LOH->new(\@SAMPLE_DATA); my @sorted = $lohSorter->sortMe(["L_NAME", "F_NAME"]); $self->assert($sorted[0]{CITY} eq "f5 d", "Test ALPHA on L_NAME"); $self->assert($sorted[2]{CITY} eq "f6 e"); $self->assert($sorted[5]{CITY} eq "f2 a"); @sorted = $lohSorter->sortMe(["-L_NAME", "F_NAME"], "Test inverted + prime ALPHA with sub not inverted on L_NAME"); $self->assert($sorted[4]{CITY} eq "f6 e"); @sorted = $lohSorter->sortMe(["STREET n"]); $self->assert($sorted[1]{CITY} eq "f2 a", "Test ALPHA on STREET"); @sorted = $lohSorter->sortMe(["-STREET n"]); $self->assert($sorted[1]{CITY} eq "f1 f", "Test inverted ALPHA on +STREET"); @sorted = $lohSorter->sortMe(["ADDRESS"]); $self->assert($sorted[0]{CITY} eq "f3 b", "Test ALPHA on ADDRESS") +; # Test one row to make sure that all the fields are intact. $self->assert($sorted[1]{ID} eq "a4 d"); $self->assert($sorted[1]{F_NAME} eq "aaaa asdafsdf b4 e"); $self->assert($sorted[1]{L_NAME} eq "asdferwv c6 b"); $self->assert($sorted[1]{STREET} eq "4"); $self->assert($sorted[1]{ADDRESS} eq "1.3"); $self->assert($sorted[1]{CITY} eq "f4 c"); $self->assert($sorted[2]{CITY} eq "f1 f"); $self->assert($sorted[3]{CITY} eq "f6 e"); $self->assert($sorted[4]{CITY} eq "f2 a"); $self->assert($sorted[5]{CITY} eq "f5 d"); @sorted = $lohSorter->sortMe(["-ADDRESS n"]); $self->assert($sorted[0]{CITY} eq "f3 b", "Test inverted NUMERIC o +n ADDRESS"); $self->assert($sorted[3]{CITY} eq "f6 e"); $self->assert($sorted[4]{CITY} eq "f1 f"); $self->assert($sorted[5]{CITY} eq "f4 c"); } sub test_factory { my $self = shift; my @sorted = Sort::LOH->static(["L_NAME", "F_NAME"], \@SAMPLE_DATA +); $self->assert($sorted[0]{CITY} eq "f5 d", "Test of factory method +with ALPHA on L_NAME"); $self->assert($sorted[2]{CITY} eq "f6 e"); $self->assert($sorted[5]{CITY} eq "f2 a"); } sub test_wacky_data { my $self = shift; my $sorter = Sort::LOH->new(\@WACKY_DATA); my @sorted = $sorter->sortMe(["-ID", "F_NAME"]); $self->assert($sorted[0]{CITY} eq "f6 e", "Wacky data test with re +verse ALPHA on ID and bad field call."); } 1;
    ()-()
     \"/
      `                                                     
    
Re: Sort::LOH
by zentara (Archbishop) on Jul 23, 2002 at 19:59 UTC
    I couldn't get your test package to work, so I made a little
    test script of my own which is more "straight-forward",
    and some more "realistic data".
    It sorts as advertised.
    I'm not real good at dereferencing but I worked out a little
    routine that will print out the sort results, and will dereference
    the arrays and hashes that are returned automatically.
    I hate it when you print out results, and get HASH019283474
    or ARRAY1234234.
    my LOH.pm test
    ##############################################
    #!/usr/bin/perl use warnings; use strict; use Sort::LOH; my @SAMPLE_DATA = ( {ID => "a1 a", F_NAME => "asd b1 b", L_NAME => "ggfsdfc1 c" +, STREET => "5", {ID => "a2 b", F_NAME => "zxczxc b2 c", L_NAME => "sdvwevc2 d" +, STREET => "2", {ID => "a3 c", F_NAME => "cdaer b3 d", L_NAME => "sdfwbbfc3 e +", STREET => "4", {ID => "a4 d", F_NAME => "aaaa asdafsdf b4 e", L_NAME => "asdferwv c6 + b", STREET => "4", {ID => "a5 e", F_NAME => "vdasdvqd43 b5 f", L_NAME => "aaaaa c5 a" +, STREET => "1", {ID => "a6 f", F_NAME => "eee ecasd b6 a", L_NAME => "asdferwv c6 + b", STREET => "6", ); my @WACKY_DATA = ( {ID => "a1 a", NAMES => ["BOB", "ELLEN"], STREET => "2nd Ave.", ADDRESS => "2", CITY => "Detroit"}, {ID => "a2 b", NAMES => ["SUE", "ROB"], STREET => [home=>"Birdview + Lane",vacation=>"Lake George Circle"], ADDRESS => [home=>"9",vacation=>"20"], CITY => "Lake George"}, {ID => "a3 c", NAMES => ["JOHN", "JANE"], STREET => "1rst", ADDRESS => "1045", CITY => "Lansing"}, {ID => "a4 d", NAMES => ["LOUIS", "ELLA"], STREET => "Silvery Lane", ADDRESS => "13", CITY => "Macon"}, {ID => "a5 e", NAMES => ["RICK", "MARK"], STREET => "Plaza Center", ADDRESS => "9", CITY => "Albany"}, {ID => "a6 f", NAMES => ["IGNATZ", "CRAZY"],STREET => "6th Street", ADDRESS => "66", CITY => "Wackoville"} ); ###################################################################### +######## my $lohSorter = Sort::LOH->new(\@SAMPLE_DATA); my @sorted = $lohSorter->sortMe(["STREET"]); #print "@sorted\n"; foreach my $href(@sorted){ print "########################################\n"; foreach my $key (keys %$href){ print "$key ---> ${$href}{$key}\n"; } print "########################################\n"; } ###################################################################### +######## print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +\n"; ###################################################################### +### my $lohSorter1 = Sort::LOH->new(\@WACKY_DATA); my @sorted1 = $lohSorter1->sortMe(["ADDRESS"]); #print "@sorted1\n"; foreach my $href1(@sorted1){ # print Dumper(%$_); print "########################################\n"; foreach my $key (keys %$href1){ if (${$href1}{$key} =~ /ARRAY/) {print "$key --->@{${$href1}{$key}}\n"} elsif (${$href1}{$key} =~ /HASH/) {print "$key --->${${$href1}{$key}}\n"} else {print "$key ---> ${$href1}{$key}\n"} } print "########################################\n"; }
      Thanks for that!

      I haven't worked out the best way to sort out tests and stuff under Perl. Right now I just put it in ~perl/site/lib/Sort/Test/LOH_test.pm and calling it with:

      use Test::Unit::TestRunner; my $testrunner = Test::Unit::TestRunner->new(); $testrunner->start("Sort::Test::LOH_test");
      This isn't the best way to do things I'm sure. Part of packaging it up into a standard package install will be getting the tests to run with $> make test. In future I'll have to organize things like that from the start.
      ()-()
       \"/
        `                                                     
      

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://184288]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (11)
As of 2014-12-19 22:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (93 votes), past polls