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