PageRenderTime 54ms CodeModel.GetById 6ms RepoModel.GetById 0ms app.codeStats 0ms

/lib/RDF/Closure/Engine/OWL2RL.pm

https://bitbucket.org/tobyink/p5-rdf-closure
Perl | 1421 lines | 1226 code | 135 blank | 60 comment | 62 complexity | be10105b34086de3e1bc48c9993b4b64 MD5 | raw file
  1. package RDF::Closure::Engine::OWL2RL;
  2. use 5.008;
  3. use strict;
  4. use utf8;
  5. use Error qw[:try];
  6. use RDF::Trine qw[statement iri];
  7. use RDF::Trine::Namespace qw[RDF RDFS OWL XSD];
  8. use RDF::Closure::AxiomaticTriples qw[
  9. $OWLRL_Datatypes_Disjointness
  10. $OWLRL_Axiomatic_Triples
  11. $OWLRL_D_Axiomatic_Triples
  12. ];
  13. use RDF::Closure::DatatypeHandling qw[
  14. literals_identical
  15. literal_valid
  16. ];
  17. use RDF::Closure::XsdDatatypes qw[
  18. $OWL_RL_Datatypes
  19. $OWL_Datatype_Subsumptions
  20. ];
  21. use RDF::Closure::Rule::Programmatic;
  22. use RDF::Closure::Rule::StatementMatcher;
  23. use Scalar::Util qw[blessed];
  24. use constant {
  25. TRUE => 1,
  26. FALSE => 0,
  27. };
  28. use namespace::clean;
  29. use base qw[RDF::Closure::Engine::Core];
  30. our $VERSION = '0.000_05';
  31. our @OneTimeRules = (
  32. # dt-type2, dt-not-type, dt-diff, dt-eq
  33. RDF::Closure::Rule::Programmatic->new(
  34. sub {
  35. my ($cl, $rule) = @_;
  36. my $implicit = {};
  37. my $explicit = {};
  38. my $used_datatypes = {};
  39. local *_add_to_explicit = sub
  40. {
  41. my ($s, $o) = map { $_->sse } @_;
  42. $explicit->{$s} = {}
  43. unless exists $explicit->{$s};
  44. $explicit->{$s}{$o}++;
  45. };
  46. local *_append_to_explicit = sub
  47. {
  48. my ($s, $o) = map { $_->sse } @_;
  49. $explicit->{$s} = {}
  50. unless exists $explicit->{$s};
  51. for my $d (keys %{ $explicit->{$o} })
  52. {
  53. $explicit->{$s}{$d}++;
  54. }
  55. };
  56. local *_add_to_used_datatypes = sub
  57. {
  58. my ($d) = @_;
  59. $d = $d->uri if blessed($d);
  60. $used_datatypes->{$d}++;
  61. };
  62. local *_handle_subsumptions = sub
  63. {
  64. my ($r, $dt) = @_;
  65. if (exists $OWL_Datatype_Subsumptions->{$dt})
  66. {
  67. foreach my $new_dt (@{ $OWL_Datatype_Subsumptions->{$dt} })
  68. {
  69. $cl->store_triple($r, $RDF->type, $new_dt);
  70. $cl->store_triple($new_dt, $RDF->type, $RDFS->Datatype);
  71. _add_to_used_datatypes($new_dt);
  72. }
  73. }
  74. };
  75. my %literals;
  76. $cl->graph->get_statements(undef, undef, undef)->each(sub
  77. {
  78. my $st = shift;
  79. my @nodes = $st->nodes;
  80. foreach my $lt (@nodes)
  81. {
  82. next unless $lt->is_literal;
  83. # We're now effectively in a foreach literal loop...
  84. # Add to %literals, but skip rest of this iteration if it was already there.
  85. next if $literals{ $lt->sse };
  86. $literals{ $lt->sse } = $lt;
  87. next unless $lt->has_datatype;
  88. $cl->store_triple($lt, $RDF->type, iri($lt->literal_datatype));
  89. next unless grep { $_->uri eq $lt->literal_datatype } @$OWL_RL_Datatypes;
  90. # RULE dt-type2
  91. $implicit->{ $lt->sse } = $lt->literal_datatype
  92. unless exists $implicit->{ $lt->sse };
  93. _add_to_used_datatypes($lt->literal_datatype);
  94. # RULE dt-not-type
  95. $cl->add_error("Literal's lexical value and datatype do not match: (%s,%s)",
  96. $lt->literal_value, $lt->literal_datatype)
  97. unless $cl->dt_handling->literal_valid($lt);
  98. }
  99. });
  100. # RULE dt-diff
  101. # RULE dt-eq
  102. foreach my $lt1 (keys %literals)
  103. {
  104. foreach my $lt2 (keys %literals)
  105. {
  106. if ($lt1 ne $lt2) # @@TODO doesn't work ???
  107. {
  108. my $l1 = $literals{$lt1};
  109. my $l2 = $literals{$lt2};
  110. if ($cl->dt_handling->literals_identical($l1, $l2))
  111. {
  112. $cl->store_triple($l1, $OWL->sameAs, $l2);
  113. }
  114. else
  115. {
  116. $cl->store_triple($l1, $OWL->differentFrom, $l2);
  117. }
  118. }
  119. }
  120. }
  121. # this next bit catches triples like { [] a xsd:string . }
  122. $cl->graph->get_statements(undef, $RDF->type, undef)->each(sub {
  123. my $st = shift;
  124. my ($s, $p, $o) = ($st->subject, $st->predicate, $st->object);
  125. if (grep { $_->equal($o); } @$OWL_RL_Datatypes)
  126. {
  127. _add_to_used_datatypes($o);
  128. _add_to_explicit($s, $o)
  129. unless exists $explicit->{ $s->sse };
  130. }
  131. });
  132. $cl->graph->get_statements(undef, $OWL->sameAs, undef)->each(sub {
  133. my $st = shift;
  134. my ($s, $p, $o) = ($st->subject, $st->predicate, $st->object);
  135. _append_to_explicit($s, $o) if exists $explicit->{$o};
  136. _append_to_explicit($o, $s) if exists $explicit->{$s};
  137. });
  138. foreach my $dt (@$OWL_RL_Datatypes)
  139. {
  140. $cl->store_triple($dt, $RDF->type, $RDFS->Datatype);
  141. }
  142. foreach my $dts (values %$explicit)
  143. {
  144. foreach my $dt (keys %$dts)
  145. {
  146. $cl->store_triple(iri($dt), $RDF->type, $RDFS->Datatype);
  147. }
  148. }
  149. foreach my $r (keys %$explicit)
  150. {
  151. my @dtypes = keys %{ $explicit->{$r} };
  152. $r = RDF::Trine::Node->from_sse($r);
  153. foreach my $dt (@dtypes)
  154. {
  155. $dt = $1 if $dt =~ /^<(.+)>$/;
  156. _handle_subsumptions($r, $dt);
  157. }
  158. }
  159. foreach my $r (keys %$implicit)
  160. {
  161. my $dt = $implicit->{$r};
  162. $r = RDF::Trine::Node->from_sse($r);
  163. _handle_subsumptions($r, $dt);
  164. }
  165. foreach my $t (@$OWLRL_Datatypes_Disjointness)
  166. {
  167. my ($l, $r) = ($t->subject, $t->object);
  168. $cl->store_triple($t)
  169. if exists $used_datatypes->{$l->uri}
  170. && exists $used_datatypes->{$r->uri};
  171. }
  172. },
  173. 'dt-type2, dt-not-type, dt-diff, dt-eq'
  174. ),
  175. # cls-thing
  176. RDF::Closure::Rule::Programmatic->new(
  177. sub {
  178. my ($cl, $rule) = @_;
  179. $cl->store_triple($OWL->Thing, $RDF->type, $OWL->Class);
  180. },
  181. 'cls-thing'
  182. ),
  183. # cls-nothing
  184. RDF::Closure::Rule::Programmatic->new(
  185. sub {
  186. my ($cl, $rule) = @_;
  187. $cl->store_triple($OWL->Nothing, $RDF->type, $OWL->Class);
  188. },
  189. 'cls-nothing'
  190. ),
  191. # prp-ap
  192. RDF::Closure::Rule::Programmatic->new(
  193. sub {
  194. my ($cl, $rule) = @_;
  195. my $OWLRL_Annotation_properties = [
  196. $RDFS->label,
  197. $RDFS->comment,
  198. $RDFS->seeAlso,
  199. $RDFS->isDefinedBy,
  200. $OWL->deprecated,
  201. $OWL->versionInfo,
  202. $OWL->priorVersion,
  203. $OWL->backwardCompatibleWith,
  204. $OWL->incompatibleWith,
  205. ];
  206. $cl->store_triple($_, $RDF->type, $OWL->AnnotationProperty)
  207. foreach @$OWLRL_Annotation_properties;
  208. },
  209. 'prp-ap'
  210. ),
  211. );
  212. my $_EQ_REF = {};
  213. our @Rules = (
  214. # prp-dom
  215. RDF::Closure::Rule::StatementMatcher->new(
  216. [undef, $RDFS->domain, undef],
  217. sub {
  218. my ($cl, $st, $rule) = @_; my ($prop, undef, $class) = $st->nodes;
  219. $cl->graph->subjects($prop)->each(sub {
  220. $cl->store_triple(shift, $RDF->type, $class);
  221. });
  222. },
  223. 'prp-dom' # Same as rdfs2
  224. ),
  225. # prp-rng
  226. RDF::Closure::Rule::StatementMatcher->new(
  227. [undef, $RDFS->range, undef],
  228. sub {
  229. my ($cl, $st, $rule) = @_; my ($prop, undef, $class) = $st->nodes;
  230. $cl->graph->objects(undef, $prop)->each(sub {
  231. $cl->store_triple(shift, $RDF->type, $class);
  232. });
  233. },
  234. 'prp-rng' # Same as rdfs3
  235. ),
  236. # prp-fp
  237. RDF::Closure::Rule::StatementMatcher->new(
  238. [undef, $RDF->type, $OWL->FunctionalProperty],
  239. sub {
  240. my ($cl, $st, $rule) = @_; my ($prop) = $st->nodes;
  241. $cl->graph->get_statements(undef, $prop, undef)->each(sub {
  242. my $x = $st->subject;
  243. my $y1 = $st->object;
  244. $cl->graph->objects($x, $prop)->each(sub{
  245. my $y2 = shift;
  246. $cl->store_triple($y1, $OWL->sameAs, $y2)
  247. unless $y1->equal($y2);
  248. });
  249. });
  250. },
  251. 'prp-fp'
  252. ),
  253. # prp-ifp
  254. RDF::Closure::Rule::StatementMatcher->new(
  255. [undef, $RDF->type, $OWL->InverseFunctionalProperty],
  256. sub {
  257. my ($cl, $st, $rule) = @_; my ($prop) = $st->nodes;
  258. $cl->graph->get_statements(undef, $prop, undef)->each(sub {
  259. my $st = shift;
  260. my $x = $st->object;
  261. my $y1 = $st->subject;
  262. $cl->graph->subjects($prop, $x)->each(sub{
  263. my $y2 = shift;
  264. $cl->store_triple($y1, $OWL->sameAs, $y2)
  265. unless $y1->equal($y2);
  266. });
  267. });
  268. },
  269. 'prp-ifp'
  270. ),
  271. # prp-irp
  272. RDF::Closure::Rule::StatementMatcher->new(
  273. [undef, $RDF->type, $OWL->IrreflexiveProperty],
  274. sub {
  275. my ($cl, $st, $rule) = @_; my ($prop) = $st->nodes;
  276. $cl->graph->get_statements(undef, $prop, undef)->each(sub{
  277. my $st = shift;
  278. $cl->add_error("Irreflexive property %s used reflexively on %s", $st->predicate, $st->subject)
  279. if $st->subject->equal($st->object);
  280. });
  281. },
  282. 'prp-irp'
  283. ),
  284. # prp-symp
  285. RDF::Closure::Rule::StatementMatcher->new(
  286. [undef, $RDF->type, $OWL->SymmetricProperty],
  287. sub {
  288. my ($cl, $st, $rule) = @_; my ($prop) = $st->nodes;
  289. $cl->graph->get_statements(undef, $prop, undef)->each(sub{
  290. my $st = shift;
  291. $cl->store_triple($st->object, $prop, $st->subject);
  292. });
  293. },
  294. 'prp-symp'
  295. ),
  296. # prp-asym
  297. RDF::Closure::Rule::StatementMatcher->new(
  298. [undef, $RDF->type, $OWL->AsymmetricProperty],
  299. sub {
  300. my ($cl, $st, $rule) = @_; my ($prop) = $st->nodes;
  301. $cl->graph->get_statements(undef, $prop, undef)->each(sub{
  302. my $st = shift;
  303. $cl->add_error("Asymmetric property %s used symmetrically on (%s,%s)", $st->predicate, $st->subject, $st->object)
  304. if $cl->graph->count_statements($st->object, $st->predicate, $st->subject);
  305. });
  306. },
  307. 'prp-asym'
  308. ),
  309. # prp-trp
  310. RDF::Closure::Rule::StatementMatcher->new(
  311. [undef, $RDF->type, $OWL->TransitiveProperty],
  312. sub {
  313. my ($cl, $st, $rule) = @_; my ($prop) = $st->nodes;
  314. $cl->graph->get_statements(undef, $prop, undef)->each(sub{
  315. my ($x, undef, $y) = $_[0]->nodes;
  316. $cl->graph->objects($y, $prop)->each(sub{
  317. my $z = $_[0];
  318. $cl->store_triple($x, $prop, $z);
  319. });
  320. });
  321. },
  322. 'prp-trp'
  323. ),
  324. # prp-adp
  325. RDF::Closure::Rule::StatementMatcher->new(
  326. [undef, $RDF->type, $OWL->AllDisjointProperties],
  327. sub {
  328. my ($cl, $st, $rule) = @_; my ($x) = $st->nodes;
  329. $cl->graph->get_statements($x, $OWL->members, undef)->each(sub {
  330. my @pis = $cl->graph->get_list($_[0]->object);
  331. for my $i (0 .. scalar(@pis)-1)
  332. {
  333. for my $j ($i+1 .. scalar(@pis)-1)
  334. {
  335. my $pi = $pis[$i];
  336. my $pj = $pis[$j];
  337. $cl->graph->get_statements(undef, $pi, undef)->each(sub {
  338. my ($x, undef, $y) = $_[0]->nodes;
  339. if ($cl->graph->count_statements($x, $pj, $y))
  340. {
  341. $cl->add_error("Disjoint properties in an 'AllDisjointProperties' are not really disjoint: %s %s %s and %s %s %s.", $x, $pi, $y, $x, $pj, $y);
  342. }
  343. });
  344. }
  345. }
  346. });
  347. },
  348. 'prp-adp'
  349. ),
  350. # prp-spo1
  351. RDF::Closure::Rule::StatementMatcher->new(
  352. [undef, $RDFS->subPropertyOf, undef],
  353. sub {
  354. my ($cl, $st, $rule) = @_; my ($prop1, undef, $prop2) = $st->nodes;
  355. $cl->graph->get_statements(undef, $prop1, undef)->each(sub {
  356. my $st = shift;
  357. $cl->store_triple($st->subject, $prop2, $st->object);
  358. });
  359. },
  360. 'prp-spo1' # Same as rdfs7
  361. ),
  362. # prp-spo2
  363. RDF::Closure::Rule::StatementMatcher->new(
  364. [undef, $OWL->propertyChainAxiom],
  365. sub {
  366. my ($cl, $st, $rule) = @_; my ($prop, undef, $chain) = $st->nodes;
  367. _property_chain($cl, $prop, $chain);
  368. },
  369. 'prp-spo2'
  370. ),
  371. # prp-eqp1, prp-eqp2
  372. RDF::Closure::Rule::StatementMatcher->new(
  373. [undef, $OWL->equivalentProperty, undef],
  374. sub {
  375. my ($cl, $st, $rule) = @_; my ($prop1, undef, $prop2) = $st->nodes;
  376. return if $prop1->equal($prop2);
  377. $cl->graph->get_statements(undef, $prop1, undef)->each(sub {
  378. my $st = shift;
  379. $cl->store_triple($st->subject, $prop2, $st->object);
  380. });
  381. $cl->graph->get_statements(undef, $prop2, undef)->each(sub {
  382. my $st = shift;
  383. $cl->store_triple($st->subject, $prop1, $st->object);
  384. });
  385. },
  386. 'prp-eqp1, prp-eqp2'
  387. ),
  388. # prp-pdw
  389. RDF::Closure::Rule::StatementMatcher->new(
  390. [undef, $OWL->propertyDisjointWith, undef],
  391. sub {
  392. my ($cl, $st, $rule) = @_; my ($prop1, undef, $prop2) = $st->nodes;
  393. $cl->graph->get_statements(undef, $prop1, undef)->each(sub {
  394. my $st = shift;
  395. $cl->add_error('Erronous usage of disjoint properties %s and %s on %s and %s', $prop1, $prop2, $st->subject, $st->object)
  396. if $cl->graph->count_statements($st->subject, $prop2, $st->object);
  397. });
  398. },
  399. 'prp-pdw'
  400. ),
  401. # prp-inv1, prp-inv2
  402. RDF::Closure::Rule::StatementMatcher->new(
  403. [undef, $OWL->inverseOf, undef],
  404. sub {
  405. my ($cl, $st, $rule) = @_; my ($prop1, undef, $prop2) = $st->nodes;
  406. $cl->graph->get_statements(undef, $prop1, undef)->each(sub {
  407. my $st = shift;
  408. $cl->store_triple($st->object, $prop2, $st->subject);
  409. });
  410. return if $prop1->equal($prop2);
  411. $cl->graph->get_statements(undef, $prop2, undef)->each(sub {
  412. my $st = shift;
  413. $cl->store_triple($st->object, $prop1, $st->subject);
  414. });
  415. },
  416. 'prp-inv1, prp-inv2'
  417. ),
  418. # prp-key
  419. RDF::Closure::Rule::StatementMatcher->new(
  420. [undef, $OWL->hasKey, undef],
  421. sub {
  422. my ($cl, $st, $rule) = @_; my ($c, $t, $u) = $st->nodes;
  423. my $G = $cl->graph;
  424. my @pis = $G->get_list($u);
  425. if (@pis)
  426. {
  427. foreach my $x ($G->subjects($RDF->type, $c))
  428. {
  429. my $finalList = [ map { [$_] } $G->objects($x, $pis[0]) ];
  430. my (undef, @otherPIS) = @pis;
  431. foreach my $pi (@otherPIS)
  432. {
  433. my $newList = [];
  434. foreach my $zi ($G->objects($x, $pi))
  435. {
  436. foreach my $l (@$finalList)
  437. {
  438. push @$newList, [@$l, $zi];
  439. }
  440. }
  441. $finalList = $newList;
  442. }
  443. my $valueList = [ grep { scalar(@$_)==scalar(@pis) } @$finalList ];
  444. #use Data::Dumper;
  445. #printf("%s is member of class %s, has key values:\n%s\n",
  446. # $x->as_ntriples,
  447. # $c->as_ntriples,
  448. # Dumper($valueList));
  449. INDY: foreach my $y ($G->subjects($RDF->type, $c))
  450. {
  451. next if $x->equal($y);
  452. next if $G->count_statements($x, $OWL->sameAs, $y);
  453. next if $G->count_statements($y, $OWL->sameAs, $x);
  454. foreach my $vals (@$valueList)
  455. {
  456. my $same = TRUE;
  457. PROP: for my $i (0 .. scalar(@pis)-1)
  458. {
  459. unless ($G->count_statements($y, $pis[$i], $vals->[$i]))
  460. {
  461. $same = FALSE;
  462. next PROP;
  463. }
  464. }
  465. if ($same)
  466. {
  467. $cl->store_triple($x, $OWL->sameAs, $y);
  468. $cl->store_triple($y, $OWL->sameAs, $x);
  469. next INDY;
  470. }
  471. }
  472. }
  473. }
  474. }
  475. },
  476. 'prp-key'
  477. ),
  478. # prp-npa1
  479. RDF::Closure::Rule::StatementMatcher->new(
  480. [undef, $OWL->targetIndividual, undef],
  481. sub {
  482. my ($cl, $st, $rule) = @_; my ($x, undef, $target) = $st->nodes;
  483. my @sources = $cl->graph->objects($x, $OWL->sourceIndividual);
  484. my @props = $cl->graph->objects($x, $OWL->assertionProperty);
  485. foreach my $s (@sources)
  486. {
  487. foreach my $p (@props)
  488. {
  489. if ($cl->graph->count_statements($s, $p, $target))
  490. {
  491. $cl->add_error('Negative (object) property assertion violated for: (%s %s %s .)', $s, $p, $target);
  492. }
  493. }
  494. }
  495. },
  496. 'prp-npa1'
  497. ),
  498. # prp-npa2
  499. RDF::Closure::Rule::StatementMatcher->new(
  500. [undef, $OWL->targetValue, undef],
  501. sub {
  502. my ($cl, $st, $rule) = @_; my ($x, undef, $target) = $st->nodes;
  503. my @sources = $cl->graph->objects($x, $OWL->sourceIndividual);
  504. my @props = $cl->graph->objects($x, $OWL->assertionProperty);
  505. foreach my $s (@sources)
  506. {
  507. foreach my $p (@props)
  508. {
  509. if ($cl->graph->count_statements($s, $p, $target))
  510. {
  511. $cl->add_error('Negative (datatype) property assertion violated for: (%s %s %s .)', $s, $p, $target);
  512. }
  513. }
  514. }
  515. },
  516. 'prp-npa2'
  517. ),
  518. # eq-ref
  519. RDF::Closure::Rule::StatementMatcher->new(
  520. [],
  521. sub {
  522. my ($cl, $st, $rule) = @_;
  523. my @nodes = $st->nodes;
  524. for (0..2)
  525. {
  526. next if $_EQ_REF->{ $nodes[$_]->sse }++; # optimisation
  527. $cl->store_triple($nodes[$_], $OWL->sameAs, $nodes[$_]);
  528. }
  529. },
  530. 'eq-ref'
  531. ),
  532. # eq-sym
  533. RDF::Closure::Rule::StatementMatcher->new(
  534. [undef, $OWL->sameAs, undef],
  535. sub {
  536. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  537. $cl->store_triple($o, $OWL->sameAs, $s);
  538. },
  539. 'eq-sym'
  540. ),
  541. # eq-trans
  542. RDF::Closure::Rule::StatementMatcher->new(
  543. [undef, $OWL->sameAs, undef],
  544. sub {
  545. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  546. foreach my $z ($cl->graph->objects($o, $OWL->sameAs))
  547. {
  548. $cl->store_triple($s, $OWL->sameAs, $z);
  549. $cl->store_triple($z, $OWL->sameAs, $s);
  550. }
  551. },
  552. 'eq-trans'
  553. ),
  554. # eq-rep-s
  555. RDF::Closure::Rule::StatementMatcher->new(
  556. [undef, $OWL->sameAs, undef],
  557. sub {
  558. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  559. $cl->graph->get_statements($s, undef, undef)->each(sub {
  560. $cl->store_triple($o, $_[0]->predicate, $_[0]->object);
  561. });
  562. },
  563. 'eq-rep-s'
  564. ),
  565. # eq-rep-p
  566. RDF::Closure::Rule::StatementMatcher->new(
  567. [undef, $OWL->sameAs, undef],
  568. sub {
  569. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  570. $cl->graph->get_statements(undef, $s, undef)->each(sub {
  571. $cl->store_triple($_[0]->subject, $o, $_[0]->object);
  572. });
  573. },
  574. 'eq-rep-p'
  575. ),
  576. # eq-rep-o
  577. RDF::Closure::Rule::StatementMatcher->new(
  578. [undef, $OWL->sameAs, undef],
  579. sub {
  580. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  581. $cl->graph->get_statements(undef, undef, $s)->each(sub {
  582. $cl->store_triple($_[0]->subject, $_[0]->predicate, $o);
  583. });
  584. },
  585. 'eq-rep-o'
  586. ),
  587. # eq-diff
  588. RDF::Closure::Rule::StatementMatcher->new(
  589. [undef, $OWL->sameAs, undef],
  590. sub {
  591. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  592. $cl->add_error("'sameAs' and 'differentFrom' cannot be used on the same subject-object pair: (%s, %s)", $s, $o)
  593. if $cl->graph->count_statements($s, $OWL->differentFrom, $o)
  594. || $cl->graph->count_statements($o, $OWL->differentFrom, $s);
  595. },
  596. 'eq-diff'
  597. ),
  598. # eq-diff2 and eq-diff3
  599. RDF::Closure::Rule::StatementMatcher->new(
  600. [undef, $RDF->type, $OWL->AllDifferent],
  601. sub {
  602. my ($cl, $st, $rule) = @_; my ($s, $p, $o) = $st->nodes;
  603. my $x = $s;
  604. my @m1 = $cl->graph->objects($x, $OWL->members);
  605. my @m2 = $cl->graph->objects($x, $OWL->distinctMembers);
  606. LOOPY: foreach my $y ((@m1, @m2))
  607. {
  608. my @zis = $cl->graph->get_list($y);
  609. LOOPI: foreach my $i (0 .. scalar(@zis)-1)
  610. {
  611. my $zi = $zis[$i];
  612. LOOPJ: foreach my $j ($i+1 .. scalar(@zis)-1)
  613. {
  614. my $zj = $zis[$j];
  615. next LOOPJ if $zi->equal($zj); # caught by another rule
  616. $cl->add_error("'sameAs' and 'AllDifferent' cannot be used on the same subject-object pair: (%s, %s)", $zi, $zj)
  617. if $cl->graph->count_statements($zi, $OWL->sameAs, $zj)
  618. || $cl->graph->count_statements($zj, $OWL->sameAs, $zi);
  619. }
  620. }
  621. }
  622. },
  623. 'eq-diff2, eq-diff3'
  624. ),
  625. # Ivan doesn't seem to have this rule, but it's required by test cases.
  626. # { ?x1 owl:differentFrom ?x2 . } => { ?x2 owl:differentFrom ?x1 . } .
  627. RDF::Closure::Rule::StatementMatcher->new(
  628. [undef, $OWL->differentFrom, undef],
  629. sub {
  630. my ($cl, $st, $rule) = @_;
  631. my ($x1, undef, $x2) = $st->nodes;
  632. $cl->store_triple($x2, $OWL->differentFrom, $x1);
  633. },
  634. '????'
  635. ),
  636. # cls-nothing2
  637. RDF::Closure::Rule::StatementMatcher->new(
  638. [undef, $RDF->type, $OWL->Nothing],
  639. sub {
  640. my ($cl, $st, $rule) = @_;
  641. $cl->add_error("%s is defined of type 'Nothing'", $st->subject);
  642. },
  643. 'cls-nothing'
  644. ),
  645. # cls-int1, cls-int2
  646. RDF::Closure::Rule::StatementMatcher->new(
  647. [undef, $OWL->intersectionOf, undef],
  648. sub {
  649. my ($cl, $st, $rule) = @_;
  650. my ($c, undef, $x) = $st->nodes;
  651. my @classes = $cl->graph->get_list($x);
  652. return unless @classes;
  653. # cls-int1
  654. foreach my $y ($cl->graph->subjects($RDF->type, $classes[0]))
  655. {
  656. my $isInIntersection = TRUE;
  657. unless ($cl->graph->count_statements($y, $RDF->type, $c)) # Ivan doesn't do this check
  658. {
  659. CI: foreach my $ci (@classes[1 .. scalar(@classes)-1])
  660. {
  661. unless ($cl->graph->count_statements($y, $RDF->type, $ci))
  662. {
  663. $isInIntersection = FALSE;
  664. last CI;
  665. }
  666. }
  667. if ($isInIntersection)
  668. {
  669. $cl->store_triple($y, $RDF->type, $c);
  670. }
  671. }
  672. }
  673. # cls-int2
  674. foreach my $y ($cl->graph->subjects($RDF->type, $c))
  675. {
  676. $cl->store_triple($y, $RDF->type, $_) foreach @classes;
  677. }
  678. },
  679. 'cls-int1, cls-int2'
  680. ),
  681. RDF::Closure::Rule::StatementMatcher->new(
  682. [undef, $OWL->unionOf, undef],
  683. sub {
  684. my ($cl, $st, $rule) = @_;
  685. my ($c, undef, $x) = $st->nodes;
  686. my @classes = $cl->graph->get_list($x);
  687. foreach my $cu (@classes)
  688. {
  689. $cl->graph->subjects($RDF->type, $cu)->each(sub {
  690. $cl->store_triple($_[0], $RDF->type, $c);
  691. });
  692. }
  693. },
  694. 'cls-uni'
  695. ),
  696. RDF::Closure::Rule::StatementMatcher->new(
  697. [undef, $OWL->complementOf, undef],
  698. sub {
  699. my ($cl, $st, $rule) = @_;
  700. my ($c1, undef, $c2) = $st->nodes;
  701. $cl->graph->subjects($RDF->type, $c1)->each(sub{
  702. $cl->add_error("Violation of complementarity for classes %s and %s on element %s", $c1, $c2, $_[0])
  703. if $cl->graph->count_statements($_[0], $RDF->type, $c2);
  704. });
  705. },
  706. 'cls-comm'
  707. ),
  708. RDF::Closure::Rule::StatementMatcher->new(
  709. [undef, $OWL->someValuesFrom, undef],
  710. sub {
  711. my ($cl, $st, $rule) = @_;
  712. my ($xx, undef, $y) = $st->nodes;
  713. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  714. my $pp = shift;
  715. $cl->graph->get_statements(undef, $pp, undef)->each(sub{
  716. my ($u, undef, $v) = $_[0]->nodes;
  717. if ($y->equal($OWL->Thing) or $cl->graph->count_statements($u, $RDF->type, $y))
  718. {
  719. $cl->store_triple($u, $RDF->type, $xx);
  720. }
  721. });
  722. });
  723. },
  724. 'cls-svf1, cls-svf2'
  725. ),
  726. RDF::Closure::Rule::StatementMatcher->new(
  727. [undef, $OWL->allValuesFrom, undef],
  728. sub {
  729. my ($cl, $st, $rule) = @_;
  730. my ($xx, undef, $y) = $st->nodes;
  731. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  732. my $pp = shift;
  733. $cl->graph->subjects($RDF->type, $xx)->each(sub{
  734. my $u = shift;
  735. $cl->graph->objects($u, $pp)->each(sub{
  736. my $v = shift;
  737. $cl->store_triple($v, $RDF->type, $y);
  738. });
  739. });
  740. });
  741. },
  742. 'cls-avf'
  743. ),
  744. RDF::Closure::Rule::StatementMatcher->new(
  745. [undef, $OWL->hasValue, undef],
  746. sub {
  747. my ($cl, $st, $rule) = @_;
  748. my ($xx, undef, $y) = $st->nodes;
  749. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  750. my $pp = shift;
  751. $cl->graph->subjects($RDF->type, $xx)->each(sub{
  752. my $u = shift;
  753. $cl->store_triple($u, $pp, $y);
  754. });
  755. $cl->graph->subjects($pp, $y)->each(sub{
  756. my $u = shift;
  757. $cl->store_triple($u, $RDF->type, $xx);
  758. });
  759. });
  760. },
  761. 'cls-hv1, cls-hv2'
  762. ),
  763. RDF::Closure::Rule::StatementMatcher->new(
  764. [undef, $OWL->maxCardinality, undef],
  765. sub {
  766. my ($cl, $st, $rule) = @_;
  767. my ($xx, undef, $x) = $st->nodes;
  768. my $val = int( $x->is_literal ? $x->literal_value : -1 );
  769. # maxc1
  770. if ($val == 0)
  771. {
  772. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  773. my $pp = shift;
  774. $cl->graph->get_statements(undef, $pp, undef)->each(sub{
  775. my ($u, undef, $y) = $_[0]->nodes;
  776. $cl->add_error("Erronous usage of maximum cardinality with %s, %s", $xx, $y)
  777. if $cl->graph->count_statements($u, $RDF->type, $xx);
  778. });
  779. });
  780. }
  781. # maxc2
  782. elsif ($val == 1)
  783. {
  784. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  785. my $pp = shift;
  786. $cl->graph->get_statements(undef, $pp, undef)->each(sub{
  787. my ($u, undef, $y1) = $_[0]->nodes;
  788. if ($cl->graph->count_statements($u, $RDF->type, $xx))
  789. {
  790. $cl->graph->objects($u, $pp)->each(sub{
  791. my $y2 = shift;
  792. unless ($y1->equal($y2))
  793. {
  794. $cl->store_triple($y1, $OWL->sameAs, $y2);
  795. $cl->store_triple($y2, $OWL->sameAs, $y1);
  796. }
  797. });
  798. }
  799. });
  800. });
  801. }
  802. else
  803. {
  804. # awesome, we can't do anything!
  805. }
  806. },
  807. 'cls-maxc1, cls-maxc2'
  808. ),
  809. RDF::Closure::Rule::StatementMatcher->new(
  810. [undef, $OWL->maxCardinality, undef],
  811. sub {
  812. my ($cl, $st, $rule) = @_;
  813. my ($xx, undef, $x) = $st->nodes;
  814. my $val = int( $x->is_literal ? $x->literal_value : -1 );
  815. # cls-maxqc1 and cls-maxqc2
  816. if ($val == 0)
  817. {
  818. my @cc = $cl->graph->objects($xx, $OWL->onClass);
  819. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  820. my $pp = shift;
  821. foreach my $cc (@cc)
  822. {
  823. $cl->graph->get_statements(undef, $pp, undef)->each(sub{
  824. my ($u, undef, $y) = $_[0]->nodes;
  825. $cl->add_error("Erronous usage of maximum qualified cardinality with %s, %s, and %s", $xx, $cc, $y)
  826. if $cl->graph->count_statements($u, $RDF->type, $xx)
  827. && ($cc->equal($OWL->Thing) or $cl->graph->count_statements($y, $RDF->type, $cc));
  828. });
  829. }
  830. });
  831. }
  832. # cls-maxqc3 and cls-maxqc4
  833. elsif ($val == 1)
  834. {
  835. my @cc = $cl->graph->objects($xx, $OWL->onClass);
  836. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  837. my $pp = shift;
  838. foreach my $cc (@cc)
  839. {
  840. $cl->graph->get_statements(undef, $pp, undef)->each(sub{
  841. my ($u, undef, $y1) = $_[0]->nodes;
  842. if ($cl->graph->count_statements($u, $RDF->type, $xx))
  843. {
  844. if ($cc->equal($OWL->Thing))
  845. {
  846. $cl->graph->objects($u, $pp)->each(sub{
  847. my $y2 = shift;
  848. unless ($y1->equal($y2))
  849. {
  850. $cl->store_triple($y1, $OWL->sameAs, $y2);
  851. $cl->store_triple($y2, $OWL->sameAs, $y1);
  852. }
  853. });
  854. }
  855. elsif ($cl->graph->count_statements($y1, $RDF->type, $cc))
  856. {
  857. $cl->graph->objects($u, $pp)->each(sub{
  858. my $y2 = shift;
  859. if (!$y1->equal($y2)
  860. and $cl->graph->count_statements($y2, $RDF->type, $cc))
  861. {
  862. $cl->store_triple($y1, $OWL->sameAs, $y2);
  863. $cl->store_triple($y2, $OWL->sameAs, $y1);
  864. }
  865. });
  866. }
  867. }
  868. });
  869. }
  870. });
  871. }
  872. else
  873. {
  874. # awesome, we can't do anything!
  875. }
  876. },
  877. 'cls-maxqc1, cls-maxqc2, cls-maxqc3, cls-maxqc4'
  878. ),
  879. RDF::Closure::Rule::StatementMatcher->new(
  880. [undef, $OWL->oneOf, undef],
  881. sub {
  882. my ($cl, $st, $rule) = @_;
  883. my ($c, undef, $x) = $st->nodes;
  884. my @indivs = $cl->graph->get_list($x);
  885. foreach my $i (@indivs)
  886. {
  887. $cl->store_triple($i, $RDF->type, $c);
  888. }
  889. },
  890. 'cls-oo'
  891. ),
  892. RDF::Closure::Rule::StatementMatcher->new(
  893. [undef, $RDFS->subClassOf, undef],
  894. sub {
  895. my ($cl, $st, $rule) = @_;
  896. my ($c1, undef, $c2) = $st->nodes;
  897. unless ($c1->equal($c2))
  898. {
  899. $cl->graph->subjects($RDF->type, $c1)->each(sub {
  900. $cl->store_triple($_[0], $RDF->type, $c2);
  901. });
  902. }
  903. },
  904. 'cax-sco'
  905. ),
  906. RDF::Closure::Rule::StatementMatcher->new(
  907. [undef, $OWL->equivalentClass, undef],
  908. sub {
  909. my ($cl, $st, $rule) = @_;
  910. my ($c1, undef, $c2) = $st->nodes;
  911. $cl->store_triple($c2, $OWL->equivalentClass, $c1); # Toby added
  912. $cl->store_triple($c1, $RDFS->subClassOf, $c2);
  913. $cl->store_triple($c2, $RDFS->subClassOf, $c1);
  914. unless ($c1->equal($c2))
  915. {
  916. $cl->graph->subjects($RDF->type, $c1)->each(sub {
  917. $cl->store_triple($_[0], $RDF->type, $c2);
  918. });
  919. $cl->graph->subjects($RDF->type, $c2)->each(sub {
  920. $cl->store_triple($_[0], $RDF->type, $c1);
  921. });
  922. }
  923. },
  924. 'cax-eqc, cax-eqc1'
  925. ),
  926. RDF::Closure::Rule::StatementMatcher->new(
  927. [undef, $OWL->disjointWith, undef],
  928. sub {
  929. my ($cl, $st, $rule) = @_;
  930. my ($c1, undef, $c2) = $st->nodes;
  931. $cl->graph->subjects($RDF->type, $c1)->each(sub {
  932. $cl->add_error('Disjoint classes %s and %s have a common individual %s', $c1, $c2, $_[0])
  933. if $cl->graph->count_statements($_[0], $RDF->type, $c2);
  934. });
  935. },
  936. 'cax-dw'
  937. ),
  938. RDF::Closure::Rule::StatementMatcher->new(
  939. [undef, $RDF->type, $OWL->AllDisjointClasses],
  940. sub {
  941. my ($cl, $st, $rule) = @_;
  942. my $x = $st->subject;
  943. $cl->graph->objects($x, $OWL->members)->each(sub{
  944. my @classes = $cl->graph->get_list($_[0]);
  945. if (@classes)
  946. {
  947. for my $i (0 .. scalar(@classes)-1)
  948. {
  949. my $cl1 = $classes[$i];
  950. $cl->graph->subjects($RDF->type, $cl1)->each(sub{
  951. my $z = shift;
  952. for my $j ($i+1 .. scalar(@classes)-1)
  953. {
  954. my $cl2 = $classes[$j];
  955. $cl->add_error("Disjoint classes %s and %s have a common individual %s", $cl1, $cl2, $z)
  956. if $cl->graph->count_statements($z, $RDF->type, $cl2);
  957. }
  958. });
  959. }
  960. }
  961. });
  962. },
  963. 'cax-adc'
  964. ),
  965. RDF::Closure::Rule::StatementMatcher->new(
  966. [undef, $RDF->type, $OWL->Class],
  967. sub {
  968. my ($cl, $st, $rule) = @_;
  969. my ($c) = $st->nodes;
  970. $cl->store_triple($c, $RDFS->subClassOf, $c);
  971. $cl->store_triple($c, $OWL->equivalentClass, $c);
  972. $cl->store_triple($c, $RDFS->subClassOf, $OWL->Thing);
  973. $cl->store_triple($OWL->Nothing, $RDFS->subClassOf, $c);
  974. },
  975. 'scm-cls'
  976. ),
  977. RDF::Closure::Rule::StatementMatcher->new(
  978. [undef, $RDFS->subClassOf, undef],
  979. sub {
  980. my ($cl, $st, $rule) = @_;
  981. my ($c1, undef, $c2) = $st->nodes;
  982. $cl->graph->objects($c2, $RDFS->subClassOf)->each(sub {
  983. my $c3 = $_[0];
  984. if ($c1->equal($c3))
  985. {
  986. # scm-eqc2
  987. $cl->store_triple($c1, $OWL->equivalentClass, $c3);
  988. }
  989. else
  990. {
  991. # scm-sco
  992. $cl->store_triple($c1, $RDFS->subClassOf, $c3);
  993. }
  994. # Ivan could optimise his version better.
  995. });
  996. },
  997. 'scm-sco, scm-eqc2'
  998. ),
  999. RDF::Closure::Rule::StatementMatcher->new(
  1000. [undef, $RDF->type, $OWL->ObjectProperty],
  1001. sub {
  1002. my ($cl, $st, $rule) = @_;
  1003. my ($pp) = $st->nodes;
  1004. $cl->store_triple($pp, $RDFS->subPropertyOf, $pp);
  1005. $cl->store_triple($pp, $OWL->equivalentProperty, $pp);
  1006. },
  1007. 'scm-op'
  1008. ),
  1009. RDF::Closure::Rule::StatementMatcher->new(
  1010. [undef, $RDF->type, $OWL->DatatypeProperty],
  1011. sub {
  1012. my ($cl, $st, $rule) = @_;
  1013. my ($pp) = $st->nodes;
  1014. $cl->store_triple($pp, $RDFS->subPropertyOf, $pp);
  1015. $cl->store_triple($pp, $OWL->equivalentProperty, $pp);
  1016. },
  1017. 'scm-dp'
  1018. ),
  1019. RDF::Closure::Rule::StatementMatcher->new(
  1020. [undef, $RDF->type, $RDF->Property],
  1021. sub {
  1022. my ($cl, $st, $rule) = @_;
  1023. my ($pp) = $st->nodes;
  1024. $cl->store_triple($pp, $RDFS->subPropertyOf, $pp);
  1025. $cl->store_triple($pp, $OWL->equivalentProperty, $pp);
  1026. },
  1027. '????' # Ivan made this up
  1028. ),
  1029. RDF::Closure::Rule::StatementMatcher->new(
  1030. [undef, $OWL->equivalentProperty, undef],
  1031. sub {
  1032. my ($cl, $st, $rule) = @_;
  1033. my ($p1, undef, $p2) = $st->nodes;
  1034. $cl->store_triple($p2, $OWL->equivalentProperty, $p1); # Toby added
  1035. $cl->store_triple($p1, $RDFS->subPropertyOf, $p2);
  1036. $cl->store_triple($p2, $RDFS->subPropertyOf, $p1);
  1037. unless ($p1->equal($p2))
  1038. {
  1039. $cl->graph->subjects($RDF->type, $p1)->each(sub {
  1040. $cl->store_triple($_[0], $RDF->type, $p2);
  1041. });
  1042. $cl->graph->subjects($RDF->type, $p2)->each(sub {
  1043. $cl->store_triple($_[0], $RDF->type, $p1);
  1044. });
  1045. }
  1046. },
  1047. 'cax-eqp, cax-eqp1'
  1048. ),
  1049. RDF::Closure::Rule::StatementMatcher->new(
  1050. [undef, $RDFS->subPropertyOf, undef],
  1051. sub {
  1052. my ($cl, $st, $rule) = @_;
  1053. my ($p1, undef, $p2) = $st->nodes;
  1054. $cl->graph->objects($p2, $RDFS->subPropertyOf)->each(sub {
  1055. my $p3 = $_[0];
  1056. if ($p1->equal($p3))
  1057. {
  1058. # scm-eqp2
  1059. $cl->store_triple($p1, $OWL->equivalentProperty, $p3);
  1060. }
  1061. else
  1062. {
  1063. # scm-spo
  1064. $cl->store_triple($p1, $RDFS->subPropertyOf, $p3);
  1065. }
  1066. # Ivan could optimise his version better.
  1067. });
  1068. },
  1069. 'scm-spo, scm-eqp2'
  1070. ),
  1071. RDF::Closure::Rule::StatementMatcher->new(
  1072. [undef, $RDFS->domain, undef],
  1073. sub {
  1074. my ($cl, $st, $rule) = @_;
  1075. my ($pp, undef, $c1) = $st->nodes;
  1076. $cl->graph->objects($c1, $RDFS->subClassOf)->each(sub {
  1077. my $c2 = $_[0];
  1078. $cl->store_triple($pp, $RDFS->domain, $c2) unless $c1->equal($c2);
  1079. });
  1080. my ($p2, undef, $c) = $st->nodes;
  1081. $cl->graph->subjects($RDFS->subPropertyOf, $p2)->each(sub {
  1082. my $p1 = $_[0];
  1083. $cl->store_triple($p1, $RDFS->domain, $c) unless $p1->equal($p2);
  1084. });
  1085. },
  1086. 'scm-dom1, scm-dom2'
  1087. ),
  1088. RDF::Closure::Rule::StatementMatcher->new(
  1089. [undef, $RDFS->range, undef],
  1090. sub {
  1091. my ($cl, $st, $rule) = @_;
  1092. my ($pp, undef, $c1) = $st->nodes;
  1093. $cl->graph->objects($c1, $RDFS->subClassOf)->each(sub {
  1094. my $c2 = $_[0];
  1095. $cl->store_triple($pp, $RDFS->range, $c2) unless $c1->equal($c2);
  1096. });
  1097. my ($p2, undef, $c) = $st->nodes;
  1098. $cl->graph->subjects($RDFS->subPropertyOf, $p2)->each(sub {
  1099. my $p1 = $_[0];
  1100. $cl->store_triple($p1, $RDFS->range, $c) unless $p1->equal($p2);
  1101. });
  1102. },
  1103. 'scm-rng1, scm-rng2'
  1104. ),
  1105. RDF::Closure::Rule::StatementMatcher->new(
  1106. [undef, $OWL->hasValue, undef],
  1107. sub {
  1108. my ($cl, $st, $rule) = @_;
  1109. my ($c1, undef, $i) = $st->nodes;
  1110. my @p1 = $cl->graph->objects($c1, $OWL->onProperty);
  1111. my @c2 = $cl->graph->subjects($OWL->hasValue, $i);
  1112. foreach my $p1 (@p1)
  1113. {
  1114. foreach my $c2 (@c2)
  1115. {
  1116. foreach my $p2 ($cl->graph->objects($c2, $OWL->onProperty))
  1117. {
  1118. $cl->store_triple($c1, $RDFS->subClassOf, $c2)
  1119. if $cl->graph->count_statements($p1, $RDFS->subPropertyOf, $p2);
  1120. }
  1121. }
  1122. }
  1123. },
  1124. 'scm-hv'
  1125. ),
  1126. RDF::Closure::Rule::StatementMatcher->new(
  1127. [undef, $OWL->someValuesFrom, undef],
  1128. sub {
  1129. my ($cl, $st, $rule) = @_;
  1130. my ($xx, undef, $y) = $st->nodes;
  1131. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  1132. my $pp = shift;
  1133. $cl->graph->get_statements(undef, $pp, undef)->each(sub{
  1134. my ($u, undef, $v) = (shift)->nodes;
  1135. if ($y->equal($OWL->Thing) or $cl->graph->count_statements($v, $RDF->type, $y))
  1136. {
  1137. $cl->store_triple($u, $RDF->type, $xx);
  1138. }
  1139. });
  1140. });
  1141. },
  1142. 'scm-svf1, scm-svf2'
  1143. ),
  1144. RDF::Closure::Rule::StatementMatcher->new(
  1145. [undef, $OWL->allValuesFrom, undef],
  1146. sub {
  1147. my ($cl, $st, $rule) = @_;
  1148. my ($xx, undef, $y) = $st->nodes;
  1149. $cl->graph->objects($xx, $OWL->onProperty)->each(sub{
  1150. my $pp = shift;
  1151. $cl->graph->subjects($RDF->type, $xx)->each(sub {
  1152. my $u = shift;
  1153. $cl->graph->objects($u, $pp)->each(sub {
  1154. my $v = shift;
  1155. $cl->store_triple($v, $RDF->type, $y);
  1156. });
  1157. });
  1158. });
  1159. },
  1160. 'scm-avf'
  1161. ),
  1162. # scm-int
  1163. RDF::Closure::Rule::StatementMatcher->new(
  1164. [undef, $OWL->intersectionOf, undef],
  1165. sub {
  1166. my ($cl, $st, $rule) = @_;
  1167. my ($c, undef, $x) = $st->nodes;
  1168. $cl->store_triple($c, $RDFS->subClassOf, $_) foreach $cl->graph->get_list($x);
  1169. },
  1170. 'scm-int'
  1171. ),
  1172. # scm-uni
  1173. RDF::Closure::Rule::StatementMatcher->new(
  1174. [undef, $OWL->unionOf, undef],
  1175. sub {
  1176. my ($cl, $st, $rule) = @_;
  1177. my ($c, undef, $x) = $st->nodes;
  1178. $cl->store_triple($_, $RDFS->subClassOf, $c) foreach $cl->graph->get_list($x);
  1179. },
  1180. 'scm-uni'
  1181. ),
  1182. );
  1183. sub _property_chain
  1184. {
  1185. my ($self, $p, $x) = @_;
  1186. my @chain = $self->graph->get_list($x);
  1187. return unless @chain;
  1188. $self->graph->get_statements(undef, $chain[0], undef)->each(sub {
  1189. my ($u1, $_y, $_z) = $_[0]->nodes;
  1190. my $finalList = [[$u1,$_z]];
  1191. my $chainExists = TRUE;
  1192. PI: foreach my $pi (@chain[1 .. scalar(@chain)-1])
  1193. {
  1194. my $newList = [];
  1195. foreach my $q (@$finalList)
  1196. {
  1197. my ($_u, $ui) = @$q;
  1198. foreach my $u ($self->graph->objects($ui, $pi))
  1199. {
  1200. push @$newList, [$u1, $u];
  1201. }
  1202. }
  1203. if (@$newList)
  1204. {
  1205. $finalList = $newList;
  1206. }
  1207. else
  1208. {
  1209. $chainExists = FALSE;
  1210. last PI;
  1211. }
  1212. }
  1213. if ($chainExists)
  1214. {
  1215. foreach my $q (@$finalList)
  1216. {
  1217. my ($_u, $un) = @$q;
  1218. $self->store_triple(($u1, $p, $un));
  1219. }
  1220. }
  1221. });
  1222. }
  1223. sub __init__
  1224. {
  1225. my ($self, @args) = @_;
  1226. $self->SUPER::__init__(@args);
  1227. $self->{bnodes} = [];
  1228. $self->{options}{technique} = 'RULE';
  1229. return $self;
  1230. }
  1231. sub _get_resource_or_literal
  1232. {
  1233. my ($self, $node) = @_;
  1234. $node; # ????
  1235. }
  1236. sub post_process
  1237. {
  1238. # Python version removes bnode predicate triples, but I'm going to keep them.
  1239. }
  1240. sub add_axioms
  1241. {
  1242. my ($self) = @_;
  1243. $self->store_triple(statement($_->nodes, $self->{axiom_context}))
  1244. foreach @$OWLRL_Axiomatic_Triples;
  1245. }
  1246. sub add_daxioms
  1247. {
  1248. my ($self) = @_;
  1249. $self->store_triple(statement($_->nodes, $self->{daxiom_context}))
  1250. foreach @$OWLRL_D_Axiomatic_Triples;
  1251. }
  1252. sub entailment_regime
  1253. {
  1254. return 'http://www.w3.org/ns/owl-profile/RL';
  1255. }
  1256. 1;
  1257. =head1 NAME
  1258. RDF::Closure::Engine::OWL2RL - OWL 2 RL inference
  1259. =head1 ANALOGOUS PYTHON
  1260. RDFClosure/OWLRL.py
  1261. =head1 DESCRIPTION
  1262. Performs OWL 2 inference, using the RL profile of OWL.
  1263. =head1 SEE ALSO
  1264. L<RDF::Closure::Engine>.
  1265. L<http://www.perlrdf.org/>.
  1266. L<http://www.w3.org/TR/2009/REC-owl2-profiles-20091027/#OWL_2_RL>.
  1267. =head1 AUTHOR
  1268. Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
  1269. =head1 COPYRIGHT
  1270. Copyright 2008-2011 Ivan Herman
  1271. Copyright 2011-2012 Toby Inkster
  1272. This library is free software; you can redistribute it and/or modify it
  1273. under any of the following licences:
  1274. =over
  1275. =item * The Artistic License 1.0 L<http://www.perlfoundation.org/artistic_license_1_0>.
  1276. =item * The GNU General Public License Version 1 L<http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt>,
  1277. or (at your option) any later version.
  1278. =item * The W3C Software Notice and License L<http://www.w3.org/Consortium/Legal/2002/copyright-software-20021231>.
  1279. =item * The Clarified Artistic License L<http://www.ncftp.com/ncftp/doc/LICENSE.txt>.
  1280. =back
  1281. =head1 DISCLAIMER OF WARRANTIES
  1282. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  1283. WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  1284. MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  1285. =cut