Algorithm-ClusterPoints

 view release on metacpan or  search on metacpan

example/cluster.pl  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Algorithm::ClusterPoints;

use Data::Dumper;

my $clp = Algorithm::ClusterPoints->new(radius => 0.1, min_size => 2, ordered => 1);

while (<DATA>) {
    next if /^\s*(?:#.*)?$/;
    chomp;
    my ($x, $y) = split;
    $clp->add_point($x, $y);
}

my @clusters_ix = $clp->clusters_ix;

print Data::Dumper->Dump([\@clusters_ix], ['clusters_ix']);

for my $i (0..$#clusters_ix) {
    print( join( ' ',
                 "cluster $i:",
                 map {
                     my ($x, $y) = $clp->point_coords($_);
                     "($_: $x, $y)"
                 } @{$clusters_ix[$i]}
               ), "\n"
         );
}

my @clusters = $clp->clusters;
print Data::Dumper->Dump([\@clusters], ['clusters']);

__DATA__
0.43 0.62
0.50 0.65
0.49 0.32
0.95 0.20
0.09 0.09
0.61 0.55
0.72 0.42
0.83 0.11

lib/Algorithm/ClusterPoints.pm  view on Meta::CPAN

use strict;
use warnings;

use constant sqr2 => sqrt(2);
use constant isqr2 => 1/sqr2;

use POSIX qw(floor ceil);
use List::Util qw(max min);
use Carp;

use Data::Dumper;

my $packing = ($] >= 5.008 ? 'w*' : 'V*');

sub new {
    @_ & 1 or croak 'Usage: Algorithm::ClusterPoints->new(%options)';
    my ($class, %opts) = @_;

    my $dimension = delete $opts{dimension};
    $dimension = 2 unless defined $dimension;
    $dimension < 1 and croak "positive dimension required";

lib/Algorithm/ClusterPoints.pm  view on Meta::CPAN

            @delta_hypercylinder = grep {
                my $sum = 0;
                for (@$_[@$group]) {
                    my $min = ($_ ? abs($_) - 1 : 0);
                    $sum += $min * $min;
                }
                $sum < @$group;
            } @delta_hypercylinder;
        }

        # print Data::Dumper->Dump([\@delta_hypercylinder], [qw($hc)]);

        \@delta_hypercylinder
    };
    # print Data::Dumper->Dump([$dhc], [qw($hc)]);
    @$dhc;
}

sub _print_clusters {
    print join(',', @$_), "\n" for sort { $a->[0] <=> $b->[0] } @_;
}

sub _make_clusters_ix_any {
    my $self = shift;

t/Algorithm-ClusterPoints.t  view on Meta::CPAN

#!/usr/bin/perl

use Test::More tests => 252;
use Algorithm::ClusterPoints;

use Data::Dumper;

sub some_partition;

my $out;

for my $dim (2, 3, 5) {
    for my $n (1, 5, 30, 100) {
        my @points = map rand, 1..$n*$dim;
        my $clp = Algorithm::ClusterPoints->new(radius => 1, ordered => 1, minimum_size => 1, dimension => $dim);
        $clp->add_points(@points);
        for my $ir (1, 10, 100) {
            my $r = 1/$ir;
            $clp->radius($r);
            for my $min_size (1, 2, 10) {
                for (1..(($dim-1) || 1)) {
                    $clp->dimensional_groups(some_partition($dim));
                    my @clusters = $clp->clusters_ix;
                    my @bfclusters = $clp->brute_force_clusters_ix;
                    # print STDERR Data::Dumper->Dump([$r, \@clusters, \@bfclusters], [qw(r clusters bfclusters)]);
                    unless (is_deeply(\@clusters, \@bfclusters, "dim: $dim, n: $n, ir: $ir")) {
                        diag "dimensional groups: ". Algorithm::ClusterPoints::_hypercylinder_id($clp->dimensional_groups);
                        unless ($out) {
                            open $out, '> /tmp/acp.out' or next;
                            require Data::Dumper;
                        }
                        print $out Data::Dumper->Dump([$clp, \@bfclusters], [qw($clp $bfc)]);
                    }
                }
            }
        }
    }
}

sub some_partition {
    my $n = shift;
    my @part;

t/cylinder.t  view on Meta::CPAN

my $clp = Algorithm::ClusterPoints->new(dimension => 2,
                                        dimensional_groups => [[0],[1]],
                                        ordered => 1,
                                        radius => 0.1);
$clp->add_point($x[$_], $y[$_]) for 0..$n-1;

my @bfc = $clp->brute_force_clusters_ix;
my @c = $clp->clusters_ix;

# use Data::Dumper;
# print STDERR Data::Dumper->Dump([\@c, \@bfc], [qw($c $bfc)]);

is_deeply(\@c, \@sol, "simple 2d - 1+1");
is_deeply(\@bfc, \@sol, "simple 2d - 1+1, brute force");

t/david.t  view on Meta::CPAN

my $n = @x;

my $clp = Algorithm::ClusterPoints->new(dimension => 4, ordered => 1, radius => 0.1);
$clp->add_point($x[$_], $y[$_], $z[$_], $t[$_]) for 0..$n-1;

my @bfc = $clp->brute_force_clusters_ix;
my @c = $clp->clusters_ix;

# use Data::Dumper;
# print STDERR Data::Dumper->Dump([\@bfc, \@c], [qw($bfc $c)]);
# print STDERR "distance(4, 15) = ".$clp->distance(4, 15)."\n";

is_deeply(\@c, \@bfc, "simple 4d");
# is_deeply(\@bfc, \@sol, "simple 3d brute force");

t/simple.t  view on Meta::CPAN

            [ 9 ], [ 11, 16 ], [ 12 ], [ 13, 17 ], [ 14 ], [ 18 ], [ 19 ] );

my $n = @x;

my $clp = Algorithm::ClusterPoints->new(dimension => 3, ordered => 1, radius => 0.2);
$clp->add_point($x[$_], $y[$_], $z[$_]) for 0..$n-1;

my @bfc = $clp->brute_force_clusters_ix;
my @c = $clp->clusters_ix;

# use Data::Dumper;
# print STDERR Data::Dumper->Dump([\@bfc, \@c], [qw($bfc $c)]);
# print STDERR "distance(4, 15) = ".$clp->distance(4, 15)."\n";

is_deeply(\@c, \@sol, "simple 3d");
is_deeply(\@bfc, \@sol, "simple 3d brute force");