use strict; # Build grid array my @grid; foreach ( ) { s/^\s*\b// or next; push @grid, [ split ' ', $_ ], } # Assign arbitrary regions my @region; foreach my $x ( 0 .. $#grid ) { foreach my $y ( 0 .. $#{ $grid[0] } ) { $region[$x][$y] = "$x.$y"; } } # Merge neighboring regions foreach my $x ( 0 .. $#grid ) { foreach my $y ( 0 .. $#{ $grid[0] } ) { my @neighbors = ( [ $x-1, $y ], [$x, $y-1] ); foreach my $coord ( @neighbors ) { my ( $nx, $ny ) = @$coord; next if ( $nx < 0 or $ny < 0 ); if ( $grid[$x][$y] eq $grid[ $nx ][ $ny ] and $region[$x][$y] ne $region[ $nx ][ $ny ] ) { # Cell is the same color as its neighbor, join it merge_regions( $x, $y, $nx, $ny ) } } } } sub merge_regions { my ( $tx, $ty, $nx, $ny ) = @_; my $tr = $region[$tx][$ty]; my $nr = $region[$nx][$ny]; foreach my $x ( 0 .. $#grid ) { foreach my $y ( 0 .. $#{ $grid[0] } ) { if ( $region[$x][$y] eq $tr ) { $region[$x][$y] = $nr } } } } my $count = 0; my %regions; foreach my $x ( 0 .. $#grid ) { foreach my $y ( 0 .. $#{ $grid[0] } ) { my $num = ( $regions{ $region[$x][$y] } ||= ++ $count ); print $num . " "; } print "\n" } __DATA__ P P B R B P R B B B B R R R B B R R R B B G G B B