Related
I'm trying to write a predicate that calculates which destination a group of friends will visit.
The friends list their countries of preferences like this
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
I want to write a predicate called where that takes 2 arguments to perform the calculation.
The formula I have in mind is that the first country is worth 3 points, the second one is worth 2 points, and the last one is worth 1 point.
Here's an example of what I'm trying to achieve.
?- where([marie,jean,sasha,helena,emma],Country).
peru .
So far I have this
where([], X).
where([H|T], N) :- choice(H, [A|B]), where(T,N).
It lets me iterate through all the different friends and shows their choices but I can't iterate through the list of choices and assign points to the destinations.
How should I go about iterating through the list of choices for each friend and assigning points to calculate the best destination?
While this will solve your problem, I know it uses many predicates that you have not seen. So think of this an opportunity to excel and learn a lot.
Even if you don't understand it all, there is enough detail and intermediate results in the test that you should be able to navigate your way to a proper solution you create.
Also this is by no means efficient, it was just a quick proof of concept I did to see how this could be done.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
destinations(Destinations) :-
findall(D1,choice(_,D1),D2),
flatten(D2,D3),
list_to_set(D3,Destinations).
init_weights(Destinations,Weights) :-
empty_assoc(Assoc),
init_weights(Destinations,Assoc,Weights).
init_weights([],Weights,Weights).
init_weights([H|T],Assoc0,Weights) :-
put_assoc(H,Assoc0,0,Assoc1),
init_weights(T,Assoc1,Weights).
update_weights([C1,C2,C3],Weights0,Weights) :-
del_assoc(C1,Weights0,Value0,Weights1),
Value1 is Value0 + 3,
put_assoc(C1,Weights1,Value1,Weights2),
del_assoc(C2,Weights2,Value2,Weights3),
Value3 is Value2 + 2,
put_assoc(C2,Weights3,Value3,Weights4),
del_assoc(C3,Weights4,Value4,Weights5),
Value5 is Value4 + 1,
put_assoc(C3,Weights5,Value5,Weights).
person_weight(Person,Weights0,Weights) :-
choice(Person,[C1,C2,C3]),
update_weights([C1,C2,C3],Weights0,Weights).
people(People) :-
findall(Person,choice(Person,_),People).
choice(Destination) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights1),
cross_ref_assoc(Weights1,Weights),
max_assoc(Weights, _, Destination),
true.
cross_ref_assoc(Assoc0,Assoc) :-
assoc_to_list(Assoc0,List0),
maplist(key_reverse,List0,List),
list_to_assoc(List,Assoc).
key_reverse(Key-Value,Value-Key).
update_choices([],Weights,Weights).
update_choices([Person|People],Weights0,Weights) :-
person_weight(Person,Weights0,Weights1),
update_choices(People,Weights1,Weights).
Tests
:- begin_tests(destination).
test(destinations) :-
destinations([peru, greece, vietnam]).
test(init_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights),
assoc_to_list(Weights,[greece-0, peru-0, vietnam-0]).
test(update_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
update_weights([peru,greece,vietnam],Weights0,Weights),
assoc_to_list(Weights,[greece-2,peru-3,vietnam-1]).
test(person_weight) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
person_weight(jean,Weights0,Weights),
assoc_to_list(Weights,[greece-3,peru-2,vietnam-1]).
test(people) :-
people([marie,jean,sasha,helena,emma]).
test(update_choices) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights),
assoc_to_list(Weights,[greece-10,peru-12,vietnam-8]).
test(cross_ref_assoc) :-
List0 = [1-a,2-b,3-c],
list_to_assoc(List0,Assoc0),
cross_ref_assoc(Assoc0,Assoc),
assoc_to_list(Assoc,[a-1,b-2,c-3]).
test(choice) :-
choice(peru).
:- end_tests(destination).
As suggested by GuyCoder, you need an accumulator to sum each person preferences, and foldl/N allows to does exactly this.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
where(People,Where) :-
foldl([Person,State,Updated]>>(choice(Person,C),update(State,C,Updated)),
People,
[0=greece,0=peru,0=vietnam],
Pref),
aggregate(max(S,S=W),member(S=W,Pref),max(_,_=Where)).
% sort(Pref,Sorted),
% last(Sorted,_=Where).
update(S0,[A,B,C],S3) :-
update(S0,3,A,S1),
update(S1,2,B,S2),
update(S2,1,C,S3).
update(L,V,C,U) :-
append(X,[Y=C|Z],L),
P is Y+V,
append(X,[P=C|Z],U).
I have left commented the last two goals replaced by the single goal aggregate/3, so you can try to understand the syntax...
I don't know how to write a Prolog program for the following scenario.
1. If any two person having same hobby then they like each other.
2. Every gardener likes the Sun.
I did this but I don't know whether it is correct or not.
like(gardener,sun).
Please help me to solve it.
Prolog rules follow the "reversed-IF" template:
Head :- Goal1, ..., GoalN.
means (roughly), "Head holds if Goal1, ..., GoalN all hold".
Put the other way around it means, "if Goal1, ..., GoalN all hold, then Head also holds".
This fits exactly your first sentence, thus it can be encoded as a rule:
likes(A, B) :- % Head :-
hobby( A, HobbyA), % Goal1,
hobby( B, HobbyB), % Goal2,
same( HobbyA, HobbyB), % Goal3,
dif( A, B). % Goal4.
% different persons, not the same one
The second sentence too fits the same template:
likes(A, sun) :-
isA(A, gardner).
With the most natural encoding of isA( X, Y) as simply a unification X = Y, this becomes equivalent to the fact that you wrote. Facts are rules with no body.
My professor gave this as an example of Prolog. It is a program that solves the Tower of Hanoi puzzle, where you have to move a stack of disks to another peg by moving one disk after the other, without putting a bigger disk on top of a smaller disk.
Now, I don't like that program. I was told Prolog was meant for declarative programming. I don't want to program how to solve the problem, I want to write down using Prolog what the problem is. Then let Prolog solve it.
My effort so far can be found below. There are two types of lists I employ, a sequence of actions is represented like this: [[1,2],[3,1]]; this would be "move the top disk from peg 1 to peg 2, move the disk from peg 3 to peg 1". My second type of list is a state, for example, if there are three pegs [[1,2,3], [], []] would mean that there are three disks on the first peg. Smaller disks have smaller numbers, so the front of the inner list is the top of a stack.
% A sequence of actions (first argument) is a solution if it leads
% from the begin state (second argument) to the End state (third argument).
solution([], X, X).
solution([[FromIdx | ToIdx] | T], Begin, End) :-
moved(FromIdx, ToIdx, Begin, X),
solution(T, X, End).
% moved is true when Result is the resulting state after moving
% a disk from FromIdx to ToIdx starting at state Start
moved(FromIdx, ToIdx, Start, Result) :-
allowedMove(FromIdx, ToIdx, Start),
nth1(FromIdx, Start, [Disk|OtherDisks]),
nth1(ToIdx, Start, ToStack),
nth1(FromIdx, Result, OtherDisks),
nth1(ToIdx, Result, [Disk|ToStack]).
allowedMove(FromIdx, ToIdx, State) :-
number(FromIdx), number(ToIdx),
nth1(FromIdx, State, [FromDisk|_]),
nth1(ToIdx, State, [ToDisk|_]),
ToDisk > FromDisk.
allowedMove(_, ToIdx, State) :- nth1(ToIdx, State, []).
The above program seems to work, but it is too slow for everything reasonably complex. Asking it to solve the classic Tower of Hanoi problem, moving three disks from the first peg to the third and last, would go like this:
?- solution(Seq, [[1,2,3], [], []], [[], [], [1,2,3]]).
I would like to make some modifications to the program so that it works for this query. How would I go about doing that? When profiling I can see that nth1 uses a lot of time, should I get rid of it? Something that bothers me is that moved is completely deterministic and should only have one result. How can I speed up this bottleneck?
The Prolog solution to Hanoi one typically finds looks something like this. The solution writes the moves out to the screen as it encounters them and doesn't collect the moves in a list:
move_one(P1, P2) :-
format("Move disk from ~k to ~k", [P1, P2]), nl.
move(1, P1, P2, _) :-
move_one(P1, P2).
move(N, P1, P2, P3) :-
N > 1,
N1 is N - 1,
move(N1, P1, P3, P2),
move(1, P1, P2, P3),
move(N1, P3, P2, P1).
hanoi(N) :-
move(N, left, center, right).
This could be modified to collect the moves in a list instead by adding a list argument throughout and using append/3:
move(0, _, _, _, []).
move(N, P1, P2, P3, Moves) :-
N > 0,
N1 is N - 1,
move(N1, P1, P3, P2, M1),
append(M1, [P1-to-P2], M2),
move(N1, P3, P2, P1, M3),
append(M2, M3, Moves).
hanoi(N, Moves) :-
move(N, left, center, right, Moves).
We were able to make the base case simpler without the write. The append/3 does the job, but it's a bit clunky. Also, the is/2 in particular makes it non-relational.
By using a DCG and CLP(FD), the append/3 can be eliminated and it can be made more relational. Here's what I'd call an initial "naive" approach, and it is also more readable:
hanoi_dcg(N, Moves) :-
N in 0..1000,
phrase(move(N, left, center, right), Moves).
move(0, _, _, _) --> [].
move(N, P1, P2, P3) -->
{ N #> 0, N #= N1 + 1 },
move(N1, P1, P3, P2),
[P1-to-P2],
move(N1, P3, P2, P1).
This results in:
| ?- hanoi_dcg(3, Moves).
Moves = [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center] ? a
no
| ?- hanoi_dcg(N, [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center]).
N = 3 ? ;
(205 ms) no
| ?-
Although it's relational, it does have a couple of issues:
Useless choice points in "both directions"
Termination issues unless constrained with something like N in 0..1000
I sense there's a way around these two issues, but haven't worked that out yet. (I'm sure if some smarter Prologers than I, such as #mat, #false, or #repeat see this, they'll have a good answer right off.)
I looked at your solution and here is some thought I had about it:
When you move, what you're doing is take from one tower and put on another.
There is a SWI-Predicate that replaces an element in a list, select/4. But you also want to have the index where you replaced it. so lets rewrite it a little, and call it switch_nth1, because it doesn't have to do much with select anymore.
% switch_nth1(Element, FromList, Replacement, ToList, Index1)
switch_nth1(Elem, [Elem|L], Repl, [Repl|L], 1).
switch_nth1(Elem, [A|B], D, [A|E], M) :-
switch_nth1(Elem, B, D, E, N),
M is N+1.
Since we're operating on List of Lists, we'll need two switch_nth1 calls: one to replace the Tower we take from, and one to put it on the new tower.
A move predicate could look like this (sorry I changed the arguments a little). (It should be called allowed_move because it doesn't do moves that aren't allowed).
move((FromX - ToX), BeginState, NewState):-
% take a disk from one tower
switch_nth1([Disk| FromTowerRest], BeginState, FromTowerRest, DiskMissing, FromX),
% put the disk on another tower.
switch_nth1(ToTower, DiskMissing, [Disk|ToTower], NewState, ToX),
% there are two ways how the ToTower can look like:
(ToTower = []; % it's empty
ToTower = [DiskBelow | _], % it already has some elements on it.
DiskBelow > Disk).
If you plug that into your solution you sadly run into some termination issues, since noone said that a state that already has been reached shouldn't be a right step on the way. Thus, we need to keep track where we already were and disallow continuation when a known state is reached.
solution(A,B,C):-solution_(A,B,C,[B]).
solution_([], X, X,_).
solution_([Move | R], BeginState, EndState, KnownStates):-
move(Move, BeginState, IntermediateState),
\+ memberchk(IntermediateState, KnownStates), % don't go further, we've been here.
solution_(R, IntermediateState, EndState, [IntermediateState | KnownStates]).
That said, this solution still is very imperative – there should be nicer solutions out there, where you really take advantage of recursion.
By "declarative" I'll assume you mean something close to the old slogan of "in Prolog, to write down a question is to have the answer to it". Let Prolog discover the answer instead of me just coding in Prolog the answer that I had to find out on my own.
Simply defining a legal_move predicate, stating the initial and final condition and running a standard search of whatever variety, leads to extremely very inefficient solution that will backtrack a whole lot.
Making a computer derive the efficient solution here seems a very hard problem to me. For us humans though, with just a little bit of thinking the solution is obvious, cutting away all the redundancy too, making any comparisons and checking the legality of positions completely unnecessary -- the solution is efficient and every move is legal by construction.
If we can move N = M + K disks, we can move M of them just the same - the other two pegs are empty, and we pretend the lower K disks aren't there.
But having moved the M disks, we're faced with the remaining K. Wherever the M disks went, we can't move any of the K there, because by construction the K disks are all "larger" than any of the M ("larger" simply because they were beneath them initially on the source peg).
But the third peg is empty. It is easy to move one disk there. Wouldn't it be just peachy if K were equal 1? Having moved the remaining K = 1 disk to the empty target peg, we again can pretend it isn't there (because it's the "largest") and move the M disks on top of it.
The vital addition: since M disks are to be moved to target in the second phase, initially they are to be moved into the spare.
This all means that if we knew how to move M disks, we could easily move M + 1. Induction, recursion, DONE!
If you knew all this already, apologies for the load of verbiage. The code:
hanoi(Disks, Moves):-
phrase( hanoi(Disks, [source,target,spare]), Moves).
hanoi( Disks, [S,T,R]) -->
{ append( M, [One], Disks) },
hanoi( M, [S,R,T]),
[ moving( One, from(S), to(T)) ],
hanoi( M, [R,T,S]).
hanoi( [], _) --> [ ].
Testing:
4 ?- hanoi([1,2,3], _X), maplist( writeln, _X).
moving(1,from(source),to(target))
moving(2,from(source),to(spare))
moving(1,from(target),to(spare))
moving(3,from(source),to(target))
moving(1,from(spare),to(source))
moving(2,from(spare),to(target))
moving(1,from(source),to(target)) ;
false.
Please can you explain what will i do to code this thing up on Prolog?
Mason, Alex, Steve,
and Simon arc standing in a police lineup. One of them is blond, handsome, and unscarred. Two
of them who are not blond are standing on either side of Mason. Alex is the only one standing
next to exactly one handsome man. Steve is the only one not standing next to exactly one scarred
man. Who is blond, handsome, and not scared?
i have here,
p --> standing(x,y)
twoOfThem(not blond, standing either side of Mason)
standing(mason,[x,y]):-
blond([x,y]) == false.
Alex only one standing next to exactly one handsome
standing(alex,x):-
handsome(x).
Steve is only not standing next to unscarred.
standing(steve,x):-
unscared(x).
without using CLP(FD), you should used combinatorial ability of Prolog expressing the problem and the constraints in appropriate way. For instance
puzzle(Name) :-
L = [[mason, Pos1, Blond1, Handsome1, UnScared1],
[alex, Pos2, Blond2, Handsome2, UnScared2],
[steve, Pos3, Blond3, Handsome3, UnScared3],
[simon, Pos4, Blond4, Handsome4, UnScared4]
],
permutation([1,2,3,4], [Pos1,Pos2,Pos3,Pos4]),
maplist(yn,
[Blond1, Handsome1, UnScared1,
Blond2, Handsome2, UnScared2,
Blond3, Handsome3, UnScared3,
Blond4, Handsome4, UnScared4
]),
...
Each variable (those symbols starting Uppercase!) is an attribute of a person, and can assume a value from the domain. yn/1 it's a service fact, allows those binary values to assume either yes or no:
yn(y).
yn(n).
The constraints can then be expressed in this way (just the first here)
...
% Two of them who are not blond are standing on either side of Mason.
member([mason, I1, _,_,_], L),
member([_, I2, n,_,_], L),
member([_, I3, n,_,_], L),
(I2>I1, I3>I1 ; I2<I1, I3<I1),
...
and the solution will be
% One of them is blond, handsome, and unscarred.
member([Name, _, y, y, y], L).
I'm not sure I understand every constraint (in English), indeed my program doesn't find a solution.
The program is rather slow, and calls for CLP(FD). Edit your question (add appropriate tag, for instance), if you are interested in a CLP(FD) solution.
I starting to study for my upcoming exam and I'm stuck on a trivial prolog practice question which is not a good sign lol.
It should be really easy, but for some reason I cant figure it out right now.
The task is to simply count the number of odd numbers in a list of Int in prolog.
I did it easily in haskell, but my prolog is terrible. Could someone show me an easy way to do this, and briefly explain what you did?
So far I have:
odd(X):- 1 is X mod 2.
countOdds([],0).
countOdds(X|Xs],Y):-
?????
Your definition of odd/1 is fine.
The fact for the empty list is also fine.
IN the recursive clause you need to distinguish between odd numbers and even numbers. If the number is odd, the counter should be increased:
countOdds([X|Xs],Y1) :- odd(X), countOdds(Xs,Y), Y1 is Y+1.
If the number is not odd (=even) the counter should not be increased.
countOdds([X|Xs],Y) :- \+ odd(X), countOdds(Xs,Y).
where \+ denotes negation as failure.
Alternatively, you can use ! in the first recursive clause and drop the condition in the second one:
countOdds([X|Xs],Y1) :- odd(X), !, countOdds(Xs,Y), Y1 is Y+1.
countOdds([X|Xs],Y) :- countOdds(Xs,Y).
In Prolog you use recursion to inspect elements of recursive data structs, as lists are.
Pattern matching allows selecting the right rule to apply.
The trivial way to do your task:
You have a list = [X|Xs], for each each element X, if is odd(X) return countOdds(Xs)+1 else return countOdds(Xs).
countOdds([], 0).
countOdds([X|Xs], C) :-
odd(X),
!, % this cut is required, as rightly evidenced by Alexander Serebrenik
countOdds(Xs, Cs),
C is Cs + 1.
countOdds([_|Xs], Cs) :-
countOdds(Xs, Cs).
Note the if, is handled with a different rule with same pattern: when Prolog find a non odd element, it backtracks to the last rule.
ISO Prolog has syntax sugar for If Then Else, with that you can write
countOdds([], 0).
countOdds([X|Xs], C) :-
countOdds(Xs, Cs),
( odd(X)
-> C is Cs + 1
; C is Cs
).
In the first version, the recursive call follows the test odd(X), to avoid an useless visit of list'tail that should be repeated on backtracking.
edit Without the cut, we get multiple execution path, and so possibly incorrect results under 'all solution' predicates (findall, setof, etc...)
This last version put in evidence that the procedure isn't tail recursive. To get a tail recursive procedure add an accumulator:
countOdds(L, C) :- countOdds(L, 0, C).
countOdds([], A, A).
countOdds([X|Xs], A, Cs) :-
( odd(X)
-> A1 is A + 1
; A1 is A
),
countOdds(Xs, A1, Cs).