Looking up shapes in a lists of lists

Program description

1. Aim of the program

My program is meant to calculate locations of shapes in a 20X15 sized plane. I have a list of shapes carrying the shape type, its id, its radius or height, and its prospective [X,Y] location on the plane. I have a different list of binary operations carrying only the shape type, its id, and its location relationship with another shape. With this information in the operations list, I should compute the [X,Y] locations of the shapes: Below is a description of the two lists:

List of shapes

I have a list of shapes: each shape is a list of the form:

[[shape, id],height/radius, [X,Y]]

A list of such shapes would look something like the below when it is printed out by Prolog:

[[[diamond,1],4,[_7948,_7954]],[[circle,3],6,[_7894,_7900]],[[square,1],4,[_7840,_7846]],[[circle,1],5,[_7786,_7792]]|_7800] 

List of operations

A list of operations that should be carried out on the shapes each operation is of the form:

[[[circle,1],below,[square,1]]] 

This means that circle 1 should appear below square 1 on the X,Y plane

Such a list when printed out by prolog would look something like the following:

[[[circle,1],below,[square,1]]|_8016] 

2. The program

So I have computeShapeLocations/2. Its first argument is a list of operations and the second list is a list of shapes. It recursively goes over the list of operations getting the shape ids on both sides of the operation. eg circle 1 - below - sqaure 1 and sends the two shapes to the correct function to calculate the locations using CLPFD. For two shapes with a relative positioning of 'below' I use computeShapesBelow/2 which takes two shapes each of the form [[shape, id],height/radius, [X,Y]].

Steps in ComputeShapeLocations/2: 1. Get an operation of the form [[[circle,1],below,[square,1]]] from the list of operations 2. Fetch first id (circle 1), then type of relationship (below) then second id (square 1). 3. Fetch the shapes from the shapes list (ShapesOut) 4. Send the shapes to computeShapesBelow/2. This just uses clpfd to compare radius or height and the dimensions of my X,Y plane.

:- use_module(library(clpfd)). computeShapeLocations([],_ShapesOut). computeShapeLocations([Operation|Rest],ShapesOut) :- writeln(ShapesOut),                                                                                                                    writeln([Operation|Rest]),                                                                                                                    nth0(0,Operation,Subject1),                                                                                                                   nth0(1,Operation,below),                                                                                                                 nth0(2,Operation,Subject2),                                                                                                                   Shape1 = [Subject1,H,Loc],                                                                                                                Shape2 = [Subject2,H2,Loc2],                                                                                                              member(Shape1,ShapesOut),                                      member(Shape2,ShapesOut),                                                                                                        writeln(Shape1),                                                                                                                  writeln(Shape2),                                                                                                  writeln(Subject1),                                                                                                                 writeln(Subject2),                                      computeShapeBelow(Shape1,Shape2),                                                                          computeShapeLocations(Rest,ShapesOut). computeShapeBelow(Shape1,Shape2) :- nth0(2,Shape1,Location1),                                                                         nth0(2,Shape2,Location2),                                                                                                                 writeln(Shape1),                                                                                                                  writeln(Shape2),                                                                                                                 nth0(1,Shape1,Dim1),                                                                                                              nth0(1,Shape2,Dim2),                                                                                                              nth0(0,Location1,Xcord1),                                                                                                                 nth0(0,Location2,Xcord2),                                                                                                             nth0(1,Location1,Ycord1),                                                                                                             nth0(1,Location2,Ycord2),                                                                                                          Ycord1 #> Dim1, Ycord1 #< 15-Dim1,                                                                                                             Xcord1 #> Dim1, Xcord1 #< 20-Dim1,                                                                                                             Ycord2 #> Dim2, Ycord2 #<  15-Dim2,                                                                                                            Xcord2 #> Dim2, Xcord2 #<  20-Dim2,                                                                                                            Ycord2 #> Ycord1+Dim2+Dim1. 

The problem: In computeShapeLocations/2 my lookup is just bizarre( see step three above in steps of computeShapeLocations/2). I use member(ShapeId, ListOFshapesList) to fetch shapes from listofshapes given their ids [shape,id]. I then print out the results( writeln(Shape1), writeln(Shape2))and the image below shows just how the behavior is wrong. For the first shape (circle,1), the result is good and computeShapesBelow/2 even comes up with a proper limit of its X,Y location (6..14 and 6..9). For the second shape (Shape2 or square 1). It does not behave as expected and the clpfd limits result in lower infinities.

The reason is because this second search of [square,1] ignores an entry of [[square, 1], 4, [_2166, _2172]] which is in the list and instead somehow adds an extra [[square, 1], _2250, [_2262|...]] which it then uses to mess up my results.

1 Answers

Answers 1

In my opinion, the source of your problem is being obscured by two simple problems. I don't have all your code and I don't really know what you're trying to do, so I'll just talk about what I see and how I would proceed.

The first problem is that you are not making effective use of unification. For instance, you can replace this:

nth0(0,Operation,Subject1), nth0(1,Operation,below), nth0(2,Operation,Subject2), 

With this:

[Subject1,below,Subject2] = Operation, 

But, moreover, you don't really need Operation on its own, so you can move that into the head of your clause:

computeShapeLocations([[Subject1,below,Subject2]|Rest],ShapesOut) :- 

As you start to make these changes your code will contract quite a bit and it should become a lot easier to see what is going on. What would make it even easier to understand would be using less listy representations. For instance, it's a little easier for me to understand what is going on in this command list:

[below(circle(1), square(1)), below(circle(2), square(1)), ...] 

or even this, which you can do by adding an :- op declaration:

[circle(1) below square(1), circle(2) below square(1), ...] 

and then your pattern matches will look even simpler, like:

compute(Shape1 below Shape2) :- ... 

Similarly, for your shapes, it would be a little easier to understand what is going on if you have a little more structure:

shape(circle(1), 4, X@Y) 

is a little more obvious to me than

[[circle,1], 4, [X,Y]] 

I find it a little odd that you've got unbound variables inside your input list. I gather you're hoping they'll obtain values later on. I suppose there's nothing wrong with this approach, I'm just surprised to see a mixture of ground and nonground acting as inputs.

Your second source of trouble is that you're mixing several kinds of procedure together. I'm pretty sure you have a DCG parsing step going on somewhere. By parsing into this weak, listy representation in there, you're forcing yourself to do more work inside these methods destructuring your lists and obtaining their meaning. Consider:

command([Shape1,below,Shape2]) --> shape(Shape1), "below", shape(Shape2). 

versus

command(Shape1 below Shape2) --> shape(Shape1), "below", shape(2). 

Or,

shape_type(circle) --> "circle".  shape_type(square) --> "square". shape_name(shape(Name, Size, X@Y)) -->      shape_type(T), integer(ID),      integer(Size),      integer(X), integer(Y),      { Name =.. [T, ID] }. 

