3/**********************************************************************
    4 *
    5 * @(#) examples.pl 1.4@(#)
    6 *
    7 */
    8
    9example(1) :-
   10	makeEnvironment('ex1','von HJO'),
   11	initEnvironment,
   12	defconcept(fatherAcademic,and([male,some(child,academic)])),
   13	defconcept(grandfatherAcademic,and([male,some(child,fatherAcademic)])),
   14	assert_ind(tom,tim,child),
   15	assert_ind(tim,mike,child),
   16	assert_ind(mike,male),
   17	assert_ind(mike,academic),
   18	assert_ind(tim,male),
   19	assert_ind(tom,male).
   20%%% Example  2:
   21%%% KRIS-Example
   22% setof(C,ask(elementOf(mary,C)),L)
   23% gives L = ['top',grandparent,parent,parent_with_sons_only,
   24%            parent_with_two_children,person] 
   25% in Total runtime 12.167 sec. (05.06.92)
   26example(2) :-
   27	makeEnvironment('ex2','krisExample'),
   28	initEnvironment,
   29	defprimconcept(male),
   30	defprimconcept(female,not(male)),
   31	defconcept(males,some(sex,male)),
   32	defconcept(females,some(sex,female)),
   33	defprimconcept(person,some(sex,or([male,female]))),
   34	defconcept(parent,and([person,some(child,person)])),
   35	defconcept(mother,and([parent,some(sex,female)])),
   36	defconcept(father,and([parent,not(mother)])),
   37	defconcept(grandparent,and([parent,some(child,parent)])),
   38	defconcept(parent_with_sons_only,and([parent,all(child,some(sex,male))])),
   39	defconcept(parent_with_two_children,and([parent,atleast(2,child)])),
   40	assert_ind(tom,father),
   41	assert_ind(tom,peter,child),
   42	assert_ind(tom,harry,child),
   43	assert_ind(mary,parent_with_sons_only),
   44	assert_ind(mary,tom,child),
   45	assert_ind(mary,chris,child).
   46%%% Example  3:
   47% inconsistent([])
   48% succeeds in Total runtime 0.000 sec. (05.06.92)
   49example(3) :-
   50	makeEnvironment('ex3','Inconsistence'),
   51	initEnvironment,
   52	defprimconcept(parent_with_one_child,atmost(1,child)),
   53	assert_ind(mary,parent_with_one_child),
   54	assert_ind(mary,tom,child),
   55	assert_ind(mary,chris,child).
   56%%% Example  4:
   57% Modal Operators
   58example(4) :-
   59	makeEnvironment('ex4','Inconsistence'),
   60	initEnvironment,
   61	defconcept([b(believe,a1)],c1,b(want,a2,car)),
   62	defconcept([b(believe,a1)],c2,b(want,a3,car)),
   63	defprimconcept([b(believe,a1)],c1,c2),
   64	assert_ind([b(believe,a1)],audi,c1).
   65%%% Example  5:
   66% subsumes([],c1,c2).
   67% fails    in Total runtime 0.050 sec. (05.06.92)
   68% subsumes([],c2,c1).
   69% succeeds in Total runtime 0.050 sec. (05.06.92)
   70example(5) :-
   71	makeEnvironment('ex5','Subsumption'),
   72	initEnvironment,
   73	defconcept(c1,and([all(r,a),all(and([r,q]),b)])),
   74	defconcept(c2,all(and([r,q]),and([a,b]))).
   75%%% Example  6:
   76% subsumes([],c1,c2).
   77% fails    in Total runtime 0.033 sec. (05.06.92)
   78% subsumes([],c2,c1).
   79% succeeds in Total runtime 0.033 sec. (05.06.92)
   80example(6) :-
   81	makeEnvironment('ex6','Subsumption'),
   82	initEnvironment,
   83	defrole(r1,and([r,q])),
   84	defconcept(d0,and([a,b])),
   85	defconcept(d1,all(r,a)),
   86	defconcept(d2,all(r1,b)),
   87	defconcept(c1,and([d1,d2])),
   88	defconcept(c2,all(r1,d0)).
   89%%% Example  7:
   90example(7) :-
   91	makeEnvironment('ex7','Subsumption'),
   92	initEnvironment,
   93	defconcept(c1,atleast(3,r)),
   94	defconcept(c2,and([all(and([r,p]),a),all(and([r,q]),not(a)),atleast(2,and([r,p])),atleast(2,and([r,q]))])).
   95%%% Example  8;
   96% ask(elementOf(tom,heterosexual))
   97% succeeds in Total runtime 0.033 sec. (05.06.92)
   98example(8) :-
   99	makeEnvironment('ex8','Disjunction of complementary concepts'),
  100	initEnvironment,
  101	defprimconcept(male),
  102	defconcept(female,not(male)),
  103	defconcept(heterosexual,or([male,female])).
  104%%% Example  9:
  105% Variation of the KRIS-Example
  106% ask(elementOf(chris,male))
  107% succeeds in Total runtime 0.000 sec. (05.06.92)
  108example(9) :-
  109	makeEnvironment('ex9','Variation of the KRIS example'),
  110	initEnvironment,
  111	defprimconcept(male),
  112	defprimconcept(female,not(male)),
  113	defprimconcept(person,or([male,female])),
  114	defconcept(parent,and([person,some(child,person)])),
  115	defconcept(mother,and([parent,female])),
  116	defconcept(father,and([parent,not(mother)])),
  117	defconcept(grandparent,and([parent,some(child,parent)])),
  118	defconcept(parent_with_sons_only,and([parent,all(child,male)])),
  119	defconcept(parent_with_two_children,and([parent,atleast(2,child)])),
  120	assert_ind(tom,father),
  121	assert_ind(tom,peter,child),
  122	assert_ind(tom,harry,child),
  123	assert_ind(mary,parent_with_sons_only),
  124	assert_ind(mary,tom,child),
  125	assert_ind(mary,chris,child).
  126%%% Example 10:
  127% ask(elementOf(tom,c2)) 
  128% succeeds in Total runtime 0.017 sec. (05.06.92)
  129example(10) :-
  130	makeEnvironment('ex10','Inverse Role'),
  131	initEnvironment,
  132	defrole(r2,inverse(r1)),
  133	defconcept(c1,all(r1,c2)),
  134	defconcept(c3,some(r2,c1)),
  135	assert_ind(tom,c3).
  136%%% Example 11:
  137% inconsistent([])
  138% succeeds in Total runtime 0.034 sec. (05.06.92)
  139example(11) :-
  140	makeEnvironment('ex11','Inconsistence'),
  141	initEnvironment,
  142	defconcept(c1,and([atleast(2,child),atmost(1,child)])),
  143	assert_ind(tom,c1).
  144%%% Example 12:
  145% subsumes([],c1,c2)
  146% succeeds in Total runtime 0.050 sec. (05.06.92)
  147% subsumes([],c2,c1)
  148% fails    in Total runtime 0.200 sec. (05.06.92)
  149example(12) :-
  150	makeEnvironment('ex12','Subsumption'),
  151	initEnvironment,
  152	defconcept(c1,and([person,atleast(2,child)])),
  153	defconcept(c2,and([person,atleast(3,restr(child,lawyer))])).
  154%%% Example 13:
  155% subsumes([],c1,c2)
  156% succeeds in Total runtime 0.117 sec. (05.06.92)
  157example(13) :-
  158	makeEnvironment('ex13','Subsumption'),
  159	initEnvironment,
  160	defconcept(c1,and([person,atmost(4,restr(child,doctor))])),
  161	defconcept(c2,and([person,female,atmost(3,child)])).
  162%%% Example 14:
  163% subsumes([],c1,c2)
  164% succeeds ???
  165% subsumes([],c2,c1)
  166% succeeds in Total runtime 0.250 sec. (06.06.92)
  167example(14) :-
  168	makeEnvironment('ex14','Subsumption'),
  169	initEnvironment,
  170	defconcept(c1,atmost(0,restr(r,and([atleast(3,s1),atleast(4,s2)])))),
  171	defconcept(c2,all(restr(r,atleast(2,s1)),atmost(2,s2))).
  172%%% Example 15:
  173% subsumes([],c2,c1)
  174% succeeds in Total runtime 0.067 sec. (05.06.92)
  175example(15) :-
  176	makeEnvironment('ex15','Subsumption'),
  177	initEnvironment,
  178	defconcept(c1,and([person,all(friend,doctor),all(restr(friend,doctor),atleast(1,speciality))])),
  179	defconcept(c2,and([person,all(friend,atleast(1,speciality))])).
  180%%% Example 16:
  181% subsumes([],c2,c1)
  182% succeeds in Total runtime 0.450 sec. (06.06.92)
  183example(16) :-
  184	makeEnvironment('ex16','Subsumption'),
  185	initEnvironment,
  186	defconcept(c1,and([atleast(1,restr(child,lawyer)),atleast(1,restr(child,doctor))])),
  187	defconcept(c2,or([atleast(2,child),atleast(1,restr(child,and([lawyer,doctor])))])).
  188%%% Example 17:
  189% subsumes([],c2,c1)
  190% succeeds in Total runtime 0.034 sec. (05.06.92)
  191example(17) :-
  192	makeEnvironment('ex17','Subsumption'),
  193	initEnvironment,
  194	defconcept(c1,some(and([child,friend]),doctor)),
  195	defconcept(c2,and([some(child,doctor),some(friend,doctor)])).
  196%%% Example 18:
  197% ask(elementOf(mary,c4))
  198% succeeds in Total runtime 0.117 sec. (05.06.92)
  199example(18) :-
  200	makeEnvironment('ex18','Number restrictions'),
  201	initEnvironment,
  202	defprimconcept(female),
  203	defconcept(male,not(female)),
  204	defconcept(c3,and([atmost(4,child),atleast(2,restr(child,female))])),
  205	defconcept(c4,atmost(2,restr(child,female))),
  206	assert_ind(tom,male),
  207	assert_ind(peter,male),
  208	assert_ind(mary,peter,child),
  209	assert_ind(mary,tom,child),
  210	assert_ind(mary,c3).
  211%%% Example 19
  212% ask(elementOf(amy,female))
  213% succeeds in Total runtime 0.067 sec. (06.06.92)
  214example(19) :-
  215	makeEnvironment('ex19','Number restrictions'),
  216	initEnvironment,
  217	defprimconcept(female),
  218	defconcept(male,not(female)),
  219	defconcept(c5,and([atmost(2,restr(child,male))])),
  220	assert_ind(tom,male),
  221	assert_ind(peter,male),
  222	assert_ind(mary,tom,child),
  223	assert_ind(mary,peter,child),
  224	assert_ind(mary,amy,child),
  225	assert_ind(mary,c5).
  226%%% Example 20
  227% inconsistent([])
  228% succeeds in Total runtime 5.167 sec. (05.06.92)
  229example(20) :-
  230	makeEnvironment('ex20','Number restrictions'),
  231	initEnvironment,
  232	defprimconcept(female),
  233	defconcept(male,not(female)),
  234	defconcept(c5,and([atmost(2,restr(child,male)),atmost(1,restr(child,female))])),
  235	assert_ind(tom,male),
  236	assert_ind(peter,male),
  237	assert_ind(mary,tom,child),
  238	assert_ind(mary,peter,child),
  239	assert_ind(mary,amy,child),
  240	assert_ind(mary,jane,child),
  241	assert_ind(mary,c5).
  242%%% Example 21
  243% ask(elementOf(betty,female))
  244example(21) :-
  245	makeEnvironment('ex21','Number restrictions'),
  246	initEnvironment,
  247	defprimconcept(female),
  248	defconcept(male,not(female)),
  249	defconcept(c1,and([atmost(1,restr(teacher,male)),atmost(1,restr(teacher,female))])),
  250	defconcept(c2,and([atmost(2,restr(teacher,male)),atmost(1,restr(teacher,female))])),
  251	assert_ind(tom,c1),
  252	assert_ind(sue,c1),
  253	assert_ind(david,c2),
  254	assert_ind(tom,betty,teacher),
  255	assert_ind(tom,peter,teacher),
  256	assert_ind(sue,betty,teacher),
  257	assert_ind(sue,chris,teacher),
  258	assert_ind(david,betty,teacher),
  259	assert_ind(david,chris,teacher),
  260	assert_ind(david,peter,teacher).
  261%%% Example 22
  262% ask(elementOf(amy,female))
  263% should succeeds
  264% but fails in the current implementation
  265example(22) :-
  266	makeEnvironment('ex22','Number restrictions'),
  267	initEnvironment,
  268	defprimconcept(female),
  269	defconcept(male,not(female)),
  270	defrole(maleTeacher,restr(teacher,male)),
  271	defrole(femaleTeacher,restr(teacher,female)),
  272	defconcept(c1,and([atmost(1,maleTeacher),atmost(1,femaleTeacher)])),
  273	defconcept(c2,atmost(1,maleTeacher)),
  274	assert_ind(tom,c2),
  275	assert_ind(sue,c1),
  276	assert_ind(tom,betty,teacher),
  277	assert_ind(tom,chris,teacher),
  278	assert_ind(tom,robin,teacher),
  279	assert_ind(sue,betty,teacher),
  280	assert_ind(sue,chris,teacher).
  281%%% Example 23
  282% is a variant of example 23 with user provided names for the 
  283% restricted roles.
  284% ask(elementOf(amy,female))
  285% should succeeds
  286% but fails in the current implementation
  287example(23) :-
  288	makeEnvironment('ex23','Number restrictions'),
  289	initEnvironment,
  290	defprimconcept(female),
  291	defconcept(male,not(female)),
  292	defprimrole(maleTeacher,teacher),
  293	defprimrole(femaleTeacher,teacher),
  294	defconcept(c1,and([atmost(1,maleTeacher),atmost(1,femaleTeacher)])),
  295	defconcept(c2,atmost(1,maleTeacher)),
  296	assert_ind(tom,c2),
  297	assert_ind(sue,c1),
  298	assert_ind(tom,betty,teacher),
  299	assert_ind(tom,chris,teacher),
  300	assert_ind(tom,robin,teacher),
  301	assert_ind(sue,betty,teacher),
  302	assert_ind(sue,chris,teacher).
  303%%% Example 24
  304% ask(elementOf(audi,c3))
  305% succeeds in Total runtime 1.634 sec. (24.06.92)
  306example(24) :-
  307	makeEnvironment('ex24','Modal operators'),
  308	initEnvironment,	
  309	modalAxioms(kd45,believe,a1),
  310	defconcept(c1,b(believe,a1,auto)),
  311	defconcept(c3,b(believe,a1,c1)),
  312	defconcept([b(believe,a1)],c1,b(believe,a1,auto)),
  313	defconcept([b(believe,a1)],c3,b(believe,a1,c1)),
  314	assert_ind(audi,c1).
  315%%% Example 25
  316% not(ask(elementOf(audi,c3)))
  317% succeeds in Total runtime 0.033 sec. (24.06.92)
  318example(25) :-
  319	makeEnvironment('ex25','Modal operators'),
  320	initEnvironment,	
  321	modalAxioms(kd45,believe,a1),
  322	defconcept([b(believe,a1)],c1,b(believe,a1,auto)),
  323	defconcept([b(believe,a1)],c3,b(believe,a1,c1)),
  324	assert_ind(audi,c1).
  325%%% Example 26
  326% subsumes([],c2,c1)
  327% succeeds in Total runtime 0.034 sec. (24.06.92)
  328% not(subsumes([],c1,c2))
  329% succeeds in Total runtime 1.333 sec. (24.06.92)
  330example(26) :-
  331	makeEnvironment('ex27','Subsumption'),
  332	initEnvironment,
  333	defconcept(c1,atmost(0,r)),
  334	defconcept(c2,all(r,c5)).
  335%%% Example 27
  336% subsumes([],c2,c1) 
  337% succeeds in Total runtime 0.067 sec. (24.06.92)
  338% not(subsumes([],c1,c2))
  339% succeeds
  340example(27) :-
  341	makeEnvironment('ex28','Subsumption'),
  342	initEnvironment,
  343	defconcept(c1,not(some(r,'top'))),
  344	defconcept(c2,all(r,c5)).
  345%%% Example 28
  346% ask(ex28,[b(believe,john)],elementOf(audi,auto),P)
  347% succeeds
  348example(28) :-
  349	makeEnvironment('ex28','Modal operators'),
  350	initEnvironment,	
  351	modalAxioms(kd45,believe,a1),
  352	modalAxioms(kd45,believe,all),
  353	defprimconcept(auto),
  354	assert_ind([b(believe,all)],audi,auto).
  355%%% Example 29
  356% is a variant of example 23 with a more restricted definition of c1
  357% ask(elementOf(amy,female))
  358% should succeeds
  359% but fails in the current implementation
  360example(29) :-
  361	makeEnvironment('ex29','Number restrictions'),
  362	initEnvironment,
  363	defprimconcept(female),
  364	defconcept(male,not(female)),
  365	defprimrole(teacher),
  366	defrole(maleTeacher,restr(teacher,male)),
  367	defrole(femaleTeacher,restr(teacher,female)),
  368	defconcept(c1,and([atmost(1,maleTeacher),atmost(2,femaleTeacher)])),
  369	assert_ind(tom,c1),
  370	assert_ind(sue,c1),
  371	assert_ind(tom,betty,teacher),
  372	assert_ind(tom,chris,teacher),
  373	assert_ind(tom,robin,teacher),
  374	assert_ind(sue,betty,teacher),
  375	assert_ind(sue,chris,teacher).
  376example(30) :-
  377	makeEnvironment('ex30','Number restrictions'),
  378	initEnvironment,
  379	defprimconcept(female),
  380	defrole(maleTeacher,restr(teacher,not(female))),
  381	defrole(femaleTeacher,restr(teacher,female)),
  382	defconcept(c1,and([atmost(1,maleTeacher),atmost(1,femaleTeacher)])),
  383	defconcept(c2,atmost(1,maleTeacher)),
  384	assert_ind(tom,c2),
  385	assert_ind(sue,c1),
  386	assert_ind(tom,betty,teacher),
  387	assert_ind(tom,chris,teacher),
  388	assert_ind(tom,robin,teacher),
  389	assert_ind(sue,betty,teacher),
  390	assert_ind(sue,chris,teacher).
  391%%% Example 31
  392% First test example for defclosed
  393% ask(elementOf(tom,onlyMaleChildren))
  394% succeeds
  395example(31) :-
  396	makeEnvironment('ex31','defclosed'),
  397	initEnvironment,
  398	defconcept(onlyMaleChildren,all(child,male)),
  399	assert_ind(tom,peter,child),
  400	assert_ind(tom,chris,child),
  401	assert_ind(tom,tim,child),
  402	assert_ind(peter,male),
  403	assert_ind(chris,male),
  404	assert_ind(tim,male),
  405	defclosed(tom,_Y,child).
  406%%% Example 32
  407% First test example for abduction
  408% abduce(elementOf(robin,male),H,E)
  409% abduce(elementOf(robin,female),H,E)
  410example(32) :-
  411	makeEnvironment('ex32','abduction'),
  412	initEnvironment,
  413	defconcept(male,not(female)).
  414%%% Example 33
  415% Second test example for abduction
  416% abduce(elementOf(nixon,dove),H,E)
  417% abduce(elementOf(nixon,hawk),H,E)
  418% gives unexpected results!!!
  419example(33) :-
  420	makeEnvironment('ex33','abduction'),
  421	initEnvironment,
  422	defconcept(c1,and([quaker,normalQuaker])),
  423	defconcept(c2,and([republican,normalRepublican])),
  424	defprimconcept(c1,dove),
  425	defprimconcept(c2,hawk),
  426	assert_ind(nixon,quaker),
  427	assert_ind(nixon,republican).
  428%%% Example 34
  429% The following gives an inconsistent specification of
  430% the penguin - bird problem. So
  431% inconsistent(ex34)
  432% succeeds
  433example(34) :-
  434	makeEnvironment('ex34',abduction),
  435	initEnvironment,
  436	defprimconcept(penguin,and([bird,not(fly)])),
  437	defprimconcept(bird,fly),
  438	assert_ind(tweety,penguin),
  439	assert_ind(john,bird).
  440%%% Example 35
  441% This is a consistent specification of the penguin - bird problem.
  442% abduce(ex35,[],elementOf(john,fly),H,E).
  443% succeeds with
  444% H = [in(env(e1),rn(_7982,_7983,_7984,_7985),modal([]),normalBird,john,
  445%         hyp(_7989),ab(_7991),call(_7993),
  446%         proved(in([],normalBird,john),hyp(_7989),basedOn(_8005)))],
  447% E = proved(in([],fly,john),hyp([]),
  448%            basedOn(and([proved(in([],bird,john),hyp([]),basedOn(abox)),
  449%                         proved(in([],normalBird,john),hyp([]),
  450%     basedOn(usingAbHyp(in(env(e1),rn(_7525,_7526,_7527,_7528),modal([]),
  451%                           normalBird,john,hyp(_7532),ab(_7534),call(_7536),
  452%                           proved(in([],normalBird,john),hyp(_7532),
  453%                           basedOn(_7548))))))])))
  454% and
  455% abduce(ex35,[],elementOf(tweety,fly),H,E).
  456% fails
  457example(35) :-
  458	makeEnvironment('ex35',abduction),
  459	initEnvironment,
  460	defprimconcept(penguin,and([bird,not(normalBird)])),
  461	defprimconcept(and([bird,normalBird]),fly),
  462	assert_ind(tweety,penguin),
  463	assert_ind(john,bird).
  464%%% Example 36
  465% Variant of example 33 giving the expected results:
  466% abduce(ex36,[],elementOf(nixon,dove),H,E).
  467% succeeds with
  468% H = [in(env(e4),rn(_8077,_8078,_8079,_8080),modal([]),
  469%         normalQuaker,nixon,hyp(_8084),ab(_8086),call(_8088),
  470%         proved(in([],normalQuaker,nixon),hyp(_8084),basedOn(_8100)))],
  471% E = proved(in([],dove,nixon),hyp([]),
  472%        basedOn(and([proved(in([],quaker,nixon),hyp([]),basedOn(abox)),
  473%                     proved(in([],normalQuaker,nixon),hyp([]),
  474%           basedOn(usingAbHyp(in(env(e4),rn(_7620,_7621,_7622,_7623),
  475%                   modal([]),normalQuaker,nixon,hyp(_7627),ab(_7629),
  476%                   call(_7631),proved(in([],normalQuaker,nixon),
  477%                   hyp(_7627),basedOn(_7643))))))]))) 
  478% and
  479% abduce(ex36,[],elementOf(nixon,hawk),H,E).
  480% succeeds with
  481% H = [in(env(e4),rn(_8077,_8078,_8079,_8080),modal([]),
  482%         normalRepublican,nixon, hyp(_8084),ab(_8086),call(_8088),
  483%         proved(in([],normalRepublican,nixon),hyp(_8084),basedOn(_8100)))],
  484% E = proved(in([],dove,nixon),hyp([]),
  485%        basedOn(and([proved(in([],republican,nixon),hyp([]),basedOn(abox)),
  486%                     proved(in([],normalRepublican,nixon),hyp([]),
  487%           basedOn(usingAbHyp(in(env(e4),rn(_7620,_7621,_7622,_7623),
  488%                   modal([]),normalRepublican,nixon,hyp(_7627),ab(_7629),
  489%                   call(_7631),proved(in([],normalRepublican,nixon),
  490%                   hyp(_7627),basedOn(_7643))))))]))) 
  491example(36) :-
  492	makeEnvironment('ex36','abduction'),
  493	initEnvironment,
  494	defprimconcept(and([quaker,normalQuaker]),dove),
  495	defprimconcept(and([republican,normalRepublican]),hawk),
  496	assert_ind(nixon,quaker),
  497	assert_ind(nixon,republican).
  498%%% Example 37
  499example(37) :-
  500	makeEnvironment('ex37','abduction'),
  501	initEnvironment,
  502	defprimconcept(rained_last_night,grass_is_wet),
  503	defprimconcept(sprinkler_was_on,grass_is_wet),
  504	defprimconcept(grass_is_wet,shoes_are_wet).
  505%%% Example 38
  506% ask(elementOf(ideaste,c2))
  507% should succeed
  508example(38) :-
  509	makeEnvironment('ex38','disjunctive_information'),
  510	initEnvironment,
  511	assert_ind(ideaste,oedipus,hasChild),
  512	assert_ind(oedipus,polyneikes,hasChild),
  513	assert_ind(ideaste,polyneikes,hasChild),
  514	assert_ind(polyneikes,thersandros,hasChild),
  515	assert_ind(oedipus,fatherMurderer),
  516	assert_ind(thersandros,not(fatherMurderer)),
  517	defconcept(c1,and([fatherMurderer,some(hasChild,not(fatherMurderer))])),
  518	defconcept(c2,some(hasChild,c1)).
  519%%% Example 39
  520% ask(elementOf(lucky,female))
  521% succeeds
  522example(39) :-
  523	makeEnvironment('ex39','negation_as_failure'),
  524	initEnvironment,
  525	defrole(parentOf,inverse(childOf)),
  526	defconcept(male,not(female)),
  527	defprimconcept(and([some(parentOf,top),naf(not(female))]),female),
  528	assert_ind(mary,lucky,childOf).
  529%%% Example 40
  530% ask(elementOf(peter,richPerson))
  531% succeeds.
  532% After
  533% assert_ind(peter,poorPerson)
  534% the query
  535% ask(elementOf(peter,richPerson))
  536% fails
  537example(40) :-
  538	makeEnvironment('ex40','negation_as_failure'),
  539	initEnvironment,
  540	defprimconcept(and([doctor,naf(not(richPerson))]),richPerson),
  541	defconcept(poorPerson,not(richPerson)),
  542	assert_ind(peter,doctor).
  543%%% Example 41
  544% ask(elementOf(tom,richPerson))
  545% succeeds.
  546% After 
  547% assert_ind(tom,poorPerson)
  548% the query
  549% ask(elementOf(tom,richPerson))
  550% fails
  551example(41) :-
  552	makeEnvironment('ex41','negation_as_failure'),
  553	initEnvironment,
  554	defrole(doctorParentOf,restr(inverse(childOf),doctor)),
  555	defrole(childOfDoctor,inverse(r1)),
  556	defprimconcept(and([some(doctorParentOf,top),naf(not(richPerson))]),richPerson),
  557	defconcept(poorPerson,not(richPerson)),
  558	assert_ind(chris,doctor),
  559	assert_ind(chris,tom,childOf).
  560%%% Example 42
  561% ask(elementOf(audi,fourWheels))
  562% succeeds.
  563% After
  564% assert_ind(audi,fiveWheels)
  565% the query
  566% ask(elementOf(audi,fourWheels))
  567% fails
  568example(42) :-
  569	makeEnvironment('ex42','negation_as_failure'),
  570	initEnvironment,
  571	defconcept(fourWheels,and([atleast(4,wheels),atmost(4,wheels)])),
  572	defconcept(fiveWheels,and([atleast(5,wheels),atmost(5,wheels)])),
  573	defprimconcept(and([car,naf(not(fourWheels))]),fourWheels),
  574	assert_ind(audi,car).
  575%%% Example 43
  576example(43) :-
  577	makeEnvironment('ex43','concrete_domains'),
  578	initEnvironment,
  579	defconcept(colors,set([b,y,r])),
  580	defconcept(blueOrYellow,set([b,y])),
  581	defconcept(red,set([r])),
  582	defconcept(blue,set([b])),
  583	defconcept(yellow,set([y])),
  584	defconcept(redOrYellow,set([r,y])),
  585	defconcept(blueOrRed,set([b,r])),
  586	defconcept(yellowOrBlue,set([y,b])).
  587%%% Example 44
  588% subsumes(c2,c1)
  589% should succeed
  590example(44) :-
  591	makeEnvironment('ex44','concrete_domains'),
  592	initEnvironment,
  593	defconcept(c1,set([a,b])),
  594	defconcept(c2,set([a,b,c])).
  595%%% Example 45
  596example(45) :-
  597	makeEnvironment('ex45','concrete_domains'),
  598	initEnvironment,
  599	defconcept(c1,set([a,b,c])),
  600	defconcept(c2,set([a,b])),
  601	defconcept(nc2,not(c2)).
  602%%% Example 46
  603% An insufficient specification of 
  604% The bmw is either yellow, blue, or red but not yellow. 
  605% ask(elementOf(bmw,c3))
  606% fails
  607example(46) :-
  608	makeEnvironment('ex46','concrete_domains'),
  609	initEnvironment,
  610	defconcept(c1,some(hasCol,set([yellow,blue,red]))),
  611	defconcept(c2,some(hasCol,not(set([yellow])))),
  612	defconcept(c3,some(hasCol,set([blue,red]))),
  613	assert_ind(bmw,c1),
  614	assert_ind(bmw,c2).
  615%%% Example 47
  616% A correct specification of
  617% The bmw is either yellow, blue, or red but not yellow. 
  618% ask(elementOf(bmw,c3))
  619% succeeds
  620example(47) :-
  621	makeEnvironment('ex47','concrete_domains'),
  622	initEnvironment,
  623	defconcept(c1,and([some(hasCol,set([yellow,blue,red])),all(hasCol,set([yellow,blue,red]))])),
  624	defconcept(c2,some(hasCol,not(set([yellow])))),
  625	defconcept(c3,some(hasCol,set([blue,red]))),
  626	assert_ind(bmw,c1),
  627	assert_ind(bmw,c2).
  628example(48) :-
  629	makeEnvironment('ex48','concrete_concepts'),
  630	initEnvironment,
  631	defconcept(oneSpouse,and([atleast(1,spouse),atmost(1,spouse)])),
  632	assert_ind(m1,oneSpouse),
  633	defprimconcept(some(inverse(spouse),set([m1])),set([g0,g1,g2])),
  634	assert_ind(g0,oneSpouse),
  635	defprimconcept(some(inverse(spouse),set([g0])),set([m1,g1,g2])),
  636	assert_ind(g1,oneSpouse),
  637	defprimconcept(some(inverse(spouse),set([g1])),set([m1,g0,g2])),
  638	assert_ind(g2,oneSpouse),
  639	defprimconcept(some(inverse(spouse),set([g2])),set([m1,g0,g1])),
  640	defconcept(zeroSH,and([atleast(0,sh),atmost(0,sh)])),
  641	defconcept(oneSH,and([atleast(1,sh),atmost(1,sh)])),
  642	defconcept(twoSH,and([atleast(2,sh),atmost(2,sh)])),
  643	assert_ind(g0,zeroSH),
  644	assert_ind(g1,oneSH),
  645	assert_ind(g2,twoSH),
  646	defprimconcept(and([some(inverse(sh),set([m1])),set([m1])]),bot),
  647	defprimconcept(and([some(inverse(sh),set([g0])),set([g0])]),bot),
  648	defprimconcept(and([some(inverse(sh),set([g1])),set([g1])]),bot),
  649	defprimconcept(and([some(inverse(sh),set([g2])),set([g2])]),bot),
  650	defprimconcept(and([some(inverse(spouse),set([m1])),some(inverse(sh),set([m1]))]),bot),
  651	defprimconcept(and([some(inverse(spouse),set([g0])),some(inverse(sh),set([g0]))]),bot),
  652	defprimconcept(and([some(inverse(spouse),set([g1])),some(inverse(sh),set([g1]))]),bot),
  653	defprimconcept(and([some(inverse(spouse),set([g2])),some(inverse(sh),set([g2]))]),bot),
  654%	defconcept(some(sh,set([m1])),some(inverse(sh),set([m1]))),
  655%	defconcept(some(sh,set([g0])),some(inverse(sh),set([g0]))),
  656%	defconcept(some(sh,set([g1])),some(inverse(sh),set([g1]))),
  657%	defconcept(some(sh,set([g2])),some(inverse(sh),set([g2]))).
  658	defrole(sh,inverse(sh)),
  659	defrole(spouse,inverse(spouse)).
  660%%% Example 49
  661% ask(elementOf(p,c4))
  662% should fail
  663example(49) :-
  664	makeEnvironment('ex49','defaults'),
  665	initEnvironment,
  666	defconcept(c4,and([c5,c6])),
  667	defprimconcept(and([c0,naf(not(c2))]),c5),
  668	defprimconcept(and([c0,naf(not(c3))]),c6),
  669	defconcept(c1,or([not(c2),not(c3)])),
  670	assert_ind(p,c0),
  671	assert_ind(p,c1).
  672example(50) :-
  673	makeEnvironment('ex50','complete_or'),
  674	initEnvironment,
  675	defprimconcept(c1,c0),
  676	defprimconcept(not(c1),c0).
  677example(51) :-
  678	makeEnvironment('ex51','functional_dependencies'),
  679	initEnvironment,
  680	def(posInfl(f,d)),
  681	def(posInfl(h,f)),
  682	def(posInfl(a,b)),
  683	def(posInfl(b,c)),
  684	def(posInfl(c,d)),
  685	def(negInfl(b,e)),
  686	def(negInfl(e,d)),
  687	def(posInfl(g,e)),
  688	def(posInfl(a,g)),
  689	def(increase(a)).
  690example(52) :-
  691	makeEnvironment('ex52','functional_dependencies'),
  692	initEnvironment,
  693	def(increase(hasCubicCapacity)),
  694	def(negInfl(withRebate,hasPrice)),
  695	def(posInfl(hasPrice,hasOverallCost)),
  696	def(posInfl(hasCubicCapacity,hasListPrice)),
  697	def(posInfl(hasListPrice,hasPrice)),
  698	def(posInfl(hasCubicCapacity,hasFuelConsumption)),
  699	def(posInfl(hasFuelConsumption,hasOverallCost)),
  700	def(posInfl(hasCubicCapacity,hasMaxSpeed)),
  701	def(negInfl(hasCatConverter,hasMaxSpeed)),
  702	def(posInfl(hasCatConverter,hasFuelConsumption)),
  703	def(posInfl(hasCubicCapacity,hasWeight)),
  704	def(negInfl(hasWeight,hasMaxSpeed)).
  705example(53) :-
  706	makeEnvironment('ex53','functional_dependencies'),
  707	initEnvironment,
  708	def(increase(hasCubicCapacity)),
  709	def(infl(withRebate,hasPrice,-1.0)),
  710	def(infl(hasPrice,hasOverallCost,1.0)),
  711	def(infl(hasCubicCapacity,hasListPrice,1.2)),
  712	def(infl(hasListPrice,hasPrice,1.0)),
  713	def(infl(hasCubicCapacity,hasFuelConsumption,0.8)),
  714	def(infl(hasFuelConsumption,hasOverallCost,1.0)),
  715	def(infl(hasCubicCapacity,hasHorsePower,1.0)),
  716	def(infl(hasHorsePower,hasFuelConsumption,1.0)),
  717	def(infl(hasHorsePower,hasMaxSpeed,1.0)),
  718	def(infl(hasFuelType,hasMaxSpeed,0.8)),
  719	def(infl(hasCatConverter,hasHorsePower,-0.5)),
  720	def(infl(hasCubicCapacity,hasWeight,0.5)),
  721	def(infl(hasWeight,hasHorsePower,-1.0)).
  722example(54) :-
  723	makeEnvironment('ex54','functional_dependencies'),
  724	initEnvironment,
  725	def(negInfl(a,b)),
  726	def(posInfl(b,e)),
  727	def(posInfl(e,d)),
  728	def(negInfl(g,e)),
  729	def(negInfl(a,g)).
  730%
  731%	Apart from the notation identical to ex54.
  732%
  733example(55) :-
  734	makeEnvironment('ex55','functional_dependencies'),
  735	initEnvironment,
  736	def(infl(a,b,1.0)),
  737	def(infl(b,e,1.0)),
  738	def(infl(e,d,1.0)),
  739	def(infl(g,e,1.0)),
  740	def(infl(a,g,-1.0)).
  741example(56) :-
  742	makeEnvironment('ex56','functional_dependencies'),
  743	initEnvironment,
  744	def(infl(a,b,1.0)),
  745	def(infl(b,e,1.0)),
  746	def(infl(e,d,1.0)),
  747	def(infl(g,e,1.0)),
  748	def(infl(a,g,-1.0)),
  749	def(infl(f,g,0.5)),
  750	def(infl(f,h,-0.5)),
  751	def(infl(h,d,0.3)).
  752example(57) :-
  753	makeEnvironment('ex57','functional_dependencies'),
  754	initEnvironment,
  755	def(posInfl(a,b)),
  756	def(posInfl(b,c)),
  757	def(posInfl(c,d)).
  758example(58) :- 
  759	makeEnvironment('ex58','functional_dependencies'),
  760	initEnvironment,
  761	def(posInfl(a,b)),
  762	def(posInfl(b,c)),
  763	def(posInfl(c,d)),
  764	def(infl(e,b,-1.0)),
  765	def(infl(e,c,0.5)).
  766example(59) :-
  767	sb_defenv('mybox','sb.lit'),
  768	sb_initenv,
  769	sb_primconcept(person),
  770	sb_primconcept(woman,[supers([person])]),
  771	sb_primconcept(man,[supers([person])]),
  772	sb_disjoint(man,woman),
  773	sb_primelemrole(child,'domain-range'(parent,person,person)),
  774	sb_defconcept(parent,[supers([person]),
  775                              nr(child,1,30,2)]),
  776	sb_defconcept(mother,[supers([parent,woman])]),
  777	sb_defconcept(father,[supers([parent,man])]),
  778	sb_defconcept(granni,[supers([grandparent,mother])]),
  779	sb_defelem(harry,[isa(parent)]),
  780	sb_defelem(mary,[isa(mother), 
  781                         irole(child, 
  782                               iname('marys-child'),
  783                               [nr(1,30,2), vr(harry)])]).
  784example(60) :-
  785	makeEnvironment('ex60','Modal operators'),
  786	initEnvironment,	
  787	modalAxioms(kd45,believe,peter),
  788	defprimconcept([b(believe,peter)],doctor,richPerson),
  789	assert_ind([b(believe,peter)],tom,doctor).
  790
  791
  792
  793
  794
  795
  796
  797
  798
  799
  800
  801
  802
  803
  804
  805
  806
  807
  808
  809
  810
  811
  812
  813
  814
  815
  816
  817
  818testMotelExample(1) :-	
  819	no_goal.
  820testMotelExample(2) :-
  821	printTime(setof(C,E^deduce(ex2,[],elementOf(mary,C),E),L1)), print(L1), nl,
  822	printTime(setof(D,F^deduce(ex2,[],elementOf(tom,D),F),L2)), print(L2), nl.
  823testMotelExample(3) :-
  824	tryGoal(inconsistent(ex3)).
  825testMotelExample(4) :-
  826	no_goal.
  827testMotelExample(5) :-
  828	tryGoal(not(subsumes([],c1,c2))),
  829	tryGoal(subsumes([],c2,c1)).
  830testMotelExample(6) :-
  831	tryGoal(not(subsumes([],c1,c2))),
  832	tryGoal(subsumes([],c2,c1)).
  833testMotelExample(7) :-
  834	no_goal.
  835testMotelExample(8) :-
  836	tryGoal(deduce(elementOf(tom,heterosexual))).
  837testMotelExample(9) :-
  838	tryGoal(deduce(elementOf(chris,male))).
  839testMotelExample(10) :-
  840	tryGoal(deduce(elementOf(tom,c2))).
  841testMotelExample(11) :-
  842	tryGoal(inconsistent(ex11)).
  843testMotelExample(12) :-
  844	tryGoal(subsumes([],c1,c2)),
  845	tryGoal(not(subsumes([],c2,c1))).
  846testMotelExample(13) :-
  847	tryGoal(subsumes([],c1,c2)).
  848testMotelExample(14) :-
  849%	initializeMotel, print('Example 14'), nl, example(14),
  850%	tryGoal(subsumes([],c2,c1)),
  851	!.
  852testMotelExample(15) :-
  853	tryGoal(subsumes([],c2,c1)).
  854testMotelExample(16) :-
  855	tryGoal(subsumes([],c2,c1)).
  856testMotelExample(17) :-
  857	tryGoal(subsumes([],c2,c1)).
  858testMotelExample(18) :-
  859	tryGoal(deduce(elementOf(mary,c4))).
  860testMotelExample(19) :-
  861	tryGoal(deduce(elementOf(amy,female))).
  862testMotelExample(20) :-
  863	tryGoal(inconsistent(ex20)).
  864testMotelExample(21) :-
  865	no_goal,
  866% 	deduce(elementOf(betty,female)),
  867	!.
  868testMotelExample(22) :-
  869% 	deduce(elementOf(amy,female)),
  870	no_goal.
  871testMotelExample(23) :-
  872% 	deduce(elementOf(amy,female))
  873	no_goal.
  874testMotelExample(24) :-
  875	tryGoal(deduce(elementOf(audi,c3))).
  876testMotelExample(25) :-
  877	tryGoal(not(deduce(elementOf(audi,c3)))).
  878testMotelExample(26) :-
  879	tryGoal(not(subsumes([],c1,c2))),
  880	tryGoal(subsumes([],c2,c1)).
  881testMotelExample(27) :-
  882	tryGoal(not(subsumes([],c1,c2))),
  883	tryGoal(subsumes([],c2,c1)).
  884testMotelExample(28) :-
  885	tryGoal(deduce(ex29,[b(believe,john)],elementOf(audi,auto),_P)).
  886testMotelExample(29) :-
  887	no_goal.
  888testMotelExample(30) :-
  889	no_goal.
  890testMotelExample(31) :-
  891	tryGoal(deduce(elementOf(tom,onlyMaleChildren))).
  892testMotelExample(32) :-
  893	tryGoal(abduce(_H1,elementOf(robin,male),_E1)),
  894	tryGoal(abduce(_H2,elementOf(robin,female),_E2)).
  895testMotelExample(33) :-
  896	tryGoal(abduce(_H3,elementOf(nixon,dove),_E3)),
  897	tryGoal(abduce(_H4,elementOf(nixon,hawk),_E4)).
  898testMotelExample(34) :-
  899	tryGoal(inconsistent(ex34)).
  900testMotelExample(35) :-
  901	tryGoal(abduce(ex35,[],_H5,elementOf(john,fly),_E5)),
  902	tryGoal(not(abduce(ex35,[],_H8,elementOf(tweety,fly),_E8))).
  903testMotelExample(36) :-
  904	tryGoal(abduce(ex36,[],_H6,elementOf(nixon,dove),_E6)),
  905	tryGoal(abduce(ex36,[],_H7,elementOf(nixon,hawk),_E7)).
  906testMotelExample(37) :-
  907	no_goal.
  908testMotelExample(38) :-
  909	tryGoal(deduce(elementOf(ideaste,c2))).
  910testMotelExample(39) :-
  911	tryGoal(deduce(elementOf(lucky,female))),
  912	tryGoal(assert_ind(lucky,male)),
  913	tryGoal(not(deduce(elementOf(lucky,female)))),
  914	tryGoal(consistent([])).
  915testMotelExample(40) :-
  916	tryGoal(deduce(elementOf(peter,richPerson))),
  917	tryGoal(assert_ind(peter,poorPerson)),
  918	tryGoal(not(deduce(elementOf(peter,richPerson)))),
  919	tryGoal(consistent([])),
  920	tryGoal(not(subsumes(richPerson,doctor))).
  921testMotelExample(41) :-
  922	tryGoal(deduce(elementOf(tom,richPerson))),
  923	tryGoal(assert_ind(tom,poorPerson)),
  924	tryGoal(not(deduce(elementOf(tom,richPerson)))),
  925	tryGoal(consistent([])).
  926testMotelExample(42) :-
  927	tryGoal(deduce(elementOf(audi,fourWheels))),
  928	tryGoal(assert_ind(audi,fiveWheels)),
  929	tryGoal(not(deduce(elementOf(audi,fourWheels)))),
  930	tryGoal(consistent([])).
  931testMotelExample(43) :-
  932	tryGoal(deduce(elementOf(r,red))),
  933	tryGoal(deduce(elementOf(r,redOrYellow))),
  934	tryGoal(deduce(elementOf(r,colors))).
  935testMotelExample(44) :-
  936	tryGoal(subsumes(c2,c12)).
  937testMotelExample(45) :-
  938	no_goal.
  939testMotelExample(46) :-
  940	no_goal.
  941testMotelExample(47) :-
  942	tryGoal(deduce(elementOf(bmw,c3))).
  943testMotelExample(48) :-
  944	no_goal.
  945testMotelExample(49) :-
  946	tryGoal(not(deduce(elementOf(p,c4)))).
  947testMotelExample(50) :-
  948	tryGoal(deduce(elementOf(peter,c0))).
  949
  950testMotelExample(51) :-
  951	tryGoal(deduce(posInfl(a,d))),
  952	tryGoal(deduce(posInfl(b,d))),
  953	tryGoal(bagof(Y1,deduce(posInfl(a,Y1)),Y1s)),
  954	tryGoal(verifySolution(Y1s,[b,c,d,g])),
  955	tryGoal(deduce(infl(a,d,1.0))),
  956	tryGoal(bagof((X1,W1),deduce(infl(X1,e,W1)),X1W1Pairs)),
  957	tryGoal(verifySolution(X1W1Pairs,[(a,0.0),(b,-1.0),(g,1.0)])),
  958	tryGoal(deduce(simultInfl([a,h],d,2.0))),
  959	tryGoal(deduce(change(d,1.0))),
  960	tryGoal(bagof(X2,deduce(increase(X2)),X2s)),
  961	tryGoal(verifySolution(X2s,[b,c,d,g,a])).
  962
  963testMotelExample(52) :-
  964	tryGoal(deduce(negInfl(withRebate,hasOverallCost))),
  965	tryGoal(deduce(posInfl(hasListPrice,hasOverallCost))),
  966	tryGoal(deduce(posInfl(hasCubicCapacity,hasPrice))),
  967	tryGoal(deduce(posInfl(hasCubicCapacity,hasOverallCost))),
  968	tryGoal(deduce(posInfl(hasCatConverter,hasOverallCost))),
  969	tryGoal(deduce(simultInfl([hasCubicCapacity,hasCatConverter],hasOverallCost,3.0))),
  970	tryGoal(deduce(simultInfl([hasCubicCapacity,hasCatConverter],hasMaxSpeed,-1.0))),
  971	tryGoal(deduce(leastInfl(hasCubicCapacity,hasMaxSpeed))),
  972	tryGoal(deduce(leastInfls([hasCatConverter,hasCubicCapacity],hasMaxSpeed))),
  973	tryGoal(deduce(maxPosInfl(hasCubicCapacity,hasOverallCost,2.0))),
  974	tryGoal(bagof((X1,W1),deduce(maxNegInfl(X1,hasMaxSpeed,W1)),X1W1Pairs)),
  975	tryGoal(verifySolution(X1W1Pairs,[(hasCatConverter,-1.0),(hasWeight,-1.0)])),
  976	tryGoal(bagof(X2,deduce(increase(X2)),X2s)),
  977	tryGoal(verifySolution(X2s,[hasFuelConsumption,hasListPrice,hasOverallCost,hasPrice,hasWeight,hasCubicCapacity])),
  978	tryGoal(bagof((X3,W3),(deduce(leastInfl(X3,hasMaxSpeed)),abduce(change(X3,W3),change(hasMaxSpeed,1.0))),X3W3s)),
  979	tryGoal(verifySolution(X3W3s,[(hasCatConverter,-1.0)])).
  980testMotelExample(53) :-
  981	no_goal.
  982testMotelExample(54) :-
  983	no_goal.
  984testMotelExample(55) :-
  985	no_goal.
  986testMotelExample(56) :-
  987	no_goal.
  988testMotelExample(57) :-
  989	no_goal.
  990testMotelExample(58) :-
  991	no_goal.
  992testMotelExample(59) :-
  993	tryGoal(sb_ask(isa(harry,parent))),
  994	tryGoal(sb_ask(isa(harry,person))),
  995	printTime(setof((X,Y),sb_ask(role(child,X,Y)),L1)), print(L1), nl,
  996	printTime(setof(X,sb_ask(roleDef(child,X)),L2)), print(L2), nl,
  997	printTime(setof((X,Y),sb_ask(roleNr('marys-child',X,Y)),L3)), print(L3), nl,
  998	printTime(setof(X,sb_ask(roleDefNr('marys-child',X)),L4)), print(L4), nl.
  999testMotelExample(60) :-
 1000	tryGoal(deduce(ex60,[b(believe,peter)],elementOf(tom,richPerson),E)),
 1001	tryGoal(assert_ind([b(believe,peter)],tom,not(richPerson))),
 1002	tryGoal(inconsistent([b(believe,peter)])).
 1003testMotelExample(61) :-
 1004	tryGoal(deduce(elementOf(tweety,fly))),
 1005	tryGoal(deduce(elementOf(tweety,nest))),
 1006	tryGoal(deduce(elementOf(tweety,not(emu)))),
 1007	tryGoal(deduce(elementOf(tweety,not(cuckoo)))),
 1008	tryGoal(consistent([])).
 1009testMotelExample(62) :-
 1010	tryGoal(deduce(elementOf(tweety,fly))),
 1011	tryGoal(deduce(elementOf(tweety,nest))),
 1012	tryGoal(not(deduce(elementOf(tweety,not(emu))))),
 1013	tryGoal(not(deduce(elementOf(tweety,not(cuckoo))))),
 1014	tryGoal(not(deduce(elementOf(tweety,emu)))),
 1015	tryGoal(not(deduce(elementOf(tweety,cuckoo)))),
 1016	tryGoal(consistent([])).
 1017testMotelExample(63) :-
 1018	tryGoal(deduce(elementOf(tweety,fly))),
 1019	tryGoal(deduce(elementOf(tweety,nest))),
 1020	tryGoal(deduce(elementOf(tweety,not(emu)))),
 1021	tryGoal(deduce(elementOf(tweety,not(cuckoo)))),
 1022	tryGoal(deduce(elementOf(tweety,sparrow))),
 1023	tryGoal(consistent([]))