Checking if a string is contained in a language (Prolog) - prolog

This is the CFG:
S -> T | V
T -> UU
U -> aUb | ab
V -> aVb | aWb
W -> bWa | ba
so this will accept some form of:
{a^n b^n a^m b^m | n,m >= 1} U {a^n b^m a^m b^n | n,m >= 1}
And here is the code I'm working with:
in_lang([]).
in_lang(L) :-
mapS(L), !.
mapS(L) :-
mapT(L) ; mapV(L),!.
mapT(L) :-
append(L1, mapU(L), L), mapU(L1), !.
mapU([a|T]) :-
((append(L1,[b],T), mapU(L1)) ; (T = b)),!.
mapV([a|T]) :-
((append(L1,[b],T), mapV(L1)) ;
(append(L1,[b],T), mapW(L1))),
!.
mapW([b|T]) :-
((append(L1,[a],T), mapW(L1)) ;
(T = a)),
!.
As of right now, this is returning false for the following three strings:
[a,a,b,b,a,b] // this should be true
[a,a,a,b,b,a,a,b,b,b] // this should be true as well
[a,a,a,b,b,a,b,b,b] // this one IS false
Any help or insight would be greatly appreciated, I'm not too comfortable with Prolog so debugging this by myself has been a challenge.

Simply use a dcg! And library(double_quotes).
:- set_prolog_flag(double_quotes, chars).
s --> t | v.
t --> u, u.
u --> "a",u,"b" | "ab".
v --> "a",v,"b" | "a",w,"b".
w --> "b",w,"a" | "ba".
?- use_module(library(double_quotes)).
?- length(L,N), phrase(s, L).
L = "abab", N = 4
; L = "abab", N = 4
; L = "aabbab", N = 6
; L = "abaabb", N = 6
; L = "aababb", N = 6
; L = "abbaab", N = 6
; L = "aaabbbab", N = 8
; L = "aabbaabb", N = 8
; L = "abaaabbb", N = 8
; L = "aaababbb", N = 8
; ... .

First, note that this code doesn't make sense:
... append(L1, mapU(L), L) ...
In Prolog there are predicates, not functions...
A CFG production rule (a non terminal) should 'eat' a number of tokens, and in Prolog this means you need at least 2 arguments: the input token list, and what remains after a production has successfully matched the relevant part of input.
That is, append/3 is not required: just pattern matching, performed by unification operator (=)/2
mapS(L1, L) :- mapT(L1,L) ; mapV(L1,L).
mapT(L1, L) :- mapU(L1,L2), mapU(L2,L).
mapU(L1, L) :- L1=[a|L2], mapU(L2,L3), L3=[b|L] ; L1=[a,b|L].
... complete the translation
and then call it:
?- mapS([a,a,b,b,a,b],R).
R = [] ;
false.
R = [] means the entire sequence has been matched...

In the definition of mapT, you are trying to use the "return value" of mapU as an argument to append. But mapU is a predicate, and predicates don't have return values.
Instead one typically writes a predicate with an unbound variable which the predicate binds to the desired "return value"; after the predciate has been proven, the now bound variable can be used in subsequent predicates.

Related

Two DCG rules for `(ab)*`. Can it be one?

