Commit 5c2ec4e5 authored by Thierry Martinez's avatar Thierry Martinez

More robust graph API

parent 1f4edde9
:- module( :- module(
graph_editor, graph_editor,
[ [
% Grammars
edge/1,
edgeref/1,
% Commands
new_graph/0, new_graph/0,
delete_graph/1, delete_graph/1,
set_graph_name/1, set_graph_name/1,
...@@ -8,9 +12,7 @@ ...@@ -8,9 +12,7 @@
select_graph/1, select_graph/1,
add_vertex/1, add_vertex/1,
delete_vertex/1, delete_vertex/1,
edge/1,
add_edge/1, add_edge/1,
edgeref/1,
delete_edge/1, delete_edge/1,
list_edges/0, list_edges/0,
list_isolated_vertices/0, list_isolated_vertices/0,
...@@ -22,21 +24,51 @@ ...@@ -22,21 +24,51 @@
list_attributes/1, list_attributes/1,
place/1, place/1,
transition/1, transition/1,
% Public API
new_graph/1,
set_graph_name/2,
get_current_graph/1, get_current_graph/1,
set_current_graph/1, set_current_graph/1,
get_graph_name/2, get_graph_name/2,
get_attribute/2 get_attribute/2,
get_attribute/3,
set_attribute/3,
place/2,
transition/2,
kind/3,
add_vertex/3,
add_edge/3
] ]
). ).
:- devdoc('\\section{Grammars}').
:- grammar(edge).
edge(From -> To) :-
name(From),
name(To).
:- grammar(edgeref).
edgeref(Edge) :-
edge(Edge).
:- devdoc('\\section{Commands}'). :- devdoc('\\section{Commands}').
new_graph :- new_graph :-
biocham_command, biocham_command,
doc('Creates a new graph.'), doc('Creates a new graph.'),
add_item([kind: graph, key: new_graph, id: Id]), new_graph(Id),
set_current_graph(Id). set_current_graph(Id).
...@@ -52,7 +84,7 @@ set_graph_name(Name) :- ...@@ -52,7 +84,7 @@ set_graph_name(Name) :-
type(Name, name), type(Name, name),
doc('Sets the name of the current graph.'), doc('Sets the name of the current graph.'),
get_current_graph(Id), get_current_graph(Id),
replace_item(Id, graph, Name, Name). set_graph_name(Id, Name).
list_graphs :- list_graphs :-
...@@ -73,10 +105,11 @@ add_vertex(NameList) :- ...@@ -73,10 +105,11 @@ add_vertex(NameList) :-
biocham_command(*), biocham_command(*),
type(NameList, '*'(name)), type(NameList, '*'(name)),
doc('Adds new vertices to the current graph.'), doc('Adds new vertices to the current graph.'),
get_current_graph(GraphId),
\+ ( \+ (
member(Name, NameList), member(Name, NameList),
\+ ( \+ (
add_vertex(Name, _VertexId) add_vertex(GraphId, Name, _VertexId)
) )
). ).
...@@ -94,14 +127,6 @@ delete_vertex(NameList) :- ...@@ -94,14 +127,6 @@ delete_vertex(NameList) :-
). ).
:- grammar(edge).
edge(From -> To) :-
name(From),
name(To).
add_edge(EdgeList) :- add_edge(EdgeList) :-
biocham_command(*), biocham_command(*),
type(EdgeList, '*'(edge)), type(EdgeList, '*'(edge)),
...@@ -109,21 +134,15 @@ add_edge(EdgeList) :- ...@@ -109,21 +134,15 @@ add_edge(EdgeList) :-
Adds the given set of edges to the current graph. Adds the given set of edges to the current graph.
The vertices are added if needed. The vertices are added if needed.
'), '),
get_current_graph(GraphId),
\+ ( \+ (
member(Edge, EdgeList), member(Edge, EdgeList),
\+ ( \+ (
add_edge(Edge, _EdgeId) add_edge(GraphId, Edge, _EdgeId)
) )
). ).
:- grammar(edgeref).
edgeref(Edge) :-
edge(Edge).
delete_edge(EdgeRefList) :- delete_edge(EdgeRefList) :-
biocham_command(*), biocham_command(*),
type(EdgeRefList, '*'(edgeref)), type(EdgeRefList, '*'(edgeref)),
...@@ -186,6 +205,33 @@ attribute(Name) :- ...@@ -186,6 +205,33 @@ attribute(Name) :-
name(Name). name(Name).
set_attribute(Id, Attribute) :-
integer(Id),
!,
(
Attribute = Key: _Value
->
true
;
Key = Attribute
),
(
item(
[parent: Id, kind: attribute, key: Key, item: Item, id: AttributeId]
)
->
(
Item = Attribute
->
true
;
replace_item(AttributeId, attribute, Key, Attribute)
)
;
add_item([parent: Id, kind: attribute, key: Key, item: Attribute])
).
set_attribute(GraphObjectSet, Attribute) :- set_attribute(GraphObjectSet, Attribute) :-
biocham_command, biocham_command,
type(GraphObjectSet, {graph_object}), type(GraphObjectSet, {graph_object}),
...@@ -194,34 +240,8 @@ set_attribute(GraphObjectSet, Attribute) :- ...@@ -194,34 +240,8 @@ set_attribute(GraphObjectSet, Attribute) :-
Adds an attribute to every vertex or edge in the given set. Adds an attribute to every vertex or edge in the given set.
The vertices and the edges are added if needed. The vertices and the edges are added if needed.
'), '),
\+ ( get_current_graph(GraphId),
member(GraphObject, GraphObjectSet), set_attribute(GraphId, GraphObjectSet, Attribute).
\+ (
add_graph_object(GraphObject, Id),
(
Attribute = Key: _Value
->
true
;
Key = Attribute
),
(
item(
[parent: Id, kind: attribute, key: Key, item: Item, id: AttributeId]
)
->
(
Item = Attribute
->
true
;
replace_item(AttributeId, attribute, Key, Attribute)
)
;
add_item([parent: Id, kind: attribute, key: Key, item: Attribute])
)
)
).
place(NameList) :- place(NameList) :-
...@@ -230,9 +250,8 @@ place(NameList) :- ...@@ -230,9 +250,8 @@ place(NameList) :-
doc(' doc('
Sets that the vertices \\argument{NameList} are places. Sets that the vertices \\argument{NameList} are places.
'), '),
add_vertex(NameList), get_current_graph(Id),
set_attribute(NameList, kind: place). place(Id, NameList).
transition(NameList) :- transition(NameList) :-
...@@ -241,30 +260,45 @@ transition(NameList) :- ...@@ -241,30 +260,45 @@ transition(NameList) :-
doc(' doc('
Sets that the vertices \\argument{NameList} are transitions. Sets that the vertices \\argument{NameList} are transitions.
'), '),
add_vertex(NameList), get_current_graph(Id),
set_attribute(NameList, kind: transition). transition(Id, NameList).
delete_attribute(Id, Attribute) :-
integer(Id),
!,
delete_item([parent: Id, kind: attribute, key: Attribute]).
delete_attribute(GraphObject, Attribute) :- delete_attribute(GraphObject, Attribute) :-
biocham_command, biocham_command,
type(GraphObject, graph_object), type(GraphObject, graph_object),
type(Attribute, name), type(Attribute, name),
doc('Removes an attribute from \\argument{GraphObject}.'), doc('Removes an attribute from \\argument{GraphObject}.'),
find_graph_object(GraphObject, Id), get_current_graph(GraphId),
delete_item([parent: Id, kind: attribute, key: Attribute]). find_graph_object(GraphId, GraphObject, Id),
delete_attribute(Id, Attribute).
list_attributes(GraphObject) :- list_attributes(GraphObject) :-
biocham_command, biocham_command,
type(GraphObject, graph_object), type(GraphObject, graph_object),
doc('List the attributes of \\argument{GraphObject}.'), doc('List the attributes of \\argument{GraphObject}.'),
find_graph_object(GraphObject, Id), get_current_graph(GraphId),
find_graph_object(GraphId, GraphObject, Id),
list_items([parent: Id, kind: attribute]). list_items([parent: Id, kind: attribute]).
:- devdoc('\\section{Public API}'). :- devdoc('\\section{Public API}').
new_graph(Id) :-
add_item([kind: graph, key: new_graph, id: Id]).
set_graph_name(Id, Name) :-
replace_item(Id, graph, Name, Name).
get_current_graph(Id) :- get_current_graph(Id) :-
get_selection(current_model, current_graph, [Id]). get_selection(current_model, current_graph, [Id]).
...@@ -290,41 +324,103 @@ get_attribute(Id, Attribute) :- ...@@ -290,41 +324,103 @@ get_attribute(Id, Attribute) :-
item([parent: Id, kind: attribute, key: Key, item: Attribute]). item([parent: Id, kind: attribute, key: Key, item: Attribute]).
get_attribute(GraphObject, Attribute) :- get_attribute(GraphId, GraphObject, Attribute) :-
find_graph_object(GraphObject, Id), get_current_graph(GraphId),
find_graph_object(GraphId, GraphObject, Id),
get_attribute(Id, Attribute). get_attribute(Id, Attribute).
set_attribute(GraphId, GraphObjectSet, Attribute) :-
list(GraphObjectSet),
!,
\+ (
member(GraphObject, GraphObjectSet),
\+ (
set_attribute(GraphId, GraphObject, Attribute)
)
).
set_attribute(GraphId, GraphObject, Attribute) :-
add_graph_object(GraphId, GraphObject, Id),
set_attribute(Id, Attribute).
place(GraphId, NameList) :-
kind(GraphId, NameList, place).
transition(GraphId, NameList) :-
kind(GraphId, NameList, transition).
kind(GraphId, NameList, Kind) :-
list(NameList),
!,
\+ (
member(Name, NameList),
\+ (
kind(GraphId, Name, Kind)
)
).
kind(GraphId, Name, Kind) :-
add_vertex(GraphId, Name, VertexId),
set_attribute(VertexId, kind: Kind).
add_vertex(GraphId, Name, VertexId) :-
(
item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
->
true
;
add_item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
).
add_edge(GraphId, Edge, EdgeId) :-
Edge = (From -> To),
add_vertex(GraphId, From, FromId),
add_vertex(GraphId, To, ToId),
(
item([parent: GraphId, kind: edge, key: Edge, id: EdgeId])
->
true
;
add_item([parent: GraphId, kind: edge, key: Edge, id: EdgeId]),
add_dependency(EdgeId, FromId),
add_dependency(EdgeId, ToId)
).
:- devdoc('\\section{Private predicates}'). :- devdoc('\\section{Private predicates}').
find_vertex(Name, Id) :- find_vertex(GraphId, Name, Id) :-
get_current_graph(GraphId),
find_item([parent: GraphId, kind: vertex, key: Name, id: Id]). find_item([parent: GraphId, kind: vertex, key: Name, id: Id]).
find_edge(Edge, Id) :- find_edge(GraphId, Edge, Id) :-
get_current_graph(GraphId),
find_item([parent: GraphId, kind: edge, key: Edge, id: Id]). find_item([parent: GraphId, kind: edge, key: Edge, id: Id]).
find_graph_object(GraphObject, Id) :- find_graph_object(GraphId, GraphObject, Id) :-
( (
GraphObject = (_From->_To) GraphObject = (_From->_To)
-> ->
find_edge(GraphObject, Id) find_edge(GraphId, GraphObject, Id)
; ;
find_vertex(GraphObject, Id) find_vertex(GraphId, GraphObject, Id)
). ).
add_graph_object(GraphObject, Id) :- add_graph_object(GraphId, GraphObject, Id) :-
( (
GraphObject = (_From->_To) GraphObject = (_From->_To)
-> ->
add_edge(GraphObject, Id) add_edge(GraphId, GraphObject, Id)
; ;
add_vertex(GraphObject, Id) add_vertex(GraphId, GraphObject, Id)
). ).
...@@ -355,30 +451,3 @@ isolated_or_attributed_vertices(GraphId, VerticesId) :- ...@@ -355,30 +451,3 @@ isolated_or_attributed_vertices(GraphId, VerticesId) :-
), ),
VerticesId VerticesId
). ).
add_vertex(Name, VertexId) :-
get_current_graph(GraphId),
(
item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
->
true
;
add_item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
).
add_edge(Edge, EdgeId) :-
get_current_graph(GraphId),
Edge = (From -> To),
add_vertex(From, FromId),
add_vertex(To, ToId),
(
item([parent: GraphId, kind: edge, key: Edge, id: EdgeId])
->
true
;
add_item([parent: GraphId, kind: edge, key: Edge, id: EdgeId]),
add_dependency(EdgeId, FromId),
add_dependency(EdgeId, ToId)
).
...@@ -174,6 +174,7 @@ test('get_attribute', [true(Kind == transition)]) :- ...@@ -174,6 +174,7 @@ test('get_attribute', [true(Kind == transition)]) :-
clear_model, clear_model,
new_graph, new_graph,
command(transition('A')), command(transition('A')),
once(get_attribute('A', kind: Kind)). get_current_graph(GraphId),
once(get_attribute(GraphId, 'A', kind: Kind)).
:- end_tests(graph_editor). :- end_tests(graph_editor).
:- module( :- module(
graphviz, graphviz,
[ [
% Commands
draw_graph/0, draw_graph/0,
export_graph/1, export_graph/1,
% Public API
draw_graph/1,
export_graph/2,
set_draw_graph_driver/1 set_draw_graph_driver/1
] ]
). ).
...@@ -14,8 +18,8 @@ ...@@ -14,8 +18,8 @@
draw_graph :- draw_graph :-
biocham_command, biocham_command,
doc('Draws the current graph.'), doc('Draws the current graph.'),
get_draw_graph_driver(Driver), get_current_graph(Id),
Driver. draw_graph(Id).
export_graph(OutputFile) :- export_graph(OutputFile) :-
...@@ -28,13 +32,23 @@ export_graph(OutputFile) :- ...@@ -28,13 +32,23 @@ export_graph(OutputFile) :-
\ttexttt{.png} or \ttexttt{.svg} \ttexttt{.png} or \ttexttt{.svg}
-- assuming no extension is \\texttt{.dot}. -- assuming no extension is \\texttt{.dot}.
'), '),
file_name_extension(_, Suffix, OutputFile), get_current_graph(Id),
export_graph(Suffix, OutputFile). export_graph(Id, OutputFile).
:- devdoc('\\section{Public API}'). :- devdoc('\\section{Public API}').
draw_graph(Id) :-
nb_getval(draw_graph_driver, Driver),
call(Driver, Id).
export_graph(Id, OutputFile) :-
file_name_extension(_, Suffix, OutputFile),
export_graph(Suffix, Id, OutputFile).
set_draw_graph_driver(Driver) :- set_draw_graph_driver(Driver) :-
nb_setval(draw_graph_driver, Driver). nb_setval(draw_graph_driver, Driver).
...@@ -42,53 +56,46 @@ set_draw_graph_driver(Driver) :- ...@@ -42,53 +56,46 @@ set_draw_graph_driver(Driver) :-
:- devdoc('\\section{Internal predicates}'). :- devdoc('\\section{Internal predicates}').
export_graph('', OutputFile) :- export_graph('', Id, OutputFile) :-
!,
atom_concat(OutputFile, '.dot', FilenameDot), atom_concat(OutputFile, '.dot', FilenameDot),
export_graph('.dot', FilenameDot). export_graph('.dot', Id, FilenameDot).
export_graph('dot', OutputFile) :- export_graph('dot', Id, OutputFile) :-
get_current_graph(GraphId), !,
create_cgraph(GraphId, Graph), create_cgraph(Id, Graph),
agwrite(Graph, OutputFile), agwrite(Graph, OutputFile),
agclose(Graph). agclose(Graph).
export_graph('pdf', OutputFile) :- export_graph(Format, Id, OutputFile) :-
render_current_graph('pdf', OutputFile). graphviz_format(Format),
!,
export_graph('eps', OutputFile) :- create_cgraph(Id, Graph),
render_current_graph('eps', OutputFile). gvLayout(Graph, dot),
gvRenderFilename(Graph, Format, OutputFile),
export_graph('ps', OutputFile) :- gvFreeLayout(Graph),
render_current_graph('ps', OutputFile). agclose(Graph).
export_graph('png', OutputFile) :-
render_current_graph('png', OutputFile).
export_graph('svg', OutputFile) :- graphviz_format('pdf').
render_current_graph('svg', OutputFile).
graphviz_format('eps').
get_draw_graph_driver(Driver) :- graphviz_format('ps').
nb_getval(draw_graph_driver, Driver).
graphviz_format('png').
render_current_graph(Format, OutputFile) :- graphviz_format('svg').
get_current_graph(GraphId),
create_cgraph(GraphId, Graph),
gvLayout(Graph, dot),
gvRenderFilename(Graph, Format, OutputFile),