How to get strongest path prolog? - prolog

I'm trying to create a social graph and I have to write some Prolog in order to get the minimal and the strongest path.
My knowledge base only has the following statements:
edge(source, destination, weight)
example: (john, mary, 2).
The weights can only be 3 for now:
1 - Friend
2- Close friend
3 - Family
Here is my code to the minimal path (less weighted).
findapath(X, Y, W, [X,Y], _) :- edge(X, Y, W).
findapath(X, Y, W, [X|P], V) :- \+ member(X, V),
edge(X, Z, W1),
findapath(Z, Y, W2, P, [X|V]),
W is W1 + W2.
:-dynamic(solution/2).
findminpath(X, Y, W, P) :- \+ solution(_, _),
findapath(X, Y, W1, P1, []),
assertz(solution(W1, P1)),
!,
findminpath(X,Y,W,P).
findminpath(X, Y, _, _) :- findapath(X, Y, W1, P1, []),
solution(W2, P2),
W1 < W2,
retract(solution(W2, P2)),
asserta(solution(W1, P1)),
fail.
findminpath(_, _, W, P) :- solution(W,P), retract(solution(W,P)).
How to include a variable to count the number of paths traveled and then use that to get the strongest path?
The strongest path is path weight / number of paths traveled.
So for example,
Weight = 8
N Paths traveled = 3
8/3 = 2.67 strength
Which means that there are 3 people between me and my destination (this is a social graph) and their weighted sum is 8.
But in this case
Weight = 7
N Paths traveled = 7
This would be the minimal path instead, right? YES, because it's 7 and 7 < 8. However, it is NOT the strongest path because 7/7 = 1 and that means that I probably had loads of people between me and my destination that weren't as close to me as the other path.
How would I do this?

Related

Performance Shortest path in GNU PROLOG

