We have an algorithm problem in hand, can you please write your ideas about this, thank you!
There are N many nodes with K different colors. Some of the nodes have direct connection between each other and some do not.
We want to select M nodes from these N total nodes, but these M nodes must be connected. Also, our selected group of M nodes must have minimum number of distinct colored neighbors. There might be more than one best combinations, finding any of them is the goal.
For example, we selected M nodes and in total, these M nodes have the following neighbors: 5 red, 3 blue, 1 green. In this case, we count the unique colors, so the number of distinct colored neighbors, in this case, is 3. We want to minimize this number by selecting the best possible combination of M nodes.
Example graph visualization :
In this example, let's assume M = 4, then the best possible combination of nodes would be {9, 10, 11, 12} since this group has only one neighbor which is yellow.
If we choose {0, 1, 3, 5}, the neighbors of this combination would be {2, 4, 6}, which consists of 2 red neighbors and 1 green neighbor; which results with score of 2 since we look for distinct number of colored neighbors.
Is this algorithm question NP-complete? How should we proceed? If this is not NP-complete, what is the best algorithm we can use to solve this problem?
Can we combine graph algorithms such as Prim’s, Kruskal's, Floyd Warshall or traversal algorithms?
If this is an NP problem, you could use ASP to solve it.
Given instance.lp
color(0,yellow).
color(3,yellow).
color(8,yellow).
color(10,yellow).
color(2,green).
color(5,green).
color(12,green).
color(7,blue).
color(1,red).
color(4,red).
color(6,red).
color(9,red).
color(11,red).
edge(0,5).
edge(0,1).
edge(0,2).
edge(0,6).
edge(5,3).
edge(5,4).
edge(6,4).
edge(3,4).
edge(2,7).
edge(7,8).
edge(8,9).
edge(5,3).
edge(9,10).
edge(9,11).
edge(9,12).
edge(11,12).
edge(B,A) :- edge(A,B).
and encoding.lp
node(X) :- color(X,_).
%select exactly one start node
1 {start(X) : node(X)} 1.
% start node is in sub graph
sub(X) :- start(X).
% for any node in the sub graph you can add any connected node
{sub(Y) : edge(X,Y)} :- sub(X).
% it is wrong if we do not have exactly m nodes in the sub graph
:- not m = #sum {1,X: sub(X)}.
#minimize {1,C : sub(X), edge(X,Y), not sub(Y), color(Y,C)}.
#show sub/1.
The call
clingo encoding.lp instance.lp --const m=4 gives you an optimal solution:
sub(3) sub(5) sub(4) sub(6)
The call
clingo encoding.lp instance.lp --const m=4 --opt-mode=optN --project
gives you all optimal solutions.
The tools can be found at https://potassco.org/
The subgraph { 4 3 5 6 } is also a good answer having one red neighbor.
I found this subgraph running a little program called subs.
C:\Users\James\code\subs>subs
l 0 1 1
l 0 6 1
l 0 5 1
l 0 2 1
l 2 7 1
l 3 5 1
l 3 4 1
l 4 6 1
l 4 5 1
l 7 8 1
l 8 9 1
l 9 10 1
l 9 11 1
l 9 12 1
l 11 12 1
n 0 yellow
n 1 red
n 2 green
n 3 yellow
n 4 red
n 5 green
n 6 red
n 7 blue
n 8 yellow
n 9 red
n 10 yellow
n 11 red
n 12 green
<-cPathFinder::read
n1 n0 n6 n5 colors 3
n1 n0 n6 n2 colors 3
n1 n0 n6 n4 colors 2
n1 n0 n5 n2 colors 3
n1 n0 n5 n3 colors 2
n1 n0 n5 n4 colors 3
n1 n0 n2 n7 colors 3
n0 n6 n5 n2 colors 3
n0 n6 n5 n3 colors 2
n0 n6 n5 n4 colors 3
n0 n6 n2 n7 colors 3
n0 n6 n2 n4 colors 4
n0 n6 n3 n4 colors 2
n0 n5 n2 n7 colors 2
n0 n5 n2 n3 colors 2
n0 n5 n2 n4 colors 3
n0 n5 n3 n4 colors 2
n0 n2 n7 n8 colors 2
n6 n5 n3 n4 colors 1
n2 n7 n8 n9 colors 3
n7 n8 n9 n10 colors 2
n7 n8 n9 n11 colors 2
n7 n8 n9 n12 colors 3
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n0 n6 n5 n2 colors 3
n0 n6 n5 n3 colors 2
n0 n6 n5 n4 colors 3
n0 n6 n2 n7 colors 3
n0 n6 n2 n4 colors 4
n0 n6 n3 n4 colors 2
n0 n5 n2 n7 colors 2
n0 n5 n2 n3 colors 2
n0 n5 n2 n4 colors 3
n0 n5 n3 n4 colors 2
n0 n2 n7 n8 colors 2
n6 n5 n3 n4 colors 1
n2 n7 n8 n9 colors 3
n7 n8 n9 n10 colors 2
n7 n8 n9 n11 colors 2
n7 n8 n9 n12 colors 3
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n6 n5 n3 n4 colors 1
n2 n7 n8 n9 colors 3
n7 n8 n9 n10 colors 2
n7 n8 n9 n11 colors 2
n7 n8 n9 n12 colors 3
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n2 n7 n8 n9 colors 3
n7 n8 n9 n10 colors 2
n7 n8 n9 n11 colors 2
n7 n8 n9 n12 colors 3
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n2 n7 n8 n9 colors 3
n7 n8 n9 n10 colors 2
n7 n8 n9 n11 colors 2
n7 n8 n9 n12 colors 3
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n7 n8 n9 n10 colors 2
n7 n8 n9 n11 colors 2
n7 n8 n9 n12 colors 3
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n8 n9 n10 n11 colors 2
n8 n9 n10 n12 colors 2
n8 n9 n11 n12 colors 2
n9 n10 n11 n12 colors 1
n9 n10 n11 n12 colors 1
subgraph n6, n5, n3, n4, has 1 differently colored neighbours
There is nothing clever about subs. It generates subgraphs and searches through them for the connected subgraph that has the fewest uniquely coloured neighbours. There are lots of nested loops, so it is not going to do well when there are thousands of nodes.
The code is at https://gist.github.com/JamesBremner/5a3965cc725c54dcaabd4beb44f9104f
An optimization has occured to me that should go a long way to handling large graphs. Assuming that the complete graph is connected ( every node can be reached from every other node ) then every subgraph must have at least one neighbour ( otherwise the nodes in the subgraph could not reach the nodes outside the subgraph ). So the best possible number of uniquely colored neighbours is 1 and no less. So the algorithm can stop as soon as the first subgraph with one uniquely colored neighbor has been found, since no better result can exist.
Related
I want to create a predicate over the alphabet {1,2,3}, f/4(N1,N2,N3,L), such that N1, N2 and N3 are a count of the number of times a 1, a 2, and a 3 appeared in a list, respectively. The predicate should operate as the following:
?- f(N1,N2,N3,[1,2,3,3]).
N1 = s(0), N2 = s(0), N3 = s(s(0))
?- f(N1,N2,N3,L).
N1 = N2, N2 = N3, N3 = 0, L = [] ;
N1 = s(0), N2 = N3, N3 = 0, L = [1] ;
N1 = N3, N3 = 0, N2 = s(0), L = [2] ;
N1 = N2, N2 = 0, N3 = s(0), L = [3] ;
N1 = s(s(0)), N2 = N3, N3 = 0, L = [1,1] ;
...
I have come up with the following solution:
f(0,0,0,[]).
f(s(N1),N2,N3,[1|Xs]) :- f(N1,N2,N3,Xs).
f(N1,s(N2),N3,[2|Xs]) :- f(N1,N2,N3,Xs).
f(N1,N2,succ(N3),[3|Xs]) :- f(N1,N2,N3,Xs).
This solution works for the first query, however, for the second query, it outputs the following:
?- f(N1,N2,N3,L).
N1 = N2, N2 = N3, N3 = 0, L = [] ;
N1 = s(0), N2 = N3, N3 = 0, L = [1] ;
N1 = s(s(0)), N2 = N3, N3 = 0, L = [2] ;
N1 = s(s(s(0))), N2 = N3, N3 = 0, L = [3] ;
N1 = s(s(s(s(0)))), N2 = N3, N3 = 0, L = [1,1] ;
This seems to be an unfair enumeration, how do I fix this?
Due to the order of the clauses in your solution, each recursive call choose to increment N1, before trying to increment N2 or N3 (which are never incremented at all).
A possible solution is:
f(0, 0, 0, []).
f(N1, N2, N3, [X|Xs]) :-
f(M1, M2, M3, Xs),
member(X - [N1, N2, N3],
[1 - [s(M1), M2, M3],
2 - [M1, s(M2), M3],
3 - [M1, M2, s(M3)]]).
Here are some examples:
?- f(N1, N2, N3, [1,2,3,3,1,1,1]).
N1 = s(s(s(s(0)))),
N2 = s(0),
N3 = s(s(0)) ;
false.
?- forall( limit(20, f(N1,N2,N3,L)), writeln(L -> [N1,N2,N3]) ).
[] -> [0,0,0]
[1] -> [s(0),0,0]
[2] -> [0,s(0),0]
[3] -> [0,0,s(0)]
[1,1] -> [s(s(0)),0,0]
[2,1] -> [s(0),s(0),0]
[3,1] -> [s(0),0,s(0)]
[1,2] -> [s(0),s(0),0]
[2,2] -> [0,s(s(0)),0]
[3,2] -> [0,s(0),s(0)]
[1,3] -> [s(0),0,s(0)]
[2,3] -> [0,s(0),s(0)]
[3,3] -> [0,0,s(s(0))]
[1,1,1] -> [s(s(s(0))),0,0]
[2,1,1] -> [s(s(0)),s(0),0]
[3,1,1] -> [s(s(0)),0,s(0)]
[1,2,1] -> [s(s(0)),s(0),0]
[2,2,1] -> [s(0),s(s(0)),0]
[3,2,1] -> [s(0),s(0),s(0)]
[1,3,1] -> [s(s(0)),0,s(0)]
true.
Given the following graph:
digraph g {
rankdir=LR;
node [shape=box];
A;
{ rank = same;
B; C; D; E;
};
A -> B [label="144"];
B -> A [label="261"; constraint=false];
B -> C [label="144"];
C -> B [label="261"; constraint=false];
C -> D [label="144"];
D -> C [label="261"; constraint=false];
D -> E [label="144"];
E -> D [label="261"; constraint=false];
B -> n1 [label="144"];
n1 -> B [label="261"; constraint=false];
n1 -> n2 [label="144"];
n2 -> n1 [label="261"; constraint=false];
C -> n3 [label="144"];
n3 -> C [label="261"; constraint=false];
n3 -> n4 [label="144"];
n4 -> n3 [label="261"; constraint=false];
D -> n5 [label="144"];
n5 -> D [label="261"; constraint=false];
n5 -> n6 [label="144"];
n6 -> n5 [label="261"; constraint=false];
E -> n7 [label="144"];
n7 -> E [label="261"; constraint=false];
n7 -> n8 [label="144"];
n8 -> n7 [label="261"; constraint=false];
};
The resulting output is:
This is almost what I want (in particular it took a lot of trouble to figure out how to make that straight line of letter nodes in the second rank), but my problem is with the way that the edge arrows are drawn in the vertical nodes.
What I want is for the "forward" arrow (the one going right/down in the graph, and the one without constraint=false) to be straight, and the "reverse" arrow (going left/up in the graph, with constraint=false) to be curved. And in both cases I want the labels to be out of the way of each other. (For the vertical arrows, this probably means pushing the label to the other side.)
I've tried playing with setting groups and weights but so far nothing has seemed to help swap the vertical arrows. And I haven't found anything that will move the label to the other side.
I also tried using the splines setting but it doesn't do anything.
Managing edge placement is very difficult.
Does this meet your requirements - it uses ports to tweak the edge placement.
digraph g {
rankdir=LR;
node [shape=box];
A;
{ rank = same;
B; C; D; E;
};
A -> B [label="144"];
B -> A [label="261"; constraint=false];
B -> C [label="144"];
C -> B:se [label="261"; constraint=false];
C -> D [label="144"];
D -> C:se [label="261"; constraint=false];
D -> E [label="144"];
E -> D:se [label="261"; constraint=false];
B -> n1 [label="144"];
n1 -> B [label="261"; constraint=false];
n1 -> n2 [label="144"];
n2 -> n1 [label="261"; constraint=false];
C -> n3 [label="144"];
n3 -> C [label="261"; constraint=false];
n3 -> n4 [label="144"];
n4 -> n3 [label="261"; constraint=false];
D -> n5 [label="144"];
n5 -> D [label="261"; constraint=false];
n5 -> n6 [label="144"];
n6 -> n5 [label="261"; constraint=false];
E -> n7 [label="144"];
n7 -> E [label="261"; constraint=false];
n7 -> n8 [label="144"];
n8 -> n7 [label="261"; constraint=false];
}
Brand new to Prolog. I've played around with variable names and making sure variables have a calculated value, but I must be missing something. Could you all have a look and help me figure out what I'm missing?
lgstar(N,Answer) :- var(N) -> write('undefined'); lgstaranswer(N,Answer).
lgstaranswer(N1,Answer1) :- lgstarcompute(N1,Iterations),
var(Answer1) -> Answer1 is Iterations, write(Answer1);
(Answer1 is Iterations -> write('yes'); write('no')).
lgstarcompute(N2,Iterations1) :- N3 is floor(log10(N2)/log10(2)), write(N2), write(N3),
N3=<1 -> Iterations1 = 1;
lgstarcompute(N3,Iterations2),
Iterations1 is Iterations2+1.
You call lgstar() to kick things off. The errors I'm getting look as follows:
Arguments are not sufficiently instantiated
In:
[4] _672 is floor(... / ...)
[3] lgstarcompute(_738,_740) at line 7
[2] lgstarcompute(70000,_796) at line 9
[1] lgstaranswer(70000,4) at line 3
Working Code
Thanks to the accepted answer below, the code works. Please read their explanation. The following is working code for the whole function. Just keep in mind your professors know how to use Google!
lgstar(N,Answer) :- var(N) -> write('undefined'); lgstaranswer(N,Answer).
lgstaranswer(N1,Answer1) :- lgstarcompute(N1,Iterations),
((var(Answer1) -> Answer1 = Iterations);
(Answer1 == Iterations -> write('yes'); write('no'))).
lgstarcompute(N2,Iterations) :- N3 is floor(log10(N2)/log10(2)),
(N3 =< 1 -> Iterations = 1;
(lgstarcompute(N3,Iterations2), Iterations is Iterations2+1)).
It turns out this is a common mistake. You need to parenthesize your expressions due to operator precedence.
This is what you have:
lgstarcompute(N2,Iterations1) :- N3 is floor(log10(N2)/log10(2)), write(N2), write(N3),
N3=<1 -> Iterations1 = 1;
lgstarcompute(N3,Iterations2),
Iterations1 is Iterations2+1.
If I format that a bit nicer, I get:
lgstarcompute(N2, Iterations1) :-
N3 is floor(log10(N2)/log10(2)),
write(N2), write(N3),
N3 =< 1 -> Iterations1 = 1
;
lgstarcompute(N3, Iterations2),
Iterations1 is Iterations2+1.
In Prolog, at least in SWI Prolog, , is higher precendence than ->, which is higher than ;. So this is equivalent to:
lgstarcompute(N2, Iterations1) :-
(
(
N3 is floor(log10(N2)/log10(2)),
write(N2), write(N3),
N3 =< 1
) -> Iterations1 = 1
)
;
(
lgstarcompute(N3, Iterations2),
Iterations1 is Iterations2+1.
).
What happens is that when N3 =< 1 fails, Prolog backtracks all the way back to before N3 is floor(...) occurs to reach the most recent choice point and N3 is no longer instantiated. It then goes to the first query after the ; which is lgstarcompute(N3, Iterations2) with N3 uninstantiated.
To fix it, you need to group using parentheses:
lgstarcompute(N2, Iterations1) :-
N3 is floor(log10(N2)/log10(2)),
write(N2), write(N3),
( N3 =< 1
-> Iterations1 = 1
; lgstarcompute(N3, Iterations2),
Iterations1 is Iterations2+1
).
Now when N3 =< 1 fails, it won't backtrack to the write(N3) and all the way back to N3 is floor(...), but rather it will take the conjunction with N3 still instantiated.
I'm trying to draw a graph with circle topology.
Here is what I'm expecting to see:
Here is my gv file:
digraph g1 {
layout="circo";
node [shape = doublecircle]; N4 N6;
node [shape = circle];
N0 -> N1 [ label = "{1,0}"];
N1 -> N2 [ label = "{1,0}"];
N2 -> N3 [ label = "{1,0}"];
N3 -> N4 [ label = "{1,0}"];
N4 -> N5 [ label = "{1,0}"];
N5 -> N6 [ label = "{1,0}"];
N6 -> N0 [ label = "{1,0}"];
N0 -> N4 [ label = "{1,0}"];
N1 -> N5 [ label = "{1,0}"];
N2 -> N6 [ label = "{1,0}"];
N3 -> N0 [ label = "{1,0}"];
N4 -> N1 [ label = "{1,0}"];
N5 -> N2 [ label = "{1,0}"];
N6 -> N3 [ label = "{1,0}"];
}
And here is an output image for graph above:
How can I arrange nodes in graphviz to make it look like 1?
If the goal is to have a graph which respects the order of the nodes, it's not that simple. You could calculate the position of the nodes with an external script and render it with neato.
Or you could first layout the nodes with the edges which determine the correct order of the nodes only:
digraph g1 {
node [shape = doublecircle]; N4 N6;
node [shape = circle];
edge[label="{1,0}"];
N0 -> N1 -> N2 -> N3 -> N4 -> N5 -> N6 -> N0;
}
with:
circo graph.gv > tempgraph.gv
Then add the remaining edges to tempgraph.gv - just copy-paste the following before the closing }:
N0 -> N4 [ label = "{1,0}"];
N1 -> N5 [ label = "{1,0}"];
N2 -> N6 [ label = "{1,0}"];
N3 -> N0 [ label = "{1,0}"];
N4 -> N1 [ label = "{1,0}"];
N5 -> N2 [ label = "{1,0}"];
N6 -> N3 [ label = "{1,0}"];
And render it with neato and the -n option:
neato -n tempgraph.gv -Tpng -O
You may want to fine-tune the position of the labels:
I want to write a simple game with prolog (Connect four). I want to read input from user many times, the input is a column number.
when I read 'Col' for the second time and I enter different values it crashes and gives false (I know how to read many times):
:- dynamic state/3.
:- dynamic top/2.
%% the problem is in the read here
play(Color, Col) :-
top(Col, Raw) -> addRing(Col, Raw, Color); (assert(top(Col,0)) ,addRing(Col, 0, Color)),
win(X,Y,Winner)
-> (write('Game over, winner is '),write(Winner));
(write('Your turn, column? '), read(Col), write('read column is '), write_ln(Col), play(red,Col)).
addRing(Col, Raw, Color):-
assert(state(Col,Raw,Color)),
Next is Raw + 1, retract(top(Col, Raw)), assert(top(Col, Next)).
win(X,Y, Winner) :-
state(X,Y, Color), N1 is X - 1, state(N1, Y, Color), N2 is N1 - 1, state(N2, Y, Color), N3 is N2 - 1, state(N3, Y, Color), Winner = Color.
%% the reset is some methods to determine the winner
win(X,Y, Winner) :-
state(X,Y, Color), N1 is Y - 1, state(X, N1, Color), N2 is N1 - 1, state(X,N2, Color), N3 is N2 - 1, state(X, N3, Color), Winner = Color.
win(X,Y, Winner) :-
state(X,Y, Color),
N1 is X + 1, M1 is Y + 1, state(N1, M1, Color),
N2 is N1 + 1, M2 is M1 + 1, state(N2, M2, Color),
N3 is N2 + 1, M3 is M2 + 1, state(N3, M3, Color),
Winner = Color.
win(X,Y, Winner) :-
state(X,Y, Color),
N1 is X + 1, M1 is Y - 1, state(N1, M1, Color),
N2 is N1 + 1, M2 is M1 - 1, state(N2, M2, Color),
N3 is N2 + 1, M3 is M2 - 1, state(N3, M3, Color),
Winner = Color.
To test the game you can start it by calling play(Red,0) for example, then it will ask for column number.
I think that Col in the recursive call should be Col1, i.e., not the same variable as in the head.