Archive

Posts Tagged ‘Rule’

Solving Logic Puzzles in Prolog: Puzzle 3 of 3

December 27, 2015 Leave a comment

In this post we solve another small logic puzzle in Prolog, similar to the previous two logic puzzles (these are available here and here).

The puzzle

There are four researchers: Ainsley, Madeline, Sophie and Theodore. The goal is to find out their sports competition discipline, birth year and research interests (while knowing that each of the mentioned attributes is different amongst them). In order so solve the puzzle, a couple of hints is provided from which the solution can be derived:

  1. The competition for Theodore or Ainsley is javelin.
  2. The researcher interested in hurricane research has relay as sports subject.
  3. Sophie is not the researcher who has relay as sports subject.
  4. Either the researcher who has longjump as sports subject or Theodore was born in 1933 – the other one was born in 1921.
  5. The researcher with relay as sports subject was born before Theodore.
  6. The researcher interested in wildfires was born after the researcher doing longjumps for sports.
  7. Neither Sophie nor Ainsley are researching wildfires.
  8. The researcher interested in earthquakes has either hurdle or javelin as sports interest.
  9. The researcher interested in earthquakes was born in 1933.
  10. Madeline was not born in 1921.

Solving the puzzle in Prolog

In our Prolog implementation we ask for a solution that a) ensures that all sports subjects, research interests and birth years exist once and b) fulfills the rules mentioned above:

% ####################################################################
% Logic puzzle solver.
%
% Read definition to prolog:
%   ['puzzle.pl'].
%
% 2) Ask for solutions:
%   solve(Ainsley, Madeline, Sophie, Theodore).
%
% Rainhard Findling
% 10/2015
% ####################################################################
all_members([H],L2) :- member(H,L2).
all_members([H|T],L2) :- member(H,L2), all_members(T, L2).

and([H]) :- H.
and([H|T]) :- H, and(T).
or([H]) :- H,!.
or([H|_]) :- H,!.
or([_|T]) :- or(T).

solve(Ainsley, Madeline, Sophie, Theodore) :-
    All = [Ainsley, Madeline, Sophie, Theodore],
    Ainsley = [Ainsley_Year, Ainsley_Competition, Ainsley_Disaster],
    Madeline = [Madeline_Year, Madeline_Competition, Madeline_Disaster],
    Sophie = [Sophie_Year, Sophie_Competition, Sophie_Disaster],
    Theodore = [Theodore_Year, Theodore_Competition, Theodore_Disaster],
    % we know what all variable must be
    all_members([1920, 1921, 1933, 1973], [Ainsley_Year, Madeline_Year, Sophie_Year, Theodore_Year]),
    all_members([hurdle, relay, javelin, longjump], [Ainsley_Competition, Madeline_Competition, Sophie_Competition, Theodore_Competition]),
    all_members([earthquakes, hurricanes, tornados, wildfires], [Ainsley_Disaster, Madeline_Disaster, Sophie_Disaster, Theodore_Disaster]),
    % c1
    or([Ainsley_Competition = javelin, Theodore_Competition = javelin]),
    % c2
    member([_, relay, hurricanes], All),
    % c3
    not(Sophie_Competition = relay),
    % c4
    member([C4_Year, longjump, _], All),
    or([and([Theodore_Year = 1921, C4_Year = 1933]), and([Theodore_Year = 1933, C4_Year = 1921])]),
    % c5
    member([C5_Year, relay, _], All),
    Theodore_Year > C5_Year,
    % c6
    member([C6_1_Year, longjump, _], All),
    member([C6_2_Year, _, wildfires], All),
    C6_1_Year < C6_2_Year,
    % c7
    not(Sophie_Disaster = wildfires),
    not(Ainsley_Disaster = wildfires),
    % c8
    member([_, C8_competition, earthquakes], All),
    not(C8_competition = hurdle),
    not(C8_competition = javelin),
    % c9
    member([1933, _, earthquakes], All),
    % c10
    not(Madeline_Year = 1921).

Using this implementation, if we ask for a solution, the single possible solution is presented:

['puzzle.prolog'].
% puzzle.prolog compiled 0.00 sec, 13 clauses
true.

?- solve(Ainsley, Madeline, Sophie, Theodore).
Ainsley = [1920, relay, hurricanes],
Madeline = [1973, hurdle, wildfires],
Sophie = [1933, longjump, earthquakes],
Theodore = [1921, javelin, tornados] ;

Solving Logic Puzzles in Prolog: Puzzle 2 of 3

November 29, 2015 1 comment

This post is about solving the 2nd of 3 small logic puzzles in Prolog. The previous post is available here.

The puzzle

Eilen, Ada, Verena and Jenny participated in a painting competition. Find out who painted which subject and who took which place in the competition, using the hints provided. Hints:

    1. Eilen painted a constable and was not last in the competition
    2. Jenny took the third place
    3. The person painting the Monet took the first place
    4. Ada beat the person painting a talyor, and the person painting a Van Gogh beat Vera

Solving the puzzle in Prolog

We just translate the hints into rules that ensure that a) places 1-4 and all mentioned painting subjects exist in our solution and b) the mentioned hints are fulfilled:

% ####################################################################
% Logic puzzle solver.
%
% Read definition to prolog:
% ['puzzle.pl'].
%
% 2) Ask for solutions:
% solve(Eilen, Ada, Vera, Jenny).
%
% Rainhard Findling
% 10/2015
% ####################################################################
all_members([H],L2) :- member(H,L2).
all_members([H|T],L2) :- member(H,L2), all_members(T, L2).

solve(Eilen, Ada, Vera, Jenny) :-
% 4 members
All = [Eilen, Ada, Vera, Jenny],
Eilen = [Eilen_place, Eilen_subject],
Ada = [Ada_place, Ada_subject],
Vera = [Vera_place, Vera_subject],
Jenny = [Jenny_place, Jenny_subject],
% we know max place is 4th
all_members([1,2,3,4], [Eilen_place, Ada_place, Vera_place, Jenny_place]),
% we know existing paintings
all_members([constable,taylor,fangogh,monet], [Eilen_subject, Ada_subject, Vera_subject, Jenny_subject]),
% #3 1st was monet
member([1, monet], All),
% #2 Jenny got third
member([3, Jenny_subject], All),
% #1 Eilen painted a constable and was not last
member([Eilen_place, constable], All),
4 > Eilen_place,
% #4 ada beat the taylor painter...
member([Ada_place, Ada_subject], All),
member([H2_taylor_place, taylor], All),
Ada_place < H2_taylor_place, 
% #4 ...and the van gogh painter beat vera member([H4_fangogh_place, fangogh], All), member([Vera_place, Vera_subject], All), Vera_place > H4_fangogh_place.

If we ask for a solution, the single valid solution is presented:

?- solve(Eilen, Ada, Vera, Jenny).
Eilen = [2, constable],
Ada = [1, monet],
Vera = [4, taylor],
Jenny = [3, fangogh] ;

And again, that’s it – problem solved!

Solving Logic Puzzles in Prolog: Puzzle 1 of 3

October 31, 2015 6 comments

Recently I played around with Prolog again to solve 3 small logic puzzles. This post is about solving the first puzzle. This first puzzle consists of 2 individual puzzles that follow the exact same internal structure, so can be solved the exact same way of stating rules in Prolog (just with different content).

The small puzzle: problem and question

