:- lib(lists). % append/3, select/3.
:- lib( stoics_lib:en_list/2 ).
:- lib( band_bn/3 ).
:- lib( kv_to_ord_k_v/3 ).
bn_to_dot_dag( Bn, File ) :-
bn_to_dot_dag( Bn, File, [] ).
/** bn_to_dot_dag( +Bn, +File, +Opts ).
Render the graph Bn onto a graphviz dot File.
Opts in
* collapse_bi(Cbi=false)
whether to collapse edges that connect 2 nodes in both directions
* colour(colour/bnw)
graph colour
* edge_colour(black)
default edge colour
* edges_attrs([])
attributes for edges
* graph(GraphVal=_)
multiple are allowed.
* node_style(NdStyle=radial)
default node style radial/filled/empty)
* nodes_attrs([])
arbitrary node attributes
* nodes_colours(NdsClrs=[])
node colours
* nodes_positions(NdsPos=[]),
positions for nodes
* nodes_labels(NdsLbls=[])
optional labels for nodes
* nodes_dichromatic(Dichr=true)
values: true/false/default,white/Colour)
* title(false)
add an optional title
* type(Type=digraph)
or graph
==
bn_to_dot_dag([1-[],2-[1],3-[2]],[output(x11),edges_attrs(2-3-penwidth(2))] ).
bn_to_dot_dag( [1-[],2-[1],3-[2,5],4-[],5-[4],6-[4],7-[3],8-[3,6]], naku ).
bn_to_dot_dag( [1-[],2-[1],3-[1]], three, [nodes_positions([1-pos(10,10),2-pos(20,20),3-pos(30,30)]) ] ).
==
@author nicos angelopoulos
@version 0.1 2014/03/13
@version 0.2 2014/04/27
@tbd use label="Network Diagram"; for title (name it main to keep the old way ?
@tbd when Colour=bnw default nodes_dichromatic should be false ?
*/
bn_to_dot_dag( Bn, File, Opts ) :-
bn_to_dot_dag_defaults( Defs, _ ),
append( Opts, Defs, AllOs ),
memberchk( node_style(NdSt), AllOs ),
memberchk( node_shape(NdSh), AllOs ),
memberchk( edge_style(EdSt), AllOs ),
memberchk( colour(Clr), AllOs ),
memberchk( type(Type), AllOs ),
memberchk( collapse_bi(Collapse), AllOs ),
memberchk( title(Title), AllOs ),
open( File, write, FStream ),
current_output( Old ),
set_output( FStream ),
memberchk( edge_colour(EdgeClr), AllOs ),
dot_preample( NdSt, NdSh, EdSt, Type, EdgeClr, Opts ),
band_bn( Bn, Collapse, Bands ),
% kv_to_ord_k_v( Against, AgsCh, AgsPa ),
% induce_parentless( AgsPa, AgsCh, [], _Pless, Induced ),
% add_induced_parentless( Induced, Against, CompAgs ),
/*
( Collapse == true ->
clear_bidirectional( CompAgs, NoBiAgainst )
;
CompAgs = NoBiAgainst
),
from against
*/
bn_bands_to_dot_dag_output( Bands, Title, Type, Clr, AllOs ),
set_output( Old ),
close( FStream ).
bn_to_dot_dag_defaults( Defs, [graph(none)] ) :-
Defs = [colour(colour),type(digraph),
node_style(radial), node_shape(circle),
edge_style(''),
nodes_colours([]),
edge_colour(black),collapse_bi(true),
nodes_attrs([]),edges_attrs([]),
nodes_labels([]),title(false),
nodes_positions([]),nodes_dichromatic(true,white)
].
has_only_known_opts( Opts ) :-
bn_to_dot_dag_defaults( DefsVals, NonVals ),
append( DefsVals, NonVals, Defs ),
findall( Name-Ar, (member(D,Defs),functor(D,Name,Ar)), Names ),
findall( Name/Ar, (member(O,Opts),functor(O,Name,Ar),\+ memberchk(Name-Ar,Names)), Pmatic ),
( Pmatic == [] -> true
; throw( unrecognised_options(Pmatic) ) ).
bn_bands_to_dot_dag_output( Bands, Title, Type, Clr, Opts ) :-
memberchk( nodes_colours(NdClrs), Opts ),
memberchk( nodes_labels(NdLbls), Opts ),
memberchk( nodes_positions(NdPoss), Opts ),
memberchk( nodes_dichromatic(DiChr,ChrDi), Opts ),
% memberchk( edges_colours(EdgeClrs), Opts ),
memberchk( nodes_attrs(NdAttrsIn), Opts ),
en_list( NdAttrsIn, NdAttrs ),
memberchk( edges_attrs(EdAttrsPrv), Opts ),
en_list( EdAttrsPrv, EdAttrs ),
% has_only_known_opts( Opts ), % turn it off for now
bands_to_zones( Bands, Zones ),
dot_title( Title, Zones ),
dot_zones_to_colours( Zones, Clr, NdClrs, DiChr/ChrDi, NdLbls, NdPoss, NdAttrs ),
graph_type_to_edge_atom( Type, EdgeAtm ),
dot_edges( Bands, EdgeAtm, EdAttrs ),
write( '}' ), nl.
bands_to_zones( [Pless,Adjusted,Cless], [Pless,AdjZone,ClessZone] ) :-
bands_to_zones1( Adjusted, AdjZone ),
bands_to_zones1( Cless, ClessZone ).
bands_to_zones1( [], [] ).
bands_to_zones1( [PrvH-_HPs|T], [H|M] ) :-
( PrvH = dbl(H) -> true ; H = PrvH ),
bands_to_zones1( T, M ).
dot_title( false, _Zones ) :- !.
dot_title( Title, _Zones ) :-
write( 'label="' ),
write( Title ),
write( '"' ),
nl.
/*
dot_title( Title, Zones ) :-
findall( X, (member(Z,Zones),member(0-X,Z)), Xs ),
( Xs == [] ->
TitleNodeId is 0
;
TitleNodeId = 'title'
),
tab( 2 ), write( TitleNodeId ), write( ' ' ),
Opts = [shape(invhouse),label(Title)],
print_graphviz_entry_opts( Opts ).
*/
dot_zones_to_colours( [PlessZ,AdjZ,ClessZ], Clr, NdClrs, DiChr, NdLbls, NdPoss, NdAttrs ) :-
( Clr == bnw ->
Red = black, Orange = black, Green = black
;
Red = red, Orange = orange, Green = green
),
dot_zone_to_colour( PlessZ, Red, NdClrs, DiChr, NdLbls, NdPoss, NdAttrs ),
dot_zone_to_colour( AdjZ, Orange, NdClrs, DiChr, NdLbls, NdPoss, NdAttrs ),
dot_zone_to_colour( ClessZ, Green, NdClrs, DiChr, NdLbls, NdPoss, NdAttrs ).
dot_zone_to_colour( [], _Colour, _NdColours, _DiChr, _NdLbls, _NdPoss, _NdAttrs ).
dot_zone_to_colour( [H|T], Colour, NdColours, DiChr/ChrDi, NdLbls, NdPoss, NdAttrs ) :-
( memberchk(H-NdClrPrv,NdColours) -> DiDef = false ; NdClrPrv = Colour, DiDef = true ),
dichromatic_node( DiChr, ChrDi, DiDef, NdClrPrv, NdClr ),
tab( 2 ), write('"'),write( H ),write('"'),tab( 1 ),
( memberchk(H-NdAt,NdAttrs) ->
en_list( NdAt, NdT )
;
NdT = []
),
( memberchk(color(_),NdT) -> CNdT=NdT; CNdT = [color(NdClr)|NdT] ), % do not override if color/1 in Attributes
( (memberchk(H-NdLbl,NdLbls)
; (integer(H),nth1(H,NdLbls,NdLbl),atomic(NdLbl))) ->
NdL = [label(NdLbl)|CNdT]
% NdL = [color(NdClr),label(NdLbl)|NdT]
;
NdL = CNdT
),
/*
write( '[' ),
write_colour( NdClr ),
write( ', label'='"' ), write( NdLbl ), write( '"' ),
write_cont_attrs_of( H, NdAttrs ),
write( ']' )
;
write( '[' ),
write( color='"' ), write( NdClr ), write( '"' ),
write_cont_attrs_of( H, NdAttrs ),
write( ']' )
*/
( memberchk(H-pos(X,Y),NdPoss) ->
atomic_list_concat( [X,',',Y,'!'], XY ),
NdP = [pos(XY)|NdL]
;
NdP = NdL
),
print_graphviz_entry_opts( NdP ),
dot_zone_to_colour( T, Colour, NdColours, DiChr/ChrDi, NdLbls, NdPoss, NdAttrs ).
dichromatic_node( DiChr, ChrDi, DiDef, Prov, NdClr ) :-
dichromatic_mode( DiChr, ChrDi, DiDef, Prov, NdClr ),
!.
dichromatic_node( _DiChr, _ChrDi, _DiDef, Prov, NdClr ) :-
dichromatic_mode( false, white, false, Prov, NdClr ).
dichromatic_mode( true, ChrDi, _DiDef, Prov, NdClr ) :-
atomic_list_concat( ProvParts, ':', Prov ),
dichromatic_parts( ProvParts, ChrDi, NdClr ).
dichromatic_mode( false, _ChrDi, _DiDef, Prov, Prov ).
dichromatic_mode( default, ChrDi, DiDef, Prov, NdClr ) :-
dichromatic_mode( DiDef, ChrDi, false, Prov, NdClr ).
dichromatic_parts( [A], Chroma, NdClr ) :-
!,
atomic_list_concat( [Chroma,A], ':', NdClr ).
dichromatic_parts( Parts, _Chroma, NdClr ) :-
atomic_list_concat( Parts, ':', NdClr ).
/*
write_colour( Scheme+Colour ) :-
write( colorscheme='"' ), write( Scheme ), write( '",' ),
write( color='"' ), write( Colour ), write( '"' ).
write_colour( NdClr ) :-
atomic( NdClr ),
write( color='"' ), write( NdClr ), write( '"' ).
*/
dot_edges( [Pless,Adj,Cless], EdgeAtm, EdgesAttrsPrv ) :-
kv_newval_empty_list( Pless, KvPless ),
% write( user_error, dot_edges_one( KvPless, EdgeAtm, Clrs ) ),
% nl( user_error ),
en_list( EdgesAttrsPrv, EdAttrs ),
dot_edges_one( KvPless, EdgeAtm, EdAttrs ),
dot_edges_one( Adj, EdgeAtm, EdAttrs ),
dot_edges_one( Cless, EdgeAtm, EdAttrs ).
dot_edges_one( [], _EdgeAtm, _EdAttrs ).
dot_edges_one( [Node-Parents|T], EdgeAtm, EdAttrs ) :-
% HERE select( Node-AgainstPrs, Against, _Ragain ),
dot_node_parents_edges( Parents, EdgeAtm, Node, EdAttrs ),
dot_edges_one( T, EdgeAtm, EdAttrs ).
% 11/2010: CLrs expanded to any edge option. format is X-Y-List
% List = [v(t)|_] -> v=t
dot_node_parents_edges( [], _EdgeAtm, _Node, _EddgesAtts ).
% dot_node_parents_edges_vanished( Node, Clrs ).
dot_node_parents_edges( [PrvH|T], EdgeAtm, Node, EdgesAtts ) :-
% ( PrvH = dbl(H) -> Dbl = true ; H = PrvH, Dbl = false ),
( PrvH = dbl(H) ->
% throw( obsolete_double_notation(H,Node) )
true
;
H = PrvH
),
tab( 2 ),
write( '"' ), write( H ), write( '"' ),
write( EdgeAtm ),
write( '"' ), write( Node ), write( '"' ),
select_edge_attrs( EdgeAtm, H, PrvH, Node, EdgesAtts, EdgeAtts, RemEdgesAtts ),
print_graphviz_entry_opts( EdgeAtts ),
dot_node_parents_edges( T, EdgeAtm, Node, RemEdgesAtts ).
% select_edge_attrs( '--', H, PrvH, Node, EdgesAtts, EAtts, RemEdgesAtts ) :-
select_edge_attrs( _, H, PrvH, Node, EdgesAtts, EAtts, RemEdgesAtts ) :-
% !,
( select(H-Node-EAttsPrv,EdgesAtts,RemEdgesAtts) ->
en_list( EAttsPrv, EAttsTmp ),
(PrvH = dbl(_) -> add_opt(dir,EAttsTmp,none,EAtts); EAtts=EAttsTmp)
;
( select(Node-H-EAttsPrv,EdgesAtts,RemEdgesAtts) ->
en_list( EAttsPrv, EAttsTmp ),
(PrvH = dbl(_) -> add_opt(dir,EAttsTmp,none,EAtts); EAtts=EAttsTmp)
;
RemEdgesAtts = EdgesAtts,
EAtts = []
)
).
/* was used by against
dot_node_parents_edges_vanished( [], _Node, _Clrs ).
dot_node_parents_edges_vanished( [H|T], Node, Clrs ) :-
( H = dbl(_) ->
true
;
tab( 2 ), write( H ), write( '->' ), write( Node ),
( memberchk(H-Node-Colour,Clrs) ->
true
;
Colour = yellow
),
write( ' [color=' ),
write( Colour ),
write( ']' ), nl,
dot_node_parents_edges_vanished( T, Node, Clrs )
).
*/
kv_newval_empty_list( [], [] ).
kv_newval_empty_list( [H|T], [H-[]|Te] ) :-
kv_newval_empty_list( T, Te ).
graph_type_to_edge_atom( graph, '--' ).
graph_type_to_edge_atom( digraph, '->' ).
dot_preample( NodeStyle, NodeShape, EdgeStyle, Type, EdgeClr, Opts ) :-
write( Type ),
write( ' G {' ), nl,
% findall( Gopt, member(graph(Gopt),Opts), Gopts ),
% fixme: make this to an independent predicate (probably in lib(options)
% trace,
findall( GoptName-GoptArity, (member(graph(Gopt),Opts),Gopt\==none,functor(Gopt,GoptName,GoptArity)), GoptPrs ),
sort( GoptPrs, GoptPrsSet ),
findall( Gopt1, (member(GoName-GoArity,GoptPrsSet),functor(Gopt1,GoName,GoArity),memberchk(graph(Gopt1),Opts)), Gopts ),
prolog_options_dot_options( Gopts, '', GraphOpt ),
atomic_list_concat( [graph,' [',GraphOpt,']'], GraphLn ),
% write( ' graph [URL="default.html", BGURL="smbluewhite_paper.gif "]' ), nl,
write( GraphLn ), nl,
write( ' node [shape=' ), write( NodeShape),
write( ',style=' ), write( NodeStyle ),
% write( ' node [style=' ), write( NodeStyle ),
write( ']' ), nl, nl,
write( ' edge [color="' ),
write( EdgeClr ), write( '"' ),
write( ',style=' ), write('"'), write( EdgeStyle ), write( '"' ),
/*
( Clr == bnw ->
write( black )
;
write( red )
),
*/
write( ']' ), nl.
prolog_options_dot_options( [], Dot, Dot ).
prolog_options_dot_options( [O|Opts], Acc, Dot ) :-
functor( O, Name, 1 ),
arg( 1, O, Value ),
atomic_list_concat( [Name,'=','"',Value,'"'], Add ),
( Acc = '' -> Nxt = Add ; atomic_list_concat( [Acc,', ',Add], Nxt ) ),
prolog_options_dot_options( Opts, Nxt, Dot ).
print_graphviz_entry_opts( InOpts ) :-
en_list( InOpts, Opts ),
write( ' [' ),
print_graphviz_entry_opts_rec( Opts ),
write( ']' ), nl.
print_graphviz_entry_opts_rec( [] ).
print_graphviz_entry_opts_rec( [H|T] ) :-
( ( functor( H, Name, 1 ),
arg( 1, H, Arg ),
% write( Name=Arg ),
write( Name ),
write( = ),
write( '"' ),
write( Arg ),
write( '"' ),
% maybe writeq/1 would do ?
( T \== [] -> write( ', ' ) ; true )
) -> true
;
throw( wrong_arity_in_option(H) )
),
print_graphviz_entry_opts_rec( T ).
add_opt( Name, InOpts, Value, OutOpts ) :-
functor( Term, Name, 1 ),
( memberchk(Term,InOpts) ->
throw( trying_to_add_opt_with_existing_value(Name,InOpts) )
;
true
),
arg( 1, Term, Value ),
OutOpts = [Term|InOpts].