1# RDF::Trine::Graph
2# -----------------------------------------------------------------------------
3
4=head1 NAME
5
6RDF::Trine::Graph - Materialized RDF Graphs for testing isomorphism
7
8=head1 VERSION
9
10This document describes RDF::Trine::Graph version 1.019
11
12=head1 SYNOPSIS
13
14  use RDF::Trine::Graph;
15  my $a	= RDF::Trine::Graph->new( $model_a );
16  my $b	= RDF::Trine::Graph->new( $model_b );
17  print "graphs are " . ($a->equals( $b ) ? "the same" : "different");
18
19=head1 DESCRIPTION
20
21RDF::Trine::Graph provdes a mechanism for testing graph isomorphism based on
22graph triples from either a RDF::Trine::Model or a RDF::Trine::Iterator.
23Isomorphism testing requires materializing all of a graph's triples in memory,
24and so should be used carefully in situations with large graphs.
25
26=head1 METHODS
27
28=over 4
29
30=cut
31
32package RDF::Trine::Graph;
33
34use strict;
35use warnings;
36no warnings 'redefine';
37
38use Algorithm::Combinatorics qw(permutations);
39
40our ($VERSION, $debug, $AUTOLOAD);
41BEGIN {
42	$debug		= 0;
43	$VERSION	= '1.019';
44}
45
46use overload
47	'=='	=> \&RDF::Trine::Graph::_eq,
48	'eq'	=> \&RDF::Trine::Graph::_eq,
49	'le'	=> \&RDF::Trine::Graph::_le,
50	'ge'	=> \&RDF::Trine::Graph::_ge,
51	'lt'	=> \&RDF::Trine::Graph::_lt,
52	'gt'	=> \&RDF::Trine::Graph::_gt,
53	;
54
55sub _eq {
56	my ($x, $y) = @_;
57	return $x->equals($y);
58}
59
60sub _le {
61	my ($x, $y) = @_;
62	return $x->is_subgraph_of($y);
63}
64
65sub _ge {
66	return _le(@_[1,0]);
67}
68
69sub _lt {
70	my ($x, $y) = @_;
71#	Test::More::diag(sprintf('%s // %s', ref($x), ref($y)));
72	return ($x->size < $y->size) && ($x->is_subgraph_of($y));
73}
74
75sub _gt {
76	return _lt(@_[1,0]);
77}
78
79use Data::Dumper;
80use Log::Log4perl;
81use Scalar::Util qw(blessed);
82use RDF::Trine::Node;
83use RDF::Trine::Store;
84
85=item C<< new ( $model ) >>
86
87=item C<< new ( $iterator ) >>
88
89Returns a new graph from the given RDF::Trine::Model or RDF::Trine::Iterator::Graph object.
90
91=cut
92
93sub new {
94	my $class	= shift;
95	unless (blessed($_[0])) {
96		throw RDF::Trine::Error::MethodInvocationError -text => "RDF::Trine::Graph::new must be called with a Model or Iterator argument";
97	}
98
99	my %data;
100	if ($_[0]->isa('RDF::Trine::Iterator::Graph')) {
101		my $iter	= shift;
102		my $model	= RDF::Trine::Model->new( RDF::Trine::Store->temporary_store() );
103		while (my $st = $iter->next) {
104			$model->add_statement( $st );
105		}
106		$data{ model }	= $model;
107	} elsif ($_[0]->isa('RDF::Trine::Model')) {
108		$data{ model }	= shift;
109	} else {
110		throw RDF::Trine::Error::MethodInvocationError -text => "RDF::Trine::Graph::new must be called with a Model or Iterator argument";
111	}
112
113	my $self	= bless(\%data, $class);
114}
115
116=item C<< equals ( $graph ) >>
117
118Returns true if the invocant and $graph represent two equal RDF graphs (e.g.
119there exists a bijection between the RDF statements of the invocant and $graph).
120
121=cut
122
123sub equals {
124	my $self  = shift;
125	my $graph = shift;
126	undef($self->{error});
127	return $self->_check_equality($graph) ? 1 : 0;
128}
129
130sub _check_equality {
131	my $self	= shift;
132	my $graph	= shift;
133	unless (blessed($graph) and $graph->isa('RDF::Trine::Graph')) {
134		$self->{error}	= "RDF::Trine::Graph::equals must be called with a Graph argument";
135		throw RDF::Trine::Error::MethodInvocationError -text => $self->{error};
136	}
137
138	my @graphs	= ($self, $graph);
139	my ($ba, $nba)	= $self->split_blank_statements;
140	my ($bb, $nbb)	= $graph->split_blank_statements;
141	if (scalar(@$nba) != scalar(@$nbb)) {
142		my $nbac	= scalar(@$nba);
143		my $nbbc	= scalar(@$nbb);
144		$self->{error}	= "count of non-blank statements didn't match ($nbac != $nbbc)";
145		return 0;
146	}
147	my $bac	= scalar(@$ba);
148	my $bbc	= scalar(@$bb);
149	if ($bac != $bbc) {
150		$self->{error}	= "count of blank statements didn't match ($bac != $bbc)";
151		return 0;
152	}
153
154	for ($nba, $nbb) {
155		@$_	= sort map { $_->as_string } @$_;
156	}
157
158	foreach my $i (0 .. $#{ $nba }) {
159		unless ($nba->[$i] eq $nbb->[$i]) {
160			$self->{error}	= "non-blank triples don't match: " . Dumper($nba->[$i], $nbb->[$i]);
161			return 0;
162		}
163	}
164
165	return _find_mapping($self, $ba, $bb);
166}
167
168=item C<< is_subgraph_of ( $graph ) >>
169
170Returns true if the invocant is a subgraph of $graph. (i.e. there exists an
171injection of RDF statements from the invocant to $graph.)
172
173=cut
174
175sub is_subgraph_of {
176	my $self  = shift;
177	my $graph = shift;
178	undef($self->{error});
179	return $self->_check_subgraph($graph) ? 1 : 0;
180}
181
182=item C<< injection_map ( $graph ) >>
183
184If the invocant is a subgraph of $graph, returns a mapping of blank node
185identifiers from the invocant graph to $graph as a hashref. Otherwise
186returns false. The solution is not always unique; where there exist multiple
187solutions, the solution returned is arbitrary.
188
189=cut
190
191sub injection_map {
192	my $self  = shift;
193	my $graph = shift;
194	undef($self->{error});
195	my $map   = $self->_check_subgraph($graph);
196	return $map if $map;
197	return;
198}
199
200sub _check_subgraph {
201	my $self	= shift;
202	my $graph	= shift;
203	unless (blessed($graph) and $graph->isa('RDF::Trine::Graph')) {
204		throw RDF::Trine::Error::MethodInvocationError -text => "RDF::Trine::Graph::equals must be called with a Graph argument";
205	}
206
207	my @graphs	= ($self, $graph);
208	my ($ba, $nba)	= $self->split_blank_statements;
209	my ($bb, $nbb)	= $graph->split_blank_statements;
210
211	if (scalar(@$nba) > scalar(@$nbb)) {
212		$self->{error}	= "invocant had too many blank node statements to be a subgraph of argument";
213		return 0;
214	} elsif (scalar(@$ba) > scalar(@$bb)) {
215		$self->{error}	= "invocant had too many non-blank node statements to be a subgraph of argument";
216		return 0;
217	}
218
219	my %NBB = map { $_->as_string => 1 } @$nbb;
220
221	foreach my $st (@$nba) {
222		unless ($NBB{ $st->as_string }) {
223			return 0;
224		}
225	}
226
227	return _find_mapping($self, $ba, $bb);
228}
229
230sub _find_mapping {
231	my ($self, $ba, $bb) = @_;
232
233	if (scalar(@$ba) == 0) {
234		return {};
235	}
236
237	my %blank_ids_a;
238	foreach my $st (@$ba) {
239		foreach my $n (grep { $_->isa('RDF::Trine::Node::Blank') } $st->nodes) {
240			$blank_ids_a{ $n->blank_identifier }++;
241		}
242	}
243
244	my %blank_ids_b;
245	foreach my $st (@$bb) {
246		foreach my $n (grep { $_->isa('RDF::Trine::Node::Blank') } $st->nodes) {
247			$blank_ids_b{ $n->blank_identifier }++;
248		}
249	}
250
251	my %bb_master	= map { $_->as_string => 1 } @$bb;
252
253	my @ka	= keys %blank_ids_a;
254	my @kb	= keys %blank_ids_b;
255	my $kbp	= permutations( \@kb );
256	my $count	= 0;
257	MAPPING: while (my $mapping = $kbp->next) {
258		my %mapping;
259		@mapping{ @ka }	= @$mapping;
260		warn "trying mapping: " . Dumper(\%mapping) if ($debug);
261
262		my %bb	= %bb_master;
263		foreach my $st (@$ba) {
264			my @nodes;
265			foreach my $method ($st->node_names) {
266				my $n	= $st->$method();
267				if ($n->isa('RDF::Trine::Node::Blank')) {
268					my $id	= $mapping{ $n->blank_identifier };
269					warn "mapping " . $n->blank_identifier . " to $id\n" if ($debug);
270					push(@nodes, RDF::Trine::Node::Blank->new( $id ));
271				} else {
272					push(@nodes, $n);
273				}
274			}
275			my $class	= ref($st);
276			my $mapped_st	= $class->new( @nodes )->as_string;
277			warn "checking for '$mapped_st' in " . Dumper(\%bb) if ($debug);
278			if ($bb{ $mapped_st }) {
279				delete $bb{ $mapped_st };
280			} else {
281				next MAPPING;
282			}
283		}
284		$self->{error}	=  "found mapping: " . Dumper(\%mapping) if ($debug);
285		return \%mapping;
286	}
287
288	$self->{error}	=  "didn't find blank node mapping\n";
289	return 0;
290}
291
292=item C<< split_blank_statements >>
293
294Returns two array refs, containing triples with blank nodes and triples without
295any blank nodes, respectively.
296
297=cut
298
299sub split_blank_statements {
300	my $self	= shift;
301	my $iter	= $self->get_statements;
302	my (@blanks, @nonblanks);
303	while (my $st = $iter->next) {
304		if ($st->has_blanks) {
305			push(@blanks, $st);
306		} else {
307			push(@nonblanks, $st);
308		}
309	}
310	return (\@blanks, \@nonblanks);
311}
312
313=item C<< get_statements >>
314
315Returns a RDF::Trine::Iterator::Graph object for the statements in this graph.
316
317=cut
318
319# The code below actually goes further now and makes RDF::Trine::Graph
320# into a subclass of RDF::Trine::Model via object delegation. This feature
321# is undocumented as it's not clear whether this is desirable or not.
322
323=begin private
324
325=item C<< isa >>
326
327=cut
328
329sub isa {
330	my ($proto, $queried) = @_;
331	$proto = ref($proto) if ref($proto);
332	return UNIVERSAL::isa($proto, $queried) || RDF::Trine::Model->isa($queried);
333}
334
335=item C<< can >>
336
337=cut
338
339sub can {
340	my ($proto, $queried) = @_;
341	$proto = ref($proto) if ref($proto);
342	return UNIVERSAL::can($proto, $queried) || RDF::Trine::Model->can($queried);
343}
344
345sub AUTOLOAD {
346	my $self = shift;
347	return if $AUTOLOAD =~ /::DESTROY$/;
348	$AUTOLOAD =~ s/^(.+)::([^:]+)$/$2/;
349	return $self->{model}->$AUTOLOAD(@_);
350}
351
352=end private
353
354=item C<< error >>
355
356Returns an error string explaining the last failed C<< equal >> call.
357
358=cut
359
360sub error {
361	my $self	= shift;
362	return $self->{error};
363}
364
3651;
366
367__END__
368
369=back
370
371=head1 BUGS
372
373Please report any bugs or feature requests to through the GitHub web interface
374at L<https://github.com/kasei/perlrdf/issues>.
375
376=head1 AUTHOR
377
378Gregory Todd Williams  C<< <gwilliams@cpan.org> >>
379
380=head1 COPYRIGHT
381
382Copyright (c) 2006-2012 Gregory Todd Williams. This
383program is free software; you can redistribute it and/or modify it under
384the same terms as Perl itself.
385
386=cut
387