How to select the shortest path from a selection in Prolog - prolog

I am a prolog beginner, have the following code which spits out all possible paths from one given node to another. Each edge is bi-directional in nature which is something to take note of.
nodeLink(1,2,4).
nodeLink(1,3,10).
nodeLink(1,5,2).
nodeLink(2,1,4).
nodeLink(2,5,1).
nodeLink(2,4,6).
nodeLink(2,6,1).
nodeLink(3,1,10).
nodeLink(3,5,2).
nodeLink(3,4,1).
nodeLink(4,3,1).
nodeLink(4,5,8).
nodeLink(4,2,6).
nodeLink(5,1,2).
nodeLink(5,2,1).
nodeLink(5,3,2).
nodeLink(5,4,8).
nodeLink(6,2,1).
path([B | BRest], B, [B | BRest], Length, Length).
path([A | ARest], B, Path, CurrentLength, Length) :-
nodeLink(A, C, X),
\+member(C, [A | ARest]),
NewLength is CurrentLength + X,
path([C, A | ARest], B, Path, NewLength, Length).
all_paths(Start, End) :-
path([Start], End, Path, 0, Length),
reverse(Path, RevPath),
write('Path: '),
printPath(RevPath),
write(' with a cost of '),
writeln(Length),
fail.
printPath([]).
printPath([X]) :-
!,
write(X).
printPath([X|Xrest]) :-
write(X),
write(', '),
printPath(Xrest).
For example:
?- all_paths(6,3).
Prints out:
Path: 6, 2, 1, 3 with a cost of 15
Path: 6, 2, 1, 5, 3 with a cost of 9
Path: 6, 2, 1, 5, 4, 3 with a cost of 16
Path: 6, 2, 5, 1, 3 with a cost of 14
Path: 6, 2, 5, 3 with a cost of 4
Path: 6, 2, 5, 4, 3 with a cost of 11
Path: 6, 2, 4, 3 with a cost of 8
Path: 6, 2, 4, 5, 1, 3 with a cost of 27
Path: 6, 2, 4, 5, 3 with a cost of 17
false.
How would I go about selecting the 'shortest' path for a given pair of nodes?
Thanks

Generally, in Prolog, you wouldn't want to use write and a failure driven loop to show all of the solutions. A canonical approach is to have a predicate that succeeds for each solution (as your path/5 predicate does), and then use findall/3 or bagof/3 or setof/3 to collect all of the solutions in a list. setof/3 has the benefit of eliminating duplicates and ordering the resulting collection.
Here's a stackoverflow search on [prolog] shortest path directed graph. This has been covered so many times on this site, I didn't want to just pick one of them. I didn't see one that uses setof/3, so here is a solution taking that approach.
I'll use your existing definition of path/5. Since the collection of paths is unique by design, using setof/3 will be a small improvement over the use of findall/3 followed by msort/2, which you'll find in at least one of the linked solutions. The idea here is to create a list of solutions of the form Cost-Path, that are ordered by Cost. You then need to pick the lowest cost from the list, which is the first element since they are ordered.
shortest_path(Start, End, ShortestPath, ShortestLength) :-
setof(Length-Path, path([Start], End, Path, 0, Length), [ShortestLength-ShortestPath|_]).
If you want to then do a nice printout of your list, you can use maplist:
print_path(Cost-Path) :-
write('Path: '),
write(Path),
write(' with a cost of '),
write(Cost), nl.
print_paths(CostPaths) :-
maplist(print_path, CostPaths).
Where CostPaths is the result of the setof/3 performed above.

Related

Prolog: obtain a list with two sublists, containing the odd position elements and the even position elements. How to Improve this code

