Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Golf/Perlish solution to this problem?

by Cody Pendant (Prior)
on Jan 31, 2008 at 01:02 UTC ( #665247=perlquestion: print w/replies, xml ) Need Help??

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

I have the numbers 1 to n UPDATE: n is always a multiple of four.

I want to arrange them in the order "highest, lowest, next-lowest, next-highest, next-highest, next-lowest, etc".

For instance, with the numbers one to eight I want "8,1,2,7,6,3,4,5".

This code gets the job done, but I feel it's clunky. Anyone got a smarter way?

my @array = ( 1 .. 8 ); my @other_array = (); while (@array) { if ( $array[0] % 2 ) { push( @other_array, pop(@array), shift(@array) ); } else { push( @other_array, shift(@array), pop(@array) ); } } print "@other_array";


Nobody says perl looks like line-noise any more
kids today don't know what line-noise IS ...

Replies are listed 'Best First'.
Re: Golf/Perlish solution to this problem?
by ikegami (Pope) on Jan 31, 2008 at 02:38 UTC

    Works with any number of elements, non-destructive:

    sub a { @_<2 ? @_ : (pop,shift,&b) } sub b { @_<2 ? @_ : (shift,pop,&a) } print a(1..8), "\n";

    Works with a multiple of 4 elements, non-destructive:

    sub a { @_ ? (@_[-1,0,1,-2],a(@_[2..$#_-2])) : () } print a(1..8), "\n";

    Update: Even shorter,

    Works with a multiple of 4 elements, non-destructive:

    sub a { @_ ? (pop,shift,shift,pop,&a) : () } print a(1..8), "\n";
Re: Golf/Perlish solution to this problem?
by BrowserUk (Pope) on Jan 31, 2008 at 03:09 UTC
Re: Golf/Perlish solution to this problem? (&2)
by tye (Sage) on Jan 31, 2008 at 03:00 UTC
    sub hllhh { my( $hi )= @_; my $lo= 1; return map $_ & 2 ? $lo++ : $hi--, 1..$hi; } print join ' ', hllhh(8), $/

    - tye        

Re: Golf/Perlish solution to this problem?
by thospel (Hermit) on Jan 31, 2008 at 08:34 UTC
    Without going for total golf (tempting, but I can resist) I'd still write something like:
    my $n = 8; my $i = 1; my @array; push @array, $n--, $i++, $i++, $n-- while $n > $i; print "@array";
    This breaks the rule of not increasing/decreasing the same variable twice in the same statement, but in practise this will work in all versions of perl5. Notice that in fact it wouldn't work if pre-increment/pre-decrement had been used instead of post-increment/post-decrement
Re: Golf/Perlish solution to this problem?
by jwkrahn (Monsignor) on Jan 31, 2008 at 02:19 UTC

    Another way to do it:

    for ( 0 .. @array / 2 ) { my ( $lower, $upper ) = ( shift @array, pop @array ); push @other_array, $lower % 2 ? ( $upper, $lower ) : ( $lower, $up +per ); }
Re: Golf/Perlish solution to this problem?
by hipowls (Curate) on Jan 31, 2008 at 02:36 UTC

    If you are golfing then

    @n = map { $n + 1 - $_, $_ } 1 .. $n / 2;
    if it the divisible by 4 constraint wasn't present then a little more care is required
    use integer; @n = map { $n + 1 - $_, $_ } 1 .. $n / 2; push @n, $n / 2 + 1 if $n % 2;

    Update: As kindly pointed out by fellow monks I misread the specs. For the sake of completeness I give a correct (I hope) solution in the same vein as the previous offerings.

    @n = map { $n + 2 - 2 * $_, 2 * $_ - 1, 2 * $_, $n + 1 - 2 * $_ } 1 .. + $n / 4;
    Unfortunately it's not as golfy but it is still cryptic looking;-)

      That gives 81726354 instead of 81276345

        Silly me, I misread the problem.

      Except it gives the wrong answer:

      Wanted: 8 1 2 7 6 3 4 5 Given: 8 1 7 2 6 3 5 4

      Less important - the OP seems to want the array elements in that order rather than just a numeric sequence, but that's trivial to fix by using a slice.


      Perl is environmentally friendly - it saves trees
        Less important - the OP seems to want the array elements in that order rather than just a numeric sequence

        Except that the array elements that the OP wants in that order are: "I have the numbers 1 to n". I doubt s/he cares whether it is his/her original 1..n or just a generated numeric sequence. Just FYI.

        - tye        

Re: Golf/Perlish solution to this problem?
by kyle (Abbot) on Jan 31, 2008 at 03:22 UTC

    I had a working solution by the time the second one was posted, but I've been sitting here watching the thread and pasting all the solutions into the test framework I made. Here's what I came up with:

    sub kyle { my @array = @_; my @other_array = ( map( $_ % 2 ? ( $array[ -$_ ], $array[ $_ - 1 ] ) : ( $array[ $_ - 1 ], $array[ -$_ ] ), 1 .. @array / 2 ), ( $array[ @array / 2 ] ) x !!( @array % 2 ) ); return "@other_array"; }

    Note that the silly x!! business after the map is there to handle an odd number of elements that I didn't know would never be an input. The formatting is by perltidy because mine was ugly.

    Anyway, here's the test framework and all the code posted so far in one steaming package:

    I found testing these almost as interesting as the problem itself, so I'm going to blab a bit now about the testing.

    • It's fairly data-driven, so interested monks should have no problem having it focus only on a particular solution or any input cases they want.
    • Some of the solutions actually crash ("Modification of non-creatable array value attempted, subscript -2"), so I had to add Test::Exception to the testing. This was especially important when I was tossing in tests like [ 3 .. 11 ].
    • Some of these toss out a bunch of warnings. I haven't considered it significant, but it would be interesting to add tests for it (probably using $SIG{__WARN__}).

    Update: Added the solution from BrowserUk.

Re: Golf/Perlish solution to this problem?
by lidden (Curate) on Jan 31, 2008 at 02:12 UTC
    Gah! Seemed easy but the best I could think of right now is:
    @other_array = pop @array; while (@array > 3) { push @other_array, splice @array, 0, 2; push @other_array, reverse splice @array, -2; } push @other_array, splice @array, 0, 2 if @array > 1; push @other_array, shift @array if @array;
Re: Golf/Perlish solution to this problem?
by rjray (Chaplain) on Jan 31, 2008 at 01:24 UTC

    This is just off the top of my head, and could probably be shorter. This assumes that @array is a multiple of 4 elements, and drops anything that's modulo 4:

    my @array = (1 .. 8); my @other = (); while ((@array % 4) == 0) { push(@other, $array[$#array], @array[0, 1], $array[$#array - 1]); splice(@array, 0, 2); splice(@array, -2); }

    If you want to handle a remainder chunk specially, you can do so after the while exits...

    Edit: This is bad in that the modulo/lost elements are from the center of the list, not the end. Unless you are certain that you list is always a multiple of 4 in length, you'll definitely want to handle the remainder.

    --rjray

Re: Golf/Perlish solution to this problem?
by GrandFather (Sage) on Jan 31, 2008 at 01:53 UTC

    I sorta like:

    use strict; use warnings; my @array = (1 .. 8); my @other; while (@array) { push @other, @array[-1, 0, 1, -2]; splice @array, 0, 2; splice @array, -2, 2; } print "@other";

    but it'd be nice to clean up the splices in some fashion. Of course if you don't want to destroy the original array you could:

    use strict; use warnings; my @array = (1 .. 8); my @other; push @other, @array[-$_ * 2 - 1, $_ * 2, $_ * 2 + 1, -$_ * 2 -2] for 0 .. $#array / 4; print "@other";

    Perl is environmentally friendly - it saves trees
Re: Golf/Perlish solution to this problem?
by 2Bad4U (Initiate) on Jan 31, 2008 at 09:11 UTC
    here is my solution (hopefully i haven't overseen something...):
    #!/usr/bin/perl use strict; use warnings; my @in = (1 .. 12); my @out = reverse @in[$#in / 2 + 1 .. $#in]; splice @out, $_ * 2 - (($_ % 2) ? 1 : 2), 0, $_ for (@in[0 .. $#in / 2 +]); print "in: \t@in\n"; print "out: \t@out\n";
    prints:
    in: 1 2 3 4 5 6 7 8 9 10 11 12
    out: 12 1 2 11 10 3 4 9 8 5 6 7

    bye

    update 1: corrected the code and added the output

Re: Golf/Perlish solution to this problem?
by johngg (Canon) on Jan 31, 2008 at 10:49 UTC
    This solution is non-destructive and uses an array slice rather than push'ing, pop'ing and shift'ing.

    use strict; use warnings; my @array = qw{ ace big cat dog egg fig gog hog }; my @newArray = @array[ reOrder( scalar @array ) ]; print qq{@newArray\n}; sub reOrder { my $length = shift; die qq{Array length not a multiple of 4\n} if $length % 4; my $low = 0; my $high = $length - 1; return map { $_ % 2 ? ( $high --, $low ++) : ( $low ++, $high --) } 1 .. $length / 2; }

    The output.

    hog ace big gog fig cat dog egg

    Cheers,

    JohnGG

    Update: Re-factored subroutine to handle any length of array.

    sub reOrder { my $length = shift; my $low = 0; my $high = $length - 1; my @slice = map { $_ % 2 ? ( $high --, $low ++) : ( $low ++, $high --) } 1 .. $length / 2; return @slice, $low == $high ? $low : (); }

Re: Golf/Perlish solution to this problem?
by pKai (Priest) on Jan 31, 2008 at 21:50 UTC

    When I read the OP, I immediately remembered back some 20 years ago, when I had to solve the same problem at $work.

    As it hasn't been mentioned so far, and in case the random monk is wondering what the whole procedure is good for:

    That reordering of 1..n; !(n%4) is needed, when you want to print a booklet from n pages, 2 pages on one, duplex.

    By searching for "booklet page reorder" (or similar) with your www search engine of choice, you'll be able to find some descriptions and even illustrations on the topic.

      You are 100% correct, pKai, good for you, that's exactly what I needed it for.

      And thanks to everyone else for their contributions.



      Nobody says perl looks like line-noise any more
      kids today don't know what line-noise IS ...
Re: Golf/Perlish solution to this problem?
by Cody Pendant (Prior) on Jan 31, 2008 at 02:28 UTC
    Sorry, I should have mentioned, the length of the array will always be a multiple of four.


    Nobody says perl looks like line-noise any more
    kids today don't know what line-noise IS ...
Re: Golf/Perlish solution to this problem?
by poolpi (Hermit) on Jan 31, 2008 at 13:31 UTC

    timtowtdi

    #!/usr/bin/perl use strict; use warnings; @_ = ( 1 .. 12 ); my @a = map { my @l = (($#_+1)-$_ => $_+1); ($_+1)%2 ? @l : reverse @l; } 0..$#_>>1; print "@a";

    Output : 12 1 2 11 10 3 4 9 8 5 6 7

    PooLpi

Re: Golf/Perlish solution to this problem?
by rir (Vicar) on Jan 31, 2008 at 17:02 UTC
    I appreciate BrowserUk's nifty answer, but I'd keep it simple:
    while ( @ar ) { push @result, pop(@ar), shift(@ar), shift(@ar), pop(@ar); }
    Be well,
    rir

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (3)
As of 2020-07-08 04:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?