Reverse List without duplicates ( convert it into Set ) -> Prolog - list

I need to delete all duplicates from a list and then show it in reverse order.
So far I have this:
reverseInSet([], Y,R):-
R=Y.
reverseInSet([H|T], Y, R):-
removeElement(H,T,T1),
reverseInSet(T1, [H|Y], R).
removeElement(_,[],[]).
removeElement(X,[X|T],L):-
removeElement(X,T,L).
removeElement(X,[Y|T],L):-
removeElement(X,T,L1),
L=[Y|L1].
And the output is this:
reverseInSet([1,2,3,3,9,3],[],P).
P = [9, 3, 2, 1]
P = [3, 9, 3, 2, 1]
P = [9, 3, 3, 2, 1]
P = [9, 3, 3, 2, 1]
P = [3, 9, 3, 3, 2, 1]
Any ideas?

This is about the simplest way to do it. In the case of duplicate entries in the source list, the last such entry is kept and the ones preceding it are discarded.
list_to_set_reverse( Xs, Ys ) :- list_to_set( Xs, Zs ) , reverse(Zs,Ys) .
list_to_set( [] , [] ) .
list_to_set( [X|Xs] , Ys ) :- member(X,Xs), !, list_to_set(Xs,Ys) .
list_to_set( [X|Xs] , [X|Ys] ) :- list_to_set(Xs,Ys) .
You could also do it in a single pass, too. You just need to use an accumulator to build the result list in reverse order:
list_to_set_reverse( Xs, Ys ) :- list_to_set( Xs, [], Ys ) .
list_to_set( [] , Ys , Ys ) .
list_to_set( [X|Xs] , Ts , Ys ) :- member(X,Xs), !, list_to_set(Xs,Ts,Ys) .
list_to_set( [X|Xs] , Ts , Ys ) :- list_to_set(Xs,[X|Ts],Ys) .
This also keeps the last duplicates in the source list. But, since we're using an accumulator here to build the result list, it's easy enough to rejigger it to keep the first of any duplicate items: we just check to see if a candidate item is already in the result set or not (rather than check to see if it occurs later in the source list).
list_to_set_reverse( Xs, Ys ) :- list_to_set( Xs, [], Ys ) .
list_to_set( [] , Ys , Ys ) .
list_to_set( [X|Xs] , Ts , Ys ) :- member(X,Ts), !, list_to_set(Xs,Ts,Ys).
list_to_set( [X|Xs] , Ts , Ys ) :- list_to_set(Xs,[X|Ts],Ys) .

Using reif library, to be both pure and reasonably deterministic:
:- use_module(library(reif)).
reverse_without_duplicates(Lst, LstRevDeDup) :-
reverse_without_duplicates_(Lst, [], LstRevDeDup).
reverse_without_duplicates_([], Lst, Lst).
reverse_without_duplicates_([H|T], Upto, LstRevDeDup) :-
memberd_t(H, T, Bool),
reverse_without_duplicates_bool_(Bool, T, H, Upto, LstRevDeDup).
reverse_without_duplicates_bool_(true, T, _H, Upto, LstRevDeDup) :-
reverse_without_duplicates_(T, Upto, LstRevDeDup).
reverse_without_duplicates_bool_(false, T, H, Upto, LstRevDeDup) :-
% Include head
reverse_without_duplicates_(T, [H|Upto], LstRevDeDup).
Result in swi-prolog:
?- time(reverse_without_duplicates([1, 2, 3, 3, 9, 3], X)).
% 52 inferences, 0.000 CPU in 0.000 seconds (88% CPU, 1025277 Lips)
X = [3,9,2,1].
This pure method shows sensible answers with:
?- time(reverse_without_duplicates([1, 2, N, 3, 9, 3], L)).
% 49 inferences, 0.000 CPU in 0.000 seconds (87% CPU, 1030603 Lips)
N = 1,
L = [3,9,1,2] ;
% 127 inferences, 0.000 CPU in 0.000 seconds (98% CPU, 845646 Lips)
N = 2,
L = [3,9,2,1] ;
% 152 inferences, 0.000 CPU in 0.000 seconds (98% CPU, 1051910 Lips)
N = 3,
L = [3,9,2,1] ;
% 178 inferences, 0.000 CPU in 0.000 seconds (98% CPU, 1229859 Lips)
N = 9,
L = [3,9,2,1] ;
% 88 inferences, 0.000 CPU in 0.000 seconds (97% CPU, 648633 Lips)
L = [3,9,N,2,1],
dif(N,1),
dif(N,9),
dif(N,3),
dif(N,2).

