shellsort.pl

• package main
  • process_line
  • SwapElements
  • CalcListSize
  • StatusReport
  • DisplayTitle
  • DisplayList
  • DisplayNumbers
  • ShellSort
  • ShellSortNums
• EOF

#!/usr/bin/env perl
#
# $Id:$
#
# Program: Shell Sort Demo
#

use 5.036_003;
use strict;
use warnings;


## -------------------------------------------------------------

sub process_line($handle2)
{
	my $index = 0;
	my $count = 0;

	my $line = readline($handle2);

	chomp($line);							# frag the newline
	if (($line cmp "") == 0) { CORE::break };
	### @list[$index] = $line;
	printf "Adding %s to array\n", $line;
	$count = $index + 1;
	
	return ($count);
}

## -------------------------------------------------------------

sub SwapElements($a, $b)
{
	my $j = $a;
	my $i = $b;
	return ($i, $j);
}

## -------------------------------------------------------------

sub CalcListSize(@c_array)
{
	my $count = @c_array;
	return $count;
}


sub StatusReport(@list)
{
	my $count = &CalcListSize(@list);

	printf "\n\nThe list has %s elements.\n", $count;
	return $count;
}


sub DisplayTitle($param)
{
	my $Title = $param;

	print("\n");
	printf "  %s\n", $Title;
	print("--------------------\n");
}


sub DisplayList(@list2)
{
	my $NumberOfItems = CalcListSize(@list2);

	for (my $n = 0; $n < $NumberOfItems; $n++) {
		printf " %s\n", $list2[$n];
	}
	print "\n";
}

sub DisplayNumbers(@list2)
{
	my $NumberOfItems = CalcListSize(@list2);

	for (my $n = 0; $n < $NumberOfItems; $n++) {
		printf " %5d\n", $list2[$n];
	}
	print "\n";
}

## -------------------------------------------------------------

# Shell-Metzner Sort
# Adapted from Programming in Pascal, P. Grogono, Addison-Wesley, 1980
# From Borland Pascal Programs for Scientists and Engineers
# by Alan R. Miller, Copyright C 1993, SYBEX Inc

sub ShellSort(@list)
{
	my @a = ();
	my $n = CalcListSize(@list);
	my $done = 0;

	@a = @list;

	#printf "number of interations = %d\n", $n;
	#foreach (@a) { printf "%s, ", $_; } print "\n";

	my $jump = $n - 1;
	while ($jump > 1) {
		$jump = int($jump / 2);
		do {
			$done = 1;
			for (my $j = 0; $j < $n - $jump; $j++) {
				my $i = $j + $jump;
				if ($a[$j] gt $a[$i]) {
					($a[$i], $a[$j]) = SwapElements($a[$i], $a[$j]);
					## print "swapped: $a[$i] $a[$j]\n";
					$done = 0;
				}
			}
		} until ($done == 1);
	}
	return @a
}

## -------------------------------------------------------------

# Shell-Metzner Sort for Numbers
# Adapted from Programming in Pascal, P. Grogono, Addison-Wesley, 1980
# From Borland Pascal Programs for Scientists and Engineers
# by Alan R. Miller, Copyright C 1993, SYBEX Inc

sub ShellSortNums(@list)
{
	my @a = ();
	my $n = CalcListSize(@list);
	my $done = 0;

	@a = @list;

	#printf "number of interations = %d\n", $n;
	#foreach (@a) { printf "%s, ", $_; } print "\n";

	my $jump = $n - 1;
	while ($jump > 1) {
		$jump = int($jump / 2);
		do {
			$done = 1;
			for (my $j = 0; $j < $n - $jump; $j++) {
				my $i = $j + $jump;
				if ($a[$j] > $a[$i]) {
					($a[$i], $a[$j]) = SwapElements($a[$i], $a[$j]);
					## print "swapped: $a[$i] $a[$j]\n";
					$done = 0;
				}
			}
		} until ($done == 1);
	}
	return @a
}


### ----------------------- Main Routune ------------------------ ###

my @a = qw//;
my @array = qw/ 1 2 3 4 5 6 7 8 9 10 11 12 /;
my @numarray = qw/ 12 11 10 9 8 7 6 5 4 3 2 1 /;
my @b = qw//;
my @line = qw//;
my @list = qw//;
my @nums = qw//;

my $handle;
my $handle2;
my $NumberOfItems = 0;
my $path_to_file = "alpha.txt";
my $TextFile = "bravo.txt";


print "\n";
print "Shellsort Demo\n";
print "\n";

unless (open $handle, "<:encoding(ascii)", $path_to_file) {
        print STDERR "Could not open file '$path_to_file'.\n";
        die "No reason to continue : $!\n";
        #return undef
}

chomp(my @lines = <$handle>);
@a = @lines;

unless (close $handle) {
        # what does it mean if close yields an error and you are just reading?
        print STDERR "Don't care error while closing - '$path_to_file'.\n";
        warn "contining - $!\n";
}

unless (open $handle2, "<:encoding(ascii)", $TextFile) {
	print STDERR "Could not open file '$TextFile' : $!\n";
	die "Can't read input text file '$TextFile' for list data.\n$!\n";
}

### ($NumberOfItems, @list) = &process_line($handle2) until eof($handle2);
chomp(my @list = <$handle2>);

@b = @list;

close $handle2;


$NumberOfItems = &StatusReport(@a);

DisplayTitle("Unsorted list");
DisplayList(@a);

@line = &ShellSort(@a);

### @line = sort(@a);

DisplayTitle("Sorted list");
DisplayList(@line);

print "\n";

$NumberOfItems = &StatusReport(@b);

DisplayTitle("Unsorted list");
DisplayList(@b);

@list = &ShellSort(@b);

### @list = sort(@b);

DisplayTitle("Sorted list");
DisplayList(@list);

print "\n";

$NumberOfItems = &StatusReport(@numarray);

DisplayTitle("Unsorted list");
DisplayNumbers(@numarray);

### @nums = &ShellSortNums(@numarray);

@nums = sort {$a <=> $b} (@numarray);

DisplayTitle("Sorted list");
DisplayNumbers(@nums);

print "\n";
print "Finished.\n";

# End of Script