3
4aleph_portray(hypothesis):-
5 hypothesis(Head,Body,_),
6 exists_causal_order((Head:-Body),Order),
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
16write_davinci_qmodel([_-Head|Body]):-
17 numbervars([Head|Body],0,_),
18 exogenous_variables(Head,E),
19 state_variables(Head,S),
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]):- !.
57get_constraint_attributes(addl,['+/-',circle]):- !.
58get_constraint_attributes(addf,['+/-',circle]):- !.
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,
87 write_davinci_links(Children,NodeId,EdgeAttributes),
88 nl, tab(8), write(')'), nl,
89 tab(4),
90 write(')').
91
92write_davinci_links([],_,_):-
93 !,
94 tab(12),
95 write('[]').
96write_davinci_links(Children,Parent,Attr):-
97 tab(12),
98 write('['),
99 write_davinci_link(Children,Parent,Attr),
100 tab(12),
101 write(']').
102
103write_davinci_link([],_,_):- !.
104write_davinci_link([Child|T],Parent,[Edge,Dir]):-
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),
111 write_davinci_link(T,Parent,[Edge,Dir]).
112
113
114
117
118exists_causal_order((Head:-Body),[H|Order]):-
119 number_lits((Head,Body),1,[H|BodyL]),
120 exogenous_variables(Head,E),
121 state_variables(Head,S),
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)