example.lisp

(defun normalize-agents ()
  (labels ((compare-agents (agent1 agent2)
	     (let ((u1 (nth 0 agent1))
		   (u2 (nth 0 agent2)))
	       (if (upi= u1 u2)
		   (list u1 u2 0)
		   (list u1 u2 
			 (loop for i in (cdr agent1)
			       for j in (cdr agent2)
			       summing (numeric-upi-equal i j) into total
			       while (< total 1)
			       finally (return total)))))))
    (let ((agentes (select0-distinct (?url ?id ?mbox ?name) 
		                (q ?url !rdf:type !foaf:Agent)
		                (q ?url !foaf:name ?name)
             	      (optional (q ?url !foaf:identifier ?id))
		                (optional (q ?url !foaf:mbox ?mbox)))))
      (dolist (set (disjoint-sets-1 (mapcar (lambda (e) (subseq e 0 2)) 
					    (compare-pairs agentes #'compare-agents))))
	(assert-sameas-group set)))))
	
	
	(defun assert-sameas-group (group)
  (let* ((master (if (< 0 (length (remove-if #'blank-node-p group)))
		     (car (sort (remove-if #'blank-node-p group) #'< 
				            :key #'(lambda (i) (length (part->string i)))))
		     (car group)))
	 (rest (remove-if #'(lambda (x) (part= x master)) group)))
    (dolist (r rest)
      (add-triple r !owl:sameAs master))))
      


(defun merge-sameas-nodes ()
  (do ((tracing 0 (1+ tracing))
       (tr (get-triple :p !owl:sameAs)
	   (get-triple :p !owl:sameAs)))
      ((null tr) tracing)
    (merge-nodes (subject tr) (object tr))))
    
(defun merge-nodes (old new)
  "Transfer all in and out edges from OLD to NEW, except owl:sameAs edges."
  (let ((new-triples nil))
    (progn 
      (mapcar #'(lambda (tr)
		  (if (not (get-triple :s new :p (predicate tr) :o (object tr)))
		      (push (list new (predicate tr) (object tr)) new-triples)))
	      (get-triples-list :s old :limit nil :filter #'(lambda (tr) (not (predicate-part= tr !owl:sameAs)))))
      (mapcar #'(lambda (tr)
		  (if (not (get-triple :s (subject tr) :p (predicate tr) :o new))
		      (push (list (subject tr) (predicate tr) new) new-triples)))
	      (get-triples-list :o old :limit nil :filter #'(lambda (tr) (not (predicate-part= tr !owl:sameAs)))))
      (dolist (a new-triples)
	(add-triple (nth 0 a) (nth 1 a) (nth 2 a)))
      (delete-triples :s old)
      (delete-triples :o old))))