This should do it:

use strict;
use warnings;
use Data::Dumper;


my @things_to_sort = (
                   { author => 'bart', title => 'skateboarding' },
                   { author => 'lisa', title => 'postmodernism' },
                   { author => 'marge', title => 'hairstyles' },
                   { author => 'lisa', title => 'THIS BOOK FIRST' },
                   { author => 'homer', title => 'donuts' },
                   { author => 'bart', title => 'coolness' }
                  );



my @sorted = sort {
         $a->{title}  eq  "THIS BOOK FIRST" && -1
     or  $b->{title}  eq  "THIS BOOK FIRST" &&  1 
     or  $a->{author} cmp $b->{author}
     or  $a->{title}  cmp $b->{title}
} @things_to_sort;

print Dumper \@sorted;

Re^2: Twisted sort requirements

forrest

created: 2006-02-01 02:25:58

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

That's the kind of thing I'm looking for, but you've missed the part of the requirement that after I get "THIS BOOK FIRST" I need all books by the same author to follow immediately after that (and finally the rest).

I guess that might not be possible with a simple sort call.

Re^3: Twisted sort requirements

davido

created: 2006-02-01 02:35:08

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

It is possible. I graff kindly /msg'ed me to let me know I missed a specification. I'll post an update in this node in a few minutes.

Dave

Re^4: Twisted sort requirements

davido

created: 2006-02-01 03:31:59

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

I'm choosing to follow up to my own node, because I believe the lesson learned is worth repeating for the benefit of others who may find the pitfall that tripped me up.

The problem with my above code is that $author doesn't get set right away; it takes a few [doc://sort] comparison iterations before $author gets set, and by then the order has already began to take shape. This resulted in one of the "lisa" entries being stranded near the bottom of the list, when it needed to find its way up to the top of the list. The solution is (as [BrowserUk] already pointed out further down in this thread, but which I errantly believed was unnecessary) to predetermine who the key author is, before starting the [doc://sort] routine. The following code does finally work, and is ready to be tidied up into a more Perlish format:

use strict;
use warnings;
use Data::Dumper;


my @things_to_sort = (
                   { author => 'bart', title => 'skateboarding' },
                   { author => 'lisa', title => 'postmodernism' },
                   { author => 'marge', title => 'hairstyles' },
                   { author => 'lisa', title => 'THIS BOOK FIRST' },
                   { author => 'homer', title => 'donuts' },
                   { author => 'bart', title => 'coolness' }
                  );

my @sorted;
my $author;

foreach my $thing ( @things_to_sort ) {
  if( $thing->{title} eq "THIS BOOK FIRST" ) {
      $author = $thing->{author};
      last;
  }
}


@sorted = sort {
    if ( $a->{title} eq "THIS BOOK FIRST" ) {
      return -1;
    } elsif
    ( $b->{title} eq "THIS BOOK FIRST" ) {
      return 1;
    } elsif
    ( $a->{author} eq $author and $b->{author} eq $author ) {
      return( $a->{title} cmp $b->{title} );
    } elsif
    ( $a->{author} eq $author ) {
      return -1;
    } elsif
    ( $b->{author} eq $author ) {
      return 1;
    } else {
      return (
            $a->{author} cmp $b->{author}
        or  $a->{title}  cmp $b->{title}
      )
    }
} @things_to_sort;

print Dumper \@sorted;

Dave

Re^4: Twisted sort requirements

graff

created: 2006-02-01 03:41:26

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

Um, I think the problem here is: if you don't know the author of "THIS BOOK FIRST" before the sorting begins, then you effectively end up changing the sort conditions in the middle of the sorting process, which would tend to make that process somewhat unstable at best.

I'll confess that I've forgotten most of the (relatively few) details I've ever known about sorting implementations, but I have a strong hunch that changing the sort criteria upon seeing input item N (where N is something other than "the first") would violate an essential underlying assumption that is built into most sort algorithms.

use strict;
use warnings;
use Data::Dumper;


my @things_to_sort = (
                   { author => 'bart', title => 'skateboarding' },
                   { author => 'lisa', title => 'postmodernism' },
                   { author => 'marge', title => 'hairstyles' },
                   { author => 'lisa', title => 'THIS BOOK FIRST' },
                   { author => 'homer', title => 'donuts' },
                   { author => 'bart', title => 'coolness' }
                  );

my ($first) = grep { $_->{title} eq 'THIS BOOK FIRST' } @things_to_sort;
my @sorted = 
    sort { $a->{title} cmp $b->{title} } 
        grep { $_->{author} eq $first->{author} } @things_to_sort;

push @sorted, 
    sort { $a->{author} cmp $b->{author} or $a->{title} cmp $b->{title} }
        grep { $_->{author} ne $first->{author} } @things_to_sort;

print Dumper \@sorted;

update: my first posting had a much more complicated block for the first sort -- which was a failed attempt to do everything in one sort -- but I simplified it to just the appropriate logic.

You are going to need a pre-pass of the data to find the author of the titled book. I've lower cased the titles for the sort so that "the book of ... " and "The book of..." will sort together, but that is easily removed. This assumes that your authors names and book titles don't contain null chars.

