Multiplication of two tables in Prolog - prolog

I am trying to create a prolog function that gets a two table multiplication .
My code is currently as follows:
mult(L1,L2,L).
So for example I would like a query such as:
?- mult([x,x],[x,x,x],R).
To display something like:
R=[x,x,x,x,x,x]
how could I fix my code?
i tried with recusion ,but didn't know how to implement it.

I would write:
mult(Ls, Rs, Answer) :-
findall(X, (member(L, Ls),
member(R, Rs),
X is L * R),
Answer).
e.g.
?- mult([10,100], [1,2,3], Answer).
Answer = [10, 20, 30, 100, 200, 300]
but you are probably supposed to use recursion, so:
% Multiply a list of numbers R(ight)s, each by
% one integer L from the original L(eft)s list
mult_row([], _, []).
mult_row([R|Rs], L, [Product|RowAnswers]) :-
Product is L * R,
mult_row(Rs, L, RowAnswers).
% Multiply two lists of integers L(eft)s and R(ight)s
mult([], _, []).
mult([L|Ls], Rs, Answers) :-
mult_row(Rs, L, As1),
mult(Ls, Rs, As2),
flatten([As1, As2], Answers).
e.g.
?- mult([10,100,1000], [1,2,3], Answers).
Answers = [10, 20, 30, 100, 200, 300, 1000, 2000, 3000]
To multiply [10,100,1000] * [1,2,3] it does this:
Take the first number from the left list (10)
calls mult_row to calculate (10 * 1,2,3)
that makes a list of [10, 20, 30] into As1.
Then the remaining [100, 1000] go through this from the start (recursion).
Take the first number from the left list (100)
calls mult_row to calculate (100 * 1,2,3)
that makes a list of [100, 200, 300] into (a new variable) As1.
Then the remaining [1000] go through this from the start (recursion).
Take the first number from the left list (1000)
calls mult_row to calculate (1000 * 1,2,3)
that makes a list of [1000, 2000, 3000] into (a new variable) As1.
Then the remaining [] go through this from the start (recursion).
Take the first number from the left list ([] - empty)
flatten [[1000, 2000, 3000], []] into Answers [1000, 2000, 3000]
finish [[100, 200, 300], [1000, 2000, 3000]] into (a new variable) Answers. [100, 200, 300, 1000, 2000, 3000]
finish [[10, 20, 30], [100, 200, 300], [1000, 2000, 3000]] into (a new variable) answers with the final answer.
finish.
And the call to mult_row does the same pattern; a recursive walk over the list, multiplying 10x1, 10x2, 10x3 into an answer list, for each row.

Related

Prolog: List of sublists

i have a task to create a list of sublists where the elements are sorted in consecutive order. I'm having difficulties because when it iterates through the list and returns multiple lists with a list, thats not what i want. My goal is a list with multiple sublists of length 3.
example
list([]).
list([_|T]) :- list(T).
sublist(L, []) :- list(L).
sublist([HX|TX],[HX|TY]) :- sublist(TX,TY).
sublist([_|TY], X) :- X = [_|_], sublist(TY, X).
This prints out every single sublist.
?- sublist([10,20,30,a,b], L).
L = [] ;
L = [10] ;
L = [10, 20] ;
L = [10, 20, 30] ;
L = [10, 20, 30, a] ;
L = [10, 20, 30, a, b] ;
L = [10, 20, 30, b] ;
..and so on
What i want is something like this
?- sublist([10,20,30,a,b], L).
L = [[10,20,30],[20,30,a],[30,a,b]]
I've been overthinking this i guess, and other thing X = [_,_,_] destroys my functionality.
You can use append/3 to obtain all the "sliding" sublists.
For the specific case of 3 elements:
sublist(L, LSubL):-
findall([A,B,C], append(_, [A,B,C|_], L), LSubL).
For the more general case of sliding window of 'Size' items:
sliding_window(L, Size, LSubL):-
length(SubL, Size),
append(SubL, _, SubLO),
findall(SubL, append(_, SubLO, L), LSubL).

Prolog insert into a list

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]).

Extract Facts as Matrix in Prolog

