Create a list of adjacencies by adjacency matrix - prolog

I need to write a program that will create a list of adjacencies based on the representation of the graph, given in the form of an adjacency matrix.
Examples
input - a list with lists of elements
[[0,1,1],[1,0,1],[1,1,0]].
output
[[0,2,3],[1,0,3],[1,2,0]]
I've tried this one:
indexof(Index, Item, List):-
nth1(Index, List, Item).
replace(I, L, E, K) :-
nth1(I, L, _, R),
nth1(I, K, E, R).
f([], []).
f([H|Tail], [Z|RezTail]):-
member(E,H),
E =:= 1,
indexof(X, E, H),
replace(X, H, X, Z),
f(Tail, RezTail).
Input - f([[0,1,1],[1,0,1],[1,1,0]], Z).
Output - Z = [[0, 2, 1], [1, 0, 1], [1, 1, 0]]
As you can see the problem is that after finding the first " 1 " the program goes into recursion and skips further items in the list. Is there any option how to avoid this?

How about
fh([], [], _).
fh([0|T1], [0|T2], I) :-
Ip is I+1,
fh(T1, T2,Ip).
fh([_|T1], [I|T2], I) :-
Ip is I+1,
fh(T1, T2, Ip).
f([], []).
f([H1|T1], [H2|T2]) :-
fh(H1, H2, 1),
f(T1, T2).
so:
?- f([[0,1,1],[1,0,1],[1,1,0]],X).
evaluates to:
X = [[0, 2, 3], [1, 0, 3], [1, 2, 0]]

Related

How to fix this permutation sort?

The following Prolog program defines a predicate sorted/2 for sorting by permutation (permutation sort) in ascending order a list passed in first argument, which results in the list passed in second argument:
sorted(X, Y) :-
permuted(X, Y),
ordered(Y).
permuted([], []).
permuted(U, [V|W]) :-
permuted(X, W),
deleted(V, U, X).
deleted(X, [X|Y], Y).
deleted(U, [V|W], [V|X]) :-
deleted(U, W, X).
ordered([]).
ordered([_]).
ordered([X, Y|Z]) :-
ordered([Y|Z]), X =< Y.
How to solve the following issues?
The program duplicates solutions for queries in which a list with duplicate elements is passed in second argument:
?- sorted(X, [1, 1, 2]).
X = [1, 1, 2]
; X = [1, 1, 2]
; X = [1, 2, 1]
; X = [1, 2, 1]
; X = [2, 1, 1]
; X = [2, 1, 1]
; false.
The program exhausts resources for queries in which a free variable is passed in second argument:
?- sorted([2, 1, 1], Y).
Y = [1, 1, 2]
; Y = [1, 1, 2]
;
Time limit exceeded
The Prolog program is based on the Horn clause program given at section 11 of Robert Kowalski’s famous paper Predicate Logic as Programming Language:
To solve non-termination, you can add same_length/2 to sorted/2 as #false suggested:
sorted(X, Y) :-
same_length(X, Y),
permuted(X, Y),
ordered(Y).
same_length([], []).
same_length([_|Xs], [_|Ys]) :-
same_length(Xs, Ys).
Or you may embed it into permuted/2 by adding a new argument:
sorted(X, Y) :-
permuted(X, X, Y),
ordered(Y).
permuted([], [], []).
permuted(U, [_|L1], [V|W]) :-
permuted(X, L1, W),
deleted(V, U, X).
The program will still return duplicates as it only sees one item at a time.
To solve duplication, you can either generate all permutations and discard the repeated ones (which is not efficient), or only generate distinct permutations. The following modification does the latter by taking the idea of the recursive procedure permuted/2 + deleted/2 which for each item puts it at the beginning of the list and does a recursive call on the remaining list, and changes it to another recursive procedure permuted_all/2 + deleted_all/2 which for each group of same items puts them at the beginning of the list and does a recursive call on the remaining list. This program uses difference lists for better efficiency:
sorted(X, Y) :-
same_length(X, Y),
permuted_all(X, Y),
ordered(Y).
permuted_all([], []).
permuted_all(U, [V|W]) :-
deleted_all(V, U, X, n-T, [V|W]),
permuted_all(X, T).
% deleted_all(Item, List, Remainder, n-T, Items|T)
deleted_all(_, [], [], y-[X|Xs], [X|Xs]).
deleted_all(X, [V|Y], [V|Y1], y-[X|Xs], Xs1) :-
dif(X, V),
deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(X, [X|Y], Y1, _-Xs, Xs1) :-
deleted_all(X, Y, Y1, y-[X|Xs], Xs1).
deleted_all(U, [V|W], [V|X], n-T, Xs) :-
dif(U, V),
deleted_all(U, W, X, n-T, Xs).
Sample runs:
?- sorted(X, [1, 1, 2]).
X = [1, 2, 1]
; X = [1, 1, 2]
; X = [2, 1, 1]
; false.
?- sorted([2, 1, 1], Y).
Y = [1, 1, 2]
; false.
As per OPs comment asking for a version which does not use difference lists, here goes one which instead obtains the remainder using same_length/2 + append/3 and with added comments:
permuted_all([], []).
permuted_all(U, [V|W]) :-
deleted_all(V, U, X, n, [V|W]),
same_length(X, T), % the remaining list X has the same length as T
append(_, T, [V|W]), % T corresponds to the last items of [V|W]
permuted_all(X, T). % T is a permutation of X
% deleted_all(Item, List, Remainder, n, Items|_)
deleted_all(_, [], [], y, _). % base case
deleted_all(X, [V|Y], [V|Y1], y, Xs1) :-
% recursive step when the current item is not the one we are gathering
dif(X, V),
deleted_all(X, Y, Y1, y, Xs1).
deleted_all(X, [X|Y], Y1, _, [X|Xs1]) :-
% recursive step when the current item is the one we are gathering
deleted_all(X, Y, Y1, y, Xs1).
deleted_all(U, [V|W], [V|X], n, Xs) :-
% recursive step when we have not selected yet the item we will be gathering
dif(U, V),
deleted_all(U, W, X, n, Xs).
Your second problem can by solved by replacing first line with
sorted(X, Y) :-
permuted(X, Y),
ordered(Y),
!.
or
sorted(X, Y) :-
permuted(X, Y),
ordered(Y),
length(X, Z),
length(Y, Z).
The first one is not so easy to solve because of the implementation of this algorithm. Both 1st [1, 1, 2] and 2nd [1, 1, 2] are valid permutations since your code that generated permutations generates all permutations not unique permutations.

