snehit.ar has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I have records store in array : 
[
  {
    'appname' => 'AAA',
    'severity' => 'critical',
    'line' => 1,
    'event_age' => 12
  },
  {
   'appname' => 'BBB',
    'severity' => 'OK',
    'line' => 2,
    'event_age' => 32
  },
  {
    'appname' => 'CCC',
    'severity' => 'critical',
    'line' => 3,
     'event_age' => 4
  },
  {
   'appname' => 'DDD',
    'severity' => 'critical',
    'line' => 4,
   'event_age' => 22
  },
  {
    'appname' => 'EEE',
    'severity' => 'OK',
    'line' => 5,
    'event_age' => 4
  },
  {
  'appname' => 'FFF',
    'severity' => 'critical',
    'line' => 6,
   'event_age' => 1,
  },
  {
   'appname' => 'GGG',
    'severity' => 'critical',
    'line' => 7,
  'event_age' => 8
  },
  {
   'appname' => 'HHH',
    'severity' => 'OK',
    'line' => 8,
    'event_age' => 10
  },
  {
 'appname' => 'III',
    'severity' => 'critical',
    'line' => 9,
   'event_age' => 7
  },
  {
    'appname' => 'JJJ',
    'severity' => 'critical',
    'line' => 10,
   'event_age' => 15
  },
  {
    'appname' => 'KKK',
    'severity' => 'OK',
    'line' => 11,
  'event_age' => 26
  },
  {
    'appname' => 'LLL',
    'severity' => 'critical',
    'line' => 12
    'event_age' => 23
  }]

[download]

I want to sort above records based on the event_age :

such that first it should show all " severity = critical " records in descending order then ; remaining records with " severity = ok " in ascending order

Eg: if there are only 12 records and 4 are critical and 8 are OK .Then its should sort 4 records based on event_age in descending order and 8 records based on event_age in ascending order Below code in am using :: 

#To sort the records
for (@records){
if ($_->{'severity'} eq "critical"){
#sort the array @records and assign line number 
@records = sort{ $a->{event_age} <=> $b->{event_age} } @records;
for my $i (0 .. $#records) {
$records[$i]->{line} = $i + 1;
}
#End# 
}

}



# To Restrict the row count to 12 to fit the screen
my $max = 12; 
for (@records){
if ($_->{'line'} < $max){
#DoNothing 
}
}

#Set Visibility to "No" if records are more then 12
for (@records+1..$max){ 
push @records, {
line    => $_,
severity    => "",
ticketnum  => "",
appname => "",
appname => "",
event_age => "" ,
visible => "No",
appspectname  => ""
};
}

print Dumper \@records;

[download]

Please suggest with the correct approach/logic.

Replies are listed 'Best First'.
Re: Two sort in single Array set
by choroba (Cardinal) on Aug 30, 2017 at 09:58 UTC
    Just use a bit more complex sort routine: 
    my %severity = ( critical => -1, OK => 1 );
my @sorted = sort {
    $severity{ $a->{severity} } <=> $severity{ $b->{severity} }
    ||
    $severity{ $a->{severity} } * ( $a->{event_age} <=> $b->{event_age
+} )
} @records;

    [download]

    i.e. when comparing two elements, first compare their severity, and then compare their event age, but reverse the result for the critical ones.

    Update: simplified by using negative severity for the critical.

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
[select]
Re: Two sort in single Array set
by johngg (Canon) on Aug 31, 2017 at 11:39 UTC

    Just to illustrate another way, though probably too complicated for this simple problem. You can use an array slice if you sort the array indices. I use array references since that's what the OP shows and use pack/unpack and a GRT to do the sort. Note that I uc the severity so that "critical" sorts before "OK".

    my $raSortedEvents = [ @{ $raEvents }[
   map  { unpack q{x12N}, $_ }
   sort
   map  {
       pack( q{A8}, uc $raEvents->[ $_ ]->{ severity } )
       .
       (
          $raEvents->[ $_ ]->{ severity } eq q{OK}
          ?   pack( q{l>}, $raEvents->[ $_ ]->{ event_age } )
          : ~ pack( q{l>}, $raEvents->[ $_ ]->{ event_age } )
       )
       .
       pack( q{N}, $_ );
   }
   0 .. $#{ $raEvents } ]
   ];

    [download]

    I hope this is of interest.

    Cheers,

    JohnGG

[reply]
[d/l]
      BTW, this only works if event_age is a non-negative integer. Also, ew.
[reply]
        this only works if event_age is a non-negative integer

        I suppose they could be recording events that haven't happened yet and if they are then an additional flag for negativity fixes the problem.

        my $raSortedEvents = [ @{ $raEvents }[
   map  { unpack q{x13N}, $_ }
   sort
   map  {
       pack( q{A8}, uc $raEvents->[ $_ ]->{ severity } )
       .
       (
          $raEvents->[ $_ ]->{ severity } eq q{OK}
          ? pack( q{cl>},
               $raEvents->[ $_ ]->{ event_age } < 0 ? 0 : 1,
               $raEvents->[ $_ ]->{ event_age } )
          : pack( q{c}, $raEvents->[ $_ ]->{ event_age } < 0 ? 1 : 0 )
            .
            ~ pack( q{l>}, $raEvents->[ $_ ]->{ event_age } )
       )
       .
       pack( q{N}, $_ );
   }
   0 .. $#{ $raEvents } ]
   ];

        [download]

        Even more ew'ness I suppose but I did say this was over-complicated for the OP's problem and was just to illustrate a technique. It would perhaps look less dense if broken down into two stages.

        my @sortOrder =
   map  { unpack q{x13N}, $_ }
   sort
   map  {
       pack( q{A8}, uc $raEvents->[ $_ ]->{ severity } )
       .
       (
          $raEvents->[ $_ ]->{ severity } eq q{OK}
          ? pack( q{cl>},
               $raEvents->[ $_ ]->{ event_age } < 0 ? 0 : 1,
               $raEvents->[ $_ ]->{ event_age } )
          : pack( q{c}, $raEvents->[ $_ ]->{ event_age } < 0 ? 1 : 0 )
            .
            ~ pack( q{l>}, $raEvents->[ $_ ]->{ event_age } )
       )
       .
       pack( q{N}, $_ );
   }
   0 .. $#{ $raEvents };
my $raSortedEvents = [ @{ $raEvents }[ @sortOrder ] ];

        [download]

        Cheers,

        JohnGG

[reply]
[d/l]
[select]
Re: Two sort in single Array set
by Anonymous Monk on Aug 30, 2017 at 16:25 UTC
    While choroba's solution is very clever and efficient, it might be daunting to someone who's new to Perl. You might feel more comfortable with something that works in smaller steps, like this: 
    my @crit = grep {$_->{severity} eq 'critical'} @records;
my @noncrit = grep {$_->{severity} ne 'critical'} @records;
@crit = sort {$b->{event_age} <=> $a->{event_age}} @crit;
@noncrit = sort {$a->{event_age} <=> $b->{event_age}} @noncrit;
@records = (@crit, @noncrit);

    [download]
[reply]
[d/l]
A reply falls below the community's threshold of quality. You may see it by logging in.

Back to Seekers of Perl Wisdom