There are 4 students: Carrie, Erma, Ora und Tracy. Each has one scholarship and one major subject they study. The goal is to find out which student has which scholarship and studies which subject (with all scholarships and majors being different from each other) from the hints provided. The available scholarships are: 25000, 30000, 35000 and 40000 USD. The available majors are: Astronomy, English, Philosophy, Physics. The following hints are given to solve the problem:

  1. The student who studies Astronomy gets a smaller scholarship than Ora.
  2. Ora is either the one who studies English or the one who studies Philosophy.
  3. Erna has a 10000 USD bigger scholarship than Carrie.
  4. Tracy has a bigger scholarship than the student that studies English.

The small puzzle: the Prolog solution

One way of solving this puzzle in Prolog to ask for a solution (which in our example consists of the 4 students and their associated attributes) that fulfills the rules that we can derive from the 4 hints from above. This is actually pretty short and easy in Prolog syntax:

% ####################################################################
% Logic puzzle solver.
%
% Read definition to prolog:
%   ['puzzle.pl'].
%
% 2) Ask for solutions:
%   solve(Carrie,Erma,Ora,Tracy).
%
% Rainhard Findling
% 10/2015
% ####################################################################

all_members([H],L2) :- member(H,L2).
all_members([H|T],L2) :- member(H,L2), all_members(T, L2).

or([H]) :- H,!.
or([H|_]) :- H,!.
or([_|T]) :- or(T).

solve(Carrie,Erma,Ora,Tracy) :-
% all students
Carrie = [Carrie_scholarship, Carrie_major],
Erma = [Erma_scholarship, Erma_major],
Ora = [Ora_scholarship, Ora_major],
Tracy = [Tracy_scholarship, Tracy_major],
% grouping
All = [Carrie,Erma,Ora,Tracy],
% ensure all values exist once
all_members([25, 30, 35, 40], [Carrie_scholarship, Erma_scholarship, Ora_scholarship, Tracy_scholarship]),
all_members([astronomy, english, philosophy, physics], [Carrie_major, Erma_major, Ora_major, Tracy_major]),
% clue 1
member([C1_scholarship,astronomy], All),
Ora_scholarship > C1_scholarship,
% clue 2
or([Ora_major = english, Ora_major = philosophy]),
% clue 3
member([C3_scholarship, physics], All),
C3_scholarship - Carrie_scholarship =:= 5,
% clue 4
Erma_scholarship - Carrie_scholarship =:= 10,
% clue 5
member([C5_scholarship, english], All),
Tracy_scholarship > C5_scholarship.

If we ask for the solution, the single possible solution is presented:

?- solve(Carrie,Erma,Ora,Tracy).
Carrie = [25, english],
Erma = [35, astronomy],
Ora = [40, philosophy],
Tracy = [30, physics] ;

The slightly bigger puzzle: problem and question

There are 5 car renting contracts. Each has a duration, a pickup location, a car brand and a customer associated to it. The goal is to find out for all contracts, what the customer, duration, car brand and pickup location is (again given the fact that each attribute is unique amongst the contracts). The pickup locations are: Brownfield, Durham, Iowa Falls, Los Altos and Redding. The car brands are: Dodge, Fiat, Hyundai, Jeep and Nissan. The contract duration are 2, 3, 4, 5 and 6 days. And the customer names are Freda, Opal, Penny, Sarah and Vicky. The following hints are given to solve the problem:

  1. The contracts of Vicky, the one with pickup location in Los Altos, the one with pickup location in Durham and the one with the Fiat are all different contracts.
  2. The contract with the Jeep is not in Iowa Falls.
  3. The contract of Vicky and the one with the Nissan are picked up in either Los Altos or Redding.
  4. Penny’s contract is not for 6 days.
  5. The contract in Iowa Falls is for 5 days.
  6. The contract with the Durham is 3 days longer than the contract of Opal.
  7. Of the contract with Nissan and the 2 day contract, one is picked up in Redding and the other is Freda’s contract.
  8. The contract with the Jeep is not for 6 days.
  9. The contract of Opal is 1 day longer than the one with the Hyundai.

The slightly bigger puzzle: the Prolog solution

Again, we can define a solution to fulfill the stated rules:

% ####################################################################
% Logic puzzle solver.
%
% Read definition to prolog:
%   ['puzzle.pl'].
%
% 2) Ask for solutions:
%   solve(Freda, Opal, Penny, Sarah, Vicky).
%
% Rainhard Findling
% 10/2015
% ####################################################################

all_members([H],L2) :- member(H,L2).
all_members([H|T],L2) :- member(H,L2), all_members(T, L2).

all_not([H]) :- not(H).
all_not([H|T]) :- not(H), all_not(T).

all_not_members([H],L2) :- not(member(H,L2)).
all_not_members([H|T],L2) :- not(member(H,L2)), all_not_members(T, L2).

and([H]) :- H.
and([H|T]) :- H, and(T).
or([H]) :- H,!.
or([H|_]) :- H,!.
or([_|T]) :- or(T).

solve(Freda, Opal, Penny, Sarah, Vicky) :-
    % all runners
    Freda = [Freda_car, Freda_location, Freda_days],
    Opal = [Opal_car, Opal_location, Opal_days],
    Penny = [Penny_car, Penny_location, Penny_days],
    Sarah = [Sarah_car, Sarah_location, Sarah_days],
    Vicky = [Vicky_car, Vicky_location, Vicky_days],
    % grouping
    All = [Freda, Opal, Penny, Sarah, Vicky],
    % ensure all values exist once
    all_members([dodge, fiat, hyundai, jeep, nissan], [Freda_car, Opal_car, Penny_car, Sarah_car, Vicky_car]),
    all_members([brownfield, durham, iowafalls, losaltos, redding], [Freda_location, Opal_location, Penny_location, Sarah_location, Vicky_location]),
    all_members([2,3,4,5,6], [Freda_days, Opal_days, Penny_days, Sarah_days, Vicky_days]),
    % clues from easy (fast) to hard (slow)
    % clue 5
    member([_,iowafalls,5], All),
    % clue 9
    member([hyundai,_,C9_days], All),
    Opal_days - C9_days =:= 1,
    % clue 6
    member([_,durham,C6_days], All),
    C6_days - Opal_days =:= 3,
    % clue 4
    not(Penny_days = 6),
    % clue 2
    member([C2_car,iowafalls,_], All),
    not(C2_car = jeep),
    % clue 8
    member([C8_car,_,6], All),
    not(C8_car = jeep),
    % clue 3
    member([nissan,C3_location,_], All),
    or([and([C3_location = losaltos, Vicky_location = redding]), and([C3_location = redding, Vicky_location = losaltos])]),
    % clue 7
    member([nissan, C7_1_location,_], All),
    member([_,C7_2_location, 2], All),
    or([and([Freda_location = C7_1_location, C7_2_location = redding]), and([Freda_location = C7_2_location, C7_1_location = redding])]),
    % clue 1
    member([C1_1_car,losaltos,_], All),
    member([C1_2_car,durham,_], All),
    member([fiat,C1_3_location,_], All),
    all_not_members([C1_1_car, C1_2_car, Vicky_car],[fiat]), %car
    all_not_members([C1_3_location, Vicky_location],[losaltos, durham]). %location

… and ask for it, which again presents the single solution:

?- solve(Freda, Opal, Penny, Sarah, Vicky).
Freda = [nissan, losaltos, 4],
Opal = [jeep, brownfield, 3],
Penny = [fiat, iowafalls, 5],
Sarah = [dodge, durham, 6],
Vicky = [hyundai, redding, 2] ;

Mastermind: code guessing helper in Prolog

March 29, 2013 Leave a comment
Mastermind Board

Mastermind board seen from the codemakers perspective.

You may know Mastermind, the 2 player board game where one player becomes the codemaker, who creates the code, and the other player becomes the codebreaker, who tries to guess/derive the code. A classic Mastermind board may look like the one shown on the left — seen from the perspective of the codemaker, with the code hidden in the first line. There are other layouts too, like I myself used to play Mastermind on a board with 8 colors (+1 more color, which was “empty”), and 6 code pegs per code line.

Game rules

One player becomes the codemaker, the other the codebreaker. At the start the codemaker secretly choses a code, which he sets with the colored code pegs on the hidden, first line on his side of the board. There are no limits on a valid code: color duplicates are allowed, in the version known to me even free slots are allowed (which simply increases the total amount of colors by 1). The color and position of each code peg matters — this is what the codebreaker tries to guess now: for each try, the codebreaker sets a code line with code pegs to the next free line, starting at his side of the board. After the guess has been set, the codemaker checks the following:

  1. how many code pegs in the guess and the actual code are equal in position and color. He sets this amount in black key pegs next to the line then. All code pegs equal that fit this criteria don’t get counted in 2. any more.
  2. how many code peg pairs (one peg in the guess, one in the code) share the same color, but not the same position. This does not include code pegs already counted for 1., and no duplicates: e.g. if the code contains 2 green code peg and the guess 3 green code pegs, which are not on the correct position, this counts for 2. The codemaker sets this amount in white key pegs next to the line then.

For the next round, the codebreaker shall use all information from the past code guesses to derive the actual code. Target of the game for the codemaker is to chose a code which the codebreaker will not guess/derive, and for the codebreaker, to guess/derive it in as least rounds as possible.

Deriving possible solutions from past guesses

As I played around a bit with Prolog the last few days and accidentally came across Mastermind again (and noticed, that it’s proven to be a NP-complete problem), I was interested in building a lightweight Mastermind helper for deriving those codes still possible from having seen the result of previous guesses. This would enable me to simply do some good code guess, type in the guess and it’s result and see which codes are still possible — which is basically what I find interesting about such games 😉 Mastermind further is a perfect example of what’s easy to solve in Prolog: there’s one exact solution we’re searching for, and we can conclude some facts from the results of previous guesses. The basic idea is easy:

  • We search for a code C where each position is a color.
  • We have results from known guesses, where we know for each guess a) the number B of code pegs in C and our guessed code G which are equal in position and color, and b) the number W of code pegs in C and G which share the same color, but are on wrong positions.

To code this in Prolog, we basically have to specify that:

  1. A guess unifies C, G, B and W. After multiply tries multiply guesses are valid, for which G, B and W will vary, but C will always be the same.
  2. C and G share the same amount B of code pegs with same position and color.
  3. C and G share the same amount W of code pegs with same color, but wrong positions. This can be unified with counting the amount of occurrences of each color in C and G and taking the minimum for each of those pairs. B+W unifies with the sum of those minimums then.

Implementation

% list of existing colors. to reduce colors change color(X) below!
color1(red).
color2(blue).
color3(green).
color4(yellow).
color5(orange).
color6(brown).
color7(black).
color8(white).
color9(none).

% how many code pegs can be set - how the layout looks. only change amount here!
layout(X) :- X=[_,_,_,_,_,_].

% color space - change amount of colors only here!
color(X) :- color1(X).
color(X) :- color2(X).
color(X) :- color3(X).
color(X) :- color4(X).
color(X) :- color5(X).
color(X) :- color6(X).
color(X) :- color7(X).
color(X) :- color8(X).
color(X) :- color9(X).

% check if all elements of a list fulfill certain criteria
all([],_).
all([H|T],Function) :- call(Function,H),all(T,Function).

% one guess that has the real code (C), the guessed code (G), the nr of correct pos+colors (B) and the nr of other correct colors (W).
guess(C,G,B,W) :-
%check code layout fits
layout(C),
all(C,color),
%check that correct amount of positions+colors fits
cnt_pos_equal(C,G,B),
%check that correct amount of colors only fits
color1(C1),color_cooccurrence(C,G,C1,Cnt1),
color2(C2),color_cooccurrence(C,G,C2,Cnt2),
color3(C3),color_cooccurrence(C,G,C3,Cnt3),
color4(C4),color_cooccurrence(C,G,C4,Cnt4),
color5(C5),color_cooccurrence(C,G,C5,Cnt5),
color6(C6),color_cooccurrence(C,G,C6,Cnt6),
color7(C7),color_cooccurrence(C,G,C7,Cnt7),
color8(C8),color_cooccurrence(C,G,C8,Cnt8),
color9(C9),color_cooccurrence(C,G,C9,Cnt9),
W is 0 - B + Cnt1 + Cnt2 + Cnt3 + Cnt4 + Cnt5 + Cnt6 + Cnt7 + Cnt8 + Cnt9.

% count color cooccurrences in C and G list
color_cooccurrence(C,G,Color,Cnt) :-
countall(C,Color,CCnt),
countall(G,Color,GCnt),
min(GCnt,CCnt,Cnt).

% count occurrence in list
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z).
countall(List,X,0) :-
sort(List,List1),
\+ member(X,List1),!.
countall(List,X,C) :-
sort(List,List1),
member(X,List1),
count(List,X,C).

% min of two objects
min(X,Y,X) :- X&lt;Y,!.
min(X,Y,Y) :- X&gt;=Y.

% count how many elements in 2 list are equal in position and object
cnt_pos_equal([],[],0).
cnt_pos_equal([H1|T1],[H2|T2],Cnt2) :- H1=H2,!,cnt_pos_equal(T1,T2,Cnt1),Cnt2 is Cnt1+1.
cnt_pos_equal([H1|T1],[H2|T2],Cnt) :- \+ H1=H2,!, cnt_pos_equal(T1,T2,Cnt).

Example game

An example game, showing how the game advances and which Prolog queries correspond to each guess is shown below. The guesses are actually pretty bad, but good for demonstration purposes.

  1. The codemaker secretly sets a code [yellow, none, green, yellow, orange, blue].
  2. The codebreaker (randomly) guesses [red,red,blue,blue,green,green]. This results in 0 black key pegs, 2 white key pegs. The codebreaker enters a Prolog query containing this information:
    guess(C,[red,red,blue,blue,green,green],0,2).

    and gets presented a very long list of possible codes.

  3. The codebreaker now (randomly) guesses [yellow,yellow,orange,orange,brown,brown]. This results in 1 black key pegs, 2 white key pegs. The codebreaker extends his Prolog query with this information:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2).8

    . He still sees a very long list of possible codes.

  4. The codebreaker now (randomly) guesses [black,black,white,white,none,none]. This results in 0 black key pegs, 1 white key peg. The new Prolog query is:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2),guess(C,[black,black,white,white,none,none],0,1).
  5. Next guess: [none,white,black,brown,orange,yellow], results in: 1 black key peg, 2 white key pegs. New Prolog query:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2),guess(C,[black,black,white,white,none,none],0,1),guess(C,[none,white,black,brown,orange,yellow],1,2).
  6. Next guess: [brown,brown,red,red,red,yellow], results in: 0 black key pegs, 1 white key peg. New Prolog query:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2),guess(C,[black,black,white,white,none,none],0,1),guess(C,[none,white,black,brown,orange,yellow],1,2),guess(C,[brown,brown,red,red,red,yellow],0,1)
  7. Next guess: [orange,orange,brown,brown,brown,green], results in: 0 black key pegs, 2 white key pegs. New prolog query:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2),guess(C,[black,black,white,white,none,none],0,1),guess(C,[none,white,black,brown,orange,yellow],1,2),guess(C,[brown,brown,red,red,red,yellow],0,1),guess(C,[orange,orange,brown,brown,brown,green],0,2)
  8. Next guess: [brown,orange,yellow,green,blue,red], results in: 0 black key pegs, 4 white key pegs. New Prolog query:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2),guess(C,[black,black,white,white,none,none],0,1),guess(C,[none,white,black,brown,orange,yellow],1,2),guess(C,[brown,brown,red,red,red,yellow],0,1),guess(C,[orange,orange,brown,brown,brown,green],0,2),guess(C,[brown,orange,yellow,green,blue,red],0,4)
  9. Finally, the codebreaker decides to guess a combination that’s still possible according to the output of his previous Prolog query: [yellow, green, none, yellow, orange, blue]. This results in: 4 black key pegs, 2 white key pegs. The new Prolog query now is:
    guess(C,[red,red,blue,blue,green,green],0,2),guess(C,[yellow,yellow,orange,orange,brown,brown],1,2),guess(C,[black,black,white,white,none,none],0,1),guess(C,[none,white,black,brown,orange,yellow],1,2),guess(C,[brown,brown,red,red,red,yellow],0,1),guess(C,[orange,orange,brown,brown,brown,green],0,2),guess(C,[brown,orange,yellow,green,blue,red],0,4),guess(C,[yellow, green, none, yellow, orange, blue],4,2).
  10. Executing this query reduces the amount of possible codes to 2. Now the codebreaker can do the rest on his own 😉 Btw: if the codebreaker would have guessed more wisely, he would have “cracked the code” most probably much earlier.

Who has to attend the party?

March 28, 2013 Leave a comment

As a follow-up to Who lives on which floor?, this is another small problem perfectly fitted for a solution written in Prolog (it’s actually on of the many exercises from the 2. semester Algorithms and Datastructures course, of the Mobile Computing Bachelor program at our university):

Instructions

Uncle Oscar throws one of his boring parties again. Adam, Betty, Camilla and Daisy are invited and argue about who has to go this time — therefore they agree on the following:

  • At least one of them has to go to the party, otherwise Oscar will be aggrieved.
  • Adam does not go together with Daisy.
  • If Betty goes, Camilla has to go with her.
  • If Adam and Camilla go, Betty wants to stay at home.
  • If Adam stays at home, then at least one of the girls (Camilla and Daisy) has to go.

Write a program that gives all possible combinations of who is going to Oscars party.

Solution

All we have to tell Prolog is what valid states for “going” are: either “is going” (true) or “is not going” (false), and that a valid solution contains 4 of those states which don’t violate the points stated above. Those rules are easily written in the form: “if condition matches, this is not a valid combination”.

Prolog knowledge database:

% what are valid states for going?
goes(true).
goes(false).

% rule1 input: A,B,C,D
rule1(false,false,false,false) :- !,fail.
rule1(_,_,_,_).
% rule2 input: A,D
rule2(true,true) :- !,fail.
rule2(_,_) :- !,true.
% rule3 input: B,C
rule3(true,false) :- !,fail.
rule3(_,_).
% rule4 input: A,C,B
rule4(true,true,true) :- !,fail.
rule4(_,_,_).
% rule5 input: A,C,D
rule5(false,false,false) :- !,fail.
rule5(_,_,_).

Prolog query to ask for valid solutions:

goes(A),goes(B),goes(C),goes(D),rule1(A,B,C,D),rule2(A,D),rule3(B,C),rule4(A,C,B),rule5(A,C,D).

And again that’s it, Prolog will present you the 7 possible solutions straight away 😉

Who lives on which floor?

March 24, 2013 1 comment

You might know logic puzzles such as the zebra puzzle/Einstein puzzle: they are perfect examples of what can easily be solved in the logic programming language Prolog. Prolog in a nutshell: you can state a) facts (which represent knowledge about the world) and b) rules (to derive new facts from current facts), and you can ask with queries a) if statements without variables are true, and b) which values the variables in the query have to take to make the statement true. Prolog will search completely on it’s own for a solution using backtracking (working from our goal backwards towards the facts we currently know) — so you don’t actually write a program to solve your problem, but you only state what you know and what a valid solution is. To start with a problem easier than the zebra puzzle, you can try out the following problem:

Instructions

There is a house with 6 floors (floor 1 to 6) with one person (represented by upper-case letters) living on each floor. We know the following about who lives on which floor:

  • E lives on floor 4.
  • D lives somewhere below J.
  • J does not live directly above E.
  • D lives directly below A.
  • H lives above P.
  • P does not live somewhere below D.
  • J lives somewhere above P.

Who lives on which floor?

Solution

All we have to tell Prolog to solve this problem is:

  • There are 6 floors: floor(1) to floor(6).
  • What a valid solution looks like: there are the floors E,D,J,A,P,H with on each the corresponding person living on it, so that the relations between E,D,J,A,P,H stated above are true.

Write down this knowledge in a knowledge database file (floors.pl), as shown below:

%% commands to start:
%  use_module(library(bounds)).
% ['floors.pl'].
%  once((house(E,D,J,H,P,A))).

floor(1).
floor(2).
floor(3).
floor(4).
floor(5).
floor(6).

house(E,D,J,H,P,A) :-
floor(E),
floor(D),
floor(J),
floor(H),
floor(P),
floor(A),
E=:=4,
D<J, J-E=:=1, A-D=:=1, H>P,
P>D,
J>P,
all_different([E,D,J,H,P,A]).

Now you can load the required library for all_different: “use_module(library(bounds)).”, then load this file in the Prolog shell of your choice and finally ask for a valid solution with a single query. That’s all, Prolog will present you the solution then 😉

use_module(library(bounds)).
['floors.pl'].
once((house(E,D,J,H,P,A))).

And just for reasons of completeness: on Ubuntu (12.04) you can easily install the interactive Prolog shell with

sudo apt-get install swi-prolog

and start it with

swipl

to try out Prolog yourself.

The Wumpus World in Jess

The Wumpus world problem is another Artificial Intelligence Toy Problem, which exists in many different forms and versions. Solving the Wumpus World in Jess, as stated by this instructions from the California Polytechnic State University was recently a topic in the AI class of my master studies. A Wumpus world example is shown in the figure below:

Wumpus world example

The World consists of caves organized in a grid. Every such entry in the grid can either be a cave (white) or not be a cave (grey, none contained in the image above). The human in the bottom left corner is the hunter who tries to find the gold and exit the world again, which he has entered at location 1/1 (this location is the only entrance/exit for this world). Basically the hunter can go up/down/left/right to adjacent caves (if there are such ones), observe effects that are placed on the cave he currently stands on (stench or breeze), collect the gold if it’s in the same cave — and he can leave the world again at location 1/1. The overall task is to leave the world which having collected the gold previously.

The mentioned effects breeze and stench are caused by pits and the Wumpus: each cave that is next to a pit contains a breeze and each cave that is next to the Wumpus contains a stench. If the hunter runs into a pit or the Wumpus he will die — therefore it is useful to observe breeze or stench, as they indicate danger. The world is only partially observable for the hunter: he can only observe effects that are in the same cave as the hunter — but he can remember, what he has already seen in the past and do reasoning to conclude new facts from this knowledge. Further, the world is deterministic (actions done by the hunter lead to the expected result for sure). In our version of the game the Wumpus (and of course the pits) cannot move, and the hunter can shoot an arrow either up, down, left or right to kill the Wumpus, if he is located in this direction. To not have a hunter simply shooting arrows in all directions, the number of arrows is limited to 1 (so if he fails to kill with the first shot, he has no further possibility to kill the wumpus).

Jess
Jess is a framework in Java, that can be used to build rule-based expert systems (can decide things by deriving new information from current information, similar to what humans can do). Beside the Jess library to use in Java, Jess provides an own “rule language” in which facts can be stated and rules can be defined, which later match to the facts and trigger the derivation of new facts. This is what gets used for our Wumpus world problem: the initial facts (position of hunter, Wumpus, pits, etc.) get added to our knowledge database. Then the hunter can operate on this knowledge database to derive new facts by thinking, and also to move around, observe new facts from the world, etc. (note: the hunter uses the same knowledge database that also contains facts about the whole world, but he only uses those informations that are available to him — so he does not cheat).

Implementation
I implemented the first three of the four tasks stated in the instructions (the optional part of making the Wumpus move would not have been too complicated, as it basically includes the same logic as for the hunter — but it would be a lot of work on which I currently don’t want to spend too much time).

The more interesting part was task 3: giving the hunter the ability to go to a distant cave he has already seen in the past — and making this work for all imaginable world configurations. An example of the world 3 configuration one will run into with a hunter that does not have the ability to go to a distant cave is shown below. The H corresponds to the hunter’s position, D to his goal at a distant cave, G to the gold, W to the dead Wumpus (shot by the hunter before), P to pits, E to the entrance/exit and gray fields to “no-caves”. The hunter has already seen the cave at 6/5 to which he wants to go to, but currently stands in the cave at 1/4.

Go to a distant cave

One of the approaches to guide the hunter to such distant caves is algorithmically actually pretty simple: check if the hunter is somewhere on the way from the distant cave back to the entrance. If he is, he is already on the “right way”, and goes one step towards the distant cave. If he is not, he currently is not on the “right way”, and therefore goes one step back towards the entrance. This approach works in all cases, as the hunter creates a spanning tree of caves as he enters new caves. If he already is in the correct branch of the tree, he can continue to go down to the target cave. If he is not, he has to go up towards the root cave (entrance) — which is part of the correct way in all cases, as all caves the hunter can see must be reachable from there. Implementing this procedure in Jess is a bit tricky from syntax point of view (requires functions and queries), but is still pretty straight.

Download
The download contains the world rules (ww.jess, how the hunter thinks and acts, code attached below for quick review), the world setups for cave 0-3, and the file to start the program easily (start.clp).
Jess Source Code, sha1: 396cb4ecd2f54c9f05b1d4daa0fc9ae6d053103f.

; AI Homework Project: JESS and the Wumpus world
;
; Rainhard Findling
; Department of Mobile Computing
; University of Applied Sciences Upper Austria
; 2012-05-27
;
;; global variables -----------------------------------------------------------

(defglobal ; these global variables encode the strength of desires
    ?*veryhigh* = 5
    ?*high* = 4
    ?*medium* =  3
    ?*low* = 2
    ?*verylow* = 1 )

;; templates -----------------------------------------------------------------

(deftemplate hunter "A hunter"
    (slot agent (default Xena))
    (slot x (type INTEGER))
    (slot y (type INTEGER))
    (slot gold (default 0)(type INTEGER))
    (slot alive (default TRUE))
    (slot arrows (type INTEGER)(default 1))
    (slot killed-wumpi (type INTEGER)(default 0))
)

(deftemplate desire "a hunter's desires"
    (slot agent)
    (slot strength (type INTEGER))
    (slot action)
    (slot x)
    (slot y))

(deftemplate goal "a hunter's goals"
    (slot agent)
    (slot action)
    (slot x)
    (slot y))

(deftemplate cave
    "Cave objects sore the hunter's model of the world"
    (slot x (type INTEGER))		; (x,y) coordinates of cave
    (slot y (type INTEGER))		;
    (slot fromx (default -1))		; coordinates of the cave from which we
    (slot fromy (default -1))		;   first entered the cave.
    (slot seenfromx (default -1))		; coordinates of the cave from which we
    (slot seenfromy (default -1))		;   first saw the cave.
    (slot visited (default FALSE))	; Has the hunter been in it?
    (slot stench (default UNKNOWN))	; Does the cave smell?
    (slot breeze (default UNKNOWN))	; Is it breezy?
    (slot glitter (default UNKNOWN))	; Is there a glitter in it?
    (slot has-wumpus (default UNKNOWN))	; Is there a wumpus here?
    (slot has-pit (default UNKNOWN))	; Is there a pit here?
    (slot has-gold (default UNKNOWN))	; Is their gold here?
    (slot safe (default UNKNOWN))	; Is the cave safe -- no wumpus, no pit?
)

(deftemplate nocave
    "a nocave assertion is used to indicate a cell in the world that is
  not a cave.  (nocave (x 3)(y 3)) means that (3,3) is not a cave."
    (slot x (type INTEGER))
    (slot y (type INTEGER)))

(deftemplate wumpus "a wumpus"
    (slot x (type INTEGER))
    (slot y (type INTEGER))
    (slot alive (default TRUE)))

(deftemplate pit "A pit"
    (slot x (type INTEGER))
    (slot y (type INTEGER)))

(deftemplate gold "Gold has a location and amount."
    (slot x (type INTEGER))
    (slot y (type INTEGER))
    (slot amount (type INTEGER)(default 10)))

(deftemplate exit "coordinates of the entrance/exit to the caves."
    (slot x)
    (slot y))

;; functions -----------------------------------------------------------------