Prolog function to create multiplication tables

I am trying to create a prolog function that gets a small multiplication table based on the first value pased to the function.
My code is currently as follows:
mult(n, [[[n, 1], n*1], [[n,2], n*2], [[n,3], n*3]]).
So for example I would like a query such as:
?- mult(5, R).
To display something like:
R = [[[5,1],5], [[5,2],10], [[5,3], 15]]
However, currently this query only returns false, how could I fix my code?
For example, like this. The capital letters for variable names are mandatory.
mult(N, [[[N, 1], N1], [[N,2], N2], [[N,3], N3]]) :-
N1 is 1*N,
N2 is 2*N,
N3 is 3*N.
or maybe:
mult(N, R) :-
numlist(1, 3, M),
maplist(x(N), M, R).
x(N, M, [[N, M], P]) :-
P is N * M.
You could also abuse findall to get the same result in a one-liner.
?- findall([[5,X],P], ( between(1, 3, X), P is 5*X ), R).
R = [[[5, 1], 5], [[5, 2], 10], [[5, 3], 15]].
mulTable(N,End):-
mulTable(N,1,End).
mulTable(_N,Start,End):-
Start > End.
mulTable(N,Counter,End):-
Counter =< End,
write(N),
write('X'),
write(Counter),
write('='),
Mul is N*Counter,
write(Mul),
nl,
NewCounter is Counter +1,
mulTable(N,NewCounter,End).

Prolog - Why does my definition for append_list not return the combined list?

% appends an element to the beginning of a list.
append_element(X, T, [X|T]).
% append a list to another list to create a combined list,
% by breaking the first list apart, and using append_element.
append_list([], L, L).
append_list([H|T], L, NewList) :-
append_element(H, L, NL),
append_list(T, NL, NL).
When I try to run append_list,
?- append_list([1,2], [3, 4, 5], NL).
I get back false. Instead of
NL = [2, 1, 3, 4, 5].
Why?

Storing results in a list in Prolog

