Calculate the sum of a sum in Clingo - logic

I am trying to resolve the following problem:
Given k neurons n1,...,nk they are connected by a predicate arc given in input. The first h neurons are input ones and do not have any incoming arcs, they have a boolean value. Every arc (i,j) have a weight w(i,j) that have value [-2, ..., +2].
The output of node (that is not an input one) is obtained, as always, by the sum on all the incoming arcs of the arc weight times the output value of the neuron at the other end of the arc.
Determine the weights of the network that maximize the sum of the absolute values of the difference between the weitghts of nk-1 and nk on all the given configurations in input. Consider only acyclic graphs.
Prepare a battery of benchmark instances in the following way. For each k = 10, 15, 20, 25, 30 and h~k/3: generate randomly 20 different instances (arc). 100 instances in total
The part that says that the input nodes have boolean values means that for each configuration we have a different set of input nodes, for example with h = 2 we have:
n_config
h1
h2
1
0
0
2
0
1
3
1
0
4
1
1
This means that in the first configuration the input nodes are false (i.e. not considered), in the second only the first is true, etc...
I am at a point where I do not know where to go. I have found a solution that works well for k = 5 and h = 2 but the moment I try with k = 10 and h = 3 the grounding takes a lot. So I suspect I am doing something wrong with the sum, for calculate the weight of each output node.
Here the code I am working with:
#const n = 5. % nodes
#const h = 2. % input nodes h~k/3
#const n_config = 2**h.
node(1..n).
weight(-2;-1;0;1;2).
% arc predicate
arc(1,3). arc(2,3). arc(3,4;3,5).
% arcs for k = 10
% arc(1,4;1,5;1,8). arc(2,4;2,5;2,8;2,10). arc(3,4;3,5;3,7;3,9). arc(4,5). arc(5,8;5,10). arc(6,8;6,9;6,10). arc(7,9;7,10). arc(8,9;8,10).
% Configurations
config(1..2**h).
% differentiate between input and output nodes
node_out(X) :- node(X), X>h.
node_in(X) :- node(X), X<=h.
% The input node don't have any input edge
:- node_in(X), node(Y), arc(Y,X).
% Assign one weight to each arc using a choice rule
1 {weight_arc(X,Y,W) : weight(W)}1 :- arc(X, Y).
% input layer
{weight_node(C,X,1) : node_in(X)}:- config(C).
% output nodes
weight_node(C,X, 1) :- node_out(X), config(C).
%%% Now we eliminate all the configurations we do not want to also speed up the aggregate sum
% the number of 1 need to be the half af all number of 0s and 1s
:- #count{C,V:weight_node(C,X,V)}!=(2**h)/2, node_in(X).
% At least one config has all at 1 or 0
:- #count{C:weight_node(C,X,V), node_in(X)}!=(2**h)-1.
% First config always at 0
:- #count{C:weight_node(C,X,V), node_in(X), C=1} != 0.
% Last config always at 1
:- #count{X:weight_node(C,X,V), node_in(X), C=2**h} < h.
% The other are always different from 0 and 1
:- #count{X:weight_node(C,X,V), node_in(X)}=0, config(C), C!=1, C!=h**2.
% give an order to the succession of input nodes
:- T1=#count{X1:weight_node(C1,X1,V), node_in(X1)},
T2=#count{X2:weight_node(C2,X2,V), node_in(X2)},
config(C1), config(C2), C1<C2, T1=T2,
MaxC1 = #max{X1:weight_node(C1,X1,V), node_in(X1)},
MaxC2 = #max{X2:weight_node(C2,X2,V), node_in(X2)},
MaxC1>MaxC2.
:- T1=#count{X1:weight_node(C1,X1,V), node_in(X1)}, T2=#count{X2:weight_node(C2,X2,V), node_in(X2)}, config(C1), config(C2), C1<C2, T1>T2.
weight_nodexarc(C,X,Y,S*Wa) :- weight_node(C, X, S), weight_arc(X,Y,Wa), node_in(X).
weight_nodexarc(C,X,Y,S*Wa) :- out_weight_node(C, X, S), weight_arc(X,Y,Wa), node_out(X).
out_weight_node(C, Y, Wn) :- Wn=#sum{W,X: weight_nodexarc(C,X,Y,W)}, node_out(Y), config(C), C>1.
out_weight_node(C, Y, Wn) :- Wn=0, node_out(Y), config(C), C=1.
result_config(C,|R|) :- out_weight_node(C,n,O1), out_weight_node(C,n-1,O2), R=O1-O2, config(C),C>1.
% the first configuration is always at 0 because it doeas not have any input nodes
result_config(1,0).
% It has sense only of the first config is at 0
:- result_config(C,R), C!=1, R=0.
:- result_config(C1,R1), result_config(C2,R2), C1<C2, R1>R2.
%result(T) :- T = #sum{R,C:result_config(C,R), config(C)}.
#maximize {R,C:result_config(C,R)}.

