/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.inverse
import analysis.special_functions.trigonometric.deriv

/-!
# derivatives of the inverse trigonometric functions

Derivatives of `arcsin` and `arccos`.
-/

noncomputable theory
open_locale classical topology filter
open set filter

open_locale real

namespace real

section arcsin

lemma deriv_arcsin_aux {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_strict_deriv_at arcsin (1 / sqrt (1 - x ^ 2)) x ∧ cont_diff_at ℝ ⊤ arcsin x :=
begin
  cases h₁.lt_or_lt with h₁ h₁,
  { have : 1 - x ^ 2 < 0, by nlinarith [h₁],
    rw [sqrt_eq_zero'.2 this.le, div_zero],
    have : arcsin =ᶠ[𝓝 x] λ _, -(π / 2) :=
      (gt_mem_nhds h₁).mono (λ y hy, arcsin_of_le_neg_one hy.le),
    exact ⟨(has_strict_deriv_at_const _ _).congr_of_eventually_eq this.symm,
      cont_diff_at_const.congr_of_eventually_eq this⟩ },
  cases h₂.lt_or_lt with h₂ h₂,
  { have : 0 < sqrt (1 - x ^ 2) := sqrt_pos.2 (by nlinarith [h₁, h₂]),
    simp only [← cos_arcsin, one_div] at this ⊢,
    exact ⟨sin_local_homeomorph.has_strict_deriv_at_symm ⟨h₁, h₂⟩ this.ne'
      (has_strict_deriv_at_sin _),
      sin_local_homeomorph.cont_diff_at_symm_deriv this.ne' ⟨h₁, h₂⟩
        (has_deriv_at_sin _) cont_diff_sin.cont_diff_at⟩ },
  { have : 1 - x ^ 2 < 0, by nlinarith [h₂],
    rw [sqrt_eq_zero'.2 this.le, div_zero],
    have : arcsin =ᶠ[𝓝 x] λ _, π / 2 := (lt_mem_nhds h₂).mono (λ y hy, arcsin_of_one_le hy.le),
    exact ⟨(has_strict_deriv_at_const _ _).congr_of_eventually_eq this.symm,
      cont_diff_at_const.congr_of_eventually_eq this⟩ }
end

lemma has_strict_deriv_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_strict_deriv_at arcsin (1 / sqrt (1 - x ^ 2)) x :=
(deriv_arcsin_aux h₁ h₂).1

lemma cont_diff_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : ℕ∞} :
  cont_diff_at ℝ n arcsin x :=
(deriv_arcsin_aux h₁ h₂).2.of_le le_top

lemma has_deriv_within_at_arcsin_Ici {x : ℝ} (h : x ≠ -1) :
  has_deriv_within_at arcsin (1 / sqrt (1 - x ^ 2)) (Ici x) x :=
begin
  rcases em (x = 1) with (rfl|h'),
  { convert (has_deriv_within_at_const _ _ (π / 2)).congr _ _;
      simp [arcsin_of_one_le] { contextual := tt } },
  { exact (has_deriv_at_arcsin h h').has_deriv_within_at }
end

lemma has_deriv_within_at_arcsin_Iic {x : ℝ} (h : x ≠ 1) :
  has_deriv_within_at arcsin (1 / sqrt (1 - x ^ 2)) (Iic x) x :=
begin
  rcases em (x = -1) with (rfl|h'),
  { convert (has_deriv_within_at_const _ _ (-(π / 2))).congr _ _;
      simp [arcsin_of_le_neg_one] { contextual := tt } },
  { exact (has_deriv_at_arcsin h' h).has_deriv_within_at }
end

lemma differentiable_within_at_arcsin_Ici {x : ℝ} :
  differentiable_within_at ℝ arcsin (Ici x) x ↔ x ≠ -1 :=
begin
  refine ⟨_, λ h, (has_deriv_within_at_arcsin_Ici h).differentiable_within_at⟩,
  rintro h rfl,
  have : sin ∘ arcsin =ᶠ[𝓝[≥] (-1 : ℝ)] id,
  { filter_upwards [Icc_mem_nhds_within_Ici ⟨le_rfl, neg_lt_self (zero_lt_one' ℝ)⟩]
      with x using sin_arcsin', },
  have := h.has_deriv_within_at.sin.congr_of_eventually_eq this.symm (by simp),
  simpa using (unique_diff_on_Ici _ _ left_mem_Ici).eq_deriv _ this (has_deriv_within_at_id _ _)
end

lemma differentiable_within_at_arcsin_Iic {x : ℝ} :
  differentiable_within_at ℝ arcsin (Iic x) x ↔ x ≠ 1 :=
begin
  refine ⟨λ h, _, λ h, (has_deriv_within_at_arcsin_Iic h).differentiable_within_at⟩,
  rw [← neg_neg x, ← image_neg_Ici] at h,
  have := (h.comp (-x) differentiable_within_at_id.neg (maps_to_image _ _)).neg,
  simpa [(∘), differentiable_within_at_arcsin_Ici] using this
end

lemma differentiable_at_arcsin {x : ℝ} :
  differentiable_at ℝ arcsin x ↔ x ≠ -1 ∧ x ≠ 1 :=
⟨λ h, ⟨differentiable_within_at_arcsin_Ici.1 h.differentiable_within_at,
  differentiable_within_at_arcsin_Iic.1 h.differentiable_within_at⟩,
  λ h, (has_deriv_at_arcsin h.1 h.2).differentiable_at⟩

@[simp] lemma deriv_arcsin : deriv arcsin = λ x, 1 / sqrt (1 - x ^ 2) :=
begin
  funext x,
  by_cases h : x ≠ -1 ∧ x ≠ 1,
  { exact (has_deriv_at_arcsin h.1 h.2).deriv },
  { rw [deriv_zero_of_not_differentiable_at (mt differentiable_at_arcsin.1 h)],
    simp only [not_and_distrib, ne.def, not_not] at h,
    rcases h with (rfl|rfl); simp }
end

lemma differentiable_on_arcsin : differentiable_on ℝ arcsin {-1, 1}ᶜ :=
λ x hx, (differentiable_at_arcsin.2
  ⟨λ h, hx (or.inl h), λ h, hx (or.inr h)⟩).differentiable_within_at

lemma cont_diff_on_arcsin {n : ℕ∞} :
  cont_diff_on ℝ n arcsin {-1, 1}ᶜ :=
λ x hx, (cont_diff_at_arcsin (mt or.inl hx) (mt or.inr hx)).cont_diff_within_at

lemma cont_diff_at_arcsin_iff {x : ℝ} {n : ℕ∞} :
  cont_diff_at ℝ n arcsin x ↔ n = 0 ∨ (x ≠ -1 ∧ x ≠ 1) :=
⟨λ h, or_iff_not_imp_left.2 $ λ hn, differentiable_at_arcsin.1 $ h.differentiable_at $
  enat.one_le_iff_ne_zero.2 hn,
  λ h, h.elim (λ hn, hn.symm ▸ (cont_diff_zero.2 continuous_arcsin).cont_diff_at) $
    λ hx, cont_diff_at_arcsin hx.1 hx.2⟩

end arcsin

section arccos

lemma has_strict_deriv_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_strict_deriv_at arccos (-(1 / sqrt (1 - x ^ 2))) x :=
(has_strict_deriv_at_arcsin h₁ h₂).const_sub (π / 2)

lemma has_deriv_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) :
  has_deriv_at arccos (-(1 / sqrt (1 - x ^ 2))) x :=
(has_deriv_at_arcsin h₁ h₂).const_sub (π / 2)

lemma cont_diff_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : ℕ∞} :
  cont_diff_at ℝ n arccos x :=
cont_diff_at_const.sub (cont_diff_at_arcsin h₁ h₂)

lemma has_deriv_within_at_arccos_Ici {x : ℝ} (h : x ≠ -1) :
  has_deriv_within_at arccos (-(1 / sqrt (1 - x ^ 2))) (Ici x) x :=
(has_deriv_within_at_arcsin_Ici h).const_sub _

lemma has_deriv_within_at_arccos_Iic {x : ℝ} (h : x ≠ 1) :
  has_deriv_within_at arccos (-(1 / sqrt (1 - x ^ 2))) (Iic x) x :=
(has_deriv_within_at_arcsin_Iic h).const_sub _

lemma differentiable_within_at_arccos_Ici {x : ℝ} :
  differentiable_within_at ℝ arccos (Ici x) x ↔ x ≠ -1 :=
(differentiable_within_at_const_sub_iff _).trans differentiable_within_at_arcsin_Ici

lemma differentiable_within_at_arccos_Iic {x : ℝ} :
  differentiable_within_at ℝ arccos (Iic x) x ↔ x ≠ 1 :=
(differentiable_within_at_const_sub_iff _).trans differentiable_within_at_arcsin_Iic

lemma differentiable_at_arccos {x : ℝ} :
  differentiable_at ℝ arccos x ↔ x ≠ -1 ∧ x ≠ 1 :=
(differentiable_at_const_sub_iff _).trans differentiable_at_arcsin

@[simp] lemma deriv_arccos : deriv arccos = λ x, -(1 / sqrt (1 - x ^ 2)) :=
funext $ λ x, (deriv_const_sub _).trans $ by simp only [deriv_arcsin]

lemma differentiable_on_arccos : differentiable_on ℝ arccos {-1, 1}ᶜ :=
differentiable_on_arcsin.const_sub _

lemma cont_diff_on_arccos {n : ℕ∞} :
  cont_diff_on ℝ n arccos {-1, 1}ᶜ :=
cont_diff_on_const.sub cont_diff_on_arcsin

lemma cont_diff_at_arccos_iff {x : ℝ} {n : ℕ∞} :
  cont_diff_at ℝ n arccos x ↔ n = 0 ∨ (x ≠ -1 ∧ x ≠ 1) :=
by refine iff.trans ⟨λ h, _, λ h, _⟩ cont_diff_at_arcsin_iff;
  simpa [arccos] using (@cont_diff_at_const _ _ _ _ _ _ _ _ _ _ (π / 2)).sub h

end arccos

end real


/-
Copyright (c) 2020 Kevin Lacker, Keeley Hoek, Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Keeley Hoek, Scott Morrison
-/
import tactic.rewrite_search
import data.rat.basic
import data.real.basic

/-
These tests ensure that `rewrite_search` works on some relatively simple examples.
They do not monitor for performance regression, so be aware of that if you make changes.
-/

namespace tactic.rewrite_search.testing

private axiom foo' : [6] = [7]
private axiom bar' : [[5], [5]] = [[6], [6]]

example : [[7], [6]] = [[5], [5]] :=
begin
  success_if_fail { rewrite_search },
  rewrite_search [foo', bar']
end

@[rewrite] private axiom foo : [0] = [1]
@[rewrite] private axiom bar1 : [1] = [2]
@[rewrite] private axiom bar2 : [3] = [2]
@[rewrite] private axiom bar3 : [3] = [4]

private example : [[0], [0]] = [[4], [4]] := by rewrite_search
private example (x : unit) : [[0], [0]] = [[4], [4]] := by rewrite_search

@[rewrite] private axiom qux' : [[1], [2]] = [[6], [7]]
@[rewrite] private axiom qux'' : [6] = [7]
private example : [[1], [1]] = [[7], [7]] := by rewrite_search

constants f g : ℕ → ℕ → ℕ → ℕ
@[rewrite] axiom f_0_0 : ∀ a b c : ℕ, f a b c = f 0 b c
@[rewrite] axiom f_0_1 : ∀ a b c : ℕ, f a b c = f 1 b c
@[rewrite] axiom f_0_2 : ∀ a b c : ℕ, f a b c = f 2 b c
@[rewrite] axiom f_1_0 : ∀ a b c : ℕ, f a b c = f a 0 c
@[rewrite] axiom f_1_1 : ∀ a b c : ℕ, f a b c = f a 1 c
@[rewrite] axiom f_1_2 : ∀ a b c : ℕ, f a b c = f a 2 c
@[rewrite] axiom f_2_0 : ∀ a b c : ℕ, f a b c = f a b 0
@[rewrite] axiom f_2_1 : ∀ a b c : ℕ, f a b c = f a b 1
@[rewrite] axiom f_2_2 : ∀ a b c : ℕ, f a b c = f a b 2
@[rewrite] axiom g_0_0 : ∀ a b c : ℕ, g a b c = g 0 b c
@[rewrite] axiom g_0_1 : ∀ a b c : ℕ, g a b c = g 1 b c
@[rewrite] axiom g_0_2 : ∀ a b c : ℕ, g a b c = g 2 b c
@[rewrite] axiom g_1_0 : ∀ a b c : ℕ, g a b c = g a 0 c
@[rewrite] axiom g_1_1 : ∀ a b c : ℕ, g a b c = g a 1 c
@[rewrite] axiom g_1_2 : ∀ a b c : ℕ, g a b c = g a 2 c
@[rewrite] axiom g_2_0 : ∀ a b c : ℕ, g a b c = g a b 0
@[rewrite] axiom g_2_1 : ∀ a b c : ℕ, g a b c = g a b 1
@[rewrite] axiom g_2_2 : ∀ a b c : ℕ, g a b c = g a b 2
@[rewrite] axiom f_g : f 0 1 2 = g 2 0 1

lemma test_pathfinding : f 0 0 0 = g 0 0 0 := by rewrite_search

constant h : ℕ → ℕ
@[rewrite,simp] axiom a1 : h 0 = h 1
@[rewrite,simp] axiom a2 : h 1 = h 2
@[rewrite,simp] axiom a3 : h 2 = h 3
@[rewrite,simp] axiom a4 : h 3 = h 4

lemma test_linear_path : h 0 = h 4 := by rewrite_search

constants a b c d e : ℚ

lemma test_algebra : (a * (b + c)) * d = a * (b * d) + a * (c * d) :=
by rewrite_search [add_comm, add_assoc, mul_assoc, mul_comm, left_distrib, right_distrib]

lemma test_simpler_algebra : a + (b + c) = (a + b) + c :=
by rewrite_search [add_assoc]

def idf : ℝ → ℝ := id

/-
These problems test `rewrite_search`'s ability to carry on in the presence of multiple
expressions that `pp` to the same thing but are not actually equal.
-/
lemma test_pp_1 : idf (0 : ℕ) = idf (0 : ℚ) :=
by rewrite_search [rat.cast_zero, nat.cast_zero, add_comm]

lemma test_pp_2 : idf (0 : ℕ) + 1 = 1 + idf (0 : ℚ) :=
by rewrite_search [rat.cast_zero, nat.cast_zero, add_comm]

example (x : ℕ) : x = x := by rewrite_search

end tactic.rewrite_search.testing


/-
Copyright (c) 2022 Joachim Breitner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joachim Breitner
-/
import group_theory.order_of_element
import data.finset.noncomm_prod
import data.fintype.card

/-!
# Canonical homomorphism from a finite family of monoids

This file defines the construction of the canonical homomorphism from a family of monoids.

Given a family of morphisms `ϕ i : N i →* M` for each `i : ι` where elements in the
images of different morphisms commute, we obtain a canonical morphism
`monoid_hom.noncomm_pi_coprod : (Π i, N i) →* M` that coincides with `ϕ`

## Main definitions

* `monoid_hom.noncomm_pi_coprod : (Π i, N i) →* M` is the main homomorphism
* `subgroup.noncomm_pi_coprod : (Π i, H i) →* G` is the specialization to `H i : subgroup G`
   and the subgroup embedding.

## Main theorems

* `monoid_hom.noncomm_pi_coprod` coincides with `ϕ i` when restricted to `N i`
* `monoid_hom.noncomm_pi_coprod_mrange`: The range of `monoid_hom.noncomm_pi_coprod` is
  `⨆ (i : ι), (ϕ i).mrange`
* `monoid_hom.noncomm_pi_coprod_range`: The range of `monoid_hom.noncomm_pi_coprod` is
  `⨆ (i : ι), (ϕ i).range`
* `subgroup.noncomm_pi_coprod_range`: The range of `subgroup.noncomm_pi_coprod` is `⨆ (i : ι), H i`.
* `monoid_hom.injective_noncomm_pi_coprod_of_independent`: in the case of groups, `pi_hom.hom` is
   injective if the `ϕ` are injective and the ranges of the `ϕ` are independent.
* `monoid_hom.independent_range_of_coprime_order`: If the `N i` have coprime orders, then the ranges
   of the `ϕ` are independent.
* `subgroup.independent_of_coprime_order`: If commuting normal subgroups `H i` have coprime orders,
   they are independent.

-/

open_locale big_operators

section family_of_monoids

variables {M : Type*} [monoid M]

-- We have a family of monoids
-- The fintype assumption is not always used, but declared here, to keep things in order
variables {ι : Type*} [hdec : decidable_eq ι] [fintype ι]
variables {N : ι → Type*} [∀ i, monoid (N i)]

-- And morphisms ϕ into G
variables (ϕ : Π (i : ι), N i →* M)

-- We assume that the elements of different morphism commute
variables (hcomm : ∀ (i j : ι), i ≠ j → ∀ (x : N i) (y : N j), commute (ϕ i x) (ϕ j y))
include hcomm

-- We use `f` and `g` to denote elements of `Π (i : ι), N i`
variables (f g : Π (i : ι), N i)

namespace monoid_hom

/-- The canonical homomorphism from a family of monoids. -/
@[to_additive "The canonical homomorphism from a family of additive monoids.

See also `linear_map.lsum` for a linear version without the commutativity assumption."]
def noncomm_pi_coprod : (Π (i : ι), N i) →* M :=
{ to_fun := λ f, finset.univ.noncomm_prod (λ i, ϕ i (f i)) $
    by { rintros i - j -, by_cases h : i = j, { subst h }, { exact hcomm _ _ h _ _ } },
  map_one' := by {apply (finset.noncomm_prod_eq_pow_card _ _ _ _ _).trans (one_pow _), simp},
  map_mul' := λ f g,
  begin
    classical,
    convert @finset.noncomm_prod_mul_distrib _ _ _ _ (λ i, ϕ i (f i)) (λ i, ϕ i (g i)) _ _ _,
    { ext i, exact map_mul (ϕ i) (f i) (g i), },
    { rintros i - j - h, exact hcomm _ _ h _ _ },
  end }

variable {hcomm}

include hdec

@[simp, to_additive]
lemma noncomm_pi_coprod_mul_single (i : ι) (y : N i):
  noncomm_pi_coprod ϕ hcomm (pi.mul_single i y) = ϕ i y :=
begin
  change finset.univ.noncomm_prod (λ j, ϕ j (pi.mul_single i y j)) _ = ϕ i y,
  simp only [←finset.insert_erase (finset.mem_univ i)] {single_pass := tt},
  rw finset.noncomm_prod_insert_of_not_mem _ _ _ _ (finset.not_mem_erase i _),
  rw pi.mul_single_eq_same,
  rw finset.noncomm_prod_eq_pow_card,
  { rw one_pow, exact mul_one _  },
  { intros j hj, simp only [finset.mem_erase] at hj, simp [hj], },
end

omit hcomm

/-- The universal property of `noncomm_pi_coprod` -/
@[to_additive "The universal property of `noncomm_pi_coprod`"]
def noncomm_pi_coprod_equiv :
  {ϕ : Π i, N i →* M // pairwise (λ i j, ∀ x y, commute (ϕ i x) (ϕ j y)) }
    ≃ ((Π i, N i) →* M) :=
{ to_fun := λ ϕ, noncomm_pi_coprod ϕ.1 ϕ.2,
  inv_fun := λ f,
  ⟨ λ i, f.comp (monoid_hom.single N i),
    λ i j hij x y, commute.map (pi.mul_single_commute i j hij x y) f ⟩,
  left_inv := λ ϕ, by { ext, simp, },
  right_inv := λ f, pi_ext (λ i x, by simp) }

omit hdec

include hcomm

@[to_additive]
lemma noncomm_pi_coprod_mrange : (noncomm_pi_coprod ϕ hcomm).mrange = ⨆ i : ι, (ϕ i).mrange :=
begin
  classical,
  apply le_antisymm,
  { rintro x ⟨f, rfl⟩,
    refine submonoid.noncomm_prod_mem _ _ _ _ _,
    intros i hi,
    apply submonoid.mem_Sup_of_mem, { use i },
    simp, },
  { refine supr_le _,
    rintro i x ⟨y, rfl⟩,
    refine ⟨pi.mul_single i y, noncomm_pi_coprod_mul_single _ _ _⟩, },
end

end monoid_hom

end family_of_monoids

section family_of_groups

variables {G : Type*} [group G]
variables {ι : Type*} [hdec : decidable_eq ι] [hfin : fintype ι]
variables {H : ι → Type*} [∀ i, group (H i)]
variables (ϕ : Π (i : ι), H i →* G)
variables {hcomm : ∀ (i j : ι), i ≠ j → ∀ (x : H i) (y : H j), commute (ϕ i x) (ϕ j y)}
include hcomm

-- We use `f` and `g` to denote elements of `Π (i : ι), H i`
variables (f g : Π (i : ι), H i)

include hfin

namespace monoid_hom

-- The subgroup version of `noncomm_pi_coprod_mrange`
@[to_additive]
lemma noncomm_pi_coprod_range : (noncomm_pi_coprod ϕ hcomm).range = ⨆ i : ι, (ϕ i).range :=
begin
  classical,
  apply le_antisymm,
  { rintro x ⟨f, rfl⟩,
    refine subgroup.noncomm_prod_mem _ _ _,
    intros i hi,
    apply subgroup.mem_Sup_of_mem, { use i },
    simp, },
  { refine supr_le _,
    rintro i x ⟨y, rfl⟩,
    refine ⟨pi.mul_single i y, noncomm_pi_coprod_mul_single _ _ _⟩, },
end

@[to_additive]
lemma injective_noncomm_pi_coprod_of_independent
  (hind : complete_lattice.independent (λ i, (ϕ i).range))
  (hinj : ∀ i, function.injective (ϕ i)) :
  function.injective (noncomm_pi_coprod ϕ hcomm):=
begin
  classical,
  apply (monoid_hom.ker_eq_bot_iff _).mp,
  apply eq_bot_iff.mpr,
  intros f heq1,
  change finset.univ.noncomm_prod (λ i, ϕ i (f i)) _ = 1 at heq1,
  change f = 1,
  have : ∀ i, i ∈ finset.univ → ϕ i (f i) = 1 :=
    subgroup.eq_one_of_noncomm_prod_eq_one_of_independent _ _ _ _ hind (by simp) heq1,
  ext i,
  apply hinj,
  simp [this i (finset.mem_univ i)],
end

variable (hcomm)

@[to_additive]
lemma independent_range_of_coprime_order [∀ i, fintype (H i)]
  (hcoprime : ∀ i j, i ≠ j → nat.coprime (fintype.card (H i)) (fintype.card (H j))) :
  complete_lattice.independent (λ i, (ϕ i).range) :=
begin
  classical,
  rintros i f ⟨hxi, hxp⟩, dsimp at hxi hxp,
  rw [supr_subtype', ← noncomm_pi_coprod_range] at hxp,
  rotate, { intros _ _ hj, apply hcomm, exact hj ∘ subtype.ext },
  cases hxp with g hgf, cases hxi with g' hg'f,
  have hxi : order_of f ∣ fintype.card (H i),
  { rw ← hg'f, exact (order_of_map_dvd _ _).trans order_of_dvd_card_univ },
  have hxp : order_of f ∣ ∏ j : {j // j ≠ i}, fintype.card (H j),
  { rw [← hgf, ← fintype.card_pi], exact (order_of_map_dvd _ _).trans order_of_dvd_card_univ },
  change f = 1, rw [← pow_one f, ← order_of_dvd_iff_pow_eq_one],
  convert ← nat.dvd_gcd hxp hxi, rw ← nat.coprime_iff_gcd_eq_one,
  apply nat.coprime_prod_left, intros j _, apply hcoprime, exact j.2,
end

end monoid_hom

end family_of_groups

namespace subgroup

-- We have an family of subgroups
variables {G : Type*} [group G]
variables {ι : Type*} [hdec : decidable_eq ι] [hfin : fintype ι] {H : ι → subgroup G}

-- Elements of `Π (i : ι), H i` are called `f` and `g` here
variables (f g : Π (i : ι), H i)

section commuting_subgroups

-- We assume that the elements of different subgroups commute
variables (hcomm : ∀ (i j : ι), i ≠ j → ∀ (x y : G), x ∈ H i → y ∈ H j → commute x y)
include hcomm

@[to_additive]
lemma commute_subtype_of_commute (i j : ι) (hne : i ≠ j) :
  ∀ (x : H i) (y : H j), commute ((H i).subtype x) ((H j).subtype y) :=
by { rintros ⟨x, hx⟩ ⟨y, hy⟩, exact hcomm i j hne x y hx hy }

include hfin

/-- The canonical homomorphism from a family of subgroups where elements from different subgroups
commute -/
@[to_additive "The canonical homomorphism from a family of additive subgroups where elements from
different subgroups commute"]
def noncomm_pi_coprod : (Π (i : ι), H i) →* G :=
  monoid_hom.noncomm_pi_coprod (λ i, (H i).subtype) (commute_subtype_of_commute hcomm)

variable {hcomm}

include hdec

@[simp, to_additive]
lemma noncomm_pi_coprod_mul_single (i : ι) (y : H i) :
  noncomm_pi_coprod hcomm (pi.mul_single i y) = y :=
by apply monoid_hom.noncomm_pi_coprod_mul_single

omit hdec

@[to_additive]
lemma noncomm_pi_coprod_range : (noncomm_pi_coprod hcomm).range = ⨆ i : ι, H i :=
by simp [noncomm_pi_coprod, monoid_hom.noncomm_pi_coprod_range]

@[to_additive]
lemma injective_noncomm_pi_coprod_of_independent (hind : complete_lattice.independent H) :
  function.injective (noncomm_pi_coprod hcomm) :=
begin
  apply monoid_hom.injective_noncomm_pi_coprod_of_independent,
  { simpa using hind },
  { intro i, exact subtype.coe_injective }
end

variable (hcomm)

@[to_additive]
lemma independent_of_coprime_order [∀ i, fintype (H i)]
  (hcoprime : ∀ i j, i ≠ j → nat.coprime (fintype.card (H i)) (fintype.card (H j))) :
  complete_lattice.independent H :=
begin
  simpa using monoid_hom.independent_range_of_coprime_order
    (λ i, (H i).subtype) (commute_subtype_of_commute hcomm) hcoprime,
end

end commuting_subgroups

end subgroup


/-
Copyright (c) 2019 Johan Commelin All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import ring_theory.ideal.basic
import topology.algebra.ring.basic
import topology.sets.opens
/-!
# Open subgroups of a topological groups

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This files builds the lattice `open_subgroup G` of open subgroups in a topological group `G`,
and its additive version `open_add_subgroup`.  This lattice has a top element, the subgroup of all
elements, but no bottom element in general. The trivial subgroup which is the natural candidate
bottom has no reason to be open (this happens only in discrete groups).

Note that this notion is especially relevant in a non-archimedean context, for instance for
`p`-adic groups.

## Main declarations

* `open_subgroup.is_closed`: An open subgroup is automatically closed.
* `subgroup.is_open_mono`: A subgroup containing an open subgroup is open.
                           There are also versions for additive groups, submodules and ideals.
* `open_subgroup.comap`: Open subgroups can be pulled back by a continuous group morphism.

## TODO
* Prove that the identity component of a locally path connected group is an open subgroup.
  Up to now this file is really geared towards non-archimedean algebra, not Lie groups.
-/

open topological_space
open_locale topology

/-- The type of open subgroups of a topological additive group. -/
@[ancestor add_subgroup]
structure open_add_subgroup  (G : Type*) [add_group G] [topological_space G]
  extends add_subgroup G :=
(is_open' : is_open carrier)

/-- The type of open subgroups of a topological group. -/
@[ancestor subgroup, to_additive]
structure open_subgroup (G : Type*) [group G] [topological_space G] extends subgroup G :=
(is_open' : is_open carrier)

/-- Reinterpret an `open_subgroup` as a `subgroup`. -/
add_decl_doc open_subgroup.to_subgroup

/-- Reinterpret an `open_add_subgroup` as an `add_subgroup`. -/
add_decl_doc open_add_subgroup.to_add_subgroup

namespace open_subgroup
open function topological_space
variables {G : Type*} [group G] [topological_space G]
variables {U V : open_subgroup G} {g : G}

@[to_additive]
instance has_coe_subgroup : has_coe_t (open_subgroup G) (subgroup G) := ⟨to_subgroup⟩

@[to_additive]
lemma coe_subgroup_injective : injective (coe : open_subgroup G → subgroup G)
| ⟨_, _⟩ ⟨_, _⟩ rfl := rfl

@[to_additive]
instance : set_like (open_subgroup G) G :=
{ coe := λ U, U.1,
  coe_injective' := λ _ _ h, coe_subgroup_injective $ set_like.ext' h }

@[to_additive]
instance : subgroup_class (open_subgroup G) G :=
{ mul_mem := λ U _ _, U.mul_mem',
  one_mem := λ U, U.one_mem',
  inv_mem := λ U _, U.inv_mem' }

@[to_additive]
instance has_coe_opens : has_coe_t (open_subgroup G) (opens G) := ⟨λ U, ⟨U, U.is_open'⟩⟩

@[simp, norm_cast, to_additive] lemma coe_coe_opens : ((U : opens G) : set G) = U := rfl
@[simp, norm_cast, to_additive] lemma coe_coe_subgroup : ((U : subgroup G) : set G) = U := rfl
@[simp, norm_cast, to_additive] lemma mem_coe_opens : g ∈ (U : opens G) ↔ g ∈ U := iff.rfl
@[simp, norm_cast, to_additive]
lemma mem_coe_subgroup : g ∈ (U : subgroup G) ↔ g ∈ U := iff.rfl

@[ext, to_additive]
lemma ext (h : ∀ x, x ∈ U ↔ x ∈ V) : (U = V) := set_like.ext h

variable (U)
@[to_additive]
protected lemma is_open : is_open (U : set G) := U.is_open'

@[to_additive]
lemma mem_nhds_one : (U : set G) ∈ 𝓝 (1 : G) :=
is_open.mem_nhds U.is_open U.one_mem
variable {U}

@[to_additive]
instance : has_top (open_subgroup G) := ⟨{ is_open' := is_open_univ, .. (⊤ : subgroup G) }⟩

@[simp, to_additive] lemma mem_top (x : G) : x ∈ (⊤ : open_subgroup G) := trivial
@[simp, norm_cast, to_additive] lemma coe_top : ((⊤ : open_subgroup G) : set G) = set.univ := rfl

@[simp, norm_cast, to_additive]
lemma coe_subgroup_top : ((⊤ : open_subgroup G) : subgroup G) = ⊤ := rfl

@[simp, norm_cast, to_additive]
lemma coe_opens_top : ((⊤ : open_subgroup G) : opens G) = ⊤ := rfl

@[to_additive]
instance : inhabited (open_subgroup G) := ⟨⊤⟩

@[to_additive]
lemma is_closed [has_continuous_mul G] (U : open_subgroup G) : is_closed (U : set G) :=
begin
  apply is_open_compl_iff.1,
  refine is_open_iff_forall_mem_open.2 (λ x hx, ⟨(λ y, y * x⁻¹) ⁻¹' U, _, _, _⟩),
  { refine λ u hux hu, hx _,
    simp only [set.mem_preimage, set_like.mem_coe] at hux hu ⊢,
    convert U.mul_mem (U.inv_mem hux) hu,
    simp },
  { exact U.is_open.preimage (continuous_mul_right _) },
  { simp [one_mem] }
end

@[to_additive]
lemma is_clopen [has_continuous_mul G] (U : open_subgroup G) : is_clopen (U : set G) :=
⟨U.is_open, U.is_closed⟩

section
variables {H : Type*} [group H] [topological_space H]

/-- The product of two open subgroups as an open subgroup of the product group. -/
@[to_additive "The product of two open subgroups as an open subgroup of the product group."]
def prod (U : open_subgroup G) (V : open_subgroup H) : open_subgroup (G × H) :=
{ is_open' := U.is_open.prod V.is_open,
  .. (U : subgroup G).prod (V : subgroup H) }

@[simp, norm_cast, to_additive] lemma coe_prod (U : open_subgroup G) (V : open_subgroup H) :
  (U.prod V : set (G × H)) = U ×ˢ V :=
rfl

@[simp, norm_cast, to_additive]
lemma coe_subgroup_prod (U : open_subgroup G) (V : open_subgroup H) :
  (U.prod V : subgroup (G × H)) = (U : subgroup G).prod V :=
rfl

end

@[to_additive]
instance : has_inf (open_subgroup G) :=
⟨λ U V, ⟨U ⊓ V, U.is_open.inter V.is_open⟩⟩

@[simp, norm_cast, to_additive] lemma coe_inf : (↑(U ⊓ V) : set G) = (U : set G) ∩ V := rfl
@[simp, norm_cast, to_additive] lemma coe_subgroup_inf : (↑(U ⊓ V) : subgroup G) = ↑U ⊓ ↑V := rfl
@[simp, norm_cast, to_additive] lemma coe_opens_inf : (↑(U ⊓ V) : opens G) = ↑U ⊓ ↑V := rfl
@[simp, to_additive] lemma mem_inf {x} : x ∈ U ⊓ V ↔ x ∈ U ∧ x ∈ V := iff.rfl

@[to_additive]
instance : semilattice_inf (open_subgroup G) :=
{ .. set_like.partial_order,
  .. set_like.coe_injective.semilattice_inf (coe : open_subgroup G → set G) (λ _ _, rfl) }

@[to_additive]
instance : order_top (open_subgroup G) :=
{ top := ⊤,
  le_top := λ U, set.subset_univ _ }

@[simp, norm_cast, to_additive] lemma coe_subgroup_le :
  (U : subgroup G) ≤ (V : subgroup G) ↔ U ≤ V :=
iff.rfl

variables {N : Type*} [group N] [topological_space N]

/-- The preimage of an `open_subgroup` along a continuous `monoid` homomorphism
  is an `open_subgroup`. -/
@[to_additive "The preimage of an `open_add_subgroup` along a continuous `add_monoid` homomorphism
is an `open_add_subgroup`."]
def comap (f : G →* N) (hf : continuous f) (H : open_subgroup N) : open_subgroup G :=
{ is_open' := H.is_open.preimage hf,
  .. (H : subgroup N).comap f }

@[simp, norm_cast, to_additive]
lemma coe_comap (H : open_subgroup N) (f : G →* N) (hf : continuous f) :
  (H.comap f hf : set G) = f ⁻¹' H := rfl

@[simp, norm_cast, to_additive]
lemma coe_subgroup_comap (H : open_subgroup N) (f : G →* N) (hf : continuous f) :
  (H.comap f hf : subgroup G) = (H : subgroup N).comap f := rfl

@[simp, to_additive]
lemma mem_comap {H : open_subgroup N} {f : G →* N} {hf : continuous f} {x : G} :
  x ∈ H.comap f hf ↔ f x ∈ H := iff.rfl

@[to_additive]
lemma comap_comap {P : Type*} [group P] [topological_space P]
  (K : open_subgroup P) (f₂ : N →* P) (hf₂ : continuous f₂) (f₁ : G →* N) (hf₁ : continuous f₁) :
  (K.comap f₂ hf₂).comap f₁ hf₁ = K.comap (f₂.comp f₁) (hf₂.comp hf₁) :=
rfl

end open_subgroup

namespace subgroup

variables {G : Type*} [group G] [topological_space G] [has_continuous_mul G] (H : subgroup G)

@[to_additive]
lemma is_open_of_mem_nhds {g : G} (hg : (H : set G) ∈ 𝓝 g) :
  is_open (H : set G) :=
begin
  refine is_open_iff_mem_nhds.2 (λ x hx, _),
  have hg' : g ∈ H := set_like.mem_coe.1 (mem_of_mem_nhds hg),
  have : filter.tendsto (λ y, y * (x⁻¹ * g)) (𝓝 x) (𝓝 g) :=
    (continuous_id.mul continuous_const).tendsto' _ _ (mul_inv_cancel_left _ _),
  simpa only [set_like.mem_coe, filter.mem_map',
    H.mul_mem_cancel_right (H.mul_mem (H.inv_mem hx) hg')] using this hg,
end

@[to_additive]

@[to_additive]
lemma is_open_of_open_subgroup {U : open_subgroup G} (h : ↑U ≤ H) :
  is_open (H : set G) :=
is_open_mono h U.is_open

/-- If a subgroup of a topological group has `1` in its interior, then it is open. -/
@[to_additive "If a subgroup of an additive topological group has `0` in its interior, then it is
open."]
lemma is_open_of_one_mem_interior (h_1_int : (1 : G) ∈ interior (H : set G)) :
  is_open (H : set G) :=
is_open_of_mem_nhds H $ mem_interior_iff_mem_nhds.1 h_1_int

end subgroup

namespace open_subgroup

variables {G : Type*} [group G] [topological_space G] [has_continuous_mul G]

@[to_additive]
instance : has_sup (open_subgroup G) :=
⟨λ U V, ⟨U ⊔ V, subgroup.is_open_mono (le_sup_left : U.1 ≤ U ⊔ V) U.is_open⟩⟩

@[simp, norm_cast, to_additive]
lemma coe_subgroup_sup (U V : open_subgroup G) : (↑(U ⊔ V) : subgroup G) = ↑U ⊔ ↑V := rfl

@[to_additive]
instance : lattice (open_subgroup G) :=
{ .. open_subgroup.semilattice_inf,
  .. coe_subgroup_injective.semilattice_sup (coe : open_subgroup G → subgroup G) (λ _ _, rfl) }

end open_subgroup

namespace submodule
open open_add_subgroup
variables {R : Type*} {M : Type*} [comm_ring R]
variables [add_comm_group M] [topological_space M] [topological_add_group M] [module R M]

lemma is_open_mono {U P : submodule R M} (h : U ≤ P) (hU : is_open (U : set M)) :
  is_open (P : set M) :=
@add_subgroup.is_open_mono M _ _ _ U.to_add_subgroup P.to_add_subgroup h hU

end submodule

namespace ideal
variables {R : Type*} [comm_ring R]
variables [topological_space R] [topological_ring R]

lemma is_open_of_open_subideal {U I : ideal R} (h : U ≤ I) (hU : is_open (U : set R)) :
  is_open (I : set R) :=
submodule.is_open_mono h hU

end ideal


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.set
! leanprover-community/mathlib commit ab343ab4edc491dbd02bed7b70295a0bb88be06f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Meta.Interactive
import Leanbin.Init.Control.Lawful

universe u v

#print Set /-
/-- A set of elements of type `α`; implemented as a predicate `α → Prop`. -/
def Set (α : Type u) :=
  α → Prop
#align set Set
-/

#print setOf /-
/-- The set `{x | p x}` of elements satisfying the predicate `p`. -/
def setOf {α : Type u} (p : α → Prop) : Set α :=
  p
#align set_of setOf
-/

namespace Set

variable {α : Type u}

instance hasMem : Membership α (Set α) :=
  ⟨fun x s => s x⟩
#align set.has_mem Set.hasMem

#print Set.mem_setOf_eq /-
@[simp]
theorem mem_setOf_eq {x : α} {p : α → Prop} : (x ∈ { y | p y }) = p x :=
  rfl
#align set.mem_set_of_eq Set.mem_setOf_eq
-/

instance : EmptyCollection (Set α) :=
  ⟨{ x | False }⟩

#print Set.univ /-
/-- The set that contains all elements of a type. -/
def univ : Set α :=
  { x | True }
#align set.univ Set.univ
-/

instance : Insert α (Set α) :=
  ⟨fun a s => { b | b = a ∨ b ∈ s }⟩

instance : Singleton α (Set α) :=
  ⟨fun a => { b | b = a }⟩

instance : Sep α (Set α) :=
  ⟨fun p s => { x | x ∈ s ∧ p x }⟩

instance : IsLawfulSingleton α (Set α) :=
  ⟨fun a => funext fun b => propext <| or_false_iff _⟩

end Set


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson

! This file was ported from Lean 3 source module ring_theory.int.basic
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.EuclideanDomain.Basic
import Mathlib.Data.Nat.Factors
import Mathlib.RingTheory.Coprime.Basic
import Mathlib.RingTheory.PrincipalIdealDomain

/-!
# Divisibility over ℕ and ℤ

This file collects results for the integers and natural numbers that use abstract algebra in
their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.

## Main statements

* `Nat.factors_eq`: the multiset of elements of `Nat.factors` is equal to the factors
   given by the `UniqueFactorizationMonoid` instance
* ℤ is a `NormalizationMonoid`
* ℤ is a `GCDMonoid`

## Tags

prime, irreducible, natural numbers, integers, normalization monoid, gcd monoid,
greatest common divisor, prime factorization, prime factors, unique factorization,
unique factors
-/

namespace Nat

instance : WfDvdMonoid ℕ :=
  ⟨by
    refine'
      RelHomClass.wellFounded
        (⟨fun x : ℕ => if x = 0 then (⊤ : ℕ∞) else x, _⟩ : DvdNotUnit →r (· < ·))
        (WithTop.wellFounded_lt Nat.lt_wfRel.wf)
    intro a b h
    cases' a with a
    · exfalso
      revert h
      simp [DvdNotUnit]
    cases b
    · simpa [succ_ne_zero] using WithTop.coe_lt_top (a + 1)
    cases' dvd_and_not_dvd_iff.2 h with h1 h2
    simp only [succ_ne_zero, cast_lt, if_false]
    refine lt_of_le_of_ne (Nat.le_of_dvd (Nat.succ_pos _) h1) fun con => h2 ?_
    rw [con]⟩

instance : UniqueFactorizationMonoid ℕ :=
  ⟨fun {_} => Nat.irreducible_iff_prime⟩

end Nat

/-- `ℕ` is a gcd_monoid. -/
instance : GCDMonoid ℕ where
  gcd := Nat.gcd
  lcm := Nat.lcm
  gcd_dvd_left := Nat.gcd_dvd_left
  gcd_dvd_right := Nat.gcd_dvd_right
  dvd_gcd := Nat.dvd_gcd
  gcd_mul_lcm a b := by rw [Nat.gcd_mul_lcm]; rfl
  lcm_zero_left := Nat.lcm_zero_left
  lcm_zero_right := Nat.lcm_zero_right

instance : NormalizedGCDMonoid ℕ :=
  { (inferInstance : GCDMonoid ℕ),
    (inferInstance : NormalizationMonoid ℕ) with
    normalize_gcd := fun _ _ => normalize_eq _
    normalize_lcm := fun _ _ => normalize_eq _ }

theorem gcd_eq_nat_gcd (m n : ℕ) : gcd m n = Nat.gcd m n :=
  rfl
#align gcd_eq_nat_gcd gcd_eq_nat_gcd

theorem lcm_eq_nat_lcm (m n : ℕ) : lcm m n = Nat.lcm m n :=
  rfl
#align lcm_eq_nat_lcm lcm_eq_nat_lcm

namespace Int

section NormalizationMonoid

instance normalizationMonoid : NormalizationMonoid ℤ where
  normUnit a := if 0 ≤ a then 1 else -1
  normUnit_zero := if_pos le_rfl
  normUnit_mul {a b} hna hnb := by
    cases' hna.lt_or_lt with ha ha <;> cases' hnb.lt_or_lt with hb hb <;>
      simp [mul_nonneg_iff, ha.le, ha.not_le, hb.le, hb.not_le]
  normUnit_coe_units u :=
    (units_eq_one_or u).elim (fun eq => eq.symm ▸ if_pos zero_le_one) fun eq =>
      eq.symm ▸ if_neg (not_le_of_gt <| show (-1 : ℤ) < 0 by decide)

-- Porting note: added
theorem normUnit_eq (z : ℤ) : normUnit z = if 0 ≤ z then 1 else -1 := rfl

theorem normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : normalize z = z := by
  rw [normalize_apply, normUnit_eq, if_pos h, Units.val_one, mul_one]
#align int.normalize_of_nonneg Int.normalize_of_nonneg

theorem normalize_of_nonpos {z : ℤ} (h : z ≤ 0) : normalize z = -z := by
  obtain rfl | h := h.eq_or_lt
  · simp
  · rw [normalize_apply, normUnit_eq, if_neg (not_le_of_gt h), Units.val_neg, Units.val_one,
      mul_neg_one]
#align int.normalize_of_nonpos Int.normalize_of_nonpos

theorem normalize_coe_nat (n : ℕ) : normalize (n : ℤ) = n :=
  normalize_of_nonneg (ofNat_le_ofNat_of_le <| Nat.zero_le n)
#align int.normalize_coe_nat Int.normalize_coe_nat

theorem abs_eq_normalize (z : ℤ) : |z| = normalize z := by
  cases le_total 0 z <;> simp [-normalize_apply, normalize_of_nonneg, normalize_of_nonpos, *]
#align int.abs_eq_normalize Int.abs_eq_normalize

theorem nonneg_of_normalize_eq_self {z : ℤ} (hz : normalize z = z) : 0 ≤ z :=
  abs_eq_self.1 <| by rw [abs_eq_normalize, hz]
#align int.nonneg_of_normalize_eq_self Int.nonneg_of_normalize_eq_self

theorem nonneg_iff_normalize_eq_self (z : ℤ) : normalize z = z ↔ 0 ≤ z :=
  ⟨nonneg_of_normalize_eq_self, normalize_of_nonneg⟩
#align int.nonneg_iff_normalize_eq_self Int.nonneg_iff_normalize_eq_self

theorem eq_of_associated_of_nonneg {a b : ℤ} (h : Associated a b) (ha : 0 ≤ a) (hb : 0 ≤ b) :
    a = b :=
  dvd_antisymm_of_normalize_eq (normalize_of_nonneg ha) (normalize_of_nonneg hb) h.dvd h.symm.dvd
#align int.eq_of_associated_of_nonneg Int.eq_of_associated_of_nonneg

end NormalizationMonoid

section GCDMonoid

instance : GCDMonoid ℤ where
  gcd a b := Int.gcd a b
  lcm a b := Int.lcm a b
  gcd_dvd_left a b := Int.gcd_dvd_left _ _
  gcd_dvd_right a b := Int.gcd_dvd_right _ _
  dvd_gcd := dvd_gcd
  gcd_mul_lcm a b := by
    rw [← Int.ofNat_mul, gcd_mul_lcm, coe_natAbs, abs_eq_normalize]
    exact normalize_associated (a * b)
  lcm_zero_left a := coe_nat_eq_zero.2 <| Nat.lcm_zero_left _
  lcm_zero_right a := coe_nat_eq_zero.2 <| Nat.lcm_zero_right _

instance : NormalizedGCDMonoid ℤ :=
  { Int.normalizationMonoid,
    (inferInstance : GCDMonoid ℤ) with
    normalize_gcd := fun _ _ => normalize_coe_nat _
    normalize_lcm := fun _ _ => normalize_coe_nat _ }

theorem coe_gcd (i j : ℤ) : ↑(Int.gcd i j) = GCDMonoid.gcd i j :=
  rfl
#align int.coe_gcd Int.coe_gcd

theorem coe_lcm (i j : ℤ) : ↑(Int.lcm i j) = GCDMonoid.lcm i j :=
  rfl
#align int.coe_lcm Int.coe_lcm

theorem natAbs_gcd (i j : ℤ) : natAbs (GCDMonoid.gcd i j) = Int.gcd i j :=
  rfl
#align int.nat_abs_gcd Int.natAbs_gcd

theorem natAbs_lcm (i j : ℤ) : natAbs (GCDMonoid.lcm i j) = Int.lcm i j :=
  rfl
#align int.nat_abs_lcm Int.natAbs_lcm

end GCDMonoid

theorem exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ) (_ : IsUnit u), (Int.natAbs a : ℤ) = u * a := by
  cases' natAbs_eq a with h h
  · use 1, isUnit_one
    rw [← h, one_mul]
  · use -1, isUnit_one.neg
    rw [← neg_eq_iff_eq_neg.mpr h]
    simp only [neg_mul, one_mul]
#align int.exists_unit_of_abs Int.exists_unit_of_abs

theorem gcd_eq_natAbs {a b : ℤ} : Int.gcd a b = Nat.gcd a.natAbs b.natAbs :=
  rfl
#align int.gcd_eq_nat_abs Int.gcd_eq_natAbs

theorem gcd_eq_one_iff_coprime {a b : ℤ} : Int.gcd a b = 1 ↔ IsCoprime a b := by
  constructor
  · intro hg
    obtain ⟨ua, -, ha⟩ := exists_unit_of_abs a
    obtain ⟨ub, -, hb⟩ := exists_unit_of_abs b
    use Nat.gcdA (Int.natAbs a) (Int.natAbs b) * ua, Nat.gcdB (Int.natAbs a) (Int.natAbs b) * ub
    rw [mul_assoc, ← ha, mul_assoc, ← hb, mul_comm, mul_comm _ (Int.natAbs b : ℤ), ←
      Nat.gcd_eq_gcd_ab, ← gcd_eq_natAbs, hg, Int.ofNat_one]
  · rintro ⟨r, s, h⟩
    by_contra hg
    obtain ⟨p, ⟨hp, ha, hb⟩⟩ := Nat.Prime.not_coprime_iff_dvd.mp hg
    apply Nat.Prime.not_dvd_one hp
    rw [← coe_nat_dvd, Int.ofNat_one, ← h]
    exact dvd_add ((coe_nat_dvd_left.mpr ha).mul_left _) ((coe_nat_dvd_left.mpr hb).mul_left _)
#align int.gcd_eq_one_iff_coprime Int.gcd_eq_one_iff_coprime

theorem coprime_iff_nat_coprime {a b : ℤ} : IsCoprime a b ↔ Nat.coprime a.natAbs b.natAbs := by
  rw [← gcd_eq_one_iff_coprime, Nat.coprime_iff_gcd_eq_one, gcd_eq_natAbs]
#align int.coprime_iff_nat_coprime Int.coprime_iff_nat_coprime

/-- If `gcd a (m * n) ≠ 1`, then `gcd a m ≠ 1` or `gcd a n ≠ 1`. -/
theorem gcd_ne_one_iff_gcd_mul_right_ne_one {a : ℤ} {m n : ℕ} :
    a.gcd (m * n) ≠ 1 ↔ a.gcd m ≠ 1 ∨ a.gcd n ≠ 1 := by
  simp only [gcd_eq_one_iff_coprime, ← not_and_or, not_iff_not, IsCoprime.mul_right_iff]
#align int.gcd_ne_one_iff_gcd_mul_right_ne_one Int.gcd_ne_one_iff_gcd_mul_right_ne_one

set_option linter.deprecated false in -- trans_rel_left
/-- If `gcd a (m * n) = 1`, then `gcd a m = 1`. -/
theorem gcd_eq_one_of_gcd_mul_right_eq_one_left {a : ℤ} {m n : ℕ} (h : a.gcd (m * n) = 1) :
    a.gcd m = 1 :=
  Nat.dvd_one.mp <| trans_rel_left _ (gcd_dvd_gcd_mul_right_right a m n) h
#align int.gcd_eq_one_of_gcd_mul_right_eq_one_left Int.gcd_eq_one_of_gcd_mul_right_eq_one_left

set_option linter.deprecated false in -- trans_rel_left
/-- If `gcd a (m * n) = 1`, then `gcd a n = 1`. -/
theorem gcd_eq_one_of_gcd_mul_right_eq_one_right {a : ℤ} {m n : ℕ} (h : a.gcd (m * n) = 1) :
    a.gcd n = 1 :=
  Nat.dvd_one.mp <| trans_rel_left _ (gcd_dvd_gcd_mul_left_right a n m) h
#align int.gcd_eq_one_of_gcd_mul_right_eq_one_right Int.gcd_eq_one_of_gcd_mul_right_eq_one_right

theorem sq_of_gcd_eq_one {a b c : ℤ} (h : Int.gcd a b = 1) (heq : a * b = c ^ 2) :
    ∃ a0 : ℤ, a = a0 ^ 2 ∨ a = -a0 ^ 2 := by
  have h' : IsUnit (GCDMonoid.gcd a b) := by
    rw [← coe_gcd, h, Int.ofNat_one]
    exact isUnit_one
  obtain ⟨d, ⟨u, hu⟩⟩ := exists_associated_pow_of_mul_eq_pow h' heq
  use d
  rw [← hu]
  cases' Int.units_eq_one_or u with hu' hu' <;>
    · rw [hu']
      simp
#align int.sq_of_gcd_eq_one Int.sq_of_gcd_eq_one

theorem sq_of_coprime {a b c : ℤ} (h : IsCoprime a b) (heq : a * b = c ^ 2) :
    ∃ a0 : ℤ, a = a0 ^ 2 ∨ a = -a0 ^ 2 :=
  sq_of_gcd_eq_one (gcd_eq_one_iff_coprime.mpr h) heq
#align int.sq_of_coprime Int.sq_of_coprime

theorem natAbs_euclideanDomain_gcd (a b : ℤ) :
    Int.natAbs (EuclideanDomain.gcd a b) = Int.gcd a b := by
  apply Nat.dvd_antisymm <;> rw [← Int.coe_nat_dvd]
  · rw [Int.natAbs_dvd]
    exact Int.dvd_gcd (EuclideanDomain.gcd_dvd_left _ _) (EuclideanDomain.gcd_dvd_right _ _)
  · rw [Int.dvd_natAbs]
    exact EuclideanDomain.dvd_gcd (Int.gcd_dvd_left _ _) (Int.gcd_dvd_right _ _)
#align int.nat_abs_euclidean_domain_gcd Int.natAbs_euclideanDomain_gcd

end Int

/-- Maps an associate class of integers consisting of `-n, n` to `n : ℕ` -/
def associatesIntEquivNat : Associates ℤ ≃ ℕ := by
  refine' ⟨fun z => z.out.natAbs, fun n => Associates.mk n, _, _⟩
  · refine' fun a =>
      Quotient.inductionOn a fun a =>
        Associates.mk_eq_mk_iff_associated.2 <| Associated.symm <| ⟨normUnit a, _⟩
    simp [Int.abs_eq_normalize]
  · intro n
    dsimp
    rw [← normalize_apply, ← Int.abs_eq_normalize, Int.natAbs_abs, Int.natAbs_ofNat]
#align associates_int_equiv_nat associatesIntEquivNat

theorem Int.Prime.dvd_mul {m n : ℤ} {p : ℕ} (hp : Nat.Prime p) (h : (p : ℤ) ∣ m * n) :
    p ∣ m.natAbs ∨ p ∣ n.natAbs := by
  rwa [← hp.dvd_mul, ← Int.natAbs_mul, ←Int.coe_nat_dvd_left]
#align int.prime.dvd_mul Int.Prime.dvd_mul

theorem Int.Prime.dvd_mul' {m n : ℤ} {p : ℕ} (hp : Nat.Prime p) (h : (p : ℤ) ∣ m * n) :
    (p : ℤ) ∣ m ∨ (p : ℤ) ∣ n := by
  rw [Int.coe_nat_dvd_left, Int.coe_nat_dvd_left]
  exact Int.Prime.dvd_mul hp h
#align int.prime.dvd_mul' Int.Prime.dvd_mul'

theorem Int.Prime.dvd_pow {n : ℤ} {k p : ℕ} (hp : Nat.Prime p) (h : (p : ℤ) ∣ n ^ k) :
    p ∣ n.natAbs := by
  rw [Int.coe_nat_dvd_left, Int.natAbs_pow] at h
  exact hp.dvd_of_dvd_pow h
#align int.prime.dvd_pow Int.Prime.dvd_pow

theorem Int.Prime.dvd_pow' {n : ℤ} {k p : ℕ} (hp : Nat.Prime p) (h : (p : ℤ) ∣ n ^ k) :
    (p : ℤ) ∣ n := by
  rw [Int.coe_nat_dvd_left]
  exact Int.Prime.dvd_pow hp h
#align int.prime.dvd_pow' Int.Prime.dvd_pow'

theorem prime_two_or_dvd_of_dvd_two_mul_pow_self_two {m : ℤ} {p : ℕ} (hp : Nat.Prime p)
    (h : (p : ℤ) ∣ 2 * m ^ 2) : p = 2 ∨ p ∣ Int.natAbs m := by
  cases' Int.Prime.dvd_mul hp h with hp2 hpp
  · apply Or.intro_left
    exact le_antisymm (Nat.le_of_dvd zero_lt_two hp2) (Nat.Prime.two_le hp)
  · apply Or.intro_right
    rw [sq, Int.natAbs_mul] at hpp
    exact (or_self_iff _).mp ((Nat.Prime.dvd_mul hp).mp hpp)
#align prime_two_or_dvd_of_dvd_two_mul_pow_self_two prime_two_or_dvd_of_dvd_two_mul_pow_self_two

theorem Int.exists_prime_and_dvd {n : ℤ} (hn : n.natAbs ≠ 1) : ∃ p, Prime p ∧ p ∣ n := by
  obtain ⟨p, pp, pd⟩ := Nat.exists_prime_and_dvd hn
  exact ⟨p, Nat.prime_iff_prime_int.mp pp, Int.coe_nat_dvd_left.mpr pd⟩
#align int.exists_prime_and_dvd Int.exists_prime_and_dvd

open UniqueFactorizationMonoid

theorem Nat.factors_eq {n : ℕ} : normalizedFactors n = n.factors := by
  cases n
  case zero => simp
  case succ n =>
    rw [← Multiset.rel_eq, ← associated_eq_eq]
    apply UniqueFactorizationMonoid.factors_unique irreducible_of_normalized_factor _
    · rw [Multiset.coe_prod, Nat.prod_factors n.succ_ne_zero]
      apply normalizedFactors_prod (Nat.succ_ne_zero _)
    · intro x hx
      rw [Nat.irreducible_iff_prime, ← Nat.prime_iff]
      exact Nat.prime_of_mem_factors hx
#align nat.factors_eq Nat.factors_eq

theorem Nat.factors_multiset_prod_of_irreducible {s : Multiset ℕ}
    (h : ∀ x : ℕ, x ∈ s → Irreducible x) : normalizedFactors s.prod = s := by
  rw [← Multiset.rel_eq, ← associated_eq_eq]
  apply
    UniqueFactorizationMonoid.factors_unique irreducible_of_normalized_factor h
      (normalizedFactors_prod _)
  rw [Ne.def, Multiset.prod_eq_zero_iff]
  intro con
  exact not_irreducible_zero (h 0 con)
#align nat.factors_multiset_prod_of_irreducible Nat.factors_multiset_prod_of_irreducible

namespace multiplicity

theorem finite_int_iff_natAbs_finite {a b : ℤ} : Finite a b ↔ Finite a.natAbs b.natAbs := by
  simp only [finite_def, ← Int.natAbs_dvd_natAbs, Int.natAbs_pow]
#align multiplicity.finite_int_iff_nat_abs_finite multiplicity.finite_int_iff_natAbs_finite

theorem finite_int_iff {a b : ℤ} : Finite a b ↔ a.natAbs ≠ 1 ∧ b ≠ 0 := by
  rw [finite_int_iff_natAbs_finite, finite_nat_iff, pos_iff_ne_zero, Int.natAbs_ne_zero]
#align multiplicity.finite_int_iff multiplicity.finite_int_iff

instance decidableNat : DecidableRel fun a b : ℕ => (multiplicity a b).Dom := fun _ _ =>
  decidable_of_iff _ finite_nat_iff.symm
#align multiplicity.decidable_nat multiplicity.decidableNat

instance decidableInt : DecidableRel fun a b : ℤ => (multiplicity a b).Dom := fun _ _ =>
  decidable_of_iff _ finite_int_iff.symm
#align multiplicity.decidable_int multiplicity.decidableInt

end multiplicity

theorem induction_on_primes {P : ℕ → Prop} (h₀ : P 0) (h₁ : P 1)
    (h : ∀ p a : ℕ, p.Prime → P a → P (p * a)) (n : ℕ) : P n := by
  apply UniqueFactorizationMonoid.induction_on_prime
  · exact h₀
  · intro n h
    rw [Nat.isUnit_iff.1 h]
    exact h₁
  · intro a p _ hp ha
    exact h p a hp.nat_prime ha
#align induction_on_primes induction_on_primes

theorem Int.associated_natAbs (k : ℤ) : Associated k k.natAbs :=
  associated_of_dvd_dvd (Int.coe_nat_dvd_right.mpr dvd_rfl) (Int.natAbs_dvd.mpr dvd_rfl)
#align int.associated_nat_abs Int.associated_natAbs

theorem Int.prime_iff_natAbs_prime {k : ℤ} : Prime k ↔ Nat.Prime k.natAbs :=
  (Int.associated_natAbs k).prime_iff.trans Nat.prime_iff_prime_int.symm
#align int.prime_iff_nat_abs_prime Int.prime_iff_natAbs_prime

theorem Int.associated_iff_natAbs {a b : ℤ} : Associated a b ↔ a.natAbs = b.natAbs := by
  rw [← dvd_dvd_iff_associated, ← Int.natAbs_dvd_natAbs, ← Int.natAbs_dvd_natAbs,
    dvd_dvd_iff_associated]
  exact associated_iff_eq
#align int.associated_iff_nat_abs Int.associated_iff_natAbs

theorem Int.associated_iff {a b : ℤ} : Associated a b ↔ a = b ∨ a = -b := by
  rw [Int.associated_iff_natAbs]
  exact Int.natAbs_eq_natAbs_iff
#align int.associated_iff Int.associated_iff

namespace Int

theorem zmultiples_natAbs (a : ℤ) :
    AddSubgroup.zmultiples (a.natAbs : ℤ) = AddSubgroup.zmultiples a :=
  le_antisymm (AddSubgroup.zmultiples_subset (mem_zmultiples_iff.mpr (dvd_natAbs.mpr (dvd_refl a))))
    (AddSubgroup.zmultiples_subset (mem_zmultiples_iff.mpr (natAbs_dvd.mpr (dvd_refl a))))
#align int.zmultiples_nat_abs Int.zmultiples_natAbs

theorem span_natAbs (a : ℤ) : Ideal.span ({(a.natAbs : ℤ)} : Set ℤ) = Ideal.span {a} := by
  rw [Ideal.span_singleton_eq_span_singleton]
  exact (associated_natAbs _).symm
#align int.span_nat_abs Int.span_natAbs

section bit
set_option linter.deprecated false

theorem eq_pow_of_mul_eq_pow_bit1_left {a b c : ℤ} (hab : IsCoprime a b) {k : ℕ}
    (h : a * b = c ^ bit1 k) : ∃ d, a = d ^ bit1 k := by
  obtain ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow' hab h
  replace hd := hd.symm
  rw [associated_iff_natAbs, natAbs_eq_natAbs_iff, ← neg_pow_bit1] at hd
  obtain rfl | rfl := hd <;> exact ⟨_, rfl⟩
#align int.eq_pow_of_mul_eq_pow_bit1_left Int.eq_pow_of_mul_eq_pow_bit1_left

theorem eq_pow_of_mul_eq_pow_bit1_right {a b c : ℤ} (hab : IsCoprime a b) {k : ℕ}
    (h : a * b = c ^ bit1 k) : ∃ d, b = d ^ bit1 k :=
  eq_pow_of_mul_eq_pow_bit1_left hab.symm (by rwa [mul_comm] at h)
#align int.eq_pow_of_mul_eq_pow_bit1_right Int.eq_pow_of_mul_eq_pow_bit1_right

theorem eq_pow_of_mul_eq_pow_bit1 {a b c : ℤ} (hab : IsCoprime a b) {k : ℕ}
    (h : a * b = c ^ bit1 k) : (∃ d, a = d ^ bit1 k) ∧ ∃ e, b = e ^ bit1 k :=
  ⟨eq_pow_of_mul_eq_pow_bit1_left hab h, eq_pow_of_mul_eq_pow_bit1_right hab h⟩
#align int.eq_pow_of_mul_eq_pow_bit1 Int.eq_pow_of_mul_eq_pow_bit1

end bit

end Int


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import algebra.algebra.basic
import algebra.field.basic
import algebra.group.type_tags
import ring_theory.ideal.local_ring
import data.equiv.basic

/-!
# Transfer algebraic structures across `equiv`s

In this file we prove theorems of the following form: if `β` has a
group structure and `α ≃ β` then `α` has a group structure, and
similarly for monoids, semigroups, rings, integral domains, fields and
so on.

Note that most of these constructions can also be obtained using the `transport` tactic.

## Tags

equiv, group, ring, field, module, algebra
-/

universes u v
variables {α : Type u} {β : Type v}

namespace equiv

section instances

variables (e : α ≃ β)

/-- Transfer `has_one` across an `equiv` -/
@[to_additive "Transfer `has_zero` across an `equiv`"]
protected def has_one [has_one β] : has_one α := ⟨e.symm 1⟩
@[to_additive]
lemma one_def [has_one β] : @has_one.one _ (equiv.has_one e) = e.symm 1 := rfl

/-- Transfer `has_mul` across an `equiv` -/
@[to_additive "Transfer `has_add` across an `equiv`"]
protected def has_mul [has_mul β] : has_mul α := ⟨λ x y, e.symm (e x * e y)⟩
@[to_additive]
lemma mul_def [has_mul β] (x y : α) :
  @has_mul.mul _ (equiv.has_mul e) x y = e.symm (e x * e y) := rfl

/-- Transfer `has_div` across an `equiv` -/
@[to_additive "Transfer `has_sub` across an `equiv`"]
protected def has_div [has_div β] : has_div α := ⟨λ x y, e.symm (e x / e y)⟩
@[to_additive]
lemma div_def [has_div β] (x y : α) :
@has_div.div _ (equiv.has_div e) x y = e.symm (e x / e y) := rfl

/-- Transfer `has_inv` across an `equiv` -/
@[to_additive "Transfer `has_neg` across an `equiv`"]
protected def has_inv [has_inv β] : has_inv α := ⟨λ x, e.symm (e x)⁻¹⟩
@[to_additive]
lemma inv_def [has_inv β] (x : α) : @has_inv.inv _ (equiv.has_inv e) x = e.symm (e x)⁻¹ := rfl

/-- Transfer `has_scalar` across an `equiv` -/
protected def has_scalar {R : Type*} [has_scalar R β] : has_scalar R α  :=
⟨λ r x, e.symm (r • (e x))⟩
lemma smul_def {R : Type*} [has_scalar R β] (r : R) (x : α) :
  @has_scalar.smul _ _ (equiv.has_scalar e) r x = e.symm (r • (e x)) := rfl

/--
An equivalence `e : α ≃ β` gives a multiplicative equivalence `α ≃* β`
where the multiplicative structure on `α` is
the one obtained by transporting a multiplicative structure on `β` back along `e`.
-/
@[to_additive
"An equivalence `e : α ≃ β` gives a additive equivalence `α ≃+ β`
where the additive structure on `α` is
the one obtained by transporting an additive structure on `β` back along `e`."]
def mul_equiv (e : α ≃ β) [has_mul β] :
  by { letI := equiv.has_mul e, exact α ≃* β } :=
begin
  introsI,
  exact
  { map_mul' := λ x y, by { apply e.symm.injective, simp, refl, },
    ..e }
end

@[simp, to_additive] lemma mul_equiv_apply (e : α ≃ β) [has_mul β] (a : α) :
  (mul_equiv e) a = e a := rfl

@[to_additive] lemma mul_equiv_symm_apply (e : α ≃ β) [has_mul β] (b : β) :
  by { letI := equiv.has_mul e, exact (mul_equiv e).symm b = e.symm b } :=
begin
  intros, refl,
end

/--
An equivalence `e : α ≃ β` gives a ring equivalence `α ≃+* β`
where the ring structure on `α` is
the one obtained by transporting a ring structure on `β` back along `e`.
-/
def ring_equiv (e : α ≃ β) [has_add β] [has_mul β] :
  by { letI := equiv.has_add e, letI := equiv.has_mul e, exact α ≃+* β } :=
begin
  introsI,
  exact
  { map_add' := λ x y, by { apply e.symm.injective, simp, refl, },
    map_mul' := λ x y, by { apply e.symm.injective, simp, refl, },
    ..e }
end

@[simp] lemma ring_equiv_apply (e : α ≃ β) [has_add β] [has_mul β] (a : α) :
  (ring_equiv e) a = e a := rfl

lemma ring_equiv_symm_apply (e : α ≃ β) [has_add β] [has_mul β] (b : β) :
  by { letI := equiv.has_add e, letI := equiv.has_mul e, exact (ring_equiv e).symm b = e.symm b } :=
begin
  intros, refl,
end

/-- Transfer `semigroup` across an `equiv` -/
@[to_additive "Transfer `add_semigroup` across an `equiv`"]
protected def semigroup [semigroup β] : semigroup α :=
let mul := e.has_mul in
by resetI; apply e.injective.semigroup _; intros; exact e.apply_symm_apply _

/-- Transfer `semigroup_with_zero` across an `equiv` -/
protected def semigroup_with_zero [semigroup_with_zero β] : semigroup_with_zero α :=
let mul := e.has_mul, zero := e.has_zero in
by resetI; apply e.injective.semigroup_with_zero _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_semigroup` across an `equiv` -/
@[to_additive "Transfer `add_comm_semigroup` across an `equiv`"]
protected def comm_semigroup [comm_semigroup β] : comm_semigroup α :=
let mul := e.has_mul in
by resetI; apply e.injective.comm_semigroup _; intros; exact e.apply_symm_apply _

/-- Transfer `mul_zero_class` across an `equiv` -/
protected def mul_zero_class [mul_zero_class β] : mul_zero_class α :=
let zero := e.has_zero, mul := e.has_mul in
by resetI; apply e.injective.mul_zero_class _; intros; exact e.apply_symm_apply _

/-- Transfer `mul_one_class` across an `equiv` -/
@[to_additive "Transfer `add_zero_class` across an `equiv`"]
protected def mul_one_class [mul_one_class β] : mul_one_class α :=
let one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.mul_one_class _; intros; exact e.apply_symm_apply _

/-- Transfer `mul_zero_one_class` across an `equiv` -/
protected def mul_zero_one_class [mul_zero_one_class β] : mul_zero_one_class α :=
let zero := e.has_zero, one := e.has_one,mul := e.has_mul in
by resetI; apply e.injective.mul_zero_one_class _; intros; exact e.apply_symm_apply _

/-- Transfer `monoid` across an `equiv` -/
@[to_additive "Transfer `add_monoid` across an `equiv`"]
protected def monoid [monoid β] : monoid α :=
let one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.monoid _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_monoid` across an `equiv` -/
@[to_additive "Transfer `add_comm_monoid` across an `equiv`"]
protected def comm_monoid [comm_monoid β] : comm_monoid α :=
let one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.comm_monoid _; intros; exact e.apply_symm_apply _

/-- Transfer `group` across an `equiv` -/
@[to_additive "Transfer `add_group` across an `equiv`"]
protected def group [group β] : group α :=
let one := e.has_one, mul := e.has_mul, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.group _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_group` across an `equiv` -/
@[to_additive "Transfer `add_comm_group` across an `equiv`"]
protected def comm_group [comm_group β] : comm_group α :=
let one := e.has_one, mul := e.has_mul, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.comm_group _; intros; exact e.apply_symm_apply _

/-- Transfer `non_unital_non_assoc_semiring` across an `equiv` -/
protected def non_unital_non_assoc_semiring [non_unital_non_assoc_semiring β] :
  non_unital_non_assoc_semiring α :=
let zero := e.has_zero, add := e.has_add, mul := e.has_mul in
by resetI; apply e.injective.non_unital_non_assoc_semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `non_unital_semiring` across an `equiv` -/
protected def non_unital_semiring [non_unital_semiring β] :  non_unital_semiring α :=
let zero := e.has_zero, add := e.has_add, mul := e.has_mul in
by resetI; apply e.injective.non_unital_semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `non_assoc_semiring` across an `equiv` -/
protected def non_assoc_semiring [non_assoc_semiring β] : non_assoc_semiring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.non_assoc_semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `semiring` across an `equiv` -/
protected def semiring [semiring β] : semiring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_semiring` across an `equiv` -/
protected def comm_semiring [comm_semiring β] : comm_semiring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul in
by resetI; apply e.injective.comm_semiring _; intros; exact e.apply_symm_apply _

/-- Transfer `ring` across an `equiv` -/
protected def ring [ring β] : ring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub in
by resetI; apply e.injective.ring _; intros; exact e.apply_symm_apply _

/-- Transfer `comm_ring` across an `equiv` -/
protected def comm_ring [comm_ring β] : comm_ring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub in
by resetI; apply e.injective.comm_ring _; intros; exact e.apply_symm_apply _

/-- Transfer `nonzero` across an `equiv` -/
protected theorem nontrivial [nontrivial β] : nontrivial α :=
e.surjective.nontrivial

/-- Transfer `is_domain` across an `equiv` -/
protected theorem is_domain [ring α] [ring β] [is_domain β] (e : α ≃+* β) : is_domain α :=
function.injective.is_domain e.to_ring_hom e.injective

/-- Transfer `division_ring` across an `equiv` -/
protected def division_ring [division_ring β] : division_ring α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.division_ring _; intros; exact e.apply_symm_apply _

/-- Transfer `field` across an `equiv` -/
protected def field [field β] : field α :=
let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
  sub := e.has_sub, inv := e.has_inv, div := e.has_div in
by resetI; apply e.injective.field _; intros; exact e.apply_symm_apply _

section R
variables (R : Type*)
include R

section
variables [monoid R]

/-- Transfer `mul_action` across an `equiv` -/
protected def mul_action (e : α ≃ β) [mul_action R β] : mul_action R α :=
{ one_smul := by simp [smul_def],
  mul_smul := by simp [smul_def, mul_smul],
  ..equiv.has_scalar e }

/-- Transfer `distrib_mul_action` across an `equiv` -/
protected def distrib_mul_action (e : α ≃ β) [add_comm_monoid β] :
  begin
    letI := equiv.add_comm_monoid e,
    exact Π [distrib_mul_action R β], distrib_mul_action R α
  end :=
begin
  intros,
  letI := equiv.add_comm_monoid e,
  exact (
  { smul_zero := by simp [zero_def, smul_def],
    smul_add := by simp [add_def, smul_def, smul_add],
    ..equiv.mul_action R e } : distrib_mul_action R α)
end

end

section
variables [semiring R]

/-- Transfer `module` across an `equiv` -/
protected def module (e : α ≃ β) [add_comm_monoid β] :
  begin
    letI := equiv.add_comm_monoid e,
    exact Π [module R β], module R α
  end :=
begin
  introsI,
  exact (
  { zero_smul := by simp [zero_def, smul_def],
    add_smul := by simp [add_def, smul_def, add_smul],
    ..equiv.distrib_mul_action R e } : module R α)
end

/--
An equivalence `e : α ≃ β` gives a linear equivalence `α ≃ₗ[R] β`
where the `R`-module structure on `α` is
the one obtained by transporting an `R`-module structure on `β` back along `e`.
-/
def linear_equiv (e : α ≃ β) [add_comm_monoid β] [module R β] :
  begin
    letI := equiv.add_comm_monoid e,
    letI := equiv.module R e,
    exact α ≃ₗ[R] β
  end :=
begin
  introsI,
  exact
  { map_smul' := λ r x, by { apply e.symm.injective, simp, refl, },
    ..equiv.add_equiv e }
end

end

section
variables [comm_semiring R]

/-- Transfer `algebra` across an `equiv` -/
protected def algebra (e : α ≃ β) [semiring β] :
  begin
    letI := equiv.semiring e,
    exact Π [algebra R β], algebra R α
  end :=
begin
  introsI,
  fapply ring_hom.to_algebra',
  { exact ((ring_equiv e).symm : β →+* α).comp (algebra_map R β), },
  { intros r x,
    simp only [function.comp_app, ring_hom.coe_comp],
    have p := ring_equiv_symm_apply e,
    dsimp at p,
    erw p, clear p,
    apply (ring_equiv e).injective,
    simp only [(ring_equiv e).map_mul],
    simp [algebra.commutes], }
end

/--
An equivalence `e : α ≃ β` gives an algebra equivalence `α ≃ₐ[R] β`
where the `R`-algebra structure on `α` is
the one obtained by transporting an `R`-algebra structure on `β` back along `e`.
-/
def alg_equiv (e : α ≃ β) [semiring β] [algebra R β] :
  begin
    letI := equiv.semiring e,
    letI := equiv.algebra R e,
    exact α ≃ₐ[R] β
  end :=
begin
  introsI,
  exact
  { commutes' := λ r, by { apply e.symm.injective, simp, refl, },
    ..equiv.ring_equiv e }
end

end
end R

end instances
end equiv

namespace ring_equiv

protected lemma local_ring {A B : Type*} [comm_ring A] [local_ring A] [comm_ring B] (e : A ≃+* B) :
  local_ring B :=
begin
  haveI := e.symm.to_equiv.nontrivial,
  refine @local_of_surjective A B _ _ _ _ e e.to_equiv.surjective,
end

end ring_equiv


import tuto_lib

set_option pp.beta true
set_option pp.coercions false

/-
This is the final file in the series. Here we use everything covered
in previous files to prove a couple of famous theorems from
elementary real analysis. Of course they all have more general versions
in mathlib.

As usual, keep in mind the following:

  abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

  ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

  le_max_left p q : p ≤ max p q

  le_max_right p q : q ≤ max p q

as well as a lemma from the previous file:

  le_of_le_add_all : (∀ ε > 0, y ≤ x + ε) →  y ≤ x

Let's start with a variation on a known exercise.
-/

-- lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
--   (ineg : ∀ n, u n ≤ y) : x ≤ y

-- 0071
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∃ N, ∀ n ≥ N, y ≤ u n) : y ≤ x :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  specialize hu ε ε_pos,
  cases ineg with nn hn,
  cases hu with ns hs,
  let n := max nn ns,
  specialize hn n (le_max_left _ _),
  specialize hs n (le_max_right _ _),
  rw abs_le at hs,
  linarith,
end

/-
Let's now return to the result proved in the `00_` file of this series,
and prove again the sequential characterization of upper bounds (with a slighly
different proof).

For this, and other exercises below, we'll need many things that we proved in previous files,
and a couple of extras.

From the 5th file:

  limit_const (x : ℝ) : seq_limit (λ n, x) x

  squeeze (lim_u : seq_limit u l) (lim_w : seq_limit w l)
    (hu : ∀ n, u n ≤ v n) (hw : ∀ n, v n ≤ w n)  : seq_limit v l

From the 8th:

  def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

  def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

  lt_sup (hx : is_sup A x) : ∀ y, y < x → ∃ a ∈ A, y < a :=

You can also use:

  nat.one_div_pos_of_nat {n : ℕ} : 0 < 1 / (n + 1 : ℝ)

  inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε

and their easy consequences:

  limit_of_sub_le_inv_succ (h : ∀ n, |u n - x| ≤ 1/(n+1)) : seq_limit u x

  limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x

  limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x

The structure of the proof is offered. It features a new tactic:
`choose` which invokes the axiom of choice (observing the tactic state before and
after using it should be enough to understand everything).
-/

-- 0072
lemma is_sup_iff (A : set ℝ) (x : ℝ) :
(is_sup A x) ↔ (upper_bound A x ∧ ∃ u : ℕ → ℝ, seq_limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    {
      exact h.left,
    },
    { have : ∀ n : ℕ, ∃ a ∈ A, x - 1/(n+1) < a,
      { intros n,
        have : 1/(n+1 : ℝ) > 0,
          exact nat.one_div_pos_of_nat,
        exact lt_sup h _ (by linarith),
      },
      choose u hu using this,
      use u,
      split,
      {
        apply squeeze (limit_const_sub_inv_succ x) (limit_const x),
          intro n,
          exact le_of_lt (hu n).right,
        intro n,
        exact h.left _ (hu n).left,
      },
      intro n,
      exact (hu n).left,
  } },
  { rintro ⟨maj, u, limu, u_in⟩,
    split,
      exact maj,
    intros y hy,
    apply lim_le limu,
    intro n,
    exact hy _ (u_in n),
  },
end

/-- Continuity of a function at a point  -/
def continuous_at_pt (f : ℝ → ℝ) (x₀ : ℝ) : Prop :=
∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε

variables {f : ℝ → ℝ} {x₀ : ℝ} {u : ℕ → ℝ}

-- 0073
lemma seq_continuous_of_continuous (hf : continuous_at_pt f x₀)
  (hu : seq_limit u x₀) : seq_limit (f ∘ u) (f x₀) :=
begin
  intros ε ε_pos,
  specialize hf ε ε_pos,
  rcases hf with ⟨δ, δ_pos, hδ⟩,
  specialize hu δ δ_pos,
  cases hu with nh hu,
  use nh,
  intros n' hn',
  apply hδ,
  exact hu n' hn',
end

-- 0074
example :
  (∀ u : ℕ → ℝ, seq_limit u x₀ → seq_limit (f ∘ u) (f x₀)) →
  continuous_at_pt f x₀ :=
begin
  contrapose!,
  intro hf,
  unfold continuous_at_pt at hf,
  push_neg at hf,
  rcases hf with ⟨ε, ε_pos, hf⟩,
  /-wtf-/
  replace hf : ∀ n : ℕ, ∃ x, |x - x₀| ≤ 1/(n+1) ∧ ε < |f x - f x₀|,
    intro n,
    apply hf,
    exact nat.one_div_pos_of_nat,
  choose u h using hf,
  use u,
  split,
    intros η η_pos,
    /-wtf-/
    have fait, exact inv_succ_le_all η η_pos,
    cases fait with n hn,
    use n,
    intros n' hn',
    calc |u n' - x₀| ≤ 1/(n' + 1) : (h n').left
         ...         ≤ η          : hn n' hn',
  unfold seq_limit,
  push_neg,
  use [ε, ε_pos],
  intro n,
  use n,
  split,
    linarith,
  exact (h n).right,
end

/-
Recall from the 6th file:

  def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

  def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
    ∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

  id_le_extraction : extraction φ → ∀ n, n ≤ φ n

and from the 8th file:

  def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

  not_seq_limit_of_tendstoinfinity : tendsto_infinity u → ∀ l, ¬ seq_limit u l
-/

variables {φ : ℕ → ℕ}

-- 0075
lemma subseq_tenstoinfinity
  (h : tendsto_infinity u) (hφ : extraction φ) :
tendsto_infinity (u ∘ φ) :=
begin
  intro a,
  specialize h a,
  cases h with n hn,
  use n,
  intros n' hn',
  apply hn,
  calc φ n' ≥ n' : id_le_extraction hφ n'
       ...  ≥ n  : hn',
end

-- 0076
lemma squeeze_infinity {u v : ℕ → ℝ} (hu : tendsto_infinity u)
(huv : ∀ n, u n ≤ v n) : tendsto_infinity v :=
begin
  intro a,
  specialize hu a,
  cases hu with n hn,
  use n,
  intros n' hn',
  calc v n' ≥ u n' : by linarith [huv n']
       ...  ≥ a    : hn n' hn',
end

/-
We will use segments: Icc a b := { x | a ≤ x ∧ x ≤ b }
The notation stands for Interval-closed-closed. Variations exist with
o or i instead of c, where o stands for open and i for infinity.

We will use the following version of Bolzano-Weirstrass

  bolzano_weierstrass (h : ∀ n, u n ∈ [a, b]) :
    ∃ c ∈ [a, b], cluster_point u c

as well as the obvious

  seq_limit_id : tendsto_infinity (λ n, n)
-/
open set

-- 0077
lemma bdd_above_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ M, ∀ x ∈ Icc a b, f x ≤ M :=
begin
  by_contra clef,
  push_neg at clef,
  /-change real to nat-/
  replace clef : ∀ n : ℕ, ∃ x, x ∈ Icc a b ∧ f x > n, intro n, apply clef,
  choose u hu using clef,
  have lim_infinie : tendsto_infinity (f ∘ u),
    apply squeeze_infinity (seq_limit_id),
    intros n,
    specialize hu n,
    linarith,
  have bornes : ∀ n, u n ∈ Icc a b,
    intro n, exact (hu n).left,
  rcases bolzano_weierstrass bornes with ⟨c, c_dans, φ, φ_extr, lim⟩,
  have lim_infinie_extr : tendsto_infinity (f ∘ (u ∘ φ)),
    exact subseq_tenstoinfinity lim_infinie φ_extr,
  have lim_extr : seq_limit (f ∘ (u ∘ φ)) (f c),
    exact seq_continuous_of_continuous (hf c c_dans) lim,
  exact not_seq_limit_of_tendstoinfinity  lim_infinie_extr (f c) lim_extr,
end

/-
In the next exercise, we can use:

  abs_neg x : |-x| = |x|
-/

-- 0078
lemma continuous_opposite {f : ℝ → ℝ} {x₀ : ℝ} (h : continuous_at_pt f x₀) :
  continuous_at_pt (λ x, -f x) x₀ :=
begin
  intros ε ε_pos,
  specialize h ε ε_pos,
  rcases h with ⟨δ, δ_pos, hδ⟩,
  use [δ, δ_pos],
  intros x hx,
  specialize hδ x hx,
  rw neg_sub_neg,
  rwa abs_sub,
end

/-
Now let's combine the two exercises above
-/

-- 0079
lemma bdd_below_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ m, ∀ x ∈ Icc a b, m ≤ f x :=
begin
  /-wtf-/
  have : ∃ M, ∀ x ∈ Icc a b, -f x ≤ M,
  { apply bdd_above_segment,
    intros x x_dans,
    exact continuous_opposite (hf x x_dans), },
  cases this with m hm,
  use -m,
  intros x hx,
  specialize hm x hx,
  linarith,
end

/-
Remember from the 5th file:

 unique_limit : seq_limit u l → seq_limit u l' → l = l'

and from the 6th one:

  subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
    seq_limit (u ∘ φ) l

We now admit the following version of the least upper bound theorem
(that cannot be proved without discussing the construction of real numbers
or admitting another strong theorem).

sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x

In the next exercise, it can be useful to prove inclusions of sets of real number.
By definition, A ⊆ B means : ∀ x, x ∈ A → x ∈ B.
Hence one can start a proof of A ⊆ B by `intros x x_in`,
which brings `x : ℝ` and `x_in : x ∈ A` in the local context,
and then prove `x ∈ B`.

Note also the use of
  {x | P x}
which denotes the set of x satisfying predicate P.

Hence `x' ∈ { x | P x} ↔ P x'`, by definition.
-/

-- 0080
example {a b : ℝ} (hab : a ≤ b) (hf : ∀ x ∈ Icc a b, continuous_at_pt f x) :
∃ x₀ ∈ Icc a b, ∀ x ∈ Icc a b, f x ≤ f x₀ :=
begin
  cases bdd_below_segment hf with m hm,
  cases bdd_above_segment hf with M hM,
  let A := {y | ∃ x ∈ Icc a b, y = f x},
  obtain ⟨y₀, y_dans, y_sup⟩ : ∃ y₀ ∈ Icc m M, is_sup A y₀,
  { apply sup_segment,
    { use [f a, a, by linarith, hab, by ring], },
    { rintros y ⟨x, x_in, rfl⟩,
      exact ⟨hm x x_in, hM x x_in⟩ } },
  rw is_sup_iff at y_sup,
  rcases y_sup with ⟨y_maj, u, lim_u, u_dans⟩,
  choose v hv using u_dans,
  cases forall_and_distrib.mp hv with v_dans hufv,
  replace hufv : u = f ∘ v := funext hufv,
  rcases bolzano_weierstrass v_dans with ⟨x₀, x₀_in, φ, φ_extr, lim_vφ⟩,
  use [x₀, x₀_in],
  intros x x_dans,
  have lim : seq_limit (f ∘ v ∘ φ) (f x₀),
  { apply seq_continuous_of_continuous,
    exact hf x₀ x₀_in,
    exact lim_vφ },
  have unique : f x₀ = y₀,
  { apply unique_limit lim,
    rw hufv at lim_u,
    exact subseq_tendsto_of_tendsto lim_u φ_extr },
  rw unique,
  apply y_maj,
  use [x, x_dans],
end

lemma stupid {a b x : ℝ} (h : x ∈ Icc a b) (h' : x ≠ b) : x < b :=
lt_of_le_of_ne h.right h'

/-
And now the final boss...
-/

def I := (Icc 0 1 : set ℝ) -- the type ascription makes sure 0 and 1 are real numbers here

-- 0081
example (f : ℝ → ℝ) (hf : ∀ x, continuous_at_pt f x) (h₀ : f 0 < 0) (h₁ : f 1 > 0) :
∃ x₀ ∈ I, f x₀ = 0 :=
begin
  let A := { x | x ∈ I ∧ f x < 0},
  have ex_x₀ : ∃ x₀ ∈ I, is_sup A x₀,
  {
    apply sup_segment,
      use 0,
      split,
        split, linarith, linarith,
      exact h₀,
    intros x hx,
    exact hx.left,
  },
  rcases ex_x₀ with ⟨x₀, x₀_in, x₀_sup⟩,
  use [x₀, x₀_in],
  have : f x₀ ≤ 0,
  {
    rw is_sup_iff at x₀_sup,
    rcases x₀_sup with ⟨maj_x₀, u, lim_u, u_dans⟩,
    have : seq_limit (f ∘ u) (f x₀),
      exact seq_continuous_of_continuous (hf x₀) lim_u,
    apply lim_le this,
    intros n,
    have : f (u n) < 0,
      exact (u_dans n).right,
    linarith
  },
  have x₀_1: x₀ < 1,
  {
    apply stupid x₀_in,
    intro h,
    rw ← h at h₁,
    linarith
  },
  have : f x₀ ≥ 0,
  { have dans : ∃ N : ℕ, ∀ n ≥ N, x₀ + 1/(n+1) ∈ I,
    { have : ∃ N : ℕ, ∀ n≥ N, 1/(n+1 : ℝ) ≤ 1-x₀,
      {
        apply inv_succ_le_all,
        linarith,
      },
      cases this with N hN,
      use N,
      intros n hn,
      specialize hN n hn,
      have : 1/(n+1 : ℝ) > 0,
        exact nat.one_div_pos_of_nat,
      change 0 ≤ x₀ ∧ x₀ ≤ 1 at x₀_in,
      split ; linarith,
    },
    have not_in : ∀ n : ℕ, x₀ + 1/(n+1) ∉ A,
    -- By definition, x ∉ A means ¬ (x ∈ A).
    {
      intros n hn,
      cases x₀_sup with x₀_maj _,
      specialize x₀_maj _ hn,
      have : 1/(n+1 : ℝ) > 0,
        from nat.one_div_pos_of_nat,
      linarith,
    },
    dsimp [A] at not_in, -- This is useful to unfold a let
    push_neg at not_in,
    have lim : seq_limit (λ n, f(x₀ + 1/(n+1))) (f x₀),
    { apply seq_continuous_of_continuous (hf x₀),
      apply limit_const_add_inv_succ },
    apply le_lim lim,
    cases dans with N hN,
    use N,
    intros n hn,
    cases not_in n with H H,
    { exfalso,
      exact H (hN n hn) },
    { exact H }
  },
  linarith,
end


import data.equiv.basic
import group_theory.subgroup
import set_theory.cardinal
import order.basic
import tactic.abel

import for_mathlib.with_zero
import for_mathlib.punit_instances

universes u v
set_option old_structure_cmd true

class linear_ordered_comm_monoid (α : Type*) extends comm_monoid α, linear_order α :=
(mul_le_mul_left : ∀ {a b : α}, a ≤ b → ∀ c : α, c * a ≤ c * b)

class linear_ordered_comm_group (α : Type*) extends comm_group α, linear_ordered_comm_monoid α

namespace linear_ordered_structure
variables {α : Type u} [linear_ordered_comm_monoid α] {x y z : α}
variables {β : Type v} [linear_ordered_comm_monoid β]

lemma mul_le_mul_left (h : x ≤ y) (c : α) : c * x ≤ c * y :=
linear_ordered_comm_monoid.mul_le_mul_left h c

class linear_ordered_comm_monoid.is_hom (f : α → β) extends is_monoid_hom f : Prop :=
(ord : ∀ {a b : α}, a ≤ b → f a ≤ f b)

structure linear_ordered_comm_monoid.equiv extends equiv α β :=
(is_hom : linear_ordered_comm_monoid.is_hom to_fun)

lemma mul_le_mul_right (H : x ≤ y) : ∀ z : α, x * z ≤ y * z :=
λ z, mul_comm z x ▸ mul_comm z y ▸ mul_le_mul_left H z
end linear_ordered_structure

namespace linear_ordered_structure
section monoid
variables {α : Type u} [linear_ordered_comm_monoid α] {x y z : α}
variables {β : Type v} [linear_ordered_comm_monoid β]

lemma one_le_mul_of_one_le_of_one_le (Hx : 1 ≤ x) (Hy : 1 ≤ y) : 1 ≤ x * y :=
have h1 : x * 1 ≤ x * y, from mul_le_mul_left Hy x,
have h2 : x ≤ x * y, by rwa mul_one x at h1,
le_trans Hx h2

lemma one_le_pow_of_one_le {n : ℕ} (H : 1 ≤ x) : 1 ≤ x^n :=
begin
  induction n with n ih,
  { exact le_refl 1 },
  { exact one_le_mul_of_one_le_of_one_le H ih }
end

lemma mul_le_one_of_le_one_of_le_one (Hx : x ≤ 1) (Hy : y ≤ 1) : x * y ≤ 1 :=
have h1 : x * y ≤ x * 1, from mul_le_mul_left Hy x,
have h2 : x * y ≤ x, by rwa mul_one x at h1,
le_trans h2 Hx

lemma pow_le_one_of_le_one {n : ℕ} (H : x ≤ 1) : x^n ≤ 1 :=
begin
  induction n with n ih,
  { exact le_refl 1 },
  { exact mul_le_one_of_le_one_of_le_one H ih }
end

/-- Wedhorn Remark 1.6 (3) -/
lemma eq_one_of_pow_eq_one {n : ℕ} (hn : n ≠ 0) (H : x ^ n = 1) : x = 1 :=
begin
  rcases nat.exists_eq_succ_of_ne_zero hn with ⟨n, rfl⟩, clear hn,
  induction n with n ih,
  { simpa using H },
  { cases le_total x 1,
    all_goals
    { have h1 := mul_le_mul_right h (x ^ (n+1)),
      rw pow_succ at H,
      rw [H, one_mul] at h1 },
    { have h2 := pow_le_one_of_le_one h,
      exact ih (le_antisymm h2 h1) },
    { have h2 := one_le_pow_of_one_le h,
      exact ih (le_antisymm h1 h2) } }
end

open_locale classical

lemma le_one_of_pow_le_one {a : α} (n : ℕ) (hn : n ≠ 0) (h : a^n ≤ 1) : a ≤ 1 :=
begin
  rcases lt_or_eq_of_le h with H|H,
  { apply le_of_lt, contrapose! H, exact one_le_pow_of_one_le H, },
  { apply le_of_eq, exact eq_one_of_pow_eq_one hn H }
end

end monoid

section group
variables {α : Type u} [linear_ordered_comm_group α] {x y z : α}
variables {β : Type v} [linear_ordered_comm_group β]

class linear_ordered_comm_group.is_hom (f : α → β) extends is_group_hom f : Prop :=
(ord : ∀ {a b : α}, a ≤ b → f a ≤ f b)

-- this is Kenny's; I think we should have iff
structure linear_ordered_comm_group.equiv extends equiv α β :=
(is_hom : linear_ordered_comm_group.is_hom to_fun)

lemma div_le_div (a b c d : α) : a * b⁻¹ ≤ c * d⁻¹ ↔ a * d ≤ c * b :=
begin
  split ; intro h,
  have := mul_le_mul_right (mul_le_mul_right h b) d,
  rwa [inv_mul_cancel_right, mul_assoc _ _ b, mul_comm _ b, ← mul_assoc, inv_mul_cancel_right] at this,
  have := mul_le_mul_right (mul_le_mul_right h d⁻¹) b⁻¹,
  rwa [mul_inv_cancel_right, _root_.mul_assoc, _root_.mul_comm d⁻¹ b⁻¹, ← mul_assoc, mul_inv_cancel_right] at this,
end

lemma inv_le_one_of_one_le (H : 1 ≤ x) : x⁻¹ ≤ 1 :=
by simpa using mul_le_mul_left H (x⁻¹)

lemma inv_le_inv_of_le (H : x ≤ y) : y⁻¹ ≤ x⁻¹ :=
have h1 : _ := mul_le_mul_left H (x⁻¹ * y⁻¹),
by rwa [inv_mul_cancel_right, mul_comm x⁻¹, inv_mul_cancel_right] at h1

lemma le_one_or_inv_le_one (x : α) : x ≤ 1 ∨ x⁻¹ ≤ 1 :=
or.imp id inv_le_one_of_one_le (le_total x 1)

lemma le_or_inv_le_inv (x y : α) : x ≤ y ∨ x⁻¹ ≤ y⁻¹ :=
or.imp id inv_le_inv_of_le (le_total x y)

end group

end linear_ordered_structure

namespace linear_ordered_structure
variables {α : Type*} [linear_ordered_comm_group α]
instance inhabited : inhabited α := ⟨1⟩

lemma mul_lt_right  :
  ∀ {a b} c : α, a < b → a*c < b*c :=
begin
  introv h,
  rw lt_iff_le_and_ne,
  refine ⟨linear_ordered_structure.mul_le_mul_right (le_of_lt h) _, _⟩,
  intro h',
  rw mul_right_cancel h' at h,
  exact lt_irrefl b h
end

lemma mul_lt_left  :
  ∀ {a b} c : α, a < b → c*a < c*b :=
begin
  introv h,
  rw [mul_comm c, mul_comm c],
  exact mul_lt_right _ h,
end

lemma mul_lt_mul  :
  ∀ {a b c d : α}, a < b → c < d → a*c < b*d :=
begin
  introv hab hcd,
  calc a*c < b*c : mul_lt_right _ hab
  ... < b*d : mul_lt_left _ hcd
end

lemma lt_of_mul_lt_mul_left {α : Type*} [linear_ordered_comm_group α] :
  ∀ a b c : α, a * b < a * c → b < c :=
λ a b c h, lt_of_not_ge (λ h', lt_irrefl _ $ lt_of_lt_of_le h $
                               linear_ordered_structure.mul_le_mul_left h' a)

-- TODO: for completeness, we would need variations
lemma mul_inv_lt_of_lt_mul {x y z : α} (h : x < y*z) : x*z⁻¹ < y :=
by simpa [mul_inv_cancel_right] using mul_lt_right z⁻¹ h

-- TODO find the right decidability type class when PRing, instead of using `classical`
lemma exists_square_le (a : α) : ∃ b : α, b*b ≤ a :=
begin
  classical,
  by_cases h : a < 1,
  { use a,
    have := mul_lt_right a h,
    rw one_mul at this,
    exact le_of_lt this },
  { use 1,
    push_neg at h,
    rwa mul_one }
end

end linear_ordered_structure

namespace linear_ordered_structure
variables {α : Type*} [linear_ordered_comm_group α]
variables {β : Type v} [linear_ordered_comm_group β]

class is_convex (S : set α) : Prop :=
(one_mem : (1:α) ∈ S)
(mul_mem : ∀ {x y}, x ∈ S → y ∈ S → x * y ∈ S)
(inv_mem : ∀ {x}, x ∈ S → x⁻¹ ∈ S)
(mem_of_between : ∀ {x y}, x ≤ y → y ≤ (1:α) → x ∈ S → y ∈ S)

class is_proper_convex (S : set α) extends is_convex S : Prop :=
(exists_ne : ∃ (x y : α) (hx : x ∈ S) (hy : y ∈ S), x ≠ y)

definition convex_linear_order : linear_order {S : set α // is_convex S} :=
{ le_total := λ ⟨x, hx⟩ ⟨y, hy⟩, classical.by_contradiction $ λ h,
    let ⟨h1, h2⟩ := not_or_distrib.1 h,
        ⟨m, hmx, hmny⟩ := set.not_subset.1 h1,
        ⟨n, hny, hnnx⟩ := set.not_subset.1 h2 in
    begin
      cases le_total m n with hmn hnm,
      { cases le_one_or_inv_le_one n with hn1 hni1,
        { exact hnnx (@@is_convex.mem_of_between _ hx hmn hn1 hmx) },
        { cases le_total m (n⁻¹) with hmni hnim,
          { exact hnnx (inv_inv n ▸ (@@is_convex.inv_mem _ hx $ @@is_convex.mem_of_between _ hx hmni hni1 hmx)) },
          { cases le_one_or_inv_le_one m with hm1 hmi1,
            { exact hmny (@@is_convex.mem_of_between _ hy hnim hm1 $ @@is_convex.inv_mem _ hy hny) },
            { exact hmny (inv_inv m ▸ (@@is_convex.inv_mem _ hy $ @@is_convex.mem_of_between _ hy (inv_le_inv_of_le hmn) hmi1 $ @@is_convex.inv_mem _ hy hny)) } } } },
      { cases le_one_or_inv_le_one m with hm1 hmi1,
        { exact hmny (@@is_convex.mem_of_between _ hy hnm hm1 hny) },
        { cases le_total n (m⁻¹) with hnni hmim,
          { exact hmny (inv_inv m ▸ (@@is_convex.inv_mem _ hy $ @@is_convex.mem_of_between _ hy hnni hmi1 hny)) },
          { cases le_one_or_inv_le_one n with hn1 hni1,
            { exact hnnx (@@is_convex.mem_of_between _ hx hmim hn1 $ @@is_convex.inv_mem _ hx hmx) },
            { exact hnnx (inv_inv n ▸ (@@is_convex.inv_mem _ hx $ @@is_convex.mem_of_between _ hx (inv_le_inv_of_le hnm) hni1 $ @@is_convex.inv_mem _ hx hmx)) } } } }
    end,
  .. subtype.partial_order is_convex }

def ker (f : α → β) (hf : linear_ordered_comm_group.is_hom f) : set α :=
{ x | f x = 1 }

theorem ker.is_convex (f : α → β) (hf : linear_ordered_comm_group.is_hom f) : is_convex (ker f hf) :=
{ one_mem := is_group_hom.map_one f,
  mul_mem := λ x y hx hy, show f (x * y) = 1, by dsimp [ker] at hx hy; rw
    [is_mul_hom.map_mul f, hx, hy, mul_one],
  inv_mem := λ x hx, show f x⁻¹ = 1, by dsimp [ker] at hx;
    rw [is_group_hom.map_inv f x, hx, one_inv],
  mem_of_between := λ x y hxy hy1 hx,
    le_antisymm (is_group_hom.map_one f ▸ linear_ordered_comm_group.is_hom.ord _ hy1)
      (hx ▸ linear_ordered_comm_group.is_hom.ord _ hxy) }

def height (α : Type) [linear_ordered_comm_group α] : cardinal :=
cardinal.mk {S : set α // is_proper_convex S}

namespace is_convex
open_locale classical

variables (S : set α) [is_convex S]

lemma mem_of_between' {a b c : α} (ha : a ∈ S) (hc : c ∈ S) (hab : a ≤ b) (hbc : b ≤ c) :
  b ∈ S :=
begin
  cases le_total b 1 with hb hb,
  { exact is_convex.mem_of_between hab hb ha },
  rw ← _root_.inv_inv b,
  apply is_convex.inv_mem,
  apply @is_convex.mem_of_between α _ S _ c⁻¹ _ _ _ (is_convex.inv_mem hc),
  { contrapose! hbc, have := mul_lt_right (b*c) hbc,
    rwa [inv_mul_cancel_left, mul_left_comm, mul_left_inv, mul_one] at this },
  { contrapose! hb, simpa using mul_lt_right b hb, }
end

lemma pow_mem {a : α} (ha : a ∈ S) (n : ℕ) : a^n ∈ S :=
begin
  induction n with n ih, { rw pow_zero, exact is_convex.one_mem S },
  rw pow_succ, exact is_convex.mul_mem ha ih,
end

lemma gpow_mem {a : α} (ha : a ∈ S) : ∀ (n : ℤ), a^n ∈ S
| (int.of_nat n) := by { rw [gpow_of_nat], exact is_convex.pow_mem S ha n }
| -[1+n] := by { apply is_convex.inv_mem, exact is_convex.pow_mem S ha _ }

end is_convex

namespace is_proper_convex
variables {x y z : α}

lemma exists_one_lt (S : set α) [h : is_proper_convex S] :
  ∃ a : α, a ∈ S ∧ 1 < a :=
begin
  choose x y hx hy hxy using h.exists_ne,
  rcases lt_trichotomy 1 x with Hx|rfl|Hx,
  { use [x, hx, Hx] },
  { rcases lt_trichotomy 1 y with Hy|rfl|Hy,
    { use [y, hy, Hy] },
    { contradiction },
    { refine ⟨y⁻¹, is_convex.inv_mem hy, _⟩,
      simpa using mul_lt_right y⁻¹ Hy, } },
  { refine ⟨x⁻¹, is_convex.inv_mem hx, _⟩,
    simpa using mul_lt_right x⁻¹ Hx, }
end

lemma exists_lt_one (S : set α) [h : is_proper_convex S] :
  ∃ a : α, a ∈ S ∧ a < 1 :=
begin
  rcases exists_one_lt S with ⟨x, H1, H2⟩,
  use [x⁻¹, is_convex.inv_mem H1],
  simpa using mul_lt_right x⁻¹ H2,
end

end is_proper_convex

end linear_ordered_structure

section
set_option old_structure_cmd true

/-- An ordered commutative monoid is a commutative monoid
  with a partial order such that mulition is an order embedding, i.e.
  `a * b ≤ a * c ↔ b ≤ c`.

  This name is needed because the `ordered_comm_monoid` that exists in mathlib
  is actually an additive monoid. TODO: refactor this. -/
class actual_ordered_comm_monoid (α : Type*) extends comm_monoid α, partial_order α :=
(mul_le_mul_left       : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b)
(lt_of_mul_lt_mul_left : ∀ a b c : α, a * b < a * c → b < c)
end

namespace actual_ordered_comm_monoid
variables {α : Type*} [actual_ordered_comm_monoid α] {a b c d : α}

lemma mul_le_mul_left' (h : a ≤ b) : c * a ≤ c * b :=
actual_ordered_comm_monoid.mul_le_mul_left a b h c

lemma mul_le_mul_right' (h : a ≤ b) : a * c ≤ b * c :=
mul_comm c a ▸ mul_comm c b ▸ mul_le_mul_left' h

lemma lt_of_mul_lt_mul_left' (a : α) : a * b < a * c → b < c :=
actual_ordered_comm_monoid.lt_of_mul_lt_mul_left a b c

lemma mul_le_mul' (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d :=
_root_.le_trans (mul_le_mul_right' h₁) (mul_le_mul_left' h₂)

lemma le_mul_of_nonneg_right' (h : b ≥ 1) : a ≤ a * b :=
have a * b ≥ a * 1, from mul_le_mul_left' h,
by rwa mul_one at this

lemma le_mul_of_nonneg_left' (h : b ≥ 1) : a ≤ b * a :=
have 1 * a ≤ b * a, from mul_le_mul_right' h,
by rwa one_mul at this

lemma lt_of_mul_lt_mul_right' (b : α) (h : a * b < c * b) : a < c :=
lt_of_mul_lt_mul_left' b
  (show b * a < b * c, begin rw [mul_comm b a, mul_comm b c], assumption end)

-- here we start using properties of one.
lemma le_mul_of_nonneg_of_le' (ha : 1 ≤ a) (hbc : b ≤ c) : b ≤ a * c :=
one_mul b ▸ mul_le_mul' ha hbc

lemma le_mul_of_le_of_nonneg' (hbc : b ≤ c) (ha : 1 ≤ a) : b ≤ c * a :=
mul_one b ▸ mul_le_mul' hbc ha

lemma mul_nonneg' (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b :=
le_mul_of_nonneg_of_le' ha hb

lemma mul_gt_one_of_gt_one_of_nonneg' (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
lt_of_lt_of_le ha $ le_mul_of_nonneg_right' hb

lemma mul_gt_one' (ha : 1 < a) (hb : 1 < b) : 1 < a * b :=
mul_gt_one_of_gt_one_of_nonneg' ha $ le_of_lt hb

lemma mul_gt_one_of_nonneg_of_gt_one' (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
lt_of_lt_of_le hb $ le_mul_of_nonneg_left' ha

lemma mul_nongt_one' (ha : a ≤ 1) (hb : b ≤ 1) : a * b ≤ 1 :=
one_mul (1:α) ▸ (mul_le_mul' ha hb)

lemma mul_le_of_nongt_one_of_le' (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c :=
one_mul c ▸ mul_le_mul' ha hbc

lemma mul_le_of_le_of_nongt_one' (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c :=
mul_one c ▸ mul_le_mul' hbc ha

lemma mul_neg_of_neg_of_nongt_one' (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
lt_of_le_of_lt (mul_le_of_le_of_nongt_one' (le_refl _) hb) ha

lemma mul_neg_of_nongt_one_of_neg' (ha : a ≤ 1) (hb : b < 1) : a * b < 1 :=
lt_of_le_of_lt (mul_le_of_nongt_one_of_le' ha (le_refl _)) hb

lemma mul_neg' (ha : a < 1) (hb : b < 1) : a * b < 1 :=
mul_neg_of_nongt_one_of_neg' (le_of_lt ha) hb

lemma lt_mul_of_nonneg_of_lt' (ha : 1 ≤ a) (hbc : b < c) : b < a * c :=
lt_of_lt_of_le hbc $ le_mul_of_nonneg_left' ha

lemma lt_mul_of_lt_of_nonneg' (hbc : b < c) (ha : 1 ≤ a) : b < c * a :=
lt_of_lt_of_le hbc $ le_mul_of_nonneg_right' ha

lemma lt_mul_of_gt_one_of_lt' (ha : 1 < a) (hbc : b < c) : b < a * c :=
lt_mul_of_nonneg_of_lt' (le_of_lt ha) hbc

lemma lt_mul_of_lt_of_gt_one' (hbc : b < c) (ha : 1 < a) : b < c * a :=
lt_mul_of_lt_of_nonneg' hbc (le_of_lt ha)

lemma mul_lt_of_nongt_one_of_lt' (ha : a ≤ 1) (hbc : b < c) : a * b < c :=
lt_of_le_of_lt (mul_le_of_nongt_one_of_le' ha (le_refl _)) hbc

lemma mul_lt_of_lt_of_nongt_one' (hbc : b < c) (ha : a ≤ 1)  : b * a < c :=
lt_of_le_of_lt (mul_le_of_le_of_nongt_one' (le_refl _) ha) hbc

lemma mul_lt_of_neg_of_lt' (ha : a < 1) (hbc : b < c) : a * b < c :=
mul_lt_of_nongt_one_of_lt' (le_of_lt ha) hbc

lemma mul_lt_of_lt_of_neg' (hbc : b < c) (ha : a < 1) : b * a < c :=
mul_lt_of_lt_of_nongt_one' hbc (le_of_lt ha)

lemma mul_eq_one_iff' (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 :=
iff.intro
  (assume hab : a * b = 1,
   have a ≤ 1, from hab ▸ le_mul_of_le_of_nonneg' (le_refl _) hb,
   have a = 1, from _root_.le_antisymm this ha,
   have b ≤ 1, from hab ▸ le_mul_of_nonneg_of_le' ha (le_refl _),
   have b = 1, from _root_.le_antisymm this hb,
   and.intro ‹a = 1› ‹b = 1›)
  (assume ⟨ha', hb'⟩, by rw [ha', hb', mul_one])

lemma mul_eq_one_iff_of_le_one' (ha : a ≤ 1) (hb : b ≤ 1) : a * b = 1 ↔ a = 1 ∧ b = 1 :=
begin
  refine iff.intro _ (assume ⟨ha', hb'⟩, by rw [ha', hb', mul_one]),
  intro hab,
  have : 1 ≤ a, { rw [← mul_one a, ← hab], exact mul_le_mul' (le_refl _) hb, },
  have : 1 ≤ b, { rw [← one_mul b, ← hab], exact mul_le_mul' ha (le_refl _), },
  split; apply _root_.le_antisymm; assumption
end

lemma square_gt_one {a : α} (h : 1 < a) : 1 < a*a :=
mul_gt_one' h h

lemma pow_le_one {a : α} (h : a ≤ 1) (n : ℕ) : a^n ≤ 1 :=
begin
  induction n with n ih, {rwa pow_zero},
  rw pow_succ,
  transitivity a,
  { simpa only [mul_one] using mul_le_mul_left' ih },
  { exact h }
end

lemma one_le_pow {a : α} (h : 1 ≤ a) (n : ℕ) : 1 ≤ a^n :=
begin
  induction n with n ih, {rwa pow_zero},
  rw pow_succ,
  transitivity a,
  { exact h },
  { simpa only [mul_one] using mul_le_mul_left' ih }
end

end actual_ordered_comm_monoid

variables {Γ₀ : Type*} [linear_ordered_comm_group Γ₀]

example (Γ₀ : Type*) [linear_ordered_comm_group Γ₀] : (1 : with_zero Γ₀) ≠ 0 := by simp

class linear_ordered_cancel_comm_monoid_with_zero (α : Type*)
  extends linear_ordered_comm_monoid α, zero_ne_one_class α :=
(zero_le : ∀ a : α, 0 ≤ a)
(mul_left_cancel {a b c : α} (h : a ≠ 0) : a * b = a * c → b = c)

namespace linear_ordered_cancel_comm_monoid_with_zero

-- variables {α : Type u} [linear_ordered_cancel_comm_monoid_with_zero α] {x: α}
-- when we need to make an API for this object

end linear_ordered_cancel_comm_monoid_with_zero

instance punit.linear_ordered_comm_group : linear_ordered_comm_group punit :=
{ mul_le_mul_left := λ a b h c, trivial,
  .. punit.decidable_linear_ordered_cancel_comm_monoid,
  .. punit.comm_group }

namespace with_zero

variables {α : Type u} {β : Type v}

variables [linear_ordered_comm_group α] [linear_ordered_comm_group β]

theorem map_mul (f : α → β) [is_group_hom f] (x y : with_zero α) :
map f (x * y) = option.map f x * option.map f y :=
begin
  cases hx : x; cases hy : y; try {refl},
  show some (f (val * val_1)) = some ((f val) * (f val_1)),
  apply option.some_inj.2,
  exact is_mul_hom.map_mul f val val_1
end

lemma mul_le_mul_left : ∀ a b : with_zero α, a ≤ b → ∀ c : with_zero α, c * a ≤ c * b
| (some x) (some y) hxy (some z) := begin
    rw with_bot.some_le_some at hxy,
    change @has_le.le (with_zero α) _ (some (z * x)) (some (z * y)),
    simp,
    exact linear_ordered_structure.mul_le_mul_left hxy z,
  end
| _        _        hxy 0        := by simp
| (some x) 0        hxy _        := by simp [le_antisymm hxy (le_of_lt (with_bot.bot_lt_some x))]
| 0        _        hxy (some _) := by simp

instance : linear_ordered_comm_monoid (with_zero α) :=
{ mul_le_mul_left := mul_le_mul_left,
  .. with_zero.comm_monoid,
  .. with_zero.linear_order }

theorem eq_zero_or_eq_zero_of_mul_eq_zero : ∀ x y : with_zero α, x * y = 0 → x = 0 ∨ y = 0
| (some x) (some y) hxy := false.elim $ option.no_confusion hxy
| 0        _        hxy := or.inl rfl
| _        0        hxy := or.inr rfl

@[simp] lemma mul_inv_self (a : with_zero α) : a * a⁻¹ ≤ 1 :=
begin
  cases a,
  { exact zero_le },
  { apply le_of_eq _,
    exact congr_arg some (mul_inv_self a) }
end

@[simp] lemma div_self (a : with_zero α) : a / a ≤ 1 := mul_inv_self a

@[move_cast] lemma div_coe' (a b : α) : (a*b⁻¹ : with_zero α) = a / b := rfl

lemma div_le_div (a b c d : with_zero α) (hb : b ≠ 0) (hd : d ≠ 0) :
  a / b ≤ c / d ↔ a * d ≤ c * b :=
begin
  rcases ne_zero_iff_exists.1 hb with ⟨b, rfl⟩,
  rcases ne_zero_iff_exists.1 hd with ⟨d, rfl⟩,
  with_zero_cases a c,
  exact linear_ordered_structure.div_le_div _ _ _ _
end

end with_zero

namespace with_zero
open linear_ordered_structure

lemma coe_of_gt {x y : with_zero Γ₀} (h : x < y) : ∃ γ : Γ₀, y = (γ : with_zero Γ₀) :=
by { with_zero_cases y }

lemma eq_coe_of_mul_eq_coe_right {x y : with_zero Γ₀} {γ : Γ₀} (h : x*y = γ) :
  ∃ γ' : Γ₀, y = γ' :=
begin
  rw ←with_zero.ne_zero_iff_exists,
  intro hy,
  rw [hy, mul_zero] at h,
  exact zero_ne_coe h
end

lemma eq_coe_of_mul_eq_coe_left {x y : with_zero Γ₀} {γ : Γ₀} (h : x*y = γ) :
  ∃ γ' : Γ₀, x = γ' :=
by rw mul_comm at h ; exact eq_coe_of_mul_eq_coe_right h

lemma eq_coe_of_mul_eq_coe {x y : with_zero Γ₀} {γ : Γ₀} (h : x*y = γ) :
  (∃ γ' : Γ₀, x = γ') ∧ ∃ γ'' : Γ₀, y = γ'' :=
⟨eq_coe_of_mul_eq_coe_left h, eq_coe_of_mul_eq_coe_right h⟩

lemma mul_inv_lt_of_lt_mul {x y z : with_zero Γ₀} (h : x < y*z) : x*z⁻¹ < y :=
begin
  cases coe_of_gt h with γ h',
  rcases eq_coe_of_mul_eq_coe h' with ⟨⟨γ', hy⟩, γ'', hz⟩,
  rw [hy, hz] at *,
  with_zero_cases x,
  exact mul_inv_lt_of_lt_mul h
end

lemma eq_inv_of_mul_eq_one_right {x y : with_zero Γ₀} (h : x*y = 1) : y = x⁻¹ :=
begin
  rcases eq_coe_of_mul_eq_coe h with ⟨⟨γ', hx⟩, γ'', hy⟩,
  rw [hx, hy] at *,
  norm_cast at *,
  rwa [mul_eq_one_iff_inv_eq, eq_comm] at h,
end

lemma eq_inv_of_mul_eq_one_left {x y : with_zero Γ₀} (h : x*y = 1) : x = y⁻¹ :=
begin
  rw mul_comm at h,
  exact eq_inv_of_mul_eq_one_right h,
end

instance : actual_ordered_comm_monoid (with_zero Γ₀) :=
{ mul_le_mul_left := λ x y x_le_y z,
    by { with_zero_cases x y z, exact linear_ordered_structure.mul_le_mul_left x_le_y z },
  lt_of_mul_lt_mul_left := λ x y z hlt,
    by { with_zero_cases x y z, exact linear_ordered_structure.lt_of_mul_lt_mul_left _ _ _ hlt },
  ..(by apply_instance : comm_monoid (with_zero Γ₀)),
  ..(by apply_instance : partial_order (with_zero Γ₀)),
}

variables {a b c d : with_zero Γ₀}

lemma mul_lt_mul : a < b → c < d → a*c < b*d :=
begin
  intros hab hcd,
  rcases coe_of_gt hcd with ⟨γ, rfl⟩,
  rcases coe_of_gt hab with ⟨γ', rfl⟩,
  with_zero_cases a c,
  exact linear_ordered_structure.mul_lt_mul hab hcd
end

lemma mul_lt_right (γ : Γ₀) (h : a < b) : a*γ < b*γ :=
begin
  rcases coe_of_gt h with ⟨γ', rfl⟩,
  with_zero_cases a,
  exact linear_ordered_structure.mul_lt_right _ h
end

lemma mul_lt_left (γ : Γ₀) (h : a < b) : (γ : with_zero Γ₀)*a < γ*b :=
begin
  repeat { rw mul_comm (γ : with_zero Γ₀) },
  exact mul_lt_right γ h
end

lemma le_of_le_mul_right (h : c ≠ 0) (hab : a * c ≤ b * c) : a ≤ b :=
begin
  replace hab := linear_ordered_structure.mul_le_mul_right hab c⁻¹,
  rwa [mul_assoc, mul_assoc, mul_right_inv _ h, mul_one, mul_one] at hab,
end

lemma le_of_le_mul_left (h : c ≠ 0) (hab : c * a ≤ c * b) :
  a ≤ b := by {rw [mul_comm, mul_comm c] at hab, exact with_zero.le_of_le_mul_right h hab}

lemma le_mul_inv_of_mul_le (h : c ≠ 0) (hab : a * c ≤ b) : a ≤ b * c⁻¹ :=
le_of_le_mul_right h (by rwa [mul_assoc, mul_left_inv _ h, mul_one])

lemma mul_inv_le_of_le_mul (h : c ≠ 0) (hab : a ≤ b * c) : a * c⁻¹ ≤ b :=
le_of_le_mul_right h (by rwa [mul_assoc, mul_left_inv _ h, mul_one])

end with_zero