1%%% clauses 1-4 define Rouveirols bg knowledge
    2
    3column(X):- brick(X), standing(X), is_on(X,Y), ground(Y).
    4
    5column(X):- brick(X), standing(X), is_on(X,Y), column(Y).
    6
    7same_height(X,Y):- ground(X), ground(Y).
    8
    9same_height(X,Y):- brick(X), standing(X), brick(Y), standing(Y), is_on(X,X1), is_on(Y,Y1), 
   10                   same_height(X1,Y1).
   11
   12
   13% the next 2 examples (5+6) show arches of different heights
   14
   15arch(X):- part_of(A,X), part_of(B,X), part_of(C,X), is_on(A,B), is_on(A,C), is_on(B,D), 
   16          is_on(C,E), ground(D), ground(E), left_of(B,C), does_not_touch(B,C), lying(A), 
   17          wedge(A), standing(B), standing(C), brick(B), brick(C).
   18
   19
   20arch(X):- part_of(A,X), part_of(B,X), part_of(C,X), is_on(A,B), is_on(A,C), is_on(B,D),
   21          is_on(C,E), left_of(B,C),does_not_touch(B,C), lying(A), wedge(A), standing(B),
   22          standing(C), brick(B), brick(C),
   23          brick(D), brick(E), does_not_touch(D,E), standing(D), standing(E),
   24          is_on(D,F), is_on(E,G), ground(G), ground(F).
   25
   26
   27% the next 3 examples (7-9) show arches of different colors (-> lgg looks strange)
   28
   29arch(X):- part_of(A,X), part_of(B,X), part_of(C,X), is_on(A,B), is_on(A,C), is_on(B,D), 
   30          is_on(C,E), ground(D), ground(E), left_of(B,C), does_not_touch(B,C), lying(A), 
   31          wedge(A), standing(B), standing(C), brick(B), brick(C), red(B), green(C).
   32
   33arch(X):- part_of(A,X), part_of(B,X), part_of(C,X), is_on(A,B), is_on(A,C), is_on(B,D), 
   34          is_on(C,E), ground(D), ground(E), left_of(B,C), does_not_touch(B,C), lying(A), 
   35          wedge(A), standing(B), standing(C), brick(B), brick(C), green(B), red(C).
   36
   37arch(X):- part_of(A,X), part_of(B,X), part_of(C,X), is_on(A,B), is_on(A,C), is_on(B,D), 
   38          is_on(C,E), ground(D), ground(E), left_of(B,C), does_not_touch(B,C), lying(A), 
   39          wedge(A), standing(B), standing(C), brick(B), brick(C),blue(B), red(C).
   40
   41
   42% some clauses (10-12) to test intra-construction
   43
   44column(X):- brick(X), standing(X), is_on(X,Y), table(Y).
   45
   46column(X):- block(X), standing(X), is_on(X,Y), ground(Y).
   47
   48column(X):- block(X), standing(X), is_on(X,Y), column(Y)