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 have created a program in prolog which should give me all possible routes between two stations. In each route each station should only get visited once. My code so far is:
% facts
connection(s1,s2).
connection(s1,s4).
connection(s2,s3).
connection(s2,s5).
connection(s3,s4).
connection(s4,s5).
connection(s5,s6).
connection(s6,s1).
% predicates
direction1(X,Y) :- connection(X,Y).
direction2(X,Y) :- connection(Y,X).
route1(X,Y,R):- route1(X,Y,[],R).
route1(X,Y,_,[X,Y]) :- direction1(X,Y).
route1(X,Y,L,R) :- \+direction1(X,Y), direction1(X,Z), \+member(Z,L), route1(Z,Y,[Z|L],RZ), R=[X|RZ].
route2(X,Y,R):- route2(X,Y,[],R).
route2(X,Y,_,[X,Y]) :- direction2(X,Y).
route2(X,Y,L,R) :- \+direction2(X,Y), direction2(X,Z), \+member(Z,L), route2(Z,Y,[Z|L],RZ), R=[X|RZ].
route(X,Y,R) :- route1(X,Y,R); route2(X,Y,R).
The problem is that prolog doesn't give me all routes, for exampel when I ask for route[s1,s4,R], prolog doesn't give me the route [s1,s2,s3,s4]. I think it is caused by "+direction1(X,Y)" and "+direction2(X,Y)". But I need this to prevent prolog visiting a station multiple times in a route. Any ideas how to fix this?
Thanks in advance!
A minimally invasive fix would be to remove the \+direction1(X,Y) that you correctly identified as the source of this failure, and to add another \+ member(X, L) guard in the definition of route1/4.
EDIT: The above does not suffice. Here is a cleaner rewrite of the whole thing, with more readable formatting and variable names:
route1(X,Y,R):- route1(X,Y,[X],R). % note that X is visited immediately
route1(X,Y,_,[X,Y]) :- direction1(X,Y).
route1(X, Y, Visited, Route) :-
direction1(X, Z),
Z \= Y,
\+ member(Z, Visited),
route1(Z, Y, [Z|Visited], Route1),
Route = [X|Route1].
You should then probably unify the two variants of the route predicates: One of them only finds routes that are only along "direction 1" edges and the other only the ones along "direction 2" edges. In general, you will want to be able to traverse any edge in any direction.
I am very new to prolog and although I’ve read some books I can definitely tell that my programming brain can’t think the Prolog way. The problem I would like to solve is pretty simple (I believe). I will describe it via an example.
Let’s say that I have a graph that contains 4 “types” of nodes and 3 edges that connect the nodes. The types can be A, B, C or D and as you can see from the image below (see Figure 1), A can be connected with B and C (A_To_B and A_To_C edges respectively), while C can be connected to D (C_To_D edge). There’s also an additional rule not shown on the picture: A can be connected to at most 1 C.
I would like to express these simple rules in Prolog to solve the problem shown in the second picture. There are 3 nodes which type is missing (labeled X?, Y? and Z?). By applying the above rules in my mind I can easily find that X? and Z? are of B type (as A can connect to no more than 1 Cs) and Y? is of type D as C can only connect to D.
Could please provide me any help on that? I am not writing just to pick the solution. I would like to learn Prolog as well so any suggestion on a book that explains Prolog to people who have never worked on such concepts before like me would be very welcome.
EDIT: Example that fails
I came up with the following two examples:
For example 1, the rules are
can_connect(a,b,_).
can_connect(a,c,1).
link(1,2).
type(1,a).
type(2,_).
The possible solutions returned are [b,c] which is correct as we request at most 1 link from A to C meaning that 0 links is also acceptable.
In example 2 the rules change to the following:
can_connect(a,b,_).
can_connect(a,c,**2**).
link(1,2).
link(1,3).
type(1,a).
type(2,_).
type(3,c).
Running the code here returns [c] which is wrong. b is also an acceptable solution as we require again at most 2 A to C links which means that having only 1 is OK.
I spent this weekend trying to figure out the solution. First of all, I believe that it works as intended in Example 1 simply because there's no link from A to C instantiated in the proposed solution (where checking if 2 can be b), so the can_connect(a,c,1) is not checked so the proposed solution is getting accepted. In Example 2, there's one A to C link already there so the can_connect(a,c,2) is checked and the solution where node 2 has type b is rejected as the rule checks if there are exactly 2 and not at most 2 links from A to C.
I find a solution which works at these scenarios but fails at some others. Here it is:
% value #3 is the lower bound and #4 is the upper bound.
can_connect(a,b,0,500).
% A C node can be connected by 0, 1 or 2 A nodes
can_connect(a,c,0,2).
can_connect(d,c,1,1).
can_connect(c,e,0,1).
%The same as previous solution
link(1,2).
link(1,3).
% No change here
type(1,a).
type(2,_).
type(3,c).
% No change here
node_type(N, NT) :-
type(N, NT),
nonvar(NT),
!. % assume a node has only one type
% No change here
node_type(N, NT) :-
assoc_types(Typed),
maplist(check_connections(Typed), Typed),
memberchk(N:NT, Typed).
% No change here
assoc_types(Typed) :-
findall(N, type(N, _), L),
maplist(typed, L, Typed).
% No change here
typed(N, N:T) :-
type(N, T),
member(T, [a,b,c]).
% Changes here
check_connections(Graph, N:NT) :-
forall(link(N, M), (
memberchk(M:MT, Graph),
can_connect(NT, MT, L, U),
findall(X, (link(N, X), memberchk(X:MT, Graph)), Ts),
mybetween(L, U, Ts),
forall(can_connect(NT, Y, LM, UM), (
findall(P, (link(N,P),memberchk(P:Y, Graph)), Ss),
length(Ss, SsSize ),
SsSize>=LM,
SsSize=<UM
))
)).
% It is used to find if the length of a list is between two limits.
mybetween(Lower, Upper, MyList) :-
length(MyList, MySize),
MySize=<Upper,
MySize>=Lower.
This solution fails in this example
In this example, X? must be always b, Y? must always be C and Z? must always be D. It finds X? and Y? correctly but not Z?. I believe after some debugging that this is due the fact that in the current implementation I only check the can_connect rules that are related with links that start from a node and not that end to a node. However, I am not sure at all about that.
Any help is appreciated.
the representation of the problem needs to disambiguate nodes names, so we can express the links appropriately
now we can write
can_connect(a,b,_).
can_connect(a,c,1).
can_connect(c,d,_).
link(1,2).
link(1,3).
link(1,4).
link(4,5).
link(4,6).
link(7,4).
link(7,8).
type(1,a).
type(2,b).
type(3,_).
type(4,c).
type(5,d).
type(6,_).
type(7,a).
type(8,_).
The underscore (anonymous variable) in Prolog plays a role similar to NULL in SQL, it can assume any value.
So, a first snippet
node_type(N, NT) :- type(N, NT), nonvar(NT), !. % assume a node has only one type
can be used to express what we know about the problem.
Facts can_connect/3 then can be read like
a can connect to any number of b
a can connect to just 1 c
etc
Where we don't know the node type, a complex rule is needed, that infers the type of source node from the type of target node, and accounts for the counting constraint, something like
node_type(N, NT) :-
link(M, N),
type(M, MT),
can_connect(MT, NT, C),
aggregate(count, Y^(link(M, Y), type(Y, NT)), C).
?- forall(between(1,8,N), (node_type(N,T),writeln(N:T))).
1:a
2:b
3:b
4:c
5:d
6:d
7:a
8:b
true.
edit if your Prolog doesn't have library(aggregate), from where aggregate/3 has been loaded, you can try
node_type(N, NT) :-
link(M, N),
type(M, MT),
can_connect(MT, NT, C),
findall(t, (link(M, Y), type(Y, NT)), Ts), length(Ts, C).
edit first of all, the updated graph, marked with types where known:
my previous code worked only under very restricted assumptions. Here is something more general, that checks the constraints over the full graph (as was suggested by #false comment), with a 'generate and test' approach.
node_type(N, NT) :-
assoc_types(Typed),
maplist(check_connections(Typed), Typed),
memberchk(N:NT, Typed).
assoc_types(Typed) :-
findall(N, type(N, _), L),
maplist(typed, L, Typed).
typed(N, N:T) :- type(N, T), member(T, [a,b,c,d]).
check_connections(Graph, N:NT) :-
forall(link(N, M), (
memberchk(M:MT, Graph),
can_connect(NT, MT, C),
aggregate(count, X^(link(N, X), memberchk(X:MT, Graph)), C)
)).
now ?- node_type(4,X). fails...
Given the following facts in a database:
foo(a, 3).
foo(b, 2).
foo(c, 4).
foo(d, 3).
foo(e, 2).
foo(f, 6).
foo(g, 3).
foo(h, 2).
I want to collect all first arguments that have the smallest second argument, plus the value of the second argument. First try:
find_min_1(Min, As) :-
setof(B-A, foo(A, B), [Min-_|_]),
findall(A, foo(A, Min), As).
?- find_min_1(Min, As).
Min = 2,
As = [b, e, h].
Instead of setof/3, I could use aggregate/3:
find_min_2(Min, As) :-
aggregate(min(B), A^foo(A, B), Min),
findall(A, foo(A, Min), As).
?- find_min_2(Min, As).
Min = 2,
As = [b, e, h].
NB
This only gives the same results if I am looking for the minimum of a number. If an arithmetic expression in involved, the results might be different. If a non-number is involved, aggregate(min(...), ...) will throw an error!
Or, instead, I can use the full key-sorted list:
find_min_3(Min, As) :-
setof(B-A, foo(A, B), [Min-First|Rest]),
min_prefix([Min-First|Rest], Min, As).
min_prefix([Min-First|Rest], Min, [First|As]) :-
!,
min_prefix(Rest, Min, As).
min_prefix(_, _, []).
?- find_min_3(Min, As).
Min = 2,
As = [b, e, h].
Finally, to the question(s):
Can I do this directly with library(aggregate)? It feels like it should be possible....
Or is there a predicate like std::partition_point from the C++ standard library?
Or is there some easier way to do this?
EDIT:
To be more descriptive. Say there was a (library) predicate partition_point/4:
partition_point(Pred_1, List, Before, After) :-
partition_point_1(List, Pred_1, Before, After).
partition_point_1([], _, [], []).
partition_point_1([H|T], Pred_1, Before, After) :-
( call(Pred_1, H)
-> Before = [H|B],
partition_point_1(T, Pred_1, B, After)
; Before = [],
After = [H|T]
).
(I don't like the name but we can live with it for now)
Then:
find_min_4(Min, As) :-
setof(B-A, foo(A, B), [Min-X|Rest]),
partition_point(is_min(Min), [Min-X|Rest], Min_pairs, _),
pairs_values(Min_pairs, As).
is_min(Min, Min-_).
?- find_min_4(Min, As).
Min = 2,
As = [b, e, h].
What is the idiomatic approach to this class of problems?
Is there a way to simplify the problem?
Many of the following remarks could be added to many programs here on SO.
Imperative names
Every time, you write an imperative name for something that is a relation you will reduce your understanding of relations. Not much, just a little bit. Many common Prolog idioms like append/3 do not set a good example. Think of append(As,As,AsAs). The first argument of find_min(Min, As) is the minimum. So minimum_with_nodes/2 might be a better name.
findall/3
Do not use findall/3 unless the uses are rigorously checked, essentially everything must be ground. In your case it happens to work. But once you generalize foo/2 a bit, you will lose. And that is frequently a problem: You write a tiny program ; and it seems to work.
Once you move to bigger ones, the same approach no longer works. findall/3 is (compared to setof/3) like a bull in a china shop smashing the fine fabric of shared variables and quantification. Another problem is that accidental failure does not lead to failure of findall/3 which often leads to bizarre, hard to imagine corner cases.
Untestable, too specific program
Another problem is somewhat related to findall/3, too. Your program is so specific, that it is quite improbable that you will ever test it. And marginal changes will invalidate your tests. So you will soon give up to perform testing. Let's see what is specific: Primarily the foo/2 relation. Yes, only an example. Think of how to set up a test configuration where foo/2 may change. After each change (writing a new file) you will have to reload the program. This is so complex, chances are you will never do it. I presume you do not have a test harness for that. Plunit for one, does not cover such testing.
As a rule of thumb: If you cannot test a predicate on the top level you never will. Consider instead
minimum_with(Rel_2, Min, Els)
With such a relation, you can now have a generalized xfoo/3 with an additional parameter, say:
xfoo(o, A,B) :-
foo(A,B).
xfoo(n, A,B) :-
newfoo(A,B).
and you most naturally get two answers for minimum_with(xfoo(X), Min, Els). Would you have used findall/3 instead of setof/3 you already would have serious problems. Or just in general: minmum_with(\A^B^member(A-B, [x-10,y-20]), Min, Els). So you can play around on the top level and produce lots of interesting test cases.
Unchecked border cases
Your version 3 is clearly my preferred approach, however there are still some parts that can be improved. In particular, if there are answers that contain variables as a minimum. These should be checked.
And certainly, also setof/3 has its limits. And ideally you would test them. Answers should not contain constraints, in particular not in the relevant variables. This shows how setof/3 itself has certain limits. After the pioneering phase, SICStus produced many errors for constraints in such cases (mid 1990s), later changed to consequently ignoring constraints in built-ins that cannot handle them. SWI on the other hand does entirely undefined things here. Sometimes things are copied, sometimes not. As an example take:
setof(A, ( A in 1..3 ; A in 3..5 ), _) and setof(t, ( A in 1..3 ; A in 3.. 5 ), _).
By wrapping the goal this can be avoided.
call_unconstrained(Goal_0) :-
call_residue_vars(Goal_0, Vs),
( Vs = [] -> true ; throw(error(representation_error(constraint),_)) ).
Beware, however, that SWI has spurious constraints:
?- call_residue_vars(all_different([]), Xs).
Xs = [_A].
Not clear if this is a feature in the meantime. It has been there since the introduction of call_residue_vars/2 about 5 years ago.
I don't think that library(aggregate) covers your use case. aggregate(min) allows for one witness:
min(Expr, Witness)
A term min(Min, Witness), where Min is the minimal version of Expr over all solutions, and Witness is any other template applied to solutions that produced Min. If multiple solutions provide the same minimum, Witness corresponds to the first solution.
Some time ago, I wrote a small 'library', lag.pl, with predicates to aggregate with low overhead - hence the name (LAG = Linear AGgregate). I've added a snippet, that handles your use case:
integrate(min_list_associated, Goal, Min-Ws) :-
State = term(_, [], _),
forall(call(Goal, V, W), % W stands for witness
( arg(1, State, C), % C is current min
arg(2, State, CW), % CW are current min witnesses
( ( var(C) ; V #< C )
-> U = V, Ws = [W]
; U = C,
( C == V
-> Ws = [W|CW]
; Ws = CW
)
),
nb_setarg(1, State, U),
nb_setarg(2, State, Ws)
)),
arg(1, State, Min), arg(2, State, Ws).
It's a simple minded extension of integrate(min)...
The comparison method it's surely questionable (it uses less general operator for equality), could be worth to adopt instead a conventional call like that adopted for predsort/3. Efficiency wise, still better would be to encode the comparison method as option in the 'function selector' (min_list_associated in this case)
edit thanks #false and #Boris for correcting the bug relative to the state representation. Calling nb_setarg(2, State, Ws) actually changes the term' shape, when State = (_,[],_) was used. Will update the github repo accordingly...
Using library(pairs) and [sort/4], this can be simply written as:
?- bagof(B-A, foo(A, B), Ps),
sort(1, #=<, Ps, Ss), % or keysort(Ps, Ss)
group_pairs_by_key(Ss, [Min-As|_]).
Min = 2,
As = [b, e, h].
This call to sort/4 can be replaced with keysort/2, but with sort/4 one can also find for example the first arguments associated with the largest second argument: just use #>= as the second argument.
This solution is probably not as time and space efficient as the other ones, but may be easier to grok.
But there is another way to do it altogether:
?- bagof(A, ( foo(A, Min), \+ ( foo(_, Y), Y #< Min ) ), As).
Min = 2,
As = [b, e, h].
I have defined list of doors in rooms:
class facts
door : (string Room1, string Room2).
skarb : (string Skarb, string Room).
class predicates
go : (string Room1, string Room2, string* R_list) nondeterm anyflow.
is_Member : (string Room, string* R_list) nondeterm .
write_list : (string* R_list) nondeterm .
clauses
door("a", "b").
door("b", "e").
door("b", "c").
door("d", "e").
door("c", "d").
door("e", "f").
door("g", "e").
door("g", "a").
door("h", "b").
door("h", "a").
door("h", "f").
door("i", "b").
door("i", "h").
door("i", "c").
door("i", "k").
skarb("bomba", "d").
And some Predicates:
go(Room, Room, R_list) :- stdio::write("\n\nJest droga:"), write_list(R_list), !.
go(Room1, Room2, R_list) :- door(Room1, X), not(is_Member(X, R_list)), go(X, Room2, [X | R_list]).
go(Room1, Room2, R_list) :- door(X, Room1), not(is_Member(X, R_list)), go(Room2, X, [X | R_list]).
is_Member(Room, [Room | _]) :- !. is_Member(Room, [_ | Tail]) :- is_Member(Room, Tail).
write_list([]) :- !.
write_list([Head | Tail]) :- stdio::write( Head), write_list(Tail).
And I'm looking for a way from room to room:
run():-
stdio::write("\nDroga z a do f"),
R_list=["a"],
go("a", "f", R_list),
fail.
This predicate works and return:
Jest droga:feba
Jest droga:fedcba
Which is list of rooms, that I must pass the from a to f.
run():-
stdio::write("\nDroga z f do a"),
R_list=["f"],
go("f", "a", R_list),
fail.
But this one, returns nothing. And As you may notice it's just reverse of the previous case.
This question smells a lot like homework. You should tag it appropriately.
door(A, B) here is a directed edge from A to B
door(A, B) in your definition does not also imply door(B, A)
In fact, f doesn't lead to any other rooms. It's a dead end, more or less.
Disclaimer: I'm not sure if there's a better way than the way I'm suggesting.
Also, I'm not positively sure path is written correctly, as I can't test it right now.
You could build a new rule like so:
reversible_door(A,B):- door(A,B).
reversible_door(A,B):- door(B,A).
But you still have to watch out for cycles. You can avoid cycles by tracking visited rooms.
path(A,B,_):- reversible_door(A,B).
path(A,B,Nodes):- reversible_door(A,X),
not(member(X,Nodes)),
path(X,B,[A|Nodes]).
Of course, this is also assuming there are no self edges, like door(A, A). If that's already implied, great. But you can also check for that, if you wanted to.
This isn't directly related to the question, but you can check if a room has a 'bomba' with not(skarb("bomba",A))