(deffunction buildworld (?width ?height)
    ;; (buildworld N M) makes cave assertions for a NxM rectangular  world.
    (printout t "Adding adj asserts for a " ?width " by " ?height "  world." crlf)
    (bind ?x 1)
    (while (        (bind ?y 1)
        (while ( ?x 1) then (assert (adj ?x ?y (- ?x 1) ?y)))
            (if (> ?y 1) then (assert (adj ?x ?y ?x (- ?y 1))))
            (if (< ?x ?width) then (assert (adj ?x ?y (+ ?x 1) ?y)))
            (if (< ?y ?height) then (assert (adj ?x ?y ?x (+ ?y 1))))             (bind ?y (+ 1 ?y)))         (bind ?x (+ ?x 1)))) (defquery query-access-cave     "returns iterator of caves at x,y"     (declare (variables ?x ?y))     (cave (x ?x)(y ?y)(fromx ?fromx)(fromy ?fromy)) ) (deffunction next-step-on-way-to-goal (?hunter ?x1 ?y1 ?exit)     "call with the 'predecessor' of the distant cave the hunter wants to go to"     ;search for intersection     (bind ?continue TRUE)     (while ?continue	         ;check next field (if hunter is on this field, done below) 	    ;remark: x,y is one step closer to the goal then it's predecessor fromx, fromy 		(bind ?result (run-query* query-access-cave ?x1 ?y1))    	    (?result next)         (bind ?fromx (integer (?result getString fromx)))             (bind ?fromy (integer (?result getString fromy)))           ;check if we are already at the entrance 		(if (and (eq ?x1 (fact-slot-value ?exit x))(eq ?y1 (fact-slot-value ?exit y))) then 			;we are already at the entrance, so the hunter 			;is not on the correct path currently 			;move him towards the entrance by moving him to the cave he came ftom             (bind ?result (run-query* query-access-cave (fact-slot-value ?hunter x) (fact-slot-value ?hunter y)))     		    (?result next) 	        (bind ?fromx (integer (?result getString fromx)))     	        (bind ?fromy (integer (?result getString fromy)))   			(printout t "#hunter is not on path from goal to exit, moving him to (" ?fromx "," ?fromy ")" crlf)     		(modify ?hunter (x ?fromx)(y ?fromy))             (bind ?continue FALSE) 		else 	        ;check if hunter is at the x,y position 			(if (and (eq ?fromx (fact-slot-value ?hunter x)) (eq ?fromy (fact-slot-value ?hunter y))) then 	        	(printout t "#hunter is on correct way to goal, moving him to (" ?x1 "," ?y1 ")" crlf) 		    	;hunter is on correct path, move him to x,y 		        ;--> one step closer to goal now
                (modify ?hunter (x ?x1)(y ?y1))
                (bind ?continue FALSE)
			else
	           	;check next field
                (bind ?x1 ?fromx)
                (bind ?y1 ?fromy)
           	)
	    )
    )
)

;; rules --------------------------------------------------------------------

(defrule in-the-beginning
    (initial-fact)
    =>
    (printout t "GENESIS..." crlf)
    (assert (task genesis)))

;; GENESIS rules  --------------------------------------------------------------

(defrule buildworld
    "This rule will call the buildworld function which will add the adj/4
    assertions for the current world"
    (task genesis)
    (worldsize ?width ?height)
    =>
    (buildworld ?width ?height))

(defrule retract-nocaves
    "This rule will retract adj/4 assertions added by buildworld when a
    matching nocave assertion is present"
    (task genesis)
    (nocave (x ?x)(y ?y))
    ?adj
    (retract ?adj))

(defrule put-hunter-in-caves
    "Assuming the hunter has no (X,Y) in the caves, find an exit
   and put him there."
    (task genesis)
    ?hunter
    (printout t ?a " enters the caves at (" ?x "," ?y ")." crlf)
    (modify ?hunter (x ?x)(y ?y)))

;; SIMULATE rules --------------------------------------------------------------

(defrule meet-the-wumpus
    "If a hunter and wumpus are in the same cave..."
    (task simulate)
    ?hunter
    (printout t "Aaarrrggghhhhhh....munch...munch...munch" crlf)
    (modify ?hunter (alive FALSE))
    (halt))

(defrule fall-into-the-pit
    "If a hunter and pit are in the same cave..."
    (task simulate)
    ?hunter
    (printout t "Aaarrrggghhhhhh....plop" crlf)
    (modify ?hunter (alive FALSE))
    (halt))

;; SENSE rules --------------------------------------------------------------

(defrule enter-new-cave
    "If we are in a cave for the first time, mark it as visited.
   This rule is only needed when the hunter wakes up in the exit cave"
    (task sense)
    (hunter (agent ?agent) (x ?x) (y ?y))
    (not (cave (x ?x)(y ?y)))
    =>
    ;(printout t ?agent " enters (" ?x "," ?y ")." crlf)
    (assert (cave (x ?x)(y ?y)(visited TRUE))))

(defrule enter-cave-for-first-time
    "If we are in a cave for the first time, mark it as visited"
    (task sense)
    (hunter (agent ?agent) (x ?x) (y ?y))
    ?cave
    ;(printout t ?agent " enters (" ?x "," ?y ")." crlf)
    (modify ?cave (visited TRUE)))

(defrule notice-other-caves
    "If we've just entered a new cave, we notice the other adjacent caves."
    (task sense)
    (hunter (agent ?agent) (x ?x)(y ?y))
    (adj ?x ?y ?x2 ?y2)
    (not (cave (x ?x2)(y ?y2)))
    =>
    (printout t ?agent " notices (" ?x2 "," ?y2 ") nearby." crlf)
    (assert (cave (x ?x2)(y ?y2)(seenfromx ?x)(seenfromy ?y)))
)

(defrule sense-breeze
    "Sense a breeze if a pit is nearby"
    (task sense)
    (hunter (agent ?agent) (x ?x) (y ?y))
    ?cave
    (printout t ?agent " feels a breeze in (" ?x "," ?y ")." crlf)
    (modify ?cave (breeze TRUE)))

(defrule sense-breeze-none
    "Sense a breeze if a pit is nearby"
    (declare  (salience -1))
    (task sense)
    (hunter (agent ?agent) (x ?x) (y ?y))
    ?cave
    (printout t ?agent " feels no breeze in (" ?x "," ?y ")." crlf)
    (modify ?cave (breeze FALSE)))

(defrule sense-stench
    "Sense a stench if a living wumpus is nearby"
    (task sense)
    (hunter (agent ?agent) (x ?x) (y ?y))
    ?cave
    (printout t ?agent " smells a stench." crlf)
    (modify ?cave (stench TRUE)))

(defrule sense-stench-none
    "Sense a stench if a living wumpus is nearby"
    (declare (salience -1))
    (task sense)
    (hunter  (agent ?agent)(x ?x) (y ?y))
    ?cave
    (printout t  ?agent " smells nothing." crlf)
    (modify ?cave (stench FALSE)))

(defrule sense-glitter
    "Sense glitter if gold in this cave"
    (task sense)
    (hunter  (agent ?agent) (x ?x) (y ?y))
    ?cave  ?n 0))
    =>
    (printout t   ?agent " sees glitter." crlf)
    (modify ?cave (glitter TRUE)))

(defrule sense-glitter-none
    "Sense a breeze if gold in this cave"
    (task sense)
    (hunter (agent ?a)(x ?x) (y ?y))
    ?cave  ?n 0))))
    =>
    (printout t ?a " sees no glitter." crlf)
    (modify ?cave (glitter FALSE))
)

;; THINK rules --------------------------------------------------------------

(defrule evaluate-stench-none
    (task think)
    (cave (x ?x)(y ?y)(stench FALSE))
    (adj ?x ?y ?x2 ?y2)
    ?f
    (printout t "No stench in (" ?x "," ?y ") means no wumpus in (" ?x2 ","  ?y2 ")." crlf)
    (modify ?f (has-wumpus FALSE)))

(defquery query-neighbors-that-possibly-or-for-sure-hold-wumpus
    "returns an iterator of neighboring caves of cave x,y that possibly or for sure hold a wumpus"
    (declare (variables ?a ?b))
    (adj ?a ?b ?a2 ?b2)
    (cave (x ?a2)(y ?b2)(has-wumpus ~FALSE))
)