I would like to ask, if anyone knows how to improve (if it's not optimal) this code.
The idea, is that you have a list of elements, and I want to return a list, with two sublists inside it, the first sublist should contain the elements that are contained in the odd positions of the list, and the second sublist should contain, the elements that are contained in the even positions of the list.
Some examples:
?-evenAndOdd([1,2,3,4,5],[[1,3,5],[2,4]])
True.
?-evenAndOdd([a,b,c,d,e],[[a,c,e],[b,d]]).
True.
The code I have implemented is the next one:
evenAndOdd([],[]).
evenAndOdd([H|R],NL):-
evenAndOddRec([H|R], [[],[]],1,NL).
evenAndOddRec([], [LOdd,LEven],_,[LOdd,LEven]).
evenAndOddRec([H|R],[LOdd,LEven],Pos,NL):-
\+ even(Pos),
!,
NPos is Pos +1,
append(LOdd,[H],NLOdd),
evenAndOddRec(R,[NLOdd,LEven],NPos,NL).
evenAndOddRec([H|R],[LOdd,LEven],Pos,NL):-
NPos is Pos + 1,
append(LEven, [H], NLEven),
evenAndOddRec(R,[LOdd, NLEven],NPos,NL).
even(N):-
N mod 2 =:=0.
One symptom that the code is not optimal is that it will run off into the woods if you ask for an additional solution in the -,+,+ instantiation pattern:
?- evenAndOdd(X, [[1,3,5], [2,4,6]]).
X = [1, 2, 3, 4, 5, 6] ;
<time passes>
This kind of thing is a frequent occurrence when manually trying to match up lists with indexes in Prolog.
Stylistically, I would rather not give back a list containing exactly two lists when I could just have three arguments instead of two; this is, after all, a relationship between three lists, the combined list and the even and odd items.
Additionally, just eyeballing it, I'm not sure why any arithmetic or any cuts are needed here. This is how I would implement it:
evenAndOdd([], [], []).
evenAndOdd([O], [O], []).
evenAndOdd([O,E|Rest], [O|ORest], [E|ERest]) :- evenAndOdd(Rest, ORest, ERest).
This works with many instantiations:
?- evenAndOdd([1,2,3,4,5,6], O, E).
O = [1, 3, 5],
E = [2, 4, 6].
?- evenAndOdd([1,2,3,4,5], O, E).
O = [1, 3, 5],
E = [2, 4] ;
false.
?- evenAndOdd(X, [1,3,5], [2,4]).
X = [1, 2, 3, 4, 5] ;
false.
?- evenAndOdd(X, [1,3,5], [2,4,6]).
X = [1, 2, 3, 4, 5, 6].
?- evenAndOdd(X, [1,3,5], [2,4,6,8]).
false.
?- evenAndOdd([1,2,3,4,5,6], X, [2,4,6,8]).
false.
?- evenAndOdd([1,2,3,4,5,6], X, [2,4,6]).
X = [1, 3, 5].
You can implicitly determine even and odd values upon recursion, by taking two elements at a time (and taking into account when the has an odd number of elements):
evenAndOdd(L, [LOdd, LEven]):-
evenAndOdd(L, LOdd, LEven).
evenAndOdd([], [], []).
evenAndOdd([Odd], [Odd], []).
evenAndOdd([Odd,Even|Tail], [Odd|LOdd], [Even|LEven]):-
evenAndOdd(Tail, LOdd, LEven).

Prolog Permutations

I'm trying to get more into learning prolog as I'll be taking an AI class at school next semester. I've been able to get down the basics down and can do relation based stuff, however, I've been trying to learn permutations and combinatronics and they seem pretty straightforward, but it led me to a question that I can't figure out how to solve. Say I wanted to know the permutations of 1's and 0's with a certain condition that there must be atleast 4 1's in a row.
I have no idea where I would start to try and find a solution for this, but in the end I want the code to do something like this:
?- placeOnesAndZeros(9,X).
% where 9 is the length of the list/array and X is the permutations
[0,0,0,0,0,0,0,0,0]
[1,1,1,1,0,0,0,0,0]
[0,1,1,1,1,0,0,0,0]
[0,0,1,1,1,1,0,0,0]
[0,0,0,1,1,1,1,0,0]
[0,0,0,0,1,1,1,1,0]
[0,0,0,0,0,1,1,1,1]
[1,1,1,1,0,1,1,1,1]
[1,1,1,1,1,0,0,0,0]
[0,1,1,1,1,1,0,0,0]
[0,0,1,1,1,1,1,0,0]
[0,0,0,1,1,1,1,1,0]
[0,0,0,0,1,1,1,1,1]
[1,1,1,1,1,1,0,0,0]
[0,1,1,1,1,1,1,0,0]
[0,0,1,1,1,1,1,1,0]
[0,0,0,1,1,1,1,1,1]
[1,1,1,1,1,1,1,0,0]
[0,1,1,1,1,1,1,1,0]
[0,0,1,1,1,1,1,1,1]
[1,1,1,1,1,1,1,1,0]
[0,1,1,1,1,1,1,1,1]
[1,1,1,1,1,1,1,1,1]
Thank you in advance!
EDIT CODE:
printList([ ]).
printList([H|T]) :- print(H), nl, printList(T).
eval([],_).
eval([H|T],[1,0]):-member(H,[1,0]),eval(T,[1,0]).
placeOnesAndZeros(N, L):-length(L,N), eval(L,[1,0]).
Generate and test it's the name of the basic technique used to search a solution space. In Prolog, it's practically built in. Just provide a filter discarding what is not required:
?- placeOnesAndZeros(9,L),once(append(_,[1,1,1,1|_],L)).
once/1 is required, otherwise append/3 could succeed multiple times.
To check the correctness of the approach, here is how to count how many solutions we get:
?- aggregate(count,L^H^T^(placeOnesAndZeros(9,L),once(append(H,[1,1,1,1|T],L))),C).
C = 111.
The quantification on variables L,H,T (these last 2 being introduced only to aggregate) can be avoided using aggregate_all:
?- aggregate_all(count,(placeOnesAndZeros(9,L),once(append(_,[1,1,1,1|_],L))),C).
C = 111.
edit
As #lurker noted, my filter isn't correct. Try instead
atLeastFourOnes(L) :- memberchk(1,L), atLeastFourOnes_(L).
atLeastFourOnes_([]).
atLeastFourOnes_([0|L]) :- atLeastFourOnes_(L).
atLeastFourOnes_([1,1,1,1|L]) :- stripOnes(L,R), atLeastFourOnes_(R).
that yields
?- placeOnesAndZeros(9,L),atLeastFourOnes(L).
L = [1, 1, 1, 1, 1, 1, 1, 1, 1] ;
L = [1, 1, 1, 1, 1, 1, 1, 1, 0] ;
L = [1, 1, 1, 1, 1, 1, 1, 0, 0] ;
...
?- aggregate(count,L^(placeOnesAndZeros(9,L),atLeastFourOnes(L)),C).
C = 22.

Manipulating Prolog code output

I am trying to run code on this page: https://swish.swi-prolog.org/example/clpfd_queens.pl in swipl on a Linux terminal.
:- use_module(library(clpfd)).
n_queens(N, Qs) :-
length(Qs, N),
Qs ins 1..N,
safe_queens(Qs).
safe_queens([]).
safe_queens([Q|Qs]) :-
safe_queens(Qs, Q, 1),
safe_queens(Qs).
safe_queens([], _, _).
safe_queens([Q|Qs], Q0, D0) :-
Q0 #\= Q,
abs(Q0 - Q) #\= D0,
D1 #= D0 + 1,
safe_queens(Qs, Q0, D1).
Following command works:
?- n_queens(4, Qs), labeling([ff], Qs).
But not just n_queens(4, Qs):
?- n_queens(4, Qs).
Qs = [_G1470, _G1473, _G1476, _G1479],
_G1470 in 1..4,
abs(_G1470-_G1479)#\=3,
_G1470#\=_G1479,
abs(_G1470-_G1476)#\=2,
_G1470#\=_G1476,
abs(_G1470-_G1473)#\=1,
_G1470#\=_G1473,
_G1479 in 1..4,
abs(_G1476-_G1479)#\=1,
_G1476#\=_G1479,
abs(_G1473-_G1479)#\=2,
_G1473#\=_G1479,
_G1476 in 1..4,
abs(_G1473-_G1476)#\=1,
_G1473#\=_G1476,
_G1473 in 1..4.
Why is labeling part needed here? Can one get proper output without labeling part?
For larger numbers, one gets only initial part of the solution:
?- n_queens(20, Qs), labeling([ff], Qs).
Qs = [1, 3, 5, 14, 17, 4, 16, 7, 12|...] ;
Qs = [1, 3, 5, 18, 16, 4, 10, 7, 14|...] ;
...
How can one get full list output for larger numbers? Also, how can one get all numbers together, without having to press spacebar for each solution? Thanks for your help.
n_queens/2 does not solves the N-queens problem for N queens: it constructs the constraint programming problem: it constructs N variables (the columns of the queens), and adds constraints between these queens: for instance that two queens can not be placed on the same row, nor on the same diagonal. We see this if we rewrite the problem output to more convenient output:
A in 1..4,
abs(A-D)#\=3,
A#\=D,
abs(A-C)#\=2,
A#\=C,
abs(A-B)#\=1,
A#\=B,
D in 1..4,
abs(C-D)#\=1,
C#\=D,
abs(B-D)#\=2,
B#\=D,
C in 1..4,
abs(B-C)#\=1,
B#\=C,
B in 1..4.
So we see four queens (A, B, C and D). Each of the queens should be in the domain 1..4, furthermore we see non equal constraints like A #\= D to prevent the first queen A sharing a column with the last queen D. We finally see constraints like abs(A-C) #\= 2 to prevent the first queen A and the third queen C to differ two columns (diagnal attack).
Next labeling/2 will actually solve the problem: it performs relaxation (reducing the domains) as well as branching (picking a value or a subrange of values for variables) and backtracking in case the constraints fail. It will continue until it finds a solution, and we can use Prolog's backtracking mechanism to let labeling/2 come up with more solutions.
labeling thus is given a list of variables and aims to label them: assign them a value out of the range such that all constraints are satisfied.
Therefore the problem construction part is usually very fast compared to the actually solving part: it is easy to generate O(N) variables and O(N2) constraints, but it can take an exponential amount of time O(DN) to come up with a solution satisfying all constraints.
Also, how can one get all numbers together, without having to press spacebar for each solution?
You can use the meta-predicate findall/3 for that:
all_n_queens(N,LL) :-
findall(L,(n_queens(N,L), labeling([ff], L)),LL).
Which generates:
?- all_n_queens(5,LL).
LL = [[1, 3, 5, 2, 4], [1, 4, 2, 5, 3], [2, 4, 1, 3, 5], [2, 5, 3, 1, 4], [3, 1, 4, 2|...], [3, 5, 2|...], [4, 1|...], [4|...], [...|...]|...].
How can one get full list output for larger numbers?
You can set the answer_write_options flag:
?- set_prolog_flag(answer_write_options,[max_depth(0)]).
true.
?- all_n_queens(5,LL).
LL = [[1,3,5,2,4],[1,4,2,5,3],[2,4,1,3,5],[2,5,3,1,4],[3,1,4,2,5],[3,5,2,4,1],[4,1,3,5,2],[4,2,5,3,1],[5,2,4,1,3],[5,3,1,4,2]].

Generate all permutations of the list [1, 1, 2, 2, ..., n, n] where the number of elements between each pair is even in Prolog

I recently started learning Prolog and I got a task to write a predicate list(N, L) that generates lists L such that:
L has length 2N,
every number between 1 and N occurs exactly twice in L,
between each pair of the same element there is an even number of other elements,
the first occurrences of each number are in increasing order.
The author states that there are N! such lists.
For example, for N = 3 all solutions are:
?- list(3, L).
L = [1, 1, 2, 2, 3, 3] ;
L = [1, 1, 2, 3, 3, 2] ;
L = [1, 2, 2, 1, 3, 3] ;
L = [1, 2, 2, 3, 3, 1] ;
L = [1, 2, 3, 3, 2, 1] ;
L = [1, 2, 3, 1, 2, 3] ;
false.
My current solution looks like:
even_distance(H, [H | _]) :-
!.
even_distance(V, [_, _ | T]) :-
even_distance(V, T).
list(N, [], _, Length, _, _) :-
Length =:= 2*N,
!.
list(N, [New | L], Max, Length, Used, Duplicates) :-
select(New, Duplicates, NewDuplicates),
even_distance(New, Used),
NewLength is Length + 1,
list(N, L, Max, NewLength, [New | Used], NewDuplicates).
list(N, [New | L], Max, Length, Used, Duplicates) :-
Max < N,
New is Max + 1,
NewLength is Length + 1,
list(N, L, New, NewLength, [New | Used], [New | Duplicates]).
list(N, L) :-
list(N, L, 0, 0, [], []).
It does two things:
if current maximum is less than N, add that number to the list, put it on the list of duplicates, and update the max;
select some duplicate, check if there is an even number of elements between it and the number already on the list (ie. that number is on odd position), then add it to the list and remove it from duplicates.
It works, but it's slow and doesn't look really nice.
The author of this exercise shows that for N < 12, his solution generates a single list with average of ~11 inferences (using time/1 and dividing the result by N!). With my solution it grows to ~60.
I have two questions:
How to improve this algorithm?
Can this problem be generalized to some other known one? I know about similar problems based on the multiset [1, 1, 2, 2, ..., n, n] (eg. Langford pairing), but couldn't find something like this.
I'm asking because the original problem is about enumerating intersections in a self-intersecting closed curve. You draw such curve, pick a point and direction and follow the curve, enumerating each intersection when met for the first time and repeating the number on the second meeting: example (with the answer [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).
The author states that every such curve satisfies the predicate list, but not every list corresponds to a curve.
I had to resort to arithmetic to satisfy the requirement about pairs of integers separated by even count of elements. Would be nice to be able to solve without arithmetic at all...
list(N,L) :- numlist(1,N,H), list_(H,L), even_(L).
list_([D|Ds],[D|Rs]) :-
list_(Ds,Ts),
select(D,Rs,Ts).
list_([],[]).
even_(L) :-
forall(nth0(P,L,X), (nth0(Q,L,X), abs(P-Q) mod 2 =:= 1)).
select/3 is used in 'insert mode'.
edit to avoid arithmetic, we could use this more verbose schema
even_(L) :-
maplist(even_(L),L).
even_(L,E) :-
append(_,[E|R],L),
even_p(E,R).
even_p(E,[E|_]).
even_p(E,[_,_|R]) :- even_p(E,R).
edit
Here is a snippet based on assignment in a prebuilt list of empty 'slots'. Based on my test, it's faster than your solution - about 2 times.
list(N,L) :-
N2 is N*2,
length(L,N2),
numlist(1,N,Ns),
pairs(Ns,L).
pairs([N|Ns],L) :- first(N,L,R),even_offset(N,R),pairs(Ns,L).
pairs([],_).
first(N,[N|R],R) :- !.
first(N,[_|R],S) :- first(N,R,S).
even_offset(N,[N|_]).
even_offset(N,[_,_|R]) :- even_offset(N,R).
My first attempt, filtering with even_/1 after every insertion, was much slower. I was initially focused on pushing the filter immediately after the select/3, and performance was indeed almost good as the last snippet, but alas, it loses a solution out of 6...

Single cycle permutations

Let's take a permutation of numbers {1,2,3,4} which has only one cycle in it. For example it can be: (2,3,4,1). I was wondering, how can I generate all such permutations using Prolog?
I know how to generate all permutations using select.
But I can't come up with an idea for how to generate only the one-cycle (i.e. single cycle) permutations.
Could someone give me a small prompt or advice?
My comment was intended as a hint for producing directly the single cycle permutations, rather than generating all permutations and filtering out the ones that consist of a single cycle.
We should perhaps clarify that two representations of permutations are frequently used. xyz writes "I know how [to] generate all permutation[s]," presumably meaning something like the code I gave in this 2006 forum post. Here all permutations are represented according to the way a list rearranges the items in some "standard order" list.
Obviously there are N! permutations of all kinds. How many of these are single cycle permutations? That question is easily answered by contemplating the other form useful for permutations, namely as a product of disjoint cycles. We need to distinguish between a cycle like (1,2,3,4) and the identity permutation [1,2,3,4]. Indeed the cycle (1,2,3,4) maps 1 to 2, 2 to 3, 3 to 4, and 4 back to 1, so rather than the identity permutation it would be [2,3,4,1] in its list representation.
Now a cycle loops back on itself, so it is arbitrary where we choose to begin the cycle notation. If we start at 1, for example, then the cycle is determined by the ordering of the following N-1 items. This shows there are (N-1)! permutations of N things that form a single cycle (necessarily of length N). Thus we can generate all single cycle permutations in cycle form easily enough, and the problem then reduces to converting from that cycle form to the list form of a permutation. [Note that in part Mog tackled the conversion going in the other direction: given a permutation as list, ferret out a cycle contained in that permutation (and see if it is full length).]
Here's my code for generating all the one-cycle list permutations of a given "standard order" list, oneCycle(Identity,Permuted):
oneCycle([H|T],P) :-
permute(T,S),
oneCycle2permute([H|S],[H|T],P).
permute([ ],[ ]) :- !.
permute(L,[H|T]) :-
omit(H,L,Z),
permute(Z,T).
omit(H,[H|T],T).
omit(X,[H|T],[H|Z]) :-
omit(X,T,Z).
oneCycle2permute(_,[ ],[ ]) :- !.
oneCycle2permute(C,[I|Is],[P|Ps]) :-
mapCycle(C,I,P),
oneCycle2permute(C,Is,Ps).
mapCycle([X],X,X) :- !.
mapCycle([H|T],X,Y) :-
mapCycleAux(H,T,X,Y).
mapCycleAux(Y,[X],X,Y) :- !.
mapCycleAux(X,[Y|_],X,Y) :- !.
mapCycleAux(_,[X,Y|_],X,Y) :- !.
mapCycleAux(H,[_|T],X,Y) :-
mapCycleAux(H,T,X,Y).
Couldn't you use the function for generating all permutations, and filter out the ones that aren't 'one-cycle permutations'? (Since I'm not at all clear on what 'one-cycle permutations' are, I'm afraid I can't help with writing that filter.)
one-cycle([H|T], Permutation) :-
permutation([H|T], Permutation),
cycle(H, [H], [H|T], Permutation, Cycle),
length(Cycle, CycleLength),
length([H|T], ListLength),
CycleLength =:= ListLength.
The cycle/5 predicate builds the cycle corresponding to the first argument you pass it. the second argument is an accumulator, initialized to [FirstArgument], the third and fourth one are the original List and Permutation, the last one is the result (the list containing the elements of the cycle).
cycle(Current, Acc, List, Permutation, Cycle) :-
The call to corresponds/4 retrieves the item that took the place of the first argument in the permutation :
corresponds(Current, List, Permutation, R),
If this item is in the cycle we're building, it means we're done building the cycle, so we unify Cycle and the accumulator (Acc).
( member(R, Acc)
-> Cycle = Acc
If not, we go on by calling recursively our predicate with the corresponding item we found and we add it to the accumulator, so that our building cycle now holds it :
; cycle(R, [R|Acc], List, Permutation, Cycle)).
corresponds(N, [N|_], [R|_], R) :-
!.
corresponds(N, [_|L], [_|P], R) :-
corresponds(N, L, P, R).
Usage :
?- one-cycle([1, 2, 3, 4], P).
P = [2, 3, 4, 1] ;
P = [3, 1, 4, 2] ;
P = [3, 4, 2, 1] ;
P = [2, 4, 1, 3] ;
P = [4, 1, 2, 3] ;
P = [4, 3, 1, 2] ;
false.
Thanks to the discussion in the answer by hardmath I was able to understand what it was all about.
It seems the solution is quite simply to replace the input list's tail with its permutation to form a cycle description, then transform that into its list representation by paring up each element with its next and sorting on the first component to get the list of the second components as the result list:
single_cycled_permutation([A|B], R) :-
permutation(B, P),
cycle_pairs(A, A, P, CP),
sort( CP, SCP),
maplist( pair, SCP, _, R).
pair( X-Y, X, Y).
cycle_pairs( A, X, [Y|Z], [X-Y|W]) :-
cycle_pairs(A, Y, Z , W ).
cycle_pairs( A, X, [ ], [X-A] ).
To easier see the cycles simply remove the last goal in single_cycled_permutation:
single_cycled_pairs([A|B], SCP) :-
permutation(B, P),
cycle_pairs(A, A, P, CP),
sort( CP, SCP).
Testing:
21 ?- forall( single_cycled_pairs([1,2,3,4], SCP),
(maplist(pair,SCP,_,R), write((SCP,R)), nl)).
[1-2,2-3,3-4,4-1],[2,3,4,1]
[1-2,2-4,3-1,4-3],[2,4,1,3]
[1-3,2-4,3-2,4-1],[3,4,2,1]
[1-3,2-1,3-4,4-2],[3,1,4,2]
[1-4,2-3,3-1,4-2],[4,3,1,2]
[1-4,2-1,3-2,4-3],[4,1,2,3]
true.
See also:
Cyclic permutation
Cycles and fixed points

Resources