Find cycle of permutation in Prolog - prolog

I'm new in Prolog world. I want to find out if a permutation is 'one-cycle'.
I'm trying to write a predicate to generate cycle from permutation. Here is my code (not working):
find_next([E|_], [N|_], E, N).
find_next([_|L1], [_|L2], E, N) :-
find_next(L1, L2, E, N).
find_cycle(L1, L2, E, C) :-
append(C, [E], C1),
find_next(L1, L2, E, N),
find_cycle(L1, L2, N, C1).
Permutations are represented by two lists (for example: [1, 2, 3, 4], [3, 4, 2, 1]).
find_next generates next cycle element (N) for element (E) (for example: E=1, N=3).
find_cycle looks for cycle (C) starting from element E.
Unfortunately I don't know how to stop my recurrence when find_next returns N same as first element of cycle C.
EDIT: some examples.
find_cycle([1, 2, 3, 4], [3, 4, 2, 1], 1, X).
should return:
X = [1, 3, 2, 4];
false.
and:
find_cycle([1, 2, 3, 4], [4, 2, 1, 3], 1, X).
should return:
X = [1, 4, 3];
false.
Why?
It is simple decomposition of permutation into disjointed cycles.
Let's analyze second permutation: [1, 2, 3, 4], [4, 2, 1, 3].
Take first element: 1.
1 goes into 4
4 goes into 3
3 goes into 1
end of cycle.
This permutation is not decomposable into one cycle (length of generated cycle is smaller than length of permutation).

To find all the cycles of the permutation:
perm_to_cycles(Perm, NPerm, Cycles):-
perm_struct(Perm, NPerm, PermS),
perm_to_cycles(PermS, [], [], Cycles),
!.
perm_to_cycles([], _, Cycles, Cycles).
%perm_to_cycles([p(Id, Id)|PermS], _, InCycles, Cycles):-
% perm_to_cycles(PermS, [], InCycles, Cycles). % This clause would remove fixed elements
perm_to_cycles([p(Id, Item)|PermS], Cycle, InCycles, Cycles):-
(select(p(Item, NId), PermS, NPermS) ->
perm_to_cycles([p(Item, NId)|NPermS], [Id|Cycle], InCycles, Cycles) ;
(
reverse([Id|Cycle], RCycle),
perm_to_cycles(PermS, [], [RCycle|InCycles], Cycles)
)
).
perm_struct([], [], []).
perm_struct([Item|Perm], [NItem|NPerm], [p(Item, NItem)|PermS]):-
perm_struct(Perm, NPerm, PermS).
The commented clause would remove fixed elements of list of cycles.
To get only one-cycle permutations you can constrain the third argument to be a one-element list. For example:
?- perm_to_cycles([1, 2, 3, 4], [3, 4, 2, 1], [X]).
X = [1, 3, 2, 4]
?- perm_to_cycles([1, 2, 3, 4], [4, 2, 1, 3], [X]).
false.
?- perm_to_cycles([1, 2, 3, 4], [4, 2, 1, 3], X).
X = X = [[2], [1, 4, 3]].

-Hi Dave, here is my solution to the problem. I followed your instructions like 1 goes to 4 , 4 goes to 3 etc and here is what I came up with. First I create arcs between the elements of the two lists(permutations) and then I simply move through the created graph using find_cycle (until our nodes start repeating ). I tried to use variable names that are self explanatory but if have hard time understanding the code let me know.
create_arcs([],[],[]).
create_arcs([H|T],[H1|T1],[arc(H,H1)|RezArc]) :- create_arcs(T,T1,RezArc).
find_cycle(Perm,Perm2,E,X) :- create_arcs(Perm,Perm2,Arcs),
find_cycle(E,Arcs,[],X).
find_cycle(StartNode,Arcs,LocRez,LocRez) :- member(arc(StartNode,NextNode),Arcs),
member(StartNode,LocRez).
find_cycle(StartNode,Arcs,LocRez,FinalRez) :- member(arc(StartNode,NextNode),Arcs),
not(member(StartNode,LocRez)),
append(LocRez,[StartNode],LocRezNew),
find_cycle(NextNode,Arcs,LocRezNew,FinalRez).

Related

Swi-prolog breaks on order check