I want to generate or test strings obeying the Perl Regex (ab)*
The code below works perfectly well:
Generate
?- phrase_acceptable(Text,6).
Text = abababababab ;
false.
Test (or compress?)
?- phrase_acceptable("ababab",N).
[97,98,97,98,97,98]
N = 3
Enumerate possibilities
?- phrase_acceptable(T,N).
T = '',
N = 0 ;
T = ab,
N = 1 ;
T = abab,
N = 2 ;
T = ababab,
N = 3
...
However, this demands two clauses for acceptable//1 which are selected based on whether N is fresh or not. Can that be avoided? Using CLP(FD) doesn't help, as one has to check that N>=0 in any case to avoid infinite descent.
ff(X) :- var(X). % "freshvar(X)" using 2 letters, which is less annoying
bb(X) :- nonvar(X). % "notfreshvar(X)" using 2 letters, which is less annoying
acceptable(0) --> [].
acceptable(N) --> { bb(N), N>0, succ(Nm,N) }, `ab`, acceptable(Nm).
acceptable(N) --> { ff(N) }, `ab`, acceptable(Nm), { succ(Nm,N) }.
phrase_acceptable(Text,N) :-
bb(Text),!,
atom_codes(Text,Codes),
writeln(Codes),
phrase(acceptable(N),Codes,[]).
phrase_acceptable(Text,N) :-
ff(Text),!,
phrase(acceptable(N),Codes,[]),
atom_codes(Text,Codes).
How about this:
:- use_module(library(clpfd)).
acceptable(0) --> [].
acceptable(N1) --> `ab`, { N #= N1-1, N #>= 0 }, acceptable(N).
phrase_acceptable(Text, N):-
(nonvar(Text) -> atom_codes(Text, Codes) ; true),
N #>= 0,
phrase(acceptable(N), Codes, []),
(var(Text) -> atom_codes(Text, Codes) ; true).
Test cases:
?- phrase_acceptable(ababab,N).
N = 3 ;
false.
?- phrase_acceptable(Text,3).
Text = ababab ;
false.
?- phrase_acceptable(Text,N).
Text = '',
N = 0 ;
Text = ab,
N = 1 ;
Text = abab,
N = 2 ;
Text = ababab,
N = 3 .

Filter list in prolog

I'm trying to rewrite code from Haskell to Prolog.
count :: Eq a => a -> [a] -> Int
count x = length . filter (x==)
f :: [Integer] -> [Integer]
f [] = []
f list = filter (\x -> count x list == 1) list
This code return list that contains elements that appears only once in the list.
So if I have list [1,1,2,2,3,4,4,5] this function returns [3,5]
I tried to find filter construction in Prolog but seems there no such thing. How can I make similar function in Prolog ?
To the existing answers, I would like to add an answer that is quite general in the sense that you can use it in multiple directions.
Building block: list_element_number/3
I start with the following predicate, defining a relation between:
a list Ls0
an element E
the number N of occurrences of E in Ls0
Here it is:
list_element_number(Ls0, E, N) :-
tfilter(=(E), Ls0, Ls),
length(Ls, N).
This solution uses tfilter/3 from library(reif). The predicate subsumes the function count you have posted. The main benefit of this predicate over the function is that the predicate can be used not only in those cases that even Haskell can do easily, such as:
?- list_element_number([a,b,c], a, N).
N = 1.
No, we can use it also in other directions, such as:
?- list_element_number([a,b,c], X, 1).
X = a ;
X = b ;
X = c ;
false.
Or even:
?- list_element_number([a,b,E], X, 2).
E = X, X = a ;
E = X, X = b ;
false.
Or even:
?- list_element_number([A,B,C], X, 3).
A = B, B = C, C = X ;
false.
And even in the most general case, in which all arguments are fresh variables:
?- list_element_number(Ls, E, N).
Ls = [],
N = 0 ;
Ls = [E],
N = 1 ;
Ls = [E, E],
N = 2 ;
Ls = [E, E, E],
N = 3 .
We can fairly enumerate all answers like this:
?- length(Ls, _), list_element_number(Ls, E, N).
Ls = [],
N = 0 ;
Ls = [E],
N = 1 ;
Ls = [_160],
N = 0,
dif(E, _160) ;
Ls = [E, E],
N = 2 .
Main predicate: list_singletons/2
Using this building block, we can define list_singletons/2 as follows:
list_singletons(Ls, Singles) :-
tfilter(count_one(Ls), Ls, Singles).
count_one(Ls, E, T) :-
list_element_number(Ls, E, Num),
cond_t(Num=1, true, T).
This uses cond_t/3 and (again) tfilter/3 from library(reif).
Sample queries
Here are a few sample queries. First, the test case you have posted:
?- list_singletons([1,1,2,2,3,4,4,5], Singles).
Singles = [3, 5].
It works as desired.
Now a case involving variables:
?- list_singletons([A,B], Singles).
A = B,
Singles = [] ;
Singles = [A, B],
dif(A, B).
On backtracking, all possibilities are generated: Either A = B holds, and in that case, there is no element that occurs only once. Or A is different from B, and in that case both A and B occur exactly once.
As a special case of the above query, we can post:
?- list_singletons([A,A], Singles).
Singles = [].
And as a generalization, we can post:
?- length(Ls, _), list_singletons(Ls, Singles).
Ls = Singles, Singles = [] ;
Ls = Singles, Singles = [_7216] ;
Ls = [_7216, _7216],
Singles = [] ;
Ls = Singles, Singles = [_7828, _7834],
dif(_7828, _7834) ;
Ls = [_7216, _7216, _7216],
Singles = [] ;
Ls = [_7910, _7910, _7922],
Singles = [_7922],
dif(_7910, _7922) .
Enjoy the generality of this relation, obtained via logical-purity.
A more simple version :
filter_list(L,OutList):-findall(X, (select(X,L, L1),\+member(X, L1)) , OutList).
?- filter_list([1,1,2,2,3,4,4,5],L).
L = [3, 5].
Without findall, you can try
filter_list(In, Out) :- filter_list(In, _, Out).
filter_list([], [], []).
filter_list([H|T], L1, L2) :-
filter_list(T, LL1, LL2),
( member(H, LL1)
-> L1 = LL1, L2 = LL2
; (select(H, LL2, L2)
-> L1 = [H|LL1]
; L1 = LL1, L2 = [H|LL2])).
without counting...
filter_uniques([],[]).
filter_uniques([H|T],F) :-
delete(T,H,D),
( D=T -> F=[H|R],S=T ; F=R,S=D ),
filter_uniques(S,R).
a more direct rewrite of your code, with library(yall) support for inlining of the filter predicate (the first argument to include/3)
filt_uniq(L,F) :-
include({L}/[E]>>aggregate(count,member(E,L),1),L,F).
A simple version:
(see the comment by #false below, the version with findall/3 has some inconsistency problems in more complex queries but second version looks ok however it is definitely not so efficient ).
filter_list(L,OutList):-findall(X, (member(X,L),count(X,L,N),N=:=1) , OutList).
count(_,[],0).
count(X,[X|T],N):-count(X,T,N1),N is N1+1.
count(X,[X1|T],N):-dif(X,X1),count(X,T,N).
The predicate filter_list/2 uses findall/3 and simply states find all X that belong to the list L and count returns 1 and store them in OutList.
Example:
?- filter_list([1,1,2,2,3,4,4,5],L).
L = [3, 5].
You could write filter_list/2 without using findall/3 like:
filter_list(L,OutList):- filter_list(L,OutList,L).
filter_list([],[],_).
filter_list([H|T],[H|T1],L):-count(H,L,N), N=:=1, filter_list(T,T1,L).
filter_list([H|T],T1,L):-count(H,L,N), N > 1, filter_list(T,T1,L).

Prolog: efficiency

Is there a way in prolog to make the following shorter:
rule(prop, [1/2,2/2]).
rule(prop, [1/3,2/3,3/3]).
rule(prop, [1/4,2/4,3/4,4/4]).
rule(prop, [1/5,2/5,3/5,4/5,5/5]).
rule(prop, [1/6,2/6,3/6,4/6,5/6,6/6]).
rule(prop, [1/7,2/7,3/7,4/7,5/7,6/7,7/7]).
TL;DR: Why not delegate the responsibility for handling recursion—and getting it right, too?
This answer follows up on this previous answer by #lurker. We do not cover the entire question, but instead focus on showing how a predicate like list_props/3 can be defined so that all recursion is delegated to the tried and true Prolog predicates
length/2, numlist/2 and maplist/3:
:- use_module(library(between), [numlist/2]).
:- use_module(library(lists), [maplist/3]).
To customize the versatile meta-predicate maplist/3 we define:
denom_num_expr(B, A, A/B).
Sample query using sicstus-prolog 4.3.2:
| ?- length(_Ds, N), numlist(N, _Ds), maplist(denom_num_expr(N), _Ds, Qs).
N = 1, Qs = [1/1] ? ;
N = 2, Qs = [1/2,2/2] ? ;
N = 3, Qs = [1/3,2/3,3/3] ? ;
N = 4, Qs = [1/4,2/4,3/4,4/4] ? ;
N = 5, Qs = [1/5,2/5,3/5,4/5,5/5] ? ;
N = 6, Qs = [1/6,2/6,3/6,4/6,5/6,6/6] ? ;
N = 7, Qs = [1/7,2/7,3/7,4/7,5/7,6/7,7/7] ? ;
N = 8, Qs = [1/8,2/8,3/8,4/8,5/8,6/8,7/8,8/8] ? ;
N = 9, Qs = [1/9,2/9,3/9,4/9,5/9,6/9,7/9,8/9,9/9] ? ...
The following code isn't necessarily "shorter" for the case of 6 different rules, but it is more scalable, which is probably what you really mean.
You can break this down as follows. First, a rule that generates one list:
list_props(N, N, [N/N]).
list_props(X, N, [X/N|T]) :-
X >= 1,
X < N,
X1 is X + 1,
list_props(X1, N, T).
When you call this, it generates one list of proportions from the first argument to the last with the last argument being the denominator. For example:
| ?- list_props(1, 4, L).
L = [1/4,2/4,3/4,4/4] ? a
| ?-
Note that you could enforce that N be an integer >= 1 using integer(N) and conditions, but I was being brief and didn't do that in the above.
You can use this in your top level predicate:
rule(prop, L) :-
between(2, 7, X),
list_props(1, X, L).
Which yields:
| ?- rule(prop, L).
L = [1/2,2/2] ? ;
L = [1/3,2/3,3/3] ? ;
L = [1/4,2/4,3/4,4/4] ? ;
L = [1/5,2/5,3/5,4/5,5/5] ? ;
L = [1/6,2/6,3/6,4/6,5/6,6/6] ? ;
L = [1/7,2/7,3/7,4/7,5/7,6/7,7/7] ? ;
(2 ms) no
| ?-

Prolog - How to find the maximum set of elements that their sum is equal to N

my game is about picking the max set of elements from a given list that their sum is N
example : L=[1,1,2,2,3,2,4,5,6], N = 6 , Sub List would be equal to [1,1,2,2]
I need a hint using constraint logic programming.
There is a library for Constrained Logic Programming in SWI-Prolog. It's called clpfd.
:-use_module(library(clpfd)).
Let's say that you'll have a variable for the length of the subsequence. Its domain goes from zero (corresponding to the empty subsequence) to the length of the list. In order to get the longest sequence first, values should be tried starting with the highest.
...
length(List, M),
L in 0..M,
labeling([max(L)],[L]),
...
Next, L can be used to build a list of L variables that would correspond to indices of elements from List. As these indices must be in ascending order, chain/2 can be used to create #</2 constraints between any two consecutive indices.
...
length(Indices, L),
Indices ins 1..M,
chain(Indices, #<),
...
Using these indices, a list with elements from List can be constructed. nth1/3 is useful here, but with a minor trick.
...
nth1a(List, N, E):-
nth1(N, List, E).
...
maplist(nth1a(List), Indices, SubSequence),
...
And the sum of that list must be N:
...
sum(SubSequence, #=, N)
...
As only the longest sequence is needed, once/1 can be used to stop after first solution is found.
Some example queries:
?- longest_subsequence([1,1,4,4,6], 9, S).
S = [1, 4, 4].
?- longest_subsequence([1,1,4,4,6], 11, S).
S = [1, 4, 6].
?- longest_subsequence([1,1,4,4,6], 21, S).
false.
As I am not sure if that's a homework or not, I won't post the full code here.
In this answer we use clpfd and a little lambda:
:- use_module([library(clpfd),
library(lambda)]).
Based on meta-predicate maplist/4 and the constraints (ins)/2 and sum/3 we define:
zs_selection_len_sum(Zs, Bs, L, S) :-
same_length(Zs, Bs),
Bs ins 0..1,
maplist(\Z^B^X^(X #= Z*B), Zs, Bs, Xs),
sum(Bs, #=, L),
sum(Xs, #=, S).
Sample queries using labeling/2 with option max/1:
?- zs_selection_len_sum([1,1,4,4,6],Bs,L,8), labeling([max(L)],Bs).
Bs = [1,1,0,0,1], L = 3
; Bs = [0,0,1,1,0], L = 2
; false.
?- zs_selection_len_sum([1,1,3,4,5],Bs,L,7), labeling([max(L)],Bs).
Bs = [1,1,0,0,1], L = 3
; Bs = [0,0,1,1,0], L = 2
; false.
?- zs_selection_len_sum([1,1,2,2,3,2,4,5,6],Bs,L,6), labeling([max(L)],Bs).
Bs = [1,1,0,1,0,1,0,0,0], L = 4
; Bs = [1,1,1,0,0,1,0,0,0], L = 4
; Bs = [1,1,1,1,0,0,0,0,0], L = 4
; Bs = [0,0,1,1,0,1,0,0,0], L = 3
; Bs = [0,1,0,0,1,1,0,0,0], L = 3
; Bs = [0,1,0,1,1,0,0,0,0], L = 3
; Bs = [0,1,1,0,1,0,0,0,0], L = 3
; Bs = [1,0,0,0,1,1,0,0,0], L = 3
; Bs = [1,0,0,1,1,0,0,0,0], L = 3
; Bs = [1,0,1,0,1,0,0,0,0], L = 3
; Bs = [1,1,0,0,0,0,1,0,0], L = 3
; Bs = [0,0,0,0,0,1,1,0,0], L = 2
; Bs = [0,0,0,1,0,0,1,0,0], L = 2
; Bs = [0,0,1,0,0,0,1,0,0], L = 2
; Bs = [0,1,0,0,0,0,0,1,0], L = 2
; Bs = [1,0,0,0,0,0,0,1,0], L = 2
; Bs = [0,0,0,0,0,0,0,0,1], L = 1
; false.

creating lists, searching sth which has been given and making combination on prolog

I want to make a Prolog program.
Predicate will be like this:
name(name, failedCourse, age)
Database of the program is:
name(george, math, 20).
name(steve, phys, 21).
name(jane, chem, 22).
I want to implement the predicate nameList(A, B). A means list of names, B means number of names on the list. For example:
nameList([george, steve],2). returns true
nameList([george, steve],X). returns X=2
nameList(X,2). returns X=[george, steve]; X=[george, jane]; X=[steve, jane]
nameList([martin],1). returns false (because martin is not included database.)
I wanted to make a list that includes all names on the database. For that reason I made a findall.
descend(X,Y,A) :- name(X,Y,A).
descend(X,Y,A) :- name(X,Z,A),descend(Z,Y,A).
findall(director(X),descend(Y,X),Z).
?- findall(B,descend(B,X,Y),A). returns A = [george, steve, jane].
But I could not figure it out to use list A in predicates :( I cannot search the list for A in the nameList.
If you help me, I will be very grateful.
The main thing you need is a predicate that calculates combinations of a given length and of a given list:
comb(0, _, []).
comb(N, [X | T], [X | Comb]) :-
N > 0,
N1 is N - 1,
comb(N1, T, Comb).
comb(N, [_ | T], Comb) :-
N > 0,
comb(N, T, Comb).
Usage:
?- comb(2, [a, b, a], Comb).
Comb = [a, b] ;
Comb = [a, a] ;
Comb = [b, a] ;
false.
(See more here.)
Now you can just apply this predicate on your data:
name(george, math, 20).
name(steve, phys, 21).
name(jane, chem, 22).
name_list(L, N) :-
findall(X, name(X, _, _), Xs),
length(Xs, Len),
between(0, Len, N),
comb(N, Xs, L).
Usage examples:
?- name_list(L, N).
L = [],
N = 0 ;
L = [george],
N = 1 ;
L = [steve],
N = 1 ;
L = [jane],
N = 1 ;
L = [george, steve],
N = 2 ;
L = [george, jane],
N = 2 ;
L = [steve, jane],
N = 2 ;
L = [george, steve, jane],
N = 3 ;
false.
?- name_list([george, steve], N).
N = 2 ;
false.
?- name_list(L, 2).
L = [george, steve] ;
L = [george, jane] ;
L = [steve, jane] ;
false.
name(george, math, 20).
name(steve, phys, 21).
name(jane, chem, 22).
name_list(Name_List,N) :-
integer(N),
findall(Name,name(Name,_,_),L),
combination(L,N,Name_List).
name_list(Name_List,N) :-
var(N),
findall(Name,name(Name,_,_),L),
length(L,Len),
for(1,N,Len),
combination(L,N,Name_List).
combination(X,1,[A]) :-
member(A,X).
combination([A|Y],N,[A|X]) :-
N > 1,
M is N - 1,
combination(Y,M,X).
combination([_|Y],N,A) :-
N > 1,
combination(Y,N,A).

Resources