This is a follow-up Question of: Restrict search in Prolog - Magic Sqare
Thanks to Isabelle Newbie for the help so far.
With the help of Isabelle Newbie I got my code working, but sadly only for 4x4 Squares.
I'm quite new to Prolog, so maybe I miss something obvious.
The following code generates a 4x4 magic square in basically no time. I implemented all the rules in a way that they also should work for squares of higher dimensions like 8x8 or 12x12, but for some reason it does not work.
:- use_module(library(clpfd)).
diag2_sum(0, _, _, _, _).
diag2_sum(I0, N, C1, Row1, Row3) :-
I0 > 0,
nth1(I0,Row1,A),
V1 is N - 2,
(I0 =:= V1 -> I2 = N ; I2 is mod(I0 + 2,N)),
nth1(I2,Row3,B),
C1 #= A + B,
I1 is I0 - 1,
diag2_sum(I1, N, C1, Row1, Row3).
diag_sum([_,_], _, _).
diag_sum([Row1|Tail], C1, N) :-
nth1(2,Tail,Row3),
diag2_sum(N, N, C1, Row1,Row3),
diag_sum(Tail, C1, N).
square_sum_x(_, _, _, 0, _).
square_sum_x(Row1, Row2, C2, I0, N) :-
V1 is N - 1,
(I0 =:= V1 -> I2 = N ; I2 is mod(I0 + 1,N)),
nth1(I0,Row1,Elem1),
nth1(I2,Row1,Elem2),
nth1(I0,Row2,Elem3),
nth1(I2,Row2,Elem4),
C2 #= Elem1 + Elem2 + Elem3 + Elem4,
I1 is I0 - 1,
square_sum_x(Row1, Row2, C2, I1, N).
square_sum_y(_, _, 0, _).
square_sum_y(Matrix, C2, I0, N) :-
V1 is N - 1,
(I0 =:= V1 -> I2 = N ; I2 is mod(I0 + 1,N)),
nth1(I0,Matrix,Row1),
nth1(I2,Matrix,Row2),
square_sum_x(Row1,Row2, C2, N, N),
I1 is I0 - 1,
square_sum_y(Matrix, C2, I1, N).
magic_square_(N, Matrix) :-
Nmax is N * N,
C1 is Nmax + 1,
C2 is C1 * 2,
write(C1),nl,write(C2),nl,
length(Matrix, N),
maplist(same_length(Matrix), Matrix),
append(Matrix, Vs),
Vs ins 1..Nmax, all_different(Vs),
diag_sum(Matrix, C1, N),
square_sum_y(Matrix, C2, N, N).
magic_square(N, Matrix) :-
magic_square_(N, Matrix),
maplist(label, Matrix).
4x4 magic square(works):
?- magic_square(4, Matrix).
17
34
Matrix = [[1, 8, 10, 15], [12, 13, 3, 6], [7, 2, 16, 9], [14, 11, 5, 4]]
8x8 magic square(doesnt work):
?- magic_square(8, Matrix).
65
130
false.
I implemented all the rules in a way that they also should work for squares of higher dimensions
my program returns true. So I assume my rule basis is correct.
diag_sum(Matrix, C1, N),
square_sum_y(Matrix, C2, N, N).
I commented out these last two lines, and verified that it does generate an 8x8 matrix and 12x12 matrix of increasing values. Adding either of these lines back in works for a 4x4 matrix but not 8x8 or 12x12, which says both of them do not work for squares of higher dimensions.
Generate a non-magic square of 8x8 and test diag_sum() on it and the topright to lowerleft / diagonal check picks these two values, the eight and the eighteen:
diag_sum([[ 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, 31, 32],
[33, 34, 35, 36, 37, 38, 39, 40],
[41, 42, 43, 44, 45, 46, 47, 48],
[49, 50, 51, 52, 53, 54, 55, 56],
[57, 58, 59, 60, 61, 62, 63, 64]], 65, 8).
I think it should pick these two, the eight and the twenty two:
[ 1, 2, 3, 4, 5, 6, 7, *8],
[9, 10, 11, 12, 13, 14, 15, 16],
[17, 18, 19, 20, 21,*22, 23, 24],
Because this line:
(I0 =:= V1 -> I2 = N ; I2 is mod(I0 + 2,N)),
rolls around to the right using mod in a way that only works where 4-2 =:= (4+2) mod 4 but 8-2 =\= (8+2) mod 8 so it fails here.
I used SWISH online tracing (click to the left of a line to set a breakpoint and step through the code as it runs) to locate this.
NB. you didn't ask a question, you only stated "for some reason it does not work". This is the first reason it does not work, it looks like the same design using mod is in the square_sum_x which may fail in the same way. What to do about it is a different question; you might find some ideas on https://www.metalevel.at/sudoku/ and in the video explanation there for how that represents the smaller squares in a Sudoku grid more directly.
Perhaps build and test a way to extract the diagonals and test that on a matrix of numbers to see that it gives the correct diagonal positions for 8x8 and 12x12, and then to split those results into spaced pairs, and test that, and then build up from there?
Related
I wanted to create a sequence of numbers in Prolog. So, if the function is print(4,3,10), it will print 4 7 10 13 16 19 22 25 28 31. The second parameter determines the next number and the last parameter determines where the sequence should stop.
I have the code but it seems doesn't work.
print(A,B,C) :- C>=0.
print(A,B,C) :- D is A+B, E is C-1, print(D,B,E), write(D).
The result only shows true.
Are there any solutions for this problem? Thanks.
You're almost there. You have realized that the counter has to be decreased every time your predicate wrote a number, so why not stop if it becomes zero? If you change the first rule...
print(_A,_B,0).
print(A,B,C) :-
D is A+B,
E is C-1,
print(D,B,E),
write(D).
... your predicate already delivers answers:
?- seq_step_len(4,3,10).
3431282522191613107
true ;
ERROR: Out of local stack
Note that there's an underscore in front of the first two arguments of the non-recursive rule. This avoids singleton warnings when loading the source file. However, the sequence does not start with 4 but with 34, it doesn't end with 31 but with 7 and there's no space between the numbers. And then there's this error ERROR: Out of local stack. The latter you can easily avoid by adding a goal C>0 to your recursive rule. The wrong start/end number can be avoided by writing A instead of D. To address the reversed sequence you can write A before the recursion. And to add spaces between the number I'd suggest the use of format/2 instead of write/1. Then print2/3 might look something like:
print2(_A,_B,0).
print2(A,B,C) :-
C>0, % <- new goal
format('~d ', [A]), % <- format/2 instead of write/1
D is A+B,
E is C-1,
print2(D,B,E).
This yields the desired results:
?- print2(4,3,10).
4 7 10 13 16 19 22 25 28 31
true ;
false.
And while you're at it, why not having the sequence in a list? Then you could actually use it, e.g. as a goal in another predicate. And it would also be nice to have a more descriptive name, that makes it more obvious which argument is what. So let's add an argument for the sequence, then the predicate might look something like this:
seq_start_end_len([],_A,_B,0).
seq_start_end_len([A|As],A,B,C) :-
C>0,
D is A+B,
E is C-1,
seq_start_end_len(As,D,B,E).
If you happen to use SWI-Prolog you might have to type w to see the entire list:
?- seq_start_end_len(Seq,4,3,10).
Seq = [4, 7, 10, 13, 16, 19, 22, 25, 28|...] [write]
Seq = [4, 7, 10, 13, 16, 19, 22, 25, 28, 31] ;
false.
However, if you try to query this predicate with any of the last three arguments being a variable you'll run into an error:
?- seq_start_end_len(Seq,X,3,10).
ERROR: is/2: Arguments are not sufficiently instantiated
?- seq_start_end_len(Seq,4,X,10).
ERROR: is/2: Arguments are not sufficiently instantiated
?- seq_start_end_len(Seq,4,3,X).
Seq = [],
X = 0 ;
ERROR: >/2: Arguments are not sufficiently instantiated
This is due to the use of is/2 and >/2. You can avoid these errors by using CLP(FD):
:- use_module(library(clpfd)). % <- new
seq_start_end_len([],_A,_B,0).
seq_start_end_len([A|As],A,B,C) :-
C#>0, % <- change
D #= A+B, % <- change
E #= C-1, % <- change
seq_start_end_len(As,D,B,E).
If you try one of the above queries now, you'll get a lot of residual goals as an answer:
?- seq_start_end_len(Seq,X,3,10).
Seq = ['$VAR'('X'), _G1690, _G1693, _G1696, _G1699, _G1702, _G1705, _G1708, _G1711, _G1714],
'$VAR'('X')+3#=_G1690,
_G1690+3#=_G1693,
_G1693+3#=_G1696,
_G1696+3#=_G1699,
_G1699+3#=_G1702,
_G1702+3#=_G1705,
_G1705+3#=_G1708,
_G1708+3#=_G1711,
_G1711+3#=_G1714,
_G1714+3#=_G1838 ;
false.
In order to get actual numbers you'll have to restrict the range of X and label the variables in the sequence:
?- X in 1..4, seq_start_end_len(Seq,X,3,10), label(Seq).
X = 1,
Seq = [1, 4, 7, 10, 13, 16, 19, 22, 25, 28] ;
X = 2,
Seq = [2, 5, 8, 11, 14, 17, 20, 23, 26, 29] ;
X = 3,
Seq = [3, 6, 9, 12, 15, 18, 21, 24, 27, 30] ;
X = 4,
Seq = [4, 7, 10, 13, 16, 19, 22, 25, 28, 31] ;
false.
?- X in 1..4, seq_start_end_len(Seq,4,X,10), label(Seq).
X = 1,
Seq = [4, 5, 6, 7, 8, 9, 10, 11, 12, 13] ;
X = 2,
Seq = [4, 6, 8, 10, 12, 14, 16, 18, 20, 22] ;
X = 3,
Seq = [4, 7, 10, 13, 16, 19, 22, 25, 28, 31] ;
X = 4,
Seq = [4, 8, 12, 16, 20, 24, 28, 32, 36, 40] ;
false.
?- X in 1..4, seq_start_end_len(Seq,4,3,X), label(Seq).
X = 1,
Seq = [4] ;
X = 2,
Seq = [4, 7] ;
X = 3,
Seq = [4, 7, 10] ;
X = 4,
Seq = [4, 7, 10, 13] ;
false.
With the CLP(FD) version you can also ask more general queries like What sequences of length 4 to 6 are there with the numbers ranging from 1 to 10?:
?- Len in 4..6, seq_start_end_len(Seq,S,E,Len), Seq ins 1..10, label(Seq).
Len = 4,
Seq = [1, 1, 1, 1],
S = 1,
E = 0 ;
Len = 4,
Seq = [1, 2, 3, 4],
S = E, E = 1 ;
Len = 4,
Seq = [1, 3, 5, 7],
S = 1,
E = 2 ;
.
.
.
Len = 6,
Seq = [9, 9, 9, 9, 9, 9],
S = 9,
E = 0 ;
Len = 6,
Seq = [10, 9, 8, 7, 6, 5],
S = 10,
E = -1 ;
Len = 6,
Seq = [10, 10, 10, 10, 10, 10],
S = 10,
E = 0 ;
false.
And you get all 80 possibilities. Note how nicely the name reflects the relational nature of the CLP(FD) predicate.
equal(X,X).
initial_step_size_sequence(Initial,Step,Size,Sequence):-
length([_H|List],Size),
maplist(equal(Step),List),
scanl(plus,List,Initial,Sequence).
Is one way to do it with higher order predicates. I have named the predicate so that vars are clear. Note you need a four place predicate not three like you suggest.
?- initial_step_size_sequence(4,3,10,S).
S = [4, 7, 10, 13, 16, 19, 22, 25, 28, 31]
A DCG could be the simplest way to embed both of good suggestions by #tas (+1) in your code.
print(_,_,0) --> [].
print(A,B,C) --> {C>0, D is A+B, E is C-1}, [A], print(D,B,E).
Test:
?- phrase(print(4,3,10),S).
S = [4, 7, 10, 13, 16, 19, 22, 25, 28, 31] ;
false.
Edit:
Higher order predicates like foldl/4 can also solve this problem quite compactly (predating the idea by #user27815: +1):
initial_step_size_sequence(Initial,Step,Size,Sequence):-
length(Sequence,Size),
foldl({Step}/[A,B,C]>>(A=B,C is B+Step),Sequence,Initial,_).
Note the 'assignment' to sequence elements A=B (free vars, as created by length/2), and the usage of library(yall) to inline the predicate.
What is the best approach to find and store all pair distances in a weighted tree?
My current approach is to run bfs on every node. But obviously this approach approach suffers from large complexity. Can we improve it further ?
A reasonable way to store them is to use consecutive node numbers starting at 0 so the distances fit neatly in a triangular array d[i,j] where j < i. A reasonable way to compute them is to augment a single search. I'll use the shorthand D[i,j] for d[max(i,j), min(i,j)]. This lets me ignore vertex numbering for convenience.
Let C be a set of completed nodes
Set W be a working set of nodes
Choose any node. Add it to C. Add all its adjacent nodes to W.
while W is not empty
Remove any node x from W
Let e be the unique edge (x,y) where y \in C and d(x, y) be its length
D[x, y] = d(x, y)
for each node z in C - {y}
D[x, z] = D[x, y] + D[y, z]
add x to C
add all nodes adjacent to x but not in C to W
The loop invariant is that for each pair of nodes in C -- call such a pair (p, q) -- we have already computed D[p,q]. The nodes in C always correspond to a subtree and W the nodes adjacent to that subtree.
While this has the same asymptotic complexity as doing n breadth first searches, it's potentially quite a bit faster because it traverses each graph edge only once rather than n times and computes each distance once rather than twice.
A quick Python implementation:
def distance_matrix(graph):
adj, dist = graph
result = [ [0 for j in range(i)] for i in range(len(adj)) ]
c = set([0])
w = set([(x, 0) for x in adj[0]])
while w:
x, y = pair = w.pop()
d = result[max(pair)][min(pair)] = dist[pair]
for z in c:
if z != y:
result[max(x,z)][min(x,z)] = d + result[max(y,z)][min(y,z)]
c.add(x)
for a in adj[x]:
if a not in c:
w.add((a, x))
return result
def to_graph(tree):
adj = [ set() for i in range(len(tree)) ]
dist = {}
for (parent, child_pairs) in tree:
for (edge_len, child) in child_pairs:
adj[child].add(parent)
adj[parent].add(child)
dist[(parent, child)] = edge_len
dist[(child, parent)] = edge_len
return (adj, dist)
def main():
tree = (
(0, ((12, 1), (7, 2), (9, 3))),
(1, ((5, 4), (19, 5))),
(2, ()),
(3, ((31, 6),)),
(4, ((27, 7), (15, 8))),
(5, ()),
(6, ((23, 9), (11, 10))),
(7, ()),
(8, ()),
(9, ()),
(10, ()))
graph = to_graph(tree)
print distance_matrix(graph)
Output (with pprint):
[[],
[12],
[7, 19],
[9, 21, 16],
[17, 5, 24, 26],
[31, 19, 38, 40, 24],
[40, 52, 47, 31, 57, 71],
[44, 32, 51, 53, 27, 51, 84],
[32, 20, 39, 41, 15, 39, 72, 42],
[63, 75, 70, 54, 80, 94, 23, 107, 95],
[51, 63, 58, 42, 68, 82, 11, 95, 83, 34]]
If you need to find the distance for all pairs, you can't do better than that. There're O(N^2) pairs so you need at least O(N^2) time to generate the answer.
If you don't need to compute all of them (say, you get pairs as query parameters later on), other solutions with their own trade-offs are possible.
Assuming that:
A+B+C=24
E+F+G=11
J+K+L=22
N+O+P=14
A+E=17
B+F+J+N=26
C+G+K+O=15
L+P=13
How could i find a possible solution to the problem, given the constraints above, using the predicate solve/1?
My first attempt was below, with no result. Thanks in advance!
solve(L1) :-
L1 = [A,B,C,E,F,G,J,K,L,N,O,P],
A is 24-B-C,
B is 26-F-J-N,
C is 15-G-K-O,
E is 11-F-G,
E is 17-A,
J is 22-K-L,
N is 14-O-P,
L is 13-P,
write(L1).
As #lurker already said in his comment, use CLP(FD) constraints.
In addition, I recommend:
instead of solve/1, use a declarative name like solution/1. You should describe what holds for a solution, so that the relation makes sense in all directions, also for example if the solution is already given and you want to validate it.
By convention, it makes sense to let variables that stand for lists end with an s.
Separate side-effects from pure code. In fact, remove side-effects altogether. Let the prolog-toplevel do the printing for you!
For example:
:- use_module(library(clpfd)).
solution(Ls) :-
Ls = [A,B,C,E,F,G,J,K,L,N,O,P],
A #= 24-B-C,
B #= 26-F-J-N,
C #= 15-G-K-O,
E #= 11-F-G,
E #= 17-A,
J #= 22-K-L,
N #= 14-O-P,
L #= 13-P.
This already works for queries like:
?- solution(Ls), Ls ins 0..sup, label(Ls).
Ls = [6, 3, 15, 11, 0, 0, 9, 0, 13, 14, 0, 0] ;
Ls = [6, 3, 15, 11, 0, 0, 10, 0, 12, 13, 0, 1] ;
Ls = [6, 3, 15, 11, 0, 0, 11, 0, 11, 12, 0, 2] ;
etc.
I leave completing this as an easy exercise.
I have the following chunk of Prolog taken from a YouTube tutorial on Prolog:
change(H, Q, D, N, P) :-
member(H, [0, 1, 2]),
member(Q, [0, 1, 2, 3, 4]),
member(D, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]),
member(N, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]),
S is 50*H + 25*Q + 10*D + 5*N,
S =< 100,
P is 100-S.
It's a program to make change on a dollar. H is half dollars, Q is quarters, D for dimes, N for nickels, P for pennies.
If I type change(H, 0, 0, 0, 0). as a query, it resolves to H=2. In the video, he mentions this is a program that makes change for $1, so I understand that two half dollars are $1, but I don't understand how it gets that.
My understanding of Prolog is that when I pass change(H, 0, 0, 0, 0)., it looks to find a value for H that will satisfy the conditions, so it goes to the first line and sees that 0 would work, then for the other "member" lines sees that the 0s that were passed also are correct.
It then sets S to a value, which given the above values would be S = 0. The next line makes sure it's less than or equal to 100, which 0 is, then sets P to 100-S (which is 100).
How is it not done there with H = 0? What am I missing?
member(H,[0,1,2]) binds H to either 0, 1 or 2. Since Q, D, N and P are all 0, the only value for H that will satisfy the equations at the bottom is 2.
When H=0, S will be 0, 100-S will be 100, and since P is 0, P is 100-S will fail.
When H=1, S will be 50, 100-S will be 50, and since P is 0, P is 100-S will fail.
When H=2, S will be 100, 100-S will be 0, and since P is 0, P is 100-S will succeed.
In addition to the operational explanation, I would like to suggest CLP(FD) constraints for such problems, which are easier to understand and more declarative than lower-level arithmetic predicates. For example, in SICStus Prolog, YAP and SWI:
:- use_module(library(clpfd)).
change(H, Q, D, N, P) :-
H in 0..2,
Q in 0..4,
D in 0..10,
N in 0..20,
S #= 50*H + 25*Q + 10*D + 5*N,
S #=< 100,
P #= 100-S.
Let us now reason declaratively:
If H = 0, as you ask, and the other parameters are 0, as you specified, then what are admissible values of P?
?- change(0, 0, 0, 0, P).
P = 100.
From this, we see that if all other arguments are 0, then the only valid solution for your query is P = 100. Thus, the goal change(0, 0, 0, 0, 0) will certainly fail.
I have a matrix, and its elements on the main diagonal aren't sorted, so I need a function that will return new matrix with sorted elements on the main diagonal. I can't understand why this won't work.
Function[A_] := Module[{res, diagonal = {}, m, n},
{m, n} = Dimensions[A];
Table[AppendTo[diagonal, A[[i, i]]], {i, 1, m}];
dijagonal = SelectionSort[diagonal];
Table[A[[i, i]] = dijagonal[[i]], {i, 1, m}];
Return[A // MatrixForm];
];
Selection sort works.
This can be an example of matrix:
A={{60, 10, 68, 72, 64},{26, 70, 32, 19, 29},{94, 78, 86, 59, 17},
{77, 13, 34, 39, 0}, {31, 71, 11, 48, 83}}
When I run it, this shows up:
Set::setps: {{60,10,68,72,64},{26,70,32,19,29},{94,78,86,59,17},{77,13,34,39,0},{31,71,11,48,83}} in the part assignment is not a symbol. >>
The main issues
you can not define your own function named Function. (Generally avoid using any symbol beginning with a capital to avoid conflicts )
you can not modify the the input argument, so make a copy
just use Sort not SelectionSort
I made a couple of other changes that are more stylistic as well:
function[A0_] :=
Module[{res, diagonal = {}, m, n, A = A0},
{m, n} = Dimensions[A];
diagonal = Table[A[[i, i]], {i, 1, m}];
dijagonal = Sort[diagonal];
Do[A[[i, i]] = dijagonal[[i]], {i, 1, m}]; A]
function[A] // MatrixForm
note you can do all this inline:
ReplacePart[ A,
Table[ {i, i} -> (Sort#Diagonal[A])[[i]], {i, Length#A} ]]
or
(A + DiagonalMatrix[Sort## - # &#Diagonal[A]])