From Flocq Require Import Core Sterbenz.

Require Import Gappa_common.
Require Import Gappa_pred_bnd.
Require Import Gappa_round_aux.

Lemma compose_lin_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x * y) zi) ->
  forall x1 x2 y2 : R, forall xi yi zi : FF,
  LIN x1 x2 xi -> LIN x2 y2 yi ->
  f xi yi zi = true ->
  LIN x1 y2 zi.
Proof.
intros f t x1 x2 y2 xi yi zi [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hb.
exists (x * y)%R.
split.
- now apply t with (1 := Hx1) (2 := Hy1).
- rewrite Hx2, Hy2. ring.
Qed.

Definition compose_lin_pp := compose_lin_generic _ mul_pp.
Definition compose_lin_po := compose_lin_generic _ mul_po.
Definition compose_lin_pn := compose_lin_generic _ mul_pn.
Definition compose_lin_op := compose_lin_generic _ mul_op.
Definition compose_lin_oo := compose_lin_generic _ mul_oo.
Definition compose_lin_on := compose_lin_generic _ mul_on.
Definition compose_lin_np := compose_lin_generic _ mul_np.
Definition compose_lin_no := compose_lin_generic _ mul_no.
Definition compose_lin_nn := compose_lin_generic _ mul_nn.

Lemma lin_refl :
 forall x : R, forall zi : FF,
 div_refl_helper zi = true ->
 LIN x x zi.
Proof.
intros x zi Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
assert (Float2 1 0 = 1 :>R)%R.
apply Rmult_1_r.
generalize (Fle2_correct _ _ H1). clear H1. rewrite H. intro H1.
generalize (Fle2_correct _ _ H2). clear H2. rewrite H. intro H2.
exists 1%R.
split.
apply (conj H1 H2).
apply eq_sym, Rmult_1_r.
Qed.

Theorem add_ll :
  forall (a b c : R) (I J K : FF),
  LIN a c I -> LIN b c J ->
  add_helper I J K = true ->
  LIN (a + b) c K.
Proof.
intros a b c I J K [i [Hi1 Hi2]] [j [Hj1 Hj2]] Hb.
exists (i + j)%R.
split.
- now apply add with (3 := Hb).
- rewrite Hi2, Hj2. ring.
Qed.

Theorem lin_of_bnd_div :
  forall (a b : R) (I : FF),
  NZR b -> BND (a / b) I ->
  LIN a b I.
Proof.
  intros a b I Hb H1.
  exists (a / b)%R. split.
  - now apply H1.
  - now field.
Qed.

Theorem bnd_div_of_lin :
  forall (a b : R) (I : FF),
  NZR b -> LIN a b I ->
  BND (a / b) I.
Proof.
  intros a b I Hb [x [H1 H2]].
  rewrite H2.
  now replace (b * x / b)%R with x by now field.
Qed.

Theorem bnd_of_lin :
  forall a b : R, forall zi : FF,
  LIN a b zi ->
  contains_zero_helper zi = true ->
  BND (a / b) zi.
Proof.
  intros a b zi [x [Hx ->]] Hb.
  destruct (Req_dec b 0) as [->|Zb].
  rewrite Rdiv_0_r.
  now apply contains_zero.
  replace (_ / b)%R with x by now field.
  exact Hx.
Qed.

Theorem sub_ll :
  forall (a b c : R) (I J K : FF),
  LIN a c I -> LIN b c J ->
  sub_helper I J K = true ->
  LIN (a - b) c K.
Proof.
  intros a b c I J K [i [Hi1 Hi2]] [j [Hj1 Hj2]] Hb.
  exists (i - j)%R.
  split.
  - now apply sub with (3 := Hb).
  - rewrite Hi2, Hj2. ring.
Qed.

Theorem minus_lin :
  forall (a b : R) (I J : FF),
  LIN a b I ->
  neg_helper I J = true ->
  LIN (-a) b J.
Proof.
  intros a b I J [x [Hx1 ->]] Hb.
  exists (-x)%R.
  split.
  - now apply neg with (2 := Hb).
  - apply Ropp_mult_distr_r.
Qed.

Lemma mul_ll_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x * y) zi) ->
  forall (a b c d : R) (I J K : FF),
  LIN a c I -> LIN b d J ->
  f I J K = true ->
  LIN (a * b) (c * d) K.
Proof.
  intros f t a b c d I J K [x [Hx1 Hx2]] [y [Hy1 Hy2]].
  exists (x * y)%R.
  split.
  - now apply t with (1 := Hx1) (2 := Hy1).
  - rewrite Hx2, Hy2 ; ring.
Qed.

Definition mul_ll_pp := mul_ll_generic _ mul_pp.
Definition mul_ll_po := mul_ll_generic _ mul_po.
Definition mul_ll_pn := mul_ll_generic _ mul_pn.
Definition mul_ll_op := mul_ll_generic _ mul_op.
Definition mul_ll_oo := mul_ll_generic _ mul_oo.
Definition mul_ll_on := mul_ll_generic _ mul_on.
Definition mul_ll_np := mul_ll_generic _ mul_np.
Definition mul_ll_no := mul_ll_generic _ mul_no.
Definition mul_ll_nn := mul_ll_generic _ mul_nn.

Lemma bnd_of_lin_bnd_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x * y) zi) ->
  forall (a b : R) (I J K : FF),
  LIN a b I -> BND b J ->
  f I J K = true ->
  BND a K.
Proof.
intros f t a b I J K [x [Hx1 Hx2]] Hb Hf.
rewrite Hx2.
replace (b * x)%R with (x * b)%R by now ring.
now apply t with (1 := Hx1) (2 := Hb).
Qed.

Definition bnd_of_lin_bnd_pp := bnd_of_lin_bnd_generic _ mul_pp.
Definition bnd_of_lin_bnd_po := bnd_of_lin_bnd_generic _ mul_po.
Definition bnd_of_lin_bnd_pn := bnd_of_lin_bnd_generic _ mul_pn.
Definition bnd_of_lin_bnd_op := bnd_of_lin_bnd_generic _ mul_op.
Definition bnd_of_lin_bnd_oo := bnd_of_lin_bnd_generic _ mul_oo.
Definition bnd_of_lin_bnd_on := bnd_of_lin_bnd_generic _ mul_on.
Definition bnd_of_lin_bnd_np := bnd_of_lin_bnd_generic _ mul_np.
Definition bnd_of_lin_bnd_no := bnd_of_lin_bnd_generic _ mul_no.
Definition bnd_of_lin_bnd_nn := bnd_of_lin_bnd_generic _ mul_nn.

Theorem lin_subset :
  forall (a b : R) (I J : FF),
  LIN a b I ->
  subset_helper I J = true ->
  LIN a b J.
Proof.
intros a b I J [x [Hx1 Hx2]] Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
exists x.
split.
apply IRsubset with (1 := H1) (2 := H2) (3 := Hx1).
exact Hx2.
Qed.

Definition intersect_ll_helper (xf yf : float2) (zi : FF) :=
  Fle2 (lower zi) (upper zi) &&
  Fle2 (lower zi) yf &&
  Fle2 xf (upper zi).

Theorem intersect_ll :
  forall (a b : R) (I J K : FF),
  LIN a b I -> LIN a b J ->
  intersect_ll_helper (upper I) (lower J) K = true ->
  LIN a b K.
Proof.
intros a b I J K [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
apply Fle2_correct in H3.
case (Req_dec b 0) ; intro.
exists (float2R (lower K)).
split.
split.
apply Rle_refl.
exact H1.
rewrite Hx2.
rewrite H.
repeat rewrite Rmult_0_l.
apply refl_equal.
exists x.
split.
split.
apply Rle_trans with (1 := H2).
replace x with y.
apply Hy1.
apply Rmult_eq_reg_l with (2 := H).
now rewrite <- Hy2.
now apply Rle_trans with (2 := H3).
exact Hx2.
Qed.

Definition intersect_ll0_helper (xf yf : float2) (zi : FF) :=
  Flt2 xf yf &&
  Fneg0 (lower zi) &&
  Fpos0 (upper zi).

Theorem intersect_ll0 :
  forall (a b : R) (I J K : FF),
  LIN a b I -> LIN a b J ->
  intersect_ll0_helper (upper I) (lower J) K = true ->
  BND b K.
Proof.
intros a b I J K [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Flt2_correct in H1.
apply Fneg0_correct in H2.
apply Fpos0_correct in H3.
destruct (Req_dec b 0) as [Hz|Hz].
rewrite Hz.
now split.
elim (Rle_not_lt x y).
apply Req_le.
apply Rmult_eq_reg_l with (2 := Hz).
now rewrite <- Hy2.
apply Rle_lt_trans with (1 := proj2 Hx1).
apply Rlt_le_trans with (2 := proj1 Hy1).
exact H1.
Qed.

Definition lin_of_rel_helper (ri li : FF) :=
  Fle2 (lower li) (Fplus2 (Float2 1 0) (lower ri)) &&
  Fle2 (Fplus2 (Float2 1 0) (upper ri)) (upper li).

Lemma lin_of_rel :
  forall x y : R, forall ri li : FF,
  REL x y ri ->
  lin_of_rel_helper ri li = true ->
  LIN x y li.
Proof.
  intros x y ri li [e [Hr ->]] Hb.
  generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
  generalize (Fle2_correct _ _ H1). rewrite Fplus2_correct. clear H1. intro H1.
  generalize (Fle2_correct _ _ H2). rewrite Fplus2_correct. clear H2. intro H2.
  exists (1 + e)%R.
  refine (conj _ eq_refl).
  apply IRplus with (1 := H1) (2 := H2) (4 := Hr).
  rewrite <- (Rmult_1_r 1).
  split ; apply Rle_refl.
Qed.

Lemma lin_of_lin_rel_generic :
  forall f,
  (forall x y : R, forall xi yi zi : FF,
   BND x xi -> BND y yi -> f xi yi zi = true ->
   BND (x * y) zi) ->
  forall (a b c : R) (I J K : FF),
  LIN a c I -> REL b a J ->
  f I J K = true ->
  LIN (b - a) c K.
Proof.
  intros f t a b c I J K [x [Hx1 Hx2]] [y [Hy1 Hy2]] Hf.
  rewrite Hy2.
  exists (x * y)%R.
  replace (a * (1 + y) - a)%R with (a * y)%R by ring.
  split.
  - now apply t with (1 := Hx1) (2 := Hy1).
  - rewrite Hx2 ; ring.
Qed.

Definition lin_of_lin_rel_pp := lin_of_lin_rel_generic _ mul_pp.
Definition lin_of_lin_rel_po := lin_of_lin_rel_generic _ mul_po.
Definition lin_of_lin_rel_pn := lin_of_lin_rel_generic _ mul_pn.
Definition lin_of_lin_rel_op := lin_of_lin_rel_generic _ mul_op.
Definition lin_of_lin_rel_oo := lin_of_lin_rel_generic _ mul_oo.
Definition lin_of_lin_rel_on := lin_of_lin_rel_generic _ mul_on.
Definition lin_of_lin_rel_np := lin_of_lin_rel_generic _ mul_np.
Definition lin_of_lin_rel_no := lin_of_lin_rel_generic _ mul_no.
Definition lin_of_lin_rel_nn := lin_of_lin_rel_generic _ mul_nn.
