Getting vertical lists of lists of lists in prolog? - list

a List of Lists like
Lists=[ [1,2,3],
[4,5,6],
[7,8,3] ]
and i want to get in this case all vertical lists like
[1,4,7], [2,5,8], [3,6,3]
how to do that? i thought about 2 counters witch work together like two "for to do" repeats.
i need to check with "is_set" if [1,4,7] is a set or [3,6,3] witch of course is not.
like this:
el_at(Llist,Gl,1),
el_at(EList, Llist,1),
globalListVertikalCheck(ListVertikal),
addlist(Elist,ListVertikal,NewListVertikal),
el_at(Llist,Gl,2),
el_at(EList, Llist,2),
globalListVertikalCheck(ListVertikal),
addlist(Elist,ListVertikal,NewListVertikal),
thanks

A list of all vertical lists is known as a transposed matrix.
SWI's library(clpfd) contains such code.

I didn't fully understand the solution you propose, but I have another one. I will try to describe how it works and maybe than you can see what was wrong with your solution and why it didn't work.
Let's consider an example of [[1,2], [3,4]]. The idea is to go through the first sub-list [1,2] and create an incomplete result [[1],[2]], then go through the next one [3,4] and prepend (which is easier than append in Prolog) each item in it to the each sub-list in the result. We will end up with [[3,1], [4,1]]. The sub-lists are then reversed and we have the result [[1,3],[1,4]].
Now the implementation:
The vertical predicate is the core, it goes through the list of lists and the result is step by step accumulated in the Acc varible.
For each of the sublists, the vertical predicate calls the addfirst predicate, which takes each element of that sublist and prepends it to the list in which the previous results were accumulated.
vertical([X|Xs],Result):-
createempty(X, Acc),
vertical([X|Xs], Acc, ReversedResults),
reverseall(ReversedResults, Result).
reverseall([], []).
reverseall([X|Xs], [XReversed|Rest]):-
reverse(X, XReversed),
reverseall(Xs, Rest).
createempty([], []).
createempty([X|Xs], [[]|R]):-createempty(Xs,R).
vertical([], Result, Result).
vertical([X|Xs], Acc, Result):-
addfirst(X, Acc2, Acc),
vertical(Xs, Acc2, Result).
addfirst([], [], []).
addfirst(
[Y|Ys],
[[Y|YVerticalRest]|ResultRest],
[YVerticalRest|VerticalsRest]):-
addfirst(Ys, ResultRest, VerticalsRest).

Here goes a small implementation of transpose:
It works by taking the first element of every sublist. When it finishes, it recursively does the same but now with the next item of each list, and so on.
transpose(M, T):-
transpose(M, [], T).
transpose([], [], []).
transpose([], S, [[]|T]):-
S \= [] ->
(reverse(S, M), transpose(M, [], T)).
transpose([[]|MTail], S, T):-
transpose(MTail, S, T).
transpose([[Item|Tail]|MTail], S, [[Item|NTail]|T]):-
transpose(MTail, [Tail|S], [NTail|T]).

transpose([[]|_],[]) :- !.
transpose(L,[L1|R2]) :-
transpose(L,L2,L1),
transpose(L2,R2).
transpose([],[],[]) :- !.
transpose([[A|R1]|R2],[R1|R3],[A|R4]) :-
transpose(R2,R3,R4).

Related

I want to replace list into elements of list [duplicate]

I'm trying to modify a list by search and replace, was wondering how do I search through a list with the search term as a list as well?
Lets say I have a list [1,2,3,4] I want to single out the 2 and 3 and replace it with 5,6
so ideally I could have a predicate:
search_and_replace(Search_Term, Replace_Term, Target_List, Result_List).
eg.
search_and_replace([2,3], [5,6], [1,2,3,4], Result_List), write(Result_List).
Let me assume that you want to replace a subsequence substring within a list by another list.
Here is a general way how to do this. You might want to insert
further conditions into the program.
replacement(A, B, Ag, Bg) :-
phrase((seq(S1),seq(A),seq(S2)), Ag),
phrase((seq(S1),seq(B),seq(S2)), Bg).
seq([]) --> [].
seq([E|Es]) --> [E], seq(Es).
And, yes this can be optimized a bit - even its termination property
would profit. But conceptual clarity is a quite precious value...
Edit: Your example query:
?- replacement([2,3], [5,6], [1,2,3,4], Xs).
Xs = [1,5,6,4]
; false.
You can use append/2 as follows :
replace(ToReplace, ToInsert, List, Result) :-
once(append([Left, ToReplace, Right], List)),
append([Left, ToInsert, Right], Result).
With or without use of once/1 depending on if you want all the possibilies or not.
To replace all the occurences I'd go with something like :
replace(ToReplace, ToInsert, List, Result) :-
replace(ToReplace, ToInsert, List, [], Result).
replace(ToReplace, ToInsert, List, Acc, Result) :-
append([Left, ToReplace, Right], List),
append([Acc, Left, ToInsert], NewAcc),
!,
replace(ToReplace, ToInsert, Right, NewAcc, Result).
replace(_ToReplace, _ToInsert, [], Acc, Acc).