I am trying to compute arithmetic calculations and store the results in a new list in Prolog.
The function prototype goes as follows:
calculation(List1, ListofLists, ResultList)
for the first argument I provide a list, for the second argument a list of lists and third the result list. I compute the first argument list with each list of list of lists and store the result in the resulting list.
So can somebody tell me how can I store results in the resulting (empty) list?
With library lambda you can write:
:- use_module(library(lambda)).
:- use_module(library(clpfd)).
calculation(L1, L2, Compute, L) :-
maplist([L2,Compute] +\X^Y^call(Compute,L2, X, Y), L1, L).
% my_compute succeeds when R is the list of all the products
% of the numbers component of L with the number V
my_compute(L, V, R) :-
maplist(V +\X^Y^maplist(V +\Z^T^(T #= Z * V), X, Y), L, R).
Here is an example:
?- calculation([1,2,3], [[4,5],[6,7]], my_compute, Zss).
Zss = [[[4, 5], [6, 7]], [[8, 10], [12, 14]], [[12, 15], [18, 21]]].
?- Zss = [[[4,5],[6,7]],[[8,10],[12,14]],[[12,15],[18,21]]],
calculation(Xs, [[4,5],[6,7]], my_compute, Zss).
Xs = [1, 2, 3].
?- Zss = [[[4,5],[6,7]],[[8,10],[12,14]],[[12,15],[18,21]]],
calculation([1,2,3], Xss, my_compute, Zss).
Xss = [[4, 5], [6, 7]].
calculation([], [], []).
calculation([X|Xs], [Y|Ys], [Z|Zs]) :-
calculate(X, Y, Z),
calculation(Xs, Ys, Zs).
which is identical to:
calculation(X, Y, Z) :-
maplist(calculate, X, Y, Z).
either way, you need a predicate calculate/3 that takes a first argument, a list of lists as the second argument, and calculates a result. For example, summing the list in the second argument and multiplying it to the first argument:
calculate(X, Ys, Z) :-
list_sum(Ys, S),
Z is X * S.
If I understood correctly, you want to do some computation on List1 and every member of ListofLists, and get a list of results.
You can do this using findall:
calculation(List1, ListofLists, ResultList) :-
findall(Result, (
member(List2, ListofLists),
your_computation(List1, List2, Result)
), ResultList).
For example, if you replace your_compuation with append, you get:
?- calculation([a,b],[[c,d],[e,f,g],[h]],X).
X = [[a, b, c, d], [a, b, e, f, g], [a, b, h]].

Create a newlist with elements of the sublists by my List

I have this list :
C = [[1,0],[2,3],[1,2],[1,3]]
I'll like find if the number 1 included in a sublist inside my list in position [1,_ ] and i like to save to a list Newlist the number of X ..... [1,X].
I will give an example... i have the list C and i am searching for sublist which first element it's 1 and give me the Newlist.
The Newlist must be : Newlist=[0,2,3]
It had the second element of the sublists who has the number 1 at the first element.
If you use SWI-Prolog with module lambda.pl, (you can find it at http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl) you can write
:- use_module(library(lambda)).
my_filter(V, L, R) :-
foldl(V+\X^Y^Z^(X = [V,W]
-> append(Y, [W], Z)
; Z = Y),
L, [], R).
nth0/3 allows to access list' elements by index:
?- C = [[1,0],[2,3],[1,2],[1,3]], findall(P, nth0(P, C, [1,_]), NewList).
C = [[1, 0], [2, 3], [1, 2], [1, 3]],
NewList = [0, 2, 3].
edit I'm sorry I didn't read the question right. nth0 is misleading. Could be instead
findall(E, member([1,E], C), NewList)
You need a "filter". This is what it could look like:
filter_1_at_pos_1([], []). % The new list is empty when the input list is empty
filter_1_at_pos_1([[1,X]|Sublist], [X|Xs]) :- % The first element is 1 so the
% second element belongs to the
% new list
!, filter_1_at_pos_1(Sublist, Xs). % filter the remainder of the list
filter_1_at_pos_1([[N,_]|Sublist], Xs) :-
N \== 1, % The first element is not 1, ignore the second element
!, filter_1_at_pos_1(Sublist, Xs).
As #mbratch suggested, just define the solution for one element of the input list for each possible condition, in this case 1) empty list 2) first element is 1 and 3) first element is not 1.
?- C = [[1,0],[2,3],[1,2],[1,3]], filter_1_at_pos_1(C, NewList).
C = [[1, 0], [2, 3], [1, 2], [1, 3]],
NewList = [0, 2, 3].
The cuts make the predicate deterministic. The cut in the last clause is not necessary.

Resources