Re: Golf/Perlish solution to this problem?

in reply to Golf/Perlish solution to this problem?

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";
}
[download]

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";
}
[download]

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.

Comment on Re: Golf/Perlish solution to this problem? Select or Download Code

In Section Seekers of Perl Wisdom