#! perl -slw
use strict;

my @things_to_sort = (
    { author => 'bart',  title => 'skateboarding' },
    { author => 'lisa',  title => 'postmodernism' },
    { author => 'marge', title => 'hairstyles' },
    { author => 'lisa',  title => 'THIS BOOK FIRST' },
    { author => 'homer', title => 'donuts' },
    { author => 'bart',  title => 'coolness' }
);

my $firstTitle = 'THIS BOOK FIRST';

## Find the author of the title
my $firstAuthor;
$_->{ title } eq $firstTitle and $firstAuthor = $_->{ author } 
    for @things_to_sort;
die "Title $firstTitle not found" unless $firstAuthor;

my @sorted = map{
    $_->[0]
} sort {
    $a->[ 1 ] cmp $b->[ 1 ]
} map {
    [
        $_,
        sprintf "%s%s%s\0%s\0",
            $_->{ title } eq $firstTitle ? chr(0) : '',
            $_->{ author } eq $firstAuthor ? chr(0) : '',
            lc( $_->{ author } ),
            lc( $_->{ title } )
     ]
} @things_to_sort;

printf "%-8s %-20s %-6s %-10s\n", %$_ for @sorted;
__END__
c:\Perl\test>junk
title    THIS BOOK FIRST      author lisa
title    postmodernism        author lisa
title    coolness             author bart
title    skateboarding        author bart
title    donuts               author homer
title    hairstyles           author marge

With a little work before hand sort is the tool to use:

use warnings;
use strict;

my @things_to_sort =
  (
  { author => 'bart', title => 'skateboarding' },
  { author => 'lisa', title => 'postmodernism' },
  { author => 'marge', title => 'hairstyles' },
  { author => 'lisa', title => 'THIS BOOK FIRST' },
  { author => 'homer', title => 'donuts' },
  { author => 'bart', title => 'coolness' }
  );

my @authors = grep {$_->{title} eq 'THIS BOOK FIRST'} @things_to_sort;

print "$_->{author}: $_->{title}\n"  for sort TwistedSort @things_to_sort;

sub TwistedSort {
  if ($a->{author} eq $b->{author})
    {# Same author, just check title
    return -1 if $a->{title} eq $authors[0]->{title};
    return 1 if $b->{title} eq $authors[0]->{title};
    return $a->{title} cmp $b->{title};
    }
    
  return -1 if $a->{author} eq $authors[0]->{author};
  return 1 if $b->{author} eq $authors[0]->{author};
  return $a->{author} cmp $b->{author};
}

Prints:

lisa: THIS BOOK FIRST
lisa: postmodernism
bart: coolness
bart: skateboarding
homer: donuts
marge: hairstyles

You can get most of what you need with a Schwartzian Transform, but there's one little wrinkle that complicates things: during the first map, when you run across an arbitrary title (say, 'postmodernism' by 'lisa'), you don't yet know whether the same author also has a 'THIS BOOK FIRST' title. So you need an extra pass, and an orcish manoeuver, to tell you that.

(If terms like 'Schwartzian Transform' and 'orcish manoeuver' are new for you, you should first look those up (Google is good here) and try to understand them before trying to use the code below.)

my %orcish;
my @sorted = map {
  # Final pass:  restore the original datum,
  # dropping the extra stuff we added:
  $$_[4]
} sort {
  # Books whose author has a 'THIS BOOK FIRST' title are first:
  $$a[0] <=> $$b[0]
  # Within that, sort by author:
  or $$a[1] <=> $$b[1]
  # Within that, sort by whether it's THIS BOOK FIRST or not:
  or $$a[2] <=> $$b[2]
  # Within that, sort by the title, alphabetically:
  or $$a[3] <=> $$b[3]
} map {
  # Second pass:  gather enough info that sort can sort like we want:
  [$orcish{$$_{author}}, $$_{author}, 
   ($$_{title} eq 'THIS BOOK FIRST'),
   $$_{title}, $_]
} map {
  # First pass:  take note of which authors have 'THIS BOOK FIRST':
  $orcish{$$_{author}}++ if $$_{title} eq 'THIS BOOK FIRST';
  # But just pass through the data unmodified for now:
  $_
} @things_to_sort;

Note that the way I've written this, if an author has _two_ books with the magic title, that author's works will be listed before the ones who only have _one_ such title. If this is undesireable, change the ++ to =1 in the first pass.

You are storing in the same array two kinds of unrelated information: a list of books and author ordering information. Using a magic marker is a bad idea almost every time.

In that case, the obvious data structures to use are an array to store book descriptions and a hash to store author ordering information.

If you are getting the information from a DB, the information should already be structured that way there. You should even be able to get the list of books ordered from the database!

If you are reading the information from a file (or from the network) you can build those two structures on the fly on the parsing phase with almost identical effort and then other parts of your code will become much clearer.

