Commit 3eb4b414 authored by Thierry Martinez's avatar Thierry Martinez
parents 4beba5d4 034cbcf0
......@@ -559,6 +559,19 @@ write_argument(Argument, Doc) :-
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, ValueId, Value, NameId, Name, ValueId, Value]
)
;
Type = '*'(Name: Value)
->
make_id(Name, NameId),
make_id(Value, ValueId),
format(
Doc,
'<a href="#~a">~a</a><sub>1</sub>: <a href="#~a">~a</a><sub>1</sub>,
...,
<a href="#~a">~a</a><sub><var>n</var></sub>:
<a href="#~a">~a</a><sub><var>n</var></sub>',
[NameId, Name, ValueId, Value, NameId, Name, ValueId, Value]
)
;
Type = '*'([Name])
->
......
......@@ -54,7 +54,8 @@ write_headers(Options) :-
write_header('VARIABLE_COUNT', '~d', VariableCount),
write_header('PARAMETER_COUNT', '~d', ParameterCount),
write_option('METHOD', '~a', method, Options),
write_option('ERROR_EPSILON', '~f', error_epsilon, Options),
write_option('ERROR_EPSILON_ABSOLUTE', '~f', error_epsilon_absolute, Options),
write_option('ERROR_EPSILON_RELATIVE', '~f', error_epsilon_relative, Options),
write_option('INITIAL_STEP_SIZE', '~f', initial_step_size, Options),
write_option('TIME_INITIAL', '~f', time_initial, Options),
write_option('TIME_FINAL', '~f', time_final, Options).
......
......@@ -2,26 +2,30 @@
:- begin_tests(gsl).
test('van_der_pol', [
true((
Table = [FirstRow | OtherRows],
append(_, [LastRow], OtherRows),
FirstRow = row(FirstTimeStamp, _, _),
LastRow = row(LastTimeStamp, _, _),
FirstTimeStamp < 1e-5,
LastTimeStamp == 100.0
))]) :-
test('van_der_pol') :-
Options = [
equations: [[1], -[0] + p(0) * [1] * (1 - [0] ^ 2)],
initial_values: [1.0, 0.0],
initial_parameter_values: [10],
method: gsl_odeiv2_step_rk8pd,
error_epsilon: 1e-6,
error_epsilon_absolute: 1e-6,
error_epsilon_relative: 1e-6,
initial_step_size: 1e-6,
precision: 5,
time_initial: 0,
time_final: 100
],
solve(Options, Table).
solve(Options, Table),
(
append(_, [LastRow], Table),
LastRow = row(LastTimeStamp, _, _),
LastTimeStamp == 100.0
->
true
;
print(Table),
nl,
fail
).
:- end_tests(gsl).
......@@ -11,7 +11,8 @@
with_influence_model/1,
list_model_influences/0,
influence/6,
compute_ode_for_influence_model/0
compute_ode_for_influence_model/0,
print_influence/2
]
).
......@@ -83,6 +84,11 @@ is_influence_model :-
check_influence_model :-
devdoc('
succeeds if the current model is an influence model
(i.e., does not contain any reaction rules)
and throws an exception otherwise.
'),
(
is_influence_model
->
......@@ -120,9 +126,10 @@ list_model_influences :-
(auxiliary predicate of list_model).
'),
\+ (
item([no_inheritance, kind: influence, item: Influence]),
item([no_inheritance, kind: influence, id: Id, item: Influence]),
\+ (
format('~w.\n', [Influence])
print_influence(Id, Influence),
write('.\n')
)
).
......@@ -171,6 +178,37 @@ compute_ode_for_influence_model :-
).
print_influence(_Id, Item) :-
(
Item = (Force for BasicInfluence)
->
format('~w for ', [Force])
;
BasicInfluence = Item
),
(
BasicInfluence = (Inputs -> Output)
->
Arrow = '->'
;
BasicInfluence = (Inputs -< Output)
->
Arrow = '-<'
),
(
Inputs = (PositiveInputs / NegativeInputs)
->
format('~w / ~w', [PositiveInputs, NegativeInputs])
;
Inputs = (/ NegativeInputs)
->
format('/ ~w', [NegativeInputs])
;
write(Inputs)
),
format(' ~w ~w', [Arrow, Output]).
:- devdoc('\\section{Private predicates}').
......@@ -239,18 +277,18 @@ inputs(PositiveInputEnum, PositiveInputList, []) :-
->
true
;
PositiveInputEnum \= (_ \ _),
PositiveInputEnum \= (\ _)
PositiveInputEnum \= (_ / _),
PositiveInputEnum \= (/ _)
),
list_enumeration(PositiveInputList, PositiveInputEnum),
!.
inputs(\ NegativeInputEnum, [], NegativeInputList) :-
inputs(/ NegativeInputEnum, [], NegativeInputList) :-
list_enumeration(NegativeInputList, NegativeInputEnum),
!.
inputs(
PositiveInputEnum \ NegativeInputEnum,
PositiveInputEnum / NegativeInputEnum,
PositiveInputList,
NegativeInputList
) :-
......
......@@ -6,12 +6,12 @@
test(
'add_influence',
[Influences == [(a, b \ c -> d), (b -< c), (\ a -< a)]]
[Influences == [((a, b) / c -> d), (b -< c), (/ a -< a)]]
) :-
clear_model,
command((a, b \ c -> d)),
command((a, b / c -> d)),
command(b -< c),
command(\ a -< a),
command(/ a -< a),
all_items([kind: influence], Influences).
test(
......@@ -40,7 +40,7 @@ test(
test(
'influence builds',
[Influence == (2 for a, b \ c -> d)]
[Influence == (2 for (a, b) / c -> d)]
) :-
influence(Influence, 2, [a, b], [c], +, d).
......@@ -52,7 +52,7 @@ test(
test(
'influence builds with negative inputs',
[Influence == (\ a -< a)]
[Influence == (/ a -< a)]
) :-
influence(Influence, 'MA'(1), [], [a], -, a).
......@@ -71,7 +71,7 @@ test(
]
) :-
influence(
(2 for a, b \ c -> d),
(2 for (a, b) / c -> d),
Force,
PositiveInputs,
NegativeInputs,
......@@ -97,7 +97,7 @@ test(
result('MA'(1), [], [a], -, a)
]
) :-
influence((\ a -< a), Force, PositiveInputs, NegativeInputs, Sign, Output).
influence((/ a -< a), Force, PositiveInputs, NegativeInputs, Sign, Output).
test(
'compute_ode_for_influence_model',
......
:- module(
influence_rules,
[
influence_predicate/1,
% Grammars
influence/1,
basic_influence/1,
inputs/1,
enumeration/1,
op(1050, xfx, (->)),
op(1050, xfx, (-<)),
op(1025, xfx, (\)),
op(1025, fx, (\))
op(1025, fx, (/)),
% Public API
influence_predicate/1,
patch_inputs/2
]
).
influence_predicate(_ for Reaction) :-
influence_predicate(Reaction).
influence_predicate(_ -> _).
influence_predicate(_ -< _).
:- devdoc('\\section{Grammars}').
:- grammar(influence).
......@@ -49,12 +46,12 @@ basic_influence(Inputs -< Output) :-
:- grammar(inputs).
inputs(PositiveInputs \ NegativeInputs) :-
inputs(PositiveInputs / NegativeInputs) :-
enumeration(PositiveInputs),
enumeration(NegativeInputs).
inputs(\ NegativeInputs) :-
inputs(/ NegativeInputs) :-
enumeration(NegativeInputs).
......@@ -75,3 +72,24 @@ enumeration((A, B)) :-
enumeration(A) :-
object(A).
:- devdoc('\\section{Public API}').
influence_predicate(_ for Reaction) :-
influence_predicate(Reaction).
influence_predicate(_ -> _).
influence_predicate(_ -< _).
patch_inputs((A / B, C), A / (B, C)) :-
!.
patch_inputs((A, B), (A, B0) / B1) :-
patch_inputs(B, B0 / B1),
!.
patch_inputs(Inputs, Inputs).
:- module(
initial_state,
[
get_initial_state/2,
get_initial_concentration/2,
% Commands
list_initial_state/0,
clear_initial_state/0,
present/1,
......@@ -10,48 +9,16 @@
absent/1,
undefined/1,
make_absent_not_present/0,
make_present_not_absent/0
make_present_not_absent/0,
% Public API
get_initial_state/2,
get_initial_concentration/2,
list_model_initial_state/0
]
).
get_initial_state(Object, State) :-
(
item([kind: initial_state, key: Object, item: Item])
->
(
Item = present(Object)
->
State = present(1)
;
Item = present(Object, Concentration)
->
(
Concentration = 0
->
State = absent
;
State = present(Concentration)
)
;
Item = absent(Object)
->
State = absent
)
;
State = undefined
).
get_initial_concentration(Object, Concentration) :-
get_initial_state(Object, State),
(
State = present(Concentration)
->
true
;
Concentration = 0
).
:- devdoc('\\section{Commands}').
list_initial_state :-
......@@ -99,16 +66,6 @@ absent(ObjectSet) :-
set_state(ObjectSet, Object, absent(Object)).
set_state(ObjectSet, Object, State) :-
\+ (
member(Object, ObjectSet),
\+ (
undefined_object(Object),
add_item([kind: initial_state, key: Object, item: State])
)
).
undefined(ObjectSet) :-
biocham_command,
type(ObjectSet, {object}),
......@@ -123,16 +80,6 @@ undefined(ObjectSet) :-
).
undefined_object(Object) :-
(
item([kind: initial_state, key: Object, id: Id])
->
delete_item(Id)
;
true
).
make_present_not_absent :-
biocham_command,
doc('
......@@ -163,5 +110,84 @@ make_absent_not_present :-
).
:- devdoc('\\section{Public API}').
get_initial_state(Object, State) :-
(
item([kind: initial_state, key: Object, item: Item])
->
(
Item = present(Object)
->
State = present(1)
;
Item = present(Object, Concentration)
->
(
Concentration = 0
->
State = absent
;
State = present(Concentration)
)
;
Item = absent(Object)
->
State = absent
)
;
State = undefined
).
get_initial_concentration(Object, Concentration) :-
get_initial_state(Object, State),
(
State = present(Concentration)
->
true
;
Concentration = 0
).
list_model_initial_state :-
devdoc('
lists the initial state in a loadable syntax
(auxiliary predicate of list_model).
'),
\+ (
item([no_inheritance, kind: initial_state, item: InitialState]),
\+ (
format('~w.\n', [InitialState])
)
).
:- devdoc('\\section{Private predicates}').
set_state(ObjectSet, Object, State) :-
\+ (
member(Object, ObjectSet),
\+ (
undefined_object(Object),
add_item([kind: initial_state, key: Object, item: State])
)
).
undefined_object(Object) :-
(
item([kind: initial_state, key: Object, id: Id])
->
delete_item(Id)
;
true
).
defined(Object) :-
once(item([kind: initial_state, key: Object])).
......@@ -14,26 +14,26 @@ main(void)
double parameters[PARAMETER_COUNT];
const gsl_odeiv2_step_type *T = METHOD;
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc(T, VARIABLE_COUNT);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new(ERROR_EPSILON, 0.0);
gsl_odeiv2_evolve * e = gsl_odeiv2_evolve_alloc(VARIABLE_COUNT);
gsl_odeiv2_system sys = {functions, jacobian, VARIABLE_COUNT, parameters};
gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new(
&sys, METHOD, INITIAL_STEP_SIZE, ERROR_EPSILON_ABSOLUTE,
ERROR_EPSILON_RELATIVE);
double t = TIME_INITIAL;
double h = INITIAL_STEP_SIZE;
double x[VARIABLE_COUNT];
gsl_odeiv2_step_set_driver(s, d);
gsl_odeiv2_driver_set_nmax(d, 1);
initial_values(x);
initial_parameter_values(parameters);
print_headers(csv);
while (t < TIME_FINAL) {
int status = gsl_odeiv2_evolve_apply(
e, c, s, &sys, &t, TIME_FINAL, &h, x);
if (status != GSL_SUCCESS) {
int status = gsl_odeiv2_driver_apply(d, &t, TIME_FINAL, x);
if (status != GSL_SUCCESS && status != GSL_EMAXITER) {
fprintf(stderr, "error, return value=%d\n", status);
return EXIT_FAILURE;
}
print(csv, t, x);
}
gsl_odeiv2_evolve_free(e);
gsl_odeiv2_control_free(c);
gsl_odeiv2_driver_free(d);
gsl_odeiv2_step_free(s);
return EXIT_SUCCESS;
}
......@@ -39,6 +39,7 @@
list_items/1,
list_ids/1,
list_ids/2,
print_item/1,
delete_item/1,
delete_items/1,
add_dependency/2,
......@@ -195,6 +196,7 @@ list_model :-
->
list_model_influences
),
list_model_initial_state,
list_model_parameters,
list_model_functions.
......@@ -489,6 +491,19 @@ list_ids(Options, Ids) :-
list_ids_aux(Options, Ids).
print_item(Id) :-
item(Id, _Parent, Kind, Item),
(
atom_concat('print_', Kind, F),
G =.. [F, Id, Item],
predicate_property(G, visible)
->
G
;
write(Item)
).
delete_item(Options) :-
list(Options),
!,
......@@ -702,7 +717,6 @@ list_ids_aux(Options, Ids) :-
\+ (
member(Id, Ids),
\+ (
item(Id, _, _, Item),
indent(Indent),
(
selection(_, _, Id)
......@@ -720,7 +734,9 @@ list_ids_aux(Options, Ids) :-
assertz(listed_item(Counter, Id)),
format('[~d]', [Counter])
),
format('~a~w\n', [Selected, Item]),
write(Selected),
print_item(Id),
nl,
(
Recursive = yes
->
......
......@@ -50,9 +50,10 @@ solve(Time) :-
initial_values: InitialValues,
initial_parameter_values: InitialParameterValues,
method: gsl_odeiv2_step_rk8pd,
error_epsilon: 1e-6,
error_epsilon_absolute: 1e-6,
error_epsilon_relative: 1e-6,
initial_step_size: 1e-6,
precision: 5,
precision: 6,
time_initial: 0,
time_final: Time
],
......
......@@ -155,7 +155,6 @@ list_ode :-
'),
biocham_silent(clear_model),
biocham(a => b),
biocham(ode_system),
biocham(list_ode),
doc('
\\end{example}
......
......@@ -24,6 +24,7 @@
** Numerical temporal properties
* Commands at Top-level
- toplevel.pl
- options.pl
** Loading, listing, importing and exporting models
*** Biocham files
- models.pl
......
......@@ -122,6 +122,12 @@ check_type('='(LeftType, RightType), Equal, NewLeft = NewRight) :-
check_type(LeftType, Left, NewLeft),
check_type(RightType, Right, NewRight).
check_type(':'(LeftType, RightType), Equal, (NewLeft: NewRight)) :-
!,
Equal = (Left: Right),
check_type(LeftType, Left, NewLeft),
check_type(RightType, Right, NewRight).
check_type({SubType}, Set, NewList) :-
!,
set_to_list(Set, List),
......@@ -140,6 +146,10 @@ check_type(Grammar, Item, NewItem) :-
Grammar = solution
->
patch_solution(Item, Item0)
;
Grammar = inputs
->
patch_inputs(Item, Item0)
;
Item0 = Item
),
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment