Add more simplifications to improve graph isomorphism detection

Julien LepillerThu Apr 09 19:08:19+0200 2020

64b7245

Add more simplifications to improve graph isomorphism detection

rdf/rdf.scm

320320 
         (sat? equivalences)
321321 
         #f))))
322322 
323+
(define (filter-sat equivalences)
324+
  (filter
325+
    (lambda (eq)
326+
      (if (member eq '(bot none))
327+
          eq
328+
          (if (sat? eq)
329+
              eq
330+
              'bot)))
331+
    equivalences))
332+
323333 
(define (merge-joins l1 l2)
324334 
  (cond
325335 
    ((null? l1) l2)
…
341351 
    ('none (list (list)))
342352 
    ('bot 'bot)
343353 
    (('or e1 e2)
344-
     (let ((e1 (to-disjunctions e1))
345-
           (e2 (to-disjunctions e2)))
354+
     (let ((e1 (filter-sat (to-disjunctions e1)))
355+
           (e2 (filter-sat (to-disjunctions e2))))
346356 
       (cond
347357 
         ((equal? e2 'bot)
348358 
          e1)
349359 
         ((equal? e1 'bot)
350360 
          e2)
361+
         ((equal? e2 'none)
362+
          'none)
363+
         ((equal? e1 'none)
364+
          'none)
365+
         ((equal? e1 e2)
366+
          e1)
351367 
         (else
352368 
           (append e1 e2)))))
353369 
    (('and e1 e2)
354-
     (let ((e1 (to-disjunctions e1))
355-
           (e2 (to-disjunctions e2)))
370+
     (let ((e1 (filter-sat (to-disjunctions e1)))
371+
           (e2 (filter-sat (to-disjunctions e2))))
356372 
       (cond
357373 
         ((equal? e1 'bot)
358374 
          'bot)
359375 
         ((equal? e2 'bot)
360376 
          'bot)
377+
         ((equal? e2 'none)
378+
          e1)
379+
         ((equal? e1 'none)
380+
          e2)
381+
         ((equal? e1 e2)
382+
          e1)
361383 
         (else
362384 
           (merge-joins e1 e2)))))))
363385 
…
437459 
               (loop disjunctions)))))
438460 
        #f)))
439461 
462+
(define* (simplify-constraints c #:optional (equivalences '()))
463+
  (match c
464+
    ('bot 'bot)
465+
    ('none 'none)
466+
    (('equiv a b)
467+
     (if (assoc-ref equivalences a)
468+
         (if (equal? (assoc-ref equivalences a) b)
469+
             'none
470+
             'bot)
471+
         c))
472+
    (('and e1 e2)
473+
     (match (simplify-constraints e1 equivalences)
474+
       ('bot 'bot)
475+
       ('none (simplify-constraints e2 equivalences))
476+
       (('equiv a b)
477+
        (list 'and (list 'equiv a b) (simplify-constraints e2 (cons (cons a b) equivalences))))
478+
       (e1 (list 'and e1 (simplify-constraints e2 equivalences)))))
479+
    (('or e1 e2)
480+
     (let ((e1 (simplify-constraints e1 equivalences))
481+
           (e2 (simplify-constraints e2 equivalences)))
482+
       (cond
483+
         ((equal? e1 'bot)
484+
          e2)
485+
         ((equal? e2 'bot)
486+
          e1)
487+
         ((equal? e1 'none)
488+
          'none)
489+
         ((equal? e2 'none)
490+
          'none)
491+
         ((equal? e1 e2)
492+
          e1)
493+
         (else
494+
           (list 'or e1 e2)))))))
495+
440496 
(define (generate-dataset-constraints d1 d2)
441497 
  (let ((g1 (rdf-dataset-default-graph d1))
442498 
        (g2 (rdf-dataset-default-graph d2))
443499 
        (ng1 (rdf-dataset-named-graphs d1))
444500 
        (ng2 (rdf-dataset-named-graphs d2)))
445-
    (list 'and (generate-graph-constraints g1 g2)
501+
    (list 'and (pk 'simpl (simplify-constraints (pk 'default (generate-graph-constraints g1 g2))))
446502 
          (if (null? ng1)
447503 
              'none
448504 
              (fold (lambda (ng1 constraints)
449505 
                      (match ng1
450506 
                        ((n1 . g1)
451-
                         (if (blank-node? n1)
507+
                         (list
508+
                           'and
509+
                           (if (blank-node? n1)
452510 
                             (fold (lambda (ng2 constraints)
453511 
                                     (list 'or (list 'and (list 'equiv n1 (car ng2))
454-
                                                     (generate-graph-constraints g1 g2))
512+
                                                     (simplify-constraints
513+
                                                       (generate-graph-constraints g1 g2)))
455514 
                                           constraints))
456515 
                                   'bot
457516 
                                   (filter (lambda (g2) (blank-node? (car g2))) ng2))
458517 
                             (let ((g2 (assoc-ref ng2 n1)))
459518 
                               (if g2
460-
                                   (list 'or (generate-graph-constraints g1 g2)
519+
                                   (list 'and (simplify-constraints
520+
                                                (generate-graph-constraints g1 g2))
461521 
                                         constraints)
462-
                                   'bot))))))
463-
                    'bot ng1)))))
522+
                                   'bot)))
523+
                           constraints))))
524+
                    'none ng1)))))
464525 
465526 
(define (validate-dataset-mapping mapping d1 d2)
466527 
  (define (validate-named-graph name graph)
…
483544 
  "Compare two datasets and return whether they are isomorphic."
484545 
  (let* ((constraints (generate-dataset-constraints d1 d2))
485546 
         (disjunctions (to-disjunctions constraints)))
547+
    (pk 'dis disjunctions)
486548 
    (if (list? disjunctions)
487549 
        (let loop ((disjunctions (filter sat? disjunctions)))
488550 
          (match disjunctions