Find all possible paths w/o loops in Graph in Prolog - path

I got an homework assignment for my logic course, but more or less don't have any clue how to solve it...
With a query like
?- find(a,[r(a,[b,d]),r(b,[a,c,e]),r(c,[b]),r(d,[a,e]),
r(e,[b,d,f]),r(f,[e,g]),r(g,[f])],Path).
Prolog should return all possible paths in the given graph. The terms r(X,List) define the graph, meaning that the nodes in List can be reached from node X. In this case, the output would be:
Path = [a,b,c] ;
Path = [a,b,e,d] ;
Path = [a,b,e,f,g] ;
Path = [a,d,e,b,c] ;
Path = [a,d,e,f,g] ;
false.
Although I get the hang of the numerous solutions here on SE and on the web in general to similar problems, I'm somehow too dumb to figure out how to work with the definition of the graph in this assignment.
I figure that find(Start,...) should be called recursively with all members of the list in r(Start,List), but as a total newbie to Prolog(we just did the standard family tree stuff...) I don't know how to do that.
Any help would be really appreciated. I'm aware of the fact that I don't have much to start with, but I already spent half a night trying to figure something out and up to now I don't have a clue.
/Edit:
For starters, I think I'll need some kind of base case to abort the recursion.
I think it should be either
find([],_,_).
because I guess that the last recursive call wouldn't have anything to start with, or
find(_,[],_).
assuming that the list of the terms defining adjacent nodes should be empty when the program finished processing it.
Now the actual call. Probably something like
find(Start,[r(Start,[Adjacent|Restadj])|Rest],Path):-
find(???).
My problems here are the following:
-How do I make the program use the members of the list in the r(...) term as the next Start?
-How do I check if a node has already been "visited"/ How can I remove a node from a specific list in r
-How do I put the found nodes into the Path list? Simply append? Or execute the recursive call with something like [Path|Start]?
As you see, it's not much. Some suggestive questions would be nice, since Prolog seems quite interesting and therefore fun to learn...
After spending some time with the neat PDT-Eclipse trace tool, I think I understood what the program is doing. What I dont't get at this point is why the last node always gets lost. After backtracking fails, for example because r(c,[b]) is the next found term and memberchk(b,[b]) fails because of the negation(that's what I thing + does) and no other term with r(c,X) can be found, it starts over with looking for other possibilities to go from node b, which has adjacent nodes left in r(b,[...]). But why does the program forget to put node c into the Path list? Is there a possibility to do some kind of if-then-else in case
member(r(Node, Adjacent), Graph),
member(AdjNode, Adjacent),
\+ memberchk(AdjNode, Seen),
fails, to still append the last node to Path?

I suspect what's tripping you up here is that instead of getting the data out of the database, you're having to find it from within an explicit data structure. A first crack at this might look like this:
find(_, _, []).
find(Node, Graph, [Node|Path]) :-
member(r(Node,Adjacent), Graph),
member(AdjNode, Adjacent),
find(AdjNode, Graph, Path).
See how I'm using member/2 to find data from within the graph. This solution isn't correct though, because it loops. An improvement might be this:
find(Node, Graph, Path) :- find(Node, Graph, Path, []).
find(_, _, [], _).
find(Node, Graph, [Node|Path], Seen) :-
member(r(Node, Adjacent), Graph),
member(AdjNode, Adjacent),
\+ memberchk(AdjNode, Seen),
find(AdjNode, Graph, Path, [Node|Seen]).
This one is basically the same as the above version except it has a "seen" list to track where it has already been. This still doesn't produce the output you want, but I think it will be enough to get you on the right track.
Edit in response to your edit,
For starters, I think I'll need some kind of base case to abort the recursion.
Yes. I chose your first case because I don't think you can safely "consume" the graph during traversal. I suppose you could use select/3 in lieu of member/2 and pass the graph-without-this-node onward. That might be an interesting thing to try (suggestion!).
How do I make the program use the members of the list in the r(...) term as the next Start?
As demonstrated, use member/2 to retrieve things from the graph. It's funny, because you used the exact word for the predicate you need. :)
How do I check if a node has already been "visited"/ How can I remove a node from a specific list in r
As demonstrated in my second set of code, you have another parameter for your auxiliary predicate, and use memberchk/3 or member/3.
How do I put the found nodes into the Path list? Simply append? Or execute the recursive call with something like [Path|Start]?
I went with the recursive call. append/3 would be more expensive.
Edit: Using findall/3 per Will's comment, we can find all the paths at once:
all_paths(From, Graph, Paths) :- findall(Path, find(From, Graph, Path), Paths).
You can invoke this like so:
?- all_paths(a, [r(a,[b,d]),r(b,[a,c,e]),r(c,[b]),r(d,[a,e]),
r(e,[b,d,f]),r(f,[e,g]),r(g,[f])], AllPaths).
I haven't tested that but it should work.