I have homework in PROLOG - I did software that knows how to calculate the shortest route and record all the nodes where it passed. But there is a serious performance problem if there are more than 5 nodes to the software it takes years to calculate (I have an 11th generation processor). I would be happy if you could advise how to modify the code so it would work faster + divide the code into 2 so that calculating a route was one query and calculating all the points would be another query.
path(X, Y, N, Path) :- path(X, Y, N, [], Path).
path(X, Y, N, Seen, [X]) :-
\+ check_member(X, Seen),
edge(X, Y, N).
path(X, Z, N, Seen, [X|T]) :-
\+ check_member(X, Seen),
edge(X, Y, N0),
path(Y, Z, N1, [X|Seen], T),
\+ check_member(X, T),
N is N0 + N1.
check_member(X, L) :- once(ismember(X, L)).
ismember(X, [X|_]).
ismember(X, [_|Xs]) :- ismember(X, Xs).
water_shortest_path(X, Y, MinCost, Path) :-
path(X, Y, MinCost, Path),
\+ (path(X, Y, LowerCost, OtherPath),
OtherPath \= Path,
LowerCost =< MinCost).
edge(l,l,0).
edge(r,r,0).
edge(l,p10,0).
edge(p10,j10,0).
edge(r,p335,1231).
edge(p335,j61,0).
edge(t3,j20,99).
edge(t1,j40,99).
edge(t2,j50,99).
edge(r,j60,1231).
edge(j10,j101,14200).
edge(j101,j103,1350).
edge(j101,j105,2540).
edge(j105,j107,1470).
edge(j103,j109,3940).
edge(j109,j111,2000).
edge(j111,j115,1160).
edge(j111,j113,1680).
edge(j113,j115,2000).
edge(j107,j115,1950).
edge(j113,j193,1660).
edge(j105,j263,2725).
edge(j115,j117,2180).
edge(j120,j119,730).
edge(j117,j120,1870).
edge(j120,j121,2050).
edge(j121,j119,2000).
edge(j121,j123,1500).
edge(j121,j125,930).
edge(j125,j127,3240).
edge(j127,j20,785).
edge(j127,j129,900).
edge(j129,j131,6480).
edge(j129,j139,2750).
edge(j139,j141,2050).
edge(j141,j143,1400).
edge(j15,j143,1650).
edge(j141,j145,3510).
edge(j145,j147,2200).
edge(j147,j149,880).
edge(j149,j151,1020).
edge(j151,j153,1170).
edge(j153,j125,4560).
edge(j151,j119,3460).
edge(j119,j157,2080).
edge(j157,j159,2910).
edge(j159,j161,2000).
edge(j161,j163,430).
edge(j163,j164,150).
edge(j164,j166,490).
edge(j265,j169,590).
edge(j169,j167,60).
edge(j187,j204,99.9).
edge(j169,j171,1270).
edge(j171,j173,50).
edge(j171,j271,760).
edge(j181,j35,30).
edge(j181,j177,30).
edge(j177,j179,30).
edge(j179,j183,210).
edge(j179,j40,1190).
edge(j185,j184,99.9).
edge(j185,j183,510).
edge(j184,j205,4530).
edge(j185,j204,1325).
edge(j189,j183,1350).
edge(j187,j189,500).
edge(j169,j269,646).
edge(j191,j187,2560).
edge(j267,j189,1230).
edge(j191,j193,520).
edge(j193,j195,360).
edge(j195,j161,2300).
edge(j197,j191,1150).
edge(j111,j197,2790).
edge(j173,j199,4000).
edge(j199,j201,630).
edge(j201,j203,120).
edge(j199,j273,725).
edge(j205,j207,1200).
edge(j207,j206,450).
edge(j207,j275,1430).
edge(j206,j208,510).
edge(j208,j209,885).
edge(j209,j211,1210).
edge(j211,j213,990).
edge(j213,j215,4285).
edge(j215,j217,1660).
edge(j217,j219,2050).
edge(j217,j225,1560).
edge(j213,j229,2200).
edge(j229,j231,1960).
edge(j211,j237,2080).
edge(j237,j229,790).
edge(j237,j239,510).
edge(j239,j241,35 ).
edge(j241,j243,2200).
edge(j241,j247,445).
edge(j239,j249,430).
edge(j247,j249,10).
edge(j247,j255,1390).
edge(j255,j50,925).
edge(j255,j253,1100).
edge(j255,j251,1100).
edge(j251,j249,1450).
edge(j257,j120,645).
edge(j259,j257,350).
edge(j259,j263,1400).
edge(j257,j261,1400).
edge(j161,j117,645).
edge(j261,j263,350).
edge(j267,j265,1580).
edge(j267,j163,1170).
edge(j189,j269,646).
edge(j181,j271,260).
edge(j273,j275,2230).
edge(j205,j273,645).
edge(j265,j163,1200).
edge(j201,j275,300).
edge(j269,j271,1290).
edge(j61,j123,45500).
edge(j60,j601,1).
edge(j601,j61,1).
edge(p10,l,0).
edge(j10,p10,0).
edge(p335,r,1231).
edge(j61,p335,0).
edge(j20,t3,99).
edge(j40,t1,99).
edge(j50,t2,99).
edge(j60,r,1231).
edge(j101,j10,14200).
edge(j103,j101,1350).
edge(j105,j101,2540).
edge(j107,j105,1470).
edge(j109,j103,3940).
edge(j111,j109,2000).
edge(j115,j111,1160).
edge(j113,j111,1680).
edge(j115,j113,2000).
edge(j115,j107,1950).
edge(j193,j113,1660).
edge(j263,j105,2725).
edge(j117,j115,2180).
edge(j119,j120,730).
edge(j120,j117,1870).
edge(j121,j120,2050).
edge(j119,j121,2000).
edge(j123,j121,1500).
edge(j125,j121,930).
edge(j127,j125,3240).
edge(j20,j127,785).
edge(j129,j127,900).
edge(j131,j129,6480).
edge(j139,j129,2750).
edge(j141,j139,2050).
edge(j143,j141,1400).
edge(j143,j15,1650).
edge(j145,j141,3510).
edge(j147,j145,2200).
edge(j149,j147,880).
edge(j151,j149,1020).
edge(j153,j151,1170).
edge(j125,j153,4560).
edge(j119,j151,3460).
edge(j157,j119,2080).
edge(j159,j157,2910).
edge(j161,j159,2000).
edge(j163,j161,430).
edge(j164,j163,150).
edge(j166,j164,490).
edge(j169,j265,590).
edge(j167,j169,60).
edge(j204,j187,99.9).
edge(j171,j169,1270).
edge(j173,j171,50).
edge(j271,j171,760).
edge(j35,j181,30).
edge(j177,j181,30).
edge(j179,j177,30).
edge(j183,j179,210).
edge(j40,j179,1190).
edge(j184,j185,99.9).
edge(j183,j185,510).
edge(j205,j184,4530).
edge(j204,j185,1325).
edge(j183,j189,1350).
edge(j189,j187,500).
edge(j269,j169,646).
edge(j187,j191,2560).
edge(j189,j267,1230).
edge(j193,j191,520).
edge(j195,j193,360).
edge(j161,j195,2300).
edge(j191,j197,1150).
edge(j197,j111,2790).
edge(j199,j173,4000).
edge(j201,j199,630).
edge(j203,j201,120).
edge(j273,j199,725).
edge(j207,j205,1200).
edge(j206,j207,450).
edge(j275,j207,1430).
edge(j208,j206,510).
edge(j209,j208,885).
edge(j211,j209,1210).
edge(j213,j211,990).
edge(j215,j213,4285).
edge(j217,j215,1660).
edge(j219,j217,2050).
edge(j225,j217,1560).
edge(j229,j213,2200).
edge(j231,j229,1960).
edge(j237,j211,2080).
edge(j229,j237,790).
edge(j239,j237,510).
edge(j241,j239,35 ).
edge(j243,j241,2200).
edge(j247,j241,445).
edge(j249,j239,430).
edge(j249,j247,10).
edge(j255,j247,1390).
edge(j50,j255,925).
edge(j253,j255,1100).
edge(j251,j255,1100).
edge(j249,j251,1450).
edge(j120,j257,645).
edge(j257,j259,350).
edge(j263,j259,1400).
edge(j261,j257,1400).
edge(j117,j161,645).
edge(j263,j261,350).
edge(j265,j267,1580).
edge(j163,j267,1170).
edge(j269,j189,646).
edge(j271,j181,260).
edge(j275,j273,2230).
edge(j273,j205,645).
edge(j163,j265,1200).
edge(j275,j201,300).
edge(j271,j269,1290).
edge(j123,j61,45500).
edge(j601,j60,1).
edge(j61,j601,1).

Taking advantage of backtracking:
% path_best(l, r, Cost, Path).
path_best(Start, End, Cost, Path) :-
assert_new_best_path(Start, End, notfound, _),
path_best_(Start, End, Cost, Path).
path_best_(Start, End, Cost, Path) :-
% Find a good path
path_edge_to_edge_good(Start, End, Cost, Path),
% Record it
assert_new_best_path(Start, End, Cost, Path),
% Keep searching via backtracking for an even better path
fail.
% Finally, return path with best cost
path_best_(Start, End, Cost, Path) :-
path_best_upto(Cost, [Start, End, Path]).
% "Good" because it backtracks if going over the current-best cost
path_edge_to_edge_good(Start, End, Cost, Path) :-
path_edge_to_edge_(Start, End, 0, Cost, [Start], Seen),
reverse(Seen, Path).
path_edge_to_edge_(End, End, Cost, Cost, Seen, Seen).
path_edge_to_edge_(PathStart, PathEnd, CostUpto, Cost, SeenUpto, Seen) :-
edge(PathStart, EdgeEnd, EdgeCost),
% Prevent infinite loops
\+ member(EdgeEnd, SeenUpto),
CostUpto1 is CostUpto + EdgeCost,
% Fail quickly if this is worse than the already-known best-so-far path cost
cost_under_best(CostUpto1),
path_edge_to_edge_(EdgeEnd, PathEnd, CostUpto1, Cost, [EdgeEnd|SeenUpto], Seen).
cost_under_best(CostUpto1) :-
path_best_upto(BestCost, _),
(BestCost = notfound -> true ; CostUpto1 < BestCost).
:- dynamic path_best_upto/2.
assert_new_best_path(Start, End, Cost, Path) :-
retractall(path_best_upto(_, _)),
asserta(path_best_upto(Cost, [Start, End, Path])).
Result after 12 seconds (in swi-prolog, but should be identical in gprolog):
?- path_best(l, r, Cost, Path).
Cost = 72141,
Path = [l,p10,j10,j101,j105,j263,j259,j257,j120,j121,j123,j61,p335,r].
It would however be more efficient to always select alternatives based on their lower cost, and then stop at the first path found, which by definition will be the lowest cost (or joint lowest with other paths).

