Library FminOp

Require Export AllFloat.
Require Export Paux.

Theorem oZ1_oZ : forall o, oZ1 o = Z_of_nat (oZ o).
Opaque Pdiv.
Opaque PdivBound.

Definition FindMin (bound base a : positive)
  (dexp exp : Z) :=
  match PdivBound bound a base with
  | (q, r, n) =>
      match (exp + Z_of_nat n)%Z with
      | exp' =>
          match (dexp - exp')%Z with
          | Zpos e =>
              match q with
              | Some q1 =>
                  match Pdiv q1 (positive_exp base e) with
                  | (q', r') =>
                      (Float (oZ1 q') dexp,
                      Fplus (Zpos base) (Float (oZ1 r') exp')
                        (Float (oZ1 r) exp))
                  end
              | None => (Float 0 dexp, Float (oZ1 r) exp)
              end
          | _ => (Float (oZ1 q) exp', Float (oZ1 r) exp)
          end
      end
  end.
Section FminOp.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Coercion Local FtoRradix := FtoR radix.
Variable b : Fbound.
Variable precision : nat.
Hypothesis precisionNotZero : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.

Let dExp := (- dExp b)%Z.

Theorem Zpower_nat_exp :
 forall (a : positive) (n : nat),
 exp (nat_of_P a) n = Zpower_nat (Zpos a) n :>Z.

Definition Z2pos x :=
  match x with
  | Z0 => 1%positive
  | Zpos p => p
  | Zneg p => p
  end.

Theorem Z2pos_correct :
 forall z : Z, (0 < z)%Z -> Zpos (Z2pos z) = z.

Theorem FminOp_correct1 :
 forall a e,
 Float (Zpos a) e =
 (fst (FindMin (vNum b) (Z2pos radix) a dExp e) +
  snd (FindMin (vNum b) (Z2pos radix) a dExp e))%R :>R.

Theorem FminOp_correct2 :
 forall a e, (0 <= snd (FindMin (vNum b) (Z2pos radix) a dExp e))%R.

Theorem FminOp_correct3 :
 forall a e, Fbounded b (fst (FindMin (vNum b) (Z2pos radix) a dExp e)).

Theorem FminOp_correct4 :
 forall a e,
 snd (FindMin (vNum b) (Z2pos radix) a dExp e) = 0%R :>R \/
 Fcanonic radix b (fst (FindMin (vNum b) (Z2pos radix) a dExp e)).

Theorem FminOp_correct5 :
 forall a e,
 snd (FindMin (vNum b) (Z2pos radix) a dExp e) = 0%R :>R \/
 (snd (FindMin (vNum b) (Z2pos radix) a dExp e) <
  Fulp b radix precision (fst (FindMin (vNum b) (Z2pos radix) a dExp e)))%R.

Theorem FminOp_correct6 :
 forall a e, (0 <= fst (FindMin (vNum b) (Z2pos radix) a dExp e))%R.

Theorem FSuccDiffPos :
 forall x : float,
 (0 <= x)%R ->
 Fminus radix (FSucc b radix precision x) x = Float 1%nat (Fexp x) :>R.

Theorem CanonicFulp :
 forall p : float,
 Fcanonic radix b p -> Fulp b radix precision p = Float 1%nat (Fexp p).

Theorem FSuccUlpPos :
 forall x : float,
 Fcanonic radix b x ->
 (0 <= x)%R ->
 Fminus radix (FSucc b radix precision x) x = Fulp b radix precision x :>R.

Theorem FNSuccUlpPos :
 forall x : float,
 Fcanonic radix b x ->
 (0 <= x)%R ->
 Fminus radix (FNSucc b radix precision x) x = Fulp b radix precision x :>R.

Theorem FminOp_correct7 :
 forall a e,
 isMin b radix (Float (Zpos a) e)
   (fst (FindMin (vNum b) (Z2pos radix) a dExp e)).

Inductive rResult : Set :=
  | rExact : float -> rResult
  | rRound : float -> rResult.

Definition rFloat o := match o with
                       | rExact e => e
                       | rRound e => e
                       end.

Definition rFloor (f : float) :=
  match f with
  | Float Z0 e => rExact (Float 0 dExp)
  | Float (Zpos a) e =>
      match FindMin (vNum b) (Z2pos radix) a dExp e with
      | (r1, Float Z0 _) => rExact r1
      | (r1, _) => rRound r1
      end
  | Float (Zneg a) e =>
      match FindMin (vNum b) (Z2pos radix) a dExp e with
      | (r1, Float Z0 _) => rExact (Fopp r1)
      | (r1, _) => rRound (Fopp (FSucc b radix precision r1))
      end
  end.

Theorem NotR0NotZero : forall f : float, Fnum f <> 0%Z -> f <> 0%R :>R.

Theorem rFloor_correct :
 forall f : float,
 isMin b radix f (rFloat (rFloor f)) /\
 match rFloor f with
 | rExact r => r = f :>R
 | rRound r => r <> f :>R /\ Fcanonic radix b r
 end.

Definition rCeil (f : float) :=
  match rFloor f with
  | rExact r => rExact r
  | rRound r => rRound (FSucc b radix precision r)
  end.

Theorem rCeil_correct :
 forall f : float,
 isMax b radix f (rFloat (rCeil f)) /\
 match rCeil f with
 | rExact r => r = f :>R
 | rRound r => r <> f :>R /\ Fcanonic radix b r
 end.

Definition rToZero (f : float) :=
  match f with
  | Float Z0 e => rExact (Float 0 dExp)
  | Float (Zpos a) e => rFloor f
  | Float (Zneg a) e => rCeil f
  end.

Theorem rToZero_correct :
 forall f : float,
 ToZeroP b radix f (rFloat (rToZero f)) /\
 match rToZero f with
 | rExact r => r = f :>R
 | rRound r => r <> f :>R /\ Fcanonic radix b r
 end.

Definition ZevenP a :=
  match Fnum a with
  | Z0 => true
  | Zpos (xO _) => true
  | Zneg (xO _) => true
  | _ => false
  end.

Theorem ZevenP_correct :
 forall a, match ZevenP a with
           | true => Feven a
           | false => Fodd a
           end.

Theorem Fcompare_correct :
 forall f1 f2 : float,
 match Fcompare radix f1 f2 with
 | Datatypes.Eq => f1 = f2 :>R
 | Datatypes.Lt => (f1 < f2)%R
 | Datatypes.Gt => (f2 < f1)%R
 end.

Definition rClosestEvenPos (a : positive) (e : Z) :=
  match FindMin (vNum b) (Z2pos radix) a dExp e with
  | (r1, Float Z0 _) => rExact r1
  | (r1, r2) =>
      match
        Fcompare radix (Float 1%nat (Fexp r1))
          (Float (2%nat * Fnum r2) (Fexp r2))
      with
      | Datatypes.Lt => rRound (FSucc b radix precision r1)
      | Datatypes.Gt => rRound r1
      | Datatypes.Eq =>
          match ZevenP r1 with
          | true => rRound r1
          | false => rRound (FSucc b radix precision r1)
          end
      end
  end.

Definition rOp a :=
  match a with
  | rExact f => rExact (Fopp f)
  | rRound f => rRound (Fopp f)
  end.

Definition rClosestEven (f : float) :=
  match f with
  | Float Z0 e => rExact (Float 0 dExp)
  | Float (Zpos a) e => rClosestEvenPos a e
  | Float (Zneg a) e => rOp (rClosestEvenPos a e)
  end.
Opaque FindMin.

Theorem RleR0Rminus : forall x y, (x <= y)%R -> (0 <= y - x)%R.

Theorem ClosestMin1 :
 forall (r : R) (min max : float),
 isMin b radix r min ->
 isMax b radix r max -> (r - min <= max - r)%R -> Closest b radix r min.

Theorem ClosestMax1 :
 forall (r : R) (min max : float),
 isMin b radix r min ->
 isMax b radix r max -> (max - r <= r - min)%R -> Closest b radix r max.

Theorem ClosestMin2 :
 forall (r : R) (min max f : float),
 isMin b radix r min ->
 isMax b radix r max ->
 (r - min < max - r)%R -> Closest b radix r f -> f = min :>R.

Theorem ClosestMax2 :
 forall (r : R) (min max f : float),
 isMin b radix r min ->
 isMax b radix r max ->
 (max - r < r - min)%R -> Closest b radix r f -> f = max :>R.

Theorem EvenClosestMin1 :
 forall (r : R) (min max : float),
 isMin b radix r min ->
 isMax b radix r max ->
 (r - min < max - r)%R -> EvenClosest b radix precision r min.

Theorem EvenClosestMax1 :
 forall (r : R) (min max : float),
 isMin b radix r min ->
 isMax b radix r max ->
 (max - r < r - min)%R -> EvenClosest b radix precision r max.

Theorem EvenClosestMin2 :
 forall (r : R) (min max : float),
 isMin b radix r min ->
 isMax b radix r max ->
 (r - min)%R = (max - r)%R ->
 FNeven b radix precision min -> EvenClosest b radix precision r min.

Theorem EvenClosestMax2 :
 forall (r : R) (min max : float),
 isMin b radix r min ->
 isMax b radix r max ->
 (max - r)%R = (r - min)%R ->
 FNeven b radix precision max -> EvenClosest b radix precision r max.

Theorem EqSpeTwice :
 forall x y z, (2%nat * (x - y))%R = (z - y)%R -> (x - y)%R = (z - x)%R.

Theorem RltSpeTwice1 :
 forall x y z, (2%nat * (x - y) < z - y)%R -> (x - y < z - x)%R.

Theorem RltSpeTwice2 :
 forall x y z, (z - y < 2%nat * (x - y))%R -> (z - x < x - y)%R.

Theorem rClosestEvenPos_correct :
 forall (a : positive) (e : Z),
 EvenClosest b radix precision (Float (Zpos a) e)
   (rFloat (rClosestEvenPos a e)) /\
 match rClosestEvenPos a e with
 | rExact r => r = Float (Zpos a) e :>R
 | rRound r => r <> Float (Zpos a) e :>R /\ Fcanonic radix b r
 end.

Theorem rClosestEven_correct :
 forall f : float,
 EvenClosest b radix precision f (rFloat (rClosestEven f)) /\
 match rClosestEven f with
 | rExact r => r = f :>R
 | rRound r => r <> f :>R /\ Fcanonic radix b r
 end.
End FminOp.
Transparent Pdiv.
Transparent PdivBound.
Transparent FindMin.