img2mosaic_threaded.pl
Threaded mosaic image filter:
"turtles" acting in parallel.
"turtles" acting in parallel.
The advent of affordable multi-core systems is opening up a new chapter in desktop computing. The performance challenge has clearly shifted to the software front as it strives to exploit such architectures as readily as possible. Whilst pondering these developments, my thoughts drifted first to the photo-mosaic video I recently created (ugolino_640x480_256.avi) and then to the Perl code used to generate it (img2photomosaic_slides.pl). Wouldn't it be great to have all those "turtles" running around simultaneously? The answer is of course a resounding "yes" but how would one go about it?
I opted to start my attempts in parallel processing by revisiting the simpler task of converting an image into a mosaic of rectangular or square "tiles", each of a single color. I first reworked the code for img2mosaic.pl using instead the "turtle" controls from img2photomosaic_slides.pl and then made the turtles act simultaneously instead of each one in turn. Given that the code is written in Perl with ImageMagick's drawing primitives accessed through its PerlMagick interface, the final objective was tackled using Perl's threading implementation called interpreter threads or, more simply, "ithreads". (Achieving true parallel processing is, of course, contingent on the OS running the various threads across different processors.) The following on-line resources are a great starting point in learning about ithreads:
- http://perldoc.perl.org/perlthrtut.html
- http://perldoc.perl.org/threads.html and
- http://perldoc.perl.org/threads/shared.html.
The Perl script img2mosaic_threaded.pl, displayed below, implements a "work crew" model. It is released for personal, non-commercial and non-profit use only. The listing includes the line numbers in order to reference them in the following general remarks.
- Lines 001-006: Declaration of the required imports.
- Lines 010-016: Description of the required command line parameters. A typical example is
perl img2mosaic_threaded.pl Mona_Lisa.jpg legoChart.txt 5 6
Note that the "Verbose" parameter can be omitted or set to "0" to suppress the computational results for each tile. If set, say "1", then details of thread execution will be displayed. For example:Turtle #0: findBestTile - 100.6 117.4 80.6 => 168-GunMetallic
Turtle #2: stepForward - 148, 191
Turtle #3: turnLeft - WA turtle's number precedes the name of a subroutine that is executing. For "findBestTile", the three numbers that follow are the average values of the rgb intensities (in that order) for the image area being analyzed. This in turn is followed by the name of the best matching tile. Subroutine "stepForward" reports the turtle's new x and y grid coordinates whereas "turnLeft" prints the new heading after the turn.
BTW, the tile dimension of 5 x 6 pixels was chosen for no other reason than the width to height ratio of an interlocked unit LEGO™ brick is 5 to 6 (see http://www.owlnet.rice.edu/~elec201/Book/legos.html).
- Lines 017-018: The program generates a single output file, namely the mosaic image as a GIF file.
For the above "Mona Lisa" example, that file is
Mona_Lisa_5x6_px_tiles_threaded.gif
BTW, contrary to img2mosaic.pl, generating the assembly instructions has been omitted because the focus here is on threading. - Lines 024-025: Outputs the title of the program after clearing the screen if running MS Windows.
- Lines 027-033: Retrieves the command-line arguments and checks for errors.
- Lines 035-039: Composes the name for the mosaic output file.
- Lines 040-041: Under Perl ithreads, all threads inherit a copy of the calling parent's data. Thus, I've taken the approach throughout the program of deleting all data that's no longer pertinent.
- Lines 043-045: Reads the color chart file and loads the data into the hash "%ColorChart" as was done with img2mosaic.pl. See the latter for details.
- Lines 048-057: Repackages the color-chart data into different formats to meet subsequent needs. For
example, the color chart entry
'1-White' => 'F2 F3 F2',
will result in@{ $TileRGB{ '1-White' } } = (242,243,242) (used for finding the best matching tile) and
$TileColor{ '1-White' } = '#F2F3F2' (used for drawing the tile).
- Lines 064-067: Uses PerlMagick's "Ping" function to get the width and height of the source image.
- Lines 070-075: Establishes an integral number of tile rows and columns given the dimensions of the original image and those of a unit tile.
- Lines 077-082: The mosaic image is initialized as a GIF duplicate of the source image but scaled to ensure an integral number of horizontal and vertical tiles.
- Line 084: The last preliminary step where the mosaic image data is given a character representation. The reason for this requirement is as follows. First an ImageMagick object cannot be declared as shared. Next, though ImageMagick is thread safe, its pixel cache operations are not. It is therefore not possible for threads to operate simultaneously on a global image object. Thus, each thread must be given its own copy of the mosaic to work with. Because a blob is a simple array, it can be declared shared and thus be readily used by each thread to initialize a local image object. Consequently, each thread will be limited to finding the best tile matches and will not overlay these tiles on its local copy.
- Lines 104-109: Marks the start of the "turtle" controls imported from
img2photomosaic_slides.pl and
their modifications for threading. For the purpose of this experiment, the bale size is restricted to
four turtles only, one at each grid corner. Note that the grid coordinates reflect the fact that
the image origin (0,0) is located at the top left corner in ImageMagick's coordinate system.
With "@Bale" declared as a shared array, it is not permitted to push an anonymous hash onto the array as was done for img2photomosaic_slides.pl. As stated in the documentation, "only simple values or references to shared variables are allowed." So to construct the array of hashes, I opted to declare each hash as a shared variable. References to theses hashes are then be pushed onto the array to complete the set up. The alternative method would involve adding a leaf node to each element of the array and then declaring each key-value pairs. The latter technique is rather too tedious in this case.
- Lines 112-119: Using the same initialization technique as for @Bale, these lines define segregated operational
areas for the turtles. The confinement of each turtle to a separate quadrant of the image area has proven to be
a simple and effective method for avoiding any collisions.
The sequential nature of the code processing in
img2photomosaic_slides.pl did not
warrant guarding against this problem. In a threaded environment, the issue of lock starvation
(see
http://www.onjava.com/pub/a/onjava/2004/10/20/threads2.html?page=4 in the context of Java)
for instance causes the CPU cycles to be unevenly allocated and thus favor on thread over another. Consequently
some turtles appear to be on steroids! If allowed to run around the whole image area, such turtles quickly
catch up with their slower mates. And when this occurs in a corner (as illustrated on the left), this can
lead to a collision as two turtles can both get the go ahead to move into the same grid square. Such a collision
therefore causes one of the turtles to be boxed in and come to a premature halt. In addition, it puts the onus
on the remaining turtle to cover additional grid areas.
All things being equal for the remaining threads, the expected performance benefit severely degrades in such a scenario. Hence, collision avoidance plays an important role. A thread semaphore could be introduced to act as a traffic cop, allowing only one turtle to move at any given moment. However, this counter-measure would increase the processing time. It seems far simpler and computationally more efficient to confine the turtles to non-overlapping areas of the image in which they can run as fast as possible.
- Lines 124-126: These statements first setup the array of arrays for tracking the grid locations visited by the turtles. Under Perl, such a nested data structure can only be created by adding individual leaf nodes to the first array elements. With the shared structure defined, the initial locations are recorded.
- Lines 129-134: Having accomplished all the preliminary steps, it is time to launch the bale into action. The shared array "@No_Consecutive_Turns" records the number of consecutive left turns by each turtle. Four consecutive turns implies that a turtle has nowhere left to go and thus will cause the associated thread to terminate. The shared array "@No_Matches" is for information purposes only in that it will be used to report the final work distribution. Each thread is defined as an element of the array "@threads" and involves an invocation of Subroutine "launchTurtle" with the turtle index as the parameter. Each turtle will then scamper around its operational zone, finding the best tile matches. The resulting tile names will overwrite the corresponding element of "@Tracks" as only a true or false value is required in assessing if a particular grid has been processed or not.
- Lines 137-164: With all the threads having terminated, the actual mosaic is created. First, the required canvas is defined. Next, the process passes to two nested loops. The iterations unfold from left to right, top to bottom, with each one drawing a filled rectangle/square of uniform color as dictated by the color parameters for the best matching tile. Finally, the resulting image is written to disk.
- Lines 167-175: A simple report showing the work done by each thread. A warning is printed should the total number of matches disagree with the total number of tiles. Just such a warning clued me in to occurrences of collisions, prior to the introduction of operational zones.
- Lines 187-397: The remaining lines define the subroutine invoked by each thread. It is sequential in nature in order to avoid the thread overhead of launching instances of the Perl interpreter (with copies of all the parent data) for smaller sub tasks.
- Lines 188-190: Parameterizes the argument and creates a local copy of the image.
- Lines 192-201: The core of the algorithm which controls a turtle's actions. This is pretty much a straight port from img2photomosaic_slides.pl.
- Lines 212-215: The first of the ancillary subroutines. It simply checks to see if a turtle has performed four consecutive left turns. Contrary to img2photomosaic_slides.pl, the boolean check is written as a subroutine in order to include a lock statement of the shared array "No_Consecutive_Turns" that will quickly go out of scope and thus be unlocked.
- Lines 228-250: Defines the subroutine to finding the best matching tile. A match is assessed using the square of the Euclidean metric in the rgb space. The metric is evaluated for all possible tiles.
- Lines 261-268: Defines the subroutine for computing the mean channel value. The mean of the normalized input values is multiplied by 256 to yield an 8-bit return value.
- Lines 279-319: Defines the subroutine where the best matching tile is determined for the image area under consideration. The scalar results from three calls to Subroutine "meanColor" are the arguments for the call to Subroutine "bestTileMatch". Each call to "meanColor" requires the argument to be an array of normalized intensities for a given color channel obtained in turn with PerlMagick's "GetPixels" function. The use of normalized values avoids knowing beforehand the color depth of the source image. The returned average color from "meanColor" is renormalized as an 8-bit value so as to be in the range 0 to 255. With the three average channel values being fed into "bestTileMatch", the name of the best matching tile is returned. It is stored in the shared "@Tracks", overwriting the element corresponding the turtle's current grid location. Finally, the turtle's tile match count is updated.
- Lines 330-337: Checks to see whether or not a turtle's next step forward would put it beyond its operational zone.
- Lines 348-355: Checks to see whether or not a turtle's next step forward would cross its path.
- Lines 366-379: Repositions a turtle in accordance with its current heading. After resetting the turn counter, a turtle new position is recorded in the shared array "@Tracks".
- Lines 390-396: Changes a turtle's heading to reflect a left turn and ups its turn count.
There remains one nagging question. Invoking the program with the same command line parameters as with the un-threaded version, results in a different mosaic:
|
Un-threaded version
Full resolution (745 x 1,158 pixels). |
Threaded version
Full resolution (745 x 1,158 pixels). |
Needless to say, despite numerous attempts, I've been unable to eliminate the differences. Could there be subtle issues involving an image blob or other aspect of pixel caching? The answer remains elusive.
In the near future, I hope to acquire a quad-core platform. When that happens, I'll report the computational times versus a single core unit, along with the times for different bale sizes. In the meantime, I'd love to hear from anyone running this code on a multi-core system.
In conclusion, this experiment in threading has been quite interesting. Despite the increase in code size, the turtle paradigm was a natural fit to threads. In fact, I have to wonder if it might not be a worthwhile approach in controlling any sort of threaded analysis over a planar region.
As always, if you have any questions regarding the code or my explanations, please do not hesitate in contacting me.
001 use strict;
002 use threads;
003 use threads::shared;
004 use File::Basename;
005 use Image::Magick;
006 use POSIX qw(HUGE_VAL);
007 #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
008 # img2mosaic_threaded.pl: Threaded mosaic image filter.
009 #===============================================================================================================================
010 # Usage : perl img2mosaic_threaded.pl ImageFile ColorChartFile TileWidth TileHeight Verbose
011 # Arguments : ImageFile = path of image file to be filtered.
012 # ColorChartFile = path of text file containing the hash declarations for the color chart.
013 # TileWidth = width of a tile in pixels
014 # TileHeight = height of a tile in pixels
015 # Verbose = boolean flag for verbose output
016 # Input Files : See arguments.
017 # Output Files : Mosaic GIF file in the form "basename_wxh_px_tiles_threaded.gif" where "basename" denotes the basename of the
018 # source image file, "w" the tile width and "h" the tile height.
019 # Temporary Files : None.
020 # Remarks : Requires PerlMagick. Used module from ImageMagick 6.3.7.
021 # History : v1.0.0 - July 18, 2008 - Original release.
022 #===============================================================================================================================
023 # 0) INITIALIZE:
024 system( 'cls' ) if $^O =~ /^MSWin/; #clear screen if running Windows
025 print "$0\n", '=' x length($0), "\n\n"; #display program name
026
027 my $SourceFile = shift || die 'ERROR: No image file specified'; #get path of source image file
028 my $ChartFile = shift || die 'ERROR: No color-chart file specified'; #get path of color-chart file
029 my $TileWidth = shift || die 'ERROR: No tile width specified'; #get pixel width of a tile
030 my $TileHeight = shift || die 'ERROR: No tile height specified'; #get pixel height of a tile
031 my $Verbose = shift; #get boolean flag for verbose mode
032 die 'ERROR: Cannot locate image file' unless -e $SourceFile;
033 die 'ERROR: Cannot locate color-chart file' unless -e $ChartFile;
034
035 fileparse_set_fstype(''); #force Unix syntax
036 my ( $basename, #extract basename &
037 $path #extract path
038 ) = fileparse( $SourceFile, '\..*' ); # of source image file
039 my $MosaicFile = "$path${basename}_${TileWidth}x${TileHeight}_px_tiles_threaded.gif"; #compose filename of mosaic image
040 undef $basename; #discard to minimise data copying to threads
041 undef $path;
042
043 my %ColorChart; #hash of tile id codes => rgb color values
044 push @ARGV, $ChartFile; #set up reading of color chart
045 eval '%ColorChart = (' . join( '', <> ) . ')'; #load chart into hash
046 undef $ChartFile; #discard to minimise data copying to threads
047
048 my %TileRGB; #hash of arrays for each color channel value
049 my %TileColor; #hash of rgb fill attributes
050 my $key; # chart hash key
051 my $value; # chart hash value
052 my @rgb; # array of rgb channel colors
053 while( ( $key, $value ) = each %ColorChart ) { # repeat for each chart entry
054 @rgb = split / /, $value; # extract hex channel colors
055 push @{ $TileRGB{ $key } }, hex for @rgb; # create RGB array of decimal values
056 $TileColor{ $key } = '#' . join '', @rgb; # create rgb fill attribute
057 } # until all chart entries processed
058 undef %ColorChart; #discard to minimise data copying to threads
059 undef $key;
060 undef $value;
061 undef @rgb;
062 #-------------------------------------------------------------------------------------------------------------------------------
063 # 1) SETUP MOSAIC IMAGE:
064 my $source = Image::Magick->new; #instantiate an image object for the source
065 my ( $sourceWidth, #get width &
066 $sourceHeight #get height
067 ) = ( $source->Ping( $SourceFile ) )[0,1]; #of source
068 undef $source; #discard to minimise data copying to threads
069
070 my $No_Tile_Cols = $sourceWidth / $TileWidth; #compute raw number of tile columns
071 $No_Tile_Cols = int( ++$No_Tile_Cols ) #adjust to an integral number
072 unless $No_Tile_Cols == int( $No_Tile_Cols ); # if necessary
073 my $No_Tile_Rows = $sourceHeight / $TileHeight; #compute raw number of tile rows
074 $No_Tile_Rows = int( ++$No_Tile_Rows ) #adjust to an integral number
075 unless $No_Tile_Rows == int( $No_Tile_Rows ); # if necessary
076
077 my $MosaicWidth = $No_Tile_Cols * $TileWidth; #compute pixel width of mosaic image
078 my $MosaicHeight = $No_Tile_Rows * $TileHeight; #compute pixel height of mosaic image
079 my $Mosaic = Image::Magick->new( magick=>"GIF" ); #instantiate an image object for the mosaic
080 $Mosaic->Read( $SourceFile ); #init mosaic with source image file
081 $Mosaic->Quantize( colors=>scalar keys %TileColor, colorspace=>'RGB' ); #insure correct colorspace
082 $Mosaic->Scale( geometry=>"${MosaicWidth}x${MosaicHeight}!" ); #scale mosaic image
083
084 my @MosaicBlob :shared = $Mosaic->ImageToBlob(); #convert mosaic image to a blob
085 undef $Mosaic; #thrash object as pixel cache won't survive threading
086
087 print "Source Image: $SourceFile\n", #echo initialization results
088 " Width: $sourceWidth px\n",
089 " Height: $sourceHeight px\n",
090 "Mosaic Image: $MosaicFile\n",
091 " Width: $MosaicWidth px\n",
092 " Height: $MosaicHeight px\n",
093 "Mosaic Details: ", $No_Tile_Cols * $No_Tile_Rows, " tiles\n",
094 " No. of rows: $No_Tile_Rows\n",
095 " No. of cols: $No_Tile_Cols\n",
096 " Tile width: $TileWidth px\n",
097 " Tile height: $TileHeight px\n\n";
098 print( "Pause. Press the ENTER key to continue..." ), <STDIN> if $Verbose;
099 undef $SourceFile; #discard to minimise data copying to threads
100 undef $sourceHeight;
101 undef $sourceWidth;
102 #-------------------------------------------------------------------------------------------------------------------------------
103 # 2) INITIALIZE A TURTLE AT EACH GRID CORNER:
104 my @Bale :shared; #array of hashes for the turtle headings & coordinates
105 my %turtle0 :shared = ( HEADING => 'S', X => 0, Y => 0 ); #definition for turtle at top left corner
106 my %turtle1 :shared = ( HEADING => 'W', X => $No_Tile_Cols - 1, Y => 0 ); #definition for turtle at top right corner
107 my %turtle2 :shared = ( HEADING => 'N', X => $No_Tile_Cols - 1, Y => $No_Tile_Rows - 1 ); #definition for turtle at bottom right corner
108 my %turtle3 :shared = ( HEADING => 'E', X => 0, Y => $No_Tile_Rows - 1 ); #definition for turtle at bottom left corner
109 push @Bale, \%turtle0, \%turtle1, \%turtle2, \%turtle3; #init bale
110 #-------------------------------------------------------------------------------------------------------------------------------
111 # 3) DEFINE AN OPERATIONAL ZONE FOR EACH TURTLE:
112 my $midRow = int( $No_Tile_Rows / 2 ); #compute a mid grid row number
113 my $midCol = int( $No_Tile_Cols / 2 ); #compute a mid drid column number
114 my @Zones :shared; #array of hashes for defining the zone edges
115 my %edges0 :shared = ( TOP => 0, BOTTOM => $midRow, LEFT => 0, RIGHT => $midCol );
116 my %edges1 :shared = ( TOP => 0, BOTTOM => $midRow, LEFT => $midCol + 1, RIGHT => $No_Tile_Cols - 1 );
117 my %edges2 :shared = ( TOP => $midRow + 1, BOTTOM => $No_Tile_Rows - 1, LEFT => $midCol + 1, RIGHT => $No_Tile_Cols - 1 );
118 my %edges3 :shared = ( TOP => $midRow + 1, BOTTOM => $No_Tile_Rows - 1, LEFT => 0, RIGHT => $midCol );
119 push @Zones, \%edges0, \%edges1, \%edges2, \%edges3; #init zones
120 undef $midRow; #discard to minimise data copying to threads
121 undef $midCol;
122 #-------------------------------------------------------------------------------------------------------------------------------
123 # 4) RECORD THE INITIAL TURTLE LOCATIONS:
124 my @Tracks :shared; #array for bale's locations & the best matching tile names
125 $Tracks[$_] = &share([]) for ( 0..$No_Tile_Cols - 1 ); #extend as array of arrays by adding shared leaf nodes
126 $Tracks[$_{X}][$_{Y}] = 1 for ( @Bale ); #record each initial location
127 #-------------------------------------------------------------------------------------------------------------------------------
128 # 5) FIND THE BEST TILE MATCHES:
129 my @No_Consecutive_Turns :shared; #array for number of consecutive left turns by each turtle
130 my @No_Matches :shared; #array for number of tiles matched by each turtle
131 my @threads; #array of threads
132 print "Finding the best tile matches...\n"; #inform user
133 $threads[$_] = threads->create( \&launchTurtle, $_ ) for ( 0..$#Bale ); #launch a thread for each turtle
134 $threads[$_]->join() for ( 0..$#Bale ); #wait for each thread to exit
135 #-------------------------------------------------------------------------------------------------------------------------------
136 # 6) OUTPUT THE MOSAIC:
137 my $best_tile; #name of best matching tile
138 my $colNo; #tile column number
139 my $rowNo; #tile row number
140 my $x_top_left; #x-coordinate of a tile's top-left corner
141 my $y_top_left; #y-coordinate of a tile's top-left corner
142 my $x_bottom_right; #x-coordinate of a tile's bottom-right corner
143 my $y_bottom_right; #y-coordinate of a tile's bottom-right corner
144
145 print "Creating mosaic image...\n"; #inform user
146 $Mosaic = Image::Magick->new( magick=>"GIF" ); #re-instantiate an image object for the mosaic
147 $Mosaic->Set(size=>"${MosaicWidth}x${MosaicHeight}!"); #set canvas size
148 $Mosaic->Quantize( colors=>scalar keys %TileColor, colorspace=>'RGB', dither=>0 ); #insure correct colorspace & no dithering
149 $Mosaic->ReadImage('xc:none'); #set no background
150
151 for $rowNo ( 0..$No_Tile_Rows - 1 ) { #repeat for each tile row
152 $y_top_left = $rowNo * $TileHeight; # image y-coordinate of the tile's top-left corner
153 $y_bottom_right = $y_top_left + $TileHeight - 1; # image y-coordinate of the tile's bottom-right corner
154 for $colNo ( 0..$No_Tile_Cols - 1 ) { # repeat for each tile column
155 $x_top_left = $colNo * $TileWidth; # image x-coordinate of the tile's top-left corner
156 $x_bottom_right = $x_top_left + $TileWidth - 1; # image x-coordinate of the tile's bottom-right corner
157 $best_tile = $Tracks[$colNo][$rowNo]; # retrieve name of best matching tile
158 $Mosaic->Draw( primitive => 'rectangle', # draw the tile
159 fill => $TileColor{ $best_tile },
160 points => "$x_top_left,$y_top_left $x_bottom_right,$y_bottom_right"
161 );
162 } # until all tile columns processed
163 } #until all tile rows processed
164 $Mosaic->Write( filename => $MosaicFile ); #save the mosaic to file
165 #-------------------------------------------------------------------------------------------------------------------------------
166 # 7) REPORT THE NUMBER OF TILES MATCHED BY EACH TURTLE:
167 my $totalMatches; #total number of tile matches
168 print "\n";
169 for ( 0..$#No_Matches ) { #repeat for each turtle
170 print "Turtle #$_ matched $No_Matches[$_] tiles "; # report count
171 printf "(%4.1f\%)\n", int ( 100 * $No_Matches[$_] / ( $No_Tile_Cols * $No_Tile_Rows ) );
172 $totalMatches += $No_Matches[$_]; # update total
173 } #until all turtles processed
174 print "\n\aOOOPS! Number of tile matches ($totalMatches) doesn't equal the tile count!" #report any discrepancy
175 unless $totalMatches == $No_Tile_Cols * $No_Tile_Rows;
176 exit; #end processing
177 #===== SUBROUTINES =============================================================================================================
178 # Usage : &launchTurtle( $TURTLE );
179 # Purpose : Governs the movement of a threaded turtle to find the best matching tiles.
180 # Arguments : $TURTLE = turtle's array index for @Bale.
181 # Externals : $TileHeight, $TileRGB, $TileWidth, $Verbose
182 # Shared Externals : @Bale, @MosaicBlob, @No_Consecutive_Turns, @No_Matches, @Tracks, @Zones
183 # Subs : None.
184 # Remarks : Names of the best matching tiles are stored in @Tracks.
185 # History : v1.0.0 - July 18, 2008 - Original release.
186
187 sub launchTurtle { #begin sub
188 my $turtle = shift; # turtle index
189 my $mosaic = Image::Magick->new( magick=>"GIF" ); # instantiate an image object for the image
190 $mosaic->BlobToImage( @MosaicBlob ); # init image object
191
192 &findBestTile(); # find best matching tile at starting location
193 until( &spunAround() ) { # repeat until end of trek
194 if( &noBoundaryAhead() and &noTracksAhead() ) { # if next step forward is permitted
195 &stepForward(); # move forward one step
196 &findBestTile(); # find matching best tile at location
197 } else { # else
198 &turnLeft(); # turn left
199 } # end if-else
200 } # until turtle has spun around completely
201 threads->exit(); #end thread processing
202
203 # Usage : &spunAround();
204 # Purpose : Checks if a turtle has done 4 consecutive left turns. If so, returns true, otherwise false.
205 # Arguments : None.
206 # Externals : $turtle
207 # Shared Externals : @No_Consecutive_Turns
208 # Subs : None.
209 # Remarks : None.
210 # History : v1.0.0 - July 18, 2008 - Original release.
211
212 sub spunAround { # begin sub
213 lock( @No_Consecutive_Turns ); # lock no-of-turns array for read
214 return $No_Consecutive_Turns[$turtle] == 4; # return check
215 } # end sub spunAround
216
217 # Usage : &bestTileMatch( $RED, $GREEN, $BLUE );
218 # Purpose : Matches a tile to the mean RGB channel values of an image area. Returns the name of the tile.
219 # Arguments : $RED = mean 8-bit red color
220 # $GREEN = mean 8-bit green color
221 # $BLUE = mean 8-bit blue color
222 # Externals : $TileRGB, $Verbose
223 # Shared Externals : None.
224 # Subs : None.
225 # Remarks : None.
226 # History : v1.0.0 - July 18, 2008 - Original release.
227
228 sub bestTileMatch { # begin sub
229 my ( $red, $green, $blue ) = @_; # parametrize the arguments
230 my $bestTile; # name of tile that best matches mean color
231 my $deltaRed; # difference in red color values
232 my $deltaGreen; # difference in green color values
233 my $deltaBlue; # difference in blue color values
234 my $key; # hash key = tile name
235 my $value; # hash value = array of channel color intensities
236 my $metric; # squared Euclidean metric of intensities
237 my $minMetric = &POSIX::HUGE_VAL; # minimum value of the metric
238
239 while( ( $key, $value ) = each %TileRGB ) { # repeat for each possible tile
240 $deltaRed = $red - @{$value}[0]; # compute difference in red colors
241 $deltaGreen = $green - @{$value}[1]; # compute difference in green colors
242 $deltaBlue = $blue - @{$value}[2]; # compute difference in blue colors
243 $metric = $deltaRed * $deltaRed + # compute metric
244 $deltaGreen * $deltaGreen +
245 $deltaBlue * $deltaBlue;
246 $minMetric = $metric, $bestTile = $key if $metric < $minMetric; # update minimum metric & possible best tile
247 } # until all tiles processed
248 print "=> $bestTile\n" if $Verbose; # report if requested
249 return $bestTile; # return best matching tile name
250 } # end sub bestTileMatch
251
252 # Usage : &meanColor( @COLORS );
253 # Purpose : Returns the mean channel color as an 8-bit value.
254 # Arguments : @COLORS = list of normalized channel intensities to be averaged.
255 # Externals : $Verbose
256 # Shared Externals : None.
257 # Subs : None.
258 # Remarks : None.
259 # History : v1.0.0 - July 18, 2008 - Original release.
260
261 sub meanColor { # begin sub
262 my $mean; # mean 8-bit color value
263
264 $mean += $_ for @_; # sum all the normalized color values
265 $mean = 256 * $mean / scalar @_; # compute the mean 8-bit value
266 printf "%5.1f ", $mean if $Verbose; # report if requested
267 return $mean; # return the mean
268 } # end sub meanColor
269
270 # Usage : &findBestTile();
271 # Purpose : Finds the best matching tile for the image area corresponding to a turtle's location.
272 # Arguments : None.
273 # Externals : $mosaic, $turtle, $TileHeight, $TileWidth, $Verbose
274 # Shared Externals : @Bale, @No_Matches, @Tracks
275 # Subs : &bestTileMatch, &meanColor.
276 # Remarks : The tile name is stored in the shared array @Tracks.
277 # History : v1.0.0 - July 18 - Original release.
278
279 sub findBestTile { # begin sub
280 my $x_top_left; # image x-coordinate of a tile's top-left corner
281 my $y_top_left; # image y-coordinate of a tile's top-left corner
282 { # start naked block to scope lock
283 lock( @Bale ); # lock bale array for read
284 $x_top_left = $Bale[$turtle]{X} * $TileWidth; # compute x-coordinate of a tile's top-left corner
285 $y_top_left = $Bale[$turtle]{Y} * $TileHeight; # compute y-coordinate of a tile's top-left corner
286 } # end naked block, releasing lock
287 my $geometry = "${TileWidth}x${TileHeight}+$x_top_left+$y_top_left"; # geometry of a tile: width, height & x,y offsets
288 my $best_tile; # name of best matching tile
289
290 print "Turtle #$turtle: findBestTile - " if $Verbose; # report progress if requested
291 $best_tile = &bestTileMatch ( # match mean image-area colors to a tile:
292 &meanColor ( # compute mean red color:
293 $mosaic->GetPixels ( # get normalized red intensities of all pixels
294 map => 'r',
295 geometry => $geometry,
296 normalize => 'true'
297 )
298 ),
299 &meanColor ( # compute mean green color:
300 $mosaic->GetPixels ( # get normalized green intensities of all pixels
301 map => 'g',
302 geometry => $geometry,
303 normalize => 'true'
304 )
305 ),
306 &meanColor ( # compute mean blue color:
307 $mosaic->GetPixels ( # get normalized blue intensities of all pixels
308 map => 'b',
309 geometry => $geometry,
310 normalize => 'true'
311 )
312 )
313 );
314 lock( @Bale ); # lock bale array for read
315 lock( @Tracks ); # lock tracks array for write
316 $Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}] = $best_tile; # record name of best matching tile
317 lock( @No_Matches ); # lock no-of-matches array for write
318 ++$No_Matches[$turtle]; # update match count
319 } # end sub findBestTile
320
321 # Usage : &noBoundaryAhead();
322 # Purpose : Returns true if the next grid location ahead is beyond an operational boundary. Otherwise, returns false.
323 # Arguments : None.
324 # Externals : $turtle
325 # Shared Externals : @Bale, @Zones
326 # Subs : None.
327 # Remarks : None.
328 # History : v1.0.0 - July 18, 2008 - Original release.
329
330 sub noBoundaryAhead { # begin sub
331 lock( @Bale ); # lock bale array for read
332 lock( @Zones ); # lock zone array for read
333 if ( $Bale[$turtle]{HEADING} eq 'S' ) { return !( $Bale[$turtle]{Y} + 1 > $Zones[$turtle]{BOTTOM} ) }
334 elsif( $Bale[$turtle]{HEADING} eq 'N' ) { return !( $Bale[$turtle]{Y} - 1 < $Zones[$turtle]{TOP} ) }
335 elsif( $Bale[$turtle]{HEADING} eq 'E' ) { return !( $Bale[$turtle]{X} + 1 > $Zones[$turtle]{RIGHT} ) }
336 elsif( $Bale[$turtle]{HEADING} eq 'W' ) { return !( $Bale[$turtle]{X} - 1 < $Zones[$turtle]{LEFT} ) }
337 } # end sub noBoundaryAhead
338
339 # Usage : &noTracksAhead( $TURTLE );
340 # Purpose : Returns true if the next grid location ahead has not been visited. Otherwise, returns false.
341 # Arguments : None.
342 # Externals : $turtle
343 # Shared Externals : @Bale, @Tracks
344 # Subs : None.
345 # Remarks : None.
346 # History : v1.0.0 - July 18, 2008 - Original release.
347
348 sub noTracksAhead { # begin sub
349 lock( @Bale ); # lock bale array for read
350 lock( @Tracks ); # lock tracks array for read
351 if ( $Bale[$turtle]{HEADING} eq 'S' ) { return !$Tracks[$Bale[$turtle]{X} ][$Bale[$turtle]{Y} + 1] }
352 elsif( $Bale[$turtle]{HEADING} eq 'N' ) { return !$Tracks[$Bale[$turtle]{X} ][$Bale[$turtle]{Y} - 1] }
353 elsif( $Bale[$turtle]{HEADING} eq 'E' ) { return !$Tracks[$Bale[$turtle]{X} + 1][$Bale[$turtle]{Y} ] }
354 elsif( $Bale[$turtle]{HEADING} eq 'W' ) { return !$Tracks[$Bale[$turtle]{X} - 1][$Bale[$turtle]{Y} ] }
355 } # end sub noTracksAhead
356
357 # Usage : &stepForward();
358 # Purpose : Repositions a turtle to an adjacent grid location in accordance with its heading.
359 # Arguments : None.
360 # Externals : $turtle, $Verbose
361 # Shared Externals : @Bale, @No_Consecutive_Turns, @Tracks
362 # Subs : None.
363 # Remarks : None.
364 # History : v1.0.0 - July 18, 2008 - Original release.
365
366 sub stepForward { # begin sub
367 lock( @Bale ); # lock bale array for read-write
368 if ( $Bale[$turtle]{HEADING} eq 'S' ) { ++$Bale[$turtle]{Y} }
369 elsif( $Bale[$turtle]{HEADING} eq 'N' ) { --$Bale[$turtle]{Y} }
370 elsif( $Bale[$turtle]{HEADING} eq 'E' ) { ++$Bale[$turtle]{X} }
371 elsif( $Bale[$turtle]{HEADING} eq 'W' ) { --$Bale[$turtle]{X} }
372
373 lock( @No_Consecutive_Turns ); # lock no-of-turns array for write
374 $No_Consecutive_Turns[$turtle] = 0; # reset turtle's turn count
375 lock( @Tracks ); # lock tracks array for write
376 $Tracks[$Bale[$turtle]{X}][$Bale[$turtle]{Y}] = 1; # update bale's accessed locations
377 print "Turtle #$turtle: stepForward - $Bale[$turtle]{X}, $Bale[$turtle]{Y}\n" # report new location if requested
378 if $Verbose;
379 } # end sub stepForward
380
381 # Usage : &turnLeft( );
382 # Purpose : Changes a turtle's heading in accordance with a left turn.
383 # Arguments : None.
384 # Externals : $turtle, $Verbose
385 # Shared Externals : @Bale, @No_Consecutive_Turns
386 # Subs : None.
387 # Remarks : None.
388 # History : v1.0.0 - July 18, 2008 - Original release.
389
390 sub turnLeft { # begin sub
391 lock( @Bale ); # lock bale array for write
392 $Bale[$turtle]{HEADING} =~ tr/NSEW/WENS/; # change heading to the left
393 lock( @No_Consecutive_Turns ); # lock no-of-turns array for write
394 ++$No_Consecutive_Turns[$turtle]; # update turtle's turn count
395 print "Turtle #$turtle: turnLeft - $Bale[$turtle]{HEADING}\n" if $Verbose; # report new heading if requested
396 } # end sub turnLeft
397 } #end sub launchTurtle
398 #===== Copyright 2008, Webpraxis Consulting Ltd. - ALL RIGHTS RESERVED - Email: webpraxis@gmail.com ============================
399 # end of img2mosaic_threaded.pl
