MathClasses.orders.rationals
Require Import
Ring Field abstract_algebra interfaces.orders
interfaces.naturals interfaces.rationals interfaces.integers
natpair_integers theory.rationals theory.dec_fields theory.rings
orders.integers orders.dec_fields.
Section rationals_and_integers.
Context `{Rationals Q} `{!SemiRingOrder Qle}
Z `{Integers Z} `{Apart Z} `{!TrivialApart Z} `{!FullPseudoSemiRingOrder (A:=Z) Zle Zlt}
{f : Z → Q} `{!SemiRing_Morphism f}.
Add Field Q : (stdlib_field_theory Q).
Lemma rationals_decompose_pos_den x :
∃ num, ∃ den, 0 < den ∧ x = f num / f den.
Proof.
destruct (rationals_decompose x) as [num [den [E1 E2]]].
destruct (total (≤) den 0).
∃ (-num) (-den). split.
apply lt_iff_le_ne. split.
now apply rings.flip_nonpos_negate.
apply not_symmetry. now apply flip_negate_ne_0.
rewrite 2!preserves_negate. rewrite E2. field.
split.
apply flip_negate_ne_0. now apply injective_ne_0.
now apply injective_ne_0.
∃ num. ∃ den. split; try assumption.
apply lt_iff_le_ne. split. assumption. now apply not_symmetry.
Qed.
End rationals_and_integers.
Section rationals_and_another_rationals.
Context `{Rationals Q1} `{Apart Q1} `{!TrivialApart Q1} `{!FullPseudoSemiRingOrder (A:=Q1) Q1le Q1lt}.
Context `{Rationals Q2} `{Apart Q2} `{!TrivialApart Q2} `{!FullPseudoSemiRingOrder (A:=Q2) Q2le Q2lt}
{f : Q1 → Q2} `{!SemiRing_Morphism f}.
Add Field Q1 : (stdlib_field_theory Q1).
Notation i_to_r := (integers.integers_to_ring (SRpair nat) Q1).
Let f_preserves_nonneg x : 0 ≤ x → 0 ≤ f x.
Proof.
intros E.
destruct (rationals_decompose_pos_den (SRpair nat) x) as [num [den [E1 E2]]].
rewrite E2 in E |- ×. clear E2.
rewrite preserves_mult, preserves_dec_recip.
apply (order_reflecting_pos (.*.) (f (i_to_r den))).
change (0 < (f ∘ i_to_r) den).
rewrite (integers.to_ring_unique _).
apply semirings.preserves_pos. unfold lt in ×. apply E1.
apply (order_preserving_nonneg (.*.) (i_to_r den)) in E.
rewrite right_absorb. rewrite right_absorb in E.
rewrite (commutativity (f (i_to_r num))), associativity, dec_recip_inverse, left_identity.
rewrite (commutativity (i_to_r num)), associativity, dec_recip_inverse, left_identity in E.
change (0 ≤ (f ∘ i_to_r) num).
rewrite (integers.to_ring_unique _).
rewrite <-(preserves_0 (f:=integers_to_ring (SRpair nat) Q2)).
apply (order_preserving _).
apply (order_reflecting i_to_r).
now rewrite preserves_0.
apply injective_ne_0. now apply lt_ne_flip.
change ((f ∘ i_to_r) den ≠ 0).
apply injective_ne_0. now apply lt_ne_flip.
apply semirings.preserves_nonneg.
now apply lt_le.
Qed.
Instance morphism_order_preserving: OrderPreserving f.
Proof. apply semirings.preserving_preserves_nonneg. apply f_preserves_nonneg. Qed.
End rationals_and_another_rationals.
Section rationals_order_isomorphic.
Context `{Rationals Q1} `{Apart Q1} `{!TrivialApart Q1} `{!FullPseudoSemiRingOrder (A:=Q1) Q1le Q1lt}
`{Rationals Q2} `{Apart Q2} `{!TrivialApart Q2} `{!FullPseudoSemiRingOrder (A:=Q2) Q2le Q2lt}
{f : Q1 → Q2} `{!SemiRing_Morphism f}.
Global Instance: OrderEmbedding f.
Proof.
split.
apply morphism_order_preserving.
repeat (split; try apply _).
intros x y E.
rewrite <-(to_rationals_involutive x (Q2:=Q2)), <-(to_rationals_involutive y (Q2:=Q2)).
rewrite <-2!(to_rationals_unique f).
now apply (morphism_order_preserving (f:=rationals_to_rationals Q2 Q1)).
Qed.
End rationals_order_isomorphic.
Instance rationals_le `{Rationals Q} : Le Q | 10 := λ x y,
∃ num, ∃ den, y = x + naturals_to_semiring nat Q num / naturals_to_semiring nat Q den.
Instance rationals_lt `{Rationals Q} : Lt Q | 10 := dec_lt.
Section default_order.
Context `{Rationals Q} `{Apart Q} `{!TrivialApart Q}.
Add Field F: (stdlib_field_theory Q).
Notation n_to_sr := (naturals_to_semiring nat Q).
Instance: Proper ((=) ==> (=) ==> iff) rationals_le.
Proof.
intros x x' E y y' E'. unfold rationals_le.
split; intros [n [d d_nonzero]]; ∃ n d.
now rewrite <-E, <-E'.
now rewrite E, E'.
Qed.
Instance: Reflexive rationals_le.
Proof. intro. ∃ (0:nat) (0:nat). rewrite preserves_0. ring. Qed.
Lemma rationals_decompose_le (x y: Q) :
x ≤ y → ∃ num, ∃ den, den ≠ 0 ∧ y = x + n_to_sr num × / n_to_sr den.
Proof with eauto.
intros [n [d E]].
destruct (decide (d = 0)) as [A|A]...
∃ (0:nat) (1:nat).
split. discriminate.
rewrite E, A, preserves_0, preserves_1, dec_recip_0.
ring.
Qed.
Instance: Transitive rationals_le.
Proof with auto.
intros x y z E1 E2.
destruct (rationals_decompose_le x y) as [n1 [d1 [A1 B1]]]...
destruct (rationals_decompose_le y z) as [n2 [d2 [A2 B2]]]...
∃ (n1 × d2 + n2 × d1) (d1 × d2).
rewrite B2, B1.
rewrite preserves_plus.
rewrite ?preserves_mult.
field. split; now apply injective_ne_0.
Qed.
Instance: AntiSymmetric rationals_le.
Proof with auto.
intros x y E1 E2.
destruct (rationals_decompose_le x y) as [n1 [d1 [A1 B1]]]...
destruct (rationals_decompose_le y x) as [n2 [d2 [A2 B2]]]...
rewrite B1 in B2 |- ×.
clear E1 E2 B1 y.
rewrite <-associativity in B2. rewrite <-(plus_0_r x) in B2 at 1.
apply (left_cancellation (+) x) in B2.
destruct (zero_product n1 d2) as [F|F]...
apply naturals.zero_sum with (d1 × n2).
apply (injective n_to_sr).
rewrite preserves_plus, preserves_mult, preserves_mult, preserves_0.
apply (left_cancellation_ne_0 (.*.) (/n_to_sr d1)).
apply dec_recip_ne_0. apply injective_ne_0...
apply (left_cancellation_ne_0 (.*.) (/n_to_sr d2)).
apply dec_recip_ne_0. apply injective_ne_0...
ring_simplify.
etransitivity.
2: now symmetry; eauto.
field.
split; apply injective_ne_0...
rewrite F. rewrite preserves_0. ring.
contradiction.
Qed.
Instance: PartialOrder rationals_le.
Proof. repeat (split; try apply _). Qed.
Instance: SemiRingOrder rationals_le.
Proof.
apply from_ring_order.
repeat (split; try apply _).
intros x y [n [d E]]. ∃ n d. rewrite E. ring.
intros x y [n1 [d1 E1]] [n2 [d2 E2]].
∃ (n1 × n2) (d1 × d2).
rewrite 2!preserves_mult.
rewrite E1, E2, dec_recip_distr. ring.
Qed.
Notation i_to_r := (integers_to_ring (SRpair nat) Q).
Instance: TotalRelation rationals_le.
Proof with auto.
assert (∀ xn xd yn yd, 0 < xd → 0 < yd → xn × yd ≤ yn × xd → i_to_r xn / i_to_r xd ≤ i_to_r yn / i_to_r yd) as P.
intros xn xd yn yd.
rewrite !lt_iff_le_apart.
intros [xd_ge0 xd_ne0] [yd_ge0 yd_ne0] E.
destruct (semirings.decompose_le E) as [z [Ez1 Ex2]].
apply nat_int_le_plus in xd_ge0. apply nat_int_le_plus in yd_ge0. apply nat_int_le_plus in Ez1.
destruct xd_ge0 as [xd' xd_ge0], yd_ge0 as [yd' yd_ge0], Ez1 as [z' Ez1].
rewrite left_identity in xd_ge0, yd_ge0, Ez1.
∃ z'. ∃ (xd' × yd').
assert (∀ a, (i_to_r ∘ naturals_to_semiring nat (SRpair nat)) a = n_to_sr a) as F.
intros a. apply (naturals.to_semiring_unique _).
rewrite preserves_mult, <-F, <-F, <-F.
unfold compose. rewrite <-xd_ge0, <-yd_ge0, <-Ez1.
transitivity ((i_to_r yn × i_to_r xd) / (i_to_r yd × i_to_r xd)).
field. split; apply injective_ne_0; apply not_symmetry...
rewrite <-preserves_mult, Ex2, preserves_plus, preserves_mult.
field. split; apply injective_ne_0; apply not_symmetry...
intros x y.
destruct (rationals_decompose_pos_den (SRpair nat) x) as [xn [xd [E1x E2x]]].
destruct (rationals_decompose_pos_den (SRpair nat) y) as [yn [yd [E1y E2y]]].
rewrite E2x, E2y.
destruct (total (≤) (xn × yd) (yn × xd)); [left | right]; now apply P.
Qed.
Global Instance: FullPseudoSemiRingOrder rationals_le rationals_lt.
Proof. now apply dec_full_pseudo_srorder. Qed.
End default_order.
Ring Field abstract_algebra interfaces.orders
interfaces.naturals interfaces.rationals interfaces.integers
natpair_integers theory.rationals theory.dec_fields theory.rings
orders.integers orders.dec_fields.
Section rationals_and_integers.
Context `{Rationals Q} `{!SemiRingOrder Qle}
Z `{Integers Z} `{Apart Z} `{!TrivialApart Z} `{!FullPseudoSemiRingOrder (A:=Z) Zle Zlt}
{f : Z → Q} `{!SemiRing_Morphism f}.
Add Field Q : (stdlib_field_theory Q).
Lemma rationals_decompose_pos_den x :
∃ num, ∃ den, 0 < den ∧ x = f num / f den.
Proof.
destruct (rationals_decompose x) as [num [den [E1 E2]]].
destruct (total (≤) den 0).
∃ (-num) (-den). split.
apply lt_iff_le_ne. split.
now apply rings.flip_nonpos_negate.
apply not_symmetry. now apply flip_negate_ne_0.
rewrite 2!preserves_negate. rewrite E2. field.
split.
apply flip_negate_ne_0. now apply injective_ne_0.
now apply injective_ne_0.
∃ num. ∃ den. split; try assumption.
apply lt_iff_le_ne. split. assumption. now apply not_symmetry.
Qed.
End rationals_and_integers.
Section rationals_and_another_rationals.
Context `{Rationals Q1} `{Apart Q1} `{!TrivialApart Q1} `{!FullPseudoSemiRingOrder (A:=Q1) Q1le Q1lt}.
Context `{Rationals Q2} `{Apart Q2} `{!TrivialApart Q2} `{!FullPseudoSemiRingOrder (A:=Q2) Q2le Q2lt}
{f : Q1 → Q2} `{!SemiRing_Morphism f}.
Add Field Q1 : (stdlib_field_theory Q1).
Notation i_to_r := (integers.integers_to_ring (SRpair nat) Q1).
Let f_preserves_nonneg x : 0 ≤ x → 0 ≤ f x.
Proof.
intros E.
destruct (rationals_decompose_pos_den (SRpair nat) x) as [num [den [E1 E2]]].
rewrite E2 in E |- ×. clear E2.
rewrite preserves_mult, preserves_dec_recip.
apply (order_reflecting_pos (.*.) (f (i_to_r den))).
change (0 < (f ∘ i_to_r) den).
rewrite (integers.to_ring_unique _).
apply semirings.preserves_pos. unfold lt in ×. apply E1.
apply (order_preserving_nonneg (.*.) (i_to_r den)) in E.
rewrite right_absorb. rewrite right_absorb in E.
rewrite (commutativity (f (i_to_r num))), associativity, dec_recip_inverse, left_identity.
rewrite (commutativity (i_to_r num)), associativity, dec_recip_inverse, left_identity in E.
change (0 ≤ (f ∘ i_to_r) num).
rewrite (integers.to_ring_unique _).
rewrite <-(preserves_0 (f:=integers_to_ring (SRpair nat) Q2)).
apply (order_preserving _).
apply (order_reflecting i_to_r).
now rewrite preserves_0.
apply injective_ne_0. now apply lt_ne_flip.
change ((f ∘ i_to_r) den ≠ 0).
apply injective_ne_0. now apply lt_ne_flip.
apply semirings.preserves_nonneg.
now apply lt_le.
Qed.
Instance morphism_order_preserving: OrderPreserving f.
Proof. apply semirings.preserving_preserves_nonneg. apply f_preserves_nonneg. Qed.
End rationals_and_another_rationals.
Section rationals_order_isomorphic.
Context `{Rationals Q1} `{Apart Q1} `{!TrivialApart Q1} `{!FullPseudoSemiRingOrder (A:=Q1) Q1le Q1lt}
`{Rationals Q2} `{Apart Q2} `{!TrivialApart Q2} `{!FullPseudoSemiRingOrder (A:=Q2) Q2le Q2lt}
{f : Q1 → Q2} `{!SemiRing_Morphism f}.
Global Instance: OrderEmbedding f.
Proof.
split.
apply morphism_order_preserving.
repeat (split; try apply _).
intros x y E.
rewrite <-(to_rationals_involutive x (Q2:=Q2)), <-(to_rationals_involutive y (Q2:=Q2)).
rewrite <-2!(to_rationals_unique f).
now apply (morphism_order_preserving (f:=rationals_to_rationals Q2 Q1)).
Qed.
End rationals_order_isomorphic.
Instance rationals_le `{Rationals Q} : Le Q | 10 := λ x y,
∃ num, ∃ den, y = x + naturals_to_semiring nat Q num / naturals_to_semiring nat Q den.
Instance rationals_lt `{Rationals Q} : Lt Q | 10 := dec_lt.
Section default_order.
Context `{Rationals Q} `{Apart Q} `{!TrivialApart Q}.
Add Field F: (stdlib_field_theory Q).
Notation n_to_sr := (naturals_to_semiring nat Q).
Instance: Proper ((=) ==> (=) ==> iff) rationals_le.
Proof.
intros x x' E y y' E'. unfold rationals_le.
split; intros [n [d d_nonzero]]; ∃ n d.
now rewrite <-E, <-E'.
now rewrite E, E'.
Qed.
Instance: Reflexive rationals_le.
Proof. intro. ∃ (0:nat) (0:nat). rewrite preserves_0. ring. Qed.
Lemma rationals_decompose_le (x y: Q) :
x ≤ y → ∃ num, ∃ den, den ≠ 0 ∧ y = x + n_to_sr num × / n_to_sr den.
Proof with eauto.
intros [n [d E]].
destruct (decide (d = 0)) as [A|A]...
∃ (0:nat) (1:nat).
split. discriminate.
rewrite E, A, preserves_0, preserves_1, dec_recip_0.
ring.
Qed.
Instance: Transitive rationals_le.
Proof with auto.
intros x y z E1 E2.
destruct (rationals_decompose_le x y) as [n1 [d1 [A1 B1]]]...
destruct (rationals_decompose_le y z) as [n2 [d2 [A2 B2]]]...
∃ (n1 × d2 + n2 × d1) (d1 × d2).
rewrite B2, B1.
rewrite preserves_plus.
rewrite ?preserves_mult.
field. split; now apply injective_ne_0.
Qed.
Instance: AntiSymmetric rationals_le.
Proof with auto.
intros x y E1 E2.
destruct (rationals_decompose_le x y) as [n1 [d1 [A1 B1]]]...
destruct (rationals_decompose_le y x) as [n2 [d2 [A2 B2]]]...
rewrite B1 in B2 |- ×.
clear E1 E2 B1 y.
rewrite <-associativity in B2. rewrite <-(plus_0_r x) in B2 at 1.
apply (left_cancellation (+) x) in B2.
destruct (zero_product n1 d2) as [F|F]...
apply naturals.zero_sum with (d1 × n2).
apply (injective n_to_sr).
rewrite preserves_plus, preserves_mult, preserves_mult, preserves_0.
apply (left_cancellation_ne_0 (.*.) (/n_to_sr d1)).
apply dec_recip_ne_0. apply injective_ne_0...
apply (left_cancellation_ne_0 (.*.) (/n_to_sr d2)).
apply dec_recip_ne_0. apply injective_ne_0...
ring_simplify.
etransitivity.
2: now symmetry; eauto.
field.
split; apply injective_ne_0...
rewrite F. rewrite preserves_0. ring.
contradiction.
Qed.
Instance: PartialOrder rationals_le.
Proof. repeat (split; try apply _). Qed.
Instance: SemiRingOrder rationals_le.
Proof.
apply from_ring_order.
repeat (split; try apply _).
intros x y [n [d E]]. ∃ n d. rewrite E. ring.
intros x y [n1 [d1 E1]] [n2 [d2 E2]].
∃ (n1 × n2) (d1 × d2).
rewrite 2!preserves_mult.
rewrite E1, E2, dec_recip_distr. ring.
Qed.
Notation i_to_r := (integers_to_ring (SRpair nat) Q).
Instance: TotalRelation rationals_le.
Proof with auto.
assert (∀ xn xd yn yd, 0 < xd → 0 < yd → xn × yd ≤ yn × xd → i_to_r xn / i_to_r xd ≤ i_to_r yn / i_to_r yd) as P.
intros xn xd yn yd.
rewrite !lt_iff_le_apart.
intros [xd_ge0 xd_ne0] [yd_ge0 yd_ne0] E.
destruct (semirings.decompose_le E) as [z [Ez1 Ex2]].
apply nat_int_le_plus in xd_ge0. apply nat_int_le_plus in yd_ge0. apply nat_int_le_plus in Ez1.
destruct xd_ge0 as [xd' xd_ge0], yd_ge0 as [yd' yd_ge0], Ez1 as [z' Ez1].
rewrite left_identity in xd_ge0, yd_ge0, Ez1.
∃ z'. ∃ (xd' × yd').
assert (∀ a, (i_to_r ∘ naturals_to_semiring nat (SRpair nat)) a = n_to_sr a) as F.
intros a. apply (naturals.to_semiring_unique _).
rewrite preserves_mult, <-F, <-F, <-F.
unfold compose. rewrite <-xd_ge0, <-yd_ge0, <-Ez1.
transitivity ((i_to_r yn × i_to_r xd) / (i_to_r yd × i_to_r xd)).
field. split; apply injective_ne_0; apply not_symmetry...
rewrite <-preserves_mult, Ex2, preserves_plus, preserves_mult.
field. split; apply injective_ne_0; apply not_symmetry...
intros x y.
destruct (rationals_decompose_pos_den (SRpair nat) x) as [xn [xd [E1x E2x]]].
destruct (rationals_decompose_pos_den (SRpair nat) y) as [yn [yd [E1y E2y]]].
rewrite E2x, E2y.
destruct (total (≤) (xn × yd) (yn × xd)); [left | right]; now apply P.
Qed.
Global Instance: FullPseudoSemiRingOrder rationals_le rationals_lt.
Proof. now apply dec_full_pseudo_srorder. Qed.
End default_order.