in reply to sorting an array with an array

Simply replace the month name with a string that sorts as you like (using the default sort), then undo that replacement after the sort: 

my @files= <*>;
@files= do {
    my @mo= ( qw(Jan Feb Mar Apr May Jun
        Jul Aug Sep Oct Nov Dec), 'a'..'l' );
    my %mo; @mo{@mo}= reverse @mo;
    grep {
        s/^(.)/$mo{$1}/
    } sort grep {
        s/^(...)/$mo{$1}/
    } @files;
};

[download]
So we set up %mo so that $mo{Jan} is 'a' and $mo{a} is 'Jan'. Then we read the "grep sort grep" from the bottom up: Take the unsorted list of file names, take the first 3 letters of each file name and replace it with appropriate letter, sort the list of modified file names, replace the first letter of the modified file names with the month abbreviations, return the sorted list.

Note that this assumes that we have a leading zero in front of single-digit days of the month and that all of the month names are capitalized exactly as we expect. If not, then we need to account for that as well. (It also doesn't deal with invalid file names.) 

my @files= <*>;
@files= do {
    my @mo= qw(jan feb mar apr may jun
        jul aug sep oct nov dec);
    my %mo; @mo{@mo}= 0..$#mo;
    grep {
        s/^[^-]*-//
    } sort grep {
        # Replace "JAN1" with "a01-JAN1":
        s/^(...)(\d\d?)/sprintf
            "%s%02d-%s",$mo{lc$1},$2,$1.$2/e
            or  $_= "?-$_";
        1;
    } @files;
};

[download]
Update: You see, this is why Perl needs a 'filter' primitive. Neither map nor grep is quite the right tool for this job and map seems almost seductively right for it which results in people making mistakes like I just did.

In the first snippet, I originally had 'map' instead of 'grep'. 'map' will give back the return value from the s/// operator, which is not the modified string.

The second snippet had the same mistake but when I fixed it I also decided to deal with filenames that aren't named as we expected.

It is easy to characterize this as an abuse of grep. I tend to agree. (:

        - tye (just that sort of guy... sort of)

Replies are listed 'Best First'.
Re: sorting an array with an array
by Abigail-II (Bishop) on Oct 01, 2002 at 16:48 UTC 
        sub filter (&@) {map {$_ [0] -> (); $_} @_ [1 .. $#_]}

    [download]

    Abigail

[reply]
[d/l]

      Yes, it isn't that hard to write one. But you missed one aspect in your version: filter { s/a/b/ } @list shouldn't modify the original @list.

      Let me go dig up my version...

      Update: Make that two features. (: I also think that 'filter' in a scalar context should return the concatenated values (a count is pretty useless): 

      package filter;

use strict;
require Exporter;
{ my $nowarn= *import }
*import= \&Exporter::import;
use vars qw( @EXPORT );
@EXPORT= qw( filter );

sub filter(&@) {
    my( $code, @vals )= @_;
    # local( $_ ); # Done by the loop.
    for(  @vals  ) {
        $code->();
    }
    wantarray ? @vals : join "", @vals;
}

1;

      [download]
      Though I've only tested this a little.

              - tye (filtering shouldn't be straining)
[reply]
[d/l]
[select]
            sub filter (&@) {map {local $_ = $_; $_ [0] -> (); $_} @_ [1 .. $#
+_]}

        [download]

        Abigail

[reply]
[d/l]
Re: (tye)Re: sorting an array with an array
by bart (Canon) on Oct 01, 2002 at 21:52 UTC
    In the first snippet, I originally had 'map' instead of 'grep'. 'map' will give back the return value from the s/// operator, which is not the modified string.
    (from another follow-up:)
    But you missed one aspect in your version: filter { s/a/b/ } @list shouldn't modify the original @list.
    In that case, make a copy. And return $_. 
      map { local $_ = $_; s/^[^-]*-//; $_ } LIST

    [download]
[reply]
[d/l]
Re^2: sorting an array with an array
by Aristotle (Chancellor) on Oct 04, 2002 at 21:59 UTC
    Per Abigail-II's trail of thought with context sensitivity added: 
    sub filter (&@) {
    (wantarray ?
        sub { @_ } :
        sub { join '', @_ }
    )->(
        map { local $_ = $_; $_[0]->(); $_ }  @_[1 .. $#_]
    );
}

    [download]
    However, I really find this silly, as you can simply do the following: 
    sub filter (&@) {
    my ($func, @out) = @_;
    $func->() for @out;
    wantarray ? @out : join '', @out;
}

    [download]

    Makeshifts last the longest.

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom