```    1% Predicate to portray qualitative models learnt
2% using the davinci graph drawing tool
3
4aleph_portray(hypothesis):-
7        open('hypothesis.davinci',write,Stream),
8        set_output(Stream),
9        write_davinci_qmodel(Order),
10        close(Stream),
11        set_output(user_output),
12        concat([davinci,' ','hypothesis.davinci'],Cmd),
13        execute(Cmd).
14
15
20	conc(E,S,Given),
21	write('['), nl,
22	write_variables(Given,Body),
23	(Body \= [] -> write(','), nl; true),
24	write_davinci_qmodel(Body,Given),
25	nl, write(']'), nl.
26
27write_davinci_qmodel([],_):- !.
28write_davinci_qmodel([N-Lit|Lits],Seen):-
29	get_vars_in_lit(Lit,Vars),
30	set_diff(Vars,Seen,New,Old),
31	write_constraint(N-Lit,New),
32	(New \= [] -> write(','), nl; true),
33	write_variables(New,Lits),
34	(Lits \= [] -> write(','), nl; true),
35	conc(Seen,New,Seen1),
36	write_davinci_qmodel(Lits,Seen1).
37
38
39
40write_variables([],_):- !.
41write_variables([Var|Vars],Lits):-
42	get_var_occurs(Lits,Var,DepLits),
43	write_davinci_node([Var,variable,white,text,Var],DepLits,[solid,none]),
44	(Vars \= [] -> write(','), nl; true),
45	write_variables(Vars,Lits).
46
47write_constraint(N-Lit,New):-
48	functor(Lit,Name,_),
49	write_constraint(N,Name,New).
50
51write_constraint(N,Name,New):-
52	get_constraint_attributes(Name,[Text,Shape]),
53	write_davinci_node([N,constraint,white,Shape,Text],New,[solid,none]).
54
55
56get_constraint_attributes(deriv,['DT',box]):- !.
59get_constraint_attributes(mult,['x',circle]):- !.
60get_constraint_attributes(m_plus,['M+',box]):- !.
61get_constraint_attributes(m_minus,['M-',box]):- !.
62get_constraint_attributes(minusl,['-',circle]):- !.
63get_constraint_attributes(minusf,['-',circle]):- !.
64get_constraint_attributes(_,['?',rhombus]).
65
66get_var_occurs([],_,[]):- !.
67get_var_occurs([N-Lit|Lits],Var,[N|T]):-
68	get_vars_in_lit(Lit,Vars),
69	element(Var,Vars), !,
70	functor(Lit,Name,_),
71	get_var_occurs(Lits,Var,T).
72get_var_occurs([_|Lits],Var,T):-
73	get_var_occurs(Lits,Var,T).
74
75
76write_davinci_node([NodeId,Type,Col,GO,Text],Children,EdgeAttributes):-
77	tab(4),
78	write('l("'), write(NodeId), write('",'), nl,
79	tab(8),
80	write('n("'), write(Type), write('",'), nl,
81	tab(12),
82	write('[a("COLOR","'), write(Col), write('"),'), nl,
83	tab(12),
84	write('a("_GO","'), write(GO), write('"),'), nl,
85	tab(12),
86	write('a("OBJECT","'), write(Text), write('")],'), nl,
88	nl, tab(8), write(')'), nl,
89	tab(4),
90	write(')').
91
93	!,
94	tab(12),
95	write('[]').
97	tab(12),
98	write('['),
100	tab(12),
101	write(']').
102
105	write('l("'), write(Parent), write('->'), write(Child), write('",'), nl,
106	tab(16),
107	write('e("",[a("EDGEPATTERN","'), write(Edge),write('"), '),
108	write('a("_DIR","'), write(Dir), write('")],'),
109	write('r("'), write(Child), write('")))'),
110	(T \= [] -> write(','), nl, tab(12); true),
112
113
114
115%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
116% Causal ordering of literals in a QM
117
122	conc(E,S,Given),
123	causal_order(BodyL,Given,Order).
124
125number_lits((A,B),N,[N-A|T]):-
126	!,
127	N1 is N + 1,
128	number_lits(B,N1,T).
129number_lits(true,_,[]):- !.
130number_lits(A,N,[N-A]).
131
132
133causal_order([],_,[]):- !.
134causal_order(Lits,Seen,[N-Lit|T]):-
135	select_lit(N-Lit,Lits,Rest),
136	functor(Lit,Name,Arity),
137	(Name/Arity = deriv/2 ->
138		causal_order(Rest,Seen,T);
139		get_vars_in_lit(Lit,Vars),
140		set_diff(Vars,Seen,New,Old),
141		length(New,L),
142		L =< 1,
143		conc(Seen,New,Seen1),
144		causal_order(Rest,Seen1,T)).
145
146get_dependencies([],_,[]).
147get_dependencies([Var|Vars],Deps,L):-
148	mem(Var1/L0,Deps),
149	Var == Var1, !,
150	get_dependencies(Vars,Deps,L1),
151	conc(L0,L1,L).
152get_dependencies([Var|Vars],Deps,[Var|L]):-
153	get_dependencies(Vars,Deps,L).
154
155
156select_lit(L,[L|T],T).
157select_lit(L,[H|T],[H|T1]):- select_lit(L,T,T1).
158
159get_vars_in_lit(Lit,Vars):-
160	functor(Lit,_,Arity),
161	get_vars_in_lit(Arity,Lit,Vars0),
162	sort(Vars0,Vars).
163
164get_vars_in_lit(0,_,[]):- !.
165get_vars_in_lit(N,Lit,[Var|Vars]):-
166	arg(N,Lit,Var),
167	(var(Var);functor(Var,'\$VAR',_)), !,
168	N1 is N - 1,
169	get_vars_in_lit(N1,Lit,Vars).
170get_vars_in_lit(N,Lit,Vars):-
171	N1 is N - 1,
172	get_vars_in_lit(N1,Lit,Vars).
173
174set_diff([],_,[],[]).
175set_diff([Var|Vars],S,S1,[Var|S2]):-
176	element(Var,S), !,
177	set_diff(Vars,S,S1,S2).
178set_diff([Var|Vars],S,[Var|S1],S2):-
179	set_diff(Vars,S,S1,S2).
180
181element(X,[Y|_]):- X == Y, !.
182element(X,[_|T]):- element(X,T).
183
184mem(X,[X|_]).
185mem(X,[_|T]):- mem(X,T).
186
187conc([],L,L).
188conc([H|T],L,[H|T1]):- conc(T,L,T1)```