I have the following code on Prolog
concat([], [], []).
concat([], [H|T], [H|T2]) :- concat([], T, T2).
concat([H|T], L2, [H|T2]) :- concat(T, L2, T2).
is_ordered([]).
is_ordered([_X]).
is_ordered([X,Y|Tail]) :- X =< Y, is_ordered([Y|Tail]).
and I try to get an example of X which fit concat and is_ordered.
When I type
concat([1, 2, 3], [4, 4, 4], X)
I get result, but when I try to do the same with is_ordered
is_ordered(X)
an error occurs after simple examples [] and [_1784]
{
"code":500,
"message":"Unknown error term: assertion_error(fail,pengines:event_term_to_json_data(error('583c29ce-fa49-4b06-971f-1c928260dcac',error(instantiation_error,context(prolog_stack([frame(2,call(system:(=<)/2),_714=<_716),frame(1,pred_line(\"is_ordered/1\",'pengine://583c29ce-fa49-4b06-971f-1c928260dcac/src':31),is_ordered([_756,_762]))]),_676))),_656,'json-html'))"
}
Why could this happen?
The problem is is_ordered/1 is no constructor, you just can't run it with a not unified variable. Example:
?- concat([1, 2, 3], [4, 4, 4], X).
X = [1, 2, 3, 4, 4, 4];
false.
?- concat([1, 2, 3], [4, 4, 4], X), is_ordered(X).
X = [1, 2, 3, 4, 4, 4];
false.
?- is_ordered(X).
X = [];
X = [_1376];
{
"code":500,
"message":"Unknown error term: assertion_error(fail,pengines:event_term_to_json_data(error('05d667b4-a0b8-415b-bee8-459a753f19b3',error(instantiation_error,context(prolog_stack([frame(2,call(system:(=<)/2),_694=<_696),frame(1,pred_line(\"is_ordered/1\",'pengine://05d667b4-a0b8-415b-bee8-459a753f19b3/src':6),is_ordered([_736,_742|_744]))]),_656))),_636,'json-html'))"
}
?- is_ordered([1, 2, 3, 4, 4, 4]).
true;
false.
The first example generates your concatenated list X. The second query additionally runs the test which you want to apply. The third query on the other hand has no info about the content of the variable and tries to unfy it and will fail while trying to apply the third rule. Tested with SWISH.
So the solution is to run the second query instead of the third.

Splitting list into sorted sublists (Prolog)

