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

! This file was ported from Lean 3 source module data.finsupp.lex
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finsupp.Order
import Mathlib.Data.Dfinsupp.Lex
import Mathlib.Data.Finsupp.ToDfinsupp

/-!
# Lexicographic order on finitely supported functions

This file defines the lexicographic order on `Finsupp`.
-/

variable {α N : Type _}

namespace Finsupp

section NHasZero

variable [Zero N]

/-- `Finsupp.Lex r s` is the lexicographic relation on `α →₀ N`, where `α` is ordered by `r`,
and `N` is ordered by `s`.

The type synonym `Lex (α →₀ N)` has an order given by `Finsupp.Lex (· < ·) (· < ·)`.
-/
protected def Lex (r : α → α → Prop) (s : N → N → Prop) (x y : α →₀ N) : Prop :=
  Pi.Lex r s x y
#align finsupp.lex Finsupp.Lex

-- Porting note: Added `_root_` to better align with Lean 3.
theorem _root_.Pi.lex_eq_finsupp_lex {r : α → α → Prop} {s : N → N → Prop} (a b : α →₀ N) :
    Pi.Lex r s a b = Finsupp.Lex r s a b :=
  rfl
#align pi.lex_eq_finsupp_lex Pi.lex_eq_finsupp_lex

theorem lex_def {r : α → α → Prop} {s : N → N → Prop} {a b : α →₀ N} :
    Finsupp.Lex r s a b ↔ ∃ j, (∀ d, r d j → a d = b d) ∧ s (a j) (b j) :=
  Iff.rfl
#align finsupp.lex_def Finsupp.lex_def

theorem lex_eq_invImage_dfinsupp_lex (r : α → α → Prop) (s : N → N → Prop) :
    Finsupp.Lex r s = InvImage (Dfinsupp.Lex r fun _ ↦ s) toDfinsupp :=
  rfl
#align finsupp.lex_eq_inv_image_dfinsupp_lex Finsupp.lex_eq_invImage_dfinsupp_lex

instance [LT α] [LT N] : LT (Lex (α →₀ N)) :=
  ⟨fun f g ↦ Finsupp.Lex (· < ·) (· < ·) (ofLex f) (ofLex g)⟩

theorem lex_lt_of_lt_of_preorder [Preorder N] (r) [IsStrictOrder α r] {x y : α →₀ N} (hlt : x < y) :
    ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i :=
  Dfinsupp.lex_lt_of_lt_of_preorder r (id hlt : x.toDfinsupp < y.toDfinsupp)
#align finsupp.lex_lt_of_lt_of_preorder Finsupp.lex_lt_of_lt_of_preorder

theorem lex_lt_of_lt [PartialOrder N] (r) [IsStrictOrder α r] {x y : α →₀ N} (hlt : x < y) :
    Pi.Lex r (· < ·) x y :=
  Dfinsupp.lex_lt_of_lt r (id hlt : x.toDfinsupp < y.toDfinsupp)
#align finsupp.lex_lt_of_lt Finsupp.lex_lt_of_lt

instance Lex.isStrictOrder [LinearOrder α] [PartialOrder N] :
    IsStrictOrder (Lex (α →₀ N)) (· < ·) :=
  let i : IsStrictOrder (Lex (α → N)) (· < ·) := Pi.Lex.isStrictOrder
  { irrefl := toLex.surjective.forall.2 fun _ ↦ @irrefl _ _ i.toIsIrrefl _
    trans := toLex.surjective.forall₃.2 fun _ _ _ ↦ @trans _ _ i.toIsTrans _ _ _ }
#align finsupp.lex.is_strict_order Finsupp.Lex.isStrictOrder

variable [LinearOrder α]

/-- The partial order on `Finsupp`s obtained by the lexicographic ordering.
See `Finsupp.Lex.linearOrder` for a proof that this partial order is in fact linear. -/
instance Lex.partialOrder [PartialOrder N] : PartialOrder (Lex (α →₀ N)) :=
  PartialOrder.lift (fun x ↦ toLex (⇑(ofLex x))) (FunLike.coe_injective (F := Finsupp α N))
#align finsupp.lex.partial_order Finsupp.Lex.partialOrder

