Related
I am now quite a while trying to figure out what my mistake is, but I am not able to.
Task:
We have to figure out how to find three permutations of a List containing 9 elements in the form of List of Lists. Each List of Lists should contain three sublists, each containing three elements. But no element is allowed to be together with another element in two different sublists.
The following output for the three permutations A, B, C with the given List= [1,2,3,4,5,6,7,8,9] could be:
predicate(A, B, C , [1,2,3,4,5,6,7,8,9]).
A = [[1,2,3],[4,5,6],[7,8,9]],
B = [[1,4,7],[2,5,8],[3,6,9]],
C = [[1,5,9],[2,6,7],[3,4,8]].
My Code so far (first my helper predicates) :
To split a list into a List of Lists ( N is always 3 ):
split_list(List, N, Splitted_List) :-
split_helper(List, N, [], Splitted_List).
split_helper([], _, Acc, Acc).
split_helper(List, N, Acc, Splitted_List) :-
my_append(H, T, List),
my_length(H, N),
split_helper(T, N, [H|Acc], Splitted_List).
A possible query:
split_list([1,2,3,4,5,6,7,8,9], 3, X).
X = [[1,2,3],[4,5,6],[7,8,9]].
To check wether all sublists of a List of lists contains at most one same element:
max_one_common_element(List1, List2) :-
max_one_common_element(List1, List2, 0).
max_one_common_element([], _, Count) :-
Count =< 1.
max_one_common_element([H|T], List2, Count) :-
(my_member(H, List2) ->
NewCount is Count + 1,
max_one_common_element(T, List2, NewCount)
;
max_one_common_element(T, List2, Count)
).
A possible query:
max_one_common_element([[1,2,3],[4,5,6],[7,8,9]], [[1,4,7],[2,5,8],[3,6,9]]).
True.
To change order of sublists, for comparing purposes (important later on):
swap_lists(List, Result):-
select(Selected, List, Rest),
append(Rest, [Selected], Result).
A possible query:
swap_list([[1,2,3],[4,5,6],[7,8,9]], X).
X = [[4,5,6],[7,8,9],[1,2,3]].
My main predicate, which instantiates A, B and C. The one making me issues is C, A and B are properly instantiated.
I was thinking to take all permutations of the input List and check with max_one_common_element/2 wether each sublists has at most one common element.
Since max_one_common_element/2 is only able to check both lists at the current index ( e.g. [[1,2],[3,4]], [[3,4],[1,2]] would return True, even though it is False) my idea was to change the order of the sublists from A and B two times and check again with C after the first and second change, so all 3 sublists of A and B should be covered.
main_predicate(A, B, C, List):-
/* instantiates A as the input list but seqmented */
split_list(List, 3 , A),
/* instantiates B as a permutation of A, taking every nth element in a sublist*/
%This part is unimportant since it works properly
/* instantiates C as a permutation from the input list, test that each Sub-List contains at most one same element */
permutation(List, Permuted),
split_list(Permuted, Size, Dessert),
max_one_common_element(A, C),
max_one_common_element(A, C),
/* first swap A and B two times */
swap_lists(A, A1),
swap_lists(A1, A2),
swap_lists(B, B1),
swap_lists(B1, B2),
/* Check again with C */
max_one_common_element(A1, C),
max_one_common_element(A2, C),
max_one_common_element(B1, C),
max_one_common_element(B2, C).
When I make a query of:
predicate(A, B ,C, [1,2,3,4,5,6,7,8,9] ).
My output is:
A = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] ,
B = [[1, 4, 7], [2, 5, 8], [3, 6, 9]] ,
C = [[7, 8, 9], [4, 5, 6], [1, 2, 3]] .
Prolog just do not seem to consider every call of max_one_common_element/2. Since deleting some seem to change the output, but in my mind I have considered all cases and everything should be fine. I also considered changing max_one_common_element/2, but nothing works.
Thank you really much for your help in advance.
Controlling the backtracking was interesting (to enforce comb_available over all the solution sublists):
:- dynamic used/2.
list_perm3(SubLen, L, P) :-
length(L, Len),
int_div_lt_plus1(Len, SubLen, SegLen),
retractall(used(_, _)),
% Work with instantiated, unique list
int_list_wrap(L, LN),
list_perm3_loop(LN, SubLen, SegLen, PN),
% Map to elements in original list
perm_lists_wrap(PN, L, P).
int_list_wrap(L, LN) :-
int_list_wrap_(L, 1, LN).
int_list_wrap_([], _, []).
int_list_wrap_([H|T], I, [i(I, H)|LN]) :-
I1 is I + 1,
int_list_wrap_(T, I1, LN).
% Can contain sublists
perm_lists_wrap([], _, []).
perm_lists_wrap([[]|T], L, [[]|P]) :-
perm_lists_wrap(T, L, P).
perm_lists_wrap([[H|R]|T], L, [E|P]) :-
% Is a sublist
perm_lists_wrap([H|R], L, E),
perm_lists_wrap(T, L, P).
% Using i/2 for first-argument indexing
perm_lists_wrap([i(_, E)|T], L, [E|P]) :-
perm_lists_wrap(T, L, P).
int_div_lt_plus1(Int, Div, Mod) :-
divmod(Int, Div, Mod0, Rem),
( Rem =:= 0
-> Mod is Mod0
% If doesn't divide cleanly, add 1
; Mod is Mod0 + 1
).
list_perm3_loop(L, SubLen, SegLen, P) :-
% Keeping backtracking to this top-level
(list_perm3_(L, SubLen, SegLen, P) -> true ; !, fail).
list_perm3_loop(L, SubLen, SegLen, P) :-
list_perm3_loop(L, SubLen, SegLen, P).
list_perm3_(L, SubLen, SegLen, P) :-
length(P, SegLen),
perm3_segments(P, SubLen, L),
assert_used(P).
assert_used([]).
assert_used([H|T]) :-
% Assert the used pairs, to prevent reuse
forall(
( select(E1, H, H0),
member(E2, H0)
),
assert(used(E1, E2))
),
assert_used(T).
perm3_segments([], _, []).
perm3_segments([H|T], SubLen, L) :-
perm3(L, H, SubLen, R),
perm3_segments(T, SubLen, R).
perm3(L, P, SubLen, R) :-
length(L, LLen),
PLen is min(LLen, SubLen),
length(P, PLen),
perm3_(P, L, [], R).
perm3_([], R, _, R).
perm3_([H|T], L, P, R) :-
select(H, L, L0),
comb_available(P, H),
perm3_(T, L0, [H|P], R).
comb_available([], _).
comb_available([H|T], E) :-
\+ used(E, H),
comb_available(T, E).
Results in swi-prolog:
?- list_perm3(3, [1,2,3,4,5,6,7,8,9], P).
P = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] ;
P = [[1, 4, 7], [2, 5, 8], [3, 6, 9]] ;
P = [[1, 5, 9], [2, 6, 7], [3, 4, 8]] ;
P = [[1, 6, 8], [2, 4, 9], [3, 5, 7]] ;
false.
To take the first 3:
?- once(findnsols(3, P, list_perm3(3, [1,2,3,4,5,6,7,8,9], P), [A,B,C])).
A = [[1, 2, 3], [4, 5, 6], [7, 8, 9]],
B = [[1, 4, 7], [2, 5, 8], [3, 6, 9]],
C = [[1, 5, 9], [2, 6, 7], [3, 4, 8]].
Example of handling vars and leftover sublists:
?- list_perm3(3, [1,2,3,Four,5,6,7,8,9,Ten,Eleven], P).
P = [[1, 2, 3], [Four, 5, 6], [7, 8, 9], [Ten, Eleven]] ;
P = [[1, Four, 7], [2, 5, 8], [3, 6, Ten], [9, Eleven]] ;
P = [[1, 5, 9], [2, Four, Ten], [3, 7, Eleven], [6, 8]] ;
P = [[1, 6, Eleven], [3, Four, 8], [5, 7, Ten], [2, 9]] ;
false.
I managed to come up with my own solution:
make_dessert(Starter, Main, Dessert, List_of_Persons, Size):-
permutation(List_of_Persons, Permuted),
split_list(Permuted, Size, Dessert),
at_most_one_common(Starter, Dessert),
at_most_one_common(Main, Dessert).
split_list(List, N, Splitted_List) :-
split_helper(List, N, [], Splitted_List).
split_helper([], _, Acc, Acc).
split_helper(List, N, Acc, Splitted_List) :-
append(H, T, List),
length(H, N),
split_helper(T, N, [H|Acc], Splitted_List).
at_most_one_common([], _).
at_most_one_common([H|T], List2) :-
check_list(H, List2),
at_most_one_common(T, List2).
check_list(_, []).
check_list(X, [H|T]) :-
intersection(X, H, Z),
length(Z, L),
L =< 1,
check_list(X, T).
I forgot to mention that I receive bonus points for keeping the inferences as low as possible. As my program is not as efficient as #brebs 's, I would really appreciate a few tipps from you to lower these. I am maybe also considering starting a new question regarding this case later on.
I am a complete amateur on Prolog so my question might be very basic. I want to automatically generate a list from 1 to N, then split it into even and odd, from just one integer input (so I don't input the list manually). Let's say I input 5, then the result should be like this:
X = [1,3,5]
Y = [2,4]
Doesn't matter which one is X, which one is Y.
How should I tackle this problem?
I know the built-in function to generate list is numlist(1,5,L).
I also found an answer on how to split the list here
I tried to combine those two like this
separate_even_odd(N) :- numlist(1,N,L), separate_even_odd(L, X, Y).
Then call the function separate_even_odd(5).
All i got is True.
Ultimately I want to append the odd list to the even list but let's put that on another story. For now, I just want it splitted.
SWI-Prolog has a library predicate partition/4 that seems it's done to fulfill your needs:
separate_even_odd(Integers, Even, Odd) :-
partition(integer_is_even, Integers, Even, Odd).
integer_is_even(I) :- I mod 2 =:= 0.
Instead of providing the service predicate integer_is_even/1, we could as well use the lambda library(yall):
separate_even_odd(Integers, Even, Odd) :-
partition([I] >> (I mod 2 =:= 0), Integers, Even, Odd).
and we get
?- numlist(1,5,L), separate_even_odd(L, Even, Odd).
L = [1, 2, 3, 4, 5],
Even = [2, 4],
Odd = [1, 3,
Just to illustrate some of the unusual constructs of Prolog (unification and if/then/else), take a look at a simple implementation, in procedural style, without library predicates:
list_with_separate_even_odd(IntegerLow, IntegerHigh, Even, Odd) :-
( IntegerLow > IntegerHigh
-> Even = [], Odd = []
; ( IntegerLow mod 2 =:= 0
-> Even = [IntegerLow|RestEven], Odd = RestOdd
; Even = RestEven, Odd = [IntegerLow|RestOdd]
),
LowSucc is IntegerLow + 1,
list_with_separate_even_odd(LowSucc, IntegerHigh, RestEven, RestOdd)
).
Note in particular how =/2 performs unification, not assigment.
Alternative method, with an introduction to difference lists due to "Ultimately I want to append the odd list to the even list":
between_evens_odds(Upper, Evens, EvensTail, Odds) :-
integer(Upper),
Upper #>= 1,
between_evens_odds_(1, Upper, Evens, EvensTail, Odds).
between_evens_odds_(Upto, Upper, Evens, EvensTail, Odds) :-
compare(Comp, Upper, Upto),
between_evens_odds_comp_(Comp, Upto, Upper, Evens, EvensTail, Odds).
between_evens_odds_comp_(<, _Upto, _Upper, EvensTail, EvensTail, []).
% Started with 1, so final number will also be odd
between_evens_odds_comp_(=, Upto, _Upper, EvensTail, EvensTail, [Upto]).
between_evens_odds_comp_(>, Upto, Upper, [Upto1|Evens], EvensTail, [Upto|Odds]) :-
Upto1 is Upto + 1,
Upto2 is Upto + 2,
between_evens_odds_(Upto2, Upper, Evens, EvensTail, Odds).
Results in swi-prolog:
% Using 0 as an example - it of course fails
?- between(0, 6, Upper), between_evens_odds(Upper, Ev, EvT, Od).
Upper = 1,
Ev = EvT,
Od = [1] ;
Upper = 2,
Ev = [2|EvT],
Od = [1] ;
Upper = 3,
Ev = [2|EvT],
Od = [1, 3] ;
Upper = 4,
Ev = [2, 4|EvT],
Od = [1, 3] ;
Upper = 5,
Ev = [2, 4|EvT],
Od = [1, 3, 5] ;
Upper = 6,
Ev = [2, 4, 6|EvT],
Od = [1, 3, 5].
Here's the magic of difference lists - since we've already iterated through the list of Evens to the end, we can grab the tail of Evens, rather than iterate through all of Evens yet again using append, for performance:
?- between_evens_odds(5, Ev, EvT, Od), EvT = Od.
Ev = [2, 4, 1, 3, 5],
EvT = Od, Od = [1, 3, 5].
A simple and efficient implementation:
separate_odd_even(N, Odd, Even) :-
odd_even_loop(1, N, Odd, Even).
odd_even_loop(M, N, Odd, Even) :-
Bool is sign(abs(N-M)), % reify equality between M and N to avoid non-determinism
odd_even_case(Bool, M, N, Odd, Even).
odd_even_case(0, M, _, [M], []). % M and N are equal
odd_even_case(1, M, N, [M|Odd], Even) :- % M and N are different
M1 is M + 1,
odd_even_loop(M1, N, Even, Odd).
Examples:
?- separate_odd_even(8, O, E).
O = [1, 3, 5, 7],
E = [2, 4, 6, 8].
?- separate_odd_even(9, O, E).
O = [1, 3, 5, 7, 9],
E = [2, 4, 6, 8].
?- separate_odd_even(3, [1,3], E).
E = [2].
?- separate_odd_even(3, O, [2]).
O = [1, 3].
?- separate_odd_even(3, [1,3], [2]).
true.
?- separate_odd_even(3, [1,2], [3]).
false.
?- time(separate_odd_even(1000000, O, E)).
% 3,000,001 inferences, 0.313 CPU in 0.312 seconds (100% CPU, 9600003 Lips)
O = [1, 3, 5, 7, 9, 11, 13, 15, 17|...],
E = [2, 4, 6, 8, 10, 12, 14, 16, 18|...].
For my assignment I need to create a list of all the possible shifts (rotations) of another list in prolog. For example,
Prototype: all_shifts(+A,-R,+L,+S) *S will always start at 1*
?- length([1,2,3,4],L), all_shifts([1,2,3,4],R,L,1).
L = 4,
R = [[2, 3, 4, 1], [3, 4, 1, 2], [4, 1, 2, 3]].
Currently, I have a program that shifts it to the left once.
one_shift(A, R) :-
rotate(left, A, R).
rotate(left, [H|T], L) :- append(T, [H], L).
However, I need to create another program in which the final result (R) contains all of the possible shifts. Recursion in prolog is really beginning to confuse me, but I'm pretty sure that's whats required. Any help would be really appreciated.
Stay logically pure using same_length/2 and append/3!
list_rotations(Es, Xss) :-
same_length(Es, [_|Xss]),
rotations_of(Xss, Es).
rotations_of([], _Es).
rotations_of([Xs|Xss], Es) :-
same_length([_|Xss], Suffix),
same_length(Es, Xs),
append(Suffix, Prefix, Xs),
append(Prefix, Suffix, Es),
rotations_of(Xss, Es).
Sample query:
?- list_rotations([A,B,C,D], Xss).
Xss = [[B,C,D,A],
[C,D,A,B],
[D,A,B,C]]. % succeeds deterministically
A solution to your problem could be:
rotatelist([H|T], R) :- append(T, [H], R).
rotate(L,LO,LL):-
rotatelist(L,L1),
\+member(L1,LO),!,
append([L1],LO,L2),
rotate(L1,L2,LL).
rotate(_,L,L).
?- rotate([1,2,3,4],[],L).
L = [[1, 2, 3, 4], [4, 1, 2, 3], [3, 4, 1, 2], [2, 3, 4, 1]]
Simply rotates the list and checks if this list has already been inserted in the output list. If not the recursion continues, otherwise it returns the list in L. I've inserted the cut ! just to have only the list with all the possible rotations. If you want generate also the other lists just remove it...
If instead you want a solution with the prototype you provide, it could be:
rotatelist([H|T], R) :- append(T, [H], R).
all_shifts(_,[],I,I).
all_shifts(L,Result,Len,I):-
I < Len,
rotatelist(L,LO),
I1 is I+1,
all_shifts(LO,R1,Len,I1),
append([LO],R1,Result).
?- length([1,2,3,4],L), all_shifts([1,2,3,4],R,L,1).
L = 4,
R = [[2, 3, 4, 1], [3, 4, 1, 2], [4, 1, 2, 3]]
The idea is basically the same as before... Note that this second solution is not tail recursive.
Say I have a list [1, 2, 3, 4, 5, 6, 7, 8], what I want to do is have an output of [[1,2], [3,4], [5,6], [7,8]].
This is my current attempt at doing this:
perms([X,Y], [X,Y], _).
perms(L, R, N) :-
N > 1,
N1 is N/2,
split(L, X1, X2),
perms(X1, R1, N1),
perms(X2, R2, N1),
append([R1], [R2], R).
split(L, R1, R2) :-
append(R1, R2, L),
length(L, N),
N1 is N/2,
length(R1, N1),
length(R2, N1).
Assume N is the length of the list that I will enter manually.
The answer seems too much simple, I'm fairly sure I didn't understand your requirement. Anyway, you could try
pairs([X,Y],[[X,Y]]).
pairs([X,Y|R],[[X,Y]|T]) :- pairs(R, T).
group([], []).
group([A, B | Tail], [[A, B] | NewTail]) :-
group(Tail, NewTail).
Test run:
?- group([1, 2, 3, 4, 5, 6, 7, 8], X).
X = [[1, 2], [3, 4], [5, 6], [7, 8]].
?- group([1, 2, 3, 4, 5, 6, 7], X).
false.
?- group([], X).
X = [].
[a,b,c,d] and
[[1,2,3,4],[5,6,7,8],[43,34,56,5],[23,32,2,2]]
I want to make
[[a,1,2,3,4],[b,5,6,7,8],[c,43,34,56,5],[d,23,32,2,2]]
I use swi prolog is it possible do it ?
Thanks a lot.
solve([], [], []).
solve([[X|Y]|S], [X|L1], [Y|L2]):-
solve(S, L1, L2).
UPDATE: How to use
Write the function in a file "a.pl", then in swi-prolog type:
['a.pl'].
then type:
solve(X, [a,b,c,d], [[1,2,3,4],[5,6,7,8],[43,34,56,5],[23,32,2,2]]).
You will get:
X = [[a, 1, 2, 3, 4], [b, 5, 6, 7, 8], [c, 43, 34, 56, 5], [d, 23, 32, 2, 2]]
I have the strange feeling that I am doing your homework. Is it?
Use meta-predicate maplist/4 and Prolog lambdas like this:
?- As = [a,b,c,d],
Bss = [[1,2,3,4],[5,6,7,8],[43,34,56,5],[23,32,2,2]],
maplist(\H^T^[H|T]^true,As,Bss,Css).
As = [ a , b , c , d ],
Bss = [[ 1,2,3,4],[ 5,6,7,8],[ 43,34,56,5],[ 23,32,2,2]],
Css = [[a,1,2,3,4],[b,5,6,7,8],[c,43,34,56,5],[d,23,32,2,2]].
Edit
Different lambda terms can be used in above maplist/4 goal, as pointed out in a comment.
maplist(\H^T^[H|T]^true,As,Bss,Css)
maplist(\H^T^ =([H|T]) ,As,Bss,Css)
SWI Prolog can do this with two short predicates:
merge0(A, B, Prev, Next) :- append(Prev, [[A|B]], Next).
merge(A, B, Result) :- foldl(merge0, A, B, [], Result).
Here is example of input and output:
a(X) :- X = [a,b,c,d].
b(X) :- X = [[1,2,3,4],[5,6,7,8],[43,34,56,5],[23,32,2,2]].
?- a(A), b(B), merge(A, B, Result).
Result = [[a, 1, 2, 3, 4], [b, 5, 6, 7, 8], [c, 43, 34, 56, 5], [d, 23, 32, 2, 2]].
try this:
delete(X, [X|T], T).
delete(X, [Y|T], [Y|L]):-
delete(X, T, L).
insert(X, List, BigList):-
delete(X, BigList, List).
if([],X,X).
if([H1|T1],[H2|T2],[SH|ST]):-
insert(H1,H2,SH),!,
if(T1,T2,ST).
I doubled checked, it works.
"if" stands for "insert first".