Skip to content

Commit

Permalink
Peter's version of graphviz_swish incorporated into the codebase (issue
Browse files Browse the repository at this point in the history 
#1)
  • Loading branch information
@So-Cool
So-Cool committed Dec 28, 2016
1 parent b46188f commit 3ef1870
Showing 1 changed file with 93 additions and 154 deletions.
247 changes: 93 additions & 154 deletions graphviz_swish.pl
View file
Original file line number Diff line number Diff line change
@@ -1,37 +1,36 @@
%%% Plotting terms as trees using Graphviz %%%

term_list_linear(false). % change to true for plotting lists linearly
write_to_file(false). % write Graphviz file

term(Term, Dot):-
gv_start('term.dot', DotOut1),
term(Term,Dot):-
gv_start('term.dot'),
Term =.. [Functor|Subterms],
gv_root(Functor,0, DotOut1, DotOut2),
term_list(Subterms,0, DotOut2, DotOut3),
gv_stop(DotOut3, Dot).
gv_root(Functor,0),
term_list(Subterms,0),
gv_stop(Dot).

term(Term,N, DotIn, DotOut):-
terml(Term,N):-
var(Term),!,
gv_node(N,Term,_, DotIn, DotOut).
term(Term,N, DotIn, DotOut):-
gv_node(N,Term,_).
terml(Term,N):-
term_list_linear(true),
list(Term),!,
gv_node(N,Term,N1, DotIn, DotOut1),
term_list(Term,N1, DotOut1, DotOut).
term([],N, DotIn, DotOut):-!,
gv_node(N,'$empty_list',_, DotIn, DotOut).
term(Term,N, DotIn, DotOut):-
gv_node(N,Term,N1),
term_list(Term,N1).
terml([],N):-!,
gv_node(N,'$empty_list',_).
terml(Term,N):-
Term =.. [Functor|Subterms],
gv_node(N,Functor,N1, DotIn, DotOut1),
term_list(Subterms,N1, DotOut1, DotOut).
gv_node(N,Functor,N1),
term_list(Subterms,N1).

term_list([],_, Dot, Dot).
term_list([Term|Terms],N, DotIn, DotOut):-
term(Term,N, DotIn, DotOut1),
term_list(Terms,N, DotOut1, DotOut).
term_list([],_).
term_list([Term|Terms],N):-
terml(Term,N),
term_list(Terms,N).

% testing
term1(Dot):-term([a,b,b,a], Dot).
term1(Dot):-term([a,b,b,a],Dot).
term2(Dot):-term(
html(head(title('Peter A. Flach')),
body([img([align=right,src='logo.jpg']),
Expand All @@ -49,46 +48,44 @@
bla,
hr,address(bla)
])
),
Dot
)
,Dot
).


%%% Meta-interpreter plotting (part of) the SLD-tree using Graphviz %%%

%:-op(1100,fx,sld). % can write ?-sld Goal instead of ?-sld(Goal)
:-op(200,xfx,sld). % can write ?-Goal sld Dot instead of ?-sld(Goal, Dot)

sld(Goal, Dot):-
sld(Goal,5, DotOut), % default depth bound
sld_(DotOut, Dot).
sld(Goal,Dot):-
sld(Goal,5,Dot). % default depth bound

sld(Goal,D, Dot):-
gv_start('sld.dot', DotOut),
gv_root((?-Goal),0, DotOut, DotOut1),
prove_d(Goal,Goal,0,D, DotOut1, Dot),
sld(Goal,D,_):-
gv_start('sld.dot'),
gv_root((?-Goal),0),
prove_d(Goal,Goal,0,D),
fail. % failure-driven loop to get all solutions
sld_(DotIn, DotOut):-
gv_stop(DotIn, DotOut).
sld(_,_,Dot):-
gv_stop(Dot).

% meta-interpreter with complete resolvent and depth bound
prove_d(true,Goal,N,_, DotIn, DotOut):-!,
gv_answer(N,Goal, DotIn, DotOut).
prove_d((A,B),Goal,N,D, DotIn, DotOut):-!,
prove_d(true,Goal,N,_):-!,
gv_answer(N,Goal).
prove_d((A,B),Goal,N,D):-!,
D>0, D1 is D-1,
resolve(A,C),
conj_append(C,B,E),
gv_node(N,(:-E),N1, DotIn, DotOut1),
prove_d(E,Goal,N1,D1, DotOut1, DotOut).
prove_d(A,Goal,N,D, DotIn, DotOut):-
gv_node(N,(:-E),N1),
prove_d(E,Goal,N1,D1).
prove_d(A,Goal,N,D):-
D>0, D1 is D-1,
resolve(A,B),
gv_node(N,(:-B),N1, DotIn, DotOut1),
prove_d(B,Goal,N1,D1, DotOut1, DotOut).
gv_node(N,(:-B),N1),
prove_d(B,Goal,N1,D1).

