view release on metacpan or  search on metacpan

lib/Image/DominantColors.pm  view on Meta::CPAN

package Image::DominantColors;

use 5.006;
use strict;
use warnings FATAL => 'all';
use Data::Dumper;
use Imager;
use Imager::Fill;
use Image::ColorCollection;
use POSIX;
 
our $VERSION = '0.02';


sub new {
	my ($class, $params) = @_;
	my $self = undef;
	if($params) {
		$self =  $params;
	} else {
	#carp die. We need a filename...
	}
	bless $self, $class;
	return $self;
}

sub getDominantColors {
	my $class = shift;
	my $img = Imager->new(file => $class->{file});
	my $clusters = 3;
	my $clus = $class->{clusters};
	if($clus)
	{
		$clusters = $clus;
	}
	my $h = $img->getheight() - 1;
	my $w = $img->getwidth() - 1;

	my @colors = ();
	for (my $j = 0; $j < $w; $j++) {
		for (my $k = 0; $k < $h; $k++) {
			my $oth = $img->getpixel(x => $j, y => $k);
			my ($red, $green, $blue, $alpha) = $oth->rgba();
			push (@colors, {
				r => $red,
				g => $green,
				b => $blue,
			});
		}		
	}

	my @centroids = ();
	for (my $i = 1; $i <= $clusters; $i++) {
		my $cc = Image::ColorCollection->new();
		push @centroids, $cc;
	}
	
	my $shft = 100;
	my $it = 0;#track iterations
#	print "TotalCentroid : ".scalar(@centroids);
	while($shft != 0)
	{
		foreach my $col (@colors) {
			my $min = LONG_MAX;
			my $cent = undef;
#				print "TotalCentroidAgainb : ".scalar(@centroids);
			foreach my $c (@centroids) {
				#print Dumper($c);
				my $d = int(euclideanDist($col, $c->getCentroid()));
				if($d < $min)
				{
					$min = $d;
					$cent = $c;					
				}
			}
			$cent->addColor($col);			
		}
		my $localShft = 0;
		foreach my $cnt (@centroids) {
			$localShft += $cnt->updateCentroid();
			$cnt->clear();
		}
		$shft = $localShft;
		$it++;				
#		print "Iteration : $it , shift : $shft\n";
	}
	my @ret = map { $_->getCentroid() } @centroids;
	return \@ret;
}
sub euclideanDist {
	my ($c1, $c2) = @_;
	return sqrt((($c1->{r}-$c2->{r})**2) + (($c1->{g}-$c2->{g})**2) + (($c1->{b}-$c2->{b})**2));
}

1; # End of Image::DominantColors
__END__


=head1 NAME

Image::DominantColors - Find dominant colors in an image with k-means clustering.

=head1 VERSION

Version 0.01

=cut




=head1 SYNOPSIS

This module does just one simple thing. It scans an image and clusters colors with the L<k-means clustering|http://en.wikipedia.org/wiki/K-means_clustering> 
algorithm to give you the most dominant colors in that image.

Here is a live demo : L<http://www.tryperl.com/dominantcolors/>

This is how it works, I would advise leaving the clusters to a default 3 which works best with images.: