clintp has asked for the wisdom of the Perl Monks concerning the following question:
This isn't a problem to test your Perl smarts. It's one to test your programming smarts. :)
Working on a sideproject indirectly involved with Parrot, I recently came across a tough problem. I managed to solve it, but the solution is inelegant. Here's the problem:
Given these resources:
 A single stack, with the depth of the stack stored on top and strings to be sorted below that.
 The depth of the stack is arbitrary.
 Your tools for manipulating and examining the stack are exclusively limited to: push, pop, and rotate_up() (see below)
 No other stacks (arrays, hashes, etc..) or data structures allowed.
 But as many scalar variables as you wish
 You can use branches, conditional logic, loops, comparison operators, even functions (see next item), and any other control logic you wish.
 No lexical variables or closures are permitted. local() would be allowed.
 Running off the end of the stack (on either side) is a fatal exception.
 The stack *must* be returned in its original state. You may not manipulate items *below* the given depth.
Design a routine to sort the stack, and return to the caller with the stack looking like it did before (depth on top) except sorted below that point.
The restrictions, of course, are based on the current Parrot opcode set. Imagine yourself programming in assembly language...
A sample stack might be:
@stack=qw(d b f a e c 6); # < bottom .. top >
and you would have to produce:
@stack=qw(f e d c b a 6); # < bottom .. top >
The rotate_up instruction takes the thing on top of the stack and shifts it farther down in the stack, moving all of the displaced elements up a notch. rotate_up(0) and rotate_up(1) are noops. rotate_up with a negative number will throw a fatal exception.
# You are not allowed to modify this.
sub rotate_up {
local($a,$b);
$a=$_[0];
$a;
return if $a<1;
$b=pop @stack;
splice(@stack, $a, 0, $b);
}
So can ya do it?
Points are given for:
 Elegance. Did it take you 300 instructions to do it? Too bad. Mine worked in about 100 and it's for crap. :)
 Simplicity. The flipside of elegance. The ease of which this translates to machine code will swell your karma.
 Speed. Pull off a bubblesort in 50 instructions, and I'll be impressed. Do a quicksort in 50 and I'll babysit your kids and wash your car.
Points are deducted for:
 Golfing in an obfuscatory manner. When I go to translate your solution back into PASM, I'll be very, very upset with golfers and obfu "artists".
 Violating the spirit of things. Being cute with eval to modify the stack? Simulating arrays with namespace manipulation? Poser.
If you need inspiration or think this is beneath you: I'd like you to consider the Story of Mel and what a Real Hacker would do. :)
I'll post my solution as a reply on Monday March 25th at 5pm Eastern Standard time. You may be horrified. :)
Re: Algorithm Pop Quiz: Sorting
by RMGir (Prior) on Mar 25, 2002 at 01:46 UTC

Quiver in fear, for here is my unholy answer :)
#!/usr/bin/perl w
use strict;
my @stack=qw(d b f a e c 6); # < bottom .. top >
# You are not allowed to modify this.
sub rotate_up {
local($a,$b);
$a=$_[0];
$a;
return if $a<1;
$b=pop @stack;
splice(@stack, $a, 0, $b);
}
sub sortIt {
print "before stack is ",(join ", ",@stack),"\n";
my $initLen=pop @stack;
my $currLen=$initLen;
# strategy: find the largest element, push it to bottom.
# reduce size by one, repeat
while($currLen) {
my $max;
my $rot=$currLen;
my $maxLoc=1;
#print "Len $currLen, stack is ",(join ",", @stack),"\n";
# find largest element, and save its position
while($rot>=1) {
my $x=pop @stack;
if (!defined $max  ($x gt $max)) {
$maxLoc=$rot;
$max=$x;
}
push @stack, $x;
rotate_up($rot) if($rot>1);
$rot;
#print "examined $x, max is ($maxLoc, $max), stack is ",(j
+oin ",", @stack),"\n";
}
# bring largest elem back up to top
while($maxLoc>1) {
rotate_up($maxLoc);
#print "bumping up, stack is ",(join ",", @stack),"\n";
}
# push it to bottom
rotate_up($currLen);
}
push @stack, $initLen;
print "Finished, ending stack is ",(join ", ",@stack),"\n";
}
# initial test case
sortIt();
# test reversed
@stack=qw(a b c d e f 6); # < bottom .. top >
sortIt();
# test sorted
sortIt();
# test 1 element stack
@stack=qw(f 1); # < bottom .. top >
sortIt();
@stack=qw(a a f a a 5); # < bottom .. top >
sortIt();
# empty stack
@stack=qw(0); # < bottom .. top >
sortIt();
# make sure items below stack aren't touched
@stack=qw(dontmoveme1 dontmoveme2 a a f a a 5); # < bottom .. top 
+>
sortIt();
Works for me!