It's the best so far:
findPath(_Limit, [Goal | Rest], Goal, Temp, Temp, [Goal | Rest]) :- !.
findPath(Limit, [A | Rest], Goal, Cost, Temp, Path) :-
edge(A,B,C),
\+member(B, Rest),
NewCosts is (Temp + C),
NewCosts < Limit,
findPath(Limit, [B, A | Rest], Goal, Cost, NewCosts, Path).
%test ?- searchPath(l, j101, Path, Length).
searchPath(Start, Goal, Path_to_goal, L) :-
S = path_len([], 200000),
arg(2, S, Limit),
( findPath(Limit, [Start], Goal, Cost, 0, Path)
-> ( Cost < Limit
-> setarg(1, S, Path),
setarg(2, S, Cost),
true
)
; fail
),
arg(1, S, Rev),
reverse(Rev, Path_to_goal),
arg(2, S, L).

Enumerating all walks in a graph

Given a term representation of an edge of a graph, i.e.:
edge(a, b).
edge(b, c).
I would like to construct a predicate path/1 which succeeds iff its sole argument is a valid path in this graph (that is, for every two adjacent terms X, Y, edge(X, Y) holds). Given a variable, it should enumerate all walks (which could have repeated nodes). My first try:
path([X, Y]) :- edge(X, Y).
path([X, Y, Z | T]) :-
path([Y, Z | T]),
edge(X, Y).
It works as intended except for the case where it is supplied an acyclic graph - path finds all solutions and then halts, unable to construct any other path. On the other hand, swapping first and second term will result in many walks being skipped, due to the DFS nature of Prolog resolution.
My second attempt:
path(P) :- length(P, L), L >= 2, (path(P, L) *-> true ; (!, fail)).
path([X, Y], 2) :- edge(X, Y).
path([X, Y, Z | T], L) :-
L >= 3,
L1 is L - 1,
edge(X, Y),
path([Y, Z | T], L1).
It works as intended, but using a soft cut feels a bit forced. I was wondering if there was an easier way to accomplish this, perhaps a simpler simulation of a soft cut is possible in this particular scenario?

Testing your first solution, after finding three paths ([a,b],[a,c],[a,b,c]), it loops. One super quick way to avoid this is to use tabling wich is available in XSB, SWI and YAP. In case of SWI just add :- table path/1. as first directive to avoid loops. Otherwise you need to remember all path and there are plenty of answers you can look at (like this).

Given your graph definition:
edge(a, b).
edge(b, c).
Something like ought to do you:
path(P) :-
node(X),
walk(X,_,P)
.
walk(A,B,P) :-
walk(A,B,[],V),
reverse(V,R),
P = [A|R]
.
walk( A, B, T, V ) :-
edge(A,X),
not( member(X,T) ),
(
( B = X , V = [B|T] )
;
walk( X, B, [A|T], V )
)
.
%
% enumerate the distinct nodes in edge/2 via backtracking
%
node(N) :-
setof( X , edge(X,_);edge(_,X) , Ns ),
node( Ns , N )
.
node( [N|_] , N ).
node( [_|Ns] , N ) :- ( Ns , N ).

How to backtrack over a NxN board in Prolog?

