Prolog - finding a common ancestor in a binary tree - prolog

Let's say you have a binary search tree:
t (73, t (31, t(5,nil,nil), nil), t (101, t (83, nil, t(97,nil,nil)), t(200,nil,nil)))
which is:
73
/ \
31 101
/ / \
5 83 200
/
97
I need to write a predicate subtree(X1,X2,T) that would take 2 values from the tree (X1 and X2) and find the smallest common parent for them, and store its subtree in T.
So for the example above, if I query : subtree(83,200,X).
I should be getting back:
t(101,t(83,nil,t(97,nil,nil)),t(200,nil,nil))
which is:
101
/ \
83 200
/
97
Since 101 is the smallest common value to both of my numbers, I get that subtree back. How could I do that?
Thanks!


Here is my code for this problem. Just call
tree(X),common_ancestor(83,200,X,Y)
You will get your answer in Y.
tree3(X) :- X = t (73, t (31, t(5,nil,nil), nil), t (101, t (83, nil, t(97,nil,nil)), t(200,nil,nil))).
% Chech membership in tree:
in(X, t(X, _, _)).
in(X, t(_, L, _)):-
in(X, L).
in(X, t(_, _, R)):-
in(X, R).
% Getting subtree given the value of root
get_subtree(X, t(X, L, R),Res) :- Res = t(X,L,R).
get_subtree(X, t(_, L, _),Res):-
get_subtree(X, L,Res).
get_subtree(X, t(_, _, R),Res):-
get_subtree(X, R,Res).
% least_common_ancestor(N1, N2, Tree, Res) assignes the value of the least common ancestor to Res.
% Note that it's assumed all nodes have different values.
% Base cases: when one value is the parent of the other, then the parent is the LCA:
least_common_ancestor(N1, N2, t(N1, L, R), N1):-
(in(N2, L) ; in(N2, R)), !.
least_common_ancestor(N1, N2, t(N2, L, R), N2):-
(in(N1, L) ; in(N1, R)), !.
% If one is in the left (right) subtree and the other is in the right (left) subtree then the current root is the LCA
least_common_ancestor(N1, N2, t(X, L, R), Res):-
((in(N1, L), in(N2, R)) ; (in(N1, R), in(N2, L))), !,
Res = X.
% Otherwise, recurse to both subtrees:
least_common_ancestor(N1, N2, t(_, L, _), Res):-
least_common_ancestor(N1, N2, L, Res), !.
least_common_ancestor(N1, N2, t(_, _, R), Res):-
least_common_ancestor(N1, N2, R, Res).
% The main function
commonGP(Ka,Kb,T,ST) :-
least_common_ancestor(Ka,Kb,T,Res), get_subtree(Res,T,ST).

Related

Prolog How to write a predicate sum 3 max values in list?

How to write a predicate sum 3 max values in list?
max3(L,X)
Example:
max3([1,7,9,3,5],X).
X = 21.

As a starting point:
% Can potentially change order of the list in Rest
list_max_rest([H|T], Max, Rest) :-
list_max_rest_(T, H, Max, Rest).
list_max_rest_([], Max, Max, []).
list_max_rest_([H|T], P, Max, [P|Rest]) :-
H #> P,
!,
list_max_rest_(T, H, Max, Rest).
list_max_rest_([H|T], P, Max, [H|Rest]) :-
list_max_rest_(T, P, Max, Rest).
Usage:
?- list_max_rest([2,1,200,9], Max, Res).
Max = 200,
Res = [1, 2, 9].
Use that 3 times...

