import for_mathlib.integral_closure

import power_bounded Huber_ring.basic

/-!
# Huber pairs

This short file defines Huber pairs.

A Huber pair consists of a Huber ring and a
so-call ring of integral elements: an integrally closed, power bounded, open subring.
A typical example is ℤ_p ⊆ ℚ_p. (However, this example is hard to use as is,
because our fomalisation uses subrings and Lean's version of ℤ_p is not a subring of ℚ_p.
This could be fixed by using injective ring homomorphisms instead of subrings.)

-/

universes u v

open_locale classical
open power_bounded

-- Notation for the power bounded subring
local postfix `ᵒ` : 66 := power_bounded_subring

set_option old_structure_cmd true

/- An subring of a Huber ring is called a “ring of integral elements”
if it is open, integrally closed, and power bounded. See [Wedhorn, Def 7.14].-/
structure is_ring_of_integral_elements (Rplus : Type u) (R : Type u)
  [comm_ring Rplus] [topological_space Rplus] [Huber_ring R] [algebra Rplus R]
  extends is_integrally_closed Rplus R, open_embedding (algebra_map R : Rplus → R) : Prop :=
(is_power_bounded : set.range (algebra_map R : Rplus → R) ≤ Rᵒ)

namespace is_ring_of_integral_elements
variables (Rplus : Type u) (R : Type u)
variables [comm_ring Rplus] [topological_space Rplus] [Huber_ring R] [algebra Rplus R]

lemma plus_is_topological_ring (h : is_ring_of_integral_elements Rplus R) :
  topological_ring Rplus :=
{ continuous_add :=
  begin
    rw h.to_open_embedding.to_embedding.to_inducing.continuous_iff,
    simp only [function.comp, algebra.map_add],
    apply continuous.add,
    all_goals { apply h.to_open_embedding.continuous.comp },
    { exact continuous_fst },
    { exact continuous_snd },
  end,
  continuous_mul :=
  begin
    rw h.to_open_embedding.to_embedding.to_inducing.continuous_iff,
    simp only [function.comp, algebra.map_mul],
    apply continuous.mul,
    all_goals { apply h.to_open_embedding.continuous.comp },
    { exact continuous_fst },
    { exact continuous_snd },
  end,
  continuous_neg :=
  begin
    rw h.to_open_embedding.to_embedding.to_inducing.continuous_iff,
    simp only [function.comp, algebra.map_neg],
    exact h.to_open_embedding.continuous.neg,
  end }

end is_ring_of_integral_elements

/-- A Huber pair consists of a Huber ring and a
so-call ring of integral elements: an integrally closed, power bounded, open subring.
(The name “Huber pair” was introduced by Scholze.
Before that, they were called “affinoid rings”.) See [Wedhorn, Def 7.14].-/
structure Huber_pair :=
(plus : Type) -- change this to (Type u) to enable universes
(carrier : Type)
[ring : comm_ring plus]
[top : topological_space plus]
[Huber : Huber_ring carrier]
[alg : algebra plus carrier]
(intel : is_ring_of_integral_elements plus carrier)

namespace Huber_pair
variable (A : Huber_pair)

/-- The coercion of a Huber pair to a type (the ambient ring).-/
instance : has_coe_to_sort Huber_pair :=
{ S := Type, coe := Huber_pair.carrier }

-- The following notation is very common in the literature.
local postfix `⁺` : 66 := λ A : Huber_pair, A.plus

/-- The Huber ring structure on a Huber pair. -/
instance : Huber_ring A := A.Huber

/-- The ring structure on the ring of integral elements. -/
instance : comm_ring (A⁺) := A.ring

/-- The algebra structure of a Huber pair. -/
instance : algebra (A⁺) A := A.alg

/-- The topology on the ring of integral elements. -/
instance : topological_space (A⁺) := A.top

/-- The ring of integral elements is a topological ring.-/
instance : topological_ring (A⁺) :=
is_ring_of_integral_elements.plus_is_topological_ring _ A A.intel

end Huber_pair


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.rat.init
import data.int.cast.defs
import data.int.dvd.basic
import algebra.ring.regular
import data.nat.gcd.basic
import data.pnat.defs

/-!
# Basics for the Rational Numbers

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

## Summary

We define the integral domain structure on `ℚ` and prove basic lemmas about it.
The definition of the field structure on `ℚ` will be done in `data.rat.basic` once the
`field` class has been defined.

## Main Definitions

- `rat.mk n d` constructs a rational number `q = n / d` from `n d : ℤ`.

## Notations

- `/.` is infix notation for `rat.mk`.

-/

namespace rat

/-- Embed an integer as a rational number. You should use the coercion `coe : ℤ → ℚ` instead. -/
def of_int (n : ℤ) : ℚ :=
⟨n, 1, nat.one_pos, nat.coprime_one_right _⟩

instance : has_int_cast ℚ := ⟨of_int⟩

@[simp] lemma of_int_eq_cast (n : ℤ) : of_int n = n := rfl
@[simp, norm_cast] lemma coe_int_num (n : ℤ) : (n : ℚ).num = n := rfl
@[simp, norm_cast] lemma coe_int_denom (n : ℤ) : (n : ℚ).denom = 1 := rfl

instance : has_zero ℚ := ⟨(0 : ℤ)⟩
instance : has_one ℚ := ⟨(1 : ℤ)⟩
instance : inhabited ℚ := ⟨0⟩

/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ+` (not necessarily coprime) -/
def mk_pnat (n : ℤ) : ℕ+ → ℚ | ⟨d, dpos⟩ :=
let n' := n.nat_abs, g := n'.gcd d in
⟨n / g, d / g, begin
  apply (nat.le_div_iff_mul_le (nat.gcd_pos_of_pos_right _ dpos)).2,
  rw one_mul, exact nat.le_of_dvd dpos (nat.gcd_dvd_right _ _)
end, begin
  have : int.nat_abs (n / ↑g) = n' / g,
  { cases int.nat_abs_eq n with e e; rw e, { refl },
    rw [int.neg_div_of_dvd, int.nat_abs_neg], { refl },
    exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) },
  rw this,
  exact nat.coprime_div_gcd_div_gcd (nat.gcd_pos_of_pos_right _ dpos)
end⟩

/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ`. In the case `d = 0`, we
  define `n / 0 = 0` by convention. -/
def mk_nat (n : ℤ) (d : ℕ) : ℚ :=
if d0 : d = 0 then 0 else mk_pnat n ⟨d, nat.pos_of_ne_zero d0⟩

/-- Form the quotient `n / d` where `n d : ℤ`. -/
def mk : ℤ → ℤ → ℚ
| n (d : ℕ) := mk_nat n d
| n -[1+ d] := mk_pnat (-n) d.succ_pnat

localized "infix (name := rat.mk) ` /. `:70 := rat.mk" in rat

theorem mk_pnat_eq (n d h) : mk_pnat n ⟨d, h⟩ = n /. d :=
by change n /. d with dite _ _ _; simp [ne_of_gt h]

theorem mk_nat_eq (n d) : mk_nat n d = n /. d := rfl

@[simp] theorem mk_zero (n) : n /. 0 = 0 := rfl

@[simp] theorem zero_mk_pnat (n) : mk_pnat 0 n = 0 :=
begin
  cases n with n npos,
  simp only [mk_pnat, int.nat_abs_zero, nat.div_self npos, nat.gcd_zero_left, int.zero_div],
  refl
end

@[simp] theorem zero_mk_nat (n) : mk_nat 0 n = 0 :=
by by_cases n = 0; simp [*, mk_nat]

@[simp] theorem zero_mk (n) : 0 /. n = 0 :=
by cases n; simp [mk]

private lemma gcd_abs_dvd_left {a b} : (nat.gcd (int.nat_abs a) b : ℤ) ∣ a :=
int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ nat.gcd_dvd_left (int.nat_abs a) b

@[simp] theorem mk_eq_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b = 0 ↔ a = 0 :=
begin
  refine ⟨λ h, _, by { rintro rfl, simp }⟩,
  have : ∀ {a b}, mk_pnat a b = 0 → a = 0,
  { rintro a ⟨b, h⟩ e,
    injection e with e,
    apply int.eq_mul_of_div_eq_right gcd_abs_dvd_left e },
  cases b with b; simp only [mk, mk_nat, int.of_nat_eq_coe, dite_eq_left_iff] at h,
  { simp only [mt (congr_arg int.of_nat) b0, not_false_iff, forall_true_left] at h,
    exact this h },
  { apply neg_injective, simp [this h] }
end

theorem mk_ne_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b ≠ 0 ↔ a ≠ 0 :=
(mk_eq_zero b0).not

theorem mk_eq : ∀ {a b c d : ℤ} (hb : b ≠ 0) (hd : d ≠ 0),
  a /. b = c /. d ↔ a * d = c * b :=
suffices ∀ a b c d hb hd, mk_pnat a ⟨b, hb⟩ = mk_pnat c ⟨d, hd⟩ ↔ a * d = c * b,
begin
  intros, cases b with b b; simp [mk, mk_nat, nat.succ_pnat],
  simp [mt (congr_arg int.of_nat) hb],
  all_goals
  { cases d with d d; simp [mk, mk_nat, nat.succ_pnat],
    simp [mt (congr_arg int.of_nat) hd],
    all_goals { rw this, try {refl} } },
  { change a * ↑(d.succ) = -c * ↑b ↔ a * -(d.succ) = c * b,
    constructor; intro h; apply neg_injective; simpa [left_distrib, neg_add_eq_iff_eq_add,
      eq_neg_iff_add_eq_zero, neg_eq_iff_add_eq_zero] using h },
  { change -a * ↑d = c * b.succ ↔ a * d = c * -b.succ,
    constructor; intro h; apply neg_injective; simpa [left_distrib, eq_comm] using h },
  { change -a * d.succ = -c * b.succ ↔ a * -d.succ = c * -b.succ,
    simp [left_distrib, sub_eq_add_neg], cc }
end,
begin
  intros, simp [mk_pnat], constructor; intro h,
  { cases h with ha hb,
    have ha,
    { have dv := @gcd_abs_dvd_left,
      have := int.eq_mul_of_div_eq_right dv ha,
      rw ← int.mul_div_assoc _ dv at this,
      exact int.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
    have hb,
    { have dv := λ {a b}, nat.gcd_dvd_right (int.nat_abs a) b,
      have := nat.eq_mul_of_div_eq_right dv hb,
      rw ← nat.mul_div_assoc _ dv at this,
      exact nat.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
    have m0 : (a.nat_abs.gcd b * c.nat_abs.gcd d : ℤ) ≠ 0,
    { refine int.coe_nat_ne_zero.2 (ne_of_gt _),
      apply mul_pos; apply nat.gcd_pos_of_pos_right; assumption },
    apply mul_right_cancel₀ m0,
    simpa [mul_comm, mul_left_comm] using
      congr (congr_arg (*) ha.symm) (congr_arg coe hb) },
  { suffices : ∀ a c, a * d = c * b →
      a / a.gcd b = c / c.gcd d ∧ b / a.gcd b = d / c.gcd d,
    { cases this a.nat_abs c.nat_abs
        (by simpa [int.nat_abs_mul] using congr_arg int.nat_abs h) with h₁ h₂,
      have hs := congr_arg int.sign h,
      simp [int.sign_eq_one_of_pos (int.coe_nat_lt.2 hb),
            int.sign_eq_one_of_pos (int.coe_nat_lt.2 hd)] at hs,
      conv in a { rw ← int.sign_mul_nat_abs a },
      conv in c { rw ← int.sign_mul_nat_abs c },
      rw [int.mul_div_assoc, int.mul_div_assoc],
      exact ⟨congr (congr_arg (*) hs) (congr_arg coe h₁), h₂⟩,
      all_goals { exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) } },
    intros a c h,
    suffices bd : b / a.gcd b = d / c.gcd d,
    { refine ⟨mul_left_cancel₀ hb.ne' _, bd⟩,
      rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _), mul_comm,
          nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), bd,
          ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), h, mul_comm,
          nat.mul_div_assoc _ (nat.gcd_dvd_left _ _)] },
    suffices : ∀ {a c : ℕ} (b>0) (d>0),
      a * d = c * b → b / a.gcd b ≤ d / c.gcd d,
    { exact le_antisymm (this _ hb _ hd h) (this _ hd _ hb h.symm) },
    intros a c b hb d hd h,
    have gb0 := nat.gcd_pos_of_pos_right a hb,
    have gd0 := nat.gcd_pos_of_pos_right c hd,
    apply nat.le_of_dvd,
    apply (nat.le_div_iff_mul_le gd0).2,
    simp, apply nat.le_of_dvd hd (nat.gcd_dvd_right _ _),
    apply (nat.coprime_div_gcd_div_gcd gb0).symm.dvd_of_dvd_mul_left,
    refine ⟨c / c.gcd d, _⟩,
    rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
        ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _)],
    apply congr_arg (/ c.gcd d),
    rw [mul_comm, ← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
        mul_comm, h, nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), mul_comm] }
end

@[simp] theorem div_mk_div_cancel_left {a b c : ℤ} (c0 : c ≠ 0) :
  (a * c) /. (b * c) = a /. b :=
begin
  by_cases b0 : b = 0, { subst b0, simp },
  apply (mk_eq (mul_ne_zero b0 c0) b0).2, simp [mul_comm, mul_assoc]
end

@[simp] theorem num_denom : ∀ {a : ℚ}, a.num /. a.denom = a
| ⟨n, d, h, (c:_=1)⟩ := show mk_nat n d = _,
  by simp [mk_nat, ne_of_gt h, mk_pnat, c]

theorem num_denom' {n d h c} : (⟨n, d, h, c⟩ : ℚ) = n /. d := num_denom.symm

lemma coe_int_eq_mk (z : ℤ) : (z : ℚ) = z /. 1 := num_denom'

/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
numbers of the form `n /. d` with `0 < d` and coprime `n`, `d`. -/
@[elab_as_eliminator] def {u} num_denom_cases_on {C : ℚ → Sort u}
   : ∀ (a : ℚ) (H : ∀ n d, 0 < d → (int.nat_abs n).coprime d → C (n /. d)), C a
| ⟨n, d, h, c⟩ H := by rw num_denom'; exact H n d h c

/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
numbers of the form `n /. d` with `d ≠ 0`. -/
@[elab_as_eliminator] def {u} num_denom_cases_on' {C : ℚ → Sort u}
   (a : ℚ) (H : ∀ (n:ℤ) (d:ℕ), d ≠ 0 → C (n /. d)) : C a :=
num_denom_cases_on a $ λ n d h c, H n d h.ne'

/-- Addition of rational numbers. Use `(+)` instead. -/
protected def add : ℚ → ℚ → ℚ
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * d₂ + n₂ * d₁) ⟨d₁ * d₂, mul_pos h₁ h₂⟩

instance : has_add ℚ := ⟨rat.add⟩

theorem lift_binop_eq (f : ℚ → ℚ → ℚ) (f₁ : ℤ → ℤ → ℤ → ℤ → ℤ) (f₂ : ℤ → ℤ → ℤ → ℤ → ℤ)
  (fv : ∀ {n₁ d₁ h₁ c₁ n₂ d₂ h₂ c₂},
    f ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ = f₁ n₁ d₁ n₂ d₂ /. f₂ n₁ d₁ n₂ d₂)
  (f0 : ∀ {n₁ d₁ n₂ d₂} (d₁0 : d₁ ≠ 0) (d₂0 : d₂ ≠ 0), f₂ n₁ d₁ n₂ d₂ ≠ 0)
  (a b c d : ℤ) (b0 : b ≠ 0) (d0 : d ≠ 0)
  (H : ∀ {n₁ d₁ n₂ d₂} (h₁ : a * d₁ = n₁ * b) (h₂ : c * d₂ = n₂ * d),
       f₁ n₁ d₁ n₂ d₂ * f₂ a b c d = f₁ a b c d * f₂ n₁ d₁ n₂ d₂) :
  f (a /. b) (c /. d) = f₁ a b c d /. f₂ a b c d :=
begin
  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
  generalize hc : c /. d = x, cases x with n₂ d₂ h₂ c₂, rw num_denom' at hc,
  rw fv,
  have d₁0 := ne_of_gt (int.coe_nat_lt.2 h₁),
  have d₂0 := ne_of_gt (int.coe_nat_lt.2 h₂),
  exact (mk_eq (f0 d₁0 d₂0) (f0 b0 d0)).2 (H ((mk_eq b0 d₁0).1 ha) ((mk_eq d0 d₂0).1 hc))