Mike
(Edit: Updated with comments, added test cases, made the sort code into a subroutine to make testing simpler, added "before and after" printouts for testing)  [reply] [d/l] 
Re: Algorithm Pop Quiz: Sorting
by seattlejohn (Deacon) on Mar 25, 2002 at 07:20 UTC

The meat of my solution (use strict, support subs, etc. not shown for brevity) is:
sub sort_stack {
# How deep is the stack?
my $depth = pop @stack;
my $original_depth = $depth;
# stacks with 0 or 1 elements already sorted
while ($depth > 1) {
# peek at top of stack, and assume it's the biggest item on there
+until we determine otherwise
my $top = pop @stack;
push @stack, $top;
my $biggest = $top;
my $position = 0;
# rotate through other stack elements to see if there are any bigg
+er ones
for my $rotations (1..$depth) {
rotate_up($depth);
$top = pop @stack;
push @stack, $top;
if ($top gt $biggest) {
$biggest = $top;
$position = $rotations;
}
}
# rotate the biggest element into the bottom position
for my $rotations (1..$position+1) {
rotate_up($depth);
}
# now that the biggest element is at the bottom, reduce the depth
+and sort the rest
$depth;
}
# put original stack depth back on top
push @stack, $original_depth;
}
Ugh, I took this challenge to heart and wrote this code without looking at any previous posts, but I now see it bears a striking similarity to the solution RMGir posted before me. Oh, well.
The thing that annoys me about this is that it looks like it's O(n^2). Is it possible to implement an O(nlogn) sort given the problem constraints? Hmmm, something to think about...  [reply] [d/l] 

I like yours better, it's cleaner.

Mike
 [reply] 
Re: Algorithm Pop Quiz: Sorting
by rjray (Chaplain) on Mar 25, 2002 at 09:55 UTC

Oh bugger me, I had to see this at 1:00AM when I was about to go in for the night...
I'm not sure that I see a quicksort coming out of this. With the limitation on accessing the stack and all, plus no allowances for making arrays or new stacks, handling the recursion would be a nightmare. I once had to write a nonrecursive implementation of quicksort as a class exercise, and it damn near drove me into the arms of the music department as a result.
Here's a bubblesort. I'm not sure how you count instructions. If I count every assignment, count each conditional as one (each of the two while's and an if), then a condclause as well (the else), plus one count for calls like pop, push and rotate_up, then I get somewhere around 24. That's probably not quite right, though, or your challenge would have been for a lower number.
Bubblesort is still an O(N^{2}) algorithm, though it is better in most cases than a selection sort. There is an earlytermination form of the algorithm, but I'm already up past my bedtime. If I get a chance to look at this again before deadline, I'll see if I can adapt that. Big raspberries to the people who say that studying computer science in universities is a waste of time (and I know a lot of them at my dayjob).
If I take complete leave of my senses, I'll see if I can remember that nonrecursive qsort...
rjray
# Assume that rotate_up as defined in the original problem
# statement has been defined.
sub sordid
{
local $len = pop(@stack);
local $bum = $len;
local ($x, $y, $limit);
while ($bum > 1)
{
$limit = $bum;
while ($limit)
{
$x = pop(@stack);
$y = pop(@stack);
if ($x gt $y)
{
push(@stack, $x);
push(@stack, $y);
}
else
{
push(@stack, $y);
push(@stack, $x);
}
rotate_up($bum);
}
# At end of the $limit loop, top element is the max, and
# top+1 to end is semisorted. One more rotate_up()
# is needed before moving the floor up one notch.
rotate_up($bum);
$bum;
}
push(@stack, $len);
}
@stack = qw(d b f a e c 6); # < bottom .. top >
print "(@stack)\n";
# Prints: (d b f a e c 6)
sordid();
print "(@stack)\n";
# Prints: (f e d c b a 6)
 [reply] [d/l] 

I knocked together an almost identical bit of code, apart from the gt bit, which really is the same:
sub sort_stack {
local $depth = pop @stack;
local $sort_depth = $depth;
for (1..$depth) {
for (1..$sort_depth) {
local $top = pop @stack;
local $next = pop @stack;
if ($top gt $next) {
$top ^= $next;
$next ^= $top;
$top ^= $next;
}
push @stack, $next, $top;
rotate_up($sort_depth);
}
rotate_up($sort_depth);
$sort_depth;
}
push @stack, $depth;
}
Although I hadda go and use an xor swap, to make it look quite cool..  [reply] [d/l] 

$ perl e'$a="a"; $b="bbb"; $a^=$b; $b^=$a; $a^=$b; print "/$a/,/$b/\n
+"; print length($a),"\n"; print length($b),"\n"'
/bbb/,/a/
3
3

Mike  [reply] [d/l] 



BZZZT
I'm going to disallow this one as it's relying on a feature that's language dependent for its implementation (the XOR swap for stings). The sprit is there, but you're starting to wander. This kind of behavior needs to be discouraged early! Use the extra register for the swap. :)
These are all so good though. The excitement is terrible. Just terrible!
 [reply] 

