random_graph.pl

:- module(random_graph,
	  [ graph_steps/2,		% +Graph, +Steps
	    graph_settings/2,		% +Graph, +List
	    graph_action/2,		% +Graph, +Action
	    show_graph/1,		% +Graph
	    reset_graph/1,		% +Graph
	    animate_graph/3		% +Graph, +Steps, +Delay
	  ]).
:- if(exists_source(library(pce))).
:- use_module(pce_graph).
:- use_module(library(pce)).
:- endif.
:- use_module(library(debug)).
:- use_module(library(error)).
:- use_module(library(lists)).
:- use_module(library(random)).
:- use_module(library(broadcast)).

/** <module>

This library creates randomly changing graphs.
*/

:- dynamic
	node/2,				% Id, Graph
	edge/3,				% Child, Parent, Graph
	snap/2,				% Graph, Id
	id/3,				% Id, Type, Graph
	probability/3.			% Graph, Action, Prob

%%	reset_graph(+Graph)
%
%	Remove all information about Graph.

reset_graph(Graph) :-
	retractall(node(_, Graph)),
	retractall(edge(_,_, Graph)),
	retractall(snap(Graph, _)),
	retractall(id(Graph, _, _)),
	show(Graph, reset).

%%	graph_steps(+Graph, +Steps) is det.
%
%	Perform N random actions on Graph.

graph_steps(Graph, N) :-
	succ(N2, N), !,
	step(Graph),
	graph_steps(Graph, N2).
graph_steps(_, _).

step(Graph) :-
	findall(A-P, action_probability(Graph,A,P), Pairs),
	pairs_values(Pairs, Probs),
	sum_list(Probs, TotProb),
	repeat,
	   P is random_float*TotProb,
	   select_action(P, Pairs, Action),
	   graph_action(Graph, Action), !,
	   debug(graph_action, '~w', [Action]).

%%	animate_graph(+Graph, +Steps, +Delay)
%
%	Show an animated graph, performing N steps with Delay seconds
%	between the steps.

animate_graph(Graph, Steps, Delay) :-
	reset_graph(Graph),
	show_graph(Graph),
	forall(between(1, Steps, _),
	       ( step(Graph),
		 sleep(Delay)
	       )).

select_action(P, [A-PA|_], A) :-
	P < PA, !.
select_action(P, [_-PA|T], A) :-
	P2 is P-PA,
	select_action(P2, T, A).

%%	graph_settings(+Graph, +List) is det.
%
%	Add settings for the graph.

graph_settings(Graph, List) :-
	must_be(list, List),
	maplist(graph_setting(Graph), List).

graph_setting(Graph, Prop) :-
	Prop =.. [Action,Prob],
	(   action(Action)
	->  retractall(probability(Graph, Action, _)),
	    asserta(probability(Graph, Action, Prob))
	;   existence_error(action, Prob)
	).


action_probability(Graph, Action, P) :-
	(   var(Action)
	->  action(Action)
	;   true
	),
	(   probability(Graph, Action, P)
	->  true
	;   default_probability(Graph, Action, P)
	).

action(Action) :-
	clause(graph_action(_, Action), _).

default_probability(Graph, create_node, P) :-
	node_count(Graph, Nodes),
	edge_count(Graph, Edges),
	P is max(Edges,1)/max(10*Nodes,1).
default_probability(_, add_leaf,		 0.1).
default_probability(_, disconnect_leaf,		 0.1).
default_probability(_, connect_clouds,		 0.1).
default_probability(_, add_non_cyclic_edge,	 0.1).
default_probability(_, add_cyclic_edge,		 0.03).
default_probability(_, remove_non_breaking_edge, 0.1).
default_probability(_, remove_edge,		 0.1).


%%	graph_action(+Graph, +Action) is det.
%
%	Perform Action on Graph.

graph_action(Graph, create_node) :-
	next_id(Graph, node, Id),
	assert_node(Graph, Id).