I currently have to make some sort of Wumpus World implementation in SWI Prolog and give all possible paths over a board of size NxN, I have done several prolog tutorials but I can't figure how to solve this particular task in Prolog. I'm trying to get all possible paths for my agent to the gold and nothing else. It has to start from the initial position (X0, Y0).
I attach the code that I've managed to write so far. I have tried to do a simple DFS which sort of works but I struggle with the variable "parsing" to complete the code.
:- dynamic getAllPathsRec/2, agent/2, visited/2, visited/2.
gold(5,5).
worldSize(10).
agent(1,1).
getAllPaths :-
getAllPathsRec(1,1).
getAllPathsRec(X,Y) :-
format(X), format(Y), format('~n'),
gold(X1,Y1),
\+visited(X,Y),
assert(visited(X,Y)),
(X = X1, Y = Y1) -> print('Found GOLD');
move(_,X,Y).
move(right, X, Y) :-
X1 is X + 1,
X1 > 0 , X1 < 11,
getAllPathsRec(X1,Y).
move(left, X, Y) :-
X1 is X - 1,
X1 > 0 , X1 < 11,
getAllPathsRec(X1,Y).
move(up, X, Y) :-
Y1 is Y + 1,
Y1 > 0 , Y1 < 11,
getAllPathsRec(X,Y1).
move(down, X, Y) :-
Y1 is Y - 1,
Y1 > 0 , Y1 < 11,
getAllPathsRec(X,Y1).
I expect to find the gold in any possible way, ideally printing each path the algorithm has taken. Thank you in advance.

EDIT:
I've noticed that this solution has some efficiency problems for boards of enough size. It's being discussed here. I'll update the answer when we come up with a result.
Take care with assert/1 predicate, as it adds the fact to the knowledge base permanently and it's not undone while trying other combinations, so you won't be able to visit the same cell twice.
Instead of that, I approached it with an extra parameter V (that stands for visited), in which you can append the element treated in each exploration step. Also I stored the chosen directions in every step into a list L to print it when the target is found.
The or operator ; allows to not keep exploring the same path once the target is found and goes back to keep trying other combinations.
Notes:
If you face any use case where you can use assert/1, take care, because it's deprecated.
The _ variable it's not necessary in the move function as you can simply add 4 different "implementations" and just append the four directions.
As an advice use the facts or knowledge (a.k.a. World Size, Target position and Player position) as variables and don't hard code it. It'll be easier to debug and try different parameters.
Here you have the working code and some output example:
:- dynamic
getAllPathsRec/2,
agent/2,
visited/2.
gold(3, 3).
worldSize(5).
agent(1, 1).
getAllPaths :-
agent(X, Y),
getAllPathsRec(X, Y, [], []).
getAllPathsRec(X, Y, V, L) :-
hashPos(X, Y, H), \+member(H, V), append(V, [H], VP),
((gold(X, Y), print(L)) ; move(X, Y, VP, L)).
% Hash H from h(X, Y)
hashPos(X, Y, H) :- H is (X*100 + Y).
% Left
move(X, Y, V, L) :-
XP is X - 1, XP > 0,
append(L, [l], LP),
getAllPathsRec(XP, Y, V, LP).
% Right
move(X, Y, V, L) :-
XP is X + 1, worldSize(MS), XP =< MS,
append(L, [r], LP),
getAllPathsRec(XP, Y, V, LP).
% Up
move(X, Y, V, L) :-
YP is Y + 1, worldSize(MS), YP =< MS,
append(L, [u], LP),
getAllPathsRec(X, YP, V, LP).
% Down
move(X, Y, V, L) :-
YP is Y - 1, YP > 0,
append(L, [d], LP),
getAllPathsRec(X, YP, V, LP).
?- getAllPaths.
[r,r,r,r,u,l,l,l,l,u,r,r]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,l,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,l,d,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,d,l,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,d,l,u,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,r,d,l,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,d,l]
...

Prolog: If Two Nodes Can Be Traversed To In A Graph

