sub new {
my $class = shift;
my @iters = @_;
my @values = $class->_materialize([], @iters);
return bless(\@values, $class);
}
sub _materialize {
my $class = shift;
my $v = shift;
my @iters = @_;
if (scalar(@iters)) {
my $i = shift(@iters);
my @values;
while (my $vv = $i->next) {
my $prefix = [@$v, @$vv];
push(@values, $class->_materialize($prefix, @iters));
}
return @values;
} else {
return $v;
}
}
sub next {
my $self = shift;
return shift(@$self);
}
}
has error => (is => 'rw', isa => Str, init_arg => undef);
sub _coerce {
my $o = shift;
if ($o->does('Attean::API::Model')) {
return $o->get_quads;
} elsif ($o->does('Attean::API::Iterator')) {
return $o;
}
return;
}
sub equals {
my $self = shift;
$self->error('');
return $self->_check_equality(@_) ? 1 : 0;
}
sub _check_equality {
my $self = shift;
my ($a, $b) = map { _coerce($_) } @_;
my @graphs = ($a, $b);
my ($ba, $nba) = $self->split_blank_statements($a);
my ($bb, $nbb) = $self->split_blank_statements($b);
if (scalar(@$nba) != scalar(@$nbb)) {
my $nbac = scalar(@$nba);
my $nbbc = scalar(@$nbb);
$self->error("count of non-blank statements didn't match ($nbac != $nbbc)");
return 0;
}
my $bac = scalar(@$ba);
my $bbc = scalar(@$bb);
if ($bac != $bbc) {
$self->error("count of blank statements didn't match ($bac != $bbc)");
return 0;
}
my $mapper = Attean::TermMap->canonicalization_map;
for ($nba, $nbb) {
@$_ = sort map { $_->apply_map($mapper)->as_string } @$_;
}
foreach my $i (0 .. $
unless ($nba->[$i] eq $nbb->[$i]) {
$self->error("non-blank triples don't match:\n" . Dumper($nba->[$i], $nbb->[$i]));
return 0;
}
}
return _find_mapping($self, $ba, $bb, 1);
}
sub is_subgraph_of {
my $self = shift;
$self->error('');
return $self->_check_subgraph(@_) ? 1 : 0;
}
sub injection_map {
my $self = shift;
$self->error('');
my $map = $self->_check_subgraph(@_);
return $map if $map;
return;
}
sub _check_subgraph {
my $self = shift;
my ($a, $b) = map { _coerce($_) } @_;
my @graphs = ($a, $b);
my ($ba, $nba) = $self->split_blank_statements($a);
my ($bb, $nbb) = $self->split_blank_statements($b);
if (scalar(@$nba) > scalar(@$nbb)) {
$self->error("invocant had too many blank node statements to be a subgraph of argument");
return 0;
} elsif (scalar(@$ba) > scalar(@$bb)) {
$self->error("invocant had too many non-blank node statements to be a subgraph of argument");
return 0;
}
my %NBB = map { $_->as_string => 1 } @$nbb;
foreach my $st (@$nba) {
unless ($NBB{ $st->as_string }) {
return 0;
}
}
return _find_mapping($self, $ba, $bb);
}
sub _statement_blank_irisets {
my $self = shift;
my @st = @_;
my %blank_ids_b_iris;
foreach my $st (@st) {
my @iris = map { $_->value } grep { $_->does('Attean::API::IRI') } $st->values;
unless (scalar(@iris)) {
push(@iris, '_');
}
foreach my $n (grep { $_->does('Attean::API::Blank') } $st->values) {
foreach my $i (@iris) {
$blank_ids_b_iris{$n->value}{$i}++;
}
}
}
my %iri_blanks;
foreach my $bid (sort keys %blank_ids_b_iris) {
my $d = Digest::MD5->new();
foreach my $iri (sort keys %{ $blank_ids_b_iris{$bid} }) {
$d->add($iri);
}
$iri_blanks{$d->hexdigest}{$bid}++;
}
return \%iri_blanks;
}
sub _find_mapping {
my $self = shift;
my $ba = shift;
my $bb = shift;
my $equal = shift || 0;
if (scalar(@$ba) == 0) {
return {};
}
my %blank_ids_a;
foreach my $st (@$ba) {
foreach my $n ($st->blanks) {
$blank_ids_a{ $n->value }++;
}
}
my %blank_ids_b;
foreach my $st (@$bb) {
foreach my $n ($st->blanks) {
$blank_ids_b{ $n->value }++;
}
}
my (@ka, @kb);
my $kbp;
@ka = keys %blank_ids_a;
@kb = keys %blank_ids_b;
$kbp = permutations( [shuffle @kb] );
my $canon_map = Attean::TermMap->canonicalization_map;
my %bb_master;
foreach my $bb_item (@$bb) {
my $k = $bb_item->apply_map($canon_map)->as_string;
$bb_master{ $k }++;
}
my $count = 0;
MAPPING: while (my $mapping = $kbp->next) {
my %mapping_str;
@mapping_str{ @ka } = @$mapping;
my %mapping = map {
Attean::Blank->new($_)->as_string => Attean::Blank->new($mapping_str{$_})
} (keys %mapping_str);
my $mapper = Attean::TermMap->rewrite_map(\%mapping);
$self->log->trace("trying mapping: " . Dumper($mapping));
my %bb = %bb_master;
foreach my $st (@$ba) {
my $mapped_st = $st->apply_map($mapper)->as_string;
$self->log->trace("checking for '$mapped_st' in " . Dumper(\%bb));
if ($bb{ $mapped_st }) {
$self->log->trace("Found mapping for binding: " . Dumper($mapped_st));
if (--$bb{ $mapped_st } == 0) {
delete $bb{ $mapped_st };
}
} else {
$self->log->trace("No mapping found for binding: " . Dumper($mapped_st));
next MAPPING;
}
}
$self->error("found mapping: " . Dumper(\%mapping_str));
return \%mapping_str;
}
$self->error("didn't find blank node mapping\n");
return 0;
}
sub split_blank_statements {
my $self = shift;
my $iter = shift;
my (@blanks, @nonblanks);
while (my $st = $iter->next) {
unless ($st->does('Attean::API::Binding')) {
die "Unexpected non-binding value found in BindingEqualityTest: " . $st->as_string;
}
if ($st->has_blanks) {
push(@blanks, $st);
} else {
push(@nonblanks, $st);
}
}
return (\@blanks, \@nonblanks);
}
}
1;