On 5/7/07, Nisse Tuta <[EMAIL PROTECTED]> wrote:
Hi All,
I am having big problems solving this sorting issue and would really
appreciate any help on this.
I have a list with each row containing 3 numbers(Run In Out).
For example,
R01 13 19
R01 25 30
R01 23 47
R01 2 14
R02 2 45
R02 55 60
R01 1 17
R03 45 66
R03 20 35
and so on......
I would like to go through these and check for any overlapping numbers
at both In and Out and replacing either the in out or both if
overlapped. And any cuts/breaks in each run will add a count.
To create a list like
Run Count In Out
R01 1 1 19
2 25 47
R02 1 2 45
2 55 60
snip
If I understand correctly then R03 should look like
R03 1 20 35
2 45 46
The sort itself isn't that bad; you are just sorting on three columns,
column 1 first, column 2 second, and column 3 last:
my @sorted = sort {
$a->[0] cmp $b->[0] or #sort on run, if equal then
$a->[1] <=> $b->[1] or #sort on in, if equal then
$a->[2] <=> $b->[2] #sort on out
} @input;
But that doesn't solve your problem. You then need to loop over the
sorted values and compress the runs. Note, if you write the code that
transforms the data correctly, it is not necessary to sort it first,
but it does make it easier.
#!/usr/bin/perl
use strict;
use warnings;
my @input = (
[ qw(R01 13 19) ],
[ qw(R01 25 30) ],
[ qw(R01 23 47) ],
[ qw(R01 2 14) ],
[ qw(R02 2 45) ],
[ qw(R02 55 60) ],
[ qw(R01 1 17) ],
[ qw(R03 45 66) ],
[ qw(R03 20 35) ],
);
my @sorted = sort {
$a->[0] cmp $b->[0] or #sort on run, if equal then
$a->[1] <=> $b->[1] or #sort on in, if equal then
$a->[2] <=> $b->[2] #sort on out
} @input;
#printf "%s %3d %3d\n", @$_ for @sorted;
my %output;
ROW:
for my $row (@sorted) {
my ($runname, $in, $out) = @$row;
for my $run (@{$output{$runname}}) {
if ($in < $run->[2]) {
if ($out > $run->[2]) {
$run->[2] = $out;
}
next ROW;
}
}
push @{$output{$runname}}, $row;
}
for my $runname (sort keys %output) {
print "$runname ";
my $i = 0;
for my $run (@{$output{$runname}}) {
$i++;
printf "$i %3d %3d\n", @{$run}[1,2];
}
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
