## Efficient relation composition

Discussion of Common Lisp

### Efficient relation composition

Code: Select all
(defun relation-composition (a b)
(if (null a) nil
(let ((rest (relation-composition (cdr a) b)))
(append
(remove-if
#'(lambda (x) (member x rest))
(mapcar
#'(lambda (x)
(remove-if
#'(lambda (x)
(not (equal (car x) (cadar a)))) b))) rest))))

Hi, this *shouldn't be* very difficult, but I'm still not sure. Will the above algo compose two relations in the most efficient way? Relation for this matter is described as a list having sub-lists, which, in turn, contain exactly two elements. The relations are well-formed (i.e. there are no repetitions). The first element of sub-list of the first list is a member of set A, the second element of the sub-list of the first list is the element in the set B. The first element of the sub-list of the second list is the element in the set B, the second element of the sub-list of the second list is the element of the set C. The composition of relations is defined as a list containing sub-lists where first element a of the sub-list is the member of set A, and the second element c of the sub-list is the member of set C, such that first relation contains the pair (a b) and the second relation contains the pair (b c).
A practical example would be the composition of relation of being a parent with itself, where the resulting relation would be the relation of being a great-parent of.
wvxvw

Posts: 123
Joined: Sat Mar 26, 2011 6:23 am

### Re: Efficient relation composition

Your code is wrong. A working and much simpler approach would be the following:

Code: Select all
(defun related-p (a b rel)
; return true if a and b are related according to rel
)

(defun combine-relations (rel-1 rel-2)
(if (endp rel-1)
rel-2
(let ((elm (car rel-1)))
(combine-relations
(cdr rel-1)
(if (related-p (car elm) (cadr elm) rel-2)
rel-2
(cons elm rel-2))))))

The time sink here is related-p. This function has to effectively calculate the disjunct partition implied by the equivilence relation every time.
To make the code more efficient it would be better to convert the relation into a partition first, then calculate the composition and then convert back.
The most efficient representation of such a partition I can think of is a hash table that maps the same gensym to objects that are related.

Code: Select all
(defun hash-relation (rel &optional (hashed-rel (make-hash-table)))
(loop for (a b) in rel
for a-tag = (gethash a hashed-rel)
for b-tag = (gethash b hashed-rel)
do (cond ((and (null a-tag) (null b-tag))
; both a and b aren't in the relation yet
; add both with the same tag
(let ((g (gensym)))
(setf (gethash a hashed-rel) g
(gethash b hashed-rel) g)))
((and a-tag (null b-tag))
; a is in the relation but b isn't
; add b with the same tag as a to make a and b equal
(setf (gethash b hashed-rel) a-tag))
((and (null a-tag) b-tag)
; b is in the relation but a isn't
; add a with the same tag as b to make a and b equal
(setf (gethash a hashed-rel) b-tag))
((not (eq a-tag b-tag))
; both a and b are in the relation but not equal
; replace all occurences of b-tag with a-tag to unite the sets of a and b
; this also implicitliy rejects the trivial case where (eql a b)
(maphash (lambda (obj tag)
(if (eq tag b-tag)
(setf (gethash obj hashed-rel) a-tag)))
hashed-rel)))
finally (return hashed-rel)))

(defun unhash-relation (hashed-rel)
(let ((partition (make-hash-table))
unhashed-rel)
(maphash (lambda (obj tag)
(push obj (gethash tag partition)))
hashed-rel)
(maphash (lambda (tag subset)
(declare (ignore tag))
(if (>= (length subset) 2)
(let ((prev (car subset)))
(dolist (elm (cdr subset))
(push (list prev elm) unhashed-rel)
(setf prev elm)))))
partition)
unhashed-rel))

(defun copy-hash-table (ht)
(let ((copy (make-hash-table)))
(maphash (lambda (key val) (setf (gethash key copy) val))
ht)
copy))

(defun calc-tag-map (hashed-rel-1 hashed-rel-2)
(let ((tag-map (make-hash-table)))
(maphash
(lambda (obj tag-1)
(let ((tag-2 (gethash obj hashed-rel-2)))
(if tag-2
(setf (gethash tag-1 tag-map) tag-2))))
hashed-rel-1)
tag-map))

