The code below successfully finds a member in a binary tree. Except that now I want to find a member in a 2-3 tree. (Similar to the tree shown in https://www.youtube.com/watch?v=vSbBB4MRzp4.) The last line below is an attempt to do this. But I am unsure what to use for the items marked TBD (and other parts of this line could be wrong). Any help on how to do this? Thanks!
bTree(L,X,R).
member(X, bTree(L,Y,_)) :-
X #< Y,
member(X,L).
member(X, bTree(_,X,_)).
member(X, bTree(_,Y,R)) :-
X #> Y,
member(X,R).
member(X, bTree(L,Y,R)) :-
X #> TBD, X #< TBD
member(X,TBD).
In a 2–3-tree, each node can be a:
2-node, say t(Left,Key,Right), that has one key and two children, or
3-node, say t(Left,Key1,Middle,Key2,Right), that has two keys and three children.
Thus, the 2-3-tree:
can be represented as:
mytree(
t(t(t(nil,1,nil),
4,
t(nil,5,nil,7,nil),
13,
t(nil,15,nil)),
16,
t(t(nil,17,nil,19,nil),
20,
t(nil,22,nil),
24,
t(nil,29,nil)))
).
To search this tree, you can use the following predicate:
:- use_module(library(clpfd)).
% search 2-nodes: t(Left, Key, Right)
has(t(L,X,_), K) :- K #< X, has(L, K).
has(t(_,K,_), K).
has(t(_,X,R), K) :- K #> X, has(R, K).
% search 3-nodes: t(Left, Key1, Middle, Key2, Right)
has(t(L,X,_,_,_), K) :- K #< X, has(L, K).
has(t(_,K,_,_,_), K).
has(t(_,X,M,Y,_), K) :- K #> X, K #< Y, has(M, K).
has(t(_,_,_,K,_), K).
has(t(_,_,_,Y,R), K) :- K #> Y, has(R, K).
Examples:
?- mytree(T), has(T, 51).
false.
?- mytree(T), has(T, 16).
T = t(t(t(nil, 1, nil), 4, t(nil, 5, nil, 7, nil), 13, t(nil, 15, nil)), 16, t(t(nil, 17, nil, 19, nil), 20, t(nil, 22, nil), 24, t(nil, 29, nil))) .
?- mytree(T), forall(has(T,X), writeln(X)).
1
4
5
7
13
15
16
17
19
20
22
24
29
T = t(t(t(nil, 1, nil), 4, t(nil, 5, nil, 7, nil), 13, t(nil, 15, nil)), 16, t(t(nil, 17, nil, 19, nil), 20, t(nil, 22, nil), 24, t(nil, 29, nil))).
Related
I have a semi complex shift scheduling problem in prolog. From what I saw it can be solved with CLF but I am not that familiar and the resources online didn't really help me.
The problem states that the company has 50 employees and that each employee can either work in the morning shift(M), the evening shift(E), the night shift(N) or have a rest day(R). The problem has 2 constraints: That at least 15 employees must work at the morning shift(M), 10 in the evening one(E) and 8 in the night one(N) and that no employee can work the night shift(N) and have a morning shift(M) the next day.Also in a period of 7 days an employee must have at least 2 days off fro example from day 1 to 7 atleast two R and the same from 2 to 8.
It asks to produce a 30 day schedule by satisfying the above constraints and that multiple solutions exist.
What could be some way to approach the problem and how could I implement it using code in prolog?
Thank you very much!
Here a solution with out the last task
days_in_month(30).
employees_num(50).
go :-
days_in_month(Days),
length(M, Days),
days(M),
show_days(M).
days([D1, D2|T]) :-
two_days(D1, D2),
(T = [] ; days([D2|T])).
other_day_constraints(D) :-
day_constraint(10, e, D),
maplist(rest_if_not_work, D).
day_constraint(Min, Element, Lst) :-
employees_num(EmpsNum),
list_has_ge_elements_being(Min, Element, EmpsNum, Lst).
two_days(D1, D2) :-
% Set the full number of employees, otherwise prevent_double_shift can shorten the list
employees_num(EmpsNum),
length(D1, EmpsNum),
length(D2, EmpsNum),
% Pass the 2-day constraint first
day_constraint(8, n, D1),
prevent_double_shift(D1, D2),
day_constraint(15, m, D2),
% Remainder of the day constraints
day_constraint(15, m, D1),
day_constraint(8, n, D2),
other_day_constraints(D1),
other_day_constraints(D2).
prevent_double_shift([], []).
prevent_double_shift([H1|T1], [H2|T2]) :-
(H1 == n -> dif(H2, m) ; true),
prevent_double_shift(T1, T2).
rest_if_not_work(E) :-
(var(E) -> E = r ; true).
show_days([]).
show_days([D|T]) :-
show_day(D),
show_days(T).
show_day(D) :-
forall(member(E, D), (upcase_atom(E, U), write(U))),
nl.
list_has_ge_elements_being(Min, Elem, MaxLen, L) :-
list_has_ge_elements_being_(L, Min, Elem, MaxLen).
list_has_ge_elements_being_(L, Min, Elem, Min) :-
!,
length(L, Min),
maplist(=(Elem), L).
list_has_ge_elements_being_(_L, 0, _Elem, _MaxLen).
list_has_ge_elements_being_([H|T], Min, Elem, MaxLen) :-
Min #> 0,
MaxLen #> Min,
( H = Elem,
Min0 is Min - 1
; Min0 = Min
),
MaxLen0 is MaxLen - 1,
list_has_ge_elements_being_(T, Min0, Elem, MaxLen0).
Here's part of the puzzle - I'm sure you can figure out the rest:
split_list_length_excl_rem(SegLen, L, Segs) :-
length(L, Len),
between(1, Len, SegLen),
split_list_length_excl_rem_(SegLen, Len, L, Segs).
split_list_length_excl_rem_(SegLen, Len, L, Segs) :-
( Len #< SegLen
-> Segs = []
; length(Seg, SegLen),
split_list_length_excl_rem_seg_(Seg, L, R),
Segs = [Seg|SegsT],
Len0 is Len - SegLen,
split_list_length_excl_rem_(SegLen, Len0, R, SegsT)
).
split_list_length_excl_rem_seg_([], R, R).
split_list_length_excl_rem_seg_([H|T], [H|LT], R) :-
split_list_length_excl_rem_seg_(T, LT, R).
Results in swi-prolog:
?- numlist(1, 30, NL), split_list_length_excl_rem(7, NL, S).
NL = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30],
S = [[1, 2, 3, 4, 5, 6, 7], [8, 9, 10, 11, 12, 13, 14], [15, 16, 17, 18, 19, 20, 21], [22, 23, 24, 25, 26, 27, 28]].
Oops, misread the week bit, this is more appropriate:
sliding_segment(SegLen, L, Seg) :-
length(L, Len),
between(1, Len, SegLen),
length(Seg, SegLen),
sliding_segment_(L, Seg).
sliding_segment_([H|T], Seg) :-
fill_list_copy(Seg, [H|T]).
sliding_segment_([_|T], Seg) :-
sliding_segment_(T, Seg).
fill_list_copy([], _).
fill_list_copy([H|T], [H|R]) :-
fill_list_copy(T, R).
Results in swi-prolog:
?- numlist(1, 30, NL), sliding_segment(7, NL, Seg).
Seg = [1, 2, 3, 4, 5, 6, 7] ;
Seg = [2, 3, 4, 5, 6, 7, 8] ;
Seg = [3, 4, 5, 6, 7, 8, 9] ;
...
Seg = [23, 24, 25, 26, 27, 28, 29] ;
Seg = [24, 25, 26, 27, 28, 29, 30] ;
false.
Given a binary tree in a format of list of adjacencies such as [1-8,1-2,...]
The elements in the list are not in any particular order.
Given the root of the tree the list needs to be converted to a recursive format t(L,Root,R). Where L and R are trees themselves or nil.
This is what I have tried:
% convert binary tree from adjacencies list to recursive term format.
% make_tree(AdjList, Root, Tree)
make_tree([],Root,t(nil,Root,nil)):-!.
make_tree([Root-X],Root,t(X,Root,nil)).
make_tree([Root-X],Root,t(nil,Root,X)):-!.
make_tree(_,nil,nil):-!.
make_tree(N,Root,t(L,Root,R)):-
find_kids(N,Root,C,S),
reorder(C,[C1,C2]),
make_tree(S,C1,L), make_tree(S,C2,R).
% reorder 2 out of 2
reorder([X,Y],[Y,X]).
reorder([X,Y],[X,Y]).
% find children and remove them from list of nodes
find_kids(L,Root,[C1,C2],R):-
find_children(L,Root,[C1,C2|_],R).
find_children([Root-Y|Xs],Root,[Y|T],Acc):-
find_children(Xs,Root,T,Acc).
find_children([X-Y|Xs],Root,R,[X-Y|Acc]):-
X \= Root,
find_children(Xs,Root,R,Acc).
find_children([],_,[nil,nil],[]).
Consider the following binary tree and an arbitrary adjacency list for it:
% 0
% / \
% 1 2
% / \ / \
% 3 4 5 6
% / \ \
% 7 8 9
adj_list([1-3,0-2,1-4,5-9,3-7,2-5,2-6,3-8,0-1]).
To get the children of a node, you can use the following predicate:
find_children(Root, List, Children, Rest) :-
partition({Root}/[X-_]>>(X=Root), List, Children0, Rest),
maplist([Root-Child, Child]>>true, Children0, Children).
Examples:
?- adj_list(List), find_children(3, List, Children, Rest).
List = [1-3, 0-2, 1-4, 5-9, 3-7, 2-5, 2-6, 3-8, ... - ...],
Children = [7, 8],
Rest = [1-3, 0-2, 1-4, 5-9, 2-5, 2-6, 0-1].
?- adj_list(List), find_children(5, List, Children, Rest).
List = [1-3, 0-2, 1-4, 5-9, 3-7, 2-5, 2-6, 3-8, ... - ...],
Children = [9],
Rest = [1-3, 0-2, 1-4, 3-7, 2-5, 2-6, 3-8, 0-1].
?- adj_list(List), find_children(4, List, Children, Rest).
List = Rest, Rest = [1-3, 0-2, 1-4, 5-9, 3-7, 2-5, 2-6, 3-8, ... - ...],
Children = [].
To build all possible binary trees from a given root, you can use the following code:
% trees(+Root, -Tree)
trees(Root, Tree) :-
adj_list(List),
make_tree(Root, List, _Rest, Tree).
% make_tree(+Root, +List, -Rest, -Tree)
make_tree(Root, List, Rest, Tree) :-
find_children(Root, List, Children, Rest0),
make_tree(Children, Root, Rest0, Rest, Tree).
make_tree([], Root, List, List, t(nil, Root, nil)).
make_tree([X], Root, List, Rest, Tree) :-
make_tree(X, List, Rest, Subtree),
( Tree = t(Subtree, Root, nil)
; Tree = t(nil, Root, Subtree) ).
make_tree([X,Y], Root, List, Rest, Tree) :-
make_tree(X, List, Rest0, Subtree1),
make_tree(Y, Rest0, Rest, Subtree2),
( Tree = t(Subtree1, Root, Subtree2)
; Tree = t(Subtree2, Root, Subtree1) ).
Examples:
?- trees(4, T).
T = t(nil, 4, nil).
?- trees(3, T).
T = t(t(nil, 7, nil), 3, t(nil, 8, nil)) ;
T = t(t(nil, 8, nil), 3, t(nil, 7, nil)).
?- trees(5, T).
T = t(t(nil, 9, nil), 5, nil) ;
T = t(nil, 5, t(nil, 9, nil)) ;
false.
?- trees(2, T).
T = t(t(t(nil, 9, nil), 5, nil), 2, t(nil, 6, nil)) ;
T = t(t(nil, 6, nil), 2, t(t(nil, 9, nil), 5, nil)) ;
T = t(t(nil, 5, t(nil, 9, nil)), 2, t(nil, 6, nil)) ;
T = t(t(nil, 6, nil), 2, t(nil, 5, t(nil, 9, nil))) ;
false.
I would advice about this exercise:
Write a method insert, which has 3 parameters, the first an ordered
list, the second an int and the third an ordered list without repeated
values equal as the first one but containing the second parameter.
Example:
> insert([5, 6, 30, 60, 90], 40, L)
L = [5, 6, 30, 40, 60, 90]
> insert([5, 6, 30, 60, 90], 30, L)
L = [5, 6, 30, 60, 90]
I would do:
insert([],_,[_]).
insert([H],_,Result) :-
Result < H,
insert([],[],[Result|H]).
insert([H],_,Result) :-
Result > H,
insert([],[],[H|Result]).
insert([H,Y|Rest], _, Result):-
_ < Y,
insert([X|Rest], [], Result).
insert([H,Y|Rest], _, Result):-
_ > Y,
insert([Y|Rest], [], Result).
But I think base case when there is only one element is redundant and not needed because of we have the general recursive case and the empty list one. I need some suggest to improve or better explanations to polish the code.
Thank you for your time.
Try with compare:
:- use_module(library(clpfd)).
insert([], X, [X]).
insert([X|Xs], New, Ys) :-
zcompare(Order, X, New),
insert(Order, X, New, Xs, Ys).
insert(>, X, New, Xs, [New,X|Xs]).
insert(=, X, _, Xs, [X|Xs]).
insert(<, X, New, Xs, [X|Ys]) :-
insert(Xs, New, Ys).
but maybe you need explanation? It is strange, because you could also just read documentation as I did and find why this is good enough implementation, but of course maybe it is good to explain more, just in case.
insert([], X, [X]).
When first argument is empty list, second argument is the only element of the result list.
insert([X|Xs], New, Ys) :-
zcompare(Order, X, New), ...
When first argument is list with at least one element, take head element and compare it to New element. After compare or zcompare first argument Order is either > or = or < (but what do these mean? maybe guess or maybe even read documentation if it is not too much work).
insert(Order, X, New, Xs, Ys).
After comparing take the Order and the rest of the variables and....
insert(>, X, New, Xs, [New,X|Xs]).
Element at head of list is larger than New element. This means that result list should be New element followed by head followed by rest of list.
insert(=, X, _, Xs, [X|Xs]).
Element at head of list is exactly the same as New element. We are done, no need to insert anything just keep original list as result.
insert(<, X, New, Xs, [X|Ys]) :-
insert(Xs, New, Ys).
Element at head of list is smaller than New element: New element must come after this element in result. So we put current element back in list and search for place of New element in rest of list.
So much text, but is it now easier to understand what code says? Maybe or maybe not?
there
?- insert([5, 6, 30, 60, 90], 40, L).
L = [5, 6, 30, 40, 60, 90].
?- insert([5, 6, 30, 60, 90], 6, L).
L = [5, 6, 30, 60, 90].
?- insert([5, 6, 30, 60, 90], 100, L).
L = [5, 6, 30, 60, 90, 100].
?- insert([5, 6, 30, 60, 90], 0, L).
L = [0, 5, 6, 30, 60, 90].
but there are more interesting things to do with this solution because it uses a predicate like zcompare/3 which looks a bit like compare/3 but it knows integer constraints so it is possible to query:
What integers can be inserted in list [1,3,4]?
?- insert([1,3,4], X, R).
R = [X, 1, 3, 4],
X in inf..0 ;
X = 1,
R = [1, 3, 4] ;
X = 2,
R = [1, 2, 3, 4] ;
X = 3,
R = [1, 3, 4] ;
X = 4,
R = [1, 3, 4] ;
R = [1, 3, 4, X],
X in 5..sup.
So you can insert any integer < 1 at front, or you can "insert" 1 that was there, or you can insert 2 between 1 and 3, or you can "insert" 3 or 4, or you can insert 5 or anything larger at the end of list.
Another way :
% First element of the list is smaller than V
% we keep on wth the rest of the list
insert([H | T], V, [H|V1]) :-
H < V, !, % remove choice points
insert(T, V, V1).
% First element of the list is equal than V
% insert([V | T] , V, [V|T]).
% corrected after **enoy** remark
insert([V | T] , V, [V|T]):- !.
% First element of the list is greater than V, found the place of V
insert([H | T] , V, [V,H|T]).
% insert V in an empty list (V is greater than all elements of the list)
insert([], V, [V]).
with the same results as the Users9213 answer.
EDIT A way to avoid cut is
% First element of the list is smaller than V
% we keep on with the rest of the list
insert([H | T], V, [H|V1]) :-
H < V,
insert(T, V, V1).
% First element of the list is equal than V
insert([V | T] , V, [V|T]).
% First element of the list is greater than V, found the place of V
insert([H | T] , V, [V,H|T]):-
H > V.
% insert V in an empty list (V is greater than all elements of the list)
insert([], V, [V]).
I need to write a progam which is getting arguments:
list_of_numbers,
result_number,
Result_list (for generating list of signs).
And is generating a list of operation sings + and - that in arithmetical meaning have a result of result_number. Also, it does concatenation of numbers to make new ones so the arithmetical meaning would be right.
So, for example, if we have a method arrange_signs(list_of_numbers, result_number, Result_List), here's how it would work:
?- arrange_signs([1, 2, 3, 4, 5, 6, 7, 8, 9], 4, Result_List).
12-3+45-67+8-9 = 4
?- arrange_signs([1, 2, 3, 4, 5, 6, 7, 8, 9], 15, Result_List).
1+2-34+56+7-8-9 = 15
How to write a program which is doing that?
I've written a program which is doing this:
?- arrange_signs([12, 3, 45, 67, 8, 9], 4, Result_List).
12-3+45-67+8-9 = 4
?- arrange_signs([1, 2, 34, 56, 7, 8, 9], 15, Result_List).
1+2-34+56+7-8-9 = 15
But I'm not sure how to write a program that is working with [1, 2, 3, 4, 5, 6, 7, 8, 9].
Here's my code:
arrange_signs([Number|Number_List],Result,Result_List) :-
generateOperationList(Number_List, [], OperationList),
find_result(Number,Number_List,OperationList,Result),
getResult([Number|Number_List], OperationList, Result_List),
show_result(Result_List, Result).
generateOperationList([_Head|Tail], Temp_List, [First_Operation|OperationList]) :-
getSign(First_Operation),
generateOperationList(Tail, Temp_List, OperationList).
generateOperationList([],Temp_List,Temp_List).
getSign('-').
getSign('+').
getOperation(Number1, '-', Number2, Answer) :-
Answer is Number1 - Number2.
getOperation(Number1, '+', Number2, Answer) :-
Answer is Number1 + Number2.
getResult([Number|Number_List], [Operation|OperationList], [Number,Operation|Result_List]) :-
getResult(Number_List, OperationList, Result_List).
getResult(Number_List, [], Number_List).
find_result(Temp_Answer,[Number|Number_List],[Operation|OperationList],Result) :-
getOperation(Temp_Answer, Operation, Number, New_Temp_Result),
find_result(New_Temp_Result,Number_List,OperationList,Result).
find_result(New_Temp_Result,[],[],New_Temp_Result).
print_result(Ready_Result) :-
write(Ready_Result).
show_result([First_Element|Result_List],Result) :-
generate_result([First_Element|Result_List],Result,'',Ready_Result),
print_result(Ready_Result).
generate_result([First_Element|Result_List],Result,Formatting_Result,Ready_Result) :-
atom_concat(Formatting_Result, First_Element, New_Formatting_Result),
generate_result(Result_List,Result,New_Formatting_Result,Ready_Result).
generate_result([],Result,Formatting_Result,Ready_Result) :-
atom_concat(Formatting_Result, '=', Temp_Variable),
atom_concat(Temp_Variable, Result, New_Formatting_Result),
generate_result(New_Formatting_Result,Ready_Result).
generate_result(New_Formatting_Result,New_Formatting_Result).
Sorry but I find difficult to understand your code.
I propose the following solution
atomL_concat([], '').
atomL_concat([A | T], C1) :-
atomL_concat(T, C0),
atom_concat(A, C0, C1).
arrangeS([], Target, Target, [' = ', ATarget]) :-
number_atom(Target, ATarget).
arrangeS([NH | NT], Target, Sum0, ['+', ANH | ST]) :-
Sum1 is Sum0 + NH,
arrangeS(NT, Target, Sum1, ST),
number_atom(NH, ANH).
arrangeS([NH | NT], Target, Sum0, ['-', ANH | ST]) :-
Sum1 is Sum0 - NH,
arrangeS(NT, Target, Sum1, ST),
number_atom(NH, ANH).
arrangeS([NH1, NH2 | NT], Target, Sum, ResList) :-
NH is NH1 * 10 + NH2,
arrangeS([NH | NT], Target, Sum, ResList).
arrange_signs(NumList, Target, ResList) :-
arrangeS(NumList, Target, 0, ['+'|ResList]),
atomL_concat(ResList, PrintList),
write(PrintList), nl.
If you want accept solutions starting with a negative number (by example: "-12-3-4+5-6+7+8+9 = 4") you can remove the first + removal and write arrange_signs/2 as
arrange_signs(NumList, Target, ResList) :-
arrangeS(NumList, Target, 0, ResList),
atomL_concat(ResList, PrintList),
write(PrintList), nl.
but, in this case, the solutions starting with a positive number are preceded by a + sign (so "+1+2-34+5+6+7+8+9 = 4" instead of "1+2-34+5+6+7+8+9 = 4").
I'm new to Prolog and I have the following question: How can I decompose a natural number N into a list, containing consecutive natural numbers whose sum is equal to N?
For example:
N=10, R=[1,2,3,4];
N=80, R=[14, 15, 16, 17, 18];
N=99, R=[4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14]
R=[7, 8, 9, 10, 11, 12, 13, 14, 15]
R=[14, 15, 16, 17, 18, 19]
R=[32, 33, 34]
R=[49, 50]
EDIT:
I have tried to build the lists without using default methods and so far I managed to write this piece:
cand([H|_],H).
cand([_|T],E):-
cand(T,E).
suma([],0).
suma([H|T],S):-
suma(T,Temp),
S is Temp+H.
list(0,[]).
list(N,[Nr|R]):-
Nr is N-1,
list(Nr,R).
generate(_,_,A,_,A).
generate(N,L,[H|T],S,R):-
S<N,
cand(L,E),
not(cand([H|T],E)),
E=:=H-1,
suma([H|T],S),
generate(N,L,[E,H|T],S,R).
start(N,Rez):-
list(N,L),
cand(L,E1),
cand(L,E2),
E2=:=E1-1,
generate(N,L,[E2,E1],0,Rez).
But for some reason, no matter the number I input, the result is always the empty list.
Use clpfd constraints to see that there are more solutions than you show:
:- use_module(library(clpfd)).
n_list(N, Ls) :-
L #=< N,
L #> 0,
indomain(L),
length(Ls, L),
Ls ins 0..N,
foldl(consecutive, Ls, _, _),
sum(Ls, #=, N),
label(Ls).
consecutive(A, Prev, A) :- A #= Prev + 1.
Example:
?- n_list(10, Ls).
Ls = [10] ;
Ls = [1, 2, 3, 4] ;
Ls = [0, 1, 2, 3, 4] ;
false.
Another example:
?- n_list(80, Ls).
Ls = [80] ;
Ls = [14, 15, 16, 17, 18] ;
false.
I leave making this faster as an exercise for you.
This follows up on #mat's previous answer.
Want mo' speed? Use redundant constraints like this!
n_list(N, Ls) :-
L #=< N,
L #> 0,
L0 #= L-1,
N0 #= (L0*L0+L0)//2,
N #= N0+K*L,
K #>= 0,
indomain(L),
length(Ls, L),
Ls ins 0..N,
foldl(consecutive, Ls, _, _),
sum(Ls, #=, N),
label(Ls).
Runtime without redundant constraints:
?- time((N in 1..100,indomain(N),n_list(N,_),false)).
% 1,048,270,907 inferences, 85.594 CPU in 85.552 seconds (100% CPU, 12247032 Lips)
false.
Runtime with redundant constraints:
?- time((N in 1..100,indomain(N),n_list(N,_),false)).
% 10,312,514 inferences, 0.834 CPU in 0.833 seconds (100% CPU, 12369051 Lips)
false.