resolve(A,true):-
%predicate_property(A,built_in),!,
!, call(A).
predicate_property(A,built_in),!,
call(A).
resolve(A,B):-
clause(A,B).

Expand All @@ -106,8 +103,8 @@
brother_of(X,Y):-brother_of(X,Z),brother_of(Z,Y).
brother_of(X,Y):-brother_of(Y,X).

sld1(Dot):-sld( student_of(_,peter), Dot).
sld2(Dot):-sld( brother_of(paul,_), Dot).
sld1(Dot):-sld(student_of(_,peter),Dot).
sld2(Dot):-sld(brother_of(paul,_),Dot).


%%% Utilities %%%
Expand All @@ -124,121 +121,85 @@

conj_append(true,Ys,Ys).
conj_append(X,Ys,(X,Ys)):- % single-element conjunction
X \= true,
X \= true,
X \= (_,_).
conj_append((X,Xs),Ys,(X,Zs)):-
conj_append(Xs,Ys,Zs).

writes([]):-!,nl.
writes([]):-!.
writes([H|T]):-!,writes(H),writes(T).
writes((A,B)):-!,writes(A),write(',\\n'),writes(B). % break up conjunctions
writes(:-A):-!,write(':-'),writes(A).
writes(?-A):-!,write('?-'),writes(A).
writes('$empty_list'):-!,write([]).
writes(A):-write(A). % catch-all


writes((A,B)):-!,writes(A),my_assert(',\\n'),writes(B). % break up conjunctions
writes(:-A):-!,my_assert(':-'),writes(A).
writes(?-A):-!,my_assert('?-'),writes(A).
writes('$empty_list'):-!,my_assert('[]').
writes(A):-(atom(A)->my_assert(A);term_to_atom(A,B),my_assert(B)). % catch-all

my_assert(A):-
assertz('$my_assert'(A)).

get_dot(A):-
get_dot('',A).

get_dot(In,Out):-
( retract('$my_assert'(A)) -> atom_concat(In,A,In1),get_dot(In1,Out)
; otherwise -> Out=In
).


%%% Graphviz utilities %%%

gv_max_id(1000). % max number of nodes in the graph

% open file and start new graph
gv_start(_, DotOut):- % gv_start(FileName, DotOut):-
%( write_to_file(true)
%-> (tell(FileName),
%writes(['digraph {']),
%%writes(['graph [size="4,6"];']),
%writes(['node [shape=plaintext, fontname=Courier, fontsize=12]'])
%)
%; true
%),
writes(['digraph {'], '', DotOut1),
writes(['node [shape=plaintext, fontname=Courier, fontsize=12]'], DotOut1, DotOut).
gv_start(FileName):-
retractall('$my_assert'(_)),
tell(FileName),
writes(['digraph {']),
%writes(['graph [size="4,6"];']),
writes(['node [shape=plaintext, fontname=Courier, fontsize=12]']).

% next graph
gv_next(DotIn, DotOut):-
%( write_to_file(true)
%-> (writes(['}']),
%writes(['digraph {']),
%writes(['node [shape=plaintext, fontname=Courier, fontsize=12]'])
%)
%; true
%),
writes(['}'], DotIn, DotOut1),
writes(['digraph {'], DotOut1, DotOut2),
writes(['node [shape=plaintext, fontname=Courier, fontsize=12]'], DotOut2, DotOut).
gv_next:-
writes(['}']),
writes(['digraph {']),
writes(['node [shape=plaintext, fontname=Courier, fontsize=12]']).

% finish graph and close file
gv_stop(DotIn, DotOut):-
%( write_to_file(true)
%-> (writes(['}']),
%told)
%; true
%),
writes(['}'], DotIn, DotOut).
gv_stop(Dot):-
writes(['}']),
told,
get_dot(Dot).

