Perl Monk, Perl Meditation PerlMonks

### Re: Sort then conditionally sort

by kyle (Abbot)
 on Apr 08, 2009 at 20:38 UTC ( #756453=note: print w/replies, xml ) Need Help??

in reply to Sort then conditionally sort

That's kind of an interesting problem. As such, I've written a solution, even though you haven't shown any work. My solution could be a lot more readable, but it does the job. Some explanation is in the comments.

```#!/usr/bin/perl

use strict;
use warnings;

my \$op_io = <<'OP_INPUT_AND_OUTPUT';
'aaa'   1,2             'aaa'   1,2
'aaa'   2,1             'aaa'   2,3
'aaa'   2,3             'aaa'   2,1
'aaa'   3,1             'aaa'   3,1
'aaa'   3,2             'aaa'   3,2
'aaa'   4,1             'aaa'   4,5
'aaa'   4,5             'aaa'   4,1
'bbb'   2,2             'bbb'   2,1
'bbb'   2,5             'bbb'   2,2
'bbb'   2,1             'bbb'   2,5
'bbb'   4,3             'bbb'   4,6
'bbb'   4,6             'bbb'   4,3
'bbb'   4,1             'bbb'   4,2
'bbb'   4,2             'bbb'   4,1
'ccc'   3,3             'ccc'   1,1
'ccc'   3,6             'ccc'   1,3
'ccc'   1,3             'ccc'   2,4
'ccc'   1,1             'ccc'   2,2
'ccc'   6,4             'ccc'   3,3
'ccc'   6,6             'ccc'   3,6
'ccc'   2,2             'ccc'   6,6
'ccc'   2,4             'ccc'   6,4
OP_INPUT_AND_OUTPUT
;

my @init;
my @want;
my \$n = 0;
foreach my \$line ( split /\n/, \$op_io ) {
( \$init[\$n][0], \$init[\$n][1], \$init[\$n][2],
\$want[\$n][0], \$want[\$n][1], \$want[\$n][2] )
= ( \$line =~ m{ \A  \'(...)\' \s+ (\d+),(\d+)
\s+ \'(...)\' \s+ (\d+),(\d+) }xms );
\$n++;
}

# At this point, @init and @want are both AoA.

# unique X values for each group
my %x_of;
\$x_of{\$_->[0]}{\$_->[1]}++ for @init;

# map an X to its relative position in a sorted list of X.
foreach my \$group ( keys %x_of ) {
my @exez = sort { \$a <=> \$b } keys %{ \$x_of{\$group} };
@{ \$x_of{\$group} }{@exez} = 0 .. \$#exez;
}

# Sort first by group, then by X,
# then ascending or descending depending on what X's position is.
my @out = sort { \$a->[0] cmp \$b->[0]
||
\$a->[1] <=> \$b->[1]
||
( ( \$x_of{ \$a->[0] }{ \$a->[1] } % 2 )
? ( \$b->[2] <=> \$a->[2] )
: ( \$a->[2] <=> \$b->[2] ) )
} @init;

use Test::More tests => 1;

is_deeply( \@out, \@want, 'it works!' );

Since you're new, you might understand what I wrote better if you look at perldsc, perlreftut, perlref, Test::More, References quick reference, and—what the heck—PerlMonks FAQ

Replies are listed 'Best First'.
Re^2: Sort then conditionally sort
by lukez (Initiate) on Apr 10, 2009 at 04:46 UTC
Hi Kyle, thank you sorry i didnt have code, I am JUST learning and I learn by looking at code solutions AND READING faqs and books etc.
my \$op_io = <<'OP_INPUT_AND_OUTPUT';
and all the example before and after columns listed in between
OP_INPUT_AND_OUTPUT ;
My request for help had the columns on the left as an example of the input data file to be sorted... the 2 columns on the right are the sorted /cond sorted data that needs to go in a separate file. This confused me. thank you for taking the time to help me.

The construct is called a "here-document", and you can find them documented in perlop. It's basically a way to include some large chunk of text as a value in your program.

In this case, I used it to hold your example data. After setting \$op_io to that value, I use split to cut it into individual lines, and I loop over those lines to pull the individual values out. When I'm done, I have your inputs and desired output.

I did it that way so I wouldn't have to reformat what you posted. I just pasted it in and wrote some code to pull out what I wanted.

Thanks Kyle, but How would this be adapted to read in a file and out put to another/

Create A New User
Node Status?
node history
Node Type: note [id://756453]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (6)
As of 2018-06-22 06:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (121 votes). Check out past polls.

Notices?