building on the excellently clear code by Daniel Lyons, a breadth first search:
all_paths(Node, Graph, Paths) :-
bfs(Graph, [[Node]-[]], R, []), % or dfs(...)
maplist( fst, Paths, R).
fst(A, A-_). % utility
pair(B, A, A-B). % helpers
add(LS,H,[H|LS]). %
bfs(_G, [], Z, Z). % queue is empty
bfs(Graph, [H|Q], [H|R], Z) :-
H = Path-Seen, Path = [Node|_],
findall( Next, member(r(Node, Next), Graph), NS),
flatten_diff( NS, Seen, WS), % working set of nodes
maplist( add(Path), WS, PS), % new paths
maplist( pair([Node|Seen]), PS, QH), % new addition to the queue
%% append( QH, Q, Q2), % DFS
append( Q, QH, Q2), % BFS
bfs(Graph, Q2, R, Z).
(not tested). flatten_diff(A,B,C) should flatten list of lists A, while removing the elements of it that appear also in list B, producing the list C as the result.
As PeterPanter has noticed, Daniel Lyons's code needs a little tweaking, to not exclude the very last node in its resulting paths.
find(Node, Graph, [Node|Path]) :- find(Node, Graph, Path, []).
find(_, _, [], _).
find(Node, Graph, [AdjNode|Path], Seen) :-
member(r(Node, Adjacent), Graph),
member(AdjNode, Adjacent),
\+ memberchk(AdjNode, Seen),
find(AdjNode, Graph, Path, [Node|Seen]).
There are no empty paths produced now, and it works as expected:
11 ?- find(a,[r(a,[b,d]),r(b,[a,c,e]),r(c,[b]), r(d,[a,g]),
r(e,[b,d,f]),r(f,[e,g]),r(g,[f])], Path).
Path = [a] ;
Path = [a, b] ;
Path = [a, b, c] ;
Path = [a, b, e] ;
Path = [a, b, e, d] ;
Path = [a, b, e, d, g] ;
Path = [a, b, e, d, g, f] ;
Path = [a, b, e, f] ;
Path = [a, b, e, f, g] ;
Path = [a, d] ;
Path = [a, d, g] ;
Path = [a, d, g, f] ;
Path = [a, d, g, f, e] ;
Path = [a, d, g, f, e, b] ;
Path = [a, d, g, f, e, b, c] ;
false.

Related

Create a DCG Parser in PROLOG

