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

! This file was ported from Lean 3 source module combinatorics.simple_graph.prod
! leanprover-community/mathlib commit 2985fa3c31a27274aed06c433510bc14b73d6488
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.SimpleGraph.Connectivity

/-!
# Graph products

This file defines the box product of graphs and other product constructions. The box product of `G`
and `H` is the graph on the product of the vertices such that `x` and `y` are related iff they agree
on one component and the other one is related via either `G` or `H`. For example, the box product of
two edges is a square.

## Main declarations

* `SimpleGraph.boxProd`: The box product.

## Notation

* `G □ H`: The box product of `G` and `H`.

## TODO

Define all other graph products!
-/

variable {α β γ : Type _}

namespace SimpleGraph

-- Porting note: pruned variables to keep things out of local contexts, which
-- can impact how generalization works, or what aesop does.
variable {G : SimpleGraph α} {H : SimpleGraph β}

/-- Box product of simple graphs. It relates `(a₁, b)` and `(a₂, b)` if `G` relates `a₁` and `a₂`,
and `(a, b₁)` and `(a, b₂)` if `H` relates `b₁` and `b₂`. -/
def boxProd (G : SimpleGraph α) (H : SimpleGraph β) : SimpleGraph (α × β) where
  Adj x y := G.Adj x.1 y.1 ∧ x.2 = y.2 ∨ H.Adj x.2 y.2 ∧ x.1 = y.1
  symm x y := by simp [and_comm, or_comm, eq_comm, adj_comm]
  loopless x := by simp
#align simple_graph.box_prod SimpleGraph.boxProd

-- mathport name: «expr □ »
/-- Box product of simple graphs. It relates `(a₁, b)` and `(a₂, b)` if `G` relates `a₁` and `a₂`,
and `(a, b₁)` and `(a, b₂)` if `H` relates `b₁` and `b₂`. -/
infixl:70 " □ " => boxProd

@[simp]
theorem boxProd_adj : (G □ H).Adj x y ↔ G.Adj x.1 y.1 ∧ x.2 = y.2 ∨ H.Adj x.2 y.2 ∧ x.1 = y.1 :=
  Iff.rfl
#align simple_graph.box_prod_adj SimpleGraph.boxProd_adj

--@[simp] porting note: `simp` can prove
theorem boxProd_adj_left : (G □ H).Adj (a₁, b) (a₂, b) ↔ G.Adj a₁ a₂ := by
  simp only [boxProd_adj, and_true, SimpleGraph.irrefl, false_and, or_false]
#align simple_graph.box_prod_adj_left SimpleGraph.boxProd_adj_left

--@[simp] porting note: `simp` can prove

theorem boxProd_neighborSet (x : α × β) :
    (G □ H).neighborSet x = G.neighborSet x.1 ×ˢ {x.2} ∪ {x.1} ×ˢ H.neighborSet x.2 := by
  ext ⟨a', b'⟩
  simp only [mem_neighborSet, Set.mem_union, boxProd_adj, Set.mem_prod, Set.mem_singleton_iff]
  simp only [eq_comm, and_comm]
#align simple_graph.box_prod_neighbor_set SimpleGraph.boxProd_neighborSet

variable (G H)

/-- The box product is commutative up to isomorphism. `Equiv.prodComm` as a graph isomorphism. -/
@[simps!]
def boxProdComm : G □ H ≃g H □ G := ⟨Equiv.prodComm _ _, or_comm⟩
#align simple_graph.box_prod_comm SimpleGraph.boxProdComm

/-- The box product is associative up to isomorphism. `Equiv.prodAssoc` as a graph isomorphism. -/
@[simps!]
def boxProdAssoc (I : SimpleGraph γ) : G □ H □ I ≃g G □ (H □ I) :=
  ⟨Equiv.prodAssoc _ _ _, fun {x y} => by
    simp only [boxProd_adj, Equiv.prodAssoc_apply, or_and_right, or_assoc, Prod.ext_iff,
      and_assoc, @and_comm (x.fst.fst = _)]; tauto⟩
#align simple_graph.box_prod_assoc SimpleGraph.boxProdAssoc

/-- The embedding of `G` into `G □ H` given by `b`. -/
@[simps]
def boxProdLeft (b : β) : G ↪g G □ H where
  toFun a := (a, b)
  inj' _ _ := congr_arg Prod.fst
  map_rel_iff' {_ _} := boxProd_adj_left
#align simple_graph.box_prod_left SimpleGraph.boxProdLeft

/-- The embedding of `H` into `G □ H` given by `a`. -/
@[simps]
def boxProdRight (a : α) : H ↪g G □ H where
  toFun := Prod.mk a
  inj' _ _ := congr_arg Prod.snd
  map_rel_iff' {_ _} := boxProd_adj_right
#align simple_graph.box_prod_right SimpleGraph.boxProdRight

namespace Walk

variable {G}

/-- Turn a walk on `G` into a walk on `G □ H`. -/
protected def boxProdLeft (b : β) : G.Walk a₁ a₂ → (G □ H).Walk (a₁, b) (a₂, b) :=
  Walk.map (G.boxProdLeft H b).toHom
#align simple_graph.walk.box_prod_left SimpleGraph.Walk.boxProdLeft

variable (G) {H}

/-- Turn a walk on `H` into a walk on `G □ H`. -/
protected def boxProdRight (a : α) : H.Walk b₁ b₂ → (G □ H).Walk (a, b₁) (a, b₂) :=
  Walk.map (G.boxProdRight H a).toHom
#align simple_graph.walk.box_prod_right SimpleGraph.Walk.boxProdRight

variable {G}

/-- Project a walk on `G □ H` to a walk on `G` by discarding the moves in the direction of `H`. -/
def ofBoxProdLeft [DecidableEq β] [DecidableRel G.Adj] {x y : α × β} :
    (G □ H).Walk x y → G.Walk x.1 y.1
  | nil => nil
  | cons h w =>
    Or.by_cases h
      (fun hG => w.ofBoxProdLeft.cons hG.1)
      (fun hH => hH.2 ▸ w.ofBoxProdLeft)
#align simple_graph.walk.of_box_prod_left SimpleGraph.Walk.ofBoxProdLeft

/-- Project a walk on `G □ H` to a walk on `H` by discarding the moves in the direction of `G`. -/
def ofBoxProdRight [DecidableEq α] [DecidableRel H.Adj] {x y : α × β} :
    (G □ H).Walk x y → H.Walk x.2 y.2
  | nil => nil
  | cons h w =>
    (Or.symm h).by_cases
      (fun hH => w.ofBoxProdRight.cons hH.1)
      (fun hG => hG.2 ▸ w.ofBoxProdRight)
#align simple_graph.walk.of_box_prod_right SimpleGraph.Walk.ofBoxProdRight

@[simp]
theorem ofBoxProdLeft_boxProdLeft [DecidableEq β] [DecidableRel G.Adj] {a₁ a₂ : α} :
    ∀ (w : G.Walk a₁ a₂), (w.boxProdLeft H b).ofBoxProdLeft = w
  | nil => rfl
  | cons' x y z h w => by
    rw [Walk.boxProdLeft, map_cons, ofBoxProdLeft, Or.by_cases, dif_pos, ← Walk.boxProdLeft]
    simp [ofBoxProdLeft_boxProdLeft]
    exact ⟨h, rfl⟩
#align simple_graph.walk.of_box_prod_left_box_prod_left SimpleGraph.Walk.ofBoxProdLeft_boxProdLeft

@[simp]
theorem ofBoxProdLeft_boxProdRight [DecidableEq α] [DecidableRel G.Adj] {b₁ b₂ : α} :
    ∀ (w : G.Walk b₁ b₂), (w.boxProdRight G a).ofBoxProdRight = w
  | nil => rfl
  | cons' x y z h w => by
    rw [Walk.boxProdRight, map_cons, ofBoxProdRight, Or.by_cases, dif_pos, ←
      Walk.boxProdRight]
    simp [ofBoxProdLeft_boxProdRight]
    exact⟨h, rfl⟩
#align simple_graph.walk.of_box_prod_left_box_prod_right SimpleGraph.Walk.ofBoxProdLeft_boxProdRight

end Walk

variable {G H}

protected theorem Preconnected.boxProd (hG : G.Preconnected) (hH : H.Preconnected) :
    (G □ H).Preconnected := by
  rintro x y
  obtain ⟨w₁⟩ := hG x.1 y.1
  obtain ⟨w₂⟩ := hH x.2 y.2
  rw [← @Prod.mk.eta _ _ x, ← @Prod.mk.eta _ _ y]
  exact ⟨(w₁.boxProdLeft _ _).append (w₂.boxProdRight _ _)⟩
#align simple_graph.preconnected.box_prod SimpleGraph.Preconnected.boxProd

protected theorem Preconnected.ofBoxProdLeft [Nonempty β] (h : (G □ H).Preconnected) :
    G.Preconnected := by
  classical
  rintro a₁ a₂
  obtain ⟨w⟩ := h (a₁, Classical.arbitrary _) (a₂, Classical.arbitrary _)
  exact ⟨w.ofBoxProdLeft⟩
#align simple_graph.preconnected.of_box_prod_left SimpleGraph.Preconnected.ofBoxProdLeft

protected theorem Preconnected.ofBoxProdRight [Nonempty α] (h : (G □ H).Preconnected) :
    H.Preconnected := by
  classical
  rintro b₁ b₂
  obtain ⟨w⟩ := h (Classical.arbitrary _, b₁) (Classical.arbitrary _, b₂)
  exact ⟨w.ofBoxProdRight⟩
#align simple_graph.preconnected.of_box_prod_right SimpleGraph.Preconnected.ofBoxProdRight

protected theorem Connected.boxProd (hG : G.Connected) (hH : H.Connected) : (G □ H).Connected := by
  haveI := hG.nonempty
  haveI := hH.nonempty
  exact ⟨hG.preconnected.boxProd hH.preconnected⟩
#align simple_graph.connected.box_prod SimpleGraph.Connected.boxProd

protected theorem Connected.ofBoxProdLeft (h : (G □ H).Connected) : G.Connected := by
  haveI := (nonempty_prod.1 h.nonempty).1
  haveI := (nonempty_prod.1 h.nonempty).2
  exact ⟨h.preconnected.ofBoxProdLeft⟩
#align simple_graph.connected.of_box_prod_left SimpleGraph.Connected.ofBoxProdLeft

protected theorem Connected.ofBoxProdRight (h : (G □ H).Connected) : H.Connected := by
  haveI := (nonempty_prod.1 h.nonempty).1
  haveI := (nonempty_prod.1 h.nonempty).2
  exact ⟨h.preconnected.ofBoxProdRight⟩
#align simple_graph.connected.of_box_prod_right SimpleGraph.Connected.ofBoxProdRight

@[simp]
theorem boxProd_connected : (G □ H).Connected ↔ G.Connected ∧ H.Connected :=
  ⟨fun h => ⟨h.ofBoxProdLeft, h.ofBoxProdRight⟩, fun h => h.1.boxProd h.2⟩
#align simple_graph.box_prod_connected SimpleGraph.boxProd_connected

instance boxProdFintypeNeighborSet (x : α × β)
    [Fintype (G.neighborSet x.1)] [Fintype (H.neighborSet x.2)] :
    Fintype ((G □ H).neighborSet x) :=
  Fintype.ofEquiv
    -- porting note: was `×ˢ`
    ((G.neighborFinset x.1 ×ᶠ {x.2}).disjUnion ({x.1} ×ᶠ H.neighborFinset x.2) <|
      Finset.disjoint_product.mpr <| Or.inl <| neighborFinset_disjoint_singleton _ _)
    ((Equiv.refl _).subtypeEquiv fun y => by
      simp_rw [Finset.mem_disjUnion, Finset.mem_product, Finset.mem_singleton, mem_neighborFinset,
        mem_neighborSet, Equiv.refl_apply, boxProd_adj]
      simp only [eq_comm, and_comm])
#align simple_graph.box_prod_fintype_neighbor_set SimpleGraph.boxProdFintypeNeighborSet

theorem boxProd_neighborFinset (x : α × β)
    [Fintype (G.neighborSet x.1)] [Fintype (H.neighborSet x.2)] [Fintype ((G □ H).neighborSet x)] :
    (G □ H).neighborFinset x =
      -- porting note: was `×ˢ`
      (G.neighborFinset x.1 ×ᶠ {x.2}).disjUnion ({x.1} ×ᶠ H.neighborFinset x.2)
        (Finset.disjoint_product.mpr <| Or.inl <| neighborFinset_disjoint_singleton _ _) := by
  -- swap out the fintype instance for the canonical one
  letI : Fintype ((G □ H).neighborSet x) := SimpleGraph.boxProdFintypeNeighborSet _
  convert_to (G □ H).neighborFinset x = _ using 2
  exact Eq.trans (Finset.map_map _ _ _) Finset.attach_map_val
#align simple_graph.box_prod_neighbor_finset SimpleGraph.boxProd_neighborFinset

theorem boxProd_degree (x : α × β)
    [Fintype (G.neighborSet x.1)] [Fintype (H.neighborSet x.2)] [Fintype ((G □ H).neighborSet x)] :
    (G □ H).degree x = G.degree x.1 + H.degree x.2 := by
  rw [degree, degree, degree, boxProd_neighborFinset, Finset.card_disjUnion]
  simp_rw [Finset.card_product, Finset.card_singleton, mul_one, one_mul]
#align simple_graph.box_prod_degree SimpleGraph.boxProd_degree

end SimpleGraph


#exit

-- this was just a proof of concept

import finiteness.is_finite
import subgroup.theorems

-- in this file we get is_finite working with groups.
-- For example we prove that a subgroup of a finite group is finite.

-- finiteness of subgroups

-- We will prove that if G is a finite group and H is a subgroup
-- then the promotion of H to a group is also finite

-- remember : (H : subgroup G) -- H is a *term* not a type

namespace mygroup

variables (G : Type) [group G]

-- use is_finite to say a group is finite

variable [is_finite G]

variable (H : subgroup G)

instance : is_finite H := is_finite.set H.carrier

example (G : Type) [group G] [is_finite G] (H : subgroup G) : is_finite H :=
by apply_instance