max3(Ls, X) :-
select(A, Ls, Ls2),
select(B, Ls2, Ls3),
select(C, Ls3, Ls4),
A >= B,
B >= C,
\+ (member(Q, Ls4), Q > C),
X is A+B+C.
Take A from the list, B from the remainder, C from that remainder, they must be A>=B>=C, and there must not be a member Q left in the remainder which is bigger than C. Add those up.
This is not efficient; brebs' suggestion of:
max3(Ls, X) :-
sort(0, #>=, Ls, [A,B,C|_]),
X is A+B+C.
is neater

Prolog | find the path from root to leaf with the maximal sum of node value

I need to create a prolog relation that receives a tree, sums the values in each nodes and finds the path with the maximal sum.
I've tried this method of a max sub tree:
max_sub_tree(Tree,T,N):-
sol_tree_noroot(Tree,T1,N1),
sol_tree_withroot(Tree,T2,N2),!,
max_set(T1,N1,T2,N2,T,N).
max_set(T1, N1, T2, N2, T, N) :-
(N1>N2,T=T1,N=N1;
N2>N1,T=T2,N=N2;
N2=:=N1,N=N1,(T=T1;T=T2)).
sol_tree_noroot(nil,nil,0).
sol_tree_noroot(t(L,_,R),T,N):-
max_sub_tree(L,T1,N1),max_sub_tree(R,T2,N2),!,
max_set(T1, N1, T2, N2, T, N).
sol_tree_withroot(nil,nil,0).
sol_tree_withroot(t(L,X,R),t(L1,X,R1),N3):-
sol_tree_withroot(L,T1,N1),sol_tree_withroot(R,T2,N2),
max_set2(T1,N1,T2,N2,L1,R1,N),
N3 is N+X.
max_set2(T1,N1,T2,N2,L,R,N):-
(N1>0,N2>0,N is N1+N2,L=T1,R=T2;
N1>=0,N2<0,N is N1 ,R=nil,L=T1;
N1<0,N2>=0,N is N2 ,L=nil,R=T2;
N1<0,N2<0,N1<N2,N is N2 ,L=nil,R=T2;
N1<0,N2<0,N1>N2,N is N1 ,L=T1,R=nil;
N1>0,N2=0,N is N1,(L=T1,R=nil;L=T1,R=T2);
N1=0,N2>0,N is N2,(R=T2,L=nil;L=T1,R=T2);
N1=0,N2=0,N is N1,(L=T1,R=nil;R=T2,L=T1;L=T1,R=T2)).
When I use the query
max_sub_tree(t(t(t(nil,2,nil),1,t(t(nil,40,nil),-30,nil)),-100,t(nil,50,t(nil,60,nil))) ,T,N).
I get
N = 110,
T = t(nil, 50, t(nil, 60, nil))
But I want the output to look like this:
N = 10,
T =.. [t, -100, 50, 60]
What Am I missing? how do I include the root? do i need to start over?

Subtree Sums
This looks complicated, might I suggest we start from how to generate the sums of the subtrees that terminate in leaf nodes:
tree_sum(t(nil, N, nil), N). % leaf
tree_sum(t(T, N, nil), X) :- % only left branch
tree_sum(T, M), X is N + M.
tree_sum(t(nil, N, T), X) :- % only right branch
tree_sum(T, M), X is N + M.
tree_sum(t(T1, N, T2), X) :- % branches
( tree_sum(T1, M), X is N + M
; tree_sum(T2, M), X is N + M
).
That disjunction is where we need to focus to find the maximum tree sum, let's add that into our code next. There's no change to the first three rules
max_tree_sum(t(nil, N, nil), N). % leaf
max_tree_sum(t(T, N, nil), X) :- % only left branch
max_tree_sum(T, M), X is N + M.
max_tree_sum(t(nil, N, T), X) :- % only right branch
max_tree_sum(T, M), X is N + M.
max_tree_sum(t(T1, N, T2), X) :-
max_tree_sum(T1, M1), X1 is N + M1,
max_tree_sum(T2, M2), X2 is N + M12,
X is max(X1, X2).
A solution
Ok, so our code is finding the maximum solution, now we need it to track the path, building the list. We add in the final argument for this and an extra sub-predicate to do the comparison of branches for us:
max_tree_sum(t(nil, N, nil), N, [N]). % leaf
max_tree_sum(t(T, N, nil), X, [N|MT]) :- % left branch only
max_tree_sum(T, M, MT), X is N + M.
max_tree_sum(t(nil, N, T), X, [N|MT]) :- % right branch only
max_tree_sum(T, M, MT), X is N + M.
max_tree_sum(t(T1, N, T2), X, [N|T]) :- % branches
max_tree_sum(T1, M1, MT1),
max_tree_sum(T2, M2, MT2),
max_subtree(M1, M2, MT1, MT2, M, T), X is M + N.
max_subtree(N1, N2, T1, _, N1, T1) :-
N1 >= N2.
max_subtree(N1, N2, _, T2, N2, T2) :-
N1 =< N2.
As Requested with T =.. [t|Nodes]
Now if you want the list converted to a predicate, put an extra predicate call to this:
max_subtree_sum(Tree, Sum, Pred) :-
max_tree_sum(Tree, Sum, Path),
Pred =.. [t|L].
?- max_subtree_sum(ExampleTree, 10, t(-100, 50, 60)).
But now t(-100, 50, 60) is not a tree.

Prolog path backtracking runs forever depending on grid size

I've written some code to do backtracking in Prolog that generates all the possible paths to reach the Gold cell from the initial one (Agent). The input of getAllPaths is the map size NxN. When I run it with a 6x6 map it works perfectly and prints all the possible paths, but when I input any map size >= 7 it prints the first path and gets stuck there when I require the next possible solution with ;. Here is my code:
gold(3, 3).
agent(1, 1).
getAllPaths(MS) :-
agent(X, Y),
assertz(worldSize(MS)),
getAllPathsRec(X, Y, [], []).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, V, L) :-
\+member((X, Y), V), append(V, [(X, Y)], VP),
((gold(X, Y), print(L)) ; move(X, Y, VP, L)).
% Left
move(X, Y, V, L) :-
XP is X - 1, XP > 0,
append(L, [l], LP),
getAllPathsRec(XP, Y, V, LP).
% Right
move(X, Y, V, L) :-
XP is X + 1, worldSize(MS), XP =< MS,
append(L, [r], LP),
getAllPathsRec(XP, Y, V, LP).
% Up
move(X, Y, V, L) :-
YP is Y + 1, worldSize(MS), YP =< MS,
append(L, [u], LP),
getAllPathsRec(X, YP, V, LP).
% Down
move(X, Y, V, L) :-
YP is Y - 1, YP > 0,
append(L, [d], LP),
getAllPathsRec(X, YP, V, LP).
The output:
?- getAllPaths(6).
[r,r,r,r,r,u,l,l,l,l,l,u,r,r]
true ;
[r,r,r,r,r,u,l,l,l,l,l,u,r,u,l,u,r,r,r,r,r,d,l,l,l,d]
true ;
[r,r,r,r,r,u,l,l,l,l,l,u,r,u,l,u,r,r,r,r,r,d,l,l,d,l]
true ;
[...]
?- getAllPaths(7).
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r]
true ;
% It gets stuck here forever...
First I thought it would be for some depth recursion limits, but it's so strange because the map size is only incremented from 36 to 49, and I would probably get some warning or error, but it displays nothing. Any clue?