I have to implement an a context-free parser in PROLOG that uses a grammar that can generate:
I saw a tutorial.
I went in a library.
In library a tutorial I saw.
(I know it's not correct grammatically, but I need to see how to match the pattern)
I receive an input as a query - let's suppose it it the first sentence - and I have to print the number of applications of rules for a successful parsing, false otherwise.
In order to achieve this, I found these grammars:
s(X,Z):- vp(Y,Z), np(X,Y).
np(X,Z):- det(X,Y), n(Y,Z).
np(X,Z):- det(X,Y), n(Y,Z), np(X,Z).
vp(X,Z):- det(X,Y), v(Y,Z).
det([i|W],W).
det([a|W],W).
det([in|W],W).
n([tutorial|W],W).
n([library|W],W).
v([went|W],W).
v([saw|W],W).
It works for the first 2 sentences, but I don't know how to make it work for the last one and I don't know how to print the number of applications of rules for a successful parsing.
Thank you!
This will help with the number of applications of rules for a successful parsing. However, as you can see, it will always be the same number as the quantity of words in the sentence. What I did was to implement a 'counter' in the parameters of each rule and each time a 'base rule' succeed it increase the value of the 'counter'.
det([i|W], W, A, R) :- R is A + 1.
det([a|W], W, A, R) :- R is A + 1.
det([in|W], W, A, R) :- R is A + 1.
n([tutorial|W], W, A, R) :- R is A + 1.
n([library|W], W, A, R) :- R is A + 1.
v([went|W], W, A, R):- R is A + 1.
v([saw|W], W, A, R):- R is A + 1.
np([], R, R).
np(X, A, R2):- det(X, Y, A, R), np(Y, R, R2).
np(X, A, R3):- det(X, Y, A, R), n(Y, Z, R, R2), np(Z, R2, R3).
vp(X, Z, R2):- det(X, Y, 0, R), v(Y, Z, R, R2).
s(X, R2):- atomic_list_concat(L,' ', X), vp(L, Z, R), np(Z, R, R2), !.
Here are the results. Results.
As you can see the last sentence still failing, that is because if you follow the flow of the algorithm or calls of it you can see that the rule 's' calls the rule 'vp' which only admits a 'det' follow by a 'v', so if you see the first word of third sentence which is 'In', 'det' in 'vp' will work, but the next word that is 'library' will not success on 'v', because 'library' is not a verb, so that' s why it fail. To conclude, if you want the third sentence to succeed you will have to do some changes to your grammars.
By the way there is better way, probably a lit bit more complex to achieve, but once you understand how to use it, will be faster to work and easier to create a complex grammar this by using Prolog DCG https://www.swi-prolog.org/pldoc/man?section=DCG. I mentioned in case you did not know about this.

Flattening a tuple in Erlang

I am trying to turn a tuple of the form:
{{A,B,{C,A,{neg,A}}},{A,B,{neg,A}}}
Into
{{A,B,C,A,{neg,A}},{A,B,{neg,A}}
I'm quite new to Erlang so I would appreciate any hints. It makes no difference if the final structure is a list or a tuple, as long as any letter preceded by neg stays as a tuple/list.
A simple solution:
convert({{A,B,{C,D,E}},F}) -> {{A,B,C,D,E},F}.
If why this works is puzzling, consider:
1> YourTuple = {{a, b, {c, a, {neg, a}}}, {a, b, {neg, a}}}.
{{a,b,{c,a,{neg,a}}},{a,b,{neg,a}}}
2> Convert = fun({{A,B,{C,D,E}},F}) -> {{A,B,C,D,E},F} end.
#Fun<erl_eval.6.54118792>
3> Convert(YourTuple).
{{a,b,c,a,{neg,a}},{a,b,{neg,a}}}
The reason this happens is because we are matching over entire values based on the shape of the data. That's the whole point of matching, and also why its super useful in so many cases (and also why we want to use tuples in more specific circumstances in a language with matching VS a language where "everything is an iterable"). We can substitute the details with anything and they will be matched and returned accordingly:
4> MyTuple = {{"foo", bar, {<<"baz">>, balls, {ugh, "HURR!"}}}, {"Fee", "fi", "fo", "fum"}}.
{{"foo",bar,{<<"baz">>,balls,{ugh,"HURR!"}}},
{"Fee","fi","fo","fum"}}
5> Convert(MyTuple).
{{"foo",bar,<<"baz">>,balls,{ugh,"HURR!"}},
{"Fee","fi","fo","fum"}}
Why did this work when the last element of the top-level pair was so different in shape than the first one? Because everything about that second element was bound to the symbol F in the function represented by Convert (note that in the shell I named an anonymous function for convenience, this would be exactly the same as using convert/1 that I wrote at the top of this answer). We don't care what that second element was -- in fact we don't want to have to care about the details of that. The freedom to selectively not care about the shape of a given element of data is one of the key abstractions we use in Erlang.
"But those were just atoms 'a', 'b', 'c' etc. I have different things in there!"
Just to make it look superficially like your example above (and reinforce what I was saying about not caring about exactly what we bound to a given variable):
6> A = 1.
1
7> B = 2.
2
8> C = 3.
3
9> AnotherTuple = {{A, B, {C, A, {neg, A}}}, {A, B, {neg, A}}}.
{{1,2,{3,1,{neg,1}}},{1,2,{neg,1}}}
10> Convert(AnotherTuple).
{{1,2,3,1,{neg,1}},{1,2,{neg,1}}}
Needing to do this is not usually optimal, though. Generally speaking the other parts of the program that are producing that data in the first place should be returning useful data types for you. If not you can certainly hide them behind a conversion function such as the one above (especially when you're dealing with APIs that are out of your control), but generally speaking the need for this is a code smell.
And moving on
The more general case of "needing to flatten a tuple" is a bit different.
Tuples are tuples because each location within it has a meaning. So you don't usually hear of people needing to "flatten a tuple" because that fundamentally changes the meaning of the data you are dealing with. If you have this problem, you should not be using tuples to begin with.
That said, we can convert a tuple to a list, and we can check the shape of a data element. With these two operations in hand we could write a procedure that moves through a tuplish structure, building a list out of whatever it finds inside as it goes. A naive implementation might look like this:
-module(tuplish).
-export([flatten/1]).
-spec flatten(list() | tuple()) -> list().
flatten(Thing) ->
lists:flatten(flatten(Thing, [])).
flatten(Thing, A) when is_tuple(Thing) ->
flatten(tuple_to_list(Thing), A);
flatten([], A) ->
lists:reverse(A);
flatten([H | T], A) when is_tuple(H) ->
flatten(T, [flatten(H) | A]);
flatten([H | T], A) when is_list(H) ->
flatten(T, [flatten(H) | A]);
flatten([H | T], A) ->
flatten(T, [H | A]).
Keep in mind that after several years of writing Erlang code I have never needed to actually do this. Remember: tuples mean something different than lists.
All that said, the problem you are facing is almost certainly handled better by using records.

Erlang implementing an amb operator.

On wikipedia it says that using call/cc you can implement the amb operator for nondeterministic choice, and my question is how would you implement the amb operator in a language in which the only support for continuations is to write in continuation passing style, like in erlang?
If you can encode the constraints for what constitutes a successful solution or choice as guards, list comprehensions can be used to generate solutions. For example, the list comprehension documentation shows an example of solving Pythagorean triples, which is a problem frequently solved using amb (see for example exercise 4.35 of SICP, 2nd edition). Here's the more efficient solution, pyth1/1, shown on the list comprehensions page:
pyth1(N) ->
[ {A,B,C} ||
A <- lists:seq(1,N-2),
B <- lists:seq(A+1,N-1),
C <- lists:seq(B+1,N),
A+B+C =< N,
A*A+B*B == C*C
].
One important aspect of amb is efficiently searching the solution space, which is done here by generating possible values for A, B, and C with lists:seq/2 and then constraining and testing those values with guards. Note that the page also shows a less efficient solution named pyth/1 where A, B, and C are all generated identically using lists:seq(1,N); that approach generates all permutations but is slower than pyth1/1 (for example, on my machine, pyth(50) is 5-6x slower than pyth1(50)).
If your constraints can't be expressed as guards, you can use pattern matching and try/catch to deal with failing solutions. For example, here's the same algorithm in pyth/1 rewritten as regular functions triples/1 and the recursive triples/5:
-module(pyth).
-export([triples/1]).
triples(N) ->
triples(1,1,1,N,[]).
triples(N,N,N,N,Acc) ->
lists:reverse(Acc);
triples(N,N,C,N,Acc) ->
triples(1,1,C+1,N,Acc);
triples(N,B,C,N,Acc) ->
triples(1,B+1,C,N,Acc);
triples(A,B,C,N,Acc) ->
NewAcc = try
true = A+B+C =< N,
true = A*A+B*B == C*C,
[{A,B,C}|Acc]
catch
error:{badmatch,false} ->
Acc
end,
triples(A+1,B,C,N,NewAcc).
We're using pattern matching for two purposes:
In the function heads, to control values of A, B and C with respect to N and to know when we're finished
In the body of the final clause of triples/5, to assert that conditions A+B+C =< N and A*A+B*B == C*C match true
If both conditions match true in the final clause of triples/5, we insert the solution into our accumulator list, but if either fails to match, we catch the badmatch error and keep the original accumulator value.
Calling triples/1 yields the same result as the list comprehension approaches used in pyth/1 and pyth1/1, but it's also half the speed of pyth/1. Even so, with this approach any constraint could be encoded as a normal function and tested for success within the try/catch expression.

Ocaml: Longest Path

I have to make an algorithm for the longest path problem.
I have an oriented weighted graph, a start node, a stop node and a number k.
The algorithm have to say if , on the graph, exist a path from start node to stop node with at least length k.
The true problem is that i have to use the BFS-visit algortihm and not the DFS. On Ocaml the BFS use the Queue and the node are insert on the end of the structure:
let breadth_first_collect graph start =
let rec search visited = function
[] -> visited
| n::rest -> if List.mem n visited
then search visited rest
else search (n::visited) (rest # (succ graph n))
(* new nodes are put into queue *)
in search [] [start];;
Someone can give me some advise, even theorical to make this?
In a BFS you basically shouldn't recurse deeper before you finished current layer. That means that on each step you should take a set of successors, cut the data, and afterwards recurse into each one in a row. Here is a first approximation (untested) of the algorithm:
let breadth_first_collect succ graph start =
let rec search visited v =
let succs = succ graph v |>
List.filter (fun s -> List.mem s visited) in
List.map (search (succs # visited)) succs |> List.concat in
search [] start
So, we first visit all children (aka succs) prepend the to the queue, and the recursively descent into each child in a row.
Again this is a first approximation. Since you need to know the path length it means, that you need to store each path in your queue separately, and can't just have a set of all visited vertices. That means, that your queue must be vertex list list. In that case, you can collect all possible paths, and find if there exists one, that is larger than k.

Erlang : how to implement Erlang list comprehension ?

Implement an Erlang list comprehension that takes two elements from a list and makes a new list of lists.
I have this code
pair([], Acc) -> lists:reverse(Acc);
pair(L, Acc0) ->
[ A, B | T ] = L,
Acc = [ [A, B] | Acc0 ],
pair(T, Acc).
which works fine:
7> l:pair(lists:seq(1,6), []).
[[1,2],[3,4],[5,6]]
but it seems like I should be able to implement this as a list comprehension. My Erlang-fu is too weak to come up with it.
Any suggestions?
Thanks
No, a list comprehension would not be a good way to do that, by definition they only work on one element a a time. In your code there is really no need to use an accumulator, the difference in speed is small, here, and it becomes clearer without it. I think so at least.
pairs([A,B|L]) ->
[[A,B]|pairs(L)];
pairs([]) -> [].
A list comprehension will be clunky because it inevitably must do something for every element of the list. To create a list comprehension you must thus try to find out if it's an even or odd element you are talking to. Here's an idea of what I'm talking about:
pair(L) ->
L2 = lists:zip(lists:seq(1, length(L)), L),
[[A, B] || {Ai, A} <- L2, {Bi, B} <- L2,
Ai rem 2 == 1, Bi rem 2 == 0, Ai + 1 == Bi].
The time complexity on this one is probably horrible because as far as I'm aware Erlang does not optimize this in any way.
I don't think there's anything wrong with your function and you should stick to it.

Resources