Exercice sur les graphes en prolog

Help!
21

In looking at the original code I gave, it was doing a depth first search for each complete path, then reducing the paths to a list of sorted unique nodes. While that works, it is very inefficient because it visits the same node multiple times.

Here is some code that does it a different way and I am guessing is more what you seek.

First is next/2 which given a node returns only its neighbors in a sorted list. While this can be used, I gave it so that you could understand how findall/3 works.

next/2 
next(Start,Sorted_next) :-
    findall(Next,arc(Start,Next),Next_list),
    sort(Next_list,Sorted_next).

:- begin_tests(next).

test(1) :-
    next(a,Next_list),
    assertion( Next_list == [l,o] ).

test(2) :-
    next(o,Next_list),
    assertion( Next_list == [] ).

test(3) :-
    next(l,Next_list),
    assertion( Next_list == [v] ).

test(4) :-
    next(v,Next_list),
    assertion( Next_list == [l] ).

test(5) :-
    next(y,Next_list),
    assertion( Next_list == [o,v] ).

:- end_tests(next).

Second is closure/3 that is the transitive closure. The code was given in a StackOverflow question by a very reputable Prolog programmer so I did not change it. R_2 is the name of the facts that represents the edges (arc/2).

closure/3 
closure0(R_2, X0,X) :-
    closure0(R_2, X0,X, [X0]).

closure(R_2, X0,X) :-
    call(R_2, X0,X1),
    closure0(R_2, X1,X, [X1,X0]).

closure0(_R_2, X,X, _).
closure0(R_2, X0,X, Xs) :-
    call(R_2, X0,X1),
    non_member(X1, Xs),
    closure0(R_2, X1,X, [X1|Xs]).

non_member(_E, []).
non_member(E, [X|Xs]) :-
    dif(E,X),
    non_member(E, Xs).

:- begin_tests(closure).

test(1) :-
    findall(Closure,closure(arc,a,Closure),Closures),
    assertion( Closures == [o,l,v] ).

test(2) :-
    findall(Closure,closure(arc,o,Closure),Closures),
    assertion( Closures == [] ).

test(3) :-
    findall(Closure,closure(arc,l,Closure),Closures),
    assertion( Closures == [v] ).

test(4) :-
    findall(Closure,closure(arc,v,Closure),Closures),
    assertion( Closures == [l] ).

test(5) :-
    findall(Closure,closure(arc,y,Closure),Closures),
    assertion( Closures == [v,l,o] ).

:- end_tests(closure).

The only reason for using sort/2 is to normalize the results so that the test cases are easier to write, in other words I don’t have to check every ordering of the values in a list.

22

For preventing cycles in the paths through the graph, there are two strategies:

  1. Check whether a new item would create a cycle in the path.
  2. Check that an existing path has a cycle.

Let’s use strategy #1 because it’s more efficient. (Strategy #2 would add a node, creating a new path, then discard the path if it has a cycle; strategy #1 doesn’t add a node at all if the path would be rejected.)

How would you check whether a node is in an existing path? If you’re not sure how to write this in Prolog, then write how you would do the check in precise language (English or French – I can translate). You might also want to use a different notation for a path – my [arc(a,l),arc(l,v),arc(v,l)] is more complicated than necessary.

Montrez-le moi, s.v.p. (Je peut lire français, mais je préfère anglais.)

PS: En anglais, “un nœud du graphe” est “a node in a graph”, pas “a knot”. Et “arc” est “arc”, pas “arch”. Merci pour avoir pris l’effort d’écrire en anglais.

23

exo4
exo4793×611 80.9 KB

Voilà l’exercice.

24

exo4 suite
exo4 suite796×317 60.9 KB

Et la suite

25

Google translation to English:

Hello. I need help with an exercise. First, I don’t think I understood it well. Here is the statement:

Well done, you just got hired as a university detective. Your task is to mercilessly shut up the gangs of corrupt teachers and students.