Alphabetizing a list of facts using repeat in prolog

I have a list of facts like this:
set(z,a).
set(z,3).
set(z,k).
set(z,10).
set(z,z).
set(z,1).
And I need to sort them like this:
?- sorted(z, List).
List = [1, 3, 10, a, k, z].
How this doesn't seem too bad. But the problem is that I'm required to use repeat to do it.
I have no idea how to do it using repeat. Here's two simple ways I found out without repeat:
sorted(Set, Z) :-
setof(X, set(Set,X), Z).
sorted2(Set,Sorted) :-
findall(X, set(Set,X), List),
sort(List, Sorted).
Here's something I tried doing on my own:
member(X, [Y|T]) :- X = Y; member(X, T).
smallest(Set,A) :-
findall(X, set(Set,X), Xs),
sort(Xs, [A|_]).
sorted(Set, List) :-
List is [],
repeat,
smallest(Set, CurrentSmallest),
not(member(CurrentSmallest, List)) ->
append(List, CurrentSmallest, List), % don't know how to keep adding to this list
length(List,ListLength),
aggregate_all(count, set(Set,_), FactCount),
ListLength = FactCount.
Idea here being that I start with any empty list. Then we start repeating and taking smaller elements one by one. If we haven't already added the element into the answer we add it to the list. Otherwise we don't. Once the list is the same length as our fact base we succeed and stop the repeat.
But adding to the same list clearly doesn't work like that. Also right now it doesn't work when we have duplicate elements in the set. This is very confusing.
EDIT:
I tried changing it a bit and using asserts for the List like Daniel Lyons said. At the moment it still doesn't work. One reason for that that I suspect of is that it keeps taking the same CurrentSmallest on every repeat. I need it to stop doing that, but I have no idea how.
:- dynamic list/1.
assert(list([])).
member(X, [Y|T]) :- X = Y; member(X, T).
smallest(Set,A) :-
findall(X, set(Set,X), Xs),
sort(Xs, [A|_]).
sorted(Set, Answer) :-
repeat,
smallest(Set, CurrentSmallest),
list(List),
not(member(CurrentSmallest, List)) ->
(
append(List, CurrentSmallest, List2),
retract(list(List)),
assert(list(List2))
),
list(Answer),
length(Answer,ListLength),
aggregate_all(count, set(Set,_), FactCount),
ListLength = FactCount.

Prolog: how to transpose non-rectangular matrices by padding

