Matrix multiplication with Prolog - matrix

I have to write a predicate the predicate product/3 which receives two matrix and returns the matrix multiplication of them if possible or fail otherwise. (This means if the matrices fullfill the requirement [n x p] [p x y], then return the multiplication with dimensions [n x y])
Example:
product(M1, M2, R)
?- product([[1,2],[3,4],[5,6]], [[1,1,1],[1,1,1]], M).
M = [[3, 3, 3], [7, 7, 7], [11, 11, 11]];
No
For this I have two codes that index the nth row on a matrix rowI and that index the nth column columnI (I explain how they work in the code below).
%Predicate: rowI(M, I, RI)
%Input rowI([[1,2],[3,4],[5,6]], 2, RI).
% RI = [3,4];
rowI([H|_],1,H):-!.
rowI([_|T],I,X) :-
I1 is I-1,
rowI(T,I1,X).
% columnJ(M, J, CJ)
%Input columnJ([[1,2],[3,4],[5,6]], 1, CJ).
% CJ = [1,3,5];
columnJ([],_,[]).
columnJ([H|T], I, [R|X]):-
rowI(H, I, R),
columnJ(T,I,X).
product([H|T], M2, [R|X]):-
columnJ(M2, C, Z),
mult(H, Z , X),
product(T, M2 , X).
I was thinking somehow by grabbing the head of the M1 (which will be each row) and then multiplied for each column in M2 and after adding the multiplication this list will be the new row. So (C would have to be a counter starting from 1 to the length of M2and then mult I was just thinking on having it multiplying the lists. (mult is not defined at this point, just a guess).
Here I am trying to explain the way I am thinking it.. but there may be a simplier way. What do you think?

Compact code (with the help of higher order constructs maplist and foldl).
I left on purpose the expressions unevaluated, so the result could be reused in more general context:
:- module(matrix_multiply,
[matrix_multiply/3
,dot_product/3
]).
:- use_module(library(clpfd), [transpose/2]).
%% matrix_multiply(+X,+Y,-M) is det.
%
% X(N*P),Y(P*M),M(N*M)
%
matrix_multiply(X,Y,M) :-
transpose(Y,T),
maplist(row_multiply(T),X,M).
row_multiply(T,X,M) :-
maplist(dot_product(X),T,M).
dot_product([X|Xs],[T|Ts],M) :-
foldl(mul,Xs,Ts,X*T,M).
mul(X,T,M,M+X*T).
edit
usage (save in a file named matrix_multiply.pl):
?- [matrix_multiply].
?- matrix_multiply([[1,2],[3,4],[5,6]], [[1,1,1],[1,1,1]],R),maplist(maplist(is),C,R).
R = [[1*1+2*1, 1*1+2*1, 1*1+2*1], [3*1+4*1, 3*1+4*1, 3*1+4*1], [5*1+6*1, 5*1+6*1, 5*1+6*1]],
C = [[3, 3, 3], [7, 7, 7], [11, 11, 11]].
The numeric evaluation is explicitly requested by ,maplist(maplist(is),C,R).
R holds the symbolic expressions, C the values.
edit
Just to note that dependency from clpfd:transpose is easy to remove: here is an alternative 'one-liner' definition based on nth/3 and library(yall)
mat_transpose([R1|Rs],T) :- findall(V,(
nth1(Col,R1,_),
maplist({Col}/[R,C]>>nth1(Col,R,C),[R1|Rs],V)),T).

Related

Prolog: generate solution according to the original list

I am a beginner in Prolog, and I've searched a lot but cannot solve the problem. The question is giving me a list given the head of the list, such as [20,_,_,_].
The length of the list is unknown. For example, it could be [30,_,_,_,_,_].
the _ is the distinct factor, which only consists of the digit from 1 to 9. For example, [20,_,_,_] could generate [1,4,5] and its combination.
The list could be filled with a number first. For example, [20,_,4,_]. The output would be still [1,4,5] and [5,4,1].
What I've tried is to rip off the head of the list, and try to generate the rest of the elements back to the original list, but I failed, and cannot understand the debugger and its trace information.
removeHead([Head|Tail],Tail).
get_head_element([],_).
get_head_element([Head|Rest],Head).
divide(1,[],_).
divide(Number,[Head|List],Result):-
0 is mod(Number,Head),
Quotient is Number/Head,
divide(Quotient,List,Result).
solve_multiply(Row,RestRow):-
get_head_element(Row, Goal),
removeHead(Row,RestRow),
all_distinct(RestRow),
RestRow ins 1..9,
divide(Goal,RestRow,RestRow).
Any hint of resource that I can keep approaching this question? Thanks.
EDIT:
I think it another way that the elements multiplied in the list would be the same at the head, so I wrote a multiply predicate.
%% multiply(+List,-Result)
%
% for calling the multiply(+List,+PrevResult,+Result) with accumulator set to 1
multiply(List,Result):-
multiply(List,1,Result).
%% multiply(+List,+PrevResult,+Result)
%
% multiply each element in the list
multiply([Element|RestList],PrevResult,Result):-
NextResult is PrevResult * Element,
multiply(RestList,NextResult, Result).
%% multiply([], -Result, -Result).
%
% multiply predicate stops when all the elements have been multiplied
multiply([], Result, Result).
%% solve_multiply(+Row,-RestRow)
solve_multiply(Row,RestRow):-
get_head_element(Row, Goal),
removeHead(Row,RestRow),
RestRow ins 1..9,
multiply(RestRow,Goal), % get the Arguments not sufficiently instantiated message
all_distinct(RestRow).
The simplest way to find the solution is to:
Compare the multiplied elements to the head element.
Use the constraint provided by clpfd.
Therefore, the code should be:
multiply(List,Result):-
multiply(List,1,Result).
multiply([Element|RestList],PrevResult,Result):-
NextResult #= PrevResult * Element, % constraint that works for both side ?X #= ?Y
multiply(RestList,NextResult, Result). % tail recursion
multiply([], Result, Result).
solve_multiply(Row,RestRow):-
get_head_element(Row, Goal),
removeHead(Row,RestRow),
RestRow ins 1..9,
multiply(RestRow,Goal),
all_distinct(RestRow).
When calling the solve_multiply([20,_,_,_],X), labeling([],X). The result is:
X = [1, 4, 5] ;
X = [1, 5, 4] ;
X = [4, 1, 5] ;
X = [4, 5, 1] ;
X = [5, 1, 4] ;
X = [5, 4, 1] ;
false.
When calling the solve_multiply([20,_,1,_],X), labeling([],X). The result is:
X = [4, 1, 5] ;
X = [5, 1, 4].

(Prolog) Check if a list can be split into 2 sub-lists that have equal sums

I am using Prolog to try and check if a list can be split into 2 sublists(subarrays) that have equal sums.
The following should succeed: [1,2,3,6], [2,1,1], [0], [1,1,2]
The following should fail: [1,4,8], [1,3,2], [2,2,1,1]
I believe my program is creating subsequences instead of sublists. This is causing queries similar to [1,3,2] and [2,2,1,1] to succeed when they should fail.
In the example of the query [1,3,2] it is returning true because the subsequences [1,2] and [3] have equal sums. That should not be allowed. Instead, [1,3,2] should be split into sublists [1]/[3,2] and [1,3]/[2]. Hence, it should fail.
I am unsure how to modify the subL predicate to return sublists instead of subsequences.
Here is what I have so far:
split([]).
split([0]).
split([H|T]) :-
subL([H|T], LEFT, RIGHT),
sum(LEFT, SUM1),
sum(RIGHT, SUM2),
SUM1=SUM2.
subL([],[],[]).
subL([H|T], [H|T2], X) :-
subL(T, T2, X).
subL([H|T], X, [H|T2]) :-
subL(T, X, T2).
sum([H|T], SUM1) :-
sum(T, SUM2),
SUM1 is SUM2 + H.
sum([H], SUM1) :-
H = SUM1.
Any help with this would be greatly appreciated. Thank you
YOu can make use of append to split the list into different lists. Indeed:
?- append(L, R, [1,2,3,6]).
L = [],
R = [1, 2, 3, 6] ;
L = [1],
R = [2, 3, 6] ;
L = [1, 2],
R = [3, 6] ;
L = [1, 2, 3],
R = [6] ;
L = [1, 2, 3, 6],
R = [] ;
false.
so you can write a predicate:
split(X) :-
append(L, R, X),
sum(L, S),
sum(R, S).
Here we thus check if both the left and the right sublist sum up to the same sum S. You however slighly need to change your sum/2 predicate such that the sum for an empty list is 0 as well. I leave that as an exercise.
The above is not very efficient, since it takes O(n2) time. You can make it linear by first calculating the sum of the entire list, and then make a predicate that iterates over the list, each time keeping track of the sum of the elements on the left side, and the remaining sum on the right side. I think that by first solving it the "naive" way, you likely will find it easier to implement that as an improvement.

Exclude variants/rotations of lists in solutions SWI-Prolog

I want to exclude multiple rotations/mirrors of a list in my solutions of the predicate. I'll give an example of what I understand are rotations/mirrors of a list:
[1,2,3,4,5]
[2,3,4,5,1]
[3,4,5,1,2]
[5,4,3,2,1]
I have to find a predicate that delivers unique sequence of numbers from 1 to N, according to some constraints. I already figured out how to compute the right sequence but I can't find out how to exclude all the rotations and mirrors of 1 list. Is there an easy way to do this?
Edit:
Full predicate. clock_round(N,Sum,Yf) finds a sequence of the numbers 1 to N in such a way that no triplet of adjacent numbers has a sum higher than Sum.
clock_round(N,Sum,Yf) :-
generate(1,N,Xs),
permutation(Xs,Ys),
nth0(0,Ys,Elem1),
nth0(1,Ys,Elem2),
append(Ys,[Elem1,Elem2],Ym),
safe(Ym,Sum),
remove_duplicates(Ym,Yf).
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+member(H, T),
remove_duplicates( T, T1).
% generate/3 generates list [1..N]
generate(N,N,[N]).
generate(M,N,[M|List]) :-
M < N, M1 is M + 1,
generate(M1,N,List).
% permutation/2
permutation([],[]).
permutation(List,[Elem|Perm]) :-
select(Elem,List,Rest),
permutation(Rest,Perm).
safe([],_).
safe(List,Sum) :-
( length(List,3),
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum
; [_|RestList] = List, % first to avoid redundant retries
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum,
safe(RestList,Sum)
).
So what you want is to identify certain symmetries. At first glance you would have to compare all possible solutions with such. That is, in addition of paying the cost of generating all possible solutions you will then compare them to each other which will cost you a further square of the solutions.
On the other hand, think of it: You are searching for certain permutations of the numbers 1..n, and thus you could fix one number to a certain position. Let's fix 1 to the first position, that is not a big harm, as you can generate the remaining n-1 solutions by rotation.
And then mirroring. What happens, if one mirrors (or reverses) a sequence? Another sequence which is a solution is produced. The open question now, how can we exclude certain solutions and be sure that they will show up upon mirroring? Like: the number after 1 is larger than the number before 1.
At the end, rethink what we did: First all solutions were generated and only thereafter some were removed. What a waste! Why not avoid to produce useless solutions first?
And even further at the end, all of this can be expressed much more efficiently with library(clpfd).
:- use_module(library(clpfd)).
clock_round_(N,Sum,Xs) :-
N #=< Sum, Sum #=< 3*N -2-1,
length(Xs, N),
Xs = [D,E|_],
D = 1, append(_,[L],Xs), E #> L, % symmetry breaking
Xs ins 1..N,
all_different(Xs),
append(Xs,[D,E],Ys),
allsums(Ys, Sum).
allsums([], _).
allsums([_], _).
allsums([_,_], _).
allsums([A,B,C|Xs], S) :-
A+B+C #=< S,
allsums([B,C|Xs], S).
?- clock_round_(N, Sum, Xs), labeling([], [Sum|Xs]).
N = 3, Sum = 6, Xs = [1,3,2]
; N = 4, Sum = 9, Xs = [1,3,4,2]
; N = 4, Sum = 9, Xs = [1,4,2,3]
; N = 4, Sum = 9, Xs = [1,4,3,2]
; N = 5, Sum = 10, Xs = [1,5,2,3,4]
; ... .
Here is a possibility do do that :
is_rotation(L1, L2) :-
append(H1, H2, L1),
append(H2, H1, L2).
is_mirror(L1, L2) :-
reverse(L1,L2).
my_filter([H|Tail], [H|Out]):-
exclude(is_rotation(H), Tail, Out_1),
exclude(is_mirror(H), Out_1, Out).
For example
?- L = [[1,2,3,4,5],[2,3,4,5,1],[3,4,5,1,2],[5,4,3,2,1], [1,3,2,4,5]],my_filter(L, Out).
L = [[1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2], [5, 4, 3, 2, 1], [1, 3, 2, 4|...]],
Out = [[1, 2, 3, 4, 5], [1, 3, 2, 4, 5]].

How to create a list of numbers that add up to a specific number

I need some help writing a predicate in Prolog that, given a number as input, returns a list of lists with numbers that add up to it.
Let's call the predicate addUpList/2, it should work like this:
?- addUpList(3,P).
P = [[1,2], [2,1], [1,1,1]]. % expected result
I'm having so much trouble figuring this out I'm beginning to think it's impossible. Any ideas? Thanks in advance.
Try this:
condense([], Rs, Rs).
condense([X|Xs], Ys, Zs) :-
condense(Xs, [X|Ys], Zs).
condense([X, Y|Xs], Ys, Zs) :-
Z is X + Y,
condense([Z|Xs], Ys, Zs).
condense(Xs, Rs) :-
condense(Xs, [], Rs).
expand(0, []).
expand(N, [1|Ns]) :-
N > 0,
N1 is N - 1,
expand(N1, Ns).
addUpList(N, Zs) :-
expand(N, Xs),
findall(Ys, condense(Xs, Ys), Zs).
Let me know what marks I get. :-)
The rule num_split/2 generates ways of splitting a number into a list, where the first element X is any number between 1 and N and the rest of the list is a split of N-X.
num_split(0, []).
num_split(N, [X | List]) :-
between(1, N, X),
plus(X, Y, N),
num_split(Y, List).
In order to get all such splits, just call findall/3 on num_split/2.
add_up_list(N, Splits) :-
findall(Split, num_split(N, Split), Splits).
Usage example:
?- add_up_list(4, Splits).
Splits =
[[1, 1, 1, 1], [1, 1, 2], [1, 2, 1], [1, 3], [2, 1, 1], [2, 2], [3, 1], [4]].
See also the post by #hardmath which gives the same answer with a bit more explanation.
The example given in the Question suggests that compositions (ordered partitions) of any positive integer N &leq; 10 are wanted. Note however that the solution [3] for N=3 seems to have been omitted/overlooked. The number of compositions of N is 2^(N-1), so N=10 gives a long list but not an unmanageable one.
It is also desired to collect all such solutions into a list, something that findall/3 can do generically after we write a predicate composition/2 that generates them.
The idea is to pick the first summand, anything between 1 and N, subtract it from the total and recurse (stopping with an empty list when the total reaches zero). SWI-Prolog provides a predicate between/3 that can generate those possible first summands, and Amzi! Prolog provides a similar predicate for/4. For the sake of portability we write our own version here.
summand(Low,High,_) :-
Low > High,
!,
fail.
summand(Low,High,Low).
summand(Low,High,Val) :-
Now is Low + 1,
summand(Now,High,Val).
composition(0,[ ]).
composition(N,[H|T]) :-
summand(1,N,H),
M is N - H,
composition(M,T).
Given the above Prolog source code, compiled or interpreted, a list of all solutions can be had in this way:
?- findall(C,composition(3,C),L).
C = H126
L = [[1, 1, 1], [1, 2], [2, 1], [3]]
Of course some arrangement of such a list of solutions or the omission of the singleton list might be required for your specific application, but this isn't clear as the Question is currently worded.
There are plenty of great answers to this question already, but here is another solution to this problem for you to consider. This program differs from the others in that it is very efficient, and generates non-redundant solutions of lists which are assumed to represent sets of integers which add up to the specified number.
gen(N, L) :-
gen(N-1, N, N, FL),
dup_n(FL, L).
gen(C-F, M, M, [C-F]).
gen(C-F, S, M, [C-F|R]) :-
S < M, C > 1,
C0 is C - 1,
F0 is floor(M / C0),
S0 is S + (C0 * F0),
gen(C0-F0, S0, M, R).
gen(C-F, S, M, R) :-
F > 0,
F0 is F - 1,
S0 is S - C,
gen(C-F0, S0, M, R).
dup_n([], []).
dup_n([_-0|R], L) :-
!, dup_n(R, L).
dup_n([V-F|R], [V|L]) :-
F0 is F - 1,
dup_n([V-F0|R], L).
Your implementation of addUpList/2 can be achieved by:
addUpList(N, P) :-
findall(L, gen(N, L), P).
Which should give you the following behaviour:
?- addUpList(4,L).
L = [[4], [3, 1], [2, 2], [2, 1, 1], [1, 1, 1, 1]].
Note that the list containing one 2 and two 1s only appears once in this result set; this is because gen/4 computes unique sets of integers which add up to the specified number.
This answer is somewhere between
#Kaarel's answer and
#sharky's "efficient" answer.
Like #sharky's code, we impose an ordering relation between adjacent list items to restrict the size of the solution space---knowing how to inflate it if we ever need to. So the solution sets of break_down/2 and gen/2 by #sharky are equal (disregarding list reversal).
And as for performance, consider:
?- time((break_down(40,_),false)).
% 861,232 inferences, 0.066 CPU in 0.066 seconds (100% CPU, 13127147 Lips)
false.
?- time((gen(40,_),false)).
% 8,580,839 inferences, 0.842 CPU in 0.842 seconds (100% CPU, 10185807 Lips)
false.

