1:- module(test_trillp,
2 [test_trillp/0]). 3:- use_module(library(plunit)). 4
5test_trillp:-
6 trill:set_algorithm(trillp),
7 run_tests([trillp_biopax,
8 9 trillp_dbpedia,
10 trillp_brca,
11 trillp_commander,
12 trillp_johnEmployee,
13 trillp_peoplePets,
14 trillp_vicodi,
15 trillp_pizza,
16 non_det,
17 local_cons]).
18
19
20:- use_module(library(trill_test/trill_test)). 21
22:- begin_tests(trillp_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((instanceOf('WomanUnderLifetimeBRCRisk','Helen',Expl),
30 test_formula(Expl,+[*([subClassOf('Woman', 'WomanUnderLifetimeBRCRisk'), +[*([classAssertion('WomanAged3040', 'Helen'), +[*([equivalentClasses(['WomanUnderShortTermBRCRisk', intersectionOf(['Woman', someValuesFrom(hasRisk, 'ShortTermBRCRisk')])]), subClassOf('WomanAged3040', 'WomanUnderShortTermBRCRisk')]), subClassOf('WomanAged3040', 'Woman')]]), classAssertion('Woman', 'Helen'), *([classAssertion('PostmenopausalWoman', 'Helen'), subClassOf('PostmenopausalWoman', 'Woman')]), *([classAssertion('WomanTakingEstrogen', 'Helen'), subClassOf('WomanTakingEstrogen', 'Woman')])]])]))).
31test(p_wa_wulbrcr):-
32 run((prob_sub_class('WomanAged3040','WomanUnderLifetimeBRCRisk',Prob),close_to(Prob,0.123))).
33test(ne_wa_wulbrcr):-
34 run((sub_class('WomanAged3040','WomanUnderLifetimeBRCRisk',Expl),
35 test_formula(Expl,+[*([subClassOf('Woman', 'WomanUnderLifetimeBRCRisk'), +[*([equivalentClasses(['WomanUnderShortTermBRCRisk', intersectionOf(['Woman', someValuesFrom(hasRisk, 'ShortTermBRCRisk')])]), subClassOf('WomanAged3040', 'WomanUnderShortTermBRCRisk')]), subClassOf('WomanAged3040', 'Woman')]])]))).
36
37:- end_tests(trillp_brca). 38
39
40:- begin_tests(trillp_vicodi, []). 41
42:- consult(library(examples/vicodi)). 43
44test(p_r_avdpf):-
45 run((prob_instanceOf('vicodi:Role','vicodi:Anthony-van-Dyck-is-Painter-in-Flanders',Prob),close_to(Prob,0.27540000000000003))).
46test(p_p_r):-
47 run((prob_sub_class('vicodi:Painter','vicodi:Role',Prob),close_to(Prob,0.30600000000000005))).
48
49:- end_tests(trillp_vicodi). 50
51
52:- begin_tests(trillp_commander, []). 53
54:- consult(library(examples/commander)). 55
56test(e_c_j):-
57 run((instanceOf(commander,john,Expl),
58 test_formula(Expl,+[*([equivalentClasses([guard, soldier]), classAssertion(allValuesFrom(commands, guard), john), subClassOf(allValuesFrom(commands, soldier), commander)])])
59 )).
60
61:- end_tests(trillp_commander). 62
63
64:- begin_tests(trillp_peoplePets, []). 65
66:- consult(library(examples/peoplePets)). 67
68test(p_nl_k):-
69 run((prob_instanceOf('natureLover','Kevin',Prob),close_to(Prob,0.8696))).
70test(ne_nl_k):-
71 run((instanceOf('natureLover','Kevin',Expl),
72 test_formula(Expl,*([subClassOf(someValuesFrom('http://cohse.semanticweb.org/ontologies/people#has_animal','http://cohse.semanticweb.org/ontologies/people#pet'),'http://cohse.semanticweb.org/ontologies/people#natureLover'),+[*([classAssertion('http://cohse.semanticweb.org/ontologies/people#dog','http://cohse.semanticweb.org/ontologies/people#Spike'),inverseProperties('http://cohse.semanticweb.org/ontologies/people#has_animal','http://cohse.semanticweb.org/ontologies/people#is_animal_of'),subClassOf('http://cohse.semanticweb.org/ontologies/people#dog','http://cohse.semanticweb.org/ontologies/people#pet'),propertyAssertion('http://cohse.semanticweb.org/ontologies/people#is_animal_of','http://cohse.semanticweb.org/ontologies/people#Spike','http://cohse.semanticweb.org/ontologies/people#Kevin')]),*([subClassOf('http://cohse.semanticweb.org/ontologies/people#cat','http://cohse.semanticweb.org/ontologies/people#pet'),+[*([classAssertion('http://cohse.semanticweb.org/ontologies/people#cat','http://cohse.semanticweb.org/ontologies/people#Tom'),propertyAssertion('http://cohse.semanticweb.org/ontologies/people#has_animal','http://cohse.semanticweb.org/ontologies/people#Kevin','http://cohse.semanticweb.org/ontologies/people#Tom')]),*([classAssertion('http://cohse.semanticweb.org/ontologies/people#cat','http://cohse.semanticweb.org/ontologies/people#Fluffy'),propertyAssertion('http://cohse.semanticweb.org/ontologies/people#has_animal','http://cohse.semanticweb.org/ontologies/people#Kevin','http://cohse.semanticweb.org/ontologies/people#Fluffy')])]])]])))).
73
74:- end_tests(trillp_peoplePets). 75
76
77:- begin_tests(trillp_biopax, []). 78
79:- consult(library(examples/biopaxLevel3)). 80
81test(p_twbr_e):-
82 run((prob_sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',Prob),close_to(Prob,0.98))).
83
84:- end_tests(trillp_biopax). 85
86:- begin_tests(trillp_biopax_rdf, []). 87
88:- ensure_loaded(library(trill)). 89
90test(p_twbr_e):-
91 run((init_trill(trillp),load_owl_kb('../examples/biopaxLevel3_rdf.owl'),prob_sub_class('biopax:TransportWithBiochemicalReaction','biopax:Entity',Prob),close_to(Prob,0.98))).
92
93:- end_tests(trillp_biopax_rdf). 94
95
96:- begin_tests(trillp_dbpedia, []). 97
98:- consult(library('examples/DBPedia.pl')). 99
100test(p_p_pp):-
101 run((prob_sub_class('dbpedia:Place','dbpedia:PopulatedPlace',Prob),close_to(Prob,0.8273765902816))).
102test(ae_p_pp):-
103 run((sub_class('dbpedia:Place','dbpedia:PopulatedPlace',Expl),
104 test_formula(Expl,+[*([subClassOf('http://dbpedia.org/ontology/Place', 'http://dbpedia.org/ontology/Settlement'), +[*([equivalentClasses(['http://dbpedia.org/ontology/A0_144_', intersectionOf(['http://dbpedia.org/ontology/Place', 'http://dbpedia.org/ontology/PopulatedPlace'])]), subClassOf('http://dbpedia.org/ontology/Settlement', 'http://dbpedia.org/ontology/A0_144_')]), subClassOf('http://dbpedia.org/ontology/Settlement', 'http://dbpedia.org/ontology/PopulatedPlace')]]), subClassOf('http://dbpedia.org/ontology/Place', 'http://dbpedia.org/ontology/PopulatedPlace'), *([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_')])])
105 )).
106
107:- end_tests(trillp_dbpedia). 108
109
110:- begin_tests(trillp_johnEmployee, []). 111
112:- consult(library(examples/johnEmployee)). 113
114test(e_p_j):-
115 run((instanceOf('johnEmployee:person','johnEmployee:john',Expl),
116 test_formula(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')])])
117 )).
118
119:- end_tests(trillp_johnEmployee). 120
121:- begin_tests(trillp_pizza, []). 122
123:- consult(library(examples/pizza)). 124
125test(p_inc_kb):-
126 run_fail((prob_inconsistent_theory(_))).
127test(p_uns_tof):-
128 run((prob_unsat('tofu',Prob),close_to(Prob,1.0))).
129test(e_uns_tof):-
130 run((unsat('tofu',Expl),
131 test_formula(Expl,+[*([disjointClasses([cheeseTopping, vegetableTopping]), subClassOf(soyCheeseTopping, cheeseTopping), subClassOf(soyCheeseTopping, vegetableTopping), subClassOf(tofu, soyCheeseTopping)])])
132 )).
133
134:- end_tests(trillp_pizza). 135
136:- begin_tests(non_det, []). 137
138:- consult(library(examples/example_or_rule)). 139
140test(p_u_a):-
141 run((prob_unsat(a,Prob),close_to(Prob,0.03393568))).
142
143:- end_tests(non_det). 144
145
146:- begin_tests(local_cons, []). 147
148:- consult(library(examples/local_inconsistent_kb)). 149
150
153
158
159test(p_pv_3_4):-
160 run((prob_property_value(t,ind3,ind4,Prob),close_to(Prob,1.0))).
161
162test(e_pv_3_4):-
163 run((property_value(r,ind3,ind4,Expl),
164 test_formula(Expl,*([subPropertyOf(s, t), subPropertyOf(t, r), subPropertyOf(u, s), propertyAssertion(u, ind3, ind4)]))
165 )).
166
167test(p_i_x_4):-
168 run((prob_instanceOf(x,ind4,Prob),close_to(Prob,1.0))).
169
170test(e_i_x_4):-
171 run((instanceOf(x,ind4,Expl),
172 test_formula(Expl,*([classAssertion(a, ind3), subClassOf(a, allValuesFrom(r, x)), subPropertyOf(s, t), subPropertyOf(t, r), subPropertyOf(u, s), propertyAssertion(u, ind3, ind4)]))
173 )).
174
175:- end_tests(local_cons).