Related

Prolog: replace the nth item in the list with the first

I'd like to have a Prolog predicate that can replace the nth item in the list with the first.
Example:
% replace(+List,+Counter,-New List, %-First Item).
?- replace([1,2,3,4,5],3,L,Z).
L = [1, 2, 1, 4, 5]
Z = 1
I don't know how to do this. Thanks for your help!
Try using the predicate nth1(Index, List, Item, Rest):
?- nth1(3, [1,2,3,4,5], Item, Rest).
Item = 3,
Rest = [1, 2, 4, 5].
?- nth1(3, List, 1, [1,2,4,5]).
List = [1, 2, 1, 4, 5].
Putting it all together:
replace(List, Index, NewList, First) :-
List = [First|_],
nth1(Index, List, _Removed, Rest),
nth1(Index, NewList, First, Rest).
Examples:
?- replace([1,2,3,4,5], 3, L, Z).
L = [1, 2, 1, 4, 5],
Z = 1.
?- replace([one,two,three,four,five], 4, NewList, First).
NewList = [one, two, three, one, five],
First = one.
Another method, slightly faster (replacing succ/2 with simple arithmetic helped performance):
replace_nth_with_first(Nth1, Lst, LstReplaced, First) :-
must_be(positive_integer, Nth1),
Lst = [First|_Tail],
replace_nth_with_first_(Nth1, Lst, LstReplaced, First).
% Keeping the arguments simple, to ensure that Nth1 = 1 matches
replace_nth_with_first_(1, Lst, LstReplaced, First) :-
!,
Lst = [_Head|Tail],
LstReplaced = [First|Tail].
replace_nth_with_first_(Nth1, [H|Lst], [H|LstReplaced], First) :-
Nth is Nth1 - 1,
replace_nth_with_first_(Nth, Lst, LstReplaced, First).
Result in swi-prolog:
?- replace_nth_with_first(3, [a, b, c, d, e], R, F).
R = [a,b,a,d,e],
F = a.
Performance comparison:
?- numlist(1, 2000000, L), time(replace_nth_with_first(1000000, L, R, First)).
% 1,000,004 inferences, 0.087 CPU in 0.087 seconds (100% CPU, 11428922 Lips)
% slago's
?- numlist(1, 2000000, L), time(replace_f(L, 1000000, R, First)).
% 2,000,011 inferences, 0.174 CPU in 0.174 seconds (100% CPU, 11484078 Lips)
Note the argument order, as per https://swi-prolog.discourse.group/t/split-list/4836/8
You might use append/3. Nice, concise, and declarative:
replace( [X|Xs] , 1 , [X|Xs], X ) . % replacing the first item in the list is a no-op
replace( Ls , I , L1 , X ) :- % for anything else...
I > 1 , % - the index must be greater than 1
J is I-1 , % - the length of the prefix is I-1
length( [X|Xs], J ) , % - construct an empty/unbound prefix list of the desired length
append( [X|Xs] , [_|Ys] , Ls ) , % - break the source list up into the desired bits
append( [X|Xs] , [X|Ys] , L1 ) % - and then put everything back together in the desired manner
. % Easy!

Grouping elements of 4 different lists

