Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Algorithm Pop Quiz: Sorting

by clintp (Curate)
on Mar 25, 2002 at 00:09 UTC ( [id://153974]=perlquestion: print w/replies, xml ) Need Help??

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 side-project 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 no-ops. 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:

  1. Elegance. Did it take you 300 instructions to do it? Too bad. Mine worked in about 100 and it's for crap. :)
  2. Simplicity. The flipside of elegance. The ease of which this translates to machine code will swell your karma.
  3. 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:
  1. 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".
  2. 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. :)

Replies are listed 'Best First'.
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)
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...

      I like yours better, it's cleaner.
      --
      Mike
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 non-recursive 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 cond-clause 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.

    Bubble-sort is still an O(N2) algorithm, though it is better in most cases than a selection sort. There is an early-termination 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 day-job).

    If I take complete leave of my senses, I'll see if I can remember that non-recursive q-sort...

    --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 semi-sorted. 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)
      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..
        Sure, it looks cool. It's just wrong :)

        The problem with xor on strings is it will extend short ones. There are now 0 bytes there that weren't there before, and length changes.

        $ 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
        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!

      OK, here's the early-exit version. This proved more straight-forward than I was expecting. I was so sure that applying the knowledge of last-exchange would be difficult, I overlooked how trivial it actually is.

      (This is still a bubble-sort, but it no longer is compelled to iterate [ $length - 1 ] times. Rather, the false-bottom can jump over several iterations if there is a clump of sorted elements at the end. Given the six-element sample list here, it saves only 3 iterations of the inner-loop, 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 semi-sorted. 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

      Wow, I like this one.

      Cool!
      --
      Mike

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 worst-case (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); }
      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.
        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.

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 self-contained 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 # Non-Destructive! # 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.

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?

      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://153974]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-03-29 06:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found