How can I divide a list [5,4,2,8,3,1,6,9,5] into a list of sub-lists that would be split at the values that break the sequence?
For example a list [5,4,2,8,3,1,6,9,5] should yield a list of sub-lists like [5], [4], [2,8], [3], [1,6,9], [5] or [[5], [4], [2,8], [3], [1,6,9], [5]] (doesn't matter).
Any ideas on this or suggestions how to resolve this problem?
Thanks.
This seemed like a DCG problem to me, so here is one DCG solution:
ascending([X|Xs]) -->
[X],
ascending(X, Xs).
ascending(X, [Y|Xs]) -->
[Y],
{ X =< Y },
{ ! },
ascending(Y, Xs).
ascending(_X, []) -->
[].
This can be used with phrase/3 to obtain both the sorted prefix and the remaining elements:
?- phrase(ascending(Asc), [1,2,3,4,5], Rest).
Asc = [1, 2, 3, 4, 5],
Rest = [].
?- phrase(ascending(Asc), [1,2,3,4,5,2,3,4,5], Rest).
Asc = [1, 2, 3, 4, 5],
Rest = [2, 3, 4, 5].
?- phrase(ascending(Asc), [1,2,3,4,5,2,3,4,5], Rest), phrase(ascending(Asc2), Rest, Final).
Asc = [1, 2, 3, 4, 5],
Rest = Asc2, Asc2 = [2, 3, 4, 5],
Final = [].
The main predicate is just:
sorted_sublists([], []).
sorted_sublists(List, [Prefix|Remaining]) :-
phrase(ascending(Prefix), List, Rest),
sorted_sublists(Rest, Remaining).
However, the cut in ascending//2 is somewhat ugly. Negation in DCGs is a bit tedious, but with constraints it can be made to work:
:- use_module(library(clpfd)).
ascending(X, [Y|Xs]) -->
{ X #=< Y },
[Y],
ascending(Y, Xs).
ascending(X, []) -->
{ X #=< Y },
\+ [Y].
This is quite nice, I think. Is there some way of doing something similar but not necessarily with constraints? Essentially, a way of writing in a DCG "match the empty list, or a nonempty list that does not satisfy some predicate P"?
Quite tricky, but it can be done with DCG :
sub([A,B|T]) --> [[A]], {A > B},sub([B|T]); {A =< B, phrase(sub_1([A,B|T], S), R, [])}, [R], sub(S).
sub([A]) --> [[A]].
sub([]) --> [].
sub_1([A,B|T], S) --> [A], {A =< B}, sub_1([B|T], S);[A], {A > B, S = [B|T]}.
sub_1([A], []) --> [A].
Result :
?- phrase(sub([5,4,2,8,3,1,6,9,5] ), A, []).
A = [[5], [4], [2, 8], [3], [1, 6, 9], [5]] ;
false
.
You just asked for a strategy, but I really wasn't able to come up with a good one. I hope someone else comes along with a better approach than any of mine.
I'm really unhappy with my solution, because it feels like a problem this simple deserves a simple solution and my solution is not very simple. In fact, I feel like something like this ought to work:
sorted_sublists([], []).
sorted_sublists(L, [Prefix|Remaining]) :-
append(Prefix, Suffix, L),
sort(Prefix, Prefix),
sorted_sublists(Suffix, Remaining).
This seems reasonably declarative to me: give me a prefix of L, if it is already sorted, put it in the result list and recur on what remains. However, this doesn't work because Prefix can be the empty list, but if you fix it like so:
sorted_sublists([], []).
sorted_sublists(L, [Prefix|Remaining]) :-
append(Prefix, Suffix, L),
Prefix=[_|_],
sort(Prefix, Prefix),
sorted_sublists(Suffix, Remaining).
It still doesn't work because you get a plethora of solutions, the last of which is the one you actually want:
[debug] ?- sorted_sublists([1,2,3,1,2,1,1], Sublists).
Sublists = [[1], [2], [3], [1], [2], [1], [1]] ;
Sublists = [[1], [2], [3], [1, 2], [1], [1]] ;
Sublists = [[1], [2, 3], [1], [2], [1], [1]] ;
Sublists = [[1], [2, 3], [1, 2], [1], [1]] ;
Sublists = [[1, 2], [3], [1], [2], [1], [1]] ;
Sublists = [[1, 2], [3], [1, 2], [1], [1]] ;
Sublists = [[1, 2, 3], [1], [2], [1], [1]] ;
Sublists = [[1, 2, 3], [1, 2], [1], [1]] ;
false.
Still, it seems like motion in the right direction. What if we had a predicate that could peel off the first sorted prefix? If we had that, we could skip append/3 and the erroneous solutions. So let's focus on writing that predicate. I came up with this:
sorted_prefix([Last], [Last], []).
sorted_prefix([X,Y|Ys], Prefix, Suffix) :-
(X < Y ->
sorted_prefix([Y|Ys], Prefix0, Suffix),
Prefix = [X|Prefix0]
;
Prefix = [X], Suffix = [Y|Ys]
).
So the base case is that we have just one element in our list. That's a sorted prefix.
The inductive case is trickier. The idea is that if the first two items are in order, I want to recur on the second item plus the remaining list, and I want to prepend my result onto that result. In other words, if the sorted prefix of L is R and X is less than the first item of L, then the sorted prefix of [X|L] is [X|R]. If that isn't the case, we wind up in the other situation, which is that if X is greater than the first element of L, the sorted prefix of [X|L] is just [X]. In that case, we also have to work out the suffix, which is just going to be L.
The final sorted_sublists/2 becomes a bit simpler:
sorted_sublists([], []).
sorted_sublists(L, [Prefix|Remaining]) :-
sorted_prefix(L, Prefix, Suffix),
sorted_sublists(Suffix, Remaining).
This is just recursively peeling off one sorted prefix at a time.

How would I modify my predicate to jumble my output result?

So I'm experimenting with some stuff. I have the following simple predicate:
insert([],Y,[Y]).
insert([H|T],Y,[H,Y|T]).
So this'll insert my element Y into my list. However this always puts it in the same place, which is in the middle. But say I wanted it to be more like the following:
?- insert([1,2,3], 4, Zs).
should succeed four times and give the following answers:
Zs = [4, 1, 2, 3]
Zs = [1, 4, 2, 3]
Zs = [1, 2, 4, 3]
Zs = [1, 2, 3, 4].
How would I modify my predicate accordingly?
another useful builtin, extended in SWI-Prolog to handle insertion as well as selection:
?- nth1(_,X,a,[1,2,3]).
X = [a, 1, 2, 3] ;
X = [1, a, 2, 3] ;
X = [1, 2, a, 3] ;
X = [1, 2, 3, a] ;
false.
just ignore first argument (the index itself)
If you want to find possible position of an element in a list, then you have to find all possible concatenation of this list containing the element to insert. This can be described using append/3 predicate:
insert(X,Y,Z):- append(A, B, X), append(A, [Y|B], Z).
This predicate states that exists a concatenation of two sublist that returns list X, and this two sublist concatenated with the value Y in the head of the second sublist, returns list Z.
?- insert([1,2,3], 4, Z).
Z = [4, 1, 2, 3]
Z = [1, 4, 2, 3]
Z = [1, 2, 4, 3]
Z = [1, 2, 3, 4]
false

Removing list within lists based on nth element

I've got a list of lists, for example:
[[1, 2, 3, 2], [1, 3, 4, 3], [1, 4, 5, 4], [2, 3, 5, 6], [1, 5, 6, 5],
[2, 4, 6, 8], [1, 6, 7, 6], [2, 5, 7, 10], [3, 4, 7, 12], [2, 6, 8, 12]]
I'd like to get the last element of and check to see if is the same as the 4th element of any of the other lists. If it is the same then leave the list alone, but if it is unique then remove the list. So in the example above I would be left with:
[[3, 4, 7, 12], [2, 6, 8, 12]]
Essentially I want to be remove all the lists where the last element is unique.
I've written a predicate to get the nth element:
my_membership(X, [X|_]).
my_membership(X, [_|Tail]) :-
my_membership(X, Tail).
where:
my_membership([_,_,_,Fourth],[[3, 4, 7, 12], [2, 6, 8, 12]]).
gives:
Fourth = 12
Fourth = 12
Start by building two basic predicates:
last([X], X).
last([_|T], X) :- last(T, X).
forth([_,_,_,F|_], F).
The first predicate extracts the last element of a list; the second predicate extracts the forth element of a list.
Now you can make a predicate that counts how many tomes an element X appears in forth place in any of the lists of a list of lists. Below, H in [H|T] is a list:
matching_forth([], _, 0).
matching_forth([H|T], X, R) :- forth(H, X), matching_forth(T, X, RR), R is RR + 1.
matching_forth([_|T], X, R) :- matching_forth(T, X, R).
With these predicates in place you can build a predicate for checking your condition. It will have three clauses - for a situation when the list is empty, for when the head list has a matching forth element in another list, and for situations when it doesn't:
my_membership([], [], _).
my_membership([H|T], [H|R], A) :-
last(H, X), matching_forth(A, X, C), C > 1, my_membership(T, R, A).
my_membership([_|T], R, A) :- my_membership(T, R, A).
The first and last clauses are self-explanatory. The middle clause extracts the last element from the head list, counts how many times it matches the forth element in the original list of lists (A stands for "all"), and adds H to the result when there is a match. Adding happens through unification with the head of the result list.
Finally, you need a my_membership/2 predicate to start off the recursive chain that passes along the original list of lists:
my_membership(L, R) :- my_membership(L, R, L).
Demo.
Here's a different twist on a potential solution. It uses an accumulator to collect members that we've seen already and checks along the way. The result saves those that have either been seen or are currently in the tail. It requires the use of the built-in, memberchk/2.
my_membership(L, R) :-
my_membership(L, [], R).
my_membership([], _, []).
my_membership([X|T], Acc, R) :-
X = [_,_,_,D],
( memberchk([_,_,_,D], Acc)
-> R = [X|T1],
Acc1 = Acc
; memberchk([_,_,_,D], T)
-> R = [X|T1],
Acc1 = [X|Acc]
; R = T1,
Acc1 = Acc
),
my_membership(T, Acc1, T1).
| ?- my_membership([[1, 2, 3, 2], [1, 3, 4, 3], [1, 4, 5, 4], [2, 3, 5, 6], [1, 5, 6, 5],
[2, 4, 6, 8], [1, 6, 7, 6], [2, 5, 7, 10], [3, 4, 7, 12], [2, 6, 8, 12]], L).
L = [[2,3,5,6],[1,6,7,6],[3,4,7,12],[2,6,8,12]]
yes

SWI-Prolog sort predicate not working

I just made up a program, doing following task: "Get elements, which values are equal to their indexes".
Here is the code:
% get element's index
get_index([Element|_], Element, 0).
get_index([_|T], Element, Index) :-
get_index(T, Element, Index1),
Index is Index1+1.
index_equals_to_element(List, List2) :-
member(X, List),
get_index(List, X, Index),
Index =:= X,
append([], [X], List2).
It works pretty well. But there is one problem. For list [0, 3, 2, 4, 0] my predicate index_equals_to_element returns [0, 2, 0].
Okay, let it happen. But when I'm trying to output only unique elements, I'm getting the same list without any changes. Example:
?- index_equals_to_element([0, 3, 2, 4, 0], List).
% Outputs [0, 2, 0]
?- sort(List, List2).
% Outputs [0, 2, 0] either, when expected [0, 2]
It's very strange for me, because this works fine:
?- sort([0, 2, 1, 0], List).
% Outputs [0, 1, 2].
Why sort doesn't work only with the list, generated by my predicate?
A simple solution is:
index_equals_to_element(List1, List2) :-
% assume that list position index starts at 0
index_equals_to_element(List1, 0, List2).
index_equals_to_element([], _, []).
index_equals_to_element([X| Xs], Index, List2) :-
NextIndex is Index + 1,
( X == Index ->
List2 = [X| Tail],
index_equals_to_element(Xs, NextIndex, Tail)
; index_equals_to_element(Xs, NextIndex, List2)
).
Example call:
?- index_equals_to_element([0, 3, 2, 4, 0], List).
List = [0, 2].
I suggest you study it by using the trace feature of your Prolog system by typing the query:
?- trace, index_equals_to_element([0, 3, 2, 4, 0], List).
Step trough the execution until is the predicate definition is clear for you.
Your index_equals_to_element([0, 3, 2, 4, 0], List). doesn't output [0, 2, 0] as you claim, but gives three answers [0], [2] and [0]:
?- index_equals_to_element([0, 3, 2, 4, 0], List).
List = [0] ;
List = [2] ;
List = [0] ;
false.
You can use findall to get what you want:
?- findall(X, index_equals_to_element([0, 3, 2, 4, 0], [X]), List).
List = [0, 2, 0].
Update. Here is what I think a better implementation of index_equals_to_element/2:
index_equals_to_element(List, List2) :-
index_equals_to_element(List, 0, List2).
index_equals_to_element([], _, []).
index_equals_to_element([X | Rest], I, Rest2) :-
Inext is I + 1,
index_equals_to_element(Rest, Inext, NewRest),
( X =:= I ->
Rest2 = [X | NewRest]
;
Rest2 = NewRest
).
Test run:
?- index_equals_to_element([0, 3, 2, 4, 0], List).
List = [0, 2].
?- index_equals_to_element([0, 1, 2, 2, 4, 5], List).
List = [0, 1, 2, 4, 5].
The other answers are best for learning the nuts and bolts of Prolog. But here's a more concise (but also easier to grok) solution using the higher-order predicate findall/3 and nth0/3 from the SWI-Prolog library(lists):
elements_equal_to_index(List, Elements) :-
findall(Index, nth0(Index, List, Index), Elements).
Edit:
As #Paulo Moura pointed out in a comment, the above answer is only equivalent to the others offered here if all argument are instantiated. I.e., if the above encounters a free variable in the list, I will bind that variable to its index in the list instead of rejecting it as an unsatisfactory element. The addition of a test for strong equality between the index and the list element should make the answer conform:
elements_equal_to_index(List, Elements) :-
findall( Index,
( nth0(Index, List, Elem),
Elem == Index ),
Elements
).

Resources