Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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:

#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; my @solutions = ( 'Cody_Pendant', \&Cody_Pendant, 'kyle', \&kyle, 'GrandFather1', \&GrandFather1, 'GrandFather2', \&GrandFather2, 'rjray', \&rjray, 'lidden', \&lidden, 'jwkrahn', \&jwkrahn, 'hipowls', \&hipowls, 'ikegami1', \&ikegami1, 'ikegami2', \&ikegami2, 'tye', \&tye, 'BrowserUk', \&BrowserUk, ); my @tests = ( [ 1 .. 8 ], [ 1 .. 16 ], ); plan 'tests' => scalar @tests * scalar @solutions; # Cody_Pendant's results are the definition of 'correct' my @correct = map { Cody_Pendant( @$_ ) } @tests; # this loop does the actual testing. while ( @solutions ) { my ( $name, $s ) = ( shift @solutions, shift @solutions ); foreach my $n ( 0 .. $#tests ) { my $test = $tests[$n]; my $test_name = sprintf '%s( %d .. %d )', $name, $test->[0], $test->[-1] +; my $lives = lives_ok( sub { $s->( @{$test} ) }, "$test_name executes and survives" ); SKIP: { skip "$test_name died", 1 if ! $lives; is( $s->( @{$test} ), $correct[$n], "$test_name" ); } } } ### solutions follow ### 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"; } sub Cody_Pendant { my @array = @_; my @other_array = (); while (@array) { if ( $array[0] % 2 ) { push( @other_array, pop(@array), shift(@array) ); } else { push( @other_array, shift(@array), pop(@array) ); } } return "@other_array"; } sub rjray { my @array = @_; my @other = (); while ((@array % 4) == 0) { push(@other, $array[$#array], @array[0, 1], $array[$#array - 1 +]); splice(@array, 0, 2); splice(@array, -2); } return "@other"; } sub GrandFather1 { my @array = @_; my @other; while (@array) { push @other, @array[-1, 0, 1, -2]; splice @array, 0, 2; splice @array, -2, 2; } return "@other"; } sub GrandFather2 { my @array = @_; my @other; push @other, @array[-$_ * 2 - 1, $_ * 2, $_ * 2 + 1, -$_ * 2 -2] for 0 .. $#array / 4; return "@other"; } sub lidden { my @array = @_; my @other_array; @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; return "@other_array"; } sub jwkrahn { my @array = @_; my @other_array; for ( 0 .. @array / 2 ) { my ( $lower, $upper ) = ( shift @array, pop @array ); push @other_array, $lower % 2 ? ( $upper, $lower ) : ( $lower, + $upper ); } return "@other_array"; } sub hipowls { my @array = @_; # I don't think I understood hipowls's solution my $n = @array; my @other_array = map { $n + 1 - $_, $_ } 1 .. $n / 2; return "@other_array"; } sub ikegami_a { @_<2 ? @_ : ((pop),(shift),&ikegami_b) } sub ikegami_b { @_<2 ? @_ : ((shift),(pop),&ikegami_a) } sub ikegami1 { my @array = @_; my @other_array = ikegami_a(@array); return "@other_array"; } sub ikegami2a { @_ ? (@_[-1,0,1,-2],ikegami2a(@_[3..$#_-3])) : () } sub ikegami2 { my @array = @_; my @other_array = ikegami2a(@array); return "@other_array"; } sub tye { my @array = @_; my $hi = $array[-1]; my $lo = 1; my @other_array = map $_ & 2 ? $lo++ : $hi--, 1..$hi; return "@other_array"; } sub BrowserUk { my @array = @_; my @other_array = sub{map{pop,shift,shift,pop}1..@_/4}->(@array); return "@other_array"; } sub example { my @array = @_; my @other_array; return "@other_array"; }

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.


In reply to Re: Golf/Perlish solution to this problem? by kyle
in thread Golf/Perlish solution to this problem? by Cody Pendant

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others drinking their drinks and smoking their pipes about the Monastery: (4)
    As of 2021-01-24 03:22 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?