graph_action(Graph, add_leaf) :-
	unconnected_node(Graph, Node),
	leaf_node(Graph, Leaf), !,
	assert_edge(Graph, Node, Leaf).
graph_action(Graph, disconnect_leaf) :-
	leaf_node(Graph, Leaf),
	retract_edge(Graph, Leaf, _Parent), !.
graph_action(Graph, connect_clouds) :-
	clouds(Graph, Clouds),
	Clouds = [_,_|_],
	random_select(C1, Clouds, RestClouds),
	random_member(C2, RestClouds),
	random_member(N1, C1),
	random_member(N2, C2),
	assert_edge(Graph, N1, N2).
graph_action(Graph, add_non_cyclic_edge) :-
	clouds(Graph, Clouds),
	random_permutation(Clouds, RC),
	member(C1, RC),
	random_permutation(C1, Perm),
	select(N1, Perm, R),
	member(N2, R),
	\+ creates_cycle(Graph, N1, N2), !,
	assert_edge(Graph, N1, N2).
graph_action(Graph, add_cyclic_edge) :-
	clouds(Graph, Clouds),
	random_permutation(Clouds, RC),
	member(C1, RC),
	random_permutation(C1, Perm),
	select(N1, Perm, R),
	member(N2, R),
	creates_cycle(Graph, N1, N2), !,
	assert_edge(Graph, N1, N2).
graph_action(Graph, remove_non_breaking_edge) :-
	edge(Child, Parent, Graph),
	connected(Graph, Parent, both_except(Child,Parent), Child), !,
	retract_edge(Graph, Child, Parent).
graph_action(Graph, remove_edge) :-
	edge(Child, Parent, Graph), !,
	retract_edge(Graph, Child, Parent).
graph_action(Graph, verify) :-
	show(Graph, verify).
graph_action(Graph, create_snap) :-
	next_id(Graph, snap, SnapID),
	assertz(snap(Graph, SnapID)),
	show(Graph, create_snap(SnapID)).
graph_action(Graph, verify_snap) :-
	findall(SnapID, snap(Graph, SnapID), Candidates),
	random_member(VerifyID, Candidates),
	show(Graph, verify_snap(VerifyID)).
graph_action(Graph, delete_snap) :-	% delete snap, preferably an old one
	(   snap(Graph,_)
	->  (   repeat,
	        clause(snap(Graph, SnapID), true, Ref),
		maybe,
		erase(Ref)
	    ->	show(Graph, delete_snap(SnapID))
	    ;	true
	    )
	;   true
	).


%%	assert_node(+Graph, +Id) is det.
%%	assert_edge(+Child, +Parent) is det.
%%	retract_edge(+Child, +Parent) is nondet.

assert_node(Graph, Id) :-
	assertz(node(Id, Graph)),
	show(Graph, add_node(Id)).

assert_edge(Graph, Child, Parent) :-
	edge(Child, Parent, Graph), !.
assert_edge(Graph, Child, Parent) :-
	assert(edge(Child, Parent, Graph)),
	show(Graph, add_edge(Child, Parent)).

retract_edge(Graph, Child, Parent) :-
	retract(edge(Child, Parent, Graph)),
	show(Graph, del_edge(Child, Parent)).

%%	leaf_node(-Node) is nondet.

leaf_node(Graph, Leaf) :-
	edge(Leaf, _, Graph),
	\+ edge(_, Leaf, Graph).

%%	unconnected_node(-Node) is nondet.

unconnected_node(Graph, Node) :-
	node(Node, Graph),
	\+ edge(Node, _, Graph),
	\+ edge(_, Node, Graph).

%%	clouds(Graph, List) is det.
%
%	List of interconnected clouds

clouds(Graph, Clouds) :-
	findall(N, node(N, Graph), Nodes0),
	sort(Nodes0, Nodes),
	clouds(Nodes, Clouds, Graph).

clouds([], [], _).
clouds([H|T], [CH|CT], Graph) :-
	findall(N, connected(Graph,H,both,N), NL),
	sort([H|NL], CH),
	ord_subtract(T, CH, RT),
	clouds(RT, CT, Graph).