Sounds like Macron’s view of the current demonstrations. The students and workers have a much different view.

The advantage is that depending on the structure of the band, it may be enough to capture a small group of people to also embark everything else, by “avalanche” effect. However, your career is just starting and you risk having many groups of dishonest people put behind bars. So you would like to have a program that does the dirty work for you. Fortunately, you have taken a course in discrete methods. You can therefore model these mafias as follows. Let us call M a set of malicious people. In order to capture the structure of the group we will introduce a binary relation A (like “Avalanche”) which associates two people p1, p2 of M. We will note p1Ap2 to say “if we catch p1, p2 also falls”. Warning! A is not symmetrical (the laws of thugs are sometimes impenetrable). The puzzles to solve are:

  1. Given (M, A) and F ⊆ M, determine all the people that will be captured by the relation A starting from F.
  1. For a given pair (M, A), find the minimum groups of people by inclusion that allow everyone to be captured. In other words, we want to find the smallest F whose answer would be M in the previous question.
  1. Calculate all the sets of “catchable” people, that is to say the F ⊆ M who do not allow to embark other people than those of F. In other words, we are looking for the F ⊆ M for which the first question returns F.

exo4 suite

In the case of the example I did this:

arc (a, o).

arc (a, l).

arc (l, v).

arc (v, l).

arc (y, v).

arc (y, o).

successor (X, Y): - arc (X, Y).

The successor predicate answers the first two questions. But for example for the first question F = {a, y}, it is necessary to make successor (a, X) then successor (y, X) to find all the solutions.

Indeed. You need to use recursion. Note that you must check to avoid following path loops (such as l → v → l → …).

And you need to decide how to represent the set F.

For the second question, just put the unknown parameter in the first position. But it’s too easy to be the solution.

Indeed it is, especially since you need to find the smallest solution(s) (there may be more than one such).

My goal is to write a predicate that will return the list of solutions for each of the first 2 questions.

I suggest you manually work through both (1) and (2) before starting to code them.

Thank you in advance…

HTH.

26

I already use recursion.
arcs(a, [l, o]).
arcs(l, [v]).
arcs(v, [l]).
arcs(y, [o, v]).

transform(X, Y) is true if Y is the set got
from the list X , keeping the order

supprime_All(X,L,R):- delete(L,X,R).
transform([],[]).
transform([X|L], [X|R]):-
supprime_All(X,L,Z),
transform(Z,R).

union (X, Y, Z) is true if Z is the union of sets X and Y
union([], B, B).

union([T|R], B, Y) :- union(R, B, Q),
transform([T|Q], Y).

And then I just write these two predicates

suivant_2([X], [X|Y]) :- arcs(X, Y).
test([], []).
test([T|R], Z) :- suivant_2([T], Y),
test(R, E),
union(Y, E, Z).
Look at this

? - test([l, y], R) R = [l, v, y, o]
?- test([a, y], R) R = [a, l, o, y, u]
?- test([a]) R = [a, l, o]
? - test([o]) R = [o]
? - test([l]) R = [l, v]
? - test([v]) R = [v, l]
?- test([y]) R = [o, v, ]

27

Completely unrelated to everything said by everyone above, I notice two things:

  1. The problem statement is high-quality material and I approve strongly. I actually thought that @barb is joking at first. I hope your professor is lurking on this forum and reads my comment: well done!
  2. This, yet again, is the kind of problem that can be modelled using library(ugraphs). It gives you (for free) predicates to find the transitive closure of your graph, to transpose your graph, find reachable nodes and so on.
28

Reference: library(ugraphs)

For those not familiar with how the online documentation for SWI-Prolog works. If a predicate has a image for it, then clicking on image will take you to the Prolog source code implementing the predicate, e.g.

neighbors(+Vertex, +Graph, -Neigbours) is det

the link will take you to source code

For those perusing the source code, you will run into warshall, which is noted in Floyd–Warshall algorithm (Wikipedia) (pdf)

