rdfs.scm
| 1 | ;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu> |
| 2 | ;;;; |
| 3 | ;;;; This library is free software; you can redistribute it and/or |
| 4 | ;;;; modify it under the terms of the GNU Lesser General Public |
| 5 | ;;;; License as published by the Free Software Foundation; either |
| 6 | ;;;; version 3 of the License, or (at your option) any later version. |
| 7 | ;;;; |
| 8 | ;;;; This library is distributed in the hope that it will be useful, |
| 9 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 10 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 11 | ;;;; Lesser General Public License for more details. |
| 12 | ;;;; |
| 13 | ;;;; You should have received a copy of the GNU Lesser General Public |
| 14 | ;;;; License along with this library; if not, write to the Free Software |
| 15 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
| 16 | ;;;; |
| 17 | |
| 18 | (define-module (rdf entailment rdfs) |
| 19 | #:use-module (ice-9 match) |
| 20 | #:use-module (rdf rdf) |
| 21 | #:use-module ((rdf entailment d) #:prefix d:) |
| 22 | #:use-module ((rdf entailment rdf) #:prefix rdf:) |
| 23 | #:use-module ((rdf xsd) #:prefix xsd:) |
| 24 | #:use-module (srfi srfi-1) |
| 25 | #:export (consistent-graph? |
| 26 | entails?)) |
| 27 | |
| 28 | (define (rdf-iri name) |
| 29 | (string-append "http://www.w3.org/1999/02/22-rdf-syntax-ns#" name)) |
| 30 | |
| 31 | (define (rdfs-iri name) |
| 32 | (string-append "http://www.w3.org/2000/01/rdf-schema#" name)) |
| 33 | |
| 34 | (define (consistent-graph? graph vocabulary) |
| 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 ((rdf-vocabulary-order vocabulary) s o) |
| 41 | (valid-subclasses? graph)) |
| 42 | (valid-subclasses? graph))) |
| 43 | ((_ graph ...) |
| 44 | (valid-subclasses? graph)))) |
| 45 | (let ((graph (augment (recognize graph vocabulary) vocabulary))) |
| 46 | (and (valid-subclasses? graph) |
| 47 | (rdf:consistent-graph? graph vocabulary)))) |
| 48 | |
| 49 | ;; G entails E if E has an instance (where blank nodes are replaced by literals |
| 50 | ;; or IRIs) that is a subgraph of G. |
| 51 | ;; |
| 52 | ;; We re-use similar procedures to verifying isomorphism of graphs, but this time |
| 53 | ;; blank nodes can also map to literals and IRIs. |
| 54 | |
| 55 | ;; We follow appendix A and use a subgraph comparison (like the simple:entails? |
| 56 | ;; procedure) after augmenting the graph with additional true triples. |
| 57 | |
| 58 | (define rdfs-axioms |
| 59 | (list |
| 60 | (make-rdf-triple (rdf-iri "type") (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 61 | (make-rdf-triple (rdfs-iri "domain") (rdfs-iri "domain") (rdf-iri "Property")) |
| 62 | (make-rdf-triple (rdfs-iri "range") (rdfs-iri "domain") (rdf-iri "Property")) |
| 63 | (make-rdf-triple (rdfs-iri "subPropertyOf") (rdfs-iri "domain") |
| 64 | (rdf-iri "Property")) |
| 65 | (make-rdf-triple (rdfs-iri "subClassOf") (rdfs-iri "domain") (rdfs-iri "Class")) |
| 66 | (make-rdf-triple (rdf-iri "subject") (rdfs-iri "domain") (rdf-iri "Statement")) |
| 67 | (make-rdf-triple (rdf-iri "predicate") (rdfs-iri "domain") (rdf-iri "Statement")) |
| 68 | (make-rdf-triple (rdf-iri "object") (rdfs-iri "domain") (rdf-iri "Statement")) |
| 69 | (make-rdf-triple (rdfs-iri "member") (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 70 | (make-rdf-triple (rdf-iri "first") (rdfs-iri "domain") (rdf-iri "List")) |
| 71 | (make-rdf-triple (rdf-iri "rest") (rdfs-iri "domain") (rdf-iri "List")) |
| 72 | (make-rdf-triple (rdfs-iri "seeAlso") (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 73 | (make-rdf-triple (rdfs-iri "isDefinedBy") (rdfs-iri "domain") |
| 74 | (rdfs-iri "Resource")) |
| 75 | (make-rdf-triple (rdfs-iri "comment") (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 76 | (make-rdf-triple (rdfs-iri "label") (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 77 | (make-rdf-triple (rdf-iri "value") (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 78 | |
| 79 | (make-rdf-triple (rdf-iri "type") (rdfs-iri "range") (rdfs-iri "Class")) |
| 80 | (make-rdf-triple (rdfs-iri "domain") (rdfs-iri "range") (rdfs-iri "Class")) |
| 81 | (make-rdf-triple (rdfs-iri "range") (rdfs-iri "range") (rdfs-iri "Class")) |
| 82 | (make-rdf-triple (rdfs-iri "subPropertyOf") (rdfs-iri "range") |
| 83 | (rdf-iri "Property")) |
| 84 | (make-rdf-triple (rdfs-iri "subClassOf") (rdfs-iri "range") (rdfs-iri "Class")) |
| 85 | (make-rdf-triple (rdf-iri "subject") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 86 | (make-rdf-triple (rdf-iri "predicate") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 87 | (make-rdf-triple (rdf-iri "object") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 88 | (make-rdf-triple (rdfs-iri "member") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 89 | (make-rdf-triple (rdf-iri "first") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 90 | (make-rdf-triple (rdf-iri "rest") (rdfs-iri "range") (rdf-iri "List")) |
| 91 | (make-rdf-triple (rdfs-iri "seeAlso") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 92 | (make-rdf-triple (rdfs-iri "isDefinedBy") (rdfs-iri "range") |
| 93 | (rdfs-iri "Resource")) |
| 94 | (make-rdf-triple (rdfs-iri "comment") (rdfs-iri "range") (rdfs-iri "Literal")) |
| 95 | (make-rdf-triple (rdfs-iri "label") (rdfs-iri "range") (rdfs-iri "Literal")) |
| 96 | (make-rdf-triple (rdf-iri "value") (rdfs-iri "range") (rdfs-iri "Resource")) |
| 97 | |
| 98 | (make-rdf-triple (rdf-iri "Alt") (rdfs-iri "subClassOf") (rdfs-iri "Container")) |
| 99 | (make-rdf-triple (rdf-iri "Bag") (rdfs-iri "subClassOf") (rdfs-iri "Container")) |
| 100 | (make-rdf-triple (rdf-iri "Seq") (rdfs-iri "subClassOf") (rdfs-iri "Container")) |
| 101 | (make-rdf-triple (rdfs-iri "ContainerMembershipProperty") |
| 102 | (rdfs-iri "subClassOf") (rdf-iri "Property")) |
| 103 | |
| 104 | (make-rdf-triple (rdfs-iri "isDefinedBy") (rdfs-iri "subPropertyOf") |
| 105 | (rdfs-iri "seeAlso")) |
| 106 | |
| 107 | (make-rdf-triple (rdfs-iri "Datatype") (rdfs-iri "subClassOf") |
| 108 | (rdfs-iri "Class")))) |
| 109 | |
| 110 | (define (rdfs-axioms-container container) |
| 111 | (list |
| 112 | (make-rdf-triple |
| 113 | container (rdf-iri "type") (rdfs-iri "ContainerMembershipProperty")) |
| 114 | (make-rdf-triple |
| 115 | container (rdfs-iri "domain") (rdfs-iri "Resource")) |
| 116 | (make-rdf-triple |
| 117 | container (rdfs-iri "range") (rdfs-iri "Resource")))) |
| 118 | |
| 119 | (define (rdfs-axioms-types d) |
| 120 | `(,@(if (and (member xsd:integer d) (member xsd:decimal d)) |
| 121 | (list (make-rdf-triple xsd:integer (rdfs-iri "subClassOf") xsd:decimal)) |
| 122 | '()))) |
| 123 | |
| 124 | (define (rdf-container-property? p) |
| 125 | (define rdf-container-property-base (rdf-iri "_")) |
| 126 | (and (string? p) |
| 127 | (> (string-length p) (string-length rdf-container-property-base)) |
| 128 | (equal? (substring p 0 (string-length rdf-container-property-base)) |
| 129 | rdf-container-property-base) |
| 130 | (string->number |
| 131 | (substring p (string-length rdf-container-property-base))))) |
| 132 | |
| 133 | (define (rdf-container-properties g) |
| 134 | (let loop ((answer '()) (g g)) |
| 135 | (match g |
| 136 | (() (if (null? answer) (list (rdf-iri "_1")) answer)) |
| 137 | ((($ rdf-triple subject predicate object) g ...) |
| 138 | (let* ((answer (if (and (rdf-container-property? subject) |
| 139 | (not (member subject answer))) |
| 140 | (cons subject answer) |
| 141 | answer)) |
| 142 | (answer (if (and (rdf-container-property? predicate) |
| 143 | (not (member predicate answer))) |
| 144 | (cons predicate answer) |
| 145 | answer)) |
| 146 | (answer (if (and (rdf-container-property? object) |
| 147 | (not (member object answer))) |
| 148 | (cons object answer) |
| 149 | answer))) |
| 150 | (loop answer g)))))) |
| 151 | |
| 152 | (define (is-iri? node iri) |
| 153 | (or (and (string? node) (equal? node iri)) |
| 154 | (and (rdf-datatype? node) (member iri (rdf-datatype-iris node))))) |
| 155 | |
| 156 | (define (get-entailments graph subclasses subprops ranges domains types) |
| 157 | (let ((type-adds |
| 158 | ;; rdfs 6 8 10 12 and 13 |
| 159 | (filter |
| 160 | (lambda (a) a) |
| 161 | (map |
| 162 | (match-lambda |
| 163 | (($ rdf-triple s _ o) |
| 164 | (cond |
| 165 | ((is-iri? o (rdf-iri "Property")) |
| 166 | (make-rdf-triple s (rdfs-iri "subPropertyOf") s)) |
| 167 | ((is-iri? o (rdfs-iri "Class")) |
| 168 | (make-rdf-triple s (rdfs-iri "subClassOf") (rdfs-iri "Resource"))) |
| 169 | ((is-iri? o (rdfs-iri "ContainerMembershipProperty")) |
| 170 | (make-rdf-triple s (rdfs-iri "subPropertyOf") |
| 171 | (rdfs-iri "member"))) |
| 172 | ((is-iri? o (rdfs-iri "Datatype")) |
| 173 | (make-rdf-triple s (rdfs-iri "subClassOf") |
| 174 | (rdfs-iri "Literal"))) |
| 175 | (else #f)))) |
| 176 | types)))) |
| 177 | (append |
| 178 | type-adds |
| 179 | (append-map |
| 180 | (match-lambda |
| 181 | (($ rdf-triple s p o) |
| 182 | `(;; grdf1 |
| 183 | ,@(if (and (rdf-literal? o) |
| 184 | (rdf-datatype? (rdf-literal-type o))) |
| 185 | (list (make-rdf-triple o (rdf-iri "type") (rdf-literal-type o))) |
| 186 | '()) |
| 187 | ;; rdf2 |
| 188 | ,(make-rdf-triple p (rdf-iri "type") (rdf-iri "Property")) |
| 189 | ;; rdfs2 |
| 190 | ,@(append-map |
| 191 | (match-lambda |
| 192 | (($ rdf-triple subject predicate object) |
| 193 | (if (equal? subject p) |
| 194 | (list (make-rdf-triple s (rdf-iri "type") object)) |
| 195 | '()))) |
| 196 | domains) |
| 197 | ;; rdfs3 |
| 198 | ,@(append-map |
| 199 | (match-lambda |
| 200 | (($ rdf-triple subject predicate object) |
| 201 | (if (equal? subject p) |
| 202 | (list (make-rdf-triple o (rdf-iri "type") object)) |
| 203 | '()))) |
| 204 | ranges) |
| 205 | ;; rdfs4a |
| 206 | ,(make-rdf-triple s (rdf-iri "type") (rdfs-iri "Resource")) |
| 207 | ;; rdfs4b |
| 208 | ,(make-rdf-triple o (rdf-iri "type") (rdfs-iri "Resource")) |
| 209 | ;; rdfs5 |
| 210 | ,@(if (is-iri? p (rdfs-iri "subPropertyOf")) |
| 211 | (let ((candidates (filter |
| 212 | (match-lambda |
| 213 | (($ rdf-triple _ _ object) |
| 214 | (equal? object s))) |
| 215 | subprops))) |
| 216 | (map |
| 217 | (match-lambda |
| 218 | (($ rdf-triple subject _ _) |
| 219 | (make-rdf-triple subject (rdfs-iri "subPropertyOf") |
| 220 | o))) |
| 221 | candidates)) |
| 222 | '()) |
| 223 | ;; rdfs7 |
| 224 | ,@(map |
| 225 | (match-lambda |
| 226 | (($ rdf-triple _ _ object) |
| 227 | (make-rdf-triple s object o))) |
| 228 | (filter |
| 229 | (match-lambda |
| 230 | (($ rdf-triple subject _ _) |
| 231 | (equal? subject p))) |
| 232 | subprops)) |
| 233 | ;; rdfs9 |
| 234 | ,@(if (is-iri? p (rdf-iri "type")) |
| 235 | (let ((candidates (filter |
| 236 | (match-lambda |
| 237 | (($ rdf-triple subject _ _) |
| 238 | (equal? subject o))) |
| 239 | subprops))) |
| 240 | (map |
| 241 | (match-lambda |
| 242 | (($ rdf-triple _ _ object) |
| 243 | (make-rdf-triple s (rdf-iri "type") object))) |
| 244 | candidates)) |
| 245 | '()) |
| 246 | ;; rdfs11 |
| 247 | ,@(if (is-iri? p (rdfs-iri "subClassOf")) |
| 248 | (let ((candidates (filter |
| 249 | (match-lambda |
| 250 | (($ rdf-triple _ _ object) |
| 251 | (equal? object s))) |
| 252 | subclasses))) |
| 253 | (map |
| 254 | (match-lambda |
| 255 | (($ rdf-triple subject _ _) |
| 256 | (make-rdf-triple subject (rdfs-iri "subClassOf") |
| 257 | o))) |
| 258 | candidates)) |
| 259 | '())))) |
| 260 | graph)))) |
| 261 | |
| 262 | (define (augment g voc) |
| 263 | (let* ((g (append rdfs-axioms g)) |
| 264 | (g (append (rdfs-axioms-types (rdf-vocabulary-datatypes voc)) g)) |
| 265 | (g (append |
| 266 | ;; rdfs1 |
| 267 | (map |
| 268 | (lambda (t) |
| 269 | (make-rdf-triple t (rdf-iri "type") (rdfs-iri "Datatype"))) |
| 270 | (rdf-vocabulary-datatypes voc)) |
| 271 | g)) |
| 272 | (g (append |
| 273 | (append-map rdfs-axioms-container (rdf-container-properties g)) |
| 274 | g))) |
| 275 | (let loop ((graph '()) (subclasses '()) (subprops '()) (ranges '()) |
| 276 | (domains '()) (types '())) |
| 277 | (let inner-loop ((graph graph) (subclasses subclasses) (subprops subprops) |
| 278 | (ranges ranges) (domains domains) |
| 279 | (types types) (added? #f) |
| 280 | (augment-set |
| 281 | (if (null? graph) |
| 282 | g |
| 283 | (recognize |
| 284 | (get-entailments |
| 285 | graph subclasses subprops ranges |
| 286 | domains types) |
| 287 | voc)))) |
| 288 | (match augment-set |
| 289 | (() (if added? |
| 290 | (loop graph subclasses subprops ranges domains types) |
| 291 | graph)) |
| 292 | ((t augment-set ...) |
| 293 | (if (member t graph) |
| 294 | (inner-loop graph subclasses subprops ranges domains types |
| 295 | added? augment-set) |
| 296 | (let ((p (rdf-triple-predicate t))) |
| 297 | (cond |
| 298 | ((is-iri? p (rdfs-iri "subClassOf")) |
| 299 | (inner-loop (cons t graph) (cons t subclasses) subprops |
| 300 | ranges domains types #t augment-set)) |
| 301 | ((is-iri? p (rdfs-iri "subPropertyOf")) |
| 302 | (inner-loop (cons t graph) subclasses (cons t subprops) |
| 303 | ranges domains types #t augment-set)) |
| 304 | ((is-iri? p (rdfs-iri "range")) |
| 305 | (inner-loop (cons t graph) subclasses subprops |
| 306 | (cons t ranges) domains types #t augment-set)) |
| 307 | ((is-iri? p (rdfs-iri "domain")) |
| 308 | (inner-loop (cons t graph) subclasses subprops |
| 309 | ranges (cons t domains) types #t augment-set)) |
| 310 | ((is-iri? p (rdf-iri "type")) |
| 311 | (inner-loop (cons t graph) subclasses subprops |
| 312 | ranges domains (cons t types) #t augment-set)) |
| 313 | (else |
| 314 | (inner-loop (cons t graph) subclasses subprops |
| 315 | ranges domains types #t augment-set))))))))))) |
| 316 | |
| 317 | (define (entails? g e vocabulary) |
| 318 | "Return true if g entails e recognizing d" |
| 319 | (let* ((g (recognize g vocabulary)) |
| 320 | (g (augment g vocabulary)) |
| 321 | (e (recognize e vocabulary))) |
| 322 | (or (not (consistent-graph? g vocabulary)) |
| 323 | (d:entails? g e vocabulary)))) |
| 324 |