starting to check conservations for real, and more tests

conservation_laws.pl

@@ -25,12 +25,12 @@ add_conservation(Conservation) :-
     caption might not be correct.'
   ),
   doc(
-    'When added, the conservation law will be checked against the rules (i.e.
-    purely from stoichiometry), if that fails against the kinetics. Since
-    these checks are not complete, even a failure will be accepted with a
-    warning.'
+    'When added, the conservation law will be checked against the reactions
+    (i.e. purely from stoichiometry), if that fails against the kinetics.
+    Since these checks are not complete, even a failure will be accepted with
+    a warning.'
   ),
-  solution_to_list(Conservation, C),
+  solution_to_conservation(Conservation, C),
   add_item(conservation, C).
 
 
@@ -38,7 +38,7 @@ delete_conservation(Conservation) :-
   biocham_command,
   type(Conservation, solution),
   doc('removes the given mass conservation law.'),
-  solution_to_list(Conservation, C),
+  solution_to_conservation(Conservation, C),
   find_item([model: current_model, id: Id, type: conservation, item: C]),
   delete_item(Id).
 
@@ -46,10 +46,9 @@ delete_conservation(Conservation) :-
 delete_conservations :-
   biocham_command,
   doc('removes all mass conservation laws.'),
-  \+ (
+  forall(
     item([model: current_model, kind: conservation, id: Id]),
-    delete_item(Id),
-    fail
+    delete_item(Id)
   ).
 
 
@@ -62,10 +61,13 @@ list_conservations :-
 check_conservations :-
   biocham_command,
   doc(
-    'checks all conservation laws against rules, and if necessary kinetics
+    'checks all conservation laws against reactions, and if necessary kinetics
     (see also \\command{add_conservation/1}).'
   ),
-  true.
+  forall(
+    item([model: current_model, kind: conservation, item: C]),
+    check_conservation(C)
+  ).
 
 
 search_conservations :-
@@ -85,4 +87,63 @@ search_conservations(Integer) :-
   true.
 
 
+%%% End of public API
+
+
+solution_to_conservation(Solution, Conservation) :-
+  devdoc('transforms a solution to a factorized list of coeff*object'),
+  reaction_editor:solution_to_list(Solution, List),
+  reaction_editor:simplify_solution(List, Conservation).
+
+
+check_conservation(C) :-
+  (
+    check_conserv_reactions(C)
+  ->
+    message('~w checked from reactions', [C])
+  ;
+    check_conserv_num(C)
+  ->
+    message('~w checked from kinetics', [C])
+  ;
+    message('~w trusted but not checked', [C]),
+    throw(error(unchecked_conservation_law(C)))
+  ).
+
+
+check_conserv_reactions(C) :-
+  forall(
+    (
+      item([model: current_model, kind: reaction, item: Item]),
+      reaction(Item, _Kinetics, Reactants, Products)
+    ),
+    (
+      scalar_conservation(Reactants, C, Moiety),
+      scalar_conservation(Products, C, Moiety)
+    )
+  ).
+
+
+check_conserv_num(_) :-
+  fail.
+
+
+scalar_conservation([], _, 0).
+
+scalar_conservation([K*M | L], C, Total) :-
+  (
+    member(I*M, C)
+  ->
+    true
+  ;
+    I = 0
+  ),
+  scalar_conservation(L, C, T1),
+  Total is I*K + T1.
+
+
+message(M, O) :-
+  format(M, O),
+  nl.
+
 % vi: set ts=2 sts=2 sw=2

conservation_laws.plt

@@ -21,9 +21,9 @@ test(
 test(
    'delete_conservation deletes the correct conservation',
    [
-      setup((models:clear_model, add_some_conservations)),
+      setup(set_some_conservations),
       cleanup(models:clear_model),
-      true(Conservations == [[1*'a-a', 2*'a'], [1*'c-c', 2*'c']])   
+      true(Conservations == [[1*'a-a', 2*'a'], [1*'c-c', 2*'c']])
    ]
 ) :-
    command(delete_conservation(b-b + 2*b)),
@@ -33,7 +33,7 @@ test(
 test(
    'delete_conservations deletes all conservations',
    [
-      setup((models:clear_model, add_some_conservations)),
+      setup(set_some_conservations),
       cleanup(models:clear_model),
       true(Conservations == [])
    ]
@@ -42,18 +42,30 @@ test(
    all_items([model: current_model, kind: conservation], Conservations).
 
 
+test(
+   'list_conservations lists all conservations',
+   [
+      setup(set_some_conservations),
+      cleanup(models:clear_model),
+      true(Conservations ==
+        '[0] [1*a-a,2*a]\n[1] [1*b-b,2*b]\n[2] [1*c-c,2*c]\n')
+   ]
+) :-
+  with_output_to(atom(Conservations), command(list_conservations)).
+
+
 test(
   'check_conservations is ok with trivial P-invariants',
   [
     setup(models:clear_model),
-    cleanup(models:clear_model),
-    blocked(not_implemented)
+    cleanup(models:clear_model)
   ]
 ) :-
   % not written 'a => b' to allow flycheck by separate compilation…
   command(add_reaction('=>'(a, b))),
+  command(add_reaction('=>'(b, a))),
   command(add_conservation(a + b)),
-  command(check_conservations).
+  with_output_to(atom(_), command(check_conservations)).
 
 
 test(
@@ -61,20 +73,21 @@ test(
   [
     setup(models:clear_model),
     cleanup(models:clear_model),
-    error(unproven_conservation_law([1*'a', 2*'b'])),
-    fixme(not_implemented)
+    throws(error(unchecked_conservation_law([1*'a', 2*'b'])))
   ]
 ) :-
   % not written 'a => b' to allow flycheck by separate compilation…
+  command(add_reaction('=>'(2*a, b))),
   command(add_reaction('=>'(a, b))),
   command(add_conservation(a + 2*b)),
-  command(check_conservations).
+  with_output_to(atom(_), command(check_conservations)).
 
 
-add_some_conservations :-
-   command(add_conservation(a-a + 2*a)),
-   command(add_conservation(b-b + 2*b)),
-   command(add_conservation(c-c + 2*c)).
+set_some_conservations :-
+  models:clear_model,
+  command(add_conservation(a-a + 2*a)),
+  command(add_conservation(b-b + 2*b)),
+  command(add_conservation(c-c + 2*c)).
 
 
 :- end_tests(conservation_laws).