import data.list.chain data.int.basic tactic data.list.basic

variables {α : Type*}

open list

def reduced (l : list (α × ℤ)) : Prop :=
l.chain' (λ a b, a.1 ≠ b.1) ∧ ∀ a : α × ℤ, a ∈ l → a.2 ≠ 0

@[simp] lemma reduced_nil : reduced ([] : list (α × ℤ)) :=
⟨list.chain'_nil, λ _, false.elim⟩

lemma reduced_of_reduced_cons {a : α × ℤ} {l : list (α × ℤ)}
  (h : reduced (a :: l)) : reduced l :=
⟨(list.chain'_cons'.1 h.1).2, λ b hb, h.2 _ (mem_cons_of_mem _ hb)⟩

lemma reduced_cons_of_reduced_cons {a : α} {i j : ℤ} {l : list (α × ℤ)}
  (h : reduced ((a, i) :: l)) (hj : j ≠ 0) : reduced ((a, j) :: l) :=
⟨chain'_cons'.2 (chain'_cons'.1 h.1),
  begin
    rintros ⟨b, k⟩ hb,
    cases (mem_cons_iff _ _ _).1 hb with hb hb,
    { cc },
    { exact h.2 _ (mem_cons_of_mem _ hb) }
  end⟩

lemma reduced_cons_cons {a b : α} {i j : ℤ} {l : list (α × ℤ)} (hab : a ≠ b) (hi : i ≠ 0)
  (hbl : reduced ((b, j) :: l)) : reduced ((a, i) :: (b, j) :: l) :=
⟨chain'_cons.2 ⟨hab, hbl.1⟩,
  begin
    rintros ⟨c, k⟩ hc,
    cases (mem_cons_iff _ _ _).1 hc with hc hc,
    { cc },
    { exact hbl.2 _ hc }
  end⟩

lemma reduced_reverse {l : list (α × ℤ)} (h : reduced l) : reduced l.reverse :=
⟨chain'_reverse.2 $ by {convert h.1, simp [function.funext_iff, eq_comm] },
  by simpa using h.2⟩

@[simp] lemma reduced_reverse_iff {l : list (α × ℤ)} : reduced l.reverse ↔ reduced l :=
⟨λ h, by convert reduced_reverse h; simp, reduced_reverse⟩

