Algorithm-DBSCAN

 view release on metacpan or  search on metacpan

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

=cut

sub FindClusters {
	my ($self, $starting_point_id) = @_;

	my $i = 0;
	unshift(@{$self->{id_list}}, $starting_point_id) if (defined $starting_point_id);
	foreach my $id (@{$self->{id_list}}) {
		my $point = $self->{dataset}->{$id};
		say "$i";
		$i++;
		next if ($point->{visited});
		$point->{visited} = 1;
		$self->_one_more_point_visited();
		
		my $neighborPts = $self->GetRegion($point);
#say Dumper($neighborPts);
		
		if (scalar(@$neighborPts) < $self->{min_points}) {
			$point->{cluster_id} = -1;
		}
		else {
			$self->ExpandCluster($point, $neighborPts);
		}
	}
}

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

			foreach my $id (keys %cluster_points) {
				my $p = $self->{dataset}->{$id};
				unless ($p->{visited}) {
					$p->{visited} = 1;
					$self->_one_more_point_visited();
					
					my $neighborPtsOfClusterMember = $self->GetRegion($p);
					if (scalar(@$neighborPtsOfClusterMember) >= $self->{min_points}) {
						map { $cluster_points{$_}++ } @$neighborPtsOfClusterMember;

say "Cluster [$self->{current_cluster}] has now [".scalar(keys %cluster_points)."] members, added region of point:[$p->{point_id}]";
						$cluster_expanded = 1;
						last;
					}
				}

				$p->{cluster_id} = $self->{current_cluster} unless($p->{cluster_id});
			}
		}
		while($cluster_expanded);
	}

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

sub PrintClusters {
	my ($self, $point) = @_;

	my %clusters;
	
	foreach my $point (@{$self->{dataset}}) {
		push(@{$clusters{$point->{cluster_id}}}, $point->{point_id});
	}
	
	foreach my $cluster_id (sort keys %clusters) {
		say "CLUSTER: $cluster_id";
		foreach my $point_id (sort @{$clusters{$cluster_id}}) {
			my $min_distance = 1000000000000;
			my $closest_point_id;
			foreach my $distance_point_id (sort @{$clusters{$cluster_id}}) {
				if ($distance_point_id ne $point_id) {
					my $this_point = $self->{dataset_object}->GetPointById($point_id);
					my $distance_point = $self->{dataset_object}->GetPointById($distance_point_id);
					
					my $distance = $this_point->Distance($distance_point);
					
					if ($distance < $min_distance) {
						$min_distance = $distance;
						$closest_point_id = $distance_point_id;
					}
				}
			}
			
			say "\t$point_id : (closest point: $closest_point_id, distance: $min_distance)";
		}
	}
}

=head2 PrintClustersShort

Will print the contents of the clusters (abreviated version)

=cut

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

	my ($self) = @_;

	my %clusters;

	foreach my $id (keys %{$self->{dataset}}) {
	my $point = $self->{dataset}->{$id};
		push(@{$clusters{$point->{cluster_id}}}, $point->{point_id});
	}

	foreach my $cluster_id (sort keys %clusters) {
	say "CLUSTER: $cluster_id, [".scalar(@{$clusters{$cluster_id}})."] points";
	my $nb = 0;
		foreach my $point_id (sort @{$clusters{$cluster_id}}) {
			$nb++;
			say "\t$point_id";
			last if ($nb >= 100);
		}
	}
}

=head2 _one_more_point_visited

Simple method used to display progress

=cut

sub _one_more_point_visited {
	my ($self) = @_;
	
	$self->{nb_visited_points}++;
	$self->{start_time} = time() unless ($self->{start_time});
	my $eta = time() + ((time() - $self->{start_time})/$self->{nb_visited_points})*(500000);
	my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($eta);

	say "ETA:".sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec);
	say "nb visited:".$self->{nb_visited_points};
}

=head1 AUTHOR

Michal TOMA, C<< <mtoma at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests on github: L<https://github.com/mtoma/Algorithm-DBSCAN>

t/01-clustering.t  view on Meta::CPAN

				foreach my $p (@points) {
					$nb_ok++ if ($clusters{$cluster_id}->{$p})
				}
				
				die "error: [$nb_ok] != [".scalar(keys %{$clusters{$cluster_id}})."]" unless ($nb_ok == scalar(keys %{$clusters{$cluster_id}}));
			}
		}
		die "error: point [$points[0]] not found in any cluster" unless($cluster_found);
	}
	
	say "RESULT OK";
	return 1;
}

my $dataset = Algorithm::DBSCAN::Dataset->new();
my @lines = split(/\n/, read_file('test_datasets/dbscan_test_dataset_1.txt'));
foreach my $line (@lines) {
	$dataset->AddPoint(new Algorithm::DBSCAN::Point(split(/\s+/, $line)));
}

my $dbscan = Algorithm::DBSCAN->new($dataset, 3.1 * 3.1, 6);

t/02-module-synopsis-code.t  view on Meta::CPAN

				foreach my $p (@points) {
					$nb_ok++ if ($clusters{$cluster_id}->{$p})
				}
				
				die "error: [$nb_ok] != [".scalar(keys %{$clusters{$cluster_id}})."]" unless ($nb_ok == scalar(keys %{$clusters{$cluster_id}}));
			}
		}
		die "error: point [$points[0]] not found in any cluster" unless($cluster_found);
	}
	
	say "RESULT OK";
	return 1;
}

my $points_data_file = 	
	'point_1 56.514307478581514 37.146118456702034
	point_2 34.02049221667614 46.024651786417536
	point_3 23.473087508078684 60.62328221968349
	point_4 10.418513808840482 24.59808378533684
	point_5 10.583414831970764 25.902459835735534
	point_6 9.756855426925464 24.062840099892146

t/03-region-index.t  view on Meta::CPAN

				foreach my $p (@points) {
					$nb_ok++ if ($clusters{$cluster_id}->{$p})
				}
				
				die "error: [$nb_ok] != [".scalar(keys %{$clusters{$cluster_id}})."]" unless ($nb_ok == scalar(keys %{$clusters{$cluster_id}}));
			}
		}
		die "error: point [$points[0]] not found in any cluster" unless($cluster_found);
	}
	
	say "RESULT OK";
	return 1;
}

my $dataset = Algorithm::DBSCAN::Dataset->new();
my @lines = split(/\n/, read_file('test_datasets/dbscan_test_dataset_2.txt'));
foreach my $line (@lines) {
	$dataset->AddPoint(new Algorithm::DBSCAN::Point(split(/\s+/, $line)));
}

my $dbscan = Algorithm::DBSCAN->new($dataset, 4 * 4, 2);