29

The professor made it clear that it is forbidden to use predefined predicates. We have to write down all the predicates.

30

Hello§
today is my last day to succeed in this exercise. I found the first question thanks to EricGT’s help. I just have to ffind the last question.

31

First, let’s do a recursive solution to finding whether there’s a way to get from P to Q (don’t worry about the table directive – it prevents infinite recursion in this situation):

:- table successor/2.

successor(P, Q) :- arc(P, Q).
successor(P, Q) :- arc(P, R), successor(R, Q).
?- forall(successor(P,Q), writeln(P->Q)).

l->l
l->v
v->l
v->v
a->o
a->l
a->v
y->o
y->v
y->l

The question then arises of how to capture the intermediate steps between P and Q. You can add a 3rd argument, to capture the path. Here’s one way of writing the predicate:

successor(P, Q, [P->Q]) :- arc(P, Q).
successor(P, Q, Path) :-
    arc(P, R),
    successor(R, Q, PathRQ),
    append([P->R], PathRQ, Path).

You can think of the 3rd argument as being the result of the predicate, like this in some hypothetical non-deterministic functional language (where “++” means list concatenation):

successor(P, Q) = [P->Q] if arc(P,Q)
successor(P, Q) = [P->R] ++ PathPR 
                  if arc(P,R) and PathPR = successor(R,Q)

When you try running this, however, it goes into an infinite loop on backtracking (the table directive, unfortunately, won’t help here):

?- forall(successor(P,Q,Path), writeln(P->Q:Path)).
a->o:[(a->o)]                                                                                                           
a->l:[(a->l)]
l->v:[(l->v)]
v->l:[(v->l)]
y->v:[(y->v)]
y->o:[(y->o)]
a->v:[(a->l),(l->v)]                                                                                                    
a->l:[(a->l),(l->v),(v->l)]
a->v:[(a->l),(l->v),(v->l),(l->v)]
a->l:[(a->l),(l->v),(v->l),(l->v),(v->l)]
a->v:[(a->l),(l->v),(v->l),(l->v),(v->l),(l->v)]
a->l:[(a->l),(l->v),(v->l),(l->v),(v->l),(l->v),(v->l)]
a->v:[(a->l),(l->v),(v->l),(l->v),(v->l),(l->v),(v->l),(l->v)]
a->l:[(a->l),(l->v),(v->l),(l->v),(v->l),(l->v),(v->l),(l->v),(v->l)]
... etc. ...

So, the problem now is: how do you prevent this infinite loop?
Hint: how would you prevent the Path having cycles in it?

32

the solution you propose requires the use of predefined predicates such as append, write, etc. As part of my exercise this is prohibited. But following your approach I will try to write a predicate for my 2nd question. Thanks.

33

arcs(a, [l, o]).
arcs(l, [v]).
arcs(v, [l]).
arcs(y, [o, v]).

supprime_All(X,L,R):- delete(L,X,R).
transform([],[]).
transform([X|L], [X|R]):-
supprime_All(X,L,Z),
transform(Z,R).

union([], B, B).
union([T|R], B, Y) :- union(R, B, Q),
transform([T|Q], Y).

suivant_2([X], [X|Y]) :- arcs(X, Y).

capture([], []).
capture([T|R], Z) :- suivant_2([T], Y),
capture(R, E),
union(Y, E, Z).

?- capture([a, l], R).
R = [a, l, o, v].
It’s not the better solution, but it works.

But when I try this :
?- capture(X, [a, l, o, v, y])
that should answer the second question, but it doesn’t work.

34

I think you have one basic idea correct – at each stage, remove the “current” node from the solutions, to prevent cycles. That approach can also be applied to the method I was suggesting (I’ll comment on that in a separate post, when I have a bit more time).

