Related
How would one implement a not_all_equal/1 predicate, which succeeds if the given list contains at least 2 different elements and fails otherwise?
Here is my attempt (a not very pure one):
not_all_equal(L) :-
( member(H1, L), member(H2, L), H1 \= H2 -> true
; list_to_set(L, S),
not_all_equal_(S)
).
not_all_equal_([H|T]) :-
( member(H1, T), dif(H, H1)
; not_all_equal_(T)
).
This however does not always have the best behaviour:
?- not_all_equal([A,B,C]), A = a, B = b.
A = a,
B = b ;
A = a,
B = b,
dif(a, C) ;
A = a,
B = b,
dif(b, C) ;
false.
In this example, only the first answer should come out, the two other ones are superfluous.
Here is a partial implementation using library(reif) for SICStus|SWI. It's certainly correct, as it produces an error when it is unable to proceed. But it lacks the generality we'd like to have.
not_all_equalp([A,B]) :-
dif(A,B).
not_all_equalp([A,B,C]) :-
if_(( dif(A,B) ; dif(A,C) ; dif(B,C) ), true, false ).
not_all_equalp([A,B,C,D]) :-
if_(( dif(A,B) ; dif(A,C) ; dif(A,D) ; dif(B,C) ; dif(B,D) ), true, false ).
not_all_equalp([_,_,_,_,_|_]) :-
throw(error(representation_error(reified_disjunction),'C\'est trop !')).
?- not_all_equalp(L).
L = [_A,_B], dif(_A,_B)
; L = [_A,_A,_B], dif(_A,_B)
; L = [_A,_B,_C], dif(_A,_B)
; L = [_A,_A,_A,_B], dif(_A,_B)
; L = [_A,_A,_B,_C], dif(_A,_B)
; L = [_A,_B,_C,_D], dif(_A,_B)
; error(representation_error(reified_disjunction),'C\'est trop !').
?- not_all_equalp([A,B,C]), A = a, B = b.
A = a, B = b
; false.
Edit: Now I realize that I do not need to add that many dif/2 goals at all! It suffices that one variable is different to the first one! No need for mutual exclusivity! I still feel a bit insecure to remove the dif(B,C) goals ...
not_all_equalp([A,B]) :-
dif(A,B).
not_all_equalp([A,B,C]) :-
if_(( dif(A,B) ; dif(A,C) ), true, false ).
not_all_equalp([A,B,C,D]) :-
if_(( dif(A,B) ; dif(A,C) ; dif(A,D) ), true, false ).
not_all_equalp([_,_,_,_,_|_]) :-
throw(error(representation_error(reified_disjunction),'C\'est trop !')).
The answers are exactly the same... what is happening here, me thinks. Is this version weaker, that is less consistent?
Here's a straightforward way you can do it and preserve logical-purity!
not_all_equal([E|Es]) :-
some_dif(Es, E).
some_dif([X|Xs], E) :-
( dif(X, E)
; X = E, some_dif(Xs, E)
).
Here are some sample queries using SWI-Prolog 7.7.2.
First, the most general query:
?- not_all_equal(Es).
dif(_A,_B), Es = [_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_A,_A,_B|_C]
...
Next, the query the OP gave in the question:
?- not_all_equal([A,B,C]), A=a, B=b.
A = a, B = b
; false. % <- the toplevel hints at non-determinism
Last, let's put the subgoal A=a, B=b upfront:
?- A=a, B=b, not_all_equal([A,B,C]).
A = a, B = b
; false. % <- (non-deterministic, like above)
Good, but ideally the last query should have succeeded deterministically!
Enter library(reif)
First argument indexing
takes the principal functor of the first predicate argument (plus a few simple built-in tests) into account to improve the determinism of sufficiently instantiated goals.
This, by itself, does not cover dif/2 satisfactorily.
What can we do? Work with
reified term equality/inequality—effectively indexing dif/2!
some_dif([X|Xs], E) :- % some_dif([X|Xs], E) :-
if_(dif(X,E), true, % ( dif(X,E), true
(X = E, some_dif(Xs,E)) % ; X = E, some_dif(Xs,E)
). % ).
Notice the similarities of the new and the old implementation!
Above, the goal X = E is redundant on the left-hand side. Let's remove it!
some_dif([X|Xs], E) :-
if_(dif(X,E), true, some_dif(Xs,E)).
Sweet! But, alas, we're not quite done (yet)!
?- not_all_equal(Xs).
DOES NOT TERMINATE
What's going on?
It turns out that the implementation of dif/3 prevents us from getting a nice answer sequence for the most general query. To do so—without using additional goals forcing fair enumeration—we need a tweaked implementation of dif/3, which I call diffirst/3:
diffirst(X, Y, T) :-
( X == Y -> T = false
; X \= Y -> T = true
; T = true, dif(X, Y)
; T = false, X = Y
).
Let's use diffirst/3 instead of dif/3 in the definition of predicate some_dif/2:
some_dif([X|Xs], E) :-
if_(diffirst(X,E), true, some_dif(Xs,E)).
So, at long last, here are above queries with the new some_dif/2:
?- not_all_equal(Es). % query #1
dif(_A,_B), Es = [_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_B|_C]
; dif(_A,_B), Es = [_A,_A,_A,_B|_C]
...
?- not_all_equal([A,B,C]), A=a, B=b. % query #2
A = a, B = b
; false.
?- A=a, B=b, not_all_equal([A,B,C]). % query #3
A = a, B = b.
Query #1 does not terminate, but has the same nice compact answer sequence. Good!
Query #2 is still non-determinstic. Okay. To me this is as good as it gets.
Query #3 has become deterministic: Better now!
The bottom line:
Use library(reif) to tame excess non-determinism while preserving logical purity!
diffirst/3 should find its way into library(reif) :)
EDIT: more general using a meta-predicate (suggested by a comment; thx!)
Let's generalize some_dif/2 like so:
:- meta_predicate some(2,?).
some(P_2, [X|Xs]) :-
if_(call(P_2,X), true, some(P_2,Xs)).
some/2 can be used with reified predicates other than diffirst/3.
Here an update to not_all_equal/1 which now uses some/2 instead of some_dif/2:
not_all_equal([X|Xs]) :-
some(diffirst(X), Xs).
Above sample queries still give the same answers, so I won't show these here.
Hello everyone,
The following code does recursive checks. For each call , F gets a value of either 1 or 0 , due to a condition . I want my test_liars predicate return True if all checks had result 1 , and False if at least one call , set F's value to 0.
What test_liars actually does , is not something really eager to explain , but I can if asked.
test_liars should return True to Flag's argument, asked :
test_liars(2,[3,2,1,4,2],[1,0,0,1,0],Flag)
given different list ,rather than [1,0,0,1,0], it must return False
test_liars(_,[],_,_) .
test_liars(N,[HF|TF],[HT|TT],Flag) :-
(HT == 0 -> ( N >= HF -> F = 1 ; F = 0)
; ( N < HF -> F = 1 ; F = 0)),
test_liars(N,TF,TT,Flag),
write(F),
(F == 0 -> Flag = 'True' ; Flag = 'False').
First of all, I think it is more elegant to transform the nested if-then-else structure into a predicate. For instance test_liar/4:
% test_liar(N,HT,HF,F).
test_liar(N,0,HF,1) :-
N >= HF,
!.
test_liar(N,1,HF,1) :-
N < HF,
!.
test_liar(_,_,_,0).
Which makes things easier. Now you can write:
test_liars(_,[],_,_).
test_liars(N,[HF|TF],[HT|TT],Flag) :-
test_liar(N,HT,HF,F),
test_liars(N,TF,TT,Flag),
write(F),
(F == 0 -> Flag = 'True' ; Flag = 'False').
Nevertheless we are not there yet. Your Flag should return 'False' if at least one element is a liar. That means that in the base case, there are no liars, so we should return 'True':
test_liars(_,[],_,'True').
In the inductive case we thus have to construct some kind of "and", like:
custom_and('True',1,'True') :-
!.
custom_and(_,_,'False').
Now we only need to call this custom_and/3 on the outcome of the recursive test_liars and test_liar:
test_liars(N,[HF|TF],[HT|TT],Flag) :-
test_liar(N,HT,HF,F),
test_liars(N,TF,TT,SubFlag),
write(F),
custom_and(SubFlag,F,Flag).
Or now the full code:
test_liar(N,0,HF,1) :-
N >= HF,
!.
test_liar(N,1,HF,1) :-
N < HF,
!.
test_liar(_,_,_,0).
custom_and('True',1,'True') :-
!.
custom_and(_,_,'False').
test_liars(_,[],_,'True').
test_liars(N,[HF|TF],[HT|TT],Flag) :-
test_liar(N,HT,HF,F),
test_liars(N,TF,TT,SubFlag),
write(F),
custom_and(SubFlag,F,Flag).
Is there a simple way of getting all the combinations of a list without doubles. Without doubles I mean also no permutations of each other. So no [a,b,c] and [c,a,b] or [c,b,a].
So for the input [a,b,c] the output would be:
[a]
[b]
[c]
[a,b]
[a,c]
[b,c]
[a,b,c]
I can only find solutions WITH the doubles (permutations)
The solution to this problem is rather simple: there is evidently only one combination out of the empty set: the empty set:
combs([],[]).
Furthermore for each element, you can decide whether you add it or not:
combs([H|T],[H|T2]) :-
combs(T,T2).
combs([_|T],T2) :-
combs(T,T2).
Since you pick (or drop) in the order of the list, this guarantees you that you later will not redecide to pick a. If you feed it [a,b,c], it will never generate something like [b,a,c], because once it has decided to pick/drop a, it cannot add b and re-decide on a.
Running this gives:
?- combs([a,b,c],L).
L = [a, b, c] ;
L = [a, b] ;
L = [a, c] ;
L = [a] ;
L = [b, c] ;
L = [b] ;
L = [c] ;
L = [].
In case you want to generate it the opposite way (have more of a test to first drop elements, instead of adding them, you can simply swap the recursive statements):
combs([],[]).
combs([_|T],T2) :-
combs(T,T2).
combs([H|T],[H|T2]) :-
combs(T,T2).
In that case the result will be:
?- combs([a,b,c],L).
L = [] ;
L = [c] ;
L = [b] ;
L = [b, c] ;
L = [a] ;
L = [a, c] ;
L = [a, b] ;
L = [a, b, c].
EDIT
Given you want to exclude the empty list, either you can do it simply by adding another check in your call:
?- combs([a,b,c],L),L \= [].
You can define this in a function like:
combs_without_empty1(LA,LB) :-
combs_without_empty1(LA,LB),
LB \= [].
Or by rewriting the comb/2 function. In that case you better use an accumulator that counts the current amount of selected elements:
combs_without_empty(L,C) :-
combs_without_empty(L,0,C).
The combs_without_empty/3 is a bit more complicated. In case the list contains only one element, one should check if N is greater than zero. If that is the case, we can choose whether to add the element or not. If N is zero, we have to include it. So:
combs_without_empty([A],_,[A]).
combs_without_empty([_],N,[]) :-
N > 0.
We also have to implement a recursive part that will increment N given we select an element:
combs_without_empty([_|T],N,T2) :-
combs_without_empty(T,N,T2).
combs_without_empty([H|T],N,[H|T2]) :-
N1 is N+1,
combs_without_empty(T,N1,T2).
Putting it all together gives:
combs_without_empty(L,C) :-
combs_without_empty(L,0,C).
combs_without_empty([A],_,[A]).
combs_without_empty([_],N,[]) :-
N > 0.
combs_without_empty([_|T],N,T2) :-
combs_without_empty(T,N,T2).
combs_without_empty([H|T],N,[H|T2]) :-
N1 is N+1,
combs_without_empty(T,N1,T2).
Which produces:
?- combs_without_empty([a,b,c],L).
L = [c] ;
L = [b, c] ;
L = [b] ;
L = [a, c] ;
L = [a] ;
L = [a, b, c] ;
L = [a, b] ;
false.
A clean solution without ancillary checks for empty list would be simply to exclude empty lists from the rules. The base case should be a single element combination:
comb_without_empty([H|_], [H]). % Simple case of one element comb
comb_without_empty([_|T], C) :- % Combinations of the tail w/o head
comb_without_empty(T, C).
comb_without_empty([H|T], [H|C]) :- % Combinations of the tail including head
comb_without_empty(T, C).
| ?- comb_without_empty([a,b,c], L).
L = [a] ? a
L = [b]
L = [c]
L = [b,c]
L = [a,b]
L = [a,c]
L = [a,b,c]
(1 ms) no
| ?-
Hello I am facing a problem. Let's say I have 3 operations(+,-,*).
I would like to generate variable that contains all possible expressions for given list of arguments using those 3 operators.
my_problem([1,2],X) would return
X=1-2
X=1*2
X=1+2
my_problem([1,2,3],X) would return
X=1+2+3 X=1-2-3
X=1+2-3 X=1+2*3
X=1-2+3 ...
and so on.
I know that i can build expression using this predicates.
args_expr(Arg1,Arg2,Arg1 + Arg2).
args_expr(Arg1,Arg2,Arg1 - Arg2).
args_expr(Arg1,Arg2,Arg1 * Arg2).
Is there any clever way to generete this variable? I would be grateful for any help or advice.
You can use the so called "univ" operator, =.., to build expressions:
?- Expr =.. [+, A, B].
Expr = A+B.
And you can enumerate the operations you have:
op(+). op(-). op(*).
Then:
?- op(Op), Expr =.. [Op, A, B].
Op = (+),
Expr = A+B ;
Op = (-),
Expr = A-B ;
Op = (*),
Expr = A*B.
Or maybe:
?- op(Op1), op(Op2), E =.. [Op1, A, E0], E0 =.. [Op2, B, C].
From here to what you need is just figuring out how to do this for lists of arbitrary number of elements (not just two or three).
Hint: If you figure out how to define expr/3, you can do:
?- foldl(expr, [B,C], A, E).
E = C+ (B+A) ;
E = C- (B+A) ;
E = C* (B+A) ;
E = C+ (B-A) ;
E = C- (B-A) ;
E = C* (B-A) ;
E = C+B*A ;
E = C-B*A ;
E = C* (B*A).
Of course, the second argument to foldl can be a list of arbitrary length.
Say I have a predicate eval(A) that just evaluates to true/false depending on some input
Now the thing is, I want another predicate
and(List, R)
that succeeds iff List is empty/the conjunction of the eval of every element in List is R. Where R is just true/false.
So if List had the items [a, b, c], then return [eval(a) ^ eval(b) ^ eval(c)] == R
My attempt:
and([], true).
and([H|T], R) :- eval(H), and(T, R).
and([H|T], R) :- eval(H) = R.
But i don't know how to compare to R properly.
Prolog has a relational data model, predicates don't carry values. You must add an argument to eval/1, holding the 'return value'.
and([], true).
and([H|T], R) :-
eval(H, X), % could 'shortcircuit' to false here if X is false
and(T, And),
( X == true, And == true -> R = true ; R = false ).
edit better could be, without changing eval/1:
and(L, R) :-
maplist(eval, L) -> R = true ; R = false.