Exclude variants/rotations of lists in solutions SWI-Prolog - prolog

I want to exclude multiple rotations/mirrors of a list in my solutions of the predicate. I'll give an example of what I understand are rotations/mirrors of a list:
[1,2,3,4,5]
[2,3,4,5,1]
[3,4,5,1,2]
[5,4,3,2,1]
I have to find a predicate that delivers unique sequence of numbers from 1 to N, according to some constraints. I already figured out how to compute the right sequence but I can't find out how to exclude all the rotations and mirrors of 1 list. Is there an easy way to do this?
Edit:
Full predicate. clock_round(N,Sum,Yf) finds a sequence of the numbers 1 to N in such a way that no triplet of adjacent numbers has a sum higher than Sum.
clock_round(N,Sum,Yf) :-
generate(1,N,Xs),
permutation(Xs,Ys),
nth0(0,Ys,Elem1),
nth0(1,Ys,Elem2),
append(Ys,[Elem1,Elem2],Ym),
safe(Ym,Sum),
remove_duplicates(Ym,Yf).
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+member(H, T),
remove_duplicates( T, T1).
% generate/3 generates list [1..N]
generate(N,N,[N]).
generate(M,N,[M|List]) :-
M < N, M1 is M + 1,
generate(M1,N,List).
% permutation/2
permutation([],[]).
permutation(List,[Elem|Perm]) :-
select(Elem,List,Rest),
permutation(Rest,Perm).
safe([],_).
safe(List,Sum) :-
( length(List,3),
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum
; [_|RestList] = List, % first to avoid redundant retries
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum,
safe(RestList,Sum)
).

So what you want is to identify certain symmetries. At first glance you would have to compare all possible solutions with such. That is, in addition of paying the cost of generating all possible solutions you will then compare them to each other which will cost you a further square of the solutions.
On the other hand, think of it: You are searching for certain permutations of the numbers 1..n, and thus you could fix one number to a certain position. Let's fix 1 to the first position, that is not a big harm, as you can generate the remaining n-1 solutions by rotation.
And then mirroring. What happens, if one mirrors (or reverses) a sequence? Another sequence which is a solution is produced. The open question now, how can we exclude certain solutions and be sure that they will show up upon mirroring? Like: the number after 1 is larger than the number before 1.
At the end, rethink what we did: First all solutions were generated and only thereafter some were removed. What a waste! Why not avoid to produce useless solutions first?
And even further at the end, all of this can be expressed much more efficiently with library(clpfd).
:- use_module(library(clpfd)).
clock_round_(N,Sum,Xs) :-
N #=< Sum, Sum #=< 3*N -2-1,
length(Xs, N),
Xs = [D,E|_],
D = 1, append(_,[L],Xs), E #> L, % symmetry breaking
Xs ins 1..N,
all_different(Xs),
append(Xs,[D,E],Ys),
allsums(Ys, Sum).
allsums([], _).
allsums([_], _).
allsums([_,_], _).
allsums([A,B,C|Xs], S) :-
A+B+C #=< S,
allsums([B,C|Xs], S).
?- clock_round_(N, Sum, Xs), labeling([], [Sum|Xs]).
N = 3, Sum = 6, Xs = [1,3,2]
; N = 4, Sum = 9, Xs = [1,3,4,2]
; N = 4, Sum = 9, Xs = [1,4,2,3]
; N = 4, Sum = 9, Xs = [1,4,3,2]
; N = 5, Sum = 10, Xs = [1,5,2,3,4]
; ... .

Here is a possibility do do that :
is_rotation(L1, L2) :-
append(H1, H2, L1),
append(H2, H1, L2).
is_mirror(L1, L2) :-
reverse(L1,L2).
my_filter([H|Tail], [H|Out]):-
exclude(is_rotation(H), Tail, Out_1),
exclude(is_mirror(H), Out_1, Out).
For example
?- L = [[1,2,3,4,5],[2,3,4,5,1],[3,4,5,1,2],[5,4,3,2,1], [1,3,2,4,5]],my_filter(L, Out).
L = [[1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2], [5, 4, 3, 2, 1], [1, 3, 2, 4|...]],
Out = [[1, 2, 3, 4, 5], [1, 3, 2, 4, 5]].

Related

(Prolog) Check if a list can be split into 2 sub-lists that have equal sums

