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))).
I want to multiply elements in a List with findall/3. Specifically I have two functions double(X,Y) which doubles X and square(X,Y) that returns the squared value of X. My problem is that it the operation works only for the first element of the list.
double(X,Y) :- Y is X*2.
square(X,Y) :- Y is X*X.
map_f(Operation,[H|List],[R|Results]) :-
Predicate=..[Operation,H,R],
call(Predicate),
findall(X,( member(X,List) ), Results).
For example, if I type map_f(double,[3,1,2,6,3,1,6],L). ,
I expect the output: L = [6,2,4,12,6,2,12],
but instead it shows:
?- map_f(double, [3, 1, 2, 6, 3, 1, 6], List).
List = [6, 1, 2, 6, 3, 1, 6]
Yes (0.00s cpu)
Any help will be very appreciated.
If you want to use findall/3, you'd have to write it like this:
?- Xs = [3,1,2,6,3,1,6], findall(Y, ( member(X, Xs), double(X, Y) ), Ys).
Xs = [3, 1, 2, 6, 3, 1, 6],
Ys = [6, 2, 4, 12, 6, 2, 12].
If you really want to pass the predicate as an argument and use =.., the logic is still the same, you'd just have to re-write your definition so that it does the right thing:
map_f(Pred_name, L1, L2) :-
Goal =.. [Pred_name, X, Y],
findall(Y, ( member(X, L1), Goal ), L2).
Then:
?- map_f(double, [3,1,2,6,3,1,6], R).
R = [6, 2, 4, 12, 6, 2, 12].
?- map_f(square, [3,1,2,6,3,1,6], R).
R = [9, 1, 4, 36, 9, 1, 36].
But, instead of:
Goal =.. [Pred_name, Arg1, Arg2], Goal
it is easier to use call/N+1:
call(Pred_name, Arg1, Arg2)
So your definition will become:
map_f(Pred_name, L1, L2) :-
findall(Y, ( member(X, L1), call(Pred_name, X, Y) ), L2).
But really, all of this is completely unnecessary if you only have lists. You can just use maplist/N+1, like that:
?- maplist(double, [3,1,2,6,3,1,6], R).
R = [6, 2, 4, 12, 6, 2, 12].
... which iterates over the lists instead of backtracking over them. You can see a maplist implementation for example here:
https://github.com/SWI-Prolog/swipl-devel/blob/2d20d4e8ac28adfcede7a9bd231ea0d9d12d0bbb/library/apply.pl#L195-L205
If your predicate is a real relation (so if it works both ways), you can also use maplist both ways. findall cannot do that! Here is one silly example:
?- maplist(succ, [1,2,3], R).
R = [2, 3, 4].
?- maplist(succ, R, [1,2,3]).
R = [0, 1, 2].
?- map_f(succ, [1,2,3], R).
R = [2, 3, 4].
?- map_f(succ, R, [1,2,3]).
ERROR: Arguments are not sufficiently instantiated
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.
So I have been trying to write a sudoku solver I wrote this:
permutation([], []).
permutation([X|L], P) :-
permutation(L, L1),
insert(X, L1, P).
del(X, [X|Xs], Xs).
del(X, [Y|Ys], [Y|Zs]) :-
del(X, Ys, Zs).
insert(X, List, BiggerList) :-
del(X, BiggerList, List).
block(X1,X2,X3,X4,X5,X6,X7,X8,X9) :-
permutation([1,2,3,4,5,6,7,8,9],[X1,X2,X3,X4,X5,X6,X7,X8,X9]).
solveSudoku(X11,X12,X13,X14,X15,X16,X17,X18,X19,X21,X22,X23,X24,X25,X26,X27,X28,X29,X31,X32,X33,X34,X35,X36,X37,X38,X39,X41,X42,X43,X44,X45,X46,X47,X48,X49,X51,X52,X53,X54,X55,X56,X57,X58,X59,X61,X62,X63,X64,X65,X66,X67,X68,X69,X71,X72,X73,X74,X75,X76,X77,X78,X79,X81,X82,X83,X84,X85,X86,X87,X88,X89,X91,X92,X93,X94,X95,X96,X97,X98,X99) :-
block(X11,X12,X13,X14,X15,X16,X17,X18,X19) ,
block(X21,X22,X23,X24,X25,X26,X27,X28,X29) ,
block(X31,X32,X33,X34,X35,X36,X37,X38,X39) ,
block(X41,X42,X43,X44,X45,X46,X47,X48,X49) ,
block(X51,X52,X53,X54,X55,X56,X57,X58,X59) ,
block(X61,X62,X63,X64,X65,X66,X67,X68,X69) ,
block(X71,X72,X73,X74,X75,X76,X77,X78,X79) ,
block(X81,X82,X83,X84,X85,X86,X87,X88,X89) ,
block(X91,X92,X93,X94,X95,X96,X97,X98,X99) ,
... 27 blockes
the only problem is that for a normal input it never finishes (takes a lot of time), how can I optimize it?
It seems to be working because when I copied it for 4x4 It worked well. And for failure cases that are reviewed at the beginning (the lines) it returns false.
the full code
Or in another way
As you have observed, your program works fine with smaller instances of the problem, e.g. 4x4. What you see is the combinatorial explosion of the search space. To see the difference, compare 4x4 variables with 4 values each (4^16 = 4.29e+9 combinations) with 9x9 variables with 9 values each (9^81 = 1.97e+77 combinations).
The first 9 calls of your block/9 predicate build a search tree with a depth of 81 levels, while only ensuring the "no duplicates in a row" constraints. The following 18 calls of block/9 check the "column" and "block" constraints, and force backtracking into the huge search tree every time they find a violation. This is hopeless.
The way to improve this behaviour is to check immediately after a variable was set to a new value, that all the constraints are still satisfiable. This is actually one of the key techniques in constraint logic programming. Several Prolog systems support corresponding extensions (see e.g. the dif/2 predicate or the alldifferent/1 constraint).
However, I'd like to show here a program in standard Prolog that implements the same idea. Although it does so in a somewhat brute force way, it is still very effective:
?- sudoku.
[1, 2, 3, 4, 5, 6, 7, 8, 9]
[4, 5, 6, 7, 8, 9, 1, 2, 3]
[7, 8, 9, 1, 2, 3, 4, 5, 6]
[2, 1, 4, 3, 6, 5, 8, 9, 7]
[3, 6, 5, 8, 9, 7, 2, 1, 4]
[8, 9, 7, 2, 1, 4, 3, 6, 5]
[5, 3, 1, 6, 4, 2, 9, 7, 8]
[6, 4, 2, 9, 7, 8, 5, 3, 1]
[9, 7, 8, 5, 3, 1, 6, 4, 2]
Yes (0.08s cpu, solution 1, maybe more)
The code consists of a predicate check/1 that makes sure that the current variable assignments do not already violate any sudoku constraint. This check is called by checked_between/4 every time a value is assigned to a variable.
sudoku :-
Grid = [X11,X12,X13,X14,X15,X16,X17,X18,X19,
X21,X22,X23,X24,X25,X26,X27,X28,X29,
X31,X32,X33,X34,X35,X36,X37,X38,X39,
X41,X42,X43,X44,X45,X46,X47,X48,X49,
X51,X52,X53,X54,X55,X56,X57,X58,X59,
X61,X62,X63,X64,X65,X66,X67,X68,X69,
X71,X72,X73,X74,X75,X76,X77,X78,X79,
X81,X82,X83,X84,X85,X86,X87,X88,X89,
X91,X92,X93,X94,X95,X96,X97,X98,X99],
checked_between(Grid, 1, 9, check(Grid)),
write([X11,X12,X13,X14,X15,X16,X17,X18,X19]), nl,
write([X21,X22,X23,X24,X25,X26,X27,X28,X29]), nl,
write([X31,X32,X33,X34,X35,X36,X37,X38,X39]), nl,
write([X41,X42,X43,X44,X45,X46,X47,X48,X49]), nl,
write([X51,X52,X53,X54,X55,X56,X57,X58,X59]), nl,
write([X61,X62,X63,X64,X65,X66,X67,X68,X69]), nl,
write([X71,X72,X73,X74,X75,X76,X77,X78,X79]), nl,
write([X81,X82,X83,X84,X85,X86,X87,X88,X89]), nl,
write([X91,X92,X93,X94,X95,X96,X97,X98,X99]), nl.
% check whether any of the values chosen so far violate a sudoku constraint
check([ X11,X12,X13,X14,X15,X16,X17,X18,X19,
X21,X22,X23,X24,X25,X26,X27,X28,X29,
X31,X32,X33,X34,X35,X36,X37,X38,X39,
X41,X42,X43,X44,X45,X46,X47,X48,X49,
X51,X52,X53,X54,X55,X56,X57,X58,X59,
X61,X62,X63,X64,X65,X66,X67,X68,X69,
X71,X72,X73,X74,X75,X76,X77,X78,X79,
X81,X82,X83,X84,X85,X86,X87,X88,X89,
X91,X92,X93,X94,X95,X96,X97,X98,X99]) :-
nodups([X11,X12,X13,X14,X15,X16,X17,X18,X19]),
nodups([X21,X22,X23,X24,X25,X26,X27,X28,X29]),
nodups([X31,X32,X33,X34,X35,X36,X37,X38,X39]),
nodups([X41,X42,X43,X44,X45,X46,X47,X48,X49]),
nodups([X51,X52,X53,X54,X55,X56,X57,X58,X59]),
nodups([X61,X62,X63,X64,X65,X66,X67,X68,X69]),
nodups([X71,X72,X73,X74,X75,X76,X77,X78,X79]),
nodups([X81,X82,X83,X84,X85,X86,X87,X88,X89]),
nodups([X91,X92,X93,X94,X95,X96,X97,X98,X99]),
nodups([X11,X21,X31,X41,X51,X61,X71,X81,X91]),
nodups([X12,X22,X32,X42,X52,X62,X72,X82,X92]),
nodups([X13,X23,X33,X43,X53,X63,X73,X83,X93]),
nodups([X14,X24,X34,X44,X54,X64,X74,X84,X94]),
nodups([X15,X25,X35,X45,X55,X65,X75,X85,X95]),
nodups([X16,X26,X36,X46,X56,X66,X76,X86,X96]),
nodups([X17,X27,X37,X47,X57,X67,X77,X87,X97]),
nodups([X18,X28,X38,X48,X58,X68,X78,X88,X98]),
nodups([X19,X29,X39,X49,X59,X69,X79,X89,X99]),
nodups([X11,X12,X13,X21,X22,X23,X31,X32,X33]),
nodups([X41,X42,X43,X51,X52,X53,X61,X62,X63]),
nodups([X71,X72,X73,X81,X82,X83,X91,X92,X93]),
nodups([X14,X15,X16,X24,X25,X26,X34,X35,X36]),
nodups([X44,X45,X46,X54,X55,X56,X64,X65,X66]),
nodups([X74,X75,X76,X84,X85,X86,X94,X95,X96]),
nodups([X17,X18,X19,X27,X28,X29,X37,X38,X39]),
nodups([X47,X48,X49,X57,X58,X59,X67,X68,X69]),
nodups([X77,X78,X79,X87,X88,X89,X97,X98,X99]).
nodups([]).
nodups([X|Xs]) :-
not_contains(Xs, X),
nodups(Xs).
not_contains([], _).
not_contains([Y|Ys], X) :-
X \== Y,
not_contains(Ys, X).
checked_between([], _, _, _).
checked_between([X|Xs], L, H, Check) :-
between(L, H, X),
call(Check),
checked_between(Xs, L, H, Check).
between(L, H, L) :- L =< H.
between(L, H, X) :-
L < H,
L1 is L+1,
between(L1, H, X).