#!/usr/bin/perl -w
use strict;
my @things_to_sort = (
                   { author => 'bart', title => 'skateboarding' },
                   { author => 'lisa', title => 'postmodernism' },
                   { author => 'marge', title => 'hairstyles' },
                   { author => 'lisa', title => 'THIS BOOK FIRST' },
                   { author => 'homer', title => 'donuts' },
                   { author => 'bart', title => 'coolness' }
                  );
#this begs for a new structure.
#lets use a hash.
my %authors_books;

#turn your AoH's into a HoA's
#see perldsc for reference
foreach (@things_to_sort){
	push @{$authors_books{$_->{author}}}, $_->{title};
}

#sort the books for each author
foreach my $author (keys %authors_books){
	@{$authors_books{$author}} = sort{
        	$a  eq  "THIS BOOK FIRST" && -1
     		or  $b  eq  "THIS BOOK FIRST" &&  1 
     		or  $a cmp $b
	}@{$authors_books{$author}};
}

#figure out who to display first.
my @display_keys = sort{
		(grep /THIS BOOK FIRST/, @{$authors_books{$a}}) && -1
		or (grep /THIS BOOK FIRST/, @{$authors_books{$b}}) && 1
		or $a cmp $b
	} keys %authors_books;

#display the information.
foreach my $display_key (@display_keys){
	print "$display_key books:\n";
	foreach (@{$authors_books{$display_key}}){
		print "\t$_\n";
	}
}
exit;

I liked [injunjoel]'s streightforward code, but I wanted to simplify it, and make special cases stand out. I also dislike handling special cases inside sort routines, because these are called more often than the number of items to be sorted. I also believe I have minimized the number of loops.

The only part I am not happy with is the "Special Marker" that is passed into the sort. That is a compromise made in order to simplify the code:

#!/usr/bin/perl -w
use strict;
my @things_to_sort = (
                   { author => 'bart', title => 'skateboarding' },
                   { author => 'lisa', title => 'postmodernism' },
                   { author => 'marge', title => 'hairstyles' },
                   { author => 'lisa', title => 'THIS BOOK FIRST' },
                   { author => 'homer', title => 'donuts' },
                   { author => 'lisa', title => 'Eating Veggies' },
                   { author => 'bart', title => 'coolness' }
                  );
#this begs for a new structure.
#lets use a hash.
my (%authors_books,  $FirstAuth);
my $FirstTitle = "THIS BOOK FIRST";
my $Special_Low_Sort_Marker = "0x00" x 100; # A hundred nulls

#turn your AoH's into a HoA's
#Find first Author
#Mark Specially-named books
#see perldsc for reference
foreach (@things_to_sort){
    if ( $_->{title} eq $FirstTitle){
       $FirstAuth =  $_->{author} ;
       push @{$authors_books{ $_->{author} }},
            $Special_Low_Sort_Marker . $_->{title}; # Special Marker - Push to top of SORT
    }else{
         push @{$authors_books{ $_->{author} }},    $_->{title};
    }  
}

#display the information.
if ($FirstAuth){
  PrintAuthor($FirstAuth);
  delete $authors_books{$FirstAuth};
}
foreach my $author ( sort keys %authors_books){
    PrintAuthor($author);
}
########################
sub PrintAuthor{
  my $author = shift;
  print "$author books:\n";
  foreach (sort @{$authors_books{$author}}){
       s/^$Special_Low_Sort_Marker//;     # Remove Special marker
       print "\t$_\n";
  }
}

lisa books:
        THIS BOOK FIRST
        Eating Veggies
        postmodernism
bart books:
        coolness
        skateboarding
homer books:
        donuts
marge books:
        hairstyles

Re^2: Twisted sort requirements

johngg

created: 2006-02-02 10:01:04

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

Another late one but never mind! I also adopted the extra data line. Then a pass through the data once to find who wrote "THIS BOOK FIRST" and the rest can be done in a Schwartzian transform.

#!/usr/local/bin/perl -w
#
use strict;

our @thingsToSort = (
   {author => 'bart', title => 'skateboarding'},
   {author => 'lisa', title => 'postmodernism'},
   {author => 'marge', title => 'hairstyles'},
   {author => 'lisa', title => 'THIS BOOK FIRST'},
   {author => 'homer', title => 'donuts'},
   {author => 'bart', title => 'coolness'},
   {author => 'lisa', title => 'eating veggies'});

our $firstAuthor = q();
foreach (@thingsToSort)
{
    next unless $_->{title} eq 'THIS BOOK FIRST';
    $firstAuthor = $_->{author};
    last;
}

print
   map {"$_->[0]->{author}: $_->[0]->{title}\n"}
   sort
   {
       $b->[1] <=> $a->[1] ||
       $b->[2] <=> $a->[2] ||
       $a->[0]->{author} cmp $b->[0]->{author} ||
       $a->[0]->{title} cmp $b->[0]->{title}
   }
   map
   {
       [
          $_,
          $_->{title} eq 'THIS BOOK FIRST',
          $_->{author} eq $firstAuthor
       ]
   }
   @thingsToSort;

I tried to think of a way to accomplish the first pass in the transform to make things simpler but failed.

Cheers,

JohnGG