Here is my variation.
getAllPaths_01(MS, R) :-
agent(X, Y),
getAllPathsRec_01(MS, X, Y, [], R).
getAllPathsRec_01(_MS, X, Y, _V, []) :-
gold(X,Y), !.
% Positions, Visited list, and Path list
getAllPathsRec_01(MS, X, Y, V, R) :-
\+ memberchk((X, Y), V),
move_01(MS, X, Y, [(X, Y)|V], R).
% Left
move_01(MS, X, Y, V, [l|R]) :-
XP is X - 1, XP > 0,
getAllPathsRec_01(MS, XP, Y, V, R).
% Right
move_01(MS, X, Y, V, [r|R]) :-
XP is X + 1, XP =< MS,
getAllPathsRec_01(MS, XP, Y, V, R).
% Up
move_01(MS, X, Y, V, [u|R]) :-
YP is Y + 1, YP =< MS,
getAllPathsRec_01(MS, X, YP, V, R).
% Down
move_01(MS, X, Y, V, [d|R]) :-
YP is Y - 1, YP > 0,
getAllPathsRec_01(MS, X, YP, V, R).
count(S,N) :-
bagof(L,getAllPaths_01(S,L),Ls),
length(Ls,N).
This removes the use assertz/1 so that rerunning the query does not add multiple facts, changes member/2 to memerchk/2 for efficiency, builds the path upon backtracking to avoid append/3, and added a cut to remove the duplicate answers.
Since the result is returned to the top level, added count/2 to show the counts instead of the list.
?- count(3,N).
N = 12.
?- count(4,N).
N = 132.
?- count(5,N).
N = 6762.
?- count(6,N).
N = 910480

This code improve the performance.
I think it's a bad design to mix the search and the printing of the result.
gold(3, 3).
agent(1, 1).
getAllPaths(MS, L) :-
agent(X, Y),
retractall(worldSize(_)),
assertz(worldSize(MS)),
getAllPathsRec(X, Y, [], [], L).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, _V, L, NL) :-
gold(X, Y),
reverse(L, NL).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, V, CL, L) :-
\+member((X, Y), V),
% useless
% append(V, [(X, Y)], VP),
move(X, Y, CL, NX, NY, NL),
% No need to use append to build the list of visited nodes
getAllPathsRec(NX, NY, [(X,Y) | V], NL, L).
% Left
move(X, Y, L, NX, Y, [l|L]) :-
X > 1 ,NX is X - 1.
% Right
move(X, Y, L, NX, Y, [r|L]) :-
worldSize(MS), X < MS,NX is X + 1.
% Up
move(X, Y, L, X, NY, [u|L]) :-
worldSize(MS), Y < MS, NY is Y + 1.
% Down
move(X, Y, L, X, NY, [d|L]) :-
Y > 1, NY is Y - 1.
I get :
?- getAllPaths(7, V), writeln(V).
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,l]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,l,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,l,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,l,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,r,u,l,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,u,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,d,r,u,u,l,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] .

get sublist of all elements that create specific word prolog

