Related
[a,a,a,a,b,c,c,a,a,d,e,e,e,e] => [[4,a],b,[2,c],[2,a],d,[4,e]].
please help me solve this problem
I have this code, but I do not know how to bring it to the one that is required or how can it be done differently or easier:
p([]):- !.
p( [X] ):- !, write(X).
p( [X | T] ):-!, write(X), write(", "), p(T).
first_letter([H], Let, Num, Mid, Res):-
( H = Let, New_num is Num +1,
G = [Let], Prom = [New_num | G],
Res = [Prom | Mid], !
; true
),
( H \= Let,New_num is 1,
G = [Let], Prom = [Num | G], New_mid = [Prom | Mid],
SG = [H], Sec_Prom = [New_num | SG],
Res = [Sec_Prom | New_mid],
!
; true
).
first_letter([H | T], Let, Num, Mid, Res):-
( H = Let,New_Num is (Num + 1),
first_letter(T, Let, New_Num, Mid, Res),
!
; true
),
( H \= Let, G = [Let], Prom = [Num | G],
New_mid = [Prom | Mid],
first_letter(T, H, 1, New_mid, Res),
!
; true
).
nreverse([T], Res):- Res = [T], !.
nreverse([H | T], Res):-
nreverse(T, Resal),
append(Resal, [H], Res). %nehvost
start:-
T = [a,a,a,a,b,c,c,a,a,d,e,e,e,e], T = [H | _],
first_letter(T, H, 0, [], Res),
nreverse(Res, End),
p(End).
squeeze([], []).
squeeze([X|Xs], Ys) :-
squeeze(Xs, X-1, [], Ys).
squeeze([], Current, Acc, Ys) :- reverse(Ys, [Current|Acc]).
squeeze([X|Xs], X-N, Acc, Ys) :-
N1 is N+1,
squeeze(Xs, X-N1, Acc, Ys).
squeeze([X|Xs], C-N, Acc, Ys) :-
dif(X,C),
squeeze(Xs, X-1, [C-N|Acc], Ys).
gives
?- squeeze([a,a,a,a,b,c,c,a,a,d,e,e,e,e], X).
X = [a-4, b-1, c-2, a-2, d-1, e-4]
I have used pairs from swi-prolog to represent and element and its length. You can change it to list if you want, just replace any instance of A-B with [A, B] in the above code.
It's an exercice to learn fold/4
:- use_module(library(lambda)).
start(Out) :-
T = [a,a,a,a,b,c,c,a,a,d,e,e,e,e],
foldl(\X^Y^Z^(nth0(_, Y , [A,X], R)
-> A1 is A + 1,
Z = [[A1, X] | R]
; Z = [[1, X] | Y]),
T, [], Out_),
sort(Out_, Out).
Result :
?- start(Out).
Out = [[1, b], [1, d], [2, c], [4, e], [6, a]].
Ok, to reduce confusion: I saw your other question first where you more or less ask about to turn the answer from rajashekar to your desired format. I agree with rajashekar, so I won't do all the work for you but it still tickles to simplify the code, so here a step closer to your goal:
At first I would remove the fourth argument. It is possible to do it with just 3 arguments and you don't even have to reverse your Acc.
Second, you want to have a list-writing ([a, 4]) instead of a minus-pair-writing (a-4).
Third you want to have a special case where single elements are displayed without the list notation (b instead of [b, 1]).
This is the code when you apply the changes 1 and 3; part 2 you can just do by reading the answer by rajashekar:
squeeze1([], []).
squeeze1([X|Xs], Ys) :-
squeeze1(Xs, X-1, Ys).
squeeze1([], Current, [Current]).
squeeze1([X|Xs], X-N, Acc) :-
N1 is N+1,
squeeze1(Xs, X-N1, Acc).
squeeze1([X|Xs], C-N, [C-N|Acc]) :-
N>1,
dif(X,C),
squeeze1(Xs, X-1, Acc).
squeeze1([X|Xs], C-1, [C|Acc]) :-
dif(X,C),
squeeze1(Xs, X-1, Acc).
?- squeeze1([a,a,a,a,b,c,c,a,a,d,e,e,e,e], X).
X = [a-4, b, c-2, a-2, d, e-4] ;
false.
I want to understand SICStus-style extensible unification.
The User's Manual on library(atts) states that:
Module:verify_attributes(-Var, +Value, -Goals) hook
...
verify_attributes/3 may invoke arbitrary Prolog goals, but Var should not be bound by it. Binding Var will result in undefined behavior.
...
In the case when a single unification binds multiple attributed variables, first all such bindings are undone, then the following actions are carried out for each relevant variable:
For each relevant module M, M:verify_attributes/3 is called, collecting a list of returned Goals.
The variable binding is redone.
Any Goals are called.
Any goals blocked on the variable, that has now become unblocked, are called.
So far, I came up with the following interpretation of the above:
Different verify_attribute/3 handlers hooked on Var, see the same state of Var: All see it "pre_unify".
verify_attribute/3 must not bind Var, but it may bind other attributed variables.
These bindings are to be delayed, too, so that the handlers not only see the same state of Var, but of all attributed variables involved.
Above list of actions entails "5. Force any delayed bindings of attributed variables."
Am I moving in the right direction—is this what "done, then undone, then redone" is all about?
 Please help!
