Сортировать несколько строк по полям

У меня есть запись с несколькими строками, что мне нужно сделать, это отсортировать их по типу и 6-значному числу в строке HEADER1.

Вот запись:

HEADER1|TYPE1|123456|JOHN SMITH
INFO|M|34|SINGLE
INFO|SGT
STATUS|KIA
MSG|NONE
HEADER1|TYPE3|654123|DANICA CLYNE
INFO|F|20|SINGLE
STATUS|MIA
MSG|HELP
MSG1||
HEADER1|TYPE2|987456|NIDALEE LANE
INFO|F|26|MARRIED
STATUS|INJURED
MSG|NONE
HEADER1|TYPE1|123456|JOHN CONNOR
INFO|M|34|SINGLE
STATUS|KIA
MSG|NONE
HEADER1|TYPE4|123789|CAITLYN MIST
INFO|F|19|SINGLE
INFO|||
STATUS|NONE
MSG|NONE
HEADER1|TYPE2|987456|NIDALEE CROSS
INFO|F|26|MARRIED
STATUS|INJURED
MSG|NONE

Выходные данные должны быть такими: сортируется строка, соответствующая правилу

HEADER1|TYPE1|123456|JOHN SMITH
INFO|M|34|SINGLE
INFO|SGT
STATUS|KIA
MSG|NONE
HEADER1|TYPE1|123456|JOHN CONNOR
INFO|M|34|SINGLE
STATUS|KIA
MSG|NONE
HEADER1|TYPE2|987456|NIDALEE LANE
INFO|F|26|MARRIED
STATUS|INJURED
MSG|NONE
HEADER1|TYPE2|987456|NIDALEE CROSS
INFO|F|26|MARRIED
STATUS|INJURED
MSG|NONE
HEADER1|TYPE3|654123|DANICA CLYNE
INFO|F|20|SINGLE
STATUS|MIA
MSG|HELP
MSG1||
HEADER1|TYPE4|123789|CAITLYN MIST
INFO|F|19|SINGLE
INFO|||
STATUS|NONE
MSG|NONE
Источник

3 ответа

Решение

Вот мое решение.

#!/bin/perl

use warnings;
use strict;

# Read in the file
open(my $fh, '<', "./record.txt") or DIE $!;
my @lines = <$fh>;
my @records;

# populate @records with each element having 4 lines
for ( my $index = 0; $index < scalar @lines; $index+=4 ) {
    push @records, join("", ($lines[$index], $lines[$index+1], $lines[$index+2], $lines[$index+3]));
}

# sort by type and then by numbers
@records =  map { $_->[0] }
            sort { $a->[1] cmp $b->[1] || $a->[2] cmp $b->[2] }
            map { [ $_ , (split('\|', $_))[1], (split('\|', $_))[2] ] }
            @records;

print "@records";

Вот обновленная версия, та же идея:

#!/bin/perl

use warnings;
use strict;


open(my $fh, '<', "./record.txt") or DIE $!;
my @lines = <$fh>;
my $temp = join ("", @lines);
my @records = split("HEADER1", "$temp");
my @new_records;

for my $rec (@records){
    push @new_records, "HEADER1" . $rec;
}
shift @new_records;



@records =  map { $_->[0] }
            sort { $a->[1] cmp $b->[1] || $a->[2] cmp $b->[2] }
            map { [ $_ , (split('\|', $_))[1], (split('\|', $_))[2] ] }
            @new_records;



print "@records";
Источник

Если вас не волнует производительность, и каждая "запись" состоит из 4 строк:

# Assume STDIN since the question didn't say anything
my $line_index = 0;
my (@records, @record);
# Slurp in all records into array of quadruplets
while (<>) {
    if (0 == $line_index) {
        push @records, [];
    };
    $records[-1]->[$line_index] = $_; # -1 lets you access last element of array.
    $line_index++;
    $line_index = 0 if $line_index == 4; # better done via "%" 
}

# Sort the array. Since we sort by type+id, 
# we can simply sort the first strings alphabetically.
my @records_sorted = sort { $a->[0] cmp $b->[0] } @records;

foreach my $record (@records_sorted) {
    print join("", @$record); # Newlines never stripped, no need to append
}

Если вы любите приключения, используйте List::MoreUtils::natatime:

use List::MoreUtils q/natatime/;
my @lines = File::Slurp::read_file("my_file.txt");
my $it = natatime 4, @lines;
my (@records, @record);
while ((@record) = $it->()) {
    push @records, \@record;
}
my @records_sorted = sort { $a->[0] cmp $b->[0] } @records;
foreach my $record (@records_sorted) {
    print join("", @$record);
}

Другой вариант создания @records из @lines - это List::Gen:

use List::Gen qw/by/; 
foreach my $record (by 4 => @lines) {
    push @records, $record;
}

Обратите внимание, что в приведенном выше коде предполагается, что все # являются 6-значными. Если это не так, вам нужно немного изменить код:

use List::Gen qw/by/;
my @lines = File::Slurp::read_file("my_file.txt");
my @records;
foreach my $record (by 4 => @lines) {
    my @sort_by = split(m#/#, $record->[0]);
    push @records, [ $record, \@sort_by ];
}
my @records_sorted = sort { 
                             $a->[1]->[1] cmp $b->[1]->[1] 
                          || $a->[1]->[2] <=> $b->[1]->[1]
                     } @records;
foreach my $record (@records_sorted) {
    print join("", @{$record->[0]}); 
}

ОБНОВЛЕНИЕ: Поскольку ОП решил, что входной файл может иметь ЛЮБОЕ число строк на запись, вот обновленный код:

my (@records, @record);
# Slurp in all records into array of quadruplets
while (<>) {
    if (/HEADER1/) {
        my @sort_by = split(m#/#);            
        push @records, [[], \@sort_by];
    };
    push @{ $records[-1]->[0] }, $_;
}
my @records_sorted = sort { 
                             $a->[1]->[1] cmp $b->[1]->[1] 
                          || $a->[1]->[2] <=> $b->[1]->[1]
                     } @records;
foreach my $record (@records_sorted) {
    print join("", @{$record->[0]}); 
}
Источник

Используя List::MoreUtils 'apply' и установив input_record_separator в 'HEADER', код может быть таким, как показано ниже.

#!/usr/bin/perl
use strict;
use warnings;
use List::MoreUtils qw/ apply /;

my $fname =  'dup_data.txt';

open (my $input_fh, '<', $fname) or die "Unable to read '$fname' because $!";
open (my $OUTPUTA, ">", $fname .".reformat")
    or die "$0: could not write to '$fname.reformat'. $!";

{
    local $/ = "HEADER";

    print $OUTPUTA map{ "HEADER$_->[0]"}
                  sort {$a->[1] <=> $b->[1] || $a->[2] <=> $b->[2]}
                   map {[$_, /TYPE(\d+)\|(\d+)/]}
                  grep $_, apply {chomp} <$input_fh>;
}
close $input_fh or die $!;
close $OUTPUTA or die $!;
Источник
Другие вопросы по тегам