end mygroup


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import ring_theory.polynomial.basic
import ring_theory.ideal.local_ring
import tactic.ring_exp

/-!
# Expand a polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`.
-/

universes u v w
open_locale classical big_operators polynomial
open finset

namespace polynomial

section comm_semiring

variables (R : Type u) [comm_semiring R] {S : Type v} [comm_semiring S] (p q : ℕ)

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`. -/
noncomputable def expand : R[X] →ₐ[R] R[X] :=
{ commutes' := λ r, eval₂_C _ _,
  .. (eval₂_ring_hom C (X ^ p) : R[X] →+* R[X]) }

lemma coe_expand : (expand R p : R[X] → R[X]) = eval₂ C (X ^ p) := rfl

variables {R}

lemma expand_eq_sum {f : R[X]} :
  expand R p f = f.sum (λ e a, C a * (X ^ p) ^ e) :=
by { dsimp [expand, eval₂], refl, }

@[simp] lemma expand_C (r : R) : expand R p (C r) = C r := eval₂_C _ _
@[simp] lemma expand_X : expand R p X = X ^ p := eval₂_X _ _
@[simp]

theorem expand_expand (f : R[X]) : expand R p (expand R q f) = expand R (p * q) f :=
polynomial.induction_on f (λ r, by simp_rw expand_C)
  (λ f g ihf ihg, by simp_rw [alg_hom.map_add, ihf, ihg])
  (λ n r ih, by simp_rw [alg_hom.map_mul, expand_C, alg_hom.map_pow, expand_X,
    alg_hom.map_pow, expand_X, pow_mul])

theorem expand_mul (f : R[X]) : expand R (p * q) f = expand R p (expand R q f) :=
(expand_expand p q f).symm

@[simp] theorem expand_zero (f : R[X]) : expand R 0 f = C (eval 1 f) :=
by simp [expand]

@[simp] theorem expand_one (f : R[X]) : expand R 1 f = f :=
polynomial.induction_on f
  (λ r, by rw expand_C)
  (λ f g ihf ihg, by rw [alg_hom.map_add, ihf, ihg])
  (λ n r ih, by rw [alg_hom.map_mul, expand_C, alg_hom.map_pow, expand_X, pow_one])

theorem expand_pow (f : R[X]) : expand R (p ^ q) f = (expand R p ^[q] f) :=
nat.rec_on q (by rw [pow_zero, expand_one, function.iterate_zero, id]) $ λ n ih,
by rw [function.iterate_succ_apply', pow_succ, expand_mul, ih]

theorem derivative_expand (f : R[X]) :
  (expand R p f).derivative = expand R p f.derivative * (p * X ^ (p - 1)) :=
by rw [coe_expand, derivative_eval₂_C, derivative_pow, derivative_X, mul_one]

theorem coeff_expand {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) :
  (expand R p f).coeff n = if p ∣ n then f.coeff (n / p) else 0 :=
begin
  simp only [expand_eq_sum],
  simp_rw [coeff_sum, ← pow_mul, C_mul_X_pow_eq_monomial, coeff_monomial, sum],
  split_ifs with h,
  { rw [finset.sum_eq_single (n/p), nat.mul_div_cancel' h, if_pos rfl],
    { intros b hb1 hb2, rw if_neg, intro hb3, apply hb2, rw [← hb3, nat.mul_div_cancel_left b hp] },
    { intro hn, rw not_mem_support_iff.1 hn, split_ifs; refl } },
  { rw finset.sum_eq_zero, intros k hk, rw if_neg, exact λ hkn, h ⟨k, hkn.symm⟩, },
end

@[simp] theorem coeff_expand_mul {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) :
  (expand R p f).coeff (n * p) = f.coeff n :=
by rw [coeff_expand hp, if_pos (dvd_mul_left _ _), nat.mul_div_cancel _ hp]

@[simp] theorem coeff_expand_mul' {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) :
  (expand R p f).coeff (p * n) = f.coeff n :=
by rw [mul_comm, coeff_expand_mul hp]

theorem expand_inj {p : ℕ} (hp : 0 < p) {f g : R[X]} :
  expand R p f = expand R p g ↔ f = g :=
⟨λ H, ext $ λ n, by rw [← coeff_expand_mul hp, H, coeff_expand_mul hp], congr_arg _⟩

theorem expand_eq_zero {p : ℕ} (hp : 0 < p) {f : R[X]} : expand R p f = 0 ↔ f = 0 :=
by rw [← (expand R p).map_zero, expand_inj hp, alg_hom.map_zero]

theorem expand_eq_C {p : ℕ} (hp : 0 < p) {f : R[X]} {r : R} :
  expand R p f = C r ↔ f = C r :=
by rw [← expand_C, expand_inj hp, expand_C]

theorem nat_degree_expand (p : ℕ) (f : R[X]) :
  (expand R p f).nat_degree = f.nat_degree * p :=
begin
  cases p.eq_zero_or_pos with hp hp,
  { rw [hp, coe_expand, pow_zero, mul_zero, ← C_1, eval₂_hom, nat_degree_C] },
  by_cases hf : f = 0,
  { rw [hf, alg_hom.map_zero, nat_degree_zero, zero_mul] },
  have hf1 : expand R p f ≠ 0 := mt (expand_eq_zero hp).1 hf,
  rw [← with_bot.coe_eq_coe, ← degree_eq_nat_degree hf1],
  refine le_antisymm ((degree_le_iff_coeff_zero _ _).2 $ λ n hn, _) _,
  { rw coeff_expand hp, split_ifs with hpn,
    { rw coeff_eq_zero_of_nat_degree_lt, contrapose! hn,
      rw [with_bot.coe_le_coe, ← nat.div_mul_cancel hpn], exact nat.mul_le_mul_right p hn },
    { refl } },
  { refine le_degree_of_ne_zero _,
    rw [coeff_expand_mul hp, ← leading_coeff], exact mt leading_coeff_eq_zero.1 hf }
end

lemma monic.expand {p : ℕ} {f : R[X]} (hp : 0 < p) (h : f.monic) : (expand R p f).monic :=
begin
  rw [monic.def, leading_coeff, nat_degree_expand, coeff_expand hp],
  simp [hp, h],
end

theorem map_expand {p : ℕ} {f : R →+* S} {q : R[X]} :
  map f (expand R p q) = expand S p (map f q) :=
begin
  by_cases hp : p = 0,
  { simp [hp] },
  ext,
  rw [coeff_map, coeff_expand (nat.pos_of_ne_zero hp), coeff_expand (nat.pos_of_ne_zero hp)],
  split_ifs; simp,
end

/-- Expansion is injective. -/
lemma expand_injective {n : ℕ} (hn : 0 < n) :
  function.injective (expand R n) :=
λ g g' h, begin
  ext,
  have h' : (expand R n g).coeff (n * n_1) = (expand R n g').coeff (n * n_1) :=
  begin
    apply polynomial.ext_iff.1,
    exact h,
  end,

  rw [polynomial.coeff_expand hn g (n * n_1), polynomial.coeff_expand hn g' (n * n_1)] at h',
  simp only [if_true, dvd_mul_right] at h',
  rw (nat.mul_div_right n_1 hn) at h',
  exact h',
end

@[simp]
lemma expand_eval (p : ℕ) (P : R[X]) (r : R) : eval r (expand R p P) = eval (r ^ p) P :=
begin
  refine polynomial.induction_on P (λ a, by simp) (λ f g hf hg, _) (λ n a h, by simp),
  rw [alg_hom.map_add, eval_add, eval_add, hf, hg]
end

/-- The opposite of `expand`: sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. -/
noncomputable def contract (p : ℕ) (f : R[X]) : R[X] :=
∑ n in range (f.nat_degree + 1), monomial n (f.coeff (n * p))

theorem coeff_contract {p : ℕ} (hp : p ≠ 0) (f : R[X]) (n : ℕ) :
  (contract p f).coeff n = f.coeff (n * p) :=
begin
  simp only [contract, coeff_monomial, sum_ite_eq', finset_sum_coeff, mem_range, not_lt,
    ite_eq_left_iff],
  assume hn,
  apply (coeff_eq_zero_of_nat_degree_lt _).symm,
  calc f.nat_degree < f.nat_degree + 1 : nat.lt_succ_self _
    ... ≤ n * 1 : by simpa only [mul_one] using hn
    ... ≤ n * p : mul_le_mul_of_nonneg_left (show 1 ≤ p, from hp.bot_lt) (zero_le n)
end

theorem contract_expand {f : R[X]} (hp : p ≠ 0) : contract p (expand R p f) = f :=
begin
  ext,
  simp [coeff_contract hp, coeff_expand hp.bot_lt, nat.mul_div_cancel _ hp.bot_lt]
end

section char_p

variable [char_p R p]

theorem expand_contract [no_zero_divisors R] {f : R[X]} (hf : f.derivative = 0)
  (hp : p ≠ 0) : expand R p (contract p f) = f :=
begin
  ext n,
  rw [coeff_expand hp.bot_lt, coeff_contract hp],
  split_ifs with h,
  { rw nat.div_mul_cancel h },
  { cases n,
    { exact absurd (dvd_zero p) h },
    have := coeff_derivative f n,
    rw [hf, coeff_zero, zero_eq_mul] at this,
    cases this,
    { rw this },
    rw [← nat.cast_succ, char_p.cast_eq_zero_iff R p] at this,
    exact absurd this h }
end

variable [hp : fact p.prime]
include hp

theorem expand_char (f : R[X]) : map (frobenius R p) (expand R p f) = f ^ p :=
begin
  refine f.induction_on' (λ a b ha hb, _) (λ n a, _),
  { rw [alg_hom.map_add, polynomial.map_add, ha, hb, add_pow_char], },
  { rw [expand_monomial, map_monomial, monomial_eq_C_mul_X, monomial_eq_C_mul_X,
        mul_pow, ← C.map_pow, frobenius_def],
    ring_exp }
end

theorem map_expand_pow_char (f : R[X]) (n : ℕ) :
   map ((frobenius R p) ^ n) (expand R (p ^ n) f) = f ^ (p ^ n) :=
begin
  induction n,
  { simp [ring_hom.one_def] },
  symmetry,
  rw [pow_succ', pow_mul, ← n_ih, ← expand_char, pow_succ, ring_hom.mul_def,
      ← map_map, mul_comm, expand_mul, ← map_expand]
end

end char_p

end comm_semiring

section is_domain

variables (R : Type u) [comm_ring R] [is_domain R]

theorem is_local_ring_hom_expand {p : ℕ} (hp : 0 < p) :
  is_local_ring_hom (↑(expand R p) : R[X] →+* R[X]) :=
begin
  refine ⟨λ f hf1, _⟩, rw ← coe_fn_coe_base at hf1,
  have hf2 := eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf1),
  rw [coeff_expand hp, if_pos (dvd_zero _), p.zero_div] at hf2,
  rw [hf2, is_unit_C] at hf1, rw expand_eq_C hp at hf2, rwa [hf2, is_unit_C]
end

variable {R}

theorem of_irreducible_expand {p : ℕ} (hp : p ≠ 0) {f : R[X]}
  (hf : irreducible (expand R p f)) : irreducible f :=
@@of_irreducible_map _ _ _ (is_local_ring_hom_expand R hp.bot_lt) hf

theorem of_irreducible_expand_pow {p : ℕ} (hp : p ≠ 0) {f : R[X]} {n : ℕ} :
  irreducible (expand R (p ^ n) f) → irreducible f :=
nat.rec_on n (λ hf, by rwa [pow_zero, expand_one] at hf) $ λ n ih hf,
ih $ of_irreducible_expand hp $ by { rw pow_succ at hf, rwa [expand_expand] }

end is_domain

end polynomial


import data.matrix
import data.rat
import data.set data.set.enumerate data.set.finite data.finset

variables {α : Type} {n m l s t : Type} [fintype n] [fintype m] [fintype s] [fintype t]

variables {n1 n2 : nat}

section matrix
def le [partial_order α] (M N : matrix n m α)  :=
∀i:n, ∀j:m, M i j ≤ N i j

instance [partial_order α] : has_le (matrix n m α) :=
{ le := le }

protected lemma matrix.le_refl [partial_order α] (A: matrix n m α) :
A ≤ A :=
by intros i j; refl

protected lemma matrix.le_trans [partial_order α] (a b c: matrix n m α)
  (h1 : a ≤ b) (h2 : b ≤ c) : a ≤ c :=
by intros i j; transitivity; solve_by_elim

protected lemma matrix.le_antisymm [partial_order α] (a b: matrix n m α)
  (h1 : a ≤ b) (h2 : b ≤ a) : a = b :=
by ext i j; exact le_antisymm (h1 i j) (h2 i j)

instance [partial_order α] : partial_order (matrix n m α) :=
{
  le := le,
  le_refl := matrix.le_refl,
  le_trans := matrix.le_trans,
  le_antisymm := matrix.le_antisymm
}
end matrix

local infixl ` *ₘ ` : 70 := matrix.mul

def polyhedron [ordered_ring α] (A : matrix m n α) (b : matrix m unit α) :
  set (matrix n unit α) :=
{ x : matrix n unit α | A *ₘ x ≥ b }

def vec (n: Type) (α : Type) [fintype n] :=
n → α

instance [ordered_ring α] [decidable_rel ((≤) : α → α → Prop)]
  (A : matrix m n α) (b : matrix m unit α) (x : matrix n unit α) :
  decidable (x ∈ polyhedron A b) :=
show decidable (∀i:m, ∀j:unit, b i j ≤ (A *ₘ x) i j),
  by apply_instance

variables [ordered_ring α] (A B : matrix m n α) (b : matrix m unit α)

protected def matrix.row (A : matrix m n α) (row : m) : matrix unit n α :=
λ x: unit, λ y: n, (A row) y

lemma polyhedron_rowinE [ordered_ring α]
        (x: matrix n unit α) (A: matrix m n α) (b: matrix m unit α):
    x ∈ (polyhedron A b) = ∀ i:m, (matrix.row
     A i *ₘ x) () () ≥ b i () :=

propext $ iff.intro
  (assume h: x ∈ (polyhedron A b),
   assume d: m,
   show (matrix.row A d *ₘ x) () () ≥ b d (),
   begin
     rw polyhedron at h,
     rw set.mem_set_of_eq at h,
     exact h d ()
   end
  )
  (assume h: ∀ i:m, (matrix.row A i *ₘ x) () () ≥ b i (),
   show x ∈ (polyhedron A b),
   begin
   assume d : m,
   assume j : unit,
   rw <-(≥),
   cases j,
   apply h,
   end
  )

def active_ineq [ordered_ring α] (x: matrix n unit α)
    (A: matrix m n α) (b: matrix m unit α) : set m :=
{ i | ((A *ₘ x) i () == b i ())}


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

! This file was ported from Lean 3 source module linear_algebra.projective_space.basic
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FiniteDimensional

/-!

# Projective Spaces

This file contains the definition of the projectivization of a vector space over a field,
as well as the bijection between said projectivization and the collection of all one
dimensional subspaces of the vector space.

## Notation
`ℙ K V` is notation for `projectivization K V`, the projectivization of a `K`-vector space `V`.

## Constructing terms of `ℙ K V`.
We have three ways to construct terms of `ℙ K V`:
- `projectivization.mk K v hv` where `v : V` and `hv : v ≠ 0`.
- `projectivization.mk' K v` where `v : { w : V // w ≠ 0 }`.
- `projectivization.mk'' H h` where `H : submodule K V` and `h : finrank H = 1`.

