Related
The given database:
age(ann, 20).
age(joe, 44).
age(bob, 40).
age(min, 27).
age(cai, 20).
age(ned, 27).
age(deb, 36).
age(pat, 36).
age(edo, 24).
age(tod, 56).
What I have so far:
hundred(L) :-
findall(X, age(X,_), L1),
sum(L1,100,L),
length(L,Len),
Len > 1.
sum(_, 0, []).
sum(L, S, [H|T]) :-
select(H, L, L1),
age(H, A),
S1 is S-A,
S1 >= 0,
sum(L1, S1, T).
I'd like to get the unique sets of persons (of length > 1) in the database whose ages add up to 100. My solution yields all possible permutations whereas I'd like to get the unique sets of persons as below (the listing order in the output example is irrelevant):
L=[joe,tod];
L=[ann,joe,deb];
L=[ann,joe,pat];
L=[ann, edo, tod];
L=[ann, cai, deb, edo];
L=[ann, cai, edo, pat];
L=[cai, edo, tod];
L=[joe, cai, deb];
L=[joe, cai, pat];
L=[bob, deb, edo];
L=[bob, pat, edo];
For clarity: people may have the same age, and that's fine. So the number combinations themselves may include duplicates to get to 100, as long as those ages belong to different persons.
In the end, each solution should be a combination of different persons but should not be a mere permutation of a previous solution.
My solution always takes combinations of different persons, but lists every change in the order as a new solution.
I've tried to get rid of the permutations by putting all solutions in a list of lists and then sorting it to remove duplicates, but it didn't work.
For the numbers, can use generic predicates:
sub_list_sum(Sum, Lst, Sub) :-
compare(C, Sum, 0),
sub_list_sum_(C, Sum, Lst, Sub).
sub_list_sum_(=, 0, _, []).
sub_list_sum_(>, Sum, Lst, [E|Sub]) :-
select_forward(E, Lst, Lst0),
Sum0 is Sum - E,
compare(C, Sum0, 0),
sub_list_sum_(C, Sum0, Lst0, Sub).
% A subsequence variant of select/3
select_forward(E, [H|T], F) :-
select_forward_(T, H, E, F).
select_forward_(T, H, H, T).
select_forward_([H|T], _, E, F) :-
select_forward_(T, H, E, F).
Result in swi-prolog:
?- Dupes = [20, 44, 40, 27, 20, 27, 36, 36, 24, 56],
sort(Dupes, Sorted), sub_list_sum(100, Sorted, S).
S = [20, 24, 56] ;
S = [20, 36, 44] ;
S = [24, 36, 40] ;
S = [44, 56] ;
false.
Customising this for the ages:
age(ann, 20).
age(joe, 44).
age(bob, 40).
age(min, 27).
age(cai, 20).
age(ned, 27).
age(deb, 36).
age(pat, 36).
age(edo, 24).
age(tod, 56).
sub_list_age_sum(Sum, Sub) :-
% Want at least length 2
Sub = [_,_|_],
bagof(age(P, A), age(P, A), Ages),
compare(C, Sum, 0),
sub_list_age_sum_(C, Sum, Ages, Sub).
sub_list_age_sum_(=, 0, _, []).
sub_list_age_sum_(>, Sum, Lst, [P|Sub]) :-
select_forward(age(P, A), Lst, Lst0),
Sum0 is Sum - A,
compare(C, Sum0, 0),
sub_list_age_sum_(C, Sum0, Lst0, Sub).
... and add select_forward code as above - result:
?- sub_list_age_sum(100, L).
L = [ann, joe, deb] ;
L = [ann, joe, pat] ;
L = [ann, cai, deb, edo] ;
L = [ann, cai, pat, edo] ;
L = [ann, edo, tod] ;
L = [joe, cai, deb] ;
L = [joe, cai, pat] ;
L = [joe, tod] ;
L = [bob, deb, edo] ;
L = [bob, pat, edo] ;
L = [cai, edo, tod] ;
false.
Turns out that my initial idea actually works. The only thing needed is to sort each valid group before adding it to the list of lists, so that setof/3 can then recognize the permutations as duplicates and remove them, thus producing a list with unique groups.
Final solution:
hundred(G):-
findall(age(N,A),age(N,A),Ps),
setof(Sorted,
Ns^(sum(100,Ps,Ns),sort(Ns,Sorted)),
Groups),
member(G,Groups), G=[_,_|_].
sum(0,_,[]).
sum(Sum,Ps,[N|Ns]):-
select(age(N,A),Ps,Rem),
NewSum is Sum-A, NewSum >= 0,
sum(NewSum,Rem,Ns).
I am stuck with the following Prolog code:
islist([]).
islist([A|B]) :-
islist(B).
memb([X|_]).
memb([Y|Z]) :-
islist(Y),
memb(Y).
memb([_|Z]) :-
memb(Z).
deep([],[]).
deep([H|P],[M|N]) :-
islist(H),
deep(H,M),
deep(P,N).
deep([Y|P],[Y|N]) :-
number(Y),
deep(P,N).
deep([H|P],[M|N]) :-
atom(H),
M is 0,
deep(P,N).
deep([Y|P],[H|Q]) :-
not(number(Y)),
not(islist(Y)),
not(atom(Y)),
Y =.. T,
deep(T,F),
H =.. F,
deep(P,Q),
!.
It is giving me fail when I am trying to run it.
I am not able to do this. Please help. I am not understanding where am I wrong...
The first problem is that you're misusing univ/2 (that is (=..)/2). Changing the last clause to
deep([Y|P],[H|Q]):-
not(number(Y)),
not(islist(Y)),
not(atom(Y)),
Y=..[T|YArgs],
deep(YArgs,HArgs),
H=..[T|HArgs],
deep(P,Q),!.
you'll get the required behaviour
?- deep([14,dog,a(b,27,c(16,[g]))],A).
A = [14, 0, a(0, 27, c(16, [0]))]
Note that a cut as last goal of last clause has no effect. It's totally useless, but it's usage is indicative that you need to study a bit more about Prolog execution mode.
When I simply took your program, loaded it, ignored the singleton warnings, and traced it, I eventually get:
Call: (14) _G2807=..[0, 16, [0]] ? creep
ERROR: =../2: Type error: `atom' expected, found `0' (an integer)
Exception: (14) _G2807=..[0, 16, [0]] ?
So, every time you get a functor, you first decompose it, like this:
foo(1, bar) ---> [foo, 1, bar] % in your code: Y=..T
You then replace the atoms with 0's:
[foo, 1, bar] ---> [0, 1, 0] % in your code: deep(T,F)
and then you for some reason try to make a functor again out of it:
[0, 1, 0] ---> 0(1, 0) % in your code: H=..F
Which of course doesn't work, and it is not what you are after, it seems:
foo(1, bar) ---> foo, [1, bar] % Y =.. [Name|Args]
Then, you can convert the list only:
[1, bar] ---> [1, 0] % deep(Args, Args1)
and re-make the term:
foo, [1, 0] ---> foo(1, 0) % H =.. [Name|Args1]
With these corrections in the program:
?- deep([14,dog,a(b,27,c(16,[g]))],A).
A = [14, 0, a(0, 27, c(16, [0]))] ;
false.
But you can altogether make the program a bit simpler. First, I don't think you need the memb/1 you have defined: get rid of it. Then, you can also use another clause in that definition:
islist(X) :-
var(X), !,
fail.
islist([]).
islist([_|T]) :-
islist(T).
One way to clean up the rest of your code a bit would be to write:
deep([], []).
deep([X|Xs], [Y|Ys]) :-
once( deep_1(X, Y) ),
deep(Xs, Ys).
deep_1(X, Y) :- islist(X), deep(X, Y).
deep_1(X, X) :- number(X).
deep_1(X, 0) :- atom(X).
deep_1(X, Y) :- compound(X),
X =.. [Name|Args],
deep(Args, Args1),
Y =.. [Name|Args1].
As you see, at the moment, if you have a variable (or any other non-recognized term), the program will fail:
?- deep([14,dog,a(b,27,c(16,[g]))],A).
A = [14, 0, a(0, 27, c(16, [0]))].
?- deep([14,Dog,a(b,27,c(16,[g]))],A).
false.
You can easily expand the program by simply adding types:
deep_1(X, X) :- string(X).
And then:
?- deep([14,"Dog",a(b,27,c(16,[g]))],A).
A = [14, "Dog", a(0, 27, c(16, [0]))].
?- deep([14,Dog,a(b,27,c(16,[g]))],A).
false.
?- deep([14,dog,a(b,27,c(16,[g]))],A).
A = [14, 0, a(0, 27, c(16, [0]))].
Say you have the following predicate:
random_int(X/Y):-
random(1,100,X),
random(1,100,Y),
X\=Y.
How can I populate a list of size n using the result of this predicate?
I tried the following code but it only populates the list if random_int(X) is true at the first attempt, i.e. it does not backtrack to try other combinations of X and Y.
findall(X,(between(1,N,_), random_int(X)),L).
I find this small 'application' of clpfd interesting:
?- N=10,M=12, repeat, findall(X, (between(1,N,_),random(1,M,X)), L), clpfd:all_different(L).
N = 10,
M = 12,
L = [5, 4, 6, 7, 9, 11, 2, 3, 8|...]
.
note: M must be > N
I guess a simple way to do it is to make a list of 1:100, and draw 100 times from it a sample of size 2, without replacement. Since this is Prolog and not R, you can instead do:
:- use_module(library(lists)).
:- use_module(library(random)).
random_pairs(Pairs) :-
findall(X/Y,
( between(1, 100, _),
randseq(2, 100, [X,Y])
), R).
This is available in SWI-Prolog at least, but it is free software and the source to randseq/3 is available on the web site.
And since it's better to not use findall unless strictly necessary, it would probable better to write:
random_pairs(Pairs) :-
length(Pairs, 100),
maplist(randseq(2, 100), Pairs).
or, if the X/Y is important,
random_pairs(Pairs) :-
length(Pairs, 100),
maplist(rand_couple(100), Pairs).
rand_couple(N, X/Y) :-
randseq(2, N, [X,Y]).
TL;DR Use the available libraries
You could do it with findall/3:
random_list(N, L) :-
findall(X, (between(1,N,_), random(50,100,X)), L).
Another tidy way to do this would be:
random_list(N, L) :-
length(L, N),
maplist(random(50, 100), L).
Which results in:
| ?- random_list(5, L).
L = [69,89,89,95,59]
yes
| ?-
In general, if you have a predicate, p(X1,X2,...,Xn,Y), and a list you want to fill with result Y using successive calls to p/(n+1), you can use length(List, Length) to set the length of your list, and then maplist(p(X1,...,Xn), List) to populate the list. Or, using the findall/3, you can do findall(X, (between(1,N,_), p(X1,...,Xn,X)), L)..
EDIT based upon the updated conditions of the question that the generated list be unique values...
The random predicates are not generators, so they don't create new random numbers on backtracking (either unique or otherwise). So this solution, likewise, will generate one list which meets the requirements, and then just succeed without generating more such lists on backtracking:
% Generate a random number X between A and B which is not in L
rand_not_in(A, B, L, X) :-
random(A, B, X1),
( memberchk(X1, L)
-> rand_not_in(A, B, L, X)
; X = X1
).
% Generate a list L of length N consisting of unique random numbers
% between A and B
random_list(N, L) :-
random_list(N, 50, 100, [], L).
random_list(N, A, B, Acc, L) :-
N > 0,
rand_not_in(A, B, A, X),
N1 is N - 1,
random_list(N1, A, B, [X|A], L).
random_list(0, _, _, L, L).
Yet another approach, in SWI Prolog, you can use randseq, which will give a random sequence in a range 1 to N. Just scale it:
random_list(N, A, B, L) :-
A < B,
Count is B - A + 1,
randseq(N, Count, L1),
Offset is A - 1,
maplist(offset(Offset), L1, L).
offset(X, Offset, Y) :-
Y is X + Offset.
?- random_list(5, 50, 100, L).
L = [54, 91, 90, 78, 75].
?-
random_len([],0).
random_len([Q|T],N) :-
random(1,100,Q),
random_len(T,X),
N is X+1.
How do you get the product of a list from left to right?
For example:
?- product([1,2,3,4], P).
P = [1, 2, 6, 24] .
I think one way is to overload the functor and use 3 arguments:
product([H|T], Lst) :- product(T, H, Lst).
I'm not sure where to go from here.
You can use library(lambda) found here : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
Quite unreadable :
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
product(L, R) :-
foldl(\X^Y^Z^(Y = []
-> Z = [X, [X]]
; Y = [M, Lst],
T #= X * M,
append(Lst, [T], Lst1),
Z = [T, Lst1]),
L, [], [_, R]).
Thanks to #Mike_Hartl for his advice, the code is much simple :
product([], []).
product([H | T], R) :-
scanl(\X^Y^Z^( Z #= X * Y), T, H, R).
seems like a list copy, just multiplying by last element handled. Let's start from 1 for the leftmost element:
product(L, P) :-
product(L, 1, P).
product([X|Xs], A, [Y|Ys]) :-
Y is X * A,
product(Xs, Y, Ys).
product([], _, []).
if we use library(clpfd):
:- [library(clpfd)].
product([X|Xs], A, [Y|Ys]) :-
Y #= X * A,
product(Xs, Y, Ys).
product([], _, []).
it works (only for integers) 'backward'
?- product(L, [1,2,6,24]).
L = [1, 2, 3, 4].
Probably very dirty solution (I am new to Prolog):
product([ListHead|ListTail], Answer) :-
product_acc(ListTail, [ListHead], Answer).
product_acc([ListHead|ListTail], [AccHead|AccTail], Answer) :-
Product is ListHead * AccHead,
append([Product, AccHead], AccTail, TempList),
product_acc(ListTail, TempList, Answer).
product_acc([], ReversedList, Answer) :-
reverse(ReversedList, Answer).
So basically at the beginning we call another predicate which has
extra "variable" Acc which is accumulator list.
So we take out head (first number) from original list and put it in
to Accumulator list.
Then we always take head (first number) from original list and
multiply it with head (first number) from accumulator list.
Then we have to append our new number which we got by multiplying
with the head from accumulator and later with the tail
Then we call same predicate again until original list becomes empty
and at the end obviously we need to reverse it.
And it seems to work
?- product([1,2,3,4], L).
L = [1, 2, 6, 24].
?- product([5], L).
L = [5].
?- product([5,4,3], L).
L = [5, 20, 60].
Sorry if my explanation is not very clear. Feel free to comment.
Write a program that deletes vowels (String, NoVowelsString) that deletes all vowels from a given string.
So far I've got the condition vowel(X):- member(X,[a,e,i,o,u]). Then I thought of the one that deletes all the elements from the other list:
delete2([],L1,L1).
delete2([H|T],L1,L3) :-
delete2(H,L1,R2),
delete2(T,R2,L3).
So having these two I thought that I could put a condition to those elements being deleted that they have to be a member of [a,e,i,o,u]. Though I still haven't got anywhere.
The following is based on the reification of term equality/inequality.
First, we first define list_memberd_t/3, which behaves just like the memberd_truth/3 but has a different argument order:
list_memberd_t([] ,_,false).
list_memberd_t([Y|Ys],X,Truth) :-
if_(X=Y, Truth=true, list_memberd_t(Ys,X,Truth)).
list_memberd_truth(Xs,X,Truth) :- list_memberd_t(Xs,X,Truth).
For the sake of brevity, let's define memberd_t/3 based on list_memberd_t/3:
memberd_t(X,Xs,Truth) :- list_memberd_t(Xs,X,Truth).
As a parallel to library(apply), let's define tinclude/3:
:- meta_predicate tinclude(2,?,?).
tinclude(P_2,Xs,Zs) :-
list_tinclude_list(Xs,P_2,Zs).
list_tinclude_list([], _P_2,[]).
list_tinclude_list([E|Es],P_2,Fs0) :-
if_(call(P_2,E), Fs0 = [E|Fs], Fs0 = Fs),
list_tinclude_list(Es,P_2,Fs).
tfilter/3 is another name for tinclude/3:
tfilter(P_2,As,Bs) :-
tinclude(P_2,As,Bs).
Next, we define the meta-predicate texclude/3, the opposite of tinclude/3:
:- meta_predicate texclude(2,?,?).
texclude(P_2,Xs,Zs) :-
list_texclude_list(Xs,P_2,Zs).
list_texclude_list([],_,[]).
list_texclude_list([E|Es],P_2,Fs0) :-
if_(call(P_2,E), Fs0 = Fs, Fs0 = [E|Fs]),
list_texclude_list(Es,P_2,Fs).
Now let's use them together!
?- texclude(list_memberd_truth([a,e,i,o,u]),
[d,e,l,e,t,e,' ',v,o,w,e,l,s,' ',i,n,' ',a,' ',l,i,s,t], Filtered).
Filtered = [d, l, t, ' ',v, w, l,s,' ', n,' ', ' ',l, s,t].
Edit
As an alternative to using above texclude/3, let's use tinclude/3 with an auxiliary predicate not/3 to flip the truth value:
:- meta_predicate not(2,?,?).
not(P_2,X,Truth) :-
call(P_2,X,Truth0),
truth_flipped(Truth0,Truth).
truth_flipped(true,false).
truth_flipped(false,true).
Sample query:
?- tinclude(not(list_memberd_truth([a,e,i,o,u])),
[d,e,l,e,t,e,' ',v,o,w,e,l,s,' ',i,n,' ',a,' ',l,i,s,t], Filtered).
Filtered = [d, l, t, ' ',v, w, l,s,' ', n,' ', ' ',l, s,t].
here a solution using DCG. Note how the 'output' is obtained (no arguments passing, only difference lists)
novowels --> ("a";"e";"i";"o";"u"), !, novowels.
% or ..
% novowels --> [C], {memberchk(C, "aeiou")}, !, novowels.
novowels, [C] --> [C], !, novowels.
novowels --> [].
I must confess the second cut doesn't like me, but seems required.
test:
?- phrase(novowels, "abcdefghilmnopq", L),format('~s',[L]).
bcdfghlmnpq
L = [98, 99, 100, 102, 103, 104, 108, 109, 110|...].
edit About the second cut, it seems required by 'left hand' notation: if I code with argument, without cut, I get a correct parsing:
novowels(Cs) --> ("a";"e";"i";"o";"u"), !, novowels(Cs).
% novowels(Cs) --> [C], {memberchk(C, "aeiou")}, !, novowels(Cs).
novowels([C|Cs]) --> [C], novowels(Cs).
novowels([]) --> [].
test:
?- phrase(novowels(L), "abcdefghilmnopq"),format('~s',[L]).
bcdfghlmnpq
L = [98, 99, 100, 102, 103, 104, 108, 109, 110|...] ;
false.
I wonder if this is a bug of the DCG translator, or (more probably) my fault...
Here is the code
deleteV([H|T],R):-member(H,[a,e,i,o,u]),deleteV(T,R),!.
deleteV([H|T],[H|R]):-deleteV(T,R),!.
deleteV([],[]).
What it does?
First it question itself?It's the head a vowel
Yes->We ignore it.
No->We need it.
If it finds an empty list, it constructs the result list, and when returning from backtracking it appends the consonats in front.
This code was tested in SWIProlog.