/-- The linear order on `Finsupp`s obtained by the lexicographic ordering. -/
instance Lex.linearOrder [LinearOrder N] : LinearOrder (Lex (α →₀ N)) :=
  { @Lex.partialOrder α N _ _ _,  -- Porting note: Added types to avoid typeclass inference problem.
    LinearOrder.lift' (toLex ∘ toDfinsupp ∘ ofLex) finsuppEquivDfinsupp.injective with }
#align finsupp.lex.linear_order Finsupp.Lex.linearOrder

variable [PartialOrder N]

theorem toLex_monotone : Monotone (@toLex (α →₀ N)) :=
  fun a b h ↦ Dfinsupp.toLex_monotone (id h : ∀ i, ofLex (toDfinsupp a) i ≤ ofLex (toDfinsupp b) i)
#align finsupp.to_lex_monotone Finsupp.toLex_monotone

end NHasZero

section Covariants

variable [LinearOrder α] [AddMonoid N] [LinearOrder N]

/-!  We are about to sneak in a hypothesis that might appear to be too strong.
We assume `CovariantClass` with *strict* inequality `<` also when proving the one with the
*weak* inequality `≤`.  This is actually necessary: addition on `Lex (α →₀ N)` may fail to be
monotone, when it is "just" monotone on `N`.

See `counterexamples.zero_divisors_in_add_monoid_algebras` for a counterexample. -/

section Left

variable [CovariantClass N N (· + ·) (· < ·)]

instance Lex.covariantClass_lt_left :
    CovariantClass (Lex (α →₀ N)) (Lex (α →₀ N)) (· + ·) (· < ·) :=
  ⟨fun _ _ _ ⟨a, lta, ha⟩ ↦ ⟨a, fun j ja ↦ congr_arg _ (lta j ja), add_lt_add_left ha _⟩⟩
#align finsupp.lex.covariant_class_lt_left Finsupp.Lex.covariantClass_lt_left

instance Lex.covariantClass_le_left :
    CovariantClass (Lex (α →₀ N)) (Lex (α →₀ N)) (· + ·) (· ≤ ·) :=
  Add.to_covariantClass_left _
#align finsupp.lex.covariant_class_le_left Finsupp.Lex.covariantClass_le_left

end Left

section Right

variable [CovariantClass N N (Function.swap (· + ·)) (· < ·)]

instance Lex.covariantClass_lt_right :
    CovariantClass (Lex (α →₀ N)) (Lex (α →₀ N)) (Function.swap (· + ·)) (· < ·) :=
  ⟨fun f _ _ ⟨a, lta, ha⟩ ↦
    ⟨a, fun j ja ↦ congr_arg (· + ofLex f j) (lta j ja), add_lt_add_right ha _⟩⟩
#align finsupp.lex.covariant_class_lt_right Finsupp.Lex.covariantClass_lt_right

instance Lex.covariantClass_le_right :
    CovariantClass (Lex (α →₀ N)) (Lex (α →₀ N)) (Function.swap (· + ·)) (· ≤ ·) :=
  Add.to_covariantClass_right _
#align finsupp.lex.covariant_class_le_right Finsupp.Lex.covariantClass_le_right

end Right

end Covariants

end Finsupp


-- 1
section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable  h : ∀x, P x → P (f x)

  example : ∀y, P y → P (f (f y)) :=
  assume y,
  assume Py,
  have Pfy : P (f y), from h y Py,
  h (f y) Pfy
end

-- 2
section
  variable U : Type
  variables A B : U → Prop

  example : (∀x, A x ∧ B x) → ∀x, A x :=
  assume h1 : (∀ x, A x ∧ B x),
  assume x,
  have AxBx : A x ∧ B x, from h1 x,
  show A x, from and.elim_left AxBx
end

-- 3
section
  variable U : Type
  variables A B C : U → Prop

  variable h1 : ∀x, A x ∨ B x
  variable h2 : ∀x, A x → C x
  variable h3 : ∀x, B x → C x

  example : ∀x, C x :=
  assume x,
  or.elim (h1 x)
      (assume Ax, h2 x Ax)
      (assume Bx, h3 x Bx)
end

-- 4
open classical

axiom not_iff_not_self (P : Prop) : ¬(P ↔ ¬P)

example (Q : Prop) : ¬(Q ↔ ¬Q) :=
not_iff_not_self Q

section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀x, shaves barber x ↔ ¬shaves x x

  example : false :=
  (not_iff_not_self (shaves barber barber)) (h barber)
end

-- 5
section
  variable U : Type
  variables A B : U → Prop

  example : (∃x, A x) → ∃x, A x ∨ B x :=
  assume Ax,
  exists.elim Ax $
  assume x Ax,
  have A x ∨ B x, from or.inl Ax,
  exists.intro x ‹A x ∨ B x›
end

-- 6
section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀x, A x → B x
  variable h2 : ∃x, A x

  example : ∃x, B x :=
  exists.elim h2 $
  assume x Ax,
  exists.intro x (h1 x Ax)
end

-- 7
section
  variable  U : Type
  variables A B C : U → Prop

  example (h1 : ∃x, A x ∧ B x) (h2 : ∀x, B x → C x) :
      ∃x, A x ∧ C x :=
      exists.elim h1 $
      assume x AxBx,
      have A x, from and.elim_left AxBx,
      have B x, from and.elim_right AxBx,
      have C x, from h2 x ‹B x›,
      exists.intro x ⟨‹A x›, ‹C x›⟩
end

-- 8
section
  variable  U : Type
  variables A B C : U → Prop

  example : (¬∃x, A x) → ∀x, ¬A x :=
  assume h1 : ¬ ∃ x, A x,
  assume x,
  assume : A x,
  have h2 : ∃ x, A x, from exists.intro x ‹A x›,
  h1 h2
end

-- 9
section
  variable  U : Type
  variables A B C : U → Prop

  example : (∀x, ¬A x) → ¬∃x, A x :=
  assume h1 : ∀ x, ¬ A x,
  assume h2 : ∃ x, A x,
  exists.elim h2 $
  assume x (_ : A x),
  have ¬ A x, from h1 x,
  show false, from ‹¬ A x› ‹A x›
end

-- 10
section
  variable  U : Type
  variables R : U → U → Prop

  example : (∃x, ∀y, R x y) → ∀y, ∃x, R x y :=
    assume h1 : ∃ x, ∀ y, R x y,
   exists.elim h1 $
   assume x (h2 : ∀ y, R x y),
   assume y,
   have R x y, from h2 y,
   exists.intro x ‹R x y›
end


import data.real.basic
import topology.continuous_on
import topology.instances.real
import topology.basic
import tactic
import lecture1

open filter
open_locale filter topological_space

/-
One alternative definition of what a countinuous function is that if xₙ → a, then f(xₙ) → f(a).

For now, we will use the mathlib definition of continuity, and show that it implies this.
-/
lemma tendsto_comp_of_continuous_at {a : ℝ} {f : ℝ → ℝ} (hf : continuous_at f a)
  {x : ℕ → ℝ} (hx : tendsto x at_top (𝓝 a)) : tendsto (f ∘ x) at_top (𝓝 (f a)) :=
begin
  rw metric.continuous_at_iff at hf,
  rw metric.tendsto_at_top at ⊢ hx,
  intros ε hε,
  rcases hf ε hε with ⟨δ, hδpos, hδ⟩,
  rcases hx δ hδpos with ⟨N, hN⟩,
  use N,
  intros n hn,
  exact hδ (hN _ hn),
end

/-
Squeeze
-/
lemma tendsto_of_le_of_le {x y z : ℕ → ℝ} {t : ℝ} (hx : tendsto x at_top (𝓝 t))
  (hz : tendsto z at_top (𝓝 t)) (hxy : ∀ n, x n ≤ y n) (hyz : ∀ n, y n ≤ z n) :
  tendsto y at_top (𝓝 t) :=
begin
  rw tendsto_seq_iff at *,
  intros ε hε,
  cases hx (ε/2) (half_pos hε) with N₁ hN₁,
  cases hz (ε/2) (half_pos hε) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  specialize hxy n,
  specialize hyz n,
  specialize hN₁ n (le_of_max_le_left hn),
  specialize hN₂ n (le_of_max_le_right hn),
  rw abs_sub_lt_iff at *,
  cases hN₁ with hN₁ hN₁',
  cases hN₂ with hN₂ hN₂',
  split;
  linarith,
end

/-
If the sequence us bounded below, then so is its limit
-/
lemma tendsto_lim_le_of_le' {x : ℕ → ℝ} {a A : ℝ} (hx₁ : ∀ n, A ≤ x n)
  (hx₂ : tendsto x at_top (𝓝 a)) : A ≤ a :=
begin
  by_contra h,
  rw not_le at h,
  set ε := A - a with hε,
  have hε' : 0 < ε,
  { linarith },
  rw tendsto_seq_iff at hx₂,
  specialize hx₂ ε hε',
  cases hx₂ with N hN,
  specialize hN N (le_refl _),
  rw abs_sub_lt_iff at hN,
  cases hN,
  specialize hx₁ N,
  linarith,
end

/-
TODO : Loosen requirement to just `hf : continuous_on f (set.Icc a b)`

Note however that with if we change just `hf`, then the statement is not true. That is, there is the
special case where c = a or c = b, and in that case, it is not true that f is continuous at a or b,
when f : ℝ → ℝ. If we instead had f : set.Icc a b → ℝ, then it would be true.
-/
lemma ivt {a b : ℝ} (h : a < b) (f : ℝ → ℝ) (hf : continuous f) (hfab : f a < f b)
  {η : ℝ} (hη : η ∈ set.Ioo (f a) (f b)) : ∃ c ∈ set.Icc a b, f c = η :=
begin
  -- Let S be the set of all x such that f(x) < η
  let S := {x | f x < η ∧ x ∈ set.Icc a b},
  -- S is nonempty
  have hS₁ : ∃ k, k ∈ S := ⟨a, hη.1, le_refl _, le_of_lt h⟩,
  -- and bounded above, so Sup S exists.
  have hS₂ : ∃ k, ∀ x ∈ S, x ≤ k := ⟨b, λ _ ⟨_, _, hx⟩, hx⟩,
  have hbS : b ∉ S,
  { rintro ⟨h, -⟩,
    cases hη,
    linarith },
  -- Let c := Sup S.
  let c := Sup S,
  -- Then a ≤ c ≤ b
  have hac : a ≤ c := real.le_Sup _ hS₂ ⟨hη.1, le_refl _, le_of_lt h⟩,
  have hbc : c ≤ b := real.Sup_le_ub _ hS₁ (λ x ⟨_, _, hx⟩, hx),
  -- We also have that f(x) is continuous at c
  have hcontc : continuous_at f c := hf.continuous_at,
  -- Now, we claim that f(c) = η
  use c,
  refine ⟨⟨real.le_Sup S hS₂ ⟨hη.1, le_refl _, le_of_lt h⟩, hbc⟩, _⟩,
  -- We will do this by showing f(c) ≤ η, and η ≤ f(c). However the proof for η ≤ f(c) requires
  -- f(c) ≤ η, so we prove this separately.
  have hcη : f c ≤ η,
  -- Let c₂(n) := c - 1/n
  { let c₂ : ℕ → ℝ := λ n, c - (1/(n+1)),
    -- Then c₂(n) → c as n → ∞
    have hc₂ : tendsto c₂ at_top (𝓝 c),
    { convert @filter.tendsto.sub ℕ ℝ _ _ _ (λ n, c) (λ n, 1/(n+1)) _ c 0 tendsto_const_nhds tendsto_one_div,
      exact (sub_zero _).symm, },
    -- and for all n, c₂(n) < c
    have hc₂' : ∀ n, c₂ n < c,
    { intro n,
      change c - (1/(n+1)) < c,
      simp only [one_div, sub_lt_self_iff, inv_pos],
      linarith [@nat.cast_nonneg ℝ _ n] },
    -- Then, for each n, there exists some x ∈ S such that c₂(n) < x ≤ c, as C = Sup S.
    have hc₂'' : ∀ n, ∃ x ∈ S, c₂ n < x ∧ x ≤ c,
    { intro n,
      rcases (real.lt_Sup _ hS₁ hS₂).mp (hc₂' n) with ⟨z, hz₁, hz₂⟩,
      use [z, hz₁, hz₂, real.le_Sup _ hS₂ hz₁] },
    -- Using this, we can define a sequence xₙ.
    let x : ℕ → ℝ := λ n, classical.some (hc₂'' n),
    -- Next, we can show that for all n, f(xₙ) < η.
    have hx₁ : ∀ n, f (x n) < η,
    { intro n,
      rcases classical.some_spec (hc₂'' n) with ⟨⟨hx : f (x n) < η, -⟩, -⟩,
      exact hx },
    -- and by the squeeze theorem, xₙ → c.
    have hx₂ : tendsto x at_top (𝓝 c),
    { apply tendsto_of_le_of_le hc₂ tendsto_const_nhds,
      { intro n,
        rcases classical.some_spec (hc₂'' n) with ⟨⟨-, -⟩, hx : c₂ n < x n, -⟩,
        exact le_of_lt hx },
      { intro n,
        rcases classical.some_spec (hc₂'' n) with ⟨⟨-, -⟩, -, hx : x n ≤ c⟩,
        exact hx } },
    -- so now we get that f(xₙ) → f(c) and f(c) ≤ η.
    apply tendsto_lim_le_of_le,
    { intro n,
      apply le_of_lt (hx₁ n) },
    { exact tendsto_comp_of_continuous_at hcontc hx₂ } },
  -- Now, all we need to do is to show that η ≤ f(c).
  { apply le_antisymm hcη,
    have hc₁ : c ≤ b,
    { apply real.Sup_le_ub _ hS₁,
      rintros x ⟨-, -, hx⟩,
      exact hx },
    have hc₂ : c < b,
    { apply lt_of_le_of_ne hc₁,
      intro h,
      have : f b ≤ η,
      { rwa h at hcη },
      cases hη,
      linarith },
    have hbc : 0 < b - c,
    { linarith },
    cases exists_nat_one_div_lt hbc with n hn,
    let x : ℕ → ℝ := λ i, c + 1/(n + i + 1),
    have hx₁ : tendsto x at_top (𝓝 c),
    { convert @filter.tendsto.add ℕ ℝ _ _ _ (λ i, c) (λ i, 1/(n+i+1)) _ c 0 tendsto_const_nhds _,
      { exact (add_zero _).symm },
      convert @tendsto_subseq _ _ (λ i, n + i) _ tendsto_one_div,
      { ext j,
        change (1/(n+j+1) : ℝ) = 1/((n+j : ℕ)+1),
        rw [nat.cast_add] },
      intro k,
      dsimp only,
      rw ←add_assoc,
      exact nat.lt_succ_self _ },
    have hx₂ : ∀ i, x i ∈ set.Icc a b,
    { intro i,
      split,
      { change a ≤ c + 1/(n + i + 1),
        have h₁: a ≤ c := real.le_Sup _ hS₂ ⟨hη.1, le_refl _, le_of_lt h⟩,
        have h₂ : (0 : ℝ) < 1/(n + i + 1),
        { rw one_div_pos,
          linarith [@nat.cast_nonneg ℝ _ n, @nat.cast_nonneg ℝ _ i] },
        linarith },
      { change c + 1/(n + i + 1) ≤ b,
        have : (1/(n + i + 1) : ℝ) ≤ 1/(n + 1),
        { rw one_div_le_one_div;
          linarith [@nat.cast_nonneg ℝ _ n, @nat.cast_nonneg ℝ _ i] },
        linarith } },
    have hx₃ : ∀ i, η ≤ f (x i),
    { intro i,
      by_contra hcontra,
      rw not_le at hcontra,
      have hxS : x i ∈ S,
      { exact ⟨hcontra, hx₂ i⟩ },
      have hxc : x i ≤ c,
      { exact real.le_Sup _ hS₂ hxS },
      have h₁ : (0 : ℝ) < 1/(n + i + 1),
      { rw one_div_pos,
        linarith [@nat.cast_nonneg ℝ _ n, @nat.cast_nonneg ℝ _ i] },
      change c + 1/(n+i+1) ≤ c at hxc,
      linarith },
    exact tendsto_lim_le_of_le' hx₃ (tendsto_comp_of_continuous_at hcontc hx₁), }
end


-- bundled subgroups

-- We're going to make one object which is all the subgroups of G.

-- first let's do some tests

import group_theory.subgroup
import algebra.group.hom

 --#print notation ↥
 --coe_sort #0
 --#print notation ↑
 --coe

example (G1 G2 : Type*) [group G1] [group G2]
  (f : G1 → G2) [is_group_hom f] (H1 : set G1) [is_subgroup H1] (a b : H1) :
  is_subgroup (f '' H1) :=
{ one_mem :=
begin
show (1:G2) ∈ f '' H1,
unfold set.image,
use (1),
split,
{exact is_submonoid.one_mem H1},
{exact is_group_hom.map_one f}
end,
  mul_mem :=
  begin
 -- intro j,
 -- intro k,
 -- intro n,
 -- change j ∈ f '' H1 at n,
 -- intro m,
 -- change k ∈ f '' H1 at m,
 -- show j*k ∈ f '' H1,
 -- cases n with j' hj',
 -- cases m with k' hk',

  rintro j k ⟨j', hj', rfl⟩ ⟨k', hk', rfl⟩,
  show (f j') * (f k') ∈ f '' H1,
  rw [← is_mul_hom.map_mul f j' k'],
 unfold set.image,
 dsimp,
 use j'*k',
 split,
   apply is_submonoid.mul_mem,
     assumption,
   assumption,
 refl,
-- need to get rid of the fs
  --apply is_submonoid.mul_mem,
  end,

  inv_mem :=
  begin
  --intro j,
  --intro n,
  --change j ∈ f '' H1 at n,
  --show j⁻¹ ∈ f '' H1,

 rintro j ⟨j', hj', rfl⟩,
 show (f j')⁻¹ ∈ f '' H1,
 rw [← is_group_hom.map_inv f j'],
 unfold set.image,
 dsimp,
 use j'⁻¹,
 split,
   rw [is_subgroup.inv_mem_iff H1],
   assumption,
refl,
-- need to get rid of the fs
 --rw [is_subgroup.inv_mem_iff H1],
  end
   }


/-
Copyright (c) 2022 Yaël Dillies, Ella Yu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Ella Yu

! This file was ported from Lean 3 source module combinatorics.additive.energy
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Prod
import Mathbin.Data.Fintype.Prod

/-!
# Additive energy

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

This file defines the additive energy of two finsets of a group. This is a central quantity in
additive combinatorics.

## TODO

It's possibly interesting to have
`(s ×ˢ s) ×ˢ t ×ˢ t).filter (λ x : (α × α) × α × α, x.1.1 * x.2.1 = x.1.2 * x.2.2)` (whose `card` is
`multiplicative_energy s t`) as a standalone definition.
-/

section

variable {α : Type _} [PartialOrder α] {x y : α}

end

variable {α : Type _} [DecidableEq α]

namespace Finset

section Mul

variable [Mul α] {s s₁ s₂ t t₁ t₂ : Finset α}

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Finset.multiplicativeEnergy /-
/-- The multiplicative energy of two finsets `s` and `t` in a group is the number of quadruples
`(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ * b₁ = a₂ * b₂`. -/
@[to_additive additive_energy
      "The additive energy of two finsets `s` and `t` in a group is the\nnumber of quadruples `(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ + b₁ = a₂ + b₂`."]
def multiplicativeEnergy (s t : Finset α) : ℕ :=
  (((s ×ˢ s) ×ˢ t ×ˢ t).filterₓ fun x : (α × α) × α × α => x.1.1 * x.2.1 = x.1.2 * x.2.2).card
#align finset.multiplicative_energy Finset.multiplicativeEnergy
#align finset.additive_energy Finset.additiveEnergy
-/

#print Finset.multiplicativeEnergy_mono /-
@[to_additive additive_energy_mono]
theorem multiplicativeEnergy_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) :
    multiplicativeEnergy s₁ t₁ ≤ multiplicativeEnergy s₂ t₂ :=
  card_le_of_subset <|
    filter_subset_filter _ <|
      product_subset_product (product_subset_product hs hs) <| product_subset_product ht ht
#align finset.multiplicative_energy_mono Finset.multiplicativeEnergy_mono
#align finset.additive_energy_mono Finset.additiveEnergy_mono
-/

#print Finset.multiplicativeEnergy_mono_left /-
@[to_additive additive_energy_mono_left]
theorem multiplicativeEnergy_mono_left (hs : s₁ ⊆ s₂) :
    multiplicativeEnergy s₁ t ≤ multiplicativeEnergy s₂ t :=
  multiplicativeEnergy_mono hs Subset.rfl
#align finset.multiplicative_energy_mono_left Finset.multiplicativeEnergy_mono_left
#align finset.additive_energy_mono_left Finset.additiveEnergy_mono_left
-/

#print Finset.multiplicativeEnergy_mono_right /-
@[to_additive additive_energy_mono_right]
theorem multiplicativeEnergy_mono_right (ht : t₁ ⊆ t₂) :
    multiplicativeEnergy s t₁ ≤ multiplicativeEnergy s t₂ :=
  multiplicativeEnergy_mono Subset.rfl ht
#align finset.multiplicative_energy_mono_right Finset.multiplicativeEnergy_mono_right
#align finset.additive_energy_mono_right Finset.additiveEnergy_mono_right
-/

#print Finset.le_multiplicativeEnergy /-
@[to_additive le_additive_energy]
theorem le_multiplicativeEnergy : s.card * t.card ≤ multiplicativeEnergy s t :=
  by
  rw [← card_product]
  refine'
    card_le_card_of_inj_on (fun x => ((x.1, x.1), x.2, x.2)) (by simp [← and_imp]) fun a _ b _ => _
  simp only [Prod.mk.inj_iff, and_self_iff, and_imp]
  exact Prod.ext
#align finset.le_multiplicative_energy Finset.le_multiplicativeEnergy
#align finset.le_additive_energy Finset.le_additiveEnergy
-/

#print Finset.multiplicativeEnergy_pos /-
@[to_additive additive_energy_pos]
theorem multiplicativeEnergy_pos (hs : s.Nonempty) (ht : t.Nonempty) :
    0 < multiplicativeEnergy s t :=
  (mul_pos hs.card_pos ht.card_pos).trans_le le_multiplicativeEnergy
#align finset.multiplicative_energy_pos Finset.multiplicativeEnergy_pos
#align finset.additive_energy_pos Finset.additiveEnergy_pos
-/

variable (s t)

#print Finset.multiplicativeEnergy_empty_left /-
@[simp, to_additive additive_energy_empty_left]
theorem multiplicativeEnergy_empty_left : multiplicativeEnergy ∅ t = 0 := by
  simp [multiplicative_energy]
#align finset.multiplicative_energy_empty_left Finset.multiplicativeEnergy_empty_left
#align finset.additive_energy_empty_left Finset.additiveEnergy_empty_left
-/

#print Finset.multiplicativeEnergy_empty_right /-
@[simp, to_additive additive_energy_empty_right]
theorem multiplicativeEnergy_empty_right : multiplicativeEnergy s ∅ = 0 := by
  simp [multiplicative_energy]
#align finset.multiplicative_energy_empty_right Finset.multiplicativeEnergy_empty_right
#align finset.additive_energy_empty_right Finset.additiveEnergy_empty_right
-/

variable {s t}

#print Finset.multiplicativeEnergy_pos_iff /-
@[simp, to_additive additive_energy_pos_iff]
theorem multiplicativeEnergy_pos_iff : 0 < multiplicativeEnergy s t ↔ s.Nonempty ∧ t.Nonempty :=
  ⟨fun h =>
    of_not_not fun H => by
      simp_rw [not_and_or, not_nonempty_iff_eq_empty] at H
      obtain rfl | rfl := H <;> simpa [Nat.not_lt_zero] using h,
    fun h => multiplicativeEnergy_pos h.1 h.2⟩
#align finset.multiplicative_energy_pos_iff Finset.multiplicativeEnergy_pos_iff
#align finset.additive_energy_pos_iff Finset.additiveEnergy_pos_iff
-/

#print Finset.multiplicativeEnergy_eq_zero_iff /-
@[simp, to_additive additive_energy_eq_zero_iff]
theorem multiplicativeEnergy_eq_zero_iff : multiplicativeEnergy s t = 0 ↔ s = ∅ ∨ t = ∅ := by
  simp [← (Nat.zero_le _).not_gt_iff_eq, not_and_or]
#align finset.multiplicative_energy_eq_zero_iff Finset.multiplicativeEnergy_eq_zero_iff
#align finset.additive_energy_eq_zero_iff Finset.additive_energy_eq_zero_iff
-/

end Mul

section CommMonoid

variable [CommMonoid α]

/- warning: finset.multiplicative_energy_comm -> Finset.multiplicativeEnergy_comm is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommMonoid.{u1} α] (s : Finset.{u1} α) (t : Finset.{u1} α), Eq.{1} Nat (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_2))) s t) (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_2))) t s)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommMonoid.{u1} α] (s : Finset.{u1} α) (t : Finset.{u1} α), Eq.{1} Nat (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_2))) s t) (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_2))) t s)
Case conversion may be inaccurate. Consider using '#align finset.multiplicative_energy_comm Finset.multiplicativeEnergy_commₓ'. -/
@[to_additive additive_energy_comm]
theorem multiplicativeEnergy_comm (s t : Finset α) :
    multiplicativeEnergy s t = multiplicativeEnergy t s :=
  by
  rw [multiplicative_energy, ← Finset.card_map (Equiv.prodComm _ _).toEmbedding, map_filter]
  simp [-Finset.card_map, eq_comm, multiplicative_energy, mul_comm, map_eq_image, Function.comp]
