#!/usr/bin/perl use strict; sub mkit { my $a = 0; return sub { my $x = cos($a)+rand()*0.2; my $y = sin($a)+rand()*0.2; my $z = cos($a)+rand()*0.2; $a+=rand()*0.2; return [$x,$y,$z]; }; } sub sqdist { my ($a,$b) = @_; my $sum = 0; map { $sum += ($a->[$_]-$b->[$_])*($a->[$_]-$b->[$_]) } 0..$#$a; return $sum; } my @clssum; my @clscnt; my @clustdist; my $it = mkit(); while(1){ my $v = $it->(); if($#clssum < 7){ # create new clusters push @clssum,$v; push @clscnt,1; }else{ # have enough clusters already. # find closest cluster. my $ccls = 0; my $cdist = sqdist($clssum[0],$v); for(my $i=1;$i<=$#clssum;$i++){ my $dist = sqdist($clssum[$i],$v); if($dist < $cdist){ $ccls = $i; $cdist = $dist; } } print "$ccls\n"; #print "nearest cluster($ccls): $cdist\n". # "\t".join(",",@{$clssum[$ccls]})."\n"; # find 2 closest existing clusters. my $nclsi = 1; my $nclsj = 0; my $ndist = sqdist($clssum[$nclsi],$clssum[$nclsj]); for(my $i=1;$i<=$#clssum;$i++){ for(my $j=0;$j<$i;$j++){ my $dist = sqdist($clssum[$i],$clssum[$j]); if($dist < $ndist){ $nclsi = $i; $nclsj = $j; $ndist = $dist; } } } #print "two nearest clusters: ($nclsi,$nclsj): $ndist\n". # "\t".join(",",@{$clssum[$nclsi]})."\n". # "\t".join(",",@{$clssum[$nclsj]})."\n"; if($cdist < $ndist){ #print "adding point to existing cluster\n"; for(my $i=0;$i<=$#$v;$i++){ $clssum[$ccls][$i] = ($clssum[$ccls][$i]*$clscnt[$ccls] + $v->[$i])/($clscnt[$ccls]+1); } $clscnt[$ccls]++; }else{ #print "merging two existing clusters\n"; for(my $i=0;$i<=$#$v;$i++){ $clssum[$nclsi][$i] = ($clssum[$nclsi][$i]*$clscnt[$nclsi] + $clssum[$nclsj][$i]*$clscnt[$nclsj] ) / ($clscnt[$nclsi]+$clscnt[$nclsj]); } $clscnt[$nclsi] = $clscnt[$nclsi]+$clscnt[$nclsj]; #print "generating new cluster using new point\n"; $clssum[$nclsj] = $v; $clscnt[$nclsj] = 1; } } # print join(",",@$v)."\n"; }