remove duplicated lines and sort the table in Perl - perl

Question

I have a table like this:
+ chr13 25017807 6
+ chr10 128074490 1
- chr7 140968671 1
+ chr10 79171976 3
- chr7 140968671 1
+ chr12 4054997  6
+ chr13 25017807 6
+ chr15 99504255 6
- chr8 91568709 5
It has been already read into Perl as a string variable (the returned value of an external shell script). I need to remove the duplicated lines and sort the table by the last column, and then print it out. How should I do it in Perl? Thanks!

Answer 1

Assuming the data is contained in the string $string, this solution would work:
my %seen; # just needed to remove duplicates
my $deduped_string =
join "\n", # 6. join the lines to a single string
map { join(" ", #$_) } # 5. join the fields of each line to a string
sort { $a->[-1] <=> $b->[-1] } # 4. sort arrayrefs by last field, numerically
map { [split] } # 3. split line into fields, store in anon arrayref
grep { not $seen{$_}++ } # 2. dedupe the lines
split /\n/, $string; # 1. split string into lines
This gargantuan expression executes from bottom towards top (or right to left). It consists of multiple composable transformers and filters:
map {BLOCK} LIST applies the code in the block to each value of the list. It transforms the list element-wise.
grep {BLOCK} LIST selects those elements from the list where the block returns true. It therefore filters the list and only outputs elements that satisfy a certain condition.
sort {BLOCK} LIST resorts the list. The block must return -1 if $a is less than $b, 1 if it is greater, or zero when equal. The <=> operator compares scalars numerically in this fashion. If the sort function is omitted, string comparision is used.
join STRING, LIST concatenates the elements of the list with the string in between.
split REGEX, STRING splits the string into pieces. The regex matches the delimiter (not usually returned). split and join can be considered inverse operations. If the string is omitted, $_ is used. When the regex is omitted, it works similarly to split /\s+/, $_, i.e. splits at every whitespace character.
This solution uses at its heart the Schwartzian Transform, a technique/idiom that enables cheap sorting by expensive-to-calculate keys. In it's general form, it is
my #sorted_data =
map { $_->[0] } # 3. map back to the orginal value
sort { $a->[1] <=> $b->[1] } # 2. sort by the special key
map { [$_, create_the_key($_)] } # 1. annotate each value with a key
#data;
In my specific case, the special key is the last column of each record; To obtain the original data (or an equivalent form) from the annotated data I join the fields together. As mpapec points out, I could also have carried the original line through the transform; this would preserve the original alignment of the lines.

Answer 2

For a beginner, I'd do it like this:
use strict; use warnings;
my $file = "table.txt";
open(my $fh, "<", $file) || die "Can't open $file: $!\n";
my #lines;
# read the file and save a transformed version to #lines
while (my $line = <$fh>) {
chomp($line); # remove final newline
$line =~ s/ +/:/gi; # make ":" the new separator
my #fields = split(/:/,$line); # split at the separator
my $newline = "$fields[4]:$fields[1]:$fields[2]:$fields[3]"; # reorder fields
push(#lines, $newline); # save the new line
}
#lines = sort(#lines); # sort lines alphabetically:
# duplicate lines are now consecutive
my $uniqline=""; # the last unique line
foreach my $line (#lines) {
# do this if the current line isn't string-equal to the last line
# (i.e. skip all lines that are equal to the previous line)
if ($uniqline ne $line) {
$uniqline = $line; # remember the last line
# print fields in original order
my #fields = split(/:/,$line);
printf(" %s %7s %11s %s\n",$fields[1],$fields[2],$fields[3],$fields[0]);
}
}
I got slightly different result...
+ chr10 128074490 1
- chr7 140968671 1
+ chr10 79171976 3
- chr8 91568709 5
+ chr12 4054997 6
+ chr13 25017807 6
+ chr15 99504255 6

Answer 3

Filters out duplicate lines, and sorts by the last column at the end,
perl -ane 'next if $s{$_}++; push #r,[$_,#F]}{ print $$_[0] for sort { $$a[-1] <=> $$b[-1] } #r' file
Almost same as,
use strict;
use warnings;
open my $fh, "file" or die $!;
my (%seen_line, #result_unique_lines);
while (<$fh>) {
# $_ => content of current line
# skip current if it's duplicate
next if $seen_line{$_}++;
my #line_values = split;
push #result_unique_lines, [$_, #line_values];
}
close $fh;
# sort lines
#result_unique_lines = sort { $a->[-1] <=> $b->[-1] } #result_unique_lines;
for my $aref (#result_unique_lines) {
my $line = $aref->[0];
print $line;
}