Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

criteria based array sorting

by zentara (Archbishop)
on Feb 12, 2004 at 12:43 UTC ( #328613=perlquestion: print w/replies, xml ) Need Help??

zentara has asked for the wisdom of the Perl Monks concerning the following question:

Hello, I'm sure this question has been asked in one form or another over the years, but the answer still eludes me.

I recently wanted to sort an array, with the sort order being sorted words beginning with a lowercase letter, followed by sorted words beginning with an uppercase letter. The following code does what I want, but was wondering if there is a "niftier" way?

#!/usr/bin/perl use strict; use warnings; my @needs_sorting = qw(Psdgs ldfgs Esdds aSdg Sgsdfs esdf sgfsdfg Osgr + T); print @needs_sorting,"\n"; my @lc = sort (grep{substr($_,0,1) eq lc(substr($_,0,1)) }@needs_sorti +ng); my @uc = sort (grep{substr($_,0,1) eq uc(substr($_,0,1)) }@needs_sorti +ng); print "@lc\n"; print "@uc\n"; push @lc,@uc; print join ',', @lc,"\n";
Then I got started thinking on how to arbtrarily define the order by another array. I found the follwing snippet, but it only works for "single letters, not words. It seems it should be easy enough to extend it to words, but the solution eludes me, and I've resorted to using my first method above.
#!/usr/bin/perl use strict; use warnings; my @sorted = ("a" .. "z", "A" .. "Z"); my @needs_sorting = ( qw (P l E a S e s O r T) ); my %S; @S{@needs_sorting} = (); my @is_sorted = grep { exists $S{$_} } @sorted; print join "|",@is_sorted;
So how would I modify the above code to say sort words by the first letter, if the criteria was complex like:
my @sorted = ('a' .. 'm','n' .. 'z','X' .. 'Z','A' .. 'W');
As in:
#!/usr/bin/perl use strict; use warnings; #not working my @sorted = ('a' .. 'm','n' .. 'z','X' .. 'Z','A' .. 'W'); my @needs_sorting = ( qw (Psdf lPik Easd aKwe SSdf eqwer scfgh Oegb rq +wer T) ); my %S; @S{@needs_sorting} = (); my @is_sorted = grep { ?????? $S{$_} } @sorted; print join "|",@is_sorted;

Replies are listed 'Best First'.
Re: criteria based array sorting
by broquaint (Abbot) on Feb 12, 2004 at 13:01 UTC
    A wee Schwartzian transform should do it
    my @unsorted = qw/Psdf lPik Easd aKwe SSdf eqwer scfgh Oegb rqwer T/; print "pre sorted: @unsorted\n"; my @sorted = map substr($_, 1), sort map { /^[a-z]/ ? "A$_" : "B$_" } @unsorted; print "post sorted: @sorted\n"; __output__ pre sorted: Psdf lPik Easd aKwe SSdf eqwer scfgh Oegb rqwer T post sorted: aKwe eqwer lPik rqwer scfgh Easd Oegb Psdf SSdf T
    See. japhy's Resorting to Sorting for more information on Schwartzian transforms and other sorting techniques.
    HTH

    _________
    broquaint

      That's not a Schwartzian Transform, but a GRT. The code is structurally similar, but works slightly differently. Though some consider the GRT to be a subset of the ST, this is a matter of debate.

      ----
      : () { :|:& };:

      Note: All code is untested, unless otherwise stated

        hardburn,
        Actually it is a variation on the GRT that tye likes to call The One True Sort. The subtle difference is that you do not have to restore the transformation - you can simply throw it away. An example of a classicle GRT would be:
        #!/usr/bin/perl use strict; use warnings; my @needs_sorting = qw(Psdgs ldfgs Esdds aSdg Sgsdfs esdf sgfsdfg Osgr + T); @needs_sorting = map { /^[a-z]/ ? "\u$_" : "\l$_" } sort map { /^[a-z]/ ? "\u$_" : "\l$_" } @needs_sorting; print "$_\n" for @needs_sorting;
        Cheers - L~R
Re: criteria based array sorting
by Limbic~Region (Chancellor) on Feb 12, 2004 at 12:51 UTC
    zentara,
    You could always use the ST:
    #!/usr/bin/perl use strict; use warnings; my @needs_sorting = qw(Psdgs ldfgs Esdds aSdg Sgsdfs esdf sgfsdfg Osgr + T); @needs_sorting = map { $_->[0] } sort { $a->[1] <=> $b->[1] || $a->[0] cmp $b->[0] } map { [$_ , substr($_ , 0 , 1) =~ /^[a-z]/ ? 0 : 1 ] } + @needs_sorting; print "$_\n" for @needs_sorting;
    Cheers - L~R
Re: criteria based array sorting
by Roy Johnson (Monsignor) on Feb 12, 2004 at 13:04 UTC
    Update: Originally solved the wrong problem. This version may be computationally simple enough that the ST suggested by others is unnecessary.
    print sort { if (($a=~/^[a-z]/) == ($b=~/^[a-z]/)) { $a cmp $b } else { $b cmp $a } } @needs_sorting;
    If the initial letters are the same case, sort normally
    If not, sort reverse (putting the lower first).

    Further update: I liked Broquaint's way of checking initial case.


    The PerlMonk tr/// Advocate
Re: criteria based array sorting
by Not_a_Number (Prior) on Feb 12, 2004 at 13:45 UTC

    TMTOWTDI

    my @sorted = (( sort grep { $_ eq lcfirst } @unsorted ), ( sort grep { $_ eq ucfirst } @unsorted ));

    dave

Re: criteria based array sorting
by zentara (Archbishop) on Feb 13, 2004 at 12:28 UTC
    Update: fixed typo's

    Well to complete this thread, I started digging around in the old nodes, and came across Language::MySort by japhy at Language::MySort.

    #!/usr/bin/perl use Language::MySort; my @order = ('s'..'z','a'..'r','R'..'Z','A'..'Q'); print q(order-> 's'..'z','a'..'r','R'..'Z','A'..'Q'),"\n"; *my_sort = lang_sort(@order); my @needs_sorting = qw(Psdgs ldfgs Esdds aSdg Sgsdfs zdef Xrty Msdb es +df sgfsdfg Osgr T); print join ',',@needs_sorting,"\n"; my @sorted = my_sort(@needs_sorting); print join ',',@sorted,"\n";
    OUTPUT: order-> 'r'..'z','a'..'s','R'..'Z','A'..'Q' Psdgs,ldfgs,Esdds,aSdg,Sgsdfs,zdef,Xrty,Msdb,esdf,sgfsdfg,Osgr,T, sgfsdfg,zdef,aSdg,esdf,ldfgs,Sgsdfs,T,Xrty,Esdds,Msdb,Osgr,Psdgs,
      I'm a big fan of Sort::ArbBiLex, myself. It's not quite the perfect lexical sort module, but it'll do for 99.995% of the population.

      --
      bowling trophy thieves, die!

      zentara,
      It appears you have a typo in that there is an overlap with 'r'..'z' and 'a'..'s' but it shouldn't cause a problem. Personally, I would steal a page from broquaint's bag of tricks:
      #!/usr/bin/perl use strict; use warnings; my @unsorted = ( qw (Psdf lPik Easd aKwe SSdf eqwer scfgh Oegb rqwer T +) ); my %order = map {$_ => /[r-z]/ ? 'A' : /[a-q]/ ? 'B' : /[R-Z]/ ? 'C' : + 'D'} ('a'..'z', 'A'..'Z'); my @sorted = map { substr($_ , 1) } sort map { $order{ substr($_,0,1) } . $_ } @unsorted; print "$_\n" for @sorted;
      Cheers - L~R
Re: criteria based array sorting
by hv (Parson) on Feb 12, 2004 at 14:10 UTC

    Yet another approach to the first part:

    @sorted = sort { substr($a, 0, 1) cmp substr($b, 0, 1) || lc($a) cmp lc($b) } @needs_sorting;

    Hugo

      That's not quite right: your method sorts case-sensitively (uppercase first) on the first letter, and otherwise sorts case-insensitively. Whether the OP wanted the sort to be otherwise case-insensitive is not clear, but he did ask for lowercase initial letters to be first.

      Here's a fix:

      sort { $b=~/^[a-z]/ <=> $a=~/^[a-z]/ or lc($a) cmp lc($b) }

      The PerlMonk tr/// Advocate
Re: criteria based array sorting
by zentara (Archbishop) on Feb 12, 2004 at 17:28 UTC
    Thank You all.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://328613]
Approved by EvdB
Front-paged by broquaint
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (12)
As of 2019-11-18 16:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Strict and warnings: which comes first?



    Results (90 votes). Check out past polls.

    Notices?