Related
count_element(Element, List, Result) :-
count_element(Element, List, 0, Result). % here I start the real rule with counter initialized to 0
count_element(Element, [], Counter, Counter). % if it arrives to the end of the list so there isn't any other element, Result is Counter.
count_element(Element, [Head | Rest], Counter, Result) :- % if Head is Element, Counter increments
Head =:= Element,
NewCounter is Counter+1.
count_element(Element, Rest, NewCounter, Result). % start recurively the function with the list without the head
count_element(Element, [Head | Rest], Counter, Result) :- % if head is not the element, simply start recursively maintaining the counter
Head \= Element,
count_element(Element, Rest, Counter, Result).
I get this:
?- count_element(3,[1,2,3,3],R).
true ;
true ;
true ;
true ;
false.
but no Result of how many occurences of that certain Element...
other interesting results:
?- count_element(3,[3],R).
true ;
true ;
false.
?- count_element(3,[1],R).
true ;
R = 0 ;
true ;
false.
?- count_element(3,[],R).
R = 0 ;
true ;
false.
You have a lot of singletons. That's a code smell that you're doing something
not quite right.
Also, this evaluates the left-hand side and the right-hand side as arithmetic expressions and compares the results:
Head =:= Element
whilst this tests whether or not the left-hand side can be unified with the right-hand side.
The one is not the converse of the other.
Prolog has multiple flavours of "equality".
What you probably want are ==/2 and \==/2 which compare to terms for equivalency, but variables are only equal to themselves. No unification is done (e.g., the variable A is only equivalent to itself, it's not equivalant to the variables _, B, or C, and its not equivalent to a atom, term or number).
Rewriting your example (with slightly shorter variable names), we get:
count_element( E, Ls, R ) :- count_element( E, Ls, 0, R ) .
count_element( _ , [] , C , C ) .
count_element( E , [H|T] , C , R ) :- H == E, C1 is C+1, count_element(E,T,C1,R) .
count_element( E , [H|T] , C , R ) :- H \== E, count_element(E,T,C,R) .
We can simplify this by introducing a cut (!/0), to eliminate the choice point at H == E (the two items, having been found equivalent, are not going to magically become non-equivalent on backtracking).
That gives us this:
count_element( E, Ls, R ) :- count_element( E, Ls, 0, R ) .
count_element( _ , [] , C , C ) .
count_element( E , [H|T] , C , R ) :- H == E, !, C1 is C+1, count_element(E,T,C1,R) .
count_element( E , [H|T] , C , R ) :- count_element(E,T,C,R) .
Alternatively, you could use a soft cut (Condition -> Then ; Else ).
That gives us:
count_element( E, Ls, R ) :- count_element( E, Ls, 0, R ) .
count_element( _ , [] , C , C ) .
count_element( E , [H|T] , C , R ) :-
( H == E -> C1 is C+1, C1 = C ),
count_element(E,T,C1,R)
.
Suppose I have a list of "base atoms" and a longer atom made up only of those base atoms. repeats are allowed. I whipped up the following code to generate lists of all the atoms which could possibly make up the longer atom. This code seems to work with the exception that it finds many repeats of the same (correct) solutions and I am not sure why?
basics([a, abc, def, aaa]).
candidate(aaaabcaaadef).
join_atoms(Atoms, Atom):- join_atoms( Atoms, '', Atom ) .
join_atoms( [], Atom, Atom ) .
join_atoms( [H|T], AtomAccum, Atom ) :-
atom_concat( AtomAccum, H, UpdatedAtom) ,
join_atoms( T, UpdatedAtom, Atom ) .
split_atoms( C, Atoms ):- split_atoms( C, [], Atoms ) .
split_atoms( '', AtomsAccum, Atoms ) :-
candidate(C) ,
reverse( AtomsAccum, AtomsAccumR ) ,
join_atoms( AtomsAccumR, C ) ,
Atoms = AtomsAccumR .
split_atoms(C, AtomsAccum, Atoms):-
basics( B ) ,
member( SubAtom, B ) ,
sub_atom( C, _, Length, _, SubAtom ) ,
sub_atom( C, Length, _, 0, AtomRest ) ,
split_atoms(AtomRest, [SubAtom|AtomsAccum], Atoms).
main:-
candidate( C ) ,
findall( Atoms, split_atoms(C, Atoms), AllAtoms ) ,
sort( AllAtoms, UniqueAtoms ) ,
write(UniqueAtoms),
nl .
The findall/3 and sort/2 will get all solutions and remove the duplicates, of course. But without those the correct solutions are repeated multiple times.
For example (output truncated)
| ?- split_atoms(aaaabcaaadef, Atoms).
Atoms = [a,a,a,abc,a,a,a,def] ? a
Atoms = [a,a,a,abc,a,a,a,def]
Atoms = [a,a,a,abc,a,a,a,def]
Atoms = [a,a,a,abc,a,a,a,def]
Atoms = [a,a,a,abc,a,a,a,def]
Atoms = [a,a,a,abc,a,a,a,def]
Atoms = [a,a,a,abc,aaa,def]
Atoms = [a,a,a,abc,a,a,a,def]
Atoms = [a,a,a,abc,a,a,a,def]
.
.
.
Can anyone suggest why this is happening? Presumably it is backtracking more than necessary for some reason? Or perhaps my code is unintentionally creating a situation which can be minimized?
I think you are over-thinking the problem here.
To paraphrase your problem statement:
I want find all the different, distinct ways a given symbol can be composed from an alphabet of shorter symbols.
To solve that requires a couple of observations:
The longer symbol must have as a prefix one of the shorter symbols contained in the alphabet
The above recursively holds true if you strip such a prefix off the longer symbol
That leads to this simple solution: https://swish.swi-prolog.org/p/tLTQiVNQ.pl
[sub_atom/5 is an ISO-standard built-in predicate that lets you disassemble atoms by offset and length]
% --------------------------------------
% compose( Atom, Subatoms, Composition )
% --------------------------------------
compose( '' , _ , [] ) . % the empty set composes the empty atom
compose( Atom , Subatoms , [A|As] ) :- % otherwise...
member(A,Subatoms) , % - fish a symbol out of our alphabet
sub_atom(Atom,0,L,P,A) , % - see if its a prefix of our candidate
sub_atom(Atom,L,P,_,Nextatom) , % - get the next atom (the suffix)
compose(Nextatom, Subatoms,As) % - and recurse down
. % Easy!
Given your sample data:
?- compose( aaaabcaaadef, [a,abc,def,aaa], Xs).
The following results are produced on backtracking:
Xs = [a, a, a, abc, a, a, a, def]
Xs = [a, a, a, abc, aaa, def]
Xs = [aaa, abc, a, a, a, def]
Xs = [aaa, abc, aaa, def]
false
Why are so many correct solutions found?
Not so fast! Let's start with a related question:
Why are so many incorrect solutions almost found?
To answer that question, let me modify your program by negating one single goal:
split_atoms( '', AtomsAccum, Atoms ) :-
candidate(C) ,
reverse( AtomsAccum, AtomsAccumR ) ,
\+ join_atoms( AtomsAccumR, C ) , % <=== negated
Atoms = AtomsAccumR .
split_atoms(C, AtomsAccum, Atoms):-
basics( B ) ,
member( SubAtom, B ) ,
sub_atom( C, _, Length, _, SubAtom ) ,
sub_atom( C, Length, _, 0, AtomRest ) ,
split_atoms(AtomRest, [SubAtom|AtomsAccum], Atoms).
?- split_atoms(aaaabcaaadef, Atoms).
Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,def,def]
; Atoms = [a,a,a,a,a,a,aaa,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,a,a,a,def]
; Atoms = [a,a,a,a,a,a,def,def]
; ... .
So now, we are looking at near-solutions that your program will have to consider and only filter out in the very last moment. That does not look very right, does it? So your program considers much too many candidates only to weed them out anyway.
What you need is some specialization of your program. Often (as in this case) it suffices to add some further goals:
... .
split_atoms(C, AtomsAccum, Atoms):-
basics( B ) ,
member( SubAtom, B ) ,
Before = 0, % specialization
sub_atom( C, Before, Length, _, SubAtom ) ,
sub_atom( C, Length, _, 0, AtomRest ) ,
split_atoms(AtomRest, [SubAtom|AtomsAccum], Atoms).
And now, there are no longer any near-solutions.
Even better you can replace this by:
... .
split_atoms(C, AtomsAccum, Atoms):-
basics( B ) ,
member( SubAtom, B ) ,
atom_concat(SubAtom, AtomRest, C),
split_atoms(AtomRest, [SubAtom|AtomsAccum], Atoms).
And even more so, you can remove basics/1 and candidate/1 as has been suggested by #NicholasCarey.
An alternative solution using DCG:
split_atom(Atom, Atoms) :-
atom_chars(Atom, Chars),
phrase(list_of_atoms(Atoms), Chars).
list_of_atoms([A|As]) --> basic_atom(A), list_of_atoms(As).
list_of_atoms([]) --> \+ [_].
basic_atom(a) --> [a].
basic_atom(aaa) --> [a,a,a].
basic_atom(abc) --> [a,b,c].
basic_atom(def) --> [d,e,f].
Example:
?- time(forall(split_atom(aaaabcaaadef, Atoms), writeln(Atoms))).
[a,a,a,abc,a,a,a,def]
[a,a,a,abc,aaa,def]
[aaa,abc,a,a,a,def]
[aaa,abc,aaa,def]
% 60 inferences, 0.000 CPU in 0.016 seconds (0% CPU, Infinite Lips)
true.
I'm trying to learn Prolog, I'm having trouble defining the predicate:
In Prolog define a predicate substitute (L1, X, L2) which every second element of the list L1 (starting from the second element) replaces with element X.
Examples:
L1 = [a, b, c], X = 1, L2 = [a, 1, c]
L1 = [a, b, c, d], X = a, L2 = [a, a, c, a]
I tried this way:
replace( [], _, [] ) :- ! .
replace( [X|Xs], T, [Z1,Z2|Zs] ):-
Z1 = X ,
Z2 = T ,
replace(Xs,T,Zs).
But it adds items to the second list, not replaces them.
Thank you in advance for your help.
Your problem is that you are pulling items off the list 1 at a time. To replace every other item, you can do it a couple of ways:
Pull items off 2 at a time
Try this to replace the even number list elements (where the 1st element in the list is item number 1.
You have the special case of the empty list:
replace( [] , _ , [] ) .
And the special case of a list of length 1:
replace( [X] , _ , [X] ) .
And then the general case (lists of length > 1):
replace( [X,_|Xs] , R , [X,R|Ys] ) :- replace(Xs, R, Ys).
Putting it all together, we get:
replace( [] , _ , [] ) .
replace( [X] , _ , [X] ) .
replace( [X,_|Xs] , R , [X,R|Ys] ) :- replace(Xs, R, Ys).
Track State As You Go
This isn't much more difficult. And it opens the possibility of
making things more general. To do this we use a helper
predicate. Ultimately, it's not a lot different.
First, our replace/3 is just a wrapper around invoking the
helper predicate, to which we pass two additional bits of state:
the current index value (1), and
the modulus we'll use to determine which elements get replaced
replace( Xs, R, Ys ) :- replace(Xs, R, 1, 2, Ys).
Here's the helper predicated replace/5:
replace( [] , _ , _ , _ , [] ) .
replace( [X|Xs] , R , N , M , [Y|Ys] ) :-
try_swap(X,R,N,M,Y),
N1 is N+1,
replace(Xs, R, N1, M, Ys ).
try_swap( _ , R , N , M , R ) :- 0 is N mod M, !.
try_swap( X , _ , _ , _ , X ) .
And putting it all together:
replace( Xs, R, Ys ) :- replace(Xs, R, 1, 2, Ys).
replace( [] , _ , _ , _ , [] ) .
replace( [X|Xs] , R , N , M , [Y|Ys] ) :-
try_swap(X,R,N,M,Y),
N1 is N+1,
replace(Xs, R, N1, M, Ys ).
try_swap( _ , R , N , M , R ) :- 0 is N mod M, !.
try_swap( X , _ , _ , _ , X ) .
You can write it as two functions that call themselves recursively in turn.
One replacing elements at odd positions, the other replacing elements at even positions:
replace_even([], _, [] ).
replace_even([H|T], R, [H|O]) :-
replace_odd(T, R, O).
replace_odd([], _, []).
replace_odd([_|T], R, [R|O]) :-
replace_even(T, R, O).
Write a recursive Prolog predicate of three arguments, called common, which returns the number of elements that belong to both lists.
For example:
?- common ( [a, b, c, k, h], [b,c,d,e], N).
N=2.
?- common ( [b, a, c, d], [a, b, c, d, e] , N).
N=4.
Preserve logical-purity!
:- use_module(library(clpfd)).
First, we define meta-predicate tcountd/3 in order to discount duplicate list items. tcount/3 is similar to tcount/3, but uses tfilter/3 and dif/3 for excluding duplicates:
:- meta_predicate tcountd(2,?,?).
tcountd(P_2,List,Count) :-
list_tcountd_pred(List,Count,P_2).
:- meta_predicate list_tcountd_pred(?,?,2).
list_tcountd_pred([] ,0, _ ).
list_tcountd_pred([X|Xs0],N,P_2) :-
if_(call(P_2,X), (N #= N0+1, N0 #>= 0), N = N0),
tfilter(dif(X),Xs0,Xs),
list_tcountd_pred(Xs,N0,P_2).
We define common/3 based upon meta-predicate tcountd/3, Prolog lambdas, and memberd_t/3:
common(Xs,Ys,N) :-
tcountd(Ys+\X^memberd_t(X,Ys),Xs,N).
Let's run the sample queries the OP gave:
?- common([a,b,c,k,h],[b,c,d,e],N).
N = 2.
?- common([b,a,c,d],[a,b,c,d,e],N).
N = 4.
As common/3 is monotone, we get sound answers with non-ground queries, too! Consider:
?- common([A,B],[X,Y],N).
N = 1, A=B , B=X
; N = 2, A=X , B=Y , dif(X,Y)
; N = 1, A=X , dif(B,X), dif(B,Y)
; N = 1, A=B , B=Y , dif(X,Y)
; N = 2, A=Y , B=X , dif(X,Y)
; N = 1, A=Y , dif(B,X), dif(B,Y), dif(X,Y)
; N = 0, A=B , dif(B,X), dif(B,Y)
; N = 1, dif(A,X), dif(A,Y), B=X
; N = 1, dif(A,X), dif(A,Y), B=Y , dif(X,Y)
; N = 0, dif(A,B), dif(A,X), dif(A,Y), dif(B,X), dif(B,Y).
Trivially to do using intersection/3 built-in:
common(A, B, N) :-
intersection(A, B, C),
length(C, N).
Test run:
?- common([a, b, c, k, h], [b,c,d,e], N).
N = 2.
?- common([b, a, c, d], [a, b, c, d, e], N).
N = 4.
Notice that there is no space between "common" and "(" in the queries. This is important. Queries as you stated in the question (with space between "common" and "(") will give syntax error.
This is one way, assuming you want to ensure that the result is a set (unique items) rather than a bag (allows duplicate items) :
set_intersection( Xs, Ys, Zs ) :- % to compute the set intersection,
sort(Xs,X1) , % - sort the 1st set, removing duplicates (so that it's a *set* rather than a *bag* ) ,
sort(Ys,Y1) , % - sort the 2nd set, removing duplicates (so that it's a *set* rather than a *bag* ) ,
common( Xs , Ys , Zs ) % - merge the two now-ordered sets, keeping only the common items
.
common( Xs , Ys , [] ) :-
( Xs=[] ; Ys=[] ) ,
! .
common( [X|Xs] , [X|Ys] , [X|Zs] ) :-
common( Xs , Ys , Zs ) .
Another, simpler way:
set_intersection( Xs , Ys , Zs ) :-
set_of(Z,(member(Z,Xs),member(Z,Ys)),Zs)
.
Another way:
set_intersection( Xs , Ys , Zs ) :- % compute the set intersection by
set_intersectin( Xs , Ys , [] , Zs ) . % invoking the worker predicate
set_intersection( [] , _ , Zs , Zs ) . % when we run out of Xs, we're done.
set_intersection( [X|Xs] , Ys , Ts , Zs ) :- % otherwise,
member(X,Ys) , % if X is a member of Ys,
\+ member(X,Ts) , % and we don't yet have an X,
set_intersection( Xs , Ys , [X|Ts] , Zs ) % add X to the accumulator and recurse down
. %
How can I remove ! from this rule for it to work properly ?
extractvowels([],[]).
extractvowels([H|T],R):-consonant(H),extractvowels(S,R),!.
extractvowels([H|T],[H|R]):-extractvowels(S,R),!.
consonant(H) contains all the consonants.
And how can I join this rule(distinct) within the extractvowels one ?
member(X, [X|_]).
member(X, [_|Tail]) :- member(X, Tail).
distinct([],[]).
distinct([H|T],C) :- member(H,T), distinct(T,C),!.
distinct([H|T],[H|C]) :- distinct(T,C).
I can't use any prolog predicate.
This doesn't address directly your question, already answered by Sergey, rather suggest a 'programming style' that attempt to avoid 'boilerplate' code, and - sometimes - cuts.
Consider this simple query - it's plain Prolog (apart the extended string notation, `hello world`, SWI-Prolog specific) , and can 'solve in a line':
?- S=`hello world`, findall(C, (member(C, S), C > 0'a, C =< 0'z, \+ memberchk(C, `eiou`)), Cs), format('~s~n', [Cs]).
hllwrld
S = [104, 101, 108, 108, 111, 32, 119, 111, 114|...],
Cs = [104, 108, 108, 119, 114, 108, 100].
What's interesting to note: see how member/2 inside findall/3 acts as a lambda expression and search space generator, allowing to name the variable - we can call it the 'local environment' - and then allowing what Prolog play best - clause solving.
General and easy, isn't it ?
This should work:
extractvowels([], []).
extractvowels([H|T], R) :- consonant(H), extractvowels(T, R).
extractvowels([H|T],[H|R]) :- \+ consonant(H), extractvowels(T, R).
I fixed your singleton variables 'S' - changed to 'T' (SWI-Prolog probably complained about this, and you should fix any singleton variables warnings).
You last extractvowels cut ('!') could be just removed - a cut at the end of the last clause does nothing.
To get rid of the first cut I added a "guard" rule \+ consonant(H) to the last extractvowels clause - proceed only if H is not a consonant.
Assuming that your definition of "vowel" is "that which is not a consonant" (there are lots of characters, most of which are neither vowels, nor consonants), and if by "extract vowels", you mean
remove all the vowels, leaving only the consonants
then something like this would work:
consonants_in( [] , [] ) .
consonants_in( [X|Xs] , [X|R] ) :- consonant(X) , consonants_in(Xs,R) .
consonants_in( [X|Xs] , R ) :- \+ consonant(X) , consonants_in(Xs,R) .
You could also say something like:
consonants_in( [] , [] ) .
consonants_in( [X|Xs] , R ) :-
( consonant(X) -> R = [X|R1] ; R = R1 ) ,
consonants_in( Xs , R1 )
.
If on the other hand, if by "extract vowels" , you mean
remove all the consonants, leaving only the vowels
then you want the inverse, something like
vowels_in( [] , [] ) .
vowels_in( [X|Xs] , [X|R] ) :- \+ consonant(X) , vowels_in(Xs,R) .
vowels_in( [X|Xs] , R ) :- consonant(X) , vowels_in(Xs,R) .
or
vowels_in( [] , [] ) .
vowels_in( [X|Xs] , R ) :-
( consonant(X) -> R = R1 ; R = [X|R1] ) ,
vowels_in( Xs , R1 )
.
You could make things more declarative by making your definition of "vowel" explicit:
vowel(C) :- \+ consonant(C) .
and change your predicates accordingly:
vowels_in( [] , [] ) .
vowels_in( [X|Xs] , [X|R] ) :- vowel(X) , vowels_in(Xs,R) .
vowels_in( [X|Xs] , R ) :- \+ vowel(X) , vowels_in(Xs,R) .
or
vowels_in( [] , [] ) .
vowels_in( [X|Xs] , R ) :-
( vowel(X) -> R = [X|R1] ; R = R1 ) ,
vowels_in( Xs , R1 )
.
The advantage of this is that you could modify you definition of "vowel" later to be more correct,
vowel(a).
vowel(e).
vowel(i).
vowel(o).
vowel(u).
without affecting the rest or your code: