Commit c25dc2eb authored by Thierry Martinez's avatar Thierry Martinez

at_delete

parent d0ca9607
:- module(
foltl,
[
foltl/1,
foltl_predicate/1,
foltl_expression/1,
validity_domain/1,
validity_domain/2,
op(700, xfy, '<>'),
......@@ -13,6 +16,97 @@
:- devdoc('\\section{Commands}').
:- grammar(foltl).
foltl('X'(E)) :-
foltl(E).
foltl('F'(E)) :-
foltl(E).
foltl('G'(E)) :-
foltl(E).
foltl(not(E)) :-
foltl(E).
foltl('U'(E, F)) :-
foltl(E),
foltl(F).
foltl('W'(E, F)) :-
foltl(E),
foltl(F).
foltl(E /\ F) :-
foltl(E),
foltl(F).
foltl(E \/ F) :-
foltl(E),
foltl(F).
foltl(E) :-
foltl_predicate(E).
:- grammar(foltl_predicate).
foltl_predicate(E = F) :-
foltl_expression(E),
foltl_expression(F).
foltl_predicate(E <> F) :-
foltl_expression(E),
foltl_expression(F).
foltl_predicate(E < F) :-
foltl_expression(E),
foltl_expression(F).
foltl_predicate(E <= F) :-
foltl_expression(E),
foltl_expression(F).
foltl_predicate(E > F) :-
foltl_expression(E),
foltl_expression(F).
foltl_predicate(E >= F) :-
foltl_expression(E),
foltl_expression(F).
foltl_expression(E + F) :-
foltl_expression(E),
foltl_expression(F).
foltl_expression(E - F) :-
foltl_expression(E),
foltl_expression(F).
foltl_expression(E * F) :-
foltl_expression(E),
foltl_expression(F).
foltl_expression(E / F) :-
foltl_expression(E),
foltl_expression(F).
foltl_expression(E) :-
number(E).
foltl_expression(E) :-
name(E).
validity_domain(Formula) :-
biocham_command,
type(Formula, foltl),
......@@ -30,7 +124,8 @@ validity_domain(Formula) :-
validity_domain(Formula, Domain) :-
ExecutableFilename = 'check',
generate_cpp_file(Formula, 'check.inc'),
expand_formula(Formula, ExpandedFormula),
generate_cpp_file(ExpandedFormula, 'check.inc'),
compile_cpp_program(ExecutableFilename),
export_table('check.csv'),
call_subprocess(
......@@ -48,6 +143,56 @@ validity_domain(Formula, Domain) :-
:- devdoc('\\section{Private predicates}').
expand_formula(not(Formula), ExpandedFormula) :-
!,
negate_formula(Formula, NegatedFormula),
expand_formula(NegatedFormula, ExpandedFormula).
expand_formula(Formula, ExpandedFormula) :-
function_apply(Formula, NewBody),
!,
expand_formula(NewBody, ExpandedFormula).
expand_formula(Formula, ExpandedFormula) :-
term_morphism(foltl:expand_formula, Formula, ExpandedFormula).
negate_formula(A <= B, A > B).
negate_formula(A > B, A <= B).
negate_formula(A >= B, A < B).
negate_formula(A < B, A >= B).
negate_formula(not(A), A).
negate_formula('X'(A), 'X'(NotA)) :-
negate_formula(A, NotA).
negate_formula('F'(A), 'G'(NotA)) :-
negate_formula(A, NotA).
negate_formula('G'(A), 'F'(NotA)) :-
negate_formula(A, NotA).
negate_formula('U'(A, B), 'W'(NotB, NotA)) :-
negate_formula(A, NotA),
negate_formula(B, NotB).
negate_formula('W'(A, B), 'U'(NotB, NotA)) :-
negate_formula(A, NotA),
negate_formula(B, NotB).
negate_formula(A \/ B, NotA /\ NotB) :-
negate_formula(A, NotA),
negate_formula(B, NotB).
negate_formula(A /\ B, NotA \/ NotB) :-
negate_formula(A, NotA),
negate_formula(B, NotB).
generate_cpp_file(Formula, Filename) :-
setup_call_cleanup(
open(Filename, write, Stream),
......@@ -241,6 +386,28 @@ generate_expression(A) :-
!,
format('(*i)[~d]', [Index]).
generate_expression(Expression) :-
binary_operator(Expression, A, Op, B),
!,
generate_expression_with_parentheses(A),
write(Op),
generate_expression_with_parentheses(B).
binary_operator(A + B, A, '+', B).
binary_operator(A - B, A, '-', B).
binary_operator(A * B, A, '*', B).
binary_operator(A / B, A, '/', B).
generate_expression_with_parentheses(A) :-
write('('),
generate_expression(A),
write(')').
has_variable(A) :-
free_variable(A, _Index).
......@@ -286,6 +453,12 @@ declare_free_variables_expression(X) :-
format(' PPL::Variable x~d(~d);\n', [Index, Index])
).
declare_free_variables_expression(Expression) :-
binary_operator(Expression, A, _Op, B),
!,
declare_free_variables_expression(A),
declare_free_variables_expression(B).
declare_formula(Formula) :-
(
......@@ -417,11 +590,35 @@ reformat_domain_conjunction((A0, B0), A1 /\ B1) :-
reformat_domain_conjunction(B0, B1).
reformat_expression(-E0, -E1) :-
!,
reformat_expression(E0, E1).
reformat_expression(E0 + F0, E1 + F1) :-
!,
reformat_expression(E0, E1),
reformat_expression(F0, F1).
reformat_expression(E0 - F0, E1 - F1) :-
!,
reformat_expression(E0, E1),
reformat_expression(F0, F1).
reformat_expression(E0 * F0, E1 * F1) :-
!,
reformat_expression(E0, E1),
reformat_expression(F0, F1).
reformat_expression(E0 / F0, E1 / F1) :-
!,
reformat_expression(E0, E1),
reformat_expression(F0, F1).
reformat_expression(Number, Number) :-
number(Number),
!.
reformat_expression(DimensionName, ColumnName) :-
reformat_expression(DimensionName, X) :-
atom(DimensionName),
!,
atom_length(DimensionName, NameLength),
......@@ -435,8 +632,7 @@ reformat_expression(DimensionName, ColumnName) :-
;
letter_index(DimensionName, Index)
),
get_current_table(Table),
once(columns(Table, Index, ColumnName)).
once(free_variable(X, Index)).
letter_index(Letter, Index) :-
......
......@@ -2,20 +2,20 @@
:- begin_tests(foltl).
test('validity_domain F', [true(Domain == ('x' >= 10))]) :-
test('validity_domain F', [true(Domain == (v >= 10))]) :-
clear_model,
add_table(table, [row('#x'), row(20), row(10), row(30), row(15)]),
validity_domain('F'('x' <= 'v'), Domain).
test(
'validity_domain =',
[true(Domain == (x = 15 \/ x = 30 \/ x = 10 \/ x = 20))]
[true(Domain == (v = 15 \/ v = 30 \/ v = 10 \/ v = 20))]
) :-
clear_model,
add_table(table, [row('#x'), row(20), row(10), row(30), row(15)]),
validity_domain('F'(x = v), Domain).
test('validity_domain X', [true(Domain == (x = 30 \/ x = 10))]) :-
test('validity_domain X', [true(Domain == (v = 30 \/ v = 10))]) :-
clear_model,
add_table(table, [row('#x'), row(20), row(10), row(30), row(15)]),
validity_domain('F'(x = v /\ 'X'(x > 10)), Domain).
......
......@@ -5,10 +5,15 @@
show_function/1,
list_functions/0,
delete_function/1,
function_apply/2,
op(1010, fx, function)
]
).
:- devdoc('\\section{Commands}').
function(FunctionList) :-
biocham_command(*),
type(FunctionList, '*'(function_prototype = term)),
......@@ -56,3 +61,24 @@ delete_function(FunctorSet) :-
delete_item([kind: function, key: Functor])
)
).
:- devdoc('\\section{Public API}').
function_apply(FunctionApplication, NewBody) :-
callable(FunctionApplication),
functor(FunctionApplication, Functor, Arity),
item([kind: function, key: Functor, item: (function(Head = Body))]),
!,
functor(Head, Functor, ApplicationArity),
(
Arity = ApplicationArity
->
true
;
throw(error(arity_mismatch(Functor, Arity, ApplicationArity)))
),
Head =.. [Functor | Parameters],
FunctionApplication =.. [Functor | Arguments],
substitute(Parameters, Arguments, Body, NewBody).
......@@ -34,21 +34,8 @@ kinetics(Reactants, product(Pattern in List, Expression), Value) :-
make_product(Reactants, S, O, Expression, Value).
kinetics(Reactants, FunctionApplication, Expression) :-
callable(FunctionApplication),
functor(FunctionApplication, Functor, Arity),
item([kind: function, key: Functor, item: (function(Head = Body))]),
function_apply(FunctionApplication, NewBody),
!,
functor(Head, Functor, ApplicationArity),
(
Arity = ApplicationArity
->
true
;
throw(error(arity_mismatch(Functor, Arity, ApplicationArity)))
),
Head =.. [Functor | Parameters],
FunctionApplication =.. [Functor | Arguments],
substitute(Parameters, Arguments, Body, NewBody),
kinetics(Reactants, NewBody, Expression).
kinetics(Reactants, Callable, Expression) :-
......
......@@ -38,7 +38,8 @@
inherits/2,
begin_command/0,
get_selection/2,
set_selection/2
set_selection/2,
at_delete/2
]
).
......@@ -672,11 +673,18 @@ delete_item(Options) :-
delete_item(Id) :-
\+ (
at_delete_goal(Id, Goal),
(
Goal
)
),
retract(item(Id, _Model, KindItem, _Item)),
retractall(key(_Key, Id)),
retractall(annotation(Id, _KindAnnotation, _Annotation)),
retractall(listed_item(_Index, Id)),
retractall(dependency(Id, _Master)),
retract_all(at_delete_goal(Id, _Goal)),
\+ (
item(SubId, Id, _SubKind, _SubItem),
\+ (
......@@ -844,3 +852,9 @@ set_selection(SelectionName, IdsOrOptions) :-
assertz(selection(SelectionName, Id))
)
).
:- dynamic(at_delete_goal/2).
at_delete(Id, Goal) :-
assertz(at_delete_goal(Id, Goal)).
......@@ -67,7 +67,7 @@ gather_headers(Headers) :-
(
between(0, VariableMax, VariableIndex),
variable(Molecule, VariableIndex),
format(atom(Header), '[~a]', [Molecule])
format(atom(Header), '~a', [Molecule])
),
Headers
).
......
......@@ -228,7 +228,29 @@ declare_column(Id, ColumnIndex, Name) :-
add_item(
[parent: Id, kind: column, key: ColumnIndex, item: Name, id: ColumnId]
),
set_annotation(ColumnId, index, ColumnIndex).
set_annotation(ColumnId, index, ColumnIndex),
at_delete(ColumnId, tables:perform_column_delete(Id, ColumnIndex)).
perform_column_delete(Id, ColumnIndex) :-
(
get_annotation(Id, data, Data)
->
findall(
NewRow,
(
member(Row, Data),
Row =.. [row, RowItems],
nth1(ColumnIndex, RowItems, _Deleted, NewRowItems),
NewRow =.. [row, NewRowItems]
),
NewData
),
set_annotation(Id, data, NewData)
;
true
).
default_column_name(ColumnIndex, Name) :-
format(atom(Name), 'column~d', [ColumnIndex]).
......
......@@ -4,6 +4,7 @@
]
).
infer(A + B, AUnit) :-
infer(A, AUnit),
infer(B, BUnit),
......@@ -40,3 +41,6 @@ check_homogeneous(AUnit, BUnit) :-
;
throw(error(not_homogeneous(A, AUnit, B, BUnit)))
).
product_unit(AUnit, BUnit, Unit) :-
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