/* (max_join G1 G2) computes the maximal join of graphs G1 and G2
and stores the result in a dummy graph named 0.  G1 and G2 can be
specified by name or graph number.  */

((max_join G1 G2)
	(max_join G1 G2 0))

/* (max_join G1 G2 G3) computes the maximal join of graphs G1 and G2
and stores the result in graph named G3.  G1 and G2 can be specified
by name or graph number, but G3 must be specified by name.  The support
for the maximal join is computed and printed out.  */

((max_join G1 G2 G3)
	(get_gname G1 G4)
	(get_gname G2 G5)
	(report_time max_join supp_join G4 G5 (N0 P0))
	(pp2 'Listing of arguments to best_nodes clauses:') (pp2)
	(forall ((best_nodes | X)) ((pspaces2 8) (pp2 X)) ) (pp2)
	(p2 Support for maximal join ':' (N0  P0))
	(pp2)
	% (print_time unify_ref)
	% (print_time unify_type)
	% (print_time conforms)
	(new_graph2 G6)
	(kill count)
	(addcl ((maxj_count conc G6 0)) )
	(addcl ((maxj_count reln G6 0)) )
	(addcl ((abstr graph G3 () G6)) )
	% (report_time max_join do_joins G4 G5 G6))
	(do_joins G4 G5 G6))

/* (supp_join G1 G2 S) evaluates the support pair S for the maximal
join of two conceptual graphs, numbers G1 and G2, by performing an
intelligent depth-first search through all possible node-pairings.  */

((supp_join G1 G2 (N0 P0))
	(kill best_supp)
	(addcl ((best_supp (0 0))))
	(kill best_nodes)
	(kill npr)
	(report_time supp_join find_nprs G1 G2)
	(kill pair)
	(kill unpaired)
	(kill sig_node)
	(kb_garbage)
	(cputime B2 _)
	(find_rel_pairs G1 G2)
	(gcount2 reln G1 0 _Relations 1)
	(collect_pairs () _Arc_pairs (0 0) _Max_supp)
	(count_unpaired 0 _Unpaired)
	(add_supp _Max_supp (0 _Unpaired) _Max_support)
	(build_node_list G1 1 () () _Node_list)
	(cputime F2 _)
	(sum A2 B2 F2)
	(p2 time elapsed from find_rel_pairs to build_node_list in supp_join A2 secs) (pp2)
	(report_time supp_join find_max_join G1 G2 _Node_list _Arc_pairs _Max_support)
	% (find_max_join G1 G2 _Node_list _Arc_pairs _Max_support)
	(!)
	(best_supp (N P))
	(times N0 _Relations N)
	(times P0 _Relations P))

/* (do_joins G1 G2 G3) checks that temporary predicate "best_nodes"
is defined, and then evaluates (more_joins G1 G2 G3).  Can backtrack
to find multiple maximal join solutions, and prints a terminating
message and succeeds when there are no more solutions.  All maximal
join solutions found will have equal supports.  */

((do_joins G1 G2 G3)
	(dict best_nodes) 
	(!)
	(one_maxj G1 G2 G3))
((do_joins _ _ _)
	(pp2)
	(pp2 'There is no maximal join solution.')
	(pp2))

/* (more_joins G1 G2 G3) deletes current "best_nodes" fact clause
(best_nodes _Best_nodes), finds list L of elements X such that:
	(member (_ X _ _ _) _Best_nodes), and X <> 0;
checks for positive length of L, and then evaluates:
	(join_copy G1 G2 G3 _Best_nodes)
	(more_joins2 G1 G2 G3)
Looks for single maximal join via "join_copy".
Looks for further maximal joins via "more_joins2".
"more_joins" fails when there are no (further) solutions.
"more_joins" succeeds if "join_copy" finds a solution and no
further maximal joins are required.  */

/* "more_joins" replaced by "one_maxj".  */

((one_maxj G1 G2 G3)
	(findall X ((best_nodes _ X _ _ _) (less 0 X)) L)
	(length L LEN_matches)
	(less 0 LEN_matches)
	(!)
	(report_time one_maxj join_copy G1 G2 G3))
	% (join_copy G1 G2 G3))

/* (more_joins2 G1 G2 G3) checks for the existence of "best_nodes"
temporary predicate.  It initialises the temporary "count" predicate
again (this was also done in "max_join"/3).
Calls (more_joins G1 G2 G3) if further maximal joins are requested
(interactively).  */

/* more_joins2 not used.  */

/*
((more_joins2 G1 G2 G3)
	(dict best_nodes)					% more solutions ?
	(kill count)
	(addcl ((maxj_count conc G3 0)) )		% reset conc val counter
	(addcl ((maxj_count reln G3 0)) )
	(p2 Another maximal join solution '(y/n) ?')
	(r X)
	(!)
	(negg eq X n)
	(more_joins G1 G2 G3))
((more_joins2 _ _ _)) 
*/

/* (join_copy G1 G2 G3 BESTNODES) performs a single maximal join
according to the node pairings established by "supp_join".
All existing concepts and relations (of type rel) matching G3 are
deleted from "conc" and "reln".
Relations in G1 and G2 are assumed to be unary or binary only.
The following is repeated for all relations R:
	(reln G1 R rel RNAME (C1) (C2))
    (sub_1 G1 C1 CN3 BESTNODES SC1)
	(sub_1 G1 C2 CN4 BESTNODES SC2)
	(add_rel G3 R RNAME CN3 CN4 RNEXT)
Then, also, the folowing is repeated for all relations R:
    (reln G2 R rel RNAME (C1) (C2))	
	(sub_2 G2 C1 CN3 BESTNODES) 
	(sub_2 G2 C2 CN4 BESTNODES)
	(add_rel G3 R RNAME CN3 CN4 RNEXT) 
Finally, G3 is simplified by (simplify G3).  */

((join_copy G1 G2 G3)
	(del_matching_cl ((reln G3 _ rel _ _ _)))
	(del_matching_cl ((conc G3 _ _ _ _ _))) 
	(reln G1 R rel RNAME (C1) (C2))
	(sub_1 G1 C1 CN3 SC1) 			% SC1 is sec conc num
	(sub_1 G1 C2 CN4 SC2)
	(add_rel G3 R RNAME CN3 CN4)
	(fail))
((join_copy G1 G2 G3)
	(reln G2 R rel RNAME (C1) (C2))	
	(sub_2 G2 C1 CN3) 
	(sub_2 G2 C2 CN4)
	(add_rel G3 R RNAME CN3 CN4) 
	(fail))
((join_copy _ _ G3)
	(!)
	(simplify G3))

/* (rem_rqmrk X Y) removes a request mark in conjuction with a referent,
by unifying X and Y unless X is (? A) when Y is unified with ('%' A).  */

((rem_rqmrk (? R3) ('%' R3) )
	(!))
((rem_rqmrk (?) (?) )
	(!))
((rem_rqmrk X X))

/* 'sub_1' and 'sub_2' substitute concepts from graphs 1 and 2
   with new (unified) concepts where applicable */

((sub_1 G1 C1 (T R) N2)
	(best_nodes C1 N2 T R _)
	(less 0 N2)
	(conc G1 C1 _ _ _ _)
	(!))									% now joined
((sub_1 G1 C1 (T R) 0)
	(conc G1 C1 T R _ _)
	(!))

((sub_2 G2 C2 (T R) )
	(best_nodes _ C2 T R _)
	(!))
((sub_2 G2 C2 (T R) )
	(conc G2 C2 T R _ _)
	(!))

/* 'find_nprs' finds all possible node pairs and the corresponding
   new node and support pair in each case */

((find_nprs G1 G2)
	(conc G1 N1 T1 R1 _ _)
	(find_pairs G2 N1 T1 R1)
	(addcl ((npr N1 0 () () () )))
	(fail))
((find_nprs _ _))

((find_pairs G2 N1 T1 R1)
	(conc G2 N2 T2 R2 _ _)
	(unify T1 R1 T2 R2 T3 R3 S)
	(addcl ((npr N1 N2 T3 R3 S)))
	(fail))
((find_pairs _ _ _ _))

/* 'find_rel_pairs' finds all the possible relation pairs between the two
   graphs */

((find_rel_pairs G1 G2)
	(reln G1 N1 A1 B1 L1 R1)
	(addcl ((unpaired N1)) )
	(pos_neg A1 B1 _Sense B2)
	(reln G2 N2 A1 B2 L2 R2)
	(check_nprs L1 R1 L2 R2 A3 B3 A4 B4 S1 S2)
	(arity_check A1 B2 S1 S2 S3)
	(negate_supp S3 _Sense S4)
	(addcl ((pair N1 N2 S4)))
	(add_sig_nodes L1)
	(add_sig_nodes R2)
	(delcl ((unpaired N1)))
	(fail))
((find_rel_pairs _ _)
	(kb_garbage))

/* 'pos_neg' enables the arc-pairing routine look for situations where
   one relation is the direct negation of another */

((pos_neg act _Actor equals _Actor)
	(!))
((pos_neg rel _Relation equals _Relation))
((pos_neg rel _Relation negated _Neg_rel)
	(name (110 111 116 95 | _N_list) _Relation)
								% (stringof (n o t '_' | _N_list) _Relation)
	(name _N_list _Neg_rel)		% (stringof _N_list _Neg_rel)
	(!))
((pos_neg rel _Relation negated _Neg_rel)
	(name _N_list _Relation)	% (stringof _N_list _Relation)
	(name (110 111 116 95 | _N_list) _Neg_rel))
								% (stringof (n o t '_' | _N_list) _Neg_rel))

/* N.B. 'check_nprs' CURRENTLY ONLY HANDLES DIADIC RELATIONS */

/* check_nprs will eventually have to determine which of the lists of nodes
   actually unify, then do the arity check using these nodes and then add
   then as sig_nodes */

((check_nprs (N1) (N2) (N3) (N4) T1 R1 T2 R2 S1 S2)
	(npr N1 N3 T1 R1 S1)
	(npr N2 N4 T2 R2 S2))

((add_sig_nodes (N) )
	(addcl ((sig_node N)) ))

/* 'arity_check' calculates the support for an arc pairing on the
   basis of the supports for the node pairs at each end, and the
   semantic meaning of the relation */

/* need to consider difference between metric and name concepts, also
   difference between actors and relations (if any!) */

((arity_check _ _ (0 0) (0 0) (0 0) )
	(!))								% surely not ... (!) (fail)) here ?!
((arity_check _ _ (N1 P1) (N2 P2) (N3 P3) )
	(less 0 P1)
	(less 0 P2)
	(times N1 N2 N3)
	(times P1 P2 P3)
	(!))
((arity_check rel _Relation _ (0 0) (0 0) )
	(right_arity _Relation 1)
	(!))
((arity_check rel _Relation (0 0) _ (0 0) )
	(left_arity _Relation 1))

/* 'negate_supp' performs a support logic negation in cases where the
   relations are opposites */

((negate_supp _Supp equals _Supp))
((negate_supp (N1 P1) negated (N2 P2) )
	(add_supp (N1 P1) (P2 N2) (1 1) ))

/* 'collect_pairs' collects together the possible arc-pairs from the
   database into a list, and sums the associated supports to give a
   maximum theoretical support for the join */

((collect_pairs _So_far _All _Supp _Max_supp)
	(delcl ((pair N1 N2 S3)))
	(add_supp _Supp S3 _New_supp)
	(collect_pairs ((N1 N2 S3)|_So_far) _All _New_supp _Max_supp))
((collect_pairs _Arc_pairs _Arc_pairs _Max_supp _Max_supp)
	(kb_garbage))

/* 'add_supp' adds two support pairs together */

((add_supp (N1 P1) (N2 P2) (N3 P3) )
	(sum N1 N2 N3)
	(sum P1 P2 P3))

/* 'count_unpaired' counts the number of relations in graph 1 which
   cannot be paired in the join */

((count_unpaired _So_far _Unpaired_count)
	(delcl ((unpaired _)) )
	(sum _So_far 1 _New)
	(count_unpaired _New _Unpaired_count))
((count_unpaired _Unpaired_count _Unpaired_count)
	(kb_garbage))

/* 'build_node_list' constructs a list of the node numbers in graph G1
   with "significant" nodes at the front of the list */

((build_node_list G1 N _First _Second _List)
	(conc G1 N | _)
	(cl ((sig_node N)) )
	(sum N 1 _Next)
	(!)
	(build_node_list G1 _Next (N|_First) _Second _List))
((build_node_list G1 N _First _Second _List)
	(conc G1 N | _)
	(sum N 1 _Next)
	(!)
	(build_node_list G1 _Next _First (N|_Second) _List))
((build_node_list _ _ _First _Second _List)
	(append _First _Second _List))

/* 'find_max_join' performs an intelligent depth-first search through
   all possible node pairings to find the set that give the maximum
   overall support for the join */

((find_max_join G1 G2 (N1|_Nodes) _Arc_pairs _Supp)
	(npr N1 N2 T3 R3 S3)
	(negg eq S3 (0 0))
	(unpaired_node N2)
	(conc G1 N1 _ _ L1 R1)
	(get_rel_2 G2 N2 L2 R2)
	(refine _Arc_pairs () _Int_pairs L1 L2 _Supp _Int_supp)
	(refine _Int_pairs () _New_pairs R1 R2 _Int_supp _New_supp)
	(best_supp _Best_so_far)
	(negg worse_support _New_supp _Best_so_far _Supp)
	(addcl ((best_nodes N1 N2 T3 R3 S3)) 0)
	(!)
	(leaf_test G1 G2 _Nodes _New_pairs _New_supp))

/* 'leaf_test' checks to see if the search has reached a leaf in the
   search tree - if so it has found a node pair set which gives as
   good support (if not better) of any found so far */

((leaf_test _ _ () _ _Supp)
	(!)
	(delcl ((best_supp S0)))
	(addcl ((best_supp _Supp)))
	(kb_garbage))