(defrule evaluate-stench
    (task think)
    ?cave     (adj ?x ?y ?x2 ?y2)
    ?f
    ;check amount of neighbors of x,y that can hold a wumpus
    ;it it's one only, he has the wumpus for sure
    ;can also be done when agent is not on x,y, therefore use UNKOWN or MAYBE
    (bind ?count (count-query-results query-neighbors-that-possibly-or-for-sure-hold-wumpus ?x ?y))
    (if (= 1 ?count) then
        (printout t "#With stench in (" ?x "," ?y "), the wumpus is in (" ?x2  "," ?y2 ") for sure." crlf)
        (modify ?f (has-wumpus TRUE)(safe FALSE))
    else
        ;only mark field as "maybe wumpus" if it is wumpus status is currently unknown
        (if (= UNKNOWN (fact-slot-value ?f has-wumpus)) then
            (printout t "#With stench in (" ?x "," ?y "), maybe the wumpus is in (" ?x2  "," ?y2 ")." crlf)
            (modify ?f (has-wumpus MAYBE))
        )
    )
)

(defrule evaluate-breeze-none
    (task think)
    (cave (x ?x)(y ?y)(breeze FALSE))
    (adj ?x ?y ?x2 ?y2)
    ?f
    (printout t "There's no breeze in (" ?x "," ?y ") so there's no pit  in (" ?x2  "," ?y2 ")." crlf)
    (modify ?f (has-pit FALSE))
)

(defquery query-neighbors-that-possibly-or-for-sure-hold-pit
    "returns an iterator of neighboring caves of cave x,y that possibly or for sure hold a pit"
    (declare (variables ?a ?b))
    (adj ?a ?b ?a2 ?b2)
    (cave (x ?a2)(y ?b2)(has-pit ~FALSE))
)

(defrule evaluate-breeze
    (task think)
    (cave (x ?x)(y ?y)(breeze TRUE))
    ?cave
    ;check amount of neighbors of x,y that can hold a pit
    ;it it's one only, he has the pit for sure
    ;can also be done when agent is not on x,y, therefore use UNKOWN or MAYBE
    (bind ?count (count-query-results query-neighbors-that-possibly-or-for-sure-hold-pit ?x ?y))
    (if (= 1 ?count) then
        (printout t "#With breeze in (" ?x "," ?y "), the pit is in (" ?x2  "," ?y2 ") for sure." crlf)
        (modify ?cave (has-pit TRUE)(safe FALSE))
    else
        ;only mark field as "maybe pit" if its pit status is currently unknown
        (if (= UNKNOWN (fact-slot-value ?cave has-pit)) then
            (printout t "#With breeze in (" ?x "," ?y "), maybe the pit is in (" ?x2  "," ?y2 ")." crlf)
            (modify ?cave (has-pit MAYBE))
        )
    )
)

(defrule evaluate-glitter
    (task think)
    (hunter (agent ?a)(x ?x)(y ?y))
    ?cave
    (printout t "Seeing glitter, " ?a " knows there is gold in (" ?x "," ?y ")." crlf)
    (modify ?cave (has-gold TRUE)))

(defrule evaluate-glitter-none
    (task think)
    (hunter (agent ?a)(x ?x)(y ?y))
    ?cave
    (printout t "Seeing no glitter, " ?a " knows there is no gold in (" ?x "," ?y ")." crlf)
    (modify ?cave (has-gold FALSE)))

(defrule safe-cave
    (task think)
    (or ?f
    (printout t "With neither wumpus nor pit, (" ?x "," ?y ") is safe." crlf)
    (modify ?f (safe TRUE)))

(defrule safe-cave2
    (task think)
    (hunter (agent ?agent) (x ?x)(y ?y)(alive TRUE))
    ?f
    (printout t "Since " ?agent " is in ("?x "," ?y ") and not dead, it must be safe." crlf)
    (modify ?f (safe TRUE))
)

(defrule safe-cave3
    "safe => ~wumpus ^ ~pit"
    (task think)
    (or ?f         ?f
    (printout t "(" ?x "," ?y ") is safe, so there's no pit or wumpus in it." crlf)
    (modify ?f (has-pit FALSE))
    (bind ?w (fact-slot-value ?f has-wumpus))
 	(if (= ?w DEAD) then
    	;this field contains a dead wumpus, do not mark it as wumpus-free
    else
    	;no dead wumpus + we alive = no wumpus here
	    (modify ?f (has-wumpus FALSE))
    )
)

;; setting desires ...

(defrule desire-to-leave-caves
    (task think)
    ;check that we have gold and killed a wumpus
    (hunter (agent ?a)(x ?x)(y ?y)(gold ~0)(killed-wumpi ~0))
    ;(cave (x ?x)(y ?y)(has-exit TRUE))
    (exit (x ?x)(y ?y))
    =>
    (printout t "Having found the gold, " ?a " want to leave the caves." crlf)
    (assert (desire (agent ?a)(strength ?*veryhigh*)(action leavecaves))))

(defrule add-desire-to-head-for-the-exit
    (task think)
    (hunter (agent ?agent) (x ?x)(y ?y)(gold ~0)(killed-wumpi ~0))
    (cave (x ?x)(y ?y)(fromx ?fx)(fromy ?fy))
    (test (> ?fx 0))
    =>
    (printout t ?agent " strongly wants to go to (" ?fx "," ?fy ") to leave the cave." crlf)
    (assert (desire (agent ?agent) (strength ?*veryhigh*) (action go)(x ?fx)(y ?fy))))

(defrule lust-for-gold
    (task think)
    (hunter (agent ?a)(x ?x)(y ?y))
    (cave (x ?x)(y ?y)(has-gold TRUE))
    =>
    (printout t ?a " wants to pick up the gold in (" ?x "," ?y ")." crlf)
    (assert (desire (agent ?a)(strength ?*veryhigh*)(action pickupgold))))

(defrule lust-for-shoot
    "if the hunter is next to a field that is known to contain a wumpus, he wants to kill the wumpus"
    (task think)
    (cave (x ?x)(y ?y)(has-wumpus TRUE))
	(hunter (agent ?a)(x ?x2)(y ?y2))
	(adj ?x ?y ?x2 ?y2)
    =>
    (printout t "#" ?a " wants to shoot the wumpus in (" ?x "," ?y ")." crlf)
    (assert (desire (agent ?a)(strength ?*veryhigh*)(action shoot))))

(defrule retract-lesser-desire
    "If we have two desires for the same thing, remove the one with lesser strength"
    (task think)
    (desire (agent ?agent)(strength ?s1)(action ?a)(x ?x)(y ?y))
    ?desire2     (test (< ?s2 ?s1))     =>
    (retract ?desire2))

(defrule add-desire-to-go-to-safe-adjacent-cave
    "go to an adjacent, safe, unvisited cave"
    (task think)
    (hunter (agent ?agent)(x ?x)(y ?y))
    (adj ?x ?y ?x2 ?y2)
    (cave (x ?x2)(y ?y2)(visited FALSE)(safe TRUE))
    =>
    (printout t ?agent " strongly wants to go to (" ?x2 "," ?y2 ")." crlf)
    (assert (desire (agent ?agent) (strength ?*high*) (action go)(x ?x2)(y ?y2))))

(defrule add-desire-to-go-to-safe-distant-cave
    "go to a non-adjacent, safe, unvisited cave"
    (task think)
    (hunter (agent ?agent)(x ?x)(y ?y))
    (cave (x ?x2)(y ?y2)(visited FALSE)(safe TRUE))
    (not (adj ?x ?y ?x2 ?y2))
    =>
    (printout t ?agent " moderately wants to go to (" ?x2 "," ?y2 ")." crlf)
    (assert (desire (agent ?agent) (strength ?*medium*) (action go)(x ?x2)(y ?y2))))

(defrule add-desire-to-go-to-risky-adjacent-cave
    "go to an adjacent, risky, unvisited cave"
    (task think)
    (hunter (agent ?agent)(x ?x)(y ?y))
    (cave (x ?x2)(y ?y2)(visited FALSE)(safe UNKNOWN))
    (adj ?x ?y ?x2 ?y2)
    =>
    (printout t ?agent " somewhat wants to go to (" ?x2 "," ?y2 ")." crlf)
    (assert (desire (agent ?agent) (strength ?*low*) (action go)(x ?x2)(y  ?y2))))

(defrule add-desire-to-go-to-risky-distant-cave
    "go to a distant, risky, unvisited cave"
    (task think)
    (hunter (agent ?agent)(x ?x)(y ?y))
    (cave (x ?x2)(y ?y2)(visited FALSE)(safe UNKNOWN))
    (not (adj ?x ?y ?x2 ?y2))
    =>
    (printout t ?agent " somewhat wants to go to (" ?x2 "," ?y2 ")." crlf)
    (assert (desire (agent ?agent) (strength ?*verylow*) (action go)(x ?x2)(y  ?y2))))

;; PLAN rules  --------------------------------------------------------------

;; Planning our action is just simply picking the desire to realize
;; and asserting an appropriate goal.

(defrule choose-desire
    "pick the best desire available for a given action. note that we
    will only promote one desire to be a goal at a time."
    (task plan)
    ?f  ?s2 ?s))))
    (not (goal))
    =>
    (retract ?f)
    (assert (goal (action ?act) (x ?x)(y ?y))))