Here's the Question I was given:
Define a Prolog predicate path(X,Y,G), where path(-,-,+), which is
true when there is a path from node X to node Y in a directed graph G,
where the graph is represented by a list of edges, each represented by
a two-element list of the source and destination nodes.
Here's the sample output:
?- path(b,Y,[[a,b],[b,c],[b,d],[d,e]]).
Y = c ;
Y = d ;
Y = e ;
no
?- path(X,b,[[a,b],[b,c],[b,d],[d,e]]).
X = a ;
no
?- path(c,e,[[a,b],[b,c],[b,d],[d,e]]).
yes
This is different to other examples I've seen online where the node traversals would be facts such as:
canTraverse(a,b).
canTraverse(b,c).
etc.
So I'm pretty stumped with it.
This is what I've gotten out so far:
path(X, Y, G) :-
(
G = [CurrentPair | EverythingElse],
CurrentPair = [X1 , Y1| _],
=(X, X1),
=(Y, Y1)
)
;
path(X, Y, EverythingElse).
Which seemed to work if the two nodes X and Y were in a pair/list together. But I'm not sure how to get it to traverse across nodes.

The graph is directed and doesn't have cycles.
The base case could be path(X, Y, G) :- member([X,Y],G). and the recursive case can say for there to be a path from X to Y, take a step from X to some middle note then find a path from middle to Y.

search all paths and the shortest path for a graph - Prolog

I have a problem in my code with turbo prolog which searches all paths and the shortest path in a graph between 2 nodes.
The problem that i have is to test if the node is in the list or not (exactly in the clause of member)
1 ---- b ---- 3
--- | ---
--- | -----
a |5 d
--- | -----
--- | ---
2 --- | --- 4
-- c --
for example we have for b--->c
([b,c],5) , ([b,a,c],3) and ([b,d,c],7) : possible paths.
([b,a,c],3) : the shortest path.
and this is my code :
DOMAINS
list=Symbol *
PREDICATES
distance(Symbol, Symbol)
path1(Symbol, Symbol, list, integer)
path(Symbol, Symbol,list, list, integer)
distance(Symbol, list, integer)
member(Symbol, list)
shortest(Symbol, Symbol, list, integer)
CLAUSES
distance(a, b, 1).
distance(a, c, 2).
distance(b, d, 3).
distance(c, d, 4).
distance(b, c, 5).
distance(b, a, 1).
distance(c, a, 2).
distance(d, b, 3).
distance(d, c, 4).
distance(c, b, 5).
member(X, [X|T]).
member(X, [Y|T]) :- member(X, T).
absent(X, L) :-
member(X, L),
!,
fail.
absent(_, _).
/* find all paths */
path1(X, Y, L, C) :- path(X, Y, L, I, C).
path(X, X, [X], I, C) :- absent(X, I).
path(X, Y, [X|R], I, C) :-
distance(X, Z, A),
absent(Z, I),
path(Z, Y, R, [X|I], C1),
C = C1 + A
.
/* to find the shortest path */
shortest(X, Y, L, C) :-
path(X, Y, L, C),
path(X, Y, L1, C1),
C < C1.

This shows the shortest path and it's weight:
edge(a,b,6).
edge(a,c,1).
edge(b,d,5).
edge(c,e,4).
edge(c,f,1).
edge(d,h,3).
edge(e,h,7).
edge(f,g,2).
edge(g,h,1).
path(X,Y,M,[Y]) :- edge(X,Y,M).
path(X,Y,P,[Z|T]) :- edge(X,Z,M),path(Z,Y,N,T),
P is M+N.
pravilo(X,Y,Z) :- assert(min(100)),assert(minpath([])),!,
path(X,Y,K,PATH1),
(min(Z),K<Z,
retract(min(Z));assert(min(K))),
minpath(Q),retract(minpath(Q)),
assert(minpath([X|PATH1])),
fail.
?- pravilo(a,h,X);
write("Minimal Path:"),
minpath(PATH),
write(PATH),
nl,
write("Path weight:"),
min(Z),
write(Z).

Without knowing what the actual problem is, I can at least suggest that maybe shortest() and path() should take a maximum-length parameter that short-circuits the search.
Also, shortest() doesn't find the shortest path. It finds, for every possible pair of paths, the shortest of each pair.

Resources