variable (α)
def free_group : Type* := {l : list (α × ℤ) // reduced l}

namespace free_group

instance : has_one (free_group α) := ⟨⟨[], trivial, by simp⟩⟩

variables {α} [decidable_eq α]

def rcons : α × ℤ → list (α × ℤ) → list (α × ℤ)
| a []     := [a]
| a (b::l) :=
  if a.1 = b.1
    then let k := a.2 + b.2 in
      if k = 0
        then l
        else (a.1, k) :: l
    else a :: b :: l

-- def rconcat (a : α × ℤ) (l : list (α × ℤ)) : list (α × ℤ) :=
-- (rcons a l.reverse).reverse

def reduce : list (α × ℤ) → list (α × ℤ)
| []       := []
| (a :: l) := if a.2 = 0 then reduce l else rcons a (reduce l)

lemma reduced_rcons : ∀ {a : α × ℤ} {l : list (α × ℤ)},
  a.2 ≠ 0 → reduced l → reduced (rcons a l)
| (a, i) []            ha h := ⟨list.chain'_singleton _, by simp [rcons]; cc⟩
| (a, i) ((b, j) :: l) ha h := begin
  simp [rcons],
  split_ifs,
  { exact reduced_of_reduced_cons h },
  { subst h_1,
    exact reduced_cons_of_reduced_cons h h_2 },
  { exact reduced_cons_cons h_1 ha h }
end

-- lemma reduced_rconcat  {a : α × ℤ} {l : list (α × ℤ)}
--   (ha : a.2 ≠ 0) (hl : reduced l) : reduced (rconcat a l) :=
-- begin
--   rw [rconcat, reduced_reverse_iff],
--   exact reduced_rcons ha (reduced_reverse hl)
-- end

lemma reduced_reduce : ∀ l : list (α × ℤ), reduced (reduce l)
| []     := reduced_nil
| (a::l) := begin
  rw reduce,
  split_ifs,
  { exact reduced_reduce l },
  { exact reduced_rcons h (reduced_reduce l) }
end

lemma rcons_eq_cons : ∀ {a : α × ℤ} {l : list (α × ℤ)},
  reduced (a :: l) → rcons a l = a :: l
| a []     h := rfl
| a (b::l) h := if_neg (chain'_cons.1 h.1).1

-- lemma rconcat_eq_concat  {a : α × ℤ} {l : list (α × ℤ)}
--   (h : reduced (l ++ [a])) : rconcat a l = l ++ [a] :=
-- begin
--   rw [rconcat, rcons_eq_cons], simp,
--   convert reduced_reverse h, simp,
-- end

lemma rcons_reduce_eq_reduce_cons : ∀ {a : α × ℤ} {l : list (α × ℤ)},
  a.2 ≠ 0 → rcons a (reduce l) = reduce (a :: l)
| a []     ha := by simp [rcons, reduce, ha]
| a (b::l) ha := begin
  rw [reduce],
  split_ifs,
  { rw [reduce, if_neg ha, reduce, if_pos h] },
  { rw [reduce, if_neg ha, reduce, if_neg h] }
end

-- inductive rel : list (α × ℤ) → list (α × ℤ) → Prop
-- | refl : ∀ l, rel l l
-- | zero : ∀ {a : α}, rel [(a, 0)] []
-- | add : ∀ {a i j}, rel [(a, i), (a, j)] [(a, i + j)]
-- | append : ∀ {l₁ l₂ l₃ l₄}, rel l₁ l₂ → rel l₃ l₄ → rel (l₁ ++ l₃) (l₂ ++ l₄)
-- | symm : ∀ {l₁ l₂}, rel l₁ l₂ → rel l₂ l₁
-- | trans : ∀ {l₁ l₂ l₃}, rel l₁ l₂ → rel l₂ l₃ → rel l₁ l₃

-- attribute [refl] rel.refl
-- attribute [symm] rel.symm
-- attribute [trans] rel.trans

-- -- @[refl] lemma rel.refl : ∀ l : list (α × ℤ), rel l l := sorry

-- lemma rel_rcons_cons : ∀ (a : α × ℤ) (l : list (α × ℤ)),
--   rel (rcons a l) (a::l)
-- | a [] := rel.refl _
-- | (a, i) ((b,j)::l) := begin
--   rw rcons,
--   split_ifs,
--   { replace h : a = b := h, subst h,
--     show rel ([] ++ l) ([(a,i), (a, j)]  ++ l),
--     refine rel.append _ (rel.refl _),
--     symmetry,
--     exact rel.add.trans (h_1.symm ▸ rel.zero) },
--   { replace h : a = b := h, subst h,
--     show rel ([(a, i + j)] ++ l) ([(a, i), (a, j)] ++ l),
--     exact rel.append rel.add.symm (rel.refl _) },
--   { refl },
-- end

-- lemma rel_cons_of_rel {l₁ l₂ : list (α × ℤ)} (h : rel l₁ l₂) (a : α × ℤ) :
--   rel (a :: l₁) (a :: l₂) :=
-- show rel ([a] ++ l₁) ([a] ++ l₂), from rel.append (rel.refl _) h

-- lemma rel_rcons_cons_of_rel {a : α × ℤ} {l₁ l₂ : list (α × ℤ)} (h : rel l₁ l₂) :
--   rel (rcons a l₁) (a ::l₂) :=
-- (rel_rcons_cons a l₁).trans (rel_cons_of_rel h _)

-- lemma rel_reduce : ∀ l : list (α × ℤ), rel l (reduce l)
-- | [] := rel.refl _
-- | ((a, i)::l) := begin
--   rw reduce,
--   split_ifs,
--   { replace h : i = 0 := h, subst h,
--     show rel ([(a, 0)] ++ l) ([] ++ reduce l),
--     exact rel.append rel.zero (rel_reduce _) },
--   { exact (rel_rcons_cons_of_rel (rel_reduce _).symm).symm }
-- end

-- lemma reduce_eq_reduce_of_rel {l₁ l₂ : list (α × ℤ)} (h : rel l₁ l₂) : reduce l₁ = reduce l₂ :=
-- begin
--   induction h,
--   { refl },
--   { simp [reduce] },
--   { simp only [reduce],
--     split_ifs,
--     { refl },
--     { simp * at * },
--     { exfalso, omega },
--     { simp [rcons, *] },
--     { exfalso, omega },
--     { simp [rcons, *] },
--     { simp [rcons, *] },
--     { simp [rcons, *] } },
--   {  }

-- end

lemma reduce_eq_self_of_reduced : ∀ {l : list (α × ℤ)}, reduced l → reduce l = l
| []     h := rfl
| (a::l) h := by rw [← rcons_reduce_eq_reduce_cons (h.2 a (mem_cons_self _ _)),
    reduce_eq_self_of_reduced (reduced_of_reduced_cons h), rcons_eq_cons h]

lemma rcons_eq_reduce_cons {a : α × ℤ} {l : list (α × ℤ)}
  (ha : a.2 ≠ 0) (hl : reduced l) : rcons a l = reduce (a :: l) :=
by rw [← rcons_reduce_eq_reduce_cons ha, reduce_eq_self_of_reduced hl]

@[simp] lemma reduce_reduce (l : list (α × ℤ)) : reduce (reduce l) = reduce l :=
reduce_eq_self_of_reduced (reduced_reduce l)

@[simp] lemma reduce_cons_reduce_eq_reduce_cons (a : α × ℤ) (l : list (α × ℤ)) :
  reduce (a :: reduce l) = reduce (a :: l)  :=
if ha : a.2 = 0 then by rw [reduce, if_pos ha, reduce, if_pos ha, reduce_reduce]
else by rw [← rcons_reduce_eq_reduce_cons ha, ← rcons_reduce_eq_reduce_cons ha,
    reduce_reduce]

lemma length_rcons_le : ∀ (a : α × ℤ) (l : list (α × ℤ)),
  (rcons a l).length ≤ (a::l : list _).length
| a     []         := le_refl _
| (a,i) ((b,j)::l) := begin
  simp [rcons],
  split_ifs,
  { linarith },
  { simp },
  { simp }
end

lemma length_reduce_le : ∀ (l : list (α × ℤ)),
  (reduce l).length ≤ l.length
| []        := le_refl _
| [a]       := by { simp [reduce], split_ifs; simp [rcons] }
| (a::b::l) := begin
  simp only [reduce, rcons],
  split_ifs,
  { exact le_trans (length_reduce_le _)
      (le_trans (nat.le_succ _) (nat.le_succ _)) },
  { exact le_trans (length_rcons_le _ _) (nat.succ_le_succ
      (le_trans (length_reduce_le _) (nat.le_succ _))) },
  { exact le_trans (length_rcons_le _ _) (nat.succ_le_succ
      (le_trans (length_reduce_le _) (nat.le_succ _))) },
  { exact le_trans (length_rcons_le _ _) (nat.succ_le_succ
         (le_trans (length_rcons_le _ _) (nat.succ_le_succ
           (length_reduce_le _)))) }
end

lemma length_rcons_lt_or_eq_rcons : ∀ (a : α × ℤ) (l : list (α × ℤ)),
  (rcons a l).length < (a :: l : list _).length ∨ rcons a l = (a::l)
| a [] := or.inr rfl
| a (b::l) := begin
  simp only [rcons],
  split_ifs,
  { exact or.inl (nat.lt_succ_of_le (nat.le_succ _)) },
  { exact or.inl (nat.lt_succ_self _) },
  { simp }
end

lemma length_reduce_lt_or_eq_reduce : ∀ (l : list (α × ℤ)),
  (reduce l).length < l.length ∨ reduce l = l
| []        := or.inr rfl
| (a::l)    := begin
  simp only [reduce],
  split_ifs,
  { exact or.inl (nat.lt_succ_of_le (length_reduce_le _)) },
  { cases length_rcons_lt_or_eq_rcons a (reduce l) with h h,
    { exact or.inl (lt_of_lt_of_le h (nat.succ_le_succ (length_reduce_le _))) },
    { rw h,
      cases length_reduce_lt_or_eq_reduce l with h h,
      { exact or.inl (nat.succ_lt_succ h) },
      { rw h, right, refl } } }
end

lemma rcons_append : ∀ {a b : α × ℤ} {l₁ l₂ : list (α × ℤ)},
  rcons a ((b::l₁) ++ l₂) = rcons a (b::l₁) ++ l₂
| a b [] l₂ := begin
  simp [rcons], split_ifs; simp
end
| a b (c::l₁) l₂ := begin
  rw [cons_append, rcons],
  dsimp,
  split_ifs,
  { simp [rcons, *] },
  { simp [rcons, *] },
  { simp [rcons, *] }
end

lemma rcons_rcons_of_add_eq_zero {a : α} {i j : ℤ} : ∀ {l : list (α × ℤ)},
  i + j = 0 → reduced l → rcons (a, i) (rcons (a, j) l) = l
| []          hij hl := by simp [rcons, hij]
| ((b, k)::l) hij hl := begin
  simp only [rcons],
  split_ifs,
  { rw [← rcons_eq_cons hl, show a = b, from h, show i = k, by omega] },
  { simp only [rcons, if_pos rfl],
    rw [if_neg, ← add_assoc, hij, zero_add, show a = b, from h],
    have hk0 : k ≠ 0 := hl.2 (b, k) (mem_cons_self _ _),
    omega },
  { rw [rcons, if_pos rfl], dsimp, rw [if_pos hij] }
end

lemma rcons_rcons_of_add_ne_zero {a : α} {i j : ℤ} : ∀ {l : list (α × ℤ)},
  i + j ≠ 0 → i ≠ 0 → reduced l → rcons (a, i) (rcons (a, j) l) = rcons (a, i + j) l
| []          hij hi hl := by simp [rcons, hij]
| [(b, k)]    hij hi hl := begin
  simp only [rcons],
  split_ifs,
  { exfalso, omega },
  { simp [rcons], omega },
  { simp only [rcons, ← add_assoc, *, if_pos rfl] },
  { simp only [rcons, if_pos rfl, ← add_assoc, *],
    simp },
  { simp [rcons, if_neg hij, if_pos rfl] }
end
| ((b, k)::(c, m)::l) hij hi hl := begin
  have hbc : b ≠ c, from (chain'_cons.1 hl.1).1,
  simp only [rcons],
  split_ifs,
  { exfalso, omega },
  { simp [*, rcons] at *, omega },
  { simp [*, rcons, ← add_assoc] at * },
  { simp [*, rcons, ← add_assoc] },
  { simp [*, rcons] }
end

lemma reduce_rcons : ∀ {a : α × ℤ} (l : list (α × ℤ)), a.2 ≠ 0 →
  reduce (rcons a l) = rcons a (reduce l)
| a []     ha := by simp [rcons, reduce, ha]
| (a, i) [(b, j)]    hi := begin
    replace hi : i ≠ 0 := hi,
    simp only [reduce, rcons],
    split_ifs; simp [reduce, rcons, *] at *
  end
| (a,i) ((b,j)::l) hi := begin
  simp only [rcons],
  split_ifs,
  { rw [reduce, if_neg, h,
      rcons_rcons_of_add_eq_zero h_1 (reduced_reduce _)],
    omega },
  { simp only [reduce, if_neg h_1, reduce],
    split_ifs,
    { simp [h_2] },
    { rw [h, rcons_rcons_of_add_ne_zero h_1 hi (reduced_reduce _)] } },
  { rw [rcons_eq_reduce_cons hi (reduced_reduce _), reduce_cons_reduce_eq_reduce_cons] }
end

@[simp] lemma reduce_reduce_append_eq_reduce_append : ∀ (l₁ l₂ : list (α × ℤ)),
  reduce (reduce l₁ ++ l₂) = reduce (l₁ ++ l₂)
| []         l₂ := rfl
| (a::l₁) l₂ := begin
  simp only [reduce, cons_append],
  split_ifs with ha ha,
  { exact reduce_reduce_append_eq_reduce_append _ _ },
  { rw [← reduce_reduce_append_eq_reduce_append l₁ l₂],
    induction h : reduce l₁,
    { simp [rcons, rcons_eq_reduce_cons ha (reduced_reduce _)] },
    { rw [← rcons_append, reduce_rcons _ ha] } }
end

@[simp] lemma reduce_append_reduce_eq_reduce_append : ∀ {l₁ l₂ : list (α × ℤ)},
  reduce (l₁ ++ reduce l₂) = reduce (l₁ ++ l₂)
| []      l₂ := by simp
| (a::l₁) l₂ := by rw [cons_append, ← reduce_cons_reduce_eq_reduce_cons,
    reduce_append_reduce_eq_reduce_append,
    reduce_cons_reduce_eq_reduce_cons, cons_append]

/- TODO: Speed up, not the best definition, no need to reduce entire first list. -/
def mul_aux : list (α × ℤ) → list (α × ℤ) → list (α × ℤ)
| []        l₂ := l₂
| (a :: l₁) l₂ := rcons a (mul_aux l₁ l₂)

lemma reduced_mul_aux : ∀ {l₁ l₂ : list (α × ℤ)}, reduced l₁ →
  reduced l₂ → reduced (mul_aux l₁ l₂)
| []      l₂ _  h  := h
| (a::l₁) l₂ h₁ h₂ := reduced_rcons
  (h₁.2 _ (mem_cons_self _ _))
  (reduced_mul_aux (reduced_of_reduced_cons h₁) h₂)

lemma mul_aux_eq_reduce_append : ∀ {l₁ l₂ : list (α × ℤ)}, reduced l₁ →
  reduced l₂ → mul_aux l₁ l₂ = reduce (l₁ ++ l₂)
| []      l₂ _  h  := by simp [reduce, mul_aux, reduce_eq_self_of_reduced h]
| (a::l₁) l₂ h₁ h₂ :=
  by rw [mul_aux, mul_aux_eq_reduce_append (reduced_of_reduced_cons h₁) h₂,
    rcons_reduce_eq_reduce_cons (h₁.2 a (mem_cons_self _ _)), cons_append]

lemma mul_aux_assoc {l₁ l₂ l₃ : list (α × ℤ)}
  (h₁ : reduced l₁) (h₂ : reduced l₂) (h₃ : reduced l₃) :
  mul_aux (mul_aux l₁ l₂) l₃ = mul_aux l₁ (mul_aux l₂ l₃) :=
begin
  rw [mul_aux_eq_reduce_append h₁ h₂, mul_aux_eq_reduce_append h₂ h₃,
    mul_aux_eq_reduce_append (reduced_reduce _) h₃,
    mul_aux_eq_reduce_append h₁ (reduced_reduce _)],
  simp [append_assoc]
end

instance : has_mul (free_group α) :=
⟨λ a b : free_group α, ⟨mul_aux a.1 b.1, reduced_mul_aux a.2 b.2⟩⟩

def inv_aux (l : list (α × ℤ)) : list (α × ℤ) :=
l.reverse.map (λ a, (a.1, -a.2))

lemma inv_aux_cons (a : α) (i : ℤ) (l : list (α × ℤ)) :
  inv_aux ((a, i) :: l) = inv_aux l ++ [(a, -i)] :=
by  simp [inv_aux]

lemma reduced_inv_aux {l : list (α × ℤ)} (hl : reduced l) : reduced (inv_aux l) :=
⟨(list.chain'_map _).2 (list.chain'_reverse.2 begin
  convert hl.1, simp [function.funext_iff, eq_comm],
end), begin
  rintros ⟨a, i⟩ ha,
  have := hl.2 (a, -i),
  finish [inv_aux]
end⟩

instance : has_inv (free_group α) :=
⟨λ a, ⟨inv_aux a.1, reduced_inv_aux a.2⟩⟩

lemma mul_aux_inv_aux_cancel : ∀ {l : list (α × ℤ)}, reduced l →
  mul_aux l (inv_aux l) = []
| []          hl := rfl
| ((a, i)::l) hal :=
have hi : i ≠ 0, from hal.2 (a, i) (mem_cons_self _ _),
have hl : reduced l, from reduced_of_reduced_cons hal,
begin
  rw [mul_aux_eq_reduce_append hal (reduced_inv_aux hal), inv_aux_cons, cons_append,
    ← append_assoc, ← reduce_cons_reduce_eq_reduce_cons,
    ← reduce_reduce_append_eq_reduce_append, reduce_cons_reduce_eq_reduce_cons,
    ← mul_aux_eq_reduce_append hl (reduced_inv_aux hl), mul_aux_inv_aux_cancel hl],
  simp [reduce, hi, rcons]
end

instance : group (free_group α) :=
{ mul := (*),
  inv := has_inv.inv,
  one := 1,
  mul_assoc := λ a b c, subtype.eq (mul_aux_assoc a.2 b.2 c.2),
  one_mul := λ ⟨_, _⟩, rfl,
  mul_one := λ ⟨_, _⟩, sorry,
  mul_left_inv := sorry }

lemma mul_def (a b : free_group α) : a * b = ⟨mul_aux a.1 b.1, reduced_mul_aux a.2 b.2⟩ := rfl

def of (a : α) : free_group α := ⟨[(a, 1)], by simp [reduced] { contextual := tt }⟩

@[elab_as_eliminator] lemma induction_on {P : free_group α → Prop}
  (g : free_group α)
  (h1 : P 1)
  (atom : ∀ a, P (of a))
  (atom_inv : ∀ a, P (of a)⁻¹)
  (hmul : ∀ a g, P g → P (of a * g)) :
  P g :=
begin
  cases g with l hl,
  induction l with a l ihl,
  { exact h1 },
  { cases a with a i,
    induction i using int.induction_on with i ihi i ihi,
    { simpa [reduced] using hl },
    { by_cases hi : i = 0,
      { subst i,
        convert hmul a ⟨l, reduced_of_reduced_cons hl⟩ (ihl (reduced_of_reduced_cons hl)),
        rw [mul_aux_eq_reduce_append (of a).2 (reduced_of_reduced_cons hl), of,
          cons_append, nil_append, ← reduce_eq_self_of_reduced hl, int.coe_nat_zero, zero_add] },
      { have hil : reduced ((a, i) :: l),
          from reduced_cons_of_reduced_cons hl (by norm_cast; exact hi),
        convert hmul a ⟨(a, i) :: l, hil⟩ (ihi hil),
        rw [mul_aux_eq_reduce_append (of a).2 hil, of, cons_append, nil_append,
          reduce, if_neg, reduce, if_neg, rcons_rcons_of_add_ne_zero],
         }, }
  }
end

variables {β : Type*} [decidable_eq β] (e : α → β)

def map : free_group α →* free_group β :=
{ to_fun := λ ⟨l, hl⟩, ⟨l.map e, _⟩ }

end free_group


/-
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.order.field.pi
import analysis.normed.group.pointwise
import analysis.normed.order.basic
import topology.algebra.order.upper_lower

/-!
# Upper/lower/order-connected sets in normed groups

The topological closure and interior of an upper/lower/order-connected set is an
upper/lower/order-connected set (with the notable exception of the closure of an order-connected
set).

We also prove lemmas specific to `ℝⁿ`. Those are helpful to prove that order-connected sets in `ℝⁿ`
are measurable.
-/

open function metric set

variables {α ι : Type*}

section metric_space
variables [normed_ordered_group α] {s : set α}

@[to_additive is_upper_set.thickening]
protected lemma is_upper_set.thickening' (hs : is_upper_set s) (ε : ℝ) :
  is_upper_set (thickening ε s) :=
by { rw ←ball_mul_one, exact hs.mul_left }

@[to_additive is_lower_set.thickening]
protected lemma is_lower_set.thickening' (hs : is_lower_set s) (ε : ℝ) :
  is_lower_set (thickening ε s) :=
by { rw ←ball_mul_one, exact hs.mul_left }

@[to_additive is_upper_set.cthickening]
protected lemma is_upper_set.cthickening' (hs : is_upper_set s) (ε : ℝ) :
  is_upper_set (cthickening ε s) :=
by { rw cthickening_eq_Inter_thickening'', exact is_upper_set_Inter₂ (λ δ hδ, hs.thickening' _) }

@[to_additive is_lower_set.cthickening]
protected lemma is_lower_set.cthickening' (hs : is_lower_set s) (ε : ℝ) :
  is_lower_set (cthickening ε s) :=
by { rw cthickening_eq_Inter_thickening'', exact is_lower_set_Inter₂ (λ δ hδ, hs.thickening' _) }

end metric_space

/-! ### `ℝⁿ` -/

section finite
variables [finite ι] {s : set (ι → ℝ)} {x y : ι → ℝ} {δ : ℝ}

lemma is_upper_set.mem_interior_of_forall_lt (hs : is_upper_set s) (hx : x ∈ closure s)
  (h : ∀ i, x i < y i) :
  y ∈ interior s :=
begin
  casesI nonempty_fintype ι,
  obtain ⟨ε, hε, hxy⟩ := pi.exists_forall_pos_add_lt h,
  obtain ⟨z, hz, hxz⟩ := metric.mem_closure_iff.1 hx _ hε,
  rw dist_pi_lt_iff hε at hxz,
  have hyz : ∀ i, z i < y i,
  { refine λ i, (hxy _).trans_le' (sub_le_iff_le_add'.1 $ (le_abs_self _).trans _),
    rw [←real.norm_eq_abs, ←dist_eq_norm'],
    exact (hxz _).le },
  obtain ⟨δ, hδ, hyz⟩ := pi.exists_forall_pos_add_lt hyz,
  refine mem_interior.2 ⟨ball y δ, _, is_open_ball, mem_ball_self hδ⟩,
  rintro w hw,
  refine hs (λ i, _) hz,
  simp_rw [ball_pi _ hδ, real.ball_eq_Ioo] at hw,
  exact ((lt_sub_iff_add_lt.2 $ hyz _).trans (hw _ $ mem_univ _).1).le,
end

lemma is_lower_set.mem_interior_of_forall_lt (hs : is_lower_set s) (hx : x ∈ closure s)
  (h : ∀ i, y i < x i) :
  y ∈ interior s :=
begin
  casesI nonempty_fintype ι,
  obtain ⟨ε, hε, hxy⟩ := pi.exists_forall_pos_add_lt h,
  obtain ⟨z, hz, hxz⟩ := metric.mem_closure_iff.1 hx _ hε,
  rw dist_pi_lt_iff hε at hxz,
  have hyz : ∀ i, y i < z i,
  { refine λ i, (lt_sub_iff_add_lt.2 $ hxy _).trans_le (sub_le_comm.1 $ (le_abs_self _).trans _),
    rw [←real.norm_eq_abs, ←dist_eq_norm],
    exact (hxz _).le },
  obtain ⟨δ, hδ, hyz⟩ := pi.exists_forall_pos_add_lt hyz,
  refine mem_interior.2 ⟨ball y δ, _, is_open_ball, mem_ball_self hδ⟩,
  rintro w hw,
  refine hs (λ i, _) hz,
  simp_rw [ball_pi _ hδ, real.ball_eq_Ioo] at hw,
  exact ((hw _ $ mem_univ _).2.trans $ hyz _).le,
end

end finite

section fintype
variables [fintype ι] {s : set (ι → ℝ)} {x y : ι → ℝ} {δ : ℝ}

lemma is_upper_set.exists_subset_ball (hs : is_upper_set s) (hx : x ∈ closure s) (hδ : 0 < δ) :
  ∃ y, closed_ball y (δ/4) ⊆ closed_ball x δ ∧ closed_ball y (δ/4) ⊆ interior s :=
begin
  refine ⟨x + const _ (3/4*δ), closed_ball_subset_closed_ball' _, _⟩,
  { rw dist_self_add_left,
    refine (add_le_add_left (pi_norm_const_le $ 3 / 4 * δ) _).trans_eq _,
    simp [real.norm_of_nonneg, hδ.le, zero_le_three],
    ring_nf },
  obtain ⟨y, hy, hxy⟩ := metric.mem_closure_iff.1 hx _ (div_pos hδ zero_lt_four),
  refine λ z hz, hs.mem_interior_of_forall_lt (subset_closure hy) (λ i, _),
  rw [mem_closed_ball, dist_eq_norm'] at hz,
  rw dist_eq_norm at hxy,
  replace hxy := (norm_le_pi_norm _ i).trans hxy.le,
  replace hz := (norm_le_pi_norm _ i).trans hz,
  dsimp at hxy hz,
  rw abs_sub_le_iff at hxy hz,
  linarith,
end

lemma is_lower_set.exists_subset_ball (hs : is_lower_set s) (hx : x ∈ closure s) (hδ : 0 < δ) :
  ∃ y, closed_ball y (δ/4) ⊆ closed_ball x δ ∧ closed_ball y (δ/4) ⊆ interior s :=
begin
  refine ⟨x - const _ (3/4*δ), closed_ball_subset_closed_ball' _, _⟩,
  { rw dist_self_sub_left,
    refine (add_le_add_left (pi_norm_const_le $ 3 / 4 * δ) _).trans_eq _,
    simp [real.norm_of_nonneg, hδ.le, zero_le_three],
    ring_nf },
  obtain ⟨y, hy, hxy⟩ := metric.mem_closure_iff.1 hx _ (div_pos hδ zero_lt_four),
  refine λ z hz, hs.mem_interior_of_forall_lt (subset_closure hy) (λ i, _),
  rw [mem_closed_ball, dist_eq_norm'] at hz,
  rw dist_eq_norm at hxy,
  replace hxy := (norm_le_pi_norm _ i).trans hxy.le,
  replace hz := (norm_le_pi_norm _ i).trans hz,
  dsimp at hxy hz,
  rw abs_sub_le_iff at hxy hz,
  linarith,
end

end fintype


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz

! This file was ported from Lean 3 source module category_theory.sites.plus
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.Sheaf

/-!

# The plus construction for presheaves.

This file contains the construction of `P⁺`, for a presheaf `P : Cᵒᵖ ⥤ D`
where `C` is endowed with a grothendieck topology `J`.

See <https://stacks.math.columbia.edu/tag/00W1> for details.

-/

namespace CategoryTheory.GrothendieckTopology

open CategoryTheory

open CategoryTheory.Limits

open Opposite

universe w v u

variable {C : Type u} [Category.{v} C] (J : GrothendieckTopology C)

variable {D : Type w} [Category.{max v u} D]

noncomputable section

variable [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), HasMultiequalizer (S.index P)]

variable (P : Cᵒᵖ ⥤ D)

/-- The diagram whose colimit defines the values of `plus`. -/
@[simps]
def diagram (X : C) : (J.cover X)ᵒᵖ ⥤ D
    where
  obj S := multiequalizer (S.unop.index P)
  map S T f :=
    Multiequalizer.lift _ _ (fun I => Multiequalizer.ι (S.unop.index P) (I.map f.unop)) fun I =>
      Multiequalizer.condition (S.unop.index P) (I.map f.unop)
  map_id' S := by
    ext I
    cases I
    simpa
  map_comp' S T W f g := by
    ext I
    simpa
#align category_theory.grothendieck_topology.diagram CategoryTheory.GrothendieckTopology.diagram

/-- A helper definition used to define the morphisms for `plus`. -/
@[simps]
def diagramPullback {X Y : C} (f : X ⟶ Y) : J.diagram P Y ⟶ (J.pullback f).op ⋙ J.diagram P X
    where
  app S :=
    Multiequalizer.lift _ _ (fun I => Multiequalizer.ι (S.unop.index P) I.base) fun I =>
      Multiequalizer.condition (S.unop.index P) I.base
  naturality' S T f := by
    ext
    dsimp
    simpa
#align category_theory.grothendieck_topology.diagram_pullback CategoryTheory.GrothendieckTopology.diagramPullback

/-- A natural transformation `P ⟶ Q` induces a natural transformation
between diagrams whose colimits define the values of `plus`. -/
@[simps]
def diagramNatTrans {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (X : C) : J.diagram P X ⟶ J.diagram Q X
    where
  app W :=
    Multiequalizer.lift _ _ (fun i => Multiequalizer.ι _ i ≫ η.app _)
      (by
        intro i
        erw [category.assoc, category.assoc, ← η.naturality, ← η.naturality, ← category.assoc, ←
          category.assoc, multiequalizer.condition]
        rfl)
  naturality' _ _ _ := by
    dsimp
    ext
    simpa
#align category_theory.grothendieck_topology.diagram_nat_trans CategoryTheory.GrothendieckTopology.diagramNatTrans

@[simp]
theorem diagramNatTrans_id (X : C) (P : Cᵒᵖ ⥤ D) : J.diagramNatTrans (𝟙 P) X = 𝟙 (J.diagram P X) :=
  by
  ext
  dsimp
  simp only [multiequalizer.lift_ι, category.id_comp]
  erw [category.comp_id]
#align category_theory.grothendieck_topology.diagram_nat_trans_id CategoryTheory.GrothendieckTopology.diagramNatTrans_id

@[simp]
theorem diagramNatTrans_zero [Preadditive D] (X : C) (P Q : Cᵒᵖ ⥤ D) :
    J.diagramNatTrans (0 : P ⟶ Q) X = 0 := by
  ext (j x)
  dsimp
  rw [zero_comp, multiequalizer.lift_ι, comp_zero]
#align category_theory.grothendieck_topology.diagram_nat_trans_zero CategoryTheory.GrothendieckTopology.diagramNatTrans_zero

@[simp]
theorem diagramNatTrans_comp {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R) (X : C) :
    J.diagramNatTrans (η ≫ γ) X = J.diagramNatTrans η X ≫ J.diagramNatTrans γ X :=
  by
  ext
  dsimp
  simp
#align category_theory.grothendieck_topology.diagram_nat_trans_comp CategoryTheory.GrothendieckTopology.diagramNatTrans_comp

variable (D)

/-- `J.diagram P`, as a functor in `P`. -/
@[simps]
def diagramFunctor (X : C) : (Cᵒᵖ ⥤ D) ⥤ (J.cover X)ᵒᵖ ⥤ D
    where
  obj P := J.diagram P X
  map P Q η := J.diagramNatTrans η X
  map_id' P := J.diagramNatTrans_id _ _
  map_comp' P Q R η γ := J.diagramNatTrans_comp _ _ _
#align category_theory.grothendieck_topology.diagram_functor CategoryTheory.GrothendieckTopology.diagramFunctor

variable {D}

variable [∀ X : C, HasColimitsOfShape (J.cover X)ᵒᵖ D]

/-- The plus construction, associating a presheaf to any presheaf.
See `plus_functor` below for a functorial version. -/
def plusObj : Cᵒᵖ ⥤ D where
  obj X := colimit (J.diagram P X.unop)
  map X Y f := colimMap (J.diagramPullback P f.unop) ≫ colimit.pre _ _
  map_id' := by
    intro X
    ext S
    dsimp
    simp only [diagram_pullback_app, colimit.ι_pre, ι_colim_map_assoc, category.comp_id]
    let e := S.unop.pullback_id
    dsimp only [functor.op, pullback_obj]
    erw [← colimit.w _ e.inv.op, ← category.assoc]
    convert category.id_comp _
    ext I
    dsimp
    simp only [multiequalizer.lift_ι, category.id_comp, category.assoc]
    dsimp [cover.arrow.map, cover.arrow.base]
    cases I
    congr
    simp
  map_comp' := by
    intro X Y Z f g
    ext S
    dsimp
    simp only [diagram_pullback_app, colimit.ι_pre_assoc, colimit.ι_pre, ι_colim_map_assoc,
      category.assoc]
    let e := S.unop.pullback_comp g.unop f.unop
    dsimp only [functor.op, pullback_obj]
    erw [← colimit.w _ e.inv.op, ← category.assoc, ← category.assoc]
    congr 1
    ext I
    dsimp
    simp only [multiequalizer.lift_ι, category.assoc]
    cases I
    dsimp only [cover.arrow.base, cover.arrow.map]
    congr 2
    simp
#align category_theory.grothendieck_topology.plus_obj CategoryTheory.GrothendieckTopology.plusObj

/-- An auxiliary definition used in `plus` below. -/
def plusMap {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) : J.plusObj P ⟶ J.plusObj Q
    where
  app X := colimMap (J.diagramNatTrans η X.unop)
  naturality' := by
    intro X Y f
    dsimp [plus_obj]
    ext
    simp only [diagram_pullback_app, ι_colim_map, colimit.ι_pre_assoc, colimit.ι_pre,
      ι_colim_map_assoc, category.assoc]
    simp_rw [← category.assoc]
    congr 1
    ext
    dsimp
    simpa
#align category_theory.grothendieck_topology.plus_map CategoryTheory.GrothendieckTopology.plusMap

@[simp]
theorem plusMap_id (P : Cᵒᵖ ⥤ D) : J.plusMap (𝟙 P) = 𝟙 _ :=
  by
  ext x : 2
  dsimp only [plus_map, plus_obj]
  rw [J.diagram_nat_trans_id, nat_trans.id_app]
  ext
  dsimp
  simp
#align category_theory.grothendieck_topology.plus_map_id CategoryTheory.GrothendieckTopology.plusMap_id

@[simp]
theorem plusMap_zero [Preadditive D] (P Q : Cᵒᵖ ⥤ D) : J.plusMap (0 : P ⟶ Q) = 0 :=
  by
  ext
  erw [comp_zero, colimit.ι_map, J.diagram_nat_trans_zero, zero_comp]
#align category_theory.grothendieck_topology.plus_map_zero CategoryTheory.GrothendieckTopology.plusMap_zero

@[simp]
theorem plusMap_comp {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R) :
    J.plusMap (η ≫ γ) = J.plusMap η ≫ J.plusMap γ :=
  by
  ext : 2
  dsimp only [plus_map]
  rw [J.diagram_nat_trans_comp]
  ext
  dsimp
  simp
#align category_theory.grothendieck_topology.plus_map_comp CategoryTheory.GrothendieckTopology.plusMap_comp

variable (D)

/-- The plus construction, a functor sending `P` to `J.plus_obj P`. -/
@[simps]
def plusFunctor : (Cᵒᵖ ⥤ D) ⥤ Cᵒᵖ ⥤ D
    where
  obj P := J.plusObj P
  map P Q η := J.plusMap η
  map_id' _ := plusMap_id _ _
  map_comp' _ _ _ _ _ := plusMap_comp _ _ _
#align category_theory.grothendieck_topology.plus_functor CategoryTheory.GrothendieckTopology.plusFunctor

variable {D}

/-- The canonical map from `P` to `J.plus.obj P`.
See `to_plus` for a functorial version. -/
def toPlus : P ⟶ J.plusObj P
    where
  app X := Cover.toMultiequalizer (⊤ : J.cover X.unop) P ≫ colimit.ι (J.diagram P X.unop) (op ⊤)
  naturality' := by
    intro X Y f
    dsimp [plus_obj]
    delta cover.to_multiequalizer
    simp only [diagram_pullback_app, colimit.ι_pre, ι_colim_map_assoc, category.assoc]
    dsimp only [functor.op, unop_op]
    let e : (J.pullback f.unop).obj ⊤ ⟶ ⊤ := hom_of_le (OrderTop.le_top _)
    rw [← colimit.w _ e.op, ← category.assoc, ← category.assoc, ← category.assoc]
    congr 1
    ext
    dsimp
    simp only [multiequalizer.lift_ι, category.assoc]
    dsimp [cover.arrow.base]
    simp
#align category_theory.grothendieck_topology.to_plus CategoryTheory.GrothendieckTopology.toPlus

@[simp, reassoc.1]
theorem toPlus_naturality {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) : η ≫ J.toPlus Q = J.toPlus _ ≫ J.plusMap η :=
  by
  ext
  dsimp [to_plus, plus_map]
  delta cover.to_multiequalizer
  simp only [ι_colim_map, category.assoc]
  simp_rw [← category.assoc]
  congr 1
  ext
  dsimp
  simp
#align category_theory.grothendieck_topology.to_plus_naturality CategoryTheory.GrothendieckTopology.toPlus_naturality

variable (D)

/-- The natural transformation from the identity functor to `plus`. -/
@[simps]
def toPlusNatTrans : 𝟭 (Cᵒᵖ ⥤ D) ⟶ J.plusFunctor D
    where
  app P := J.toPlus P
  naturality' _ _ _ := toPlus_naturality _ _
#align category_theory.grothendieck_topology.to_plus_nat_trans CategoryTheory.GrothendieckTopology.toPlusNatTrans

variable {D}

/-- `(P ⟶ P⁺)⁺ = P⁺ ⟶ P⁺⁺` -/
@[simp]
theorem plusMap_toPlus : J.plusMap (J.toPlus P) = J.toPlus (J.plusObj P) :=
  by
  ext (X S)
  dsimp [to_plus, plus_obj, plus_map]
  delta cover.to_multiequalizer
  simp only [ι_colim_map]
  let e : S.unop ⟶ ⊤ := hom_of_le (OrderTop.le_top _)
  simp_rw [← colimit.w _ e.op, ← category.assoc]
  congr 1
  ext I
  dsimp
  simp only [diagram_pullback_app, colimit.ι_pre, multiequalizer.lift_ι, ι_colim_map_assoc,
    category.assoc]
  dsimp only [functor.op]
  let ee : (J.pullback (I.map e).f).obj S.unop ⟶ ⊤ := hom_of_le (OrderTop.le_top _)
  simp_rw [← colimit.w _ ee.op, ← category.assoc]
  congr 1
  ext II
  dsimp
  simp only [limit.lift_π, multifork.of_ι_π_app, multiequalizer.lift_ι, category.assoc]
  dsimp [multifork.of_ι]
  convert multiequalizer.condition (S.unop.index P)
      ⟨_, _, _, II.f, 𝟙 _, I.f, II.f ≫ I.f, I.hf, sieve.downward_closed _ I.hf _, by simp⟩
  · cases I
    rfl
  · dsimp [cover.index]
    erw [P.map_id, category.comp_id]
    rfl
#align category_theory.grothendieck_topology.plus_map_to_plus CategoryTheory.GrothendieckTopology.plusMap_toPlus

theorem isIso_toPlus_of_isSheaf (hP : Presheaf.IsSheaf J P) : IsIso (J.toPlus P) :=
  by
  rw [presheaf.is_sheaf_iff_multiequalizer] at hP
  rsuffices : ∀ X, is_iso ((J.to_plus P).app X)
  · apply nat_iso.is_iso_of_is_iso_app
  intro X
  dsimp
  rsuffices : is_iso (colimit.ι (J.diagram P X.unop) (op ⊤))
  · apply is_iso.comp_is_iso
  rsuffices : ∀ (S T : (J.cover X.unop)ᵒᵖ) (f : S ⟶ T), is_iso ((J.diagram P X.unop).map f)
  · apply is_iso_ι_of_is_initial (initial_op_of_terminal is_terminal_top)
  intro S T e
  have : S.unop.to_multiequalizer P ≫ (J.diagram P X.unop).map e = T.unop.to_multiequalizer P :=
    by
    ext
    dsimp
    simpa
  have :
    (J.diagram P X.unop).map e = inv (S.unop.to_multiequalizer P) ≫ T.unop.to_multiequalizer P := by
    simp [← this]
  rw [this]
  infer_instance
#align category_theory.grothendieck_topology.is_iso_to_plus_of_is_sheaf CategoryTheory.GrothendieckTopology.isIso_toPlus_of_isSheaf

/-- The natural isomorphism between `P` and `P⁺` when `P` is a sheaf. -/
def isoToPlus (hP : Presheaf.IsSheaf J P) : P ≅ J.plusObj P :=
  letI := is_iso_to_plus_of_is_sheaf J P hP
  as_iso (J.to_plus P)
#align category_theory.grothendieck_topology.iso_to_plus CategoryTheory.GrothendieckTopology.isoToPlus

@[simp]
theorem isoToPlus_hom (hP : Presheaf.IsSheaf J P) : (J.isoToPlus P hP).Hom = J.toPlus P :=
  rfl
#align category_theory.grothendieck_topology.iso_to_plus_hom CategoryTheory.GrothendieckTopology.isoToPlus_hom

/-- Lift a morphism `P ⟶ Q` to `P⁺ ⟶ Q` when `Q` is a sheaf. -/
def plusLift {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (hQ : Presheaf.IsSheaf J Q) : J.plusObj P ⟶ Q :=
  J.plusMap η ≫ (J.isoToPlus Q hQ).inv
#align category_theory.grothendieck_topology.plus_lift CategoryTheory.GrothendieckTopology.plusLift

@[simp, reassoc.1]
theorem toPlus_plusLift {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (hQ : Presheaf.IsSheaf J Q) :
    J.toPlus P ≫ J.plusLift η hQ = η := by
  dsimp [plus_lift]
  rw [← category.assoc]
  rw [iso.comp_inv_eq]
  dsimp only [iso_to_plus, as_iso]
  rw [to_plus_naturality]
#align category_theory.grothendieck_topology.to_plus_plus_lift CategoryTheory.GrothendieckTopology.toPlus_plusLift

theorem plusLift_unique {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (hQ : Presheaf.IsSheaf J Q)
    (γ : J.plusObj P ⟶ Q) (hγ : J.toPlus P ≫ γ = η) : γ = J.plusLift η hQ :=
  by
  dsimp only [plus_lift]
  rw [iso.eq_comp_inv, ← hγ, plus_map_comp]
  dsimp
  simp
#align category_theory.grothendieck_topology.plus_lift_unique CategoryTheory.GrothendieckTopology.plusLift_unique

theorem plus_hom_ext {P Q : Cᵒᵖ ⥤ D} (η γ : J.plusObj P ⟶ Q) (hQ : Presheaf.IsSheaf J Q)
    (h : J.toPlus P ≫ η = J.toPlus P ≫ γ) : η = γ :=
  by
  have : γ = J.plus_lift (J.to_plus P ≫ γ) hQ :=
    by
    apply plus_lift_unique
    rfl
  rw [this]
  apply plus_lift_unique
  exact h
#align category_theory.grothendieck_topology.plus_hom_ext CategoryTheory.GrothendieckTopology.plus_hom_ext

@[simp]
theorem isoToPlus_inv (hP : Presheaf.IsSheaf J P) : (J.isoToPlus P hP).inv = J.plusLift (𝟙 _) hP :=
  by
  apply J.plus_lift_unique
  rw [iso.comp_inv_eq, category.id_comp]
  rfl
#align category_theory.grothendieck_topology.iso_to_plus_inv CategoryTheory.GrothendieckTopology.isoToPlus_inv

@[simp]
theorem plusMap_plusLift {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R) (hR : Presheaf.IsSheaf J R) :
    J.plusMap η ≫ J.plusLift γ hR = J.plusLift (η ≫ γ) hR :=
  by
  apply J.plus_lift_unique
  rw [← category.assoc, ← J.to_plus_naturality, category.assoc, J.to_plus_plus_lift]
#align category_theory.grothendieck_topology.plus_map_plus_lift CategoryTheory.GrothendieckTopology.plusMap_plusLift

instance plusFunctor_preservesZeroMorphisms [Preadditive D] :
    (plusFunctor J D).PreservesZeroMorphisms
    where map_zero' F G := by
    ext
    dsimp
    rw [J.plus_map_zero, nat_trans.app_zero]
#align category_theory.grothendieck_topology.plus_functor_preserves_zero_morphisms CategoryTheory.GrothendieckTopology.plusFunctor_preservesZeroMorphisms

end CategoryTheory.GrothendieckTopology