(* Use of this source code is governed by the license described	* * in the LICENSE file at the root of the source tree.		*)
(* A theory of constructed rational numbers *)
Set Implicit Arguments.
Inductive Rat :=
RatIntro : nat -> posnat -> Rat.
Definition ratCD(r1 r2 : Rat) : (nat * nat * posnat) :=
match (r1, r2) with
| (RatIntro n1 d1, RatIntro n2 d2) =>
((n1 * d2), (n2 * d1), (posnatMult d1 d2))
end.
Definition ratMult(r1 r2 : Rat) : Rat :=
match (r1, r2) with
| (RatIntro n1 d1, RatIntro n2 d2) =>
RatIntro (n1 * n2) (posnatMult d1 d2)
end.
Definition rat1 := (RatIntro 1 (pos 1)).
Definition rat0 := (RatIntro 0 (pos 1)).
Definition ratAdd(r1 r2 : Rat) : Rat :=
match ratCD r1 r2 with
| (n1, n2, d) =>
RatIntro (n1 + n2) d
end.
Definition ratSubtract(r1 r2: Rat) : Rat :=
match ratCD r1 r2 with
| (n1, n2, d) =>
RatIntro (n1 - n2) d
end.
Definition beqRat(r1 r2 : Rat) :=
match (ratCD r1 r2) with
| (n1, n2, _) =>
if (eq_nat_dec n1 n2) then true else false
end.
Definition bleRat(r1 r2 : Rat) :=
match (ratCD r1 r2) with
| (n1, n2, _) =>
if (le_gt_dec n1 n2) then true else false
end.
Definition eqRat(r1 r2 : Rat) :=
beqRat r1 r2 = true.
Definition leRat(r1 r2 : Rat) :=
bleRat r1 r2 = true.
Definition maxRat(r1 r2 : Rat) :=
if (bleRat r1 r2) then r2 else r1.
Definition minRat(r1 r2 : Rat) :=
if (bleRat r1 r2) then r1 else r2.
Definition ratDistance(r1 r2 : Rat) :=
ratSubtract (maxRat r1 r2) (minRat r1 r2).
Ltac rattac_one :=
match goal with
(* rules that solve goals *)
| [|- posnatMult ?x1 ?x2 = posnatMult ?x2 ?x1] => apply posnatMult_comm
| [|- posnatToNat (posnatMult ?x1 ?x2) = posnatToNat (posnatMult ?x2 ?x1)] => rewrite posnatMult_comm; trivial
| [|- ?x1 * ?x2 = ?x2 * ?x1 ] => apply mult_comm
| [|- (mult (?x1 + ?x2) _)  = (mult (?x2 + ?x1) _ )] => f_equal
| [|- ?x1 * ?x2 * _ = ?x2 * ?x1 * _ ] => f_equal
| [ |- posnatToNat ?p > 0 ] => destruct p; unfold posnatToNat; omega
(* inversion on hypotheses *)
| [H1 : ?n * ?x = ?n0 * ?x1, H2: ?n1 * ?x1 = ?n * ?x0 |- ?n1 * ?x = ?n0 * ?x0 ] => eapply (@mult_same_l x1)(* ;
[idtac | rewrite mult_assoc ;
rewrite (mult_comm x1 n1);
rewrite H2;
rewrite <- mult_assoc ;
rewrite (mult_comm x x0) ;
repeat rewrite mult_assoc;
f_equal] *)
| [H : ?x = ?n * (posnatToNat ?p) |- ?x = (posnatToNat ?p) * ?n ] => rewrite H
| [H : RatIntro _ _ = RatIntro _ _ |- _ ] => inversion H; clear H; subst
| [H : (eqRat _ _) |- _ ] => unfold eqRat, beqRat in H
| [H : (leRat _ _) |- _ ] => unfold leRat, bleRat in H
| [H : ?r = RatIntro _ _ |- context[match ?r with | RatIntro _ _ => _ end] ] => rewrite r
| [|- context[match ?r with | RatIntro _ _ => _ end] ] => case_eq r; intuition idtac
| [H : (_ , _) = (_ , _) |- _ ] => inversion H; clear H; subst
| [|- (_, _) = (_, _) ] => f_equal
| [H: context[ratCD _ _] |- _ ] => unfold ratCD in *
| [H : context[match rat0 with | RatIntro _ _ => _ end ] |- _ ] => unfold rat0 in H
| [H1 : context[match ?r with | RatIntro _ _ => _ end], H2 : ?r = RatIntro _ _ |- _ ] => rewrite H2 in H1
| [H : context[match ?r with | RatIntro _ _ => _ end ] |- _ ] => case_eq r; intuition idtac
| [|- context[let (_, _) := ?x in _] ] => case_eq x; intuition idtac
| [H : context[ratAdd _ _] |- _ ] => unfold ratAdd in H
| [H : context[ratMult _ _] |- _ ] => unfold ratMult in H
| [H: context [eq_nat_dec ?x ?y] |- _] => destruct (eq_nat_dec x y)
| [H: context [le_gt_dec ?x ?y] |- _] => destruct (le_gt_dec x y)
| [|- (if (eq_nat_dec ?x ?y) then true else false) = true ] => assert (x = y); destruct (eq_nat_dec x y); trivial
| [|- (if (le_gt_dec ?x ?y) then true else false) = true ] => assert (x <= y); [idtac | destruct (le_gt_dec x y); trivial]
| [|- context[posnatMult _ _ ] ] => unfold posnatMult
| [|- (eqRat _ _) ] => unfold eqRat, beqRat
| [|- (leRat _ _) ] => unfold leRat, bleRat
| [|- (posnatEq _ _ ) ] => econstructor
| [|- context[(posnatToNat _)] ] => unfold posnatToNat in *
| [H : context[let (_, _) := ?p in _] |- _] => destruct p
end.
Ltac rattac :=
intuition idtac; unfold ratCD in *;
repeat (rattac_one; subst); repeat rewrite mult_1_r; repeat rewrite plus_0_r; trivial; try congruence; try omega.
rattac.
Qed.
Infix "*" := ratMult : rat_scope.
Local Open Scope rat_scope.
Notation "n / d" := (RatIntro n (pos d)) : rat_scope.
Notation "0" := rat0 : rat_scope.
Notation "1" := rat1 : rat_scope.
Infix "+" := ratAdd : rat_scope.
Delimit Scope rat_scope with rat.
Notation " |  a - b |" := (ratDistance a%rat b%rat) (at level 30, a at next level, b at next level) : rat_scope.
Infix "<=" := leRat : rat_scope.
Infix "==" := eqRat (at level 70) : rat_scope.
intuition.
case_eq (bleRat r1 r2); intuition.
right.
intuition.
congruence.
Qed.
intuition.
case_eq (beqRat r1 r2); intuition.
right.
intuition.
congruence.
Qed.
rattac.
Qed.
rattac.
Qed.
rattac.
match goal with H:_, G:_ |- _ => ring [H G] end.
Qed.
rattac.
Qed.
induction n2; destruct n3; intuition; simpl in *; try omega.
exfalso.
remember (n2 * n1)%nat as x.
omega.
eapply le_n_S.
eapply IHn2; eauto.
omega.
Qed.
intuition.
eapply mult_le_compat_r_iff_h; eauto.
Qed.
rattac.
eapply (@mult_le_compat_r_iff x1); trivial.
rewrite <- mult_assoc.
rewrite (mult_comm x).
rewrite mult_assoc.
eapply le_trans.
eapply mult_le_compat.
eapply l.
eauto.
repeat rewrite <- mult_assoc.
repeat rewrite (mult_comm x0).
repeat rewrite mult_assoc.
eapply mult_le_compat; eauto.
Qed.
rattac.
Qed.
rattac.
Qed.
(* Definition eqRat_setoid : Setoid_Theory Rat eqRat. econstructor; red. eapply eqRat_refl. eapply eqRat_symm. eapply eqRat_trans. Defined. *)
Add Parametric Relation : Rat leRat
reflexivity proved by leRat_refl
transitivity proved by leRat_trans
as leRat_rel.
Add Parametric Relation : Rat eqRat
reflexivity proved by eqRat_refl
symmetry proved by eqRat_symm
transitivity proved by eqRat_trans
as eqRat_rel.
Global Instance Subrelation_eq_le : subrelation eqRat leRat.
repeat red.
intuition.
eapply eqRat_impl_leRat.
trivial.
Qed.
Global Instance eqRat_resp_leRat :
forall x,
Proper (eqRat ==> Basics.flip Basics.impl)
(leRat x).
intuition.
repeat red; intuition.
simpl.
unfold respectful.
intuition.
eapply leRat_trans.
eapply H0.
eapply eqRat_impl_leRat.
symmetry.
trivial.
Qed.
Local Open Scope rat_scope.
rattac.
Qed.
intuition.
Qed.
intuition.
Qed.
rattac.
Qed.
rattac;
inversion H;
subst;
rewrite mult_1_r;
trivial.
Qed.
intuition.
rewrite ratAdd_comm.
apply ratAdd_0_r.
Qed.
rattac.
Qed.
rattac.
inversion H; clear H; subst.
Local Open Scope nat_scope.
Ltac arithNormalize_step :=
repeat rewrite mult_succ_r in *;
repeat rewrite mult_plus_distr_r in *;
repeat rewrite mult_plus_distr_l in *;
repeat rewrite mult_minus_distr_r in *;
repeat rewrite mult_minus_distr_l in *;
repeat rewrite plus_assoc in *;
repeat rewrite mult_assoc in *.
Ltac arithNormalize := repeat arithNormalize_step.
Ltac arithSimplify :=
match goal with
| [|- _ + ?x = _ + ?x] => f_equal
| [|- _ + (?x1 * ?x2) = _ + (?x2 * ?x1) ] => f_equal
| [|- _ + (?x1 * ?x2 * ?x3) = _ + (?x1 * ?x3 * ?x2) ] => f_equal
| [|- _ + (?x1 * ?x2 * ?x3 * ?x4 * ?x5 * ?x6) = _ + (?x1 * ?x3 * ?x2 * ?x4 * ?x5 * ?x6) ] => f_equal
| [|- _ * ?x1 = _ * ?x1] => f_equal
| [|- _ * ?x = _ ] => rewrite mult_comm; repeat rewrite mult_assoc; arithSimplify
| [|- _ + ?x = _ ] => rewrite plus_comm; repeat rewrite plus_assoc; arithSimplify
| [|- _ * ?x1 <= _ * ?x1] => apply mult_le_compat; auto
| [|- _ * ?x1 <= _ * ?x1] => apply plus_le_compat; auto
| [|- _ * ?x <= _ ] => rewrite mult_comm; repeat rewrite mult_assoc; arithSimplify
| [|- _ + ?x <= _ ] => rewrite plus_comm; repeat rewrite plus_assoc; arithSimplify
end.
arithNormalize.
arithSimplify.
arithSimplify.
do 5 arithSimplify.
do 5 arithSimplify.
Qed.
Local Open Scope rat_scope.
rattac;
inversion H0; clear H0; subst;
inversion H; clear H; subst;
arithNormalize;
arithSimplify.
Qed.
rattac.
arithNormalize.
f_equal.
f_equal.
rewrite mult_comm.
rewrite (mult_comm _ x1).
repeat rewrite mult_assoc.
f_equal.
rewrite mult_comm.
rewrite e.
apply mult_comm.
do 3 arithSimplify.
Qed.
intuition.
eapply eqRat_trans.
eapply ratAdd_eqRat_compat_l; eauto.
repeat rewrite (ratAdd_comm r2).
eapply ratAdd_eqRat_compat_l; eauto.
Qed.
rattac.
unfold leRat, bleRat in *.
rattac.
arithNormalize.
apply plus_le_compat.
apply mult_le_compat; trivial.
repeat rewrite <- mult_assoc.
repeat rewrite (mult_comm x0).
repeat rewrite mult_assoc.
apply mult_le_compat; trivial.
apply mult_le_compat; trivial.
rewrite <- mult_assoc.
rewrite (mult_comm x1).
rewrite mult_assoc.
apply mult_le_compat; trivial.
Qed.
intuition.
eapply leRat_trans.
eapply ratAdd_leRat_compat_l; eauto.
rewrite ratAdd_comm.
eapply leRat_trans.
apply ratAdd_leRat_compat_l; eauto.
rewrite ratAdd_comm.
intuition.
Qed.
rattac.
nia.
Qed.
Add Parametric Morphism : ratAdd
with signature (leRat ==> leRat ==> leRat)
as ratAdd_leRat_mor.
intuition.
eapply ratAdd_leRat_compat; trivial.
Qed.
Add Parametric Morphism : ratAdd
with signature (eqRat ==> eqRat ==> eqRat)
as ratAdd_eqRat_mor.
intuition.
eapply ratAdd_eqRat_compat; trivial.
Qed.
rattac.
repeat rewrite mult_assoc.
rewrite <- (mult_assoc n1).
rewrite (mult_comm n).
rewrite mult_assoc.
rewrite <- mult_assoc.
rewrite e.
rewrite e0.
rewrite mult_assoc.
do 3 arithSimplify.
Qed.
Add Parametric Morphism : ratMult
with signature (leRat ==> leRat ==> leRat)
as ratMult_leRat_mor.
intuition.
eapply ratMult_leRat_compat; trivial.
Qed.
Add Parametric Morphism : ratMult
with signature (eqRat ==> eqRat ==> eqRat)
as ratMult_eqRat_mor.
intuition.
eapply ratMult_eqRat_compat; trivial.
Qed.
intuition.
rattac.
rewrite mult_0_l in e.
unfold posnatToNat in *.
simpl in *.
destruct p1.
destruct p0.
rewrite mult_1_r in e.
apply plus_is_O in e.
intuition.
eapply mult_is_O in H0.
intuition.
rattac.
rewrite mult_0_l in e.
unfold posnatToNat in *.
simpl in *.
destruct p1.
destruct p0.
rewrite mult_1_r in e.
apply plus_is_O in e.
intuition.
eapply mult_is_O in H1.
intuition.
rewrite (ratAdd_0_r 0).
eapply ratAdd_eqRat_compat; eauto.
Qed.
intuition.
destruct (eq_Rat_dec r1 0); intuition.
destruct (eq_Rat_dec r2 0); intuition.
exfalso.
eapply H.
apply ratAdd_0; eauto.
apply H1.
specialize (ratAdd_0 r1 r2); intuition.
apply H1.
specialize (ratAdd_0 r1 r2); intuition.
Qed.
rattac.
Qed.
intuition; destruct r.
unfold ratMult.
simpl.
unfold natToPosnat, posnatMult; simpl.
destruct p.
apply rat_num_0.
Qed.
rattac.
Qed.
rattac.
inversion H; clear H; subst.
repeat rewrite mult_1_l in *.
trivial.
Qed.
intuition.
rattac.
rewrite mult_0_l in e.
unfold posnatToNat in *.
simpl in *.
rewrite mult_1_r in e.
apply mult_is_O in e.
intuition; subst.
left.
apply rat_num_0.
right.
apply rat_num_0.
rewrite <- (ratMult_0_l r2).
eapply ratMult_eqRat_compat; intuition.
rewrite <- (ratMult_0_r r1).
eapply ratMult_eqRat_compat; intuition.
Qed.
intuition.
eapply H.
specialize (ratMult_0 r1 r2); intuition.
eapply H.
specialize (ratMult_0 r1 r2); intuition.
apply ratMult_0 in H0.
intuition.
Qed.
rattac.
eapply mult_le_compat; eauto.
Qed.
rattac.
Qed.
rattac.
Qed.
intuition.
Qed.
intuition.
unfold bleRat in *.
rattac.
Qed.
rattac;
unfold ratDistance, ratSubtract in *;
rattac;
unfold minRat, maxRat in *;
rattac.
case_eq (bleRat (RatIntro n (exist (fun n : nat => n > 0) x2 g2))
(RatIntro n0 (exist (fun n : nat => n > 0) x1 g1))); intuition.
rewrite H1 in H2.
rewrite H1 in H0.
rattac.
rewrite H1 in H2.
rewrite H1 in H0.
rattac.
case_eq (bleRat (RatIntro n0 (exist (fun n : nat => n > 0) x0 g0))
(RatIntro n1 (exist (fun n : nat => n > 0) x g))); intuition.
rewrite H0 in H1.
rewrite H0 in H2.
rattac.
inversion e; clear e; subst.
apply mult_is_O in H2; intuition.
unfold posnatMult in *.
inversion H5; clear H5; subst.
assert ((RatIntro n4 (exist (fun n : nat => n > 0) x0 g0)) <= (RatIntro n3 (exist (fun n : nat => n > 0) x g))).
unfold leRat.
trivial.
eapply nat_minus_eq.
apply (leRat_mult H2).
trivial.
rewrite H0 in H1.
rewrite H0 in H2.
rattac.
unfold posnatMult in *.
simpl in *.
inversion H5; clear H5; subst.
apply mult_is_O in e. intuition.
symmetry.
eapply nat_minus_eq; trivial.
apply bleRat_total in H0.
assert (leRat (RatIntro n4 (exist (fun n : nat => n > 0) x g))
(RatIntro n3 (exist (fun n : nat => n > 0) x0 g0))).
apply H0.
apply (leRat_mult H2).
Qed.
(* is this even true ? Lemma ratDistance_comm_2 : forall r1 r2 r3 r4, ratDistance (ratDistance r1 r2) (ratDistance r3 r4) == ratDistance (ratDistance r1 r3) (ratDistance r2 r4).  intuition.  unfold ratDistance, ratSubtract. rattac. arithNormalize.  Lemma minus_eq_compat : forall n1 n2 n3 n4, n1 = n2 -> n3 = n4 -> n1 - n3 = n2 - n4.  intuition. Qed.  apply minus_eq_compat. arithSimplify. rewrite (mult_comm _ x). arithNormalize. arithSimplify. unfold minRat, maxRat in *. case_eq (bleRat (RatIntro (n7 * p8 - n8 * p7) (posnatMult p7 p8)) (RatIntro (n9 * p10 - n10 * p9) (posnatMult p9 p10))); intuition; case_eq ( bleRat (RatIntro (n3 * p4 - n4 * p3) (posnatMult p3 p4)) (RatIntro (n5 * p6 - n6 * p5) (posnatMult p5 p6))); intuition. case_eq (bleRat (RatIntro (n7 * p8 - n8 * p7) (posnatMult p7 p8)) (RatIntro (n9 * p10 - n10 * p9) (posnatMult p9 p10))); intuition. case_eq (bleRat (RatIntro (n3 * p4 - n4 * p3) (posnatMult p3 p4)) (RatIntro (n5 * p6 - n6 * p5) (posnatMult p5 p6))); intuition. rewrite H11 in H. rewrite H12 in H1. rewrite H13 in H0. rewrite H14 in H2.  inversion H; clear H; subst. inversion H0; clear H0; subst. inversion H1; clear H1; subst. inversion H2; clear H2; subst.  unfold posnatMult in *. destruct p9; destruct p10. destruct p5; destruct p6. destruct p7; destruct p8. destruct p3; destruct p4. simpl in *. inversion H1; clear H1; subst. inversion H15; clear H15; subst. inversion H16; clear H16; subst. inversion H17; clear H17; subst.  unfold minRat in *.  destruct p7.  SearchAbout minus. rattac_one. rattac_one. Abort. *)
rattac.
unfold ratSubtract in *.
rattac.
arithNormalize.
rewrite <- NPeano.Nat.add_sub_swap.
eapply minus_eq_compat.
rewrite minus_add_assoc.
rewrite plus_comm.
rewrite <- minus_add_assoc.
rewrite <- plus_0_r at 1.
apply plus_eq_compat.
do 4 arithSimplify.
symmetry.
eapply minus_diag_eq.
do 4 arithSimplify.
apply le_eq.
do 5 arithSimplify.
do 4 (apply mult_le_compat; trivial).
do 4 arithSimplify.
do 4 (apply mult_le_compat; trivial).
Qed.
rattac.
arithNormalize.
assert (n * x * x0 <= n0 * x0 * x1)%nat.
rewrite (mult_comm (n0 * x0) x1).
rewrite mult_assoc.
apply mult_le_compat; trivial.
rewrite (mult_comm x1).
trivial.
rewrite <- plus_0_r at 1.
apply plus_le_compat; eauto.
apply le_0_n.
Qed.
intros.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
apply ratAdd_comm.
}
apply ratAdd_any_leRat_l; eauto.
Qed.
intuition.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply eqRat_symm.
eapply H.
}
apply ratAdd_any_leRat_l.
apply leRat_refl.
Qed.
intuition.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply eqRat_symm.
eapply H.
}
apply ratAdd_any_leRat_r.
apply leRat_refl.
Qed.
rattac.
unfold ratSubtract in *.
rattac.
unfold posnatMult in *.
inversion H4; clear H4; subst.
inversion H3; clear H3; subst.
arithNormalize.
assert (n * x3 * x3 * x1 <= n0 * x3 * x3 * x2)%nat.
rewrite <- mult_comm.
rewrite <- (mult_comm x2).
repeat rewrite mult_assoc.
eapply mult_le_compat; trivial.
eapply mult_le_compat; trivial.
rewrite mult_comm.
rewrite l.
rewrite mult_comm.
trivial.
assert (n3 * x1 * x3 * x2 = n3 * x2 * x3 * x1)%nat.
do 3 arithSimplify.
omega.
Qed.
rattac.
unfold ratSubtract in *.
rattac.
unfold posnatMult in *.
inversion H4; clear H4; subst.
inversion H3; clear H3; subst.
arithNormalize.
assert (n * x3 * x1 * x3 <= n0 * x3 * x2 * x3)%nat.
apply mult_le_compat; trivial.
rewrite <- (mult_comm x1).
rewrite <- (mult_comm x2).
repeat rewrite mult_assoc.
apply mult_le_compat; trivial.
rewrite mult_comm.
rewrite l.
rewrite mult_comm.
trivial.
assert (n3 * x2 * x1 * x3 = n3 * x1 * x2 * x3)%nat.
do 3 arithSimplify.
omega.
Qed.
intuition.
eapply leRat_trans.
eapply ratSubtract_leRat_l; eauto.
eapply ratSubtract_leRat_r; eauto.
Qed.
intuition.
unfold ratSubtract.
rattac.
inversion l; clear l; subst.
omega.
rewrite H0.
unfold posnatToNat in *.
omega.
Qed.
intuition.
case_eq (bleRat r3 r1); intuition.
case_eq (bleRat r2 r3); intuition.
rewrite ratSubtract_partition; eauto.
rewrite ratAdd_comm.
eapply ratAdd_leRat_compat;
intuition.
eapply bleRat_total in H2.
rewrite ratAdd_0_r.
eapply ratAdd_leRat_compat.
eapply leRat_trans; eauto.
eapply ratSubtract_leRat;
intuition.
eapply rat0_le_all.
apply bleRat_total in H1.
case_eq (bleRat r2 r3); intuition.
rewrite ratAdd_0_l.
eapply ratAdd_leRat_compat.
eapply rat0_le_all.
eapply leRat_trans; eauto.
eapply ratSubtract_leRat;
intuition.
apply bleRat_total in H2.
rewrite ratSubtract_0.
eapply rat0_le_all.
eapply leRat_trans; eauto.
Qed.
intuition.
unfold ratDistance, maxRat, minRat in *.
case_eq (bleRat r1 r3); intuition.
case_eq (bleRat r3 r2); intuition.
assert (bleRat r1 r2 = true).
eapply leRat_trans; eauto.
rewrite H1.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply ratAdd_comm.
}
eapply ratSubtract_partition_leRat; eapply leRat_refl.
case_eq (bleRat r1 r2); intuition.
apply bleRat_total in H0.
eapply leRat_trans.
2:{
eapply eqRat_impl_leRat.
eapply ratAdd_comm.
}
eapply ratSubtract_partition_leRat.
eapply ratSubtract_leRat; eauto.
intuition.
apply bleRat_total in H1.
apply bleRat_total in H0.
eapply ratSubtract_partition_leRat.
rewrite ratSubtract_0.
eapply rat0_le_all.
eapply leRat_refl.
eapply ratSubtract_leRat; intuition.
apply bleRat_total in H.
case_eq (bleRat r1 r2); intuition.
assert (bleRat r3 r2 = true).
eapply leRat_trans; eauto.
rewrite H1.
apply ratAdd_any_leRat_r.
eapply ratAdd_eq_impl_leRat_r.
eapply ratSubtract_partition; eauto.
apply bleRat_total in H0.
case_eq (bleRat r3 r2); intuition.
apply ratAdd_any_leRat_l.
eapply ratAdd_eq_impl_leRat_r.
eapply ratSubtract_partition; eauto.
apply bleRat_total in H1.
eapply eqRat_impl_leRat.
rewrite ratAdd_comm.
eapply ratSubtract_partition; eauto.
Qed.
intuition.
rewrite ratMult_comm.
apply ratMult_1_l.
Qed.
intuition.
Qed.
intuition.
unfold ratSubtract.
rattac.
arithNormalize.
apply minus_le.
rewrite <- (mult_assoc n).
rewrite (mult_comm x0).
rewrite mult_assoc.
apply mult_le_compat; trivial.
Qed.
intuition.
eapply leRat_trans.
eapply ratTriangleInequality.
eapply ratAdd_leRat_compat; eauto.
Qed.
intuition.
unfold ratDistance, maxRat, minRat.
case_eq (bleRat r1 r2); intuition;
apply ratSubtract_le; eauto.
Qed.
intuition.
unfold ratSubtract.
rattac.
inversion e0; clear e0; subst.
inversion e; clear e; subst.
arithNormalize.
apply minus_eq_compat.
arithSimplify.
rewrite <- (mult_assoc n1).
rewrite (mult_comm x2).
rewrite mult_assoc.
arithSimplify.
trivial.
rewrite <- (mult_assoc (n2 * x1)).
rewrite (mult_comm x).
rewrite mult_assoc.
arithSimplify.
rewrite <- (mult_assoc n2).
rewrite (mult_comm x1 x0).
rewrite mult_assoc.
arithSimplify.
rewrite mult_comm.
trivial.
Qed.
Add Parametric Morphism : ratSubtract
with signature (eqRat ==> eqRat ==> eqRat)
as ratSubtract_eqRat_mor.
intuition.
eapply ratSubtract_eqRat_compat; trivial.
Qed.
rattac.
Qed.
intuition.
unfold maxRat.
case_eq (bleRat r1 r2); intuition;
case_eq (bleRat r3 r4); intuition.
apply bleRat_total in H2.
eapply leRat_impl_eqRat;
eauto using leRat_trans, eqRat_impl_leRat, eqRat_symm.
apply bleRat_total in H1.
eapply leRat_impl_eqRat;
eauto using leRat_trans, eqRat_impl_leRat, eqRat_symm.
Qed.
Add Parametric Morphism : maxRat
with signature (eqRat ==> eqRat ==> eqRat)
as maxRat_eqRat_mor.
intuition.
eapply maxRat_eqRat_compat; trivial.
Qed.
intuition.
unfold minRat.
case_eq (bleRat r1 r2); intuition;
case_eq (bleRat r3 r4); intuition.
apply bleRat_total in H2.
eapply leRat_impl_eqRat;
eauto using leRat_trans, eqRat_impl_leRat, eqRat_symm.
apply bleRat_total in H1.
eapply leRat_impl_eqRat;
eauto using leRat_trans, eqRat_impl_leRat, eqRat_symm.
Qed.
Add Parametric Morphism : minRat
with signature (eqRat ==> eqRat ==> eqRat)
as minRat_eqRat_mor.
intuition.
eapply minRat_eqRat_compat; trivial.
Qed.
intuition.
unfold ratDistance.
eauto using ratSubtract_eqRat_compat, maxRat_eqRat_compat, minRat_eqRat_compat.
Qed.
Add Parametric Morphism : ratDistance
with signature (eqRat ==> eqRat ==> eqRat)
as ratDistance_eqRat_mor.
intuition.
eapply ratDistance_eqRat_compat; trivial.
Qed.
intuition.
unfold ratSubtract.
rattac.
arithNormalize.
rewrite (plus_comm (n2 * x0 * x1 * x0 * x1 * x)).
rewrite NPeano.Nat.sub_add_distr.
apply minus_eq_compat.
rewrite <- NPeano.Nat.add_sub_assoc.
rewrite minus_diag_eq.
rewrite plus_0_r.
do 5 arithSimplify.
do 5 arithSimplify.
eapply le_eq.
do 5 arithSimplify.
do 5 arithSimplify.
Qed.
intuition.
unfold ratSubtract.
rattac.
arithNormalize.
rewrite NPeano.Nat.sub_add_distr.
apply minus_eq_compat.
rewrite plus_comm.
rewrite <- NPeano.Nat.add_sub_assoc.
rewrite minus_diag_eq.
rewrite plus_0_r.
do 5 arithSimplify.
do 5 arithSimplify.
eapply le_eq.
do 5 arithSimplify.
do 5 arithSimplify.
Qed.
intuition.
Qed.
intuition.
unfold ratSubtract.
rattac.
arithNormalize.
rewrite  minus_plus_assoc.
f_equal.
f_equal.
do 5 arithSimplify.
do 5 arithSimplify.
do 3 (eapply mult_le_compat; trivial).
repeat rewrite <- mult_assoc.
repeat rewrite (mult_comm x).
repeat rewrite mult_assoc.
apply mult_le_compat; trivial.
Qed.
intuition.
assert (ratSubtract (r1 + r2) r2 == ratSubtract (r3 + r2) r2).
eapply ratSubtract_eqRat_compat; intuition.
rewrite ratSubtract_ratAdd_assoc in H0.
setoid_rewrite ratAdd_0_r.
eapply eqRat_trans.
eapply ratAdd_eqRat_compat.
eapply eqRat_refl.
eapply eqRat_symm.
apply (@ratSubtract_0 r2 r2).
eapply leRat_refl.
rewrite H0.
rewrite ratSubtract_ratAdd_assoc.
eapply ratAdd_eqRat_compat.
intuition.
apply ratSubtract_0.
eapply leRat_refl.
apply leRat_refl.
apply leRat_refl.
Qed.
intuition.
eapply ratAdd_add_same_r.
eapply eqRat_trans.
apply ratAdd_comm.
rewrite H.
apply ratAdd_comm.
Qed.
intuition.
unfold ratDistance, maxRat, minRat.
case_eq (bleRat r1 r3); intuition.
assert (r1 + r2 <= r3 + r2).
eapply ratAdd_leRat_compat; trivial.
eapply leRat_refl.
rewrite H0.
apply ratSubtract_add_same_r; eauto.
apply bleRat_total in H.
assert (r3 + r2 <= r1 + r2).
eapply ratAdd_leRat_compat; trivial.
apply leRat_refl.
case_eq (bleRat (r1 + r2) (r3 + r2)); intuition.
assert (r1 + r2 == r3 + r2).
eapply leRat_antisymm; eauto.
repeat rewrite ratSubtract_0.
intuition.
eapply eqRat_impl_leRat.
eapply ratAdd_add_same_r.
eauto.
eapply eqRat_impl_leRat.
eapply eqRat_symm.
trivial.
apply ratSubtract_add_same_r; eauto.
Qed.
intuition.
unfold ratDistance, maxRat, minRat.
case_eq (bleRat r3 r1); intuition.
assert (r2 + r3 <= r2 + r1).
eapply ratAdd_leRat_compat; trivial.
eapply leRat_refl.
rewrite H0.
apply ratSubtract_add_same_l; eauto.
apply bleRat_total in H.
assert (r2 + r1 <= r2 + r3).
eapply ratAdd_leRat_compat; trivial.
apply leRat_refl.
case_eq (bleRat (r2 + r3) (r2 + r1)); intuition.
assert (r2 + r3 == r2 + r1).
eapply leRat_antisymm; eauto.
repeat rewrite ratSubtract_0.
intuition.
eapply eqRat_impl_leRat.
eapply ratAdd_add_same_l.
eauto.
eapply eqRat_impl_leRat.
eapply eqRat_symm.
trivial.
apply ratSubtract_add_same_l; eauto.
Qed.
intuition.
eapply leRat_trans.
eapply (ratTriangleInequality _ _ (r3 + r2)).
eapply ratAdd_leRat_compat.
eapply eqRat_impl_leRat.
eapply ratDistance_add_same_r.
eapply eqRat_impl_leRat.
eapply ratDistance_add_same_l.
Qed.
rattac.
inversion H1; clear H1; subst.
inversion H0; clear H0; subst.
inversion H; clear H; subst.
arithNormalize.
f_equal.
do 5 arithSimplify.
do 5 arithSimplify.
Qed.
rattac.
inversion H0; clear H0; subst.
omega.
Qed.
rattac.
arithNormalize.
trivial.
Qed.
rattac.
Qed.
intuition.
unfold ratMult, natToPosnat, posnatMult.
eapply eqRat_refl.
Qed.
rattac.
arithNormalize.
arithSimplify.
Qed.
intuition.
assert (n = 1 * n)%nat.
omega.
rewrite H at 1.
apply ratMult_num_den; omega.
Qed.
unfold ratAdd.
simpl.
unfold posnatMult.
simpl.
apply (@num_dem_same_rat1 4 _).
simpl.
trivial.
Qed.
rattac.
unfold natToPosnat in *.
inversion H0; clear H0; subst.
repeat rewrite mult_1_r.
inversion H; clear H; subst.
trivial.
Qed.
intuition.
unfold ratDistance, maxRat, minRat.
case_eq (bleRat r1 r2); case_eq (bleRat r2 r1); intuition.
apply ratSubtract_eqRat_compat;
eapply leRat_antisymm; eauto.
apply bleRat_total in H.
apply bleRat_total in H0.
apply ratSubtract_eqRat_compat;
eapply leRat_antisymm; eauto.
Qed.
intuition.
rewrite ratMult_comm.
rewrite ratMult_distrib.
eapply ratAdd_eqRat_compat; eapply ratMult_comm.
Qed.
intuition.
unfold ratSubtract.
rattac.
arithNormalize.
rewrite <- (mult_assoc (n1 * x)).
rewrite (mult_comm x x0).
rewrite mult_assoc.
remember (n1 * x * x0 * x)%nat as a.
repeat rewrite <- (mult_assoc n0).
rewrite (mult_comm x).
omega.
Qed.
intuition.
apply eqRat_symm.
eapply eqRat_trans.
2:{
apply ratSubtract_ratAdd_assoc.
trivial.
}
apply eqRat_symm.
apply ratSubtract_ratAdd_inverse.
Qed.
intuition.
exists (ratSubtract r1 r2).
apply eqRat_symm.
apply ratSubtract_ratAdd_inverse_2.
trivial.
Qed.
intuition.
destruct (leRat_difference_exists H).
destruct (leRat_difference_exists H0).
eapply eqRat_trans.
apply ratSubtract_eqRat_compat.
eapply eqRat_trans.
apply ratMult_eqRat_compat.
apply H1.
apply H2.
eapply eqRat_trans.
apply ratMult_distrib_r.
eapply eqRat_trans.
eapply ratAdd_eqRat_compat.
apply ratMult_comm.
apply ratMult_comm.
apply ratAdd_eqRat_compat.
apply ratMult_distrib_r.
apply ratMult_distrib_r.
apply eqRat_refl.
eapply eqRat_trans.
eapply ratSubtract_eqRat_compat.
apply ratAdd_assoc.
apply ratMult_comm.
eapply eqRat_trans.
apply ratSubtract_ratAdd_inverse.
rewrite <- ratAdd_assoc.
apply ratAdd_eqRat_compat.
rewrite ratAdd_comm.
apply ratAdd_eqRat_compat.
rewrite ratMult_comm.
apply ratMult_eqRat_compat.
eapply eqRat_symm.
eapply eqRat_trans.
eapply ratSubtract_eqRat_compat.
apply H1.
apply eqRat_refl.
apply ratSubtract_ratAdd_inverse.
intuition.
apply ratMult_eqRat_compat.
apply eqRat_symm.
eapply eqRat_trans.
apply ratSubtract_eqRat_compat.
apply H2.
apply eqRat_refl.
apply ratSubtract_ratAdd_inverse.
intuition.
rewrite ratMult_comm.
apply ratMult_eqRat_compat.
apply eqRat_symm.
eapply eqRat_trans.
apply ratSubtract_eqRat_compat.
apply H1.
apply eqRat_refl.
apply ratSubtract_ratAdd_inverse.
apply eqRat_symm.
eapply eqRat_trans.
apply ratSubtract_eqRat_compat.
apply H2.
apply eqRat_refl.
apply ratSubtract_ratAdd_inverse.
Qed.
rattac.
unfold ratSubtract in *.
rattac.
match goal with
H: (_ * (?x*_) = _ * (?x*_))%nat |- _
=> eapply (@mult_same_l (x * x)); nia
end.
Qed.
intuition.
unfold ratDistance, maxRat, minRat.
case_eq (bleRat r3 v); intuition.
assert (r2 <= v).
rewrite H0.
eauto.
rewrite H2.
assert (r1 <= v).
rewrite H.
eauto.
rewrite H3.
assert ((ratSubtract v r3) <= (ratSubtract v r1)).
eapply ratSubtract_leRat_r.
eauto using leRat_trans.
case_eq (bleRat (ratSubtract v r1) (ratSubtract v r3)); intuition.
assert (r1 == r3).
assert ((ratSubtract v r1) == (ratSubtract v r3)).
eapply leRat_antisymm; eauto.
eapply ratSubtract_eq_r; eauto.
eapply ratSubtract_leRat_r.
rewrite <- H6.
trivial.
eapply ratSubtract_leRat_r.
trivial.
eapply bleRat_total in H1.
case_eq (bleRat r2 v); intuition.
assert (r1 <= v).
eauto using leRat_trans.
rewrite H3.
case_eq (bleRat (ratSubtract v r1) (ratSubtract r3 v)); intuition.
eapply leRat_trans.
eapply ratSubtract_leRat_r.
eapply H.
eapply H4.
eapply ratSubtract_leRat_r; trivial.
apply bleRat_total in H2.
case_eq (bleRat r1 v); intuition.
case_eq (bleRat (ratSubtract v r1) (ratSubtract r3 v)); intuition.
assert (r1 <= v).
eauto using leRat_trans.
eapply ratSubtract_leRat_l; trivial.
apply bleRat_total in H4.
eapply leRat_trans.
eapply ratSubtract_leRat_l.
eapply H0.
trivial.
assert (bleRat (ratSubtract r1 v) (ratSubtract r3 v) = true).
eapply ratSubtract_leRat_l.
eauto using leRat_trans.
rewrite H4.
eapply ratSubtract_leRat_l; trivial.
Qed.
intuition.
unfold maxRat in *.
case_eq (bleRat r1 r2); intuition.
Qed.
rattac.
inversion H; clear H; subst.
inversion H0; clear H0; subst.
simpl.
arithNormalize.
repeat rewrite mult_0_r.
repeat rewrite plus_0_r.
trivial.
Qed.
rattac.
inversion H0; clear H0; subst.
rewrite mult_1_r in l.
rewrite mult_1_l in l.
rewrite mult_assoc.
rewrite <- (mult_assoc n2).
rewrite (mult_comm n).
rewrite mult_assoc.
apply mult_le_compat;
auto.
Qed.
intuition.
unfold ratDistance, maxRat, minRat in *.
case_eq (bleRat r1 r3); intuition;
rewrite H5 in H.
case_eq (bleRat r2 r4); intuition;
rewrite H6 in H0.
assert (r1 * r2 <= r3 * r4).
apply ratMult_leRat_compat; eauto.
rewrite H7.
rewrite ratSubtract_ratMult_le; eauto.
repeat rewrite ratMult_small_le.
rewrite H.
rewrite H0.
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_3_ratAdd.
eapply ratSubtract_le.
trivial.
trivial.
trivial.
apply bleRat_total in H6.
case_eq (bleRat (r1 * r2) (r3 * r4)); intuition.
rewrite ratSubtract_leRat.
2:{
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply H6.
}
2:{
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply H6.
}
rewrite ratSubtract_ratMult_le; eauto.
repeat rewrite ratMult_small_le.
rewrite H.
rewrite H0.
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_3_ratAdd.
eapply ratSubtract_le.
trivial.
trivial.
trivial.
apply bleRat_total in H7.
eapply leRat_trans.
eapply ratSubtract_leRat.
eapply ratMult_leRat_compat.
eapply H5.
eapply leRat_refl.
eapply ratMult_leRat_compat.
eapply H5.
eapply leRat_refl.
rewrite ratSubtract_ratMult_le; eauto.
repeat rewrite ratMult_small_le.
rewrite H.
rewrite H0.
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_3_ratAdd.
eapply ratSubtract_le.
trivial.
trivial.
trivial.
apply bleRat_total in H5.
case_eq (bleRat r2 r4); intuition.
rewrite H6 in H0.
case_eq (bleRat (r1 * r2) (r3 * r4)); intuition.
eapply leRat_trans.
eapply ratSubtract_leRat.
eapply ratMult_leRat_compat.
eapply H5.
eapply leRat_refl.
eapply ratMult_leRat_compat.
eapply H5.
eapply leRat_refl.
rewrite ratSubtract_ratMult_le; eauto.
repeat rewrite ratMult_small_le.
rewrite H.
rewrite H0.
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_3_ratAdd.
eapply ratSubtract_le.
trivial.
trivial.
trivial.
apply bleRat_total in H7.
eapply leRat_trans.
eapply ratSubtract_leRat.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply H6.
eapply ratMult_leRat_compat.
eapply leRat_refl.
eapply H6.
rewrite ratSubtract_ratMult_le; eauto.
repeat rewrite ratMult_small_le.
rewrite H.
rewrite H0.
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_3_ratAdd.
eapply ratSubtract_le.
trivial.
trivial.
trivial.
rewrite H6 in H0.
apply bleRat_total in H6.
assert (r3 * r4 <= r1 * r2).
eapply ratMult_leRat_compat; eauto.
case_eq (bleRat (r1 * r2) (r3 * r4)); intuition.
rewrite ratSubtract_0; eauto.
eapply rat0_le_all.
apply bleRat_total in H8.
rewrite ratSubtract_ratMult_le; eauto.
repeat rewrite ratMult_small_le.
rewrite H.
rewrite H0.
eapply eqRat_impl_leRat.
symmetry.
eapply ratMult_3_ratAdd.
eapply ratSubtract_le.
trivial.
trivial.
trivial.
Qed.
intuition.
eapply leRat_trans.
eapply eqRat_impl_leRat.
apply ratAdd_0_r.
eapply leRat_trans.
eapply ratAdd_leRat_compat.
apply leRat_refl.
apply rat0_le_all.
eauto.
Qed.
intuition.
unfold posnatMult.
destruct p.
remember (pos 1) as p2.
destruct p2.
unfold posnatToNat.
inversion Heqp2; subst.
apply mult_1_r.
Qed.
rattac.
unfold posnatToNat, natToPosnat in *.
destruct d.
simpl in *.
omega.
Qed.
intuition.
rewrite H.
rewrite <- (ratMult_1_r r2) at 2.
rewrite ratMult_assoc.
eapply ratMult_eqRat_compat.
intuition.
rewrite <- ratMult_num_den.
eapply num_dem_same_rat1.
rattac.
Qed.
intuition.
eapply ratMult_inverse.
rewrite H.
eapply ratMult_eqRat_compat.
intuition.
eapply eqRat_terms; eauto.
Qed.
intuition.
unfold ratMult in *.
destruct r1.
destruct r2.
destruct r3.
unfold eqRat, beqRat in *.
simpl in *.
unfold posnatMult, posnatToNat, natToPosnat in *.
destruct p1.
destruct p0.
destruct p.
destruct (eq_nat_dec (n * n0 * (x * x0)) (n1 * n0 * (x1 * x0))); try congruence.
destruct (eq_nat_dec (n * x) (n1 * x1)).
trivial.
exfalso.
eapply n2.
clear n2.
arithNormalize.
rewrite <- (mult_assoc n) in e.
rewrite (mult_comm n0) in e.
arithNormalize.
rewrite <- mult_assoc in e.
rewrite <- (mult_assoc n1) in e.
rewrite <- (mult_comm x1) in e.
rewrite (mult_assoc n1) in e.
rewrite <- (mult_assoc (n1 * x1)) in e.
eapply mult_same_r.
2:{
eapply e.
}
rewrite mult_0_r in H0.
rewrite plus_0_l in H0.
destruct (eq_nat_dec n0 0); intuition.
assert (~n0 * x0 = O)%nat.
intuition.
eapply mult_is_O in H1.
intuition.
remember (n0 * x0)%nat as a.
omega.
Qed.
rattac.
inversion H1; clear H1; subst.
rewrite mult_1_r.
rewrite mult_1_l.
trivial.
Qed.
rattac.
inversion H; clear H; subst.
arithNormalize.
do 2 arithSimplify.
Qed.
rattac.
inversion H; clear H; subst.
arithNormalize.
rewrite mult_0_r.
rewrite plus_0_r.
f_equal.
f_equal.
rewrite <- mult_assoc.
rewrite <- mult_assoc.
rewrite mult_comm.
simpl.
trivial.
Qed.
(* ratInverse only works correctly when the number is positive *)
Definition ratInverse (r : Rat) :=
match r with
| RatIntro n d =>
match n with
| O => RatIntro d (pos (S O))
| S n' => RatIntro d (pos (S n'))
end
end.
intuition.
unfold ratInverse.
destruct r.
destruct n.
exfalso.
eapply H.
eapply rat_num_0.
rewrite <- ratMult_num_den.
eapply num_dem_same_rat1.
unfold posnatMult, natToPosnat, posnatToNat.
destruct p.
apply mult_comm.
Qed.
Fixpoint expRat r n :=
match n with
| O => rat1
| S n' => r * (expRat r n')
end.
intuition.
unfold ratInverse in *.
rattac.
destruct n0.
unfold posnatToNat, natToPosnat in *.
destruct p.
destruct p0.
inversion H0; clear H0; subst.
rewrite mult_1_r in e.
rewrite mult_1_r in e.
omega.
unfold posnatToNat, natToPosnat in *.
destruct p.
destruct p0.
inversion H0; clear H0; subst.
rewrite mult_1_r in e.
rewrite mult_0_l in e.
omega.
Qed.
intuition.
unfold ratInverse.
destruct r.
destruct n.
exfalso.
eapply H.
eapply rat_num_0.
rattac.
inversion H1; clear H1; subst.
omega.
Qed.
unfold ratInverse.
case_eq rat1; intuition.
inversion H; clear H; subst.
eapply eqRat_terms;
trivial.
Qed.
intuition.
unfold ratInverse.
rattac.
destruct n0.
exfalso.
eapply H.
eapply rat_num_0.
destruct n.
exfalso.
rewrite mult_0_l in l.
simpl in *.
remember (n0 * x1)%nat as a.
nia.
inversion H3; clear H3; subst.
inversion H2; clear H2; subst.
nia.
Qed.
rattac.
eapply H0.
unfold posnatMult, natToPosnat, posnatToNat in *.
destruct p1.
destruct p0.
rewrite mult_plus_distr_r in l.
rewrite <- mult_assoc in l.
rewrite (mult_comm x) in l.
assert ((n1 * x0 * x0) = O)%nat.
remember (n0 * (x0 * x))%nat as a.
remember (n1 * x0 * x0)%nat as b.
omega.
apply mult_is_O in H1;
intuition;
subst.
apply mult_is_O in H2;
intuition;
subst.
apply rat_num_0.
omega.
omega.
Qed.
(* relational versions of arithmetic operations. *)
Definition ratSubtract_rel (r1 r2 : Rat -> Prop) d :=
forall r1' r2', r1 r1' -> r2 r2' -> d == ratSubtract r1' r2'.
Definition ratAdd_rel(r1 r2 : Rat -> Prop) r :=
forall r1' r2', r1 r1' -> r2 r2' -> r == r1' + r2'.
Definition ratMult_rel (r1 r2 : Rat -> Prop)(r : Rat) :=
forall r1' r2', r1 r1' -> r2 r2' -> r == r1' * r2'.
Definition expRat_rel (r1 : Rat -> Prop) n r :=
forall r1', r1 r1' -> r == expRat r1' n.
Definition ratInverse_rel (r : Rat -> Prop) v :=
forall r',
r r' -> v == ratInverse r'.

Lemma eqRat_flip : forall (p1 p2 p3 p4 : posnat),
RatIntro p1 p2 == RatIntro p3 p4 ->
RatIntro p2 p1 == RatIntro p4 p3.