1:- module(common_logic_reordering,[]). 2
3
4:- op(800,xfx,'=<>='). 5
6
7
8combine_clauses_with_disjuncts(SET,OUT):-
9 sort(SET,SORTED),combine_clauses_with_disjuncts_0(SORTED,OUT).
10
11combine_clauses_with_disjuncts_0([],[]).
12combine_clauses_with_disjuncts_0([(H1:-B1),(H2:-B2)|SORTED],OUT):-
13 H2=@=H1,(WAS = H1:B2),
14 copy_term(WAS,NOW),H1=H2,WAS=@=NOW,!,
15 combine_clauses_with_disjuncts_0([(H1:- (B2 ; B1))|SORTED],OUT).
16combine_clauses_with_disjuncts_0([S1|SORTED],[S1|OUT]):-
17 combine_clauses_with_disjuncts_0(SORTED,OUT).
18
19
20dedupe_clauses(List,ListO):- sanity(is_list(List)),
21 sort(List,ListM),
22 dedupe_clauses_pass2(ListM,ListO).
23
24dedupe_clauses_pass2([],[]).
25dedupe_clauses_pass2([X,Y|ListM],ListO):- show_call(same_clauses(X,Y)),!,
26 dedupe_clauses_pass2([X|ListM],ListO).
27dedupe_clauses_pass2([X|ListM],[X|ListO]):-
28 dedupe_clauses_pass2(ListM,ListO).
29
30
31same_cl_test0 :-
32 same_clauses(
33 proven_neg(dudes(X)) ,
34 ((nesc(dudes(Dudes0)),
35 dif_objs(X, Dudes0))),
36 proven_neg(dudes(Dudes0)),
37 (nesc(dudes(X)),
38 dif_objs(X, Dudes0))).
39
40same_cl_test1:-
41 same_clauses(
42 (proven_neg(different(Dudes1, Dudes3)) :-
43 nesc(dudes(Dudes3)),
44 nesc(dudes(Dudes1)),
45 dif_objs(Dudes1, Dudes2),
46 nesc(dudes(Dudes2))),
47 (proven_neg(different(Dudes1, Dudes2)) :-
48 dif_objs(Dudes1, Dudes3),
49 nesc(dudes(Dudes1)),
50 nesc(dudes(Dudes2)),
51 nesc(dudes(Dudes3)))).
52
53
54X =<>= Y :- X==Y,!.
55X =<>= Y :- (\+compound(X);\+compound(Y)),!,fail.
56L =<>= R :- L=..[F,X,Y], R=..[F,YY,XX], is_symetric_lr(F), v(X,Y) == v(XX,YY),v(X,Y) = v(XX,YY).
57L =<>= R :- L=..[F,X|Y], R=..[F,XX|YY],maplist( =<>= ,[X|Y],[XX|YY]).
59
60is_symetric_lr(sameObjects).
61is_symetric_lr(different).
62is_symetric_lr(equal).
63is_symetric_lr(equals).
64is_symetric_lr(dif_objs).
65
66same_clauses(HB1,HB2):- HB1 =<>= HB2,!.
67same_clauses(HB1,HB2):- \+ \+ same_clauses0(HB1,HB2).
68
69same_clauses0(H1B1,H2B2):-
70 del_term_attr(vn,H1B1),
71 del_term_attr(vn,H2B2),
72 expand_to_hb(H1B1,H1,B1),
73 expand_to_hb(H2B2,H2,B2),!,
74 same_clauses(H1,B1,H2,B2).
75
76same_clauses(H1,B1,H2,B2):- H1 =@= H2, H1 = H2,
77 body_to_sorted_dumb(B1,BB1),
78 body_to_sorted_dumb(B2,BB2),!,
79 term_variables(H1:BB1,BV1),
80 term_variables(H2:BB2,BV2),
81 BV1=BV2,!,
82 maplist(=<>=,BB1,BB2),!.
83
84del_term_attr(Attr,Term):-attvar(Term),!,del_attr(Term,Attr).
85del_term_attr(Attr,Term):-term_attvars(Term,AVs),maplist(del_term_attr(Attr),AVs).
86
87body_to_sorted_dumb(B1,BB1):-
88 conjuncts_to_list_det(B1,List),
89 sort(List,BB1),!.
90
91
92
93
94
95
96test_sort_body_better(Head,SET,SSET):-
97 SET=[A,B],
98 body_rating(Head,A,AR),writeln(AR-A),
99 body_rating(Head,B,BR),writeln(BR-B),
100 predsort(nearest_to_head(Head,SET),SET,SSET),!.
101
102
103sort_body_list_better(Head,SET,SSET):-
104 predsort(nearest_to_head(Head,SET),SET,SSET),!.
105
106vbody_sort((H:-B),(H:-BO)):- !, must(sort_body_better(H,B,BO)).
107vbody_sort(H,H).
108
109sort_body_better(Head,(A,B),BodyOut):- nonvar(A),
110 conjuncts_to_list_det((A,B),List),
111 list_to_set(List,SET),
112 sort_body_list_better(Head,SET,SSET),
113 list_to_conjuncts_det(SSET,BodyOut).
114sort_body_better(_,Body,Body).
115
116
117nearest_to_head(Head,_SET,Order,A,B):-
118 body_rating(Head,A,AR),
119 body_rating(Head,B,BR),
120 compare_along(Order,BR,AR),
121 Order \== (=),!.
122nearest_to_head(_Head,SET,Order,A,B):-
123 nth1_eq(AR,SET,A),
124 nth1_eq(BR,SET,B),
125 compare(Order,AR,BR).
126
127compare_along(Order,[A|List1],[B|List2]):-
128 ((compare(Order,A,B), Order \== ( = ) )
129 -> true ; compare_along(Order,List1,List2)).
130
131nth1_eq(AR,SET,A):- nth1(AR,SET,E),E==A.
132
133body_rating(Head,A,[SC,UCR,AR,AC]):-
134 term_variables(A,BV),length(BV,BC),
135 term_variables(Head,HV),length(BV,HC),
136 '$expand':intersection_eq(HV,BV,Shared),length(Shared,SC),
137 subtract_eq(BV,Shared,Uniq),length(Uniq,UC),UCR is - UC,
138 atomics_count(A,AC),!,
139 nop(AR is SC*3 - UC*2 + AC + HC +BC),
140 AR is ((SC*3 - UC + AC*2 ))/(BC+HC+1).
141
142atomics_count(A,AC):- findall(Sub,(sub_term(Sub,A),atomic(Sub)),Atoms),length(Atoms,AC).
151sort_body(HBINFO,BB,BBB):-sort_body_0(HBINFO,BB,BBB),(BBB=@=BB->true; (expand_to_hb(HBINFO,H,_),nop(dmsg([(H:-BB),'=>',(H:-BBB)])))).
160sort_body_0(_,SORTED,SORTED):-leave_as_is_logically(SORTED).
161sort_body_0(HBINFO,(A,B),SORTED):-!,conjuncts_to_list_det((A,B),List),
162 must_maplist_det(sort_body_0(HBINFO),List,ListIn),
163 predsort(litcost_compare(HBINFO),ListIn,SortedL),
164 list_to_conjuncts_det(SortedL,SORTED).
165sort_body_0(HBINFO,(A;B),SORTED):-!,disjuncts_to_list((A;B),List),
166 must_maplist_det(sort_body_0(HBINFO),List,ListIn),
167 predsort(litcost_compare(HBINFO),ListIn,SortedL),
168 list_to_conjuncts_det((;),SortedL,SORTED).
169sort_body_0(_,SORTED,SORTED).
178litcost_compare(_,=,A,B):- A=@=B,!.
179litcost_compare(HBINFO,Comp,A,B):-lit_cost(HBINFO,A,AC),lit_cost(HBINFO,B,BC),compare(CompC,AC,BC),
180 (CompC\== (=) -> CompC = Comp ; Comp = (<)).
189lit_cost(_,A,9):-isSlot(A).
190lit_cost(_,A,0):- \+ compound(A),!.
191lit_cost(HBINFO,A,AC):- A=..[F,ARG], is_log_op(F),!,lit_cost(HBINFO,ARG,AC0),!,
192 193 term_slots(A,Slots),length(Slots,SC),
194 AC is AC0+SC.
195lit_cost(HBINFO,A,AC):- expand_to_hb(HBINFO,H,B),
196 var_count_num(A,H,SH,UH),
197 var_count_num(A,B,VC,Singles),
198 AC is Singles*3 + VC + UH - SH.
199
200
201
202:- fixup_exports.