#align finset.multiplicative_energy_comm Finset.multiplicativeEnergy_comm
#align finset.additive_energy_comm Finset.additiveEnergy_comm

end CommMonoid

section CommGroup

variable [CommGroup α] [Fintype α] (s t : Finset α)

/- warning: finset.multiplicative_energy_univ_left -> Finset.multiplicativeEnergy_univ_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommGroup.{u1} α] [_inst_3 : Fintype.{u1} α] (t : Finset.{u1} α), Eq.{1} Nat (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))) (Finset.univ.{u1} α _inst_3) t) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (Fintype.card.{u1} α _inst_3) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) (Finset.card.{u1} α t) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommGroup.{u1} α] [_inst_3 : Fintype.{u1} α] (t : Finset.{u1} α), Eq.{1} Nat (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))) (Finset.univ.{u1} α _inst_3) t) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Fintype.card.{u1} α _inst_3) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) (Finset.card.{u1} α t) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))
Case conversion may be inaccurate. Consider using '#align finset.multiplicative_energy_univ_left Finset.multiplicativeEnergy_univ_leftₓ'. -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp, to_additive additive_energy_univ_left]
theorem multiplicativeEnergy_univ_left :
    multiplicativeEnergy univ t = Fintype.card α * t.card ^ 2 :=
  by
  simp only [multiplicative_energy, univ_product_univ, Fintype.card, sq, ← card_product]
  set f : α × α × α → (α × α) × α × α := fun x => ((x.1 * x.2.2, x.1 * x.2.1), x.2) with hf
  have : (↑((univ : Finset α) ×ˢ t ×ˢ t) : Set (α × α × α)).InjOn f :=
    by
    rintro ⟨a₁, b₁, c₁⟩ h₁ ⟨a₂, b₂, c₂⟩ h₂ h
    simp_rw [Prod.ext_iff] at h
    obtain ⟨h, rfl, rfl⟩ := h
    rw [mul_right_cancel h.1]
  rw [← card_image_of_inj_on this]
  congr with a
  simp only [hf, mem_filter, mem_product, mem_univ, true_and_iff, mem_image, exists_prop,
    Prod.exists]
  refine' ⟨fun h => ⟨a.1.1 * a.2.2⁻¹, _, _, h.1, by simp [mul_right_comm, h.2]⟩, _⟩
  rintro ⟨b, c, d, hcd, rfl⟩
  simpa [mul_right_comm]
#align finset.multiplicative_energy_univ_left Finset.multiplicativeEnergy_univ_left
#align finset.additive_energy_univ_left Finset.additiveEnergy_univ_left

/- warning: finset.multiplicative_energy_univ_right -> Finset.multiplicativeEnergy_univ_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommGroup.{u1} α] [_inst_3 : Fintype.{u1} α] (s : Finset.{u1} α), Eq.{1} Nat (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))) s (Finset.univ.{u1} α _inst_3)) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (Fintype.card.{u1} α _inst_3) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) (Finset.card.{u1} α s) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : CommGroup.{u1} α] [_inst_3 : Fintype.{u1} α] (s : Finset.{u1} α), Eq.{1} Nat (Finset.multiplicativeEnergy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α (CommGroup.toGroup.{u1} α _inst_2))))) s (Finset.univ.{u1} α _inst_3)) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Fintype.card.{u1} α _inst_3) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) (Finset.card.{u1} α s) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))
Case conversion may be inaccurate. Consider using '#align finset.multiplicative_energy_univ_right Finset.multiplicativeEnergy_univ_rightₓ'. -/
@[simp, to_additive additive_energy_univ_right]
theorem multiplicativeEnergy_univ_right :
    multiplicativeEnergy s univ = Fintype.card α * s.card ^ 2 := by
  rw [multiplicative_energy_comm, multiplicative_energy_univ_left]
#align finset.multiplicative_energy_univ_right Finset.multiplicativeEnergy_univ_right
#align finset.additive_energy_univ_right Finset.additiveEnergy_univ_right

end CommGroup

end Finset


import Mathlib.Data.Nat.Basic
import Mathlib.Tactic.Linarith

/-
# Sorting a list

-/

namespace Notes

variable {α : Type} (r : α → α → Prop) [DecidableRel r]

/-
We sort lists of type `α` using the comparison function
`f` (or `r`).

If `f a₁ a₂ = true`, then this is the "correct" order.
Otherwise, it is "incorrect"

If `r a₁ a₂` has a proof, then this is the "correct" order.
Otherwise, it is "incorrect"

What are some examples of sorted lists?

- [] is should be sorted
- for any `a:α`, then `[a]` is sorted
- for any `a₁ a₂ : α` and any `as : List α` such that
  `f a₁ a₂  = true` and `a₂ :: as` is sorted, then
  `a₁ :: a₂ :: as` is sorted
-/