I do not understand the predicate supprime_All/3 (which translates into English as delete_all/3 – it merely calls the builtin delete/3, which only deletes one item. If you want to delete all, try this:

delete_all(X, [], []).
delete_all(X, [X|Xs], Ys) :- !, delete_all(X, Xs, Ys).
delete_all(X, [X1|Xs], [X1|Ys]) :- delete_all(X, Xs, Ys).

After re-reading all three problems, I think that the instructor has given a rather difficult exercise for students who are just beginning with Logic Programming, especially if they aren’t allowed to use builtin predicates such as append/3 (although I notice that OP has used delete/3 in their solution). For example, question #2 is fairly easily answered by using (bagof/3 and length/2), if question #1 has been answered with a predicate that also computes the connections between people.

36

Question 1
capture([], []).
capture([T|R], Z) :- suivant_2([T], Y),
capture(R, E),
union(Y, E, Z).

? - capture([a,l],R)
R = [l, a, o, v]

Question 2
test_1(X, M) :- suivant_2(U, V),
suivant_2(T, Y),
union(U, T, X),
union(V, Y, M),!.

? - test_1(R, [a,l,o,y,v]).
R = [a, y]

Question 3
test_2(X) :-capture(X, X).

?-test_2®.
R = [l, v]

Add these predicates
This version works.

37

It is impossible to do I/O without write. :wink:
But I’ll show how to change successor/3 to not use append/3` and also show another way of appending.

The typical definition of append/3 is:

append([], Xs, Xs).
append([X|Xs], Ys, [X|Zs]) :- append(Xs, Ys, Zs).

If you look at my successor/3 predicate, you can see that it uses a constrained form of calling append/3, namely append([P->R], PathRq, Path) – the first argument is always a 1-element list. This only matches clause #2 of append/3, so we can rewrite successor/3:

successor(P, Q, [P->Q]) :- arc(P, Q).
successor(P, Q, Path) :-
    arc(P, R),
    successor(R, Q, PathRQ),
    X=(P->R), Xs=[], Ys=PathRQ, Path=[X|Path2], append([], Ys, Path2).

which simplifies (using clause #1 of append/3) to

successor(P, Q, [P->Q]) :- arc(P, Q).
successor(P, Q, [P->R|PathRQ]) :-
    arc(P, R),
    successor(R, Q, PathRQ)

This is a general technique in Prolog (an “idiom”, if you wish), for building a result in order:

pred([], []).
pred(X|Xs], [Y|Xs]) :- transform(X, Y), pred(Xs, Ys).

If you want to pass the built-up list (e.g., for detecting cycles), then you need an auxiliary list:

pred(Xs, Ys) :- pred(Xs, [], Ys).  % pred/2
pred([], _, Ys).                   % pred/3
pred([X|Xs], XsToHere, [Y|Ys]) :-  % pred/3
    transform(X, XsToHere, Y),
    append(XsToHere, [X], XsToHere2),
    pred(Xs, XsToHere2, Ys).

and if you don’t care about the order of elements in the auxiliary list (or if you want them in reverse order):

pred(Xs, Ys) :- pred(Xs, [], Ys).
pred([], _, Ys).
pred([Xs|Xs, XsToHere, [Y|Ys]) :-
    transform(X, XsToHere, Y), 
    pred(Xs, [X|XsToHere], Ys).

If you’re familiar with functional languages, they often build the list in reverse order using an auxiliary argument, and then reverse the result. In Prolog, you can build the list in order, using the power of logical variables.

There are many variations on these idioms, such as filter/2:

filter([], []).
filter([X|Xs], Zs) :-
    (  filter_test(X)   % if filter_test/1 succeeds
    -> Zs = [X|Ys]      % then keep X in the result
    ;  Zs = Ys          % otherwise omit X from result
    ),
    filter(Xs, Ys).     % recurse along the list

This can get tedious to write, so the DCG notation can be used to simplify the code; but that’s a lesson for another day.

38

Thank you very much Peter.ludemann. Peter.ludemann