Reverse Logic programme - list

I've written code in prolog which will return a list using the depth-first search method.
s(a, b).
s(a, f).
s(b, c).
s(b, d).
s(b, e).
s(f, g).
s(f, i).
s(i, j).
s(i, k).
goal(i).
searching(Path, Paths, RestOfPaths):-
Rest = [Start|],
Start == Path,
findall( X,( arc(X, Start, ), + s(X, Rest) ),[T|Extend]),
maplist( consed(Rest), [T|Extend], VisitedExtended).
How can I change my code to produce
X = [a, f, i].

Assuming s/2 is defined by:
s(A, B):- arc(A, B).
s(A, B):- arc(B, A).
you can reverse the list after obtaining your path:
solve2(Node, Solution):-
depthfirst2([], Node, SolutionR),
reverse(SolutionR, Solution).
Test run:
?- solve2(a, X).
X = [a, f, i] ;
false.
You may also build the list in order by traversing the list where you will keep the solution, unifying step by step with each visited node:
solve2(Node, [Node|Solution]) :-
depthfirst2([], Solution, Node).
depthfirst2(_, [], Node) :-
goal(Node).
depthfirst2(Path, [Node1|Solution], Node) :-
s(Node, Node1),
not(member(Node1, Path)),
depthfirst2([Node|Path], Solution, Node1).

Put the reverse/2 as part of the public (wrapper) predicate.
This is how I would do it:
arc( a , b ).
arc( a , f ).
arc( b , c ).
arc( b , d ).
arc( b , e ).
arc( f , g ).
arc( f , i ).
arc( i , j ).
arc( i , k ).
% --- traverse/3 -----------------------
%
% Traverses a directed graph
%
% traverse( Origin, Destination, Path ).
%---------------------------------------
traverse(A,Z,P) :-
traverse(A,Z,[],Vs),
reverse(Vs,P).
% --- traverse/4 --------------------------------------------
%
% private helper for traverse/3
%
% traverse( Origin, Destination, Visited, Path).
%
% Note that Path is returned in most recently visited order.
%
%------------------------------------------------------------
traverse(A,Z,Vs,[Z,A|Vs]) :- % we can get from A to Z
arc(A,Z). % - if A and Z are directly connected
traverse(A,Z,Vs,P) :- % otherwise, we can get from A to Z, if...
arc(A,B), % - A is connected to some B
\+ member(B,Vs), % - that we have not yet visited
traverse(B,Z,[A|Vs],P). % - and we can get from B to Z (recording that A has been visited).
And if you run this (See the Swish at https://swish.swi-prolog.org/p/MhhEiKal.pl) by invoking:
traverse(a,i,P).
You get
P = [a,f,i]

Related

Calculating List of positive numbers of a given list in Prolog

I tried resolving it by myself in the following way:
list_of_positives(L1, L2) :-
list_of_positives(L1, L2, []).
list_of_positives([], L, L).
list_of_positives([H|T], L2, L3) :-
( H > 0
-> list_of_positives(T,L2,[H|L3])
; list_of_positives(T,L2,L3)
).
The problem with this solution is that I get as response a reversed list of positive numbers. Can someone help me to find a way to get the list in the "correct order"?
You can solve the problem as follows:
positives([], []).
positives([H|T], P) :-
( H > 0
-> P = [H|R] % desired order!
; P = R),
positives(T, R) .
Example:
?- positives([2,-3,6,-7,1,4,-9], P).
P = [2, 6, 1, 4].
You want to use a difference list, a non-closed, or open list. So, something like this:
positives( [] , [] ) . % An empty list has not positives, and closes the list.
positives( [N|Ns] , [N|Rs] ) :- % For a non-empty list, we prepend N to the result list
N > 0, % - if N is positive
positives(Ns,Rs) % - and recurse down.
. %
positives( [N|Ns] , Rs ) :- % For non-empty lists, we discard N
N =< 0, % - if N is non-positive
positives(Ns,Rs) % - and recurse down.
. %

Splice in sublists in a list, without using flatten/2

I want to make one list of multiple sublists without using the flatten predicate in Prolog.
This is my code:
acclistsFromList([],A,A).
acclistsFromList([H|T],Listwithinlist,A):-
not(is_list(H)),
acclistsFromList(T,Listwithinlist,A).
acclistsFromList([H|T],Listwithinlist,A):-
is_list(H),
append([H],Listwithinlist,Acc2),
acclistsFromList(T,Acc2,A).
I get this as output
?- listsFromList([1,2,[a,b,c],3,4,[d,e]],X).
X = [[d, e], [a, b, c]] ;
But I want this:
?- listsFromList([1,2,[a,b,c],3,4,[d,e]],X).
X = [a, b, c, d, e] .
?- listsFromList([1,[],2,3,4,[a,b]],X).
X = [a, b] .
?- listsFromList([[[[a]]],b,c,d,e,[f]],X).
X = [f, a] .
?- listsFromList([[[[a]],b,[c]],d,e,[f]],X).
X = [f, a, b, c] .
What is the best way to reach this result, without using flatten?
The second clause of the acclistsFromList/3 does not do anything with H if it has verified that H is not a list, but you need to prepend the result with H.
acclistsFromList([H|T], Listwithinlist, [H|A]) :-
\+ is_list(H),
acclistsFromList(T, Listwithinlist, A).
but this is not sufficient. Since you prepend to the accumulator, the result is reversed. You do not need an accumulator here anyway:
acclistsFromList([], []).
acclistsFromList([H|T], [H|A]) :-
\+ is_list(H),
acclistsFromList(T, A).
acclistsFromList([H|T], Result):-
is_list(H),
append(H, Res1, Result),
acclistsFromList(T, Res1).
or without the "scalar" elements:
acclistsFromList([], []).
acclistsFromList([H|T], A) :-
\+ is_list(H),
acclistsFromList(T, A).
acclistsFromList([H|T], Result):-
is_list(H),
append(H, Res1, Result),
acclistsFromList(T, Res1).
This furthermore does not recurse on lists. A list of lists of lists will thus not be flattened. I leave it as an exercise to implement this.
This is a one-liner,
foo(X,L) :-
findall(Z, (member(A,X),is_list(A),member(Z,A)), L).
(as seen here).
To deal with multi-layered nested lists, we need to use a recursive predicate,
nembr(Z,A) :- % member in nested lists
is_list(A), member(B,A), nembr(Z,B)
;
\+ is_list(A), A=Z.
then use it instead of that final member call in findall's goal:
bar(X,L) :-
findall(Z, (member(A,X),is_list(A),nembr(Z,A)), L).
testing:
10 ?- foo([1,2,[a,b,c],3,4,[d,e]],X).
X = [a, b, c, d, e].
11 ?- bar([1,2,[a,b,c],3,4,[d,e]],X).
X = [a, b, c, d, e].
12 ?- bar([1,2,[a,b,[[[c]]]],3,4,[d,e]],X).
X = [a, b, c, d, e].
In case you want to roll your own, here's breadth-first enumeration of arbitrarily nested lists:
bfs( XS, L) :- bfs( s(z), [XS|Q], Q, L, []).
bfs( z, _, _, Z, Z).
bfs( s(N), [[] |P], Q, L, Z) :- bfs( N, P, Q, L, Z).
bfs( s(N), [[A|B]|P], Q, L, Z) :-
is_list(A) % if is_list(A),
-> Q = [A|R], bfs( s(s(N)), [B|P], R, L, Z) % then enqueue A,
; L = [A|R], bfs( s(N), [B|P], Q, R, Z). % otherwise produce A
The first argument is the distance between read and write point on the queue. When they meet the queue has become exhausted and we stop. Both the input queue and the output list are maintained as difference list pairs of head and tail variables.
Trying it out:
12 ?- bfs( [[[6]],1,2,[4,[[[[[7]]]]],5],3], A).
A = [1, 2, 3, 4, 5, 6, 7] .
You will need to augment it to skip the non-lists in the top level.
A solution that uses an "open list" to append the elements encountered while walking the list-of-lists, which is essentially a tree, in prefix fashion.
The indicated examples indicate that non-list elements at depth 0 shall be discarded, and the other elements sorted by depth. However, no precise spec is given.
Indeed, one would expect the result of flattening
[[[[a]],b,[c]],d,e,[f]]
to be
[b,f,c,a]
via the "sorted-by-depth" pair list of Depth-Value pairs:
[3-a,1-b,2-c,1-f]
But the question poster requests this result instead:
[f, a, b, c]
I don't really know whether this is an error or not.
:- debug(flatwalker).
flatwalker(ListIn,ListOut) :-
Tip=Fin, % 2 unbound variables
% % designating the same memory
% % cell. Hold the Tip, grow at Fin.
flatwalker_2(0,ListIn,Fin,TerFin), % Elements are appended at Fin.
% % The final Fin is found in TerFin
% % on success.
TerFin=[], % Unify TerFin with [], closing
% % the list at Tip.
keysort(Tip,Sorted), % Sort the closed list at Tip
% % by pair key, i.e. by depth.
% % keysort/2 is stable and keeps
% % duplicates.
debug(flatwalker,"Got : ~q",[Tip]),
maplist([_-V,V]>>true,Sorted,ListOut). % Remove depth values.
% ---
% flatwalker_2(+Depth,+TreeIn,+Fin,+TerFin)
% Depth: Input integer, indicates current tree depth.
% TreeIn: The list to flatten at this depth (it's a node of the tree,
% which may or may not contain subtrees, i.e. lists)
% Fin: Always an unbound variable denoting the end of an open list to
% which we will append.
% ("points to an empty memory cell at the fin of the open list")
% Works as an accumulator as a new Fin, advanced by 1 cell at each
% append operation is handed to the next flatwalker_2/4
% activation.
% TerFin: When flatwalker_2/ is done, the final Fin is unified with
% TerFin so that it can be passed to flatwalker/2.
% ---
% We make the guards explicit and cut heavily.
% Optimizing the guards (if so desired) is left as an exercise.
flatwalker_2(_,[],Fin,Fin) :- !. % Done as TreeIn is empty.
% Unify Fin with TerFin.
flatwalker_2(0,[X|Xs],Fin,TerFin) :- % Case of X is nonlist at depth 0:
% % discard!
\+is_list(X),!,
flatwalker_2(0,Xs,Fin,TerFin). % Continue with the rest of the
% list at this depth.
flatwalker_2(D,[X|Xs],Fin,TerFin) :- % Case of X is nonlist at
% % depth > 0: keep!
D>0,\+is_list(X),!,
Fin=[D-X|Fin2], % Grow the result list at its
% % Fin by D-X.
flatwalker_2(D,Xs,Fin2,TerFin). % Continue with the rest of the
% list at this depth.
flatwalker_2(D,[X|Xs],Fin,TerFin) :- % Case of X is a list at any
% % depth.
is_list(X),!,
DD is D+1,
flatwalker_2(DD,X,Fin,Fin2), % Collect one level down
flatwalker_2(D,Xs,Fin2,TerFin). % On return, continue with the
% rest of the list at this depth.
Some plunit tests:
:- begin_tests(flatwalker).
test("empty",true(Out == [])) :-
flatwalker([],Out).
test("simple",true(Out == [])) :-
flatwalker([1,2,3],Out).
test("with empties",true(Out == [])) :-
flatwalker([[],1,[],2,[],3,[]],Out).
test("test 1",true(Out == [a, b, c, d, e])) :-
flatwalker([1,2,[a,b,c],3,4,[d,e]],Out).
test("test 2",true(Out == [a, b])) :-
flatwalker([1,[],2,3,4,[a,b]],Out).
test("test 3",true(Out == [f, a])) :-
flatwalker([[[[a]]],b,c,d,e,[f]],Out).
test("test 4",true(Out == [f, a, b, c])) :-
flatwalker([[[[a]],b,[c]],d,e,[f]],Out).
:- end_tests(flatwalker).
And so:
?- run_tests.
% PL-Unit: flatwalker
% Got : []
.
% Got : []
.
% Got : []
.
% Got : [1-a,1-b,1-c,1-d,1-e]
.
% Got : [1-a,1-b]
.
% Got : [3-a,1-f]
.
% Got : [3-a,1-b,2-c,1-f]
ERROR: flatwalker.pl:66:
test test 4: wrong answer (compared using ==)
ERROR: Expected: [f,a,b,c]
ERROR: Got: [b,f,c,a]
done
% 1 test failed
% 6 tests passed
false.

DCG and inversion of a list in Prolog

I'm trying to count the numer of inversions in a list. A predicate inversion(+L,-N) unifies N to the number of inversions in that list. A inversion is defined as X > Y and X appears before Y in the list (unless X or Y is 0). For example:
?- inversions([1,2,3,4,0,5,6,7,8],N).
N = 0.
?- inversions([1,2,3,0,4,6,8,5,7],N).
N = 3.
For what I'm using this for, the list will always have exacly 9 elements, and always containing the numbers 0-8 uniquely.
I'm quite new to Prolog and I'm trying to do this as concise and as elegant as possible; It seems like DCG will probably help a lot. I read into the official definition and some tutorial sites, but still don't quit understand what it is. Any help would be greatly appreciated.
Here is another solution that doesn't leave choice points using if_/3:
inversions([],0).
inversions([H|T], N):-
if_( H = 0,
inversions(T,N),
( find_inv(T,H,N1),inversions(T, N2), N #= N1+N2 )
).
find_inv([],_,0).
find_inv([H1|T],H,N1):-
if_( H1=0,
find_inv(T,H,N1),
if_( H#>H1,
(find_inv(T,H,N2),N1 #= N2+1),
find_inv(T,H,N1)
)
).
#>(X, Y, T) :-
( integer(X),
integer(Y)
-> ( X > Y
-> T = true
; T = false
)
; X #> Y,
T = true
; X #=< Y,
T = false
).
I'm not so sure a DCG would be helpful here. Although we're processing a sequence, there's a lot of examination of the entire list at each point when looking at each element.
Here's a CLPFD approach which implements the "naive" algorithm for inversions, so it's transparent and simple, but not as efficient as it could be (it's O(n^2)). There's a more efficient algorithm (O(n log n)) involving a divide and conquer approach, which I show further below.
:- use_module(library(clpfd)).
inversions(L, C) :-
L ins 0..9,
all_distinct(L),
count_inv(L, C).
% Count inversions
count_inv([], 0).
count_inv([X|T], C) :-
count_inv(X, T, C1), % Count inversions for current element
C #= C1 + C2, % Add inversion count for the rest of the list
count_inv(T, C2). % Count inversions for the rest of the list
count_inv(_, [], 0).
count_inv(X, [Y|T], C) :-
( X #> Y, X #> 0, Y #> 0
-> C #= C1 + 1, % Valid inversion, count it
count_inv(X, T, C1)
; count_inv(X, T, C)
).
?- inversions([1,2,3,4,0,5,6,7,8],N).
N = 0 ;
false.
?- inversions([1,2,3,0,4,6,8,5,7],N).
N = 3 ;
false.
?- inversions([0,2,X],1).
X = 1 ;
false.
It does leave a choice point, as you can see, which I haven't sorted out yet.
Here's the O(n log n) solution, which is using the sort/merge algorithm.
inversion([], [], 0).
inversion([X], [X], 0).
inversion([HU1, HU2|U], [HS1, HS2|S], C) :- % Ensure list args have at least 2 elements
split([HU1, HU2|U], L, R),
inversion(L, SL, C1),
inversion(R, SR, C2),
merge(SL, SR, [HS1, HS2|S], C3),
C #= C1 + C2 + C3.
% Split list into left and right halves
split(List, Left, Right) :-
split(List, List, Left, Right).
split(Es, [], [], Es).
split(Es, [_], [], Es).
split([E|Es], [_,_|T], [E|Ls], Right) :-
split(Es, T, Ls, Right).
% merge( LS, RS, M )
merge([], RS, RS, 0).
merge(LS, [], LS, 0).
merge([L|LS], [R|RS], [L|T], C) :-
L #=< R,
merge(LS, [R|RS], T, C).
merge([L|LS], [R|RS], [R|T], C) :-
L #> R, R #> 0 #<==> D, C #= C1+D,
merge([L|LS], RS, T, C1).
You can ignore the second argument, which is the sorted list (just a side effect if all you want is the count of inversions).
Here is another possibility to define the relation. First, #</3 and #\=/3 can be defined like so:
:- use_module(library(clpfd)).
bool_t(1,true).
bool_t(0,false).
#<(X,Y,Truth) :- X #< Y #<==> B, bool_t(B,Truth).
#\=(X,Y,Truth) :- X #\= Y #<==> B, bool_t(B,Truth).
Based on that, if_/3 and (',')/3 a predicate inv_t/3 can be defined, that yields true in the case of an inversion and false otherwise, according to the definition given by the OP:
inv_t(X,Y,T) :-
if_(((Y#<X,Y#\=0),X#\=0),T=true,T=false).
And subsequently the actual relation can be described like so:
list_inversions(L,I) :-
list_inversions_(L,I,0).
list_inversions_([],I,I).
list_inversions_([X|Xs],I,Acc0) :-
list_x_invs_(Xs,X,I0,0),
Acc1 #= Acc0+I0,
list_inversions_(Xs,I,Acc1).
list_x_invs_([],_X,I,I).
list_x_invs_([Y|Ys],X,I,Acc0) :-
if_(inv_t(X,Y),Acc1#=Acc0+1,Acc1#=Acc0),
list_x_invs_(Ys,X,I,Acc1).
Thus the example queries given by the OP succeed deterministically:
?- list_inversions([1,2,3,4,0,5,6,7,8],N).
N = 0.
?- list_inversions([1,2,3,0,4,6,8,5,7],N).
N = 3.
Such application-specific constraints can often be built using reified constraints (constraints whose truth value is reflected into a 0/1 variable). This leads to a relatively natural formulation, where B is 1 iff the condition you want to count is satisfied:
:- lib(ic).
inversions(Xs, N) :-
( fromto(Xs, [X|Ys], Ys, [_]), foreach(NX,NXs) do
( foreach(Y,Ys), param(X), foreach(B,Bs) do
B #= (X#\=0 and Y#\=0 and X#>Y)
),
NX #= sum(Bs) % number of Ys that are smaller than X
),
N #= sum(NXs).
This code is for ECLiPSe.
Using clpfd et automaton/8 we can write
:- use_module(library(clpfd)).
inversions(Vs, N) :-
Vs ins 0..sup,
variables_signature(Vs, Sigs),
automaton(Sigs, _, Sigs,
[source(s),sink(i),sink(s)],
[arc(s,0,s), arc(s,1,s,[C+1]), arc(s,1,i,[C+1]),
arc(i,0,i)],
[C], [0], [N]),
labeling([ff],Vs).
variables_signature([], []).
variables_signature([V|Vs], Sigs) :-
variables_signature_(Vs, V, Sigs1),
variables_signature(Vs, Sigs2),
append(Sigs1, Sigs2, Sigs).
variables_signature_([], _, []).
variables_signature_([0|Vs], Prev, Sigs) :-
variables_signature_(Vs,Prev,Sigs).
variables_signature_([V|Vs], Prev, [S|Sigs]) :-
V #\= 0,
% Prev #=< V #<==> S #= 0,
% modified after **false** remark
Prev #> V #<==> S,
variables_signature_(Vs,Prev,Sigs).
examples :
?- inversions([1,2,3,0,4,6,8,5,7],N).
N = 3 ;
false.
?- inversions([1,2,3,0,4,5,6,7,8],N).
N = 0 ;
false.
?- inversions([0,2,X],1).
X = 1.
in SWI-Prolog, with libraries aggregate and lists:
inversions(L,N) :-
aggregate_all(count, (nth1(P,L,X),nth1(Q,L,Y),X\=0,Y\=0,X>Y,P<Q), N).
both libraries are autoloaded, no need to explicitly include them.
If you want something more general, you can see the example in library(clpfd), under the automaton section, for some useful ideas. But I would try to rewrite your specification in simpler terms, using element/3 instead of nth1/3.
edit
after #false comment, I tried some variation on disequality operators, but none I've tried have been able to solve the problematic query. Then I tried again with the original idea, to put to good use element/3. Here is the result:
:- use_module(library(clpfd)).
inversions(L) :-
L ins 0..8,
element(P,L,X),
element(Q,L,Y),
X #\= 0, Y #\= 0, X #> Y, P #< Q,
label([P,Q]).
inversions(L,N) :-
aggregate(count, inversions(L), N) ; N = 0.
The last line label([P,Q]) it's key to proper reification: now we can determine the X value.
?- inversions([0,2,X],1).
X = 1.

Prolog - get middle element of List

I would like to get the middle element of a list in Prolog.
The predicates middle([1,2,3],M) and middle([1,2,3,4],M) should both return 2 as a result.
And I am allowed to use the predicate deleteLast.
I know that there are similar posts that solve that question but I have not found one that just uses deleteLast.
Even the syntax is not correct - however this is my solution so far:
middle([], _).
middle([X|XTail|Y], E) :-
1 is mod(list_length([X|XTail|Y], 2)),
middle([XTail], E).
middle([X|XTail|Y], E) :-
0 is mod(list_length([X|XTail|Y], 2)),
middle([X|XTail], E).
middle([X], X).
Question: Is that partly correct or am I completely on the wrong path ?
Sorry, the attempted solution you have is completely on the wrong path.
It doesn't use deleteLast/2 as you stated you require
You are using list_length/2 as if it were an arithmetic function, which it is not. It's a predicate.
You have a term with invalid syntax and unknown semantics, [X|XTail|Y]
In Prolog, you just need to think about it in terms of the rules. Here's an approach using deleteLast/2:
middle([X], X). % `X` is the middle of the single element list `[X]`
middle([X,_], X). % `X` is the middle of the two-element list `[X,_]`
% X is the middle of the list `[H|T]` if X is the middle of the list TWithoutLast
% where TWithoutLast is T with its last element removed
%
middle([H|T], X) :-
deleteLast(T, TWithoutLast),
middle(TWithoutLast, X).
I assume deleteLast/2 is well-behaved and just fails if T is empty.
You can also do this with same_length/2 and append/3, but, alas, doesn't use deleteLast/2:
middle(L, M) :-
same_length(L1, L2),
append(L1, [M|L2], L).
middle(L, M) :-
same_length(L1, L2),
append(L1, [M,_|L2], L).
So much unnecessary work, and unnecessary code. length/2 is very efficient, and a true relation. Its second argument is guaranteed to be a non-negative integer. So:
middle(List, Middle) :-
List = [_|_], % at least one element
length(List, Len),
divmod(Len, 2, Q, R), % if not available do in two separate steps
N is Q + R,
nth1(N, List, Middle).
And you are about ready:
?- middle(L, M), numbervars(L).
L = [A],
M = A ;
L = [A, B],
M = A ;
L = [A, B, C],
M = B ;
L = [A, B, C, D],
M = B ;
L = [A, B, C, D, E],
M = C ;
L = [A, B, C, D, E, F],
M = C .
I understand that this doesn't solve your problem (the answer by #lurker does) but it answers your question. :-(
Here is my attempt:
middle(L,M):- append(L1,L2,L),length(L1,N),length(L2,N), reverse(L1,[M|_]).
middle(L,M):- append(L1,L2,L),length(L1,N),length(L2,N1), N is N1+1 ,
reverse(L1,[M|_]).
Example:
?- middle([1,2,3],M).
M = 2 ;
false.
?- middle([1,2,3,4],M).
M = 2 ;
false.
In your implementation the problem is that by writing for example:
list_length([X|XTail|Y], 2)
The above does not give you as X the first element and as Y the last so I think it has some major problems...
As well pointed out by lurker you could write the above solution in one clause without using reverse/2:
middle(L, M) :- append(L1, [M|T], L), length(L1, N), length([M|T], N1),
(N1 is N + 1 ; N1 is N + 2).
Also to make the solution more relational (also see mat's comment below) you could use CLPFD library and replace is/2 with #= like:
middle(L, M) :- append(L1, [M|T], L), length(L1, N), length([M|T], N1),
(N1 #= N + 1 ; N1 #= N + 2).
Another interesting solution is to consider this predicate for splitting a list in half:
half(List, Left, Right) :-
half(List, List, Left, Right).
half(L, [], [], L).
half(L, [_], [], L).
half([H|T], [_,_|T2], [H|Left], Right) :-
half(T, T2, Left, Right).
This predicate divides an even list into two equal halves, or an odd list into two pieces where the right half has one more element than the left. It does so by reducing the original list, via the second argument, by two elements, each recursive call, while at the same time reducing the original list by one element each recursive call via the first argument. When it recurses down to the second argument being zero or one elements in length, then the first argument represents the half that's left, which is the right-hand list.
Example results for half/3 are:
| ?- half([a,b,c], L, R).
L = [a]
R = [b,c] ? a
(1 ms) no
| ?- half([a,b,c,d], L, R).
L = [a,b]
R = [c,d] ? a
no
| ?-
We can't quite use this to easily find the middle element because, in the even case, we want the last element of the left hand list. If we could bias the right-hand list by an extra element, we could then pick off the head of the right-hand half as the "middle" element. We can accomplish this using the deleteLast/2 here:
middle([X], X).
middle(List, Middle) :-
deleteLast(List, ListWithoutLast),
half(ListWithoutLast, _, [Middle|_]).
The head of the right half list of the original list, with the last element deleted, is the "middle" element. We can also simply half/3 and combine it with middle/2 since we don't really need everything half/3 does (e.g., we don't need the left-hand list, or the tail of the right hand list):
middle([X], X).
middle(List, Middle) :-
deleteLast(List, ListWithoutLast),
middle(ListWithoutLast, ListWithoutLast, Middle).
middle([M|_], [], M).
middle([M|_], [_], M).
middle([_|T], [_,_|T2], Right) :-
middle(T, T2, Right).
Another approach would be to modify half/3 to bias the splitting of the original list in half toward the right-hand half, which eliminates the need for using deleteLast/2.
modified_half(List, Left, Right) :-
modified_half(List, List, Left, Right).
modified_half(L, [_], [], L).
modified_half(L, [_,_], [], L).
modified_half([H|T], [_,_,X|T2], [H|Left], Right) :-
modified_half(T, [X|T2], Left, Right).
This will bias the right hand list to have an extra element at the "expense" of the left:
| ?- modified_half([a,b,c,d,e], L, R).
L = [a,b]
R = [c,d,e] ? a
no
| ?- modified_half([a,b,c,d,e,f], L, R).
L = [a,b]
R = [c,d,e,f] ? a
no
| ?-
Now we can see that the middle element, per the original definition, is just the head of the right hand list. We can create a new definition for middle/2 using the above. As we did before with half/3, we can ignore everything but the head in the right half, and we can eliminate the left half since we don't need it, and create a consolidated middle/2 predicate:
middle(List, Middle) :-
middle(List, List, Middle).
middle([M|_], [_,_], M).
middle([M|_], [_], M).
middle([_|T], [_,_,X|T2], Middle) :-
middle(T, [X|T2], Middle).
This reduces the original list down one element at a time (first argument) and two elements at a time (second argument) until the second argument is reduced to one or two elements. It then considers the head first argument to be the middle element:
This gives:
| ?- middle([a,b,c], M).
M = b ? ;
no
| ?- middle([a,b,c,d], M).
M = b ? ;
no
| ?- middle(L, M).
L = [M,_] ? ;
L = [M] ? ;
L = [_,M,_,_] ? ;
L = [_,M,_] ? ;
L = [_,_,M,_,_,_] ? ;
L = [_,_,M,_,_] ? ;
L = [_,_,_,M,_,_,_,_] ?
...

Swapping a specific number in list 1 with a specific number in list 2

I have been brushing up on some Prolog recently. I kind of enjoy just coming up with random problems to try and solve and then working them out. This one is quite tough though, and I'm not one to give up on a problem that I have set out to solve.
The problem: I want to make a predicate that will have 2 predetermined lists, 2 numbers to swap, and then output the lists after the swapping is done.
Further Explanation: I made it a little harder on myself by wanting to find a specific unique number from list 1, and swapping this with a specific unique number from list 2 so that if I have 2 lists...
[7,2,7,8,5], and [1,2,3,8,7,9,8], and then give the predicate 2 numbers(Lets just say 8 and 7), then the number 8 and the number 7 will be swapped between the lists IF AND ONLY IF the number 8 is in the first list and the number 7 is in the second list. (It would disregard an 8 in the second list and a 7 in the first list).
Sample query with expected answer:
?- bothSwap([7,2,7,8,5],[1,2,3,8,7,9,8],8,7,X,Y).
X = [7,2,7,7,5], Y = [1,2,3,8,8,9,8].
I kind of got stuck at this point:
bothSwap([],L2,N1,N2,[],L2).
bothSwap(L1,[],N1,N2,L1,[]).
bothSwap([H1|T1],[H2|T2],N1,N2,X,Y) :- H1 == N1, H2 == N2, bothSwap(T1,T2,N1,N2,D1,D2), append(D1,[H2],X), append(D2,[H1],Y).
bothSwap([H1|T1],[H2|T2],N1,N2,X,Y) :- H1 == N1, H2 =\= N2, bothSwap([H1|T1],T2,N1,N2,D1,D2).
bothSwap([H1|T1],[H2|T2],N1,N2,X,Y) :- H1 =\= N1, H2 == N2, bothSwap(T1,[H2|T2],N1,N2,D1,D2).
Any bright minds out there willing to tackle this problem with me? :)
Imagine how easy this problem would be if we could just "wish" for a list to be split up at the occurrence of the desired element, like this:
?- splitsies([1,2,3,4,5,6,7,8], 4, Prefix, Suffix).
Prefix = [1, 2, 3],
Suffix = [5, 6, 7, 8] ;
Guess what? :) append/3 can do that:
% splitsies is true if X splits list into a prefix/suffix pair.
splitsies(List, X, Start, Finish) :-
append(Start, [X|Finish], List).
Now the problem seems pretty simple!
bothSwap(Left, Right, A, B, AfterLeft, AfterRight) :-
% break up the inputs
splitsies(Left, A, LPre, LPost),
splitsies(Right, B, RPre, RPost),
% glue together the outputs (note that A and B are switched)
splitsies(AfterLeft, B, LPre, LPost),
splitsies(AfterRight, A, RPre, RPost).
I wouldn't pretend that this solution is efficient… but it's so hot you better wear oven mitts when you type it in. Oh, and check this out:
?- bothSwap([7,2,7,8,5],[1,2,3,8,7,9,8], X, Y, [7,2,7,7,5], [1,2,3,8,8,9,8]).
X = 8,
Y = 7 ;
false.
Let's start, what you mean by swapping.
swap(X0,X, S0,S) :-
if_(X0 = S0, S = X, S = S0).
bothSwap0(Xs0, Ys0, X0,X, Xs,Ys) :-
maplist(swap(X0,X), Xs0,Xs),
maplist(swap(X,X0), Ys0,Ys).
if_( C_1, Then_0, Else_0) :-
call(C_1, Truth),
functor(Truth,_,0), % safety check
( Truth == true -> Then_0 ; Truth == false, Else_0 ).
=(X, Y, R) :- X == Y, !, R = true.
=(X, Y, R) :- ?=(X, Y), !, R = false. % syntactically different
=(X, Y, R) :- X \= Y, !, R = false. % semantically different
=(X, Y, R) :- R == true, !, X = Y.
=(X, X, true).
=(X, Y, false) :-
dif(X, Y).
Now you wanted a particular condition - it is not clear how to apply it. I see two interpretations:
bothSwap(Xs0, Ys0, X0,X, Xs,Ys) :-
memberd(X0, Xs0),
memberd(X, Ys0),
maplist(swap(X0,X), Xs0,Xs),
maplist(swap(X,X0), Ys0,Ys).
Which means that bothSwap/6 will fail should the two elements not occur in their respective list.
Another interpretation might be that you want that otherwise the lists remain the same. To express this (in a pure monotonic fashion):
bothSwap(Xs0, Ys0, X0,X, Xs,Ys) :-
if_( ( memberd_t(X0, Xs0), memberd_t(X, Ys0) ),
( maplist(swap(X0,X), Xs0,Xs), maplist(swap(X,X0), Ys0,Ys) ),
( Xs0 = Xs, Ys0 = Ys) ).
memberd_t(E, Xs, T) :-
list_memberd(Xs, E, T).
list_memberd([], _, false).
list_memberd([X|Xs], E, T) :-
if_(E = X, T = true, list_memberd(Xs, E, T) ).
','( A_1, B_1, T) :-
if_( A_1, call(B_1, T), T = false ).
Since Prolog is a descriptive language (that is, we describe what constitutes a solution and let Prolog work it out), If I understand your problem statement correctly, something like this ought to suffice:
both_swap(L1, L2, A, B, S1, S2 ) :- % to do the swap,
memberchk(A,L1) , % - L1 must contain an A
memberchk(B,L2) , % - L2 must contain a B
replace(L1,A,B,S1) , % - replace all As in L1 with a B
replace(L2,B,A,S2) % - replace all Bs in L2 with an A
. % Easy!
replace([],_,_,[]) . % if the list is empty, we're done.
replace([H|T],A,B,[S|Ss]) :- % otherwise...
( H = A -> S=B ; S=H ) , % - do the swap (if necessary),
replace(T,A,B,Ss) % - and recurse down
. % Also easy!
This replicates the implementation that uses splitsies/4
swap_two(A,B,C,D,E,F) :-
nth0(I1,A,C,L1),
dif(A,L1),
nth0(I2,B,D,L2),
dif(B,L2),
nth0(I1,E,D,L1),
nth0(I2,F,C,L2).