OK, here's the earlyexit version. This proved more straightforward than I was expecting. I was so sure that applying the knowledge of lastexchange would be difficult, I overlooked how trivial it actually is.
(This is still a bubblesort, but it no longer is compelled to iterate [ $length  1 ] times. Rather, the falsebottom can jump over several iterations if there is a clump of sorted elements at the end. Given the sixelement sample list here, it saves only 3 iterations of the innerloop, 17 versus 20 in my original.)
# Assume that rotate_up as defined in the original problem
# statement has been defined.
sub sordid
{
local $len = pop(@stack);
local $bum = $len;
local ($x, $y, $limit, $last_swap);
while ($bum > 1)
{
$limit = $bum;
$last_swap = 0;
while ($limit)
{
$x = pop(@stack);
$y = pop(@stack);
if ($x gt $y)
{
push(@stack, $x);
push(@stack, $y);
$last_swap = $bum  $limit;
}
else
{
push(@stack, $y);
push(@stack, $x);
}
rotate_up($bum);
}
# At end of the $limit loop, top element is the max, and
# top+1 to end is semisorted. One more rotate_up()
# is needed before moving the floor up one notch.
rotate_up($bum);
$bum = $last_swap;
}
push(@stack, $len);
}
@stack = qw(d b f a e c 6); # < bottom .. top >
print "(@stack)\n";
# Prints: (d b f a e c 6)
sordid();
print "(@stack)\n";
# Prints: (f e d c b a 6)
rjray
 [reply] [d/l] 

Wow, I like this one.
Cool!

Mike
 [reply] 
Quicksort (of a stack)
by robin (Chaplain) on Mar 26, 2002 at 08:33 UTC

Here's a basic quicksort implementation. Because we don't have random access to the stack, I've used the top element as the pivot. That has the unfortunate effect that we get worstcase (quadratic) behaviour if the input list is already sorted! Bubblesort would actually be better in that case. For a random input list, the asymptotic behaviour should be O(n log n), on the assumption that rotate_up takes constant time.
I think it'll translate to fewer than 50 instructions of assembler, but I don't have kids or a car :)
sub debug ($;@) {
# Uncomment the next line to see a partial execution trace
# print @_;
}
my @stack = @ARGV; # Initialise the stack with test value
+s
push @stack, scalar(@stack); # Push the length
quicksort(); # call the sort routine
print "Result: @stack\n"; # and print the result
sub quicksort {
local ($n) = pop(@stack);
push @stack, $n;
push @stack, 0;
sort_and_tuck();
push @stack, $n;
}
sub sort_and_tuck {
local ($w) = pop(@stack); # where to put result
local ($c) = pop(@stack); # number of items
debug " \$w=$w; \$c=$c; \@stack=@stack\n";
if ($c == 1) {
rotate_up($w+1);
}
elsif ($c > 1) {
local ($p) = pop(@stack); # pivot
$c;
local ($n) = $c;
local ($i) = $c;
debug "\t< \$p=$p; \$n=$n";
while ($i) {
local ($e) = pop(@stack); # examine top element
push @stack, $e;
debug "\t\t\$e=$e (@stack)\n";
if ($p gt $e) {
rotate_up($c);
 $n;
}
else {
rotate_up($n);
}
}
debug "\t> \$n=$n\n";
# Now we've partitioned the list. The top $n elements are gt $
+p,
# and the next ($c$n) are le $p. Sort the partitions.
local($r) = $c$n;
push @stack, $n;
push @stack, $w+$r;
sort_and_tuck();
push @stack, $r;
push @stack, $w;
sort_and_tuck();
push @stack, $p; # Reinsert the pivot
rotate_up(1+$w+$r);
debug " Return: @stack\n"
}
}
# Should be called put_away(), but I'm not allowed to modify it ;)
sub rotate_up {
local($a,$b);
$a=$_[0];
$a;
return if $a<1;
$b=pop @stack;
splice(@stack, $a, 0, $b);
}
 [reply] [d/l] 

Excellent. If you'll notice I *did* post a function (in PASM) that does a peek into the stack. The $2 question is, does the overhead of that function destroy the benefits of a quicksort? (I'll bet it does.) This is kinda cool though.
 [reply] 

