salva. I've fixed the problem.

The solution I've chosen is to make two passes of the data. During the first pass, I draw each of the circle at scale (as before), but then reset the central pixel back to whatever color (background or previously draw circle color) was there before. The second pass operates exactly as it did previously. Because during the second pass, all the 'circles of influence' have already been drawn once, there is no ordering issue. By unsetting the central pixel during the first pass, it will only be colored if a subsequent circle overlays it.

The effect is most clearly demonstrated by 'ficker comparing' between the two images produced when you run the modifed code below. (Performance wise, the code now processes the OPs original 300_000 point scenario, finding (for example) 127000 points in 93000 groups in under 2 minutes.)

I suggest the following commandline options as giving the clearest demonstration:

perl -slw 604750.pl -POINTS=100 -SCALER=800 -DELTA=100

What you will see is that in the image: 604790all.png, all the circles are plotted. Any circles whos central pixel is colored, are grouped. Those where the central pixel is white are not part of any group.

In the second image 694790grouped.png, just the grouped circles are draw in outline. By flicker comparing the two images, (I believe that) you can clearly see that the algorithm is now operating correctly.

I'd really value your confirmation (or otherwise)?

#! perl -slw
use strict;
use Data::Dump qw[ pp ];
use List::Util qw[ reduce sum ];
use GD;

#use constant {
#    WHITE => 16777215,
#    MinX => 10.318842, MaxX => 14.124424,
#    MinY => 21.097507, MaxY => 24.912207,
#};
#use constant {
    WHITE => 16777215,
    MinX => 0, MaxX => 1,
    MinY => 0, MaxY => 1,
};

use constant {
    SpanX => MaxX - MinX, SpanY => MaxY - MinY,
};

sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }
sub n2rgb{ unpack 'xCCC', pack 'N', $_[0] }

our $POINTS ||= 300_000;
our $SCALER ||= 1000;
our $DELTA  ||= 20;

my @points = map [ MinX + rand( SpanX ), MinY + rand( SpanY ) ], 1 .. 
+$POINTS;

## Normalise to our grid, scale by 1000 and integerise
my @scaled = map [
    int( ( $_->[ 0 ] - MinX ) * $SCALER ),
    int( ( $_->[ 1 ] - MinY ) * $SCALER ),
], @points;

my( $sizeX, $sizeY ) = ( int( SpanX * $SCALER ), int( SpanY * $SCALER 
+) );
my $img = GD::Image->new( $sizeX, $sizeY , 1 );
$img->filledRectangle( 0, 0, $sizeX, $sizeY, rgb2n( 255, 255, 255 ) );


for my $i ( 0 .. $#scaled ) {
    my $color = $img->getPixel( @{ $scaled[ $i ] } );
    $img->filledEllipse( @{ $scaled[ $i ] }, $DELTA, $DELTA, $i );
    $img->setPixel( @{ $scaled[ $i ] }, $color );
}

my %groups;
for my $i ( 0 .. $#scaled ) {
    my $color = $img->getPixel( @{ $scaled[ $i ] } );
    if( $color != WHITE ) {
        push @{ $groups{ $color } }, $i;
    }
    else {
        $color = $i;
    }
    $img->ellipse( @{ $scaled[ $i ] }, $DELTA, $DELTA, $i );
}

printf "Found %d groups containing a total of %d points\n",
    scalar keys( %groups), sum( map scalar @$_, values %groups );

open IMG, '>:raw', '694790all.png' or die $!;
print IMG $img->png;
close IMG;
system 1, '694790all.png';

undef $img;

open OUT, '>', '694790.groups' or die $!;
for my $key ( sort { $a <=> $b } keys %groups ) {
    print OUT "[ @{ $points[ $_ ] } ]" for $key, @{ $groups{ $key } };
    print OUT "------";
}
close OUT;

$img = GD::Image->new( $sizeX, $sizeY , 1 );
$img->filledRectangle( 0, 0, $sizeX, $sizeY, rgb2n( 255, 255, 255 ) );

for my $key ( sort { $a <=> $b } keys %groups ) {
    for my $point ( $scaled[ $key ], @scaled[ @{ $groups{ $key } } ]  
+) {
        $img->setPixel( @{ $point }, $key );
        $img->ellipse( @{ $point }, $DELTA, $DELTA, $key );
    }
}

open IMG, '>:raw', '694790grouped.png' or die $!;
print IMG $img->png;
close IMG;
system 1, '694790grouped.png';
[download]