As it turns out the script I posted was pretty poor at doing this and only yielded good results if you had pretty clean data. Worse still it had some major flaws and a number of head scratching tests led me to rewrite it quite a bit. First I added code that identified the blocks of changed sectors that the code was grouping together into units and then I used that to debug the issues with the script. By yesterday I had code that could produce images like this one without making mistakes - the script posted last week has some major bugs that cause it to ignore large sections of an image. The revised script is listed below.
As you can see here the corrected script now identifies adjacent blocks correctly and colour codes them so I can quickly see what it is really doing. Small groups are ignored (where the distance covered by the group of adjacent sectors is less than 10), blue means that the mean square of the distance of the points from the longest axis of the group is less than 10, green means that it is less than 50 and red means that it is greater than 50. In general this will mean that blue marked sectors are properly interesting lines but you can see that it's not always true.
This version is a bit better at identifying the stuff I've told it to look for but that stuff isn't actually good enough. After more testing against my sample data I've found that while I can get to a point where I identify 80% of the interesting stuff with abut a 50% false positive rate on relatively clean data I about 5x that rate of false positives when I feed in very noisy data (shots of fast moving cloud cover).
A bit more research over the past few days pointed me to line finding algorithms based on Hough Transforms. This is a very cool way of switching the image mapping domain into a polar form (sort of ) that allows you to identify the "line like" features in an image. The basic idea is simple enough and one very kind soul has provided the source code for a Java demo here . I've spent most of today building the code to do this efficiently and I've finally gotten to a point where I think the transform is correct but I need to complete the mapping of the detected lines back on to the source images before I can be sure it really is working.
Tune in next week for the next exciting episode.. :)
Updated Line Finder..
$datafile=shift();
$highlightfile=shift();
$sectorfile=shift();
SetupData ($datafile);
foreach $item (@data) {
@items=split(/[^\d]/,$item);
$itemcount++;
$mapdata{$items[0]}{$items[1]}=$itemcount;
$mapitems[$itemcount]=[$items[0],$items[1],$items[2]]; # First item is 1 which means is not currently used in a line
$livemap[$itemcount]=1;
}
for ($indexitem=0;$indexitem<$itemcount;$indexitem++) {
if ($livemap[$indexitem]) {
$mstring=liner("",$indexitem);
$nscore = Analyze($mstring);
$score=$nscore if ($nscore>$score);
}
}
print "$score";
SaveSectorFile();
sub liner { # Depth First Recursive Scan for Adjacent sectors
my $lstring=shift();
my $position=shift();
$lstring .= "$position ";
$livemap[$position]=0;
for (my $traverse=0;$traverse<=7;$traverse++) {
my $new_x=$mapitems[$position][0]+$traces[$traverse][0];
my $new_y=$mapitems[$position][1]+$traces[$traverse][1];
if (exists($mapdata{$new_x}{$new_y})) {
my $new_position=$mapdata{$new_x}{$new_y};
my $bstring="";
if ($livemap[$new_position]) {
$lstring .= liner("",$new_position);
}
}
}
return($lstring);
}
sub Analyze { # Test a list of sector and score for "line-ness" Bigger scores are more line like.
my $mstring=shift();
my @points=split(/\s/,$mstring);
my ($leng,$depth,$dist,$score,$min,$max)=(0,0,0,0,$points[0],$points[0]);
$minp=int(($mapitems[$min][0])**2+($mapitems[$min][1])**2);
$maxp=int(($mapitems[$max][0])**2+($mapitems[$max][1])**2);;
foreach my $pixel (@points) {
my $tx=$mapitems[$pixel][0];
my $ty=$mapitems[$pixel][1];
my $dist2=int((($tx)**2+($ty)**2));
if ($dist2<$minp) {
$minp=$dist2;
$min=$pixel;
}
if ($dist2>$maxp) {
$maxp=$dist2;
$max=$pixel;
}
$depth++;
}
($x0,$y0)=($mapitems[$min][0],$mapitems[$min][1]);
($x1,$y1)=($mapitems[$max][0],$mapitems[$max][1]);
if ( (($x1-$x0)+($y1-$y0)) != 0 ) {
foreach my $pixel (@points) {
$x=$mapitems[$pixel][0];
$y=$mapitems[$pixel][1];
$dist +=((($y0-$y1)*$x+($x1-$x0)*$y+($x0*$y1-$x1*$y0))/sqrt( ($x1-$x0)**2+($y1-$y0)**2))**2;
}
$leng=sqrt(($x1-$x0)**2+($y1-$y0)**2);
}
if ($leng>10) {
$dist2=int($dist/$leng);
$dist=int($dist);
$leng=int($leng);
$colour=$red;
$colour=$blue if ($dist2<10);
$colour=$green if (($dist2>=10) and ($dist2<50));
highlight (\$image,$mstring,$colour,$dist2.$sectsize);
if (($dist2<10)>10)) {
if ($dist2 > 0) {
$score=$leng/$dist2;
} else {
$score=$leng*2;
}
}
print "$score $dist2 $leng $depth ($x0,$y0) ($x1,$y1)\n" if ($comments);
}
return($score);
}
sub highlight { # colour in the sectors of the provided list on the sector image
my ($im,$points,$colour,$trigger,$diff)=@_;
my $image=${$im};
my @points=split(/\s/,$points);
foreach my $point (@points) {
$image->rectangle($diff*$mapitems[$point][0],$diff*$mapitems[$point][1],
$diff*$mapitems[$point][0]+$diff, $diff*$mapitems[$point][1]+$diff,
$colour);
}
}
sub Init { # Set up dome global values
use GD;
use GD::Image;
GD::Image->trueColor(1);
$ChartImage=$sectorfile;
$image = GD::Image->newFromJpeg($ChartImage);
($limx,$limy)= $image->getBounds();
$limx=$limx/$sectsize;
$limy=$limy/$sectsize;
$image->interlaced('true');
$image->setThickness(1);
$red = $image->colorAllocate(255,0,0);
$blue = $image->colorAllocate(0,0,255);
$green = $image->colorAllocate(0,255,0);
@traces=([-1,-1],[0,-1],[1,-1],[-1,0],[1,0],[-1,1],[0,1],[1,1]);
$itemcount=0;
$score=0;
}
sub RunTest { # Create test data
$sectsize=5;
$highlightfile="Sectors.png";
$sectorfile="sectors.jpg";
$dataout=`motiontrack.exe -s 1 --sectorsize=$sectsize picture.jpg lastpicture.jpg sectors.jpg 2>dump.txt`;
@dataitems=split(/\n/,$dataout);
$data=$dataitems[1];
$comments=1;
}
sub SaveSectorFile { # Save the marked up sector file
open (IMG, ">$highlightfile");
binmode(IMG);
print IMG $image->png;
close (IMG);
}
sub SetupData { # Read in data if provided in a file otherwise run the test code.
my $datafile=shift();
if ( -e $datafile) {
open (INFILE, "$datafile") or die ("Unable to open $datafile");
$data="";
while () {
chomp;
$data .= $_
}
} else {
RunTest();
}
$data .=" ";
if ($data !~ /^(\d+\,\d+\:\d+\s+)+$/) {
print "Data Format Error\n";
exit;
}
@data=split(/\s/,$data);
Init();
}
No comments:
Post a Comment