universe u

def tuple (α : Type u) (n : ℕ) :=
  { l : list α // list.length l = n }

variables {α : Type u} {n : ℕ}

example (h : n = 0) (t : tuple α n) : tuple α 0 :=
begin
  rw h at t,
  exact t
end


import tactic
import topology.basic
import apartness_spaces

variables (X : Type) (τ : topological_space X)

namespace top_apart

def apart (x : X) (A : set X) : Prop :=
∃ U : set X, (τ.is_open U) ∧ (x ∈ U ∧ U ⊆ {z | ∀ y, y ∈ A → z ≠ y})

def apartness_complement (S : set X) : set X :=
{x | apart X τ x S}

def apartness_difference (A : set X) (S : set X) : set X :=
A ∩ (apartness_complement X τ S)

def near (x : X) (A : set X) : Prop :=
∀ S : set X, x ∈ (apartness_complement X τ S) → ∃ y : X, y ∈ (apartness_difference X τ A S)

variable (A5 : ∀ (x : X) (A : set X), apart X τ x A → (∀ y : X, x ≠ y ∨ apart X τ y A))

open point_set_apartness

@[instance]
lemma topological_apartness_structure
(TTA₁ : ∀ (x y : X), x ≠ y → ∃ (U V : set X),
                                     (τ.is_open U ∧ τ.is_open V)
                                   ∧ (x ∈ U ∧ y ∉ U)
                                   ∧ (x ∉ V ∧ y ∈ V))
: point_set_apartness_space X :=
{ r := λ x y, x = y,
  iseqv := eq_equivalence,
  ar := λ x y, x ≠ y,
  ar_not_r := λ _ _ p, p,
  ar_symm := λ _ _ p, by finish,
  apart := apart X τ,
  ar_to_apart := begin
    intros x y p,
    unfold apart,
    have h := TTA₁ x y p,
    cases h with U h,
    cases h with V h,
    cases h with h0 h1,
    cases h0 with oU oV,
    cases h1 with h0 h1,
    use U,
    split,
    exact oU,
    split,
    exact h0.1,
    intros hh hhi y' hy' hhhy',
    apply h0.2,
    cases hy',
    rw ← hhhy',
    exact hhi
  end,
  apart_to_nin := begin
    intros x A axA,
    cases axA with U hUA,
    cases hUA with oU huA,
    cases huA with hUx hUA,
    intro hxA,
    specialize hUA hUx x hxA,
    apply hUA,
    refl,
  end,
  apart_union_iff_apart_and_apart := begin
    intros x A B,
    split,
    intro axAB,
    cases axAB with U axAB,
    cases axAB with oU axAB,
    cases axAB with hxU axAB,
    split,
    use U,
    split,
    exact oU,
    split,
    exact hxU,
    intros x' hx',
    specialize axAB hx',
    intros y' hy',
    specialize axAB y',
    apply axAB,
    exact set.mem_union_left B hy',
    use U,
    split,
    exact oU,
    split,
    exact hxU,
    intros x' hx',
    specialize axAB hx',
    intros y' hy',
    specialize axAB y',
    apply axAB,
    exact set.mem_union_right A hy',
    intro h,
    cases h with h1 h2,
    cases h1 with U h1,
    cases h2 with U' h2,
    cases h1 with oU h1,
    cases h2 with oU' h2,
    cases h1 with hxU h1,
    cases h2 with hxU' h2,
    use U ∩ U',
    split,
    exact topological_space.is_open_inter τ U U' oU oU',
    split,
    split,
    exact hxU,
    exact hxU',
    intros x'' hx'',
    cases hx'' with hx''1 hx''2,
    intros y hy,
    specialize h1 hx''1,
    specialize h2 hx''2,
    cases hy,
    exact h1 y hy,
    exact h2 y hy,
  end,
  apart_conj_to_apart := begin
    intros x A B h,
    cases h with h1 h2,
    dsimp at *,
    unfold apartness.complement at h2,
    unfold apart,
    cases h1 with U h1,
    cases h1 with hU h1,
    cases h1 with korn h1,
    use U,
    split,
    exact hU,
    split,
    exact korn,
    intros x' hx' y hy,
    apply h2,
    use U,
    split,
    exact hU,
    split,
    exact hx',
    exact h1,
    exact hy,
  end,
  apart_to_or_apart := A5 }
-- possibly need to refactor so that these definitions can be accessed

end top_apart


import algebra.ofe.basic

universe u

/-!
# OFEs for `option` and `part`
-/

inductive option.eq_at_prop {α : Type u} [ofe α] (n : ℕ) : option α → option α → Prop
| some : Π {a b : α}, a =[n] b → option.eq_at_prop (some a) (some b)
| none : option.eq_at_prop none none

instance {α : Type u} [ofe α] : ofe (option α) := {
  eq_at := option.eq_at_prop,
  eq_at_reflexive := begin
    intros n x,
    cases x,
    exact option.eq_at_prop.none,
    refine option.eq_at_prop.some _,
    refl,
  end,
  eq_at_symmetric := begin
    intros n x y h,
    cases h,
    refine option.eq_at_prop.some _, symmetry, assumption,
    exact option.eq_at_prop.none,
  end,
  eq_at_transitive := begin
    intros n x y z hxy hyz,
    cases hxy,
    case none { cases hyz, exact option.eq_at_prop.none, },
    cases hyz,
    refine option.eq_at_prop.some _,
    transitivity, skip, assumption, assumption,
  end,
  eq_at_mono' := begin
    intros m n hmn x y h,
    cases h,
    case none { exact option.eq_at_prop.none, },
    refine option.eq_at_prop.some _,
    refine eq_at_mono hmn _,
    assumption,
  end,
  eq_at_limit' := begin
    intros x y h,
    cases h 0,
    case none { refl },
    refine congr_arg _ _, rw eq_at_limit,
    intro n, cases h n, assumption,
  end,
}

@[simp] lemma option.some_is_nonexpansive {α : Type u} [ofe α] :
  is_nonexpansive (some : α → option α) :=
λ n x y h, option.eq_at_prop.some h

lemma option.eq_at_of_some_eq_at {α : Type u} [ofe α] {n : ℕ} {a b : α} :
  some a =[n] some b → a =[n] b :=
λ h, by cases h; assumption

@[simp] lemma option.some_eq_at_iff {α : Type u} [ofe α] {n : ℕ} {a b : α} :
  some a =[n] some b ↔ a =[n] b :=
⟨option.eq_at_of_some_eq_at, option.eq_at_prop.some⟩

@[simp] lemma option.exists_eq_iff_some_eq {α : Type u} [ofe α] {n : ℕ} {a : α} {b : option α} :
  some a =[n] b ↔ ∃ b', b = some b' ∧ a =[n] b' :=
begin
  split,
  { rintro (h | h),
    exact ⟨_, rfl, ‹_›⟩, },
  { rintro ⟨b', rfl, hb⟩,
    exact option.some_eq_at_iff.mpr hb, },
end

-- TODO: Refactor this to use an inductive equality.

instance {α : Type u} [ofe α] : ofe (part α) := {
  eq_at := λ n a b, (¬a.dom ∧ ¬b.dom) ∨ ∃ (ha : a.dom) (hb : b.dom), a.get ha =[n] b.get hb,
  eq_at_reflexive := begin
    intros n a,
    by_cases a.dom,
    { right,
      refine ⟨h, h, _⟩,
      refl, },
    { left,
      exact ⟨h, h⟩, },
  end,
  eq_at_symmetric := begin
    rintros n a b (⟨ha, hb⟩ | ⟨ha, hb, hab⟩),
    { left,
      exact ⟨hb, ha⟩, },
    { right,
      refine ⟨hb, ha, _⟩,
      symmetry,
      exact hab, },
  end,
  eq_at_transitive := begin
    rintros n a b c (⟨ha, hb⟩ | ⟨ha, hb, hab⟩) (⟨hb', hc⟩ | ⟨hb', hc, hbc⟩),
    { left,
      exact ⟨ha, hc⟩, },
    { cases hb hb', },
    { cases hb' hb, },
    { right,
      refine ⟨ha, hc, _⟩,
      transitivity b.get hb,
      exact hab,
      exact hbc, },
  end,
  eq_at_mono' := begin
    rintros m n hmn a b (⟨ha, hb⟩ | ⟨ha, hb, hab⟩),
    { left,
      exact ⟨ha, hb⟩, },
    { right,
      refine ⟨ha, hb, _⟩,
      exact eq_at_mono hmn hab, },
  end,
  eq_at_limit' := begin
    intros a b h,
    rcases h 0 with (h' | ⟨ha, hb, h'⟩),
    { refine part.ext' _ _;
      tauto, },
    { refine part.ext' _ _,
      { tauto, },
      intros _ _,
      rw eq_at_limit,
      intro n,
      rcases h n with (h'' | ⟨ha, hb, h''⟩),
      { cases h''.1 ha, },
      { exact h'', }, },
  end,
}


class Semigroup (M : Type u) extends Mul M where
  mul_assoc (a b c : M) : (a * b) * c = a * (b * c)
export Semigroup (mul_assoc)

class CommSemigroup (M : Type u) extends Semigroup M where
  mul_comm (a b : M) : a * b = b * a
export CommSemigroup (mul_comm)

class Monoid (M : Type u) extends Semigroup M, OfNat M 1 where
  mul_one (m : M) : m * 1 = m
  one_mul (m : M) : 1 * m = m

class CommMonoid (M : Type u) extends Monoid M, CommSemigroup M

theorem mul_left_comm {M} [CommSemigroup M] (a b c : M) : a * (b * c) = b * (a * c) := by
  rw [← mul_assoc, mul_comm a b, mul_assoc]

example {M} [CommMonoid M] (a b c d : M) : a * (b * (c * d)) = (a * c) * (b * d) := by
  simp only [mul_left_comm, mul_comm, mul_assoc]

example {M} [CommMonoid M] (a b c d : M) : (b * (c * d)) = (c) * (b * d) := by
  simp only [mul_left_comm, mul_comm, mul_assoc]


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.polynomial.group_ring_action
import Mathlib.deprecated.subfield
import Mathlib.field_theory.normal
import Mathlib.field_theory.separable
import Mathlib.field_theory.tower
import Mathlib.linear_algebra.matrix
import Mathlib.ring_theory.polynomial.default
import Mathlib.PostPort

universes u v w

namespace Mathlib

/-!
# Fixed field under a group action.

This is the basis of the Fundamental Theorem of Galois Theory.
Given a (finite) group `G` that acts on a field `F`, we define `fixed_points G F`,
the subfield consisting of elements of `F` fixed_points by every element of `G`.

This subfield is then normal and separable, and in addition (TODO) if `G` acts faithfully on `F`
then `findim (fixed_points G F) F = fintype.card G`.

## Main Definitions

- `fixed_points G F`, the subfield consisting of elements of `F` fixed_points by every element of `G`, where
`G` is a group that acts on `F`.

-/

protected instance fixed_by.is_subfield (G : Type u) [group G] (F : Type v) [field F]
    [mul_semiring_action G F] (g : G) : is_subfield (mul_action.fixed_by G F g) :=
  is_subfield.mk
    fun (x : F) (hx : x ∈ mul_action.fixed_by G F g) =>
      Eq.trans (smul_inv F g x) (congr_arg has_inv.inv hx)

namespace fixed_points

protected instance mul_action.fixed_points.is_subfield (G : Type u) [group G] (F : Type v) [field F]
    [mul_semiring_action G F] : is_subfield (mul_action.fixed_points G F) :=
  eq.mpr
    ((fun (S S_1 : set F) (e_2 : S = S_1) => congr_arg is_subfield e_2)
      (mul_action.fixed_points G F) (set.Inter (mul_action.fixed_by G F))
      (eq.mpr
        (id
          (Eq._oldrec (Eq.refl (mul_action.fixed_points G F = set.Inter (mul_action.fixed_by G F)))
            (mul_action.fixed_eq_Inter_fixed_by G F)))
        (Eq.refl (set.Inter fun (g : G) => mul_action.fixed_by G F g))))
    (is_subfield.Inter (mul_action.fixed_by G F))

protected instance mul_action.fixed_points.is_invariant_subring (G : Type u) [group G] (F : Type v)
    [field F] [mul_semiring_action G F] : is_invariant_subring G (mul_action.fixed_points G F) :=
  is_invariant_subring.mk
    fun (g : G) (x : F) (hx : x ∈ mul_action.fixed_points G F) (g' : G) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (g' • g • x = g • x)) (hx g)))
        (eq.mpr (id (Eq._oldrec (Eq.refl (g' • x = x)) (hx g'))) (Eq.refl x))

@[simp] theorem smul (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] (g : G)
    (x : ↥(mul_action.fixed_points G F)) : g • x = x :=
  subtype.eq (subtype.property x g)

-- Why is this so slow?

@[simp] theorem smul_polynomial (G : Type u) [group G] (F : Type v) [field F]
    [mul_semiring_action G F] (g : G) (p : polynomial ↥(mul_action.fixed_points G F)) : g • p = p :=
  sorry

protected instance algebra (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] :
    algebra (↥(mul_action.fixed_points G F)) F :=
  algebra.of_is_subring (mul_action.fixed_points G F)

theorem coe_algebra_map (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] :
    algebra_map (↥(mul_action.fixed_points G F)) F =
        is_subring.subtype (mul_action.fixed_points G F) :=
  rfl

theorem linear_independent_smul_of_linear_independent (G : Type u) [group G] (F : Type v) [field F]
    [mul_semiring_action G F] {s : finset F} :
    (linear_independent ↥(mul_action.fixed_points G F) fun (i : ↥↑s) => ↑i) →
        linear_independent F fun (i : ↥↑s) => coe_fn (mul_action.to_fun G F) ↑i :=
  sorry

/-- `minpoly G F x` is the minimal polynomial of `(x : F)` over `fixed_points G F`. -/
def minpoly (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] [fintype G]
    (x : F) : polynomial ↥(mul_action.fixed_points G F) :=
  polynomial.to_subring (prod_X_sub_smul G F x) (mul_action.fixed_points G F) sorry

namespace minpoly

theorem monic (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] [fintype G]
    (x : F) : polynomial.monic (minpoly G F x) :=
  subtype.eq (prod_X_sub_smul.monic G F x)

theorem eval₂ (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] [fintype G]
    (x : F) :
    polynomial.eval₂ (is_subring.subtype (mul_action.fixed_points G F)) x (minpoly G F x) = 0 :=
  sorry

theorem ne_one (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] [fintype G]
    (x : F) : minpoly G F x ≠ 1 :=
  sorry

theorem of_eval₂ (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F] [fintype G]
    (x : F) (f : polynomial ↥(mul_action.fixed_points G F))
    (hf : polynomial.eval₂ (is_subring.subtype (mul_action.fixed_points G F)) x f = 0) :
    minpoly G F x ∣ f :=
  sorry

/- Why is this so slow? -/

theorem irreducible_aux (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] (x : F) (f : polynomial ↥(mul_action.fixed_points G F))
    (g : polynomial ↥(mul_action.fixed_points G F)) (hf : polynomial.monic f)
    (hg : polynomial.monic g) (hfg : f * g = minpoly G F x) : f = 1 ∨ g = 1 :=
  sorry

theorem irreducible (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] (x : F) : irreducible (minpoly G F x) :=
  iff.mpr (polynomial.irreducible_of_monic (monic G F x) (ne_one G F x)) (irreducible_aux G F x)

end minpoly

theorem is_integral (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] (x : F) : is_integral (↥(mul_action.fixed_points G F)) x :=
  Exists.intro (minpoly G F x) { left := minpoly.monic G F x, right := minpoly.eval₂ G F x }

theorem minpoly_eq_minpoly (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] (x : F) : minpoly G F x = minpoly (↥(mul_action.fixed_points G F)) x :=
  minpoly.unique' (is_integral G F x) (minpoly.irreducible G F x) (minpoly.eval₂ G F x)
    (minpoly.monic G F x)

protected instance normal (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] : normal (↥(mul_action.fixed_points G F)) F :=
  sorry

protected instance separable (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] : is_separable (↥(mul_action.fixed_points G F)) F :=
  sorry

theorem dim_le_card (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] : vector_space.dim (↥(mul_action.fixed_points G F)) F ≤ ↑(fintype.card G) :=
  sorry

protected instance finite_dimensional (G : Type u) [group G] (F : Type v) [field F]
    [mul_semiring_action G F] [fintype G] : finite_dimensional (↥(mul_action.fixed_points G F)) F :=
  iff.mpr finite_dimensional.finite_dimensional_iff_dim_lt_omega
    (lt_of_le_of_lt (dim_le_card G F) (cardinal.nat_lt_omega (fintype.card G)))

theorem findim_le_card (G : Type u) [group G] (F : Type v) [field F] [mul_semiring_action G F]
    [fintype G] : finite_dimensional.findim (↥(mul_action.fixed_points G F)) F ≤ fintype.card G :=
  eq.mp (propext cardinal.nat_cast_le)
    (trans_rel_right LessEq (finite_dimensional.findim_eq_dim (↥(mul_action.fixed_points G F)) F)
      (dim_le_card G F))

end fixed_points

theorem linear_independent_to_linear_map (R : Type u) (A : Type v) (B : Type w) [comm_semiring R]
    [integral_domain A] [algebra R A] [integral_domain B] [algebra R B] :
    linear_independent B alg_hom.to_linear_map :=
  sorry

theorem cardinal_mk_alg_hom (K : Type u) (V : Type v) (W : Type w) [field K] [field V] [algebra K V]
    [finite_dimensional K V] [field W] [algebra K W] [finite_dimensional K W] :
    cardinal.mk (alg_hom K V W) ≤ ↑(finite_dimensional.findim W (linear_map K V W)) :=
  finite_dimensional.cardinal_mk_le_findim_of_linear_independent
    (linear_independent_to_linear_map K V W)

protected instance alg_hom.fintype (K : Type u) (V : Type v) (W : Type w) [field K] [field V]
    [algebra K V] [finite_dimensional K V] [field W] [algebra K W] [finite_dimensional K W] :
    fintype (alg_hom K V W) :=
  Classical.choice sorry

protected instance alg_equiv.fintype (K : Type u) (V : Type v) [field K] [field V] [algebra K V]
    [finite_dimensional K V] : fintype (alg_equiv K V V) :=
  fintype.of_equiv (alg_hom K V V) (equiv.symm (alg_equiv_equiv_alg_hom K V))

theorem findim_alg_hom (K : Type u) (V : Type v) [field K] [field V] [algebra K V]
    [finite_dimensional K V] :
    fintype.card (alg_hom K V V) ≤ finite_dimensional.findim V (linear_map K V V) :=
  finite_dimensional.fintype_card_le_findim_of_linear_independent
    (linear_independent_to_linear_map K V V)

namespace fixed_points

/-- Embedding produced from a faithful action. -/
@[simp] theorem to_alg_hom_apply (G : Type u) (F : Type v) [group G] [field F]
    [faithful_mul_semiring_action G F] :
    ⇑(to_alg_hom G F) =
        fun (g : G) =>
          alg_hom.mk (ring_hom.to_fun (mul_semiring_action.to_semiring_hom G F g))
            (to_alg_hom._proof_3 G F g) (to_alg_hom._proof_4 G F g) (to_alg_hom._proof_5 G F g)
            (to_alg_hom._proof_6 G F g) (to_alg_hom._proof_7 G F g) :=
  Eq.refl ⇑(to_alg_hom G F)

theorem to_alg_hom_apply_apply {G : Type u} {F : Type v} [group G] [field F]
    [faithful_mul_semiring_action G F] (g : G) (x : F) :
    coe_fn (coe_fn (to_alg_hom G F) g) x = g • x :=
  rfl

theorem findim_eq_card (G : Type u) (F : Type v) [group G] [field F] [fintype G]
    [faithful_mul_semiring_action G F] :
    finite_dimensional.findim (↥(mul_action.fixed_points G F)) F = fintype.card G :=
  sorry

theorem to_alg_hom_bijective (G : Type u) (F : Type v) [group G] [field F] [fintype G]
    [faithful_mul_semiring_action G F] : function.bijective ⇑(to_alg_hom G F) :=
  sorry

/-- Bijection between G and algebra homomorphisms that fix the fixed points -/
def to_alg_hom_equiv (G : Type u) (F : Type v) [group G] [field F] [fintype G]
    [faithful_mul_semiring_action G F] : G ≃ alg_hom (↥(mul_action.fixed_points G F)) F F :=
  function.embedding.equiv_of_surjective (to_alg_hom G F) sorry

end Mathlib


import positive_nat.mod

namespace positive_nat namespace natural

lemma gcd_wf (n m : natural) (hx : m % n ≠ n) : m % n < n :=
begin
  cases @mod_le_right m n,
  { constructor,
    exfalso,
    exact hx h,
    exact 1 },
  { assumption }
end

def gcd : natural → natural → natural
| n m := let x := m % n in if h: x = n then x else
have hh : _ := gcd_wf n m h,
gcd x n
using_well_founded lib.wf_tacs

lemma gcd_def' {a b : natural} : gcd a b = if b % a = a then b % a else gcd (b % a) a :=
begin
  conv { to_lhs, rw gcd.equations._eqn_1 }
end

@[simp]
lemma gcd_same {a : natural} : gcd a a = a :=
begin
  rw gcd_def',
  rw if_pos mod_of_eq,
  exact mod_of_eq
end

lemma  gcd_def {a b : natural} : gcd a b = if a = b then a else gcd (b % a) a :=
begin
  by_cases a = b,
  { rw if_pos h, rw h, exact gcd_same },
  { rw if_neg h,
    conv in (gcd a b) { rw gcd_def' },
    by_cases hh : b % a = a,
    { rw if_pos hh, rw hh, rw gcd_same },
    { rw if_neg hh } }
end

lemma gcd_step {a b : natural} : gcd a b = gcd (b % a) a :=
begin
  conv in (gcd a b) { rw gcd_def },
  by_cases h: a = b,
  { rw if_pos h, rw h, rw mod_of_eq, rw gcd_same },
  { rw if_neg h }
end

lemma gcd_symm {x y : natural} : gcd x y = gcd y x :=
begin
  wlog h : y ≤ x, { exact le_or_le_symm },
  rw gcd_def,
  cases h,
  { rw if_pos h.symm, subst y, rw gcd_same },
  { rw if_neg,
    rw mod_of_le,
    exact or.inr h,
    intro hh,
    cases h with x h,
    subst y,
    exact add_ne_self h }
end

@[simp]
lemma gcd_one {a : natural} : gcd a 1 = 1 :=
begin
  rw [gcd_symm, gcd_step, mod_one, gcd_same]
end

@[simp]
lemma gcd_dvd_left_of_le {a b : natural} (h : b ≤ a) : gcd a b ∣ a :=
begin
  sorry
end
-- mod_le_right
-- lt_of_le_lt

end natural end positive_nat

#print instances has_dvd


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import topology.continuous_function.algebra

/-!

# Continuous Monoid Homs

This file defines the space of continuous homomorphisms between two topological groups.

## Main definitions

* `continuous_monoid_hom A B`: The continuous homomorphisms `A →* B`.

-/

variables (A B C D E : Type*)
  [monoid A] [monoid B] [monoid C] [monoid D] [comm_group E]
  [topological_space A] [topological_space B] [topological_space C] [topological_space D]
  [topological_space E] [topological_group E]

set_option old_structure_cmd true

/-- Continuous homomorphisms between two topological groups. -/
structure continuous_monoid_hom extends A →* B, continuous_map A B

/-- Continuous homomorphisms between two topological groups. -/
structure continuous_add_monoid_hom (A B : Type*) [add_monoid A] [add_monoid B]
  [topological_space A] [topological_space B] extends A →+ B, continuous_map A B

attribute [to_additive] continuous_monoid_hom
attribute [to_additive] continuous_monoid_hom.to_monoid_hom

initialize_simps_projections continuous_monoid_hom (to_fun → apply)

/-- Reinterpret a `continuous_monoid_hom` as a `monoid_hom`. -/
add_decl_doc continuous_monoid_hom.to_monoid_hom

/-- Reinterpret a `continuous_monoid_hom` as a `continuous_map`. -/
add_decl_doc continuous_monoid_hom.to_continuous_map

/-- Reinterpret a `continuous_add_monoid_hom` as an `add_monoid_hom`. -/
add_decl_doc continuous_add_monoid_hom.to_add_monoid_hom

/-- Reinterpret a `continuous_add_monoid_hom` as a `continuous_map`. -/
add_decl_doc continuous_add_monoid_hom.to_continuous_map

namespace continuous_monoid_hom

variables {A B C D E}

@[to_additive] instance : has_coe_to_fun (continuous_monoid_hom A B) (λ _, A → B) :=
⟨continuous_monoid_hom.to_fun⟩

@[to_additive] lemma ext {f g : continuous_monoid_hom A B} (h : ∀ x, f x = g x) : f = g :=
by cases f; cases g; congr; exact funext h

/-- Construct a `continuous_monoid_hom` from a `continuous` `monoid_hom`. -/
@[to_additive "Construct a `continuous_add_monoid_hom` from a `continuous` `add_monoid_hom`.",
  simps]
def mk' (f : A →* B) (hf : continuous f) : continuous_monoid_hom A B := { .. f }

/-- Composition of two continuous homomorphisms. -/
@[to_additive "Composition of two continuous homomorphisms.", simps]
def comp (g : continuous_monoid_hom B C) (f : continuous_monoid_hom A B) :
  continuous_monoid_hom A C :=
mk' (g.to_monoid_hom.comp f.to_monoid_hom) (g.continuous_to_fun.comp f.continuous_to_fun)

/-- Product of two continuous homomorphisms on the same space. -/
@[to_additive "Product of two continuous homomorphisms on the same space.", simps]
def prod (f : continuous_monoid_hom A B) (g : continuous_monoid_hom A C) :
  continuous_monoid_hom A (B × C) :=
mk' (f.to_monoid_hom.prod g.to_monoid_hom) (f.continuous_to_fun.prod_mk g.continuous_to_fun)

/-- Product of two continuous homomorphisms on different spaces. -/
@[to_additive "Product of two continuous homomorphisms on different spaces.", simps]
def prod_map (f : continuous_monoid_hom A C) (g : continuous_monoid_hom B D) :
  continuous_monoid_hom (A × B) (C × D) :=
mk' (f.to_monoid_hom.prod_map g.to_monoid_hom) (f.continuous_to_fun.prod_map g.continuous_to_fun)

variables (A B C D E)

/-- The trivial continuous homomorphism. -/
@[to_additive "The trivial continuous homomorphism.", simps]
def one : continuous_monoid_hom A B := mk' 1 continuous_const

@[to_additive] instance : inhabited (continuous_monoid_hom A B) := ⟨one A B⟩

/-- The identity continuous homomorphism. -/
@[to_additive "The identity continuous homomorphism.", simps]
def id : continuous_monoid_hom A A := mk' (monoid_hom.id A) continuous_id

/-- The continuous homomorphism given by projection onto the first factor. -/
@[to_additive "The continuous homomorphism given by projection onto the first factor.", simps]
def fst : continuous_monoid_hom (A × B) A := mk' (monoid_hom.fst A B) continuous_fst

/-- The continuous homomorphism given by projection onto the second factor. -/
@[to_additive "The continuous homomorphism given by projection onto the second factor.", simps]
def snd : continuous_monoid_hom (A × B) B := mk' (monoid_hom.snd A B) continuous_snd

/-- The continuous homomorphism given by inclusion of the first factor. -/
@[to_additive "The continuous homomorphism given by inclusion of the first factor.", simps]
def inl : continuous_monoid_hom A (A × B) := prod (id A) (one A B)

/-- The continuous homomorphism given by inclusion of the second factor. -/
@[to_additive "The continuous homomorphism given by inclusion of the second factor.", simps]
def inr : continuous_monoid_hom B (A × B) := prod (one B A) (id B)

/-- The continuous homomorphism given by the diagonal embedding. -/
@[to_additive "The continuous homomorphism given by the diagonal embedding.", simps]
def diag : continuous_monoid_hom A (A × A) := prod (id A) (id A)

/-- The continuous homomorphism given by swapping components. -/
@[to_additive "The continuous homomorphism given by swapping components.", simps]
def swap : continuous_monoid_hom (A × B) (B × A) := prod (snd A B) (fst A B)

/-- The continuous homomorphism given by multiplication. -/
@[to_additive "The continuous homomorphism given by addition.", simps]
def mul : continuous_monoid_hom (E × E) E :=
mk' mul_monoid_hom continuous_mul

/-- The continuous homomorphism given by inversion. -/
@[to_additive "The continuous homomorphism given by negation.", simps]
def inv : continuous_monoid_hom E E :=
mk' comm_group.inv_monoid_hom continuous_inv

variables {A B C D E}

/-- Coproduct of two continuous homomorphisms to the same space. -/
@[to_additive "Coproduct of two continuous homomorphisms to the same space.", simps]
def coprod (f : continuous_monoid_hom A E) (g : continuous_monoid_hom B E) :
  continuous_monoid_hom (A × B) E :=
(mul E).comp (f.prod_map g)

@[to_additive] instance : comm_group (continuous_monoid_hom A E) :=
{ mul := λ f g, (mul E).comp (f.prod g),
  mul_comm := λ f g, ext (λ x, mul_comm (f x) (g x)),
  mul_assoc := λ f g h, ext (λ x, mul_assoc (f x) (g x) (h x)),
  one := one A E,
  one_mul := λ f, ext (λ x, one_mul (f x)),
  mul_one := λ f, ext (λ x, mul_one (f x)),
  inv := λ f, (inv E).comp f,
  mul_left_inv := λ f, ext (λ x, mul_left_inv (f x)) }

instance : topological_space (continuous_monoid_hom A B) :=
topological_space.induced to_continuous_map continuous_map.compact_open

variables (A B C D E)

lemma is_inducing : inducing (to_continuous_map : continuous_monoid_hom A B → C(A, B)) := ⟨rfl⟩

lemma is_embedding : embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
⟨is_inducing A B, λ _ _, ext ∘ continuous_map.ext_iff.mp⟩

variables {A B C D E}

instance [locally_compact_space A] [t2_space B] : t2_space (continuous_monoid_hom A B) :=
(is_embedding A B).t2_space

instance : topological_group (continuous_monoid_hom A E) :=
let hi := is_inducing A E, hc := hi.continuous in
{ continuous_mul := hi.continuous_iff.mpr (continuous_mul.comp (continuous.prod_map hc hc)),
  continuous_inv := hi.continuous_iff.mpr (continuous_inv.comp hc) }

end continuous_monoid_hom


import Lean4Axiomatic.Rational.Impl.Fraction.Multiplication
import Lean4Axiomatic.Rational.Negation

namespace Lean4Axiomatic.Rational.Impl.Fraction

variable {ℕ : Type} [Natural ℕ]
variable {ℤ : Type} [Integer (ℕ := ℕ) ℤ]

/-! ## Negation and subtraction on fractions -/

/-- Negation of fractions. -/
def neg : Fraction ℤ → Fraction ℤ
| p//q => (-p)//q

instance negation_ops : Negation.Ops (Fraction ℤ) := {
  neg := neg
}

/--
Negation of integer fractions is consistent with its equivalent on integers.

**Property intuition**: This must be true if we want integers to be represented
as integer fractions.

**Proof intuition**: Follows directly from the definition of negation.
-/
theorem neg_compat_from_integer
    {a : ℤ} : from_integer (-a) ≃ -(from_integer a)
    := by
  show (-a)//1 ≃ -(a//1)
  exact eqv_refl

/--
The negations of equivalent fractions are themselves equivalent.

**Property intuition**: This must be true for negation on fractions to be a
valid function.

**Proof intuition**: Expand all definitions in the hypotheses and goal until
equivalences involving only integers are reached. Show the goal equivalence
using algebra and the equivalence from the `p₁ ≃ p₂` hypothesis.
-/
theorem neg_subst {p₁ p₂ : Fraction ℤ} : p₁ ≃ p₂ → -p₁ ≃ -p₂ := by
  revert p₁; intro (p₁n//p₁d); revert p₂; intro (p₂n//p₂d)
  intro (_ : p₁n//p₁d ≃ p₂n//p₂d)
  show -(p₁n//p₁d) ≃ -(p₂n//p₂d)
  show (-p₁n//p₁d) ≃ (-p₂n//p₂d)
  show -p₁n * p₂d ≃ -p₂n * p₁d
  have : p₁n * p₂d ≃ p₂n * p₁d := ‹p₁n//p₁d ≃ p₂n//p₂d›
  calc
    (-p₁n) * p₂d   ≃ _ := Rel.symm AA.scompatL
    (-(p₁n * p₂d)) ≃ _ := AA.subst₁ ‹p₁n * p₂d ≃ p₂n * p₁d›
    (-(p₂n * p₁d)) ≃ _ := AA.scompatL
    (-p₂n) * p₁d   ≃ _ := Rel.refl

/--
The negation of a fraction is its left additive inverse.

**Property intuition**: Fractions should obey all the algebraic properties of
integers.

**Proof intuition**: The denominators are the same, so the numerators can be
directly added. But the numerators are additive inverses, so they sum to zero,
and thus the entire result is zero.
-/
theorem add_inverseL {p : Fraction ℤ} : -p + p ≃ 0 := by
  revert p; intro (pn//pd)
  show -(pn//pd) + pn//pd ≃ 0
  calc
    -(pn//pd) + pn//pd ≃ _ := eqv_refl
    (-pn)//pd + pn//pd ≃ _ := add_eqv_denominators
    (-pn + pn)//pd     ≃ _ := substN AA.inverseL
    0//pd              ≃ _ := eqv_zero_iff_numerator_eqv_zero.mpr Rel.refl
    0                  ≃ _ := eqv_refl

/--
The negation of a fraction is its right additive inverse.

**Property intuition**: Fractions should obey all the algebraic properties of
integers.

**Proof intuition**: Follows from the left additive inverse and commutativity.
-/
theorem add_inverseR {p : Fraction ℤ} : p + -p ≃ 0 :=
  eqv_trans add_comm add_inverseL

instance negation_props : Negation.Props (Fraction ℤ) := {
  neg_subst := neg_subst
  neg_compat_from_integer := neg_compat_from_integer
  add_inverseL := add_inverseL
  add_inverseR := add_inverseR
}

instance negation : Negation (Fraction ℤ) := {
  toOps := negation_ops
  toProps := negation_props
}

/--
Subtraction of fractions.

**Definition intuition**: Adding the negation is the same as subtraction, e.g.
`5 - 3` is the same as `5 + (-3)`.
-/
def sub (p q : Fraction ℤ) : Fraction ℤ := p + (-q)

instance subtraction_ops : Subtraction.Ops (Fraction ℤ) := {
  sub := sub
}

instance subtraction_props : Subtraction.Props (Fraction ℤ) := {
  sub_add_neg := eqv_refl
}

instance subtraction : Subtraction (Fraction ℤ) := {
  toOps := subtraction_ops
  toProps := subtraction_props
}

end Lean4Axiomatic.Rational.Impl.Fraction


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jeremy Avigad, Yury Kudryashov
-/
import order.filter.cofinite
import order.zorn

/-!
# Ultrafilters

An ultrafilter is a minimal (maximal in the set order) proper filter.
In this file we define

* `ultrafilter.of`: an ultrafilter that is less than or equal to a given filter;
* `ultrafilter`: subtype of ultrafilters;
* `ultrafilter.pure`: `pure x` as an `ultrafiler`;
* `ultrafilter.map`, `ultrafilter.bind`, `ultrafilter.comap` : operations on ultrafilters;
* `hyperfilter`: the ultrafilter extending the cofinite filter.
-/

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

open set zorn filter function
open_locale classical filter

/-- An ultrafilter is a minimal (maximal in the set order) proper filter. -/
@[protect_proj]
structure ultrafilter (α : Type*) extends filter α :=
(ne_bot' : ne_bot to_filter)
(le_of_le : ∀ g, filter.ne_bot g → g ≤ to_filter → to_filter ≤ g)

namespace ultrafilter

variables {f g : ultrafilter α} {s t : set α} {p q : α → Prop}

instance : has_coe_t (ultrafilter α) (filter α) := ⟨ultrafilter.to_filter⟩

instance : has_mem (set α) (ultrafilter α) := ⟨λ s f, s ∈ (f : filter α)⟩

lemma unique (f : ultrafilter α) {g : filter α} (h : g ≤ f)
  (hne : ne_bot g . tactic.apply_instance) : g = f :=
le_antisymm h $ f.le_of_le g hne h

instance ne_bot (f : ultrafilter α) : ne_bot (f : filter α) := f.ne_bot'

@[simp, norm_cast] lemma mem_coe : s ∈ (f : filter α) ↔ s ∈ f := iff.rfl

lemma coe_injective : injective (coe : ultrafilter α → filter α)
| ⟨f, h₁, h₂⟩ ⟨g, h₃, h₄⟩ rfl := by congr

@[simp, norm_cast] lemma coe_le_coe {f g : ultrafilter α} : (f : filter α) ≤ g ↔ f = g :=
⟨λ h, coe_injective $ g.unique h, λ h, h ▸ le_rfl⟩

@[simp, norm_cast] lemma coe_inj : (f : filter α) = g ↔ f = g := coe_injective.eq_iff

@[ext] lemma ext ⦃f g : ultrafilter α⦄ (h : ∀ s, s ∈ f ↔ s ∈ g) : f = g :=
coe_injective $ filter.ext h

lemma le_of_inf_ne_bot (f : ultrafilter α) {g : filter α} (hg : ne_bot (↑f ⊓ g)) : ↑f ≤ g :=
le_of_inf_eq (f.unique inf_le_left hg)

lemma le_of_inf_ne_bot' (f : ultrafilter α) {g : filter α} (hg : ne_bot (g ⊓ f)) : ↑f ≤ g :=
f.le_of_inf_ne_bot $ by rwa inf_comm

@[simp] lemma compl_not_mem_iff : sᶜ ∉ f ↔ s ∈ f :=
⟨λ hsc, le_principal_iff.1 $ f.le_of_inf_ne_bot
  ⟨λ h, hsc $ mem_of_eq_bot$ by rwa compl_compl⟩, compl_not_mem⟩

@[simp] lemma frequently_iff_eventually : (∃ᶠ x in f, p x) ↔ ∀ᶠ x in f, p x :=
compl_not_mem_iff

alias frequently_iff_eventually ↔ filter.frequently.eventually _

lemma compl_mem_iff_not_mem : sᶜ ∈ f ↔ s ∉ f := by rw [← compl_not_mem_iff, compl_compl]

lemma diff_mem_iff (f : ultrafilter α) : s \ t ∈ f ↔ s ∈ f ∧ t ∉ f :=
inter_mem_iff.trans $ and_congr iff.rfl compl_mem_iff_not_mem

/-- If `sᶜ ∉ f ↔ s ∈ f`, then `f` is an ultrafilter. The other implication is given by
`ultrafilter.compl_not_mem_iff`.  -/
def of_compl_not_mem_iff (f : filter α) (h : ∀ s, sᶜ ∉ f ↔ s ∈ f) : ultrafilter α :=
{ to_filter := f,
  ne_bot' := ⟨λ hf, by simpa [hf] using h⟩,
  le_of_le := λ g hg hgf s hs, (h s).1 $ λ hsc, by exactI compl_not_mem hs (hgf hsc) }

lemma nonempty_of_mem (hs : s ∈ f) : s.nonempty := nonempty_of_mem hs
lemma ne_empty_of_mem (hs : s ∈ f) : s ≠ ∅ := (nonempty_of_mem hs).ne_empty
@[simp] lemma empty_not_mem : ∅ ∉ f := empty_not_mem f

lemma mem_or_compl_mem (f : ultrafilter α) (s : set α) : s ∈ f ∨ sᶜ ∈ f :=
or_iff_not_imp_left.2 compl_mem_iff_not_mem.2

protected lemma em (f : ultrafilter α) (p : α → Prop) :
  (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, ¬p x :=
f.mem_or_compl_mem {x | p x}

lemma eventually_or : (∀ᶠ x in f, p x ∨ q x) ↔ (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, q x :=
⟨λ H, (f.em p).imp_right $ λ hp, (H.and hp).mono $ λ x ⟨hx, hnx⟩, hx.resolve_left hnx,
  λ H, H.elim (λ hp, hp.mono $ λ x, or.inl) (λ hp, hp.mono $ λ x, or.inr)⟩

lemma union_mem_iff : s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f := eventually_or

lemma eventually_not : (∀ᶠ x in f, ¬p x) ↔ ¬∀ᶠ x in f, p x := compl_mem_iff_not_mem

lemma eventually_imp : (∀ᶠ x in f, p x → q x) ↔ (∀ᶠ x in f, p x) → ∀ᶠ x in f, q x :=
by simp only [imp_iff_not_or, eventually_or, eventually_not]

lemma finite_sUnion_mem_iff {s : set (set α)} (hs : finite s) : ⋃₀ s ∈ f ↔ ∃t∈s, t ∈ f :=
finite.induction_on hs (by simp) $ λ a s ha hs his,
  by simp [union_mem_iff, his, or_and_distrib_right, exists_or_distrib]

lemma finite_bUnion_mem_iff {is : set β} {s : β → set α} (his : finite is) :
  (⋃i∈is, s i) ∈ f ↔ ∃i∈is, s i ∈ f :=
by simp only [← sUnion_image, finite_sUnion_mem_iff (his.image s), bex_image_iff]

/-- Pushforward for ultrafilters. -/
def map (m : α → β) (f : ultrafilter α) : ultrafilter β :=
of_compl_not_mem_iff (map m f) $ λ s, @compl_not_mem_iff _ f (m ⁻¹' s)

@[simp, norm_cast] lemma coe_map (m : α → β) (f : ultrafilter α) :
  (map m f : filter β) = filter.map m ↑f := rfl

@[simp] lemma mem_map {m : α → β} {f : ultrafilter α} {s : set β} :
  s ∈ map m f ↔ m ⁻¹' s ∈ f := iff.rfl

/-- The pullback of an ultrafilter along an injection whose range is large with respect to the given
ultrafilter. -/
def comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) : ultrafilter α :=
{ to_filter := comap m u,
  ne_bot' := u.ne_bot'.comap_of_range_mem large,
  le_of_le := λ g hg hgu, by { resetI,
    simp only [← u.unique (map_le_iff_le_comap.2 hgu), comap_map inj, le_rfl] } }

@[simp] lemma mem_comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) {s : set α} :
  s ∈ u.comap inj large ↔ m '' s ∈ u :=
mem_comap_iff inj large

@[simp] lemma coe_comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) : (u.comap inj large : filter α) = filter.comap m u := rfl

/-- The principal ultrafilter associated to a point `x`. -/
instance : has_pure ultrafilter :=
⟨λ α a, of_compl_not_mem_iff (pure a) $ λ s, by simp⟩

@[simp] lemma mem_pure {a : α} {s : set α} : s ∈ (pure a : ultrafilter α) ↔ a ∈ s := iff.rfl

instance [inhabited α] : inhabited (ultrafilter α) := ⟨pure (default _)⟩
instance [nonempty α] : nonempty (ultrafilter α) := nonempty.map pure infer_instance

/-- Monadic bind for ultrafilters, coming from the one on filters
defined in terms of map and join.-/
def bind (f : ultrafilter α) (m : α → ultrafilter β) : ultrafilter β :=
of_compl_not_mem_iff (bind ↑f (λ x, ↑(m x))) $ λ s,
  by simp only [mem_bind', mem_coe, ← compl_mem_iff_not_mem, compl_set_of, compl_compl]

instance ultrafilter.has_bind : has_bind ultrafilter := ⟨@ultrafilter.bind⟩
instance ultrafilter.functor : functor ultrafilter := { map := @ultrafilter.map }
instance ultrafilter.monad : monad ultrafilter := { map := @ultrafilter.map }

section

local attribute [instance] filter.monad filter.is_lawful_monad

instance ultrafilter.is_lawful_monad : is_lawful_monad ultrafilter :=
{ id_map := assume α f, coe_injective (id_map f.1),
  pure_bind := assume α β a f, coe_injective (pure_bind a (coe ∘ f)),
  bind_assoc := assume α β γ f m₁ m₂, coe_injective (filter_eq rfl),
  bind_pure_comp_eq_map := assume α β f x, coe_injective (bind_pure_comp_eq_map f x.1) }

end

/-- The ultrafilter lemma: Any proper filter is contained in an ultrafilter. -/

alias exists_le ← filter.exists_ultrafilter_le

/-- Construct an ultrafilter extending a given filter.
  The ultrafilter lemma is the assertion that such a filter exists;
  we use the axiom of choice to pick one. -/
noncomputable def of (f : filter α) [ne_bot f] : ultrafilter α :=
classical.some (exists_le f)

lemma of_le (f : filter α) [ne_bot f] : ↑(of f) ≤ f := classical.some_spec (exists_le f)

lemma of_coe (f : ultrafilter α) : of ↑f = f :=
coe_inj.1 $ f.unique (of_le f)

lemma exists_ultrafilter_of_finite_inter_nonempty (S : set (set α))
  (cond : ∀ T : finset (set α), (↑T : set (set α)) ⊆ S → (⋂₀ (↑T : set (set α))).nonempty) :
  ∃ F : ultrafilter α, S ⊆ F.sets :=
begin
  suffices : ∃ F : filter α, ne_bot F ∧ S ⊆ F.sets,
  { rcases this with ⟨F, cond, hF⟩,
    resetI,
    obtain ⟨G : ultrafilter α, h1 : ↑G ≤ F⟩ := exists_le F,
    exact ⟨G, λ T hT, h1 (hF hT)⟩ },
  use filter.generate S,
  refine ⟨_, λ T hT, filter.generate_sets.basic hT⟩,
  rw ← forall_mem_nonempty_iff_ne_bot,
  intros T hT,
  rcases mem_generate_iff.mp hT with ⟨A, h1, h2, h3⟩,
  let B := set.finite.to_finset h2,
  rw (show A = ↑B, by simp) at *,
  rcases cond B h1 with ⟨x, hx⟩,
  exact ⟨x, h3 hx⟩,
end

end ultrafilter

namespace filter

open ultrafilter

lemma mem_iff_ultrafilter {s : set α} {f : filter α} :
  s ∈ f ↔ ∀ g : ultrafilter α, ↑g ≤ f → s ∈ g :=
begin
  refine ⟨λ hf g hg, hg hf, λ H, by_contra $ λ hf, _⟩,
  set g : filter ↥sᶜ := comap coe f,
  haveI : ne_bot g := comap_ne_bot_iff_compl_range.2 (by simpa [compl_set_of]),
  simpa using H ((of g).map coe) (map_le_iff_le_comap.mpr (of_le g))
end

lemma le_iff_ultrafilter {f₁ f₂ : filter α} : f₁ ≤ f₂ ↔ ∀ g : ultrafilter α, ↑g ≤ f₁ → ↑g ≤ f₂ :=
⟨λ h g h₁, h₁.trans h, λ h s hs, mem_iff_ultrafilter.2 $ λ g hg, h g hg hs⟩

/-- A filter equals the intersection of all the ultrafilters which contain it. -/
lemma supr_ultrafilter_le_eq (f : filter α) :
  (⨆ (g : ultrafilter α) (hg : ↑g ≤ f), (g : filter α)) = f :=
eq_of_forall_ge_iff $ λ f', by simp only [supr_le_iff, ← le_iff_ultrafilter]

/-- The `tendsto` relation can be checked on ultrafilters. -/
lemma tendsto_iff_ultrafilter (f : α → β) (l₁ : filter α) (l₂ : filter β) :
  tendsto f l₁ l₂ ↔ ∀ g : ultrafilter α, ↑g ≤ l₁ → tendsto f g l₂ :=
by simpa only [tendsto_iff_comap] using le_iff_ultrafilter

lemma exists_ultrafilter_iff {f : filter α} : (∃ (u : ultrafilter α), ↑u ≤ f) ↔ ne_bot f :=
⟨λ ⟨u, uf⟩, ne_bot_of_le uf, λ h, @exists_ultrafilter_le _ _ h⟩

lemma forall_ne_bot_le_iff {g : filter α} {p : filter α → Prop} (hp : monotone p) :
  (∀ f : filter α, ne_bot f → f ≤ g → p f) ↔ ∀ f : ultrafilter α, ↑f ≤ g → p f :=
begin
  refine ⟨λ H f hf, H f f.ne_bot hf, _⟩,
  introsI H f hf hfg,
  exact hp (of_le f) (H _ ((of_le f).trans hfg))
end

section hyperfilter

variables (α) [infinite α]

/-- The ultrafilter extending the cofinite filter. -/
noncomputable def hyperfilter : ultrafilter α := ultrafilter.of cofinite

variable {α}

lemma hyperfilter_le_cofinite : ↑(hyperfilter α) ≤ @cofinite α :=
ultrafilter.of_le cofinite

@[simp] lemma bot_ne_hyperfilter : (⊥ : filter α) ≠ hyperfilter α :=
(by apply_instance : ne_bot ↑(hyperfilter α)).1.symm

theorem nmem_hyperfilter_of_finite {s : set α} (hf : s.finite) : s ∉ hyperfilter α :=
λ hy, compl_not_mem hy $ hyperfilter_le_cofinite hf.compl_mem_cofinite

alias nmem_hyperfilter_of_finite ← set.finite.nmem_hyperfilter

theorem compl_mem_hyperfilter_of_finite {s : set α} (hf : set.finite s) :
  sᶜ ∈ hyperfilter α :=
compl_mem_iff_not_mem.2 hf.nmem_hyperfilter

alias compl_mem_hyperfilter_of_finite ← set.finite.compl_mem_hyperfilter

theorem mem_hyperfilter_of_finite_compl {s : set α} (hf : set.finite sᶜ) :
  s ∈ hyperfilter α :=
compl_compl s ▸ hf.compl_mem_hyperfilter

end hyperfilter

end filter


import algebraic_topology.simplicial_object

open opposite category_theory category_theory.limits
open simplex_category

universes v u

namespace category_theory

namespace comma

universes v₁ v₂ v₃ u₁ u₂ u₃
variables {A : Type u₁} [category.{v₁} A]
variables {B : Type u₂} [category.{v₂} B]
variables {T : Type u₃} [category.{v₃} T]
variables {L : A ⥤ T} {R : B ⥤ T}
variables {X Y : comma L R} (f : X ⟶ Y)

lemma is_iso_of [is_iso f.left] [is_iso f.right] : is_iso f :=
{ out := ⟨
  { left := inv f.left,
    right := inv f.right,
    w' := by { dsimp,
      simp only [is_iso.eq_comp_inv, functor.map_inv, comma_morphism.w,
        is_iso.inv_comp_eq, category.assoc],
      simp } },
   by { split; ext; dsimp; simp only [is_iso.hom_inv_id, is_iso.inv_hom_id] }⟩ }

end comma

namespace simplicial_object

variables {C : Type u} [category.{v} C]

section

variables {X Y : simplicial_object C} (f : X ⟶ Y)

lemma is_iso_of [hf : ∀ n, is_iso (f.app n)] : is_iso f :=
{ out :=
  begin
    let g : Y ⟶ X :=
    { app := λ n, inv (f.app n),
      naturality' := λ m n φ, _ },
    { refine ⟨g, _, _⟩;
      { ext n,
        simp only [nat_trans.id_app, nat_trans.comp_app, is_iso.hom_inv_id, is_iso.inv_hom_id], } },
    { simp only [is_iso.inv_hom_id_assoc, nat_trans.naturality, is_iso.comp_inv_eq, category.assoc] }
  end }

end

local attribute [instance] category_theory.simplicial_object.is_iso_of

namespace augmented

variables {X Y : augmented C} (f : X ⟶ Y)

lemma is_iso_of [∀ n, is_iso (f.left.app n)] [is_iso f.right] : is_iso f :=
category_theory.comma.is_iso_of _

end augmented

end simplicial_object

end category_theory


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.graded_monoid
import algebra.direct_sum.basic

/-!
# Additively-graded multiplicative structures on `⨁ i, A i`

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over `⨁ i, A i` such that `(*) : A i → A j → A (i + j)`; that is to say, `A` forms an
additively-graded ring. The typeclasses are:

* `direct_sum.gnon_unital_non_assoc_semiring A`
* `direct_sum.gsemiring A`
* `direct_sum.gring A`
* `direct_sum.gcomm_semiring A`
* `direct_sum.gcomm_ring A`

Respectively, these imbue the external direct sum `⨁ i, A i` with:

* `direct_sum.non_unital_non_assoc_semiring`, `direct_sum.non_unital_non_assoc_ring`
* `direct_sum.semiring`
* `direct_sum.ring`
* `direct_sum.comm_semiring`
* `direct_sum.comm_ring`

the base ring `A 0` with:

* `direct_sum.grade_zero.non_unital_non_assoc_semiring`,
  `direct_sum.grade_zero.non_unital_non_assoc_ring`
* `direct_sum.grade_zero.semiring`
* `direct_sum.grade_zero.ring`
* `direct_sum.grade_zero.comm_semiring`
* `direct_sum.grade_zero.comm_ring`

and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication:

* `direct_sum.grade_zero.has_smul (A 0)`, `direct_sum.grade_zero.smul_with_zero (A 0)`
* `direct_sum.grade_zero.module (A 0)`
* (nothing)
* (nothing)
* (nothing)

Note that in the presence of these instances, `⨁ i, A i` itself inherits an `A 0`-action.

`direct_sum.of_zero_ring_hom : A 0 →+* ⨁ i, A i` provides `direct_sum.of A 0` as a ring
homomorphism.

`direct_sum.to_semiring` extends `direct_sum.to_add_monoid` to produce a `ring_hom`.

## Direct sums of subobjects

Additionally, this module provides helper functions to construct `gsemiring` and `gcomm_semiring`
instances for:

* `A : ι → submonoid S`:
  `direct_sum.gsemiring.of_add_submonoids`, `direct_sum.gcomm_semiring.of_add_submonoids`.
* `A : ι → subgroup S`:
  `direct_sum.gsemiring.of_add_subgroups`, `direct_sum.gcomm_semiring.of_add_subgroups`.
* `A : ι → submodule S`:
  `direct_sum.gsemiring.of_submodules`, `direct_sum.gcomm_semiring.of_submodules`.

If `complete_lattice.independent (set.range A)`, these provide a gradation of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

graded ring, filtered ring, direct sum, add_submonoid
-/

set_option old_structure_cmd true

variables {ι : Type*} [decidable_eq ι]

namespace direct_sum

open_locale direct_sum

/-! ### Typeclasses -/
section defs

variables (A : ι → Type*)

/-- A graded version of `non_unital_non_assoc_semiring`. -/
class gnon_unital_non_assoc_semiring [has_add ι] [Π i, add_comm_monoid (A i)] extends
  graded_monoid.ghas_mul A :=
(mul_zero : ∀ {i j} (a : A i), mul a (0 : A j) = 0)
(zero_mul : ∀ {i j} (b : A j), mul (0 : A i) b = 0)
(mul_add : ∀ {i j} (a : A i) (b c : A j), mul a (b + c) = mul a b + mul a c)
(add_mul : ∀ {i j} (a b : A i) (c : A j), mul (a + b) c = mul a c + mul b c)

end defs

section defs

variables (A : ι → Type*)

/-- A graded version of `semiring`. -/
class gsemiring [add_monoid ι] [Π i, add_comm_monoid (A i)] extends
  gnon_unital_non_assoc_semiring A, graded_monoid.gmonoid A :=
(nat_cast : ℕ → A 0)
(nat_cast_zero : nat_cast 0 = 0)
(nat_cast_succ : ∀ n : ℕ, nat_cast (n + 1) = nat_cast n + graded_monoid.ghas_one.one)

/-- A graded version of `comm_semiring`. -/
class gcomm_semiring [add_comm_monoid ι] [Π i, add_comm_monoid (A i)] extends
  gsemiring A, graded_monoid.gcomm_monoid A

/-- A graded version of `ring`. -/
class gring [add_monoid ι] [Π i, add_comm_group (A i)] extends gsemiring A :=
(int_cast : ℤ → A 0)
(int_cast_of_nat : ∀ n : ℕ, int_cast n = nat_cast n)
(int_cast_neg_succ_of_nat : ∀ n : ℕ, int_cast (-(n+1 : ℕ)) = -nat_cast (n+1 : ℕ))

/-- A graded version of `comm_ring`. -/
class gcomm_ring [add_comm_monoid ι] [Π i, add_comm_group (A i)] extends
  gring A, gcomm_semiring A

end defs

lemma of_eq_of_graded_monoid_eq {A : ι → Type*} [Π (i : ι), add_comm_monoid (A i)]
  {i j : ι} {a : A i} {b : A j} (h : graded_monoid.mk i a = graded_monoid.mk j b) :
  direct_sum.of A i a = direct_sum.of A j b :=
dfinsupp.single_eq_of_sigma_eq h

variables (A : ι → Type*)

/-! ### Instances for `⨁ i, A i` -/

section one
variables [has_zero ι] [graded_monoid.ghas_one A] [Π i, add_comm_monoid (A i)]

instance : has_one (⨁ i, A i) :=
{ one := direct_sum.of (λ i, A i) 0 graded_monoid.ghas_one.one }

end one

section mul
variables [has_add ι] [Π i, add_comm_monoid (A i)] [gnon_unital_non_assoc_semiring A]

open add_monoid_hom (flip_apply coe_comp comp_hom_apply_apply)

/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/
@[simps]
def gmul_hom {i j} : A i →+ A j →+ A (i + j) :=
{ to_fun := λ a,
  { to_fun := λ b, graded_monoid.ghas_mul.mul a b,
    map_zero' := gnon_unital_non_assoc_semiring.mul_zero _,
    map_add' := gnon_unital_non_assoc_semiring.mul_add _ },
  map_zero' := add_monoid_hom.ext $ λ a, gnon_unital_non_assoc_semiring.zero_mul a,
  map_add' := λ a₁ a₂, add_monoid_hom.ext $ λ b, gnon_unital_non_assoc_semiring.add_mul _ _ _}

/-- The multiplication from the `has_mul` instance, as a bundled homomorphism. -/
def mul_hom : (⨁ i, A i) →+ (⨁ i, A i) →+ ⨁ i, A i :=
direct_sum.to_add_monoid $ λ i,
  add_monoid_hom.flip $ direct_sum.to_add_monoid $ λ j, add_monoid_hom.flip $
    (direct_sum.of A _).comp_hom.comp $ gmul_hom A

instance : non_unital_non_assoc_semiring (⨁ i, A i) :=
{ mul := λ a b, mul_hom A a b,
  zero := 0,
  add := (+),
  zero_mul := λ a, by simp only [add_monoid_hom.map_zero, add_monoid_hom.zero_apply],
  mul_zero := λ a, by simp only [add_monoid_hom.map_zero],
  left_distrib := λ a b c, by simp only [add_monoid_hom.map_add],
  right_distrib := λ a b c, by simp only [add_monoid_hom.map_add, add_monoid_hom.add_apply],
  .. direct_sum.add_comm_monoid _ _}

variables {A}

lemma mul_hom_of_of {i j} (a : A i) (b : A j) :
  mul_hom A (of _ i a) (of _ j b) = of _ (i + j) (graded_monoid.ghas_mul.mul a b) :=
begin
  unfold mul_hom,
  rw [to_add_monoid_of, flip_apply, to_add_monoid_of, flip_apply, coe_comp, function.comp_app,
      comp_hom_apply_apply, coe_comp, function.comp_app, gmul_hom_apply_apply],
end

lemma of_mul_of {i j} (a : A i) (b : A j) :
  of _ i a * of _ j b = of _ (i + j) (graded_monoid.ghas_mul.mul a b) :=
mul_hom_of_of a b

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A]

open add_monoid_hom (flip_hom coe_comp comp_hom_apply_apply flip_apply flip_hom_apply)

private lemma one_mul (x : ⨁ i, A i) : 1 * x = x :=
suffices mul_hom A 1 = add_monoid_hom.id (⨁ i, A i),
  from add_monoid_hom.congr_fun this x,
begin
  apply add_hom_ext, intros i xi,
  unfold has_one.one,
  rw mul_hom_of_of,
  exact of_eq_of_graded_monoid_eq (one_mul $ graded_monoid.mk i xi),
end

private lemma mul_one (x : ⨁ i, A i) : x * 1 = x :=
suffices (mul_hom A).flip 1 = add_monoid_hom.id (⨁ i, A i),
  from add_monoid_hom.congr_fun this x,
begin
  apply add_hom_ext, intros i xi,
  unfold has_one.one,
  rw [flip_apply, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (mul_one $ graded_monoid.mk i xi),
end

private lemma mul_assoc (a b c : ⨁ i, A i) : a * b * c = a * (b * c) :=
suffices (mul_hom A).comp_hom.comp (mul_hom A)            -- `λ a b c, a * b * c` as a bundled hom
       = (add_monoid_hom.comp_hom flip_hom $              -- `λ a b c, a * (b * c)` as a bundled hom
             (mul_hom A).flip.comp_hom.comp (mul_hom A)).flip,
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b) c,
begin
  ext ai ax bi bx ci cx : 6,
  dsimp only [coe_comp, function.comp_app, comp_hom_apply_apply, flip_apply, flip_hom_apply],
  rw [mul_hom_of_of, mul_hom_of_of, mul_hom_of_of, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (mul_assoc (graded_monoid.mk ai ax) ⟨bi, bx⟩ ⟨ci, cx⟩),
end

/-- The `semiring` structure derived from `gsemiring A`. -/
instance semiring : semiring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  one_mul := one_mul A,
  mul_one := mul_one A,
  mul_assoc := mul_assoc A,
  nat_cast := λ n, of _ _ (gsemiring.nat_cast n),
  nat_cast_zero := by rw [gsemiring.nat_cast_zero, map_zero],
  nat_cast_succ := λ n, by { rw [gsemiring.nat_cast_succ, map_add], refl },
  ..direct_sum.non_unital_non_assoc_semiring _, }

lemma of_pow {i} (a : A i) (n : ℕ) :
  of _ i a ^ n = of _ (n • i) (graded_monoid.gmonoid.gnpow _ a) :=
begin
  induction n with n,
  { exact of_eq_of_graded_monoid_eq (pow_zero $ graded_monoid.mk _ a).symm, },
  { rw [pow_succ, n_ih, of_mul_of],
    exact of_eq_of_graded_monoid_eq (pow_succ (graded_monoid.mk _ a) n).symm, },
end

lemma of_list_dprod {α} (l : list α) (fι : α → ι) (fA : Π a, A (fι a)) :
  of A _ (l.dprod fι fA) = (l.map $ λ a, of A (fι a) (fA a)).prod :=
begin
  induction l,
  { simp only [list.map_nil, list.prod_nil, list.dprod_nil],
    refl },
  { simp only [list.map_cons, list.prod_cons, list.dprod_cons, ←l_ih, direct_sum.of_mul_of],
    refl },
end

lemma list_prod_of_fn_of_eq_dprod (n : ℕ) (fι : fin n → ι) (fA : Π a, A (fι a)) :
  (list.of_fn $ λ a, of A (fι a) (fA a)).prod = of A _ ((list.fin_range n).dprod fι fA) :=
by rw [list.of_fn_eq_map, of_list_dprod]

open_locale big_operators

lemma mul_eq_dfinsupp_sum [Π (i : ι) (x : A i), decidable (x ≠ 0)] (a a' : ⨁ i, A i) :
  a * a' = a.sum (λ i ai, a'.sum $ λ j aj, direct_sum.of _ _ $ graded_monoid.ghas_mul.mul ai aj) :=
begin
  change mul_hom _ a a' = _,
  simpa only [mul_hom, to_add_monoid, dfinsupp.lift_add_hom_apply, dfinsupp.sum_add_hom_apply,
    add_monoid_hom.dfinsupp_sum_apply, flip_apply, add_monoid_hom.dfinsupp_sum_add_hom_apply],
end

/-- A heavily unfolded version of the definition of multiplication -/
lemma mul_eq_sum_support_ghas_mul
  [Π (i : ι) (x : A i), decidable (x ≠ 0)] (a a' : ⨁ i, A i) :
  a * a' =
    ∑ ij in dfinsupp.support a ×ˢ dfinsupp.support a',
      direct_sum.of _ _ (graded_monoid.ghas_mul.mul (a ij.fst) (a' ij.snd)) :=
by simp only [mul_eq_dfinsupp_sum, dfinsupp.sum, finset.sum_product]

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A]

private lemma mul_comm (a b : ⨁ i, A i) : a * b = b * a :=
suffices mul_hom A = (mul_hom A).flip,
  from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b,
begin
  apply add_hom_ext, intros ai ax, apply add_hom_ext, intros bi bx,
  rw [add_monoid_hom.flip_apply, mul_hom_of_of, mul_hom_of_of],
  exact of_eq_of_graded_monoid_eq (gcomm_semiring.mul_comm ⟨ai, ax⟩ ⟨bi, bx⟩),
end

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance comm_semiring : comm_semiring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  mul_comm := mul_comm A,
  ..direct_sum.semiring _, }

end comm_semiring

section non_unital_non_assoc_ring
variables [Π i, add_comm_group (A i)] [has_add ι] [gnon_unital_non_assoc_semiring A]

/-- The `ring` derived from `gsemiring A`. -/
instance non_assoc_ring : non_unital_non_assoc_ring (⨁ i, A i) :=
{ mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  ..(direct_sum.non_unital_non_assoc_semiring _),
  ..(direct_sum.add_comm_group _), }

end non_unital_non_assoc_ring

section ring
variables [Π i, add_comm_group (A i)] [add_monoid ι] [gring A]

/-- The `ring` derived from `gsemiring A`. -/
instance ring : ring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  int_cast := λ z, of _ _ (gring.int_cast z),
  int_cast_of_nat := λ z, congr_arg _ $ gring.int_cast_of_nat _,
  int_cast_neg_succ_of_nat := λ z,
    (congr_arg _ $ gring.int_cast_neg_succ_of_nat _).trans (map_neg _ _),
  ..(direct_sum.semiring _),
  ..(direct_sum.add_comm_group _), }

end ring

section comm_ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_ring A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance comm_ring : comm_ring (⨁ i, A i) :=
{ one := 1,
  mul := (*),
  zero := 0,
  add := (+),
  neg := has_neg.neg,
  ..(direct_sum.ring _),
  ..(direct_sum.comm_semiring _), }

end comm_ring

/-! ### Instances for `A 0`

The various `g*` instances are enough to promote the `add_comm_monoid (A 0)` structure to various
types of multiplicative structure.
-/

section grade_zero

section one
variables [has_zero ι] [graded_monoid.ghas_one A] [Π i, add_comm_monoid (A i)]

@[simp] lemma of_zero_one : of _ 0 (1 : A 0) = 1 := rfl

end one

section mul
variables [add_zero_class ι] [Π i, add_comm_monoid (A i)] [gnon_unital_non_assoc_semiring A]

@[simp] lemma of_zero_smul {i} (a : A 0) (b : A i) : of _ _ (a • b) = of _ _ a * of _ _ b :=
(of_eq_of_graded_monoid_eq (graded_monoid.mk_zero_smul a b)).trans (of_mul_of _ _).symm

@[simp] lemma of_zero_mul (a b : A 0) : of _ 0 (a * b) = of _ 0 a * of _ 0 b:=
of_zero_smul A a b

instance grade_zero.non_unital_non_assoc_semiring : non_unital_non_assoc_semiring (A 0) :=
function.injective.non_unital_non_assoc_semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of A 0).map_add (of_zero_mul A) (λ x n, dfinsupp.single_smul n x)

instance grade_zero.smul_with_zero (i : ι) : smul_with_zero (A 0) (A i) :=
begin
  letI := smul_with_zero.comp_hom (⨁ i, A i) (of A 0).to_zero_hom,
  refine dfinsupp.single_injective.smul_with_zero (of A i).to_zero_hom (of_zero_smul A),
end

end mul

section semiring
variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A]

@[simp] lemma of_zero_pow (a : A 0) : ∀ n : ℕ, of _ 0 (a ^ n) = of _ 0 a ^ n
| 0 := by rw [pow_zero, pow_zero, direct_sum.of_zero_one]
| (n + 1) := by rw [pow_succ, pow_succ, of_zero_mul, of_zero_pow]

instance : has_nat_cast (A 0) := ⟨gsemiring.nat_cast⟩

@[simp] lemma of_nat_cast (n : ℕ) : of A 0 n = n :=
rfl

/-- The `semiring` structure derived from `gsemiring A`. -/
instance grade_zero.semiring : semiring (A 0) :=
function.injective.semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_nsmul (λ x n, of_zero_pow _ _ _) (of_nat_cast A)

/-- `of A 0` is a `ring_hom`, using the `direct_sum.grade_zero.semiring` structure. -/
def of_zero_ring_hom : A 0 →+* (⨁ i, A i) :=
{ map_one' := of_zero_one A, map_mul' := of_zero_mul A, ..(of _ 0) }

/-- Each grade `A i` derives a `A 0`-module structure from `gsemiring A`. Note that this results
in an overall `module (A 0) (⨁ i, A i)` structure via `direct_sum.module`.
-/
instance grade_zero.module {i} : module (A 0) (A i) :=
begin
  letI := module.comp_hom (⨁ i, A i) (of_zero_ring_hom A),
  exact dfinsupp.single_injective.module (A 0) (of A i) (λ a, of_zero_smul A a),
end

end semiring

section comm_semiring

variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A]

/-- The `comm_semiring` structure derived from `gcomm_semiring A`. -/
instance grade_zero.comm_semiring : comm_semiring (A 0) :=
function.injective.comm_semiring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (λ x n, dfinsupp.single_smul n x) (λ x n, of_zero_pow _ _ _) (of_nat_cast A)

end comm_semiring

section ring
variables [Π i, add_comm_group (A i)] [add_zero_class ι] [gnon_unital_non_assoc_semiring A]

/-- The `non_unital_non_assoc_ring` derived from `gnon_unital_non_assoc_semiring A`. -/
instance grade_zero.non_unital_non_assoc_ring : non_unital_non_assoc_ring (A 0) :=
function.injective.non_unital_non_assoc_ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub
  (λ x n, begin
    letI : Π i, distrib_mul_action ℕ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)
  (λ x n, begin
    letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)

end ring

section ring
variables [Π i, add_comm_group (A i)] [add_monoid ι] [gring A]

instance : has_int_cast (A 0) := ⟨gring.int_cast⟩

@[simp] lemma of_int_cast (n : ℤ) : of A 0 n = n :=
rfl

/-- The `ring` derived from `gsemiring A`. -/
instance grade_zero.ring : ring (A 0) :=
function.injective.ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub
  (λ x n, begin
    letI : Π i, distrib_mul_action ℕ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)
  (λ x n, begin
    letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end) (λ x n, of_zero_pow _ _ _)
  (of_nat_cast A) (of_int_cast A)

end ring

section comm_ring
variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_ring A]

/-- The `comm_ring` derived from `gcomm_semiring A`. -/
instance grade_zero.comm_ring : comm_ring (A 0) :=
function.injective.comm_ring (of A 0) dfinsupp.single_injective
  (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A)
  (of A 0).map_neg (of A 0).map_sub
  (λ x n, begin
    letI : Π i, distrib_mul_action ℕ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end)
  (λ x n, begin
    letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance,
    exact dfinsupp.single_smul n x
  end) (λ x n, of_zero_pow _ _ _)
  (of_nat_cast A) (of_int_cast A)

end comm_ring

end grade_zero

section to_semiring

variables {R : Type*} [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A] [semiring R]
variables {A}

/-- If two ring homomorphisms from `⨁ i, A i` are equal on each `of A i y`,
then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma ring_hom_ext' ⦃F G : (⨁ i, A i) →+* R⦄
  (h : ∀ i, (↑F : _ →+ R).comp (of A i) = (↑G : _ →+ R).comp (of A i)) : F = G :=
ring_hom.coe_add_monoid_hom_injective $ direct_sum.add_hom_ext' h

/-- Two `ring_hom`s out of a direct sum are equal if they agree on the generators. -/
lemma ring_hom_ext ⦃f g : (⨁ i, A i) →+* R⦄ (h : ∀ i x, f (of A i x) = g (of A i x)) :
  f = g :=
ring_hom_ext' $ λ i, add_monoid_hom.ext $ h i

/-- A family of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
describes a `ring_hom`s on `⨁ i, A i`. This is a stronger version of `direct_sum.to_monoid`.

Of particular interest is the case when `A i` are bundled subojects, `f` is the family of
coercions such as `add_submonoid.subtype (A i)`, and the `[gsemiring A]` structure originates from
`direct_sum.gsemiring.of_add_submonoids`, in which case the proofs about `ghas_one` and `ghas_mul`
can be discharged by `rfl`. -/
@[simps]
def to_semiring
  (f : Π i, A i →+ R) (hone : f _ (graded_monoid.ghas_one.one) = 1)
  (hmul : ∀ {i j} (ai : A i) (aj : A j), f _ (graded_monoid.ghas_mul.mul ai aj) = f _ ai * f _ aj) :
  (⨁ i, A i) →+* R :=
{ to_fun := to_add_monoid f,
  map_one' := begin
    change (to_add_monoid f) (of _ 0 _) = 1,
    rw to_add_monoid_of,
    exact hone
  end,
  map_mul' := begin
    rw (to_add_monoid f).map_mul_iff,
    ext xi xv yi yv : 4,
    show to_add_monoid f (of A xi xv * of A yi yv) =
         to_add_monoid f (of A xi xv) * to_add_monoid f (of A yi yv),
    rw [of_mul_of, to_add_monoid_of, to_add_monoid_of, to_add_monoid_of],
    exact hmul _ _,
  end,
  .. to_add_monoid f}

@[simp] lemma to_semiring_of (f : Π i, A i →+ R) (hone hmul) (i : ι) (x : A i) :
  to_semiring f hone hmul (of _ i x) = f _ x :=
to_add_monoid_of f i x

@[simp] lemma to_semiring_coe_add_monoid_hom (f : Π i, A i →+ R) (hone hmul):
  (to_semiring f hone hmul : (⨁ i, A i) →+ R) = to_add_monoid f := rfl

/-- Families of `add_monoid_hom`s preserving `direct_sum.ghas_one.one` and `direct_sum.ghas_mul.mul`
are isomorphic to `ring_hom`s on `⨁ i, A i`. This is a stronger version of `dfinsupp.lift_add_hom`.
-/
@[simps]
def lift_ring_hom :
  {f : Π {i}, A i →+ R //
    f (graded_monoid.ghas_one.one) = 1 ∧
    ∀ {i j} (ai : A i) (aj : A j), f (graded_monoid.ghas_mul.mul ai aj) = f ai * f aj} ≃
    ((⨁ i, A i) →+* R) :=
{ to_fun := λ f, to_semiring (λ _, f.1) f.2.1 (λ _ _, f.2.2),
  inv_fun := λ F,
    ⟨λ i, (F : (⨁ i, A i) →+ R).comp (of _ i), begin
      simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom],
      rw ←F.map_one,
      refl
    end, λ i j ai aj, begin
      simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom],
      rw [←F.map_mul, of_mul_of],
    end⟩,
  left_inv := λ f, begin
    ext xi xv,
    exact to_add_monoid_of (λ _, f.1) xi xv,
  end,
  right_inv := λ F, begin
    apply ring_hom.coe_add_monoid_hom_injective,
    ext xi xv,
    simp only [ring_hom.coe_add_monoid_hom_mk,
      direct_sum.to_add_monoid_of,
      add_monoid_hom.mk_coe,
      add_monoid_hom.comp_apply, to_semiring_coe_add_monoid_hom],
  end}

end to_semiring

end direct_sum

/-! ### Concrete instances -/

section uniform

variables (ι)

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring
  {R : Type*} [add_monoid ι] [non_unital_non_assoc_semiring R] :
  direct_sum.gnon_unital_non_assoc_semiring (λ i : ι, R) :=
{ mul_zero := λ i j, mul_zero,
  zero_mul := λ i j, zero_mul,
  mul_add := λ i j, mul_add,
  add_mul := λ i j, add_mul,
  ..has_mul.ghas_mul ι }

/-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/
instance semiring.direct_sum_gsemiring {R : Type*} [add_monoid ι] [semiring R] :
  direct_sum.gsemiring (λ i : ι, R) :=
{ nat_cast := λ n, n,
  nat_cast_zero := nat.cast_zero,
  nat_cast_succ := nat.cast_succ,
  ..non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring ι,
  ..monoid.gmonoid ι }

open_locale direct_sum

-- To check `has_mul.ghas_mul_mul` matches
example {R : Type*} [add_monoid ι] [semiring R] (i j : ι) (a b : R) :
  (direct_sum.of _ i a * direct_sum.of _ j b : ⨁ i, R) = direct_sum.of _ (i + j) (by exact a * b) :=
by rw [direct_sum.of_mul_of, has_mul.ghas_mul_mul]

/-- A direct sum of copies of a `comm_semiring` inherits the commutative multiplication structure.
-/
instance comm_semiring.direct_sum_gcomm_semiring {R : Type*} [add_comm_monoid ι] [comm_semiring R] :
  direct_sum.gcomm_semiring (λ i : ι, R) :=
{ ..comm_monoid.gcomm_monoid ι, ..semiring.direct_sum_gsemiring ι }

end uniform


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.default
import Mathlib.ring_theory.ideal.over
import Mathlib.ring_theory.jacobson_ideal
import Mathlib.ring_theory.localization
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Jacobson Rings
The following conditions are equivalent for a ring `R`:
1. Every radical ideal `I` is equal to its Jacobson radical
2. Every radical ideal `I` can be written as an intersection of maximal ideals
3. Every prime ideal `I` is equal to its Jacobson radical
Any ring satisfying any of these equivalent conditions is said to be Jacobson.
Some particular examples of Jacobson rings are also proven.
`is_jacobson_quotient` says that the quotient of a Jacobson ring is Jacobson.
`is_jacobson_localization` says the localization of a Jacobson ring to a single element is Jacobson.
`is_jacobson_polynomial_iff_is_jacobson` says polynomials over a Jacobson ring form a Jacobson ring.
## Main definitions
Let `R` be a commutative ring. Jacobson Rings are defined using the first of the above conditions
* `is_jacobson R` is the proposition that `R` is a Jacobson ring. It is a class,
  implemented as the predicate that for any ideal, `I.radical = I` implies `I.jacobson = I`.

## Main statements
* `is_jacobson_iff_prime_eq` is the equivalence between conditions 1 and 3 above.
* `is_jacobson_iff_Inf_maximal` is the equivalence between conditions 1 and 2 above.
* `is_jacobson_of_surjective` says that if `R` is a Jacobson ring and `f : R →+* S` is surjective,
  then `S` is also a Jacobson ring
* `is_jacobson_mv_polynomial` says that multi-variate polynomials over a Jacobson ring are Jacobson.
## Tags
Jacobson, Jacobson Ring
-/

namespace ideal

/-!
The following two lemmas are independent of Jacobson.  I extracted them from the
original proof of `quotient_mk_comp_C_is_integral_of_jacobson` to speed up processing.
Honestly, I did not spend time to unwind their "meaning", hence the names are likely inappropriate.

TODO: clean up, move elsewhere
-/

theorem injective_quotient_le_comap_map {R : Type u_1} [comm_ring R] (P : ideal (polynomial R)) : function.injective
  ⇑(quotient_map (map (polynomial.map_ring_hom (quotient.mk (comap polynomial.C P))) P)
      (polynomial.map_ring_hom (quotient.mk (comap polynomial.C P))) le_comap_map) := sorry

/-- The identity in this lemma is used in the proof of `quotient_mk_comp_C_is_integral_of_jacobson`.
It is isolated, since it speeds up the processing, avoiding a deterministic timeout. -/
theorem quotient_mk_maps_eq {R : Type u_1} [comm_ring R] (P : ideal (polynomial R)) : ring_hom.comp
    (ring_hom.comp (quotient.mk (map (polynomial.map_ring_hom (quotient.mk (comap polynomial.C P))) P)) polynomial.C)
    (quotient.mk (comap polynomial.C P)) =
  ring_hom.comp
    (quotient_map (map (polynomial.map_ring_hom (quotient.mk (comap polynomial.C P))) P)
      (polynomial.map_ring_hom (quotient.mk (comap polynomial.C P))) le_comap_map)
    (ring_hom.comp (quotient.mk P) polynomial.C) := sorry

/-- A ring is a Jacobson ring if for every radical ideal `I`,
 the Jacobson radical of `I` is equal to `I`.
 See `is_jacobson_iff_prime_eq` and `is_jacobson_iff_Inf_maximal` for equivalent definitions. -/
def is_jacobson (R : Type u_1) [comm_ring R] :=
  ∀ (I : ideal R), radical I = I → jacobson I = I

/--  A ring is a Jacobson ring if and only if for all prime ideals `P`,
 the Jacobson radical of `P` is equal to `P`. -/
theorem is_jacobson_iff_prime_eq {R : Type u_1} [comm_ring R] : is_jacobson R ↔ ∀ (P : ideal R), is_prime P → jacobson P = P := sorry

/-- A ring `R` is Jacobson if and only if for every prime ideal `I`,
 `I` can be written as the infimum of some collection of maximal ideals.
 Allowing ⊤ in the set `M` of maximal ideals is equivalent, but makes some proofs cleaner. -/
theorem is_jacobson_iff_Inf_maximal {R : Type u_1} [comm_ring R] : is_jacobson R ↔
  ∀ {I : ideal R}, is_prime I → ∃ (M : set (ideal R)), (∀ (J : ideal R), J ∈ M → is_maximal J ∨ J = ⊤) ∧ I = Inf M := sorry

theorem is_jacobson_iff_Inf_maximal' {R : Type u_1} [comm_ring R] : is_jacobson R ↔
  ∀ {I : ideal R},
    is_prime I → ∃ (M : set (ideal R)), (∀ (J : ideal R), J ∈ M → ∀ (K : ideal R), J < K → K = ⊤) ∧ I = Inf M := sorry

theorem radical_eq_jacobson {R : Type u_1} [comm_ring R] [H : is_jacobson R] (I : ideal R) : radical I = jacobson I := sorry

/-- Fields have only two ideals, and the condition holds for both of them.  -/
protected instance is_jacobson_field {K : Type u_1} [field K] : is_jacobson K :=
  fun (I : ideal K) (hI : radical I = I) =>
    or.rec_on (eq_bot_or_top I)
      (fun (h : I = ⊥) =>
        le_antisymm (Inf_le { left := le_of_eq rfl, right := Eq.symm h ▸ bot_is_maximal }) (Eq.symm h ▸ bot_le))
      fun (h : I = ⊤) =>
        eq.mpr (id (Eq._oldrec (Eq.refl (jacobson I = I)) h))
          (eq.mpr (id (Eq._oldrec (Eq.refl (jacobson ⊤ = ⊤)) (propext jacobson_eq_top_iff))) (Eq.refl ⊤))

theorem is_jacobson_of_surjective {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] [H : is_jacobson R] : (∃ (f : R →+* S), function.surjective ⇑f) → is_jacobson S := sorry

protected instance is_jacobson_quotient {R : Type u_1} [comm_ring R] {I : ideal R} [is_jacobson R] : is_jacobson (quotient I) :=
  is_jacobson_of_surjective
    (Exists.intro (quotient.mk I)
      (id
        fun (b : quotient I) =>
          quot.induction_on b fun (x : R) => Exists.intro x (id (Eq.refl (coe_fn (quotient.mk I) x)))))

theorem is_jacobson_iso {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] (e : R ≃+* S) : is_jacobson R ↔ is_jacobson S := sorry

theorem is_jacobson_of_is_integral {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] [algebra R S] (hRS : algebra.is_integral R S) (hR : is_jacobson R) : is_jacobson S := sorry

theorem is_jacobson_of_is_integral' {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] (f : R →+* S) (hf : ring_hom.is_integral f) (hR : is_jacobson R) : is_jacobson S :=
  is_jacobson_of_is_integral hf hR

theorem disjoint_powers_iff_not_mem {R : Type u_1} [comm_ring R] {I : ideal R} {y : R} (hI : radical I = I) : disjoint ↑(submonoid.powers y) ↑I ↔ ¬y ∈ submodule.carrier I := sorry

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its comap.
See `le_rel_iso_of_maximal` for the more general relation isomorphism -/
theorem is_maximal_iff_is_maximal_disjoint {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] {y : R} (f : localization_map.away_map y S) [H : is_jacobson R] (J : ideal S) : is_maximal J ↔ is_maximal (comap (localization_map.to_map f) J) ∧ ¬y ∈ comap (localization_map.to_map f) J := sorry

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its map.
See `le_rel_iso_of_maximal` for the more general statement, and the reverse of this implication -/
theorem is_maximal_of_is_maximal_disjoint {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] {y : R} (f : localization_map.away_map y S) [is_jacobson R] (I : ideal R) (hI : is_maximal I) (hy : ¬y ∈ I) : is_maximal (map (localization_map.to_map f) I) := sorry

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y` -/
def order_iso_of_maximal {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] {y : R} (f : localization_map.away_map y S) [is_jacobson R] : (Subtype fun (p : ideal S) => is_maximal p) ≃o Subtype fun (p : ideal R) => is_maximal p ∧ ¬y ∈ p :=
  rel_iso.mk
    (equiv.mk
      (fun (p : Subtype fun (p : ideal S) => is_maximal p) =>
        { val := comap (localization_map.to_map f) (subtype.val p), property := sorry })
      (fun (p : Subtype fun (p : ideal R) => is_maximal p ∧ ¬y ∈ p) =>
        { val := map (localization_map.to_map f) (subtype.val p), property := sorry })
      sorry sorry)
    sorry

/-- If `S` is the localization of the Jacobson ring `R` at the submonoid generated by `y : R`, then `S` is Jacobson. -/
theorem is_jacobson_localization {R : Type u_1} {S : Type u_2} [comm_ring R] [comm_ring S] {y : R} [H : is_jacobson R] (f : localization_map.away_map y S) : is_jacobson S := sorry

namespace polynomial

/-- If `I` is a prime ideal of `polynomial R` and `pX ∈ I` is a non-constant polynomial,
  then the map `R →+* R[x]/I` descends to an integral map when localizing at `pX.leading_coeff`.
  In particular `X` is integral because it satisfies `pX`, and constants are trivially integral,
  so integrality of the entire extension follows by closure under addition and multiplication. -/
theorem is_integral_localization_map_polynomial_quotient {R : Type u_1} [comm_ring R] {Rₘ : Type u_3} {Sₘ : Type u_4} [comm_ring Rₘ] [comm_ring Sₘ] (P : ideal (polynomial R)) [is_prime P] (pX : polynomial R) (hpX : pX ∈ P) (ϕ : localization_map (submonoid.powers (polynomial.leading_coeff (polynomial.map (quotient.mk (comap polynomial.C P)) pX)))
  Rₘ) (ϕ' : localization_map
  (submonoid.map (↑(quotient_map P polynomial.C le_rfl))
    (submonoid.powers (polynomial.leading_coeff (polynomial.map (quotient.mk (comap polynomial.C P)) pX))))
  Sₘ) : ring_hom.is_integral
  (localization_map.map ϕ
    (submonoid.mem_map_of_mem
      (submonoid.powers (polynomial.leading_coeff (polynomial.map (quotient.mk (comap polynomial.C P)) pX)))
      ↑(quotient_map P polynomial.C le_rfl))
    ϕ') := sorry

/-- If `f : R → S` descends to an integral map in the localization at `x`,
  and `R` is a Jacobson ring, then the intersection of all maximal ideals in `S` is trivial -/
theorem jacobson_bot_of_integral_localization {S : Type u_2} [integral_domain S] {Rₘ : Type u_3} {Sₘ : Type u_4} [comm_ring Rₘ] [comm_ring Sₘ] {R : Type u_1} [integral_domain R] [is_jacobson R] (φ : R →+* S) (hφ : function.injective ⇑φ) (x : R) (hx : x ≠ 0) (ϕ : localization_map (submonoid.powers x) Rₘ) (ϕ' : localization_map (submonoid.map (↑φ) (submonoid.powers x)) Sₘ) (hφ' : ring_hom.is_integral (localization_map.map ϕ (submonoid.mem_map_of_mem (submonoid.powers x) ↑φ) ϕ')) : jacobson ⊥ = ⊥ := sorry

/-- Used to bootstrap the proof of `is_jacobson_polynomial_iff_is_jacobson`.
  That theorem is more general and should be used instead of this one. -/
theorem is_jacobson_polynomial_of_is_jacobson {R : Type u_1} [comm_ring R] (hR : is_jacobson R) : is_jacobson (polynomial R) := sorry

theorem is_jacobson_polynomial_iff_is_jacobson {R : Type u_1} [comm_ring R] : is_jacobson (polynomial R) ↔ is_jacobson R := sorry

protected instance polynomial.ideal.is_jacobson {R : Type u_1} [comm_ring R] [is_jacobson R] : is_jacobson (polynomial R) :=
  iff.mpr is_jacobson_polynomial_iff_is_jacobson _inst_5

theorem is_maximal_comap_C_of_is_maximal {R : Type u_1} [integral_domain R] [is_jacobson R] (P : ideal (polynomial R)) [hP : is_maximal P] (hP' : ∀ (x : R), coe_fn polynomial.C x ∈ P → x = 0) : is_maximal (comap polynomial.C P) := sorry

/-- Used to bootstrap the more general `quotient_mk_comp_C_is_integral_of_jacobson` -/
/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `polynomial R`,
  then `R → (polynomial R)/P` is an integral map. -/
theorem quotient_mk_comp_C_is_integral_of_jacobson {R : Type u_1} [integral_domain R] [is_jacobson R] (P : ideal (polynomial R)) [hP : is_maximal P] : ring_hom.is_integral (ring_hom.comp (quotient.mk P) polynomial.C) := sorry

theorem is_maximal_comap_C_of_is_jacobson {R : Type u_1} [integral_domain R] [is_jacobson R] (P : ideal (polynomial R)) [hP : is_maximal P] : is_maximal (comap polynomial.C P) := sorry

theorem comp_C_integral_of_surjective_of_jacobson {R : Type u_1} [integral_domain R] [is_jacobson R] {S : Type u_2} [field S] (f : polynomial R →+* S) (hf : function.surjective ⇑f) : ring_hom.is_integral (ring_hom.comp f polynomial.C) := sorry

end polynomial

namespace mv_polynomial

theorem is_jacobson_mv_polynomial_fin {R : Type u_1} [comm_ring R] [H : is_jacobson R] (n : ℕ) : is_jacobson (mv_polynomial (fin n) R) := sorry

/-- General form of the nullstellensatz for Jacobson rings, since in a Jacobson ring we have
  `Inf {P maximal | P ≥ I} = Inf {P prime | P ≥ I} = I.radical`. Fields are always Jacobson,
  and in that special case this is (most of) the classical Nullstellensatz,
  since `I(V(I))` is the intersection of maximal ideals containing `I`, which is then `I.radical` -/
protected instance mv_polynomial.ideal.is_jacobson {R : Type u_1} [comm_ring R] {ι : Type u_2} [fintype ι] [is_jacobson R] : is_jacobson (mv_polynomial ι R) :=
  quot.induction_on (fintype.equiv_fin ι)
    fun (e : ι ≃ fin (fintype.card ι)) =>
      eq.mpr
        (id
          (Eq._oldrec (Eq.refl (is_jacobson (mv_polynomial ι R)))
            (propext (is_jacobson_iso (mv_polynomial.ring_equiv_of_equiv R e)))))
        (is_jacobson_mv_polynomial_fin (fintype.card ι))

theorem quotient_mk_comp_C_is_integral_of_jacobson {n : ℕ} {R : Type u_1} [integral_domain R] [is_jacobson R] (P : ideal (mv_polynomial (fin n) R)) [is_maximal P] : ring_hom.is_integral (ring_hom.comp (quotient.mk P) mv_polynomial.C) := sorry

theorem comp_C_integral_of_surjective_of_jacobson {R : Type u_1} [integral_domain R] [is_jacobson R] {σ : Type u_2} [fintype σ] {S : Type u_3} [field S] (f : mv_polynomial σ R →+* S) (hf : function.surjective ⇑f) : ring_hom.is_integral (ring_hom.comp f mv_polynomial.C) := sorry


import data.finset.basic -- for not_eq_or_aux
import algebra.order.sub.basic  -- for tsub_tsub_tsub_cancel_left

import data.finset.nat_antidiagonal -- for 4-fold sums
import ring_theory.ideal.basic -- for 4-fold sums (might not be optimal)

import data.finset.sym

/- -- Not used anymore
-- The "unused arguments" linter incorrectly flags this (?!)
-- To help distinguish the extreme cases in a finset.range(n+1).sum
lemma not_eq_or_aux {n m : ℕ} (hn : n ≠ 0) (hm : m ∈ finset.range(n + 1)) : m ≠ 0 ∨ n - m ≠ 0 :=
begin
  simp only [finset.mem_range, nat.lt_succ_iff] at hm,
  by_contradiction h,
  simp only [not_or_distrib, ne.def, not_not, tsub_eq_zero_iff_le, not_le, not_lt] at h,
  apply hn, rw ← le_zero_iff, rw ← h.1, exact h.2,
end -/

/- -- Now in mathlib
lemma tsub_tsub_tsub_cancel_left {α : Type*} [add_comm_semigroup α] [partial_order α]
  [has_exists_add_of_le α] [covariant_class α α has_add.add has_le.le] [has_sub α]
  [has_ordered_sub α] [contravariant_class α α has_add.add has_le.le] {a b c : α} (hcb : c ≤ b)
  (hab : b ≤ a) : a - c - (a - b) = b - c :=
by rw [tsub_eq_iff_eq_add_of_le (tsub_le_tsub_left hcb a), tsub_add_eq_add_tsub hcb, add_comm,
  tsub_add_cancel_of_le hab] -/

/- -- Not used anymore
lemma nat.self_sub_sub_eq {u v n : ℕ} (huv : v ≤ u) (hun : u ≤ n) :
  n - v - (n - u) = u - v :=
tsub_tsub_tsub_cancel_left hun
/- begin
  rw nat.sub_eq_iff_eq_add (tsub_le_tsub_left h n),
  rw ← nat.sub_add_comm h,
  rw add_comm,
  rw nat.sub_add_cancel h',
end -/ -/

section classical
open_locale classical

lemma function.extend_apply_first {α β γ : Type*} (f : α → β) (g : α → γ) (e' : β → γ)
  (hf : ∀ (a b : α), f a = f b → g a = g b) (a : α) :
  function.extend f g e' (f a) = g a :=
begin
  simp only [function.extend_def, dif_pos, exists_apply_eq_apply],
  apply hf,
  exact (classical.some_spec (exists_apply_eq_apply f a)),
end

end classical

section four_fold_sums

/- This lemma is awkward and mathematically obvious,
just rewrite the sum using the variable x which determines y, z, t.
However, one of its points is to reduce a 4-fold sum to a 2-fold sum.  -/

/-- The sum of f(x, y) on x + y = m and z + t = n and x + z = u and y + t = v
  is equal to the sum of  f(x, y) on x + y = m
  provided f (x, y) vanishes if x > u or y > v.
-/
lemma rewriting_4_fold_sums {α : Type*} [comm_semiring α] {m n u v : ℕ}
  (h : m + n = u + v) (f : ℕ × ℕ → α) {g : (ℕ × ℕ) × ℕ × ℕ → α}
  (hgf : g = λ x, f(x.fst.fst, x.fst.snd) )
  (hf : ∀ (x : ℕ × ℕ), u < x.fst ∨ v < x.snd → f x = 0) :
  (finset.filter (λ (x : (ℕ × ℕ) × ℕ × ℕ), x.fst.fst + x.snd.fst = u ∧ x.fst.snd + x.snd.snd = v)
  (finset.nat.antidiagonal m ×ˢ finset.nat.antidiagonal n)).sum  g
  = (finset.nat.antidiagonal m).sum f :=
begin
  let q := λ (x : (ℕ × ℕ) × ℕ × ℕ), x.fst,
  have hq : ∀ x ∈ finset.filter (λ (x : (ℕ × ℕ) × ℕ × ℕ), x.fst.fst + x.snd.fst =
    u ∧ x.fst.snd + x.snd.snd = v) (finset.nat.antidiagonal m ×ˢ finset.nat.antidiagonal n),
  x.fst ∈ finset.nat.antidiagonal m,
  { intro x, simp, intro h', simp [h'], },
  rw ←  finset.sum_fiberwise_of_maps_to hq,

  apply finset.sum_congr rfl,
  rintros ⟨i,j⟩ hij, simp only [finset.nat.mem_antidiagonal] at hij,
  rw finset.sum_filter, rw finset.sum_filter,
  simp_rw ← ite_and,
  suffices hf' : ∀ (x : (ℕ × ℕ) × ℕ × ℕ),
  ite ((x.fst.fst + x.snd.fst = u ∧ x.fst.snd + x.snd.snd = v) ∧ x.fst = (i, j)) (g x) 0 =
  ite ((x.fst.fst + x.snd.fst = u ∧ x.fst.snd + x.snd.snd = v) ∧ x.fst = (i, j)) 1 0 * (f⟨i, j⟩),
  rw finset.sum_congr rfl (λ x hx, hf' x),
  rw ← finset.sum_mul,
  by_cases hij' : i ≤ u ∧ j ≤ v,
  { conv_rhs { rw ← one_mul (f ⟨i, j⟩), },
    apply congr_arg2 _ _ rfl,
    rw finset.sum_eq_single (⟨⟨i, j⟩, ⟨u-i, v-j⟩⟩ : (ℕ × ℕ) × ℕ ×ℕ),
    simp only [nat.add_sub_of_le hij'.1, nat.add_sub_of_le hij'.2, eq_self_iff_true,
      and_self, if_true],
    { rintros ⟨⟨x,y⟩, ⟨z,t⟩⟩ hb hb',   rw if_neg, intro hb'',
      simp only [finset.mem_product, finset.nat.mem_antidiagonal] at hb,
      simp only [ne.def, prod.mk.inj_iff, not_and, and_imp] at hb',
      simp only [prod.mk.inj_iff] at hb'',
      specialize hb' hb''.2.1 hb''.2.2,
      rw [hb''.2.1, hb''.2.2] at hb,
      apply hb',
      apply nat.add_left_cancel, rw [nat.add_sub_of_le hij'.1, ← hb''.2.1, hb''.1.1],
      apply nat.add_left_cancel, rw [nat.add_sub_of_le hij'.2, ← hb''.2.2, hb''.1.2], },
    { intro hb, rw if_neg, intro hb', apply hb,
      simp only [eq_self_iff_true, and_true] at hb',
      simp only [finset.mem_product, finset.nat.mem_antidiagonal],
      apply and.intro hij,
      apply nat.add_left_cancel, rw [h, ← hij],
      conv_rhs {rw [← hb'.1, ← hb'.2] },
      simp only [← add_assoc, add_left_inj],
      simp only [add_assoc, add_right_inj],
      apply add_comm,  }, },
  { simp only [not_and_distrib, not_le] at hij',
    rw [hf ⟨i, j⟩ hij', mul_zero], },
  { intro x,
    split_ifs with hx,
    { simp only [one_mul, hgf], rw hx.2, },
    { rw zero_mul, } },
end

/- -- Unused
lemma rewriting_4_fold_sums' {m n u v : ℕ}
  (h : m + n = u + v) (f : ℕ × ℕ → ℕ) {g : (ℕ × ℕ) × ℕ × ℕ → ℕ}
  (hgf : g = λ x, f(x.fst.fst, x.fst.snd) )
  (hf : ∀ (x : ℕ × ℕ), u < x.fst ∨ v < x.snd → f x = 0) :
  (finset.nat.antidiagonal m).sum
    (λ (y : ℕ × ℕ),
       (finset.filter (λ (x : (ℕ × ℕ) × ℕ × ℕ), (λ (x : (ℕ × ℕ) × ℕ × ℕ), x.fst) x = y)
          (finset.filter (λ (x : (ℕ × ℕ) × ℕ × ℕ), x.fst.fst + x.snd.fst =
            u ∧ x.fst.snd + x.snd.snd = v)
             (finset.nat.antidiagonal m ×ˢ finset.nat.antidiagonal n))).sum g) =
  (finset.nat.antidiagonal m).sum (λ (ij : ℕ × ℕ), f ⟨ij.fst, ij.snd⟩) :=
begin
rw ← rewriting_4_fold_sums, --  h f hgf hf
end
-/

/- TODO : There should be some general rewriting pattern
for sums indexed by finset.nat_tuple_antidiagonal
This one would first rewrite to
(finset.nat_tuple_antidiagonal 4 n).sum (λ x, f(x0, x1, x2, x3))
and then one would apply the permutation (13)(24) -/

/-- Rewrites a 4-fold sum from variables (12)(34) to (13)(24) -/
lemma finset.sum_4_rw {α : Type*} [add_comm_monoid α] (f : ℕ × ℕ × ℕ × ℕ → α) (n : ℕ) :
  finset.sum (finset.range (n + 1)) (λ k,
    finset.sum (finset.range (k + 1)) (λ a,
      finset.sum (finset.range (n - k + 1)) (λ c,
        f(a, k - a, c, n - k - c)))) =
  finset.sum (finset.range (n + 1)) (λ l,
    finset.sum (finset.range (l + 1)) (λ a,
      finset.sum (finset.range (n - l + 1)) (λ b,
        f(a, b, l - a, n - l - b)))) :=
begin
  rw finset.sum_sigma',
  rw finset.sum_sigma',
  rw finset.sum_sigma',
  rw finset.sum_sigma',
  let aux_i : (Σ (i : Σ (i : ℕ), ℕ), ℕ) → (Σ (i : Σ (i : ℕ), ℕ), ℕ) :=
  λ ⟨⟨k, a⟩, c⟩, ⟨⟨a + c, a⟩, k - a⟩,
  have aux_hi : ∀ (a : Σ (i : Σ (i : ℕ), ℕ), ℕ)
    (ha : a ∈ ((finset.range (n + 1)).sigma
      (λ (x : ℕ), finset.range (x + 1))).sigma
        (λ (a : Σ (i : ℕ), ℕ), finset.range (n - a.fst + 1))),
    (λ (x : Σ (i : Σ (i : ℕ), ℕ), ℕ)
     (hx : x ∈ ((finset.range (n + 1)).sigma
        (λ (a : ℕ), finset.range (a + 1))).sigma
           (λ (a : Σ (i : ℕ), ℕ), finset.range (n - a.fst + 1))), aux_i x) a ha ∈
    ((finset.range (n + 1)).sigma (λ (a : ℕ), finset.range (a + 1))).sigma
      (λ (x : Σ (i : ℕ), ℕ), finset.range (n - x.fst + 1)),
  { rintros ⟨⟨k, a⟩, c⟩ h,
    simp only [finset.mem_sigma, finset.mem_range, nat.lt_succ_iff] at h,
    simp_rw [aux_i, finset.mem_sigma, finset.mem_range, nat.lt_succ_iff],
    split, split,
    { apply le_trans (add_le_add h.1.2 h.2) _,
      rw add_comm, rw nat.sub_add_cancel h.1.1, },
    { exact le_self_add, },
    { rw add_comm a c, rw ← nat.sub_sub n c a,
      simp, rw nat.sub_add_cancel,
      rw nat.le_sub_iff_right,
      rw nat.le_sub_iff_right at h, rw add_comm k c, exact h.2,
      exact h.1.1,
      apply le_trans h.2, exact nat.sub_le n k,
      rw nat.le_sub_iff_right,
      rw nat.le_sub_iff_right at h,
      apply nat.le_of_add_le_add_right,
      rw add_assoc a c _, rw add_comm n _,
      exact add_le_add h.1.2 h.2,
      exact h.1.1,
      apply le_trans h.2 _, apply nat.sub_le, }, },
  rw finset.sum_bij' (λ x hx, aux_i x) aux_hi _ (λ y hy, aux_i y) aux_hi _ _,
  { rintros ⟨⟨k, a⟩, c⟩ h,
    simp only [finset.mem_sigma, finset.mem_range, nat.lt_succ_iff] at h,
    apply congr_arg,
    dsimp [aux_i],
    simp only [prod.mk.inj_iff],
    apply and.intro rfl,
    apply and.intro rfl,
    split,
    { rw add_comm a c, rw nat.add_sub_cancel, },
    { simp only [nat.sub_sub],
      apply congr_arg2 _ rfl,
      rw [add_comm k c, add_comm a c, add_assoc],
      apply congr_arg2 _ rfl,
      rw add_comm,
      rw nat.sub_add_cancel h.1.2, }, },
  { rintros ⟨⟨k, a⟩, c⟩ h,
    simp only [finset.mem_sigma, finset.mem_range, nat.lt_succ_iff] at h,
    simp_rw [aux_i],
    simp only [add_tsub_cancel_left, sigma.mk.inj_iff, heq_iff_eq, eq_self_iff_true, and_true],
    { rw add_comm, rw nat.sub_add_cancel h.1.2, }, },
  { rintros ⟨⟨k, a⟩, c⟩ h,
    simp only [finset.mem_sigma, finset.mem_range, nat.lt_succ_iff] at h,
    simp_rw [aux_i],
    simp only [add_tsub_cancel_left, sigma.mk.inj_iff, heq_iff_eq, eq_self_iff_true, and_true],
    { rw add_comm, rw nat.sub_add_cancel h.1.2, }, },
end

end four_fold_sums

lemma range_sym_prop {m n : ℕ} {k : sym ℕ m} (hk :
  k ∈ (finset.range (n + 1)).sym m) :
  finset.sum (finset.range (n + 1)) (λ i,
    multiset.count i ↑k) = m :=
begin
  simp only [finset.mem_sym_iff] at hk,
  simp_rw ← k.prop,
  rw ← multiset.to_finset_sum_count_eq ↑k,
  apply symm,
  apply finset.sum_subset_zero_on_sdiff,
  { intros i hi,
    rw [multiset.mem_to_finset, sym.mem_coe] at  hi,
    exact hk i hi, },
  { intros x hx,
    rw [finset.mem_sdiff, multiset.mem_to_finset, sym.mem_coe] at hx,
    simp only [multiset.count_eq_zero, sym.mem_coe],
    exact hx.2, },
  { intros x hk, refl, },
end

lemma range_sym_weighted_sum_le {m n : ℕ} (k : sym ℕ m) (hk : k ∈ (finset.range (n+1)).sym m) :
  (finset.range (n+1)).sum  (λ i, multiset.count i ↑k * i) ≤ m * n :=
begin
  suffices : ∀ (i : ℕ) (hi : i ∈ finset.range (n + 1)),
  (multiset.count i ↑k * i ≤ multiset.count i ↑k * n),
    apply le_trans (finset.sum_le_sum this),
    rw ← finset.sum_mul,
    rw range_sym_prop hk,
  -- suffices
  intros i hi,
  apply nat.mul_le_mul_of_nonneg_left,
  exact nat.lt_succ_iff.mp (finset.mem_range.mp hi),
end

lemma sum_range_sym_mul_compl {m n : ℕ} {k : sym ℕ m} (hk : k ∈ (finset.range (n + 1)).sym m) :
    finset.sum (finset.range (n+1)) (λ i, ((multiset.count i k) * (n - i)))
    = m * n - finset.sum (finset.range (n+1)) (λ i, ((multiset.count i k) * i)) :=
  begin
    suffices : (finset.range (n+1)).sum (λ i, multiset.count i ↑k * (n-i))
      + (finset.range (n+1)).sum (λi, multiset.count i ↑k * i) = m * n,
    rw ← this,  rw nat.add_sub_cancel,

    rw ← finset.sum_add_distrib,
    simp_rw ← mul_add,
    have : ∀ (x : ℕ) (hx : x ∈ finset.range (n + 1)),
      multiset.count x ↑k * (n -x + x) = multiset.count x ↑k * n,
    { intros x hx,
      rw nat.sub_add_cancel (nat.lt_succ_iff.mp (finset.mem_range.mp hx)), },
    rw finset.sum_congr rfl this,
    rw ← finset.sum_mul,
    rw range_sym_prop hk,
end


import QL.FOL.Tait.search_tree QL.FOL.Tait.semantics

universes u v

namespace fol
open_locale logic_symbol aclogic
open subformula
variables {L : language.{u}}  {m : ℕ}

theorem completeness_of_countable_language [∀ k, encodable (L.fn k)] [∀ k, encodable (L.pr k)] {T : Theory L} {σ : sentence L} :
  T ⊧₀ σ → T ⊢ σ :=
begin
  have s : T ⊧₀ σ → to_tait '' T ⊧ σ.to_tait,
  { intros h S hh, simpa using @h S (by { intros p hp, simpa using hh (set.mem_image_of_mem _ hp) }) },
  have complete : to_tait '' T ⊧ σ.to_tait → to_tait '' T ⊢ σ.to_tait, from Tait.completeness_of_countable_language,
  have b : to_tait '' T ⊢ to_tait σ → T ⊢ σ, from provable.of_Tait_provable,
  refine (λ h, (b $ complete $ s h))
end

end fol