That mechanism was originally designed by Christian Holzbaur and implemented by yours truly. Re. your interpretation:
Different verify_attribute/3 handlers hooked on Var, see the same
state of Var: All see it "pre_unify".
Right.
verify_attribute/3 must not bind Var, but it may bind other
attributed variables.
Right.
These bindings are to be delayed, too, so that the handlers not only
see the same state of Var, but of all attributed variables involved.
Wrong. If it binds other attributed variables, the whole extended unification mechanism gets invoked recursively on those variables.
Above list of actions entails "5. Force any delayed bindings of
attributed variables."
Wrong.
This is the meta-interpreter:
:- use_module(library(lists), [append/2,append/3,maplist/2,maplist/3,member/2,select/3]).
% Source: https://sicstus.sics.se/sicstus/docs/3.7.1/html/sicstus_17.html
% Source: https://sicstus.sics.se/sicstus/docs/latest4/html/sicstus.html/lib_002datts.html#lib_002datts
element(Es, E) :-
member(E, Es).
get_atts(S, _, _, _, _, _) :-
var(S),
throw(error(instantiation_error,get_atts/3)).
get_atts(_, V, _, _, _, _) :-
nonvar(V),
throw(error(uninstantiation_error,get_atts/3)).
get_atts(+, V, D, G_3, As0, As) :-
element(As0, s(V0,D0,G0_3)),
V == V0,
\+ \+ s(V,D,G_3) = s(V0,D0,G0_3), !,
mi([s(V0,D0,G0_3) = s(V,D,G_3)], As0, As).
get_atts(-, V, D, G_3, As0, _) :-
element(As0, s(V0,D0,G0_3)),
V == V0,
\+ \+ s(V,D,G_3) = s(V0,D0,G0_3),
mi([s(V0,D0,G0_3) = s(V,D,G_3)], As0, _), !,
false.
get_atts(-, _, _, _, As, As).
put_atts(S, _, _, _, _, _) :-
var(S),
throw(error(instantiation_error,put_atts/3)).
put_atts(_, V, _, _, _, _) :-
nonvar(V),
throw(error(uninstantiation_error,put_atts/3)).
put_atts(_, _, D, _, _, _) :-
var(D),
throw(error(instantiation_error,put_atts/3)).
put_atts(+, V, D, G_3, As0, [s(V,D,G_3)|As]) :-
functor(D, A, N),
functor(D0, A, N),
select(s(V0,D0,_), As0, As),
V == V0, !.
put_atts(+, V, D, G_3, As, [s(V,D,G_3)|As]).
put_atts(-, V, D, G_3, As0, As) :-
select(s(V0,D0,G0_3), As0, As1),
V == V0,
\+ \+ s(V,D,G_3) = s(V0,D0,G0_3),
mi([s(V0,D0,G0_3) = s(V,D,G_3)], As1, As), !.
put_atts(-, _, _, _, As, As).
mi(G, As) :-
mi([G], [], As).
mi([], As, As).
mi([G|_], _, _) :-
var(G),
throw(error(instantiation_error,mi/3)).
mi([G|_], As, _) :-
false,
writeq([G,As]), nl,
false.
mi([false|_], _, _) :-
!,
false.
mi([true|Gs], As0, As) :-
!,
mi(Gs, As0, As).
mi([G0|Gs], As0, As) :-
functor(G0, call, N),
N #> 0,
G0 =.. [call,F|Bs0], !,
F =.. Bs1,
append(Bs1, Bs0, Bs),
G =.. Bs,
mi([G|Gs], As0, As).
mi([(G0, G)|Gs], As0, As) :-
!,
mi([G0,G|Gs], As0, As).
mi([(G ; _)|Gs], As0, As) :-
G \= (_->_),
mi([G|Gs], As0, As).
mi([(G0 -> G ; _)|Gs], As0, As) :-
mi([G0], As0, As1), !,
mi([G|Gs], As1, As).
mi([(_ ; G)|Gs], As0, As) :-
!,
mi([G|Gs], As0, As).
mi([(G0 -> G)|Gs], As0, As) :-
mi([G0], As0, As1), !,
mi([G|Gs], As1, As).
mi([catch(G0, E, G)|Gs], As0, As) :-
catch(mi([G0|Gs], As0, As), E, mi([G|Gs], As0, As)).
mi([throw(E)|_], _, _) :-
throw(E).
mi([A \= B|_], As, _) :-
mi([A = B], As, _), !,
false.
mi([_ \= _|Gs], As0, As) :-
!,
mi(Gs, As0, As).
mi([get_atts(Mode, V, D, G_3)|Gs], As0, As) :-
!,
get_atts(Mode, V, D, G_3, As0, As1),
mi(Gs, As1, As).
mi([put_atts(Mode, V, D, G_3)|Gs], As0, As) :-
!,
put_atts(Mode, V, D, G_3, As0, As1),
mi(Gs, As1, As).
% mi([G0|_], _, _) :-
% functor(G0, A, N),
% \+ pi(A, N), !,
% throw(error(existence_error(procedure,A/N),mi/3)).
mi([G0|Gs0], As0, As) :-
copy_term(G0, G),
head_body(G, Gs, Gs0),
unify(G0, G, As0, As1),
mi(Gs, As1, As).
unify(G0, G, As0, As) :-
maplist(arg(1), As0, Vs0),
sort(Vs0, Vs),
unify_(G0, G, Vs, As0, As).
unify_(G, G, Vs, As0, As) :-
maplist(var, Vs),
term_variables(Vs, Vs), !,
As0 = As.
unify_(G0, G, Vs, As0, As) :-
unifiable(G0, G, Eqs0),
shrink_equations(Vs, Eqs0, Eqs),
gather_attributes_goals(Eqs, As0, As1, Gs),
G0 = G, % maplist(call, Eqs),
filter_attributes(As1, As2),
mi(Gs, As2, As).
shrink_equations(_, [], []).
shrink_equations(Vs, [Eq|Eqs0], Eqs) :-
call(Eq),
maplist(var, Vs),
term_variables(Vs, Vs), !,
shrink_equations(Vs, Eqs0, Eqs).
shrink_equations(Vs, [Eq|Eqs0], [Eq|Eqs]) :-
shrink_equations(Vs, Eqs0, Eqs).
unifiable(X, Y, Eqs) :-
\+ \+ X = Y,
unifiable_([X], [Y], Eqs, Eqs, []).
unifiable_([], [], _, Eqs, Eqs).
unifiable_([X|Xs], [Y|Ys], Eqs0, Eqs1, Eqs) :-
nonvar(X),
nonvar(Y), !,
functor(X, A, N),
functor(Y, A, N),
X =.. [A|Xs0],
Y =.. [A|Ys0],
unifiable_(Xs0, Ys0, Eqs0, Eqs1, Eqs2),
unifiable_(Xs, Ys, Eqs0, Eqs2, Eqs).
unifiable_([X|Xs], [Y|Ys], Eqs0, Eqs1, Eqs) :-
element([X=Y,Y=X], Eq),
\+ maplist(\==(Eq), Eqs0), !,
unifiable_(Xs, Ys, Eqs0, Eqs1, Eqs).
unifiable_([X|Xs], [Y|Ys], Eqs0, [X=Y|Eqs1], Eqs) :-
unifiable_(Xs, Ys, Eqs0, Eqs1, Eqs).
gather_attributes_goals(Eqs, As0, As, Gs) :-
gather_attributes_goals_(Eqs, As0, As, Gss, []),
append(Gss, Gs).
gather_attributes_goals_([], As, As, Gss, Gss).
gather_attributes_goals_([X=Y|Eqs], As0, As, Gss0, Gss) :-
% TODO: Investigate `==(X)` and `==(Y)`, since goals are executed.
filter(ar(1, ==(X)), As0, SubAs0),
maplist(arg(3), SubAs0, Gs0),
execute_attributes(Gs0, X, Y, As0, As1, Gss0, Gss1),
filter(ar(1, ==(Y)), As1, SubAs1),
maplist(arg(3), SubAs1, Gs1),
execute_attributes(Gs1, Y, X, As1, As2, Gss1, Gss2),
gather_attributes_goals_(Eqs, As2, As, Gss2, Gss).
execute_attributes([], _, _, As, As, Gss, Gss).
execute_attributes([G_3|Gs], X, Y, As0, As, [Gs0|Gss0], Gss) :-
mi([call(G_3, X, Y, Gs0)], As0, As1),
execute_attributes(Gs, X, Y, As1, As, Gss0, Gss).
filter_attributes([], []).
filter_attributes([s(V,_,_)|As0], As) :-
nonvar(V), !,
filter_attributes(As0, As).
filter_attributes([s(V,D,_)|As0], As) :-
var(V),
functor(D, A, N),
functor(D0, A, N),
element(As0, s(V0,D0,_)),
V == V0, !,
filter_attributes(As0, As).
filter_attributes([A|As0], [A|As]) :-
filter_attributes(As0, As).
ar(N, G_1, A0) :-
arg(N, A0, A),
call(G_1, A).
filter(_, [], []).
filter(G_1, [L|Ls0], Ms) :-
call(G_1, L), !,
Ms = [L|Ls],
filter(G_1, Ls0, Ls).
filter(G_1, [_|Ls0], Ls) :-
filter(G_1, Ls0, Ls).
head_body(true, Rs, Rs).
head_body(A=A, Rs, Rs).
head_body(element([A|_], A), Rs, Rs).
head_body(element([_|As], A), [element(As, A)|Rs], Rs).
head_body(select(A0, [A0|As], As), Rs, Rs).
head_body(select(A0, [A|As0], [A|As]), [select(A0, As0, As)|Rs], Rs).
head_body(maplist(_, []), Rs, Rs).
head_body(maplist(G_1, [A|As]), [call(G_1, A), maplist(G_1, As)|Rs], Rs).
head_body(p(_), Rs, Rs).
head_body(p(a), Rs, Rs).
head_body(var(T), Rs, Rs) :-
var(T).
head_body(nonvar(T), Rs, Rs) :-
nonvar(T).
head_body(T0==T, Rs, Rs) :-
T0 == T.
head_body(T0\==T, Rs, Rs) :-
T0 \== T.
head_body(sort(As0,As), Rs, Rs) :-
sort(As0, As).
head_body(freeze(V, G_0), [(
( var(V) ->
put_atts(+, W, frozen(G_0), freezer),
W = V
; nonvar(V), call(G_0)
)
)|Rs], Rs).
head_body(freezer(V, W, Gs), [(
get_atts(+, V, frozen(G0), _),
( var(W) ->
( get_atts(+, W, frozen(G1), _) ->
put_atts(+, V, frozen((G0, G1)), freezer)
; true
),
Gs = []
; Gs = [G0]
)
)|Rs], Rs).
head_body(domain(V, Dom0), [(
( var(Dom0) ->
get_atts(+, V, dom(Dom0), _)
; maplist(nonvar, Dom0),
sort(Dom0, Dom),
Dom = [E|Es],
( Es = [] ->
V = E
; put_atts(+, W, dom(Dom), contraction),
V = W
)
)
)|Rs], Rs).
head_body(contraction(V, W, Gs), [(
get_atts(+, V, dom(Dom0), _),
( var(W) ->
( get_atts(+, W, dom(Dom1), _) ->
intersection(Dom0, Dom1, Dom),
Dom = [E|Es],
( Es = [] ->
Gs = [W=E]
; put_atts(+, V, dom(Dom), contraction),
% put_atts(+, W, dom(Dom), contraction),
Gs = []
)
; Gs = []
)
; ( element(Dom0, W) ->
true
; false
),
Gs = []
)
)|Rs], Rs).
head_body(intersection(Us, Vs, Ws), [(
( (Us = [] ; Vs = []) ->
Ws = []
; [U|Us0] = Us,
( select(V, Vs, Vs0), U == V ->
[U|Ws0] = Ws
; Vs0 = Vs,
Ws0 = Ws
),
intersection(Us0, Vs0, Ws0)
)
)|Rs], Rs).
/*
head_body(dif(X, Y), [(
X \== Y,
( X \= Y ->
true
; put
)
)|Rs], Rs).
head_body(differentiator(V, W, Gs), [(
get_atts(+, V, dif(Vs), _),
( var(W) ->
( get_atts(+, W, dif(Ws), _) ->
intersection(Vs, Ws, Xs),
maplist(differentiate(V, W), Xs, Gs)
; Gs = []
)
; Gs = []
)
)|Rs], Rs).
% */
test :-
writeq(freeze), nl,
mi(freeze(A,false), As),
writeq([A,As]), nl,
false.
test :-
writeq(freeze), nl,
mi((freeze(A,false),freeze(A,true)), As),
writeq([A,As]), nl,
false.
test :-
writeq(domain), nl,
mi((domain(X,[5,6,7,1]),domain(Y,[3,4,5,6]),domain(Z,[1,6,7,8])), As),
writeq([X,Y,Z,As]), nl,
false.
test :-
writeq(domain), nl,
mi((domain(X,[5,6,7,1]),domain(Y,[3,4,5,6]),domain(Z,[1,6,7,8]),X=Y), As),
writeq([X,Y,Z,As]), nl,
false.
test :-
writeq(domain), nl,
mi((domain(X,[5,6,7,1]),domain(Y,[3,4,5,6]),domain(Z,[1,6,7,8]),X=Y,Y=Z), As),
writeq([X,Y,Z,As]), nl,
false.
test :-
halt.
For a quick test run test/0.
The predicates of interest are get_atts/6 and put_atts/6. This meta-interpreter doesn't handle module so the interface has been generalized (thus creating new unknown issue).
This hasn't been tested extensively, the predicate gather_attributes_goals/4 may need a deeper inspection. Only freeze/2 and domain/2 has been implemented (but need more testing). Implementing dif/2 could help in testing it. Implementing cut could also help load a library like clpz for testing.
Unification is done with unify/4 where handling the attributed variables begins.
This is the first implementation polished, it's more something to learn how does it work, I still need to work on something better.
I'm trying to do a predicate in prolog which substitute the value I give to the variables of the polynomial and then it calculate the result. Here is my code:
as_monomial(X, m(X, 0, [])) :- number(X), !.
as_monomial(^(Y, Z), m(1, Z, [v(Z, Y)])) :- !.
as_monomial(*(X, ^(Y, Z)), m(G, K, Q)) :- as_monomial(X, m(G, TD, Vars)), K is (TD + Z), compress_monomial([v(Z, Y)| Vars], A), ordina_m(A, Q), !.
as_monomial(*(X, Y), m(G, K, Q)) :- as_monomial(X, m(G, TD, Vars)), K is (TD + 1), compress_monomial([v(1, Y)| Vars], A), ordina_m(A, Q), !.
as_monomial(-(X), m(-A, Y, L)) :- as_monomial(X, m(A, Y, L)).
as_monomial(X, m(1, 1, [v(1, X)])).
ordina_m(List, Sorted) :- sort(2, #=<, List, Sorted).
ordina_var(List, Sorted) :- sort(0, #=<, List, Sorted).
compress_monomial([], []) :- !.
compress_monomial([X| Xs], A2) :- compress_monomial(Xs, A), compress_monomial2(X, A, A2), !.
is_monomial(m(_C, TD, VPs)) :- integer(TD), TD >= 0, is_list(VPs).
is_polynomial(poly(M)) :- is_list(M), foreach(member(Monomio, M), is_monomial(Monomio)).
variables(Poly1, Result) :- is_polynomial(Poly1), variabili(Poly1, Result), !.
variables(Poly1, Result) :- as_polynomial(Poly1, Result1), variabili(Result1, Result), !.
variabili(poly([]), []) :- !.
variabili(poly([m(_, _, [])| Xs]), Ys) :- variabili(poly(Xs), Ys), !.
variabili(poly([m(X, Y, [v(_, A)| Vs])| Xs]), Z) :- variabili(poly([m(X, Y, Vs)| Xs]), Ys), ordina_var([A| Ys], R), compressV(R, Z), !.
compressV([], []).
compressV([X|T],[X|T1]):- member(X,T),!,canc(X,T,R), compressV(R,T1).
compressV([X|T],[X|T1]) :- compressV(T,T1).
canc(_L, [], []).
canc(L, [L|S], Z) :- canc(L, S, Z).
canc(L, [H|S], [H|Z]):- canc(L, S, Z), !.
as_polynomial(+(X, Y), poly(C)) :- as_monomial(Y, G), as_polynomial(X, poly(Gs)), compress_polynomial([G| Gs], C), !.
as_polynomial(-(X, Y), poly(C)) :- as_monomial(-Y, G), as_polynomial(X, poly(Gs)), compress_polynomial([G| Gs], C), !.
as_polynomial(X, poly([X])) :- is_monomial(X), !.
as_polynomial(X, poly([Q])) :- as_monomial(X, Q), !.
compress_polynomial([], []) :- !.
compress_polynomial([X| Xs], A2) :- compress_polynomial(Xs, A), compress_polynomial2(X, A, A2), !.
compress_polynomial2(m(X, Y, Z), [], [m(X, Y, Z)]) :- !.
compress_polynomial2(m(X, Y, Z), [m(X1, Y, Z)| Xs], [m(X2, Y, Z)| Xs]) :- X2 is (X + X1), !.
compress_polynomial2(X, [Y| Ys], [Y| Z]) :- compress_polynomial2(X, Ys, Z), !.
polyval(Poly1, V, Result) :- is_polynomial(Poly1), variables(Poly1, Vars), poly_val(Poly1, Vars, V, Result), !.
polyval(Poly1, V, Result) :- as_polynomial(Poly1, P1), variables(P1, Vars), poly_val(P1, Vars, V, Result), !.
poly_val(poly([]), , , poly([])) :- !.
poly_val(poly([m(X, Y, Z)| Xs]), Vars, V, poly([R| Ys])) :- poly_val(poly(Xs), Vars, V, poly(Ys)), print(m(X, Y, Z)), mon_val(m(X, Y, Z), Vars, V, R), !.
mon_val(m(X, Y, []), [_], [_], m(X, Y, [])) :- !.
mon_val(m(X, Y, [v(W, Z)| Vs]), [Z| Vs2], [Val| Vvs], m(X2, Y2, Z2)) :- integer(Val), mon_val(m(X, Y, Vs), Vs2, Vvs, m(X3, Y2, Z2)), X2 is (X3 * (Val ^ W)), !.
mon_val(m(X, Y, [v(W, Z)| Vs]), [_| Vs2], [_| Vvs], m(X, Y2, Z2)) :- mon_val(m(X, Y, [v(W, Z)| Vs]), Vs2, Vvs, m(X, Y3, Z2)), Y2 is (Y3 + W), !.
I hope I put all the code you need to prove it, in case please say it to me and I apologise for it. I know about the cut but, at the moment, it is just a trial. My problem is in mon_val because it looks like doesn't want to unify. An example of query I use is polyval(x+x+y, [1, 3], Q). where the output is "false" and it should return poly(m(1, 0, []), m(1, 0, []), m(3, 0, [])). Are you able to help me doing that? I just want to solve the problem and later I will also implement the sum between the numbers which is pretty easy with the rest of the code I have. Thanks guys
If you wanna know, at the end I solve the problem myself (which is, according some of you, the best way to learn and I'm agree). So my poly-val becomes:
polyval(Poly1, V, Result) :- is_polynomial(Poly1), variables(Poly1, Vars), poly_val(Poly1, Vars, V, Result), !.
polyval(Poly1, V, Result) :- as_polynomial(Poly1, P1), variables(P1, Vars), poly_val(P1, Vars, V, Result), !.
poly_val(poly([]), _, _, poly([])) :- !.
poly_val(poly([X| Xs]), Vars, V, poly(Z)) :- poly_val(poly(Xs), Vars, V, poly(Ys)), mon_val(X, Vars, V, R), compress_polynomial([R| Ys], Z), !.
/* mon_val(Monomio, Variabili, ValoreVariabili, Result) */
mon_val(m(X, _, []), [_], [_], m(X,0, [])) :- !.
mon_val(m(X, _, Z), [], [], m(X,0, Z)) :- !.
mon_val(m(X, Y, [v(W, Z) | R]), [Z| Vs], [Val|Vvs], m(X2, Y2, Z2)) :- integer(Val), mon_val(m(X, Y, R), Vs, Vvs, m(X3, Y2, Z2)), X2 is (X3 * (Val ^ W)), !.
mon_val(m(X, Y, Z), [_|Vs2], [_| Vvs], m(X2, Y2, A)) :- mon_val(m(X, Y, Z), Vs2, Vvs, m(X2, Y2, A)), !.`
I'm trying to do an exercise in prolog. I put a lot of cut (I know. Too much and some of them are useful and I will discuss in future to remove some of them), otherwise the program doesn't stop itself. Here is my code:
as_monomial(X, m(X, 0, [])) :- number(X), !.
as_monomial(^(Y, Z), m(1, Z, [v(Z, Y)])) :- !.
as_monomial(*(X, ^(Y, Z)), m(G, K, Q)) :- as_monomial(X, m(G, TD, Vars)), K is (TD + Z), ordina_m([v(Z, Y)| Vars], Q), !.
as_monomial(*(X, Y), m(G, K, Q)) :- as_monomial(X, m(G, TD, Vars)), K is (TD + 1), ordina_m([v(1, Y)| Vars], Q), !.
as_monomial(-(X), m(-A, Y, L)) :- as_monomial(X, m(A, Y, L)).
as_monomial(X, m(1, 1, [v(1, X)])).
ordina_m(List, Sorted) :- sort(2, #=<, List, Sorted).
ordina_poly1(List, Sorted) :- sort(2, #>=, List, Sorted).
ordina_poly2(List, Sorted) :- sort(3, #=<, List, Sorted).
is_monomial(m(_C, TD, VPs)) :- integer(TD), TD >= 0, is_list(VPs).
is_polynomial(poly(M)) :- is_list(M), foreach(member(Monomio, M), is_monomial(Monomio)).
as_polynomial(+(X, Y), poly(C)) :- as_monomial(Y, G), as_polynomial(X, poly(Gs)), inverti(G, H), inverti2(Gs, Hs), ordina_poly2([H| Hs], D), inverti2(D, F), ordina_poly1(F, C), !.
as_polynomial(-(X, Y), poly(C)) :- as_monomial(-Y, G), as_polynomial(X, poly(Gs)), inverti(G, H), inverti2(Gs, Hs), ordina_poly2([H| Hs], D), inverti2(D, F), ordina_poly1(F, C), !.
as_polynomial(X, poly([X])) :- is_monomial(X), !.
as_polynomial(X, poly([Q])) :- as_monomial(X, Q), is_monomial(Q).
/* coefficienti */
coefficients(Poly1, Result) :- is_polynomial(Poly1), coefficienti(Poly1, Result), !.
coefficients(Poly1, Result) :- as_polynomial(Poly1, Result1), coefficienti(Result1, Result), !.
coefficienti(poly([]), []) :- !.
coefficienti(poly([m(X, _, _)|Xs]), [X|Ys]) :- coefficienti(poly(Xs), Ys), !.
/* variabili */
variables(Poly1, Result) :- is_polynomial(Poly1), variabili(Poly1, Result), !.
variables(Poly1, Result) :- as_polynomial(Poly1, Result1), variabili(Result1, Result), !.
variabili(poly([]), []) :- !.
variabili(poly([m(_, _, X)|Xs]), [X|Ys]) :- variabili(poly(Xs), Ys), !.
/* monomi */
monomials(Poly1, Result) :- is_polynomial(Poly1), monomi(Poly1, Result), !.
monomials(Poly1, Result) :- as_polynomial(Poly1, Result1), monomi(Result1, Result), !.
monomi(poly([]), []) :- !.
monomi(poly([X|Xs]), [X|Ys]) :- monomi(poly(Xs), Ys), !.
/* somma */
polyplus(Poly1, Poly2, Result) :- is_polynomial(Poly1), is_polynomial(Poly2), poly_plus(Poly1, Poly2, Result), !.
polyplus(Poly1, Poly2, Result) :- is_polynomial(Poly1), as_polynomial(Poly2, Q), poly_plus(Poly1, Q, Result), !.
polyplus(Poly1, Poly2, Result) :- as_polynomial(Poly1, Q), is_polynomial(Poly2), poly_plus(Q, Poly2, Result), !.
polyplus(Poly1, Poly2, Result) :- as_polynomial(Poly1, Q1), as_polynomial(Poly2, Q2), poly_plus(Q1, Q2, Result).
poly_plus(poly([]), poly(Q), poly(Q)) :- !.
poly_plus(poly([X|Xs]), poly(Q), poly([X|Z])) :- poly_plus(poly(Xs), poly(Q), poly(Ys)), compress_somma(X, Ys, Z), compara(Ys, Z).
poly_plus(poly([X|Xs]), poly(Q), poly(Z)) :- poly_plus(poly(Xs), poly(Q), poly(Ys)), compress_somma(X, Ys, Z).
compress_somma(_X, [], []) :- !.
compress_somma(m(X,Y,Z), [m(R,Y,Z)| List1], [m(K,Y,Z)| List2]) :- compress_somma(m(X,Y,Z), List1, List2), K is (R + X), !.
compress_somma(X, [Y| List], [Y| List]) :- compress_somma(X, List, List).
/* differenza */
polyminus(Poly1, Poly2, Result) :- is_polynomial(Poly1), is_polynomial(Poly2), poly_minus(Poly1, Poly2, Result), !.
polyminus(Poly1, Poly2, Result) :- is_polynomial(Poly1), as_polynomial(Poly2, X), poly_minus(Poly1, X, Result), !.
polyminus(Poly1, Poly2, Result) :- as_polynomial(Poly1, X), is_polynomial(Poly2), poly_minus(X, Poly2, Result), !.
polyminus(Poly1, Poly2, Result) :- as_polynomial(Poly1, Y), as_polynomial(Poly2, Z), poly_minus(Y, Z, Result).
poly_minus(poly([]), poly(X), poly(X)) :- !.
poly_minus(poly([X|Xs]), poly(Q), poly([X|Z])) :- poly_minus(poly(Xs), poly(Q), poly(Ys)), compress_differenza(X, Ys, Z), compara(Ys, Z).
poly_minus(poly([X|Xs]), poly(Q), poly(Z)) :- poly_minus(poly(Xs), poly(Q), poly(Ys)), compress_differenza(X, Ys, Z).
compress_differenza(_X, [], []) :- !.
compress_differenza(m(X,Y,Z), [m(R,Y,Z)| List1], [m(K,Y,Z)| List2]) :- compress_differenza(m(X,Y,Z), List1, List2), K is (X - R), !.
compress_differenza(X, [Y| List], [Y| List]) :- compress_differenza(X, List, List).
/*moltiplicazione */
compara([], []) :- !.
compara([X|Xs], [X|Ys]) :- compara(Xs, Ys).
inverti(m(_, _, []), m(_, _, [])) :- !.
inverti(m(X, Y, [v(W, Z)| Xs]), m(X, Y, [v(Z, W)| Ys])) :- inverti(m(X, Y, Xs), m(X, Y, Ys)), !.
inverti2([], []) :- !.
inverti2([m(X, Y, [])| Zs], [m(X, Y, [])| Ss]) :- inverti2(Zs, Ss), !.
inverti2([m(X, Y, [v(W, Z)| Xs])| Zs], [m(X, Y, [v(Z, W)| Ys])| Ss]) :- inverti2([m(X, Y, Xs)| Zs], [m(X, Y, Ys)| Ss]), !.
The program gives me as output the right one but, instead of give me the end of the procedure it looks like it's waiting for something and I have to "force" the end with "enter". Is there some problem or it should be normal? Are you able to help me in someway? Thanks everyone
Okay. I solve my problem thanks to #coder. To solve it I put another cut (maybe the good one) in a single line of the closure "as_polynomial":
as_polynomial(+(X, Y), poly(C)) :- as_monomial(Y, G), as_polynomial(X, poly(Gs)), inverti(G, H), inverti2(Gs, Hs), ordina_poly2([H| Hs], D), inverti2(D, F), ordina_poly1(F, C), !.
as_polynomial(-(X, Y), poly(C)) :- as_monomial(-Y, G), as_polynomial(X, poly(Gs)), inverti(G, H), inverti2(Gs, Hs), ordina_poly2([H| Hs], D), inverti2(D, F), ordina_poly1(F, C), !.
as_polynomial(X, poly([X])) :- is_monomial(X), **!**.
as_polynomial(X, poly([Q])) :- as_monomial(X, Q), is_monomial(Q).
Then I also remove is_monomial(Q) because it was not useful
The question is to write a general rule to find any level of relative!
cousin(N,Child1,Child2).
So that it is true if Child1 and Child2 are Nth cousins. So
cousin1(Child1,Child2) = cousin(1,Child1,Child2) and
cousin2(Child1,Child2) = cousin(2,Child1,Child2) and so on
for third and fourth and even higher level cousins.
What I have so far:
/* first person is parent of second person */
parent(a, b).
parent(b, f).
parent(a, d).
parent(f, g).
parent(a, k).
parent(f, h).
parent(k, l).
parent(f, i).
parent(k, m).
parent(l, t).
parent(b, e).
sibling(X,Y) :- parent(Z,X), parent(Z,Y), not(X=Y).
grandparent(X, Z) :-
parent(X, Y),
parent(Y, Z).
greatgrandparent(X, Z) :-
parent(X, Y),
parent(Y, P),
parent(P, Z).
cousin1(Child1,Child2) :-
parent(Y1,Child1),
parent(Y2,Child2),
sibling(Y1,Y2).
cousin2(Child1,Child2) :-
greatgrandparent(Z, Child1),
greatgrandparent(Z, Child2),
\+sibling(Child1, Child2),
\+cousin1(Child1, Child2),
Child1 \= Child2.
This returns false regardless of values input, so clearly I have no idea what I am doing PLEASE help!
cousin(N,Child1,Child2) :-
nth0(N, parent(Y1,Child1),Y1),
nth0(N, parent(Y2,Child2),Y2),
cousin1(Y1,Y2).
I tried:
% first person is parent of second person
parent(a, b).
parent(b, f).
parent(a, d).
parent(f, g).
parent(a, k).
parent(f, h).
parent(k, l).
parent(f, i).
parent(k, m).
parent(l, t).
parent(b, e).
sibling(Sib1,Sib2) :- parent(SomeParent,Sib1),
parent(SomeParent,Sib2),
\+ Sib1 = Sib2.
% first person is ancestor of second person
ancestor(Older,Younger,L) :-
parent(Older,Younger),
L is 1.
ancestor(Older,Younger,Level) :-
parent(Older,Child),
ancestor(Child,Younger,L),
Level is L + 1.
%nth_cousin(Level,Cous1,Cous2) :-
% ancestor(Sib1,Cous1,Level),
% ancestor(Sib2,Cous2,Level),
% sibling(Sib1,Sib2).
nth_cousin(Level,Cous1,Cous2) :-
setof((Cous1,Cous2), Sib1^Sib2^(ancestor(Sib1,Cous1,Level),
ancestor(Sib2,Cous2,Level),
sibling(Sib1,Sib2)
),
Cousins),
member((Cous1,Cous2), Cousins),
\+ (Cous2#<Cous1, member((Cous2,Cous1), Cousins)).
Ex.
1 ?- nth_cousin(1,Cous1,Cous2).
Cous1 = e,
Cous2 = l ;
Cous1 = e,
Cous2 = m ;
Cous1 = f,
Cous2 = l ;
Cous1 = f,
Cous2 = m ;
false.
2 ?- nth_cousin(2,Cous1,Cous2).
Cous1 = g,
Cous2 = t ;
Cous1 = h,
Cous2 = t ;
Cous1 = i,
Cous2 = t ;
false.