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 have used 'asserta' to put a large csv file with several columns into the database.) Is there a way to sort numerically by column without removing duplicates?
As you can see from my simple example (which sorts by the second column / element), the predsort method removes duplicates.
I could work around this by switching and removing some columns and using msort, but am asking you specifically here for an alternative.
Any advice would be v much appreciated !
mycompare(X,E1,E2):-
E1=[_,A1],E2=[_,A2],compare(X, A1, A2).
?- predsort(mycompare,[ [[95, 97], 11], [[97, 99], 4], [[97, 98], 4]],X).
X = [[[97, 99], 4], [[95, 97], 11]].
?- msort([ [[95, 97], 11], [[97, 99], 4], [[97, 98], 4]],X).
X = [[[95, 97], 11], [[97, 98], 4], [[97, 99], 4]].
%What I want is:
?- wanted_sort(...<as above>...).
X = [[[97, 98], 4], [[97, 99], 4], [[95, 97], 11] ].
The standard way to do this would be to use keysort/2. So first you start by mapping the elements accordingly, then keysorting, and mapping back the values.
list_pairs([], []).
list_pairs([E|Es], [B-E|Ps]) :-
E = [_,B],
list_pairs(Es, Ps).
pairs_values([], []).
pairs_values([_-V|Ps], [V|Vs]) :-
pairs_values(Ps, Vs).
andrew_sort(Xs, Ys) :-
list_pairs(Xs, Ps),
keysort(Ps, PsS),
pairs_values(PsS, Ys).
For other uses of keysort/2 see this list.
Imho predsort/3 provides a very general and fairly efficient way to do - it's as simple as avoiding returning = from the comparison predicate. Example:
?- [user].
|: comparer(<, A, B) :- A #< B.
|: comparer(>, _, _).
(^D here)
true.
?- predsort(comparer, [1,2,1,a,b,a], L).
L = [1, 1, 2, a, a, b].
Your test case:
mycompare(<,[_,A1|_],[_,A2|_]) :- A1 < A2.
mycompare(>, _, _).
yields
?- predsort(mycompare,[ [[95, 97], 11], [[97, 99], 4], [[97, 98], 4]],X).
X = [[[97, 98], 4], [[97, 99], 4], [[95, 97], 11]].
I slightly generalized the pattern matched, from [_,N] to [_,N|_]...
edit: it's funny, I didn't read the title...
to generalize comparing for nth argument:
?- predsort(nthcompare(2),[ [[95, 97], 11], [[97, 99], 4], [[97, 98], 4]],X).
X = [[[97, 98], 4], [[97, 99], 4], [[95, 97], 11]].
and nthcompare/4 itself:
nthcompare(N,<,A,B) :- nth1(N,A,X),nth1(N,B,Y), X #< Y.
nthcompare(_,>,_,_).
that is...
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 = [].
I've got a function which takes a list, and removes all unique elements in that list:
repeating(Q, L):-
repeating(Q, Q, L).
repeating([], _, []).
repeating([H | T], Q, [H | L]):-
count(H, Q, N),
N > 1, !,
repeating(T, Q, L).
repeating([H | T], Q, L):-
count(H, Q, N),
N = 1,
repeating(T, Q, L).
for example the query
repeating([1, 2, 3, 4, 5, 2, 7, 7, 3, 8], X).
gives
X = [2, 3, 2, 7, 7, 3].
I want to apply this to a list made up of four element long lists, checking only the third element, such that, for example
repeating([[1, 2, 3, 4], [5, 6, 7, 8], [3, 5, 7, 9], [4, 3, 2, 1]], X).
would return
X = [[5, 6, 7, 8], [3, 5, 7, 9].
only the lists which had non-unique third elements. My code as now only applies to simple lists such as the first one, and I've spent all morning trying to come up with a way to modify it to apply to cases such as these for an arbitrarily long list of four element long lists, but have not been able to find a way to do so, and would very much appreciate some guidance on this.
Thanks.
You can get a function to retrieve the third element of each list, and then adapt your code by checking those elements
%get the third element of a list
third([_,_,E|_], E).
%Build a list made of the third elements of the input list
buildthirdslist([],[]).
buildthirdslist([X|Xl],[Th|Thl]):-
third(X,Th),
buildthirdslist(Xl,Thl).
%Your code adapted
repeatingthirds(Q, L):-
buildthirdslist(Q,Ths),
repeatingthirds(Q, Ths, L).
repeatingthirds([], _, []).
repeatingthirds([H | T], Q, [H | L]):-
third(H,Th),
count(Th, Q, N),
N > 1, !,
repeatingthirds(T, Q, L).
repeatingthirds([H | T], Q, L):-
third(H,Th),
count(Th, Q, N),
N = 1,
repeatingthirds(T, Q, L).
Just a little variation from Guillermo's solution. This one leaves your repeating predicate unchanged and uses a different count:
repeating(Q, L):-
repeating(Q, Q, L).
repeating([], _, []).
repeating([H | T], Q, [H | L]):-
count(H, Q, N),
N > 1, !,
repeating(T, Q, L).
repeating([H | T], Q, L):-
count(H, Q, N),
N = 1,
repeating(T, Q, L).
count(H, Q, N) :-
count(H, Q, 0, N).
count([_,_,E,_], [[_,_,E,_]|T], A, N) :-
A1 is A + 1,
count([_,_,E,_], T, A1, N).
count([_,_,E,_], [[_,_,X,_]|T], A, N) :-
E \= X,
count([_,_,E,_], T, A, N).
count(_, [], A, A).
Quick test:
| ?- repeating([[1, 2, 3, 4], [5, 6, 7, 8], [3, 5, 7, 9], [4, 3, 2, 1]], X).
X = [[5,6,7,8],[3,5,7,9]] ? a
no
| ?-