Suppose we have the following:
edge(a, 1, 10).
edge(b, 2, 20).
edge(c, 3, 30).
edge(d, 4, 40).
I want to extract a matrix representation (M) of these facts, such that
M = [[a,b,c,d],[1,2,3,4],[10,20,30,40]]
Here's a no-brainer solution:
edgeMatrix(M) :-
findall(A, edge(A, _, _), As),
findall(B, edge(_, B, _), Bs),
findall(C, edge(_, _, C), Cs),
M = [As, Bs, Cs].
There are some problems to this approach, however, viz:
we traverse the database n times, where n is the number of arguments; and
this doesn't generalize very well to an arbitrary n.
So the question is: what is the most idiomatic way to achieve this in Prolog?
What about:
edgeMatrix(M) :-
findall([A,B,C],edge(A,B,C),Trans),
transpose(Trans,M).
Now you can simply import the transpose/2 matrix from clpfd module, or implement one yourself like in this answer (yeah I know that's quite lazy, but what is the point of reinventing the wheel?).
If I run this in swipl, I get:
?- edgeMatrix(M).
M = [[a, b, c, d], [1, 2, 3, 4], [10, 20, 30, 40]].
which looks exactly like you want.
You can of course say that there is still some computational overhead to calculate the transpose/2, but the collecting phase is done only once (and if these are not simply facts, but answers from clauses as well) which can be expensive as well, and furthermore I think a module will implement clauses probably very efficiently anyway.
I don't think you'll find a solution that is both completely general and maximally efficient. Here's a simple solution for N = 3:
edges(Edges) :-
Goal = edge(_A, _B, _C),
findall(Goal, Goal, Edges).
edges_abcs_([], [], [], []).
edges_abcs_([edge(A,B,C)|Edges], [A|As], [B|Bs], [C|Cs]) :-
edges_abcs_(Edges, As, Bs, Cs).
edges_abcs([As, Bs, Cs]) :-
edges(Edges),
edges_abcs_(Edges, As, Bs, Cs).
After adding 100,000 additional edge/3 facts, this performs as follows:
?- time(edges_abcs(M)).
% 200,021 inferences, 0.063 CPU in 0.065 seconds (97% CPU, 3176913 Lips)
M = [[a, b, c, d, 1, 2, 3, 4|...], [1, 2, 3, 4, 1, 2, 3|...], [10, 20, 30, 40, 1, 2|...]].
For comparison, here is the measurement for the implementation from the question:
?- time(edgeMatrix_orig(M)).
% 300,043 inferences, 0.061 CPU in 0.061 seconds (100% CPU, 4896149 Lips)
M = [[a, b, c, d, 1, 2, 3, 4|...], [1, 2, 3, 4, 1, 2, 3|...], [10, 20, 30, 40, 1, 2|...]].
And here is the more general solution based on transpose/2 by Willem:
?- time(edgeMatrix_transpose(M)).
% 700,051 inferences, 0.098 CPU in 0.098 seconds (100% CPU, 7142196 Lips)
M = [[a, b, c, d, 1, 2, 3, 4|...], [1, 2, 3, 4, 1, 2, 3|...], [10, 20, 30, 40, 1, 2|...]].
So my solution seems best in terms of number of inferences: 100,000 inferences for the findall/3 and 100,000 inferences for traversing the list. The solution from the question has 100,000 inferences for each findall/3, but nothing more. It is, however, slightly faster because it's more memory efficient: Everything that is allocated ends up in the final solution, whereas my program allocates a list of 100,000 edge/3 terms which must then be garbage collected. (In SWI-Prolog, you can see the garbage collections if you turn on the profiler and/or GC tracing.)
If I really needed this to be as fast as possible and to be generalizable to many different values of N, I'd write a macro that expands to something like the solution in the question.
Edit: If the "idiomatic" requirement is lifted, I would resort to storing the edge database as a list in an SWI-Prolog global variable. In that case, my single-pass implementation would work without the findall/3 overhead and without producing intermediate garbage.

Generate all permutations of the list [1, 1, 2, 2, ..., n, n] where the number of elements between each pair is even in Prolog

I recently started learning Prolog and I got a task to write a predicate list(N, L) that generates lists L such that:
L has length 2N,
every number between 1 and N occurs exactly twice in L,
between each pair of the same element there is an even number of other elements,
the first occurrences of each number are in increasing order.
The author states that there are N! such lists.
For example, for N = 3 all solutions are:
?- list(3, L).
L = [1, 1, 2, 2, 3, 3] ;
L = [1, 1, 2, 3, 3, 2] ;
L = [1, 2, 2, 1, 3, 3] ;
L = [1, 2, 2, 3, 3, 1] ;
L = [1, 2, 3, 3, 2, 1] ;
L = [1, 2, 3, 1, 2, 3] ;
false.
My current solution looks like:
even_distance(H, [H | _]) :-
!.
even_distance(V, [_, _ | T]) :-
even_distance(V, T).
list(N, [], _, Length, _, _) :-
Length =:= 2*N,
!.
list(N, [New | L], Max, Length, Used, Duplicates) :-
select(New, Duplicates, NewDuplicates),
even_distance(New, Used),
NewLength is Length + 1,
list(N, L, Max, NewLength, [New | Used], NewDuplicates).
list(N, [New | L], Max, Length, Used, Duplicates) :-
Max < N,
New is Max + 1,
NewLength is Length + 1,
list(N, L, New, NewLength, [New | Used], [New | Duplicates]).
list(N, L) :-
list(N, L, 0, 0, [], []).
It does two things:
if current maximum is less than N, add that number to the list, put it on the list of duplicates, and update the max;
select some duplicate, check if there is an even number of elements between it and the number already on the list (ie. that number is on odd position), then add it to the list and remove it from duplicates.
It works, but it's slow and doesn't look really nice.
The author of this exercise shows that for N < 12, his solution generates a single list with average of ~11 inferences (using time/1 and dividing the result by N!). With my solution it grows to ~60.
I have two questions:
How to improve this algorithm?
Can this problem be generalized to some other known one? I know about similar problems based on the multiset [1, 1, 2, 2, ..., n, n] (eg. Langford pairing), but couldn't find something like this.
I'm asking because the original problem is about enumerating intersections in a self-intersecting closed curve. You draw such curve, pick a point and direction and follow the curve, enumerating each intersection when met for the first time and repeating the number on the second meeting: example (with the answer [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).
The author states that every such curve satisfies the predicate list, but not every list corresponds to a curve.
I had to resort to arithmetic to satisfy the requirement about pairs of integers separated by even count of elements. Would be nice to be able to solve without arithmetic at all...
list(N,L) :- numlist(1,N,H), list_(H,L), even_(L).
list_([D|Ds],[D|Rs]) :-
list_(Ds,Ts),
select(D,Rs,Ts).
list_([],[]).
even_(L) :-
forall(nth0(P,L,X), (nth0(Q,L,X), abs(P-Q) mod 2 =:= 1)).
select/3 is used in 'insert mode'.
edit to avoid arithmetic, we could use this more verbose schema
even_(L) :-
maplist(even_(L),L).
even_(L,E) :-
append(_,[E|R],L),
even_p(E,R).
even_p(E,[E|_]).
even_p(E,[_,_|R]) :- even_p(E,R).
edit
Here is a snippet based on assignment in a prebuilt list of empty 'slots'. Based on my test, it's faster than your solution - about 2 times.
list(N,L) :-
N2 is N*2,
length(L,N2),
numlist(1,N,Ns),
pairs(Ns,L).
pairs([N|Ns],L) :- first(N,L,R),even_offset(N,R),pairs(Ns,L).
pairs([],_).
first(N,[N|R],R) :- !.
first(N,[_|R],S) :- first(N,R,S).
even_offset(N,[N|_]).
even_offset(N,[_,_|R]) :- even_offset(N,R).
My first attempt, filtering with even_/1 after every insertion, was much slower. I was initially focused on pushing the filter immediately after the select/3, and performance was indeed almost good as the last snippet, but alas, it loses a solution out of 6...

Whats wrong with this prolog optimization solution?

solve(Amounts) :-
Total = 1505,
Prices = [215, 275, 335, 355, 420, 580],
length(Prices, N),
length(Amounts, N),
Amounts :: 0..Total//min(Prices),
Amounts * Prices #= Total,
labeling(Amounts).
There is nothing wrong with it. It is the example from http://eclipseclp.org/examples/xkcd287.ecl.txt, and if you hadn't omitted the line
:- lib(ic).
which loads the interval constraint solver, it would work just fine in ECLiPSe Prolog.
Does also work in SWI-Prolog:
?- use_module(library(clpfd)).
?- [user].
solve(Amounts) :-
Total = 1505,
Prices = [215,275,335,355,420,580],
length(Prices, N),
length(Amounts, N),
min_list(Prices, MinPrice),
MaxAmount is Total//MinPrice,
Amounts ins 0..MaxAmount,
scalar_product(Prices, Amounts, #=, Total),
label(Amounts).
^D
?- solve(X).
X = [1, 0, 0, 2, 0, 1] ;
X = [7, 0, 0, 0, 0, 0].
But I guess its not an optimization search problem,
the objective function is missing.
Bye

Resources