The Perl examples


#!/usr/bin/env perl
#
# $Id: sol4-17.pl,v 0.05 2024/04/05 16:19:18 kc4zvw Exp kc4zvw $

use 5.036_003;
use strict;
use warnings;

# fisher_yates_shuffle( \@array ) : generate a random permutation
# of @array in place

sub fisher_yates_shuffle {
        my $array = shift;
        my $i;

        for ($i = @$array; --$i;) {
                my $j = int rand ($i + 1);
                next if $i == $j;
                @$array[$i, $j] = @$array[$j, $i];
        }
}


####################
### main program ###
####################

my @array = qw/ 1 2 3 4 5 6 7 8 9 10 11 12 /;
my $path_to_file = "alpha.txt";
my $handle;

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


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

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";
}

# assuming @array is your array:
print join(", ", @array);
print "\n";
fisher_yates_shuffle(\@array);
print join(", ", @array);
print "\n\n";

# assuming @a is your array:
my @a = qw(abc def ghi jkl mno pqr stu vw xyz);
print "@a";
print "\n";
fisher_yates_shuffle(\@a);
print "@a";
print "\n\n";

# assuming @lines is your array:
print "@lines";
print "\n";
fisher_yates_shuffle(\@lines);
print "@lines";
print "\n\n";

# End of File


1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
8, 12, 7, 11, 9, 4, 3, 10, 2, 1, 6, 5

abc def ghi jkl mno pqr stu vw xyz
stu abc mno pqr vw jkl ghi def xyz

alpha bravo charlie delta echo foxtrot golf hotel india
foxtrot echo hotel india bravo delta alpha golf charlie


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

use 5.036_003;
use strict;
use warnings;


# ***=====================================================================
# **    
# **      Author: David Billsbrough 
# **     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


Shellsort Demo



The list has 5 elements.

  Unsorted list
--------------------
 Echo
 Delta
 Charlie
 Bravo
 Alpha


  Sorted list
--------------------
 Alpha
 Bravo
 Charlie
 Delta
 Echo




The list has 26 elements.

  Unsorted list
--------------------
 Zulu
 Yoke
 X-ray
 Wiskey
 Victor
 Uniform
 Tango
 Siera
 Romeo
 Quebec
 Papa
 Oscar
 November
 Mike
 Lima
 Kilo
 Juliet
 India
 Hotel
 Golf
 Foxtrot
 Echo
 Delta
 Charlie
 Bravo
 Alpha


  Sorted list
--------------------
 Alpha
 Bravo
 Charlie
 Delta
 Echo
 Foxtrot
 Golf
 Hotel
 India
 Juliet
 Kilo
 Lima
 Mike
 November
 Oscar
 Papa
 Quebec
 Romeo
 Siera
 Tango
 Uniform
 Victor
 Wiskey
 X-ray
 Yoke
 Zulu




The list has 12 elements.

  Unsorted list
--------------------
    12
    11
    10
     9
     8
     7
     6
     5
     4
     3
     2
     1


  Sorted list
--------------------
     1
     2
     3
     4
     5
     6
     7
     8
     9
    10
    11
    12


Finished.

The Perl 5 Project

Introduction

Example Number One

An example fisher_yates_shuffle in Perl

Example Number Four : a Shellsort

Resources

Miscellaneous