I have the following 4 lists:
A= [1,2,3],
B=[4,5,6],
C=[7,8,9],
D=[10,11,12]
I want to get another list of lists, whose first element gets the first element of each list, second element gets the second elements of each list etc. For example:
[1,2,3], [4,5,6], [7,8,9], [10,11,12]
becomes
[[1,4,7,10], [2,5,8,11],[3,6,9,12]].
I have tried using
findall([X,Y,Z,T],(member(X,A),member(Y,B),member(Z,C),member(T,D)),ModifiedList).
But it didn't work.
How can i do this in Prolog?
A solution would be:
% auxiliary predicate to group the first elements of
% all input lists and return the tails of the lists
group_first([], [], []).
group_first([[X| Xs]| Lists], [X| Tail], [Xs| Tails]) :-
group_first(Lists, Tail, Tails).
% main predicate; we separate the first list from the other
% lists to take advantage of first-argument indexing
group([], []).
group([List| Lists], Groups) :-
group(List, Lists, Groups).
group([], _, []).
group([X| Xs], Lists, [Group| Groups]) :-
group_first([[X| Xs]| Lists], Group, Tails),
group(Tails, Groups).
Sample call:
| ?- group([[1,2,3],[a,b,c],['A','B','C']], R).
R = [[1,a,'A'],[2,b,'B'],[3,c,'C']]
yes
To help understand the solution:
| ?- group_first([[1,2,3],[a,b,c],['A','B','C']], Group, Tails).
Group = [1,a,'A']
Tails = [[2,3],[b,c],['B','C']]
yes
what you describe is just transpose/2:
?- [library(clpfd)].
true.
?- transpose([[1,2],[3,4],[5,6]],T).
T = [[1, 3, 5], [2, 4, 6]].
Note that Paulo' answer is interesting: here is his group_first/3 in library(yall)
group_first(A,B,C) :- maplist([U,V,Z]>>(U=[X|Xs],V=X,Z=Xs),A,B,C).
or more efficiently
group_first(A,B,C) :- maplist([[X|Xs],X,Xs]>>true,A,B,C).
group/2 is fairly faster that clpfd:transpose:
?- N=100,length(M,N),maplist({N}/[R]>>length(R,N),M),time(group(M,T)).
% 20,402 inferences, 0.009 CPU in 0.009 seconds (100% CPU, 2165467 Lips)
?- N=100,length(M,N),maplist({N}/[R]>>length(R,N),M),time(transpose(M,T)).
% 30,708 inferences, 0.010 CPU in 0.010 seconds (100% CPU, 3192701 Lips)
and still better in original Paulo answer (group_first not inlined):
?- N=100,length(M,N),maplist({N}/[R]>>length(R,N),M),time(group(M,T)).
% 10,302 inferences, 0.004 CPU in 0.004 seconds (100% CPU, 2513070 Lips)
and is (almost) reversible:
?- group(T,[[1,2]]).
T = [[1], [2|_5420]].
Seems a good candidate for a pull request on library(clpfd)...
Here is another take:
nifty([], []).
nifty([[]|X], []) :-
nifty(X, []).
nifty([], [[]|X]) :-
nifty([], X).
nifty([[X|Y]|Z], [[X|Q]|R]) :-
swap(Y, R, N),
swap(Q, Z, M),
nifty(M, N).
swap([], [], []).
swap([X|Y], [[X|P]|Q], [P|R]) :-
swap(Y, Q, R).
It ranks second concerning speed:
?- dim(77,66,L), time((between(1,100,_), transpose(L,_), fail; true)).
% 1,577,201 inferences, 0.103 CPU in 0.104 seconds (99% CPU, 15244107 Lips)
?- dim(77,66,L), time((between(1,100,_), nifty(L,_), fail; true)).
% 521,601 inferences, 0.062 CPU in 0.063 seconds (99% CPU, 8368647 Lips)
?- dim(77,66,L), time((between(1,100,_), group(L,_), fail; true)).
% 528,300 inferences, 0.048 CPU in 0.049 seconds (98% CPU, 11105739 Lips)
But it is fully bidirectional, even in SWI-Prolog:
Welcome to SWI-Prolog (threaded, 64 bits, version 8.1.4)
?- nifty([[1,2,3],[4,5,6]],X).
X = [[1, 4], [2, 5], [3, 6]].
?- nifty([[1,4],[2,5],[3,6]],X).
X = [[1, 2, 3], [4, 5, 6]] ;
false.
?- nifty(X,[[1,2,3],[4,5,6]]).
X = [[1, 4], [2, 5], [3, 6]] ;
false.
?- nifty(X,[[1,4],[2,5],[3,6]]).
X = [[1, 2, 3], [4, 5, 6]].
And if the Prolog system provides just in time multi-argument indexing, as in Jekejeke Prolog, it even leaves no choice points without much ado:
Jekejeke Prolog 3, Runtime Library 1.3.8 (23 May 2019)
?- nifty([[1,2,3],[4,5,6]], X).
X = [[1,4],[2,5],[3,6]]
?- nifty([[1,4],[2,5],[3,6]], X).
X = [[1,2,3],[4,5,6]]
?- nifty(X, [[1,2,3],[4,5,6]]).
X = [[1,4],[2,5],[3,6]]
?- nifty(X, [[1,4],[2,5],[3,6]]).
X = [[1,2,3],[4,5,6]]

How to use dynamic databases in Prolog?

I have written the following program, which calculates the longest non-decreasing sub-sequence of input array.
The sub-program to find the longest list from the list of lists is taken from stackoverflow (How do I find the longest list in a list of lists) itself.
:- dynamic lns/2.
:- retractall(lns(_, _)).
lns([], []).
lns([X|_], [X]).
lns([X|Xs], [X, Y|Ls]) :-
lns(Xs, [Y|Ls]),
X < Y,
asserta(lns([X|Xs], [X, Y|Ls])).
lns([_|Xs], [Y|Ls]) :-
lns(Xs, [Y|Ls]).
% Find the longest list from the list of lists.
lengths([], []).
lengths([H|T], [LH|LengthsT]) :-
length(H, LH),
lengths(T, LengthsT).
lengthLongest(ListOfLists, Max) :-
lengths(ListOfLists, Lengths),
max_list(Lengths, Max).
longestList(ListOfLists, Longest) :-
lengthLongest(ListOfLists, Len),
member(Longest, ListOfLists),
length(Longest, Len).
optimum_solution(List, Ans) :-
setof(A, lns(List, A), P),
longestList(P, Ans),
!.
I have used the Prolog dynamic database for memoization purpose.
Though the program with database runs slower than the program without database. Below are the comparative times between two runs.
?- time(optimum_solution([0, 8, 4, 12, 2, 10, 6, 14, 1, 9], Ans)).
% 53,397 inferences, 0.088 CPU in 0.088 seconds (100% CPU, 609577 Lips)
Ans = [0, 2, 6, 9]. %% With database
?- time(optimum_solution([0, 8, 4, 12, 2, 10, 6, 14, 1, 9], Ans)).
% 4,097 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 2322004 Lips)
Ans = [0, 2, 6, 9]. %% Without database. commented out the database usage.
I would like to know if I am using the dynamic database correctly. Thanks!
The issue is that as you are traversing the list building subsequences, you need to consider only prior subsequences whose last value is less than the value you have in-hand. The problem is that Prolog's first-argument indexing is doing an equality check, not a less-than check. So Prolog will have to traverse the entire store of lns/2, unifying the first parameter with a value so you can check to see if it's less and then backtracking to get the next.
Earlier, we presented a concise solution based on clpfd.
Now we aim at generality and efficiency!
:- use_module([library(clpfd), library(lists)]).
list_long_nondecreasing_subseq(Zs, Xs) :-
minimum(Min, Zs),
append(_, Suffix, Zs),
same_length(Suffix, Xs),
zs_subseq_taken0(Zs, Xs, Min).
zs_subseq_taken0([], [], _).
zs_subseq_taken0([E|Es], [E|Xs], E0) :-
E0 #=< E,
zs_subseq_taken0(Es, Xs, E).
zs_subseq_taken0([E|Es], Xs, E0) :-
zs_subseq_taken0_min0_max0(Es, Xs, E0, E, E).
zs_subseq_taken0_min0_max0([], [], E0, _, Max) :-
Max #< E0.
zs_subseq_taken0_min0_max0([E|Es], [E|Xs], E0, Min, Max) :-
E0 #=< E,
E0 #> Min #\/ Min #> E,
E0 #> Max #\/ Max #> E,
zs_subseq_taken0(Es, Xs, E).
zs_subseq_taken0_min0_max0([E|Es], Xs, E0, Min0, Max0) :-
Min #= min(Min0,E),
Max #= max(Max0,E),
zs_subseq_taken0_min0_max0(Es, Xs, E0, Min, Max).
Sample query using SICStus Prolog 4.3.2 (with pretty-printed answer sequence):
?- list_long_nondecreasing_subseq([0,8,4,12,2,10,6,14,1,9], Xs).
Xs = [0,8,12,14]
; Xs = [0,8,10,14]
; Xs = [0,4,12,14]
; Xs = [0,4,10,14]
; Xs = [0,4, 6,14]
; Xs = [0,4, 6, 9]
; Xs = [0,2,10,14]
; Xs = [0,2, 6,14]
; Xs = [0,2, 6, 9]
; Xs = [0,8,9]
; Xs = [0,4,9]
; Xs = [0,2,9]
; Xs = [0,1,9]
; false.
Note that the answer sequence of list_long_nondecreasing_subseq/2
may be a lot smaller than the one given by list_nondecreasing_subseq/2.
Above list [0,8,4,12,2,10,6,14,1,9] has 9 non-descending subsequences of length 4—all are "returned" by both list_nondecreasing_subseq/2 and
list_long_nondecreasing_subseq/2.
The respective answer sequence sizes, however, differ considerably: (65+9=74) vs (4+9=13).
TL;DR:
In this answer we implement a very general approach based on clpfd.
:- use_module(library(clpfd)).
list_nondecreasing_subseq(Zs, Xs) :-
append(_, Suffix, Zs),
same_length(Suffix, Xs),
chain(Xs, #=<),
list_subseq(Zs, Xs). % a.k.a. subset/2 by #gusbro
Sample query using SWI-Prolog 7.3.16:
?- list_nondecreasing_subseq([0,8,4,12,2,10,6,14,1,9], Zs).
Zs = [0,8,12,14]
; Zs = [0,8,10,14]
; Zs = [0,4,12,14]
; Zs = [0,4,10,14]
; Zs = [0,4,6,14]
; Zs = [0,4,6,9]
; Zs = [0,2,10,14]
; Zs = [0,2,6,14]
; Zs = [0,2,6,9]
; Zs = [0,8,12]
...
; Zs = [9]
; Zs = []
; false.
Note the particular order of the answer sequence!
The longest lists come first, followed by the lists a little smaller ... all the way down to singleton lists, and the empty list.
Keeps getting better!
In this answer we present list_long_nondecreasing_subseq__NEW/2, a drop-in replacement of list_long_nondecreasing_subseq/2—presented in this earlier answer.
Let's cut to the chase and define list_long_nondecreasing_subseq__NEW/2!
:- use_module([library(clpfd), library(lists), library(random), library(between)]).
list_long_nondecreasing_subseq__NEW(Zs, Xs) :-
minimum(Min, Zs),
append(Prefix, Suffix, Zs),
same_length(Suffix, Xs),
zs_skipped_subseq_taken0(Zs, Prefix, Xs, Min).
zs_skipped_subseq_taken0([], _, [], _).
zs_skipped_subseq_taken0([E|Es], Ps, [E|Xs], E0) :-
E0 #=< E,
zs_skipped_subseq_taken0(Es, Ps, Xs, E).
zs_skipped_subseq_taken0([E|Es], [_|Ps], Xs, E0) :-
zs_skipped_subseq_taken0_min0_max0(Es, Ps, Xs, E0, E, E).
zs_skipped_subseq_taken0_min0_max0([], _, [], E0, _, Max) :-
Max #< E0.
zs_skipped_subseq_taken0_min0_max0([E|Es], Ps, [E|Xs], E0, Min, Max) :-
E0 #=< E,
E0 #> Min #\/ Min #> E,
E0 #> Max #\/ Max #> E,
zs_skipped_subseq_taken0(Es, Ps, Xs, E).
zs_skipped_subseq_taken0_min0_max0([E|Es], [_|Ps], Xs, E0, Min0, Max0) :-
Min #= min(Min0,E),
Max #= max(Max0,E),
zs_skipped_subseq_taken0_min0_max0(Es, Ps, Xs, E0, Min, Max).
So ... does it still work as before? Let's run some tests and compare the answer sequences:
| ?- setrand(random(29251,13760,3736,425005073)),
between(7, 23, N),
nl,
write(n=N),
write(' '),
length(Zs, N),
between(1, 10, _),
maplist(random(1,N), Zs),
findall(Xs1, list_long_nondecreasing_subseq( Zs,Xs1), Xss1),
findall(Xs2, list_long_nondecreasing_subseq__NEW(Zs,Xs2), Xss2),
( Xss1 == Xss2 -> true ; throw(up) ),
length(Xss2,L),
write({L}),
false.
n=7 {3}{8}{3}{7}{2}{5}{4}{4}{8}{4}
n=8 {9}{9}{9}{8}{4}{4}{7}{5}{6}{9}
n=9 {9}{8}{5}{7}{10}{7}{9}{4}{5}{4}
n=10 {7}{12}{7}{14}{13}{19}{13}{17}{10}{7}
n=11 {14}{17}{7}{9}{17}{21}{14}{10}{10}{21}
n=12 {25}{18}{20}{10}{32}{35}{7}{30}{15}{11}
n=13 {37}{19}{18}{22}{20}{14}{10}{11}{8}{14}
n=14 {27}{9}{18}{10}{20}{29}{69}{28}{10}{33}
n=15 {17}{24}{13}{26}{32}{14}{22}{28}{32}{41}
n=16 {41}{55}{35}{73}{44}{22}{46}{47}{26}{23}
n=17 {54}{43}{38}{110}{50}{33}{48}{64}{33}{56}
n=18 {172}{29}{79}{36}{32}{99}{55}{48}{83}{37}
n=19 {225}{83}{119}{61}{27}{67}{48}{65}{90}{96}
n=20 {58}{121}{206}{169}{111}{66}{233}{57}{110}{146}
n=21 {44}{108}{89}{99}{149}{148}{92}{76}{53}{47}
n=22 {107}{137}{221}{79}{172}{156}{184}{78}{162}{112}
n=23 {163}{62}{76}{192}{133}{372}{101}{290}{84}{378}
no
All answer sequences were exactly identical! ... So, how about runtimes?
Let's run some more queries using SICStus Prolog 4.3.2 and pretty-print the answers!
?- member(N, [15,20,25,30,35,40,45,50]),
length(Zs, N),
_NN #= N*N,
maplist(random(1,_NN), Zs),
call_time(once(list_long_nondecreasing_subseq( Zs, Xs )), T1),
call_time(once(list_long_nondecreasing_subseq__NEW(Zs,_Xs2)), T2),
Xs == _Xs2,
length(Xs,L).
N = 15, L = 4, T1 = 20, T2 = 0, Zs = [224,150,161,104,134,43,9,111,76,125,50,68,202,178,148], Xs = [104,111,125,202] ;
N = 20, L = 6, T1 = 60, T2 = 10, Zs = [71,203,332,366,350,19,241,88,370,100,288,199,235,343,181,90,63,149,215,285], Xs = [71,88,100,199,235,343] ;
N = 25, L = 7, T1 = 210, T2 = 20, Zs = [62,411,250,222,141,292,276,94,548,322,13,317,68,488,137,33,80,167,101,475,475,429,217,25,477], Xs = [62,250,292,322,475,475,477] ;
N = 30, L = 10, T1 = 870, T2 = 30, Zs = [67,175,818,741,669,312,99,23,478,696,63,793,280,364,677,254,530,216,291,660,218,664,476,556,678,626,75,834,578,850], Xs = [67,175,312,478,530,660,664,678,834,850] ;
N = 35, L = 7, T1 = 960, T2 = 120, Zs = [675,763,1141,1070,299,650,1061,1184,512,905,139,719,844,8,1186,1006,400,690,29,791,308,1180,819,331,482,982,81,574,1220,431,416,357,1139,636,591], Xs = [299,650,719,844,1006,1180,1220] ;
N = 40, L = 9, T1 = 5400, T2 = 470, Zs = [958,1047,132,1381,22,991,701,1548,470,1281,358,32,605,1270,692,1020,350,794,1451,11,985,1196,504,1367,618,1064,961,463,736,907,1103,719,1385,1026,935,489,1053,380,637,51], Xs = [132,470,605,692,794,985,1196,1367,1385] ;
N = 45, L = 10, T1 = 16570, T2 = 1580, Zs = [1452,171,442,1751,160,1046,470,450,1245,971,1574,901,1613,1214,1849,1805,341,34,1923,698,156,1696,717,1708,1814,1548,463,421,1584,190,1195,1563,1772,1639,712,693,1848,1531,250,783,1654,1732,1333,717,1322], Xs = [171,442,1046,1245,1574,1613,1696,1708,1814,1848] ;
N = 50, L = 11, T1 = 17800, T2 = 1360, Zs = [2478,2011,2411,1127,1719,1286,1081,2042,1166,86,355,894,190,7,1973,1912,753,1411,1082,70,2142,417,1609,1649,2329,2477,1324,37,1781,1897,2415,1018,183,2422,1619,1446,1461,271,56,2399,1681,267,977,826,2145,2318,2391,137,55,1995], Xs = [86,355,894,1411,1609,1649,1781,1897,2145,2318,2391] ;
false.
Of course, the baroque approach shown in this answer simply cannot compete with "serious" suitable algorithms for determining the lis—still, getting 10X speedup always feels good:)

