view release on metacpan or  search on metacpan

lib/Geo/KML/PolyMap.pm  view on Meta::CPAN

	my $legend = generate_legend($bins_colors->[0],$bins_colors->[1],$FONT_PATH);

	# KML must be rendered to disk
	my ($tmp_fh,$tmp_fn) = tempfile();
	_generate_kml($entities,$placename,$datadesc,$nbins,
		      $bins_colors->[0],$bins_colors->[1],$tmp_fh,$legend_name);
	close($tmp_fh);

	# Construct the KMZ/ZIP archive and add the kml and legend files
	my $kmz = Archive::Zip->new();
	#my $kml_member = $kmz->addString(join("",@$kml),"generated_map.kml");
	my $kml_member = $kmz->addFile($tmp_fn,"generated_map.kml");
		$kml_member->desiredCompressionMethod( COMPRESSION_DEFLATED );
	my $leg_member = $kmz->addString($$legend,$legend_name);
		$leg_member->desiredCompressionMethod( COMPRESSION_STORED );
	
	# Dump the zip data to the file
	#my $kmz_fh;
	#open($kmz_fh,">$kmzname") or die "Couldn't create output file in generate_kmz";
	if ($kmz->writeToFileHandle($kmzfh) != AZ_OK) {
		die "Couldn't write to output file in generate_kmz";
	}
	#close($kmzfh);
	unlink($tmp_fn);
	return;
}
sub _kmeans {
	my ($data,$clusters,$npass) = @_;
	if ($clusters > scalar(@$data)) {
		warn "More clusters ($clusters) than data points (".scalar(@$data).")!";
		my @result;
		for (my $i=0;$i < scalar(@$data); $i++) {
			push (@result,$i);
		}
		return \@result;
	}
	
	my %cluster_centroids = ();
	for (my $i=0; $i < $clusters; $i++) {
		my $idx;
		do {
			$idx = int(rand(scalar(@$data)));
		} while (defined($cluster_centroids{$idx}));
		$cluster_centroids{$idx} = 1;
	}
	
	my $rcenters = [];
	foreach my $cent (keys %cluster_centroids) {
		push (@$rcenters,$data->[$cent]);
	}
	
	#Assign points to clusters
	my $assn = assign_clusters($data,$rcenters);
	
	for (;$npass>0;$npass--) {
		#Recalculate centroids
		$rcenters = recalculate_centroids($data,$rcenters,$assn);
		#Assign points to clusters
		my $newassn = assign_clusters($data,$rcenters);
		
		# End the iterations if the assignments don't change		
		my $done = 1;
		for (my $i = 0;$i<scalar(@$newassn) and $done; $i++) {
			$done = ($assn->[$i] == $newassn->[$i])
		}
		if ($done) {
			$npass = 0;
		} else {
			$assn = $newassn;
		}
	}
	return $assn;
}

sub assign_clusters {
	my ($data,$centroids) = @_;
	my @assn=();
	$#assn = scalar(@$data)-1;
	for (my $di = 0; $di < scalar(@$data); $di++) {
		my $pt = $data->[$di];
		my $dist = abs($pt-$centroids->[0]);
		my $idx = 0;
		for (my $i=1;$i<scalar(@$centroids);$i++) {
			my $d2 = abs($pt-$centroids->[$i]);
			if ($d2 < $dist) {
				$dist = $d2;
				$idx = $i;
			}
		}
		$assn[$di] = $idx;
	}
	
	# This inverted loop loses on performance
	#my @dists;
	#for (my $c=0;$c<scalar(@$centroids);$c++) {
	#	for (my $i=0;$i<scalar(@$data);$i++) {
	#		my $dist = abs($data->[$i]-$centroids->[$c]);
	#		if (not defined($dists[$i]) or ($dists[$i] > $dist)) {
	#			$dists[$i] = $dist;
	#			$assn[$i] = $c;
	#		}
	#	}
	#}
	
	return \@assn;
}

sub recalculate_centroids {
	my ($data,$centroids,$assignments) = @_;
	
	my @means;
	my @counts;
	for (my $c=0;$c<scalar(@$centroids);$c++) {
		push(@means,0);
		push(@counts,0);
	}
	for (my $i = 0;$i < scalar(@$data);$i++) {
		my $t = $assignments->[$i];
		$means[$t] += $data->[$i];
		$counts[$t]++;
	}