end

@[simp] theorem add_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
  a /. b + c /. d = (a * d + c * b) /. (b * d) :=
begin
  apply lift_binop_eq rat.add; intros; try {assumption},
  { apply mk_pnat_eq },
  { apply mul_ne_zero d₁0 d₂0 },
  calc (n₁ * d₂ + n₂ * d₁) * (b * d) =
          (n₁ * b) * d₂ * d + (n₂ * d) * (d₁ * b) : by simp [mul_add, mul_comm, mul_left_comm]
    ... = (a * d₁) * d₂ * d + (c * d₂) * (d₁ * b) : by rw [h₁, h₂]
    ... = (a * d + c * b) * (d₁ * d₂)             : by simp [mul_add, mul_comm, mul_left_comm]
end

/-- Negation of rational numbers. Use `-r` instead. -/
protected def neg (r : ℚ) : ℚ :=
⟨-r.num, r.denom, r.pos, by simp [r.cop]⟩

instance : has_neg ℚ := ⟨rat.neg⟩

@[simp] theorem neg_def {a b : ℤ} : -(a /. b) = -a /. b :=
begin
  by_cases b0 :  b = 0, { subst b0, simp, refl },
  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
  show rat.mk' _ _ _ _ = _, rw num_denom',
  have d0 := ne_of_gt (int.coe_nat_lt.2 h₁),
  apply (mk_eq d0 b0).2, have h₁ := (mk_eq b0 d0).1 ha,
  simp only [neg_mul, congr_arg has_neg.neg h₁]
end

@[simp] lemma mk_neg_denom (n d : ℤ) : n /. -d = -n /. d :=
begin
  by_cases hd : d = 0;
  simp [rat.mk_eq, hd]
end

/-- Multiplication of rational numbers. Use `(*)` instead. -/
protected def mul : ℚ → ℚ → ℚ
| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * n₂) ⟨d₁ * d₂, mul_pos h₁ h₂⟩

instance : has_mul ℚ := ⟨rat.mul⟩

@[simp] theorem mul_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
  (a /. b) * (c /. d) = (a * c) /. (b * d) :=
begin
  apply lift_binop_eq rat.mul; intros; try {assumption},
  { apply mk_pnat_eq },
  { apply mul_ne_zero d₁0 d₂0 },
  cc
end

/-- Inverse rational number. Use `r⁻¹` instead. -/
protected def inv : ℚ → ℚ
| ⟨(n+1:ℕ), d, h, c⟩ := ⟨d, n+1, n.succ_pos, c.symm⟩
| ⟨0, d, h, c⟩ := 0
| ⟨-[1+ n], d, h, c⟩ := ⟨-d, n+1, n.succ_pos, nat.coprime.symm $ by simp; exact c⟩

instance : has_inv ℚ := ⟨rat.inv⟩
instance : has_div ℚ := ⟨λ a b, a * b⁻¹⟩

@[simp] theorem inv_def {a b : ℤ} : (a /. b)⁻¹ = b /. a :=
begin
  by_cases a0 : a = 0, { subst a0, simp, refl },
  by_cases b0 : b = 0, { subst b0, simp, refl },
  generalize ha : a /. b = x, cases x with n d h c, rw num_denom' at ha,
  refine eq.trans (_ : rat.inv ⟨n, d, h, c⟩ = d /. n) _,
  { cases n with n; [cases n with n, skip],
    { refl },
    { change int.of_nat n.succ with (n+1:ℕ),
      unfold rat.inv, rw num_denom' },
    { unfold rat.inv, rw num_denom', refl } },
  have n0 : n ≠ 0,
  { rintro rfl,
    rw [rat.zero_mk, mk_eq_zero b0] at ha,
    exact a0 ha },
  have d0 := ne_of_gt (int.coe_nat_lt.2 h),
  have ha := (mk_eq b0 d0).1 ha,
  apply (mk_eq n0 a0).2,
  cc
end

variables (a b c : ℚ)

protected theorem add_zero : a + 0 = a :=
num_denom_cases_on' a $ λ n d h,
by rw [← zero_mk d]; simp [h, -zero_mk]

protected theorem zero_add : 0 + a = a :=
num_denom_cases_on' a $ λ n d h,
by rw [← zero_mk d]; simp [h, -zero_mk]

protected theorem add_comm : a + b = b + a :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
by simp [h₁, h₂]; cc

protected theorem add_assoc : a + b + c = a + (b + c) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
num_denom_cases_on' c $ λ n₃ d₃ h₃,
by simp [h₁, h₂, h₃, mul_ne_zero, mul_add, mul_comm, mul_left_comm, add_left_comm, add_assoc]

protected theorem add_left_neg : -a + a = 0 :=
num_denom_cases_on' a $ λ n d h,
by simp [h]

@[simp] lemma mk_zero_one : 0 /. 1 = 0 :=
show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }

@[simp] lemma mk_one_one : 1 /. 1 = 1 :=
show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }

@[simp] lemma mk_neg_one_one : (-1) /. 1 = -1 :=
show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }

protected theorem mul_one : a * 1 = a :=
num_denom_cases_on' a $ λ n d h,
by { rw ← mk_one_one, simp [h, -mk_one_one] }

protected theorem one_mul : 1 * a = a :=
num_denom_cases_on' a $ λ n d h,
by { rw ← mk_one_one, simp [h, -mk_one_one] }

protected theorem mul_comm : a * b = b * a :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
by simp [h₁, h₂, mul_comm]

protected theorem mul_assoc : a * b * c = a * (b * c) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
num_denom_cases_on' c $ λ n₃ d₃ h₃,
by simp [h₁, h₂, h₃, mul_ne_zero, mul_comm, mul_left_comm]

protected theorem add_mul : (a + b) * c = a * c + b * c :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
num_denom_cases_on' c $ λ n₃ d₃ h₃,
by simp [h₁, h₂, h₃, mul_ne_zero];
   refine (div_mk_div_cancel_left (int.coe_nat_ne_zero.2 h₃)).symm.trans _;
   simp [mul_add, mul_comm, mul_assoc, mul_left_comm]

protected theorem mul_add : a * (b + c) = a * b + a * c :=
by rw [rat.mul_comm, rat.add_mul, rat.mul_comm, rat.mul_comm c a]

protected theorem zero_ne_one : 0 ≠ (1:ℚ) :=
by { rw [ne_comm, ← mk_one_one, mk_ne_zero one_ne_zero], exact one_ne_zero }

protected theorem mul_inv_cancel : a ≠ 0 → a * a⁻¹ = 1 :=
num_denom_cases_on' a $ λ n d h a0,
have n0 : n ≠ 0, from mt (by { rintro rfl, simp }) a0,
by simpa [h, n0, mul_comm] using @div_mk_div_cancel_left 1 1 _ n0

protected

instance : decidable_eq ℚ := by tactic.mk_dec_eq_instance

/-! At this point in the import hierarchy we have not defined the `field` typeclass.
Instead we'll instantiate `comm_ring` and `comm_group_with_zero` at this point.
The `rat.field` instance and any field-specific lemmas can be found in `data.rat.basic`.
-/

