Prime numbers Prolog - list

I have written Prolog code to (try) find prime numbers between 0 and N. I am however unable to filter out composite numbers.
Any advice would be great.
check(N, 2) :-
N mod 2 =:= 0.
plist(N, List) :-
X>1,
findall(Z, between(1, N, Z), L1),
list(L1, 2, List).
list([], _, []).
list([H | Tail1], 2, [H | Tail2]) :-
\+ divide(H, 2),
list(Tail1, 2, Tail2).
list([H | Tail1], 2, List) :-
divide(H, 2),
list(Tail1, 2, List).

Start coding a predicate is_prime(N) :- .... without any optimization, just looping from 2 to N-1 (of course, you can stop at square root of N, but it's not so important right now...).
You can test it at the command line, ?- is_prime(13). should give true, ?- is_prime(21). should give false...
Then you have done:
plist(N, List) :-
findall(Z, (between(1, N, Z), is_prime(Z)), List).

Related

Prolog - How to make a list of lists with a certain length from a flat list

For example:
createlistoflists([1,2,3,4,5,6,7,8,9], NewLists)
NewLists = [[1,2,3], [4,5,6], [7,8,9].
So basically my first argument is a list, my second argument a new list consisting of lists with the proper length (the proper length being 3). My first idea was to use append of some sort. But I have literally no idea how to do this, any thoughts?
thanks in advance
If you don't mind using the nice facilities Prolog provides you, there's a simple approach;
list_length(Size, List) :- length(List, Size).
split_list(List, SubSize, SubLists) :-
maplist(list_length(SubSize), SubLists),
append(SubLists, List).
And you can query it as:
?- split_list([1,2,3,4,5,6,7,8,9], 3, L).
L = [[1, 2, 3], [4, 5, 6], [7, 8, 9]]
It will fail if List is instantiated in such a way that it's length is not a multiple of SubSize.
As pointed out by Will Ness in the comments, the above simple solution has a flaw: the maplist(list_length(SubSize), SubList) will continue to query and find longer and longer sets of sublists, unconstrained. Thus, on retry, the query above will not terminate.
The temptation would be to use a cut like so:
split_list(List, SubSize, SubLists) :-
maplist(list_length(SubSize), SubLists), !,
append(SubLists, List).
The cut here assumes you just want to get a single answer as if you were writing an imperative function.
A better approach is to try to constrain, in a logical way, the SubList argument to maplist. A simple approach would be to ensure that the length of SubList doesn't exceed the length of List since, logically, it should never be greater. Adding in this constraint:
list_length(Size, List) :- length(List, Size).
not_longer_than([], []).
not_longer_than([], [_|_]).
not_longer_than([_|X], [_|Y]) :-
not_longer_than(X, Y).
split_list(List, SubSize, SubLists) :-
not_longer_than(SubLists, List),
maplist(list_length(SubSize), SubLists),
append(SubLists, List).
Then the query terminates without losing generality of the solution:
?- split_list([1,2,3,4,5,6,7,8,9], 3, L).
L = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] ;
false.
?-
One could be more precise in the implementation of not_longer_than/2 and have it use the SubSize as a multiple. That would be more efficient but not required to get termination.
not_longer_than_multiple(L1, Mult, L2) :-
not_longer_than_multiple(L1, Mult, Mult, L2).
not_longer_than_multiple([], _, _, []).
not_longer_than_multiple([], _, _, [_|_]).
not_longer_than_multiple([_|Xs], Mult, 1, [_|Ys]) :-
not_longer_than_multiple(Xs, Mult, Mult, Ys).
not_longer_than_multiple(Xs, Mult, C, [_|Ys]) :-
C #> 1,
C1 #= C - 1,
not_longer_than_multiple(Xs, Mult, C1, Ys).
Or something along those lines...
But then, if we're going to go through all that non-sense to cover the sins of this use of maplist, then perhaps hitting the problem head-on makes the cleanest solution:
split_list(List, SubSize, SubLists) :-
split_list(List, SubSize, SubSize, SubLists).
split_list([], _, _, []).
split_list([X|Xs], SubList, 1, [[X]|S]) :-
split_list(Xs, SubList, SubList, S).
split_list([X|Xs], SubSize, C, [[X|T]|S]) :-
C #> 1,
C1 #= C - 1,
split_list(Xs, SubSize, C1, [T|S]).

Longest subsequence in Prolog

I want to implement a predicate P(Xs,Ys,Zs) where Xs,Ys,Zs are lists.
I'm new in Prolog and I can't find a way to get to the longest sequence in Xs (example. Xs = ['b','b','A','A','A','A','b','b']) which is included to Ys (for example Ys = ['A','A','A','A','c','A','A','A','A']) without crossing- an even number of times. Maybe someone already wrote this code ore some one can say me how can I start. Thanks for helps.
explanation of teacher.
longest_subsequence(List, Part, Subsequence):-
longest_subsequence_(List, Part, [], Subsequence).
longest_subsequence_(Xs, Ys, CurrentSubsequence, LongestSubsequence):-
append(CurrentSubsequence, Ys, NextSubsequence),
divide_list(Xs, [_LeftYs, NextSubsequence, _RightYs]), !,
longest_subsequence_(Xs, Ys, NextSubsequence, LongestSubsequence).
longest_subsequence_(_Xs, _Ys, LongestSubsequence, LongestSubsequence).
okey i did.
main_task(Xs, Ys, Zs) :-
atom_chars(Xs, Xl),
atom_chars(Ys, Yl),
retractall(record(_, _)),
assert(record(0, [])),
process(Xl, Yl, Zl),
atom_chars(Zs, Zl).
process(Xl, Yl, _) :-
get_sublist(Xl, Zl),
length(Zl, L),
record(MaxL, _),
L > MaxL,
get_index(Yl, Zl, Il),
test_even(Il),
test_intersect(Il, L),
retractall(record(_, _)),
assert(record(L, Zl)),
fail.
process(_, _, Zl) :-
record(_, Zl).
get_sublist(L1, L2) :-
get_tail(L1, L3),
get_head(L3, L2).
get_tail(L, L).
get_tail([_|T], L) :-
get_tail(T, L).
get_head([H|T1], [H|T2]) :-
get_head(T1, T2).
get_head(_, []).
get_index(Yl, Zl, Il) :-
get_index(Yl, Zl, Il, 0).
get_index([], _, [], _).
get_index([Yh|Yt], Zl, [I|It], I) :-
get_head([Yh|Yt], Zl),
!,
I1 is I + 1,
get_index(Yt, Zl, It, I1).
get_index([_|Yt], Zl, Il, I) :-
I1 is I + 1,
get_index(Yt, Zl, Il, I1).
test_even(Il) :-
length(Il, L),
L > 0,
L mod 2 =:= 0.
test_intersect([_], _).
test_intersect([X,Y|T], L) :-
Y - X >= L,
test_intersect([Y|T], L).
All lines in the list at the symbols on working with lists
Initialize the dynamic database - will be stored in it, and its maximum line length
enumerates all of the substring (sublists) from X. Bust goes double "pruning" - first place in a list of cut off the front, then from behind.
Check the length of the resulting string, if we already have a long, immediately leave for the continuation of busting
We consider a list of indexes in the occurrence of a Y, then there is every element of the list - a position in the Y, from which it includes Z.
Check the parity - just consider the length of the list of indexes, chёtnaya length - an even number of entries. And we need to check that it is greater than zero.
Check the intersection - you need to check the difference between two adjacent elements of the list of indexes, the difference should always be greater than the length Z.
If all checks are made, there is a dynamic database updates - current list Z is stored as the maximum
At the end it is a forced failure, it is rolled back to the fork in paragraph 3) and the continued search.
Note: If any check is not performed, the failure of this test is immediately rolled back to the fork in paragraph 3) and the continued search.
When the bust comes to an end, performed a second rule predicate process, it simply selects the last spicok Z in the base.
At the end of the list Z is converted back to a string
A naive approach is the following:
longest_subsequence(Xs,Ys,Zs) :-
longest_subsequence(Xs,Ys,Ys,0,[],Zs).
longest_subsequence([X|Xs],Y0,[Y|Ys],N0,Z0,Z) :-
try_seq([X|Xs],[Y|Ys],Nc,Zc),
(Nc > N0
-> longest_subsequence([X|Xs],Y0,Ys,Nc,Zc,Z)
; longest_subsequence([X|Xs],Y0,Ys,N0,Z0,Z)
).
longest_subsequence([_|Xs],Y0,[],N0,Z0,Z) :-
longest_subsequence(Xs,Y0,Y0,N0,Z0,Z).
longest_subsequence([],_,_,_,Z,Z).
try_seq([H|TA],[H|TB],N,[H|TC]) :-
!,
try_seq(TA,TB,N1,TC),
N is N1+1.
try_seq(_,_,0,[]).
here a predicate try_seq/3 aims to match as much as possible (generate the longest common subsequence) starting from the beginning of the list.
The problem is that this is a computationally expensive approach: it will have a time complexity O(m n p) with n the length of the first list, m the length of the second list and p the minimum length of the two lists.
Calling this with your example gives:
?- longest_subsequence([b,b,a,a,a],[a,a,a,c,a,a,a],Zs).
Zs = [a, a, a] ;
false.
You can make the algorithm more efficient using back-referencing, this is more or less based on the Knuth-Morris-Pratt-algorithm.
When approaching a problem, first try: divide and conquer.
When we have a list_subsequence(+List, ?Subsequence) predicate
list_subsequence([H|T], S) :-
list_subsequence(H, T, S, _).
list_subsequence([H|T], S) :-
list_subsequence(H, T, _, R),
list_subsequence(R, S).
list_subsequence(H, [H|T], [H|S], R) :- !, list_subsequence(H, T, S, R).
list_subsequence(H, R, [H], R).
we can call for library(aggregate) help:
longest_subsequence(Seq, Rep, Longest) :-
aggregate(max(L, Sub), N^(
list_subsequence(Seq, Sub),
aggregate(count, list_subsequence(Rep, Sub), N),
N mod 2 =:= 0,
length(Sub, L)
), max(_, Longest)).
edit: more library support available
A recently added library helps:
longest_subsequence_(Seq, Rep, Longest) :-
order_by([desc(L)], filter_subsequence(Seq, Rep, Longest, L)), !.
where filter_subsequence/4 is simply the goal of the outer aggregate:
filter_subsequence(Seq, Rep, Sub, L) :-
list_subsequence(Seq, Sub),
aggregate(count, list_subsequence(Rep, Sub), N),
N mod 2 =:= 0,
length(Sub, L).

Remove unique elements only

There are many resources on how to remove duplicates and similar issues but I can't seem to be able to find any on removing unique elements. I'm using SWI-Prolog but I don't want to use built-ins to achieve this.
That is, calling remove_unique([1, 2, 2, 3, 4, 5, 7, 6, 7], X). should happily result in X = [2, 2, 7, 7].
The obvious solution is as something along the lines of
count(_, [], 0) :- !.
count(E, [E | Es], A) :-
S is A + 1,
count(E, Es, S).
count(E, [_ | Es], A) :-
count(E, Es, A).
is_unique(E, Xs) :-
count(E, Xs, 1).
remove_unique(L, R) :- remove_unique(L, L, R).
remove_unique([], _, []) :- !.
remove_unique([X | Xs], O, R) :-
is_unique(X, O), !,
remove_unique(Xs, O, R).
remove_unique([X | Xs], O, [X | R]) :-
remove_unique(Xs, O, R).
It should become quickly apparent why this isn't an ideal solution: count is O(n) and so is is_unique as it just uses count. I could improve this by failing when we find more than one element but worst-case is still O(n).
So then we come to remove_unique. For every element we check whether current element is_unique in O. If the test fails, the element gets added to the resulting list in the next branch. Running in O(n²), we get a lot of inferences. While I don't think we can speed it in the worst case, can we do better than this naïve solution? The only improvement that I can clearly see is to change count to something that fails as soon as >1 elements are identified.
Using tpartition/4 in tandem with
if_/3 and (=)/3, we define remove_unique/2 like this:
remove_unique([], []).
remove_unique([E|Xs0], Ys0) :-
tpartition(=(E), Xs0, Es, Xs),
if_(Es = [], Ys0 = Ys, append([E|Es], Ys, Ys0)),
remove_unique(Xs, Ys).
Here's the sample query, as given by the OP:
?- remove_unique([1,2,2,3,4,5,7,6,7], Xs).
Xs = [2,2,7,7]. % succeeds deterministically
As long as you don't know that the list is sorted in any way, and you want to keep the sequence of the non-unique elements, it seems to me you can't avoid making two passes: first count occurrences, then pick only repeating elements.
What if you use a (self-balancing?) binary tree for counting occurrences and look-up during the second pass? Definitely not O(n²), at least...