;; ACT rules  --------------------------------------------------------------

;; These rules find a goal and take actions to carry it out.

(defrule found-exit
    "If the hunter has gold and finds an exit, she leaves."
    (task act)
    ?goal
    (printout t ?agent " leaves the caves." crlf)
    (halt))

(defrule pickup-gold
    "If we find the gold, pick it up"
    (task act)
    ?goal     ?f1     ?cave     ?f2  ?more 0))
    =>
    (printout t ?a " picks up " ?more " pieces of gold!" crlf)
    (retract ?goal)
    (modify ?f1 (gold (+ ?current ?more)))
    (modify ?cave (has-gold FALSE)(glitter FALSE))
    (modify ?f2 (amount 0)))

(defrule go-to-adjacent-cave
    "If our desire is to goto XY and were are in an adjacent cell,
   do it and remove the desire"
    (task act)
    ?goal     ?hunter     (adj ?x ?y ?x2 ?y2)
    ?target
    (printout t ?agent " goes to (" ?x "," ?y ")." crlf)
    (retract ?goal)
    (modify ?hunter (x ?x)(y ?y))
    (if (not ?v) then (modify ?target (fromx ?x2)(fromy ?y2))))

(defrule shoot
	"if there is a cave x,y with an wumpus on it an a adjacent cave x2,y2 with the hunter on it, the hunter kills the wumpus"
	(task act)
    ?goal     ;wumpus for later modification
    ;pos and state unknown - that's why we don't access it's x,y or alive state
    ?wumpus     ;cave witch is known to have a wumpus
    ?cave     ;hunter pos x2,y2 and hunter alive
    ?hunter
    ;remember arrow amount
    (bind ?arrows (fact-slot-value ?hunter arrows))
    ;get wumpus
    (if (> ?arrows 0) then
        ;we have arrows, kill wumpus, reduce arrows by one, set wumpus to false
	    (retract ?goal)
	    (printout t "#Hunter at (" ?x2 "," ?y2 ") kills wumpus at (" ?x "," ?y ")." crlf)
        (modify ?wumpus (alive FALSE))
        (bind ?killed-wumpi (fact-slot-value ?hunter killed-wumpi))
        (modify ?hunter (killed-wumpi (+ ?killed-wumpi 1)))
        (modify ?hunter (arrows (- ?arrows 1)))
        (modify ?cave (has-wumpus DEAD))
    else
        ;damn, no arrows ._.
    	(printout t "#Hunter at (" ?x2 "," ?y2 ") would like to kill wumpus at (" ?x "," ?y "), but has no arrows." crlf)
    )
)

(defrule move-toward-distant-cave
    "The hunter is in X1Y1 and intends to go to distant X3Y3.  Hunter
  goes to adjacent safe cave X2Y2 which is closer to X3Y3."
    (task act)
    (goal (action go) (x ?x3)(y ?y3))
    ;idea: go back to entrance, hope that the distant cave is adjacent to a cave on our way.
    ?hunter     ;?cave     ?goalcave     (not (adj ?x1 ?y1 ?x3 ?y3))
    ?exit
    ;(printout t "#goal (" ?x3 "," ?y3 ") seenfrom (" ?seenfromx "," ?seenfromy ")." crlf)
	(next-step-on-way-to-goal ?hunter ?seenfromx ?seenfromy ?exit)
)

(defrule delete-desires
    "retracts any desire facts in the database"
    (task act)
    (deletedesires)
    ?f
    (retract ?f))

(defrule delete-desires-end
    "retracts any desire facts in the database"
    (task act)
    (deletedesires)
    (not (desire))
    =>
    (retract (deletedesires)))

(defrule retract-satisfied-goal
    ;; this shouldn't happen, and is here for debugging.
    (task act)
    ?goal
    (printout t "WARNING: " ?a " has a goal to go to (" ?x "," ?y ")
  and she is already here." crlf)
    (retract ?goal))

(defrule retract-satisfied-goal
    ;; this shouldn't happen, and is here for debugging.
    (declare (salience -1))
    (task act)
    ?goal
    (printout t "WARNING: unsatisfied goal: " ?act " " ?x " " ?y "."  crlf)
    (halt))

;; TASK SWITCHING rules -------------------------------------------------------

;; These rules cycle us through the various tasks.  Note that they all
;; have a very low salience, so that they will be run last.  Depending
;; on which is the current task, the rules just move us on to the
;; next.  we start in genesis, the move to a cycle of (simulate,
;; sense, think, plan, act).

(defrule genesis-to-simulate
    (declare  (salience -100))
    ?f
    (retract ?f)
    (printout t "SIMULATING..." crlf)
    (assert (task simulate)))

(defrule simulate-to-sense
    (declare  (salience -100))
    ?f
    (retract ?f)
    (printout t "SENSING..." crlf)
    (assert (task sense)))

(defrule sense-to-think
    (declare  (salience -100))
    ?f
    (retract ?f)
    (printout t "THINKING..." crlf)
    (assert (task think)))

(defrule think-to-plan
    (declare  (salience -100))
    ?f
    (retract ?f)
    (printout t "PLANNING..." crlf)
    (assert (task plan)))

(defrule plan-to-act
    (declare  (salience -100))
    ?f
    (retract ?f)
    (printout t "ACTING..." crlf)
    (assert (task act)))

(defrule act-to-simulate
    (declare  (salience -100))
    ?f
    (retract ?f)
    (printout t "SIMULATING..." crlf)
    (assert (task simulate)))