% start new subgraph
gv_cluster_start(DotIn, DotOut):-
gv_cluster_start:-
( retract('$gv_cluster'(N)) -> N1 is N+1
; otherwise -> N1=0
),assert('$gv_cluster'(N1)),
%( write_to_file(true)
%-> (writes(['subgraph cluster_',N1,' {']),
%writes(['[style=filled, color=lightgrey];']),
%writes(['node [style=filled,color=white];'])
%)
%; true
%),
atom_number(N1Atom, N1),
writes(['subgraph cluster_',N1Atom,' {'], DotIn, DotOut1),
writes(['[style=filled, color=lightgrey];'], DotOut1, DotOut2),
writes(['node [style=filled,color=white];'], DotOut2, DotOut).

% finish subgraph
gv_cluster_stop(DotIn, DotOut):-
%( write_to_file(true)
%-> writes(['}'])
%; true
%),
writes(['}'], DotIn, DotOut).
writes(['subgraph cluster_',N1,' {']),
writes(['[style=filled, color=lightgrey];']),
writes(['node [style=filled,color=white];']).

% finish subgraph
gv_cluster_stop:-
writes(['}']).

% write the root of a tree and initialise node IDs
gv_root(L,N, DotIn, DotOut):-
%( write_to_file(true)
%-> writes([N,' [label="',L,'"];'])
%; true
%),
atom_number(NAtom, N),
writes([NAtom,' [label="',L,'"];'], DotIn, DotOut),
gv_root(L,N):-
writes([N,' [label="',L,'"];']),
gv_init_ids(N).

% add a node with label L and parent N0
gv_node(N0,L,N, DotIn, DotOut):-
gv_node(N0,L,N):-
gv_id(N),
%( write_to_file(true)
%-> writes([N,' [label="',L,'"];']),
%writes([N0,' -> ',N,';'])
%; true
%),
atom_number(NAtom, N),
atom_number(N0Atom, N0),
writes([NAtom,' [label="',L,'"];'], DotIn, DotOut1),
writes([N0Atom,' -> ',NAtom,';'], DotOut1, DotOut).
writes([N,' [label="',L,'"];']),
writes([N0,' -> ',N,';']).

% add a specially formatted leaf
gv_answer(N0,L, DotIn, DotOut):-
gv_answer(N0,L):-
gv_id(N),
%( write_to_file(true)
%-> (writes([N,' [label="Answer:\\n',L,'", shape=ellipse, style=dotted, fontsize=10];']),
%writes([N0,' -> ',N,' [style=dotted, arrowhead=none];'])
%%writes(['{rank=same;',N0,';',N,';}']).
%)
%; true
%),
atom_number(NAtom, N),
atom_number(N0Atom, N0),
writes([NAtom,' [label="Answer:\n',L,'", shape=ellipse, style=dotted, fontsize=10];'], DotIn, DotOut1),
writes([N0Atom,' -> ',NAtom,' [style=dotted, arrowhead=none];'], DotOut1, DotOut).
writes([N,' [label="Answer:\\n',L,'", shape=ellipse, style=dotted, fontsize=10];']),
writes([N0,' -> ',N,' [style=dotted, arrowhead=none];']).
%writes(['{rank=same;',N0,';',N,';}']).

% generate a new node ID
gv_id(N):-
Expand All @@ -253,25 +214,3 @@
retractall('$gv_id'(_)),
assert('$gv_id'(N)).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
append(X, Y, XY) :-
atom_concat(X, '\n', Xp),
atom_concat(Xp, Y, XY).
merge(In, Out) :-
merge_(In, '', Out).
merge_([In|RIn], Acc, Out) :-
atom_concat(Acc, In, AccUp),
merge_(RIn, AccUp, Out).
merge_([], Out, Out).% :-
%atom_concat(Acc, '\n', Out).

writes([], In, Out):-!,atom_concat(In, '\n', Out).
writes([H|T], In, Out):-!,writes(H, In, Out1),writes(T, Out1, Out).
writes((A,B), In, Out):-!,writes(A, In, Out1),atom_concat(Out1, ',\n', Out2),writes(B, Out2, Out). % break up conjunctions
writes(:-A, In, Out):-!,atom_concat(In, ':-', Out1),writes(A, Out1, Out).
writes(?-A, In, Out):-!,atom_concat(In, '?-', Out1),writes(A, Out1, Out).
writes('$empty_list', In, Out):-!,atom_concat(In, '[]', Out).
writes(A, In, Out):-% catch-all
format(atom(AAtom), "~w", [A]),
atom_concat(In, AAtom, Out).

0 comments on commit 3ef1870

Please sign in to comment.