Improve rdfs entailment

Julien LepillerSun Apr 05 03:32:09+0200 2020

1f83418

Improve rdfs entailment

rdf/entailment/rdfs.scm

1919 
  #:use-module (ice-9 match)
2020 
  #:use-module (rdf rdf)
2121 
  #:use-module ((rdf entailment d) #:prefix d:)
22+
  #:use-module ((rdf entailment rdf) #:prefix rdf:)
23+
  #:use-module ((rdf xsd) #:prefix xsd:)
2224 
  #:use-module (srfi srfi-1)
2325 
  #:export (consistent-graph?
2426 
            entails?))

…

3032 
  (string-append "http://www.w3.org/2000/01/rdf-schema#" name))
3133 
3234 
(define (consistent-graph? graph)
33-
  (define (non-overlapping-types? graph)
34-
    (let loop ((graph graph) (type-mappings '()))
35-
      (if (null? graph)
36-
          #t
37-
          (let* ((t (car graph)))
38-
            (if (equal? (rdf-triple-predicate t) (rdf-iri "type"))
39-
                (if (assoc-ref type-mappings (rdf-triple-subject t))
40-
                    #f
41-
                    (loop (cdr graph)
42-
                          (cons
43-
                            (cons (rdf-triple-subject t) (rdf-triple-object t))
44-
                            type-mappings)))
45-
                (loop (cdr graph) type-mappings))))))
46-
  (and (d:consistent-graph? graph)
47-
       (non-overlapping-types? graph)))
35+
  (define (valid-subclasses? graph)
36+
    (match graph
37+
      (() #t)
38+
      ((($ rdf-triple (? rdf-datatype? s) p (? rdf-datatype? o)) graph ...)
39+
       (if (is-iri? p (rdfs-iri "subClassOf"))
40+
           (and (xsd:order s o)
41+
                (valid-subclasses? graph))
42+
           (valid-subclasses? graph)))
43+
      ((_ graph ...)
44+
       (valid-subclasses? graph))))
45+
  (and (valid-subclasses? graph)
46+
       (rdf:consistent-graph? graph)))
4847 
4948 
;; G entails E if E has an instance (where blank nodes are replaced by literals
5049 
;; or IRIs) that is a subgraph of G.
…
116115 
    (make-rdf-triple
117116 
      container (rdfs-iri "range") (rdfs-iri "Resource"))))