Swap two elements from list with specified indices

I need to swap two elements in list with specified indices using predicate:
swap(List, index1, index2).
I tried this way:
change_value([X|List], 0, Y, [Y|List2]) :-
copy_rest([X|List], List2).
change_value([], P, Y, []).
change_value([X|List], Pos, Y, [X|List2]) :-
X \== Y,
Pos > 0,
NewPos is Pos - 1,
change_value(List, NewPos, Y, List2).
copy_rest([], []).
copy_rest([X|List], [X|List2]) :-
copy_rest(List, List2).
Is there any better solution?
Thank you very much!
No need to write recursive code!
Simply use the builtin predicates length/2, same_length/2, and append/3 like so:
list_i_j_swapped(As,I,J,Cs) :-
same_length(As,Cs),
append(BeforeI,[AtI|PastI],As),
append(BeforeI,[AtJ|PastI],Bs),
append(BeforeJ,[AtJ|PastJ],Bs),
append(BeforeJ,[AtI|PastJ],Cs),
length(BeforeI,I),
length(BeforeJ,J).
Done! Let's put it to use!
?- list_i_j_swapped([e0,e1,e2,e3,e4,e5],5,1,Ys).
Ys = [e0,e5,e2,e3,e4,e1]
; false.
OK! Does it work in the "other direction", too?
?- list_i_j_swapped(Xs,5,1,[e0,e5,e2,e3,e4,e1]).
Xs = [e0,e1,e2,e3,e4,e5]
; false.
Alright! What about the following quite general query?
?- list_i_j_swapped([A,B,C],I,J,Ys).
I = 0, J = 0, Ys = [A,B,C]
; I = 0, J = 1, Ys = [B,A,C]
; I = 0, J = 2, Ys = [C,B,A]
; I = 1, J = 0, Ys = [B,A,C]
; I = 1, J = 1, Ys = [A,B,C]
; I = 1, J = 2, Ys = [A,C,B]
; I = 2, J = 0, Ys = [C,B,A]
; I = 2, J = 1, Ys = [A,C,B]
; I = J, J = 2, Ys = [A,B,C]
; false.
It worked! At last, we run the most general query:
?- list_i_j_swapped(Xs,I,J,Ys).
I = 0, J = 0, Xs = [_A] , Ys = [_A]
; I = 0, J = 0, Xs = [_A,_B] , Ys = [_A,_B]
; I = 0, J = 1, Xs = [_A,_B] , Ys = [_B,_A]
; I = 1, J = 0, Xs = [_A,_B] , Ys = [_B,_A]
; I = 1, J = 1, Xs = [_A,_B] , Ys = [_A,_B]
; I = 0, J = 0, Xs = [_A,_B,_C], Ys = [_A,_B,_C]
...
Fair enumeration out-of-the-box? What's not to like?
Using DCG, for performance (due to difference lists):
list_i_j_nth1_swap_using_dcg(I, J, Lst, LstSwap) :-
integer(I),
integer(J),
Min is min(I, J),
Max is max(I, J),
Min >= 1,
Min < Max,
phrase(list_i_j_nth1_swap(Min, Max), Lst, LstSwap).
list_i_j_nth1_swap(1, Max), [ElemJ] -->
!, [ElemI], { Max0 is Max - 1 }, list_i_j_nth1_swap_j(Max0, ElemI, ElemJ).
list_i_j_nth1_swap(Min, Max), [E] -->
[E], { Min0 is Min - 1, Max0 is Max - 1 }, list_i_j_nth1_swap(Min0, Max0).
list_i_j_nth1_swap_j(1, ElemI, ElemJ), [ElemI] -->
!, [ElemJ].
list_i_j_nth1_swap_j(Max, ElemI, ElemJ), [E] -->
[E], { Max0 is Max - 1 }, list_i_j_nth1_swap_j(Max0, ElemI, ElemJ).
Result in swi-prolog:
?- numlist(1, 10, L), time(list_i_j_nth1_swap_using_dcg(2, 4, L, S)).
% 9 inferences, 0.000 CPU in 0.000 seconds (88% CPU, 208792 Lips)
L = [1,2,3,4,5,6,7,8,9,10],
S = [1,4,3,2,5,6,7,8,9,10].
?- time(list_i_j_nth1_swap_using_dcg(2, 9, L, [1,9,3,4,5,6,7,8,2,10])).
% 14 inferences, 0.000 CPU in 0.000 seconds (90% CPU, 272368 Lips)
L = [1,2,3,4,5,6,7,8,9,10].
?- numlist(1, 10000000, L), time(list_i_j_nth1_swap_using_dcg(3, 5, L, S)).
% 10 inferences, 0.000 CPU in 0.000 seconds (86% CPU, 320092 Lips)
S = [1,2,5,4,3,6,7,8,9,10...
?- numlist(1, 10000000, L), time(list_i_j_nth1_swap_using_dcg(2000, 1000, L,
S)).
% 2,005 inferences, 0.319 CPU in 0.325 seconds (98% CPU, 6290 Lips)

Appending a list to a list of lists recursively

The problem I'm trying to solve is as follows:
I'm given a sorted list where I must pair the first and last items in the list. Then I must pair the 2nd and (last-1) items in the list until the list is either empty or 1 element remains. Then I must return a list of the pairs.
The steps I decided to take for this problem was to first check if the list's length was greater than 1. If it wasn't, then that means we have a list of 0 or 1 elements.
Then I get the first and last items in the given list, delete them from the list, pair them, and then recursively call the same predicate on the new list. Once I've gone all the way down to 0/1 items, I then pop back up and append them to my return list.
The problem I'm having is that when I try to append the pair L = [first,last] to my return list, it errors out. My code is listed below.
T is my input list.
first/2 just gets the first item in the list. pair/3 strips away some info from P1 and P2 and then creates L = [P1,P2].
getMatches(T,K,ReturnList) :-
( length(T,Val),
Val > 1,
first(T,P1),
last(T, P2),
delete(T,P1,G),
delete(G,P2,H),
pair(P1,P2,L),
getMatches(H,K,ReturnList),
append(L,K,ReturnList)
; first(T,_),
K = []
).
An example use:
If T = [1, 2, 3, 4, 5] then
ReturnList = [[1,5], [2, 4]] should hold.
We define list_pairs/2 based on the commonly available list predicate append/3.
list_pairs([] , []).
list_pairs([_], []).
list_pairs([A,B|Xs0], [A-Z|Yss]) :-
append(Xs, [Z], [B|Xs0]),
list_pairs(Xs, Yss).
Note we do not represent a pair of X and Y as a list [X,Y], but rather as a compound X-Y. This convention is idiomatic, widespread, and more efficient, too!
Here's the most general query of list_pairs/2:
?- list_pairs(Es, Pss).
Es = [] , Pss = []
; Es = [_] , Pss = []
; Es = [A,B] , Pss = [A-B]
; Es = [A,_,B] , Pss = [A-B]
; Es = [A,B,C,D] , Pss = [A-D,B-C]
; Es = [A,B,_,C,D] , Pss = [A-D,B-C]
; Es = [A,B,C,D,E,F] , Pss = [A-F,B-E,C-D]
; Es = [A,B,C,_,D,E,F] , Pss = [A-F,B-E,C-D]
; Es = [A,B,C,D,E,F,G,H] , Pss = [A-H,B-G,C-F,D-E]
; Es = [A,B,C,D,_,E,F,G,H], Pss = [A-H,B-G,C-F,D-E]
...
This is a follow-up to this earlier answer and improves it by
avoiding the creation of useless choice-points and by
reducing the Big-O complexity from O(N2) to O(N).
list_pairs_lin([], []).
list_pairs_lin([X|Xs], XYs) :-
reverse(Xs, Ys),
ahead_keys_values_pairs(Xs, [X|Xs], Ys, XYs).
ahead_keys_values_pairs([], _, _, []).
ahead_keys_values_pairs([_|Fs0], [X|Xs], [Y|Ys], [X-Y|XYs]) :-
maybe_ahead(Fs0, Fs),
ahead_keys_values_pairs(Fs, Xs, Ys, XYs).
maybe_ahead([], []).
maybe_ahead([_|Xs], Xs).
Let's run some queries with SWI-Prolog 7.3.15!
Do we still get sound answers when using list_pairs_lin/2?
?- length(Es, N), numlist(1, N, Es), list_pairs_lin(Es, Pss).
N = 1, Es = [1] , Pss = []
; N = 2, Es = [1,2] , Pss = [1-2]
; N = 3, Es = [1,2,3] , Pss = [1-3]
; N = 4, Es = [1,2,3,4] , Pss = [1-4,2-3]
; N = 5, Es = [1,2,3,4,5] , Pss = [1-5,2-4]
; N = 6, Es = [1,2,3,4,5,6] , Pss = [1-6,2-5,3-4]
; N = 7, Es = [1,2,3,4,5,6,7] , Pss = [1-7,2-6,3-5]
; N = 8, Es = [1,2,3,4,5,6,7,8] , Pss = [1-8,2-7,3-6,4-5]
; N = 9, Es = [1,2,3,4,5,6,7,8,9], Pss = [1-9,2-8,3-7,4-6]
...
Yes! What about complexity?
?- set_prolog_flag(toplevel_print_anon, false).
true.
?- numlist(1, 5000, _Xs), time(list_pairs(_Xs,_)).
% 6,252,500 inferences, 2.302 CPU in 2.301 seconds (100% CPU, 2716404 Lips)
true ; % succeeds, but leaves behind useless choicepoint
% 2,503 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 1716259 Lips)
false. % terminates universally
?- numlist(1, 5000, _Xs), time(list_pairs_lin(_Xs,_)).
% 10,003 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 3680523 Lips)
true. % succeeds deterministically
getMatches(List, ReturnList) :- % getMatches/2
getMatches(List, [], Answer),
reverse(Answer, ReturnList),
!.
getMatches(List, ListAns, ListAns) :- % getMatches/3
length(List, L),
L < 2.
getMatches([H | Tail], List, Ans) :-
last(Tail, Last),
delete(Tail, Last, NewTail),
append([[H, Last]], List, NewList),
getMatches(NewTail, NewList, Ans).
And
?- getMatches([1,2,3,4,5],X).
X = [[1, 5], [2, 4]].