inductive Sorted (r : α → α → Prop) : List α → Prop where
  | nil : Sorted r []
  | single {a : α} : Sorted r [a]
  | longer {a₁ a₂ : α} {as : List α} (h : r a₁ a₂)
    (h' : Sorted r (a₂ :: as)) : Sorted r (a₁::a₂::as)

open Sorted

/- We can check that particular lists are `Sorted` -/
example : Sorted (·≤·) [1,2,3] := by
  apply longer
  · simp
  · apply longer
    · simp
    · apply single

/- We can also prove basic facts about our implementation
of sorted lists -/
theorem sorted_tail_of_sorted (a : α) (as : List α)
    (h : Sorted r (a::as)) : Sorted r as := by
  match h with
  | single => apply nil
  | longer _ h'' => exact h''

/- We now we want to implement an algortihm to sort
lists and then _prove_ that it always produces a `Sorted`
list.

We will use insert sort. We will recursively sort the
tail of a list and then insert the head in the
appropriate place. We first give the insertion function.-/

/--
`insert` places `a` before the first element `a'`
of `l` which satisfies `f a a'`.
-/
def insert (a : α) (l : List α) : List α :=
  match l with
  | [] => [a]
  | a'::as =>
    if r a a' then a::a'::as else a'::insert a as

#check insert

/- We prove a basic result about the length of inserted
list and tag it with `@[simp]` for use with `simp` -/
@[simp]
theorem len_insert_eq_succ_len {a : α} {l : List α} :
    (insert r a l).length = l.length + 1 :=
  match l with
  | [] => by simp [insert]
  | a'::as =>
    if h : r a a' then by simp [insert, h] else
    by simp [insert, h]; apply len_insert_eq_succ_len

/--
We sort `l` recursively sorting the tail first and then
inserting the head at the appropriate location.
-/
def insertSort (l : List α) : List α :=
  match l with
  | [] => []
  | a::as => insert r a <| insertSort as

#check insertSort

/- Some examples our polymorphic sorting algorithm applies to -/
#eval insertSort (·≤·) [4,5,2,4,5,6]
#eval insertSort (fun (b b' : Bool) => b && b') [true,false,false]
#eval insertSort (fun _ _ => true) [4,5,2,4,5,6]

/- For a general `f`, we will not be able to show that the
output of `insert f l` satsisfies `Sorted f l`. For example,
for `fun _ _ => false`, if we have `Sorted f l` then
`l.length` is 0 or 1. This is a reasonable class of `f` to
make sorting work as expected -/
class Asymmetric (r : α → α → Prop) where
  asym {a a'} : ¬ r a a' → r a' a

open Asymmetric

/- A helpful constructor for `Sorted` that unifies the
nonempty cases -/
def Sorted.cons {a : α} {l : List α} (h₁ : Sorted r l)
    (h₂ : l.length > 0) (h₃ : r a l[0]) : Sorted r (a::l) :=
  match h₁ with
  | nil => single
  | single => longer h₃ single
  | longer h h' => longer h₃ <| longer h h'

/- If we have a `Sorted` list with at least two elements,
then the first elements are ordered appropriately with
respect to `f` -/
theorem ordered_of_sorted {a a' : α} {as : List α}
    (h : Sorted r (a::a'::as)) : r a a' :=
  match h with
  | longer h' _ => h'

/- If we have a `Sorted` list `a'::as` where `a` and `a'` are
ordered wrong, then the first two elements of `a'::insert f a as`
are ordered correctly -/
theorem ordered_cons_insert_of_unordered {a a' : α} {as : List α}
    (h : Sorted r (a'::as)) (h' : r a' a) : r a' (insert r a as)[0] :=
  match as with
  | [] => by simp [insert]; assumption
  | a''::as' =>
    if h'' : r a a'' then
    by simpa [insert, h'']
    else
    by simp [insert, h'']; apply ordered_of_sorted r h

/- We prove that if we insert an element into a `Sorted` list
it will remain `Sorted` assuming `f` is `Asymmetric` -/
theorem insert_sorted_of_sorted {a : α} {l : List α} [Asymmetric r]
    (h : Sorted r l) : Sorted r <| insert r a l :=
  match l with
  | [] => single
  | a'::as =>
    if h' : r a a' then
    by simp [insert, h']; apply longer h' h
    else
    by
      simp [insert, h']
      apply cons r
      · apply insert_sorted_of_sorted <| sorted_tail_of_sorted r a' as h
      · apply ordered_cons_insert_of_unordered r h
        · apply asym; simp; assumption

/- Finally, we prove that if `f` is `Asymmetric` then `insertSort`
always produces a `Sorted` list no matter `α` or `f` -/
theorem sorted_of_insertSort (l : List α) [Asymmetric r] :
    Sorted r <| insertSort r l :=
  match l with
  | [] => nil
  | a::as => by
    dsimp [insertSort]
    apply insert_sorted_of_sorted r <| sorted_of_insertSort as

variable [Trans r r r]

class Transitive (r : α → α → Prop) where
  trans' {a₁ a₂ a₃} : r a₁ a₂ → r a₂ a₃ → r a₁ a₃

theorem Nat.succ_of_lt {i j : ℕ} (h : i < j) : ∃ l, l+1 = j := sorry

open Transitive

theorem totally_ordered_of_sorted [Transitive r] {l : List α} (h : Sorted r l) :
    ∀ {i j : ℕ}, (i < j) → (_ : i < l.length) → (_ : j < l.length) → r l[i] l[j] :=
  match h with
  | nil => fun _ h' _ => False.elim <| by
    rw [List.length_nil] at h'
    exact Nat.not_lt_zero _ h'
  | single => fun h hi hj => by
    dsimp at hi hj
    apply False.elim
    linarith
  | longer h₁ h₂ => by
    intro h' hi hj
    rename_i i j a₁ a₂ as
    have ⟨l,hl⟩ := Nat.succ_of_lt h'
    rw [←hl] at hj h'
    simp only [←hl]
    have : l < (a₂ :: as).length :=
      Nat.pred_lt_pred (by simp) hj
    have hl' : (a₁::a₂::as)[l+1] = (a₂::as)[l] := rfl
    by_cases i = 0
    · simp [h,hl'] at *
      by_cases l = 0
      · simp [h,h₁]
      · apply trans'
        . exact h₁
        · change r (a₂::as)[0] (a₂::as)[l]
          apply totally_ordered_of_sorted h₂
          apply Nat.one_le_iff_ne_zero.mpr h
    · have ⟨k,hk⟩ := Nat.exists_eq_succ_of_ne_zero h
      rw [hk] at hi h'
      simp only [hk]
      have : k < (a₂::as).length :=
        Nat.pred_lt_pred (by simp) hi
      have hk' : (a₁::a₂::as)[k+1] = (a₂::as)[k] := rfl
      rw [hk',hl']
      apply totally_ordered_of_sorted h₂
      apply Nat.pred_lt_pred (by simp) h'


import Mathlib.Data.Nat.Basic

/-
# Sorting a list

-/

namespace Notes

variable {α : Type} (f : α → α → Bool) (r : α → α → Prop)

/-
We sort lists of type `α` using the comparison function
`f` (or `r`).

If `f a₁ a₂ = true`, then this is the "correct" order.
Otherwise, it is "incorrect"

If `r a₁ a₂` has a proof, then this is the "correct" order.
Otherwise, it is "incorrect"

What are some examples of sorted lists?

- [] is should be sorted
- for any `a:α`, then `[a]` is sorted
- for any `a₁ a₂ : α` and any `as : List α` such that
  `f a₁ a₂  = true` and `a₂ :: as` is sorted, then
  `a₁ :: a₂ :: as` is sorted
-/

inductive Sorted (f : α → α → Bool) : List α → Prop where
  | nil : Sorted f []
  | single {a : α} : Sorted f [a]
  | longer {a₁ a₂ : α} {as : List α} (h : f a₁ a₂)
    (h' : Sorted f (a₂ :: as)) : Sorted f (a₁::a₂::as)

open Sorted

/- We can check that particular lists are `Sorted` -/
example : Sorted (·≤·) [1,2,3] := by
  apply longer
  · simp
  · apply longer
    · simp
    · apply single

/- We can also prove basic facts about our implementation
of sorted lists -/
theorem sorted_tail_of_sorted (a : α) (as : List α)
    (h : Sorted f (a::as)) : Sorted f as := by
  match h with
  | single => apply nil
  | longer _ h'' => exact h''

/- We now we want to implement an algortihm to sort
lists and then _prove_ that it always produces a `Sorted`
list.

We will use insert sort. We will recursively sort the
tail of a list and then insert the head in the
appropriate place. We first give the insertion function.-/

/--
`insert` places `a` before the first element `a'`
of `l` which satisfies `f a a'`.
-/
def insert (a : α) (l : List α) : List α :=
  match l with
  | [] => [a]
  | a'::as =>
    match f a a' with
    | true => a::a'::as
    | false => a'::insert a as

#check insert

/- We prove a basic result about the length of inserted
list and tag it with `@[simp]` for use with `simp` -/
@[simp]
theorem len_insert_eq_succ_len {a : α} {l : List α} :
    (insert f a l).length = l.length + 1 := by
  match l with
  | [] => simp [insert]
  | a'::as =>
    match h : f a a' with
    | true => simp [insert, h]
    | false => simp [insert, h]; apply len_insert_eq_succ_len

/--
We sort `l` recursively sorting the tail first and then
inserting the head at the appropriate location.
-/
def insertSort (l : List α) : List α :=
  match l with
  | [] => []
  | a::as => insert f a <| insertSort as

#check insertSort

/- Some examples our polymorphic sorting algorithm applies to -/
#eval insertSort (·≤·) [4,5,2,4,5,6]
#eval insertSort (fun (b b' : Bool) => b && b') [true,false,false]
#eval insertSort (fun _ _ => true) [4,5,2,4,5,6]

/- For a general `f`, we will not be able to show that the
output of `insert f l` satsisfies `Sorted f l`. For example,
for `fun _ _ => false`, if we have `Sorted f l` then
`l.length` is 0 or 1. This is a reasonable class of `f` to
make sorting work as expected -/
class Asymmetric (f : α → α → Bool) where
  asym {a a'} : !f a a' → f a' a

open Asymmetric

/- A helpful constructor for `Sorted` that unifies the
nonempty cases -/
def Sorted.cons {a : α} {l : List α} (h₁ : Sorted f l)
    (h₂ : l.length > 0) (h₃ : f a l[0]) : Sorted f (a::l) :=
  match h₁ with
  | nil => single
  | single => longer h₃ single
  | longer h h' => longer h₃ <| longer h h'

/- If we have a `Sorted` list with at least two elements,
then the first elements are ordered appropriately with
respect to `f` -/
theorem ordered_of_sorted {a a' : α} {as : List α}
    (h : Sorted f (a::a'::as)) : f a a' :=
  match h with
  | longer h' _ => h'

/- If we have a `Sorted` list `a'::as` where `a` and `a'` are
ordered wrong, then the first two elements of `a'::insert f a as`
are ordered correctly -/
theorem ordered_cons_insert_of_unordered {a a' : α} {as : List α}
    (h : Sorted f (a'::as)) (h' : f a' a) : f a' (insert f a as)[0] :=
  match as with
  | [] => by simpa [insert]
  | a''::as' =>
  match h'' : f a a'' with
    | true => by simpa [insert, h'']
    | false => by simp [insert, h'']; apply ordered_of_sorted f h

/- We prove that if we insert an element into a `Sorted` list
it will remain `Sorted` assuming `f` is `Asymmetric` -/
theorem insert_sorted_of_sorted {a : α} {l : List α} [Asymmetric f]
    (h : Sorted f l) : Sorted f <| insert f a l :=
  match l with
  | [] => single
  | a'::as =>
    match h' : f a a' with
    | true => by simp [insert, h']; apply longer h' h
    | false => by
      simp [insert, h']
      apply cons f
      · apply insert_sorted_of_sorted <| sorted_tail_of_sorted f a' as h
      · apply ordered_cons_insert_of_unordered f h
        · apply asym; simp; assumption

/- Finally, we prove that if `f` is `Asymmetric` then `insertSort`
always produces a `Sorted` list no matter `α` or `f` -/
theorem sorted_of_insertSort (l : List α) [Asymmetric f] :
    Sorted f <| insertSort f l :=
  match l with
  | [] => nil
  | a::as => by
    dsimp [insertSort]
    apply insert_sorted_of_sorted f <| sorted_of_insertSort as


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.local_extr
import topology.algebra.order.basic

/-!
# Maximum/minimum on the closure of a set

In this file we prove several versions of the following statement: if `f : X → Y` has a (local or
not) maximum (or minimum) on a set `s` at a point `a` and is continuous on the closure of `s`, then
`f` has an extremum of the same type on `closure s` at `a`.
-/

open filter set
open_locale topological_space

variables {X Y : Type*} [topological_space X] [topological_space Y] [preorder Y]
  [order_closed_topology Y] {f g : X → Y} {s : set X} {a : X}

protected lemma is_max_on.closure (h : is_max_on f s a) (hc : continuous_on f (closure s)) :
  is_max_on f (closure s) a :=
λ x hx, continuous_within_at.closure_le hx ((hc x hx).mono subset_closure)
  continuous_within_at_const h

protected lemma is_min_on.closure (h : is_min_on f s a) (hc : continuous_on f (closure s)) :
  is_min_on f (closure s) a :=
h.dual.closure hc

protected lemma is_extr_on.closure (h : is_extr_on f s a) (hc : continuous_on f (closure s)) :
  is_extr_on f (closure s) a :=
h.elim (λ h, or.inl $ h.closure hc) (λ h, or.inr $ h.closure hc)

protected lemma is_local_max_on.closure (h : is_local_max_on f s a)
  (hc : continuous_on f (closure s)) :
  is_local_max_on f (closure s) a :=
begin
  rcases mem_nhds_within.1 h with ⟨U, Uo, aU, hU⟩,
  refine mem_nhds_within.2 ⟨U, Uo, aU, _⟩,
  rintro x ⟨hxU, hxs⟩,
  refine continuous_within_at.closure_le _ _ continuous_within_at_const hU,
  { rwa [mem_closure_iff_nhds_within_ne_bot, nhds_within_inter_of_mem,
      ← mem_closure_iff_nhds_within_ne_bot],
    exact nhds_within_le_nhds (Uo.mem_nhds hxU) },
  { exact (hc _ hxs).mono ((inter_subset_right _ _).trans subset_closure) }
end

protected lemma is_local_min_on.closure (h : is_local_min_on f s a)
  (hc : continuous_on f (closure s)) :
  is_local_min_on f (closure s) a :=
is_local_max_on.closure h.dual hc

protected lemma is_local_extr_on.closure (h : is_local_extr_on f s a)
  (hc : continuous_on f (closure s)) :
  is_local_extr_on f (closure s) a :=
h.elim (λ h, or.inl $ h.closure hc) (λ h, or.inr $ h.closure hc)


/-
Copyright (c) 2019 Kenny Lau, Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes
-/
import data.finset.order
import algebra.direct_sum.module
import ring_theory.free_comm_ring
import ring_theory.ideal.quotient_operations
/-!
# Direct limit of modules, abelian groups, rings, and fields.

See Atiyah-Macdonald PP.32-33, Matsumura PP.269-270

Generalizes the notion of "union", or "gluing", of incomparable modules over the same ring,
or incomparable abelian groups, or rings, or fields.

It is constructed as a quotient of the free module (for the module case) or quotient of
the free commutative ring (for the ring case) instead of a quotient of the disjoint union
so as to make the operations (addition etc.) "computable".

## Main definitions

* `directed_system f`
* `module.direct_limit G f`
* `add_comm_group.direct_limit G f`
* `ring.direct_limit G f`

-/
universes u v w u₁

open submodule

variables {R : Type u} [ring R]
variables {ι : Type v}
variables [dec_ι : decidable_eq ι] [preorder ι]
variables (G : ι → Type w)

/-- A directed system is a functor from a category (directed poset) to another category. -/
class directed_system (f : Π i j, i ≤ j → G i → G j) : Prop :=
(map_self [] : ∀ i x h, f i i h x = x)
(map_map [] : ∀ {i j k} hij hjk x, f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x)

namespace module

variables [Π i, add_comm_group (G i)] [Π i, module R (G i)]

variables {G} (f : Π i j, i ≤ j → G i →ₗ[R] G j)

/-- A copy of `directed_system.map_self` specialized to linear maps, as otherwise the
`λ i j h, f i j h` can confuse the simplifier. -/
lemma directed_system.map_self [directed_system G (λ i j h, f i j h)] (i x h) :
  f i i h x = x :=
directed_system.map_self (λ i j h, f i j h) i x h

/-- A copy of `directed_system.map_map` specialized to linear maps, as otherwise the
`λ i j h, f i j h` can confuse the simplifier. -/
lemma directed_system.map_map [directed_system G (λ i j h, f i j h)] {i j k} (hij hjk x) :
  f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x :=
directed_system.map_map (λ i j h, f i j h) hij hjk x

variables (G)

include dec_ι

/-- The direct limit of a directed system is the modules glued together along the maps. -/
def direct_limit : Type (max v w) :=
direct_sum ι G ⧸ (span R $ { a | ∃ (i j) (H : i ≤ j) x,
  direct_sum.lof R ι G i x - direct_sum.lof R ι G j (f i j H x) = a })

namespace direct_limit

instance : add_comm_group (direct_limit G f) := quotient.add_comm_group _
instance : module R (direct_limit G f) := quotient.module _

instance : inhabited (direct_limit G f) := ⟨0⟩

variables (R ι)
/-- The canonical map from a component to the direct limit. -/
def of (i) : G i →ₗ[R] direct_limit G f :=
(mkq _).comp $ direct_sum.lof R ι G i
variables {R ι G f}

@[simp] lemma of_f {i j hij x} : (of R ι G f j (f i j hij x)) = of R ι G f i x :=
eq.symm $ (submodule.quotient.eq _).2 $ subset_span ⟨i, j, hij, x, rfl⟩

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/

@[elab_as_eliminator]
protected theorem induction_on [nonempty ι] [is_directed ι (≤)] {C : direct_limit G f → Prop}
  (z : direct_limit G f)
  (ih : ∀ i x, C (of R ι G f i x)) : C z :=
let ⟨i, x, h⟩ := exists_of z in h ▸ ih i x

variables {P : Type u₁} [add_comm_group P] [module R P] (g : Π i, G i →ₗ[R] P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)
include Hg

variables (R ι G f)
/-- The universal property of the direct limit: maps from the components to another module
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit. -/
def lift : direct_limit G f →ₗ[R] P :=
liftq _ (direct_sum.to_module R ι P g)
  (span_le.2 $ λ a ⟨i, j, hij, x, hx⟩, by rw [← hx, set_like.mem_coe, linear_map.sub_mem_ker_iff,
    direct_sum.to_module_lof, direct_sum.to_module_lof, Hg])
variables {R ι G f}

omit Hg
lemma lift_of {i} (x) : lift R ι G f g Hg (of R ι G f i x) = g i x :=
direct_sum.to_module_lof R _ _

theorem lift_unique [nonempty ι] [is_directed ι (≤)] (F : direct_limit G f →ₗ[R] P) (x) :
  F x = lift R ι G f (λ i, F.comp $ of R ι G f i)
    (λ i j hij x, by rw [linear_map.comp_apply, of_f]; refl) x :=
direct_limit.induction_on x $ λ i x, by rw lift_of; refl

section totalize
open_locale classical
variables (G f)
omit dec_ι

/-- `totalize G f i j` is a linear map from `G i` to `G j`, for *every* `i` and `j`.
If `i ≤ j`, then it is the map `f i j` that comes with the directed system `G`,
and otherwise it is the zero map. -/
noncomputable def totalize (i j) : G i →ₗ[R] G j :=
if h : i ≤ j then f i j h else 0
variables {G f}

lemma totalize_of_le {i j} (h : i ≤ j) : totalize G f i j = f i j h := dif_pos h

lemma totalize_of_not_le {i j} (h : ¬(i ≤ j)) : totalize G f i j = 0 := dif_neg h

end totalize

variables [directed_system G (λ i j h, f i j h)]
open_locale classical

lemma to_module_totalize_of_le {x : direct_sum ι G} {i j : ι}
  (hij : i ≤ j) (hx : ∀ k ∈ x.support, k ≤ i) :
  direct_sum.to_module R ι (G j) (λ k, totalize G f k j) x =
  f i j hij (direct_sum.to_module R ι (G i) (λ k, totalize G f k i) x) :=
begin
  rw [← @dfinsupp.sum_single ι G _ _ _ x],
  unfold dfinsupp.sum,
  simp only [linear_map.map_sum],
  refine finset.sum_congr rfl (λ k hk, _),
  rw [direct_sum.single_eq_lof R k (x k), direct_sum.to_module_lof, direct_sum.to_module_lof,
    totalize_of_le (hx k hk), totalize_of_le (le_trans (hx k hk) hij), directed_system.map_map],
end

lemma of.zero_exact_aux [nonempty ι] [is_directed ι (≤)] {x : direct_sum ι G}
  (H : submodule.quotient.mk x = (0 : direct_limit G f)) :
  ∃ j, (∀ k ∈ x.support, k ≤ j) ∧
    direct_sum.to_module R ι (G j) (λ i, totalize G f i j) x = (0 : G j) :=
nonempty.elim (by apply_instance) $ assume ind : ι,
span_induction ((quotient.mk_eq_zero _).1 H)
  (λ x ⟨i, j, hij, y, hxy⟩, let ⟨k, hik, hjk⟩ := exists_ge_ge i j in
    ⟨k, begin
      clear_,
      subst hxy,
      split,
      { intros i0 hi0,
        rw [dfinsupp.mem_support_iff, direct_sum.sub_apply, ← direct_sum.single_eq_lof,
            ← direct_sum.single_eq_lof, dfinsupp.single_apply, dfinsupp.single_apply] at hi0,
        split_ifs at hi0 with hi hj hj, { rwa hi at hik }, { rwa hi at hik }, { rwa hj at hjk },
        exfalso, apply hi0, rw sub_zero },
      simp [linear_map.map_sub, totalize_of_le, hik, hjk,
        directed_system.map_map, direct_sum.apply_eq_component,
        direct_sum.component.of],
    end⟩)
  ⟨ind, λ _ h, (finset.not_mem_empty _ h).elim, linear_map.map_zero _⟩
  (λ x y ⟨i, hi, hxi⟩ ⟨j, hj, hyj⟩,
    let ⟨k, hik, hjk⟩ := exists_ge_ge i j in
    ⟨k, λ l hl,
      (finset.mem_union.1 (dfinsupp.support_add hl)).elim
        (λ hl, le_trans (hi _ hl) hik)
        (λ hl, le_trans (hj _ hl) hjk),
      by simp [linear_map.map_add, hxi, hyj,
          to_module_totalize_of_le hik hi,
          to_module_totalize_of_le hjk hj]⟩)
  (λ a x ⟨i, hi, hxi⟩,
    ⟨i, λ k hk, hi k (direct_sum.support_smul _ _ hk),
      by simp [linear_map.map_smul, hxi]⟩)

/-- A component that corresponds to zero in the direct limit is already zero in some
bigger module in the directed system. -/
theorem of.zero_exact [is_directed ι (≤)] {i x} (H : of R ι G f i x = 0) :
  ∃ j hij, f i j hij x = (0 : G j) :=
by haveI : nonempty ι := ⟨i⟩; exact
let ⟨j, hj, hxj⟩ := of.zero_exact_aux H in
if hx0 : x = 0 then ⟨i, le_rfl, by simp [hx0]⟩
else
  have hij : i ≤ j, from hj _ $
    by simp [direct_sum.apply_eq_component, hx0],
  ⟨j, hij, by simpa [totalize_of_le hij] using hxj⟩

end direct_limit

end module

namespace add_comm_group

variables [Π i, add_comm_group (G i)]
include dec_ι

/-- The direct limit of a directed system is the abelian groups glued together along the maps. -/
def direct_limit (f : Π i j, i ≤ j → G i →+ G j) : Type* :=
@module.direct_limit ℤ _ ι _ _ G _ _
  (λ i j hij, (f i j hij).to_int_linear_map)

namespace direct_limit

variables (f : Π i j, i ≤ j → G i →+ G j)

omit dec_ι

protected lemma directed_system [h : directed_system G (λ i j h, f i j h)] :
  directed_system G (λ i j hij, (f i j hij).to_int_linear_map) :=
h

include dec_ι

local attribute [instance] direct_limit.directed_system

instance : add_comm_group (direct_limit G f) :=
module.direct_limit.add_comm_group G (λ i j hij, (f i j hij).to_int_linear_map)

instance : inhabited (direct_limit G f) := ⟨0⟩

/-- The canonical map from a component to the direct limit. -/
def of (i) : G i →ₗ[ℤ] direct_limit G f :=
module.direct_limit.of ℤ ι G (λ i j hij, (f i j hij).to_int_linear_map) i
variables {G f}

@[simp] lemma of_f {i j} (hij) (x) : of G f j (f i j hij x) = of G f i x :=
module.direct_limit.of_f

@[elab_as_eliminator]
protected theorem induction_on [nonempty ι] [is_directed ι (≤)] {C : direct_limit G f → Prop}
  (z : direct_limit G f) (ih : ∀ i x, C (of G f i x)) : C z :=
module.direct_limit.induction_on z ih

/-- A component that corresponds to zero in the direct limit is already zero in some
bigger module in the directed system. -/
theorem of.zero_exact [is_directed ι (≤)] [directed_system G (λ i j h, f i j h)] (i x)
  (h : of G f i x = 0) :
  ∃ j hij, f i j hij x = 0 :=
module.direct_limit.of.zero_exact h

variables (P : Type u₁) [add_comm_group P]
variables (g : Π i, G i →+ P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)

variables (G f)
/-- The universal property of the direct limit: maps from the components to another abelian group
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit. -/
def lift : direct_limit G f →ₗ[ℤ] P :=
module.direct_limit.lift ℤ ι G (λ i j hij, (f i j hij).to_int_linear_map)
  (λ i, (g i).to_int_linear_map) Hg
variables {G f}

@[simp] lemma lift_of (i x) : lift G f P g Hg (of G f i x) = g i x :=
module.direct_limit.lift_of _ _ _

lemma lift_unique [nonempty ι] [is_directed ι (≤)] (F : direct_limit G f →+ P) (x) :
  F x = lift G f P (λ i, F.comp (of G f i).to_add_monoid_hom)
    (λ i j hij x, by simp) x :=
direct_limit.induction_on x $ λ i x, by simp

end direct_limit

end add_comm_group

namespace ring

variables [Π i, comm_ring (G i)]

section
variables (f : Π i j, i ≤ j → G i → G j)

open free_comm_ring

/-- The direct limit of a directed system is the rings glued together along the maps. -/
def direct_limit : Type (max v w) :=
free_comm_ring (Σ i, G i) ⧸ (ideal.span { a |
  (∃ i j H x, of (⟨j, f i j H x⟩ : Σ i, G i) - of ⟨i, x⟩ = a) ∨
  (∃ i, of (⟨i, 1⟩ : Σ i, G i) - 1 = a) ∨
  (∃ i x y, of (⟨i, x + y⟩ : Σ i, G i) - (of ⟨i, x⟩ + of ⟨i, y⟩) = a) ∨
  (∃ i x y, of (⟨i, x * y⟩ : Σ i, G i) - (of ⟨i, x⟩ * of ⟨i, y⟩) = a) })

namespace direct_limit

instance : comm_ring (direct_limit G f) :=
ideal.quotient.comm_ring _

instance : ring (direct_limit G f) :=
comm_ring.to_ring _

instance : inhabited (direct_limit G f) := ⟨0⟩

/-- The canonical map from a component to the direct limit. -/
def of (i) : G i →+* direct_limit G f :=
ring_hom.mk'
{ to_fun := λ x, ideal.quotient.mk _ (of (⟨i, x⟩ : Σ i, G i)),
  map_one' := ideal.quotient.eq.2 $ subset_span $ or.inr $ or.inl ⟨i, rfl⟩,
  map_mul' := λ x y, ideal.quotient.eq.2 $ subset_span $ or.inr $ or.inr $ or.inr ⟨i, x, y, rfl⟩, }
(λ x y, ideal.quotient.eq.2 $ subset_span $ or.inr $ or.inr $ or.inl ⟨i, x, y, rfl⟩)

variables {G f}

@[simp] lemma of_f {i j} (hij) (x) : of G f j (f i j hij x) = of G f i x :=
ideal.quotient.eq.2 $ subset_span $ or.inl ⟨i, j, hij, x, rfl⟩

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/
theorem exists_of [nonempty ι] [is_directed ι (≤)] (z : direct_limit G f) :
  ∃ i x, of G f i x = z :=
nonempty.elim (by apply_instance) $ assume ind : ι,
quotient.induction_on' z $ λ x, free_abelian_group.induction_on x
  ⟨ind, 0, (of _ _ ind).map_zero⟩
  (λ s, multiset.induction_on s
    ⟨ind, 1, (of _ _ ind).map_one⟩
    (λ a s ih, let ⟨i, x⟩ := a, ⟨j, y, hs⟩ := ih, ⟨k, hik, hjk⟩ := exists_ge_ge i j in
      ⟨k, f i k hik x * f j k hjk y, by rw [(of _ _ _).map_mul, of_f, of_f, hs]; refl⟩))
  (λ s ⟨i, x, ih⟩, ⟨i, -x, by rw [(of _ _ _).map_neg, ih]; refl⟩)
  (λ p q ⟨i, x, ihx⟩ ⟨j, y, ihy⟩, let ⟨k, hik, hjk⟩ := exists_ge_ge i j in
    ⟨k, f i k hik x + f j k hjk y, by rw [(of _ _ _).map_add, of_f, of_f, ihx, ihy]; refl⟩)

section
open_locale classical
open polynomial

variables {f' : Π i j, i ≤ j → G i →+* G j}

theorem polynomial.exists_of [nonempty ι] [is_directed ι (≤)]
  (q : polynomial (direct_limit G (λ i j h, f' i j h))) :
  ∃ i p, polynomial.map (of G (λ i j h, f' i j h) i) p = q :=
polynomial.induction_on q
  (λ z, let ⟨i, x, h⟩ := exists_of z in ⟨i, C x, by rw [map_C, h]⟩)
  (λ q₁ q₂ ⟨i₁, p₁, ih₁⟩ ⟨i₂, p₂, ih₂⟩, let ⟨i, h1, h2⟩ := exists_ge_ge i₁ i₂ in
    ⟨i, p₁.map (f' i₁ i h1) + p₂.map (f' i₂ i h2),
     by { rw [polynomial.map_add, map_map, map_map, ← ih₁, ← ih₂],
      congr' 2; ext x; simp_rw [ring_hom.comp_apply, of_f] }⟩)
  (λ n z ih, let ⟨i, x, h⟩ := exists_of z in ⟨i, C x * X ^ (n + 1),
    by rw [polynomial.map_mul, map_C, h, polynomial.map_pow, map_X]⟩)

end

@[elab_as_eliminator] theorem induction_on [nonempty ι] [is_directed ι (≤)]
  {C : direct_limit G f → Prop}
  (z : direct_limit G f) (ih : ∀ i x, C (of G f i x)) : C z :=
let ⟨i, x, hx⟩ := exists_of z in hx ▸ ih i x

section of_zero_exact
open_locale classical

variables (f' : Π i j, i ≤ j → G i →+* G j)
variables [directed_system G (λ i j h, f' i j h)]
variables (G f)

lemma of.zero_exact_aux2 {x : free_comm_ring Σ i, G i} {s t} (hxs : is_supported x s) {j k}
  (hj : ∀ z : Σ i, G i, z ∈ s → z.1 ≤ j) (hk : ∀ z : Σ i, G i, z ∈ t → z.1 ≤ k)
  (hjk : j ≤ k) (hst : s ⊆ t) :
  f' j k hjk (lift (λ ix : s, f' ix.1.1 j (hj ix ix.2) ix.1.2) (restriction s x)) =
  lift (λ ix : t, f' ix.1.1 k (hk ix ix.2) ix.1.2) (restriction t x) :=
begin
  refine subring.in_closure.rec_on hxs _ _ _ _,
  { rw [(restriction _).map_one, (free_comm_ring.lift _).map_one, (f' j k hjk).map_one,
        (restriction _).map_one, (free_comm_ring.lift _).map_one] },
  { rw [(restriction _).map_neg, (restriction _).map_one,
        (free_comm_ring.lift _).map_neg, (free_comm_ring.lift _).map_one,
        (f' j k hjk).map_neg, (f' j k hjk).map_one,
        (restriction _).map_neg, (restriction _).map_one,
        (free_comm_ring.lift _).map_neg, (free_comm_ring.lift _).map_one] },
  { rintros _ ⟨p, hps, rfl⟩ n ih,
    rw [(restriction _).map_mul, (free_comm_ring.lift _).map_mul,
        (f' j k hjk).map_mul, ih,
        (restriction _).map_mul, (free_comm_ring.lift _).map_mul,
        restriction_of, dif_pos hps, lift_of, restriction_of, dif_pos (hst hps), lift_of],
    dsimp only,
    have := directed_system.map_map (λ i j h, f' i j h),
    dsimp only at this,
    rw this, refl },
  { rintros x y ihx ihy,
    rw [(restriction _).map_add, (free_comm_ring.lift _).map_add,
        (f' j k hjk).map_add, ihx, ihy,
        (restriction _).map_add, (free_comm_ring.lift _).map_add] }
end
variables {G f f'}

lemma of.zero_exact_aux [nonempty ι] [is_directed ι (≤)] {x : free_comm_ring Σ i, G i}
  (H : ideal.quotient.mk _ x = (0 : direct_limit G (λ i j h, f' i j h))) :
  ∃ j s, ∃ H : (∀ k : Σ i, G i, k ∈ s → k.1 ≤ j), is_supported x s ∧
    lift (λ ix : s, f' ix.1.1 j (H ix ix.2) ix.1.2) (restriction s x) = (0 : G j) :=
begin
  refine span_induction (ideal.quotient.eq_zero_iff_mem.1 H) _ _ _ _,
  { rintros x (⟨i, j, hij, x, rfl⟩ | ⟨i, rfl⟩ | ⟨i, x, y, rfl⟩ | ⟨i, x, y, rfl⟩),
    { refine ⟨j, {⟨i, x⟩, ⟨j, f' i j hij x⟩}, _,
        is_supported_sub (is_supported_of.2 $ or.inr rfl) (is_supported_of.2 $ or.inl rfl), _⟩,
      { rintros k (rfl | ⟨rfl | _⟩), exact hij, refl },
      { rw [(restriction _).map_sub, (free_comm_ring.lift _).map_sub,
            restriction_of, dif_pos, restriction_of, dif_pos, lift_of, lift_of],
        dsimp only,
        have := directed_system.map_map (λ i j h, f' i j h),
        dsimp only at this,
        rw this, exact sub_self _,
        exacts [or.inr rfl, or.inl rfl] } },
    { refine ⟨i, {⟨i, 1⟩}, _, is_supported_sub (is_supported_of.2 rfl) is_supported_one, _⟩,
      { rintros k (rfl|h), refl },
      { rw [(restriction _).map_sub, (free_comm_ring.lift _).map_sub, restriction_of, dif_pos,
          (restriction _).map_one, lift_of, (free_comm_ring.lift _).map_one],
        dsimp only, rw [(f' i i _).map_one, sub_self],
        { exact set.mem_singleton _ } } },
    { refine ⟨i, {⟨i, x+y⟩, ⟨i, x⟩, ⟨i, y⟩}, _,
        is_supported_sub (is_supported_of.2 $ or.inl rfl)
          (is_supported_add (is_supported_of.2 $ or.inr $ or.inl rfl)
            (is_supported_of.2 $ or.inr $ or.inr rfl)), _⟩,
      { rintros k (rfl | ⟨rfl | ⟨rfl | hk⟩⟩); refl },
      { rw [(restriction _).map_sub, (restriction _).map_add,
            restriction_of, restriction_of, restriction_of,
            dif_pos, dif_pos, dif_pos,
            (free_comm_ring.lift _).map_sub, (free_comm_ring.lift _).map_add,
            lift_of, lift_of, lift_of],
        dsimp only, rw (f' i i _).map_add, exact sub_self _,
        exacts [or.inl rfl, or.inr (or.inr rfl), or.inr (or.inl rfl)] } },
    { refine ⟨i, {⟨i, x*y⟩, ⟨i, x⟩, ⟨i, y⟩}, _,
        is_supported_sub (is_supported_of.2 $ or.inl rfl)
          (is_supported_mul (is_supported_of.2 $ or.inr $ or.inl rfl)
            (is_supported_of.2 $ or.inr $ or.inr rfl)), _⟩,
      { rintros k (rfl | ⟨rfl | ⟨rfl | hk⟩⟩); refl },
      { rw [(restriction _).map_sub, (restriction _).map_mul,
            restriction_of, restriction_of, restriction_of,
            dif_pos, dif_pos, dif_pos,
            (free_comm_ring.lift _).map_sub, (free_comm_ring.lift _).map_mul,
            lift_of, lift_of, lift_of],
        dsimp only, rw (f' i i _).map_mul,
        exacts [sub_self _, or.inl rfl, or.inr (or.inr rfl),
          or.inr (or.inl rfl)] } } },
  { refine nonempty.elim (by apply_instance) (assume ind : ι, _),
    refine ⟨ind, ∅, λ _, false.elim, is_supported_zero, _⟩,
    rw [(restriction _).map_zero, (free_comm_ring.lift _).map_zero] },
  { rintros x y ⟨i, s, hi, hxs, ihs⟩ ⟨j, t, hj, hyt, iht⟩,
    obtain ⟨k, hik, hjk⟩ := exists_ge_ge i j,
    have : ∀ z : Σ i, G i, z ∈ s ∪ t → z.1 ≤ k,
    { rintros z (hz | hz), exact le_trans (hi z hz) hik, exact le_trans (hj z hz) hjk },
    refine ⟨k, s ∪ t, this, is_supported_add (is_supported_upwards hxs $ set.subset_union_left s t)
      (is_supported_upwards hyt $ set.subset_union_right s t), _⟩,
    { rw [(restriction _).map_add, (free_comm_ring.lift _).map_add,
        ← of.zero_exact_aux2 G f' hxs hi this hik (set.subset_union_left s t),
        ← of.zero_exact_aux2 G f' hyt hj this hjk (set.subset_union_right s t),
        ihs, (f' i k hik).map_zero, iht, (f' j k hjk).map_zero, zero_add] } },
  { rintros x y ⟨j, t, hj, hyt, iht⟩, rw smul_eq_mul,
    rcases exists_finset_support x with ⟨s, hxs⟩,
    rcases (s.image sigma.fst).exists_le with ⟨i, hi⟩,
    obtain ⟨k, hik, hjk⟩ := exists_ge_ge i j,
    have : ∀ z : Σ i, G i, z ∈ ↑s ∪ t → z.1 ≤ k,
    { rintros z (hz | hz),
      exacts [(hi z.1 $ finset.mem_image.2 ⟨z, hz, rfl⟩).trans hik, (hj z hz).trans hjk] },
    refine ⟨k, ↑s ∪ t, this, is_supported_mul
      (is_supported_upwards hxs $ set.subset_union_left ↑s t)
      (is_supported_upwards hyt $ set.subset_union_right ↑s t), _⟩,
    rw [(restriction _).map_mul, (free_comm_ring.lift _).map_mul,
        ← of.zero_exact_aux2 G f' hyt hj this hjk (set.subset_union_right ↑s t),
        iht, (f' j k hjk).map_zero, mul_zero] }
end

/-- A component that corresponds to zero in the direct limit is already zero in some
bigger module in the directed system. -/
lemma of.zero_exact [is_directed ι (≤)] {i x} (hix : of G (λ i j h, f' i j h) i x = 0) :
  ∃ j (hij : i ≤ j), f' i j hij x = 0 :=
by haveI : nonempty ι := ⟨i⟩; exact
let ⟨j, s, H, hxs, hx⟩ := of.zero_exact_aux hix in
have hixs : (⟨i, x⟩ : Σ i, G i) ∈ s, from is_supported_of.1 hxs,
⟨j, H ⟨i, x⟩ hixs, by rw [restriction_of, dif_pos hixs, lift_of] at hx; exact hx⟩
end of_zero_exact

variables (f' : Π i j, i ≤ j → G i →+* G j)

/-- If the maps in the directed system are injective, then the canonical maps
from the components to the direct limits are injective. -/
theorem of_injective [is_directed ι (≤)] [directed_system G (λ i j h, f' i j h)]
  (hf : ∀ i j hij, function.injective (f' i j hij)) (i) :
  function.injective (of G (λ i j h, f' i j h) i) :=
begin
  suffices : ∀ x, of G (λ i j h, f' i j h) i x = 0 → x = 0,
  { intros x y hxy, rw ← sub_eq_zero, apply this,
    rw [(of G _ i).map_sub, hxy, sub_self] },
  intros x hx, rcases of.zero_exact hx with ⟨j, hij, hfx⟩,
  apply hf i j hij, rw [hfx, (f' i j hij).map_zero]
end

variables (P : Type u₁) [comm_ring P]
variables (g : Π i, G i →+* P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)
include Hg

open free_comm_ring

variables (G f)
/-- The universal property of the direct limit: maps from the components to another ring
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit.
-/
def lift : direct_limit G f →+* P :=
ideal.quotient.lift _ (free_comm_ring.lift $ λ (x : Σ i, G i), g x.1 x.2) begin
  suffices : ideal.span _ ≤
    ideal.comap (free_comm_ring.lift (λ (x : Σ (i : ι), G i), g (x.fst) (x.snd))) ⊥,
  { intros x hx, exact (mem_bot P).1 (this hx) },
  rw ideal.span_le, intros x hx,
  rw [set_like.mem_coe, ideal.mem_comap, mem_bot],
  rcases hx with ⟨i, j, hij, x, rfl⟩ | ⟨i, rfl⟩ | ⟨i, x, y, rfl⟩ | ⟨i, x, y, rfl⟩;
  simp only [ring_hom.map_sub, lift_of, Hg, ring_hom.map_one, ring_hom.map_add, ring_hom.map_mul,
      (g i).map_one, (g i).map_add, (g i).map_mul, sub_self]
end

variables {G f}
omit Hg

@[simp] lemma lift_of (i x) : lift G f P g Hg (of G f i x) = g i x := free_comm_ring.lift_of _ _

theorem lift_unique [nonempty ι] [is_directed ι (≤)] (F : direct_limit G f →+* P) (x) :
  F x = lift G f P (λ i, F.comp $ of G f i) (λ i j hij x, by simp) x :=
direct_limit.induction_on x $ λ i x, by simp

end direct_limit

end

end ring

namespace field

variables [nonempty ι] [is_directed ι (≤)] [Π i, field (G i)]
variables (f : Π i j, i ≤ j → G i → G j)
variables (f' : Π i j, i ≤ j → G i →+* G j)

namespace direct_limit

instance nontrivial [directed_system G (λ i j h, f' i j h)] :
  nontrivial (ring.direct_limit G (λ i j h, f' i j h)) :=
⟨⟨0, 1, nonempty.elim (by apply_instance) $ assume i : ι, begin
  change (0 : ring.direct_limit G (λ i j h, f' i j h)) ≠ 1,
  rw ← (ring.direct_limit.of _ _ _).map_one,
  intros H, rcases ring.direct_limit.of.zero_exact H.symm with ⟨j, hij, hf⟩,
  rw (f' i j hij).map_one at hf,
  exact one_ne_zero hf
end ⟩⟩

theorem exists_inv {p : ring.direct_limit G f} : p ≠ 0 → ∃ y, p * y = 1 :=
ring.direct_limit.induction_on p $ λ i x H,
⟨ring.direct_limit.of G f i (x⁻¹), by erw [← (ring.direct_limit.of _ _ _).map_mul,
    mul_inv_cancel (assume h : x = 0, H $ by rw [h, (ring.direct_limit.of _ _ _).map_zero]),
    (ring.direct_limit.of _ _ _).map_one]⟩

section
open_locale classical

/-- Noncomputable multiplicative inverse in a direct limit of fields. -/
noncomputable def inv (p : ring.direct_limit G f) : ring.direct_limit G f :=
if H : p = 0 then 0 else classical.some (direct_limit.exists_inv G f H)

protected theorem mul_inv_cancel {p : ring.direct_limit G f} (hp : p ≠ 0) : p * inv G f p = 1 :=
by rw [inv, dif_neg hp, classical.some_spec (direct_limit.exists_inv G f hp)]

protected theorem inv_mul_cancel {p : ring.direct_limit G f} (hp : p ≠ 0) : inv G f p * p = 1 :=
by rw [_root_.mul_comm, direct_limit.mul_inv_cancel G f hp]

/-- Noncomputable field structure on the direct limit of fields.
See note [reducible non-instances]. -/
@[reducible]
protected noncomputable def field [directed_system G (λ i j h, f' i j h)] :
  field (ring.direct_limit G (λ i j h, f' i j h)) :=
{ inv := inv G (λ i j h, f' i j h),
  mul_inv_cancel := λ p, direct_limit.mul_inv_cancel G (λ i j h, f' i j h),
  inv_zero := dif_pos rfl,
  .. ring.direct_limit.comm_ring G (λ i j h, f' i j h),
  .. direct_limit.nontrivial G (λ i j h, f' i j h) }

end

end direct_limit

end field