Related

Heuristic function prolog

I have a problem which is [1,2,3,0,4,5,6] and the goal is [4,5,6,0,1,2,3] and the Heuristic function
is to calculate misplaced for 4,5,6 tile in position of 1,2,3 tile so when I try to add the condition for head >3 it always false
getHeuristic([], 0, []):-!.
% here it is calculated as number of misplaced numbers for 4,5,6 only
% ( so if Head = Head and value greater than 3 its correct so
% don't count it)
getHeuristic([H|T1],V,[H|T2]):-!,
H>3,
getHeuristic(T1,V, T2).
getHeuristic([_|T1],H,[_|T2]):-
getHeuristic(T1,TH, T2),
H is TH + 1.
A heuristic is a quick way to estimate how close the current state is to the goal state (in the state space).
Let h*(S) be the cost of an optimal path from current state S to a goal state G. Then, a heuristic function h(S) is admissible if, and only, if:
0 ≤ h(S) ≤ h*(S), and
h(G) = 0.
In other words, an admissible heuristic function must be always optimistic!
For example, from the following current state, you need at least two "moves" to reach the goal state:
Current state = [6,4,5,0,1,2,3]
Swap 6 and 4 : [4,6,5,0,1,2,3]
Swap 5 and 6 : [4,5,6,0,1,2,3] = Goal state
Notice that, for example, a heuristic function that estimates the cost of an optimal path to reach the goal state [4,5,6,0,1,2,3] from the current state [5,4,6,0,1,2,3] as at least 2 is not admissible (since a unique move - swap 5 and 4 - is sufficient to correct both positions).
Thus, I think you can do something like this:
heuristic(State, Goal, Value) :-
heuristic(State, Goal, 0, Value).
heuristic([], [], A, A).
heuristic([X|Xs], [Y|Ys], A, V) :-
( X < Y
-> A1 is A + 1
; A1 is A ),
heuristic(Xs, Ys, A1, V).
Examples:
?- heuristic([1,2,3,0,4,5,6], [4,5,6,0,1,2,3], V).
V = 3.
?- heuristic([6,4,5,0,1,2,3], [4,5,6,0,1,2,3], V).
V = 2.
?- heuristic([5,4,6,0,1,2,3], [4,5,6,0,1,2,3], V).
V = 1.
?- heuristic([4,5,6,0,1,2,3], [4,5,6,0,1,2,3], V).
V = 0.
Remark: The "moves" counted by the heuristic function do not necessarily correspond to the actual moves that cause transitions from states to their successors in the state space (i.e., they are relaxed moves).
If you want to compute a "distance" from the "current state" to the "target state" by counting the number of nonmatching positions:
% nmpcount(+CurrentState,+TargetState,?Count)
nmpcount(CurrentState,TargetState,Count) :-
nmpcount2(CurrentState,TargetState,0,Count).
% nmpcount2(+CurrentState,+TargetState,+CountSoFar,?CountFinal)
nmpcount2([],[],Count,Count).
nmpcount2([X|MoreCS],[X|MoreTS],CountIn,FinalCount) :-
nmpcount2(MoreCS,MoreTS,CountIn,FinalCount).
nmpcount2([X|MoreCS],[Y|MoreTS],CountIn,FinalCount) :-
dif(X,Y),
CountNext is CountIn+1,
nmpcount2(MoreCS,MoreTS,CountNext,FinalCount).

Answer Set Programming: Re-arrange matrix so that in no row 2 numbers are in the same order

Let's I have matrix
A =
1 2 3
1 3 5
1 2 4
2 3 7
The task is to re-arrange the matrix so that in no row two elements are in the same order.
For example, in row 1 and row 2 we have numbers 1 and 3 in the same order. We flip the numbers in 1 and 3 left to right in row 1 and get
3 2 1
1 3 5
1 2 4
2 3 7
My thoughts are this is a search problem, that could be maybe solved with Answer Set Programming? The problem is that if you try to do this with some algorithm, at some point you end up putting two numbers in to the same order as they are in some other row.
This is useful for reorienting triangular surface mesh faces of a mesh where the face normals point to inconsistent directions so that all normals point to inward (or outward)
Given input in the form:
value(ROW,COL,VAL).
nrows(nr).
ncols(nc).
You can do something like:
row(1..NR) :- nrows(NR).
col(1..NC) :- ncols(NC).
is_value(V) :- value(_, _, V).
% For each position in the original matrix, say what new column it's in.
{new_place(ROW,OLDCOL,NEWCOL,VAL) : col(NEWCOL)} = 1 :- value(ROW,OLDCOL,VAL).
% Can't have more than one value in the same position.
:- {new_place(ROW,_,COL,_)} > 1; row(ROW); col(COL).
% A comes before B in row ROW if COL_A < COL_B
ordered(A,B,ROW) :- new_place(ROW,_,COL_A,A); new_place(ROW,_,COL_B,B); COL_A < COL_B.
% For any two values A and B, there exists at most one row where A comes before B
:- {ordered(A,B,ROW) : row(ROW)} > 1; is_value(A); is_value(B).
#show.
#show p(R,C,V) : new_place(R,_,C,V).
Note that you have to keep track of the original column in case there are duplicates within a row. If no row contains duplicates (as is the case in your example) the second parameter of new_place is unnecessary.
Yes you can do this with ASP.
This is not the most elegant code but I think you could do it like this if you use Clingo series 5:
%% List the numbers to fill the matrix, we must associated each with an index value
number(1,1;2,2;3,3;1,4;3,5;5,6;1,7;2,8;4,9;2,10;3,11;7,12).
%% x limits
x(0..2).
%% y limits
y(0..3).
%% Generate the matrix
{ matrix(V, I, X, Y) } :- number(V, I), x(X), y(Y).
%% Define the order of the elements
order(V1, I1, V2, I2, Y) :- matrix(V1, I1, X1, Y), matrix(V2, I2, X2, Y), X1 < X2.
%% Do not allow two different rows to have the same order of elements
:- order(V1, I1, V2, I2, Y1), order(V1, I3, V2, I4, Y2), Y1 != Y2.
%% Each number must be in the matrix exactly once
:- not { matrix(V, I, X, Y) } = 1, number(V, I).
%% Each element can contain only one number
:- not #count { V, I : matrix(V, I, X, Y) } = 1, matrix(_, _, X, Y).
%% Show the matrix
#show matrix/4.
Which gives you this as output:
3 1 3
4 2 3
1 1 5
2 2 7
Although bare in mind there are many hundreds of thousands (I think millions) of ways to order this matrix and get a result which satisfies your constraints.

Count items bigger than 2 in a list

I have a List with numbers. (e.g : L = [1,0,0,1,3,2,3]).
I'm trying to create a predicate which takes this list and returns an integer E, which is the times of occurrences of any number bigger than 2.
For instance in the case above let's say that the predicate is called pred/2,
then pred([1,0,0,1,3,2,3],E) would return E = 2 because the only number bigger than 2 is 3 and this number occurs 2 times.
In the case that there are 2 and more different numbers bigger than 2, for instance: L = [0,1,1,2,3,4,5,6,6] would have to return 5 because there are 5 numbers that are bigger than 2.
We can use a helper predicate with accumulator count/3. We will use this accumulator store count of already encountered values greater than 2.
% we initialize accumulator with 0
count(L, Count) :- count2(L, 0, Count).
% for empty list there is no more elements grater than 2
count2([], Acum, Acum).
% otherwise we have two consider two cases
count2([H|T], Acum, Out) :-
( H > 2 ->
Acum2 is Acum + 1,
count2(T, Acum2, Out)
;
count2(T, Acum, Out)
).
I figured out the best way to go is to write some modern prolog using high-order predicates:
pred(List, Count) :-
maplist([In,Out] >> (In>2 -> Out=1 ; Out=0), List, BinaryList),
foldl([In1,In2,Out] >> (Out is In1+In2), BinaryList, 0, Count).
which works by mapping each item to 1 if it is greater than 2, otherwise to 0, and then summing the 1s and 0s.
Some tests:
?- pred([1,0,0,1,3,2,3], Count).
Count = 2.
?- pred([0,1,1,2,3,4,5,6,6], Count).
Count = 5.
Bonus: this can be generalized to counting how many elements make a predicate hold:
count(Pred, List, Count) :-
maplist([In,Out] >> (call(Pred,In) -> Out=1 ; Out=0), List, BinaryList),
foldl([In1,In2,Out] >> (Out is In1+In2), BinaryList, 0, Count).
so that we can pass the (X>2) as an argument:
?- count([X] >> (X>2), [1,0,0,1,3,2,3], Count).
Count = 2.
or something else:
?- count([X] >> (X<2), [1,0,0,1,3,2,3], Count).
Count = 4.

Checking all of facts in prolog

I have a number of facts that represents a cell with a row,Column and the number in that certain cell, And I want to check those facts just like checking a normal array .
I tried this function but it doesn't seem to work ,I don't think I am checking all my facts.
allcolored(X,Y) :-
cell(X,Y,_),
X1 is X - 1,
Y1 is Y - 1,
allcolored(X1,Y1).
If I understand you correctly, you want to check if, given a pair of X/Y coordinates, all positions in the grid spanned by those coordinates are covered by cell/3 facts. For arguments sake, let's consider that the following facts are currently present:
cell(1,1,100).
cell(1,2,200).
cell(1,3,300).
cell(2,1,110).
cell(2,2,120).
cell(2,3,130).
Looking at your attempt for a recursive rule, you try to check if, for a given pair, say 2/2, there are facts cell/3 for the pairs 2/2 and 1/1. But you probably want to check if the following pairs are covered: 2/2, 1/2, 2/1 and 1/1. As you can see in this sequence, the X-coordinate is being reduced to 1, then the Y-coordinate is decreased while the X-coordinate starts over at 2 again. So you need to preserve the original value of X somehow. This can be done with an auxiliary predicate with an additional argument. Your predicate allcolored/2 would then be the calling predicate for such a predicate, let's call it allcolored_/3:
allcolored(X,Y) :-
allcolored_(X,Y,X).
As #lurker already pointed out, your predicate is lacking a base case, where the recursion can stop. An obvious candidate for that would be the pair 1/1:
allcolored_(1,1,_) :-
cell(1,1,_).
Then a rule is needed to describe that all values between X and 2 have to be covered by cell/3:
allcolored_(X,Y,Max) :-
cell(X,Y,_),
X > 1,
Y >= 1,
X0 is X-1,
allcolored_(X0,Y,Max).
And an additional rule to describe the change to the next lower Y-coordinate, once X reached 1:
allcolored_(1,Y,Max) :-
cell(1,Y,_),
Y > 1,
Y0 is Y-1,
allcolored_(Max,Y0,Max).
Now you can test if a grid, spanned by the coordinates you provide, is covered by facts cell/3:
?- allcolored(2,2).
true ;
false.
?- allcolored(2,3).
true ;
false.
?- allcolored(3,3).
false.
Note that the above code assumes that the smallest coordinate in the grid is 1. To change that, to e.g. 0, you have to replace the 1's in the goals X >1, Y >= 1 and Y > 1 by 0's. Also note that due to the ordering of the goals (the cell/3 goals first) you can also ask questions like What grids are there that are covered by the facts of cell/3? :
?- allcolored(X,Y).
X = Y, Y = 1 ;
X = 2,
Y = 1 ;
X = Y, Y = 2 ;
X = 2,
Y = 3 ;
X = 1,
Y = 2 ;
X = 1,
Y = 3 ;
false.
Instead of checking for the existence of a fact for every pair of indices in range, check for the non-existence of non-existence of the fact for some pair of indices in range:
allcolored(X,Y) :-
\+ (between(1,X,A), between(1,Y,B), \+ cell(A,B,_)).
this says: allcolored(X,Y) holds if there are no indices A, B in allowed ranges (1..X, 1..Y) for which the fact cell(A,B) doesn't exist.
In other words, "there are no empty cells in the given area" is the same thing as "all cells in the given area are full".

How can I get this simple Prolog predicate to "return" the right way?

So I am learning Prolog. I need to write a predicate that finds the min/max value of an integer list. For example, the query minmaxArray([4,-1,5,4,1,2,3,-2],X,Y) would return X = -2 Y = 5. Here is what I have so far:
%min/max element of a 1 item list is that item.
minmaxArray([X], X, X).
%when there is only 2 items, put the smaller element in A and the
%larger element in B
minmaxArray([X,Y], A, B) :- mymin(X,Y,Min),
A is Min, mymax(X,Y,Max), B is Max.
%when there is more than two items make a recursive call to find the min/max
%of the rest of the list.
minmaxArray([X,Y|T], A, B) :- minmaxArray([Y|T], M, K),
mymin(X,M,Temp), A is Temp, mymax(X,K,Temp2), B is Temp2.
Assume mymin and mymax predicates work properly. They return the min and max of 2 numbers.
The issue here is that for example when I query minmaxArray([4,-1,5],X,Y) it returns X = -1 Y = 5 and then again X = -1 Y = 5. I know this must be because it hits the 2nd condition on the recursive call. I only want it to return X = -1 Y = 5 one time. I tried replacing condition 3 with this:
minmaxArray([X,Y,_|T], A, B) :- minmaxArray([Y,_|T], M, K),
mymin(X,M,Temp), A is Temp, mymax(X,K,Temp2), B is Temp2.
but that crashes the program. What can I do to fix this?
Note: I know that I may not be using the terminology correctly by saying returning and saying predicate when it should be rule, etc so I apologize in advance.
Seems that your code could be simpler. This predicate does all what's needed, and attempt to show how to use some standard construct (if/then/else)
minmaxArray([X], X, X).
minmaxArray([X|R], Min, Max) :-
minmaxArray(R, Tmin, Tmax),
( X < Tmin -> Min = X ; Min = Tmin ), % or mymin(X,Tmin,Min)
( X > Tmax -> Max = X ; Max = Tmax ).
You have provided 2 ways of solving the case where there are 2 items: one explicitly for 2 items, and your general case, which then employs the 1 element case.
Solution: remove the unneeded 2-element case.
Or, tail-recursive:
minmax([X|Xs],Min,Max) :- % we can only find the min/max of a non-empty list.
minmax(Xs,(X,X),Min,Max) % invoke the helper with the min/max accumulators seeded with the first item
.
minmax([],(Min,Max),Min,Max). % when the source list is exhausted, we're done: unify the accumulators with the result
minmax([X|Xs],(M,N),Min,Max) :- % when the source list is non-empty
min(X,M,M1) , % - get a new min value for the accumulator
max(X,N,N1) , % - get a new max value for the accumulator
minmax(Xs,(M1,N1),Min,Max) % - recurse down on the tail.
.
min(X,Y,X) :- X =< Y . % X is the min if it's less than or equal to Y.
min(X,Y,Y) :- X > Y . % Y is the min if it's greater than X.
max(X,Y,X) :- X >= Y . % X is the max if it's greater than or equal to Y.
max(X,Y,Y) :- X < Y . % Y is the max if it's greater than X.

Resources