How can I verify if two lists represent the same relationship between their variables in any given order and then unify the corresponding variables?
For example the list:
[#=(_G13544,_G13547+1),#=(_G13553,_G13554),#=(_G13559,2),#>(_G13559, _G13544)]
would be equivalent to:
[#>(_G13453,_G13430),#=(_G13409,_G13355),#=(_G13453,2),#=(_G13430,1+_G13370)]
because both could be written as:
[A#>B,C#=D,A#=2,B#=E+1]
and the variable would be bound in the following way:
_G13453 = _G13559 # Equivalent to A
_G13430 = _G13544 # Equivalent to B
_G13409 = _G13553 # Equivalent to C
_G13355 = _G13554 # Equivalent to D
_G13370 = _G13547 # Equivalent to E
The functors are the following CLPFD operators:
Symmetrical: #=/2,+/2,-/2, and #\//2;
Not symmetrical: #>/2, and #</2;
Unary: abs/1
something to get started
'same relationship between their variables'(L1, L2, Vs) :-
copy_term(L1, T1),
copy_term(L2, T2),
numbervars(T1, 0, N),
numbervars(T2, 0, N),
rel_pairs(T1, T2, [], Vs).
rel_pairs([], [], B, B).
rel_pairs(Xs, Ys, B0, B2) :-
select(X, Xs, Xr),
select(Y, Ys, Yr),
assign(X, Y, B0, B1),
rel_pairs(Xr, Yr, B1, B2).
assign(A#=B, C#=D, B0, B2) :-
assign(A, C, B0, B1),
assign(B, D, B1, B2)
;
assign(A, D, B0, B1),
assign(B, C, B1, B2).
assign(A#>B, C#>D, B0, B2) :-
assign(A, C, B0, B1),
assign(B, D, B1, B2).
assign(A+B, C+D, B0, B2) :-
assign(A, C, B0, B1),
assign(B, D, B1, B2)
;
assign(A, D, B0, B1),
assign(B, C, B1, B2).
assign('$VAR'(A), '$VAR'(B), B0, B0) :-
memberchk(A-B, B0), !.
assign('$VAR'(A), '$VAR'(B), B0, [A-B|B0]) :-
\+memberchk(A-_, B0),
\+memberchk(_-B, B0), !.
assign(X, X, B, B).
surely there are a number of improvements that could be done...
Related
I need to write the predicate Frequest(InList, OutList) to find the list
OutList of all elements that occur most frequently in the given InList.
Here is my code, help me write more professional and understandable for everyone please.
`counter([], _, 0).
counter([X|T], X, C) :- counter(T, X, C1), C is C1 + 1.
counter([X|T], Y, C) :- X == Y, counter(T, Y, C).
max_count([], , 0).
max_count([E|L], L1, C):-
counter(L1, E, C1),
maxcount(L, L1, C2),
C is max(C1, C2), !.
max_count_el([], , _, []) :- !.
max_count_el([X|L], L1, M, LR) :-
ffff(L, L1, M, LR2),
( counter(L1, X, C),
C == M,
+ member(X, LR2),
append(LR2, [X], LR);
LR = LR2
).
frequentest(L1, L2):-
max_count(L1, L1, R),
max_count_el(L1, L1, R, L2), !.`
How can I implement a switch statement equivalent to a nested set of if_s?
Ideally something like (don't mind the syntax):
compatible(X, Y) :-
switch X
a1 -> dif(Y, b2),
a2 -> dif(Y, c2), dif(Y, c3),
_ -> true
working the same way as this one:
compatible(X, Y) :-
if_(X = a1,
dif(Y, b2),
if_(X = a2,
(dif(Y, c2), dif(Y, c3)),
true
)
).
:- module(switch_, []).
:- use_module(library(reif)).
:- multifile goal_expansion/2.
user:goal_expansion(switch_(X, ;(->(H, C), T)), if_(X = H, C, switch_(X, T))).
user:goal_expansion(switch_(X, ->(H, C)), if_(X = H, C, fail)).
user:goal_expansion(switch_(_, true), true).
user:goal_expansion(switch_(_, false), false).
:- use_module(switch_).
likes(A, B) :-
switch_(A, (
john -> B = mary ;
mary -> dif(B, john) ;
true
)).
Example
?- likes(A, B).
A = john,
B = mary ;
A = mary,
dif(B, john) ;
dif(A, mary),
dif(A, john).
?- likes(mary, B).
dif(B, john).
?- likes(john, B).
B = mary.
Here's my solution for the water jugs problem
:- use_module(library(clpfd)).
initial(state(8, 0, 0)).
final(state(4, 4, 0)).
constraint(A0, A1, B0, B1, C0, C1, V) :-
A0 #< A1,
( B0 #> 0, T #= min(V - A0, B0), A1 #= A0 + T, B1 #= B0 - T, C1 #= C0
; C0 #> 0, T #= min(V - A0, C0), A1 #= A0 + T, C1 #= C0 - T, B1 #= B0
).
transition(state(A0, B0, C0), state(A1, B1, C1)) :-
( constraint(A0, A1, B0, B1, C0, C1, 8)
; constraint(B0, B1, A0, A1, C0, C1, 5)
; constraint(C0, C1, A0, A1, B0, B1, 3)
).
solve(A, A, _, [A]).
solve(A, B, P, [A|Q]) :-
transition(A, A1),
\+ member(A1, P),
solve(A1, B, [A|P], Q).
path(P) :-
initial(S0),
final(S),
solve(S0, S, [], P).
Is there a way to find the P of minimal length without traversing all options?
Here is a solution that makes more use of the power of clpfd: First state the problem, then try to solve it (using labeling/2 or similar). Given that we do not know the length of the (shortest) path, this will generate larger and larger problems until a solution is found. In my code, I do not prevent visiting the same state twice (but this could be added in the same way as in the MiniZinc model written by #DavidTonhofer, or as some post-processing). However, in order to ensure a finite search space, I've added code to stop the problem generation if the length of the path is longer than (5+1)*(3+1), as this is an upper bound on the number of different states (assuming we have do not add or remove water outside of the 3 jugs).
:- use_module(library(clpfd)).
initial(state(8, 0, 0)).
final(state(4, 4, 0)).
constraint(A0,A1,B0,B1,C0,C1,R,Max):-
T#=min(Max-B0,A0),
R in 0..1,
R#==>T#>0,
R#==>A1#=A0-T,
R#==>B1#=B0+T,
R#==>C1#=C0.
transition(state(A0, B0, C0), state(A1, B1, C1)) :-
A0+B0+C0#=A1+B1+C1,
A0 in 0..8,
B0 in 0..5,
C0 in 0..3,
A1 in 0..8,
B1 in 0..5,
C1 in 0..3,
constraint(A0,A1,B0,B1,C0,C1,RAB,5),
constraint(B0,B1,A0,A1,C0,C1,RBA,8),
constraint(A0,A1,C0,C1,B0,B1,RAC,3),
constraint(C0,C1,A0,A1,B0,B1,RCA,8),
constraint(C0,C1,B0,B1,A0,A1,RCB,5),
constraint(B0,B1,C0,C1,A0,A1,RBC,3),
RAB+RBA+RAC+RCA+RCB+RBC#=1.
solve(A, A, Xs, [A]):-
labeling([],Xs).
solve(A, B, Xs, [A|Q]) :-
length(Xs, L),
L < 24*3,
transition(A, A1),
A=state(X1,X2,X3),
solve(A1, B, [X1,X2,X3|Xs], Q).
path(P) :-
initial(S0),
final(S),
solve(S0, S, [], P).
I tried to keep the code relatively close to the one in the question. The main difference is that all the prolog-level disjunctions in transition/2 and constraint/7 have been removed and replaced by reification. In particular, I added the parameter R to constraint/8 which is equal to 1 if that specific transition is taken. Then I state in transition/2 that exactly one of the transitions must take place.
I must add that this formulation is not particularly efficient and I would not be surprised to find out that one can solve the problem more efficiently with either a different clpfd formulation or without using clpfd at all.
I found this problem in 99-problems in prolog online. There is a solution (has nothing to do with mine) and I was wondering why mine won't work. Or to be precise: it works but it finds only 1 solution instead of all of them. The problem is stated as such:
a) In how many ways can a group of 9 people work in 3 disjoint subgroups of 2, 3 and 4 persons?
member(X,[X]).
member(X,[X|_]).
member(X,[_|R]):- member(X,R).
append(X,[],X).
append([],X,X).
append([H|R], [A|B], [H|W]):- append(R,[A|B],W).
group234(G,G2,G3,G4):- length(G2,2),
length(G3,3),
length(G4,4),
member(X,G),
member(Y,G),
member(Z,G),
member(X,G2),
member(Y,G2),
member(Z,G3),
append(G2,G3,I),append(I,G4,G).
q1: Is there a way to use length and append and member as I did and sole this succesfully or do I need to completely rewrite this?
q2: Why does this code produce only 1 solution? Prolog should search for many possible members, shouldn't it? (Obviously , it should not , because the language knows better than I do . But to my understanding it should so why it does not?)
You need only append/3 to define a predicate to choose and remove one person of a group:
choose(X, L1, L2) :-
append(A, [X|B], L1),
append(A, B, L2).
For example:
?- choose(X, [a,b,c], Rest).
X = a,
Rest = [b, c] ;
X = b,
Rest = [a, c] ;
X = c,
Rest = [a, b] ;
false.
Then, using this predicate, you can define group234/4 as:
group234(G, [A,B], [C,D,E], G4):-
choose(A, G, G0),
choose(B, G0, G1), A #< B,
choose(C, G1, G2),
choose(D, G2, G3), C #< D,
choose(E, G3, G4), D #< E.
Notice that you need condition A #< B, to avoid permutations (since both lists [A,B] and [B,A] represent the same group). Analogously, conditions C #< D and D #< E avoid permutations of the list [C,D,E].
Example:
?- group234([a,b,c,d,e,f,g,h,i], G2, G3, G4).
G2 = [a, b],
G3 = [c, d, e],
G4 = [f, g, h, i] ;
G2 = [a, b],
G3 = [c, d, f],
G4 = [e, g, h, i] ;
G2 = [a, b],
G3 = [c, d, g],
G4 = [e, f, h, i] ;
G2 = [a, b],
G3 = [c, d, h],
G4 = [e, f, g, i]
...
I think the problem formulation is rather ambiguous.
The (nice! +1) solution proposed by #slago relies on elements being sortable, but I think that the solution should be rather expressed working on the positions of the list. Here is their solution completed, expressed using library predicates:
%! %%%%
group234(G, [A,B], [C,D,E], G4):-
select(A, G, G0),
select(B, G0, G1), A #< B,
select(C, G1, G2),
select(D, G2, G3), C #< D,
select(E, G3, G4), D #< E.
n_group234_slago(N) :-
numlist(1,9,L),
aggregate_all(count,group234(L,_,_,_),N).
and here is mine
take_ordered(L,[X],R) :-
select(X,L,R).
take_ordered(L,[X|Xs],R) :-
append(H,[X|T],L),
take_ordered(T,Xs,J),
append(H,J,R).
group234_cc(L,[A1,A2],[B1,B2,B3],[C1,C2,C3,C4]) :-
take_ordered(L,[A1,A2],U),
take_ordered(U,[B1,B2,B3],[C1,C2,C3,C4]).
n_group234_cc(N) :-
numlist(1,9,L),
aggregate_all(count,group234_cc(L,_A,_B,_C),N).
Both n_group234_slago(N), n_group234_cc(N) return the correct number N requested.
Edit
I was not satisfied with take_ordered/3. Then, I tried to express it with a DCG:
take_ordered([],[]) --> [].
take_ordered([X|Xs],Ys) --> [X],
take_ordered(Xs,Ys).
take_ordered(Xs,[Y|Ys]) --> [Y],
take_ordered(Xs,Ys).
take_ordered(L,O,R) :-
phrase(take_ordered(O,R),L).
and the efficiency gain is notable, halving the inference count.
Edit
The proposed solution group3/4 by the 'P-99: Ninety-Nine Prolog Problems' site is a lot less efficient than the proposals by #slago and me you find here.
?- numlist(1,9,L),time(aggregate_all(count,group3(L,A,B,C),N)).
% 122,373 inferences, ...
?- time(n_group234_cc(N)).
% 7,549 inferences, ...
I'm trying to implement Levenshtein distance in Prolog.
The implementation is pretty straightforward:
levenshtein(W1, W2, D) :-
atom_length(W1, L1),
atom_length(W2, L2),
lev(W1, W2, L1, L2, D),
!.
lev(_, _, L1, 0, D) :- D is L1, !.
lev(_, _, 0, L2, D) :- D is L2, !.
lev(W1, W2, L1, L2, D) :-
lev(W1, W2, L1 - 1, L2, D1),
lev(W1, W2, L1, L2 - 1, D2),
lev(W1, W2, L1 - 1, L2 - 1, D3),
charAt(W1, L1, C1),
charAt(W2, L2, C2),
( C1 = C2 -> T is 0; T is 1 ),
min(D1, D2, D3 + T, D).
% Returns the character at position N in the atom A
% The position is 1-based
% A: The atom
% N: The position at which to extract the character
% C: The character of A at position N
charAt(A, N, C) :- P is N - 1, sub_atom(A, P, 1, _, C).
% min(...): These rules compute the minimum of the given integer values
% I1, I2, I3: Integer values
% M: The minimum over the values
min(I1, I2, M) :- integer(I1), integer(I2), ( I1 =< I2 -> M is I1; M is I2).
min(I1, I2, I3, M) :- min(I1, I2, A), min(I2, I3, B), min(A, B, M).
However, this code failures with this error:
?- levenshtein("poka", "po", X).
ERROR: Out of local stack
I'm using SWIPL implementation on Mac OS X Sierra.
There is a good reason for which your program does not work: your recursive calls lead into an infinite loop.
This is caused by those lines:
lev(W1, W2, L1 - 1, L2, D1),
lev(W1, W2, L1, L2 - 1, D2),
lev(W1, W2, L1 - 1, L2 - 1, D3),
min(D1, D2, D3 + T, D)
In Prolog things like L1 - 1 are expressions that do not get evaluated to numbers. Therefore your code will recursively call lev with the third argument as L1 -1, then L1 - 1 - 1, etc. which does not match your terminating rules.
To fix this you need to use temporary variables where you evaluate the result of e.g. L1 - 1.
This fixes it:
lev(W1, W2, L1, L2, D) :-
L11 is L1 - 1,
L22 is L2 - 1,
lev(W1, W2, L11, L2, D1),
lev(W1, W2, L1, L22, D2),
lev(W1, W2, L11, L22, D3),
charAt(W1, L1, C1),
charAt(W2, L2, C2),
( C1 = C2 -> T is 0; T is 1 ),
D4 is D3 + T,
min(D1, D2, D4, D).
Now this does this:
?- levenshtein("poka","po",X).
X = 0.
Which is probably not the result you want, but at least it does not error. I will leave it to you to fix your predicate.
There are several problems with your program.
The loop
#Fatalize already gave you a reason, here is a general method how you can localize such problems, using a failure-slice by which some goals false are inserted into your program. If the remaining program loops, also the original version did:
?- levenshtein("poka","po",X), false.
levenshtein(W1, W2, D) :-
atom_length(W1, L1),
atom_length(W2, L2),
lev(W1, W2, L1, L2, D), false,
!.
lev(_, _, L1, 0, D) :- D is L1, !.
lev(_, _, 0, L2, D) :- D is L2, !.
lev(W1, W2, L1, L2, D) :-
lev(W1, W2, L1 - 1, L2, D1), false,
lev(W1, W2, L1, L2 - 1, D2),
lev(W1, W2, L1 - 1, L2 - 1, D3),
charAt(W1, L1, C1),
charAt(W2, L2, C2),
( C1 = C2 -> T is 0; T is 1 ),
min(D1, D2, D3 + T, D).
You have to modify something in the remaining, visible part. Otherwise, this problem will persist.
Use lists!
Instead of using atoms or strings, better use lists to represent words. The best is to add into your .swiplrc or .sicstusrc:
:- set_prolog_flag(double_quotes, chars).
In this manner, the following holds:
?- "abc" = [a,b,c].
Avoid cuts
Cuts somehow, sometimes work, but such programs are hard-to-debug. In particular for beginners. Therefore, avoid them at all costs
Use clean arithmetics
You are using the "olde" arithmetic of Prolog which is highly moded. Instead use_module(library(clpfd)) to get purer code.