Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
AVA
FloVer
Commits
c2fce4c8
Commit
c2fce4c8
authored
Oct 07, 2016
by
Heiko Becker
Browse files
Division with proof holes in Coq
parent
179823d5
Changes
4
Hide whitespace changes
Inline
Side-by-side
coq/ErrorBounds.v
View file @
c2fce4c8
...
...
@@ -147,19 +147,17 @@ Proof.
eapply
Rmult_le_compat_l
;
[
apply
Rabs_pos
|
auto
].
Qed
.
Lemma
mult_abs_err_bounded
(
e1
:
exp
R
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
R
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
cenv
:
nat
->
R
)
(
err1
:
R
)
(
err2
:
R
)
:
Lemma
mult_abs_err_bounded
(
e1
:
exp
R
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
R
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
cenv
:
env_ty
)
(
err1
:
R
)
(
err2
:
R
)
:
eval_exp
0
%
R
cenv
e1
e1R
->
eval_exp
machineEpsilon
cenv
e1
e1F
->
eval_exp
0
%
R
cenv
e2
e2R
->
eval_exp
machineEpsilon
cenv
e2
e2F
->
eval_exp
0
%
R
cenv
(
Binop
Mult
e1
e2
)
vR
->
eval_exp
machineEpsilon
(
updEnv
2
e2F
(
updEnv
1
e1F
cenv
))
(
Binop
Mult
(
Var
R
1
)
(
Var
R
2
))
vF
->
(
Rabs
(
e1R
-
e1F
)
<=
err1
)
%
R
->
(
Rabs
(
e2R
-
e2F
)
<=
err2
)
%
R
->
(
Rabs
(
vR
-
vF
)
<=
Rabs
(
e1R
*
e2R
-
e1F
*
e2F
)
+
Rabs
(
e1F
*
e2F
)
*
machineEpsilon
)
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
mult_real
mult_float
bound_e1
bound_e2
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
+
e2R
*
)
intros
e1_real
e1_float
e2_real
e2_float
mult_real
mult_float
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
*
e2R
*
)
inversion
mult_real
;
subst
.
rewrite
perturb_0_val
in
mult_real
;
auto
.
rewrite
perturb_0_val
;
auto
.
...
...
@@ -191,4 +189,47 @@ Proof.
eapply
Rmult_le_compat_l
;
auto
.
rewrite
<-
Rabs_mult
.
apply
Rabs_pos
.
Qed
.
\ No newline at end of file
Qed
.
Lemma
div_abs_err_bounded
(
e1
:
exp
R
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
R
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
cenv
:
env_ty
)
(
err1
:
R
)
(
err2
:
R
)
:
eval_exp
0
%
R
cenv
e1
e1R
->
eval_exp
machineEpsilon
cenv
e1
e1F
->
eval_exp
0
%
R
cenv
e2
e2R
->
eval_exp
machineEpsilon
cenv
e2
e2F
->
eval_exp
0
%
R
cenv
(
Binop
Div
e1
e2
)
vR
->
eval_exp
machineEpsilon
(
updEnv
2
e2F
(
updEnv
1
e1F
cenv
))
(
Binop
Div
(
Var
R
1
)
(
Var
R
2
))
vF
->
(
Rabs
(
vR
-
vF
)
<=
Rabs
(
e1R
/
e2R
-
e1F
/
e2F
)
+
Rabs
(
e1F
/
e2F
)
*
machineEpsilon
)
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
div_real
div_float
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
*
e2R
*
)
inversion
div_real
;
subst
.
rewrite
perturb_0_val
in
div_real
;
auto
.
rewrite
perturb_0_val
;
auto
.
unfold
eval_binop
in
*
;
simpl
in
*
.
clear
delta
H2
.
rewrite
(
eval_0_det
H4
e1_real
);
rewrite
(
eval_0_det
H5
e2_real
).
rewrite
(
eval_0_det
H4
e1_real
)
in
div_real
.
rewrite
(
eval_0_det
H5
e2_real
)
in
div_real
.
clear
H4
H5
v1
v2
.
(
*
Now
unfold
the
float
valued
evaluation
to
get
the
deltas
we
need
for
the
inequality
*
)
inversion
div_float
;
subst
.
unfold
perturb
;
simpl
.
inversion
H4
;
subst
;
inversion
H5
;
subst
.
unfold
updEnv
;
simpl
.
(
*
We
have
now
obtained
all
necessary
values
from
the
evaluations
-->
remove
them
for
readability
*
)
clear
div_float
H4
H5
div_real
e1_real
e1_float
e2_real
e2_float
.
repeat
rewrite
Rmult_plus_distr_l
.
rewrite
Rmult_1_r
.
rewrite
Rsub_eq_Ropp_Rplus
.
rewrite
Ropp_plus_distr
.
rewrite
<-
Rplus_assoc
.
setoid_rewrite
<-
Rsub_eq_Ropp_Rplus
at
2.
eapply
Rle_trans
.
eapply
Rabs_triang
.
eapply
Rplus_le_compat_l
.
rewrite
Rabs_Ropp
.
repeat
rewrite
Rabs_mult
.
eapply
Rmult_le_compat_l
;
auto
.
apply
Rabs_pos
.
Qed
.
\ No newline at end of file
coq/ErrorValidation.v
View file @
c2fce4c8
...
...
@@ -13,7 +13,6 @@ Fixpoint validErrorbound (e:exp Q) (env:analysisResult) :=
match
e
with
|
Var
v
=>
false
|
Param
v
=>
andb
errPos
(
Qleb
(
maxAbs
intv
*
RationalSimps
.
machineEpsilon
)
err
)
(
*
A
constant
will
be
a
point
intv
.
Take
maxAbs
never
the
less
*
)
|
Const
n
=>
andb
errPos
(
Qleb
(
maxAbs
intv
*
RationalSimps
.
machineEpsilon
)
err
)
|
Binop
b
e1
e2
=>
let
(
ive1
,
err1
)
:=
env
e1
in
...
...
@@ -28,7 +27,7 @@ Fixpoint validErrorbound (e:exp Q) (env:analysisResult) :=
|
Plus
=>
Qleb
(
err1
+
err2
+
(
maxAbs
(
addIntv
errIve1
errIve2
))
*
RationalSimps
.
machineEpsilon
)
err
|
Sub
=>
Qleb
(
err1
+
err2
+
(
maxAbs
(
subtractIntv
errIve1
errIve2
))
*
RationalSimps
.
machineEpsilon
)
err
|
Mult
=>
Qleb
((
upperBoundE1
*
err2
+
upperBoundE2
*
err1
+
err1
*
err2
)
+
(
maxAbs
(
multIntv
errIve1
errIve2
))
*
RationalSimps
.
machineEpsilon
)
err
|
Div
=>
false
|
Div
=>
Qleb
((
maxAbs
(
subtractIntv
(
divideIntv
ive1
ive2
)
(
divideIntv
errIve1
errIve2
)))
+
(
maxAbs
(
divideIntv
errIve1
errIve2
))
*
RationalSimps
.
machineEpsilon
)
err
end
in
andb
(
andb
rec
errPos
)
theVal
end
.
...
...
@@ -1035,6 +1034,108 @@ Proof.
repeat
rewrite
Q2R_plus
;
auto
.
Qed
.
Lemma
validErrorboundCorrectDiv
cenv
absenv
(
e1
:
exp
Q
)
(
e2
:
exp
Q
)
(
nR
nR1
nR2
nF
nF1
nF2
:
R
)
(
e
err1
err2
:
error
)
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
P
:
precondValidForExec
P
cenv
->
eval_exp
0
%
R
cenv
(
toRExp
e1
)
nR1
->
eval_exp
0
%
R
cenv
(
toRExp
e2
)
nR2
->
eval_exp
0
%
R
cenv
(
toRExp
(
Binop
Div
e1
e2
))
nR
->
eval_exp
(
Q2R
RationalSimps
.
machineEpsilon
)
cenv
(
toRExp
e1
)
nF1
->
eval_exp
(
Q2R
RationalSimps
.
machineEpsilon
)
cenv
(
toRExp
e2
)
nF2
->
eval_exp
(
Q2R
RationalSimps
.
machineEpsilon
)
(
updEnv
2
nF2
(
updEnv
1
nF1
cenv
))
(
toRExp
(
Binop
Div
(
Var
Q
1
)
(
Var
Q
2
)))
nF
->
validErrorbound
(
Binop
Div
e1
e2
)
absenv
=
true
->
validIntervalbounds
(
Binop
Div
e1
e2
)
absenv
P
=
true
->
absenv
e1
=
((
e1lo
,
e1hi
),
err1
)
->
absenv
e2
=
((
e2lo
,
e2hi
),
err2
)
->
absenv
(
Binop
Div
e1
e2
)
=
((
alo
,
ahi
),
e
)
->
(
Rabs
(
nR1
-
nF1
)
<=
(
Q2R
err1
))
%
R
->
(
Rabs
(
nR2
-
nF2
)
<=
(
Q2R
err2
))
%
R
->
(
Rabs
(
nR
-
nF
)
<=
(
Q2R
e
))
%
R
.
Proof
.
intros
p_valid
e1_real
e2_real
eval_real
e1_float
e2_float
eval_float
valid_error
valid_intv
absenv_e1
absenv_e2
absenv_div
err1_bounded
err2_bounded
.
pose
proof
(
ivbounds_approximatesPrecond_sound
(
Binop
Div
e1
e2
)
absenv
P
valid_intv
)
as
env_approx_p
.
eapply
Rle_trans
.
eapply
(
div_abs_err_bounded
(
toRExp
e1
)
_
_
(
toRExp
e2
));
eauto
.
rewrite
<-
mEps_eq_Rmeps
.
apply
e1_float
.
rewrite
<-
mEps_eq_Rmeps
.
apply
e2_float
.
rewrite
<-
mEps_eq_Rmeps
.
apply
eval_float
.
rewrite
<-
mEps_eq_Rmeps
.
unfold
validErrorbound
in
valid_error
at
1.
rewrite
absenv_div
,
absenv_e1
,
absenv_e2
in
valid_error
.
apply
Is_true_eq_left
in
valid_error
.
apply
andb_prop_elim
in
valid_error
.
destruct
valid_error
as
[
valid_rec
valid_error
].
apply
andb_prop_elim
in
valid_rec
.
apply
Is_true_eq_true
in
valid_error
.
destruct
valid_rec
as
[
valid_rec
le_0_e
].
apply
andb_prop_elim
in
valid_rec
.
destruct
valid_rec
as
[
valid_err1
valid_err2
].
apply
Is_true_eq_true
in
valid_err1
.
apply
Is_true_eq_true
in
valid_err2
.
assert
(
0
<=
Q2R
err1
)
%
R
as
err1_pos
by
(
apply
(
err_always_positive
e1
absenv
(
e1lo
,
e1hi
)
err1
);
auto
).
assert
(
0
<=
Q2R
err2
)
%
R
as
err2_pos
by
(
apply
(
err_always_positive
e2
absenv
(
e2lo
,
e2hi
)
err2
);
auto
).
clear
valid_err1
valid_err2
.
apply
Qle_bool_iff
in
valid_error
.
apply
Qle_Rle
in
valid_error
.
rewrite
Q2R_plus
,
Q2R_mult
in
valid_error
.
eapply
Rle_trans
.
Focus
2.
apply
valid_error
.
eapply
Rplus_le_compat
.
-
(
*
Similar
to
other
goal
*
)
remember
(
subtractIntv
(
divideIntv
(
e1lo
,
e1hi
)
(
e2lo
,
e2hi
))
(
divideIntv
(
widenIntv
(
e1lo
,
e1hi
)
err1
)
(
widenIntv
(
e2lo
,
e2hi
)
err2
)))
as
iv
.
iv_assert
iv
iv_unf
.
destruct
iv_unf
as
[
ivl
[
ivh
iv_unf
]].
rewrite
iv_unf
.
rewrite
<-
maxAbs_impl_RmaxAbs
.
assert
(
ivlo
iv
=
ivl
)
by
(
rewrite
iv_unf
;
auto
).
assert
(
ivhi
iv
=
ivh
)
by
(
rewrite
iv_unf
;
auto
).
rewrite
<-
H
,
<-
H0
.
admit
.
(
*
By
validity
of
IV
,
monotonicity
*
)
-
apply
Rmult_le_compat_r
.
+
apply
mEps_geq_zero
.
+
remember
(
divideIntv
(
widenIntv
(
e1lo
,
e1hi
)
err1
)
(
widenIntv
(
e2lo
,
e2hi
)
err2
))
as
iv
.
iv_assert
iv
iv_unf
.
destruct
iv_unf
as
[
ivl
[
ivh
iv_unf
]].
rewrite
iv_unf
.
rewrite
<-
maxAbs_impl_RmaxAbs
.
assert
(
ivlo
iv
=
ivl
)
by
(
rewrite
iv_unf
;
auto
).
assert
(
ivhi
iv
=
ivh
)
by
(
rewrite
iv_unf
;
auto
).
rewrite
<-
H
,
<-
H0
.
admit
.
(
*
assert
(
validIntervalbounds_sound
_
_
_
_
_
p_valid
valid_iv_e1
e1_real
)
as
valid_bounds_e1
by
admit
.
rewrite
absenv_e1
in
valid_bounds_e1
.
simpl
in
valid_bounds_e1
.
pose
proof
(
distance_gives_iv
nR1
nF1
(
Q2R
err1
)
(
Q2R
e1lo
,
Q2R
e1hi
)
valid_bounds_e1
err1_bounded
).
pose
proof
(
validIntervalbounds_sound
_
_
_
_
_
p_valid
valid_iv_e2
e2_real
)
as
valid_bounds_e2
.
rewrite
absenv_e2
in
valid_bounds_e2
.
simpl
in
valid_bounds_e2
.
pose
proof
(
distance_gives_iv
nR2
nF2
(
Q2R
err2
)
(
Q2R
e2lo
,
Q2R
e2hi
)
valid_bounds_e2
err2_bounded
).
pose
proof
(
IntervalArith
.
interval_multiplication_valid
_
_
_
_
H1
H2
).
unfold
IntervalArith
.
contained
in
H3
.
destruct
H3
.
unfold
RmaxAbsFun
.
apply
Rmult_le_compat_r
.
apply
mEps_geq_zero
.
apply
RmaxAbs
;
subst
;
simpl
in
*
.
-
rewrite
Q2R_min4
.
repeat
rewrite
Q2R_mult
;
repeat
rewrite
Q2R_minus
;
repeat
rewrite
Q2R_plus
;
auto
.
-
rewrite
Q2R_max4
.
repeat
rewrite
Q2R_mult
;
repeat
rewrite
Q2R_minus
;
repeat
rewrite
Q2R_plus
;
auto
.
Qed
.
*
)
Admitted
.
Lemma
validErrorbound_sound
(
e
:
exp
Q
)
:
forall
cenv
absenv
nR
nF
err
P
elo
ehi
,
precondValidForExec
P
cenv
->
...
...
@@ -1139,5 +1240,21 @@ Proof.
{
apply
andb_prop_intro
.
split
;
apply
Is_true_eq_left
;
auto
.
}
{
apply
Is_true_eq_left
;
auto
.
}
+
inversion
valid_error
.
+
eapply
(
validErrorboundCorrectDiv
cenv
absenv
e1
e2
);
eauto
.
simpl
.
rewrite
absenv_eq
,
absenv_e1
,
absenv_e2
;
simpl
.
apply
Is_true_eq_true
.
apply
andb_prop_intro
;
split
.
*
apply
andb_prop_intro
.
split
;
try
auto
.
apply
andb_prop_intro
.
split
;
apply
Is_true_eq_left
;
auto
.
*
apply
Is_true_eq_left
;
auto
.
*
unfold
validIntervalbounds
.
rewrite
absenv_eq
,
absenv_e1
,
absenv_e2
;
simpl
.
apply
Is_true_eq_true
.
apply
andb_prop_intro
;
split
.
{
apply
andb_prop_intro
.
split
;
apply
Is_true_eq_left
;
auto
.
}
{
apply
Is_true_eq_left
;
auto
.
}
Qed
.
coq/Infra/RealRationalProps.v
View file @
c2fce4c8
...
...
@@ -85,6 +85,15 @@ Proof.
subst
;
auto
.
Qed
.
Definition
Q2RP
(
iv
:
Q
*
Q
)
:=
let
(
lo
,
hi
)
:=
iv
in
(
Q2R
lo
,
Q2R
hi
).
Lemma
maxAbs_impl_RmaxAbs_iv
iv
:
RmaxAbsFun
(
Q2RP
iv
)
=
Q2R
(
maxAbs
iv
).
Proof
.
unfold
Q2RP
;
destruct
iv
;
apply
maxAbs_impl_RmaxAbs
.
Qed
.
Lemma
Q2R_max
(
a
:
Q
)
(
b
:
Q
)
:
Rmax
(
Q2R
a
)
(
Q2R
b
)
=
Q2R
(
Qmax
a
b
).
Proof
.
...
...
coq/IntervalValidation.v
View file @
c2fce4c8
(
**
Interval
arithmetic
checker
and
its
soundness
proof
**
)
Require
Import
Coq
.
QArith
.
QArith
Coq
.
QArith
.
Qreals
QArith
.
Qminmax
Coq
.
Lists
.
List
.
Require
Import
Coq
.
QArith
.
QArith
Coq
.
QArith
.
Qreals
QArith
.
Qminmax
Coq
.
Lists
.
List
Coq
.
micromega
.
Psatz
.
Require
Import
Daisy
.
Infra
.
Abbrevs
Daisy
.
Infra
.
RationalSimps
Daisy
.
Infra
.
RealRationalProps
.
Require
Import
Daisy
.
Infra
.
ExpressionAbbrevs
Daisy
.
IntervalArithQ
Daisy
.
IntervalArith
Daisy
.
Infra
.
RealSimps
.
...
...
@@ -10,16 +10,16 @@ Import Lists.List.ListNotations.
Fixpoint
freeVars
(
V
:
Type
)
(
e
:
exp
V
)
:
list
nat
:=
match
e
with
|
Const
n
=>
[]
|
Var
v
=>
[]
|
Param
v
=>
[
v
]
|
Var
_
v
=>
[]
|
Param
_
v
=>
[
v
]
|
Binop
b
e1
e2
=>
(
freeVars
V
e1
)
++
(
freeVars
V
e2
)
end
.
Fixpoint
validIntervalbounds
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
:=
let
(
intv
,
_
)
:=
absenv
e
in
match
e
with
|
Var
v
=>
false
|
Param
v
=>
|
Var
_
v
=>
false
|
Param
_
v
=>
isSupersetIntv
(
P
v
)
intv
|
Const
n
=>
isSupersetIntv
(
n
,
n
)
intv
...
...
@@ -259,5 +259,31 @@ Proof.
repeat
rewrite
<-
Q2R_mult
in
valid_mul_hi
.
rewrite
<-
Q2R_max4
in
valid_mul_hi
.
unfold
absIvUpd
;
auto
.
+
pose
proof
(
divisionIsValid
(
Q2R
v1
)
v2
(
Q2R
(
fst
iv1
),
Q2R
(
snd
iv1
))
(
Q2R
(
fst
iv2
),
Q2R
(
snd
iv2
)))
as
valid_div
.
contradiction
.
Qed
.
\ No newline at end of file
+
pose
proof
(
divisionIsValid
v1
v2
(
Q2R
(
fst
iv1
),
Q2R
(
snd
iv1
))
(
Q2R
(
fst
iv2
),
Q2R
(
snd
iv2
)))
as
valid_div
.
unfold
contained
in
valid_div
.
unfold
isSupersetIntv
in
valid_bin
.
apply
andb_prop_elim
in
valid_bin
;
destruct
valid_bin
as
[
valid_lo
valid_hi
].
apply
Is_true_eq_true
in
valid_lo
;
apply
Is_true_eq_true
in
valid_hi
.
apply
Qle_bool_iff
in
valid_lo
;
apply
Qle_bool_iff
in
valid_hi
.
apply
Qle_Rle
in
valid_lo
;
apply
Qle_Rle
in
valid_hi
.
destruct
valid_div
as
[
valid_div_lo
valid_div_hi
];
try
auto
.
*
admit
.
*
unfold
divideInterval
,
IVlo
,
IVhi
in
valid_div_lo
,
valid_div_hi
.
simpl
in
*
.
split
.
{
eapply
Rle_trans
.
apply
valid_lo
.
unfold
ivlo
.
unfold
multIntv
.
simpl
in
valid_div_lo
.
rewrite
<-
Q2R_inv
in
valid_div_lo
;
[
|
admit
].
rewrite
<-
Q2R_inv
in
valid_div_lo
;
[
|
admit
].
repeat
rewrite
<-
Q2R_mult
in
valid_div_lo
.
rewrite
<-
Q2R_min4
in
valid_div_lo
;
auto
.
}
{
eapply
Rle_trans
.
Focus
2.
apply
valid_hi
.
simpl
in
valid_div_hi
.
rewrite
<-
Q2R_inv
in
valid_div_hi
;
[
|
admit
].
rewrite
<-
Q2R_inv
in
valid_div_hi
;
[
|
admit
].
repeat
rewrite
<-
Q2R_mult
in
valid_div_hi
.
rewrite
<-
Q2R_max4
in
valid_div_hi
;
auto
.
}
Admitted
.
\ No newline at end of file
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment