import data.padics
import ring_theory.noetherian

import for_mathlib.group_with_zero
import for_mathlib.ideal_operations

noncomputable theory
open_locale classical

variables {p : ℕ} [nat.prime p]

local attribute [-simp] padic.cast_eq_of_rat_of_nat

namespace padic_seq

def valuation (f : padic_seq p) : ℤ :=
if hf : f ≈ 0 then 0 else padic_val_rat p (f (stationary_point hf))

lemma norm_eq_pow_val {f : padic_seq p} (hf : ¬ f ≈ 0) :
  f.norm = p^(-f.valuation : ℤ) :=
begin
  delta norm valuation,
  rw [dif_neg hf, dif_neg hf],
  delta padic_norm,
  rw if_neg,
  assume H, apply cau_seq.not_lim_zero_of_not_congr_zero hf,
  intros ε hε,
  use (stationary_point hf),
  intros n hn,
  rw stationary_point_spec hf (le_refl _) hn,
  simpa [H] using hε,
end

lemma val_eq_iff_norm_eq {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) :
  f.valuation = g.valuation ↔ f.norm = g.norm :=
begin
  rw [norm_eq_pow_val hf, norm_eq_pow_val hg, ← neg_inj', fpow_inj],
  { exact_mod_cast nat.prime.pos ‹_› },
  { exact_mod_cast nat.prime.ne_one ‹_› },
end

end padic_seq

@[simp] lemma real.supr_empty {α : Type*} (f : α → ℝ) :
  (⨆ (a ∈ (∅:set α)), f a) = 0 :=
begin
  suffices : lattice.Sup {x : ℝ | ∃ (y : α), 0 = x} = 0,
  by simpa [lattice.supr, set.range, real.Sup_empty],
  by_cases hα : nonempty α,
  { rcases hα with a,
    apply le_antisymm,
    { apply (real.Sup_le _ _ _).mpr,
      { rintros r ⟨_, rfl⟩, refl },
      { use [0, ⟨a, rfl⟩], },
      { use 0, rintros r ⟨_, rfl⟩, refl } },
    { apply real.le_Sup,
      { use 0, rintros r ⟨_, rfl⟩, refl },
      { use ⟨a, rfl⟩ } } },
  { convert real.Sup_empty,
    rw set.eq_empty_iff_forall_not_mem,
    rintros r ⟨a, rfl⟩, exact hα ⟨a⟩ }
end

namespace padic

-- generalize to nonarchimedean fields
lemma norm_sum {α : Type*} (s : finset α) (f : α → ℚ_[p]) :
  ∥s.sum f∥ ≤ s.fold max 0 (λ a, ∥f a∥) :=
begin
  apply finset.induction_on s, { simp, },
  clear s,
  intros a s ha IH,
  rw [finset.sum_insert ha, finset.fold_insert ha],
  refine le_trans (padic_norm_e.nonarchimedean _ _) (max_le _ _),
  { apply le_max_left, },
  { refine le_trans IH (le_max_right _ _), }
end
.

-- -- generalize to nonarchimedean fields
-- lemma norm_sum {α : Type*} (s : finset α) (f : α → ℚ_[p]) :
--   ∥s.sum f∥ ≤ ⨆ a∈s, ∥f a∥ :=
-- begin
--   apply finset.induction_on s,
--   { erw real.supr_empty, simp },
--   clear s,
--   intros a s ha IH,
--   rw [finset.sum_insert ha],
--   have := @lattice.supr_insert,
--   refine le_trans (padic_norm_e.nonarchimedean _ _) (max_le _ _),
--   { apply le_max_left, },
--   { refine le_trans IH (le_max_right _ _), }
-- end

@[simp] lemma norm_p : ∥(p : ℚ_[p])∥ = p⁻¹ :=
begin
  have p₀ : p ≠ 0 := nat.prime.ne_zero ‹_›,
  have p₁ : p ≠ 1 := nat.prime.ne_one ‹_›,
  simp [p₀, p₁, norm, padic_norm, padic_val_rat, fpow_neg, padic.cast_eq_of_rat_of_nat],
end

open normed_field

@[simp] lemma norm_p_pow (n : ℤ) : ∥(p^n : ℚ_[p])∥ = p^-n :=
by rw [norm_fpow, norm_p, fpow_neg, one_div_eq_inv,
  ← fpow_inv, ← fpow_inv, ← fpow_mul, ← fpow_mul, mul_comm]

def valuation : ℚ_[p] → ℤ :=
quotient.lift (@padic_seq.valuation p _) (λ f g h,
begin
  by_cases hf : f ≈ 0,
  { have hg : g ≈ 0, from setoid.trans (setoid.symm h) hf,
    simp [hf, hg, padic_seq.valuation] },
  { have hg : ¬ g ≈ 0, from (λ hg, hf (setoid.trans h hg)),
    rw padic_seq.val_eq_iff_norm_eq hf hg,
    exact padic_seq.norm_equiv h },
end)

@[simp] lemma valuation_zero : valuation (0 : ℚ_[p]) = 0 :=
dif_pos ((const_equiv p).2 rfl)

@[simp] lemma valuation_one : valuation (1 : ℚ_[p]) = 0 :=
begin
  change dite (cau_seq.const (padic_norm p) 1 ≈ _) _ _ = _,
  have h : ¬ cau_seq.const (padic_norm p) 1 ≈ 0,
  { assume H, erw const_equiv p at H, exact one_ne_zero H },
  rw dif_neg h,
  simp,
end

lemma norm_eq_pow_val {x : ℚ_[p]} (hx : x ≠ 0) :
  ∥x∥ = p^(-x.valuation) :=
begin
  revert hx, apply quotient.induction_on' x, clear x,
  intros f hf,
  change (padic_seq.norm _ : ℝ) = (p : ℝ) ^ -padic_seq.valuation _,
  rw padic_seq.norm_eq_pow_val,
  change ↑((p : ℚ) ^ -padic_seq.valuation f) = (p : ℝ) ^ -padic_seq.valuation f,
  { rw cast_fpow,
    congr' 1,
    norm_cast },
  { apply cau_seq.not_lim_zero_of_not_congr_zero,
    contrapose! hf, apply quotient.sound, simpa using hf, }
end

@[simp] lemma valuation_p : valuation (p : ℚ_[p]) = 1 :=
begin
  have h : (1 : ℝ) < p := by exact_mod_cast nat.prime.one_lt ‹_›,
  apply neg_inj,
  apply (fpow_strict_mono h).injective,
  dsimp only,
  rw ← norm_eq_pow_val,
  { simp [fpow_inv], },
  { exact_mod_cast nat.prime.ne_zero ‹_›, }
end

end padic

namespace padic_int
open local_ring

lemma norm_mul (x y : ℤ_[p]) : ∥x*y∥ = ∥x∥*∥y∥ :=
by exact_mod_cast normed_field.norm_mul (x:ℚ_[p]) (y:ℚ_[p])

lemma norm_pow (x : ℤ_[p]) : ∀ (n : ℕ), ∥x^n∥ = ∥x∥^n
| 0     := by simp
| (n+1) := by simp

@[simp] lemma norm_p : ∥(p : ℤ_[p])∥ = p⁻¹ :=
show ∥((p : ℤ_[p]) : ℚ_[p])∥ = p⁻¹, by exact_mod_cast padic.norm_p

@[simp] lemma norm_p_pow (n : ℕ) : ∥(p : ℤ_[p])^n∥ = p^(-n:ℤ) :=
show ∥((p^n : ℤ_[p]) : ℚ_[p])∥ = p^(-n:ℤ),
by { convert padic.norm_p_pow n, simp, }

def valuation (x : ℤ_[p]) := padic.valuation (x : ℚ_[p])

lemma norm_eq_pow_val {x : ℤ_[p]} (hx : x ≠ 0) :
  ∥x∥ = p^(-x.valuation) :=
begin
  convert padic.norm_eq_pow_val _,
  contrapose! hx,
  exact subtype.val_injective hx
end

@[simp] lemma valuation_zero : valuation (0 : ℤ_[p]) = 0 :=
padic.valuation_zero

@[simp] lemma valuation_one : valuation (1 : ℤ_[p]) = 0 :=
padic.valuation_one

@[simp] lemma valuation_p : valuation (p : ℤ_[p]) = 1 :=
by { delta valuation, exact_mod_cast padic.valuation_p }

lemma valuation_nonneg (x : ℤ_[p]) : 0 ≤ x.valuation :=
begin
  by_cases hx : x = 0,
  { simp [hx] },
  have h : (1 : ℝ) < p := by exact_mod_cast nat.prime.one_lt ‹_›,
  rw [← neg_nonpos, ← (fpow_strict_mono h).le_iff_le],
  show ↑p ^ -valuation x ≤ ↑p ^ 0,
  rw [← norm_eq_pow_val hx],
  simpa using x.property,
end

lemma norm_le_pow_iff_norm_lt_pow_succ (x : ℤ_[p]) (n : ℤ) :
  ∥x∥ ≤ p^n ↔ ∥x∥ < p^(n+1) :=
begin
  by_cases hx : x = 0,
  { have hp_pos : (0:ℝ) < p := by exact_mod_cast nat.prime.pos ‹_›,
    have hp_nonneg : (0:ℝ) ≤ p := le_of_lt hp_pos,
    simp [hx, fpow_pos_of_pos hp_pos, fpow_nonneg_of_nonneg hp_nonneg], },
  have hp : (1:ℝ) < p, { exact_mod_cast nat.prime.one_lt ‹_› },
  rw [norm_eq_pow_val hx, (fpow_strict_mono hp).le_iff_le,
    (fpow_strict_mono hp).lt_iff_lt, int.lt_add_one_iff],
end

def mk_units {u : ℚ_[p]} (h : ∥u∥ = 1) : units ℤ_[p] :=
let z : ℤ_[p] := ⟨u, le_of_eq h⟩ in ⟨z, z.inv, mul_inv h, inv_mul h⟩

@[simp]
lemma mk_units_eq {u : ℚ_[p]} (h : ∥u∥ = 1) : ((mk_units h : ℤ_[p]) : ℚ_[p]) = u :=
rfl

lemma exists_repr {x : ℤ_[p]} (hx : x ≠ 0) :
  ∃ (u : units ℤ_[p]) (n : ℕ), x = u*p^n :=
begin
  let u : ℚ_[p] := x*p^(-x.valuation),
  have repr : (x : ℚ_[p]) = u*p^x.valuation,
  { rw [mul_assoc, ← fpow_add],
    { simp },
    { exact_mod_cast nat.prime.ne_zero ‹_› } },
  have hu : ∥u∥ = 1,
    by simp [hx, nat.fpow_ne_zero_of_pos (by exact_mod_cast nat.prime.pos ‹_›) x.valuation,
             norm_eq_pow_val, fpow_neg, inv_mul_cancel],
  obtain ⟨n, hn⟩ : ∃ n : ℕ, valuation x = n,
    from int.eq_coe_of_zero_le (valuation_nonneg x),
  use [mk_units hu, n],
  apply subtype.val_injective,
  simp [hn, repr]
end

variable (p)

lemma span_p_is_maximal :
  (ideal.span ({p} : set ℤ_[p])).is_maximal :=
begin
  rw ideal.is_maximal_iff,
  split,
  { rw ideal.mem_span_singleton', push_neg, intro x,
    assume eq_one,
    suffices : ∥x * p∥ < 1,
    { apply ne_of_lt this, simp [eq_one] },
    have norm_p_lt_one : ∥(p:ℤ_[p])∥ < 1,
    { rw [norm_p], apply inv_lt_one, exact_mod_cast nat.prime.one_lt ‹_›, },
    simpa using mul_lt_mul' x.property norm_p_lt_one (norm_nonneg _) zero_lt_one, },
  { intros I x hI hx_ne hx_mem,
    rw ideal.mem_span_singleton' at hx_ne, push_neg at hx_ne,
    have x_ne_zero : x ≠ 0,
    { specialize hx_ne 0,
      contrapose! hx_ne with x_eq_zero,
      simpa using x_eq_zero.symm, },
    rcases exists_repr x_ne_zero with ⟨u, n, rfl⟩,
    cases n,
    { apply ideal.one_mem_of_unit_mem, simpa using hx_mem, },
    { exfalso,
      apply hx_ne (u*p^n),
      simp [pow_succ', mul_assoc] }, }
end

lemma nonunits_ideal_eq_span :
  nonunits_ideal ℤ_[p] = ideal.span {p} :=
unique_of_exists_unique (max_ideal_unique ℤ_[p])
  (nonunits_ideal.is_maximal _) (span_p_is_maximal p)

lemma nonunits_ideal_fg :
  (nonunits_ideal ℤ_[p]).fg :=
by { rw nonunits_ideal_eq_span, exact ⟨{p}, rfl⟩, }

lemma power_nonunits_ideal_eq_norm_le_pow (n : ℕ) :
  (↑((nonunits_ideal ℤ_[p])^n) : set ℤ_[p]) = {x | ∥x∥ ≤ p^-(n:ℤ) } :=
begin
  rw nonunits_ideal_eq_span p,
  rw ideal.span_singleton_pow,
  ext x,
  erw [ideal.mem_span_singleton', set.mem_set_of_eq],
  split,
  { rintros ⟨y, rfl⟩,
    rw [padic_int.norm_mul, norm_p_pow],
    apply le_of_mul_le_mul_right _ (_ : (p : ℝ)^n > 0),
    rw [mul_assoc, fpow_neg_mul_fpow_self, mul_one],
    { exact y.property },
    { exact_mod_cast ne_of_gt (nat.prime.pos ‹_›) },
    { exact nat.fpow_pos_of_pos (by exact_mod_cast nat.prime.pos ‹_›) (n : ℤ) } },
  { intro h,
    by_cases hx : x = 0, { use 0, simp [hx] },
    { rcases exists_repr hx with ⟨u, n', rfl⟩,
      suffices : n ≤ n',
      { use [u * p^(n' - n)],
        rw [mul_assoc, ← pow_add, nat.sub_add_cancel this], },
      have hp : (1:ℝ) < p, { exact_mod_cast nat.prime.one_lt ‹_› },
      rw [padic_int.norm_mul, is_unit_iff.1 (is_unit_unit u), one_mul, padic_int.norm_pow,
        norm_p, ← fpow_of_nat, ← fpow_inv, ← fpow_mul, (fpow_strict_mono hp).le_iff_le,
        neg_one_mul, neg_le_neg_iff] at h,
      exact_mod_cast h, } },
end

variable {p}

instance coe_is_ring_hom : is_ring_hom (coe : ℤ_[p] → ℚ_[p]) :=
{ map_one := rfl,
  map_mul := coe_mul,
  map_add := coe_add }

private lemma aux (p : ℚ) (n : ℤ) (hp : 1 ≤ p) (h : p ^ n < p) : p ^ n ≤ 1 :=
by simpa using fpow_le_of_le hp (le_of_not_lt $ λ h' : 0 < n, not_le_of_lt h $
  by simpa using fpow_le_of_le hp (int.add_one_le_iff.2 h'))

lemma coe_open_embedding : open_embedding (coe : ℤ_[p] → ℚ_[p]) :=
{ induced := rfl, inj := subtype.val_injective, open_range :=
    begin
      show is_open (set.range subtype.val),
      rw subtype.val_range,
      rw show {x : ℚ_[p] | ∥x∥ ≤ 1} = {x : ℚ_[p] | ∥x∥ < p},
      { ext x, split; intro h ; rw set.mem_set_of_eq at h ⊢,
        { calc  ∥x∥ ≤ 1 : h
               ... < _ : by exact_mod_cast (nat.prime.one_lt ‹_›) },
        { by_cases hx : x = 0,
          { simp [hx, zero_le_one] },
          { rcases padic_norm_e.image hx with ⟨n, hn⟩,
            have hp : 1 < p, from nat.prime.one_lt ‹_›,
            rw hn at h ⊢,
            norm_cast at h ⊢,
            apply aux, {exact_mod_cast le_of_lt hp}, {exact h} } } },
      rw ← ball_0_eq,
      exact metric.is_open_ball
    end }

lemma continuous_coe : continuous (coe : ℤ_[p] → ℚ_[p]) :=
 coe_open_embedding.to_embedding.continuous

end padic_int

lemma padic.exists_repr (x : ℚ_[p]) (hx : x ≠ 0) :
  ∃ (u : units ℤ_[p]) (n : ℤ), x = (u : ℤ_[p])*p^n :=
begin
  have : ∥x * (p : ℚ_[p])^(-x.valuation)∥ ≤ 1,
  { rw [normed_field.norm_mul, padic.norm_eq_pow_val hx, normed_field.norm_fpow, padic.norm_p,
      ← mul_fpow, mul_inv_cancel, one_fpow],
    exact_mod_cast nat.prime.ne_zero ‹_› },
  let y : ℤ_[p] := ⟨x * (p : ℚ_[p])^(-x.valuation), this⟩,
  have y_ne_zero : y ≠ 0,
  { contrapose! hx with hy,
    rw subtype.coe_ext at hy,
    rcases eq_zero_or_eq_zero_of_mul_eq_zero hy with h|h,
    { exact h },
    { exfalso, apply nat.prime.ne_zero ‹_›, exact_mod_cast fpow_eq_zero h } },
  rcases padic_int.exists_repr y_ne_zero with ⟨u, n, hy⟩,
  refine ⟨u, (n:ℤ) + x.valuation, _⟩,
  rw [fpow_add, fpow_of_nat],
  { have hnz : (p:ℚ_[p])^(-x.valuation) ≠ 0,
    { assume h, exfalso, apply nat.prime.ne_zero ‹_›, exact_mod_cast fpow_eq_zero h },
    apply group_with_zero.mul_right_cancel hnz,
    rw subtype.coe_ext at hy,
    rw [mul_assoc, mul_assoc, ← fpow_add, add_neg_self, fpow_zero, mul_one],
    { exact_mod_cast hy, },
    { exact_mod_cast nat.prime.ne_zero ‹_› } },
  { exact_mod_cast nat.prime.ne_zero ‹_› }
end

/-- The ring of p-adic integers has characteristic 0.-/
instance padic_int.char_zero : char_zero ℤ_[p] :=
⟨λ m n, by { rw subtype.coe_ext, norm_cast, apply char_zero.cast_injective }⟩


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.with_one
import Mathlib.algebra.group.type_tags
import Mathlib.algebra.group.prod
import Mathlib.algebra.order_functions
import Mathlib.order.bounded_lattice
import Mathlib.PostPort

universes u_1 l u u_2

namespace Mathlib

/-!
# Ordered monoids

This file develops the basics of ordered monoids.

## Implementation details

Unfortunately, the number of `'` appended to lemmas in this file
may differ between the multiplicative and the additive version of a lemma.
The reason is that we did not want to change existing names in the library.

-/

/-- An ordered commutative monoid is a commutative monoid
with a partial order such that
  * `a ≤ b → c * a ≤ c * b` (multiplication is monotone)
  * `a * b < a * c → b < c`.
-/
class ordered_comm_monoid (α : Type u_1) extends partial_order α, comm_monoid α where
  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

/-- An ordered (additive) commutative monoid is a commutative monoid
  with a partial order such that
  * `a ≤ b → c + a ≤ c + b` (addition is monotone)
  * `a + b < a + c → b < c`.
-/
class ordered_add_comm_monoid (α : Type u_1) extends partial_order α, add_comm_monoid α where
  add_le_add_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c + a ≤ c + b
  lt_of_add_lt_add_left : ∀ (a b c : α), a + b < a + c → b < c

/-- A linearly ordered commutative monoid with a zero element. -/
class linear_ordered_comm_monoid_with_zero (α : Type u_1)
    extends ordered_comm_monoid α, comm_monoid_with_zero α, linear_order α where
  zero_le_one : 0 ≤ 1

theorem mul_le_mul_left' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (h : a ≤ b) (c : α) :
    c * a ≤ c * b :=
  ordered_comm_monoid.mul_le_mul_left a b h c

theorem add_le_add_right {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} (h : a ≤ b)
    (c : α) : a + c ≤ b + c :=
  sorry

theorem lt_of_add_lt_add_left {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α} :
    a + b < a + c → b < c :=
  ordered_add_comm_monoid.lt_of_add_lt_add_left a b c

theorem mul_le_mul' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} {d : α}
    (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d :=
  has_le.le.trans (mul_le_mul_right' h₁ c) (mul_le_mul_left' h₂ b)

theorem mul_le_mul_three {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α} {d : α}
    {e : α} {f : α} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : a * b * c ≤ d * e * f :=
  mul_le_mul' (mul_le_mul' h₁ h₂) h₃

theorem le_mul_of_one_le_right' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (h : 1 ≤ b) :
    a ≤ a * b :=
  (fun (this : a * 1 ≤ a * b) => eq.mp (Eq._oldrec (Eq.refl (a * 1 ≤ a * b)) (mul_one a)) this)
    (mul_le_mul_left' h a)

theorem le_mul_of_one_le_left' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (h : 1 ≤ b) :
    a ≤ b * a :=
  (fun (this : 1 * a ≤ b * a) => eq.mp (Eq._oldrec (Eq.refl (1 * a ≤ b * a)) (one_mul a)) this)
    (mul_le_mul_right' h a)

theorem lt_of_mul_lt_mul_right' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (h : a * b < c * b) : a < c :=
  sorry

-- here we start using properties of one.

theorem le_add_of_nonneg_of_le {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : 0 ≤ a) (hbc : b ≤ c) : b ≤ a + c :=
  zero_add b ▸ add_le_add ha hbc

theorem le_add_of_le_of_nonneg {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b ≤ c) (ha : 0 ≤ a) : b ≤ c + a :=
  add_zero b ▸ add_le_add hbc ha

theorem add_nonneg {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} (ha : 0 ≤ a)
    (hb : 0 ≤ b) : 0 ≤ a + b :=
  le_add_of_nonneg_of_le ha hb

theorem one_lt_mul_of_lt_of_le' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : 1 < a)
    (hb : 1 ≤ b) : 1 < a * b :=
  lt_of_lt_of_le ha (le_mul_of_one_le_right' hb)

theorem add_pos_of_nonneg_of_pos {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α}
    (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b :=
  lt_of_lt_of_le hb (le_add_of_nonneg_left ha)

theorem one_lt_mul' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : 1 < a) (hb : 1 < b) :
    1 < a * b :=
  one_lt_mul_of_lt_of_le' ha (has_lt.lt.le hb)

theorem mul_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : a ≤ 1) (hb : b ≤ 1) :
    a * b ≤ 1 :=
  one_mul 1 ▸ mul_le_mul' ha hb

theorem mul_le_of_le_one_of_le' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c :=
  one_mul c ▸ mul_le_mul' ha hbc

theorem mul_le_of_le_of_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c :=
  mul_one c ▸ mul_le_mul' hbc ha

theorem mul_lt_one_of_lt_one_of_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α}
    (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
  has_le.le.trans_lt (mul_le_of_le_of_le_one' le_rfl hb) ha

theorem mul_lt_one_of_le_one_of_lt_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α}
    (ha : a ≤ 1) (hb : b < 1) : a * b < 1 :=
  has_le.le.trans_lt (mul_le_of_le_one_of_le' ha le_rfl) hb

theorem mul_lt_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : a < 1) (hb : b < 1) :
    a * b < 1 :=
  mul_lt_one_of_le_one_of_lt_one' (has_lt.lt.le ha) hb

theorem lt_add_of_nonneg_of_lt' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : 0 ≤ a) (hbc : b < c) : b < a + c :=
  has_lt.lt.trans_le hbc (le_add_of_nonneg_left ha)

theorem lt_mul_of_lt_of_one_le' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : 1 ≤ a) : b < c * a :=
  has_lt.lt.trans_le hbc (le_mul_of_one_le_right' ha)

theorem lt_add_of_pos_of_lt' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : 0 < a) (hbc : b < c) : b < a + c :=
  lt_add_of_nonneg_of_lt' (has_lt.lt.le ha) hbc

theorem lt_add_of_lt_of_pos' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : 0 < a) : b < c + a :=
  lt_add_of_lt_of_nonneg' hbc (has_lt.lt.le ha)

theorem mul_lt_of_le_one_of_lt' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a ≤ 1) (hbc : b < c) : a * b < c :=
  lt_of_le_of_lt (mul_le_of_le_one_of_le' ha le_rfl) hbc

theorem mul_lt_of_lt_of_le_one' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : a ≤ 1) : b * a < c :=
  lt_of_le_of_lt (mul_le_of_le_of_le_one' le_rfl ha) hbc

theorem mul_lt_of_lt_one_of_lt' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a < 1) (hbc : b < c) : a * b < c :=
  mul_lt_of_le_one_of_lt' (has_lt.lt.le ha) hbc

theorem add_lt_of_lt_of_neg' {α : Type u} [ordered_add_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : a < 0) : b + a < c :=
  add_lt_of_lt_of_nonpos' hbc (has_lt.lt.le ha)

theorem mul_eq_one_iff' {α : Type u} [ordered_comm_monoid α] {a : α} {b : α} (ha : 1 ≤ a)
    (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 :=
  sorry

theorem monotone.mul' {α : Type u} [ordered_comm_monoid α] {β : Type u_1} [preorder β] {f : β → α}
    {g : β → α} (hf : monotone f) (hg : monotone g) : monotone fun (x : β) => f x * g x :=
  fun (x y : β) (h : x ≤ y) => mul_le_mul' (hf h) (hg h)

theorem monotone.mul_const' {α : Type u} [ordered_comm_monoid α] {β : Type u_1} [preorder β]
    {f : β → α} (hf : monotone f) (a : α) : monotone fun (x : β) => f x * a :=
  monotone.mul' hf monotone_const

theorem monotone.const_mul' {α : Type u} [ordered_comm_monoid α] {β : Type u_1} [preorder β]
    {f : β → α} (hf : monotone f) (a : α) : monotone fun (x : β) => a * f x :=
  monotone.mul' monotone_const hf

theorem bit0_pos {α : Type u} [ordered_add_comm_monoid α] {a : α} (h : 0 < a) : 0 < bit0 a :=
  add_pos h h

namespace units

protected instance Mathlib.add_units.preorder {α : Type u} [add_monoid α] [preorder α] :
    preorder (add_units α) :=
  preorder.lift coe

@[simp] theorem Mathlib.add_units.coe_le_coe {α : Type u} [add_monoid α] [preorder α]
    {a : add_units α} {b : add_units α} : ↑a ≤ ↑b ↔ a ≤ b :=
  iff.rfl

-- should `to_additive` do this?

@[simp] theorem Mathlib.add_units.coe_lt_coe {α : Type u} [add_monoid α] [preorder α]
    {a : add_units α} {b : add_units α} : ↑a < ↑b ↔ a < b :=
  iff.rfl

protected instance partial_order {α : Type u} [monoid α] [partial_order α] :
    partial_order (units α) :=
  partial_order.lift coe ext

protected instance linear_order {α : Type u} [monoid α] [linear_order α] : linear_order (units α) :=
  linear_order.lift coe ext

@[simp] theorem Mathlib.add_units.max_coe {α : Type u} [add_monoid α] [linear_order α]
    {a : add_units α} {b : add_units α} : ↑(max a b) = max ↑a ↑b :=
  sorry

@[simp] theorem Mathlib.add_units.min_coe {α : Type u} [add_monoid α] [linear_order α]
    {a : add_units α} {b : add_units α} : ↑(min a b) = min ↑a ↑b :=
  sorry

end units

namespace with_zero

protected instance preorder {α : Type u} [preorder α] : preorder (with_zero α) := with_bot.preorder

protected instance partial_order {α : Type u} [partial_order α] : partial_order (with_zero α) :=
  with_bot.partial_order

protected instance order_bot {α : Type u} [partial_order α] : order_bot (with_zero α) :=
  with_bot.order_bot

theorem zero_le {α : Type u} [partial_order α] (a : with_zero α) : 0 ≤ a := order_bot.bot_le a

theorem zero_lt_coe {α : Type u} [partial_order α] (a : α) : 0 < ↑a := with_bot.bot_lt_coe a

@[simp] theorem coe_lt_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a < ↑b ↔ a < b :=
  with_bot.coe_lt_coe

@[simp] theorem coe_le_coe {α : Type u} [partial_order α] {a : α} {b : α} : ↑a ≤ ↑b ↔ a ≤ b :=
  with_bot.coe_le_coe

protected instance lattice {α : Type u} [lattice α] : lattice (with_zero α) := with_bot.lattice

protected instance linear_order {α : Type u} [linear_order α] : linear_order (with_zero α) :=
  with_bot.linear_order

theorem mul_le_mul_left {α : Type u} [ordered_comm_monoid α] (a : with_zero α) (b : with_zero α) :
    a ≤ b → ∀ (c : with_zero α), c * a ≤ c * b :=
  sorry

theorem lt_of_mul_lt_mul_left {α : Type u} [ordered_comm_monoid α] (a : with_zero α)
    (b : with_zero α) (c : with_zero α) : a * b < a * c → b < c :=
  sorry

protected instance ordered_comm_monoid {α : Type u} [ordered_comm_monoid α] :
    ordered_comm_monoid (with_zero α) :=
  ordered_comm_monoid.mk comm_monoid_with_zero.mul sorry comm_monoid_with_zero.one sorry sorry sorry
    partial_order.le partial_order.lt sorry sorry sorry mul_le_mul_left lt_of_mul_lt_mul_left

/-
Note 1 : the below is not an instance because it requires `zero_le`. It seems
like a rather pathological definition because α already has a zero.

Note 2 : there is no multiplicative analogue because it does not seem necessary.
Mathematicians might be more likely to use the order-dual version, where all
elements are ≤ 1 and then 1 is the top element.
-/

/--
If `0` is the least element in `α`, then `with_zero α` is an `ordered_add_comm_monoid`.
-/
def ordered_add_comm_monoid {α : Type u} [ordered_add_comm_monoid α] (zero_le : ∀ (a : α), 0 ≤ a) :
    ordered_add_comm_monoid (with_zero α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry

end with_zero

namespace with_top

protected instance has_zero {α : Type u} [HasZero α] : HasZero (with_top α) := { zero := ↑0 }

@[simp] theorem coe_one {α : Type u} [HasOne α] : ↑1 = 1 := rfl

@[simp] theorem coe_eq_one {α : Type u} [HasOne α] {a : α} : ↑a = 1 ↔ a = 1 := coe_eq_coe

@[simp] theorem one_eq_coe {α : Type u} [HasOne α] {a : α} : 1 = ↑a ↔ a = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 = ↑a ↔ a = 1)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑a = 1 ↔ a = 1)) (propext coe_eq_one))) (iff.refl (a = 1)))

@[simp] theorem top_ne_one {α : Type u} [HasOne α] : ⊤ ≠ 1 :=
  fun (ᾰ : ⊤ = 1) =>
    eq.dcases_on ᾰ (fun (a : some 1 = none) => option.no_confusion a) (Eq.refl 1) (HEq.refl ᾰ)

@[simp] theorem one_ne_top {α : Type u} [HasOne α] : 1 ≠ ⊤ :=
  fun (ᾰ : 1 = ⊤) =>
    eq.dcases_on ᾰ (fun (a : none = some 1) => option.no_confusion a) (Eq.refl ⊤) (HEq.refl ᾰ)

protected instance has_add {α : Type u} [Add α] : Add (with_top α) :=
  { add :=
      fun (o₁ o₂ : with_top α) =>
        option.bind o₁ fun (a : α) => option.map (fun (b : α) => a + b) o₂ }

protected instance add_semigroup {α : Type u} [add_semigroup α] : add_semigroup (with_top α) :=
  add_semigroup.mk Add.add sorry

theorem coe_add {α : Type u} [Add α] {a : α} {b : α} : ↑(a + b) = ↑a + ↑b := rfl

theorem coe_bit0 {α : Type u} [Add α] {a : α} : ↑(bit0 a) = bit0 ↑a := rfl

theorem coe_bit1 {α : Type u} [Add α] [HasOne α] {a : α} : ↑(bit1 a) = bit1 ↑a := rfl

@[simp] theorem add_top {α : Type u} [Add α] {a : with_top α} : a + ⊤ = ⊤ :=
  option.cases_on a (idRhs (none + ⊤ = none + ⊤) rfl)
    fun (a : α) => idRhs (some a + ⊤ = some a + ⊤) rfl

@[simp] theorem top_add {α : Type u} [Add α] {a : with_top α} : ⊤ + a = ⊤ := rfl

theorem add_eq_top {α : Type u} [Add α] {a : with_top α} {b : with_top α} :
    a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ :=
  sorry

theorem add_lt_top {α : Type u} [Add α] [partial_order α] {a : with_top α} {b : with_top α} :
    a + b < ⊤ ↔ a < ⊤ ∧ b < ⊤ :=
  sorry

theorem add_eq_coe {α : Type u} [Add α] {a : with_top α} {b : with_top α} {c : α} :
    a + b = ↑c ↔ ∃ (a' : α), ∃ (b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = c :=
  sorry

protected instance add_comm_semigroup {α : Type u} [add_comm_semigroup α] :
    add_comm_semigroup (with_top α) :=
  add_comm_semigroup.mk add_comm_semigroup.add sorry sorry

protected instance add_monoid {α : Type u} [add_monoid α] : add_monoid (with_top α) :=
  add_monoid.mk Add.add sorry (some 0) sorry sorry

protected instance add_comm_monoid {α : Type u} [add_comm_monoid α] :
    add_comm_monoid (with_top α) :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance ordered_add_comm_monoid {α : Type u} [ordered_add_comm_monoid α] :
    ordered_add_comm_monoid (with_top α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry

/-- Coercion from `α` to `with_top α` as an `add_monoid_hom`. -/
def coe_add_hom {α : Type u} [add_monoid α] : α →+ with_top α := add_monoid_hom.mk coe sorry sorry

@[simp] theorem coe_coe_add_hom {α : Type u} [add_monoid α] : ⇑coe_add_hom = coe := rfl

@[simp] theorem zero_lt_top {α : Type u} [ordered_add_comm_monoid α] : 0 < ⊤ := coe_lt_top 0

@[simp] theorem zero_lt_coe {α : Type u} [ordered_add_comm_monoid α] (a : α) : 0 < ↑a ↔ 0 < a :=
  coe_lt_coe

end with_top

namespace with_bot

protected instance has_zero {α : Type u} [HasZero α] : HasZero (with_bot α) := with_top.has_zero

protected instance has_one {α : Type u} [HasOne α] : HasOne (with_bot α) := with_top.has_one

protected instance add_semigroup {α : Type u} [add_semigroup α] : add_semigroup (with_bot α) :=
  with_top.add_semigroup

protected instance add_comm_semigroup {α : Type u} [add_comm_semigroup α] :
    add_comm_semigroup (with_bot α) :=
  with_top.add_comm_semigroup

protected instance add_monoid {α : Type u} [add_monoid α] : add_monoid (with_bot α) :=
  with_top.add_monoid

protected instance add_comm_monoid {α : Type u} [add_comm_monoid α] :
    add_comm_monoid (with_bot α) :=
  with_top.add_comm_monoid

protected instance ordered_add_comm_monoid {α : Type u} [ordered_add_comm_monoid α] :
    ordered_add_comm_monoid (with_bot α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_zero {α : Type u} [HasZero α] : ↑0 = 0 := rfl

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_one {α : Type u} [HasOne α] : ↑1 = 1 := rfl

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_eq_zero {α : Type u_1} [add_monoid α] {a : α} : ↑a = 0 ↔ a = 0 := sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_add {α : Type u} [add_semigroup α] (a : α) (b : α) : ↑(a + b) = ↑a + ↑b := sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_bit0 {α : Type u} [add_semigroup α] {a : α} : ↑(bit0 a) = bit0 ↑a := sorry

-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast`

theorem coe_bit1 {α : Type u} [add_semigroup α] [HasOne α] {a : α} : ↑(bit1 a) = bit1 ↑a := sorry

@[simp] theorem bot_add {α : Type u} [ordered_add_comm_monoid α] (a : with_bot α) : ⊥ + a = ⊥ := rfl

@[simp] theorem add_bot {α : Type u} [ordered_add_comm_monoid α] (a : with_bot α) : a + ⊥ = ⊥ :=
  option.cases_on a (Eq.refl (none + ⊥)) fun (a : α) => Eq.refl (some a + ⊥)

end with_bot

/-- A canonically ordered additive monoid is an ordered commutative additive monoid
  in which the ordering coincides with the subtractibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a + c`.
  This is satisfied by the natural numbers, for example, but not
  the integers or other nontrivial `ordered_add_comm_group`s. -/
class canonically_ordered_add_monoid (α : Type u_1) extends ordered_add_comm_monoid α, order_bot α
    where
  le_iff_exists_add : ∀ (a b : α), a ≤ b ↔ ∃ (c : α), b = a + c

/-- A canonically ordered monoid is an ordered commutative monoid
  in which the ordering coincides with the divisibility relation,
  which is to say, `a ≤ b` iff there exists `c` with `b = a * c`.
  Example seem rare; it seems more likely that the `order_dual`
  of a naturally-occurring lattice satisfies this than the lattice
  itself (for example, dual of the lattice of ideals of a PID or
  Dedekind domain satisfy this; collections of all things ≤ 1 seem to
  be more natural that collections of all things ≥ 1).
-/
class canonically_ordered_monoid (α : Type u_1) extends ordered_comm_monoid α, order_bot α where
  le_iff_exists_mul : ∀ (a b : α), a ≤ b ↔ ∃ (c : α), b = a * c

theorem le_iff_exists_mul {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} :
    a ≤ b ↔ ∃ (c : α), b = a * c :=
  canonically_ordered_monoid.le_iff_exists_mul a b

theorem self_le_mul_right {α : Type u} [canonically_ordered_monoid α] (a : α) (b : α) : a ≤ a * b :=
  iff.mpr le_iff_exists_mul (Exists.intro b rfl)

theorem self_le_add_left {α : Type u} [canonically_ordered_add_monoid α] (a : α) (b : α) :
    a ≤ b + a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b + a)) (add_comm b a))) (self_le_add_right a b)

@[simp] theorem one_le {α : Type u} [canonically_ordered_monoid α] (a : α) : 1 ≤ a := sorry

@[simp] theorem bot_eq_one {α : Type u} [canonically_ordered_monoid α] : ⊥ = 1 :=
  le_antisymm bot_le (one_le ⊥)

@[simp] theorem add_eq_zero_iff {α : Type u} [canonically_ordered_add_monoid α] {a : α} {b : α} :
    a + b = 0 ↔ a = 0 ∧ b = 0 :=
  add_eq_zero_iff' (zero_le a) (zero_le b)

@[simp] theorem le_one_iff_eq_one {α : Type u} [canonically_ordered_monoid α] {a : α} :
    a ≤ 1 ↔ a = 1 :=
  { mp := fun (h : a ≤ 1) => le_antisymm h (one_le a), mpr := fun (h : a = 1) => h ▸ le_refl a }

theorem pos_iff_ne_zero {α : Type u} [canonically_ordered_add_monoid α] {a : α} : 0 < a ↔ a ≠ 0 :=
  { mp := ne_of_gt, mpr := fun (hne : a ≠ 0) => lt_of_le_of_ne (zero_le a) (ne.symm hne) }

theorem exists_pos_mul_of_lt {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α}
    (h : a < b) : ∃ (c : α), ∃ (H : c > 1), a * c = b :=
  sorry

theorem le_mul_left {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} {c : α}
    (h : a ≤ c) : a ≤ b * c :=
  sorry

theorem le_mul_right {α : Type u} [canonically_ordered_monoid α] {a : α} {b : α} {c : α}
    (h : a ≤ b) : a ≤ b * c :=
  sorry

-- This instance looks absurd: a monoid already has a zero

/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/
protected instance with_zero.canonically_ordered_add_monoid {α : Type u}
    [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_zero α) :=
  canonically_ordered_add_monoid.mk ordered_add_comm_monoid.add sorry ordered_add_comm_monoid.zero
    sorry sorry sorry ordered_add_comm_monoid.le ordered_add_comm_monoid.lt sorry sorry sorry sorry
    sorry 0 sorry sorry

protected instance with_top.canonically_ordered_add_monoid {α : Type u}
    [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_top α) :=
  canonically_ordered_add_monoid.mk ordered_add_comm_monoid.add sorry ordered_add_comm_monoid.zero
    sorry sorry sorry order_bot.le order_bot.lt sorry sorry sorry sorry sorry order_bot.bot sorry
    sorry

/-- A canonically linear-ordered additive monoid is a canonically ordered additive monoid
    whose ordering is a linear order. -/
class canonically_linear_ordered_add_monoid (α : Type u_1)
    extends canonically_ordered_add_monoid α, linear_order α where

/-- A canonically linear-ordered monoid is a canonically ordered monoid
    whose ordering is a linear order. -/
class canonically_linear_ordered_monoid (α : Type u_1)
    extends canonically_ordered_monoid α, linear_order α where

protected instance canonically_linear_ordered_add_monoid.semilattice_sup_bot {α : Type u}
    [canonically_linear_ordered_add_monoid α] : semilattice_sup_bot α :=
  semilattice_sup_bot.mk order_bot.bot lattice.le lattice.lt sorry sorry sorry sorry lattice.sup
    sorry sorry sorry

/-- An ordered cancellative additive commutative monoid
is an additive commutative monoid with a partial order,
in which addition is cancellative and monotone. -/
class ordered_cancel_add_comm_monoid (α : Type u) extends add_cancel_comm_monoid α, partial_order α
    where
  add_le_add_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c + a ≤ c + b
  le_of_add_le_add_left : ∀ (a b c : α), a + b ≤ a + c → b ≤ c

/-- An ordered cancellative commutative monoid
is a commutative monoid with a partial order,
in which multiplication is cancellative and monotone. -/
class ordered_cancel_comm_monoid (α : Type u) extends partial_order α, cancel_comm_monoid α where
  mul_le_mul_left : ∀ (a b : α), a ≤ b → ∀ (c : α), c * a ≤ c * b
  le_of_mul_le_mul_left : ∀ (a b c : α), a * b ≤ a * c → b ≤ c

theorem le_of_mul_le_mul_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} :
    a * b ≤ a * c → b ≤ c :=
  ordered_cancel_comm_monoid.le_of_mul_le_mul_left

protected instance ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid {α : Type u}
    [ordered_cancel_add_comm_monoid α] : ordered_add_comm_monoid α :=
  ordered_add_comm_monoid.mk ordered_cancel_add_comm_monoid.add
    ordered_cancel_add_comm_monoid.add_assoc ordered_cancel_add_comm_monoid.zero
    ordered_cancel_add_comm_monoid.zero_add ordered_cancel_add_comm_monoid.add_zero
    ordered_cancel_add_comm_monoid.add_comm ordered_cancel_add_comm_monoid.le
    ordered_cancel_add_comm_monoid.lt ordered_cancel_add_comm_monoid.le_refl
    ordered_cancel_add_comm_monoid.le_trans ordered_cancel_add_comm_monoid.le_antisymm
    ordered_cancel_add_comm_monoid.add_le_add_left sorry

theorem mul_lt_mul_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} (h : a < b)
    (c : α) : c * a < c * b :=
  lt_of_le_not_le (mul_le_mul_left' (has_lt.lt.le h) c) (mt le_of_mul_le_mul_left' (not_le_of_gt h))

theorem add_lt_add_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} (h : a < b)
    (c : α) : a + c < b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + c < b + c)) (add_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (c + a < b + c)) (add_comm b c))) (add_lt_add_left h c))

theorem mul_lt_mul''' {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α} {d : α}
    (h₁ : a < b) (h₂ : c < d) : a * c < b * d :=
  lt_trans (mul_lt_mul_right' h₁ c) (mul_lt_mul_left' h₂ b)

theorem mul_lt_mul_of_le_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    {d : α} (h₁ : a ≤ b) (h₂ : c < d) : a * c < b * d :=
  lt_of_le_of_lt (mul_le_mul_right' h₁ c) (mul_lt_mul_left' h₂ b)

theorem mul_lt_mul_of_lt_of_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    {d : α} (h₁ : a < b) (h₂ : c ≤ d) : a * c < b * d :=
  lt_of_lt_of_le (mul_lt_mul_right' h₁ c) (mul_le_mul_left' h₂ b)

theorem lt_add_of_pos_right {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α) {b : α}
    (h : 0 < b) : a < a + b :=
  (fun (this : a + 0 < a + b) => eq.mp (Eq._oldrec (Eq.refl (a + 0 < a + b)) (add_zero a)) this)
    (add_lt_add_left h a)

theorem lt_mul_of_one_lt_left' {α : Type u} [ordered_cancel_comm_monoid α] (a : α) {b : α}
    (h : 1 < b) : a < b * a :=
  (fun (this : 1 * a < b * a) => eq.mp (Eq._oldrec (Eq.refl (1 * a < b * a)) (one_mul a)) this)
    (mul_lt_mul_right' h a)

theorem le_of_add_le_add_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α}
    {c : α} (h : a + b ≤ c + b) : a ≤ c :=
  sorry

theorem mul_lt_one {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} (ha : a < 1)
    (hb : b < 1) : a * b < 1 :=
  one_mul 1 ▸ mul_lt_mul''' ha hb

theorem add_neg_of_neg_of_nonpos {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α}
    (ha : a < 0) (hb : b ≤ 0) : a + b < 0 :=
  zero_add 0 ▸ add_lt_add_of_lt_of_le ha hb

theorem add_neg_of_nonpos_of_neg {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α}
    (ha : a ≤ 0) (hb : b < 0) : a + b < 0 :=
  zero_add 0 ▸ add_lt_add_of_le_of_lt ha hb

theorem lt_add_of_pos_of_le {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : 0 < a) (hbc : b ≤ c) : b < a + c :=
  zero_add b ▸ add_lt_add_of_lt_of_le ha hbc

theorem lt_add_of_le_of_pos {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b ≤ c) (ha : 0 < a) : b < c + a :=
  add_zero b ▸ add_lt_add_of_le_of_lt hbc ha

theorem mul_le_of_le_one_of_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c :=
  one_mul c ▸ mul_le_mul' ha hbc

theorem mul_le_of_le_of_le_one {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c :=
  mul_one c ▸ mul_le_mul' hbc ha

theorem add_lt_of_neg_of_le {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a < 0) (hbc : b ≤ c) : a + b < c :=
  zero_add c ▸ add_lt_add_of_lt_of_le ha hbc

theorem mul_lt_of_le_of_lt_one {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b ≤ c) (ha : a < 1) : b * a < c :=
  mul_one c ▸ mul_lt_mul_of_le_of_lt hbc ha

theorem lt_mul_of_one_le_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : 1 ≤ a) (hbc : b < c) : b < a * c :=
  one_mul b ▸ mul_lt_mul_of_le_of_lt ha hbc

theorem lt_mul_of_lt_of_one_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : 1 ≤ a) : b < c * a :=
  mul_one b ▸ mul_lt_mul_of_lt_of_le hbc ha

theorem lt_add_of_pos_of_lt {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : 0 < a) (hbc : b < c) : b < a + c :=
  zero_add b ▸ add_lt_add ha hbc

theorem lt_mul_of_lt_of_one_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : 1 < a) : b < c * a :=
  mul_one b ▸ mul_lt_mul''' hbc ha

theorem mul_lt_of_le_one_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a ≤ 1) (hbc : b < c) : a * b < c :=
  one_mul c ▸ mul_lt_mul_of_le_of_lt ha hbc

theorem add_lt_of_lt_of_nonpos {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α}
    {c : α} (hbc : b < c) (ha : a ≤ 0) : b + a < c :=
  add_zero c ▸ add_lt_add_of_lt_of_le hbc ha

theorem mul_lt_of_lt_one_of_lt {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α} {c : α}
    (ha : a < 1) (hbc : b < c) : a * b < c :=
  one_mul c ▸ mul_lt_mul''' ha hbc

theorem add_lt_of_lt_of_neg {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α} {c : α}
    (hbc : b < c) (ha : a < 0) : b + a < c :=
  add_zero c ▸ add_lt_add hbc ha

@[simp] theorem add_le_add_iff_left {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α) {b : α}
    {c : α} : a + b ≤ a + c ↔ b ≤ c :=
  { mp := le_of_add_le_add_left, mpr := fun (h : b ≤ c) => add_le_add_left h a }

@[simp] theorem add_le_add_iff_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α} {b : α}
    (c : α) : a + c ≤ b + c ↔ a ≤ b :=
  add_comm c a ▸ add_comm c b ▸ add_le_add_iff_left c

@[simp] theorem mul_lt_mul_iff_left {α : Type u} [ordered_cancel_comm_monoid α] (a : α) {b : α}
    {c : α} : a * b < a * c ↔ b < c :=
  { mp := lt_of_mul_lt_mul_left', mpr := fun (h : b < c) => mul_lt_mul_left' h a }

@[simp] theorem mul_lt_mul_iff_right {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α}
    (c : α) : a * c < b * c ↔ a < b :=
  mul_comm c a ▸ mul_comm c b ▸ mul_lt_mul_iff_left c

@[simp] theorem le_add_iff_nonneg_right {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α)
    {b : α} : a ≤ a + b ↔ 0 ≤ b :=
  (fun (this : a + 0 ≤ a + b ↔ 0 ≤ b) =>
      eq.mp (Eq._oldrec (Eq.refl (a + 0 ≤ a + b ↔ 0 ≤ b)) (add_zero a)) this)
    (add_le_add_iff_left a)

@[simp] theorem le_add_iff_nonneg_left {α : Type u} [ordered_cancel_add_comm_monoid α] (a : α)
    {b : α} : a ≤ b + a ↔ 0 ≤ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b + a ↔ 0 ≤ b)) (add_comm b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ a + b ↔ 0 ≤ b)) (propext (le_add_iff_nonneg_right a))))
      (iff.refl (0 ≤ b)))

@[simp] theorem lt_mul_iff_one_lt_right' {α : Type u} [ordered_cancel_comm_monoid α] (a : α)
    {b : α} : a < a * b ↔ 1 < b :=
  (fun (this : a * 1 < a * b ↔ 1 < b) =>
      eq.mp (Eq._oldrec (Eq.refl (a * 1 < a * b ↔ 1 < b)) (mul_one a)) this)
    (mul_lt_mul_iff_left a)

@[simp] theorem lt_mul_iff_one_lt_left' {α : Type u} [ordered_cancel_comm_monoid α] (a : α)
    {b : α} : a < b * a ↔ 1 < b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a < b * a ↔ 1 < b)) (mul_comm b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a < a * b ↔ 1 < b)) (propext (lt_mul_iff_one_lt_right' a))))
      (iff.refl (1 < b)))

@[simp] theorem mul_le_iff_le_one_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α}
    {b : α} : a * b ≤ b ↔ a ≤ 1 :=
  sorry

@[simp] theorem add_le_iff_nonpos_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α}
    {b : α} : a + b ≤ a ↔ b ≤ 0 :=
  sorry

@[simp] theorem add_lt_iff_neg_right {α : Type u} [ordered_cancel_add_comm_monoid α] {a : α}
    {b : α} : a + b < b ↔ a < 0 :=
  sorry