%%	connected(+Graph, ?Node1, +Direction, ?Node2) is nondet.
%
%	True when Node1 and Node2 are   connected, considering the graph
%	as an undirected graph.

connected(Graph, N1, Dir, N2) :-
	nonvar(N1), nonvar(N2), !,
	connected([N1], [N1], Dir, N2, Graph), !.
connected(Graph, N1, Dir, N2) :-
	nonvar(N1), !,
	connected([N1], [N1], Dir, N2, Graph).
connected(Graph, N1, Dir, N2) :-
	nonvar(N2), !,
	revert_dir(Dir, RevDir),
	connected([N2], [N2], RevDir, N1, Graph).
connected(Graph, N1, Dir, N2) :-
	node(N1, Graph),
	connected([N1], [N1], Dir, N2, Graph).

connected([N|Agenda], Visited, Dir, Node, Graph) :-
	findall(New, connected_unvisited(N, Visited, Dir, New, Graph), NewList),
	(   member(Node, NewList)
	;   append(NewList, Visited, NewVisited),
	    append(Agenda, NewList, NewAgenda),
	    connected(NewAgenda, NewVisited, Dir, Node, Graph)
	).

connected_unvisited(N, Visited, both, New, Graph) :- !,
	(   edge(N, New, Graph)
	;   edge(New, N, Graph)
	),
	\+ memberchk(New, Visited).
connected_unvisited(N, Visited, forward, New, Graph) :- !,
	edge(N, New, Graph),
	\+ memberchk(New, Visited).
connected_unvisited(N, Visited, backward, New, Graph) :- !,
	edge(New, N, Graph),
	\+ memberchk(New, Visited).
connected_unvisited(N, Visited, both_except(Child,Parent), New, Graph) :- !,
	(   edge(N, New, Graph),
	    \+ (N == Child, New == Parent)
	;   edge(New, N, Graph),
	    \+ (New == Child, N == Parent)
	),
	\+ memberchk(New, Visited).

revert_dir(both,	     both).
revert_dir(both_except(C,P), both_except(P,C)).
revert_dir(forward,	     backward).
revert_dir(backward,	     forward).


%%	creates_cycle(+Graph, +Child, +Parent) is semidet.
%
%	True when adding Child-Parent to  the   graph,  the  graph would
%	become cyclic.

creates_cycle(Graph, Child, Parent) :-
	connected(Graph, Parent, forward, Child).

%%	next_id(+Graph, +Type, -Id) is det.
%
%	Create a new unique node Id.

next_id(Graph, Type, Id) :-
	retract(id(Graph, Type, Id0)), !,
	Id is Id0+1,
	assertz(id(Graph, Type, Id)).
next_id(Graph, Type, 1) :-
	assertz(id(Graph, Type, 1)).


node_count(Graph, Count) :-
	aggregate_all(count, node(_,Graph), Count).

edge_count(Graph, Count) :-
	aggregate_all(count, edge(_,_,Graph), Count).


		 /*******************************
		 *	       SHOW		*
		 *******************************/

show(Graph, Action) :-
	broadcast(graph(Graph, Action)).


:- if(exists_source(library(pce))).
:- pce_global(@(graph), new(graph_viewer)).

%%	show_graph(+Graph) is det.
%
%	Create a graphics window for Graph.  The window listens for
%	broadcasts messages, updating if the graph changes.

show_graph(Graph) :-
	in_pce_thread_sync(broadcast_request(graph(Graph))), !.
show_graph(Graph) :-
	in_pce_thread_sync(pce_show_graph(Graph)).

pce_show_graph(Graph) :-
	context_module(Here),
	new(GV, graph_viewer(Graph)),
	send(GV, open),
	send(GV, generate, Child-Parent,
	     Here:edge(Child, Parent, Graph)),
	forall(node(N, Graph),
	       get(GV, node, N, _Node)).

:- else.

show_graph(_) :-
	format(user_error, 'Cannot show graphs without xpce~n', []).

:- endif.