shellsort.pl

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

#!/usr/bin/env perl
#
# $Id:$

use 5.036_003;
use strict;
use warnings;


# ***=====================================================================
# **    
# **      Author: David Billsbrough <billsbrough@gmail.com>
# **     Created: Sunday, November 10, 2024 at 15:49:49 PM (EST)
# **     License: GNU General Public License - version 2
# **     Version: $Revision:$
# **    Warranty: None
# **    
# **     Purpose: ShellSort demo in Perl
# **    
# ***=====================================================================

#####################
###  Subroutines  ###
#####################

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 program  ###
######################


my @arr1 = 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 @arr2 = 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>);
@arr1 = @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>);

@arr2 = @list;

close $handle2;

#
#
#
$NumberOfItems = &StatusReport(@arr1);

DisplayTitle("Unsorted list");
DisplayList(@arr1);
@line = &ShellSort(@arr1);
### @line = sort(@arr1);
DisplayTitle("Sorted list");
DisplayList(@line);

print "\n";

#
#
#
$NumberOfItems = &StatusReport(@arr2);

DisplayTitle("Unsorted list");
DisplayList(@arr2);
@list = &ShellSort(@arr2);
### @list = sort(@arr2);
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