#!/usr/bin/perl -w

use strict;
use warnings;

print "Quick Sort algorithm ported from QBASIC to Perl.\n\n";

my $REPEAT = 5000;

my @SAMPLE = (
  384, 12, 44, 847, 66, -324, 217, 550, -3, 18302, 136, 255,
  441, 4.5, -5, 77, 101, -2, 12, 74, 3, 933, 50, -7, 61, 52,
  902, 74, -23, 8, 32, 31, 32, 81, 22, -9, 65, 258, 71, -33,
  433, 985, 164, -19, 0, 1, 0.2, 783, 92, 10, 343, 195, -1);

my @COPY = @SAMPLE;

my $START_TIME1 = time;
for (my $i = 0; $i < $REPEAT; $i++)
{
  @SAMPLE = @COPY;
  @SAMPLE = sort {$a<=>$b} @SAMPLE;
}
my $END_TIME1 = time;
PrintList("Sorted list", @SAMPLE);

my $START_TIME2 = time;
for (my $i = 0; $i < $REPEAT; $i++)
{
  @SAMPLE = @COPY;
  QSort(@SAMPLE);
}
my $END_TIME2 = time;

PrintList("Sorted List", @SAMPLE);
print "sort operation took ", ($END_TIME1 - $START_TIME1), " second(s)\n";
print "QSort operation took ", ($END_TIME2 - $START_TIME2), " second(s)\n";
exit;


sub PrintList
{
  print shift, ":\n";
  print '-' x 78 . "\n";
  my $N;
  for (my $i = 1; @_; $i++)
  {
    $N = shift;
    print $N . "\t";
    if (($i % 9) == 0) { print "\n"; }
  }
  print "\n", '-' x 78, "\n";
}

#
# QuickSort algorithm ported from QBASIC to Perl.
#
# Usage: QSort(ARRAY_OF_NUMBERS)
#
sub QSort
{
  @_ or return;

  my $First = 0;
  my $Last = @_ - 1;
  my @QStack;
  my $StackPtr = 0;
  my $temp;
  my $i;
  my $j;

  for (;;)
  {
    do
    {
      $temp = $_[int(($Last + $First) / 2)];
      $i = $First;
      $j = $Last;

      do
      {
        while ($_[$i] < $temp) { $i++; }
        while ($_[$j] > $temp) { $j--; }
        if ($i < $j) { @_[$i, $j] = @_[$j, $i]; }
        if ($i <= $j) { $i++; $j--; }
      }
      while ($i <= $j);

      if ($i < $Last)
      {
        $QStack[$StackPtr++] = $i;
        $QStack[$StackPtr++] = $Last;
      }
      $Last = $j;
    }
    while ($First < $Last);

    $StackPtr or return;
    $Last = $QStack[--$StackPtr];
    $First = $QStack[--$StackPtr];
  }
}