@[simp] theorem mul_lt_iff_lt_one_left' {α : Type u} [ordered_cancel_comm_monoid α] {a : α}
    {b : α} : a * b < a ↔ b < 1 :=
  sorry

theorem mul_eq_one_iff_eq_one_of_one_le {α : Type u} [ordered_cancel_comm_monoid α] {a : α} {b : α}
    (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 :=
  sorry

theorem monotone.add_strict_mono {α : Type u} [ordered_cancel_add_comm_monoid α] {β : Type u_1}
    [preorder β] {f : β → α} {g : β → α} (hf : monotone f) (hg : strict_mono g) :
    strict_mono fun (x : β) => f x + g x :=
  fun (x y : β) (h : x < y) => add_lt_add_of_le_of_lt (hf (le_of_lt h)) (hg h)

theorem strict_mono.mul_monotone' {α : Type u} [ordered_cancel_comm_monoid α] {β : Type u_1}
    [preorder β] {f : β → α} {g : β → α} (hf : strict_mono f) (hg : monotone g) :
    strict_mono fun (x : β) => f x * g x :=
  fun (x y : β) (h : x < y) => mul_lt_mul_of_lt_of_le (hf h) (hg (le_of_lt h))

theorem strict_mono.add_const {α : Type u} [ordered_cancel_add_comm_monoid α] {β : Type u_1}
    [preorder β] {f : β → α} (hf : strict_mono f) (c : α) : strict_mono fun (x : β) => f x + c :=
  strict_mono.add_monotone hf monotone_const

theorem strict_mono.const_add {α : Type u} [ordered_cancel_add_comm_monoid α] {β : Type u_1}
    [preorder β] {f : β → α} (hf : strict_mono f) (c : α) : strict_mono fun (x : β) => c + f x :=
  monotone.add_strict_mono monotone_const hf

theorem with_top.add_lt_add_iff_left {α : Type u} [ordered_cancel_add_comm_monoid α]
    {a : with_top α} {b : with_top α} {c : with_top α} : a < ⊤ → (a + c < a + b ↔ c < b) :=
  sorry

theorem with_bot.add_lt_add_iff_left {α : Type u} [ordered_cancel_add_comm_monoid α]
    {a : with_bot α} {b : with_bot α} {c : with_bot α} : ⊥ < a → (a + c < a + b ↔ c < b) :=
  sorry

theorem with_top.add_lt_add_iff_right {α : Type u} [ordered_cancel_add_comm_monoid α]
    {a : with_top α} {b : with_top α} {c : with_top α} : a < ⊤ → (c + a < b + a ↔ c < b) :=
  sorry

theorem with_bot.add_lt_add_iff_right {α : Type u} [ordered_cancel_add_comm_monoid α]
    {a : with_bot α} {b : with_bot α} {c : with_bot α} : ⊥ < a → (c + a < b + a ↔ c < b) :=
  sorry

/-! Some lemmas about types that have an ordering and a binary operation, with no
  rules relating them. -/

theorem fn_min_add_fn_max {α : Type u} {β : Type u_1} [linear_order α] [add_comm_semigroup β]
    (f : α → β) (n : α) (m : α) : f (min n m) + f (max n m) = f n + f m :=
  sorry

theorem min_mul_max {α : Type u} [linear_order α] [comm_semigroup α] (n : α) (m : α) :
    min n m * max n m = n * m :=
  fn_min_mul_fn_max id n m

/-- A linearly ordered cancellative additive commutative monoid
is an additive commutative monoid with a decidable linear order
in which addition is cancellative and monotone. -/
class linear_ordered_cancel_add_comm_monoid (α : Type u)
    extends ordered_cancel_add_comm_monoid α, linear_order α where

/-- A linearly ordered cancellative commutative monoid
is a commutative monoid with a linear order
in which multiplication is cancellative and monotone. -/
class linear_ordered_cancel_comm_monoid (α : Type u)
    extends linear_order α, ordered_cancel_comm_monoid α where

theorem min_add_add_left {α : Type u} [linear_ordered_cancel_add_comm_monoid α] (a : α) (b : α)
    (c : α) : min (a + b) (a + c) = a + min b c :=
  Eq.symm (monotone.map_min (monotone.const_add monotone_id a))

theorem min_mul_mul_right {α : Type u} [linear_ordered_cancel_comm_monoid α] (a : α) (b : α)
    (c : α) : min (a * c) (b * c) = min a b * c :=
  Eq.symm (monotone.map_min (monotone.mul_const' monotone_id c))

theorem max_add_add_left {α : Type u} [linear_ordered_cancel_add_comm_monoid α] (a : α) (b : α)
    (c : α) : max (a + b) (a + c) = a + max b c :=
  Eq.symm (monotone.map_max (monotone.const_add monotone_id a))

theorem max_mul_mul_right {α : Type u} [linear_ordered_cancel_comm_monoid α] (a : α) (b : α)
    (c : α) : max (a * c) (b * c) = max a b * c :=
  Eq.symm (monotone.map_max (monotone.mul_const' monotone_id c))

theorem min_le_add_of_nonneg_right {α : Type u} [linear_ordered_cancel_add_comm_monoid α] {a : α}
    {b : α} (hb : 0 ≤ b) : min a b ≤ a + b :=
  iff.mpr min_le_iff (Or.inl (le_add_of_nonneg_right hb))

theorem min_le_add_of_nonneg_left {α : Type u} [linear_ordered_cancel_add_comm_monoid α] {a : α}
    {b : α} (ha : 0 ≤ a) : min a b ≤ a + b :=
  iff.mpr min_le_iff (Or.inr (le_add_of_nonneg_left ha))

theorem max_le_mul_of_one_le {α : Type u} [linear_ordered_cancel_comm_monoid α] {a : α} {b : α}
    (ha : 1 ≤ a) (hb : 1 ≤ b) : max a b ≤ a * b :=
  iff.mpr max_le_iff { left := le_mul_of_one_le_right' hb, right := le_mul_of_one_le_left' ha }

namespace order_dual

protected instance ordered_comm_monoid {α : Type u} [ordered_comm_monoid α] :
    ordered_comm_monoid (order_dual α) :=
  ordered_comm_monoid.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry sorry sorry

protected instance ordered_cancel_add_comm_monoid {α : Type u} [ordered_cancel_add_comm_monoid α] :
    ordered_cancel_add_comm_monoid (order_dual α) :=
  ordered_cancel_add_comm_monoid.mk ordered_add_comm_monoid.add sorry sorry
    ordered_add_comm_monoid.zero sorry sorry sorry sorry ordered_add_comm_monoid.le
    ordered_add_comm_monoid.lt sorry sorry sorry sorry sorry

protected instance linear_ordered_cancel_add_comm_monoid {α : Type u}
    [linear_ordered_cancel_add_comm_monoid α] :
    linear_ordered_cancel_add_comm_monoid (order_dual α) :=
  linear_ordered_cancel_add_comm_monoid.mk ordered_cancel_add_comm_monoid.add sorry sorry
    ordered_cancel_add_comm_monoid.zero sorry sorry sorry sorry linear_order.le linear_order.lt
    sorry sorry sorry sorry sorry sorry linear_order.decidable_le linear_order.decidable_eq
    linear_order.decidable_lt

end order_dual

namespace prod

protected instance ordered_cancel_comm_monoid {M : Type u_1} {N : Type u_2}
    [ordered_cancel_comm_monoid M] [ordered_cancel_comm_monoid N] :
    ordered_cancel_comm_monoid (M × N) :=
  ordered_cancel_comm_monoid.mk comm_monoid.mul sorry sorry comm_monoid.one sorry sorry sorry sorry
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry

end prod

protected instance multiplicative.preorder {α : Type u} [preorder α] :
    preorder (multiplicative α) :=
  id

protected instance additive.preorder {α : Type u} [preorder α] : preorder (additive α) := id

protected instance multiplicative.partial_order {α : Type u} [partial_order α] :
    partial_order (multiplicative α) :=
  id

protected instance additive.partial_order {α : Type u} [partial_order α] :
    partial_order (additive α) :=
  id

protected instance multiplicative.linear_order {α : Type u} [linear_order α] :
    linear_order (multiplicative α) :=
  id

protected instance additive.linear_order {α : Type u} [linear_order α] :
    linear_order (additive α) :=
  id

protected instance multiplicative.ordered_comm_monoid {α : Type u} [ordered_add_comm_monoid α] :
    ordered_comm_monoid (multiplicative α) :=
  ordered_comm_monoid.mk comm_monoid.mul sorry comm_monoid.one sorry sorry sorry partial_order.le
    partial_order.lt sorry sorry sorry ordered_add_comm_monoid.add_le_add_left
    ordered_add_comm_monoid.lt_of_add_lt_add_left

protected instance additive.ordered_add_comm_monoid {α : Type u} [ordered_comm_monoid α] :
    ordered_add_comm_monoid (additive α) :=
  ordered_add_comm_monoid.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry
    partial_order.le partial_order.lt sorry sorry sorry ordered_comm_monoid.mul_le_mul_left
    ordered_comm_monoid.lt_of_mul_lt_mul_left

protected instance multiplicative.ordered_cancel_comm_monoid {α : Type u}
    [ordered_cancel_add_comm_monoid α] : ordered_cancel_comm_monoid (multiplicative α) :=
  ordered_cancel_comm_monoid.mk right_cancel_semigroup.mul sorry sorry ordered_comm_monoid.one sorry
    sorry sorry sorry ordered_comm_monoid.le ordered_comm_monoid.lt sorry sorry sorry sorry
    ordered_cancel_add_comm_monoid.le_of_add_le_add_left

protected instance additive.ordered_cancel_add_comm_monoid {α : Type u}
    [ordered_cancel_comm_monoid α] : ordered_cancel_add_comm_monoid (additive α) :=
  ordered_cancel_add_comm_monoid.mk add_right_cancel_semigroup.add sorry sorry
    ordered_add_comm_monoid.zero sorry sorry sorry sorry ordered_add_comm_monoid.le
    ordered_add_comm_monoid.lt sorry sorry sorry sorry
    ordered_cancel_comm_monoid.le_of_mul_le_mul_left

end Mathlib


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson

! This file was ported from Lean 3 source module ring_theory.polynomial.gauss_lemma
! leanprover-community/mathlib commit cbdf7b565832144d024caa5a550117c6df0204a5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Int.Basic
import Mathbin.FieldTheory.SplittingField
import Mathbin.RingTheory.Localization.Integral
import Mathbin.RingTheory.IntegrallyClosed

/-!
# Gauss's Lemma

Gauss's Lemma is one of a few results pertaining to irreducibility of primitive polynomials.

## Main Results
 - `polynomial.monic.irreducible_iff_irreducible_map_fraction_map`:
  A monic polynomial over an integrally closed domain is irreducible iff it is irreducible in a
    fraction field
 - `is_integrally_closed_iff'`:
   Integrally closed domains are precisely the domains for in which Gauss's lemma holds
    for monic polynomials
 - `polynomial.is_primitive.irreducible_iff_irreducible_map_fraction_map`:
  A primitive polynomial over a GCD domain is irreducible iff it is irreducible in a fraction field
 - `polynomial.is_primitive.int.irreducible_iff_irreducible_map_cast`:
  A primitive polynomial over `ℤ` is irreducible iff it is irreducible over `ℚ`.
 - `polynomial.is_primitive.dvd_iff_fraction_map_dvd_fraction_map`:
  Two primitive polynomials over a GCD domain divide each other iff they do in a fraction field.
 - `polynomial.is_primitive.int.dvd_iff_map_cast_dvd_map_cast`:
  Two primitive polynomials over `ℤ` divide each other if they do in `ℚ`.

-/

open nonZeroDivisors Polynomial

variable {R : Type _} [CommRing R]

namespace Polynomial

section

variable {S : Type _} [CommRing S] [IsDomain S]

variable {φ : R →+* S} (hinj : Function.Injective φ) {f : R[X]} (hf : f.IsPrimitive)

include hinj hf

theorem IsPrimitive.isUnit_iff_isUnit_map_of_injective : IsUnit f ↔ IsUnit (map φ f) :=
  by
  refine' ⟨(map_ring_hom φ).isUnit_map, fun h => _⟩
  rcases is_unit_iff.1 h with ⟨_, ⟨u, rfl⟩, hu⟩
  have hdeg := degree_C u.ne_zero
  rw [hu, degree_map_eq_of_injective hinj] at hdeg
  rw [eq_C_of_degree_eq_zero hdeg] at hf⊢
  exact is_unit_C.mpr (is_primitive_iff_is_unit_of_C_dvd.mp hf (f.coeff 0) dvd_rfl)
#align polynomial.is_primitive.is_unit_iff_is_unit_map_of_injective Polynomial.IsPrimitive.isUnit_iff_isUnit_map_of_injective

theorem IsPrimitive.irreducible_of_irreducible_map_of_injective (h_irr : Irreducible (map φ f)) :
    Irreducible f :=
  by
  refine'
    ⟨fun h => h_irr.not_unit (IsUnit.map (map_ring_hom φ) h), fun a b h =>
      (h_irr.is_unit_or_is_unit <| by rw [h, Polynomial.map_mul]).imp _ _⟩
  all_goals apply ((is_primitive_of_dvd hf _).isUnit_iff_isUnit_map_of_injective hinj).mpr
  exacts[Dvd.intro _ h.symm, Dvd.intro_left _ h.symm]
#align polynomial.is_primitive.irreducible_of_irreducible_map_of_injective Polynomial.IsPrimitive.irreducible_of_irreducible_map_of_injective

end

section FractionMap

variable {K : Type _} [Field K] [Algebra R K] [IsFractionRing R K]

theorem IsPrimitive.isUnit_iff_isUnit_map {p : R[X]} (hp : p.IsPrimitive) :
    IsUnit p ↔ IsUnit (p.map (algebraMap R K)) :=
  hp.isUnit_iff_isUnit_map_of_injective (IsFractionRing.injective _ _)
#align polynomial.is_primitive.is_unit_iff_is_unit_map Polynomial.IsPrimitive.isUnit_iff_isUnit_map

variable [IsDomain R]

section IsIntegrallyClosed

open IsIntegrallyClosed

/-- **Gauss's Lemma** for integrally closed domains states that a monic polynomial is irreducible
  iff it is irreducible in the fraction field. -/
theorem Monic.irreducible_iff_irreducible_map_fraction_map [IsIntegrallyClosed R] {p : R[X]}
    (h : p.Monic) : Irreducible p ↔ Irreducible (p.map <| algebraMap R K) :=
  by
  /- The ← direction follows from `is_primitive.irreducible_of_irreducible_map_of_injective`.
       For the → direction, it is enought to show that if `(p.map $ algebra_map R K) = a * b` and
       `a` is not a unit then `b` is a unit -/
  refine'
    ⟨fun hp =>
      irreducible_iff.mpr
        ⟨hp.not_unit.imp h.is_primitive.is_unit_iff_is_unit_map.mpr, fun a b H =>
          or_iff_not_imp_left.mpr fun hₐ => _⟩,
      fun hp =>
      h.is_primitive.irreducible_of_irreducible_map_of_injective (IsFractionRing.injective R K) hp⟩
  obtain ⟨a', ha⟩ := eq_map_mul_C_of_dvd K h (dvd_of_mul_right_eq b H.symm)
  obtain ⟨b', hb⟩ := eq_map_mul_C_of_dvd K h (dvd_of_mul_left_eq a H.symm)
  have : a.leading_coeff * b.leading_coeff = 1 := by
    rw [← leading_coeff_mul, ← H, monic.leading_coeff (h.map <| algebraMap R K)]
  rw [← ha, ← hb, mul_comm _ (C b.leading_coeff), mul_assoc, ← mul_assoc (C a.leading_coeff), ←
    C_mul, this, C_1, one_mul, ← Polynomial.map_mul] at H
  rw [← hb, ← Polynomial.coe_mapRingHom]
  refine'
    IsUnit.mul (IsUnit.map _ (Or.resolve_left (hp.is_unit_or_is_unit _) (show ¬IsUnit a' from _)))
      (is_unit_iff_exists_inv'.mpr
        (Exists.intro (C a.leading_coeff) <| by rwa [← C_mul, this, C_1]))
  · exact Polynomial.map_injective _ (IsFractionRing.injective R K) H
  · by_contra h_contra
    refine' hₐ _
    rw [← ha, ← Polynomial.coe_mapRingHom]
    exact
      IsUnit.mul (IsUnit.map _ h_contra)
        (is_unit_iff_exists_inv.mpr
          (Exists.intro (C b.leading_coeff) <| by rwa [← C_mul, this, C_1]))
#align polynomial.monic.irreducible_iff_irreducible_map_fraction_map Polynomial.Monic.irreducible_iff_irreducible_map_fraction_map

/-- Integrally closed domains are precisely the domains for in which Gauss's lemma holds
    for monic polynomials -/
theorem isIntegrallyClosed_iff' :
    IsIntegrallyClosed R ↔
      ∀ p : R[X], p.Monic → (Irreducible p ↔ Irreducible (p.map <| algebraMap R K)) :=
  by
  constructor
  · intro hR p hp
    letI := hR
    exact monic.irreducible_iff_irreducible_map_fraction_map hp
  · intro H
    refine'
      (isIntegrallyClosed_iff K).mpr fun x hx =>
        ring_hom.mem_range.mp <| minpoly.mem_range_of_degree_eq_one R x _
    rw [← monic.degree_map (minpoly.monic hx) (algebraMap R K)]
    apply
      degree_eq_one_of_irreducible_of_root ((H _ <| minpoly.monic hx).mp (minpoly.irreducible hx))
    rw [is_root, eval_map, ← aeval_def, minpoly.aeval R x]
#align polynomial.is_integrally_closed_iff' Polynomial.isIntegrallyClosed_iff'

theorem Monic.dvd_of_fraction_map_dvd_fraction_map [IsIntegrallyClosed R] {p q : R[X]}
    (hp : p.Monic) (hq : q.Monic) (h : q.map (algebraMap R K) ∣ p.map (algebraMap R K)) : q ∣ p :=
  by
  obtain ⟨r, hr⟩ := h
  obtain ⟨d', hr'⟩ := IsIntegrallyClosed.eq_map_mul_c_of_dvd K hp (dvd_of_mul_left_eq _ hr.symm)
  rw [monic.leading_coeff, C_1, mul_one] at hr'
  rw [← hr', ← Polynomial.map_mul] at hr
  exact dvd_of_mul_right_eq _ (Polynomial.map_injective _ (IsFractionRing.injective R K) hr.symm)
  · exact monic.of_mul_monic_left (hq.map (algebraMap R K)) (by simpa [← hr] using hp.map _)
#align polynomial.monic.dvd_of_fraction_map_dvd_fraction_map Polynomial.Monic.dvd_of_fraction_map_dvd_fraction_map

theorem Monic.dvd_iff_fraction_map_dvd_fraction_map [IsIntegrallyClosed R] {p q : R[X]}
    (hp : p.Monic) (hq : q.Monic) : q.map (algebraMap R K) ∣ p.map (algebraMap R K) ↔ q ∣ p :=
  ⟨fun h => hp.dvd_of_fraction_map_dvd_fraction_map hq h, fun ⟨a, b⟩ =>
    ⟨a.map (algebraMap R K), b.symm ▸ Polynomial.map_mul (algebraMap R K)⟩⟩
#align polynomial.monic.dvd_iff_fraction_map_dvd_fraction_map Polynomial.Monic.dvd_iff_fraction_map_dvd_fraction_map

end IsIntegrallyClosed

open IsLocalization

section NormalizedGCDMonoid

variable [NormalizedGCDMonoid R]

theorem isUnit_or_eq_zero_of_isUnit_integerNormalization_primPart {p : K[X]} (h0 : p ≠ 0)
    (h : IsUnit (integerNormalization R⁰ p).primPart) : IsUnit p :=
  by
  rcases is_unit_iff.1 h with ⟨_, ⟨u, rfl⟩, hu⟩
  obtain ⟨⟨c, c0⟩, hc⟩ := integer_normalization_map_to_map R⁰ p
  rw [Subtype.coe_mk, Algebra.smul_def, algebra_map_apply] at hc
  apply isUnit_of_mul_isUnit_right
  rw [← hc, (integer_normalization R⁰ p).eq_C_content_mul_primPart, ← hu, ← RingHom.map_mul,
    is_unit_iff]
  refine'
    ⟨algebraMap R K ((integer_normalization R⁰ p).content * ↑u), isUnit_iff_ne_zero.2 fun con => _,
      by simp⟩
  replace con := (injective_iff_map_eq_zero (algebraMap R K)).1 (IsFractionRing.injective _ _) _ Con
  rw [mul_eq_zero, content_eq_zero_iff, IsFractionRing.integerNormalization_eq_zero_iff] at con
  rcases Con with (con | con)
  · apply h0 Con
  · apply Units.ne_zero _ Con
#align polynomial.is_unit_or_eq_zero_of_is_unit_integer_normalization_prim_part Polynomial.isUnit_or_eq_zero_of_isUnit_integerNormalization_primPart

/-- **Gauss's Lemma** for GCD domains states that a primitive polynomial is irreducible iff it is
  irreducible in the fraction field. -/
theorem IsPrimitive.irreducible_iff_irreducible_map_fraction_map {p : R[X]} (hp : p.IsPrimitive) :
    Irreducible p ↔ Irreducible (p.map (algebraMap R K)) :=
  by
  refine'
    ⟨fun hi => ⟨fun h => hi.not_unit (hp.is_unit_iff_is_unit_map.2 h), fun a b hab => _⟩,
      hp.irreducible_of_irreducible_map_of_injective (IsFractionRing.injective _ _)⟩
  obtain ⟨⟨c, c0⟩, hc⟩ := integer_normalization_map_to_map R⁰ a
  obtain ⟨⟨d, d0⟩, hd⟩ := integer_normalization_map_to_map R⁰ b
  rw [Algebra.smul_def, algebra_map_apply, Subtype.coe_mk] at hc hd
  rw [mem_nonZeroDivisors_iff_ne_zero] at c0 d0
  have hcd0 : c * d ≠ 0 := mul_ne_zero c0 d0
  rw [Ne.def, ← C_eq_zero] at hcd0
  have h1 : C c * C d * p = integer_normalization R⁰ a * integer_normalization R⁰ b :=
    by
    apply map_injective (algebraMap R K) (IsFractionRing.injective _ _) _
    rw [Polynomial.map_mul, Polynomial.map_mul, Polynomial.map_mul, hc, hd, map_C, map_C, hab]
    ring
  obtain ⟨u, hu⟩ :
    Associated (c * d)
      (content (integer_normalization R⁰ a) * content (integer_normalization R⁰ b)) :=
    by
    rw [← dvd_dvd_iff_associated, ← normalize_eq_normalize_iff, normalize.map_mul,
      normalize.map_mul, normalize_content, normalize_content, ←
      mul_one (normalize c * normalize d), ← hp.content_eq_one, ← content_C, ← content_C, ←
      content_mul, ← content_mul, ← content_mul, h1]
  rw [← RingHom.map_mul, eq_comm, (integer_normalization R⁰ a).eq_C_content_mul_primPart,
    (integer_normalization R⁰ b).eq_C_content_mul_primPart, mul_assoc, mul_comm _ (C _ * _), ←
    mul_assoc, ← mul_assoc, ← RingHom.map_mul, ← hu, RingHom.map_mul, mul_assoc, mul_assoc, ←
    mul_assoc (C ↑u)] at h1
  have h0 : a ≠ 0 ∧ b ≠ 0 := by
    classical
      rw [Ne.def, Ne.def, ← Decidable.not_or_iff_and_not, ← mul_eq_zero, ← hab]
      intro con
      apply hp.ne_zero (map_injective (algebraMap R K) (IsFractionRing.injective _ _) _)
      simp [Con]
  rcases hi.is_unit_or_is_unit (mul_left_cancel₀ hcd0 h1).symm with (h | h)
  · right
    apply
      is_unit_or_eq_zero_of_is_unit_integer_normalization_prim_part h0.2
        (isUnit_of_mul_isUnit_right h)
  · left
    apply is_unit_or_eq_zero_of_is_unit_integer_normalization_prim_part h0.1 h
#align polynomial.is_primitive.irreducible_iff_irreducible_map_fraction_map Polynomial.IsPrimitive.irreducible_iff_irreducible_map_fraction_map

theorem IsPrimitive.dvd_of_fraction_map_dvd_fraction_map {p q : R[X]} (hp : p.IsPrimitive)
    (hq : q.IsPrimitive) (h_dvd : p.map (algebraMap R K) ∣ q.map (algebraMap R K)) : p ∣ q :=
  by
  rcases h_dvd with ⟨r, hr⟩
  obtain ⟨⟨s, s0⟩, hs⟩ := integer_normalization_map_to_map R⁰ r
  rw [Subtype.coe_mk, Algebra.smul_def, algebra_map_apply] at hs
  have h : p ∣ q * C s := by
    use integer_normalization R⁰ r
    apply map_injective (algebraMap R K) (IsFractionRing.injective _ _)
    rw [Polynomial.map_mul, Polynomial.map_mul, hs, hr, mul_assoc, mul_comm r]
    simp
  rw [← hp.dvd_prim_part_iff_dvd, prim_part_mul, hq.prim_part_eq, Associated.dvd_iff_dvd_right] at h
  · exact h
  · symm
    rcases is_unit_prim_part_C s with ⟨u, hu⟩
    use u
    rw [hu]
  iterate 2
    apply mul_ne_zero hq.ne_zero
    rw [Ne.def, C_eq_zero]
    contrapose! s0
    simp [s0, mem_nonZeroDivisors_iff_ne_zero]
#align polynomial.is_primitive.dvd_of_fraction_map_dvd_fraction_map Polynomial.IsPrimitive.dvd_of_fraction_map_dvd_fraction_map

variable (K)

theorem IsPrimitive.dvd_iff_fraction_map_dvd_fraction_map {p q : R[X]} (hp : p.IsPrimitive)
    (hq : q.IsPrimitive) : p ∣ q ↔ p.map (algebraMap R K) ∣ q.map (algebraMap R K) :=
  ⟨fun ⟨a, b⟩ => ⟨a.map (algebraMap R K), b.symm ▸ Polynomial.map_mul (algebraMap R K)⟩, fun h =>
    hp.dvd_of_fraction_map_dvd_fraction_map hq h⟩
#align polynomial.is_primitive.dvd_iff_fraction_map_dvd_fraction_map Polynomial.IsPrimitive.dvd_iff_fraction_map_dvd_fraction_map

end NormalizedGCDMonoid

end FractionMap

/-- **Gauss's Lemma** for `ℤ` states that a primitive integer polynomial is irreducible iff it is
  irreducible over `ℚ`. -/
theorem IsPrimitive.Int.irreducible_iff_irreducible_map_cast {p : ℤ[X]} (hp : p.IsPrimitive) :
    Irreducible p ↔ Irreducible (p.map (Int.castRingHom ℚ)) :=
  hp.irreducible_iff_irreducible_map_fraction_map
#align polynomial.is_primitive.int.irreducible_iff_irreducible_map_cast Polynomial.IsPrimitive.Int.irreducible_iff_irreducible_map_cast

theorem IsPrimitive.Int.dvd_iff_map_cast_dvd_map_cast (p q : ℤ[X]) (hp : p.IsPrimitive)
    (hq : q.IsPrimitive) : p ∣ q ↔ p.map (Int.castRingHom ℚ) ∣ q.map (Int.castRingHom ℚ) :=
  hp.dvd_iff_fraction_map_dvd_fraction_map ℚ hq
#align polynomial.is_primitive.int.dvd_iff_map_cast_dvd_map_cast Polynomial.IsPrimitive.Int.dvd_iff_map_cast_dvd_map_cast

end Polynomial


import data.set.basic

open set

def equivalence_class {X : Type} (R : X → X → Prop) (x : X) := {y : X | R x y}

example (X : Type) (R : X → X → Prop) (hR : equivalence R) (x : X) : equivalence_class R x ≠ ∅ :=
begin
  rw ne_empty_iff_nonempty,
  use x,
  cases hR with hR H,
  exact hR x,
end


import .group_representation
import .morphism
universe variables u v w
variables {G : Type u} {R : Type v} {M : Type w} [group G] [ring R] [add_comm_group M] [module R M]

namespace stability

variables {p : submodule R M}
/--
  Technical lemma to deal with `submodule p` of `M`.
-/

lemma submodule_ext (x y : p) : (x : M) = (y : M)  → x = y := begin
          intros,rcases x,rcases y,congr; try {assumption},
end

lemma coersion₂ ( f g : M ≃ₗ[R] M) : ⇑ f ∘ ⇑ g = ⇑ (f * g) := rfl

/--
  Let `ρ : G →* M ≃ₗ[R] M` a representation. A submodule `p` of `M` is `ρ-stable` when :
      `∀ g ∈ G, ∀ x ∈ p, ρ g x ∈ p`. It induce a `sub-representation`  : ` Res ρ  p : G →* p ≃ₗ[R] p `
-/
def stable_submodule (ρ : group_representation G R M)(p : submodule R M) :=
                     ∀ g : G, ∀  x : p,  ρ g x ∈ p    --- better with x : M, x ∈ p → ρ g x ∈ p  ?
variables {ρ : group_representation G R M}

/--
  Restriction map : `res ρ : G → (p → p)`.
-/
def res  (stab : stable_submodule ρ p):  G → p → p  := λ g x, ⟨( ρ   g ) x, stab g x⟩

variables (stab : stable_submodule ρ p)(g : G)

lemma coersion (x : p) :   ((res stab g x) : M) = (ρ g : M ≃ₗ[R] M) (x : M) := rfl

lemma res_add (g : G) (x y : p) : res stab g (x+y) = res stab g x + res stab g y := begin
    apply submodule_ext, change ρ _ _ = _,
    erw (ρ g).map_add,
    exact rfl,
end

lemma res_smul (g : G) (r : R) ( x : p) : res stab g ( r • x) = r • res stab g x := begin
    apply submodule_ext, change ρ _ _ = _, erw (ρ g).map_smul, exact rfl,
end
/--
   `res` is linear map.
-/
def res_linear (stab : stable_submodule ρ p) (g : G) : p →ₗ[R]p := { to_fun := res stab g,
  add := res_add  stab g,
  smul := res_smul stab g }
/--
  ` ∀ g :G, res ρ g` has an inverse given by ` res ρ g⁻¹`.
-/

lemma res_mul (stab : stable_submodule ρ p ) (g1 g2 : G) : res stab (g1 * g2) = res stab g1 ∘ res stab g2 :=
 begin

      ext, apply submodule_ext,  rw [ coersion, ρ.map_mul], exact rfl,

end
lemma res_one (stab : stable_submodule ρ p) : res stab 1 = id :=
begin

  ext,apply submodule_ext,rw [coersion,ρ.map_one], exact rfl,

end
/--
  `res` is an `set` equivalence
-/
def  res_equiv (h : stable_submodule ρ p) (g : G) :  (p ≃ p) :=
{ to_fun := (res  h g),
  inv_fun := (res  h g⁻¹),
  left_inv := begin
              intros x, apply submodule_ext,
              change (ρ _   *  _) x = _, rw ← ρ.map_mul,
                rw [inv_mul_self,
                    ρ.map_one ],  exact rfl,
               end
  , right_inv := begin
               intros x,
               apply submodule_ext,
               change (ρ g * _) x = _,
               rw ←  ρ.map_mul,
               rw mul_inv_self, rw ρ.map_one, exact rfl,
  end }
/--
    We make `G → p ≃ₗ[R]p`
-/
def res_equiv_linear (stab : stable_submodule ρ p) (g : G) : p ≃ₗ[R]p := {
    .. res_linear stab g,
    ..  res_equiv stab g}

lemma res_equiv_coersion (stab : stable_submodule ρ p) (g : G)(x : p) :
          (res_equiv_linear stab g) x = res stab g x:= rfl

/--
   the restriction representation `G →* p ≃ₗ[R]p`
-/
def Res (stab : stable_submodule ρ p) : group_representation G R p := {
   to_fun := res_equiv_linear stab,
  map_one' := begin
                ext,apply submodule_ext, change (ρ 1) x = _,  rw ρ.map_one,
                exact rfl,
                end,

  map_mul' := begin intros g1 g2,
                    ext, apply submodule_ext,
                    change  (ρ (g1 *  g2))  x = _ ,  rw  ρ.map_mul,
                    exact rfl,
              end}
/-
  i have to study more the notion
-/
theorem Res.apply (g : G) (x : p) : (Res stab g x : M) = ρ g x := rfl
/--
   make a morphism : `Res stab → ρ`
-/

def res.subtype (stab : stable_submodule ρ p) : Res stab ⟶ ρ  := {
    ℓ := submodule.subtype p,
    commute := by {intros g, exact rfl}
}
end stability


import data.list.basic

section left_pad

variables {α : Type*}

open nat

lemma list.cons_repeat (c : α) :
  Π  (n : ℕ), c :: list.repeat c n = list.repeat c n ++ [c] :=
by { intro, symmetry, induction n ; simp *, }

lemma list.take_append (xs ys : list α) (n : ℕ)
  (h : xs.length = n) :
  (xs ++ ys).take n = xs :=
by { subst n, induction xs ; simp! [add_one,*], }

lemma list.drop_append (xs ys : list α) (n : ℕ)
  (h : xs.length = n) :
  (xs ++ ys).drop n = ys :=
by { subst n, induction xs ; simp! [add_one,*], }

def left_pad_aux (c : α) : ℕ → list α → list α
 | 0 xs := xs
 | (succ n) xs := left_pad_aux n (c :: xs)

def left_pad (c : α) (n : ℕ) (x : list α) : list α :=
left_pad_aux c (n - x.length) x

variables (c : α) (n : ℕ) (x : list α)

lemma left_pad_def
: left_pad c n x = list.repeat c (n - x.length) ++ x :=
begin
  simp [left_pad],
  generalize : (n - list.length x) = k,
  induction k generalizing x
  ; simp! [add_one,add_succ,succ_add,list.cons_repeat,*],
end

lemma length_left_pad
: (left_pad c n x).length = max n x.length :=
begin
  simp [left_pad_def],
  cases le_total n x.length with Hk Hk,
  { rw max_eq_right Hk,
    rw ← nat.sub_eq_zero_iff_le at Hk,
    simp *, },
  { simp [max_eq_left Hk],
    rw [← nat.add_sub_assoc Hk,nat.add_sub_cancel_left] },
end

lemma left_pad_prefix
: ∀ c' ∈ (left_pad c n x).take (n - x.length), c' = c :=
by { rw [left_pad_def,list.take_append] ,
     { intro, apply list.eq_of_mem_repeat },
     simp! , }

lemma left_pad_suffix
: (left_pad c n x).drop (n - x.length) = x :=
by simp [left_pad_def,list.drop_append]

end left_pad

section unique

variables {α : Type*} [decidable_eq α]

def unique : list α → list α
 | [] := []
 | (x :: xs) :=
   if x ∈ xs
     then unique xs
     else x :: unique xs

lemma mem_unique (x : α) (xs : list α) :
  x ∈ unique xs ↔ x ∈ xs :=
begin
  induction xs with x' xs ; simp!,
  by_cases x' ∈ xs ; simp *,
  split ; intro h,
  { simp * },
  { cases h ; cc, },
end

lemma nodup_unique (xs : list α) :
  (unique xs).nodup :=
begin
  induction xs with x xs ; simp!,
  by_cases x ∈ xs ; simp [*,mem_unique],
end

end unique

-- These are pretty general lemmas about lists.
-- We could find them in the standard library
namespace list

universes u v w

variables {α : Type u} {β : Type v} {γ : Type w}
variables (f : α → β → γ)
variables {x : α} {y : β} {xs : list α} {ys : list β}

open function

@[simp]
lemma map_eq_nil {f : α → γ} :
  map f xs = nil ↔ xs = nil :=
by cases xs ; simp

@[simp]
lemma zip_eq_nil :
  zip xs ys = nil ↔ xs = nil ∨ ys = nil :=
by cases xs ; cases ys ; simp

lemma map₂_eq_map_zip :
  map₂ f xs ys = map (uncurry f) (zip xs ys) :=
begin
  induction xs generalizing ys,
  { cases ys ; simp, },
  { cases ys ; simp [*,uncurry], }
end

lemma mem_map₂
  (h : (x,y) ∈ zip xs ys) :
  f x y ∈ map₂ f xs ys :=
by { rw map₂_eq_map_zip,
     refine @mem_map_of_mem _ _ (uncurry f) (x,y) _ h, }

@[simp]
lemma cons_tail_tails :
  xs :: tail (tails xs) = tails xs :=
by cases xs ; simp

lemma tails_append {xs' : list α} :
  tails (xs ++ xs') = map (++ xs') (tails xs) ++ (tails xs').tail :=
by induction xs ; simp *

lemma tails_reverse :
  tails (reverse xs) = reverse (map reverse (inits xs)) :=
by induction xs with x xs; simp [tails_append,*,comp]

lemma inits_reverse :
  inits (reverse xs) = reverse (map reverse (tails xs)) :=
by { rw ← reverse_reverse xs,
     generalize : reverse xs = ys,
     simp [tails_reverse,comp],
     symmetry, apply map_id }

@[simp]
lemma sum_reverse [add_comm_monoid α] :
  sum (reverse xs) = sum xs :=
by induction xs ; simp *

end list

section minimum

variables {α : Type*} [decidable_linear_order α] [inhabited α]

def minimum (xs : list α) : α :=
list.foldl min xs.head xs.tail

@[simp]
lemma minimum_single (x : α) :
  minimum [x] = x :=
rfl

open list

@[simp]
lemma minimum_cons (x : α) (xs : list α)
  (h : xs ≠ []) :
  minimum (x :: xs) = min x (minimum xs) :=
by { cases xs with y ys, contradiction,
     simp [minimum], rw ← foldl_hom,
     simp [min_assoc], }

lemma le_minimum {x : α} {xs : list α}
  (h : xs ≠ [])
  (h' : ∀ i, i ∈ xs → x ≤ i) :
  x ≤ minimum xs :=
begin
  induction xs, contradiction,
  by_cases xs_tl = list.nil,
  { subst xs_tl, apply h', simp, },
  simp *, apply le_min,
  { apply h', simp },
  { apply xs_ih h, introv h'',
    apply h', right, apply h'' },
end

@[simp]
lemma minimum_cons_le_self {i : α} {xs : list α} :
  minimum (i :: xs) ≤ i :=
by cases xs ; simp [min_le_left]

lemma minimum_le {i : α} {xs : list α}
  (h : i ∈ xs) :
  minimum xs ≤ i :=
by { induction xs ; cases h,
     { subst i, simp [min_le_left], },
     { have : xs_tl ≠ [],
       { intro, subst xs_tl, cases h },
       simp *, transitivity, apply min_le_right,
       solve_by_elim } }

end minimum

local attribute [instance, priority 0] classical.prop_decidable

-- Here are the specifics of our solution.
-- It hinges on computing lists of partial sums
-- forward (`inits_sums`) and backward (`tails_sums`)
section fulcrum

open list int function

instance : inhabited ℤ :=
⟨ 0 ⟩

def inits_sums.f : list ℤ × ℤ → ℤ → list ℤ × ℤ
 | (xs,acc) x := ((acc+x) :: xs, acc+x)

def partial_sums (xs : list ℤ) : list ℤ :=
(list.foldl inits_sums.f ([0],0) xs).1

def tails_sums (xs : list ℤ) : list ℤ :=
partial_sums xs.reverse

def inits_sums (xs : list ℤ) : list ℤ :=
(partial_sums xs).reverse

def fulcrum (xs : list ℤ) : ℤ :=
let xs' := map₂ (λ i j, abs (i - j)) (inits_sums xs) (tails_sums xs) in
minimum xs'

variables (xs : list ℤ)

@[simp]
def partial_sums_def :
  partial_sums xs.reverse = xs.tails.map sum :=
begin
  simp [partial_sums],
  suffices : foldl inits_sums.f ([0], 0) (reverse xs)
           = (map sum (tails xs), sum xs),            { simpa * },
  induction xs ; simp [*,foldl_reverse,inits_sums.f],
end

@[simp]
def tails_sums_def :
  tails_sums xs = xs.tails.map sum :=
by simp [tails_sums]

@[simp]
def inits_sums_def :
  inits_sums xs = xs.inits.map sum :=
by { rw ← reverse_reverse xs,
     generalize : reverse xs = ys,
     simp [inits_sums,inits_reverse,comp], }

lemma le_fulcrum (x : ℤ)
  (h : ∀ i j, (i,j) ∈ zip (xs.inits.map sum) (xs.tails.map sum) → x ≤ abs (i - j)) :
  x ≤ fulcrum xs :=
begin
  apply le_minimum,
  { simp [map₂_eq_map_zip,decidable.not_or_iff_and_not],
    cases xs ; simp, },
  { simp, introv h', simp [map₂_eq_map_zip,uncurry] at h',
    rcases h' with ⟨ a, b, h₀, h₁ ⟩, subst i,
    apply h _ _ h₀, }
end

lemma fulcrum_le (i j : ℤ)
  (h : (i,j) ∈ zip (xs.inits.map sum) (xs.tails.map sum)) :
  fulcrum xs ≤ abs (i - j) :=
minimum_le $
by { simp, refine mem_map₂ (λ i j, abs (i + -j)) h, }

def fulcrum_idx.f : ℕ × ℤ → ℕ × ℤ → ℕ × ℤ
 | (i,acc) (j,x) :=
if x < acc
  then (j,x)
  else (i,acc)

def fulcrum_idx (xs : list ℤ) : ℕ :=
let xs' := map₂ (λ i j, abs (i - j)) (inits_sums xs) (tails_sums xs) in
(xs'.enum.foldl fulcrum_idx.f (0,0)).1

-- lemma fulcrum_idx_lt_length_self (xs : list ℤ)
--   (h : xs ≠ []) :
--   fulcrum_idx xs < xs.length := sorry

-- local notation `♯`:20 xs := (let h := fulcrum_idx_lt_length_self xs (by assumption) in by cc)

-- lemma fulcrum_idx_spec (i : ℕ)
--   (h₀ : xs ≠ [])
--   (h₁ : i = fulcrum_idx xs) :
--   abs ( (xs.inits.map list.sum).inth i - (xs.tails.map list.sum).inth i ) = fulcrum xs :=
-- begin
--   subst i,
--   simp [fulcrum,-inth,minimum],
-- end

end fulcrum


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Alex Kontorovich, Heather Macbeth
-/
import measure_theory.measure.haar_quotient
import measure_theory.integral.interval_integral
import topology.algebra.order.floor

/-!
# Integrals of periodic functions

In this file we prove that the half-open interval `Ioc t (t + T)` in `ℝ` is a fundamental domain of
the action of the subgroup `ℤ ∙ T` on `ℝ`.

A consequence is `add_circle.measure_preserving_mk`: the covering map from `ℝ` to the "additive
circle" `ℝ ⧸ (ℤ ∙ T)` is measure-preserving, with respect to the restriction of Lebesgue measure to
`Ioc t (t + T)` (upstairs) and with respect to Haar measure (downstairs).

Another consequence (`function.periodic.interval_integral_add_eq` and related declarations) is that
`∫ x in t..t + T, f x = ∫ x in s..s + T, f x` for any (not necessarily measurable) function with
period `T`.
-/

open set function measure_theory measure_theory.measure topological_space add_subgroup
  interval_integral

open_locale measure_theory nnreal ennreal

local attribute [-instance] quotient_add_group.measurable_space quotient.measurable_space

lemma is_add_fundamental_domain_Ioc {T : ℝ} (hT : 0 < T) (t : ℝ) (μ : measure ℝ . volume_tac) :
  is_add_fundamental_domain (add_subgroup.zmultiples T) (Ioc t (t + T)) μ :=
begin
  refine is_add_fundamental_domain.mk' measurable_set_Ioc.null_measurable_set (λ x, _),
  have : bijective (cod_restrict (λ n : ℤ, n • T) (add_subgroup.zmultiples T) _),
    from (equiv.of_injective (λ n : ℤ, n • T) (zsmul_strict_mono_left hT).injective).bijective,
  refine this.exists_unique_iff.2 _,
  simpa only [add_comm x] using exists_unique_add_zsmul_mem_Ioc hT x t
end

lemma is_add_fundamental_domain_Ioc' {T : ℝ} (hT : 0 < T) (t : ℝ) (μ : measure ℝ . volume_tac) :
  is_add_fundamental_domain (add_subgroup.zmultiples T).opposite (Ioc t (t + T)) μ :=
begin
  refine is_add_fundamental_domain.mk' measurable_set_Ioc.null_measurable_set (λ x, _),
  have : bijective (cod_restrict (λ n : ℤ, n • T) (add_subgroup.zmultiples T) _),
    from (equiv.of_injective (λ n : ℤ, n • T) (zsmul_strict_mono_left hT).injective).bijective,
  refine this.exists_unique_iff.2 _,
  simpa using exists_unique_add_zsmul_mem_Ioc hT x t,
end

namespace add_circle
variables (T : ℝ) [hT : fact (0 < T)]
include hT

/-- Equip the "additive circle" `ℝ ⧸ (ℤ ∙ T)` with, as a standard measure, the Haar measure of total
mass `T` -/
noncomputable instance measure_space : measure_space (add_circle T) :=
{ volume := (ennreal.of_real T) • add_haar_measure ⊤,
  .. add_circle.measurable_space }

@[simp] protected lemma measure_univ : volume (set.univ : set (add_circle T)) = ennreal.of_real T :=
begin
  dsimp [(volume)],
  rw ← positive_compacts.coe_top,
  simp [add_haar_measure_self, -positive_compacts.coe_top],
end

instance : is_add_haar_measure (volume : measure (add_circle T)) :=
is_add_haar_measure.smul _ (by simp [hT.out]) ennreal.of_real_ne_top

instance is_finite_measure : is_finite_measure (volume : measure (add_circle T)) :=
{ measure_univ_lt_top := by simp }

/-- The covering map from `ℝ` to the "additive circle" `ℝ ⧸ (ℤ ∙ T)` is measure-preserving,
considered with respect to the standard measure (defined to be the Haar measure of total mass `T`)
on the additive circle, and with respect to the restriction of Lebsegue measure on `ℝ` to an
interval (t, t + T]. -/
protected lemma measure_preserving_mk (t : ℝ) :
  measure_preserving (coe : ℝ → add_circle T) (volume.restrict (Ioc t (t + T))) :=
measure_preserving_quotient_add_group.mk'
  (is_add_fundamental_domain_Ioc' hT.out t)
  (⊤ : positive_compacts (add_circle T))
  (by simp)
  T.to_nnreal
  (by simp [← ennreal.of_real_coe_nnreal, real.coe_to_nnreal T hT.out.le])

lemma volume_closed_ball {x : add_circle T} (ε : ℝ) :
  volume (metric.closed_ball x ε) = ennreal.of_real (min T (2 * ε)) :=
begin
  have hT' : |T| = T := abs_eq_self.mpr hT.out.le,
  let I := Ioc (-(T / 2)) (T / 2),
  have h₁ : ε < T/2 → (metric.closed_ball (0 : ℝ) ε) ∩ I = metric.closed_ball (0 : ℝ) ε,
  { intros hε,
    rw [inter_eq_left_iff_subset, real.closed_ball_eq_Icc, zero_sub, zero_add],
    rintros y ⟨hy₁, hy₂⟩, split; linarith, },
  have h₂ : coe⁻¹' metric.closed_ball (0 : add_circle T) ε ∩ I =
    if ε < T/2 then metric.closed_ball (0 : ℝ) ε else I,
  { conv_rhs { rw [← if_ctx_congr (iff.rfl : ε < T/2 ↔ ε < T/2) h₁ (λ _, rfl), ← hT'], },
    apply coe_real_preimage_closed_ball_inter_eq,
    simpa only [hT', real.closed_ball_eq_Icc, zero_add, zero_sub] using Ioc_subset_Icc_self, },
  rw add_haar_closed_ball_center,
  simp only [restrict_apply' measurable_set_Ioc, (by linarith : -(T/2) + T = T/2), h₂,
    ← (add_circle.measure_preserving_mk T (-(T/2))).measure_preimage measurable_set_closed_ball],
  by_cases hε : ε < T/2,
  { simp [hε, min_eq_right (by linarith : 2 * ε ≤ T)], },
  { simp [hε, min_eq_left (by linarith : T ≤ 2 * ε)], },
end

instance : is_doubling_measure (volume : measure (add_circle T)) :=
begin
  refine ⟨⟨real.to_nnreal 2, filter.eventually_of_forall $ λ ε x, _⟩⟩,
  simp only [volume_closed_ball],
  erw ← ennreal.of_real_mul zero_le_two,
  apply ennreal.of_real_le_of_real,
  rw mul_min_of_nonneg _ _ (zero_le_two : (0 : ℝ) ≤ 2),
  exact min_le_min (by linarith [hT.out]) (le_refl _),
end

/-- The isomorphism `add_circle T ≃ Ioc a (a + T)` whose inverse is the natural quotient map,
  as an equivalence of measurable spaces. -/
noncomputable def measurable_equiv_Ioc (a : ℝ) : add_circle T ≃ᵐ Ioc a (a + T) :=
{ measurable_to_fun   := measurable_of_measurable_on_compl_singleton _
                          (continuous_on_iff_continuous_restrict.mp $ continuous_at.continuous_on $
                          λ x hx, continuous_at_equiv_Ioc T a hx).measurable,
  measurable_inv_fun  := add_circle.measurable_mk'.comp measurable_subtype_coe,
                      .. equiv_Ioc T a }

/-- The isomorphism `add_circle T ≃ Ico a (a + T)` whose inverse is the natural quotient map,
  as an equivalence of measurable spaces. -/
noncomputable def measurable_equiv_Ico (a : ℝ) : add_circle T ≃ᵐ Ico a (a + T) :=
{ measurable_to_fun   := measurable_of_measurable_on_compl_singleton _
                          (continuous_on_iff_continuous_restrict.mp $ continuous_at.continuous_on $
                          λ x hx, continuous_at_equiv_Ico T a hx).measurable,
  measurable_inv_fun  := add_circle.measurable_mk'.comp measurable_subtype_coe,
                      .. equiv_Ico T a }

/-- The lower integral of a function over `add_circle T` is equal to the lower integral over an
interval (t, t + T] in `ℝ` of its lift to `ℝ`. -/
protected lemma lintegral_preimage (t : ℝ) (f : add_circle T → ℝ≥0∞) :
  ∫⁻ a in Ioc t (t + T), f a = ∫⁻ b : add_circle T, f b :=
begin
  have m : measurable_set (Ioc t (t + T)) := measurable_set_Ioc,
  have := lintegral_map_equiv f (measurable_equiv_Ioc T t).symm,
  swap, exact volume,
  simp only [measurable_equiv_Ioc, equiv_Ioc, quotient_add_group.equiv_Ioc_mod,
    measurable_equiv.symm_mk, measurable_equiv.coe_mk, equiv.coe_fn_symm_mk] at this,
  rw ←(add_circle.measure_preserving_mk T t).map_eq,
  convert this.symm using 1, -- TODO : there is no "set_lintegral_eq_subtype"?
  { rw ←(map_comap_subtype_coe m _),
    exact measurable_embedding.lintegral_map (measurable_embedding.subtype_coe m) _, },
  { congr' 1,
    have : (coe : Ioc t (t + T) → add_circle T) = (coe : ℝ → add_circle T) ∘ (coe : _ → ℝ),
    { ext1 x, refl, },
    simp_rw [this, ←map_map add_circle.measurable_mk' measurable_subtype_coe,
      ←map_comap_subtype_coe m],
    refl, }
end

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]

/-- The integral of an almost-everywhere strongly measurable function over `add_circle T` is equal
to the integral over an interval (t, t + T] in `ℝ` of its lift to `ℝ`. -/
protected lemma integral_preimage (t : ℝ) (f : add_circle T → E) :
  ∫ a in Ioc t (t + T), f a = ∫ b : add_circle T, f b :=
begin
  have m : measurable_set (Ioc t (t + T)) := measurable_set_Ioc,
  have := integral_map_equiv (measurable_equiv_Ioc T t).symm f,
  simp only [measurable_equiv_Ioc, equiv_Ioc, quotient_add_group.equiv_Ioc_mod,
    measurable_equiv.symm_mk, measurable_equiv.coe_mk, equiv.coe_fn_symm_mk, coe_coe] at this,
  rw [←(add_circle.measure_preserving_mk T t).map_eq, set_integral_eq_subtype m, ←this],
  have : (coe : Ioc t (t + T) → add_circle T) = (coe : ℝ → add_circle T) ∘ (coe : _ → ℝ),
  { ext1 x, refl, },
  simp_rw [this, ←map_map add_circle.measurable_mk' measurable_subtype_coe,
    ←map_comap_subtype_coe m],
  refl,
end

/-- The integral of an almost-everywhere strongly measurable function over `add_circle T` is equal
to the integral over an interval (t, t + T] in `ℝ` of its lift to `ℝ`. -/
protected lemma interval_integral_preimage (t : ℝ) (f : add_circle T → E) :
  ∫ a in t..(t + T), f a = ∫ b : add_circle T, f b :=
begin
  rw [integral_of_le, add_circle.integral_preimage T t f],
  linarith [hT.out],
end

end add_circle

namespace unit_add_circle
local attribute [instance] real.fact_zero_lt_one

noncomputable instance measure_space : measure_space unit_add_circle := add_circle.measure_space 1

@[simp] protected lemma measure_univ : volume (set.univ : set unit_add_circle) = 1 := by simp

instance is_finite_measure : is_finite_measure (volume : measure unit_add_circle) :=
add_circle.is_finite_measure 1

/-- The covering map from `ℝ` to the "unit additive circle" `ℝ ⧸ ℤ` is measure-preserving,
considered with respect to the standard measure (defined to be the Haar measure of total mass 1)
on the additive circle, and with respect to the restriction of Lebsegue measure on `ℝ` to an
interval (t, t + 1]. -/
protected lemma measure_preserving_mk (t : ℝ) :
  measure_preserving (coe : ℝ → unit_add_circle) (volume.restrict (Ioc t (t + 1))) :=
add_circle.measure_preserving_mk 1 t

/-- The integral of a measurable function over `unit_add_circle` is equal to the integral over an
interval (t, t + 1] in `ℝ` of its lift to `ℝ`. -/
protected lemma lintegral_preimage (t : ℝ) (f : unit_add_circle → ℝ≥0∞) :
  ∫⁻ a in Ioc t (t + 1), f a = ∫⁻ b : unit_add_circle, f b :=
add_circle.lintegral_preimage 1 t f

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]

/-- The integral of an almost-everywhere strongly measurable function over `unit_add_circle` is
equal to the integral over an interval (t, t + 1] in `ℝ` of its lift to `ℝ`. -/
protected lemma integral_preimage (t : ℝ) (f : unit_add_circle → E) :
  ∫ a in Ioc t (t + 1), f a = ∫ b : unit_add_circle, f b :=
add_circle.integral_preimage 1 t f

/-- The integral of an almost-everywhere strongly measurable function over `unit_add_circle` is
equal to the integral over an interval (t, t + 1] in `ℝ` of its lift to `ℝ`. -/
protected lemma interval_integral_preimage (t : ℝ) (f : unit_add_circle → E) :
  ∫ a in t..(t + 1), f a = ∫ b : unit_add_circle, f b :=
add_circle.interval_integral_preimage 1 t f

end unit_add_circle

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]

namespace function

namespace periodic

variables {f : ℝ → E} {T : ℝ}

/-- An auxiliary lemma for a more general `function.periodic.interval_integral_add_eq`. -/
lemma interval_integral_add_eq_of_pos (hf : periodic f T)
  (hT : 0 < T) (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
begin
  simp only [integral_of_le, hT.le, le_add_iff_nonneg_right],
  haveI : vadd_invariant_measure (add_subgroup.zmultiples T) ℝ volume :=
    ⟨λ c s hs, measure_preimage_add _ _ _⟩,
  exact (is_add_fundamental_domain_Ioc hT t).set_integral_eq
    (is_add_fundamental_domain_Ioc hT s) hf.map_vadd_zmultiples
end

/-- If `f` is a periodic function with period `T`, then its integral over `[t, t + T]` does not
depend on `t`. -/
lemma interval_integral_add_eq (hf : periodic f T)
  (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
begin
  rcases lt_trichotomy 0 T with (hT|rfl|hT),
  { exact hf.interval_integral_add_eq_of_pos hT t s },
  { simp },
  { rw [← neg_inj, ← integral_symm, ← integral_symm],
    simpa only [← sub_eq_add_neg, add_sub_cancel]
      using (hf.neg.interval_integral_add_eq_of_pos (neg_pos.2 hT) (t + T) (s + T)) }
end

/-- If `f` is an integrable periodic function with period `T`, then its integral over `[t, s + T]`
is the sum of its integrals over the intervals `[t, s]` and `[t, t + T]`. -/
lemma interval_integral_add_eq_add (hf : periodic f T) (t s : ℝ)
  (h_int : ∀ t₁ t₂, interval_integrable f measure_space.volume t₁ t₂) :
  ∫ x in t..s+T, f x = (∫ x in t..s, f x) + ∫ x in t..t + T, f x :=
by rw [hf.interval_integral_add_eq t s, integral_add_adjacent_intervals (h_int t s) (h_int s _)]

/-- If `f` is an integrable periodic function with period `T`, and `n` is an integer, then its
integral over `[t, t + n • T]` is `n` times its integral over `[t, t + T]`. -/
lemma interval_integral_add_zsmul_eq (hf : periodic f T) (n : ℤ) (t : ℝ)
  (h_int : ∀ t₁ t₂, interval_integrable f measure_space.volume t₁ t₂) :
  ∫ x in t..t + n • T, f x = n • ∫ x in t..t + T, f x :=
begin
  -- Reduce to the case `b = 0`
  suffices : ∫ x in 0..n • T, f x = n • ∫ x in 0..T, f x,
  { simp only [hf.interval_integral_add_eq t 0, (hf.zsmul n).interval_integral_add_eq t 0, zero_add,
      this], },
  -- First prove it for natural numbers
  have : ∀ (m : ℕ), ∫ x in 0..m • T, f x = m • ∫ x in 0..T, f x,
  { intros,
    induction m with m ih,
    { simp, },
    { simp only [succ_nsmul', hf.interval_integral_add_eq_add 0 (m • T) h_int, ih, zero_add], }, },
  -- Then prove it for all integers
  cases n with n n,
  { simp [← this n], },
  { conv_rhs { rw zsmul_neg_succ_of_nat, },
    have h₀ : (int.neg_succ_of_nat n) • T + (n + 1) • T = 0, { simp, linarith, },
    rw [integral_symm, ← (hf.nsmul (n+1)).funext, neg_inj],
    simp_rw [integral_comp_add_right, h₀, zero_add, this (n+1),
      add_comm T, hf.interval_integral_add_eq ((n+1) • T) 0, zero_add], },
end

section real_valued

open filter

variables {g : ℝ → ℝ}
variables (hg : periodic g T) (h_int : ∀ t₁ t₂, interval_integrable g measure_space.volume t₁ t₂)
include hg h_int

/-- If `g : ℝ → ℝ` is periodic with period `T > 0`, then for any `t : ℝ`, the function
`t ↦ ∫ x in 0..t, g x` is bounded below by `t ↦ X + ⌊t/T⌋ • Y` for appropriate constants `X` and
`Y`. -/
lemma Inf_add_zsmul_le_integral_of_pos (hT : 0 < T) (t : ℝ) :
  Inf ((λ t, ∫ x in 0..t, g x) '' (Icc 0 T)) + ⌊t/T⌋ • (∫ x in 0..T, g x) ≤ ∫ x in 0..t, g x :=
begin
  let ε := int.fract (t/T) * T,
  conv_rhs { rw [← int.fract_div_mul_self_add_zsmul_eq T t (by linarith),
    ← integral_add_adjacent_intervals (h_int 0 ε) (h_int _ _)] },
  rw [hg.interval_integral_add_zsmul_eq ⌊t/T⌋ ε h_int, hg.interval_integral_add_eq ε 0, zero_add,
    add_le_add_iff_right],
  exact (continuous_primitive h_int 0).continuous_on.Inf_image_Icc_le
    (mem_Icc_of_Ico (int.fract_div_mul_self_mem_Ico T t hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0`, then for any `t : ℝ`, the function
`t ↦ ∫ x in 0..t, g x` is bounded above by `t ↦ X + ⌊t/T⌋ • Y` for appropriate constants `X` and
`Y`. -/
lemma integral_le_Sup_add_zsmul_of_pos (hT : 0 < T) (t : ℝ) :
  ∫ x in 0..t, g x ≤ Sup ((λ t, ∫ x in 0..t, g x) '' (Icc 0 T)) + ⌊t/T⌋ • (∫ x in 0..T, g x) :=
begin
  let ε := int.fract (t/T) * T,
  conv_lhs { rw [← int.fract_div_mul_self_add_zsmul_eq T t (by linarith),
    ← integral_add_adjacent_intervals (h_int 0 ε) (h_int _ _)] },
  rw [hg.interval_integral_add_zsmul_eq ⌊t/T⌋ ε h_int, hg.interval_integral_add_eq ε 0, zero_add,
    add_le_add_iff_right],
  exact (continuous_primitive h_int 0).continuous_on.le_Sup_image_Icc
    (mem_Icc_of_Ico (int.fract_div_mul_self_mem_Ico T t hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `0 < ∫ x in 0..T, g x`, then
`t ↦ ∫ x in 0..t, g x` tends to `∞` as `t` tends to `∞`. -/
lemma tendsto_at_top_interval_integral_of_pos (h₀ : 0 < ∫ x in 0..T, g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_top at_top :=
begin
  apply tendsto_at_top_mono (hg.Inf_add_zsmul_le_integral_of_pos h_int hT),
  apply at_top.tendsto_at_top_add_const_left (Inf $ (λ t, ∫ x in 0..t, g x) '' (Icc 0 T)),
  apply tendsto.at_top_zsmul_const h₀,
  exact tendsto_floor_at_top.comp (tendsto_id.at_top_mul_const (inv_pos.mpr hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `0 < ∫ x in 0..T, g x`, then
`t ↦ ∫ x in 0..t, g x` tends to `-∞` as `t` tends to `-∞`. -/
lemma tendsto_at_bot_interval_integral_of_pos (h₀ : 0 < ∫ x in 0..T, g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_bot at_bot :=
begin
  apply tendsto_at_bot_mono (hg.integral_le_Sup_add_zsmul_of_pos h_int hT),
  apply at_bot.tendsto_at_bot_add_const_left (Sup $ (λ t, ∫ x in 0..t, g x) '' (Icc 0 T)),
  apply tendsto.at_bot_zsmul_const h₀,
  exact tendsto_floor_at_bot.comp (tendsto_id.at_bot_mul_const (inv_pos.mpr hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `∀ x, 0 < g x`, then `t ↦ ∫ x in 0..t, g x`
tends to `∞` as `t` tends to `∞`. -/
lemma tendsto_at_top_interval_integral_of_pos' (h₀ : ∀ x, 0 < g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_top at_top :=
hg.tendsto_at_top_interval_integral_of_pos h_int (interval_integral_pos_of_pos (h_int 0 T) h₀ hT) hT

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `∀ x, 0 < g x`, then `t ↦ ∫ x in 0..t, g x`
tends to `-∞` as `t` tends to `-∞`. -/
lemma tendsto_at_bot_interval_integral_of_pos' (h₀ : ∀ x, 0 < g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_bot at_bot :=
hg.tendsto_at_bot_interval_integral_of_pos h_int (interval_integral_pos_of_pos (h_int 0 T) h₀ hT) hT

end real_valued

end periodic

end function