i want to get a sublist of all elements that assemble specific word for example
for the call
assemble([hello,'',world,hi,bye,good,well], 'hello world', A).
program should print
A=[hello,'',world]
for the call
assemble([abc,123,ab,c,123],'abc123', A).
program should print
A=[abc,123];
A=[ab,c,123];
thanks for your help.
matchwords(W1, W2, Results) :-
setof(R, matchw(W1, W2, R), RSet), % Collect all the matching substrings
% and their lengths
reverse(RSet, Set), % Order by longest first
highest(Set, Results). % keep only the highest ones
matchw(W1, W2, N-Result) :-
atom_chars(W1, A1),
atom_chars(W2, A2),
matchl(A1, A2, R),
length(R, N),
atom_chars(Result, R).
matchl([H|T1], [H|T2], [H|T]) :-
matchl(T1, T2, T).
matchl([H1|T1], [H2|T2], R) :-
H1 \= H2,
( matchl(T1, [H2|T2], R) ; matchl([H1|T1], T2, R) ).
matchl([], _, []).
matchl([_|_], [], []).
highest([_-W], [W]).
highest([N1-W1,N2-_|_], [W1]) :-
N1 > N2.
highest([N1-W1,N2-W2|T], [W1|WT]) :-
N1 = N2,
highest([N2-W2|T], WT).

prolog:search in binary search tree

i need to covert list to binary search tree ,then search about range of ages in this tree and return the a list contain these values, and also return number of checks in order to build the output list .
i spend two days trying do this but it always return false
here my last code that i reach it with help of mbratch:
my_list( [[30,'john'], [58,'alex'], [14,'randy'], [65,'shawn'], [67,'jack']] ).
construct(L,T) :- construct(L,T,nil).
construct([],T,T).
construct([N|Ns],T,T0) :- add(N,T0,T1), construct(Ns,T,T1).
add(X, nil, node(X, nil, nil)).
add(X, node(Root, L, R),node(Root, L1, R)) :- X #< Root, add(X, L, L1).
add(X, node(Root, L, R),node(Root, L, R1)) :- X #> Root, add(X, R, R1).
findInRange(R1, R2, T, S, N) :- find(R1, R2, T, S, N),!.
find(_R1,_R2, nil, [], 0).
find(R1, R2, node([Age,Name],L,R), S, N) :-
R1 =< Age,R2 >= Age, % is the age OK (in range), if it is check left and
find(R1, R2, L, LL, NL),
find(R1,R2,R,LR,NR),
append([[Age,Name]],LL,X),
append(X,LR,S),
N is NL+NR+1.
find(R1, R2, node([Age,Name],L,R), [], 0) :-
Age > R2;Age<R1. % if the age is greater than R2, return []
find(R1, R2, node([Age,Name],L,R), LL, N) :-
R1 < Age, % if the age is bigger than R1 search the left tree return LL
find(R1,R2,L,LL,NL),
N is NL+1.
find(R1, R2, node([Age,Name],L,R), LR, N) :-
R2 > Age, % if the age smaller than R1 search the right tree return LR
find(R1,R2,R,LR,NR),
N is NR+1.
and here is my query :
my_list(Z), construct(Z, T), findInRange(11, 15, T, S, N).
it should retufn [[14,'randy']] and number of checks.
Why does it return empty list and N=0 ?

I think this will do the trick. I ran the query you posted and got S = [[30, john], [14, randy]].
my_list( [[30,'john'], [58,'alex'], [14,'randy'], [65,'shawn'], [67,'jack']] ).
construct(L,T) :- construct(L,T,nil).
construct([],T,T).
construct([N|Ns],T,T0) :- add(N,T0,T1),construct(Ns,T,T1).
add(X, nil, node(X, nil, nil)).
add(X, node(Root, L, R),node(Root, L1, R)) :- X #< Root, add(X, L, L1).
add(X, node(Root, L, R),node(Root, L, R1)) :- X #> Root, add(X, R, R1).
findInRange(R1, R2, T, S, N) :- find(R1, R2, T, S, N),!.
find(_R1,_R2, nil, [], 0).
find(R1, R2, node([Age,Name],L,R), S, N) :-
R1 =< Age,R2 >= Age, % is the age OK (in range), if it is check left and right side
find(R1, R2, L, LL, NL),
find(R1,R2,R,LR,NR),
append([[Age,Name]| LL],LR,S),
N is NL+NR+1.
find(R1, R2, node([Age,Name],L,R), LL, N) :-
Age > R2, % if the age is bigger than R2 search the left tree return LL
find(R1,R2,L,LL,NL),
N is NL+1.
find(R1, R2, node([Age,Name],L,R), LR, N) :-
R1 > Age, % if the age smaller than R1 search the right tree return LR
find(R1,R2,R,LR,NR),
N is NR+1.

Resources