As of right now, I use the following code for transposing rectangular matrices.
trans(L,[Head|Tail]) :-
list_first(L,Head,A),
trans(A,Tail).
trans(Empty,[]) :-
empty(Empty).
empty([[]|Tail]) :-
empty(Tail).
empty([[]]).
list_first([[Head|A]|Rest],[Head|Heads],[A|As]) :-
list_first(Rest,Heads,As).
list_first([],[],[]).
How can I make it work with "jagged" list of lists like [[a,b,c],[1,2]], as used below, too?
Sample query:
?- trans([[a,b,c],[1,2]], T).
false. % desired answer: T = [[a,1],[b,2],[c,[]]
I would stay with some 'reusable' utilities, preprocessing the Lists and ensure all have the same length:
lists_length_max(ListS, LenS, MaxLen) :-
maplist(length, ListS, LenS),
max_list(LenS, MaxLen).
list_padding(MaxLen, ElemPad, List, Len, Padded) :-
LenTail is MaxLen - Len,
length(Tail, LenTail),
maplist(=(ElemPad), Tail),
append(List, Tail, Padded).
trans_padding(ListS, Trans) :-
trans_padding(ListS, Trans, []).
trans_padding(ListS, Trans, PadElem) :-
lists_length_max(ListS, LenS, MaxLen),
maplist(list_padding(MaxLen, PadElem), ListS, LenS, Padded),
trans(Padded, Trans).
now, trans_padding/2 should be called instead of trans/2
Here's another variation:
row([], [_|_], [], []).
row([[]|Rs], A, NewRs, [[]|Cs]) :-
row(Rs, A, NewRs, Cs).
row([[X|Xs]|Rs], A, [Xs|NewRs], [X|Cs]) :-
row(Rs, [X|A], NewRs, Cs).
transpose(Rows, [T|Ts]) :-
row(Rows, [], Rest, T),
transpose(Rest, Ts).
transpose(Empty, []) :-
maplist(=([]), Empty).
transpose operates a row at a time. The row predicate uses an auxiliary argument (the third one) to ensure that it terminates without generating phantom rows that are all empty elements. The call to maplist(=([]), Empty) is a short-hand for the predicate empty/1 defined in the question.

Prolog compressing list

I have a strange problem that I do not know how to solve.
I have written a predicate that compresses lists by removing repeating items.
So if the input is [a,a,a,a,b,c,c,a,a], output should be [a,b,c,a]. My first code worked, but the item order was wrong. So I add a append/3 goal and it stopped working altogether.
Can't figure out why. I tried to trace and debug but don't know what is wrong.
Here is my code which works but gets the item order wrong:
p08([Z], X, [Z|X]).
p08([H1,H2|T], O, X) :-
H1 \= H2,
p08([H2|T], [H1|O], X).
p08([H1,H1|T], O, X) :-
p08([H1|T], O, X).
Here's the newer version, but it does not work at all:
p08([Z], X, [Z|X]).
p08([H1,H2|T], O, X) :-
H1 \= H2,
append(H1, O, N),
p08([H2|T], N, X).
p08([H1,H1|T], O, X) :-
p08([H1|T], O, X).
H1 is not a list, that's why append(H1, O, N) fails.
And if you change H1 to [H1] you actually get a solution identical to your first one. In order to really reverse the list in the accumulator you should change the order of the first two arguments: append(O, [H1], N). Also, you should change the first rule with one that matches the empty list p08([], X, X) (without it, the goal p08([], [], Out) fails).
Now, to solve your problem, here is the simplest solution (which is already tail recursive, as #false stated in the comments to this answer, so there is no need for an accumulator)
p([], []). % Rule for empty list
p([Head, Head|Rest], Out):- % Ignore the Head if it unifies with the 2nd element
!,
p([Head|Rest], Out).
p([Head|Tail], [Head|Out]):- % otherwise, Head must be part of the second list
p(Tail, Out).
and if you want one similar to yours (using an accumulator):
p08(List, Out):-p08(List, [], Out).
p08([], Acc, Acc).
p08([Head, Head|Rest], Acc, Out):-
!,
p08([Head|Rest], Acc, Out).
p08([Head|Tail], Acc, Out):-
append(Acc, [Head], Acc2),
p08(Tail, Acc2, Out).
Pure and simple:
list_withoutAdjacentDuplicates([],[]).
list_withoutAdjacentDuplicates([X],[X]).
list_withoutAdjacentDuplicates([X,X|Xs],Ys) :-
list_withoutAdjacentDuplicates([X|Xs],Ys).
list_withoutAdjacentDuplicates([X1,X2|Xs],[X1|Ys]) :-
dif(X1,X2),
list_withoutAdjacentDuplicates([X2|Xs],Ys).
Sample query:
?- list_withoutAdjacentDuplicates([a,a,a,a,b,c,c,a,a],Xs).
Xs = [a,b,c,a] ; % succeeds, but leaves useless choicepoint(s) behind
false
Edit 2015-06-03
The following code is based on if_/3 and reified term equality (=)/3 by #false, which---in combination with first argument indexing---helps us avoid above creation of useless choicepoints.
list_without_adjacent_duplicates([],[]).
list_without_adjacent_duplicates([X|Xs],Ys) :-
list_prev_wo_adj_dups(Xs,X,Ys).
list_prev_wo_adj_dups([],X,[X]).
list_prev_wo_adj_dups([X1|Xs],X0,Ys1) :-
if_(X0 = X1, Ys1 = Ys0, Ys1 = [X0|Ys0]),
list_prev_wo_adj_dups(Xs,X1,Ys0).
Let's see it in action!
?- list_without_adjacent_duplicates([a,a,a,a,b,c,c,a,a],Xs).
Xs = [a,b,c,a]. % succeeds deterministically
In this answer we use meta-predicate foldl/4 and
Prolog lambdas.
:- use_module(library(apply)).
:- use_module(library(lambda)).
We define the logically pure predicatelist_adj_dif/2 based on if_/3 and (=)/3:
list_adj_dif([],[]).
list_adj_dif([X|Xs],Ys) :-
foldl(\E^(E0-Es0)^(E-Es)^if_(E=E0,Es0=Es,Es0=[E0|Es]),Xs,X-Ys,E1-[E1]).
Let's run the query given by the OP!
?- list_adj_dif([a,a,a,a,b,c,c,a,a],Xs).
Xs = [a,b,c,a]. % succeeds deterministically
How about a more general query? Do we get all solutions we expect?
?- list_adj_dif([A,B,C],Xs).
A=B , B=C , Xs = [C]
; A=B , dif(B,C), Xs = [B,C]
; dif(A,B), B=C , Xs = [A,C]
; dif(A,B), dif(B,C), Xs = [A,B,C].
Yes, we do! So... the bottom line is?
Like many times before, the monotone if-then-else construct if_/3 enables us to ...
..., preserve logical-purity, ...
..., prevent the creation of useless choicepoints (in many cases), ...
..., and remain monotone—lest we lose solutions in the name of efficiency.
More easily:
compress([X],[X]).
compress([X,Y|Zs],Ls):-
X = Y,
compress([Y|Zs],Ls).
compress([X,Y|Zs],[X|Ls]):-
X \= Y,
compress([Y|Zs],Ls).
The code works recursevely and it goes deep to the base case, where the list include only one element, and then it comes up, if the found element is equal to the one on his right , such element is not added to the 'Ls' list (list of no duplicates ), otherwise it is.
compr([X1,X1|L1],[X1|L2]) :-
compr([X1|L1],[X1|L2]),
!.
compr([X1|L1],[X1|L2]) :-
compr(L1,L2).
compr([],[]).

How do I delete all but duplicates from a list in prolog

I have a list, let's say X=[a,b,c,d,c,e,d], how can I delete one of each character so the only answer remains X1=[c,d].
I have a bunch of lists with just alphabetical letters and I need a command which would delete every single letter once if list contains such and do nothing if there's none of that letter.
I have tried using selectchk/3 for this but it only works for specific cases.
For instance if I have list X=[a,b,c,d,d,e,e,f,f,g,h],
I can write selectchk(d,X,X1), selectchk(e,X1,X2), selectchk(f,X2,X3) etc.
As I said, this only works for specific case, however if I add general predicate, let's say I have selectchk/3 for every single letter, but, for example,
new list is X1=[a,b,c,d,d] and I use selectchk(f,X,X3),
command fails and doesn't name the next list X3, so the next command which checks for letter 'G' in list X3 can't run since there's no such list. Is there a possibility to do OR command, if one fails?
X=[a,a,c,d,d,e]
selectchk(a,X,X1) OR (if there's no a) append([],X,X1),selectchk(b,X1,X2) OR (if there's no 'b'), append([],X2,X3) etc.
Thanks
There are several ways one could do this. I think selectchk/3 forms a good basis for a solution, which is really to "automate" what you attempted to do manually and use a recursion:
select_each_one(L, R) :-
sort(L, PickList),
select_each_one(L, PickList, R).
select_each_one(L, [H|T], R) :-
selectchk(H, L, R1),
select_each_one(R1, T, R).
select_each_one(L, [], L).
The sort provides a "picklist" containing just one of each of the elements in the original list. The select_each_one/3 predicate then performs the selectchk with each of those elements on each iteration of the original list.
?- select_each_one([a,b,c,d,c,e,d], L).
L = [c, d] ;
false.
?- select_each_one([a,b,c,d,d,e,e,f,f,g,h], L).
L = [d, e, f] ;
false.
Another approach would be to copy the list over one element at a time, but track whether we've seen the element or not:
select_each_one(L, R) :-
select_each_one(L, [], R).
select_each_one([H|T], Seen, R) :-
( member(H, Seen)
-> R = [H|R1], select_each_one(T, Seen, R1)
; select_each_one(T, [H|Seen], R)
).
select_each_one([], _, []).