versus whatever you have now.

IOW, you could create structure during the parse that will simplify your life during the processing. Similarly, doing a lot of what looks to me like debug I/O is making your processing more complex.

find_shape(ShapeId, Shapes, Shape) :-     Shape = shape(ShapeId, _, _),     member(Shape, Shapes).  computeShapeLocations([], _). computeShapeLocations([ShapeId1 below ShapeId2|Rest], Shapes) :-     find_shape(ShapeId1, Shapes, Shape1),     find_shape(ShapeId2, Shapes, Shape2),     computeShapeBelow(Shape1, Shape2),     computeShapeLocations(Rest, Shapes).  computeShapeBelow(shape(_, D1, X1@Y1), shape(_, D2, X2@Y2)) :-     Y1 #> D1, Y1 #< 15 - D1,     X1 #> D1, X1 #< 20 - D1,     Y2 #> D2, Y2 #< 15 - D2,     X2 #> D2, X2 #< 20 - D2,     Y2 #> Y1 + D2 + D1. 

I think if I were staring at this I would find it a bit easier to debug.

Read More

Shuffle in prolog

I'm trying to write a procedure in prolog where if L1 = [1,2,3] and L2 = [4,5,6] then L3 = [1,4,2,5,3,6]

so shuffle([1,2,3],[4,5,6],[1,4,2,5,3,6])

I have this so far:

shuffle([X],[Y],[X,Y]). shuffle([X|Xs],[Y|Ys],_) :- shuffle(Xs,Ys,Z), shuffle(X,Y,Z). 

This is my first attempt at writing prolog code so I'm still trying to wrap my head around the syntax, rules and everything.

I understand the logic, I'm just not sure how to implement it so any help would be greatly appreciated!

Thanks!

Edit: I've figured it out. Here's the solution if anyone's interested:

shuffle([X],[Y],[X,Y]).   shuffle([X|Xs],[Y|Ys],[Z1,Z2|Zs]) :- shuffle([X],[Y],[Z1,Z2]),shuffle(Xs,Ys,Zs). 

2 Answers

Answers 1

shuffle([], B, B). shuffle([H|A], B, [H|S]) :- shuffle(B, A, S). 

In this kind of problems, usually the difficult part is not Prolog but identifying the simplest recursive relation that solves it.

Answers 2

Here's the simple solution:

shuffle([], [], []). shuffle([X|Xs], [Y|Ys], [X,Y|Zs]) :-     shuffle(Xs,Ys,Zs). 

Generalizing this to handle list of unequal length is a matter of changing the base case into:

shuffle(Xs, [], Xs). shuffle([], Ys, Ys). 

although that may generate duplicate solutions. Those can be fixed with a cut if you don't mind the predicate being "one-way".

(Though I still think you should call this flatzip or interlace instead of shuffle.)

Read More

Prolog unpacking lists predicate

Hey guys so I tried to create something what would work like this:

?- unpacking([[1], [1,2], [3]], Lst1, NewLst). NewLst=[1,3] 

I wrote it like this:

unpacking([], Lst1, Lst1). unpacking([[H]|T], Lst1, NewLst):-     append([H], Lst2),     unpacking(T, Lst2, NewLst). unpacking([_|T], Lst1, NewLst):-     unpacking(T, Lst1, NewLst). 

and I know that I am doing something wrong, but yeh, I'm starting in Prolog so, need to learn from my mistakes :)

5 Answers

Answers 1

You probably meant:

unpacking([], []). unpacking([[E]|T], [E|L]) :-    unpacking(T, L). unpacking([[]|T], L) :-    unpacking(T, L). unpacking([[_,_|_]|T], L) :-    unpacking(T, L). 

There are more concise ways to write this - and more efficient, too.

Answers 2

What about this :

%?-unpacking([[a,b,c],[a],[b],[c,d]],Items). unpacking(Lists,Items):-  my_tpartition(length_t(1),Lists,Items,Falses).  my_tpartition(P_2,List,Ts,Fs) :- my_tpartition_ts_fs_(List,Ts,Fs,P_2).  my_tpartition_ts_fs_([],[],[],_). my_tpartition_ts_fs_([X|Xs0],Ts,Fs,P_2) :-  if_(call(P_2,X), (X=[NX],Ts = [NX|Ts0], Fs = Fs0),                 (Ts = Ts0,     Fs = [X|Fs0])), my_tpartition_ts_fs_(Xs0,Ts0,Fs0,P_2).  length_t(X,Y,T):-  length(Y,L1),  =(X,L1,T). 

This is based on Most general higher-order constraint describing a sequence of integers ordered with respect to a relation

* Update*

You could change to

length_t(X,Y,T):-  L1 #=< X,  fd_length(Y,L1),  =(X,L1,T),!.  length_t(_X,_Y,false).  fd_length(L, N) :-  N #>= 0,  fd_length(L, N, 0).  fd_length([], N, N0) :-  N #= N0. fd_length([_|L], N, N0) :-  N1 is N0+1,  N #>= N1,  fd_length(L, N, N1). 

giving:

?-unpacking([[1],[2,3],[4],[_,_|_]],U). U= [1,4]. 

but:

?-unpacking([X],Xs). X = Xs, Xs = []. 

Answers 3

After some thought, here is my implementation using if_/3:

unpacking(L,L1):-if_( =(L,[]), L1=[], unpack(L,L1)).  unpack([H|T],L):-if_(one_element(H), (H = [X],L=[X|T1],unpacking(T,T1)), unpacking(T,L)).  one_element(X, T) :-    (  var(X) ->(T=true,X=[_]; T=false,X=[])     ;  X = [_] -> T = true     ;  X \= [_] -> T = false). 

Some testcases:

?- unpacking([Xss],[]).  Xss = [].  ?- unpacking([[1],[2,3],[4],[_,_|_]],U). U = [1, 4].  ?- unpacking([[1],[2,3],[4]],U). U = [1, 4].  ?- unpacking([[E]],[1]), E = 2. false.  ?- unpacking(non_list, []). false.  ?- unpacking([Xs],Xs). Xs = [_G6221] ; Xs = []. 

---

UPDATE
To fix the case that @false referred in the comment we could define:

one_element([],false). one_element([_],true). one_element([_,_|_],false). 

But this leaves some choice points...

Answers 4

Based on @coder's solution, I made my own attempt based on if_ and DCGs:

one_element([_],true) :-     !. one_element([_,_|_],false). one_element([],false).   f([]) -->     []. f([X|Xs]) -->     { if_(one_element(X), Y=X, Y=[]) },     Y,     f(Xs).  unpack(Xs,Ys) :-     phrase(f(Xs),Ys). 

I only tried for about 30s, but the queries:

?- Xs = [[] | Xs], unpack(Xs,Ys). ?- Xs = [[_] | Xs], unpack(Xs,Ys). ?- Xs = [[_, _ | _] | Xs], unpack(Xs,Ys). 

didn't stop with a stack overflow. In my opinion, the critical one should be the last query, but apparently, SWI Prolog manages to optimize:

?- L = [_,_|_], one_element(L,T). L = [_3162, _3168|_3170], T = false. 

Edit: Oh no, the cut is not green:

?- unpack([A,B],Ys), Ys = []. false. 

This solution is incomplete!

Answers 5

One way to do it is with a findall I dont think its what the bounty is for though ;)

unpacking(Lists,L1):-    findall(I,(member(M,Lists),length(M,1),M=[I]),L1).  or   unpacking2(Lists,L1):-    findall(I,member([I],Lists),L1). 

Read More

(SWI)Prolog: Order of sub-goals

I have two, slightly different, implementations of a predicate, unique_element/2, in Prolog. The predicate succeeds when given an element X and a list L, the element X appears only once in the list. Below are the implementations and the results:

Implementation 1:

%%% unique_element/2 unique_element(Elem, [Elem|T]) :-     not(member(Elem, T)).  unique_element(Elem, [H|T]) :-     member(Elem, T),      H\==Elem,      unique_element(Elem, T),      !.  

Results:

?- unique_element(X, [a, a, b, c, c, b]).  false.  ?- unique_element(X, [a, b, c, c, b, d]). X = a ; X = d. 

Implementation 2:

%%% unique_element/2 unique_element(Elem, [Elem|T]) :-      not(member(Elem, T)).  unique_element(Elem, [H|T]) :-     H\==Elem,      member(Elem, T),      unique_element(Elem, T),      !.  

In case you didn't notice at first sight: "H\==Elem" and "member(Elem, T)" are flipped on the 2nd impl, rule 2.

Results:

?- unique_element(X, [a, a, b, c, c, b]). X = a.  ?- unique_element(X, [a, b, c, c, b, d]). X = a ; X = d. 

Question: How does the order, in this case, affect the result? I realize that the order of the rules/facts/etc matters. The two specific rules that are flipped though, don't seem to be "connected" or affect each other somehow (e.g. a "cut" predicate in the wrong place/order).

Note: We are talking about SWI-Prolog here.

Note 2: I am aware of, probably different and better implementations. My question here is about the order of sub-goals being changed.

4 Answers

Answers 1

TL;DR: Read the documentation and figure out why:

?- X = a, X \== a. false.  ?- X \== a, X = a. X = a. 

---

I wonder why you stop so close from figuring it out yourself ;-)

There are too many ways to compare things in Prolog. At the very least, you have unification, which sometimes can compare, and sometimes does more; than you have equvalence, and its negation, the one you are using. So what does it do:

?- a \== b. % two different ground terms true.  ?- a \== a. % the same ground term false. 

Now it gets interesting:

?- X \== a. % a free variable and a ground term true.  ?- X \== X. % the same free variable false.  ?- X \== Y. % two different free variables true. 

I would suggest that you do the following: figure out how member/2 does its thing (does it use unification? equivalence? something else?) then replace whatever member/2 is using in all the examples above and see if the results are any different.

And since you are trying to make sure that things are different, try out what dif/2 does. As in:

?- dif(a, b). 

or

?- dif(X, X). 

or

?- dif(X, a). 

and so on.

See also this question and answers: I think the answers are relevant to your question.

Hope that helps.

Answers 2

H\==Elem is testing for syntactic inequality at the point in time when the goal is executed. But later unification might make variables identical:

?- H\==Elem, H = Elem. H = Elem.  ?- H\==Elem, H = Elem, H\==Elem. false. 

So here we test if they are (syntactically) different, and then they are unified nevertheless and thus are no longer different. It is thus just a temporary test.

The goal member(Elem, T) on the other hand is true if that Elem is actually an element of T. Consider:

 ?- member(Elem, [X]).  Elem = X. 

Which can be read as

(When) does it hold that Elem is an element of the list [X]?

and the answer is

It holds under certain circumstances, namely when Elem = X.

If you now mix those different kinds of goals in your programs you get odd results that can only explained by inspecting your program in detail.

As a beginner, it is best to stick to the pure parts of Prolog only. In your case:

• use dif/2 in place of \==

• do not use cuts - in your case it limits the number of answers to two. As in unique_element(X, [a,b,c])

• do not use not/1 nor (\+)/1. It produces even more incorrectness. Consider unique_element(a,[a,X]),X=b. which incorrectly fails while X=b,unique_element(a,[a,X]) correctly succeeds.

---

Here is a directly purified version of your program. There is still room for improvement!

non_member(_X, []). non_member(X, [E|Es]) :-    dif(X, E),    non_member(X, Es).  unique_element(Elem, [Elem|T]) :-      non_member(Elem, T).  unique_element(Elem, [H|T]) :-     dif(H,Elem),       % member(Elem, T),          % makes unique_element(a,[b,a,a|Xs]) loop     unique_element(Elem, T).  ?- unique_element(a,[a,X]).    dif(X, a) ;  false.              % superfluous  ?- unique_element(X,[E1,E2,E3]).    X = E1,    dif(E1, E3),    dif(E1, E2) ;  X = E2,    dif(E2, E3),    dif(E1, E2) ;  X = E3,    dif(E2, E3),    dif(E1, E3) ;  false. 

Note how the last query reads?

When is X a unique element of (any) list [E1,E2,E3]?

The answer is threefold. Considering one element after the other:

X is E1 but only if it is different to E2 and E3

etc.

Answers 3

Can you not define unique_element like tcount Prolog - count repetitions in list

unique_element(X, List):- tcount(=(X),List,1).

Answers 4

Here is another possibility do define unique_element/2 using if_/3 and maplist/2:

:- use_module(library(apply)).  unique_element(Y,[X|Xs]) :-    if_(Y=X,maplist(dif(Y),Xs),unique_element(Y,Xs)). 

In contrast to @user27815's very elegant solution (+s(0)) this version does not build on clpfd (used by tcount/3). The example queries given by the OP work as expected:

   ?- unique_element(a,[a, a, b, c, c, b]). no    ?- unique_element(X,[a, b, c, c, b, d]). X = a ? ; X = d ? ; no 

The example provided by @false now succeeds without leaving a superfluous choicepoint:

   ?- unique_element(a,[a,X]). dif(a,X) 

The other more general query yields the same results:

   ?- unique_element(X,[E1,E2,E3]). E1 = X, dif(X,E3), dif(X,E2) ? ; E2 = X, dif(X,E3), dif(X,E1) ? ; E3 = X, dif(X,E2), dif(X,E1) ? ; no 

Read More

DNA Matching in Prolog