I am using Prolog to try and check if a list can be split into 2 sublists(subarrays) that have equal sums.
The following should succeed: [1,2,3,6], [2,1,1], [0], [1,1,2]
The following should fail: [1,4,8], [1,3,2], [2,2,1,1]
I believe my program is creating subsequences instead of sublists. This is causing queries similar to [1,3,2] and [2,2,1,1] to succeed when they should fail.
In the example of the query [1,3,2] it is returning true because the subsequences [1,2] and [3] have equal sums. That should not be allowed. Instead, [1,3,2] should be split into sublists [1]/[3,2] and [1,3]/[2]. Hence, it should fail.
I am unsure how to modify the subL predicate to return sublists instead of subsequences.
Here is what I have so far:
split([]).
split([0]).
split([H|T]) :-
subL([H|T], LEFT, RIGHT),
sum(LEFT, SUM1),
sum(RIGHT, SUM2),
SUM1=SUM2.
subL([],[],[]).
subL([H|T], [H|T2], X) :-
subL(T, T2, X).
subL([H|T], X, [H|T2]) :-
subL(T, X, T2).
sum([H|T], SUM1) :-
sum(T, SUM2),
SUM1 is SUM2 + H.
sum([H], SUM1) :-
H = SUM1.
Any help with this would be greatly appreciated. Thank you
YOu can make use of append to split the list into different lists. Indeed:
?- append(L, R, [1,2,3,6]).
L = [],
R = [1, 2, 3, 6] ;
L = [1],
R = [2, 3, 6] ;
L = [1, 2],
R = [3, 6] ;
L = [1, 2, 3],
R = [6] ;
L = [1, 2, 3, 6],
R = [] ;
false.
so you can write a predicate:
split(X) :-
append(L, R, X),
sum(L, S),
sum(R, S).
Here we thus check if both the left and the right sublist sum up to the same sum S. You however slighly need to change your sum/2 predicate such that the sum for an empty list is 0 as well. I leave that as an exercise.
The above is not very efficient, since it takes O(n2) time. You can make it linear by first calculating the sum of the entire list, and then make a predicate that iterates over the list, each time keeping track of the sum of the elements on the left side, and the remaining sum on the right side. I think that by first solving it the "naive" way, you likely will find it easier to implement that as an improvement.

Calculate whether the sum of exactly three values in a list is equal to N

Examples: ([1,2,3,7,6,9], 6). should print True, as 1+2+3=6.
([1,2,3,7,6,9], 5). should print False as there are no three numbers whose sum is 5.
([],N) where N is equal to anything should be false.
Need to use only these constructs:
A single clause must be defined (no more than one clause is allowed).
Only the following is permitted:
+, ,, ;, ., !, :-, is, Lists -- Head and Tail syntax for list types, Variables.
I have done a basic coding as per my understanding.
findVal([Q|X],A) :-
[W|X1]=X,
[Y|X2]=X,
% Trying to append the values.
append([Q],X1,X2),
% finding sum.
RES is Q+W+Y,
% verify here.
(not(RES=A)->
% finding the values.
(findVal(X2,A=)->
true
;
(findVal(X,A)->
% return result.
true
;
% return value.
false))
;
% return result.
true
).
It does not seem to run throwing the following error.
ERROR:
Undefined procedure: findVal/2 (DWIM could not correct goal)
Can someone help with this?
You can make use of append/3 [swi-doc] here to pick an element from a list, and get access to the rest of the elements (the elements after that element). By applying this technique three times, we thus obtain three items from the list. We can then match the sum of these elements:
sublist(L1, S) :-
append(_, [S1|L2], L1),
append(_, [S2|L3], L2),
append(_, [S3|_], L3),
S is S1 + S2 + S3.
Well, you can iterate (via backtracking) over all the sublists of 3 elements from the input list and see which ones sum 3:
sublist([], []).
sublist([H|T], [H|S]) :- sublist(T, S).
sublist([_|T], S) :- sublist(T, S).
:- length(L, 3), sublist([1,2,3,7,6,9], L), sum_list(L, 6).
I'm giving a partial solution here because it is an interesting problem even though the constraints are ridiculous.
First, I want something like select/3, except that will give me the tail of the list rather than the list without the item:
select_from(X, [X|R], R).
select_from(X, [_|T], R) :- select_from(X, T, R).
I want the tail, rather than just member/2, so I can recursively ask for items from the list without getting duplicates.
?- select_from(X, [1,2,3,4,5], R).
X = 1,
R = [2, 3, 4, 5] ;
X = 2,
R = [3, 4, 5] ;
X = 3,
R = [4, 5] ;
X = 4,
R = [5] ;
X = 5,
R = [] ;
false.
Yeah, this is good. Now I want to build a thing to give me N elements from a list. Again, I want combinations, because I don't want unnecessary duplicates if I can avoid it:
select_n_from(1, L, [X]) :- select_from(X, L, _).
select_n_from(N, L, [X|R]) :-
N > 1,
succ(N0, N),
select_from(X, L, Next),
select_n_from(N0, Next, R).
So the idea here is simple. If N = 1, then just do select_from/3 and give me a singleton list. If N > 1, then get one item using select_from/3 and then recur with N-1. This should give me all the possible combinations of items from this list, without giving me a bunch of repetitions I don't care about because addition is commutative and associative:
?- select_n_from(3, [1,2,3,4,5], R).
R = [1, 2, 3] ;
R = [1, 2, 4] ;
R = [1, 2, 5] ;
R = [1, 3, 4] ;
R = [1, 3, 5] ;
R = [1, 4, 5] ;
R = [2, 3, 4] ;
R = [2, 3, 5] ;
R = [2, 4, 5] ;
R = [3, 4, 5] ;
false.
We're basically one step away now from the result, which is this:
sublist(List, N) :-
select_n_from(3, List, R),
sumlist(R, N).
I'm hardcoding 3 here because of your problem, but I wanted a general solution. Using it:
?- sublist([1,2,3,4,5], N).
N = 6 ;
N = 7 ;
N = 8 ;
N = 8 ;
N = 9 ;
N = 10 ;
N = 9 ;
N = 10 ;
N = 11 ;
N = 12 ;
false.
You can also check:
?- sublist([1,2,3,4,5], 6).
true ;
false.
?- sublist([1,2,3,4,5], 5).
false.
?- sublist([1,2,3,4,5], 8).
true ;
true ;
false.
New users of Prolog will be annoyed that you get multiple answers here, but knowing that there are multiple ways to get 8 is probably interesting.

Prolog subgroup of list of size n