Prolog: find all numbers of unique digits that can be formed from a list of digits

The best thing I could come up with so far is this function:
numberFromList([X], X) :-
digit(X), !.
numberFromList(List, N) :-
member(X, List),
delete(List, X, LX),
numberFromList(LX, NX),
N is NX * 10 + X.
where digit/1 is a function verifying if an atom is a decimal digit.
The numberFromList(List, N) finds all the numbers that can be formed with all digits from List.
E.g. [2, 3] -> 23, 32.
but I want to get this result: [2, 3] -> 2, 3, 23, 32
I spent a lot of hours thinking about this and I suspect you might use something like append(L, _, List) at some point to get lists of lesser length.
I would appreciate any contribution.
You are missing case when you skip digit from list.
numberFromList([X], X) :-
digit(X), !.
numberFromList(List, N) :-
member(X, List),
delete(List, X, LX),
numberFromList(LX, NX),
( % use X
N is NX * 10 + X
; % skip X
N = NX
).
BTW, as #Roland Illig mentioned there is select(X, List, LX) to replace member(X, List), delete(List, X, LX)
The predicate unique/3 generates all lists of length up to MaxLen consisting of symbols from Symbols. The generated lists are stored in L, once at a time.
unique(MaxLen, Symbols, L) :-
between(0, MaxLen, Len),
length(L, Len),
unique(Symbols, L).
The helper predicate for generating the lists.
unique(_, []).
unique(Set, [H|R]) :-
select(H, Set, ReducedSet),
unique(ReducedSet, R).
A simple program for demonstrating the above predicate:
main :-
unique(5, [2,3], L),
write(L), nl, fail.
Here's one way, using SWI-PROLOG built-ins for atomic_list_concat/2, atom_number/2 and select/3. Firstly, the entry point refers to an implementation using an initially empty accumulator:
numberFromList(L, N) :-
numberFromList(L, [], N).
The predicate numberFromList/3 either accumulates digits (unchecked) from the list, or not, leaving choicepoints:
numberFromList([_|Cs], Acc, N) :-
numberFromList(Cs, Acc, N).
numberFromList([C|Cs], Acc, N) :-
numberFromList(Cs, [C|Acc], N).
The final clause of numberFromList/3 permutes the accumulated list of digits and concatenates them into an atom, which is then converted to a number as required:
numberFromList([], [C|Cs], N) :-
permute([C|Cs], PermutedAcc),
atomic_list_concat(PermutedAcc, AN),
atom_number(AN, N).
Sometimes permute/2 (as defined manually below) may be available as a built-in, such as permutation/2. Here is a manual definition using select/3:
permute([], []).
permute([E|Es], [E0|PL]) :-
select(E0, [E|Es], Rem),
permute(Rem, PL).
If you want a list of all the results and don't want numberFromList/2 to backtrack itself, you could wrap the call to numberFromList/3 (with the empty accumulator in the first clause of numberFromList/2) in a findall/3 call.

