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

Arithmetic simplification rules

parent a732dd58
......@@ -25,15 +25,33 @@ simplify(In, Out) :-
simplify_aux(In, Out) :-
additive_block(In, Blocks),
!,
simplify_blocks(additive_block, additive_index, rebuild_additive_coef, Blocks, CoefSubBlocks),
simplify_blocks(additive_block, additive_index, Blocks, ReducedSubBlocks),
maplist(rebuild_additive_coef, ReducedSubBlocks, CoefSubBlocks),
rebuild_additive_blocks(CoefSubBlocks, Out).
simplify_aux(In, Out) :-
multiplicative_block(In, Blocks),
!,
simplify_blocks(multiplicative_block, multiplicative_index, rebuild_multiplicative_coef, Blocks, CoefSubBlocks),
simplify_blocks(multiplicative_block, multiplicative_index, Blocks, ReducedSubBlocks),
map_blocks(rebuild_multiplicative_coef, ReducedSubBlocks, CoefSubBlocks),
compute_product(CoefSubBlocks, CoefSubBlocksComputed),
rebuild_multiplicative_blocks(CoefSubBlocksComputed, Out).
rebuild_multiplicative_blocks(CoefSubBlocksComputed, OutCoef),
(
extract_coefficient(OutCoef, Coef, SubOut),
Coef < 0
->
CoefOpp is - Coef,
(
CoefOpp = 1
->
OutOpp = SubOut
;
insert_coef(SubOut, CoefOpp, OutOpp)
),
Out = - OutOpp
;
Out = OutCoef
).
simplify_aux(log(exp(Expr)), Out) :-
!,
......@@ -75,7 +93,7 @@ simplify_aux(In, Out) :-
).
simplify_blocks(Block, Index, RebuildCoef, Blocks, CoefSubBlocks) :-
simplify_blocks(Block, Index, Blocks, ReducedSubBlocks) :-
gather_loop(Block, Blocks, SubBlocks),
maplist(Index, SubBlocks, IndexedSubBlocks),
sort(4, @=<, IndexedSubBlocks, SortedSubBlocks),
......@@ -85,8 +103,7 @@ simplify_blocks(Block, Index, RebuildCoef, Blocks, CoefSubBlocks) :-
arithmetic_rules:gather_indexed(SortedSubBlocks),
arithmetic_rules:reduce_blocks(IndexedSubBlocks, ReducedSubBlocks)
)
),
map_blocks(RebuildCoef, ReducedSubBlocks, CoefSubBlocks).
).
gather_loop(Block, Blocks, SubBlocks) :-
......@@ -103,30 +120,50 @@ gather_loop(Block, Blocks, SubBlocks) :-
compute_product([], []).
compute_product([+ N | T], Out) :-
number(N),
compute_product([B | T], Out) :-
block_number(B, N),
!,
compute_product_with_others(T, PT, Others),
P is N * PT,
P is PT * N,
(
P = 1
->
Out = Others
;
Out = [+ P | Others]
normalize_number(P, PNorm),
Out = [+ PNorm | Others]
).
compute_product([H | TIn], [H | TOut]) :-
compute_product(TIn, TOut).
block_number(B, N) :-
sign(B, Sign, C),
(
number(C),
V = C
;
C = M ^ E,
number(M),
V is M ^ E
),
(
Sign = 1
->
N = V
;
N is 1 / V
).
compute_product_with_others([], 1, []).
compute_product_with_others([+ N | T], P, Others) :-
number(N),
compute_product_with_others([B | T], P, Others) :-
block_number(B, N),
!,
compute_product_with_others(T, PT, Others),
P is N * PT.
P is PT * N.
compute_product_with_others([H | TIn], P, [H | TOut]) :-
compute_product_with_others(TIn, P, TOut).
......@@ -207,14 +244,39 @@ additive_index(H, index(Expr, Sign, Coef, Others, Canonical)) :-
canonical_expression(Others, Canonical).
extract_coefficient(C, C, 1) :-
number(C),
!.
extract_coefficient(- CA, COpp, A) :-
extract_coefficient(CA, C, A),
!,
COpp is - C.
extract_coefficient(+ CA, C, A) :-
extract_coefficient(CA, C, A),
!.
extract_coefficient(A * B, A, B) :-
number(A).
number(A),
!.
extract_coefficient(A / B, A, 1 / B) :-
number(A),
!.
extract_coefficient(A * B, B, A) :-
number(B).
number(B),
!.
extract_coefficient(A / B, BInv, A) :-
number(B),
!,
BInv is 1 / B.
extract_coefficient(CA * B, C, A * B) :-
extract_coefficient(CA, C, A).
extract_coefficient(CA, C, A),
!.
extract_coefficient(A * CB, C, A * B) :-
extract_coefficient(CB, C, B).
......@@ -261,23 +323,49 @@ canonical_expression(In, Out) :-
term_morphism(arithmetic_rules:canonical_expression, In, Out).
rebuild_additive_coef(Block, Value) :-
rebuild_additive_coef(SignedBlock, Value) :-
sign(SignedBlock, Sign, Block),
(
Block = (Coef : Expr)
->
SignedCoef is Sign * Coef,
(
Coef = 1
SignedCoef = 1
->
Value = Expr
Value = + Expr
;
Expr = 1
->
Value = Coef
Value = + SignedCoef
;
insert_coef(Expr, Coef, Value)
(
extract_coefficient(Expr, OtherCoef, SubExpr)
->
FullCoef is SignedCoef * OtherCoef
;
FullCoef = SignedCoef,
SubExpr = Expr
),
(
FullCoef < 0
->
NewSign = -1,
NewCoef is - FullCoef
;
NewSign = 1,
NewCoef = FullCoef
),
(
NewCoef = 1
->
UnsignedValue = SubExpr
;
insert_coef(SubExpr, NewCoef, UnsignedValue)
),
sign(Value, NewSign, UnsignedValue)
)
;
Value = Block
Value = + Block
).
......@@ -285,7 +373,18 @@ insert_coef(A * B, Coef, Result * B) :-
!,
insert_coef(A, Coef, Result).
insert_coef(A, Coef, Coef * A).
insert_coef(A, Coef, Result) :-
(
Coef > 0,
Coef < 1
->
CoefInv is 1 / Coef,
normalize_number(CoefInv, CoefInvNorm),
Result = A / CoefInvNorm
;
normalize_number(Coef, CoefNorm),
Result = CoefNorm * A
).
rebuild_multiplicative_coef(Block, Value) :-
......@@ -423,6 +522,9 @@ additive_block(A + B, [+A, +B]).
additive_block(A - B, [+A, -B]).
multiplicative_block(+ A, [+A]).
multiplicative_block(- A, [+(-1), +A]).
multiplicative_block(A * B, [+A, +B]).
......@@ -591,3 +693,18 @@ always_positive(A / B) :-
always_positive(A / B) :-
always_negative(A),
always_negative(B).
normalize_number(N, Norm) :-
(
F is float_fractional_part(N),
(
F = 0
;
F = 0.0
)
->
Norm is truncate(N)
;
Norm = N
).
......@@ -12,7 +12,7 @@ test('dx/dt(x^2) = 2x', [true(E == 2 * x)]) :-
derivate(x ^ 2, x, E).
test('dx/dt(cos(sqrt(x))) = - 0.5 / sqrt(x) * sin(sqrt(x))',
[true(E == - (0.5 / sqrt(x)) * sin(sqrt(x)))]) :-
[true(E == - (1 / sqrt(x) / 2 * sin(sqrt(x))))]) :-
derivate(cos(sqrt(x)), x, E).
:- end_tests(formal_derivation).
......@@ -223,10 +223,10 @@ sign(+, Force, Force).
influence_model(ReactionModel, InfluenceModel) :-
\+ (
item([parent: ReactionModel, kind: reaction, item: Reaction]),
reaction(Reaction, _Kinetics, Reactants, Products),
reaction(Reaction, Kinetics, Reactants, Products),
\+ (
substract_list(Reactants, Products, Difference),
create_influences(Reactants, Difference, InfluenceModel)
create_influences(Reactants, Difference, Kinetics, InfluenceModel)
)
).
......@@ -251,22 +251,26 @@ substract_list([Coefficient0 * Object | Tail], Products, Difference) :-
).
create_influences(Reactants, Difference, InfluenceModel) :-
create_influences(Reactants, Difference, Kinetics, InfluenceModel) :-
\+ (
member(_ * Input, Reactants),
findall(
Input,
member(_ * Input, Reactants),
PositiveInputs
),
member(Coefficient * Output, Difference),
\+ (
(
Coefficient > 0
->
add_item(
[parent: InfluenceModel, kind: influence, item: (Input -> Output)]
)
Sign = +,
simplify(Coefficient * Kinetics, CoefficientKinetics)
;
add_item(
[parent: InfluenceModel, kind: influence, item: (Input -< Output)]
)
)
Sign = -,
simplify(- Coefficient * Kinetics, CoefficientKinetics)
),
influence(Influence, CoefficientKinetics, PositiveInputs, [], Sign, Output),
add_item([parent: InfluenceModel, kind: influence, item: Influence])
)
).
......
......@@ -28,8 +28,8 @@ test(
Influences
==
[
(a -< b), (a -< a), (a -> c), (a -> d),
(b -< b), (b -< a), (b -> c), (b -> d)
(a, b -< b), (a, b -< a),
(a, b -> c), (a, b -> d)
]
]
) :-
......
......@@ -100,37 +100,42 @@ update_identifier_kinds(ModelId) :-
assertz(identifier_kind(ModelId, Object, function))
)
),
enumerate_objects_and_free(ModelId, reaction),
enumerate_objects_and_free(ModelId, influence),
\+ (
item([kind: reaction, item: Reaction]),
directly_inherits_from(SubModelId, ModelId),
\+ (
update_identifier_kinds(SubModelId)
)
).
:- devdoc('\\section{Private predicates}').
enumerate_objects_and_free(ModelId, Kind) :-
\+ (
item([parent: ModelId, kind: Kind, item: Item]),
\+ (
grammar_iter(
reaction,
Kind,
[object: namespace:set_kind(ModelId, object)],
Reaction
Item
)
)
),
\+ (
item([kind: reaction, item: Reaction]),
item([parent: ModelId, kind: Kind, item: Item]),
\+ (
grammar_iter(
reaction,
Kind,
[name: namespace:set_kind_if_not_set(ModelId, free)],
Reaction
Item
)
)
),
\+ (
directly_inherits_from(SubModelId, ModelId),
\+ (
update_identifier_kinds(SubModelId)
)
).
:- devdoc('\\section{Private predicates}').
set_kind(ModelId, Kind, Identifier) :-
assertz(identifier_kind(ModelId, Identifier, Kind)).
......
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