I am attempting to learn basic Prolog. I have read some basic tutorials on the basic structures of lists, variables, and if/and logic. A project I am attempting to do to help learn some of this is to match DNA sequences.

Essentially I want it to match reverse compliments of DNA sequences.

Example outputs can be seen below:

?- dnamatch([t, t, a, c],[g, t, a, a]). true 

While it's most likely relatively simple, being newer to Prolog I am currently figuring it out.

I started by defining basic matching rules for the DNA pairs:

pair(a,t). pair(g,c). etc... 

I was then going to try to implement this into lists somehow, but am unsure how to make this logic apply to longer lists of sequences. I am unsure if my attempted start is even the correct approach. Any help would be appreciated.

3 Answers

Answers 1

Since your relation is describing lists, you could opt to use DCGs. You can describe the complementary nucleobases like so:

complementary(t) -->    % thymine is complementary to   [a].                  % adenine complementary(a) -->    % adenine is complementary to   [t].                  % thymine complementary(g) -->    % guanine is complementary to   [c].                  % cytosine complementary(c) -->    % cytosine is complementary to   [g].                  % guanine 

This corresponds to your predicate pair/2. To describe a bonding sequence in reverse order you can proceed like so:

bond([]) -->            % the empty sequence   [].                   % doesn't bond bond([A|As]) -->        % the sequence [A|As] bonds with   bond(As),             % a bonding sequence to As (in reverse order)   complementary(A).     % followed by the complementary nucleobase of A 

The reverse order is achieved by writing the recursive goal first and then the goal that describes the complementary nucleobase to the one in the head of the list. You can query this using phrase/2 like so:

   ?- phrase(bond([t,t,a,c]),S). S = [g,t,a,a] 

Or you can use a wrapper predicate with a single goal containing phrase/2:

seq_complseq(D,M) :-   phrase(bond(D),M). 

And then query it:

   ?- seq_complseq([t,t,a,c],C). C = [g,t,a,a] 

I find the description of lists with DCGs easier to read than the corresponding predicate version. Of course, describing a complementary sequence in reverse order is a relatively easy task. But once you want to describe more complex structures like, say the cloverleaf structure of tRNA DCGs come in real handy.

Answers 2

A solution with maplist/3 and reverse/2:

dnamatch(A,B) :- reverse(B,C), maplist(pairmatch,A,C). 

Answers 3

If you want to avoid traversing twice you can also maybe do it like this?

rev_comp(DNA, RC) :-     rev_comp(DNA, [], RC).  rev_comp([], RC, RC). rev_comp([X|Xs], RC0, RC) :-     pair(X, Y),     rev_comp(Xs, [Y|RC0], RC). 

Then:

?- rev_comp([t,c,g,a], RC). RC = [t, c, g, a]. 

This is only hand-coded amalgamation of reverse and maplist. Is it worth it? Maybe, maybe not. Probably not.

Now that I thought about it a little bit, you could also do it with foldl which reverses, but now you really want to reverse so it is more useful than annoying.

rev_comp([], []). rev_comp([X|Xs], Ys) :-     pair(X, Y),     foldl(rc, Xs, [Y], Ys).  rc(X, Ys, [Y|Ys]) :- pair(X, Y). 

But this is even less obvious than solution above and solution above is still less obvious than solution by @Capellic so maybe you can look at code I wrote but please don't write such code unless of course you are answering questions of Stackoverflow and want to look clever or impress a girl that asks your help for exercise in university.

Read More

More compact definition

Given word/1,

word(W) :-    abs(ABs),    ABs = W.  abs([]). abs([AB|ABs]) :-    abs(ABs),    ab(AB).  ab(a). ab(b).  ?- word(W).    W = [] ;  W = [a] ;  W = [b] ;  W = [a,a] ;  W = [b,a] ;  W = [a,b] ;  W = [b,b] ;  W = [a,a,a] ;  W = [b,a,a] ;  W = [a,b,a] ;  W = [b,b,a] ;  W = [a,a,b] ;  W = [b,a,b] ;  W = [a,b,b] ;  W = [b,b,b] ;  W = [a,a,a,a] ... 

how does a more compact definition of word/1 look like, otherwise identical w.r.t. termination and the set of solutions, fairness, with the following constraints:

1. No use of built-ins like (=)/2.

2. No use of control constructs like (',')/2 or (;)/2, or call/1.

3. Uses one fact, one recursive rule, and one rule for word/1.

Maybe simpler is to ask for the terms F1 ... F4 in:

word(W) :-    p(F1).  p(F2). p(F3) :-    p(F4). 

For the record: The property exploited here is closely related to the undecidability of termination of a single binary clause. Praise goes to:

Philippe Devienne, Patrick Lebègue, Jean-Christophe Routier, and Jörg Würtz. One binary horn clause is enough (http://dl.acm.org/citation.cfm?id=694839). STACS '94.

7 Answers

Answers 1

The solution I have come up with is:

 word(W) :-         p([[]|Ls], Ls, W).  p([W|_], _, W). p([W0|Ws], [[a|W0],[b|W0]|Ls], W) :-         p(Ws, Ls, W). 

Sample query and answer:

 ?- word(W). W = [] ; W = [a] ; W = [b] ; W = [a, a] ; W = [b, a] ; W = [a, b] ; W = [b, b] ; W = [a, a, a] ; W = [b, a, a] ; W = [a, b, a] ; W = [b, b, a] ; W = [a, a, b] ; W = [b, a, b] ; W = [a, b, b] ; W = [b, b, b] ; W = [a, a, a, a] ; W = [b, a, a, a] ; etc. 

I am using a difference list to incrementally materialize the solutions I want the toplevel to report.

Answers 2

Okay so not an answer yet.

The closest I had was :

s_s1([],[a]). s_s1([b|T],[a|T]). s_s1([a|T],[b|T2]):-  s_s1(T,T2).  word([]). word(W2):-  word(W),  s_s1(W,W2). 

Which does not either meet the criteria or give the right solutions!

So next I thought we could try and use prolog to find the answer.. The structure is given so we need to search for the args..

%First define the first 16 correct solutions..  correct_sols(X):- X=[      [],      [a],      [b],      [a,a],      [b,a],      [a,b],      [b,b],      [a,a,a],      [b,a,a],      [a,b,a],      [b,b,a],      [a,a,b],      [b,a,b],      [a,b,b],      [b,b,b],      [a,a,a,a] ].  %Then a mi provable(true, _) :- !. provable((G1,G2), Defs) :- !,     provable(G1, Defs),     provable(G2, Defs). provable(BI, _) :-     predicate_property(BI, built_in),     !,     call(BI). provable(Goal, Defs) :-     member(Def, Defs),     copy_term(Def, Goal-Body),     provable(Body, Defs).  %From 4 Vars find 16 solutions to word(X) vars_16sols(Vars,List):-     Vars =[Args,Args0,Args1,Argsx],     findnsols(16,X,provable(word(X),[                             a(Args)-true,                             a(Args0)-a(Args1),                             word(X)-a(Argsx)]                        ),List). %Evaluate the score, for the solutions found how many match correct evaluate_score(Solutions,Score):-    correct_sols(C),    maplist(correct_test_tf,C,Solutions,TrueFalse),    findall(_,member(true,TrueFalse),Matches),    length(Matches,Score).  %The main search, give a form for the starting 4 arguments, if they  match all 16 correct stop. startingargs_solution(Start,Sol):-    vars_16sols(Start,SolsStart),    evaluate_score(SolsStart,Score),    Score =16,    SolsStart=Sol. %Othewise refine args, and try again. startingargs_solution(Start,Sol):-    vars_16sols(Start,SolsStart),    evaluate_score(SolsStart,Score),    Score <16,    start_refined(Start,Refined),    startingargs_solution(Refined,Sol). 

We would still need to define :

1. correct_test_tf/3
2. start_refined/2 with some constraints, such as the size of the terms for args(needs to be reasonable to be a 'compact definition', and what things need to be included, i.e. at least a and b somewhere and probably [].

Clearly not finished and not sure if it will be possible to do this but thought I would post an answer to see what people have to say.. The search is naive at the moment!

This is only testing the first 16 solutions but maybe that is adequate to get a correct answer..

Also maybe this is harder then solving the question on its own!

Answers 3

So to clarify, the intended solution is an instance of the following schema?

fact(Args).  recursive_rule(Args0) :-     recursive_rule(Args1).  word(W) :-     recursive_rule(Args). 

Where each occurrence of an Args variable stands for zero or more terms and presumably (but not necessarily) fact and recursive_rule are actually the same functor?

Answers 4

With Guy coder's suggestions this is closer?

unfold([], []). unfold([H|T], [[a|H], [b|H]|L]) :-  unfold(T, L).  ab([], [[]]).    ab([_|N1],L):-  ab(N1, L1),  unfold(L1, L).  word(X):-  length(List,_),  ab(List,Values),  member(X,Values). 

Answers 5

My closest yet.

unfold20([], []). unfold20([H|T], [[a|H], [b|H]|L]) :-    unfold20(T, L).  member20(X, [X|_]). member20(X, [_|Tail]) :-   member20(X, Tail).  swap20(R,R) :-     write('swap20 R: '),write(R),nl.  swap20(In,L) :-     write('swap20 In: '),write(In),nl,     unfold20(In,L),     swap20(L,_),     write('swap20 L: '),write(L),nl.  word20(W) :-     swap20([[]],L),     write('word20 L: '),write(L),nl,     member20(W,L),     write('word20 W: '),write(W),nl. 

% ?- word20(X). % swap20 R: [[]] % word20 L: [[]] % word20 W: [] % X = [] ; % swap20 In: [[]] % swap20 R: [[a],[b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] ; % word20 W: [b] % X = [b] ; % swap20 In: [[a],[b]] % swap20 R: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] ; % word20 W: [b] % X = [b] ; % swap20 In: [[a,a],[b,a],[a,b],[b,b]] % swap20 R: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] ; % word20 W: [b] % X = [b] ; % swap20 In: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 R: [[a,a,a,a],[b,a,a,a],[a,b,a,a],[b,b,a,a],[a,a,b,a],[b,a,b,a],[a,b,b,a],[b,b,b,a],[a,a,a,b],[b,a,a,b],[a,b,a,b],[b,b,a,b],[a,a,b,b],[b,a,b,b],[a,b,b,b],[b,b,b,b]] % swap20 L: [[a,a,a,a],[b,a,a,a],[a,b,a,a],[b,b,a,a],[a,a,b,a],[b,a,b,a],[a,b,b,a],[b,b,b,a],[a,a,a,b],[b,a,a,b],[a,b,a,b],[b,b,a,b],[a,a,b,b],[b,a,b,b],[a,b,b,b],[b,b,b,b]] % swap20 L: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] 

If you look you will see that there is no use of ; which I am sure is a problem some people are having. Also all of the rules are simple enough that they should be able to be folded into the requirements by using additional arguments. e.g. unfold(A,B) would become unfold(A,B,C,D) or a variation.

The problem with this version is that I get the correct answers as the evaluation progresses, it is just getting them back to the top level.

e.g.

% swap20 L: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] 

I will keep working on this before the dead line, but if someone is able to use what I have here, hats off to them, I just ask that you give credit if any part of this helped you get the answer.

The unfold predicate is based on this SO answer. Credit to salva

member is an old friend. Notice that it starts with [[]] and not [].

swap I created this predicate. I have swap working for different variation yet the variation fails for a different reason.

Answers 6

Not a solution, but an insight toward a solution.

This started with using DCG

abs4 --> []. abs4 --> abs4, ([a] | [b]). 

?- phrase(abs4,X). X = [] ; X = [a] ; X = [b] ; X = [a, a] ; X = [a, b] ; X = [b, a] ; X = [b, b] ; X = [a, a, a] ; X = [a, a, b] ; X = [a, b, a] ; X = [a, b, b] ; X = [b, a, a] ; X = [b, a, b] ; X = [b, b, a] ; X = [b, b, b] ; X = [a, a, a, a] ; X = [a, a, a, b] ; 

then looking at the listing

?- listing(abs4). abs4(A, A). abs4(A, C) :-         abs4(A, B),         (   B=[a|C]         ;   B=[b|C]         ). 

and using member to remove the ;.

word5(W) :-     abs5(W,[]). abs5(A, A). abs5(A, C) :-     abs5(A, [D|C]),     member5(D,[a,b]). member5(X, [X|_]). member5(X, [_|Tail]) :-   member5(X, Tail). 

?- word5(X). X = [] ; X = [a] ; X = [b] ; X = [a, a] ; X = [a, b] ; X = [b, a] ; X = [b, b] ; X = [a, a, a] ; X = [a, a, b] ; X = [a, b, a] ; X = [a, b, b] ; X = [b, a, a]  

Answers 7

Normally I would post these as a single answer, but @false asked me to keep them separate.

If you read my comments and answers you will see that I was aware that I had to pass the result from one iteration back into the next iteration. What gave me insight into that was using a cross-product predicate which I found in

"The Craft of Prolog" by Richard A. O'Keefe pg. 243

If you are serious about learning Prolog, the book is a must have.

To quote the Preface

There are a lot of introductory Prolog books around. This not one of them. Think of it as "second steps in Prolog". If you have already read one of the introductory books, if you have taken an introductory course on Prolog, if you have written ore or two Prolog programs, and if you are wondering why it is still hard to write good Prolog programs, this book is meant to help you. The purpose of the book is to show you how you can write Prolog programs that work, that don't take an unreasonable amount of time, and that are clean enough to show to your friends.