How do I find the longest list in a list of lists?

I have a list of lists, and I need to find the longest one of them. If there are more than one with the same length it's the same which it returns. Thanks.
Here is a general predicate that scans a list to find a single member defined by a given goal.
select_element(Goal, [Head | Tail], Selected) :-
select_element(Goal, Tail, Head, Selected).
select_element(_Goal, [], Selected, Selected).
select_element(Goal, [Head | Tail], Current, FinalSelected) :-
call(Goal, Head, Current, Selected),
select_element(Goal, Tail, Selected, FinalSelected).
Lets say you define a predicate
get_bigger_number(N1, N2, N) :-
N is max(N1, N2).
Now you can execute:
?- select_element(get_bigger_number, [5, 1, -2, 10, 3.2, 0], Selected).
Selected = 10
So all you need to do now is define a predicate get_longer_list(L1, L2, L),
and use it instead of get_bigger_number/3.
Of course, using a general predicate like select_element/3 might not be very efficient. For example, you should try to avoid calculating the length of the same list several times, because this calculation is slow in Prolog (at least if implemented in Prolog in the standard way).
Please consider my aproach.
longest([L], L) :-
!.
longest([H|T], H) :-
length(H, N),
longest(T, X),
length(X, M),
N > M,
!.
longest([H|T], X) :-
longest(T, X),
!.
Then you can consult it:
?- longest([[1]], N).
N = [1] ;
?- longest([[1],[2]], N).
N = [2] .
?- longest([[1],[2], [3,3,3], [2]], N).
N = [3, 3, 3] ;
?- longest([[1],[2], [3,3,3], [2]], N).
N = [3, 3, 3].
?- longest([[1],[2], [3,3,3], [2], [4,4,4,4]], N).
N = [4, 4, 4, 4] .
?- longest([[1],[2], [3,3,3], [2], [4,4,4,4]], N).
N = [4, 4, 4, 4] ;
Greets!
We define longest/2 based on meta-predicate max_of_by/3 used in tandem with length/2:
longest(Xss,Ys) :-
max_of_by(Ys,Xss,length).
Sample queries:
?- longest([[1],[2]],Xs). % we expect multiple solutions
Xs = [1]
; Xs = [2]. % we _get_ multiple solutions
?- longest([[2,1,3],[7,5],[1,8,2,3,1],[2,7,1,4]],Xs).
Xs = [1,8,2,3,1]. % succeeds deterministically
Here is another approach that is efficient and easy to understand. The idea is to find the lengths of all lists in the list, use max_list to get the length of the longest list, and then find a list that is that long. This has the benefit that it will return all lists of the longest length.
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).
% Correct again.
longest(LL,LX) :-
findmax(Len,(append(_,[L|_],LL),length(L,Len)),MaxLen),
append(_,[LX|_],LL),
length(LX,MaxLen).
findmax(V,P,Max) :-
findall(V,P,L),
max(L,Max).
max([N],N) :- !.
max([N|R],Max) :-
max(R,Max2),
max3(N,Max2,Max).
max3(N,Max2,N) :- N > Max2,!.
max3(N,Max2,Max2).
To have the length of longest list:
%sample: longest([[2,1,3],[7,5],[1,8,2,3,1],[2,7,1,4]],L,LEN).
longest([L], L, _) :-
!.
longest([H|T], H, _) :-
length(H, N),
longest(T, X, N),
length(X, M),
N > M,
!.
longest([_|T], X, LEN) :-
length(X, LEN),
longest(T, X, LEN),
!.