Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
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 making s'mores by the fire in the courtyard of the Monastery: (12)
As of 2015-07-07 16:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (91 votes), past polls