Re: Golf/Perlish solution to this problem?
by ikegami (Patriarch) 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";
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: Golf/Perlish solution to this problem?
by BrowserUk (Patriarch) on Jan 31, 2008 at 03:09 UTC
|
print sub{map{pop,shift,shift,pop}1..@_/4}->(1..8);;
8 1 2 7 6 3 4 5
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply] [Watch: Dir/Any] [d/l] |
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), $/
| [reply] [Watch: Dir/Any] [d/l] |
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 | [reply] [Watch: Dir/Any] [d/l] |
Re: Golf/Perlish solution to this problem?
by jwkrahn (Abbot) on Jan 31, 2008 at 02:19 UTC
|
for ( 0 .. @array / 2 ) {
my ( $lower, $upper ) = ( shift @array, pop @array );
push @other_array, $lower % 2 ? ( $upper, $lower ) : ( $lower, $up
+per );
}
| [reply] [Watch: Dir/Any] [d/l] |
Re: Golf/Perlish solution to this problem?
by hipowls (Curate) on Jan 31, 2008 at 02:36 UTC
|
@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;-)
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
That gives 81726354 instead of 81276345
| [reply] [Watch: Dir/Any] |
|
| [reply] [Watch: Dir/Any] |
|
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
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] |
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. | [reply] [Watch: Dir/Any] [d/l] [select] |
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.
| [reply] [Watch: Dir/Any] [d/l] |
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;
| [reply] [Watch: Dir/Any] [d/l] |
Re: Golf/Perlish solution to this problem?
by GrandFather (Saint) on Jan 31, 2008 at 01:53 UTC
|
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
| [reply] [Watch: Dir/Any] [d/l] [select] |
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.
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] |
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 | [reply] [Watch: Dir/Any] [d/l] |
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 : ();
}
| [reply] [Watch: Dir/Any] [d/l] [select] |
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 ...
| [reply] [Watch: Dir/Any] |
Re: Golf/Perlish solution to this problem?
by poolpi (Hermit) on Jan 31, 2008 at 13:31 UTC
|
#!/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 | [reply] [Watch: Dir/Any] [d/l] [select] |
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 | [reply] [Watch: Dir/Any] [d/l] |