instance : comm_ring ℚ :=
{ zero             := 0,
  add              := (+),
  neg              := has_neg.neg,
  one              := 1,
  mul              := (*),
  zero_add         := rat.zero_add,
  add_zero         := rat.add_zero,
  add_comm         := rat.add_comm,
  add_assoc        := rat.add_assoc,
  add_left_neg     := rat.add_left_neg,
  mul_one          := rat.mul_one,
  one_mul          := rat.one_mul,
  mul_comm         := rat.mul_comm,
  mul_assoc        := rat.mul_assoc,
  left_distrib     := rat.mul_add,
  right_distrib    := rat.add_mul,
  int_cast         := coe,
  /- Important: We do not set `nat_cast := λ n, ((n : ℤ) : ℚ)` (even though it's defeq) as that
  makes `int.cast_coe_nat` and `coe_coe` loop in `simp`. -/
  nat_cast         := λ n, of_int n,
  nat_cast_zero    := rfl,
  nat_cast_succ    := λ n, by simp only [of_int_eq_cast, coe_int_eq_mk,
    add_def one_ne_zero one_ne_zero, ← mk_one_one, nat.cast_add, nat.cast_one, mul_one] }

instance : comm_group_with_zero ℚ :=
{ zero := 0,
  one := 1,
  mul := (*),
  inv := has_inv.inv,
  div := (/),
  exists_pair_ne   := ⟨0, 1, rat.zero_ne_one⟩,
  inv_zero := rfl,
  mul_inv_cancel := rat.mul_inv_cancel,
  mul_zero := mul_zero,
  zero_mul := zero_mul,
  .. rat.comm_ring }

instance : is_domain ℚ :=
no_zero_divisors.to_is_domain _

/- Extra instances to short-circuit type class resolution -/
-- TODO(Mario): this instance slows down data.real.basic
instance : nontrivial ℚ         := by apply_instance
--instance : ring ℚ             := by apply_instance
instance : comm_semiring ℚ      := by apply_instance
instance : semiring ℚ           := by apply_instance
instance : add_comm_group ℚ     := by apply_instance
instance : add_group ℚ          := by apply_instance
instance : add_comm_monoid ℚ    := by apply_instance
instance : add_monoid ℚ         := by apply_instance
instance : add_left_cancel_semigroup ℚ := by apply_instance
instance : add_right_cancel_semigroup ℚ := by apply_instance
instance : add_comm_semigroup ℚ := by apply_instance
instance : add_semigroup ℚ      := by apply_instance
instance : comm_monoid ℚ        := by apply_instance
instance : monoid ℚ             := by apply_instance
instance : comm_semigroup ℚ     := by apply_instance
instance : semigroup ℚ          := by apply_instance

lemma denom_ne_zero (q : ℚ) : q.denom ≠ 0 :=
ne_of_gt q.pos

lemma eq_iff_mul_eq_mul {p q : ℚ} : p = q ↔ p.num * q.denom = q.num * p.denom :=
begin
  conv { to_lhs, rw [← @num_denom p, ← @num_denom q] },
  apply rat.mk_eq;
  { rw [← nat.cast_zero, ne, int.coe_nat_eq_coe_nat_iff],
    apply denom_ne_zero, },
end

theorem sub_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
  a /. b - c /. d = (a * d - c * b) /. (b * d) :=
by simp [b0, d0, sub_eq_add_neg]

@[simp] lemma denom_neg_eq_denom (q : ℚ) : (-q).denom = q.denom := rfl

@[simp] lemma num_neg_eq_neg_num (q : ℚ) : (-q).num = -(q.num) := rfl

@[simp] lemma num_zero : rat.num 0 = 0 := rfl

@[simp] lemma denom_zero : rat.denom 0 = 1 := rfl

lemma zero_of_num_zero {q : ℚ} (hq : q.num = 0) : q = 0 :=
have q = q.num /. q.denom, from num_denom.symm,
by simpa [hq]

lemma zero_iff_num_zero {q : ℚ} : q = 0 ↔ q.num = 0 :=
⟨λ _, by simp *, zero_of_num_zero⟩

lemma num_ne_zero_of_ne_zero {q : ℚ} (h : q ≠ 0) : q.num ≠ 0 :=
assume : q.num = 0,
h $ zero_of_num_zero this

@[simp] lemma num_one : (1 : ℚ).num = 1 := rfl

@[simp] lemma denom_one : (1 : ℚ).denom = 1 := rfl

lemma mk_num_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : n ≠ 0 :=
assume : n = 0,
hq $ by simpa [this] using hqnd

lemma mk_denom_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : d ≠ 0 :=
assume : d = 0,
hq $ by simpa [this] using hqnd

lemma mk_ne_zero_of_ne_zero {n d : ℤ} (h : n ≠ 0) (hd : d ≠ 0) : n /. d ≠ 0 :=
(mk_ne_zero hd).mpr h

lemma mul_num_denom (q r : ℚ) : q * r = (q.num * r.num) /. ↑(q.denom * r.denom) :=
have hq' : (↑q.denom : ℤ) ≠ 0, by have := denom_ne_zero q; simpa,
have hr' : (↑r.denom : ℤ) ≠ 0, by have := denom_ne_zero r; simpa,
suffices (q.num /. ↑q.denom) * (r.num /. ↑r.denom) = (q.num * r.num) /. ↑(q.denom * r.denom),
  by simpa using this,
by simp [mul_def hq' hr', -num_denom]

lemma div_num_denom (q r : ℚ) : q / r = (q.num * r.denom) /. (q.denom * r.num) :=
if hr : r.num = 0 then
  have hr' : r = 0, from zero_of_num_zero hr,
  by simp *
else
  calc q / r = q * r⁻¹ : div_eq_mul_inv q r
         ... = (q.num /. q.denom) * (r.num /. r.denom)⁻¹ : by simp
         ... = (q.num /. q.denom) * (r.denom /. r.num) : by rw inv_def
         ... = (q.num * r.denom) /. (q.denom * r.num) : mul_def (by simpa using denom_ne_zero q) hr

section casts

protected lemma add_mk (a b c : ℤ) : (a + b) /. c = a /. c + b /. c :=
if h : c = 0 then by simp [h] else
by { rw [add_def h h, mk_eq h (mul_ne_zero h h)], simp [add_mul, mul_assoc] }

theorem mk_eq_div (n d : ℤ) : n /. d = ((n : ℚ) / d) :=
begin
  by_cases d0 : d = 0, {simp [d0, div_zero]},
  simp [division_def, coe_int_eq_mk, mul_def one_ne_zero d0]
end

lemma mk_mul_mk_cancel {x : ℤ} (hx : x ≠ 0) (n d : ℤ) : (n /. x) * (x /. d) = n /. d :=
begin
  by_cases hd : d = 0,
  { rw hd,
    simp},
  rw [mul_def hx hd, mul_comm x, div_mk_div_cancel_left hx],
end

lemma mk_div_mk_cancel_left {x : ℤ} (hx : x ≠ 0) (n d : ℤ) : (n /. x) / (d /. x) = n /. d :=
by rw [div_eq_mul_inv, inv_def, mk_mul_mk_cancel hx]

lemma mk_div_mk_cancel_right {x : ℤ} (hx : x ≠ 0) (n d : ℤ) : (x /. n) / (x /. d) = d /. n :=
by rw [div_eq_mul_inv, inv_def, mul_comm, mk_mul_mk_cancel hx]

lemma coe_int_div_eq_mk {n d : ℤ} : (n : ℚ) / ↑d = n /. d :=
begin
  repeat {rw coe_int_eq_mk},
  exact mk_div_mk_cancel_left one_ne_zero n d,
end

@[simp]
theorem num_div_denom (r : ℚ) : (r.num / r.denom : ℚ) = r :=
by rw [← int.cast_coe_nat, ← mk_eq_div, num_denom]

lemma coe_int_num_of_denom_eq_one {q : ℚ} (hq : q.denom = 1) : ↑(q.num) = q :=
by { conv_rhs { rw [←(@num_denom q), hq] }, rw [coe_int_eq_mk], refl }

lemma denom_eq_one_iff (r : ℚ) : r.denom = 1 ↔ ↑r.num = r :=
⟨rat.coe_int_num_of_denom_eq_one, λ h, h ▸ rat.coe_int_denom r.num⟩

instance can_lift : can_lift ℚ ℤ coe (λ q, q.denom = 1) :=
⟨λ q hq, ⟨q.num, coe_int_num_of_denom_eq_one hq⟩⟩

theorem coe_nat_eq_mk (n : ℕ) : ↑n = n /. 1 :=
by rw [← int.cast_coe_nat, coe_int_eq_mk]

@[simp, norm_cast] theorem coe_nat_num (n : ℕ) : (n : ℚ).num = n :=
by rw [← int.cast_coe_nat, coe_int_num]

@[simp, norm_cast] theorem coe_nat_denom (n : ℕ) : (n : ℚ).denom = 1 :=
by rw [← int.cast_coe_nat, coe_int_denom]

-- Will be subsumed by `int.coe_inj` after we have defined
-- `linear_ordered_field ℚ` (which implies characteristic zero).
lemma coe_int_inj (m n : ℤ) : (m : ℚ) = n ↔ m = n := ⟨congr_arg num, congr_arg _⟩

end casts

end rat

-- Guard against import creep.
assert_not_exists field


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_48
  (q e : ℂ)
  (h₀ : q = 9 - 4 * complex.I)
  (h₁ : e = -3 - 4 * complex.I) : q - e = 12 :=
begin
  rw [h₀, h₁],
  ring,
end


/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import topology.order.lattice
import analysis.normed.group.basic
import algebra.order.lattice_group

/-!
# Normed lattice ordered groups

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

Motivated by the theory of Banach Lattices, we then define `normed_lattice_add_comm_group` as a
lattice with a covariant normed group addition satisfying the solid axiom.

## Main statements

We show that a normed lattice ordered group is a topological lattice with respect to the norm
topology.

## References

* [Meyer-Nieberg, Banach lattices][MeyerNieberg1991]

## Tags

normed, lattice, ordered, group
-/

/-!
### Normed lattice orderd groups

Motivated by the theory of Banach Lattices, this section introduces normed lattice ordered groups.
-/

local notation (name := abs) `|`a`|` := abs a

/--
Let `α` be a normed commutative group equipped with a partial order covariant with addition, with
respect which `α` forms a lattice. Suppose that `α` is *solid*, that is to say, for `a` and `b` in
`α`, with absolute values `|a|` and `|b|` respectively, `|a| ≤ |b|` implies `‖a‖ ≤ ‖b‖`. Then `α` is
said to be a normed lattice ordered group.
-/
class normed_lattice_add_comm_group (α : Type*)
  extends normed_add_comm_group α, lattice α :=
(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b)
(solid : ∀ a b : α, |a| ≤ |b| → ‖a‖ ≤ ‖b‖)

lemma solid {α : Type*} [normed_lattice_add_comm_group α] {a b : α} (h : |a| ≤ |b|) : ‖a‖ ≤ ‖b‖ :=
normed_lattice_add_comm_group.solid a b h

instance : normed_lattice_add_comm_group ℝ :=
{ add_le_add_left := λ _ _ h _, add_le_add le_rfl h,
  solid := λ _ _, id, }

/--
A normed lattice ordered group is an ordered additive commutative group
-/
@[priority 100] -- see Note [lower instance priority]
instance normed_lattice_add_comm_group_to_ordered_add_comm_group {α : Type*}
  [h : normed_lattice_add_comm_group α] : ordered_add_comm_group α := { ..h }

variables {α : Type*} [normed_lattice_add_comm_group α]
open lattice_ordered_comm_group

lemma dual_solid (a b : α) (h: b⊓-b ≤ a⊓-a) : ‖a‖ ≤ ‖b‖ :=
begin
  apply solid,
  rw abs_eq_sup_neg,
  nth_rewrite 0 ← neg_neg a,
  rw ← neg_inf_eq_sup_neg,
  rw abs_eq_sup_neg,
  nth_rewrite 0 ← neg_neg b,
  rwa [← neg_inf_eq_sup_neg, neg_le_neg_iff, @inf_comm _ _ _ b, @inf_comm _ _ _ a],
end

/--
Let `α` be a normed lattice ordered group, then the order dual is also a
normed lattice ordered group.
-/
@[priority 100] -- see Note [lower instance priority]
instance : normed_lattice_add_comm_group αᵒᵈ :=
{ solid := dual_solid,
  ..order_dual.ordered_add_comm_group, ..order_dual.normed_add_comm_group }

lemma norm_abs_eq_norm (a : α) : ‖|a|‖ = ‖a‖ :=
(solid (abs_abs a).le).antisymm (solid (abs_abs a).symm.le)

lemma norm_inf_sub_inf_le_add_norm (a b c d : α) : ‖a ⊓ b - c ⊓ d‖ ≤ ‖a - c‖ + ‖b - d‖ :=
begin
  rw [← norm_abs_eq_norm (a - c), ← norm_abs_eq_norm (b - d)],
  refine le_trans (solid _) (norm_add_le (|a - c|) (|b - d|)),
  rw abs_of_nonneg (|a - c| + |b - d|) (add_nonneg (abs_nonneg (a - c)) (abs_nonneg (b - d))),
  calc |a ⊓ b - c ⊓ d| =
    |a ⊓ b - c ⊓ b + (c ⊓ b - c ⊓ d)| : by rw sub_add_sub_cancel
  ... ≤ |a ⊓ b - c ⊓ b| + |c ⊓ b - c ⊓ d| : abs_add_le _ _
  ... ≤ |a -c| + |b - d| : by
    { apply add_le_add,
      { exact abs_inf_sub_inf_le_abs _ _ _, },
      { rw [@inf_comm _ _ c, @inf_comm _ _ c],
        exact abs_inf_sub_inf_le_abs _ _ _, } },
end

lemma norm_sup_sub_sup_le_add_norm (a b c d : α) : ‖a ⊔ b - (c ⊔ d)‖ ≤ ‖a - c‖ + ‖b - d‖ :=
begin
  rw [← norm_abs_eq_norm (a - c), ← norm_abs_eq_norm (b - d)],
  refine le_trans (solid _) (norm_add_le (|a - c|) (|b - d|)),
  rw abs_of_nonneg (|a - c| + |b - d|) (add_nonneg (abs_nonneg (a - c)) (abs_nonneg (b - d))),
  calc |a ⊔ b - (c ⊔ d)| =
    |a ⊔ b - (c ⊔ b) + (c ⊔ b - (c ⊔ d))| : by rw sub_add_sub_cancel
  ... ≤ |a ⊔ b - (c ⊔ b)| + |c ⊔ b - (c ⊔ d)| : abs_add_le _ _
  ... ≤ |a -c| + |b - d| : by
    { apply add_le_add,
      { exact abs_sup_sub_sup_le_abs _ _ _, },
      { rw [@sup_comm _ _ c, @sup_comm _ _ c],
        exact abs_sup_sub_sup_le_abs _ _ _, } },
end

lemma norm_inf_le_add (x y : α) : ‖x ⊓ y‖ ≤ ‖x‖ + ‖y‖ :=
begin
  have h : ‖x ⊓ y - 0 ⊓ 0‖ ≤ ‖x - 0‖ + ‖y - 0‖ := norm_inf_sub_inf_le_add_norm x y 0 0,
  simpa only [inf_idem, sub_zero] using h,
end

lemma norm_sup_le_add (x y : α) : ‖x ⊔ y‖ ≤ ‖x‖ + ‖y‖ :=
begin
  have h : ‖x ⊔ y - 0 ⊔ 0‖ ≤ ‖x - 0‖ + ‖y - 0‖ := norm_sup_sub_sup_le_add_norm x y 0 0,
  simpa only [sup_idem, sub_zero] using h,
end

/--
Let `α` be a normed lattice ordered group. Then the infimum is jointly continuous.
-/
@[priority 100] -- see Note [lower instance priority]
instance normed_lattice_add_comm_group_has_continuous_inf : has_continuous_inf α :=
begin
  refine ⟨continuous_iff_continuous_at.2 $ λ q, tendsto_iff_norm_tendsto_zero.2 $ _⟩,
  have : ∀ p : α × α, ‖p.1 ⊓ p.2 - q.1 ⊓ q.2‖ ≤ ‖p.1 - q.1‖ + ‖p.2 - q.2‖,
    from λ _, norm_inf_sub_inf_le_add_norm _ _ _ _,
  refine squeeze_zero (λ e, norm_nonneg _) this _,
  convert (((continuous_fst.tendsto q).sub tendsto_const_nhds).norm).add
        (((continuous_snd.tendsto q).sub tendsto_const_nhds).norm),
  simp,
end

@[priority 100] -- see Note [lower instance priority]
instance normed_lattice_add_comm_group_has_continuous_sup {α : Type*}
  [normed_lattice_add_comm_group α] :
  has_continuous_sup α :=
order_dual.has_continuous_sup αᵒᵈ

/--
Let `α` be a normed lattice ordered group. Then `α` is a topological lattice in the norm topology.
-/
@[priority 100] -- see Note [lower instance priority]
instance normed_lattice_add_comm_group_topological_lattice : topological_lattice α :=
topological_lattice.mk

lemma norm_abs_sub_abs (a b : α) :
  ‖ |a| - |b| ‖ ≤ ‖a-b‖ :=
solid (lattice_ordered_comm_group.abs_abs_sub_abs_le _ _)

lemma norm_sup_sub_sup_le_norm (x y z : α) : ‖x ⊔ z - (y ⊔ z)‖ ≤ ‖x - y‖ :=
solid (abs_sup_sub_sup_le_abs x y z)

lemma norm_inf_sub_inf_le_norm (x y z : α) : ‖x ⊓ z - (y ⊓ z)‖ ≤ ‖x - y‖ :=
solid (abs_inf_sub_inf_le_abs x y z)

lemma lipschitz_with_sup_right (z : α) : lipschitz_with 1 (λ x, x ⊔ z) :=
lipschitz_with.of_dist_le_mul $ λ x y, by
{ rw [nonneg.coe_one, one_mul, dist_eq_norm, dist_eq_norm], exact norm_sup_sub_sup_le_norm x y z, }

lemma lipschitz_with_pos : lipschitz_with 1 (has_pos_part.pos : α → α) :=
lipschitz_with_sup_right 0

lemma continuous_pos : continuous (has_pos_part.pos : α → α) :=
lipschitz_with.continuous lipschitz_with_pos

lemma continuous_neg' : continuous (has_neg_part.neg : α → α) :=
continuous_pos.comp continuous_neg

lemma is_closed_nonneg {E} [normed_lattice_add_comm_group E] : is_closed {x : E | 0 ≤ x} :=
begin
  suffices : {x : E | 0 ≤ x} = has_neg_part.neg ⁻¹' {(0 : E)},
  by { rw this, exact is_closed.preimage continuous_neg' is_closed_singleton, },
  ext1 x,
  simp only [set.mem_preimage, set.mem_singleton_iff, set.mem_set_of_eq, neg_eq_zero_iff],
end

lemma is_closed_le_of_is_closed_nonneg {G} [ordered_add_comm_group G] [topological_space G]
  [has_continuous_sub G] (h : is_closed {x : G | 0 ≤ x}) :
  is_closed {p : G × G | p.fst ≤ p.snd} :=
begin
  have : {p : G × G | p.fst ≤ p.snd} = (λ p : G × G, p.snd - p.fst) ⁻¹' {x : G | 0 ≤ x},
    by { ext1 p, simp only [sub_nonneg, set.preimage_set_of_eq], },
  rw this,
  exact is_closed.preimage (continuous_snd.sub continuous_fst) h,
end

@[priority 100]  -- See note [lower instance priority]
instance normed_lattice_add_comm_group.order_closed_topology {E} [normed_lattice_add_comm_group E] :
  order_closed_topology E :=
⟨is_closed_le_of_is_closed_nonneg is_closed_nonneg⟩


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.extreme

open_locale classical affine big_operators
open set
--TODO: Generalise to LCTVS
variables {E : Type*} [normed_group E] [normed_space ℝ E] {x y : E} {A B : set E}

namespace affine

def intrinsic_interior (A : set E) :
  set E :=
{x ∈ A | ∃ (ι : Type*) (s : finset ι) (w : ι → ℝ) (z : ι → E) (hs : A ⊆ affine_span ℝ (z '' s))
  (hw₀ : ∀ i ∈ s, 0 < w i) (hw₁ : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, z i ∈ A),
  s.center_mass w z = x}

def intrinsic_frontier (A : set E) :
  set E :=
{x ∈ A | ∀ (ι : Type*) (s : finset ι) (w : ι → ℝ) (z : ι → E) (hs : A ⊆ affine_span ℝ (z '' s))
  (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, z i ∈ A)
  (hx : s.center_mass w z = x), ∃ i : ι, w i = 0}

lemma intrinsic_interior_subset (A : set E) :
  intrinsic_interior A ⊆ A :=
λ x hx, hx.1

lemma intrinsic_frontier_subset (A : set E) :
  intrinsic_frontier A ⊆ A :=
λ x hx, hx.1

lemma convex.open_segment_subset_intrinsic_interior_of_mem_left (hA : convex A)
  (x ∈ intrinsic_interior A) (y ∈ A) :
  open_segment x y ⊆ intrinsic_interior A :=
begin
  rintro z hz,
  split,
  {
    sorry -- hA
  },
  dsimp,
  --obtain ⟨x₁, x₂, hx₁, hx₂, x, ⟨hxA, ι, t, hw₀, hw₁, hyA, hy⟩, hx⟩ := sorry,
  sorry
end

lemma eq_intrinsic_interior_union_intrinsic_frontier :
  A = intrinsic_interior A ∪ intrinsic_frontier A := sorry

lemma intrinsic_frontier.is_extreme :
  is_extreme A (intrinsic_frontier A) :=
begin
  use intrinsic_frontier_subset _,
  rintro x₁ x₂ hx₁ hx₂ x hxA hx,
  sorry
end

/-def intrinsic_interior (A : set E) :
  set E :=
{x ∈ A | ∀ y ∈ A, ∃ z ∈ A, x ∈ open_segment y z}

def intrinsic_frontier (A : set E) :
  set E :=
{x ∈ A | ∃ y ∈ A, ∀ z ∈ A, x ∉ open_segment y z}

lemma intrinsic_interior_subset (A : set E) :
  intrinsic_interior A ⊆ A :=
λ x hx, hx.1

lemma intrinsic_frontier_subset (A : set E) :
  intrinsic_frontier A ⊆ A :=
λ x hx, hx.1

lemma intrinsic_frontier.is_extreme :
  is_extreme A (intrinsic_frontier A) :=
begin
  use intrinsic_frontier_subset _,
  rintro x₁ x₂ hx₁ hx₂ x ⟨hxA, y, hyA, hy⟩ hx,
  split,
  {
    use [hx₁, y, hyA],
    rintro z hz,
  }
end-/

/-
def intrinsic_frontier (A : set E) :
  set E :=
coe '' (frontier {x : affine_span ℝ A | ↑x ∈ A})

def intrinsic_interior (A : set E) :
  set E :=
coe '' (interior {x : affine_span ℝ A | ↑x ∈ A})

def intrinsic_closure (A : set E) :
  set E :=
coe '' (closure {x : affine_span ℝ A | ↑x ∈ A})

lemma intrinsic_frontier_empty :
  intrinsic_frontier (∅ : set E) = ∅ :=
begin
  apply subset_empty_iff.1,
  rintro x ⟨x', hx', hxx'⟩,
  simp at hx',
  exact hx',
end

lemma intrinsic_interior_empty :
  intrinsic_frontier (∅ : set E) = ∅ :=
begin
  apply subset_empty_iff.1,
  rintro x ⟨x', hx', hxx'⟩,
  simp at hx',
  exact hx',
end

lemma nonempty_intrinsic_interior (hA : A.nonempty) :
  (intrinsic_interior A).nonempty :=
begin

end

lemma coe_closure_subset_closure_aux (B : set E) :
  coe '' closure {x : affine_span ℝ A | ↑x ∈ B} ⊆ closure B :=
begin
  rintro _ ⟨x, hx, rfl⟩,
  rw mem_closure_iff_seq_limit at ⊢ hx,
  obtain ⟨f, hfB, hflim⟩ := hx,
  exact ⟨λ y, f y, hfB, by rwa ←embedding.tendsto_nhds_iff embedding_subtype_coe⟩,
end

lemma closure_eq_intrinsic_closure :
  closure A = coe '' (closure {x : affine_span ℝ A | ↑x ∈ A}) :=
begin
  refine subset.antisymm _ (coe_closure_subset_closure_aux A),
  rintro x hxA,
  rw mem_closure_iff_seq_limit at hxA,
  obtain ⟨f, hfA, hflim⟩ := hxA,
  simp_rw [mem_image, closure_induced],
  split,
  sorry,
  sorry,
end

lemma closure_eq_intrinsic_interior_union_intrinsic_frontier :
  closure A = intrinsic_interior A ∪ intrinsic_frontier A :=
begin
  ext x,
  rw [closure_eq_intrinsic_closure, closure_eq_interior_union_frontier],
  split,
  { rintro ⟨x', (hx' | hx'), rfl⟩,
    { left,
      exact ⟨x', hx', rfl⟩ },
    right,
    exact ⟨x', hx', rfl⟩ },
  rintro (⟨x', hx', rfl⟩ | ⟨x', hx', rfl⟩),
  exacts [⟨x', by {left, exact hx'}, rfl⟩, ⟨x', by {right, exact hx'}, rfl⟩],