Here is a slight variation that I used for one variation that did not work.

combine(X,Y,[X,Y]).  product(P,Xs,Ys,PXYs) :-     product1(Xs,Ys,PXYs,P).  product1([],_,[],_).  product1([X|Xs],Ys,PXYs0,P) :-     product1(Ys,X,P,PXYs0,PXYs1),     product1(Xs,Ys,PXYs1,P).  product1([],_,_) --> [].  product1([Y|Ys],X,P) -->     {         call(P,X,Y,PXY)     },     [PXY],     product1(Ys,X,P).  ?- product(combine,[a,b],[a,b],R). R = [[a, a], [a, b], [b, a], [b, b]]. 

Read More

Prolog getting head and tail of string

I'm trying to wrap my brain around Prolog for the first time (SWI-Prolog) and I'm struggling with what I'm sure are the basics. I'm trying to take a string such as "pie" and print out the military NATO spelling of it to look something like this:

spellWord("Pie"). Papa India Echo 

Currently I'm just trying to verify that I'm using the [H|T] syntax and Write function correctly. My function is:

spellWord(String) :- String = [H|T], writeChar(H), spellWord(T).  writeChar(String) :- H == "P", print4("Papa"). 

When making a call to spellWord("Pie"). this currently just returns false.

3 Answers

Answers 1

SWI-Prolog has several different representation of what you might call "strings".

• List of character codes (Unicode);
• List of chars (one-letter atoms);
• Strings, which are "atomic" objects, and can be manipulated only with the built-in predicates for strings;
• And finally, of course, atoms.

You should read the documentation, but for now, you have at least two choices.

Choice 1: Use a flag to make double-quoted strings code lists

$ swipl --traditional Welcome to SWI-Prolog (Multi-threaded, 64 bits, Version 7.3.19-57-g9d8aa27) Copyright (c) 1990-2015 University of Amsterdam, VU Amsterdam SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software, and you are welcome to redistribute it under certain conditions. Please visit http://www.swi-prolog.org for details.  For help, use ?- help(Topic). or ?- apropos(Word).  ?- X = "abc". X = [97, 98, 99]. 

At this point, your approach should work, as you now have a list.

Choice 2: Use the new code list syntax with back-ticks

?- X = `abc`. X = [97, 98, 99]. 

---

And, of course, there are predicates that convert between atoms, code lists, char lists, and strings. So, to make a list of chars (one-character atoms), you have:

• atom_chars/2
• char_code/2
• string_chars/2

As for your predicate definition, consider using unification in the head. Also, don't mix side effects (printing) with what the predicate does. Let the top level (the Prolog interpreter) do the printing for you.

nato(p, 'Papa'). nato(i, 'India'). nato(e, 'Echo'). % and so on  word_nato([], []). word_nato([C|Cs], [N|Ns]) :-     char_code(Char, C),     char_type(U, to_lower(Char)),     nato(U, N),     word_nato(Cs, Ns). 

And with this:

?- word_nato(`Pie`, Nato). Nato = ['Papa', 'India', 'Echo']. 

I used chars (one-letter atoms) instead of character codes because those are easier to write.

---

And finally, you can use the following flag, and set_prolog_flag/2 at run time to change how Prolog treats a string enclosed in double quotes.

For example:

$ swipl Welcome to SWI-Prolog (Multi-threaded, 64 bits, Version 7.3.19-40-g2bcbced) Copyright (c) 1990-2015 University of Amsterdam, VU Amsterdam SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software, and you are welcome to redistribute it under certain conditions. Please visit http://www.swi-prolog.org for details.  For help, use ?- help(Topic). or ?- apropos(Word).  ?- current_prolog_flag(double_quotes, DQs). DQs = string.  ?- string("foo"). true.  ?- set_prolog_flag(double_quotes, codes). true.  ?- X = "foo". X = [102, 111, 111].  ?- set_prolog_flag(double_quotes, chars). true.  ?- X = "foo". X = [f, o, o].  ?- set_prolog_flag(double_quotes, atom). true.  ?- X = "foo". X = foo. 

Answers 2

Regardless of the Prolog system you are using and unless you have to maintain existing code, stick to set_prolog_flag(double_quotes, chars). This works in many systems like B, GNU, IF, IV, Minerva, SICStus, SWI, YAP. So it is a safe bet. The other options mentioned by @Boris are hard to debug. One is even specific to SWI only.

?- set_prolog_flag(double_quotes, chars). true.  ?- L = "abc". L = [a, b, c]. 

With library(double_quotes) these strings can be printed more compactly.

In SWI, the best you can do is to put in your .swiplrc the lines:

:- set_prolog_flag(back_quotes, string). :- set_prolog_flag(double_quotes, chars). :- use_module(library(double_quotes)). 

For your concrete example, it is a good idea to avoid producing side-effects immmediately. Instead consider defining a relation between a word and the spelling:

word_spelling(Ws, Ys) :-    phrase(natospelling(Ws), Ys).  natospelling([]). natospelling([C|Cs]) -->    {char_lower(C, L)},    nato(L),    "\n",    natospelling(Cs).  nato(p) --> "Papa". nato(i) --> "India". nato(e) --> "Echo".  char_lower(C, L) :-    char_type(L, to_lower(C)).  ?- word_spelling("Pie",Xs). Xs = "Papa\nIndia\nEcho\n".  ?- word_spelling("Pie",Xs), format("~s",[Xs]). Papa India Echo Xs = "Papa\nIndia\nEcho\n". 

And here is your original definition. Most of the time, however, rather stick with the pure core of it.

spellWord(Ws) :-    word_spelling(Ws, Xs),    format("~s", [Xs]). 

Also note that SWI's built-in library(pio) only works for codes and leaves unnecessary choice-points open. Instead, use this replacement which works for chars and codes depending on the Prolog flag.

Historically, characters were first represented as atoms of length one. That is, 1972 in Prolog 0. However, there, strings were represented in a left-associative manner which facilitated suffix matching.

plur(nil-c-i-e-l, nil-c-i-e-u-x). 

Starting with Prolog I, 1973, double quotes meant a list of characters like today.

In 1977, DECsystem 10 Prolog changed the meaning of double quotes to lists of characters codes and used codes in place of chars. This made some I/O operations a little bit more efficient, but made debugging such programs much more difficult [76,105,107,101,32,116,104,105,115] - can you read it?.

ISO Prolog supports both. There is a flag double_quotes that indicates how double quotes are interpreted. Also, character related built-ins are present for both:

char_code/2  atom_chars/2, number_chars/2, get_char/1/2, peek_char/1/2, put_char/1/2  atom_codes/2, number_codes/2, get_code/1/2, peek_code/1/2, put_code/1/2 

Answers 3

The problems with your code are:

spellWord(String) :- String = [H|T], writeChar(H), spellWord(T). 

When you give this predicate a long string, it will invoke itself with the tail of that string. But when String is empty, it cannot be split into [H|T], therefore the predicate fails, returning false.

To fix this, you have to define additionally:

spellWord([]). 

This is the short form of:

spellWord(String) :- String = []. 

Your other predicate also has a problem:

writeChar(String) :- H == "P", print4("Papa"). 

You have two variables here, String and H. These variables are in no way related. So no matter what you pass as a parameter, it will not influence the H that you use for comparison. And since the == operator only does a comparison, without unification, writeChar fails at this point, returning false. This is the reason why there is no output at all.

Read More

Set Intersection predicate Prolog using not

I am trying to build a simple predicate which get as inputs two lists and the results is a third one consisting of the intersection of the first two. I have decided to do using logical statement. I am pretty sure my logic is correct but my predicate is not working. Any ideas?:

element(X,[H|T]) :-        X=H    ;       element(X,T).  intersection(L1,L2,R) :-     not((         element(A,L1),         not(element(A,L2))     )),     not((         element(A,L1),         not(element(A,R))     )). 

Please do not post alternative methods I am wondering why this one returns FALSE every time.

2 Answers

Answers 1

The problem is that not/1 merely negates the outcome of your element/2. It doesn't cause element/2 to backtrack to find other instantiations for which the enclosing not/1 will be true.

Consider the following program.

a(1). a(2).  b(1). b(2). b(3). 

And the following queries:

1. b(X), not(a(X)).
2. not(a(X)), b(X).

The first one yields X = 3 while the second one yields false. That is because the first query first instantiates X with 1, then with 2, then with 3, until finally not(a(X)) succeeds.
The second query first instantiates X with 1, a(1) succeeds, so not(a(1)) fails. There is no backtracking done!

Answers 2

Your definition is correct. For the ground case. What is a bit unusual is that the intersection is the first and not the last argument.

