Prolog recursing through list of lists - recursion
I'm attempting a prolog question that states the following:
A magic square is a 3× 3 matrix of distinct numbers (between 1 and 9) such that all rows and columns add up to the same total (but not necessarily the diagonals). For example:
2 7 6
9 5 1
4 3 8
is a magic square.
We will represent squares in Prolog as 3 × 3 matrices, i.e. lists of lists [R1, R2, R3] where each R_i is a list of three numbers. For example, the
representation of the above magic square is
[[2,7,6],[9,5,1],[4,3,8]]
Define a predicate magic/1 that tests whether a ground 3 × 3 matrix (i.e.
where all the entries are numbers) is a magic square.
I've done this the following way, and I'm pretty sure it's allowed if I also do it like this in an exam, however to me it seems like sort of a hack:
magic([[A,B,C], [D,E,F], [G,H,I]]) :-
Y is A + B + C,
Y is D + E + F,
Y is G + H + I,
Y is A + D + G,
Y is B + E + H,
Y is C + F + I.
My desired way would be to recurse through each list in the outer list, and sum it up. For each of the lists in outer list, they should sum up to the same value (I think 15 is actually the only possible solution for this "magic" matrix). Likewise, I do the same for the columns (take the first, second and 3rd of each list and add up respectively). However, I'm not entirely sure how to do the latter as I haven't been working with list of lists much. I would appreciate if anybody would give a neat solution on how these sort of computations can be done generally.
Thanks
Note that your solution does not check that A, ..,I values are distinct and in the range 1..9. Here is a solution for NxN squares for N > 2:
magic(L) :-
magic_range(L),
magic_sum(S, L),
magic_line(S, L),
transpose(L, T),
magic_line(S, T).
% S value from https://oeis.org/A006003
magic_sum(S, L) :-
length(L, N),
S is N * (N*N + 1) / 2.
magic_range(L) :-
flatten(L, F),
sort(F, S),
length(L, N),
N2 is N * N,
numlist(1, N2, S).
magic_line(_, []).
magic_line(S, [A | As]) :-
sumlist(A, S),
magic_line(S, As).
% https://github.com/SWI-Prolog/swipl-devel/blob/9452af09962000ebb5157fe06169bbf51af5d5c9/library/clp/clpfd.pl#L6411
transpose(Ls, Ts) :-
must_be(list(list), Ls),
lists_transpose(Ls, Ts).
lists_transpose([], []).
lists_transpose([L|Ls], Ts) :-
foldl(transpose_, L, Ts, [L|Ls], _).
transpose_(_, Fs, Lists0, Lists) :-
maplist(list_first_rest, Lists0, Fs, Lists).
list_first_rest([L|Ls], L, Ls).
Some queries
?- magic([[1,1,1],[1,1,1],[1,1,1]]).
false.
?- magic([[2,7,6],[9,5,1],[4,3,8]]).
true ;
false.
?- magic([[16,3,2,13], [5,10,11,8], [9,6,7,12], [4,15,14,1]]).
true ;
false.
The transpose predicate is the most complicated part. See here for some alternatives.
Related
Concatenation of binary representation of first n positive integers in O(logn) time complexity
I came across this question in a coding competition. Given a number n, concatenate the binary representation of first n positive integers and return the decimal value of the resultant number formed. Since the answer can be large return answer modulo 10^9+7. N can be as large as 10^9. Eg:- n=4. Number formed=11011100(1=1,10=2,11=3,100=4). Decimal value of 11011100=220. I found a stack overflow answer to this question but the problem is that it only contains a O(n) solution. Link:- concatenate binary of first N integers and return decimal value Since n can be up to 10^9 we need to come up with solution that is better than O(n).
Here's some Python code that provides a fast solution; it uses the same ideas as in Abhinav Mathur's post. It requires Python >= 3.8, but it doesn't use anything particularly fancy from Python, and could easily be translated into another language. You'd need to write algorithms for modular exponentiation and modular inverse if they're not already available in the target language. First, for testing purposes, let's define the slow and obvious version: # Modulus that results are reduced by, M = 10 ** 9 + 7 def slow_binary_concat(n): """ Concatenate binary representations of 1 through n (inclusive). Reinterpret the resulting binary string as an integer. """ concatenation = "".join(format(k, "b") for k in range(n + 1)) return int(concatenation, 2) % M Checking that we get the expected result: >>> slow_binary_concat(4) 220 >>> slow_binary_concat(10) 462911642 Now we'll write a faster version. First, we split the range [1, n) into subintervals such that within each subinterval, all numbers have the same length in binary. For example, the range [1, 10) would be split into four subintervals: [1, 2), [2, 4), [4, 8) and [8, 10). Here's a function to do that splitting: def split_by_bit_length(n): """ Split the numbers in [1, n) by bit-length. Produces triples (a, b, 2**k). Each triple represents a subinterval [a, b) of [1, n), with a < b, all of whose elements has bit-length k. """ a = 1 while n > a: b = 2 * a yield (a, min(n, b), b) a = b Example output: >>> list(split_by_bit_length(10)) [(1, 2, 2), (2, 4, 4), (4, 8, 8), (8, 10, 16)] Now for each subinterval, the value of the concatenation of all numbers in that subinterval is represented by a fairly simple mathematical sum, which can be computed in exact form. Here's a function to compute that sum modulo M: def subinterval_concat(a, b, l): """ Concatenation of values in [a, b), all of which have the same bit-length k. l is 2**k. Equivalently, sum(i * l**(b - 1 - i)) for i in range(a, b)) modulo M. """ n = b - a inv = pow(l - 1, -1, M) q = (pow(l, n, M) - 1) * inv return (a * q + (q - n) * inv) % M I won't go into the evaluation of the sum here: it's a bit off-topic for this site, and it's hard to express without a good way to render formulas. If you want the details, that's a topic for https://math.stackexchange.com, or a page of fairly simple algebra. Finally, we want to put all the intervals together. Here's a function to do that. def fast_binary_concat(n): """ Fast version of slow_binary_concat. """ acc = 0 for a, b, l in split_by_bit_length(n + 1): acc = (acc * pow(l, b - a, M) + subinterval_concat(a, b, l)) % M return acc A comparison with the slow version shows that we get the same results: >>> fast_binary_concat(4) 220 >>> fast_binary_concat(10) 462911642 But the fast version can easily be evaluated for much larger inputs, where using the slow version would be infeasible: >>> fast_binary_concat(10**9) 827129560 >>> fast_binary_concat(10**18) 945204784
You just have to note a simple pattern. Taking up your example for n=4, let's gradually build the solution starting from n=1.
1 -> 1 #1
2 -> 2^2(1) + 2 #6
3 -> 2^2[2^2(1)+2] + 3 #27
4 -> 2^3{2^2[2^2(1)+2]+3} + 4 #220
If you expand the coefficients of each term for n=4, you'll get the coefficients as:
1 -> (2^3)*(2^2)*(2^2)
2 -> (2^3)*(2^2)
3 -> (2^3)
4 -> (2^0)
Let the N be total number of bits in the string representation of our required number, and D(x) be the number of bits in x. The coefficients can then be written as
1 -> 2^(N-D(1))
2 -> 2^(N-D(1)-D(2))
3 -> 2^(N-D(1)-D(2)-D(3))
... and so on
Since the value of D(x) will be the same for all x between range (2^t, 2^(t+1)-1) for some given t, you can break the problem into such ranges and solve for each range using mathematics (not iteration). Since the number of such ranges will be log2(Given N), this should work in the given time limit.
As an example, the various ranges become:
1. 1 (D(x) = 1)
2. 2-3 (D(x) = 2)
3. 4-7 (D(x) = 3)
4. 8-15 (D(x) = 4)
Creating a prolog rule with count
mother(X, Y):- child(Y, X), female(X). How would I have code to find out whether or not X is the mother of at least 3 children? Would I have to use some sort of aggregate to see how many times child(Y,X) would happen?
Not sure to understand what do you want but I suppose that the following example could help motherOf3OrMore(X) :- female(X), findall(Y, child(Y, X), L), length(L, N), N >= 3. If the minimum number of childs isn't a fixed number (3) you can pass it as a parameter as follows motherOfMore(X, N) :- female(X), findall(Y, child(Y, X), L), length(L, M), M >= N.
Decompression of a list in prolog
I need to decompress a list in prolog , like in the example below : decode([[a,1],[b,2],[c,1],[d,3]],L). L = [a, b, b, c, d, d, d] ; I made this code : divide(L,X,Y):-length(X,1),append(X,Y,L). divide2(L,X,Y):-divide(L,[X|_],[Y|_]). makelist(_,N,[]):- N =< 0 . makelist(X,Y,[X|Result]):-Y1 is Y-1,makelist(X,Y1,Result). makelist2(L,L2):-divide2(L,X,Y),makelist(X,Y,L2). decode([],[]). decode([H|T],L):-makelist2(H,H2),append(H2,L,L2),decode(T,L2). and when i call makelist2([a,3],L2). L2 = [a,a,a]. but when i call decode([[a,3],[b,1],[c,4]],L) runs continuously. What am i doing wrong ?
Another variation of the theme, using a slightly modified version of Boris' repeat/3 predicate: % True when L is a list with N repeats of X repeat([X, N], L) :- length(L, N), maplist(=(X), L). decode(Encoded, Decoded) :- maplist(repeat, Encoded, Expanded), flatten(Expanded, Decoded). If Encode = [[a,1],[b,2],[c,1],[d,3]], then in the above decode/2, the maplist/3 call will yield Expanded = [[a],[b,b],[c],[d,d,d]], and then the flatten/2 call results in Decoded = [a,b,b,c,d,d,d]. In SWI Prolog, instead of flatten/2, you can use append/2 since you only need a "flattening" at one level. EDIT: Adding a "bidirectional" version, using a little CLPFD: rle([], []). rle([X], [[1,X]]). rle([X,Y|T], [[1,X]|R]) :- X \== Y, % use dif(X, Y) here, if available rle([Y|T], R). rle([X,X|T], [[N,X]|R]) :- N #= N1 + 1, rle([X|T], [[N1,X]|R]). This will yield: | ?- rle([a,a,a,b,b], L). L = [[3,a],[2,b]] ? ; (1 ms) no | ?- rle(L, [[3,a],[2,b]]). L = [a,a,a,b,b] ? ; no | ?- rle([a,a,a,Y,Y,Z], [X, [N,b],[M,c]]). M = 1 N = 2 X = [3,a] Y = b Z = c ? a no | ?- rle([A,B,C], D). D = [[1,A],[1,B],[1,C]] ? ; C = B D = [[1,A],[2,B]] ? ; B = A D = [[2,A],[1,C]] ? ; B = A C = A D = [[3,A]] ? ; (2 ms) no | ?- rle(A, [B,C]). A = [D,E] B = [1,D] C = [1,E] ? ; A = [D,E,E] B = [1,D] C = [2,E] ? ; A = [D,E,E,E] B = [1,D] C = [3,E] ? ; ... | ?- rle(A, B). A = [] B = [] ? ; A = [C] B = [[1,C]] ? ; A = [C,D] B = [[1,C],[1,D]] ? ; ... As #mat suggests in his comment, in Prolog implementations that have dif/2, then dif(X,Y) is preferable to X \== Y above.
The problem is in the order of your append and decode in the last clause of decode. Try tracing it, or even better, trace it "by hand" to see what happens. Another approach: see this answer. So, with repeat/3 defined as: % True when L is a list with N repeats of X repeat(X, N, L) :- length(L, N), maplist(=(X), L). You can write your decode/2 as: decode([], []). decode([[X,N]|XNs], Decoded) :- decode(XNs, Decoded_rest), repeat(X, N, L), append(L, Decoded_rest, Decoded). But this is a slightly roundabout way to do it. You could define a difference-list version of repeat/3, called say repeat/4: repeat(X, N, Reps, Reps_back) :- ( succ(N0, N) -> Reps = [X|Reps0], repeat(X, N0, Reps0, Reps_back) ; Reps = Reps_back ). And then you can use a difference-list version of decode/2, decode_1/3 decode(Encoded, Decoded) :- decode_1(Encoded, Decoded, []). decode_1([], Decoded, Decoded). decode_1([[X,N]|XNs], Decoded, Decoded_back) :- repeat(X, N, Decoded, Decoded_rest), decode_1(XNs, Decoded_rest, Decoded_back). ?- decode([[a,1],[b,2],[c,1],[d,3]],L). L = [a, b, b, c, d, d, d]. ?- decode([[a,3],[b,1],[c,0],[d,3]],L). L = [a, a, a, b, d, d, d]. ?- decode([[a,3]],L). L = [a, a, a]. ?- decode([],L). L = [].
You can deal with both direction with this code : :- use_module(library(lambda)). % code from Pascal Bourguignon packRuns([],[]). packRuns([X],[[X]]). packRuns([X|Rest],[XRun|Packed]):- run(X,Rest,XRun,RRest), packRuns(RRest,Packed). run(Var,[],[Var],[]). run(Var,[Var|LRest],[Var|VRest],RRest):- run(Var,LRest,VRest,RRest). run(Var,[Other|RRest],[Var],[Other|RRest]):- dif(Var,Other). %end code pack_1(In, Out) :- maplist(\X^Y^(X = [V|_], Y = [V, N], length(X, N), maplist(=(V), X)), In, Out). decode(In, Out) :- when((ground(In); ground(Out1)),pack_1(Out1, In)), packRuns(Out, Out1). Output : ?- decode([[a,1],[b,2],[c,1],[d,3]],L). L = [a, b, b, c, d, d, d] . ?- decode(L, [a,b,b,c,d,d,d]). L = [[a, 1], [b, 2], [c, 1], [d, 3]] .
a compact way: decode(L,D) :- foldl(expand,L,[],D). expand([S,N],L,E) :- findall(S,between(1,N,_),T), append(L,T,E). findall/3 it's the 'old fashioned' Prolog list comprehension facility
decode is a poor name for your predicate: properly done, you predicate should be bi-directional — if you say decode( [[a,1],[b,2],[c,3]] , L ) You should get L = [a,b,b,c,c,c]. And if you say decode( L , [a,b,b,c,c,c] ) . You should get L = [[a,1],[b,2],[c,3]]. So I'd use a different name, something like run_length_encoding/2. I might also not use a list to represent individual run lengths as [a,1] is this prolog term: .(a,.(1,[]). Just use a simple term with arity 2 — myself, I like using :/2 since it's defined as an infix operator, so you can simply say a:1. Try this on for size: run_length_encoding( [] , [] ) . % the run-length encoding of the empty list is the empty list. run_length_encoding( [X|Xs] , [R|Rs] ) :- % the run-length encoding of a non-empty list is computed by rle( Xs , X:1 , T , R ) , % - run-length encoding the prefix of the list run_length_encoding( T , Rs ) % - and recursively run-length encoding the remainder . % Easy! rle( [] , C:N , [] , C:N ) . % - the run is complete when the list is exhausted. rle( [X|Xs] , C:N , [X|Xs] , C:N ) :- % - the run is complete, X \= C % - when we encounter a break . % rle( [X|Xs] , X:N , T , R ) :- % - the run continues if we haven't seen a break, so.... N1 is N+1 , % - increment the run length, rle( Xs, X:N1, T, R ) % - and recurse down. . % Easy!
In direct answer to the original question of, What am I doing wrong?... When I ran the original code, any expected use case "ran indefinitely" without yielding a result. Reading through the main predicate: decode([],[]). This says that [] is the result of decoding []. Sounds right. decode([H|T],L) :- makelist2(H,H2), append(H2,L,L2), decode(T,L2). This says that L is the result of decoding [H|T] if H2 is an expansion of H (which is what makelist2 does... perhaps - we'll go over that below), and H2 appended to this result gives another list L2 which is the decoded form of the original tail T. That doesn't sound correct. If I decode [H|T], I should (1) expand H, (2) decode T giving L2, then (3) append H to L2 giving L. So the corrected second clause is: decode([H|T], L) :- makelist2(H, H2), decode(T, L2), append(H2, L2, L). Note the argument order of append/3 and that the call occurs after the decode of the tail. As Boris pointed out previously, the incorrect order of append and the recursive decode can cause the continuous running without any output as append with more uninstantiated arguments generates a large number of unneeded possibilities before decode can succeed. But now the result is: | ?- decode([[a,3]], L). L = [a,a,a] ? ; L = [a,a,a,a] ? ; ... If you try out our other predicates by hand in the Prolog interpreter, you'll find that makelist2/2 has an issue: It produces the correct result, but also a bunch of incorrect results. Let's have a look at makelist2/2. We can try this predicate by itself and see what happens: | ?- makelist2([a,3], L). L = [a,a,a] ? ; L = [a,a,a,a] ? ; ... There's an issue: makelist2/2 should only give the first solution, but it keeps going, giving incorrect solutions. Let's look closer at makelist/2: makelist2(L,L2) :- divide2(L,X,Y), makelist(X,Y,L2). It takes a list L of the form [A,N], divides it (via divide2/3) into X = A and Y = N, then calls an auxiliary, makelist(X, Y, L2). makelist(_,N,[]):- N =< 0 . makelist(X,Y,[X|Result]):-Y1 is Y-1,makelist(X,Y1,Result). makelist/3 is supposed to generate a list (the third argument) by replicating the first argument the number of times given in the second argument. The second, recursive clause appears to be OK, but has one important flaw: it will succeed even if the value of Y is less than or equal to 0. Therefore, even though a correct solution is found, it keeps succeeding on incorrect solutions because the base case allows the count to be =< 0: | ?- makelist(a,2,L). L = [a,a] ? ; L = [a,a,a] ? ; We can fix makelist/2 as follows: makelist(_,N,[]):- N =< 0 . makelist(X,Y,[X|Result]):- Y > 0, Y1 is Y-1, makelist(X,Y1,Result). Now the code will generate a correct result. We just needed to fix the second clause of decode/2, and the second clause of makelist/3. | ?- decode([[a,3],[b,4]], L). L = [a,a,a,b,b,b,b] yes The complete, original code with just these couple of corrections looks like this: divide(L, X, Y) :- length(X, 1), append(X, Y, L). divide2(L, X, Y) :- divide(L, [X|_], [Y|_]). makelist(_, N, []) :- N =< 0 . makelist(X, Y, [X|Result]) :- Y > 0, Y1 is Y-1, makelist(X,Y1,Result). makelist2(L, L2) :- divide2(L, X, Y), makelist(X, Y, L2). decode([], []). decode([H|T], L) :- makelist2(H,H2), decode(T,L2), append(H2,L2,L). Note some simple, direct improvements. The predicate, divide2(L, X, Y) takes a list L of two elements and yields each, individual element, X and Y. This predicate is unnecessary because, in Prolog, you can obtain these elements by simple unification: L = [X, Y]. You can try this right in the Prolog interpreter: | ?- L = [a,3], L = [X,Y]. L = [a,3] X = a Y = 3 yes We can then completely remove the divide/3 and divide2/3 predicates, and replace a call to divide2(L, X, Y) with L = [X,Y] and reduce makelist2/2 to: makelist2(L, L2) :- L = [X, Y], makelist(X, Y, L2). Or more simply (because we can do the unification right in the head of the clause): makelist2([X,Y], L2) :- makelist(X, Y, L2). You could just remove makelist2/2 and call makelist/2 directly from decode/2 by unifying H directly with its two elements, [X, N]. So the original code simplifies to: makelist(_, N, []) :- N =< 0 . makelist(X, Y, [X|Result]) :- Y > 0, Y1 is Y-1, makelist(X,Y1,Result). decode([], []). decode([[X,N]|T], L) :- makelist(X, N, H2), decode(T, L2), append(H2, L2, L). And makelist/3 can be performed a bit more clearly using one of the methods provided in the other answers (e.g., see Boris' repeat/3 predicate).
Accumulating Curried Function (SML)
I have a set of problems that I've been working through and can't seem to understand what the last one is asking. Here is the first problem, and my solution to it: a) Often we are interested in computing ∑i=m..n f(i), the sum of function values f(i) for i = m through n. Define sigma f m n which computes ∑i=m..n f(i). This is different from defining sigma (f, m, n). fun sigma f m n = if (m=n) then f(m) else (f(m) + sigma f (m+1) n); The second problem, and my solution: b) In the computation of sigma above, the index i goes from current i to next value i+1. We may want to compute the sum of f(i) where i goes from current i to the next, say i+2, not i+1. If we send this information as an argument, we can compute more generalized summation. Define ‘sum f next m n’ to compute such summation, where ‘next’ is a function to compute the next index value from the current index value. To get ‘sigma’ in (a), you send the successor function as ‘next’. fun sum f next m n = if (m>=n) then f(m) else (f(m) + sum f (next) (next(m)) n); And the third problem, with my attempt: c) Generalizing sum in (b), we can compute not only summation but also product and other forms of accumulation. If we want to compute sum in (b), we send addition as an argument; if we want to compute the product of function values, we send multiplication as an argument for the same parameter. We also have to send the identity of the operator. Define ‘accum h v f next m n’ to compute such accumulation, where h is a two-variable function to do accumulation, and v is the base value for accumulation. If we send the multiplication function for h, 1 for v, and the successor function as ‘next’, this ‘accum’ computes ∏i=m..n f(i). Create examples whose ‘h’ is not addition or multiplication, too. fun accum h v f next m n = if (m>=n) then f(m) else (h (f(m)) (accum (h) (v) (f) (next) (next(m)) n)); In problem C, I'm unsure of what i'm suppose to do with my "v" argument. Right now the function will take any interval of numbers m - n and apply any kind of operation to them. For example, I could call my function accum mult (4?) double next3 1 5; where double is a doubling function and next3 adds 3 to a given value. Any ideas on how i'm suppoes to utilize the v value?
This set of problems is designed to lead to implementation of accumulation function. It takes h - combines previous value and current value to produce next value v - starting value for h f - function to be applied to values from [m, n) interval before passing them to h function next - computes next value in sequence m and n - boundaries Here is how I'd define accum: fun accum h v f next m n = if m >= n then v else accum h (h (f m) v) f next (next m) n Examples that were described in C will look like this: fun sum x y = x + y; fun mult x y = x * y; fun id x = x; accum sum 0 id next 1 10; (* sum [1, 10) staring 0 *) accum mult 1 id next 1 10; (* prod [1, 10) starting 1 *) For example, you can calculate sum of numbers from 1 to 10 and plus 5 if you pass 5 as v in first example.
The instructions will make more sense if you consider the possibility of an empty interval. The "sum" of a single value n is n. The sum of no values is zero. The "product" of a single value n is n. The product of no values is one. A list of a single value n is [n] (n::nil). A list of no values is nil. Currently, you're assuming that m ≤ n, and treating m = n as a special case that returns f m. Another approach is to treat m > n as the special case, returning v. Then, when m = n, your function will automatically return h v (f m), which is the same as (f m) (provided that v was selected properly for this h). To be honest, though, I think the v-less approach is fine when the function's arguments specify an interval of the form [m,n], since there's no logical reason that such a function would support an empty interval. (I mean, [m,m−1] isn't so much "the empty interval" as it is "obvious error".) The v-ful approach is chiefly useful when the function's arguments specify a list or set of elements in some way that really could conceivably be empty, e.g. as an 'a list.
How to compute vector product if there are imaginary numbers, in Prolog?
I am trying to multiply two vectors in Prolog but, if those vectors contain imaginary numbers, I can't get it to work. My code so far: vector_product([X|Xs],[Y|Ys],OP) :- inner(Xs,Ys,OP1), OP is X*Y+OP1. vector_product([],[],0).
See if this could help you... Formulae from Wikipedia: % (a+bi) + (c+di) = (a+c) + (b+d)i c_sum((A,B), (C,D), (E,F)) :- E is A+C, F is B+D. % (a+bi) (c+di) = (ac-bd) + (bc+ad)i c_mul((A,B), (C,D), (E,F)) :- E is A*C - B*D, F is B*C + A*D. Numbers are represented as (Real, Imaginary). vector_product([X|Xs], [Y|Ys], OP) :- vector_product(Xs, Ys, OP1), c_mul(X, Y, M), c_sum(M, OP1, OP). vector_product([], [], (0,0)).