prolog pascal triangle

hi is there anybody know how can i do the pascal nth row
when i ask for
:? pascal(2,Row).
i get Row=[1,2,1]
??
please help me
Here is the code to compute the nth row.
The first part scans a row, to compute the next row. The first row must be prefixed with a 0, so that the first "1" in the next row is a sum, like the other elements. It recurses on the 2 lists:
pascal_next_row([X],[X]).
pascal_next_row([H,H2|T],[A|B]):-
pascal_next_row([H2|T],B),
A is H + H2.
The second part computes all the rows until the one which was asked. It recurses on N:
pascal(0, [1]) :- !.
pascal(N, R) :-
N1 is N-1,
pascal(N1, R1),
pascal_next_row([0|R1], R).
If you need the full triangle, all you have to do is change the second parameter to handle a list of rows, and collect them:
pascal(0, [[1]]) :- !.
pascal(N, [R, R1 | RN]) :-
N1 is N-1,
pascal(N1, [R1 | RN]),
pascal_next_row([0|R1], R).
This answer to a code golf has the implementation in prolog, just expand the names:
The Pascal Triangle is also known as the Tartaglia Triangle:
sumC([X,Y],[Z]) :- Z is X + Y.
sumC([X,Y|L], Z):- H is X + Y,
sumC([Y|L],L2),
Z = [H|L2].
tartaglia(1,[1]) :- ! .
tartaglia(2,[1,1]) :- !.
tartaglia(N, L) :- Ant is N - 1,
tartaglia(Ant,L2),
sumC(L2,R),
append([1|R],[1],L), !.
Using the helper predicate sumC, you can get it easily:
?- tartaglia(3,R).
R = [1, 2, 1].
?- tartaglia(2,R).
R = [1, 1].
?- tartaglia(1,R).
R = [1].
?- tartaglia(6,R).
R = [1, 5, 10, 10, 5, 1].
As said in my comment. You ask for the nth row. [1,2,1] from your example is the 3rd row.

Resources