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:
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.
