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

This is mostly for elegance in code than anything else, but can anybody optimize the following snippet of code?

my $cmp_shift = (($a cmp $b) * ($top cmp $a) * ($top cmp $b)) || (($top eq $b) <=> ($top eq $a));

I'm not sure if there's some sort of rules involving algebraic simplification of comparitive operators, but it would be a nice thing to know in this case. Converting comparitive statements to variables and trying multiplicative simplification doesn't yield anything. I'm pretty good with logic, but not to this degree.

The overall goal on this sort function was to have a forced starting value, and have everything before the starter to be appended to the end. Like, if J was the starter and the values was A-N, the list would be JKLMNOABCDEFGHI.

The first part of the code (before the ||) works well except if the starter actually popped in as $a or $b. Hence, it checks for a zero and the right side of the OR fixes that.

This seems overly complex and messy, but I wanted to see if I could get it down to a single logic/comparison formula. Here's the entire test code, with debug data:

@unsort = sort { int(rand(3)) - 1 } ('aaa','yyy','fff','bbb','eee','dd +d','fff','jjj','iii','kkk','zzz','xxx','vvv','sss'); print "T\tA\tB\tA<>B\tT<>A\tT<>B\tTA<>TB\tRESULT\n"; @sort = sort { &sort_alpha_wrap('jjj',$a,$b); } @unsort; print join("\n", @sort)."\n"; sub sort_alpha_wrap { my ($top, $a, $b) = @_; my $cmp_shift = (($a cmp $b) * ($top cmp $a) * ($top cmp $b)) || (( +$top eq $b) <=> ($top eq $a)); print "$top\t$a\t$b\t".($a cmp $b)."\t".($top cmp $a)."\t".($top cm +p $b)."\t".(($top eq $b) <=> ($top eq $a))."\t$cmp_shift\n"; return $cmp_shift; }

Replies are listed 'Best First'.
Re: Optimizing a sort function (wrap-around alpha)
by Roy Johnson (Monsignor) on Apr 15, 2005 at 11:26 UTC
    I get your desired effect with this:
    use strict; use warnings; use List::Util 'shuffle'; my @list = shuffle('A'..'N', 'I'..'K'); my $pick = 'J'; print sort {(($a lt $pick) == ($b lt $pick)) ? ($a cmp $b) : ($b cmp $ +a)} @list;
    Technically, each of those lt's should be a ternary operation, because values for true could be different.

    Update: this GR transorm also works:

    use strict; use warnings; use List::Util 'shuffle'; my @list = shuffle('A'..'N', 'I'..'K'); my $pick = 'J'; ++(my $after_pick = $pick); print map substr($_,1), sort map {$_ lt $pick ? "$after_pick$_" : "$pi +ck$_"} @list;

    Caution: Contents may have been coded under pressure.

      Technically, each of those lt's should be a ternary operation, because values for true could be different.

      How about using ! xor instead of == ?

      !(($a lt $pick) xor ($b lt $pick)) ? ...

      Update: Alternatively, you could "booleanize" each side of the comparison with !:

      ( !($a lt $pick) == !($b lt $pick) ) ? ...
      Hmmm, I think ! xor is clearer; it's the "semantically correct" way to test two booleans for equality.

      the lowliest monk

      Yeah, that first one works, and looks a lot better. I knew I was making it too complex. Thanks.
Re: Optimizing a sort function (wrap-around alpha)
by Anonymous Monk on Apr 15, 2005 at 11:29 UTC
    I'd write that as:
    my @sorted = ((sort grep {$_ ge $top} @unsort), (sort grep {$_ lt $top} @unsort));
    Or, if you really insist on a single sort:
    my @sorted = map {substr $_, 1} sort map {sprintf "%s%s", (0, 1, 2)[$top cmp $_], $_} @unsorted;
    Neither technique uses a sort block, and that usually means it's more efficient than a method using a sort block.
      And yet another way:
      my %h; push @{$h{$_ cmp $top}}, $_ for @unsorted; my @sorted = (@{$h{0}}, sort(@{$h{1}}), sort(@{$h{-1}}));
      It's using a single pass bucket-sort as first step. Again note the absense of a sorting block.
      For the latter solution, you must have meant [$_ cmp $top] instead of [$top cmp $_].
use Sort::Key
by salva (Canon) on Apr 15, 2005 at 14:42 UTC
    I have a module on CPAN that makes it really easy:
    use Sort::Key; @sorted = keysort { ($_ ge $top ? 'a' : 'b').$_ } @unsort;
      What should happen in this case?
      my @data; foreach ( 1 .. 100 ) { push @data, [ map { rand(200) - 100 } 1 .. 100 ]; } my $pivot = 0; my @sorted = keysort { my $v = $_; my @v = keysort { $_ > $pivot ? 1 : -1 } @{$v}; $v[50] } @data;
        well, what are you trying to do?

        The inner keysort on your code is equivalent to:

        @v=((grep { $_ <= $pivot } @$v), (grep { $_ > $pivot } @$v));
        is that what you intended?

        I suppose that what you really want is to mimic the sort on the original post but numerically: sort first the elements > $pivot and then the rest.

        Then, for your specific data, integers between -100 and 100, this works:

        my @v=nkeysort { $_<$pivot ? $_ + 200 : $_ } @$v;
        but if you know nothing about the numbers in $@v, then figuring a convenient sorting key can be quite difficult, it's easier to just use a grep/sort combination:
        my @v=((sort {$a<=>$b} (grep { $_ >= $pivot } @$v)), (sort {$a<=>$b} (grep { $_ < $pivot } @$v)));
        that inserted on the outer sort becomes:
        my @sorted = nkeysort { ( ( sort {$a<=>$b} (grep { $_ >= $pivot } @$_) ), ( sort {$a<=>$b} (grep { $_ < $pivot } @$_) ) )[50] } @data;
        BTW, note that for numeric keys you have to use nkeysort.
Re: Optimizing a sort function (wrap-around alpha)
by TedPride (Priest) on Apr 15, 2005 at 14:03 UTC
    Unless I'm missing something here, both of those last two solutions give the letters in the wrong order. The order requested is divider, after, before - not before, divider, after. The following should work:
    use strict; use warnings; my $str = 'AFNMIWEBFASBPMLASIFBYRW'; my $mid = 'I'; my @sorting; push @{$sorting[($_ cmp $mid) + 1]}, $_ for split '', $str; $str = join '', @{$sorting[1]}, (sort @{$sorting[2]}), (sort @{$sortin +g[0]}); print $str;