(defun combine-hashed-relations (hashed-rel-1 hashed-rel-2)
(let ((hashed-rel-3 (copy-hash-table hashed-rel-2))
(tag-map (calc-tag-map hashed-rel-1 hashed-rel-2)))
(maphash
(lambda (obj tag)
(let ((mapped-tag (gethash tag tag-map tag)))
(setf (gethash obj hashed-rel-3) mapped-tag)))
hashed-rel-1)
hashed-rel-3))

(defun related-p (a b hashed-rel)
(or (eql a b)
(let ((a-tag (gethash a hashed-rel))
(b-tag (gethash b hashed-rel)))
(and a-tag (eq a-tag b-tag)))))

; (unhash-relation (combine-hashed-relations (hash-relation '((a b) (b c) (d e))) (hash-relation '((e f)))))
Last edited by Konfusius on Thu May 03, 2012 12:07 pm, edited 2 times in total.
Konfusius

Posts: 61
Joined: Fri Jun 10, 2011 6:38 am

### Re: Efficient relation composition

Sorry, that's not working... what is `compose-relations'? If you meant `combine-relations', then the arity doesn't match... In any case, knowing only (car elm) and (cadr elm) will not suffice for combination because I need to know all 4 members of the lists in order to be able to compose them. I.e.

((a b)) . ((b c)) => ((a c))
((a b)) . ((d c)) => ()
((a b)) . ((b a)) => ((a a))
((a a)) . ((a a)) => ((a a))

where dot means composition and => means the result of it.

EDIT: OK, but I see now where my isn't working.

EDIT2: But it would have worked, if it was like this:

Code: Select all
(defun relation-composition (a b)
(if (null a) nil
(let ((rest (relation-composition (cdr a) b)))
(append
(remove-if
#'(lambda (x)
(labels ((filter (y)
(cond
((null y) nil)
((and (equal (car x) (caar y))
(t (filter (cdr y))))))
(filter rest)))
(mapcar
#'(lambda (x)
(remove-if
#'(lambda (x)
(not (equal (car x) (cadar a)))) b))) rest))))

(I don't say it become better - it's just I didn't realize `member' will act like `eq' rather than `equal')
Last edited by wvxvw on Thu May 03, 2012 12:36 pm, edited 1 time in total.
wvxvw

Posts: 123
Joined: Sat Mar 26, 2011 6:23 am

### Re: Efficient relation composition

Sorry for the typos. I corrected them. The second code example is tested and working, though.

I dont' get what you mean with "composition of relations" (I'm assuming you mean equivalence relations). The idea of composition you gave in your second post cannot be generalized for relations containing more than one pair. But the code example in your first post implies that you want to compose relations with more than one pair. Maybe you misunderstood the concept of composing relations.

Composing equivalence relations as I understand it means to unite two sets of equivalence pairs and removing those pairs that can be concluded from the rest.

Example:
{ a=b, b=c } and { a=c, b=d } is { a=b, b=c, b=d}.
a=c has been removed because it can be concluded form a=b and b=c.
Konfusius

Posts: 61
Joined: Fri Jun 10, 2011 6:38 am

### Re: Efficient relation composition

OK, cool, I'm checking it now, but few points before I've more to reply:

I'm assuming you mean equivalence relations

No, just any relation. There's no requirement it is equivalence. For example, ((a b) (a c) (b a)) means a relation from set {a,b} to set {b,c,a} such that a is related to b and c (the relation is considered one directional, i.e. the second pair is a relation from the second set to the first, but we don't care about that relation), and b is related to a. The composition of this relation to ((a b) (c b)) yields ((b b) (a b)) because there is a path from (b a) => (a b) => (b b) and (a c) => (c b) => (a b), but (a b) has no "path" because no relation in the second set starts with b.

Equivalence relation has too many restrictions (must be reflexive and transitive), but there's no such requirement for composition of any two relations.
wvxvw

Posts: 123
Joined: Sat Mar 26, 2011 6:23 am

### Re: Efficient relation composition

wvxvw wrote:(I don't say it become better - it's just I didn't realize `member' will act like `eq' rather than `equal')

You can tell MEMBER to use EQUAL by doing (MEMBER ... :TEST #'EQUAL).

Kompottkin

Posts: 91
Joined: Mon Jul 21, 2008 7:26 am
Location: München, Germany

### Re: Efficient relation composition

Oh, cool, good to know that.
wvxvw

Posts: 123
Joined: Sat Mar 26, 2011 6:23 am

### Who is online

Users browsing this forum: Google [Bot] and 0 guests