end

lemma intrinsic_interior_subset_closure :
  intrinsic_interior A ⊆ closure A :=
begin
  rw closure_eq_intrinsic_interior_union_intrinsic_frontier,
  exact subset_union_left _ _,
end

lemma intrinsic_frontier_subset_closure :
  intrinsic_frontier A ⊆ closure A :=
begin
  rw closure_eq_intrinsic_interior_union_intrinsic_frontier,
  exact subset_union_right _ _,
end

lemma disjoint_intrinsic_interior_intrinsic_frontier :
  disjoint (intrinsic_interior A) (intrinsic_frontier A) :=
begin
  rintro x ⟨⟨x₁, hx₁, rfl⟩, x₂, hx₂, hx₁x₂⟩,
  rw subtype.ext hx₁x₂ at hx₂,
  exact hx₂.2 hx₁,
end

lemma intrinsic_frontier_eq_closure_diff_intrinsic_interior :
  intrinsic_frontier A = closure A \ intrinsic_interior A :=
by rw [closure_eq_intrinsic_interior_union_intrinsic_frontier,
  set.union_diff_cancel_left disjoint_intrinsic_interior_intrinsic_frontier]

lemma intrinsic_interior_eq_closure_diff_intrinsic_frontier :
  intrinsic_interior A = closure A \ intrinsic_frontier A :=
by rw [intrinsic_frontier_eq_closure_diff_intrinsic_interior, diff_diff_right, diff_self,
  empty_union, inter_eq_self_of_subset_right intrinsic_interior_subset_closure]

lemma intrinsic_frontier_subset_frontier :
  intrinsic_frontier A ⊆ frontier A :=
begin
  rintro x hx,
  unfold intrinsic_frontier at hx,
  rw frontier_eq_closure_inter_closure at ⊢ hx,
  obtain ⟨x', hx', rfl⟩ := hx,
  exact ⟨coe_closure_subset_closure_aux _ ⟨x', hx'.1, rfl⟩, coe_closure_subset_closure_aux Aᶜ
    ⟨x', hx'.2, rfl⟩⟩,
end

lemma interior_subset_intrinsic_interior :
  interior A ⊆ intrinsic_interior A :=
begin
  rw [interior_eq_closure_diff_frontier, intrinsic_interior_eq_closure_diff_intrinsic_frontier],
  exact diff_subset_diff_right intrinsic_frontier_subset_frontier,
end

--rewrite the condition to something about dimension?
lemma intrinsic_frontier_eq_frontier (hA : affine_span ℝ A = ⊤) :
  intrinsic_frontier A = frontier A :=
begin
  apply subset.antisymm intrinsic_frontier_subset_frontier,
  rintro x hx,
  have hxA : x ∈ affine_span ℝ A,
  {
    rw hA,
    sorry,
  },
  refine ⟨⟨x, hxA⟩, _, rfl⟩,
  sorry
end

lemma intrinsic_frontier_convex_hull_eq (hA : affine_independent ℝ (λ p, p : A → E)) :
  intrinsic_frontier (convex_hull A) = ⋃ B ⊂ A, convex_hull B :=
begin
  sorry --damn hard
end-/

end affine


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

! This file was ported from Lean 3 source module linear_algebra.dfinsupp
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finsupp.ToDfinsupp
import Mathlib.LinearAlgebra.Basis

/-!
# Properties of the module `Π₀ i, M i`

Given an indexed collection of `R`-modules `M i`, the `R`-module structure on `Π₀ i, M i`
is defined in `Data.Dfinsupp`.

In this file we define `LinearMap` versions of various maps:

* `Dfinsupp.lsingle a : M →ₗ[R] Π₀ i, M i`: `Dfinsupp.single a` as a linear map;

* `Dfinsupp.lmk s : (Π i : (↑s : set ι), M i) →ₗ[R] Π₀ i, M i`: `Dfinsupp.single a` as a linear map;

* `Dfinsupp.lapply i : (Π₀ i, M i) →ₗ[R] M`: the map `fun f ↦ f i` as a linear map;

* `Dfinsupp.lsum`: `Dfinsupp.sum` or `Dfinsupp.liftAddHom` as a `LinearMap`;

## Implementation notes

This file should try to mirror `LinearAlgebra.Finsupp` where possible. The API of `Finsupp` is
much more developed, but many lemmas in that file should be eligible to copy over.

## Tags

function with finite support, module, linear algebra
-/

-- Porting note: TODO Erase this line. Workaround for lean4#2074.
attribute [-instance] Ring.toNonAssocRing

variable {ι : Type _} {R : Type _} {S : Type _} {M : ι → Type _} {N : Type _}

variable [dec_ι : DecidableEq ι]

namespace Dfinsupp

variable [Semiring R] [∀ i, AddCommMonoid (M i)] [∀ i, Module R (M i)]

variable [AddCommMonoid N] [Module R N]

/-- `Dfinsupp.mk` as a `LinearMap`. -/
def lmk (s : Finset ι) : (∀ i : (↑s : Set ι), M i) →ₗ[R] Π₀ i, M i
    where
  toFun := mk s
  map_add' _ _ := mk_add
  map_smul' c x := mk_smul c x
#align dfinsupp.lmk Dfinsupp.lmk

