Perl is a powerful language for prototyping applications. This chapter introduces you to implementing some practical algorithms using Perl as the base language. Once you have tested your algorithm you can use another faster language, but during testing the Perl interpreter will provide a quick turnaround for testing and debugging.
Perl programs can call the standard math library functions to give you greater computing power. The following functions are available to you as standard calls. All values of these functions are sent and returned as radians:
| Atan2($y,$x); | Returns the arc tangent in radians of the value of $y/$x. The value returned is always between PI and -PI. There is no atan() function because of the floating-point error problem. |
| cos($x); | Returns cosine of $x. |
| sin($x); | Returns sine of $x. |
| sqrt($x); | Returns the square root of $x. |
| log($x); | Returns the natural log of $x. |
| exp($x); | Returns e to the power of $x. |
| srand($x); | Seeds the random number generator. |
| rand($x); | Generates a random number based on the seed. |
| time; | Returns the number of seconds since Jan. 1, 1970. |
| int($x); | Returns the integer portion of $x. To get the fraction portion, use $x - int($x);. |
For most applications, these routines will suffice. Perl is linked with the math libraries for this function. Please check the man pages for the details of how to use these standard library functions.
Listing 29.1 presents a simple application that uses two subroutines to convert from polar to rectangular coordinates and then back again.
Listing 29.1. Using the math functions in Perl.
1 #!/usr/bin/perl
2
3 #
4 # Simple statistical functions in Perl
5 #
6
7 use Getopt::Long;
8
9 #----------------------------------------------------------------
10 # Declare any subroutines here
11 #----------------------------------------------------------------
12 sub toPolar($$); # Declare as taking two scalars
13 sub toRect($$); # Declare as taking two scalars
14
15 *PI = \3.1415926;
16 *PIBY2 = $PI / 2;
17 *TODEG = \57.2958;
18 *TORAD = \0.01745;
19
20 GetOptions('x=i', 'y=i');
21
22 $x = $opt_x;
23 $y = $opt_y;
24
25 ($r,$theta) = &toPolar($x,$y);
26
27 printf "The polar coordinates for %6.3f,%6.3f are \n", $x,$y;
28 printf " r = %6.3f and theta %6.3f or %6.3f degrees\n",
29 $r,$theta, $theta * $TODEG;
30
31 ($x1,$y1) = toRect($r,$theta);
32
33 printf "Compare x,y (%6.3f,%6.3f) with ", $x, $y, $x1, $y1;
34 printf " x1,y1 (%6.3f,%6.3f) \n", $x, $y, $x1, $y1;
35
36
37 sub toPolar { # ($$); # Declare as taking two scalars
38 my ($x,$y) = @_;
39 my $r;
40 my $t;
41
42 $r = sqrt( $x * $x + $y + $y ) ;
43 $t = atan2($y,$x);
44
45 return($r,$t);
46
47 }
48 sub toRect { #($$); # Declare as taking two scalars
49 my ($r,$t) = @_;
50 my $x;
51 my $y;
52
53 $x = $r * cos($t);
54 $y = $r * sin($t);
55
56 return($x,$y);
57 }
58
At line 37, the subroutine toPolar uses a prototype to specify two input parameters using the ($$) construct. Similarly, the toRect function also takes two parameters with the ($$) prototype. Both functions return two items each. The constants declared in lines 17 and 18 are not used in this program but are included only for reference or future use should you need them.
Let's add some more functionality to what you have just developed in the code in Listing 29.1. Let's start by adding some simple statistical routines.
Perhaps the most common function to perform on a list of numeric values is to calculate the average and standard deviation. Listing 29.2 presents a function that returns these values given an array of items.
Listing 29.2. Calculating the average and standard deviation.
1 #!/usr/bin/perl
2
3
4 #
5 # Simple statistical functions in Perl
6 #
7
8 use Getopt::Long;
9
10 #----------------------------------------------------------------
11 # Declare any subroutines here
12 #----------------------------------------------------------------
13 sub stats(\@); # Declare as taking reference to array.
14
15
16 GetOptions('file=s');
17 open (DATA,"$opt_file") || die "Cannot open $opt_file \n";
18
19 $i = 0;
20 while ($line = <DATA>)
21 {
22 chop $line;
23 ($date,$hi[$i],$lo[$i],$day[$i]) = split(' ',$line);
24 $i++;
25 }
26
27 ($ave,$max,$min,$std) = &stats(\@day);
28
29 printf " Average = %6.2lf \n", $ave;
30 printf " Maximum = %6.2lf \n", $max;
31 printf " Minimum = %6.2lf \n", $min;
32 printf " Std Dev = %6.2lf \n", $std;
33
34 close DATA;
35
36
37 #
38 # Compute simple stats on incoming stream.
39 #
40
41 sub stats {
42 #
43 # Allow passing of array either by reference or
44 # by its values.
45 #
46 my $a = ref($_[0]) ? $_[0] : \@_;
47 my $count = $#{$a} + 1;
48
49 #
50 # Bail out in case of erroneous data.
51 #
52 return(-1,-1,-1,-1) if ($count < 2);
53
54 print "$count items \n";
55 my $i;
56
57 #
58 # Initialize local variables. The assignment to 0
59 # is unnecessary for all scalars except $max and $min
60 # since Perl will initialize them to zero for you.
61 #
62 my $min = $$a[0];
63 my $max = $$a[0];
64 my $sum = 0;
65 my $sum2 = 0;
66 my $ave = 0;
67 my $std = 0;
68
69 #
70 # Get the required statistics
71 #
72 for $i (@$a) {
73 $sum += $i;
74 $sum2 += ($i * $i);
75 $max = $i if ($max < $i);
76 $min = $i if ($min > $i);
77 }
78 $ave = $sum/$count;
79 $std = (($sum2 - $sum * $ave)/($count - 1));
80 #
81 # Return the list of values back from function.
82 #
83 return ($ave,$max,$min,$std);
84 }
Look at line 23 in Listing 29.2. The data is stripped off into columns for you to work with. The format of the data file has the list of data points for each item in separate columns.
Also note that we are forcing the user to type in file=something for this program to work. If you never intend on passing any parameters to this program via the use of options, then it's better to use ARGV[1]. However, you will have to take care of things like missing or malformed strings in ARGV[1].
The stats subroutine is also defined via a prototype in line 13. Prototypes are discussed in Chapter 2, "A Brief Introduction to Perl." The stats subroutine is shown to take only one parameter, which is a pointer to an array.
Note how the input parameter to the stats function is derived using the ref() function call in line 46. If the passed parameter is a reference, then the function uses the first argument; otherwise, $a is assigned to the entire incoming argument list:
my $a = ref($_[0]) ? $_[0] : \@_;
The math operations are performed in lines 72 to 79. The results of these calculations are returned in line 83. Listing 29.1 and Listing 29.2 should be enough to get you started on creating more complicated functions. For example, let's add two routines for performing vector calculations.
Two subroutines that perform the cross and dot products of two vectors are shown in Listing 29.3. A cross product of a vector of length n and a vector of length m will return a matrix of size m ¥ n, whereas a dot product of two vectors of the same size (i.e., m = n) will return a scalar value.
Listing 29.3. Vector functions.
1 #!/usr/bin/perl
2
3 #
4 # Simple statistical functions in Perl
5 #
6
7
8 #----------------------------------------------------------------
9 # Declare any subroutines here
10 #----------------------------------------------------------------
11 sub xProduct(\@\@\@); # Declare as taking two pointers to arrays
12 sub dProduct(\@\@); # Declare as taking two pointers to arrays
13
14 @one = ( 2, 4, 3);
15 @two = ( 4, -1, 7);
16 @result = ();
17
18 $r = &dProduct(\@one,\@two);
19
20 print "\n Dot Product = $r \n";
21
22 &xProduct(\@one,\@two,\@result);
23
24 print "\n Cross Product = \n";
25 for ($i=0;$i<3;$i++) {
26 for ($j=0;$j< 3;$j++) {
27 printf " %4d", $result[$i][$j];
28 }
29 print "\n";
30 }
31
32 exit (0);
33 # ------------------------------------------------
34 # Returns dot product of two vectors.
35 # Takes two pointers to arrays as input
36 # Returns a scalar.
37 sub dProduct { #
38 my ($x,$y) = @_;
39 my $sum;
40 my $ct1 = $#{$x} + 1; # items in $x
41 my $ct2 = $#{$y} + 1; # items in $y
42 return undef if ($ct1 != $ct2) ;
43
44 for ($i=0;$i<$ct1;$i++) {
45 $sum += $$x[$i] * $$y[$i];
46 }
47 return $sum;
48 }
49 # ------------------------------------------------
50 # Returns a cross product of two vectors.
51 # Takes two pointers to arrays as input
52 # Returns a two-dimensional array.
53 sub xProduct {
54 my ($x,$y) = @_;
55 my $i, $j, @array;
56 my $ct1 = $#{$x} + 1; # items in $x
57 my $ct2 = $#{$y} + 1; # items in $y
58 my $result = \@arrau;
59 for ($i=0;$i<$ct1;$i++) {
60 for ($j=0;$j<$ct2;$j++) {
61 $$result[$i][$j] = $$x[$i] * $$y[$i];
62 # print " $i, $j, $$result[$i][$j] \n";
63 }
64 }
64 return ($result); return result.
65 }
Notice how the subroutines for the two functions are declared at lines 11 and 12. At line 18, the script calls dProduct to return the dot product of the two vectors. The return value from the dProduct function can also be undef if the vectors are not the same size.
At line 22, you get the resulting cross product matrix of multiplying the two vectors together. The size of the matrix is M¥N, where M is the size of the first vector and N is the size of the second vector passed into xProduct().
To return an entire result of a calculation instead of having to pass the @result array, you can rewrite the cross product function as shown in Listing 29.4. Line 9 now declares only two pointers to arrays into xProduct. The array in xProduct is referred to by reference as well at line 53. The reference, $result, is returned to the caller in line 64. Note the @array, even though declared as a my variable, is not destroyed because the reference to it in $result is returned by the xProduct function. As long as the returned reference to the calling program continues to be used, the space allocated for the @array will not be destroyed.
It's quite straightforward to include the two functions to add and subtract two vectors. These two subroutines are defined in Listing 29.4 at lines 65 and 87, respectively.
The number of elements in each array passed into the functions is kept in variables $ct1 and $ct2 (see lines 105 and 106). The counts are used in loops elsewhere in the code.
Listing 29.4. Calculations returning an array.
1 #!/usr/bin/perl
2
3 #---------------------------------------------------------------
4 # Vector Arithmetic Routines for use in Perl.
5 # Copy these freely with NO RESTRICTIONS AND NO WARRANTY!
6 #----------------------------------------------------------------
7 # Declare thy subroutines here
8 #----------------------------------------------------------------
9 sub xProduct(\@\@); # Declare as taking two pointers to arrays
10 sub dProduct(\@\@); # Declare as taking two pointers to arrays
11 sub vAdd(\@\@); # Declare as taking two pointers to arrays
12 sub vSubtract(\@\@); # Declare as taking two pointers to arrays
13
14 # -------------------------------------------------------------------
15 # Test with these vectors
16 # -------------------------------------------------------------------
17 @one = ( 2, 4, 3);
18 @two = ( 4, -1, 7);
19 @result = ();
20
21 print "\n Vector 1 = ";
22 for (@one) { printf " %4d", $_; }
23
24 print "\n Vector 2 = ";
25 for (@two) { printf " %4d", $_; }
26
27
28 # -------------------------------------------------------------------
29 # Test Dot Product
30 # -------------------------------------------------------------------
31 $r = &dProduct(@one,@two);
32 print "\n Dot Product = $r \n";
33
34 # -------------------------------------------------------------------
35 # Test Addition
36 # -------------------------------------------------------------------
37 @result = &vAdd(\@one,\@two);
38 print "\n Added = ";
39 for (@result) { printf " %4d", $_; }
40
41 # -------------------------------------------------------------------
42 # Test Subtraction
43 # -------------------------------------------------------------------
44 @result = &vSubtract(\@one,\@two);
45 print "\n Subtract = ";
46 for (@result) { printf " %4d", $_; }
47
48 # -------------------------------------------------------------------
49 # Test Cross Product
50 # -------------------------------------------------------------------
51 @result = &xProduct(\@one,\@two);
52
53 print "\n Cross Product = \n";
54 for ($i=0;$i<3;$i++) {
55 for ($j=0;$j< 3;$j++) {
56 printf " %4d", $result[$i][$j];
57 }
58 print "\n";
59 }
60
61 exit (0);
62
63 # -------------------------------------------------------------------
64 # Returns a vector that is the result of subtracting one vector from
65 # another. Both vectors have to be the same size.
66 # -------------------------------------------------------------------
67 sub vAdd { # (\@\@); Declare as taking two pointers to arrays
68 my ($x,$y) = @_;
69 my $ct1 = $#{$x} + 1; # items in $x
70 my $ct2 = $#{$y} + 1; # items in $y
71 return undef if ($ct1 != $ct2) ;
72 my $i;
73 my @answer;
74
75 for ($i=0;$i<$ct1;$i++) {
76 $answer[$i] = $$x[$i] + $$y[$i];
77 }
78 return @answer;
79 }
80
81 # -------------------------------------------------------------------
82 # Returns a vector that is the result of subtracting one vector from
83 # another. Both vectors have to be the same size.
84 # -------------------------------------------------------------------
85 sub vSubtract { # (\@\@); Declare as taking two pointers to arrays
86 my ($x,$y) = @_;
87 my $ct1 = $#{$x} + 1; # items in $x
88 my $ct2 = $#{$y} + 1; # items in $y
89 return undef if ($ct1 != $ct2) ;
90 my $i;
91 my @answer;
92
93 for ($i=0;$i<$ct1;$i++) {
94 $answer[$i] = $$x[$i] - $$y[$i];
95 }
96 return @answer;
97 }
98
99 # -------------------------------------------------------------------
100 # Returns a scalar that is a dot product of two vectors.
101 # -------------------------------------------------------------------
102 sub dProduct { # (\@\@); Declare as taking two pointers to arrays
103 my ($x,$y) = @_;
104 my $sum;
105 my $ct1 = $#{$x} + 1; # items in $x
106 my $ct2 = $#{$y} + 1; # items in $y
107 return undef if ($ct1 != $ct2) ;
108
109 for ($i=0;$i<$ct1;$i++) {
110 $sum += $$x[$i] * $$y[$i];
111 }
112 return $sum;
113 }
114
115 # ------------------------------------------------------------
116 # Returns an array that is the cross product of two vectors.
117 # ------------------------------------------------------------
118 sub xProduct { # (\@\@); Declare as taking two pointers to arrays
119 my ($x,$y) = @_;
120 my @array;
121 my $result = \@array;
122 my $i, $j;
123 my $ct1 = $#{$x} + 1; # items in $x
124 my $ct2 = $#{$y} + 1; # items in $y
125
126 for ($i=0;$i<$ct1;$i++) {
127 for ($j=0;$j<$ct2;$j++) {
128 $$result[$i][$j] = $$x[$i] * $$y[$i];
129 # print " $i, $j, $$result[$i][$j] \n";
130 }
131 }
132 return @array;
133 }
Just like with vectors, you can use Perl references on matrices. As an example of developing code for a prototype, this section covers the following items:
This section covers the image shown in Figure 29.1. The image is a black-and-white cartoon, but the techniques you'll learn here can be applied to color images as well. Listing 29.5 contains the complete code for developing the images shown in Figures 29.2 and 29.3.
Figure 29.1 : The unfiltered image.
Listing 29.5. The complete listing for reading and writing PBM files.
1 #!/usr/bin/perl
2
3 #-------------------------------------------------------
4 # Read and write ASCII PPM files
5 #-------------------------------------------------------
6 # Author: Kamran Husain 4.4.96
7 # NO WARRANTIES WHATSOEVER APPLY HERE!! Copy freely, use
8 # at will, with no restrictions.
9 #-------------------------------------------------------
10 use Getopt::Long;
11 GetOptions('out=s');
12
13 open (TEXT,"pirate.ppm") || die "\n Cannot open $!\n";
14 @image = ();
15 @hist = ();
16 ($wd, $ht, @image) = &readImage;
17 close <TEXT>;
18
19 print "@image ";
20 @hist = &getHistogram($ht,$wd,@image);
21
22 $ctr = 0;
23 $hi = $#hist + 1;
24
25 # ------------------------------------------------------
26 # Display histogram of image in memory
27 # ------------------------------------------------------
28 print "Histogram of image\n";
29 for ($i = 0; $i < $hi; $i++) {
30 if ($hist[$i] != 0) {
31 printf "[%3d] = %5d ", $i, $hist[$i] ; $ctr++;
32 if ($ctr >= 5) {
33 $ctr = 0;
34 print "\n"
35 }
36 }
37 }
38
39 # ------------------------------------------------------
40 # Write to disk as unfiltered.
41 # ------------------------------------------------------
42 @convolve = ( 0.1, 0.1, 0.1,
43 0.1, 0.1, 0.1,
44 0.1, 0.1, 0.1);
45 print "\n Filter 1 applied";
46 &applyFilter3($wd,$ht,\@convolve,\@image);
47 &dumpImage ('filt1.ppm', $wd, $ht);
48
49 @convolve = ( 0.1, 0.0, 0.1,
50 0.0, 0.5, 0.0,
51 0.1, 0.0, 0.1);
52 print "\n Filter 2 applied";
53 &applyFilter3($wd,$ht,\@convolve,\@image);
54
55 &dumpImage ('filt2.ppm', $wd, $ht);
56
57 exit(0);
58
59 # ------------------------------------------------------
60 # Dump PPM file to disk given file name,
61 # ht and width of image
62 # ------------------------------------------------------
63 sub dumpImage {
64
65 my $fname = shift @_;
66 my $wd = shift @_;
67 my $ht = shift @_;
68 my $i,$j,$k,$v;
69
70 print "\n Writing file $fname $wd by $ht";
71
72 open (OUTPUT,">$fname") || die "Cannot open $fname $! ";
73 select OUTPUT;
74 print "P3\n";
75 print "# Test output\n";
76 print "$wd $ht\n";
77 print "255\n";
78
79 $count = 0;
80 for($i=0;$i<$ht;$i++) {
81 for($j=0;$j<$wd;$j++) {
82 $v = $$image[$i][$j];
83 printf "%3d %3d %3d ", $v,$v,$v;
84 $count++;
85 if (($count % 5) == 0) {
86 $count = 0;
87 print "\n";}
88 }
89 }
90 close OUTPUT;
91 select STDOUT;
92 }
93
94
95 # ------------------------------------------------------
96 # Read PPM file from disk given file name,
97 # Return b/w version back along with ht and width of
98 # image.
99 # ------------------------------------------------------
100 sub readImage { # (\@) for image data;
101 my @image;
102 my $result = \@image;
103 my $format = <TEXT>;
104 my $comment = <TEXT>;
105 $a = <TEXT>;
106 chop $a;
107 local ($cols, $rows) = split(' ',$a);
108 local $colors = <TEXT>;
109 my $row = 0;
110 my $col = 0;
111 my $a;
112
113 $rows = int($rows);
114 $cols = int($cols);
115
116 while ($a = <TEXT>) {
117 chop $a;
118 @words = split(' ',$a);
119 $count = $#words;
120
121 while (@words) {
122 ($r,$g,$b) = splice(@words,0,3);
123 $$image[$row][$col] = ($r+$g+$b)/3;
124 $col++;
125 if ($col >= $cols) { $row++; $col = 0 }
126 }
127 }
128 return ($cols,$rows,@image);
129 }
130
131
132 # ------------------------------------------------------
133 # Calculate histogram of up to 256 colors in
134 # the passed image bytes.
135 # ------------------------------------------------------
136 sub getHistogram {
137 my ($rows,$cols,$img) = @_;
138 my @image = @$img;
139 my @refered = ();
140 my $hst = \@refered;
141
142 my $i,$j,$k;
143
144 for($i=0;$i<$rows;$i++) {
145 for($j=0;$j<$cols;$j++) {
146 $k = $$image[$i][$j];
147 $$hst[$k] += 1;
148 }
149 }
150 return (@refered);
151 }
152
153
154 # ------------------------------------------------------
155 # Apply 3x3 filter to the image
156 # Return resulting image.
157 # ------------------------------------------------------
158 sub applyFilter3 {
159 my ($rows,$cols,$convolve,$img) = @_;
160 my @fir = @$convolve;
161 my @image = @$img;
162 my $i,$j,$k,$v;
163
164 print "\n Filter: $rows X $cols ";
165 for ($i=0; $i<9;$i++) {
166 print "\[ $fir[$i] \]";
167 }
168 for($i=1;$i<$rows -1;$i++) {
169 for($j=1;$j<$cols - 1;$j++) {
170 $k = $$image[$i-1][$j-1] * $fir[0] +
171 $$image[$i][$j-1] * $fir[1] +
172 $$image[$i+1][$j-1] * $fir[2] +
173 $$image[$i-1][$j] * $fir[3] +
174 $$image[$i][$j] * $fir[4] +
175 $$image[$i+1][$j] * $fir[5] +
176 $$image[$i-1][$j+1] * $fir[6] +
177 $$image[$i][$j+1] * $fir[7] +
178 $$image[$i+1][$j+1] * $fir[8];
179 $$image[$i][$j] = int($k);
180 }
181 }
182 }
The format chosen for this example is the ASCII version of the portable bitmap (PBM) file type PPM. There are two reasons for choosing this format. First, it's simple to work with compared to the more complicated GIF, pcX, and JPEG formats. The idea here is to show how to use Perl to prototype algorithms, not discuss graphics file formats. Second, the PBM utilities have some filters and lots of conversion utilities for converting an image to a format other than PBM if necessary. The downside of the ASCII depiction is the slow speed in reading ASCII and the large amount of disk space required for the image.
Obviously, after you prototype your algorithm, you'll want to code the reading and writing of PBM files in a compiled and optimized language such as C.
Following is the header for the image shown in Figures 29.1, 29.2, and 29.3:
P3
# CREATOR: XV Version 3.10 Rev: 12/16/94
99 77
255
252 252 252 252 252 252 252 252 252 252 252 252 252 252 252
252 252 252 252 252 252 252 252 252 252 252 252 252 252 252
252 252 252 252 252 252 252 252 252 252 252 252 252 252 252
252 252 252 252 252 252 252 252 252 252 252 252 252 252 252
252 252 252 252 252 252 252 252 252 252 252 252 252 252 252
252 252 252 252 252 252 252 252 252 252 252 252 252 252 252
P3 is required for this image file. The comment line concerning CREATOR is optional, but you will have to compensate for its existence. 99 refers to the number of columns in the image, 77 refers to the number of rows of pixels, and 255 refers to the highest color.
What follows next is the red/green/blue (RGB) content of each pixel in the image. All images used in this chapter have 256 gray levels, so the RGB values are all equal. There must be 99¥77¥3 distinct RGB values.
The code for reading these pixel RGB values knows when to start a new row by reading the number of values per row and then incrementing the row when it reaches the columns per row. Thus, the program reads in three values at a time and then assigns each value to an $$image array. Here's the fragment of code to do this:
while ($a = <TEXT>) {
chop $a;
@words = split(' ',$a);
$count = $#words;
while (@words) {
($r,$g,$b) = splice(@words,0,3);
$$image[$row][$col] = ($r+$g+$b)/3;
$col++;
if ($col >= $cols) { $row++; $col = 0 }
}
}
The RGB values in this example are all equal, but this cannot be guaranteed because you may be working with a color image. You take the average of the RGB intensities to determine the average intensity of a pixel by using the following line:
$$image[$row][$col] = ($r+$g+$b)/3;
instead of assuming grayscale images only and then using only one value. I do take the liberty of allocating room (by default) to 97¥88 because grayscale images are used instead of color maps to get the average intensity of a pixel.
The processing algorithm requires the dimensions of the file and the data. These values are returned in the following line:
return ($cols,$rows,@image);
After the image has been read from disk into memory, you can run some programs on it. The histogram routine to run on the image is as follows:
sub getHistogram {
my ($rows,$cols,$img) = @_;
my @image = @$img;
my @refered = ();
my $hst = \@refered;
my $i,$j,$k;
for($i=0;$i<$rows;$i++) {
for($j=0;$j<$cols;$j++) {
$k = $$image[$i][$j];
$$hst[$k] += 1;
}
}
return (@refered);
}
The reference to the @hst array in the getHistogram subroutine is called to store the accumulated values per pixel in the image.
A simple 3¥3 matrix convolution filter is used in this section. Two filters are shown in Listing 29.5. The first filter is a uniform gain filter, and the second is for using a type of Gaussian filter. You can modify this code to use your own filter.
The filter is applied with a call to applyFilter3. In line 159, we pick up the $convolve filter and the pointer to the $img. The convolve filter is passed to an array with nine elements: The first three elements are in the row above the pixel, followed by three more at the center of row, and then three immediately below the current row. The filter is shown at line 42 as this:
@convolve = ( 0.1, 0.1, 0.1,
0.1, 0.1, 0.1,
0.1, 0.1, 0.1);
The second filter is shown at line 49 as this:
@convolve = ( 0.1, 0.0, 0.1,
0.0, 0.5, 0.0,
0.1, 0.0, 0.1);
The following lines are where the filter is applied and the results are written to disk:
print "\n Filter 2 applied";
&applyFilter3($wd,$ht,\@convolve,\@image);
dumpImage ("filt1.ppm");
The output of these filters is shown in Figures 29.2 and 29.3. The way the convolution matrix is applied to the image is shown in lines 168 to 179 in Listing 29.5.
Figure 29.2 : The filtered image using the first filter.
Figure 29.3 : The filtered image using the second filter.
Note that a band is left around the image so as not to overrun the extents of the image array. When prototyping for eventual use in a formal language, keep the restrictions of the formal language in mind.
Finally, the image is written to disk with the dumpImage subroutine (shown in line 63). The calls to dump the image are shown in lines 43 and 55.
To see the histograms in three dimensions, you can use the VRML.pm module developed earlier in this book to generate a display. By applying different filters and then generating 3D histograms of the resulting image, you can get a pictorial view of how each filter affects the output. The following lines of code are for a subroutine, show3Dhistogram, to create VRML cubes from the histogram array. Add this subroutine to the end of the file shown in Listing 29.5:
1 use VRML;
2 use VRML::Cube;
3 use VRML::Cylinder;
4
5 sub show3Dhistogram {
6 open (VRMLFILE,">vrml1.wrl") || die "\n Cannot open $!\n";
7 $oldfile = select VRMLFILE;
8 my $header = VRML::new();
9 $header->VRML::startHeader;
10 $header->VRML::startSeparator;
11 $width = 0.01;
12 my @cyl;
13 $hi = $#hist + 1;
14 for ($i = 0; $i < $hi; $i++) {
15 $v = $hist[$i] / 100;
16 if ($v > 0) {
17 $x = ($i * $width) % 16 ;
18 $y = ($i * $width) / 16 ;
19 $t = $header->VRML::putCube(
20 'width' => $width, 'height' => $v, 'depth' => $width,
21 'translation' => [$x,$y,0],
22 'ambientColor' => [$v,$v,$v]
23 );
24 }
25 }
26 $header->VRML::stopSeparator;
27 close VRMLFILE;
28 select $oldfile;
29 }
Note that in line 7, we take care to store away the file handle of the current output file when we set the default file handle to VRMLFILE with the select call. The for loop in line 14 steps through the entire hist array and generates code to print a cube. Lines 19 through 23 are the statements for generating VRML code for a cube. Line 26 terminates the VRML output. The file handle is used to close the VRML output file in line 27. After the VRML output file is closed, we reset the default file handle (in line 28) to whatever it was prior to the select call.
The number of routines in this chapter (and other chapters, for that matter) make it hard for me to look them up by name. You can use the following script to quickly get listings of all the subroutine functions you want in a bunch of source code files. See Listing 29.6.
Listing 29.6. Printing the subroutines in source files.
1 #!/usr/bin/perl
2 #
3 # Display all the subroutines in the files on the command line
4 #
5 while (<>) {
6 chop;
7 if (/^\s*sub\s+(\w+(?:[:`]+))?(\w+)/) {
8 $name = $2;
9 print $ARGV, ":Line $. :", "$name\n";
10 close(ARGV) if eof(); # reset line numbers
11 }
12 }
The key line to look at is the search pattern defined in line 7:
/^\s*sub\s+(\w+(?:[:`]+))?(\w+)/
Basically, the first part \s*sub\s* looks for all whitespaces (tabs and spaces) before and after the string sub. Then it looks for an ( open parenthesis, followed by a word as specified by \w. If the word that matches the \w is followed by :: or a single quote `, then it's considered a class specification and accepted as such since the second question mark ? allows for more than one occurrence of such words. Note that we did not look for an open curly brace for the subroutine code on the same line as the subroutine declaration since the open curly brace may be on the next line following the subroutine declaration.
The program shown in Listing 29.6 is not foolproof because it looks for a very specific pattern in defining subroutines. However, it will catch most subroutine definitions. The output from this script gives you a listing of all subroutines declared in a file. It even attempts to print subroutines in *.pm files. Actually, this script can write out a tags file by replacing the print line with the following line:
print "$name\t$ARGV\t\/^$_\/\n"
Hope this will help you keep your functions in order! ;-)
This chapter is designed to show you how to use the techniques you learned in the previous chapters of this book by developing prototyping algorithms using Perl. The built-in mathematical and array functions of Perl can be assets when used for developing algorithms. In this chapter we worked on a filtering algorithm for an image, as well as reading and archiving to disk. You even can use previously developed modules and available tools to see how your prototypes work.