118117 
118+
(define (rdfs-axioms-types d)
119+
  `(,@(if (and (member xsd:integer d) (member xsd:decimal d))
120+
          (list (make-rdf-triple xsd:integer (rdfs-iri "subClassOf") xsd:decimal))
121+
          '())))
122+
119123 
(define (rdf-container-property? p)
120124 
  (define rdf-container-property-base (rdf-iri "_"))
121125 
  (and (string? p)
…
144148 
                          answer)))
145149 
         (loop answer g))))))
146150 
147-
(define (grdf1 graph)
148-
  "Implements Grdf1 entailment."
149-
  (filter
150-
    (lambda (a) a)
151-
    (map
152-
      (match-lambda
153-
        (($ rdf-triple subject predicate object)
154-
         (if (and (rdf-literal? object)
155-
                  (rdf-datatype? (rdf-literal-type object)))
156-
             (make-rdf-triple object (rdf-iri "type")
157-
                              (rdf-literal-type object))
158-
             #f)))
159-
      graph)))
160-
161-
(define (rdf2 graph)
162-
  "Implements rdf2 entailment."
163-
  (map
164-
    (match-lambda
165-
      (($ rdf-triple subject predicate object)
166-
       (make-rdf-triple predicate (rdf-iri "type")
167-
                        (rdf-iri "Property"))))
168-
    graph))
169-
170-
(define (rdfs1 graph)
171-
  "Implements rdfs1 entailment."
172-
  (filter
173-
    (lambda (a) a)
174-
    (append-map
175-
      (match-lambda
176-
        (($ rdf-triple subject predicate object)
177-
         (list
178-
           (if (rdf-datatype? subject)
179-
               (make-rdf-triple subject (rdf-iri "type") (rdfs-iri "Datatype"))
180-
               #f)
181-
           (if (rdf-datatype? predicate)
182-
               (make-rdf-triple predicate (rdf-iri "type") (rdfs-iri "Datatype"))
183-
               #f)
184-
           (if (rdf-datatype? object)
185-
               (make-rdf-triple object (rdf-iri "type") (rdfs-iri "Datatype"))
186-
               #f))))
187-
      graph)))
188-
189-
(define (rdfs2 graph)
190-
  (let ((domains
191-
         (filter
192-
           (match-lambda
193-
             (($ rdf-triple _ p _)
194-
              (or (and (string? p) (equal? p (rdfs-iri "domain")))
195-
                  (and (rdf-datatype? p)
196-
                       (member (rdfs-iri "domain") (rdf-datatype-iris p))))))
197-
           graph)))
198-
    (append-map
199-
      (lambda (domain)
200-
        (map
201-
          (match-lambda
202-
            (($ rdf-triple subject _ _)
203-
             (make-rdf-triple subject (rdf-iri "type") (rdf-triple-object domain))))
204-
          (filter
205-
            (match-lambda
206-
              (($ rdf-triple _ p _)
207-
               (equal? p (rdf-triple-subject domain))))
208-
            graph)))
209-
      domains)))
210-
211-
(define (rdfs3 graph)
212-
  (let ((ranges
213-
         (filter
214-
           (match-lambda
215-
             (($ rdf-triple _ p _)
216-
              (or (and (string? p) (equal? p (rdfs-iri "range")))
217-
                  (and (rdf-datatype? p)
218-
                       (member (rdfs-iri "range") (rdf-datatype-iris p))))))
219-
           graph)))
220-
    (append-map
221-
      (lambda (range)
222-
        (map
223-
          (match-lambda
224-
            (($ rdf-triple _ _ object)
225-
             (make-rdf-triple object (rdf-iri "type") (rdf-triple-object range))))
226-
          (filter
227-
            (match-lambda
228-
              (($ rdf-triple _ p _)
229-
               (equal? p (rdf-triple-subject range))))
230-
            graph)))
231-
      ranges)))
232-
233-
(define (rdfs4a graph)
234-
  (map
235-
    (match-lambda
236-
      (($ rdf-triple subject predicate object)
237-
       (make-rdf-triple subject (rdf-iri "type")
238-
                        (rdf-iri "Resource"))))
239-
    graph))
240-
241-
(define (rdfs4b graph)
242-
  (map
243-
    (match-lambda
244-
      (($ rdf-triple subject predicate object)
245-
       (make-rdf-triple object (rdf-iri "type")
246-
                        (rdf-iri "Resource"))))
247-
    graph))
248-
249-
(define (rdfs5 graph)
250-
  (let ((subprops
251-
         (filter
252-
           (match-lambda
253-
             (($ rdf-triple _ p _)
254-
              (or (and (string? p) (equal? p (rdfs-iri "subPropertyOf")))
255-
                  (and (rdf-datatype? p)
256-
                       (member (rdfs-iri "subPropertyOf") (rdf-datatype-iris p))))))
257-
           graph)))
258-
    (append-map
259-
      (lambda (prop)
260-
        (map
261-
          (match-lambda
262-
            (($ rdf-triple _ _ o)
263-
             (make-rdf-triple (rdf-triple-subject prop)
264-
                              (rdfs-iri "subPropertyOf") o)))
265-
          (filter
266-
            (match-lambda
267-
              (($ rdf-triple s _ _)
268-
               (equal? s (rdf-triple-object prop))))
269-
            subprops)))
270-
      subprops)))
271-
272-
(define (rdfs6 graph)
273-
  "Implements rdfs6 entailment."
274-
  (filter
275-
    (lambda (a) a)
276-
    (map
277-
      (match-lambda
278-
        (($ rdf-triple subject predicate object)
279-
         (if (and (or (equal? predicate (rdf-iri "type"))
280-
                      (and
281-
                        (rdf-datatype? predicate)
282-
                        (member (rdf-iri "type") (rdf-datatype-iris predicate))))
283-
                  (or (equal? object (rdfs-iri "Property"))
284-
                      (and
285-
                        (rdf-datatype? object)
286-
                        (member (rdf-iri "Property") (rdf-datatype-iris object)))))
287-
             (make-rdf-triple subject (rdf-iri "subPropertyOf") subject)
288-
             #f)))
289-
      graph)))
151+
(define (is-iri? node iri)
152+
  (or (and (string? node) (equal? node iri))
153+
      (and (rdf-datatype? node) (member iri (rdf-datatype-iris node)))))
290154 
291-
(define (rdfs7 graph)
292-
  (let ((subprops
293-
         (filter
294-
           (match-lambda
295-
             (($ rdf-triple _ p _)
296-
              (or (and (string? p) (equal? p (rdfs-iri "subPropertyOf")))
297-
                  (and (rdf-datatype? p)
298-
                       (member (rdfs-iri "subPropertyOf") (rdf-datatype-iris p))))))
299-
           graph)))
300-
    (append-map
301-
      (lambda (prop)
302-
        (map
303-
          (match-lambda
304-
            (($ rdf-triple subject _ object)
305-
             (make-rdf-triple object (rdf-triple-subject prop) subject)))
155+
(define (get-entailments graph subclasses subprops ranges domains types)
156+
  (let ((type-adds
157+
          ;; rdfs 6 8 10 12 and 13
306158 
          (filter
307-
            (match-lambda
308-
              (($ rdf-triple _ p _)
309-
               (equal? p (rdf-triple-subject prop))))
310-
            graph)))
311-
      subprops)))
312-
313-
(define (rdfs8 graph)
314-
  "Implements rdfs8 entailment."
315-
  (filter
316-
    (lambda (a) a)
317-
    (map
318-
      (match-lambda
319-
        (($ rdf-triple subject predicate object)
320-
         (if (and (or (equal? predicate (rdf-iri "type"))
321-
                      (and
322-
                        (rdf-datatype? predicate)
323-
                        (member (rdf-iri "type") (rdf-datatype-iris predicate))))
324-
                  (or (equal? object (rdfs-iri "Class"))
325-
                      (and
326-
                        (rdf-datatype? object)
327-
                        (member (rdf-iri "Class") (rdf-datatype-iris object)))))
328-
             (make-rdf-triple subject (rdfs-iri "subClassOf") (rdfs-iri "Resource"))
329-
             #f)))
330-
      graph)))
331-
332-
(define (rdfs9 graph)
333-
  (let ((subclasses
334-
         (filter
335-
           (match-lambda
336-
             (($ rdf-triple _ p _)
337-
              (or (and (string? p) (equal? p (rdfs-iri "subClassOf")))
338-
                  (and (rdf-datatype? p)
339-
                       (member (rdfs-iri "subClassOf") (rdf-datatype-iris p))))))
340-
           graph)))
341-
    (append-map
342-
      (lambda (class)
343-
        (map
344-
          (match-lambda
345-
            (($ rdf-triple subject _ object)
346-
             (make-rdf-triple subject (rdf-iri "type") (rdf-triple-subject class))))
347-
          (filter
348-
            (match-lambda
349-
              (($ rdf-triple _ p o)
350-
               (and (equal? o (rdf-triple-object class))
351-
                    (or (equal? p (rdf-iri "type"))
352-
                        (and
353-
                          (rdf-datatype? p)
354-
                          (member (rdf-iri "type") (rdf-datatype-iris p)))))))
355-
            graph)))
356-
      subclasses)))
357-
358-
(define (rdfs10 graph)
359-
  "Implements rdfs10 entailment."
360-
  (filter
361-
    (lambda (a) a)
362-
    (map
363-
      (match-lambda
364-
        (($ rdf-triple subject predicate object)
365-
         (if (and (or (equal? predicate (rdf-iri "type"))
366-
                      (and
367-
                        (rdf-datatype? predicate)
368-
                        (member (rdf-iri "type") (rdf-datatype-iris predicate))))
369-
                  (or (equal? object (rdfs-iri "Class"))
370-
                      (and
371-
                        (rdf-datatype? object)
372-
                        (member (rdf-iri "Class") (rdf-datatype-iris object)))))
373-
             (make-rdf-triple subject (rdfs-iri "subClassOf") subject)
374-
             #f)))
375-
      graph)))
376-
377-
(define (rdfs11 graph)
378-
  (let ((subclasses
379-
         (filter
380-
           (match-lambda
381-
             (($ rdf-triple _ p _)
382-
              (or (and (string? p) (equal? p (rdfs-iri "subClassOf")))
383-
                  (and (rdf-datatype? p)
384-
                       (member (rdfs-iri "subClassOf") (rdf-datatype-iris p))))))
385-
           graph)))
386-
    (append-map
387-
      (lambda (class)
388-
        (map
389-
          (match-lambda
390-
            (($ rdf-triple _ _ o)
391-
             (make-rdf-triple (rdf-triple-subject class)
392-
                              (rdfs-iri "subClassOf") o)))
393-
          (filter
394-
            (match-lambda
395-
              (($ rdf-triple s _ _)
396-
               (equal? s (rdf-triple-object class))))
397-
            subclasses)))
398-
      subclasses)))
399-
400-
(define (rdfs12 graph)
401-
  "Implements rdfs12 entailment."
402-
  (filter
403-
    (lambda (a) a)
404-
    (map
405-
      (match-lambda
406-
        (($ rdf-triple subject predicate object)
407-
         (if (and (or (equal? predicate (rdf-iri "type"))
408-
                      (and
409-
                        (rdf-datatype? predicate)
410-
                        (member (rdf-iri "type") (rdf-datatype-iris predicate))))
411-
                  (or (equal? object (rdfs-iri "ContainerMembershipProperty"))
412-
                      (and
413-
                        (rdf-datatype? object)
414-
                        (member (rdf-iri "ContainerMembershipProperty")
415-
                                (rdf-datatype-iris object)))))
416-
             (make-rdf-triple subject (rdfs-iri "subPropertyOf")
417-
                              (rdfs-iri "member"))
418-
             #f)))
419-
      graph)))
420-
421-
(define (rdfs13 graph)
422-
  "Implements rdfs13 entailment."
423-
  (filter
424-
    (lambda (a) a)
425-
    (map
426-
      (match-lambda
427-
        (($ rdf-triple subject predicate object)
428-
         (if (and (or (equal? predicate (rdf-iri "type"))
429-
                      (and
430-
                        (rdf-datatype? predicate)
431-
                        (member (rdf-iri "type") (rdf-datatype-iris predicate))))
432-
                  (or (equal? object (rdfs-iri "Datatype"))
433-
                      (and
434-
                        (rdf-datatype? object)
435-
                        (member (rdf-iri "Datatype") (rdf-datatype-iris object)))))
436-
             (make-rdf-triple subject (rdfs-iri "subClass") (rdfs-iri "Literal"))
437-
             #f)))
438-
      graph)))
439-
440-
(define rdfs-entailments
441-
  (list grdf1 rdf2 rdfs1 rdfs2 rdfs3 rdfs4a rdfs4b rdfs5 rdfs6 rdfs7 rdfs8
442-
        rdfs9 rdfs10 rdfs11 rdfs12 rdfs13))
443-
444-
(define (augment g d entailments)
159+
            (lambda (a) a)
160+
            (map
161+
              (match-lambda
162+
                (($ rdf-triple s _ o)
163+
                 (cond
164+
                   ((is-iri? o (rdf-iri "Property"))
165+
                    (make-rdf-triple s (rdfs-iri "subPropertyOf") s))
166+
                   ((is-iri? o (rdfs-iri "Class"))
167+
                    (make-rdf-triple s (rdfs-iri "subClassOf") (rdfs-iri "Resource")))
168+
                   ((is-iri? o (rdfs-iri "ContainerMembershipProperty"))
169+
                    (make-rdf-triple s (rdfs-iri "subPropertyof")
170+
                                     (rdfs-iri "member")))
171+
                   ((is-iri? o (rdfs-iri "Datatype"))
172+
                    (make-rdf-triple s (rdfs-iri "subClassOf")
173+
                                     (rdfs-iri "Literal")))
174+
                   (else #f))))
175+
              types))))
176+
    (append
177+
      type-adds
178+
      (append-map
179+
        (match-lambda
180+
          (($ rdf-triple s p o)
181+
           `(;; grdf1
182+
             ,@(if (and (rdf-literal? o)
183+
                        (rdf-datatype? (rdf-literal-type o)))
184+
                   (list (make-rdf-triple o (rdf-iri "type") (rdf-literal-type o)))
185+
                   '())
186+
             ;; rdf2
187+
             ,(make-rdf-triple p (rdf-iri "type") (rdf-iri "Property"))
188+
             ;; rdfs2
189+
             ,@(append-map
190+
                 (match-lambda
191+
                   (($ rdf-triple subject predicate object)
192+
                    (if (equal? subject p)
193+
                        (list (make-rdf-triple s (rdf-iri "type") object))
194+
                        '())))
195+
                 domains)
196+
             ;; rdfs3
197+
             ,@(append-map
198+
                 (match-lambda
199+
                   (($ rdf-triple subject predicate object)
200+
                    (if (equal? subject p)
201+
                        (list (make-rdf-triple o (rdf-iri "type") object))
202+
                        '())))
203+
                 ranges)
204+
             ;; rdfs4a
205+
             ,(make-rdf-triple s (rdf-iri "type") (rdfs-iri "Resource"))
206+
             ;; rdfs4b
207+
             ,(make-rdf-triple o (rdf-iri "type") (rdfs-iri "Resource"))
208+
             ;; rdfs5
209+
             ,@(if (is-iri? p (rdfs-iri "subPropertyOf"))
210+
                   (let ((candidates (filter
211+
                                       (match-lambda
212+
                                         (($ rdf-triple _ _ object)
213+
                                          (equal? object s)))
214+
                                       subprops)))
215+
                     (map
216+
                       (match-lambda
217+
                         (($ rdf-triple subject _ _)
218+
                          (make-rdf-triple subject (rdfs-iri "subPropertyOf")
219+
                                           o)))
220+
                       candidates))
221+
                   '())
222+
             ;; rdfs7
223+
             ,@(map
224+
                 (match-lambda
225+
                   (($ rdf-triple _ _ object)
226+
                    (make-rdf-triple s object o)))
227+
                 (filter
228+
                   (match-lambda
229+
                     (($ rdf-triple subject _ _)
230+
                      (equal? subject p)))
231+
                   subprops))
232+
             ;; rdfs9
233+
             ,@(if (is-iri? p (rdf-iri "type"))
234+
                   (let ((candidates (filter
235+
                                       (match-lambda
236+
                                         (($ rdf-triple subject _ _)
237+
                                          (equal? subject o)))
238+
                                       subprops)))
239+
                     (map
240+
                       (match-lambda
241+
                         (($ rdf-triple _ _ object)
242+
                          (make-rdf-triple s (rdf-iri "type") object)))
243+
                       candidates))
244+
                   '())
245+
             ;; rdfs11
246+
             ,@(if (is-iri? p (rdfs-iri "subClassOf"))
247+
                   (let ((candidates (filter
248+
                                       (match-lambda
249+
                                         (($ rdf-triple _ _ object)
250+
                                          (equal? object s)))
251+
                                       subclasses)))
252+
                     (map
253+
                       (match-lambda
254+
                         (($ rdf-triple subject _ _)
255+
                          (make-rdf-triple subject (rdfs-iri "subClassOf")
256+
                                           o)))
257+
                       candidates))
258+
                   '()))))
259+
        graph))))
260+
261+
(define (augment g d)
445262 
  (let* ((g (append rdfs-axioms g))
263+
         (g (append (rdfs-axioms-types d) g))
264+
         (g (append
265+
              ;; rdfs1
266+
              (map
267+
                (lambda (t)
268+
                  (make-rdf-triple t (rdf-iri "type") (rdfs-iri "Datatype")))
269+
                d)))
446270 
         (g (append
447271 
              (append-map rdfs-axioms-container (rdf-container-properties g))
448272 
              g)))
449-
    (let loop ((g g) (to-entail entailments) (augmented? #f))
450-
      (if (null? to-entail)
451-
          (if augmented?
452-
              (loop g entailments #f)
453-
              g)
454-
          (let loop2 ((g g) (augmented-entail? #f))
455-
            (pk 'looping-until (car to-entail) 'is-exhausted)
456-
            (let* ((new-triples ((car to-entail) g))
457-
                   (new-triples (recognize new-triples d)))
458-
              (let loop3 ((g g) (new-triples new-triples) (augmented-here? #f))
459-
                (match new-triples
460-
                  (() (if augmented-here?
461-
                          (loop2 g #t)
462-
                          (loop g (cdr to-entail) augmented-entail?)))
463-
                  ((t new-triples ...)
464-
                   (if (member t g)
465-
                       (loop3 g new-triples augmented-here?)
466-
                       (loop3 (cons t g) new-triples #t)))))))))))
273+
    (let loop ((graph '()) (subclasses '()) (subprops '()) (ranges '())
274+
                         (domains '()) (types '()))
275+
      (let inner-loop ((graph graph) (subclasses subclasses) (subprops subprops)
276+
                                     (ranges ranges) (domains domains)
277+
                                     (types types) (added? #f)
278+
                                     (augment-set
279+
                                       (if (null? graph)
280+
                                           g
281+
                                           (pk 'entailments
282+
                                           (get-entailments
283+
                                             graph subclasses subprops ranges
284+
                                             domains types)))))
285+
        (match augment-set
286+
          (() (if added?
287+
                  (loop graph subclasses subprops ranges domains types)
288+
                  graph))
289+
          ((t augment-set ...)
290+
           (if (member t graph)
291+
               (inner-loop graph subclasses subprops ranges domains types
292+
                           added? augment-set)
293+
               (let ((p (rdf-triple-predicate t)))
294+
                 (cond
295+
                   ((is-iri? p "subClassOf")
296+
                    (inner-loop (cons t graph) (cons t subclasses) subprops
297+
                                ranges domains types #t augment-set))
298+
                   ((is-iri? p "subPropertyOf")
299+
                    (inner-loop (cons t graph) subclasses (cons t subprops)
300+
                                ranges domains types #t augment-set))
301+
                   ((is-iri? p "range")
302+
                    (inner-loop (cons t graph) subclasses subprops
303+
                                (cons t ranges) domains types #t augment-set))
304+
                   ((is-iri? p "domain")
305+
                    (inner-loop (cons t graph) subclasses subprops
306+
                                ranges (cons t domains) types #t augment-set))
307+
                   ((is-iri? p "type")
308+
                    (inner-loop (cons t graph) subclasses subprops
309+
                                ranges domains (cons t types) #t augment-set))
310+
                   (else
311+
                     (inner-loop (cons t graph) subclasses subprops
312+
                                 ranges domains types #t augment-set)))))))))))
467313 
468314 
(define (entails? g e d)
469315 
  "Return true if g entails e recognizing d"
470-
  (let* ((g (recognize g d))
471-
         (g (augment g d rdfs-entailments)))
472-
    (pk 'augment-done)
316+
  (let* ((g (recognize g d)))
473317 
    (or (not (consistent-graph? g))
474-
        (d:entails? g e))))
318+
        (d:entails? (augment g d) (recognize e d)))))
rdf/xsd.scm
1818 
(define-module (rdf xsd)
1919 
  #:use-module (ice-9 match)
2020 
  #:use-module (rdf rdf)
21-
  #:export (datatypes))
21+
  #:export (datatypes order))
2222 
2323 
;; This module implements the xsd datatypes, as presented in https://www.w3.org/TR/rdf11-concepts/#xsd-datatypes
2424 
…
9595 
9696 
(define datatypes
9797 
  (list string boolean decimal integer int))
98+
99+
(define sub-classes
100+
  (list
101+
    (list rdf:langString)
102+
    (list string)
103+
    (list boolean)
104+
    (list decimal integer int)
105+
    (list integer int)
106+
    (list int)))
107+
108+
(define (order d1 d2)
109+
  "Return whether d1's value space is included in d2's"
110+
  (member d1 (assoc-ref sub-classes d2)))