1:- module(test_trill,
2 [test_trill/0]). 3:- use_module(library(plunit)). 4
5test_trill:-
6 trill:set_algorithm(trill),
7 run_tests([trill_biopax,
8 9 trill_dbpedia,
10 trill_brca,
11 trill_commander,
12 trill_johnEmployee,
13 trill_peoplePets,
14 trill_vicodi,
15 trill_pizza,
16 non_det,
17 non_det_max,
18 local_cons]).
19
20:- use_module(library(trill_test/trill_test)). 21
22:- begin_tests(trill_brca, []). 23
24:- consult(library('examples/BRCA.pl')). 25
26test(p_wlbrcr_h):-
27 run((prob_instanceOf('WomanUnderLifetimeBRCRisk','Helen',Prob),close_to(Prob,0.123))).
28test(ne_wlbrcr_h):-
29 run((aggregate_all(count, (instanceOf('WomanUnderLifetimeBRCRisk','Helen',_ListExpl)), Count), Count = 5)).
30test(p_wa_wulbrcr):-
31 run((prob_sub_class('WomanAged3040','WomanUnderLifetimeBRCRisk',Prob),close_to(Prob,0.123))).
32test(ne_wa_wulbrcr):-
33 run((aggregate_all(count, (sub_class('WomanAged3040','WomanUnderLifetimeBRCRisk',_ListExpl)), Count), Count = 2)).
34
35:- end_tests(trill_brca). 36
37
38:- begin_tests(trill_vicodi, []). 39
40:- consult(library(examples/vicodi)). 41
42test(p_r_avdpf):-
43 run((prob_instanceOf('vicodi:Role','vicodi:Anthony-van-Dyck-is-Painter-in-Flanders',Prob),close_to(Prob,0.27540000000000003))).
44test(p_p_r):-
45 run((prob_sub_class('vicodi:Painter','vicodi:Role',Prob),close_to(Prob,0.30600000000000005))).
46
47:- end_tests(trill_vicodi). 48
49
50:- begin_tests(trill_commander, []). 51
52:- consult(library(examples/commander)). 53
54test(e_c_j):-
55 run((instanceOf(commander,john,Expl),
56 one_of(Expl,[[equivalentClasses([guard, soldier]), classAssertion(allValuesFrom(commands, guard), john), subClassOf(allValuesFrom(commands, soldier), commander)]])
57 )).
58
59:- end_tests(trill_commander). 60
61
62:- begin_tests(trill_peoplePets, []). 63
64:- consult(library(examples/peoplePets)). 65
66test(p_nl_k):-
67 run((prob_instanceOf('natureLover','Kevin',Prob),close_to(Prob,0.8696))).
68test(ne_nl_k):-
69 run((aggregate_all(count, (instanceOf('natureLover','Kevin',_ListExpl)), Count),Count = 3)).
70
71:- end_tests(trill_peoplePets). 72
73
74:- begin_tests(trill_biopax, []). 75
76:- consult(library(examples/biopaxLevel3)). 77
78test(p_twbr_e):-
79 run((prob_sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',Prob),close_to(Prob,0.98))).
80test(e_twbr_e):-
81 run((sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',ListExpl),
82 one_of(ListExpl,[[subClassOf('http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction','http://www.biopax.org/release/biopax-level3.owl#Conversion'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion','http://www.biopax.org/release/biopax-level3.owl#Interaction'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction','http://www.biopax.org/release/biopax-level3.owl#Entity'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction','http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction')],
83[subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion','http://www.biopax.org/release/biopax-level3.owl#Interaction'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction','http://www.biopax.org/release/biopax-level3.owl#Entity'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Transport','http://www.biopax.org/release/biopax-level3.owl#Conversion'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction','http://www.biopax.org/release/biopax-level3.owl#Transport')]])
84 )).
85test(ae_twbr_e):-
86 run((all_sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',Expl),
87 same_expl(Expl,[[subClassOf('http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction', 'http://www.biopax.org/release/biopax-level3.owl#Conversion'),
88 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion', 'http://www.biopax.org/release/biopax-level3.owl#Interaction'),
89 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction', 'http://www.biopax.org/release/biopax-level3.owl#Entity'),
90 subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction', 'http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction')],
91 [subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion', 'http://www.biopax.org/release/biopax-level3.owl#Interaction'),
92 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction', 'http://www.biopax.org/release/biopax-level3.owl#Entity'),
93 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Transport', 'http://www.biopax.org/release/biopax-level3.owl#Conversion'),
94 subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction', 'http://www.biopax.org/release/biopax-level3.owl#Transport')]])
95 )).
96
97:- end_tests(trill_biopax). 98
99:- begin_tests(trill_biopax_rdf, []). 100
101:- ensure_loaded(library(trill)). 102
103test(p_twbr_e):-
104 run((init_trill(trill),load_owl_kb('../examples/biopaxLevel3_rdf.owl'),prob_sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',Prob),close_to(Prob,0.98))).
105test(e_twbr_e):-
106 run((sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',ListExpl),
107 one_of(ListExpl,[[subClassOf('http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction','http://www.biopax.org/release/biopax-level3.owl#Conversion'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion','http://www.biopax.org/release/biopax-level3.owl#Interaction'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction','http://www.biopax.org/release/biopax-level3.owl#Entity'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction','http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction')],
108[subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion','http://www.biopax.org/release/biopax-level3.owl#Interaction'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction','http://www.biopax.org/release/biopax-level3.owl#Entity'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#Transport','http://www.biopax.org/release/biopax-level3.owl#Conversion'),subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction','http://www.biopax.org/release/biopax-level3.owl#Transport')]])
109 )).
110test(ae_twbr_e):-
111 run((all_sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',Expl),
112 same_expl(Expl,[[subClassOf('http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction', 'http://www.biopax.org/release/biopax-level3.owl#Conversion'),
113 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion', 'http://www.biopax.org/release/biopax-level3.owl#Interaction'),
114 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction', 'http://www.biopax.org/release/biopax-level3.owl#Entity'),
115 subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction', 'http://www.biopax.org/release/biopax-level3.owl#BiochemicalReaction')],
116 [subClassOf('http://www.biopax.org/release/biopax-level3.owl#Conversion', 'http://www.biopax.org/release/biopax-level3.owl#Interaction'),
117 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Interaction', 'http://www.biopax.org/release/biopax-level3.owl#Entity'),
118 subClassOf('http://www.biopax.org/release/biopax-level3.owl#Transport', 'http://www.biopax.org/release/biopax-level3.owl#Conversion'),
119 subClassOf('http://www.biopax.org/release/biopax-level3.owl#TransportWithBiochemicalReaction', 'http://www.biopax.org/release/biopax-level3.owl#Transport')]])
120 )).
121
122:- end_tests(trill_biopax_rdf). 123
124
125:- begin_tests(trill_dbpedia, []). 126
127:- consult(library('examples/DBPedia.pl')). 128
129test(p_p_pp):-
130 run((prob_sub_class('dbpedia:Place','dbpedia:PopulatedPlace',Prob),close_to(Prob,0.8273765902816))).
131test(ae_p_pp):-
132 run((all_sub_class('dbpedia:Place','dbpedia:PopulatedPlace',Expl),
133 same_expl(Expl,[[equivalentClasses(['http://dbpedia.org/ontology/A73_A0_',intersectionOf(['http://dbpedia.org/ontology/PopulatedPlace','http://dbpedia.org/ontology/Settlement'])]),subClassOf('http://dbpedia.org/ontology/Place','http://dbpedia.org/ontology/A73_A0_')],[subClassOf('http://dbpedia.org/ontology/Place','http://dbpedia.org/ontology/PopulatedPlace')],[equivalentClasses(['http://dbpedia.org/ontology/A0_144_',intersectionOf(['http://dbpedia.org/ontology/Place','http://dbpedia.org/ontology/PopulatedPlace'])]),subClassOf('http://dbpedia.org/ontology/Place','http://dbpedia.org/ontology/Settlement'),subClassOf('http://dbpedia.org/ontology/Settlement','http://dbpedia.org/ontology/A0_144_')],[subClassOf('http://dbpedia.org/ontology/Place','http://dbpedia.org/ontology/Settlement'),subClassOf('http://dbpedia.org/ontology/Settlement','http://dbpedia.org/ontology/PopulatedPlace')]])
134 )).
135
136:- end_tests(trill_dbpedia). 137
138
139:- begin_tests(trill_johnEmployee, []). 140
141:- consult(library(examples/johnEmployee)). 142
143test(e_p_j):-
144 run((instanceOf('johnEmployee:person','johnEmployee:john',Expl),
145 same_expl([Expl],[[classAssertion('http://example.foo#employee', 'http://example.foo#john'), subClassOf('http://example.foo#employee', 'http://example.foo#worker'), subClassOf('http://example.foo#worker', 'http://example.foo#person')]])
146 )).
147
148:- end_tests(trill_johnEmployee). 149
150
151:- begin_tests(trill_pizza, []). 152
153:- consult(library(examples/pizza)). 154
155test(p_inc_kb):-
156 run_fail((prob_inconsistent_theory(_))).
157test(p_uns_tof):-
158 run((prob_unsat('tofu',Prob),close_to(Prob,1.0))).
159test(e_uns_tof):-
160 run((unsat('tofu',Expl),
161 same_expl([Expl],[[disjointClasses([cheeseTopping, vegetableTopping]), subClassOf(soyCheeseTopping, cheeseTopping), subClassOf(soyCheeseTopping, vegetableTopping), subClassOf(tofu, soyCheeseTopping)]])
162 )).
163
164:- end_tests(trill_pizza). 165
166:- begin_tests(non_det, []). 167
168:- consult(library(examples/example_or_rule)). 169
170test(p_u_a):-
171 run((prob_unsat(a,Prob),close_to(Prob,0.03393568))).
172
173test(e_u_a):-
174 run((all_unsat(a,Expl),
175 same_expl(Expl,[
176 [subClassOf(a,intersectionOf([b,someValuesFrom(r,e)])),subClassOf(a,unionOf([complementOf(c),complementOf(d)])),subClassOf(b,intersectionOf([c,d]))],
177 [subClassOf(a,intersectionOf([b,someValuesFrom(r,e)])),subClassOf(a,unionOf([f,allValuesFrom(r,b)])),subClassOf(a,unionOf([complementOf(c),complementOf(f)])),subClassOf(b,complementOf(e)),subClassOf(b,intersectionOf([c,d]))],
178 [subClassOf(a,intersectionOf([b,someValuesFrom(r,e)])),subClassOf(a,unionOf([f,allValuesFrom(r,b)])),subClassOf(a,unionOf([intersectionOf([c,complementOf(c)]),complementOf(f)])),subClassOf(b,complementOf(e))],
179 [subClassOf(a,intersectionOf([b,someValuesFrom(r,e)])),subClassOf(a,unionOf([f,allValuesFrom(r,b)])),subClassOf(b,complementOf(e)),subClassOf(b,complementOf(f))],
180 [subClassOf(a,intersectionOf([b,someValuesFrom(r,e)])),subClassOf(b,complementOf(e)),subClassOf(b,intersectionOf([c,d])),subClassOf(c,intersectionOf([minCardinality(1,r),e]))]
181 ])
182 )).
183
184:- end_tests(non_det). 185
186:- begin_tests(non_det_max, []). 187
188:- consult(library(examples/example_max_rule)). 189
190test(e_i):-
191 run((all_inconsistent_theory(Expl),
192 same_expl(Expl,[[disjointClasses([b,e,f]),classAssertion(a,'1'),classAssertion(c,'3'),classAssertion(c,'4'),classAssertion(e,'3'),classAssertion(f,'4'),subClassOf(a,maxCardinality(1,s,c)),propertyAssertion(s,'1','3'),propertyAssertion(s,'1','4')],
193 [disjointClasses([b,e,f]),classAssertion(a,'1'),classAssertion(b,'2'),classAssertion(c,'2'),classAssertion(c,'4'),classAssertion(f,'4'),subClassOf(a,maxCardinality(1,s,c)),propertyAssertion(s,'1','2'),propertyAssertion(s,'1','4')],
194 [disjointClasses([b,e,f]),classAssertion(a,'1'),classAssertion(b,'2'),classAssertion(c,'2'),classAssertion(c,'3'),classAssertion(e,'3'),subClassOf(a,maxCardinality(1,s,c)),propertyAssertion(s,'1','2'),propertyAssertion(s,'1','3')]
195 ])
196 )).
197
198:- end_tests(non_det_max). 199
200
201:- begin_tests(local_cons, []). 202
203:- consult(library(examples/local_inconsistent_kb)). 204
205
208
213
214test(p_pv_3_4):-
215 run((prob_property_value(t,ind3,ind4,Prob),close_to(Prob,1.0))).
216
217test(e_pv_3_4):-
218 run((all_property_value(r,ind3,ind4,Expl),
219 same_expl(Expl,[[subPropertyOf(s, t), subPropertyOf(t, r), subPropertyOf(u, s), propertyAssertion(u, ind3, ind4)]])
220 )).
221
222test(p_i_x_4):-
223 run((prob_instanceOf(x,ind4,Prob),close_to(Prob,1.0))).
224
225test(e_i_x_4):-
226 run((all_instanceOf(x,ind4,Expl),
227 same_expl(Expl,[[classAssertion(a, ind3), subClassOf(a, allValuesFrom(r, x)), subPropertyOf(s, t), subPropertyOf(t, r), subPropertyOf(u, s), propertyAssertion(u, ind3, ind4)]])
228 )).
229
230:- end_tests(local_cons).