:- 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].