((leaf_test G1 G2 _Nodes _Arc_pairs _Supp)
	(find_max_join G1 G2 _Nodes _Arc_pairs _Supp))

/* 'unpaired_node' succeeds if the node from G1 is to be unpaired, or
   paired to a previously unpaired node of G2 */

((unpaired_node 0)
	(!))
((unpaired_node N)
	(negg best_nodes _ N _ _ _))

/* 'get_rel_2' returns the list of related arcs, or () for an
   unpaired node */

((get_rel_2 _ 0 () () ))
((get_rel_2 G2 N2 L2 R2)
	(conc G2 N2 _ _ L2 R2))

/* 'refine' considers all remaining possible arc pairings and
   determines whether any have been made impossible by the latest
   node pairing.  If so, this arc pair is removed from the list of
   possibilities, and its support is subtracted from the cumulative
   total for the search path */

((refine () _Arc_pairs _Arc_pairs _ _ _Supp _Supp))
((refine ((A1 A2 S3)|_Rest) _Arc_pairs _New_arcs R1 R2 S1 S2)
	(member A1 R1)
	(negg member A2 R2)
	(!)
	(add_supp S3 _Supp S1)
	(refine _Rest _Arc_pairs _New_arcs R1 R2 _Supp S2))
((refine (_Arc_pair|_Rest) _Arc_pairs _New_arcs R1 R2 S1 S2)
	(refine _Rest (_Arc_pair|_Arc_pairs) _New_arcs R1 R2 S1 S2))

/* 'worse_support' succeeds if the cumulative support for the join
   is lower than the best support obtained to date, or the necessary
   support for this node is zero, but for last node was >0  */

((worse_support (0 _) _ (N _) )
	(negg eq N 0)
	(!))
((worse_support (N _) (N0 _) _)
	(less N N0)
	(!))
((worse_support (N0 P) (N0 P0) _)
	(less P P0))

/* 'add_pairs' stores the best node and arc pair sets in the database */

/*
((add_pairs _Paired_nodes S0 S0)
	(addcl ((best_nodes _Paired_nodes)))
	(!))
((add_pairs _Paired_nodes _ _)
	(kill best_nodes)
	(addcl ((best_nodes _Paired_nodes)) ))
*/

/* find_next_node_val is used to find which node number the last node had */

((find_next_node_val G TYPE NEXTV)
	(delcl ((maxj_count TYPE G OLDV)) )
	(!)
	(sum OLDV 1 NEXTV)
	(addcl ((maxj_count TYPE G NEXTV)) ))
((find_next_node_val G TYPE 1)
	(addcl ((maxj_count TYPE G 1)) ))

/* get_cname invents a vew conc node in graph number G
	called CNAME, and also designates a new conc number G or it */

((get_cname G (T R) CVAL)
	(conc G CVAL T R _ _)
	(!))
((get_cname G (T R) CNEWVAL)
	(find_next_node_val G conc CNEWVAL)
	(addcl ((conc G CNEWVAL T R () () )) ))

/* 'add_rel' adds a relation to graph G3 and avoids duplicating
   relations - CN1 and CN2 are in conc names */

((add_rel G3 R RNAME (CN1 R1) (CN2 R2) )
	(rem_rqmrk R1 R3)
	(rem_rqmrk R2 R4)						% remove request marks
	(get_cname G3 (CN1 R3) C1)
	(get_cname G3 (CN2 R4) C2)
	(add_rel2 G3 R RNAME C1 C2))

((add_rel2 G3 R RNAME C1 C2)
	(reln G3 R rel RNAME (C1) (C2))			% relation already exists
	(!)) 
((add_rel2 G3 R RNAME C1 C2)				% create new relation
	(find_next_node_val G3 reln NEXTR)
	(addcl ((reln G3 NEXTR rel RNAME (C1) (C2) )) ) 
	(update_conc2 G3 C1 () (NEXTR) )				% update concs
	(update_conc2 G3 C2 (NEXTR) () ))

((update_conc2 G N L1 R1)
	(delcl ((conc G N A B L2 R2)) )
	(append L1 L2 L)
	(append R1 R2 R)
	(!)
	(addcl ((conc G N A B L R)) 0))

/* 'clear_kb' cleanses kb of old temporary unuseful cgs, saving space */

((clear_kb ()) 
	(kb_garbage)
	(!))
((clear_kb (H|L))
	(del_gr H)
	(clear_kb L))

/* del_gr deletes the cg X from the database */

((del_gr X)
	(abstr _ X _ G)
	(delcl ((abstr _ _ _ G)) )
	(conc G |A)
	(delcl ((conc G |A)) )
	(reln G |B)
	(delcl ((reln G |B)) )
	(fail))
((del_gr _))