Climbing trees

Here is a solution to an ACM programming problem requiring one to analyse trees describing parental relationships.

I wrote this in Maude even though the classic tool for this kind of problem is Prolog.

The solution
The output

We start by importing integers and quoted identifiers (symbols):

mod CLIMBING is
protecting INT .
protecting QID .

Next we define the sorts used in the program. Rel means any kind of relationship, NamePair is a just pair of names. The sorts Parent, Sibling and Cousing are all relationship types.


sort Rel .

sorts NamePair .
sorts Parent Sibling Cousin RelType .
subsorts Parent Sibling Cousin < RelType .

The following operators (or constructors) are used to construct various relationship facts.


op Parent : Nat -> Parent .
op Cousin : Nat Nat -> Cousin .
op Sibling : -> Sibling .

op pair : Qid Qid -> NamePair .
op rel : NamePair RelType -> Rel .
op parent : Qid Qid -> Rel .

op Empty : -> Rel [ ctor ] .
op __ : Rel Rel -> Rel [ ctor assoc comm id: Empty ] .

The problem set is initialized with the following set of parent-child facts

op init : -> Rel .
eq init =
parent('alonzo.church, 'oswald.veblen)
parent('stephen.kleene, 'alonzo.church)
parent('dana.scott, 'alonzo.church)
parent('martin.davis, 'alonzo.church)
parent('pat.fischer, 'hartley.rogers)
parent('mike.paterson, 'david.park)
parent('dennis.ritchie, 'pat.fischer)
parent('hartley.rogers, 'alonzo.church)
parent('les.valiant, 'mike.paterson)
parent('bob.constable, 'stephen.kleene)
parent('david.park, 'hartley.rogers) .

We use the following variables to name various objects in our rules:


vars A B : Qid .
vars X Y Z : Qid .

vars N M O P : Nat .
vars R : RelType .
vars REST : Rel .

These four rules describe the different relationship types:


---- Note that the input is in (child, parent) format, but we want to output (parent, child)

rl [ parent ] : parent(A, B) => rel( pair(B, A), Parent(0)) .

rl [ grandparent ] :
rel( pair(X, Y), Parent(0))
rel( pair(Y, Z), Parent(N)) => rel( pair(X, Z), Parent(N + 1)) .

---- sibling is reflexive

rl [ sibling ] :
rel( pair(X, Y), Parent(0))
rel( pair(X, Z), Parent(0)) => rel( pair(Y, Z), Sibling) rel( pair(Z, Y), Sibling) .

---- check least ancestor
rl [ cousin ] :
rel( pair(X, Y), Parent(N))
rel( pair(X, Z), Parent(M)) => rel( pair(Y, Z), Cousin(min(N,M), abs(N - M))) .
endm

These search expressions describe the input queries (we could make an effort to parse these properly instead)


search [1] in CLIMBING : init =>+ rel (pair ('stephen.kleene, 'bob.constable), R) REST .
search [1] in CLIMBING : init =>+ rel (pair ('hartley.rogers, 'stephen.kleene), R) REST .

----- search [1] in CLIMBING : init =>+ rel (pair ('les.valiant, 'alonzo.church), R) REST .
----- swap this query to search for father instead of child

search [1] in CLIMBING : init =>+ rel (pair ('alonzo.church, 'les.valiant), R) REST .

search [1] in CLIMBING : init =>+ rel (pair ('les.valiant, 'dennis.ritchie), R) REST .
search [1] in CLIMBING : init =>+ rel (pair ('dennis.ritchie, 'les.valiant), R) REST .
search [1] in CLIMBING : init =>+ rel (pair ('pat.fischer, 'michael.rabin), R) REST .

quit