Yeah I agree. I don't think it would be worth it.
The quicksort should still be quicker than bubblesort most of the time  substantially quicker if there are a lot of elements to sort. If you do get this implemented in parrotcode, I'd be interested in seeing any benchmarks etc.
It's an interesting curiosity that it's possible to do a sensible quicksort at all. I briefly considered using mergesort, but I don't think it can be done at all efficiently because there's only one stack.
 [reply] 
Re: Algorithm Pop Quiz: Sorting
by clintp (Curate) on Mar 25, 2002 at 22:55 UTC

Okay, here's my solution and it's  horror of horrors  a classic bubble sort. Since I had already implemented PEEK and REPLACE (for other things I needed) writing a simple bubble sort wasn't too much of a bother.
Everyone seemed to do the same sort of modified bubble sort, but they're more efficient than mine being selfcontained and not requiring SWAP and PEEK. With no objections I'd like to borrow the general algorithm for an OSS project  this PerlMonks thread cited.
Unless something frighteningly better comes along.
# Stack Library
# This'll get a whole lot cleaner when I can tell the
# depth of the stack automagically
# peek  return whatever string is on the stack
# Inputs: the offset on the stack
# Outputs: the string
# NonDestructive!
# Does *not* test for bounds conditions
PEEK: pushi
restore I0
set I3, I0
inc I0
set I2 0
PLOOP: ge I2, I3, POL
rotate_up I0
inc I2
branch PLOOP
POL:
restore S0
save S0
eq I0, 0, EOP
rotate_up I0
EOP: save S0
popi
ret
# REPLACE  replace thing at stack position X
# Inputs: the offset to remove
# the string to leave in its place
# Outputs: The string removed
# Note: Almost *identical* to PEEK above
# Does *not* test for bounds conditions
REPLACE: pushi
pushs
restore S1
restore I0
set I3, I0
inc I0
set I2, 0
RLOOP: ge I2, I3, ROL
rotate_up I0
inc I2
branch RLOOP
ROL: restore S0
save S1
eq I0, 0, ENDOFREPLACE
rotate_up I0
ENDOFREPLACE:
save S0
popi
pops
ret
# swap  swap the position of two strings on the stack
# Inputs: Offsets of the two things on the stack
# Outputs: None.
# Does *not* test for bounds conditions
SWAP: pushi
pushs
restore I0
restore I1
save I0
save "" # Just a dummy
bsr REPLACE
restore S0
save I1
save S0
bsr REPLACE
restore S1
save I0
save S1
bsr REPLACE
restore S1 # dummy
popi
pops
ret
# Sort whatever's on the stack.
# Yes, this is a bubble sort. Get over it.
# Inputs: Stack depth on top of the stack
# Outputs: Stack depth on top of the stack
SORTSTACK:
pushi
pushs
restore I5
set I0, 0
set I1, 0
BUBBLE: inc I1
le I1, I0, BUB1
set I1, 0
inc I0
BUB1: ge I0, I5, SORTEND
save I1
bsr PEEK
restore S2
save I0
bsr PEEK
restore S3
le S2, S3, BUBBLE
save I1
save I0
bsr SWAP
branch BUBBLE
SORTEND:
save I5
popi
pops
ret
What? You expected me to post Perl code? :)
Now, can you write me a general purpose expression evaluator given just the tokens on the stack? and...oh nevermind.
 [reply] [d/l] 
Is recursion allowed?
by robin (Chaplain) on Mar 25, 2002 at 17:54 UTC

I can't tell whether recursion is allowed or not. You say that there's only one stack; but you also say that we can use functions and local.
Is there another, secret stack that you can only access by using local in a recursive function? Or do values get pushed onto the main stack whenever local is called?  [reply] 

Parrot allows you to push all of the string registers (pointers, actually) and integer registers onto their own private stack with pushs, pushi and restore them with pops and popi. (Numerics and PMC's with n/p respectively.) So you *can* write recursive subroutines after a fashion but effectively you make the entire register set local to each recursion:
set I0, 100
bsr FUNC
print I0 # Gives 100
end
FUNC: pushi
set I0, 56
popi
ret
local() for a particular registister can be emulated but it's a pain in the ass with something like:
set I0, 100
set I1, 200
set I6, 700
bsr FUNC
#
print I0 # 100, original value
print I1 # 0, new value
print I6 # 0, new value
end
# Local changes to I1 and I6 preserved
# think of this as unlocal() :)
FUNC: pushi # saves all integer registers
set I0, 0
set I1, 0
set I6, 0
save I1
save I6
popi
restore I6
restore I1
ret
The answer to your other question (asked in /msg) is that no, you can't peer down the stack or get the stack's depth at this time. However you can simulate peering into the stack just fine with the tools given.  [reply] [d/l] [select] 