## Other definitions
- For `v : ℙ K V`, `v.submodule` gives the corresponding submodule of `V`.
- `projectivization.equiv_submodule` is the equivalence between `ℙ K V`
  and `{ H : submodule K V // finrank H = 1 }`.
- For `v : ℙ K V`, `v.rep : V` is a representative of `v`.

-/

variable (K V : Type _) [DivisionRing K] [AddCommGroup V] [Module K V]

/-- The setoid whose quotient is the projectivization of `V`. -/
def projectivizationSetoid : Setoid { v : V // v ≠ 0 } :=
  (MulAction.orbitRel Kˣ V).comap coe
#align projectivization_setoid projectivizationSetoid

/-- The projectivization of the `K`-vector space `V`.
The notation `ℙ K V` is preferred. -/
@[nolint has_nonempty_instance]
def Projectivization :=
  Quotient (projectivizationSetoid K V)
#align projectivization Projectivization

-- mathport name: exprℙ
notation "ℙ" => Projectivization

namespace Projectivization

variable {V}

/-- Construct an element of the projectivization from a nonzero vector. -/
def mk (v : V) (hv : v ≠ 0) : ℙ K V :=
  Quotient.mk'' ⟨v, hv⟩
#align projectivization.mk Projectivization.mk

/-- A variant of `projectivization.mk` in terms of a subtype. `mk` is preferred. -/
def mk' (v : { v : V // v ≠ 0 }) : ℙ K V :=
  Quotient.mk'' v
#align projectivization.mk' Projectivization.mk'

@[simp]
theorem mk'_eq_mk (v : { v : V // v ≠ 0 }) : mk' K v = mk K v v.2 :=
  by
  dsimp [mk, mk']
  congr 1
  simp
#align projectivization.mk'_eq_mk Projectivization.mk'_eq_mk

instance [Nontrivial V] : Nonempty (ℙ K V) :=
  let ⟨v, hv⟩ := exists_ne (0 : V)
  ⟨mk K v hv⟩

variable {K}

/-- Choose a representative of `v : projectivization K V` in `V`. -/
protected noncomputable def rep (v : ℙ K V) : V :=
  v.out'
#align projectivization.rep Projectivization.rep

theorem rep_nonzero (v : ℙ K V) : v.rep ≠ 0 :=
  v.out'.2
#align projectivization.rep_nonzero Projectivization.rep_nonzero

@[simp]
theorem mk_rep (v : ℙ K V) : mk K v.rep v.rep_nonzero = v :=
  by
  dsimp [mk, Projectivization.rep]
  simp
#align projectivization.mk_rep Projectivization.mk_rep

open FiniteDimensional

/-- Consider an element of the projectivization as a submodule of `V`. -/
protected def submodule (v : ℙ K V) : Submodule K V :=
  (Quotient.liftOn' v fun v => K ∙ (v : V)) <|
    by
    rintro ⟨a, ha⟩ ⟨b, hb⟩ ⟨x, rfl : x • b = a⟩
    exact Submodule.span_singleton_group_smul_eq _ x _
#align projectivization.submodule Projectivization.submodule

variable (K)

theorem mk_eq_mk_iff (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) :
    mk K v hv = mk K w hw ↔ ∃ a : Kˣ, a • w = v :=
  Quotient.eq''
#align projectivization.mk_eq_mk_iff Projectivization.mk_eq_mk_iff

/-- Two nonzero vectors go to the same point in projective space if and only if one is
a scalar multiple of the other. -/
theorem mk_eq_mk_iff' (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) :
    mk K v hv = mk K w hw ↔ ∃ a : K, a • w = v :=
  by
  rw [mk_eq_mk_iff K v w hv hw]
  constructor
  · rintro ⟨a, ha⟩
    exact ⟨a, ha⟩
  · rintro ⟨a, ha⟩
    refine' ⟨Units.mk0 a fun c => hv.symm _, ha⟩
    rwa [c, zero_smul] at ha
#align projectivization.mk_eq_mk_iff' Projectivization.mk_eq_mk_iff'

theorem exists_smul_eq_mk_rep (v : V) (hv : v ≠ 0) : ∃ a : Kˣ, a • v = (mk K v hv).rep :=
  show (projectivizationSetoid K V).Rel _ _ from Quotient.mk_out' ⟨v, hv⟩
#align projectivization.exists_smul_eq_mk_rep Projectivization.exists_smul_eq_mk_rep

variable {K}

/-- An induction principle for `projectivization`.
Use as `induction v using projectivization.ind`. -/
@[elab_as_elim]
theorem ind {P : ℙ K V → Prop} (h : ∀ (v : V) (h : v ≠ 0), P (mk K v h)) : ∀ p, P p :=
  Quotient.ind' <| Subtype.rec <| h
#align projectivization.ind Projectivization.ind

@[simp]
theorem submodule_mk (v : V) (hv : v ≠ 0) : (mk K v hv).Submodule = K ∙ v :=
  rfl
#align projectivization.submodule_mk Projectivization.submodule_mk

theorem submodule_eq (v : ℙ K V) : v.Submodule = K ∙ v.rep :=
  by
  conv_lhs => rw [← v.mk_rep]
  rfl
#align projectivization.submodule_eq Projectivization.submodule_eq

theorem finrank_submodule (v : ℙ K V) : finrank K v.Submodule = 1 :=
  by
  rw [submodule_eq]
  exact finrank_span_singleton v.rep_nonzero
#align projectivization.finrank_submodule Projectivization.finrank_submodule

instance (v : ℙ K V) : FiniteDimensional K v.Submodule :=
  by
  rw [← v.mk_rep]
  change FiniteDimensional K (K ∙ v.rep)
  infer_instance

theorem submodule_injective :
    Function.Injective (Projectivization.submodule : ℙ K V → Submodule K V) :=
  by
  intro u v h; replace h := le_of_eq h
  simp only [submodule_eq] at h
  rw [Submodule.le_span_singleton_iff] at h
  rw [← mk_rep v, ← mk_rep u]
  apply Quotient.sound'
  obtain ⟨a, ha⟩ := h u.rep (Submodule.mem_span_singleton_self _)
  have : a ≠ 0 := fun c => u.rep_nonzero (by simpa [c] using ha.symm)
  use Units.mk0 a this, ha
#align projectivization.submodule_injective Projectivization.submodule_injective

variable (K V)

/-- The equivalence between the projectivization and the
collection of subspaces of dimension 1. -/
noncomputable def equivSubmodule : ℙ K V ≃ { H : Submodule K V // finrank K H = 1 } :=
  Equiv.ofBijective (fun v => ⟨v.Submodule, v.finrank_submodule⟩)
    (by
      constructor
      · intro u v h
        apply_fun fun e => e.val  at h
        apply submodule_injective h
      · rintro ⟨H, h⟩
        rw [finrank_eq_one_iff'] at h
        obtain ⟨v, hv, h⟩ := h
        have : (v : V) ≠ 0 := fun c => hv (Subtype.coe_injective c)
        use mk K v this
        symm
        ext x
        revert x
        erw [← Set.ext_iff]
        ext x
        dsimp [-SetLike.mem_coe]
        rw [Submodule.span_singleton_eq_range]
        refine' ⟨fun hh => _, _⟩
        · obtain ⟨c, hc⟩ := h ⟨x, hh⟩
          exact ⟨c, congr_arg coe hc⟩
        · rintro ⟨c, rfl⟩
          refine' Submodule.smul_mem _ _ v.2)
#align projectivization.equiv_submodule Projectivization.equivSubmodule

variable {K V}

/-- Construct an element of the projectivization from a subspace of dimension 1. -/
noncomputable def mk'' (H : Submodule K V) (h : finrank K H = 1) : ℙ K V :=
  (equivSubmodule K V).symm ⟨H, h⟩
#align projectivization.mk'' Projectivization.mk''

@[simp]
theorem submodule_mk'' (H : Submodule K V) (h : finrank K H = 1) : (mk'' H h).Submodule = H :=
  by
  suffices (equiv_submodule K V) (mk'' H h) = ⟨H, h⟩ by exact congr_arg coe this
  dsimp [mk'']
  simp
#align projectivization.submodule_mk'' Projectivization.submodule_mk''

@[simp]
theorem mk''_submodule (v : ℙ K V) : mk'' v.Submodule v.finrank_submodule = v :=
  show (equivSubmodule K V).symm (equivSubmodule K V _) = _ by simp
#align projectivization.mk''_submodule Projectivization.mk''_submodule

section Map

variable {L W : Type _} [DivisionRing L] [AddCommGroup W] [Module L W]

/-- An injective semilinear map of vector spaces induces a map on projective spaces. -/
def map {σ : K →+* L} (f : V →ₛₗ[σ] W) (hf : Function.Injective f) : ℙ K V → ℙ L W :=
  Quotient.map' (fun v => ⟨f v, fun c => v.2 (hf (by simp [c]))⟩)
    (by
      rintro ⟨u, hu⟩ ⟨v, hv⟩ ⟨a, ha⟩
      use Units.map σ.to_monoid_hom a
      dsimp at ha⊢
      erw [← f.map_smulₛₗ, ha])
#align projectivization.map Projectivization.map

/-- Mapping with respect to a semilinear map over an isomorphism of fields yields
an injective map on projective spaces. -/
theorem map_injective {σ : K →+* L} {τ : L →+* K} [RingHomInvPair σ τ] (f : V →ₛₗ[σ] W)
    (hf : Function.Injective f) : Function.Injective (map f hf) :=
  by
  intro u v h
  rw [← u.mk_rep, ← v.mk_rep] at *
  apply Quotient.sound'
  dsimp [map, mk] at h
  simp only [Quotient.eq''] at h
  obtain ⟨a, ha⟩ := h
  use Units.map τ.to_monoid_hom a
  dsimp at ha⊢
  have : (a : L) = σ (τ a) := by rw [RingHomInvPair.comp_apply_eq₂]
  change (a : L) • f v.rep = f u.rep at ha
  rw [this, ← f.map_smulₛₗ] at ha
  exact hf ha
#align projectivization.map_injective Projectivization.map_injective

@[simp]
theorem map_id : map (LinearMap.id : V →ₗ[K] V) (LinearEquiv.refl K V).Injective = id :=
  by
  ext v
  induction v using Projectivization.ind
  rfl
#align projectivization.map_id Projectivization.map_id

@[simp]
theorem map_comp {F U : Type _} [Field F] [AddCommGroup U] [Module F U] {σ : K →+* L} {τ : L →+* F}
    {γ : K →+* F} [RingHomCompTriple σ τ γ] (f : V →ₛₗ[σ] W) (hf : Function.Injective f)
    (g : W →ₛₗ[τ] U) (hg : Function.Injective g) :
    map (g.comp f) (hg.comp hf) = map g hg ∘ map f hf :=
  by
  ext v
  induction v using Projectivization.ind
  rfl
#align projectivization.map_comp Projectivization.map_comp

end Map

end Projectivization


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import ring_theory.ideal.quotient
import ring_theory.principal_ideal_domain

/-!
# Invariant basis number property

We say that a ring `R` satisfies the invariant basis number property if there is a well-defined
notion of the rank of a finitely generated free (left) `R`-module. Since a finitely generated free
module with a basis consisting of `n` elements is linearly equivalent to `fin n → R`, it is
sufficient that `(fin n → R) ≃ₗ[R] (fin m → R)` implies `n = m`.

It is also useful to consider two stronger conditions, namely the rank condition,
that a surjective linear map `(fin n → R) →ₗ[R] (fin m → R)` implies `m ≤ n` and
the strong rank condition, that an injective linear map `(fin n → R) →ₗ[R] (fin m → R)`
implies `n ≤ m`.

The strong rank condition implies the rank condition, and the rank condition implies
the invariant basis number property.

## Main definitions

`strong_rank_condition R` is a type class stating that `R` satisfies the strong rank condition.
`rank_condition R` is a type class stating that `R` satisfies the rank condition.
`invariant_basis_number R` is a type class stating that `R` has the invariant basis number property.

## Main results

We show that every nontrivial left-noetherian ring satisfies the strong rank condition,
(and so in particular every division ring or field),
and then use this to show every nontrivial commutative ring has the invariant basis number property.

More generally, every commutative ring satisfies the strong rank condition. This is proved in
`linear_algebra/free_module/strong_rank_condition`. We keep
`invariant_basis_number_of_nontrivial_of_comm_ring` here since it imports fewer files.

## Future work

So far, there is no API at all for the `invariant_basis_number` class. There are several natural
ways to formulate that a module `M` is finitely generated and free, for example
`M ≃ₗ[R] (fin n → R)`, `M ≃ₗ[R] (ι → R)`, where `ι` is a fintype, or providing a basis indexed by
a finite type. There should be lemmas applying the invariant basis number property to each
situation.

The finite version of the invariant basis number property implies the infinite analogue, i.e., that
`(ι →₀ R) ≃ₗ[R] (ι' →₀ R)` implies that `cardinal.mk ι = cardinal.mk ι'`. This fact (and its
variants) should be formalized.

## References

* https://en.wikipedia.org/wiki/Invariant_basis_number
* https://mathoverflow.net/a/2574/

## Tags

free module, rank, invariant basis number, IBN

-/

noncomputable theory

open_locale classical big_operators
open function

universes u v w

section
variables (R : Type u) [ring R]

/-- We say that `R` satisfies the strong rank condition if `(fin n → R) →ₗ[R] (fin m → R)` injective
    implies `n ≤ m`. -/
@[mk_iff]
class strong_rank_condition : Prop :=
(le_of_fin_injective : ∀ {n m : ℕ} (f : (fin n → R) →ₗ[R] (fin m → R)), injective f → n ≤ m)

lemma le_of_fin_injective [strong_rank_condition R] {n m : ℕ} (f : (fin n → R) →ₗ[R] (fin m → R)) :
  injective f → n ≤ m :=
strong_rank_condition.le_of_fin_injective f

/-- A ring satisfies the strong rank condition if and only if, for all `n : ℕ`, any linear map
`(fin (n + 1) → R) →ₗ[R] (fin n → R)` is not injective. -/
lemma strong_rank_condition_iff_succ : strong_rank_condition R ↔
  ∀ (n : ℕ) (f : (fin (n + 1) → R) →ₗ[R] (fin n → R)), ¬function.injective f :=
begin
  refine ⟨λ h n, λ f hf, _, λ h, ⟨λ n m f hf, _⟩⟩,
  { letI : strong_rank_condition R := h,
    exact nat.not_succ_le_self n (le_of_fin_injective R f hf) },
  { by_contra H,
    exact h m (f.comp (function.extend_by_zero.linear_map R (fin.cast_le (not_le.1 H))))
      (hf.comp (function.extend_injective (rel_embedding.injective _) 0)) }
end

lemma card_le_of_injective [strong_rank_condition R] {α β : Type*} [fintype α] [fintype β]
  (f : (α → R) →ₗ[R] (β → R)) (i : injective f) : fintype.card α ≤ fintype.card β :=
begin
  let P := linear_equiv.fun_congr_left R R (fintype.equiv_fin α),
  let Q := linear_equiv.fun_congr_left R R (fintype.equiv_fin β),
  exact le_of_fin_injective R ((Q.symm.to_linear_map.comp f).comp P.to_linear_map)
    (((linear_equiv.symm Q).injective.comp i).comp (linear_equiv.injective P)),
end

lemma card_le_of_injective' [strong_rank_condition R] {α β : Type*} [fintype α] [fintype β]
  (f : (α →₀ R) →ₗ[R] (β →₀ R)) (i : injective f) : fintype.card α ≤ fintype.card β :=
begin
  let P := (finsupp.linear_equiv_fun_on_fintype R R β),
  let Q := (finsupp.linear_equiv_fun_on_fintype R R α).symm,
  exact card_le_of_injective R ((P.to_linear_map.comp f).comp Q.to_linear_map)
    ((P.injective.comp i).comp Q.injective)
end

/-- We say that `R` satisfies the rank condition if `(fin n → R) →ₗ[R] (fin m → R)` surjective
    implies `m ≤ n`. -/
class rank_condition : Prop :=
(le_of_fin_surjective : ∀ {n m : ℕ} (f : (fin n → R) →ₗ[R] (fin m → R)), surjective f → m ≤ n)

lemma le_of_fin_surjective [rank_condition R] {n m : ℕ} (f : (fin n → R) →ₗ[R] (fin m → R)) :
  surjective f → m ≤ n :=
rank_condition.le_of_fin_surjective f

lemma card_le_of_surjective [rank_condition R] {α β : Type*} [fintype α] [fintype β]
  (f : (α → R) →ₗ[R] (β → R)) (i : surjective f) : fintype.card β ≤ fintype.card α :=
begin
  let P := linear_equiv.fun_congr_left R R (fintype.equiv_fin α),
  let Q := linear_equiv.fun_congr_left R R (fintype.equiv_fin β),
  exact le_of_fin_surjective R ((Q.symm.to_linear_map.comp f).comp P.to_linear_map)
    (((linear_equiv.symm Q).surjective.comp i).comp (linear_equiv.surjective P)),
end

lemma card_le_of_surjective' [rank_condition R] {α β : Type*} [fintype α] [fintype β]
  (f : (α →₀ R) →ₗ[R] (β →₀ R)) (i : surjective f) : fintype.card β ≤ fintype.card α :=
begin
  let P := (finsupp.linear_equiv_fun_on_fintype R R β),
  let Q := (finsupp.linear_equiv_fun_on_fintype R R α).symm,
  exact card_le_of_surjective R ((P.to_linear_map.comp f).comp Q.to_linear_map)
    ((P.surjective.comp i).comp Q.surjective)
end

/--
By the universal property for free modules, any surjective map `(fin n → R) →ₗ[R] (fin m → R)`
has an injective splitting `(fin m → R) →ₗ[R] (fin n → R)`
from which the strong rank condition gives the necessary inequality for the rank condition.
-/
@[priority 100]
instance rank_condition_of_strong_rank_condition [strong_rank_condition R] : rank_condition R :=
{ le_of_fin_surjective := λ n m f s,
    le_of_fin_injective R _ (f.splitting_of_fun_on_fintype_surjective_injective s), }

/-- We say that `R` has the invariant basis number property if `(fin n → R) ≃ₗ[R] (fin m → R)`
    implies `n = m`. This gives rise to a well-defined notion of rank of a finitely generated free
    module. -/
class invariant_basis_number : Prop :=
(eq_of_fin_equiv : ∀ {n m : ℕ}, ((fin n → R) ≃ₗ[R] (fin m → R)) → n = m)

@[priority 100]
instance invariant_basis_number_of_rank_condition [rank_condition R] : invariant_basis_number R :=
{ eq_of_fin_equiv := λ n m e, le_antisymm
    (le_of_fin_surjective R e.symm.to_linear_map e.symm.surjective)
    (le_of_fin_surjective R e.to_linear_map e.surjective) }

end

section
variables (R : Type u) [ring R] [invariant_basis_number R]

lemma eq_of_fin_equiv {n m : ℕ} : ((fin n → R) ≃ₗ[R] (fin m → R)) → n = m :=
invariant_basis_number.eq_of_fin_equiv

lemma card_eq_of_lequiv {α β : Type*} [fintype α] [fintype β]
  (f : (α → R) ≃ₗ[R] (β → R)) : fintype.card α = fintype.card β :=
eq_of_fin_equiv R (((linear_equiv.fun_congr_left R R (fintype.equiv_fin α)).trans f) ≪≫ₗ
  ((linear_equiv.fun_congr_left R R (fintype.equiv_fin β)).symm))

lemma nontrivial_of_invariant_basis_number : nontrivial R :=
begin
  by_contra h,
  refine zero_ne_one (eq_of_fin_equiv R _),
  haveI := not_nontrivial_iff_subsingleton.1 h,
  haveI : subsingleton (fin 1 → R) := ⟨λ a b, funext $ λ x, subsingleton.elim _ _⟩,
  refine { .. }; { intros, exact 0 } <|> tidy
end

end

section
variables (R : Type u) [ring R] [nontrivial R] [is_noetherian_ring R]

/--
Any nontrivial noetherian ring satisfies the strong rank condition.

An injective map `((fin n ⊕ fin (1 + m)) → R) →ₗ[R] (fin n → R)` for some left-noetherian `R`
would force `fin (1 + m) → R ≃ₗ punit` (via `is_noetherian.equiv_punit_of_prod_injective`),
which is not the case!
-/
-- Note this includes fields,
-- and we use this below to show any commutative ring has invariant basis number.
@[priority 100]
instance noetherian_ring_strong_rank_condition : strong_rank_condition R :=
begin
  fsplit,
  intros m n f i,
  by_contradiction h,
  rw [not_le, ←nat.add_one_le_iff, le_iff_exists_add] at h,
  obtain ⟨m, rfl⟩ := h,
  let e : fin (n + 1 + m) ≃ fin n ⊕ fin (1 + m) :=
    (fin_congr (add_assoc _ _ _)).trans fin_sum_fin_equiv.symm,
  let f' := f.comp ((linear_equiv.sum_arrow_lequiv_prod_arrow _ _ R R).symm.trans
    (linear_equiv.fun_congr_left R R e)).to_linear_map,
  have i' : injective f' := i.comp (linear_equiv.injective _),
  apply @zero_ne_one (fin (1 + m) → R) _ _,
  apply (is_noetherian.equiv_punit_of_prod_injective f' i').injective,
  ext,
end

end

/-!
  We want to show that nontrivial commutative rings have invariant basis number. The idea is to
  take a maximal ideal `I` of `R` and use an isomorphism `R^n ≃ R^m` of `R` modules to produce an
  isomorphism `(R/I)^n ≃ (R/I)^m` of `R/I`-modules, which will imply `n = m` since `R/I` is a field
  and we know that fields have invariant basis number.

  We construct the isomorphism in two steps:
  1. We construct the ring `R^n/I^n`, show that it is an `R/I`-module and show that there is an
     isomorphism of `R/I`-modules `R^n/I^n ≃ (R/I)^n`. This isomorphism is called
    `ideal.pi_quot_equiv` and is located in the file `ring_theory/ideals.lean`.
  2. We construct an isomorphism of `R/I`-modules `R^n/I^n ≃ R^m/I^m` using the isomorphism
     `R^n ≃ R^m`.
-/

section
variables {R : Type u} [comm_ring R] (I : ideal R) {ι : Type v} [fintype ι] {ι' : Type w}

/-- An `R`-linear map `R^n → R^m` induces a function `R^n/I^n → R^m/I^m`. -/
private def induced_map (I : ideal R) (e : (ι → R) →ₗ[R] (ι' → R)) :
  (ι → R) ⧸ (I.pi ι) → (ι' → R) ⧸ I.pi ι' :=
λ x, quotient.lift_on' x (λ y, ideal.quotient.mk _ (e y))
begin
  refine λ a b hab, ideal.quotient.eq.2 (λ h, _),
  rw ←linear_map.map_sub,
  exact ideal.map_pi _ _ hab e h,
end

/-- An isomorphism of `R`-modules `R^n ≃ R^m` induces an isomorphism of `R/I`-modules
    `R^n/I^n ≃ R^m/I^m`. -/
private def induced_equiv [fintype ι'] (I : ideal R) (e : (ι → R) ≃ₗ[R] (ι' → R)) :
  ((ι → R) ⧸ I.pi ι) ≃ₗ[R ⧸ I] (ι' → R) ⧸ I.pi ι' :=
begin
  refine { to_fun := induced_map I e, inv_fun := induced_map I e.symm, .. },
  all_goals { rintro ⟨a⟩ ⟨b⟩ <|> rintro ⟨a⟩,
    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
    congr, simp }
end

end

section
local attribute [instance] ideal.quotient.field

-- TODO: in fact, any nontrivial commutative ring satisfies the strong rank condition.
-- To see this, consider `f : (fin m → R) →ₗ[R] (fin n → R)`,
-- and consider the subring `A` of `R` generated by the matrix entries.
-- That subring is noetherian, and `f` induces a new linear map `f' : (fin m → A) →ₗ[R] (fin n → A)`
-- which is injective if `f` is.
-- Since we've already established the strong rank condition for noetherian rings,
-- this gives the result.

/-- Nontrivial commutative rings have the invariant basis number property. -/
@[priority 100]
instance invariant_basis_number_of_nontrivial_of_comm_ring {R : Type u} [comm_ring R]
  [nontrivial R] : invariant_basis_number R :=
⟨λ n m e, let ⟨I, hI⟩ := ideal.exists_maximal R in
  by exactI eq_of_fin_equiv (R ⧸ I)
    ((ideal.pi_quot_equiv _ _).symm ≪≫ₗ ((induced_equiv _ e) ≪≫ₗ (ideal.pi_quot_equiv _ _)))⟩

end


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import ring_theory.local_properties
import ring_theory.localization.inv_submonoid

/-!

# The meta properties of finite-type ring homomorphisms.

The main result is `ring_hom.finite_is_local`.

-/

namespace ring_hom

open_locale pointwise

lemma finite_type_holds_for_localization_away :
  holds_for_localization_away @finite_type :=
begin
  introv R _,
  resetI,
  suffices : algebra.finite_type R S,
  { change algebra.finite_type _ _, convert this, ext, rw algebra.smul_def, refl },
  exact is_localization.finite_type_of_monoid_fg (submonoid.powers r) S,
end

lemma finite_type_of_localization_span_target : of_localization_span_target @finite_type :=
begin
  -- Setup algebra intances.
  rw of_localization_span_target_iff_finite,
  introv R hs H,
  resetI,
  classical,
  letI := f.to_algebra,
  replace H : ∀ r : s, algebra.finite_type R (localization.away (r : S)),
  { intro r, convert H r, ext, rw algebra.smul_def, refl },
  replace H := λ r, (H r).1,
  constructor,
  -- Suppose `s : finset S` spans `S`, and each `Sᵣ` is finitely generated as an `R`-algebra.
  -- Say `t r : finset Sᵣ` generates `Sᵣ`. By assumption, we may find `lᵢ` such that
  -- `∑ lᵢ * sᵢ = 1`. I claim that all `s` and `l` and the numerators of `t` and generates `S`.
  choose t ht using H,
  obtain ⟨l, hl⟩ := (finsupp.mem_span_iff_total S (s : set S) 1).mp
    (show (1 : S) ∈ ideal.span (s : set S), by { rw hs, trivial }),
  let sf := λ (x : s), is_localization.finset_integer_multiple (submonoid.powers (x : S)) (t x),
  use s.attach.bUnion sf ∪ s ∪ l.support.image l,
  rw eq_top_iff,
  -- We need to show that every `x` falls in the subalgebra generated by those elements.
  -- Since all `s` and `l` are in the subalgebra, it suffices to check that `sᵢ ^ nᵢ • x` falls in
  -- the algebra for each `sᵢ` and some `nᵢ`.
  rintro x -,
  apply subalgebra.mem_of_span_eq_top_of_smul_pow_mem _ (s : set S) l hl _ _ x _,
  { intros x hx,
    apply algebra.subset_adjoin,
    rw [finset.coe_union, finset.coe_union],
    exact or.inl (or.inr hx) },
  { intros i,
    by_cases h : l i = 0, { rw h, exact zero_mem _ },
    apply algebra.subset_adjoin,
    rw [finset.coe_union, finset.coe_image],
    exact or.inr (set.mem_image_of_mem _ (finsupp.mem_support_iff.mpr h)) },
  { intro r,
    rw [finset.coe_union, finset.coe_union, finset.coe_bUnion],
    -- Since all `sᵢ` and numerators of `t r` are in the algebra, it suffices to show that the
    -- image of `x` in `Sᵣ` falls in the `R`-adjoin of `t r`, which is of course true.
    obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.exists_smul_mem_of_mem_adjoin
      (submonoid.powers (r : S)) x (t r)
      (algebra.adjoin R _) _ _ _,
    { exact ⟨n₂, hn₂⟩ },
    { intros x hx,
      apply algebra.subset_adjoin,
      refine or.inl (or.inl ⟨_, ⟨r, rfl⟩, _, ⟨s.mem_attach r, rfl⟩, hx⟩) },
    { rw [submonoid.powers_eq_closure, submonoid.closure_le, set.singleton_subset_iff],
      apply algebra.subset_adjoin,
      exact or.inl (or.inr r.2) },
    { rw ht, trivial } }
end

lemma finite_type_is_local :
  property_is_local @finite_type :=
⟨localization_finite_type, finite_type_of_localization_span_target,
  finite_type_stable_under_composition, finite_type_holds_for_localization_away⟩

lemma finite_type_respects_iso : ring_hom.respects_iso @ring_hom.finite_type :=
ring_hom.finite_type_is_local.respects_iso

end ring_hom


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import linear_algebra.finsupp
import linear_algebra.direct_sum.tensor_product
import data.finsupp.to_dfinsupp

/-!
# Results on direct sums and finitely supported functions.

1. The linear equivalence between finitely supported functions `ι →₀ M` and
the direct sum of copies of `M` indexed by `ι`.

2. The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N).
-/

universes u v w

noncomputable theory
open_locale direct_sum

open set linear_map submodule
variables {R : Type u} {M : Type v} {N : Type w} [ring R] [add_comm_group M] [module R M]
  [add_comm_group N] [module R N]

section finsupp_lequiv_direct_sum

variables (R M) (ι : Type*) [decidable_eq ι]

/-- The finitely supported functions `ι →₀ M` are in linear equivalence with the direct sum of
copies of M indexed by ι. -/
def finsupp_lequiv_direct_sum : (ι →₀ M) ≃ₗ[R] ⨁ i : ι, M :=
by haveI : Π m : M, decidable (m ≠ 0) := classical.dec_pred _; exact finsupp_lequiv_dfinsupp R

@[simp] theorem finsupp_lequiv_direct_sum_single (i : ι) (m : M) :
  finsupp_lequiv_direct_sum R M ι (finsupp.single i m) = direct_sum.lof R ι _ i m :=
finsupp.to_dfinsupp_single i m

@[simp] theorem finsupp_lequiv_direct_sum_symm_lof (i : ι) (m : M) :
  (finsupp_lequiv_direct_sum R M ι).symm (direct_sum.lof R ι _ i m) = finsupp.single i m :=
begin
  letI : Π m : M, decidable (m ≠ 0) := classical.dec_pred _,
  exact (dfinsupp.to_finsupp_single i m),
end

end finsupp_lequiv_direct_sum

section tensor_product

open tensor_product
open_locale tensor_product classical

/-- The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N). -/
def finsupp_tensor_finsupp (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N] :
  (ι →₀ M) ⊗[R] (κ →₀ N) ≃ₗ[R] (ι × κ) →₀ (M ⊗[R] N) :=
linear_equiv.trans
  (tensor_product.congr (finsupp_lequiv_direct_sum R M ι) (finsupp_lequiv_direct_sum R N κ)) $
linear_equiv.trans
  (tensor_product.direct_sum R ι κ (λ _, M) (λ _, N))
  (finsupp_lequiv_direct_sum R (M ⊗[R] N) (ι × κ)).symm

@[simp] theorem finsupp_tensor_finsupp_single (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
  (i : ι) (m : M) (k : κ) (n : N) :
  finsupp_tensor_finsupp R M N ι κ (finsupp.single i m ⊗ₜ finsupp.single k n) =
  finsupp.single (i, k) (m ⊗ₜ n) :=
by simp [finsupp_tensor_finsupp]

@[simp] theorem finsupp_tensor_finsupp_apply (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
  (f : ι →₀ M) (g : κ →₀ N) (i : ι) (k : κ) :
  finsupp_tensor_finsupp R M N ι κ (f ⊗ₜ g) (i, k) = f i ⊗ₜ g k :=
begin
  apply finsupp.induction_linear f,
  { simp, },
  { intros f₁ f₂ hf₁ hf₂, simp [add_tmul, hf₁, hf₂], },
  { intros i' m,
    apply finsupp.induction_linear g,
    { simp, },
    { intros g₁ g₂ hg₁ hg₂, simp [tmul_add, hg₁, hg₂], },
    { intros k' n,
      simp only [finsupp_tensor_finsupp_single],
      simp only [finsupp.single, finsupp.coe_mk],
      split_ifs; finish, } }
end

@[simp] theorem finsupp_tensor_finsupp_symm_single (R M N ι κ : Sort*) [comm_ring R]
  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
  (i : ι × κ) (m : M) (n : N) :
  (finsupp_tensor_finsupp R M N ι κ).symm (finsupp.single i (m ⊗ₜ n)) =
  (finsupp.single i.1 m ⊗ₜ finsupp.single i.2 n) :=
prod.cases_on i $ λ i k, (linear_equiv.symm_apply_eq _).2
  (finsupp_tensor_finsupp_single _ _ _ _ _ _ _ _ _).symm

variables (S : Type*) [comm_ring S] (α β : Type*)

/--
A variant of `finsupp_tensor_finsupp` where both modules are the ground ring.
-/
def finsupp_tensor_finsupp' : ((α →₀ S) ⊗[S] (β →₀ S)) ≃ₗ[S] (α × β →₀ S) :=
(finsupp_tensor_finsupp S S S α β).trans (finsupp.lcongr (equiv.refl _) (tensor_product.lid S S))

@[simp] lemma finsupp_tensor_finsupp'_apply_apply (f : α →₀ S) (g : β →₀ S) (a : α) (b : β) :
  finsupp_tensor_finsupp' S α β (f ⊗ₜ[S] g) (a, b) = f a * g b :=
by simp [finsupp_tensor_finsupp']

@[simp] lemma finsupp_tensor_finsupp'_single_tmul_single (a : α) (b : β) (r₁ r₂ : S) :
  finsupp_tensor_finsupp' S α β (finsupp.single a r₁ ⊗ₜ[S] finsupp.single b r₂) =
    finsupp.single (a, b) (r₁ * r₂) :=
by { ext ⟨a', b'⟩, simp [finsupp.single], split_ifs; finish }

end tensor_product


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.submodule
import algebra.lie.of_associative

/-!
# Quotients of Lie algebras and Lie modules

Given a Lie submodule of a Lie module, the quotient carries a natural Lie module structure. In the
special case that the Lie module is the Lie algebra itself via the adjoint action, the submodule
is a Lie ideal and the quotient carries a natural Lie algebra structure.

We define these quotient structures here. A notable omission at the time of writing (February 2021)
is a statement and proof of the universal property of these quotients.

## Main definitions

  * `lie_submodule.quotient.lie_quotient_lie_module`
  * `lie_submodule.quotient.lie_quotient_lie_algebra`

## Tags

lie algebra, quotient
-/

universes u v w w₁ w₂

namespace lie_submodule

variables {R : Type u} {L : Type v} {M : Type w}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]
variables (N N' : lie_submodule R L M) (I J : lie_ideal R L)

/-- The quotient of a Lie module by a Lie submodule. It is a Lie module. -/
instance : has_quotient M (lie_submodule R L M) :=
⟨λ N, M ⧸ N.to_submodule⟩

namespace quotient

variables {N I}

instance add_comm_group : add_comm_group (M ⧸ N) := submodule.quotient.add_comm_group _
instance module : module R (M ⧸ N) := submodule.quotient.module _
instance inhabited : inhabited (M ⧸ N) := ⟨0⟩

/-- Map sending an element of `M` to the corresponding element of `M/N`, when `N` is a
lie_submodule of the lie_module `N`. -/
abbreviation mk : M → M ⧸ N := submodule.quotient.mk

lemma is_quotient_mk (m : M) :
  quotient.mk' m = (mk m : M ⧸ N) := rfl

/-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there
is a natural linear map from `L` to the endomorphisms of `M` leaving `N` invariant. -/
def lie_submodule_invariant : L →ₗ[R] submodule.compatible_maps N.to_submodule N.to_submodule :=
  linear_map.cod_restrict _ (lie_module.to_endomorphism R L M) N.lie_mem

variables (N)

/-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there
is a natural Lie algebra morphism from `L` to the linear endomorphism of the quotient `M/N`. -/
def action_as_endo_map : L →ₗ⁅R⁆ module.End R (M ⧸ N) :=
{ map_lie' := λ x y, by { ext m,
                          change mk ⁅⁅x, y⁆, m⁆ = mk (⁅x, ⁅y, m⁆⁆ - ⁅y, ⁅x, m⁆⁆),
                          congr, apply lie_lie, },
  ..linear_map.comp (submodule.mapq_linear (N : submodule R M) ↑N) lie_submodule_invariant }

/-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there is
a natural bracket action of `L` on the quotient `M/N`. -/
def action_as_endo_map_bracket : has_bracket L (M ⧸ N) := ⟨λ x n, action_as_endo_map N x n⟩

instance lie_quotient_lie_ring_module : lie_ring_module L (M ⧸ N) :=
{ bracket     := λ x n, (action_as_endo_map N : L →ₗ[R] module.End R (M ⧸ N)) x n,
  add_lie     := λ x y n, by { simp only [linear_map.map_add, linear_map.add_apply], },
  lie_add     := λ x m n, by { simp only [linear_map.map_add, linear_map.add_apply], },
  leibniz_lie := λ x y m, show action_as_endo_map _ _ _ = _,
  { simp only [lie_hom.map_lie, lie_ring.of_associative_ring_bracket, sub_add_cancel,
      lie_hom.coe_to_linear_map, linear_map.mul_apply, linear_map.sub_apply], } }

/-- The quotient of a Lie module by a Lie submodule, is a Lie module. -/
instance lie_quotient_lie_module : lie_module R L (M ⧸ N) :=
{ smul_lie := λ t x m, show (_ : L →ₗ[R] module.End R (M ⧸ N)) _ _ = _,
  { simp only [linear_map.map_smul], refl, },
  lie_smul := λ x t m, show (_ : L →ₗ[R] module.End R (M ⧸ N)) _ _ = _,
  { simp only [linear_map.map_smul], refl, }, }

instance lie_quotient_has_bracket : has_bracket (L ⧸ I) (L ⧸ I) :=
⟨begin
  intros x y,
  apply quotient.lift_on₂' x y (λ x' y', mk ⁅x', y'⁆),
  intros x₁ x₂ y₁ y₂ h₁ h₂,
  apply (submodule.quotient.eq I.to_submodule).2,
  have h : ⁅x₁, x₂⁆ - ⁅y₁, y₂⁆ = ⁅x₁, x₂ - y₂⁆ + ⁅x₁ - y₁, y₂⁆,
    by simp [-lie_skew, sub_eq_add_neg, add_assoc],
  rw h,
  apply submodule.add_mem,
  { apply lie_mem_right R L I x₁ (x₂ - y₂) h₂, },
  { apply lie_mem_left R L I (x₁ - y₁) y₂ h₁, },
end⟩

@[simp] lemma mk_bracket (x y : L) :
  mk ⁅x, y⁆ = ⁅(mk x : L ⧸ I), (mk y : L ⧸ I)⁆ := rfl

instance lie_quotient_lie_ring : lie_ring (L ⧸ I) :=
{ add_lie  := by { intros x' y' z', apply quotient.induction_on₃' x' y' z', intros x y z,
                   repeat { rw is_quotient_mk <|>
                            rw ←mk_bracket <|>
                            rw ←submodule.quotient.mk_add, },
                   apply congr_arg, apply add_lie, },
  lie_add  := by { intros x' y' z', apply quotient.induction_on₃' x' y' z', intros x y z,
                   repeat { rw is_quotient_mk <|>
                            rw ←mk_bracket <|>
                            rw ←submodule.quotient.mk_add, },
                   apply congr_arg, apply lie_add, },
  lie_self := by { intros x', apply quotient.induction_on' x', intros x,
                   rw [is_quotient_mk, ←mk_bracket],
                   apply congr_arg, apply lie_self, },
  leibniz_lie := by { intros x' y' z', apply quotient.induction_on₃' x' y' z', intros x y z,
                   repeat { rw is_quotient_mk <|>
                            rw ←mk_bracket <|>
                            rw ←submodule.quotient.mk_add, },
                   apply congr_arg, apply leibniz_lie, } }

instance lie_quotient_lie_algebra : lie_algebra R (L ⧸ I) :=
{ lie_smul := by { intros t x' y', apply quotient.induction_on₂' x' y', intros x y,
                   repeat { rw is_quotient_mk <|>
                            rw ←mk_bracket <|>
                            rw ←submodule.quotient.mk_smul, },
                   apply congr_arg, apply lie_smul, } }

/-- `lie_submodule.quotient.mk` as a `lie_module_hom`. -/
@[simps]
def mk' : M →ₗ⁅R,L⁆ M ⧸ N :=
{ to_fun := mk, map_lie' := λ r m, rfl, ..N.to_submodule.mkq}

/-- Two `lie_module_hom`s from a quotient lie module are equal if their compositions with
`lie_submodule.quotient.mk'` are equal.

See note [partially-applied ext lemmas]. -/
@[ext]
lemma lie_module_hom_ext ⦃f g : M ⧸ N →ₗ⁅R,L⁆ M⦄ (h : f.comp (mk' N) = g.comp (mk' N)) :
  f = g :=
lie_module_hom.ext $ λ x, quotient.induction_on' x $ lie_module_hom.congr_fun h

end quotient

end lie_submodule


/-
Copyright (c) 2020 Pim Spelier, Daan van Gent. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pim Spelier, Daan van Gent.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.data.num.lemmas
import Mathlib.tactic.derive_fintype
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# Encodings

This file contains the definition of a (finite) encoding, a map from a type to
strings in an alphabet, used in defining computability by Turing machines.
It also contains several examples:

## Examples

- `fin_encoding_nat_bool`   : a binary encoding of ℕ in a simple alphabet.
- `fin_encoding_nat_Γ'`    : a binary encoding of ℕ in the alphabet used for TM's.
- `unary_fin_encoding_nat` : a unary encoding of ℕ
- `fin_encoding_bool_bool`  : an encoding of bool.
-/

namespace computability

/-- An encoding of a type in a certain alphabet, together with a decoding. -/
structure encoding (α : Type)
where
  Γ : Type
  encode : α → List Γ
  decode : List Γ → Option α
  decode_encode : ∀ (x : α), decode (encode x) = some x

/-- An encoding plus a guarantee of finiteness of the alphabet. -/
structure fin_encoding (α : Type)
extends encoding α
where
  Γ_fin : fintype (encoding.Γ _to_encoding)

/-- A standard Turing machine alphabet, consisting of blank,bit0,bit1,bra,ket,comma. -/
inductive Γ'
where
| blank : Γ'
| bit : Bool → Γ'
| bra : Γ'
| ket : Γ'
| comma : Γ'

protected instance inhabited_Γ' : Inhabited Γ' :=
  { default := Γ'.blank }

/-- The natural inclusion of bool in Γ'. -/
def inclusion_bool_Γ' : Bool → Γ' :=
  Γ'.bit

/-- An arbitrary section of the natural inclusion of bool in Γ'. -/
def section_Γ'_bool : Γ' → Bool :=
  sorry

theorem left_inverse_section_inclusion : function.left_inverse section_Γ'_bool inclusion_bool_Γ' :=
  fun (x : Bool) => bool.cases_on x rfl rfl

theorem inclusion_bool_Γ'_injective : function.injective inclusion_bool_Γ' :=
  function.has_left_inverse.injective (Exists.intro section_Γ'_bool left_inverse_section_inclusion)

/-- An encoding function of the positive binary numbers in bool. -/
def encode_pos_num : pos_num → List Bool :=
  sorry

/-- An encoding function of the binary numbers in bool. -/
def encode_num : num → List Bool :=
  sorry

/-- An encoding function of ℕ in bool. -/
def encode_nat (n : ℕ) : List Bool :=
  encode_num ↑n

/-- A decoding function from `list bool` to the positive binary numbers. -/
def decode_pos_num : List Bool → pos_num :=
  sorry

/-- A decoding function from `list bool` to the binary numbers. -/
def decode_num : List Bool → num :=
  fun (l : List Bool) => ite (l = []) num.zero ↑(decode_pos_num l)

/-- A decoding function from `list bool` to ℕ. -/
def decode_nat : List Bool → ℕ :=
  fun (l : List Bool) => ↑(decode_num l)

theorem encode_pos_num_nonempty (n : pos_num) : encode_pos_num n ≠ [] :=
  pos_num.cases_on n (list.cons_ne_nil tt []) (fun (m : pos_num) => list.cons_ne_nil tt (encode_pos_num m))
    fun (m : pos_num) => list.cons_ne_nil false (encode_pos_num m)

theorem decode_encode_pos_num (n : pos_num) : decode_pos_num (encode_pos_num n) = n := sorry

theorem decode_encode_num (n : num) : decode_num (encode_num n) = n := sorry

theorem decode_encode_nat (n : ℕ) : decode_nat (encode_nat n) = n := sorry

/-- A binary encoding of ℕ in bool. -/
def encoding_nat_bool : encoding ℕ :=
  encoding.mk Bool encode_nat (fun (n : List Bool) => some (decode_nat n)) sorry

/-- A binary fin_encoding of ℕ in bool. -/
def fin_encoding_nat_bool : fin_encoding ℕ :=
  fin_encoding.mk encoding_nat_bool bool.fintype

/-- A binary encoding of ℕ in Γ'. -/
def encoding_nat_Γ' : encoding ℕ :=
  encoding.mk Γ' (fun (x : ℕ) => list.map inclusion_bool_Γ' (encode_nat x))
    (fun (x : List Γ') => some (decode_nat (list.map section_Γ'_bool x))) sorry

/-- A binary fin_encoding of ℕ in Γ'. -/
def fin_encoding_nat_Γ' : fin_encoding ℕ :=
  fin_encoding.mk encoding_nat_Γ' Γ'.fintype

/-- A unary encoding function of ℕ in bool. -/
def unary_encode_nat : ℕ → List Bool :=
  sorry

/-- A unary decoding function from `list bool` to ℕ. -/
def unary_decode_nat : List Bool → ℕ :=
  list.length

theorem unary_decode_encode_nat (n : ℕ) : unary_decode_nat (unary_encode_nat n) = n :=
  Nat.rec rfl (fun (m : ℕ) (hm : unary_decode_nat (unary_encode_nat m) = m) => Eq.symm (congr_arg Nat.succ (Eq.symm hm)))
    n

/-- A unary fin_encoding of ℕ. -/
def unary_fin_encoding_nat : fin_encoding ℕ :=
  fin_encoding.mk (encoding.mk Bool unary_encode_nat (fun (n : List Bool) => some (unary_decode_nat n)) sorry)
    bool.fintype

/-- An encoding function of bool in bool. -/
def encode_bool : Bool → List Bool :=
  list.ret

/-- A decoding function from `list bool` to bool. -/
def decode_bool : List Bool → Bool :=
  sorry

theorem decode_encode_bool (b : Bool) : decode_bool (encode_bool b) = b :=
  bool.cases_on b rfl rfl

/-- A fin_encoding of bool in bool. -/
def fin_encoding_bool_bool : fin_encoding Bool :=
  fin_encoding.mk (encoding.mk Bool encode_bool (fun (x : List Bool) => some (decode_bool x)) sorry) bool.fintype

protected instance inhabited_fin_encoding : Inhabited (fin_encoding Bool) :=
  { default := fin_encoding_bool_bool }

protected instance inhabited_encoding : Inhabited (encoding Bool) :=
  { default := fin_encoding.to_encoding fin_encoding_bool_bool }


/-
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 Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.order
import Mathlib.linear_algebra.direct_sum_module
import Mathlib.ring_theory.free_comm_ring
import Mathlib.ring_theory.ideal.operations
import Mathlib.PostPort

universes v w l u u₁

namespace Mathlib

/-!
# 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".

-/

/-- A directed system is a functor from the category (directed poset) to another category.
This is used for abelian groups and rings and fields because their maps are not bundled.
See module.directed_system -/
class directed_system {ι : Type v} [directed_order ι] (G : ι → Type w) (f : (i j : ι) → i ≤ j → G i → G j)
where
  map_self : ∀ (i : ι) (x : G i) (h : i ≤ i), f i i h x = x
  map_map : ∀ (i j k : ι) (hij : i ≤ j) (hjk : j ≤ k) (x : G i), f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x

namespace module

/-- A directed system is a functor from the category (directed poset) to the category of
`R`-modules. -/
class directed_system {R : Type u} [ring R] {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j))
where
  map_self : ∀ (i : ι) (x : G i) (h : i ≤ i), coe_fn (f i i h) x = x
  map_map : ∀ (i j k : ι) (hij : i ≤ j) (hjk : j ≤ k) (x : G i),
  coe_fn (f j k hjk) (coe_fn (f i j hij) x) = coe_fn (f i k (le_trans hij hjk)) x

/-- The direct limit of a directed system is the modules glued together along the maps. -/
def direct_limit {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) :=
  submodule.quotient
    (submodule.span R
      (set_of
        fun (a : direct_sum ι fun (i : ι) => G i) =>
          ∃ (i : ι),
            ∃ (j : ι),
              ∃ (H : i ≤ j),
                ∃ (x : G i),
                  coe_fn (direct_sum.lof R ι G i) x - coe_fn (direct_sum.lof R ι G j) (coe_fn (f i j H) x) = a))

namespace direct_limit

protected instance add_comm_group {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) : add_comm_group (direct_limit G f) :=
  submodule.quotient.add_comm_group
    (submodule.span R
      (set_of
        fun (a : direct_sum ι fun (i : ι) => G i) =>
          ∃ (i : ι),
            ∃ (j : ι),
              ∃ (H : i ≤ j),
                ∃ (x : G i),
                  coe_fn (direct_sum.lof R ι G i) x - coe_fn (direct_sum.lof R ι G j) (coe_fn (f i j H) x) = a))

protected instance semimodule {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) : semimodule R (direct_limit G f) :=
  submodule.quotient.semimodule
    (submodule.span R
      (set_of
        fun (a : direct_sum ι fun (i : ι) => G i) =>
          ∃ (i : ι),
            ∃ (j : ι),
              ∃ (H : i ≤ j),
                ∃ (x : G i),
                  coe_fn (direct_sum.lof R ι G i) x - coe_fn (direct_sum.lof R ι G j) (coe_fn (f i j H) x) = a))

protected instance inhabited {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) : Inhabited (direct_limit G f) :=
  { default := 0 }

/-- The canonical map from a component to the direct limit. -/
def of (R : Type u) [ring R] (ι : Type v) [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) (i : ι) : linear_map R (G i) (direct_limit G f) :=
  linear_map.comp
    (submodule.mkq
      (submodule.span R
        (set_of
          fun (a : direct_sum ι fun (i : ι) => G i) =>
            ∃ (i : ι),
              ∃ (j : ι),
                ∃ (H : i ≤ j),
                  ∃ (x : G i),
                    coe_fn (direct_sum.lof R ι G i) x - coe_fn (direct_sum.lof R ι G j) (coe_fn (f i j H) x) = a)))
    (direct_sum.lof R ι G i)

@[simp] theorem of_f {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} {i : ι} {j : ι} {hij : i ≤ j} {x : G i} : coe_fn (of R ι G f j) (coe_fn (f i j hij) x) = coe_fn (of R ι G f i) x := sorry

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/
theorem exists_of {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} [Nonempty ι] (z : direct_limit G f) : ∃ (i : ι), ∃ (x : G i), coe_fn (of R ι G f i) x = z := sorry

protected theorem induction_on {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} [Nonempty ι] {C : direct_limit G f → Prop} (z : direct_limit G f) (ih : ∀ (i : ι) (x : G i), C (coe_fn (of R ι G f i) x)) : C z := sorry

/-- 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 (R : Type u) [ring R] (ι : Type v) [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) {P : Type u₁} [add_comm_group P] [module R P] (g : (i : ι) → linear_map R (G i) P) (Hg : ∀ (i j : ι) (hij : i ≤ j) (x : G i), coe_fn (g j) (coe_fn (f i j hij) x) = coe_fn (g i) x) : linear_map R (direct_limit G f) P :=
  submodule.liftq
    (submodule.span R
      (set_of
        fun (a : direct_sum ι fun (i : ι) => G i) =>
          ∃ (i : ι),
            ∃ (j : ι),
              ∃ (H : i ≤ j),
                ∃ (x : G i),
                  coe_fn (direct_sum.lof R ι G i) x - coe_fn (direct_sum.lof R ι G j) (coe_fn (f i j H) x) = a))
    (direct_sum.to_module R ι P g) sorry

theorem lift_of {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} {P : Type u₁} [add_comm_group P] [module R P] (g : (i : ι) → linear_map R (G i) P) (Hg : ∀ (i j : ι) (hij : i ≤ j) (x : G i), coe_fn (g j) (coe_fn (f i j hij) x) = coe_fn (g i) x) {i : ι} (x : G i) : coe_fn (lift R ι G f g Hg) (coe_fn (of R ι G f i) x) = coe_fn (g i) x :=
  direct_sum.to_module_lof R i x

theorem lift_unique {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} {P : Type u₁} [add_comm_group P] [module R P] [Nonempty ι] (F : linear_map R (direct_limit G f) P) (x : direct_limit G f) : coe_fn F x =
  coe_fn
    (lift R ι G f (fun (i : ι) => linear_map.comp F (of R ι G f i))
      fun (i j : ι) (hij : i ≤ j) (x : G i) =>
        eq.mpr
          (id
            (Eq._oldrec
              (Eq.refl
                (coe_fn ((fun (i : ι) => linear_map.comp F (of R ι G f i)) j) (coe_fn (f i j hij) x) =
                  coe_fn ((fun (i : ι) => linear_map.comp F (of R ι G f i)) i) x))
              (linear_map.comp_apply F (of R ι G f j) (coe_fn (f i j hij) x))))
          (eq.mpr
            (id
              (Eq._oldrec
                (Eq.refl
                  (coe_fn F (coe_fn (of R ι G f j) (coe_fn (f i j hij) x)) =
                    coe_fn ((fun (i : ι) => linear_map.comp F (of R ι G f i)) i) x))
                of_f))
            (Eq.refl (coe_fn F (coe_fn (of R ι G f i) x)))))
    x := sorry

/-- `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. -/
def totalize {R : Type u} [ring R] {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) (i : ι) (j : ι) : linear_map R (G i) (G j) :=
  dite (i ≤ j) (fun (h : i ≤ j) => f i j h) fun (h : ¬i ≤ j) => 0

theorem totalize_apply {R : Type u} [ring R] {ι : Type v} [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} (i : ι) (j : ι) (x : G i) : coe_fn (totalize G f i j) x = dite (i ≤ j) (fun (h : i ≤ j) => coe_fn (f i j h) x) fun (h : ¬i ≤ j) => 0 := sorry

theorem to_module_totalize_of_le {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} [directed_system G f] {x : direct_sum ι G} {i : ι} {j : ι} (hij : i ≤ j) (hx : ∀ (k : ι), k ∈ dfinsupp.support x → k ≤ i) : coe_fn (direct_sum.to_module R ι (G j) fun (k : ι) => totalize G f k j) x =
  coe_fn (f i j hij) (coe_fn (direct_sum.to_module R ι (G i) fun (k : ι) => totalize G f k i) x) := sorry

theorem of.zero_exact_aux {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} [directed_system G f] [Nonempty ι] {x : direct_sum ι G} (H : submodule.quotient.mk x = 0) : ∃ (j : ι),
  (∀ (k : ι), k ∈ dfinsupp.support x → k ≤ j) ∧
    coe_fn (direct_sum.to_module R ι (G j) fun (i : ι) => totalize G f i j) x = 0 := sorry

/-- 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 {R : Type u} [ring R] {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)] {f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)} [directed_system G f] {i : ι} {x : G i} (H : coe_fn (of R ι G f i) x = 0) : ∃ (j : ι), ∃ (hij : i ≤ j), coe_fn (f i j hij) x = 0 := sorry

end direct_limit

end module

namespace add_comm_group

/-- The direct limit of a directed system is the abelian groups glued together along the maps. -/
def direct_limit {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] (f : (i j : ι) → i ≤ j → G i →+ G j) :=
  module.direct_limit G fun (i j : ι) (hij : i ≤ j) => add_monoid_hom.to_int_linear_map (f i j hij)

namespace direct_limit

protected theorem directed_system {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] (f : (i j : ι) → i ≤ j → G i →+ G j) [directed_system G fun (i j : ι) (h : i ≤ j) => ⇑(f i j h)] : module.directed_system G fun (i j : ι) (hij : i ≤ j) => add_monoid_hom.to_int_linear_map (f i j hij) :=
  module.directed_system.mk (directed_system.map_self fun (i j : ι) (h : i ≤ j) => ⇑(f i j h))
    (directed_system.map_map fun (i j : ι) (h : i ≤ j) => ⇑(f i j h))

protected instance add_comm_group {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] (f : (i j : ι) → i ≤ j → G i →+ G j) : add_comm_group (direct_limit G f) :=
  module.direct_limit.add_comm_group G fun (i j : ι) (hij : i ≤ j) => add_monoid_hom.to_int_linear_map (f i j hij)

protected instance inhabited {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] (f : (i j : ι) → i ≤ j → G i →+ G j) : Inhabited (direct_limit G f) :=
  { default := 0 }

/-- The canonical map from a component to the direct limit. -/
def of {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] (f : (i j : ι) → i ≤ j → G i →+ G j) (i : ι) : linear_map ℤ (G i) (direct_limit G f) :=
  module.direct_limit.of ℤ ι G (fun (i j : ι) (hij : i ≤ j) => add_monoid_hom.to_int_linear_map (f i j hij)) i

@[simp] theorem of_f {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] {f : (i j : ι) → i ≤ j → G i →+ G j} {i : ι} {j : ι} (hij : i ≤ j) (x : G i) : coe_fn (of G f j) (coe_fn (f i j hij) x) = coe_fn (of G f i) x :=
  module.direct_limit.of_f

protected theorem induction_on {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] {f : (i j : ι) → i ≤ j → G i →+ G j} [Nonempty ι] {C : direct_limit G f → Prop} (z : direct_limit G f) (ih : ∀ (i : ι) (x : G i), C (coe_fn (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 {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] {f : (i j : ι) → i ≤ j → G i →+ G j} [directed_system G fun (i j : ι) (h : i ≤ j) => ⇑(f i j h)] (i : ι) (x : G i) (h : coe_fn (of G f i) x = 0) : ∃ (j : ι), ∃ (hij : i ≤ j), coe_fn (f i j hij) x = 0 :=
  module.direct_limit.of.zero_exact h

/-- 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 {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] (G : ι → Type w) [(i : ι) → add_comm_group (G i)] (f : (i j : ι) → i ≤ j → G i →+ G j) (P : Type u₁) [add_comm_group P] (g : (i : ι) → G i →+ P) (Hg : ∀ (i j : ι) (hij : i ≤ j) (x : G i), coe_fn (g j) (coe_fn (f i j hij) x) = coe_fn (g i) x) : linear_map ℤ (direct_limit G f) P :=
  module.direct_limit.lift ℤ ι G (fun (i j : ι) (hij : i ≤ j) => add_monoid_hom.to_int_linear_map (f i j hij))
    (fun (i : ι) => add_monoid_hom.to_int_linear_map (g i)) Hg

@[simp] theorem lift_of {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] {f : (i j : ι) → i ≤ j → G i →+ G j} (P : Type u₁) [add_comm_group P] (g : (i : ι) → G i →+ P) (Hg : ∀ (i j : ι) (hij : i ≤ j) (x : G i), coe_fn (g j) (coe_fn (f i j hij) x) = coe_fn (g i) x) (i : ι) (x : G i) : coe_fn (lift G f P g Hg) (coe_fn (of G f i) x) = coe_fn (g i) x :=
  module.direct_limit.lift_of (fun (i : ι) => add_monoid_hom.to_int_linear_map (g i)) Hg x

theorem lift_unique {ι : Type v} [dec_ι : DecidableEq ι] [directed_order ι] {G : ι → Type w} [(i : ι) → add_comm_group (G i)] {f : (i j : ι) → i ≤ j → G i →+ G j} (P : Type u₁) [add_comm_group P] [Nonempty ι] (F : direct_limit G f →+ P) (x : direct_limit G f) : coe_fn F x =
  coe_fn
    (lift G f P (fun (i : ι) => add_monoid_hom.comp F (linear_map.to_add_monoid_hom (of G f i)))
      fun (i j : ι) (hij : i ≤ j) (x : G i) =>
        eq.mpr
          (id
            (Eq.trans
              ((fun (a a_1 : P) (e_1 : a = a_1) (ᾰ ᾰ_1 : P) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
                (coe_fn ((fun (i : ι) => add_monoid_hom.comp F (linear_map.to_add_monoid_hom (of G f i))) j)
                  (coe_fn (f i j hij) x))
                (coe_fn F (coe_fn (of G f i) x))
                (Eq.trans
                  (Eq.trans
                    (Eq.trans
                      (congr_fun (add_monoid_hom.coe_comp F (linear_map.to_add_monoid_hom (of G f j)))
                        (coe_fn (f i j hij) x))
                      ((fun (f_1 f_2 : direct_limit G f → P) (e_1 : f_1 = f_2) (g g_1 : G j → direct_limit G f)
                          (e_2 : g = g_1) (ᾰ ᾰ_1 : G j) (e_3 : ᾰ = ᾰ_1) =>
                          congr (congr (congr_arg function.comp e_1) e_2) e_3)
                        (⇑F) (⇑F) (Eq.refl ⇑F) (⇑(linear_map.to_add_monoid_hom (of G f j))) (⇑(of G f j))
                        (linear_map.to_add_monoid_hom_coe (of G f j)) (coe_fn (f i j hij) x) (coe_fn (f i j hij) x)
                        (Eq.refl (coe_fn (f i j hij) x))))
                    (function.comp_app (⇑F) (⇑(of G f j)) (coe_fn (f i j hij) x)))
                  ((fun (x x_1 : direct_limit G f →+ P) (e_1 : x = x_1) (ᾰ ᾰ_1 : direct_limit G f) (e_2 : ᾰ = ᾰ_1) =>
                      congr (congr_arg coe_fn e_1) e_2)
                    F F (Eq.refl F) (coe_fn (of G f j) (coe_fn (f i j hij) x)) (coe_fn (of G f i) x) (of_f hij x)))
                (coe_fn ((fun (i : ι) => add_monoid_hom.comp F (linear_map.to_add_monoid_hom (of G f i))) i) x)
                (coe_fn F (coe_fn (of G f i) x))
                (Eq.trans
                  (Eq.trans (congr_fun (add_monoid_hom.coe_comp F (linear_map.to_add_monoid_hom (of G f i))) x)
                    ((fun (f_1 f_2 : direct_limit G f → P) (e_1 : f_1 = f_2) (g g_1 : G i → direct_limit G f)
                        (e_2 : g = g_1) (ᾰ ᾰ_1 : G i) (e_3 : ᾰ = ᾰ_1) =>
                        congr (congr (congr_arg function.comp e_1) e_2) e_3)
                      (⇑F) (⇑F) (Eq.refl ⇑F) (⇑(linear_map.to_add_monoid_hom (of G f i))) (⇑(of G f i))
                      (linear_map.to_add_monoid_hom_coe (of G f i)) x x (Eq.refl x)))
                  (function.comp_app (⇑F) (⇑(of G f i)) x)))
              (propext (eq_self_iff_true (coe_fn F (coe_fn (of G f i) x))))))
          trivial)
    x := sorry

end direct_limit

end add_comm_group

namespace ring

/-- The direct limit of a directed system is the rings glued together along the maps. -/
def direct_limit {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → comm_ring (G i)] (f : (i j : ι) → i ≤ j → G i → G j) :=
  ideal.quotient
    (ideal.span
      (set_of
        fun (a : free_comm_ring (sigma fun (i : ι) => G i)) =>
          (∃ (i : ι),
              ∃ (j : ι),
                ∃ (H : i ≤ j),
                  ∃ (x : G i), free_comm_ring.of (sigma.mk j (f i j H x)) - free_comm_ring.of (sigma.mk i x) = a) ∨
            (∃ (i : ι), free_comm_ring.of (sigma.mk i 1) - 1 = a) ∨
              (∃ (i : ι),
                  ∃ (x : G i),
                    ∃ (y : G i),
                      free_comm_ring.of (sigma.mk i (x + y)) -
                          (free_comm_ring.of (sigma.mk i x) + free_comm_ring.of (sigma.mk i y)) =
                        a) ∨
                ∃ (i : ι),
                  ∃ (x : G i),
                    ∃ (y : G i),
                      free_comm_ring.of (sigma.mk i (x * y)) -
                          free_comm_ring.of (sigma.mk i x) * free_comm_ring.of (sigma.mk i y) =
                        a))

namespace direct_limit

protected instance comm_ring {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → comm_ring (G i)] (f : (i j : ι) → i ≤ j → G i → G j) : comm_ring (direct_limit G f) :=
  ideal.quotient.comm_ring
    (ideal.span
      (set_of
        fun (a : free_comm_ring (sigma fun (i : ι) => G i)) =>
          (∃ (i : ι),
              ∃ (j : ι),
                ∃ (H : i ≤ j),
                  ∃ (x : G i), free_comm_ring.of (sigma.mk j (f i j H x)) - free_comm_ring.of (sigma.mk i x) = a) ∨
            (∃ (i : ι), free_comm_ring.of (sigma.mk i 1) - 1 = a) ∨
              (∃ (i : ι),
                  ∃ (x : G i),
                    ∃ (y : G i),
                      free_comm_ring.of (sigma.mk i (x + y)) -
                          (free_comm_ring.of (sigma.mk i x) + free_comm_ring.of (sigma.mk i y)) =
                        a) ∨
                ∃ (i : ι),
                  ∃ (x : G i),
                    ∃ (y : G i),
                      free_comm_ring.of (sigma.mk i (x * y)) -
                          free_comm_ring.of (sigma.mk i x) * free_comm_ring.of (sigma.mk i y) =
                        a))

protected instance ring {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → comm_ring (G i)] (f : (i j : ι) → i ≤ j → G i → G j) : ring (direct_limit G f) :=
  comm_ring.to_ring (direct_limit G f)

protected instance inhabited {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → comm_ring (G i)] (f : (i j : ι) → i ≤ j → G i → G j) : Inhabited (direct_limit G f) :=
  { default := 0 }

/-- The canonical map from a component to the direct limit. -/
def of {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → comm_ring (G i)] (f : (i j : ι) → i ≤ j → G i → G j) (i : ι) : G i →+* direct_limit G f := sorry

@[simp] theorem of_f {ι : Type v} [directed_order ι] {G : ι → Type w} [(i : ι) → comm_ring (G i)] {f : (i j : ι) → i ≤ j → G i → G j} {i : ι} {j : ι} (hij : i ≤ j) (x : G i) : coe_fn (of G f j) (f i j hij x) = coe_fn (of G f i) x :=
  iff.mpr ideal.quotient.eq
    (submodule.subset_span (Or.inl (Exists.intro i (Exists.intro j (Exists.intro hij (Exists.intro x rfl))))))

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/
theorem exists_of {ι : Type v} [directed_order ι] {G : ι → Type w} [(i : ι) → comm_ring (G i)] {f : (i j : ι) → i ≤ j → G i → G j} [Nonempty ι] (z : direct_limit G f) : ∃ (i : ι), ∃ (x : G i), coe_fn (of G f i) x = z := sorry

theorem polynomial.exists_of {ι : Type v} [directed_order ι] {G : ι → Type w} [(i : ι) → comm_ring (G i)] {f' : (i j : ι) → i ≤ j → G i →+* G j} [Nonempty ι] (q : polynomial (direct_limit G fun (i j : ι) (h : i ≤ j) => ⇑(f' i j h))) : ∃ (i : ι), ∃ (p : polynomial (G i)), polynomial.map (of G (fun (i j : ι) (h : i ≤ j) => ⇑(f' i j h)) i) p = q := sorry

theorem induction_on {ι : Type v} [directed_order ι] {G : ι → Type w} [(i : ι) → comm_ring (G i)] {f : (i j : ι) → i ≤ j → G i → G j} [Nonempty ι] {C : direct_limit G f → Prop} (z : direct_limit G f) (ih : ∀ (i : ι) (x : G i), C (coe_fn (of G f i) x)) : C z := sorry

theorem of.zero_exact_aux2 {ι : Type v} [directed_order ι] (G : ι → Type w) [(i : ι) → comm_ring (G i)] (f' : (i j : ι) → i ≤ j → G i →+* G j) [directed_system G fun (i j : ι) (h : i ≤ j) => ⇑(f' i j h)] {x : free_comm_ring (sigma fun (i : ι) => G i)} {s : set (sigma fun (i : ι) => G i)} {t : set (sigma fun (i : ι) => G i)} (hxs : free_comm_ring.is_supported x s) {j : ι} {k : ι} (hj : ∀ (z : sigma fun (i : ι) => G i), z ∈ s → sigma.fst z ≤ j) (hk : ∀ (z : sigma fun (i : ι) => G i), z ∈ t → sigma.fst z ≤ k) (hjk : j ≤ k) (hst : s ⊆ t) : coe_fn (f' j k hjk)
    (coe_fn
      (free_comm_ring.lift
        fun (ix : ↥s) =>
          coe_fn (f' (sigma.fst (subtype.val ix)) j (hj (↑ix) (subtype.pro


import completeness

namespace fol

/-- A version of compactness theorem: a theory is consistent (a.k.a satisfiable)
  if and only if it is finitely consistent -/
theorem compactness' {L} {T : Theory L} : is_consistent T ↔
  ∀ fs : finset (sentence L), ↑fs ⊆ T → is_consistent (↑fs : Theory L) :=
begin
  split,
  { rintros hT fs hfsT ⟨hbot⟩,
    exact hT ⟨sweakening hfsT hbot⟩ },
  { intros h hbot,
    rw theory_proof_compactness_iff at hbot,
    obtain ⟨ fs , hfsbot , hfsT ⟩ := hbot,
    exact h fs hfsT hfsbot },
end

end fol


import linear_algebra.basis
import for_mathlib.fd_duality
import for_mathlib.basis
import topology.constructions

variables {V K : Type*} [field K] [add_comm_group V] [module K V]

namespace module

def dual.pointwise_convergence_topology :
  topological_space (dual K V) :=
let e : (dual K V) → (V → K) := λ f, f in
topological_space.induced e (@Pi.topological_space V (λ _, K) (λ _, ⊥))

end module

namespace submodule

open module

def closed (H : submodule K (dual K V)) : Prop :=
∀ (f : dual K V), (∀ (a : V) (ha : a ∈ H.dual_annihilator_comap), f a = 0) → f ∈ H

section
local attribute [instance] dual.pointwise_convergence_topology

theorem is_closed_iff (H : submodule K (dual K V)) :
  is_closed (H : set (dual K V)) ↔ H.closed :=
begin
  letI : topological_space V := ⊥,
  letI : topological_space K := ⊥,
  let e : dual K V → V → K := λ f, f,
  have he : inducing e := ⟨rfl⟩,
  split,
  { intros h f hf,
    rw he.is_closed_iff at h,
    obtain ⟨T,hT1,hT2⟩ := h,
    change f ∈ (H : set (dual K V)), rw ← hT2,
    rw is_closed_iff_nhds at hT1,
    apply hT1,
    intros U hU,
    rw [nhds_pi, filter.mem_pi] at hU,
    obtain ⟨I,hI1,hI2,hI3,hI4⟩ := hU,
    simp_rw [nhds_discrete, filter.mem_pure] at hI3,
    let W : submodule K V := submodule.span K I,
    haveI : finite_dimensional K W,
    { apply finite_dimensional.span_of_finite, exact hI1 },
    let F : dual K V →ₗ[K] dual K W :=  dual.transpose W.subtype,
    let H' := H.map F,
    suffices : F f ∈ H',
    { obtain ⟨g,hg1,hg2⟩ := this,
      use g,
      split,
      { apply hI4, rw set.mem_pi, intros i hi,
        have : g i = f i,
        { let j : W := ⟨i, submodule.subset_span hi⟩,
          change F g j = F f j, rw hg2 },
        rw this,
        apply hI3 },
      { change g ∈ e ⁻¹' T, rw hT2, apply hg1 } },
    rw mem_iff_dual_annihilator_comap,
    intros a ha,
    rw mem_dual_annihilator_comap_iff at ha,
    apply hf,
    dsimp, rw mem_dual_annihilator_comap_iff,
    intros g hg,
    apply ha (F g), refine ⟨g,hg,rfl⟩ },
  { intros h,
    have : (H : set (dual K V)) =
      ⋂ (a : V) (ha : a ∈ H.dual_annihilator_comap), { g | a ∈ g.ker },
    { ext f,
      split,
      { intros hf,
        rw set.mem_Inter, intros a, rw set.mem_Inter, intros ha,
        rw mem_dual_annihilator_comap_iff at ha,
        exact ha _ hf },
      { intros hf,
        apply h,
        intros a ha,
        rw set.mem_Inter at hf, specialize hf a,
        rw set.mem_Inter at hf, specialize hf ha,
        apply hf } },
    rw this,
    apply is_closed_Inter, intros a,
    apply is_closed_Inter, intros ha,
    rw he.is_closed_iff,
    use (λ (e : V → K), e a) ⁻¹' ({0} : set K),
    refine ⟨_, rfl⟩,
    apply is_closed.preimage, exact continuous_apply a,
    constructor, trivial }
end
end

lemma mem_iff_dual_annihilator_comap_of_closed (H : submodule K (dual K V))
  (hH : H.closed) (f : dual K V) :
  f ∈ H ↔ (∀ (a : V) (ha : a ∈ H.dual_annihilator_comap), f a = 0) :=
begin
  split,
  { intros hf a ha,
    rw mem_dual_annihilator_comap_iff at ha,
    exact ha _ hf },
  { intro hf,
    apply hH _ hf }
end

noncomputable
def equiv_to_dual_mod_of_is_closed (H : submodule K (dual K V))
  (hH : H.closed) :
  H ≃ₗ[K] dual K (V ⧸ H.dual_annihilator_comap) :=
linear_equiv.of_bijective H.map_to_dual_mod H.map_to_dual_mod_injective
begin
  intros f,
  let g : dual K V := f.comp H.dual_annihilator_comap.mkq,
  use g,
  swap, { ext, refl },
  rw mem_iff_dual_annihilator_comap_of_closed _ hH,
  intros a ha,
  dsimp [g],
  convert f.map_zero using 2,
  simpa only [quotient.mk_eq_zero],
end

@[simp]
lemma equiv_to_dual_mod_of_is_closed_apply_apply
  (H : submodule K (dual K V)) (hH : H.closed)
  (f : H) (v : V) :
  H.equiv_to_dual_mod_of_is_closed hH f (H.dual_annihilator_comap.mkq v) = f v :=
rfl

@[simp]
lemma equiv_to_dual_mod_of_is_closed_symm_apply_apply
  (H : submodule K (dual K V)) (hH : H.closed)
  (f : dual K (V ⧸ H.dual_annihilator_comap)) (v : V) :
  ((H.equiv_to_dual_mod_of_is_closed hH).symm f : dual K V) v =
    f (H.dual_annihilator_comap.mkq v) :=
begin
  erw ← H.equiv_to_dual_mod_of_is_closed_apply_apply hH,
  simp,
end

lemma is_closed_dual_annihilator (T : submodule K V) :
  T.dual_annihilator.closed :=
begin
  intros f hf,
  rw mem_dual_annihilator,
  intros w hw,
  apply hf,
  rw mem_dual_annihilator_comap_iff,
  intros g hg,
  rw mem_dual_annihilator at hg,
  apply hg,
  assumption
end

lemma exists_functional_of_nonzero (v : V) (hv : v ≠ 0) :
  ∃ φ : dual K V, φ v ≠ 0 :=
begin
  have : linear_independent K ![v],
  { by_contra c,
    rw fintype.not_linear_independent_iff at c,
    obtain ⟨g,h1,i,h2⟩ := c,
    apply h2,
    simp only [fintype.univ_of_subsingleton, fin.mk_zero, matrix.cons_val_fin_one, finset.sum_singleton,
      smul_eq_zero] at h1,
    fin_cases i, cases h1, assumption,
    contradiction },
  let β := basis.sum_extend this,
  use β.coord (sum.inl 0),
  change β.coord (sum.inl 0) (![v] 0) ≠ 0,
  dsimp only [β],
  have := basis.sum_extend_extends _ this 0,
  rw ← this,
  dsimp,
  classical,
  simp only [basis.repr_self, finsupp.single_apply, if_pos rfl],
  exact one_ne_zero,
end

@[simp]
lemma dual_annihilator_dual_annihilator_comap (T : submodule K V) :
  T.dual_annihilator.dual_annihilator_comap = T :=
begin
  ext t,
  split,
  { intros ht,
    rw mem_dual_annihilator_comap_iff at ht,
    by_contra c,
    have : ∃ (φ : dual K (V ⧸ T)), φ (T.mkq t) ≠ 0,
    { apply exists_functional_of_nonzero, simpa },
    obtain ⟨φ, hφ⟩ := this,
    apply hφ,
    let ψ := φ.comp T.mkq, apply ht ψ,
    rw mem_dual_annihilator,
    intros v hv,
    dsimp only [ψ, linear_map.comp_apply],
    convert φ.map_zero,
    simpa },
  { intros ht,
    rw mem_dual_annihilator_comap_iff,
    intros φ hφ,
    rw mem_dual_annihilator at hφ,
    apply hφ,
    assumption }
end

lemma closed.dual_comap_dual {T : submodule K (dual K V)}
  (hT : T.closed) : T.dual_annihilator_comap.dual_annihilator = T :=
begin
  ext t,
  split,
  { intros ht,
    rw mem_dual_annihilator at ht,
    rwa mem_iff_dual_annihilator_comap_of_closed _ hT },
  { intros ht,
    rw mem_dual_annihilator,
    rwa ← mem_iff_dual_annihilator_comap_of_closed _ hT, },
end

def quotient_dual_dual_equiv (T : submodule K V) :
  (V ⧸ T.dual_annihilator.dual_annihilator_comap) ≃ₗ[K]
  (V ⧸ T) :=
{ inv_fun := T.liftq (submodule.mkq _) (by simp),
  left_inv := by { rintro ⟨t⟩, refl },
  right_inv := by { rintro ⟨t⟩, refl },
  ..(submodule.liftq T.dual_annihilator.dual_annihilator_comap T.mkq (by simp)) }

@[simp]
lemma quotient_dual_dual_equiv_apply (T : submodule K V) (v : V) :
  T.quotient_dual_dual_equiv (submodule.mkq _ v) = T.mkq v := rfl

@[simp]
lemma quotient_dual_dual_equiv_symm_apply (T : submodule K V) (v : V) :
  T.quotient_dual_dual_equiv.symm (submodule.mkq _ v) = submodule.mkq _ v := rfl

def mod_to_dual_mod (T H : submodule K V) :
  (↥(T.dual_annihilator) ⧸ (H.dual_annihilator.comap T.dual_annihilator.subtype)) →ₗ[K]
  (dual K (H ⧸ T.comap H.subtype)) :=
(H.dual_annihilator.comap T.dual_annihilator.subtype).liftq
({ to_fun := λ e, (T.comap H.subtype).liftq ((e : dual K V).comp H.subtype) begin
    rintros ⟨x,hx⟩ hhx,
    simp only [mem_comap, coe_subtype, coe_mk] at hhx,
    cases e with e he,
    rw mem_dual_annihilator at he,
    apply he, exact hhx,
  end,
  map_add' := begin
    rintros ⟨x,hx⟩ ⟨y,hy⟩, ext ⟨t,ht⟩,
    refl,
  end,
  map_smul' := begin
    rintros c ⟨x,hx⟩, ext ⟨t,ht⟩,
    refl,
  end }) $
begin
  rintros ⟨x,hx⟩ hhx,
  simp only [mem_comap, coe_subtype, coe_mk, mem_dual_annihilator] at hhx,
  rw mem_dual_annihilator at hx, rw linear_map.mem_ker, dsimp,
  ext ⟨t,ht⟩,
  simp only [liftq_mkq, linear_map.coe_comp, coe_subtype, function.comp_app, coe_mk,
    linear_map.zero_comp, linear_map.zero_apply],
  apply hhx, exact ht,
end

@[simp]
lemma mod_to_dual_mod_apply (T H : submodule K V) (e : T.dual_annihilator) (h : H) :
  mod_to_dual_mod T H (submodule.mkq _ e) (submodule.mkq _ h) = e h := rfl

noncomputable
def dual_mod_comap_iso (T H : submodule K V) (le : T ≤ H) :
  (↥(T.dual_annihilator) ⧸ (H.dual_annihilator.comap T.dual_annihilator.subtype)) ≃ₗ[K]
  (dual K (↥H ⧸ T.comap H.subtype)) :=
linear_equiv.of_bijective
(mod_to_dual_mod T H)
begin
  rintros ⟨f⟩ ⟨g⟩ h,
  simp only [quotient.quot_mk_eq_mk] at h,
  simp only [quotient.quot_mk_eq_mk],
  rw ← sub_eq_zero at h ⊢,
  simp only [← submodule.mkq_apply, ← linear_map.map_sub] at h ⊢,
  simp only [submodule.mkq_apply, submodule.quotient.mk_eq_zero],
  simp only [mem_comap, coe_subtype, add_subgroup_class.coe_sub,
    mem_dual_annihilator, linear_map.sub_apply],
  intros v hv,
  let t : H := ⟨v,hv⟩,
  apply_fun (λ e, e (submodule.mkq _ t)) at h,
  exact h
end
begin
  intros e,
  let g : dual K H := e.comp (submodule.mkq _),
  obtain ⟨f,hf⟩ := subspace.dual_restrict_surjective g,
  have hfT : f ∈ T.dual_annihilator,
  { rw mem_dual_annihilator,
    intros v hv,
    let u : H := ⟨v, le hv⟩,
    change dual_restrict _ f u = _,
    rw hf,
    dsimp [g], rw ← submodule.mkq_apply,
    have : ((comap H.subtype T).mkq) u = 0,
    { simpa only [mkq_apply, quotient.mk_eq_zero, mem_comap, coe_subtype, coe_mk] },
    simp [this] },
  let t : T.dual_annihilator := ⟨f,hfT⟩,
  let tt := submodule.mkq (H.dual_annihilator.comap T.dual_annihilator.subtype) t,
  use tt,
  ext,
  dsimp only [linear_map.comp_apply, tt],
  rw mod_to_dual_mod_apply T H t x,
  change dual_restrict _ f x = _, rw hf, refl,
end

end submodule