I'm trying to create a rule to determine if a list is a sublist of size n of another list.
isSubgroup/3
isSubgroup(+Subgroup, +Group, +N)
For example, isSubgroup([1, 2, 4], [1, 2, 3, 4, 5], 3) would return True
However, isSubgroup([4, 2, 1], [1, 2, 3, 4, 5], 3) would return False (because of the different order)
I thought of checking for each member of the subgroup whether or not it's a member of the large group, but that would ignore the order.
Is the idea feasible?
Really, try to write an inductive relation. Meanwhile, library(yall) coupled with library(apply) can make one liner:
isSubgroup(S,G,N) :- length(S,N),
foldl({G}/[E,P,X]>>(nth1(X,G,E),X>=P),S,1,_F).
As #WillemVanOnsem suggested, an inductive solution:
subGroups([], []).
subGroups([X|Xs], [X|Ys]):-
subGroups(Xs, Ys).
subGroups(Xs, [_|Ys]):-
subGroups(Xs, Ys).
subGroupsN(Options, N, Solution) :-
length(Solution, N),
subGroups(Solution, Options).
We can define this predictate by an inductive definition. A Subgroup is a subgroup of Group if:
the Subgroup is an empty list;
the first element of the Subgroup is the same as the first element of Group, and the rest of the Subgroup is a subgroup of the rest of the Group;
the Subgroup is a subgroup of the rest of the Group.
We need to update N accordingly such that, if the Subgroup is empty, then the length is 0:
isSubgroup([], _, 0). %% (1)
isSubgroup([H|TS], [H|TG], N) :- %% (2)
N1 is N-1,
isSubgroup(TS, TG, N1).
isSubgroup(S, [_|TG], N) :- %% (3)
isSubgroup(S, TG, N).
The above however results in duplicate trues for the same subgroup. This is due to the fact that we can satisfy the predicate in multiple ways. For example if we call:
isSubgroup([], [1,2], 0).
then it is satisfied through the fact (1), but the last clause (3) also calls this with isSubgroup([], [1], 0)., that will then get satisfied through the fact (1), etc.
We can avoid this by making the last clause more restrictive:
isSubgroup([], _, 0). %% (1)
isSubgroup([H|TS], [H|TG], N) :- %% (2)
N1 is N-1,
isSubgroup(TS, TG, N1).
isSubgroup([HS|TS], [_|TG], N) :- %% (3)
isSubgroup([HS|TS], TG, N).
The above works for the given "directions" (all arguments should be grounded, are "input"). But typically one wants to use a predicate in other directions as well. We can implement a version that works basically when we use arguments as "output" as well, and still make use of tail-call optimization (TCO):
isSubgroup(S, G, N) :-
isSubgroup(S, G, 0, N).
isSubgroup([], _, L, L). %% (1)
isSubgroup([H|TS], [H|TG], L, N) :- %% (2)
L1 is L+1,
isSubgroup(TS, TG, L1, N).
isSubgroup([HS|TS], [_|TG], L, N) :- %% (3)
isSubgroup([HS|TS], TG, L, N).
For example:
?- isSubgroup([1,4,2], G, N).
G = [1, 4, 2|_2974],
N = 3 ;
G = [1, 4, _2972, 2|_2986],
N = 3 ;
G = [1, 4, _2972, _2984, 2|_2998],
N = 3 ;
G = [1, 4, _2972, _2984, _2996, 2|_3010],
N = 3 .
Here Prolog is thus able to propose groups for which [1,4,2] is a subgroup, and it is capable to determining the length N of the subgroup.
We can query in the opposite direction as well:
?- isSubgroup(S, [1,4,2], N).
S = [],
N = 0 ;
S = [1],
N = 1 ;
S = [1, 4],
N = 2 ;
S = [1, 4, 2],
N = 3 ;
S = [1, 2],
N = 2 ;
S = [4],
N = 1 ;
S = [4, 2],
N = 2 ;
S = [2],
N = 1 ;
false.
Prolog can, for a given group [1,4,2] enumerate exhaustively all possible subgroups, together with N the length of that subgroup.

Create a list from zero down to a negative number

I want to make a program in which the user will give a negative number and it will return a list starting from zero till that number. Here is a desired output example
create(-5,L).
L = [0,-1,-2,-3,-4,-5]
could you help me in any way, please?
I would break it up into two auxiliary predicates. The auxiliary predicate is helpful for building the list in the direction you desire.
create(N, L) :-
N < 0,
create_neg(N, 0, L).
create(N, L) :-
N >= 0,
create_pos(N, 0, L).
create_neg(N, N, [N]).
create_neg(N, A, [A|T]) :-
A > N,
A1 is A - 1,
create_neg(N, A1, T).
create_pos(N, N, [N]).
create_pos(N, A, [A|T]) :-
A < N,
A1 is A + 1,
create_pos(N, A1, T).
This will put them in the right order as well:
| ?- create(-5, L).
L = [0,-1,-2,-3,-4,-5] ? a
no
| ?- create(5, L).
L = [0,1,2,3,4,5] ? a
no
| ?-
What you're after is not really a program, just an 'idiomatic' pattern:
?- findall(X, (between(0,5,T), X is -T), L).
L = [0, -1, -2, -3, -4, -5].
Note the parenthesis around the Goal. It's a compound one...
Another way:
?- numlist(-5,0,T), reverse(T,L).
...
Since you provided your code (which as mentioned in comments would be better to appear in your question), one problem I think is that with X>0 and X<0 clauses-cases you will have infinite recursion, maybe it would be better to use abs/1:
create(0,[0]).
create(X,[X|T]):- Y is abs(X), Y > 0,
(X>0 -> N is X-1 ; N is X+1),
create(N,T).
Though still one problem:
?- create(-5,L).
L = [-5, -4, -3, -2, -1, 0] ;
false.
?- create(5,L).
L = [5, 4, 3, 2, 1, 0] ;
false.
The list is built reversed so you could reverse it at the end like:
create_list(N,L):- create(N,L1), reverse(L1, L).
And now:
?- create_list(5,L).
L = [0, 1, 2, 3, 4, 5] ;
false.
?- create_list(-5,L).
L = [0, -1, -2, -3, -4, -5] ;
false.

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...

Resources