Commit 04b8693a authored by MARTINEZ Thierry 's avatar MARTINEZ Thierry

Graph editor

parent 6df982b4
......@@ -552,6 +552,17 @@ write_argument(Argument, Doc) :-
[<a href="#~a">~a</a><sub><var>n</var></sub>]',
[NameId, Name, NameId, Name]
)
;
Type = '*'(Name)
->
make_id(Name, NameId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, NameId, Name]
)
;
Type = '='(ItemType)
->
......@@ -618,6 +629,8 @@ refer_argument(Argument, Doc) :-
(
(
Type = '='(ItemType)
;
Type = '*'(ItemType)
;
Type = [ItemType]
;
......
......@@ -14,13 +14,17 @@
add_edge/1,
delete_edge/1,
list_edges/0,
list_isolated_vertices/0,
list_graph_objects/0,
graph_object/1,
attribute/1,
set_attribute/2,
delete_attribute/2,
list_attributes/1,
place/1,
transition/1,
get_current_graph/1,
set_current_graph/1,
get_attribute/2
]
).
......@@ -70,32 +74,40 @@ draw_graph :-
doc('').
export_graph(Argument) :-
export_graph(OutputFile) :-
biocham_command,
type(Argument, type),
doc('').
type(OutputFile, output_file),
doc('Exports the current graph as a \\texttt{.dot} file.'),
setup_call_cleanup(
open(OutputFile, write, OutputStream),
export_graph_stream(OutputStream),
close(OutputStream)
).
add_vertex(Name) :-
biocham_command,
type(Name, name),
doc('Adds a vertex to the current graph.'),
get_current_graph(GraphId),
(
item([parent: GraphId, kind: vertex, key: Name])
->
true
;
add_item([parent: GraphId, kind: vertex, key: Name])
add_vertex(NameList) :-
biocham_command(*),
type(NameList, '*'(name)),
doc('Adds new vertices to the current graph.'),
\+ (
member(Name, NameList),
\+ (
add_vertex(Name, _VertexId)
)
).
delete_vertex(Name) :-
biocham_command,
type(Name, name),
doc('Removes a vertex from the current graph.'),
delete_vertex(NameList) :-
biocham_command(*),
type(NameList, '*'(name)),
doc('Deletes a set of vertices from the current graph.'),
get_current_graph(GraphId),
delete_item([parent: GraphId, kind: vertex, key: Name]).
\+ (
member(Name, NameList),
\+ (
delete_item([parent: GraphId, kind: vertex, key: Name])
)
).
:- grammar(edge).
......@@ -106,40 +118,62 @@ edge(From -> To) :-
name(To).
add_edge(Edge) :-
biocham_command,
type(Edge, edge),
doc('Adds an edge'),
Edge = (From -> To),
find_vertex(From, FromId),
find_vertex(To, ToId),
get_current_graph(GraphId),
(
item([parent: GraphId, kind: edge, key: Edge])
->
true
;
add_item([parent: GraphId, kind: edge, key: Edge, id: Id]),
add_dependency(Id, FromId),
add_dependency(Id, ToId)
add_edge(EdgeList) :-
biocham_command(*),
type(EdgeList, '*'(edge)),
doc('
Adds the given set of edges to the current graph.
The vertices are added if needed.
'),
\+ (
member(Edge, EdgeList),
\+ (
add_edge(Edge, _EdgeId)
)
).
delete_edge(Edge) :-
biocham_command,
type(Edge, edge),
doc('Deletes an edge'),
delete_edge(EdgeList) :-
biocham_command(*),
type(EdgeList, '*'(edge)),
doc('Deletes a set of edges from the current graph.'),
get_current_graph(GraphId),
delete_item([parent: GraphId, kind: edge, key: Edge]).
\+ (
member(Edge, EdgeList),
\+ (
delete_item([parent: GraphId, kind: edge, key: Edge])
)
).
list_edges :-
biocham_command,
doc('Lists the edges of the current graph'),
doc('Lists the edges of the current graph.'),
get_current_graph(GraphId),
list_items([parent: GraphId, kind: edge]).
list_isolated_vertices :-
biocham_command,
doc('Lists the isolated vertices of the current graph.'),
get_current_graph(GraphId),
isolated_vertices(GraphId, VerticeIds),
list_ids(VerticeIds).
list_graph_objects :-
biocham_command,
doc('
Lists the edges and the isolated vertices of the current graph,
and their attributes if any.
'),
get_current_graph(GraphId),
all_ids([parent: GraphId, kind: edge], EdgeIds),
isolated_or_attributed_vertices(GraphId, VerticeIds),
append(EdgeIds, VerticeIds, AllIds),
list_ids([recursive, kind: attribute], AllIds).
:- grammar(graph_object).
......@@ -155,59 +189,69 @@ graph_object(Name) :-
attribute(Key: Value) :-
name(Key),
name(Value).
term(Value).
attribute(Name) :-
name(Name).
set_attribute(GraphObject, Attribute) :-
set_attribute(GraphObjectSet, Attribute) :-
biocham_command,
type(GraphObject, graph_object),
type(GraphObjectSet, {graph_object}),
type(Attribute, attribute),
doc('Adds an attribute to a vertex or an edge.'),
find_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)
doc('
Adds an attribute to every vertex or edge in the given set.
The vertices and the edges are added if needed.
'),
\+ (
member(GraphObject, GraphObjectSet),
\+ (
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])
)
)
;
add_item([parent: Id, kind: attribute, key: Key, item: Attribute])
).
place(Name) :-
biocham_command,
type(Name, name),
place(NameList) :-
biocham_command(*),
type(NameList, '*'(name)),
doc('
Sets that the vertex \\argument{Name} is a place.
Sets that the vertices \\argument{NameList} are places.
'),
add_vertex(Name),
set_attribute(Name, kind: place).
add_vertex(NameList),
set_attribute(NameList, kind: place).
transition(Name) :-
biocham_command,
type(Name, name),
transition(NameList) :-
biocham_command(*),
type(NameList, '*'(name)),
doc('
Sets that the vertex \\argument{Name} is a transition.
Sets that the vertices \\argument{NameList} are transitions.
'),
add_vertex(Name),
set_attribute(Name, kind: transition).
add_vertex(NameList),
set_attribute(NameList, kind: transition).
delete_attribute(GraphObject, Attribute) :-
......@@ -227,7 +271,38 @@ list_attributes(GraphObject) :-
list_items([parent: Id, kind: attribute]).
:- devdoc('\\section{End of commands}').
:- devdoc('\\section{Public API}').
get_current_graph(Id) :-
find_item([kind: current_graph, item: Id]).
set_current_graph(Id) :-
deselect_graph,
add_item([kind: current_graph, item: Id, id: CurrentGraphId]),
add_dependency(CurrentGraphId, Id).
get_attribute(Id, Attribute) :-
integer(Id),
!,
(
Attribute = Key: _Value
->
true
;
Key = Attribute
),
item([parent: Id, kind: attribute, key: Key, item: Attribute]).
get_attribute(GraphObject, Attribute) :-
find_graph_object(GraphObject, Id),
get_attribute(Id, Attribute).
:- devdoc('\\section{Private predicates}').
find_vertex(Name, Id) :-
......@@ -250,49 +325,71 @@ find_graph_object(GraphObject, Id) :-
).
add_graph_object(GraphObject, Id) :-
(
GraphObject = (_From->_To)
->
add_edge(GraphObject, Id)
;
add_vertex(GraphObject, Id)
).
deselect_graph :-
\+ (
item([kind: graph, id: Id]),
\+ (
delete_items([kind: current_graph]).
isolated_vertices(GraphId, VerticesId) :-
findall(
VertexId,
(
item([parent: GraphId, kind: vertex, id: VertexId, item: Vertex]),
\+ item([parent: GraphId, kind: edge, item: (Vertex -> _)]),
\+ item([parent: GraphId, kind: edge, item: (_ -> Vertex)])
),
VerticesId
).
isolated_or_attributed_vertices(GraphId, VerticesId) :-
findall(
VertexId,
(
item([parent: GraphId, kind: vertex, id: VertexId, item: Vertex]),
(
delete_annotation(Id, selected)
\+ item([parent: GraphId, kind: edge, item: (Vertex -> _)]),
\+ item([parent: GraphId, kind: edge, item: (_ -> Vertex)])
->
true
;
true
once(item([parent: VertexId, kind: attribute]))
)
)
),
VerticesId
).
set_current_graph(Id) :-
deselect_graph,
set_annotation(Id, selected, selected).
get_current_graph(Id) :-
add_vertex(Name, VertexId) :-
get_current_graph(GraphId),
(
item([kind: graph, id: Id]),
get_annotation(Id, selected, selected)
item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
->
true
;
throw(error(no_graph_selected))
add_item([parent: GraphId, kind: vertex, key: Name, id: VertexId])
).
get_attribute(Id, Attribute) :-
integer(Id),
!,
add_edge(Edge, EdgeId) :-
get_current_graph(GraphId),
Edge = (From -> To),
add_vertex(From, FromId),
add_vertex(To, ToId),
(
Attribute = Key: _Value
item([parent: GraphId, kind: edge, key: Edge, id: EdgeId])
->
true
;
Key = Attribute
),
item([parent: Id, kind: attribute, key: Key, item: Attribute]).
get_attribute(GraphObject, Attribute) :-
find_graph_object(GraphObject, Id),
get_attribute(Id, Attribute).
add_item([parent: GraphId, kind: edge, key: Edge, id: EdgeId]),
add_dependency(EdgeId, FromId),
add_dependency(EdgeId, ToId)
).
......@@ -42,57 +42,75 @@ test('select_graph', [true(Item == graphA)]) :-
test('add_vertex', [true(Vertices == ['A'])]) :-
clear_model,
new_graph,
add_vertex('A'),
add_vertex('A'),
command(add_vertex('A', 'A')),
get_current_graph(GraphId),
all_items([parent: GraphId, kind: vertex], Vertices).
test('delete_vertex', [true(Vertices == [])]) :-
clear_model,
new_graph,
add_vertex('A'),
delete_vertex('A'),
command(add_vertex('A')),
command(delete_vertex('A')),
get_current_graph(GraphId),
all_items([parent: GraphId, kind: vertex], Vertices).
test('add_edge', [true(Edges == ['A' -> 'B'])]) :-
clear_model,
new_graph,
add_vertex('A'),
add_vertex('B'),
add_vertex('C'),
add_edge('A' -> 'B'),
add_edge('A' -> 'B'),
add_edge('A' -> 'C'),
delete_vertex('C'),
command(add_edge('A' -> 'B', 'A' -> 'B', 'A' -> 'C')),
command(delete_vertex('C')),
get_current_graph(GraphId),
all_items([parent: GraphId, kind: edge], Edges).
test('delete_edge', [true(Edges == [])]) :-
clear_model,
new_graph,
add_vertex('A'),
add_vertex('B'),
add_edge('A' -> 'B'),
delete_edge('A' -> 'B'),
command(add_edge('A' -> 'B')),
command(delete_edge('A' -> 'B')),
get_current_graph(GraphId),
all_items([parent: GraphId, kind: edge], Edges).
test('list_edges', [true(Atom == '[0] A->B\n')]) :-
clear_model,
new_graph,
add_vertex('A'),
add_vertex('B'),
add_edge('A' -> 'B'),
command(add_edge('A' -> 'B')),
with_output_to(atom(Atom), list_edges).
test('list_isolated_vertices', [true(Atom == '[0] C\n')]) :-
clear_model,
new_graph,
command(add_vertex('A', 'B', 'C')),
command(add_edge('A' -> 'B')),
with_output_to(atom(Atom), list_isolated_vertices).
test(
'list_graph_objects',
[true(Atom == '\c
[0] A->B
[1] stochiometry:2
[2] B
[3] kind:transition
[4] C
[5] kind:place
[6] D
')]) :-
clear_model,
new_graph,
command(add_vertex('A')),
command(transition('B')),
command(place('C')),
command(add_vertex('D')),
command(add_edge('A' -> 'B')),
command(set_attribute(('A' -> 'B'), stochiometry: 2)),
with_output_to(atom(Atom), list_graph_objects).
test('set_attribute vertex', [true(Attributes == ['object', 'item'])]) :-
clear_model,
new_graph,
add_vertex('A'),
set_attribute('A', object),
set_attribute('A', item),
set_attribute('A', object),
command(add_vertex('A')),
command(set_attribute('A', object)),
command(set_attribute('A', item)),
command(set_attribute('A', object)),
get_current_graph(GraphId),
find_item([parent: GraphId, kind: vertex, key: 'A', id: VertexId]),
all_items([parent: VertexId, kind: attribute], Attributes).
......@@ -100,10 +118,9 @@ test('set_attribute vertex', [true(Attributes == ['object', 'item'])]) :-
test('set_attribute edge', [true(Attributes == [stochiometry: 2])]) :-
clear_model,
new_graph,
add_vertex('A'),
add_vertex('B'),
add_edge('A' -> 'B'),
set_attribute(('A' -> 'B'), stochiometry: 2),
command(add_vertex('A', 'B')),
command(add_edge('A' -> 'B')),
command(set_attribute(('A' -> 'B'), stochiometry: 2)),
get_current_graph(GraphId),
find_item([parent: GraphId, kind: edge, key: ('A' -> 'B'), id: EdgeId]),
all_items([parent: EdgeId, kind: attribute], Attributes).
......@@ -111,9 +128,9 @@ test('set_attribute edge', [true(Attributes == [stochiometry: 2])]) :-
test('place', [true(Attributes == [kind: place])]) :-
clear_model,
new_graph,
transition('A'),
place('A'),
transition('B'),
command(transition('A')),
command(place('A')),
command(transition('B')),
get_current_graph(GraphId),
find_item([parent: GraphId, kind: vertex, key: 'A', id: VertexId]),
all_items([parent: VertexId, kind: attribute], Attributes).
......@@ -121,9 +138,9 @@ test('place', [true(Attributes == [kind: place])]) :-
test('transition', [true(Attributes == [kind: transition])]) :-
clear_model,
new_graph,
place('A'),
transition('A'),
place('B'),
command(place('A')),
command(transition('A')),
command(place('B')),
get_current_graph(GraphId),
find_item([parent: GraphId, kind: vertex, key: 'A', id: VertexId]),
all_items([parent: VertexId, kind: attribute], Attributes).
......@@ -131,9 +148,9 @@ test('transition', [true(Attributes == [kind: transition])]) :-
test('delete_attribute', [true(Attributes == [])]) :-
clear_model,
new_graph,
add_vertex('A'),
set_attribute('A', object),
delete_attribute('A', object),
command(add_vertex('A')),
command(set_attribute('A', object)),
command(delete_attribute('A', object)),
get_current_graph(GraphId),
find_item([parent: GraphId, kind: vertex, key: 'A', id: VertexId]),
all_items([parent: VertexId, kind: attribute], Attributes).
......@@ -141,22 +158,22 @@ test('delete_attribute', [true(Attributes == [])]) :-
test('list_attributes vertex', [true(Atom == '[0] kind:place\n')]) :-
clear_model,
new_graph,
place('A'),
command(place('A')),
with_output_to(atom(Atom), list_attributes('A')).
test('list_attributes edge', [true(Atom == '[0] stochiometry:2\n')]) :-
clear_model,
new_graph,
add_vertex('A'),
add_vertex('B'),
add_edge('A' -> 'B'),
set_attribute(('A' -> 'B'), stochiometry: 2),
command(add_vertex('A')),
command(add_vertex('B')),
command(add_edge('A' -> 'B')),
command(set_attribute(('A' -> 'B'), stochiometry: 2)),
with_output_to(atom(Atom), list_attributes('A' -> 'B')).
test('get_attribute', [true(Kind == transition)]) :-
clear_model,
new_graph,
transition('A'),
command(transition('A')),
get_attribute('A', kind: Kind).
:- end_tests(graph_editor).
......@@ -29,6 +29,7 @@
all_ids/2,
list_items/1,
list_ids/1,
list_ids/2,
delete_item/1,
delete_items/1,
add_dependency/2
......@@ -510,6 +511,12 @@ list_ids(Ids) :-
list_ids(Options, Ids) :-
retractall(listed_item(_, _)),
set_counter(list_item_counter, 0),
list_ids_aux(Options, Ids).
list_ids_aux(Options, Ids) :-
optional(indent: Indent, Options),
default(Indent, 0),
(
......@@ -519,8 +526,6 @@ list_ids(Options, Ids) :-
;
Recursive = no
),
retractall(listed_item(_, _)),
set_counter(list_item_counter, 0),
\+ (
member(Id, Ids),
\+ (
......@@ -533,7 +538,8 @@ list_ids(Options, Ids) :-
Recursive = yes
->
SubIndent is Indent + 1,
list_items([indent: SubIndent, recursive, parent: Id | Options])
all_ids([parent: Id | Options], SubIds),
list_ids_aux([indent: SubIndent, recursive | Options], SubIds)
;
true
)
......
......@@ -3,8 +3,7 @@
[
reaction_graph/0,
import_reactions_from_graph/0,
draw_reactions/0,
export_dot/1
draw_reactions/0
]
).
......@@ -24,11 +23,11 @@ reaction_graph :-
\+ (
count(reaction, ReactionCount),
format(atom(ReactionCounter), 'reaction~d', [ReactionCount]),
transition(ReactionCounter),
transition([ReactionCounter]),
(
Reversible = yes
->
set_attribute(ReactionCounter, reversible: Reversible)
set_attribute([ReactionCounter], reversible: Reversible)
;
true
),
......@@ -37,7 +36,7 @@ reaction_graph :-
->
true
;
set_attribute(ReactionCounter, kinetics: Kinetics)
set_attribute([ReactionCounter], kinetics: Kinetics)
),
\+ (
(
......@@ -50,8 +49,8 @@ reaction_graph :-
To = Object
),
\+ (
place(Object),
add_edge(From -> To),
place([Object]),
add_edge([From -> To]),
(
get_attribute((From -> To), stochiometry: OldStochiometry)
->
......@@ -63,12 +62,12 @@ reaction_graph :-
NewStochiometry = 1
->
catch(
delete_attribute((From -> To), stochiometry),
delete_attribute([From -> To], stochiometry),
error(unknown_item),
true
)
;
set_attribute((From -> To), stochiometry: NewStochiometry)
set_attribute([From -> To], stochiometry: NewStochiometry)
)
)
)
......@@ -90,12 +89,6 @@ draw_reactions :-
doc('').
export_dot(InputFile) :-
biocham_command,
type(InputFile, input_file),
doc('').
:- dynamic(vertex_transition/1).
......
......@@ -101,20 +101,7 @@ check_type('*'(SubType), List, NewList) :-
check_type([SubType], List, NewList) :-
!,
findall(
NewItem,
(
member(Item, List),
(
check_type(SubType, Item, NewItem)
->
true
;
throw(error(failure))
)
),
NewList
).
check_type_list(List, SubType, NewList).
check_type(Grammar, Item, NewItem) :-
(
......@@ -129,7 +116,11 @@ check_type(Grammar, Item, NewItem) :-
(
clause(NewHead, NewBody),
copy_term((NewHead, NewBody), (Head, Body)),
check_grammar_body(Body, NewBody)
catch(
check_grammar_body(Body, NewBody),
error(expected(_)),
fail
)
->
true
;
......@@ -137,6 +128,13 @@ check_type(Grammar, Item, NewItem) :-
).
check_type_list([], _Type, []).
check_type_list([HeadIn| TailIn], Type, [HeadOut | TailOut]) :-
check_type(Type, HeadIn, HeadOut),
check_type_list(TailIn, Type, TailOut).
check_atom(Atom, NewAtom) :-
format(atom(NewAtom), '~w', [