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    %trill_biopax_rdf,
    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
  206%test(p_in):-
  207%  run((prob_inconsistent_theory(Prob),close_to(Prob,1.0))).
  208
  209%test(e_in):-
  210%  run((all_inconsistent_theory(Expl),
  211%       same_expl(Expl,[[classAssertion(a, ind1),classAssertion(complementOf(x), ind2),subClassOf(a, allValuesFrom(r, x)),propertyAssertion(r, ind1, ind2)]])
  212%  )).
  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).