It is a bit too general, though - like many Prolog predicates (think of append([], non_list, non_list). Apart from lists, your definition admits also terms that are neither lists nor partial lists:

?- intersection(non_list,[1,2|non_list],[3,4|non_list]) 

To make it really useful safe, use it like so:

?- when(ground(intersection(I, A, B), intersection(I, A, B)). 

or so:

?- (  ground(intersection(I, A, B))    -> intersection(I, A, B)    ;  throw(error(instantiation_error, interaction(I, A, B)))    ). 

---

As a minor remark, rather write (\+)/1 in place of not/1.

Read More

Prolog: Splitting Single List into Three in Order

I am trying to make a function that splits a list of variable length into 3 lists of even length in order. The following splits it into 3 but processes inserts them into each list one at a time.

An example of what I want is:

[1, 2, 3, 4, 5] -> [1, 2], [3, 4], [5] 

Another example would be:

[8, 7, 6, 5, 4, 3, 2, 1] -> [8, 7, 6], [5, 4, 3], [2, 1]. 

The following code splits them by inserting into each list one at a time:

div([], [], [], []). div([X], [X], [], []). div([X,Y], [X], [Y], []). div([X,Y,Z|End], [X|XEnd], [Y|YEnd], [Z|ZEnd]):-   div(End, XEnd, YEnd, ZEnd). 

What this code outputs is:

[1, 2, 3, 4, 5] -> [1, 4], [2, 5], [3] 

I would appreciate any pointers that could help me with this.

2 Answers

Answers 1

The answer by @Boris does not terminate when the length of the list of the first argument is not known. To see this, there is no need to look any further than the first goal with a failure-slice:

 div(L, L1, L2, L3) :-     length(L, Len), false,     % here you compute for example Len1 and Len2     length(L1, Len1),     length(L2, Len2),     append(L1, L1_suffix, L),     append(L2, L3, L1_suffix). 

On the other hand, your original program had quite nice termination properties. cTI gave the following optimal termination property:

div(A,B,C,D) terminates_if b(A);b(B);b(C);b(D). 

In other words, to ensure termination, you only need a single argument (either A or B or C or D) to be a concrete list that is finite and ground (that's what b(..) means). That is a very strong termination condition. It's really a pity that the arguments do not fit! Why not generalize your program? The only problem it has it that it restricts the list elements. So I will replace all variable names of list elements by _s:

gdiv([], [], [], []). gdiv([_], [_], [], []). gdiv([_,_], [_], [_], []). gdiv([_,_,_|End], [_|XEnd], [_|YEnd], [_|ZEnd]):-   gdiv(End, XEnd, YEnd, ZEnd). 

The very same termination properties hold for this program.

Alas, it is now a bit too general. Boris's solution can now be repurposed:

divnew(Zs, As, Bs, Cs) :-    gdiv(Zs, As, Bs, Cs),    append(As, BsCs, Zs),    append(Bs, Cs, BsCs). 

My preferred way to express the same would rather be:

divnew(Zs, As, Bs, Cs) :-    gdiv(Zs, As, Bs, Cs),    phrase( ( seq(As), seq(Bs), seq(Cs) ), Zs). 

See other answers for a definition of seq//1.

Answers 2

div(L, L1, L2, L3) :-     append(L1, L1_suffix, L),     append(L2, L3, L1_suffix). 

Do you see how this splits the three lists? Now you don't say how long you expect the lists L1, L2, and L3 to be. You can use length/2 to get the length of L and set the length of the three results if you don't want the predicate to be as general as it is at the moment.

Since you say "relatively even length", which is relative and I need to interpret it somehow, lets assume you mean that, for a positive integer len and n, len = 3n, you get len1 = len2 = len3 = n, for k = 3n+1 you get len1 = n+1, len2 = len3 = n, and for k = 3n+2 you get len1 = len2 = n+1, len3 = n. I let you figure out how to compute the lengths.

div(L, L1, L2, L3) :-     length(L, Len),     % here you compute for example Len1 and Len2     length(L1, Len1),     length(L2, Len2),     append(L1, L1_suffix, L),     append(L2, L3, L1_suffix). 

Read More

Prolog - Finding adjacent elements in a list

I'm trying to define a predicate adjacent(X, Y, Zs) that is true if X and Y are adjacent in a list. My code is currently this:

adjacent(_, _, []). adjacent(X, Y, [X, Y|Tail]) :-   adjacent(X,Y, Tail). 

It works for the basic case of adjacent(c, d, [a, b, c, d, e]), but due to the base case, every other case returns true as well, and I'm stuck on that.

The other problem is that if X is not equal to the first part of the list's head, then it skips past both X and Y and goes to the next 'X'; e.g., if c isn't equal to a, then it skips past both a and b and checks if c is equal to c. This is problematic when, for example, the list is

[a, c, d, e] 

because it ends up never checking c (I believe).

I'm pretty lost on how to reconcile the two issues and turn my logical understanding of what needs to occur into code.

EDIT: Thanks to Christian Hujer's answer, my base case mistake has been corrected, so now I'm just stuck on the second issue.

SOLUTION: Thank you to everybody who answered, here is the non-built-in predicate solution to the problem.

adjacent(X, Y, [X, Y|_]). adjacent(X, Y, [_|Tail]) :-   adjacent(X, Y, Tail). 

Use of the built-in append/3 below.

adjacent(X, Y, Z) :-   append(_, [X,Y|_], Z). 

4 Answers

Answers 1

In the original solution attempt:

adjacent(_, _, []). adjacent(X, Y, [X, Y|Tail]) :-     adjacent(X,Y, Tail). 

As @ChristianHujer points out, the first clause should not be there because it isn't true. The empty list should have no adjacent elements.

The second clause is also problematic. It shows that X and Y are adjacent in the list, but then recurses and doesn't just succeed. A proper clause should be:

adjacent(X, Y, [X,Y|_]). 

Which says that X and Y are adjacent in the list if they're the first two elements in the list, regardless of what the tail is. This also forms a proper base case. Then your general, recursive clause should take care of the rest of the cases:

adjacent(X, Y, [_|Tail]) :-     adjacent(X, Y, Tail). 

This says that X and Y are adjacent in [_|Tail] if they're adjacent in Tail. This takes care of the second problem you were encountering.

Thus, the whole solution would be:

adjacent(X, Y, [X,Y|_]). adjacent(X, Y, [_|Tail]) :-     adjacent(X, Y, Tail). 

This will succeed as many times as X and Y appear together, in that order, in the list.

---

This is also naturally solvable with a DCG (although @repeat's append/3 based solution is more concise):

adjacent(X, Y) --> ..., [X, Y], ... . ... --> [] | [_], ... .  adjacent(X, Y, L) :- phrase(adjacent(X, Y), L). 

---

| ?- adjacent(b, c, [a,b,c,d]).  true ? a  (1 ms) no | ?-  

Answers 2

I think your base case is wrong. In your situation, you want recursion to terminate with a false predicate, not with a true predicate. And it's logical: In an empty list, there are no adjacent elements. Never.

Answers 3

In this answer we try to keep it simple—by building on append/3:

 adjacent(E0, E1, Es) :-     append(_, [E0,E1|_], Es). 

Sample query:

?- adjacent(X, Y, [a,b,c,d,e]). X = a, Y = b ; X = b, Y = c ; X = c, Y = d ; X = d, Y = e ; false. 

Answers 4

Challenge accepted!

 adjacent(X0, X1, [E0,E1|Es]) :-    adjacent_(Es, E0, E1, X0, X1).  adjacent_([],      E0, E1, E0, E1). adjacent_([E2|Es], E0, E1, X0, X1) :-    if_(E0 = X0,        E1 = X1,        adjacent_(Es, E1, E2, X0, X1)). 

Using SWI-Prolog we run:

 ?- set_prolog_flag(double_quotes, chars). true.  ?- adjacent(a, b, "abab"). true.  ?- adjacent(b, c, "abcd"). true.   ?- adjacent(X, Y, "abcd").    X = a, Y = b ;  X = b, Y = c ;  X = c, Y = d.  ?- adjacent(X, X, [A,B,C]).    X = A, A = B ;  X = B, B = C, dif(A, C). 

Read More

Check if a list is a palindrome. If not, insert elements to make it a palindrome. (Prolog)

I have written the following code to check whether it is a palindrome or not. I have also created the logic to insert elements when the list is not a palindrome

reverse_list(Inputlist, Outputlist) :-    reverse(Inputlist, [], Outputlist).      reverse([], Outputlist, Outputlist).     reverse([Head|Tail], List1, List2) :-    reverse(Tail, [Head|List1], List2).  printList([]). printList([X|List]) :-    write(X),    write(' '),    printList(List).  palindrome(List1) :-    reverse_list(List1, List2),    compareLists(List1, List1, List2, List2).  compareLists(L1, [], [], L2) :-    write("\nList is Palindrome").     compareLists(L1, [X|List1], [X|List2], L2) :-    compareLists(L1, List1, List2, L2),    !.         compareLists(L1, [X|List1], [Y|List2], [Z|L2]) :-    write("\nList is not Palindrome. "),    append(L1, L2, L),    printList(L). 

The code gives the correct output for

palindrome([a,b,c,a]). List is not Palindrome. a b c a c b a   palindrome([a,b,c]). List is not Palindrome. a b c b a  

However, for an input such as

palindrome([a,b,c,b]). List is not Palindrome. a b c b c b a  

The optimal solution however should be

 a b c b a 

What changes should I incorporate to be able to achieve this?

2 Answers

Answers 1

I think you need a predicate with two Args, In and Out :

pal([], []). pal([X], [X]). pal(In, Out) :-     % first we check if the first and last letter are the same     (   append([H|T], [H], In)         % we must check that the middle is a palindrome     ->  pal(T, T1),         append([H|T1], [H], Out)     ;   % if not, we remove the first letter         % and we work with the rest         In = [H|T],         % we compute the palindrome from T         pal(T,T1),         % and we complete the palindrome to         % fit the first letter of the input         append([H|T1], [H], Out)). 

EDIT1 This code looks good but there is a bug for

? pal([a,b,c,a], P). P = [a, b, c, b, a] . 

Should be [a,b,c,a,c,b,a] I'll try to fix it.

EDIT2 Looks correct :

build_pal([H|T], Out):-     pal(T,T1),     append([H|T1], [H], Out).   pal([], []). pal([X], [X]). pal(In, Out) :-     (   append([H|T], [H], In)     ->  pal(T, T1),         (   T = T1         ->  append([H|T1], [H], Out)         ;   build_pal(In, Out))     ;   build_pal(In, Out)). 

with output :

 ?- pal([a,b,c], P). P = [a, b, c, b, a] .   ?- pal([a,b,a], P). P = [a, b, a] .   ?- pal([a,b,c,b], P). P = [a, b, c, b, a] .   ?- pal([a,b,c,a], P). P = [a, b, c, a, c, b, a] .   ?- pal([a,b,a,c,a], P). P = [a, b, a, c, a, b, a] . 

Answers 2

The first 3 equations of a DCG capture the palindrome pattern. Add a fourth, covering the mismatch, to complete the specification:

p([]) --> []. p([T]) --> [T]. p([T|R]) --> [T], p(P), [T], {append(P,[T],R)}. p([T|R]) --> [T], p(P), {append(P,[T],R)}.  ?- phrase(p(L), [a,b,c,b]). L = [a, b, c, b, a] ; L = [a, b, c, c, b, a] ; L = [a, b, c, b, c, b, a] ; L = [a, b, c, b, b, c, b, a] ; false. 

Read More