/-- `Dfinsupp.single` as a `LinearMap` -/
def lsingle (i) : M i →ₗ[R] Π₀ i, M i :=
  { Dfinsupp.singleAddHom _ _ with
    toFun := single i
    map_smul' := single_smul }
#align dfinsupp.lsingle Dfinsupp.lsingle

/-- Two `R`-linear maps from `Π₀ i, M i` which agree on each `single i x` agree everywhere. -/

/-- Two `R`-linear maps from `Π₀ i, M i` which agree on each `single i x` agree everywhere.

See note [partially-applied ext lemmas].
After apply this lemma, if `M = R` then it suffices to verify `φ (single a 1) = ψ (single a 1)`. -/
@[ext]
theorem lhom_ext' ⦃φ ψ : (Π₀ i, M i) →ₗ[R] N⦄ (h : ∀ i, φ.comp (lsingle i) = ψ.comp (lsingle i)) :
    φ = ψ :=
  lhom_ext fun i => LinearMap.congr_fun (h i)
#align dfinsupp.lhom_ext' Dfinsupp.lhom_ext'

/-- Interpret `fun (f : Π₀ i, M i) ↦ f i` as a linear map. -/
def lapply (i : ι) : (Π₀ i, M i) →ₗ[R] M i
    where
  toFun f := f i
  map_add' f g := add_apply f g i
  map_smul' c f := smul_apply c f i
#align dfinsupp.lapply Dfinsupp.lapply

@[simp]
theorem lmk_apply (s : Finset ι) (x) : (lmk s : _ →ₗ[R] Π₀ i, M i) x = mk s x :=
  rfl
#align dfinsupp.lmk_apply Dfinsupp.lmk_apply

@[simp]
theorem lsingle_apply (i : ι) (x : M i) : (lsingle i : (M i) →ₗ[R] _) x = single i x :=
  rfl
#align dfinsupp.lsingle_apply Dfinsupp.lsingle_apply

@[simp]
theorem lapply_apply (i : ι) (f : Π₀ i, M i) : (lapply i : (Π₀ i, M i) →ₗ[R] _) f = f i :=
  rfl
#align dfinsupp.lapply_apply Dfinsupp.lapply_apply

section Lsum

-- Porting note: Unclear how true these docstrings are in lean 4
/-- Typeclass inference can't find `Dfinsupp.addCommMonoid` without help for this case.
This instance allows it to be found where it is needed on the LHS of the colon in
`Dfinsupp.moduleOfLinearMap`. -/
instance addCommMonoidOfLinearMap : AddCommMonoid (Π₀ i : ι, M i →ₗ[R] N) :=
  inferInstance
#align dfinsupp.add_comm_monoid_of_linear_map Dfinsupp.addCommMonoidOfLinearMap

/-- Typeclass inference can't find `Dfinsupp.module` without help for this case.
This is needed to define `Dfinsupp.lsum` below.

The cause seems to be an inability to unify the `∀ i, AddCommMonoid (M i →ₗ[R] N)` instance that
we have with the `∀ i, Zero (M i →ₗ[R] N)` instance which appears as a parameter to the
`Dfinsupp` type. -/
instance moduleOfLinearMap [Semiring S] [Module S N] [SMulCommClass R S N] :
    Module S (Π₀ i : ι, M i →ₗ[R] N) :=
  Dfinsupp.module
#align dfinsupp.module_of_linear_map Dfinsupp.moduleOfLinearMap

variable (S)

instance {R : Type _} {S : Type _} [Semiring R] [Semiring S] (σ : R →+* S)
  {σ' : S →+* R} [RingHomInvPair σ σ'] [RingHomInvPair σ' σ] (M : Type _) (M₂ : Type _)
  [AddCommMonoid M] [AddCommMonoid M₂] [Module R M] [Module S M₂] :
      EquivLike (LinearEquiv σ M M₂) M M₂ :=
  inferInstance

/- Porting note: In every application of lsum that follows, the argument M needs to be explicitly
supplied, lean does not manage to gather that information itself -/
/-- The `Dfinsupp` version of `Finsupp.lsum`.

See note [bundled maps over different rings] for why separate `R` and `S` semirings are used. -/
@[simps]
def lsum [Semiring S] [Module S N] [SMulCommClass R S N] :
    (∀ i, M i →ₗ[R] N) ≃ₗ[S] (Π₀ i, M i) →ₗ[R] N
    where
  toFun F :=
    { toFun := sumAddHom fun i => (F i).toAddMonoidHom
      -- Porting note: needed to (β := M) hint below
      map_add' := (Dfinsupp.liftAddHom (β := M) (fun (i : ι) => (F i).toAddMonoidHom)).map_add
      map_smul' := fun c f => by
        dsimp
        apply Dfinsupp.induction f
        · rw [smul_zero, AddMonoidHom.map_zero, smul_zero]
        · intro a b f _ _ hf
          rw [smul_add, AddMonoidHom.map_add, AddMonoidHom.map_add, smul_add, hf, ← single_smul,
            sumAddHom_single, sumAddHom_single, LinearMap.toAddMonoidHom_coe,
            LinearMap.map_smul] }
  invFun F i := F.comp (lsingle i)
  left_inv F := by
    ext
    simp
  right_inv F := by
    refine Dfinsupp.lhom_ext' (fun i ↦ ?_)
    ext
    simp
  map_add' F G := by
    refine Dfinsupp.lhom_ext' (fun i ↦ ?_)
    ext
    simp
  map_smul' c F := by
    refine Dfinsupp.lhom_ext' (fun i ↦ ?_)
    ext
    simp
#align dfinsupp.lsum Dfinsupp.lsum

/-- While `simp` can prove this, it is often convenient to avoid unfolding `lsum` into `sumAddHom`
with `Dfinsupp.lsum_apply_apply`. -/
theorem lsum_single [Semiring S] [Module S N] [SMulCommClass R S N] (F : ∀ i, M i →ₗ[R] N) (i)
    (x : M i) : lsum S (M := M) F (single i x) = F i x := by
  simp
#align dfinsupp.lsum_single Dfinsupp.lsum_single

end Lsum

/-! ### Bundled versions of `Dfinsupp.mapRange`

The names should match the equivalent bundled `Finsupp.mapRange` definitions.
-/

section mapRange

variable {β β₁ β₂ : ι → Type _}

variable [∀ i, AddCommMonoid (β i)] [∀ i, AddCommMonoid (β₁ i)] [∀ i, AddCommMonoid (β₂ i)]

variable [∀ i, Module R (β i)] [∀ i, Module R (β₁ i)] [∀ i, Module R (β₂ i)]

theorem mapRange_smul (f : ∀ i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0) (r : R)
    (hf' : ∀ i x, f i (r • x) = r • f i x) (g : Π₀ i, β₁ i) :
    mapRange f hf (r • g) = r • mapRange f hf g := by
  ext
  simp only [mapRange_apply f, coe_smul, Pi.smul_apply, hf']
#align dfinsupp.map_range_smul Dfinsupp.mapRange_smul

/-- `Dfinsupp.mapRange` as a `LinearMap`. -/
@[simps! apply]
def mapRange.linearMap (f : ∀ i, β₁ i →ₗ[R] β₂ i) : (Π₀ i, β₁ i) →ₗ[R] Π₀ i, β₂ i :=
  {
    mapRange.addMonoidHom fun i =>
      (f i).toAddMonoidHom with
    toFun := mapRange (fun i x => f i x) fun i => (f i).map_zero
    map_smul' := fun r => mapRange_smul _ (fun i => (f i).map_zero) _ fun i => (f i).map_smul r }
#align dfinsupp.map_range.linear_map Dfinsupp.mapRange.linearMap

@[simp]
theorem mapRange.linearMap_id :
    (mapRange.linearMap fun i => (LinearMap.id : β₂ i →ₗ[R] _)) = LinearMap.id := by
  ext
  simp [linearMap]
#align dfinsupp.map_range.linear_map_id Dfinsupp.mapRange.linearMap_id

theorem mapRange.linearMap_comp (f : ∀ i, β₁ i →ₗ[R] β₂ i) (f₂ : ∀ i, β i →ₗ[R] β₁ i) :
    (mapRange.linearMap fun i => (f i).comp (f₂ i)) =
      (mapRange.linearMap f).comp (mapRange.linearMap f₂) :=
  LinearMap.ext <| mapRange_comp (fun i x => f i x) (fun i x => f₂ i x)
    (fun i => (f i).map_zero) (fun i => (f₂ i).map_zero) (by simp)
#align dfinsupp.map_range.linear_map_comp Dfinsupp.mapRange.linearMap_comp

theorem sum_mapRange_index.linearMap [∀ (i : ι) (x : β₁ i), Decidable (x ≠ 0)]
    [∀ (i : ι) (x : β₂ i), Decidable (x ≠ 0)] {f : ∀ i, β₁ i →ₗ[R] β₂ i} {h : ∀ i, β₂ i →ₗ[R] N}
    {l : Π₀ i, β₁ i} :
    -- Porting note: Needed to add (M := ...) below
    (Dfinsupp.lsum ℕ (M := β₂)) h (mapRange.linearMap f l)
      = (Dfinsupp.lsum ℕ (M := β₁)) (fun i => (h i).comp (f i)) l  := by
  simpa [Dfinsupp.sumAddHom_apply] using sum_mapRange_index fun i => by simp
#align dfinsupp.sum_map_range_index.linear_map Dfinsupp.sum_mapRange_index.linearMap

/-- `Dfinsupp.mapRange.linearMap` as a `LinearEquiv`. -/
@[simps apply]
def mapRange.linearEquiv (e : ∀ i, β₁ i ≃ₗ[R] β₂ i) : (Π₀ i, β₁ i) ≃ₗ[R] Π₀ i, β₂ i :=
  { mapRange.addEquiv fun i => (e i).toAddEquiv,
    mapRange.linearMap fun i =>
      (e i).toLinearMap with
    toFun := mapRange (fun i x => e i x) fun i => (e i).map_zero
    invFun := mapRange (fun i x => (e i).symm x) fun i => (e i).symm.map_zero }
#align dfinsupp.map_range.linear_equiv Dfinsupp.mapRange.linearEquiv

@[simp]
theorem mapRange.linearEquiv_refl :
    (mapRange.linearEquiv fun i => LinearEquiv.refl R (β₁ i)) = LinearEquiv.refl _ _ :=
  LinearEquiv.ext mapRange_id
#align dfinsupp.map_range.linear_equiv_refl Dfinsupp.mapRange.linearEquiv_refl

theorem mapRange.linearEquiv_trans (f : ∀ i, β i ≃ₗ[R] β₁ i) (f₂ : ∀ i, β₁ i ≃ₗ[R] β₂ i) :
    (mapRange.linearEquiv fun i => (f i).trans (f₂ i)) =
      (mapRange.linearEquiv f).trans (mapRange.linearEquiv f₂) :=
  LinearEquiv.ext <| mapRange_comp (fun i x => f₂ i x) (fun i x => f i x)
    (fun i => (f₂ i).map_zero) (fun i => (f i).map_zero) (by simp)
#align dfinsupp.map_range.linear_equiv_trans Dfinsupp.mapRange.linearEquiv_trans

@[simp]
theorem mapRange.linearEquiv_symm (e : ∀ i, β₁ i ≃ₗ[R] β₂ i) :
    (mapRange.linearEquiv e).symm = mapRange.linearEquiv fun i => (e i).symm :=
  rfl
#align dfinsupp.map_range.linear_equiv_symm Dfinsupp.mapRange.linearEquiv_symm

end mapRange

section CoprodMap

variable [DecidableEq ι] [∀ x : N, Decidable (x ≠ 0)]

/-- Given a family of linear maps `f i : M i  →ₗ[R] N`, we can form a linear map
`(Π₀ i, M i) →ₗ[R] N` which sends `x : Π₀ i, M i` to the sum over `i` of `f i` applied to `x i`.
This is the map coming from the universal property of `Π₀ i, M i` as the coproduct of the `M i`.
See also `LinearMap.coprod` for the binary product version. -/
noncomputable def coprodMap (f : ∀ i : ι, M i →ₗ[R] N) : (Π₀ i, M i) →ₗ[R] N :=
  (Finsupp.lsum ℕ fun _ : ι => LinearMap.id) ∘ₗ
    (@finsuppLequivDfinsupp ι R N _ _ _ _ _).symm.toLinearMap ∘ₗ Dfinsupp.mapRange.linearMap f
#align dfinsupp.coprod_map Dfinsupp.coprodMap

theorem coprodMap_apply (f : ∀ i : ι, M i →ₗ[R] N) (x : Π₀ i, M i) :
    coprodMap f x =
      Finsupp.sum (mapRange (fun i => f i) (fun _ => LinearMap.map_zero _) x).toFinsupp fun _ =>
        id :=
  rfl
#align dfinsupp.coprod_map_apply Dfinsupp.coprodMap_apply

end CoprodMap

section Basis

/-- The direct sum of free modules is free.

Note that while this is stated for `Dfinsupp` not `direct_sum`, the types are defeq. -/
noncomputable def basis {η : ι → Type _} (b : ∀ i, Basis (η i) R (M i)) :
    Basis (Σi, η i) R (Π₀ i, M i) :=
  .ofRepr
    ((mapRange.linearEquiv fun i => (b i).repr).trans (sigmaFinsuppLequivDfinsupp R).symm)
#align dfinsupp.basis Dfinsupp.basis

end Basis

end Dfinsupp

namespace Submodule

variable [Semiring R] [AddCommMonoid N] [Module R N]

open Dfinsupp

theorem dfinsupp_sum_mem {β : ι → Type _} [∀ i, Zero (β i)] [∀ (i) (x : β i), Decidable (x ≠ 0)]
    (S : Submodule R N) (f : Π₀ i, β i) (g : ∀ i, β i → N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) :
    f.sum g ∈ S :=
  _root_.dfinsupp_sum_mem S f g h
#align submodule.dfinsupp_sum_mem Submodule.dfinsupp_sum_mem

theorem dfinsupp_sumAddHom_mem {β : ι → Type _} [∀ i, AddZeroClass (β i)] (S : Submodule R N)
    (f : Π₀ i, β i) (g : ∀ i, β i →+ N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) :
    Dfinsupp.sumAddHom g f ∈ S :=
  _root_.dfinsupp_sumAddHom_mem S f g h
#align submodule.dfinsupp_sum_add_hom_mem Submodule.dfinsupp_sumAddHom_mem

-- set_option pp.universes true
/-- The supremum of a family of submodules is equal to the range of `Dfinsupp.lsum`; that is
every element in the `supr` can be produced from taking a finite number of non-zero elements
of `p i`, coercing them to `N`, and summing them. -/
theorem supᵢ_eq_range_dfinsupp_lsum (p : ι → Submodule R N) :
    supᵢ p = LinearMap.range (Dfinsupp.lsum ℕ (M := fun i ↦ ↥(p i)) fun i => (p i).subtype) := by
  apply le_antisymm
  · apply supᵢ_le _
    intro i y hy
    simp only [LinearMap.mem_range, lsum_apply_apply]
    exact ⟨Dfinsupp.single i ⟨y, hy⟩, Dfinsupp.sumAddHom_single _ _ _⟩
  · rintro x ⟨v, rfl⟩
    exact dfinsupp_sumAddHom_mem _ v _ fun i _ => (le_supᵢ p i : p i ≤ _) (v i).2
#align submodule.supr_eq_range_dfinsupp_lsum Submodule.supᵢ_eq_range_dfinsupp_lsum

/-- The bounded supremum of a family of commutative additive submonoids is equal to the range of
`Dfinsupp.sumAddHom` composed with `Dfinsupp.filter_add_monoid_hom`; that is, every element in the
bounded `supr` can be produced from taking a finite number of non-zero elements from the `S i` that
satisfy `p i`, coercing them to `γ`, and summing them. -/
theorem bsupᵢ_eq_range_dfinsupp_lsum (p : ι → Prop) [DecidablePred p] (S : ι → Submodule R N) :
    (⨆ (i) (_h : p i), S i) =
      LinearMap.range
        (LinearMap.comp
          (Dfinsupp.lsum ℕ (M := fun i ↦ ↥(S i)) (fun i => (S i).subtype))
            (Dfinsupp.filterLinearMap R _ p)) := by
  apply le_antisymm
  · refine' supᵢ₂_le fun i hi y hy => ⟨Dfinsupp.single i ⟨y, hy⟩, _⟩
    rw [LinearMap.comp_apply, filterLinearMap_apply, filter_single_pos _ _ hi]
    simp only [lsum_apply_apply, sumAddHom_single, LinearMap.toAddMonoidHom_coe, coeSubtype]
  · rintro x ⟨v, rfl⟩
    refine' dfinsupp_sumAddHom_mem _ _ _ fun i _ => _
    refine' mem_supᵢ_of_mem i _
    by_cases hp : p i
    · simp [hp]
    · simp [hp]
#align submodule.bsupr_eq_range_dfinsupp_lsum Submodule.bsupᵢ_eq_range_dfinsupp_lsum

theorem mem_supᵢ_iff_exists_dfinsupp (p : ι → Submodule R N) (x : N) :
    x ∈ supᵢ p ↔
      ∃ f : Π₀ i, p i, Dfinsupp.lsum ℕ (M := fun i ↦ ↥(p i)) (fun i => (p i).subtype) f = x :=
  SetLike.ext_iff.mp (supᵢ_eq_range_dfinsupp_lsum p) x
#align submodule.mem_supr_iff_exists_dfinsupp Submodule.mem_supᵢ_iff_exists_dfinsupp

/-- A variant of `submodule.mem_supr_iff_exists_dfinsupp` with the RHS fully unfolded. -/
theorem mem_supᵢ_iff_exists_dfinsupp' (p : ι → Submodule R N) [∀ (i) (x : p i), Decidable (x ≠ 0)]
    (x : N) : x ∈ supᵢ p ↔ ∃ f : Π₀ i, p i, (f.sum fun i xi => ↑xi) = x := by
  rw [mem_supᵢ_iff_exists_dfinsupp]
  simp_rw [Dfinsupp.lsum_apply_apply, Dfinsupp.sumAddHom_apply,
    LinearMap.toAddMonoidHom_coe, coeSubtype]
#align submodule.mem_supr_iff_exists_dfinsupp' Submodule.mem_supᵢ_iff_exists_dfinsupp'

theorem mem_bsupr_iff_exists_dfinsupp (p : ι → Prop) [DecidablePred p] (S : ι → Submodule R N)
    (x : N) :
    (x ∈ ⨆ (i) (_h : p i), S i) ↔
      ∃ f : Π₀ i, S i,
        Dfinsupp.lsum ℕ (M := fun i ↦ ↥(S i)) (fun i => (S i).subtype) (f.filter p) = x :=
  SetLike.ext_iff.mp (bsupᵢ_eq_range_dfinsupp_lsum p S) x
#align submodule.mem_bsupr_iff_exists_dfinsupp Submodule.mem_bsupr_iff_exists_dfinsupp

open BigOperators

theorem mem_supᵢ_finset_iff_exists_sum {s : Finset ι} (p : ι → Submodule R N) (a : N) :
    (a ∈ ⨆ i ∈ s, p i) ↔ ∃ μ : ∀ i, p i, (∑ i in s, (μ i : N)) = a := by
  classical
    rw [Submodule.mem_supᵢ_iff_exists_dfinsupp']
    constructor <;> rintro ⟨μ, hμ⟩
    · use fun i => ⟨μ i, (supᵢ_const_le : _ ≤ p i) (coe_mem <| μ i)⟩
      rw [← hμ]
      symm
      apply Finset.sum_subset
      · intro x
        contrapose
        intro hx
        rw [mem_support_iff, not_ne_iff]
        ext
        rw [coe_zero, ← mem_bot R]
        suffices : ⊥ = ⨆ (_H : x ∈ s), p x
        · exact this.symm ▸ coe_mem (μ x)
        exact (supᵢ_neg hx).symm
      · intro x _ hx
        rw [mem_support_iff, not_ne_iff] at hx
        rw [hx]
        rfl
    · refine' ⟨Dfinsupp.mk s _, _⟩
      · rintro ⟨i, hi⟩
        refine' ⟨μ i, _⟩
        rw [supᵢ_pos]
        · exact coe_mem _
        · exact hi
      simp only [Dfinsupp.sum]
      rw [Finset.sum_subset support_mk_subset, ← hμ]
      exact Finset.sum_congr rfl fun x hx => congr_arg Subtype.val <| mk_of_mem hx
      · intro x _ hx
        rw [mem_support_iff, not_ne_iff] at hx
        rw [hx]
        rfl
#align submodule.mem_supr_finset_iff_exists_sum Submodule.mem_supᵢ_finset_iff_exists_sum

end Submodule

namespace CompleteLattice

open Dfinsupp

section Semiring

variable [Semiring R] [AddCommMonoid N] [Module R N]

/-- Independence of a family of submodules can be expressed as a quantifier over `Dfinsupp`s.

This is an intermediate result used to prove
`CompleteLattice.independent_of_dfinsupp_lsum_injective` and
`CompleteLattice.Independent.dfinsupp_lsum_injective`. -/
theorem independent_iff_forall_dfinsupp (p : ι → Submodule R N) :
    Independent p ↔
      ∀ (i) (x : p i) (v : Π₀ i : ι, ↥(p i)),
        lsum ℕ (M := fun i ↦ ↥(p i)) (fun i => (p i).subtype) (erase i v) = x → x = 0 := by
  simp_rw [CompleteLattice.independent_def, Submodule.disjoint_def,
    Submodule.mem_bsupr_iff_exists_dfinsupp, exists_imp, filter_ne_eq_erase]
  refine' forall_congr' fun i => Subtype.forall'.trans _
  simp_rw [Submodule.coe_eq_zero]
#align complete_lattice.independent_iff_forall_dfinsupp CompleteLattice.independent_iff_forall_dfinsupp

/- If `Dfinsupp.lsum` applied with `submodule.subtype` is injective then the submodules are
independent. -/
theorem independent_of_dfinsupp_lsum_injective (p : ι → Submodule R N)
    (h : Function.Injective (lsum ℕ (M := fun i ↦ ↥(p i)) fun i => (p i).subtype)) :
    Independent p := by
  rw [independent_iff_forall_dfinsupp]
  intro i x v hv
  replace hv :
    lsum ℕ (M := fun i ↦ ↥(p i)) (fun i => (p i).subtype) (erase i v) =
      lsum ℕ (M := fun i ↦ ↥(p i)) (fun i => (p i).subtype) (single i x)
  · simpa only [lsum_single] using hv
  have := FunLike.ext_iff.mp (h hv) i
  simpa [eq_comm] using this
#align complete_lattice.independent_of_dfinsupp_lsum_injective CompleteLattice.independent_of_dfinsupp_lsum_injective

/- If `Dfinsupp.sumAddHom` applied with `add_submonoid.subtype` is injective then the additive
submonoids are independent. -/
theorem independent_of_dfinsupp_sumAddHom_injective (p : ι → AddSubmonoid N)
    (h : Function.Injective (sumAddHom fun i => (p i).subtype)) : Independent p := by
  rw [← independent_map_orderIso_iff (AddSubmonoid.toNatSubmodule : AddSubmonoid N ≃o _)]
  exact independent_of_dfinsupp_lsum_injective _ h
#align complete_lattice.independent_of_dfinsupp_sum_add_hom_injective CompleteLattice.independent_of_dfinsupp_sumAddHom_injective

/-- Combining `Dfinsupp.lsum` with `LinearMap.toSpanSingleton` is the same as `Finsupp.total` -/
theorem lsum_comp_mapRange_toSpanSingleton [∀ m : R, Decidable (m ≠ 0)] (p : ι → Submodule R N)
    {v : ι → N} (hv : ∀ i : ι, v i ∈ p i) :
    (lsum ℕ (M := fun i ↦ ↥(p i)) fun i => (p i).subtype : _ →ₗ[R] _).comp
        ((mapRange.linearMap fun i => LinearMap.toSpanSingleton R (↥(p i)) ⟨v i, hv i⟩ :
              _ →ₗ[R] _).comp
          (finsuppLequivDfinsupp R : (ι →₀ R) ≃ₗ[R] _).toLinearMap) =
      Finsupp.total ι N R v := by
  ext
  simp
#align complete_lattice.lsum_comp_map_range_to_span_singleton CompleteLattice.lsum_comp_mapRange_toSpanSingleton

end Semiring

section Ring

variable [Ring R] [AddCommGroup N] [Module R N]

/- If `Dfinsupp.sumAddHom` applied with `add_submonoid.subtype` is injective then the additive
subgroups are independent. -/
theorem independent_of_dfinsupp_sumAddHom_injective' (p : ι → AddSubgroup N)
    (h : Function.Injective (sumAddHom fun i => (p i).subtype)) : Independent p := by
  rw [← independent_map_orderIso_iff (AddSubgroup.toIntSubmodule : AddSubgroup N ≃o _)]
  exact independent_of_dfinsupp_lsum_injective _ h
#align complete_lattice.independent_of_dfinsupp_sum_add_hom_injective' CompleteLattice.independent_of_dfinsupp_sumAddHom_injective'

/-- The canonical map out of a direct sum of a family of submodules is injective when the submodules
are `CompleteLattice.Independent`.

Note that this is not generally true for `[Semiring R]`, for instance when `A` is the
`ℕ`-submodules of the positive and negative integers.

See `counterexamples/direct_sum_is_internal.lean` for a proof of this fact. -/
theorem Independent.dfinsupp_lsum_injective {p : ι → Submodule R N} (h : Independent p) :
    Function.Injective (lsum ℕ (M := fun i ↦ ↥(p i)) fun i => (p i).subtype) := by
  -- simplify everything down to binders over equalities in `N`
  rw [independent_iff_forall_dfinsupp] at h
  suffices LinearMap.ker (lsum ℕ (M := fun i ↦ ↥(p i)) fun i => (p i).subtype) = ⊥
    by
    -- Lean can't find this without our help
    letI thisI : AddCommGroup (Π₀ i, p i) := inferInstance
    rw [LinearMap.ker_eq_bot] at this
    exact this
  rw [LinearMap.ker_eq_bot']
  intro m hm
  ext i : 1
  -- split `m` into the piece at `i` and the pieces elsewhere, to match `h`
  rw [Dfinsupp.zero_apply, ← neg_eq_zero]
  refine' h i (-m i) m _
  rwa [← erase_add_single i m, LinearMap.map_add, lsum_single, Submodule.subtype_apply,
    add_eq_zero_iff_eq_neg, ← Submodule.coe_neg] at hm
#align complete_lattice.independent.dfinsupp_lsum_injective CompleteLattice.Independent.dfinsupp_lsum_injective

/-- The canonical map out of a direct sum of a family of additive subgroups is injective when the
additive subgroups are `CompleteLattice.Independent`. -/
theorem Independent.dfinsupp_sumAddHom_injective {p : ι → AddSubgroup N} (h : Independent p) :
    Function.Injective (sumAddHom fun i => (p i).subtype) := by
  rw [← independent_map_orderIso_iff (AddSubgroup.toIntSubmodule : AddSubgroup N ≃o _)] at h
  exact h.dfinsupp_lsum_injective
#align complete_lattice.independent.dfinsupp_sum_add_hom_injective CompleteLattice.Independent.dfinsupp_sumAddHom_injective

/-- A family of submodules over an additive group are independent if and only iff `Dfinsupp.lsum`
applied with `submodule.subtype` is injective.

Note that this is not generally true for `[semiring R]`; see
`CompleteLattice.Independent.dfinsupp_lsum_injective` for details. -/
theorem independent_iff_dfinsupp_lsum_injective (p : ι → Submodule R N) :
    Independent p ↔ Function.Injective (lsum ℕ (M := fun i ↦ ↥(p i)) fun i => (p i).subtype) :=
  ⟨Independent.dfinsupp_lsum_injective, independent_of_dfinsupp_lsum_injective p⟩
#align complete_lattice.independent_iff_dfinsupp_lsum_injective CompleteLattice.independent_iff_dfinsupp_lsum_injective

/-- A family of additive subgroups over an additive group are independent if and only if
`Dfinsupp.sumAddHom` applied with `AddSubgroup.subtype` is injective. -/
theorem independent_iff_dfinsupp_sumAddHom_injective (p : ι → AddSubgroup N) :
    Independent p ↔ Function.Injective (sumAddHom fun i => (p i).subtype) :=
  ⟨Independent.dfinsupp_sumAddHom_injective, independent_of_dfinsupp_sumAddHom_injective' p⟩
#align complete_lattice.independent_iff_dfinsupp_sum_add_hom_injective CompleteLattice.independent_iff_dfinsupp_sumAddHom_injective

/-- If a family of submodules is `Independent`, then a choice of nonzero vector from each submodule
forms a linearly independent family.

See also `CompleteLattice.Independent.linearIndependent'`. -/
theorem Independent.linearIndependent [NoZeroSMulDivisors R N] (p : ι → Submodule R N)
    (hp : Independent p) {v : ι → N} (hv : ∀ i, v i ∈ p i) (hv' : ∀ i, v i ≠ 0) :
    LinearIndependent R v := by
  classical
    rw [linearIndependent_iff]
    intro l hl
    let a :=
      Dfinsupp.mapRange.linearMap (fun i => LinearMap.toSpanSingleton R (p i) ⟨v i, hv i⟩)
        l.toDfinsupp
    have ha : a = 0 := by
      apply hp.dfinsupp_lsum_injective
      rwa [← lsum_comp_mapRange_toSpanSingleton _ hv] at hl
    ext i
    apply smul_left_injective R (hv' i)
    have : l i • v i = a i := rfl
    simp only [coe_zero, Pi.zero_apply, ZeroMemClass.coe_zero, smul_eq_zero, ha] at this
    simpa
#align complete_lattice.independent.linear_independent CompleteLattice.Independent.linearIndependent

theorem independent_iff_linearIndependent_of_ne_zero [NoZeroSMulDivisors R N] {v : ι → N}
    (h_ne_zero : ∀ i, v i ≠ 0) : (Independent fun i => R ∙ v i) ↔ LinearIndependent R v :=
  ⟨fun hv => hv.linearIndependent _ (fun i => Submodule.mem_span_singleton_self <| v i) h_ne_zero,
    fun hv => hv.independent_span_singleton⟩
#align complete_lattice.independent_iff_linear_independent_of_ne_zero CompleteLattice.independent_iff_linearIndependent_of_ne_zero

end Ring

end CompleteLattice


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebraic_topology.dold_kan.projections
import category_theory.idempotents.functor_categories
import category_theory.idempotents.functor_extension

/-!

# Construction of the projection `P_infty` for the Dold-Kan correspondence

TODO (@joelriou) continue adding the various files referenced below

In this file, we construct the projection `P_infty : K[X] ⟶ K[X]` by passing
to the limit the projections `P q` defined in `projections.lean`. This
projection is a critical tool in this formalisation of the Dold-Kan correspondence,
because in the case of abelian categories, `P_infty` corresponds to the
projection on the normalized Moore subcomplex, with kernel the degenerate subcomplex.
(See `equivalence.lean` for the general strategy of proof.)

-/

open category_theory
open category_theory.category
open category_theory.preadditive
open category_theory.simplicial_object
open category_theory.idempotents
open opposite
open_locale simplicial dold_kan

noncomputable theory

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C] {X : simplicial_object C}

lemma P_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) :
  ((P (q+1)).f n : X _[n] ⟶ _ ) = (P q).f n :=
begin
  cases n,
  { simp only [P_f_0_eq], },
  { unfold P,
    simp only [add_right_eq_self, comp_add, homological_complex.comp_f,
      homological_complex.add_f_apply, comp_id],
    exact (higher_faces_vanish.of_P q n).comp_Hσ_eq_zero
      (nat.succ_le_iff.mp hqn), },
end

lemma Q_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) :
  ((Q (q+1)).f n : X _[n] ⟶ _ ) = (Q q).f n :=
by simp only [Q, homological_complex.sub_f_apply, P_is_eventually_constant hqn]

/-- The endomorphism `P_infty : K[X] ⟶ K[X]` obtained from the `P q` by passing to the limit. -/
def P_infty : K[X] ⟶ K[X] := chain_complex.of_hom _ _ _ _ _ _
  (λ n, ((P n).f n : X _[n] ⟶ _ ))
  (λ n, by simpa only [← P_is_eventually_constant (show n ≤ n, by refl),
    alternating_face_map_complex.obj_d_eq] using (P (n+1)).comm (n+1) n)

/-- The endomorphism `Q_infty : K[X] ⟶ K[X]` obtained from the `Q q` by passing to the limit. -/
def Q_infty : K[X] ⟶ K[X] := 𝟙 _ - P_infty

@[simp]
lemma P_infty_f_0 : (P_infty.f 0 : X _[0] ⟶ X _[0]) = 𝟙 _ := rfl

lemma P_infty_f (n : ℕ) : (P_infty.f n : X _[n] ⟶  X _[n] ) = (P n).f n := rfl

@[simp]
lemma Q_infty_f_0 : (Q_infty.f 0 : X _[0] ⟶ X _[0]) = 0 :=
by { dsimp [Q_infty], simp only [sub_self], }

lemma Q_infty_f (n : ℕ) : (Q_infty.f n : X _[n] ⟶  X _[n] ) = (Q n).f n := rfl

@[simp, reassoc]
lemma P_infty_f_naturality (n : ℕ) {X Y : simplicial_object C} (f : X ⟶ Y) :
  f.app (op [n]) ≫ P_infty.f n = P_infty.f n ≫ f.app (op [n]) :=
P_f_naturality n n f

@[simp, reassoc]
lemma Q_infty_f_naturality (n : ℕ) {X Y : simplicial_object C} (f : X ⟶ Y) :
  f.app (op [n]) ≫ Q_infty.f n = Q_infty.f n ≫ f.app (op [n]) :=
Q_f_naturality n n f

@[simp, reassoc]
lemma P_infty_f_idem (n : ℕ) :
  (P_infty.f n : X _[n] ⟶ _) ≫ (P_infty.f n) = P_infty.f n :=
by simp only [P_infty_f, P_f_idem]

@[simp, reassoc]
lemma P_infty_idem : (P_infty : K[X] ⟶ _) ≫ P_infty = P_infty :=
by { ext n, exact P_infty_f_idem n, }

@[simp, reassoc]
lemma Q_infty_f_idem (n : ℕ) :
  (Q_infty.f n : X _[n] ⟶ _) ≫ (Q_infty.f n) = Q_infty.f n :=
Q_f_idem _ _

@[simp, reassoc]
lemma Q_infty_idem : (Q_infty : K[X] ⟶ _) ≫ Q_infty = Q_infty :=
by { ext n, exact Q_infty_f_idem n, }

@[simp, reassoc]
lemma P_infty_f_comp_Q_infty_f (n : ℕ) :
  (P_infty.f n : X _[n] ⟶ _) ≫ Q_infty.f n = 0 :=
begin
  dsimp only [Q_infty],
  simp only [homological_complex.sub_f_apply, homological_complex.id_f, comp_sub, comp_id,
    P_infty_f_idem, sub_self],
end

@[simp, reassoc]
lemma P_infty_comp_Q_infty :
  (P_infty : K[X] ⟶ _) ≫ Q_infty = 0 :=
by { ext n, apply P_infty_f_comp_Q_infty_f, }

@[simp, reassoc]
lemma Q_infty_f_comp_P_infty_f (n : ℕ) :
  (Q_infty.f n : X _[n] ⟶ _) ≫ P_infty.f n = 0 :=
begin
  dsimp only [Q_infty],
  simp only [homological_complex.sub_f_apply, homological_complex.id_f, sub_comp, id_comp,
    P_infty_f_idem, sub_self],
end

@[simp, reassoc]
lemma Q_infty_comp_P_infty :
  (Q_infty : K[X] ⟶ _) ≫ P_infty = 0 :=
by { ext n, apply Q_infty_f_comp_P_infty_f, }

@[simp]
lemma P_infty_add_Q_infty :
  (P_infty : K[X] ⟶ _) + Q_infty = 𝟙 _ :=
by { dsimp only [Q_infty], simp only [add_sub_cancel'_right], }

variable (C)

/-- `P_infty` induces a natural transformation, i.e. an endomorphism of
the functor `alternating_face_map_complex C`. -/
@[simps]
def nat_trans_P_infty :
  alternating_face_map_complex C ⟶ alternating_face_map_complex C :=
{ app := λ _, P_infty,
  naturality' := λ X Y f, by { ext n, exact P_infty_f_naturality n f, }, }

/-- The natural transformation in each degree that is induced by `nat_trans_P_infty`. -/
@[simps]
def nat_trans_P_infty_f (n : ℕ) :=
nat_trans_P_infty C ◫ 𝟙 (homological_complex.eval _ _ n)

variable {C}

@[simp]
lemma map_P_infty_f {D : Type*} [category D] [preadditive D]
  (G : C ⥤ D) [G.additive] (X : simplicial_object C) (n : ℕ) :
  (P_infty : K[((whiskering C D).obj G).obj X] ⟶ _).f n =
  G.map ((P_infty : alternating_face_map_complex.obj X ⟶ _).f n) :=
by simp only [P_infty_f, map_P]

/-- Given an object `Y : karoubi (simplicial_object C)`, this lemma
computes `P_infty` for the associated object in `simplicial_object (karoubi C)`
in terms of `P_infty` for `Y.X : simplicial_object C` and `Y.p`. -/
lemma karoubi_P_infty_f {Y : karoubi (simplicial_object C)} (n : ℕ) :
  ((P_infty : K[(karoubi_functor_category_embedding _ _).obj Y] ⟶ _).f n).f =
    Y.p.app (op [n]) ≫ (P_infty : K[Y.X] ⟶ _).f n :=
begin
  -- We introduce P_infty endomorphisms P₁, P₂, P₃, P₄ on various objects Y₁, Y₂, Y₃, Y₄.
  let Y₁ := (karoubi_functor_category_embedding _ _).obj Y,
  let Y₂ := Y.X,
  let Y₃ := (((whiskering _ _).obj (to_karoubi C)).obj Y.X),
  let Y₄ := (karoubi_functor_category_embedding _ _).obj ((to_karoubi _).obj Y.X),
  let P₁ : K[Y₁] ⟶ _ := P_infty,
  let P₂ : K[Y₂] ⟶ _ := P_infty,
  let P₃ : K[Y₃] ⟶ _ := P_infty,
  let P₄ : K[Y₄] ⟶ _ := P_infty,
  -- The statement of lemma relates P₁ and P₂.
  change (P₁.f n).f = Y.p.app (op [n]) ≫ P₂.f n,
  -- The proof proceeds by obtaining relations h₃₂, h₄₃, h₁₄.
  have h₃₂ : (P₃.f n).f = P₂.f n := karoubi.hom_ext.mp (map_P_infty_f (to_karoubi C) Y₂ n),
  have h₄₃ : P₄.f n = P₃.f n,
  { have h := functor.congr_obj (to_karoubi_comp_karoubi_functor_category_embedding _ _) Y₂,
    simp only [← nat_trans_P_infty_f_app],
    congr', },
  let τ₁ := 𝟙 (karoubi_functor_category_embedding (simplex_categoryᵒᵖ) C),
  let τ₂ := nat_trans_P_infty_f (karoubi C) n,
  let τ := τ₁ ◫ τ₂,
  have h₁₄ := idempotents.nat_trans_eq τ Y,
  dsimp [τ, τ₁, τ₂, nat_trans_P_infty_f] at h₁₄,
  rw [id_comp, id_comp, comp_id, comp_id] at h₁₄,
  /- We use the three equalities h₃₂, h₄₃, h₁₄. -/
  rw [← h₃₂, ← h₄₃, h₁₄],
  simp only [karoubi_functor_category_embedding.map_app_f, karoubi.decomp_id_p_f,
    karoubi.decomp_id_i_f, karoubi.comp_f],
  let π : Y₄ ⟶ Y₄ := (to_karoubi _ ⋙ karoubi_functor_category_embedding _ _).map Y.p,
  have eq := karoubi.hom_ext.mp (P_infty_f_naturality n π),
  simp only [karoubi.comp_f] at eq,
  dsimp [π] at eq,
  rw [← eq, reassoc_of (app_idem Y (op [n]))],
end

end dold_kan

end algebraic_topology


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.category.Ring.basic
import algebra.ring.boolean_ring
import order.category.BoolAlg

/-!
# The category of Boolean rings

This file defines `BoolRing`, the category of Boolean rings.

## TODO

Finish the equivalence with `BoolAlg`.
-/

universes u

open category_theory order

/-- The category of Boolean rings. -/
def BoolRing := bundled boolean_ring

namespace BoolRing

instance : has_coe_to_sort BoolRing Type* := bundled.has_coe_to_sort
instance (X : BoolRing) : boolean_ring X := X.str

/-- Construct a bundled `BoolRing` from a `boolean_ring`. -/
def of (α : Type*) [boolean_ring α] : BoolRing := bundled.of α

@[simp] lemma coe_of (α : Type*) [boolean_ring α] : ↥(of α) = α := rfl

instance : inhabited BoolRing := ⟨of punit⟩

instance : bundled_hom.parent_projection @boolean_ring.to_comm_ring := ⟨⟩

attribute [derive [large_category, concrete_category]] BoolRing

@[simps] instance has_forget_to_CommRing : has_forget₂ BoolRing CommRing := bundled_hom.forget₂ _ _

/-- Constructs an isomorphism of Boolean rings from a ring isomorphism between them. -/
@[simps] def iso.mk {α β : BoolRing.{u}} (e : α ≃+* β) : α ≅ β :=
{ hom := e,
  inv := e.symm,
  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }

end BoolRing

/-! ### Equivalence between `BoolAlg` and `BoolRing` -/

@[simps] instance BoolRing.has_forget_to_BoolAlg : has_forget₂ BoolRing BoolAlg :=
{ forget₂ := { obj := λ X, BoolAlg.of (as_boolalg X), map := λ X Y, ring_hom.as_boolalg } }

@[simps] instance BoolAlg.has_forget_to_BoolRing : has_forget₂ BoolAlg BoolRing :=
{ forget₂ := { obj := λ X, BoolRing.of (as_boolring X),
               map := λ X Y, bounded_lattice_hom.as_boolring } }

/-- The equivalence between Boolean rings and Boolean algebras. This is actually an isomorphism. -/
@[simps functor inverse] def BoolRing_equiv_BoolAlg : BoolRing ≌ BoolAlg :=
equivalence.mk (forget₂ BoolRing BoolAlg) (forget₂ BoolAlg BoolRing)
  (nat_iso.of_components (λ X, BoolRing.iso.mk $ (ring_equiv.as_boolring_as_boolalg X).symm) $
    λ X Y f, rfl)
  (nat_iso.of_components (λ X, BoolAlg.iso.mk $ order_iso.as_boolalg_as_boolring X) $
    λ X Y f, rfl)


import data.real.nnreal
import algebra.module.hom

import breen_deligne.category

import for_mathlib.free_abelian_group

import facts.nnreal

/-!

# "suitability" of a universal map

If `f` is a universal map then a pair `(c₁, c₂)` of non-negative reals is
`f`-suitable, if (morally) `f` sends things of norm at most `c₁` to things
of norm at most `c₂`. The formal definition is in definitions 1.11 and 1.12
of the blueprint.

## Main definitions

- `breen_deligne.basic_univeral_map.suitable` :  see blueprint definition 1.11.
- `breen_deligne.universal_map.suitable` : see blueprint definition 1.12.
- `breen_deligne.data.suitable` : see blueprint definition 1.13.

These are all precise ways of controlling the norm on maps between normed
objects induced by `f`.
-/

open_locale nnreal big_operators kronecker

-- move this??
/-- `rescale_constants κ N` for a sequence `κ : ℕ → ℝ≥0`,
  is the sequence `(κ i) / N`. -/
noncomputable
def rescale_constants (κ : ℕ → ℝ≥0) (N : ℝ≥0) : ℕ → ℝ≥0 :=
λ i, (κ i) * N⁻¹

namespace rescale_constants

@[simp] lemma one (κ : ℕ → ℝ≥0) : rescale_constants κ 1 = κ :=
by { ext i, simp only [rescale_constants, mul_one, inv_one] }

end rescale_constants

namespace breen_deligne

variables {k l m n : ℕ}
variables (r r' : ℝ≥0) (S : Type*) (c c₁ c₂ c₃ c₄ : ℝ≥0) [fintype S]

namespace basic_universal_map

variables (f : basic_universal_map m n)

/-- Addition goes from `Lbar r' S c` to `Lbar r' S κ` for suitable `κ`.
This predicate says what *suitable* means for basic universal maps.
See Lemma 9.11 of [Analytic]. -/
def suitable (f : basic_universal_map m n) (c₁ c₂ : ℝ≥0) : Prop :=
∀ i, (∑ j, ↑(f i j).nat_abs) * c₁ ≤ c₂

attribute [class] suitable

lemma sup_mul_le (f : basic_universal_map m n) (c₁ c₂ : ℝ≥0) [h : f.suitable c₁ c₂] :
  (finset.univ.sup $ λ i, ∑ j, ↑(f i j).nat_abs) * c₁ ≤ c₂ :=
begin
  by_cases H : c₁ = 0,
  { unfreezingI {subst H}, rw mul_zero, exact zero_le' },
  rw [mul_comm, nnreal.mul_le_iff_le_inv H, finset.sup_le_iff],
  rintro i -,
  rw [← nnreal.mul_le_iff_le_inv H, mul_comm],
  apply h
end

instance suitable_mul_left (f : basic_universal_map m n) [h : f.suitable c₁ c₂] :
  f.suitable (c * c₁) (c * c₂) :=
λ i, by { rw mul_left_comm, exact mul_le_mul' le_rfl (h i) }

instance suitable_mul_right (f : basic_universal_map m n) [h : f.suitable c₁ c₂] :
  f.suitable (c₁ * c) (c₂ * c) :=
by { rw [mul_comm _ c, mul_comm _ c], exact basic_universal_map.suitable_mul_left _ _ _ _ }

instance suitable_id : (id n).suitable c c :=
begin
  intro i,
  calc _ ≤ 1 * c : mul_le_mul' (le_of_eq _) le_rfl
     ... = c : one_mul c,
  simp only [id, int.nat_abs],
  rw [finset.sum_eq_single i],
  { simp only [matrix.one_apply_eq, nat.cast_one, int.nat_abs_one] },
  { rintro j - hj,
    simp only [int.nat_abs_eq_zero, matrix.one_apply_ne' hj, nat.cast_eq_zero, one_ne_zero] },
  { intro h, exact (h $ finset.mem_univ _).elim }
end

-- this cannot be an instance, because c₂ cannot be inferred
lemma suitable_comp {g : basic_universal_map m n} {f : basic_universal_map l m}
  {c₁ : ℝ≥0} (c₂ : ℝ≥0) {c₃ : ℝ≥0}
  [hg : g.suitable c₂ c₃] [hf : f.suitable c₁ c₂] :
  (comp g f).suitable c₁ c₃ :=
begin
  intro i,
  simp only [← nat.coe_cast_ring_hom, ← ring_hom.map_sum, comp, matrix.mul_apply],
  calc  ↑(∑ k, (∑ j, g i j * f j k).nat_abs) * c₁
      ≤ ↑(∑ j, (g i j).nat_abs * ∑ k, (f j k).nat_abs) * c₁    : _ -- proof below
  ... = ∑ j, ↑(g i j).nat_abs * ((∑ k, ↑(f j k).nat_abs) * c₁) : _ -- proof below
  ... ≤ ∑ j, ↑(g i j).nat_abs * c₂                             : _ -- proof below
  ... ≤ c₃                                                 : by { rw ← finset.sum_mul, exact hg i },
  { refine mul_le_mul' _ le_rfl,
    rw nat.cast_le,
    simp only [finset.mul_sum],
    rw finset.sum_comm,
    apply finset.sum_le_sum,
    rintro k -,
    simp only [← int.nat_abs_mul],
    apply nat_abs_sum_le },
  { simp only [← nat.coe_cast_ring_hom, ring_hom.map_sum, ring_hom.map_mul,
      finset.sum_mul, mul_assoc] },
  { apply finset.sum_le_sum, rintro j -, exact mul_le_mul' le_rfl (hf j) }
end

@[priority 1001]
instance zero_suitable : (0 : basic_universal_map m n).suitable c₁ c₂ :=
λ i, by simp only [nat.cast_zero, zero_mul, zero_le', finset.sum_const_zero,
          dmatrix.zero_apply, int.nat_abs_zero]

instance suitable_zero_left (f : basic_universal_map m n) (c : ℝ≥0) : f.suitable 0 c :=
λ j, by { rw [mul_zero], exact zero_le' }

lemma suitable.le (hf : f.suitable c₂ c₃) (h1 : c₁ ≤ c₂) (h2 : c₃ ≤ c₄) :
  f.suitable c₁ c₄ :=
λ j, (mul_le_mul' le_rfl h1).trans ((hf j).trans h2)

lemma suitable_of_le [hf : f.suitable c₂ c₃] (h1 : c₁ ≤ c₂) (h2 : c₃ ≤ c₄) :
  f.suitable c₁ c₄ :=
hf.le _ _ _ _ _ h1 h2

instance suitable_mul_left_one_le (f : basic_universal_map m n)
  [h : f.suitable c₁ c₂] [fact (1 ≤ c)] :
  f.suitable c₁ (c * c₂) :=
h.le _ _ _ _ _ le_rfl $ fact.out _

instance suitable_mul_right_one_le (f : basic_universal_map m n)
  [h : f.suitable c₁ c₂] [fact (1 ≤ c)] :
  f.suitable c₁ (c₂ * c) :=
h.le _ _ _ _ _ le_rfl $ fact.out _

instance suitable_mul_left_le_one (f : basic_universal_map m n)
  [h : f.suitable c₁ c₂] [fact (c ≤ 1)] :
  f.suitable (c * c₁) c₂ :=
h.le _ _ _ _ _ (fact.out _) le_rfl

instance suitable_mul_right_le_one (f : basic_universal_map m n)
  [h : f.suitable c₁ c₂] [fact (c ≤ 1)] :
  f.suitable (c₁ * c) c₂ :=
h.le _ _ _ _ _ (fact.out _) le_rfl

instance suitable_add (f g : basic_universal_map m n) (c cf cg : ℝ≥0)
  [hf : f.suitable c cf] [hg : g.suitable c cg] :
  (f + g).suitable c (cf + cg) :=
begin
  intro i,
  calc (∑ (j : fin m), ↑(((f + g) i j).nat_abs)) * c
      ≤ (∑ (j : fin m), ↑((f i j).nat_abs) + ∑ (j : fin m), ↑((g i j).nat_abs)) * c : _
  ... ≤ cf + cg : _,
  { rw ← finset.sum_add_distrib,
    refine mul_le_mul' (finset.sum_le_sum _) le_rfl,
    rintro j -,
    rw [← nat.cast_add, nat.cast_le],
    apply int.nat_abs_add_le, },
  { rw add_mul, apply add_le_add (hf i) (hg i) }
end

instance suitable_sum {ι : Type*} (s : finset ι) (f : ι → basic_universal_map m n)
  {c : ℝ≥0} {κ' : ι → ℝ≥0}
  [hf : ∀ i, (f i).suitable c (κ' i)] :
  (∑ i in s, f i).suitable c (∑ i in s, κ' i) :=
begin
  classical,
  apply finset.induction_on s,
  { simp only [finset.sum_empty], apply_instance },
  { intros i s his IH,
    simp only [finset.sum_insert his], resetI, apply_instance }
end
.

instance proj_suitable (N : ℕ) (k : fin N) (c : ℝ≥0) : (proj n k).suitable c c :=
begin
  intro i,
  apply le_of_eq,
  dsimp [proj, matrix.kronecker, proj_aux, - fin_prod_fin_equiv_symm_apply],
  rw [finset.sum_eq_single (fin_prod_fin_equiv (k, i))],
  { simp only [equiv.symm_apply_apply, if_pos rfl, matrix.one_apply_eq,
      nat.cast_one, int.nat_abs_one, one_mul] },
  { rintro j - hj,
    generalize hj' : fin_prod_fin_equiv.symm j = j',
    rw [equiv.symm_apply_eq] at hj', subst j,
    cases j' with a b,
    rw [matrix.one_apply, boole_mul, ← ite_and],
    simpa only [int.nat_abs_eq_zero, ite_eq_right_iff, nat.cast_eq_zero, one_ne_zero,
      equiv.apply_eq_iff_eq, prod.mk.inj_iff, ne.def, @eq_comm _ b] using hj },
  { intro h, exact (h $ finset.mem_univ _).elim }
end

instance mul_suitable (N : ℕ) (f : basic_universal_map m n) [hf : f.suitable c₁ c₂] :
  (basic_universal_map.mul N f).suitable c₁ c₂ :=
begin
  intros i,
  refine (le_of_eq _).trans (hf $ (fin_prod_fin_equiv.symm i).2),
  congr' 1,
  rw [← fin_prod_fin_equiv.sum_comp, ← finset.univ_product_univ, finset.sum_product,
    finset.sum_comm],
  apply fintype.sum_congr,
  intro j,
  dsimp [mul, matrix.kronecker, - fin_prod_fin_equiv_symm_apply],
  rw finset.sum_eq_single (fin_prod_fin_equiv.symm i).1,
  { congr' 2,
    simp only [one_mul, equiv.symm_apply_apply, matrix.one_apply_eq] },
  { rintro k - hk,
    simp only [equiv.symm_apply_apply, int.nat_abs_eq_zero, nat.cast_eq_zero, mul_eq_zero,
      matrix.one_apply_ne' hk, eq_self_iff_true, true_or] },
  { intro h, exact (h $ finset.mem_univ _).elim }
end
.

instance one_mul_hom_suitable : (one_mul_hom n).suitable c c :=
by { rw one_mul_hom_eq_proj, apply_instance }

instance mul_mul_inv_suitable (k : ℕ) : (mul_mul_inv m n k).suitable c c :=
begin
  intro i,
  calc _ ≤ 1 * c : mul_le_mul' (le_of_eq _) le_rfl
     ... = c : one_mul c,
  dsimp only [mul_mul_inv],
  simp only [matrix.reindex_linear_equiv_apply, matrix.reindex_apply, matrix.submatrix_apply,
    matrix.one_apply, equiv.eq_symm_apply],
  rw [finset.sum_eq_single, if_pos rfl, int.nat_abs_one, nat.cast_one],
  { rintro j - hj,
    rw [if_neg, int.nat_abs_zero, nat.cast_zero],
    exact hj.symm },
  { intro h, exact (h $ finset.mem_univ _).elim }
end

end basic_universal_map

namespace universal_map

open free_abelian_group

/-- A univeral map `f` is `suitable c₁ c₂` if all of the matrices `g`
occuring in the formal sum `f` satisfy `g.suitable c₁ c₂`.
This definition is tailored in such a way that we get a sensible
`CLCFP V r' c₂ n ⟶ CLCFP V r' c₁ m`
if `f.suitable c₁ c₂`.

See Lemma 9.11 of [Analytic]. -/
def suitable (c₁ c₂ : ℝ≥0) (f : universal_map m n) : Prop :=
∀ g ∈ f.support, basic_universal_map.suitable g c₁ c₂

attribute [class] suitable

lemma suitable_of_mem_support (f : universal_map m n) (c₁ c₂ : ℝ≥0)
  (g : basic_universal_map m n) (hg : g ∈ f.support) [h : f.suitable c₁ c₂] :
  g.suitable c₁ c₂ :=
h g hg

lemma suitable_free_predicate (c₁ c₂ : ℝ≥0) :
  free_predicate (@suitable m n c₁ c₂) :=
by { intro x, simp only [suitable, forall_eq, finset.mem_singleton, support_of] }

lemma suitable_congr (f g : universal_map m n) (c₁ c₂ : ℝ≥0) (h : f = g) :
  f.suitable c₁ c₂ ↔ g.suitable c₁ c₂ :=
by subst h

lemma suitable.le {f : universal_map m n} (hf : f.suitable c₂ c₃) (h1 : c₁ ≤ c₂) (h2 : c₃ ≤ c₄) :
  f.suitable c₁ c₄ :=
λ g hg, (suitable_of_mem_support f _ _ _ hg).le _ _ _ _ _ h1 h2

lemma suitable_of_le (f : universal_map m n) [hf : f.suitable c₂ c₃] (h1 : c₁ ≤ c₂) (h2 : c₃ ≤ c₄) :
  f.suitable c₁ c₄ :=
hf.le _ _ _ _ h1 h2

/-- `f.factor` for `f : universal_map m n`
is the ratio `c₂ / c₁` that two constants need to satisfy
in order that `f.suitable c₁ c₂` holds. -/
noncomputable def factor (f : universal_map m n) : ℝ≥0 :=
(f.support.product finset.univ).sup (λ gi, (∑ j, ↑(gi.1 gi.2 j).nat_abs))

lemma le_factor (f : universal_map m n) (g : basic_universal_map m n)
  (hg : g ∈ f.support) (i : fin n) :
  (∑ j, ↑(g i j).nat_abs) ≤ f.factor :=
begin
  transitivity, swap,
  refine @finset.le_sup _ _ _ _ (f.support.product (finset.univ : finset (fin n)))
     (λ gi, (∑ j, ↑(gi.1 gi.2 j).nat_abs)) (g, i) _,
  { simp only [and_true, finset.mem_univ, finset.mem_product, hg] },
  { exact le_rfl }
end

lemma suitable_of_factor_le (f : universal_map m n) (hf : f.factor ≤ c₂ * c₁⁻¹) :
  f.suitable c₁ c₂ :=
begin
  intros g hg i,
  by_cases h : c₁ = 0,
  { simp only [h, zero_le', mul_zero] },
  rw [mul_comm, nnreal.mul_le_iff_le_inv h, mul_comm],
  exact (le_factor _ _ hg _).trans hf
end

lemma factor_le_of_suitable (f : universal_map m n) [hf : f.suitable c₁ c₂] [h : fact (0 < c₁)] :
  f.factor ≤ c₂ * c₁⁻¹ :=
begin
  refine finset.sup_le _,
  simp only [and_true, finset.mem_univ, finset.mem_product],
  rintro ⟨g, i⟩ hg,
  rw [mul_comm, ← nnreal.mul_le_iff_le_inv h.1.ne', mul_comm],
  apply hf _ hg,
end

@[simp] lemma factor_neg (f : universal_map m n) : (-f).factor = f.factor :=
by simp only [factor, support_neg]

lemma factor_add (f₁ f₂ : universal_map m n) : factor (f₁ + f₂) ≤ max f₁.factor f₂.factor :=
begin
  refine finset.sup_le _,
  simp only [prod.forall, and_true, finset.mem_univ, finset.mem_product, le_max_iff],
  intros g i hg,
  replace hg := support_add f₁ f₂ hg,
  simp only [finset.mem_union] at hg,
  refine hg.imp _ _; { intro h, apply le_factor, exact h },
end

lemma factor_sub (f₁ f₂ : universal_map m n) : factor (f₁ - f₂) ≤ max f₁.factor f₂.factor :=
by simpa only [factor_neg, sub_eq_add_neg] using factor_add f₁ (-f₂)

end universal_map

namespace basic_universal_map
open free_abelian_group

lemma suitable_of_suitable_of (f : basic_universal_map m n) (c₁ c₂ : ℝ≥0)
  [h : universal_map.suitable c₁ c₂ (of f)] :
  f.suitable c₁ c₂ :=
h f $ by simp only [finset.mem_singleton, support_of]

end basic_universal_map

namespace universal_map
open free_abelian_group

instance suitable_of (f : basic_universal_map m n) (c₁ c₂ : ℝ≥0) [f.suitable c₁ c₂] :
  suitable c₁ c₂ (of f) :=
begin
  intros g hg,
  rw [support_of, finset.mem_singleton] at hg,
  rwa hg
end

@[simp] lemma suitable_of_iff (f : basic_universal_map m n) (c₁ c₂ : ℝ≥0) :
  suitable c₁ c₂ (of f) ↔ f.suitable c₁ c₂ :=
⟨by {introI h, apply basic_universal_map.suitable_of_suitable_of }, by {introI h, apply_instance}⟩

instance suitable_zero : (0 : universal_map m n).suitable c₁ c₂ :=
(suitable_free_predicate c₁ c₂).zero

instance suitable_zero_left (f : universal_map m n) (c : ℝ≥0) : f.suitable 0 c :=
λ g hg, by apply_instance

instance suitable_neg (f : universal_map m n) (c₁ c₂ : ℝ≥0) [h : f.suitable c₁ c₂] :
  suitable c₁ c₂ (-f) :=
(suitable_free_predicate c₁ c₂).neg h

@[simp] lemma suitable_neg_iff (f : universal_map m n) (c₁ c₂ : ℝ≥0) :
  suitable c₁ c₂ (-f) ↔ f.suitable c₁ c₂ :=
(suitable_free_predicate c₁ c₂).neg_iff

instance suitable_add {f g : universal_map m n} {c₁ c₂ : ℝ≥0}
  [hf : f.suitable c₁ c₂] [hg : g.suitable c₁ c₂] :
  suitable c₁ c₂ (f + g) :=
(suitable_free_predicate c₁ c₂).add hf hg

instance suitable_sum {ι : Type*} (s : finset ι) (f : ι → universal_map m n) {c₁ c₂ : ℝ≥0}
  [hf : ∀ i, (f i).suitable c₁ c₂] :
  (∑ i in s, f i).suitable c₁ c₂ :=
begin
  classical,
  apply finset.induction_on s,
  { simp only [finset.sum_empty], apply_instance },
  { intros i s his IH,
    simp only [finset.sum_insert his], resetI, apply_instance }
end

instance suitable_sub {f g : universal_map m n} {c₁ c₂ : ℝ≥0}
  [hf : f.suitable c₁ c₂] [hg : g.suitable c₁ c₂] :
  suitable c₁ c₂ (f - g) :=
by rw sub_eq_add_neg; apply_instance

lemma suitable_smul_iff (k : ℤ) (hk : k ≠ 0) (f : universal_map m n) (c₁ c₂ : ℝ≥0) :
  suitable c₁ c₂ (k • f) ↔ f.suitable c₁ c₂ :=
(suitable_free_predicate c₁ c₂).smul_iff k hk

instance suitable_mul_left (f : universal_map m n) [h : f.suitable c₁ c₂] :
  f.suitable (c * c₁) (c * c₂) :=
λ g hg, @basic_universal_map.suitable_mul_left _ _ _ _ _ _ (h g hg)

instance suitable_mul_right (f : universal_map m n) [h : f.suitable c₁ c₂] :
  f.suitable (c₁ * c) (c₂ * c) :=
by { rw [mul_comm _ c, mul_comm _ c], exact universal_map.suitable_mul_left _ _ _ _ }

instance suitable_mul_left_one_le (f : universal_map m n)
  [h : f.suitable c₁ c₂] [fact (1 ≤ c)] :
  f.suitable c₁ (c * c₂) :=
h.le _ _ _ _ le_rfl $ fact.out _

instance suitable_mul_right_one_le (f : universal_map m n)
  [h : f.suitable c₁ c₂] [fact (1 ≤ c)] :
  f.suitable c₁ (c₂ * c) :=
h.le _ _ _ _ le_rfl $ fact.out _

instance suitable_mul_left_le_one (f : universal_map m n)
  [h : f.suitable c₁ c₂] [fact (c ≤ 1)] :
  f.suitable (c * c₁) c₂ :=
h.le _ _ _ _ (fact.out _) le_rfl

instance suitable_mul_right_le_one (f : universal_map m n)
  [h : f.suitable c₁ c₂] [fact (c ≤ 1)] :
  f.suitable (c₁ * c) c₂ :=
h.le _ _ _ _ (fact.out _) le_rfl

instance suitable_id : (id n).suitable c c :=
λ g hg, by { simp only [id, finset.mem_singleton, support_of] at hg, subst g, apply_instance }

-- this cannot be an instance, because c₂ cannot be inferred
lemma suitable.comp {g : universal_map m n} {f : universal_map l m} {c₁ : ℝ≥0} (c₂ : ℝ≥0)
  {c₃ : ℝ≥0} [hg : g.suitable c₂ c₃] [hf : f.suitable c₁ c₂] :
  (comp g f).suitable c₁ c₃ :=
begin
  apply free_abelian_group.induction_on_free_predicate
    (suitable c₂ c₃) (suitable_free_predicate c₂ c₃) g hg; unfreezingI { clear_dependent g },
  { simpa only [pi.zero_apply, add_monoid_hom.zero_apply, add_monoid_hom.map_zero]
      using breen_deligne.universal_map.suitable_zero _ _ },
  { intros g hg,
    apply free_abelian_group.induction_on_free_predicate
      (suitable c₁ c₂) (suitable_free_predicate c₁ c₂) f hf; unfreezingI { clear_dependent f },
      { simp only [add_monoid_hom.map_zero], apply_instance },
      { intros f hf,
        rw comp_of,
        rw suitable_of_iff at hf hg ⊢,
        resetI,
        exact breen_deligne.basic_universal_map.suitable_comp c₂ },
      { intros g hg H, simpa only [add_monoid_hom.map_neg, suitable_neg_iff] },
      { intros g₁ g₂ hg₁ hg₂ H₁ H₂,
        simp only [add_monoid_hom.map_add],
        resetI, apply_instance } },
  { intros f hf H,
    simpa only [pi.neg_apply, add_monoid_hom.map_neg, suitable_neg_iff, add_monoid_hom.neg_apply] },
  { intros f₁ f₂ hf₁ hf₂ H₁ H₂,
    simp only [add_monoid_hom.add_apply, add_monoid_hom.map_add, pi.add_apply],
    resetI, apply_instance }
end

instance sum_suitable (c : ℝ≥0) (n N : ℕ) : (sum n N).suitable (c * N⁻¹) c :=
begin
  by_cases hN : N = 0,
  { subst N, simp only [nat.cast_zero, inv_zero, mul_zero], apply_instance },
  refine @universal_map.suitable_of _ _ _ _ _ (_root_.id _),
  suffices : c = ∑ i : fin N, c * N⁻¹,
  { conv { congr, skip, skip, rw this },
    apply_instance },
  rw [finset.sum_const, finset.card_fin, nsmul_eq_mul, mul_left_comm, mul_inv_cancel, mul_one],
  exact_mod_cast hN
end

instance sum_two_suitable (c : ℝ≥0) (n : ℕ) : (sum n 2).suitable (c * 2⁻¹) c :=
by { convert universal_map.sum_suitable c n 2, norm_num }

instance proj_suitable (c : ℝ≥0) (n N : ℕ) : (proj n N).suitable c c :=
universal_map.suitable_sum _ _

instance mul_suitable (f : universal_map m n) [h : f.suitable c₁ c₂] (N : ℕ) [hN : fact (0 < N)] :
  (mul N f).suitable c₁ c₂ :=
begin
  intros g hg,
  rw [universal_map.mem_support_mul N hN.out] at hg,
  rcases hg with ⟨g, hg, rfl⟩,
  haveI := universal_map.suitable_of_mem_support f c₁ c₂ g hg,
  apply_instance
end

end universal_map

namespace data

/-- A sequence of nonnegative real numbers `κ 0`, `κ 1`, ...
is *suitable* with respect to a Breen--Deligne data `BD`,
if for all `i : ℕ`, the constants `κ (i+1)` and `κ i` are
suitable with respect to the universal map `BD.d (i+1) i`.

This definition ensures that we get a well-defined complex
of normed groups `CLCFP V r' (κ i) (BD.rank i)`,
induced by the maps `BD.d (i+1) i`. -/
class suitable (BD : data) (κ : ℕ → ℝ≥0) : Prop :=
(universal_suitable : ∀ i j, (BD.d i j).suitable (κ i) (κ j))

attribute [instance] suitable.universal_suitable

variables (BD : data) (κ : ℕ → ℝ≥0) (i j j' : ℕ)

lemma suitable.of_basic (H : ∀ i, (BD.d (i+1) i).suitable (κ (i+1)) (κ i)) : BD.suitable κ :=
⟨λ j i, begin
  by_cases hij : i + 1 = j,
  {  subst j, exact H i },
  { rw BD.shape _ _ hij, apply_instance }
end⟩

instance comp_suitable [BD.suitable κ] :
  (universal_map.comp (BD.d j i) (BD.d j' j)).suitable (κ j') (κ i) :=
universal_map.suitable.comp (κ j)

instance suitable_mul_left [BD.suitable κ] (c : ℝ≥0) : BD.suitable (λ i, c * κ i) :=
⟨λ i j, by apply_instance⟩

instance suitable_mul_right [BD.suitable κ] (c : ℝ≥0) : BD.suitable (λ i, κ i * c) :=
⟨λ i j, by apply_instance⟩

instance suitable_rescale_constants [BD.suitable κ] (N : ℝ≥0) :
  BD.suitable (rescale_constants κ N) :=
data.suitable_mul_right _ _ _

instance mul_obj_suitable [BD.suitable κ] (N : ℕ) [fact (0 < N)] : ((mul N).obj BD).suitable κ :=
begin
  constructor,
  intros i j,
  dsimp [mul_obj_d],
  apply_instance
end

instance sum_suitable (i N : ℕ) (N' : ℝ≥0) [hN' : fact (N'⁻¹ ≤ N⁻¹)] :
  universal_map.suitable (rescale_constants κ N' i) (κ i) ((BD.sum N).f i) :=
(universal_map.sum_suitable _ _ _).le _ _ _ _ (mul_le_mul' le_rfl hN'.1) le_rfl

instance proj_suitable_strict (i N : ℕ) :
  universal_map.suitable c c ((BD.proj N).f i) :=
universal_map.proj_suitable _ _ _

instance proj_suitable (i N : ℕ) (N' : ℝ≥0) [fact (N'⁻¹ ≤ 1)] :
  universal_map.suitable (rescale_constants κ N' i) (κ i) ((BD.proj N).f i) :=
begin
  refine (universal_map.proj_suitable _ _ _).le _ _ _ _ _ le_rfl,
  dsimp [rescale_constants],
  apply fact.out,
end

instance hom_pow'_suitable_strict
  (f : (mul 2).obj BD ⟶ BD) (i : ℕ) [universal_map.suitable c c (f.f i)] :
  Π N, ((hom_pow' f N).f i).suitable c c
| 0     := by { dsimp [hom_pow'], exact universal_map.suitable_id _ }
| (N+1) :=
begin
  dsimp [hom_pow'],
  refine @universal_map.suitable.comp _ _ _ _ _ _ c _ _ (id _),
  refine @universal_map.mul_suitable _ _ _ _ _ (id _) _ ⟨two_pos⟩,
  apply_assumption
end

instance hom_pow'_sum_suitable (i N : ℕ) :
  ((data.hom_pow' (BD.sum 2) N).f i).suitable (c * (2 ^ N)⁻¹) c :=
begin
  induction N with N ih,
  { simp only [hom_pow', rescale_constants, pow_zero, inv_one, mul_one],
    exact universal_map.suitable_id _ },
  simp only [hom_pow', rescale_constants, pow_succ, mul_inv] at ih ⊢, resetI,
  refine @universal_map.suitable.comp _ _ _ _ _ _ (c * 2⁻¹) _ (id _) (id _),
  { apply universal_map.sum_two_suitable },
  { rw [← mul_assoc, mul_right_comm],
    haveI : fact (0 < 2) := ⟨two_pos⟩,
    apply universal_map.mul_suitable }
end

end data

namespace universal_map

/-- A universal map `f` satisfies `very_suitable r r' c₁ c₂` if it satisfies a technical predicate
that is useful when evaluating `f` on a special type of semi-normed groups,
namely those considered in the system of complexes occuring in `first_target`.

In this case, we have the naive evaluation of `f`, whose norm is bounded by `N = f.bound`,
but we can compose this sufficiently often with a restriction map whose norm is stricly `< 1`.

This predicate records the conditions that make sure that the resulting composition
is norm-nonincreasing: In addition to `f` being `suitable c₁ κ` we require
that `κ ≤ c₂` leaves enough room to apply the restriction map `b` times,
where `b` satisfies `r ^ b * N ≤ 1` and `κ ≤ r' ^ b * c₂`. -/
def very_suitable (f : universal_map m n) (r r' : out_param ℝ≥0) (c₁ c₂ : ℝ≥0) : Prop :=
∃ (N b : ℕ) (κ : ℝ≥0), f.bound_by N ∧ f.suitable c₁ κ ∧ r ^ b * N ≤ 1 ∧ κ ≤ r' ^ b * c₂

attribute [class] very_suitable

namespace very_suitable

variables (f : universal_map m n)

@[priority 100]
instance suitable [hr' : fact (r' ≤ 1)] [hf : f.very_suitable r r' c₁ c₂] : f.suitable c₁ c₂ :=
begin
  unfreezingI { rcases hf with ⟨N, b, κ, hN, hf, hr, H⟩ },
  exact hf.le _ _ _ _ le_rfl (H.trans $ fact.out _)
end

instance mul_left (f : universal_map m n) [h : f.very_suitable r r' c₁ c₂] :
  f.very_suitable r r' (c * c₁) (c * c₂) :=
begin
  unfreezingI { rcases h with ⟨N, b, κ, hN, hf, hr, H⟩ },
  refine ⟨N, b, c * κ, hN, infer_instance, hr, _⟩,
  rw mul_left_comm,
  exact mul_le_mul' le_rfl H
end

instance mul_right (f : universal_map m n) [h : f.very_suitable r r' c₁ c₂] :
  f.very_suitable r r' (c₁ * c) (c₂ * c) :=
by { rw [mul_comm _ c, mul_comm _ c], apply universal_map.very_suitable.mul_left }

lemma zero : (0 : universal_map m n).very_suitable r r' c₁ c₂ :=
begin
  refine ⟨0, 0, c₂, zero_bound_by 0, infer_instance, _, _⟩,
  { simp only [nat.cast_zero, zero_le', mul_zero] },
  { simp only [one_mul, pow_zero] }
end

end very_suitable

end universal_map

namespace data

/-- A sequence of constants `κ : ℕ → ℝ≥0` is `very_suitable` for some Breen--Deligne data `BD`
if every pair of constants is `very_suitable` for the corresponding differential in `BD`. -/
class very_suitable (BD : data) (r r' : out_param ℝ≥0) (κ : ℕ → ℝ≥0) : Prop :=
(universal_very_suitable : ∀ i j, (BD.d i j).very_suitable r r' (κ i) (κ j))
(pos : ∀ i, 0 < κ i)

lemma pos (BD : data) {r r' : ℝ≥0} (κ : ℕ → ℝ≥0) [BD.very_suitable r r' κ] (i : ℕ) :
  0 < κ i :=
very_suitable.pos BD i

attribute [instance] very_suitable.universal_very_suitable

namespace very_suitable

variables (BD : data) (κ : ℕ → ℝ≥0)

@[priority 100]
instance suitable [hr' : fact (r' ≤ 1)] [h : BD.very_suitable r r' κ] :
  BD.suitable κ :=
{ universal_suitable := λ i j, by apply_instance }

lemma of_succ (h1 : ∀ i, universal_map.very_suitable (BD.d (i + 1) i) r r' (κ (i + 1)) (κ i))
  (h2 : ∀ i, 0 < κ i) :
  BD.very_suitable r r' κ :=
{ universal_very_suitable :=
  begin
    intros i j,
    by_cases hij : i = j + 1,
    { rw hij, exact h1 _ },
    { rw BD.shape, swap, exact ne.symm hij,
      exact universal_map.very_suitable.zero r r' (κ i) (κ j) }
  end,
  pos := h2 }

end very_suitable

end data

end breen_deligne