/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin
-/
import algebra.direct_sum.module
import algebra.module.big_operators
import linear_algebra.isomorphisms
import group_theory.torsion
import ring_theory.coprime.ideal
import ring_theory.finiteness

/-!
# Torsion submodules

## Main definitions

* `torsion_of R M x` : the torsion ideal of `x`, containing all `a` such that `a • x = 0`.
* `submodule.torsion_by R M a` : the `a`-torsion submodule, containing all elements `x` of `M` such
  that `a • x = 0`.
* `submodule.torsion_by_set R M s` : the submodule containing all elements `x` of `M` such that
  `a • x = 0` for all `a` in `s`.
* `submodule.torsion' R M S` : the `S`-torsion submodule, containing all elements `x` of `M` such
  that `a • x = 0` for some `a` in `S`.
* `submodule.torsion R M` : the torsion submoule, containing all elements `x` of `M` such that
  `a • x = 0` for some non-zero-divisor `a` in `R`.
* `module.is_torsion_by R M a` : the property that defines a `a`-torsion module. Similarly,
  `is_torsion_by_set`, `is_torsion'` and `is_torsion`.
* `module.is_torsion_by_set.module` : Creates a `R ⧸ I`-module from a `R`-module that
  `is_torsion_by_set R _ I`.

## Main statements

* `quot_torsion_of_equiv_span_singleton` : isomorphism between the span of an element of `M` and
  the quotient by its torsion ideal.
* `torsion' R M S` and `torsion R M` are submodules.
* `torsion_by_set_eq_torsion_by_span` : torsion by a set is torsion by the ideal generated by it.
* `submodule.torsion_by_is_torsion_by` : the `a`-torsion submodule is a `a`-torsion module.
  Similar lemmas for `torsion'` and `torsion`.
* `submodule.torsion_by_is_internal` : a `∏ i, p i`-torsion module is the internal direct sum of its
  `p i`-torsion submodules when the `p i` are pairwise coprime. A more general version with coprime
  ideals is `submodule.torsion_by_set_is_internal`.
* `submodule.no_zero_smul_divisors_iff_torsion_bot` : a module over a domain has
  `no_zero_smul_divisors` (that is, there is no non-zero `a`, `x` such that `a • x = 0`)
  iff its torsion submodule is trivial.
* `submodule.quotient_torsion.torsion_eq_bot` : quotienting by the torsion submodule makes the
  torsion submodule of the new module trivial. If `R` is a domain, we can derive an instance
  `submodule.quotient_torsion.no_zero_smul_divisors : no_zero_smul_divisors R (M ⧸ torsion R M)`.

## Notation

* The notions are defined for a `comm_semiring R` and a `module R M`. Some additional hypotheses on
  `R` and `M` are required by some lemmas.
* The letters `a`, `b`, ... are used for scalars (in `R`), while `x`, `y`, ... are used for vectors
  (in `M`).

## Tags

Torsion, submodule, module, quotient
-/

namespace ideal

section torsion_of

variables (R M : Type*) [semiring R] [add_comm_monoid M] [module R M]

/--The torsion ideal of `x`, containing all `a` such that `a • x = 0`.-/
@[simps] def torsion_of (x : M) : ideal R := (linear_map.to_span_singleton R M x).ker

@[simp] lemma torsion_of_zero : torsion_of R M (0 : M) = ⊤ := by simp [torsion_of]

variables {R M}

@[simp] lemma mem_torsion_of_iff (x : M) (a : R) : a ∈ torsion_of R M x ↔ a • x = 0 := iff.rfl

variables (R)

@[simp] lemma torsion_of_eq_top_iff (m : M) : torsion_of R M m = ⊤ ↔ m = 0 :=
begin
  refine ⟨λ h, _, λ h, by simp [h]⟩,
  rw [← one_smul R m, ← mem_torsion_of_iff m (1 : R), h],
  exact submodule.mem_top,
end

@[simp] lemma torsion_of_eq_bot_iff_of_no_zero_smul_divisors
  [nontrivial R] [no_zero_smul_divisors R M] (m : M) :
  torsion_of R M m = ⊥ ↔ m ≠ 0 :=
begin
  refine ⟨λ h contra, _, λ h, (submodule.eq_bot_iff _).mpr $ λ r hr, _⟩,
  { rw [contra, torsion_of_zero] at h,
    exact bot_ne_top.symm h, },
  { rw [mem_torsion_of_iff, smul_eq_zero] at hr,
    tauto, },
end

/-- See also `complete_lattice.independent.linear_independent` which provides the same conclusion
but requires the stronger hypothesis `no_zero_smul_divisors R M`. -/
lemma complete_lattice.independent.linear_independent' {ι R M : Type*} {v : ι → M}
  [ring R] [add_comm_group M] [module R M]
  (hv : complete_lattice.independent $ λ i, (R ∙ v i))
  (h_ne_zero : ∀ i, ideal.torsion_of R M (v i) = ⊥) :
  linear_independent R v :=
begin
  refine linear_independent_iff_not_smul_mem_span.mpr (λ i r hi, _),
  replace hv := complete_lattice.independent_def.mp hv i,
  simp only [supr_subtype', ← submodule.span_range_eq_supr, disjoint_iff] at hv,
  have : r • v i ∈ ⊥,
  { rw [← hv, submodule.mem_inf],
    refine ⟨submodule.mem_span_singleton.mpr ⟨r, rfl⟩, _⟩,
    convert hi,
    ext,
    simp, },
  rw [← submodule.mem_bot R, ← h_ne_zero i],
  simpa using this,
end

end torsion_of

section
variables (R M : Type*) [ring R] [add_comm_group M] [module R M]
/--The span of `x` in `M` is isomorphic to `R` quotiented by the torsion ideal of `x`.-/
noncomputable def quot_torsion_of_equiv_span_singleton (x : M) :
  (R ⧸ torsion_of R M x) ≃ₗ[R] (R ∙ x) :=
(linear_map.to_span_singleton R M x).quot_ker_equiv_range.trans $
linear_equiv.of_eq _ _ (linear_map.span_singleton_eq_range R M x).symm

variables {R M}
@[simp] lemma quot_torsion_of_equiv_span_singleton_apply_mk (x : M) (a : R) :
  quot_torsion_of_equiv_span_singleton R M x (submodule.quotient.mk a) =
    a • ⟨x, submodule.mem_span_singleton_self x⟩ := rfl
end
end ideal

open_locale non_zero_divisors

section defs

variables (R M : Type*) [comm_semiring R] [add_comm_monoid M] [module R M]

namespace submodule

/-- The `a`-torsion submodule for `a` in `R`, containing all elements `x` of `M` such that
  `a • x = 0`. -/
@[simps] def torsion_by (a : R) : submodule R M := (distrib_mul_action.to_linear_map R M a).ker

/-- The submodule containing all elements `x` of `M` such that `a • x = 0` for all `a` in `s`. -/
@[simps] def torsion_by_set (s : set R) : submodule R M := Inf (torsion_by R M '' s)

/-- The `S`-torsion submodule, containing all elements `x` of `M` such that `a • x = 0` for some
`a` in `S`. -/
@[simps] def torsion' (S : Type*)
  [comm_monoid S] [distrib_mul_action S M] [smul_comm_class S R M] :
  submodule R M :=
{ carrier := { x | ∃ a : S, a • x = 0 },
  zero_mem' := ⟨1, smul_zero _⟩,
  add_mem' := λ x y ⟨a, hx⟩ ⟨b, hy⟩,
    ⟨b * a,
      by rw [smul_add, mul_smul, mul_comm, mul_smul, hx, hy, smul_zero, smul_zero, add_zero]⟩,
  smul_mem' := λ a x ⟨b, h⟩, ⟨b, by rw [smul_comm, h, smul_zero]⟩ }

/-- The torsion submodule, containing all elements `x` of `M` such that  `a • x = 0` for some
  non-zero-divisor `a` in `R`. -/
@[reducible] def torsion := torsion' R M R⁰

end submodule

namespace module

/-- A `a`-torsion module is a module where every element is `a`-torsion. -/
@[reducible] def is_torsion_by (a : R) := ∀ ⦃x : M⦄, a • x = 0

/-- A module where every element is `a`-torsion for all `a` in `s`. -/
@[reducible] def is_torsion_by_set (s : set R) := ∀ ⦃x : M⦄ ⦃a : s⦄, (a : R) • x = 0

/-- A `S`-torsion module is a module where every element is `a`-torsion for some `a` in `S`. -/
@[reducible] def is_torsion' (S : Type*) [has_smul S M] := ∀ ⦃x : M⦄, ∃ a : S, a • x = 0

/-- A torsion module is a module where every element is `a`-torsion for some non-zero-divisor `a`.
-/
@[reducible] def is_torsion := ∀ ⦃x : M⦄, ∃ a : R⁰, a • x = 0

end module

end defs

variables {R M : Type*}

section
variables [comm_semiring R] [add_comm_monoid M] [module R M] (s : set R) (a : R)

namespace submodule

@[simp] lemma smul_torsion_by (x : torsion_by R M a) : a • x = 0 := subtype.ext x.prop
@[simp] lemma smul_coe_torsion_by (x : torsion_by R M a) : a • (x : M) = 0 := x.prop
@[simp] lemma mem_torsion_by_iff (x : M) : x ∈ torsion_by R M a ↔ a • x = 0 := iff.rfl

@[simp] lemma mem_torsion_by_set_iff (x : M) :
  x ∈ torsion_by_set R M s ↔ ∀ a : s, (a : R) • x = 0 :=
begin
  refine ⟨λ h ⟨a, ha⟩, mem_Inf.mp h _ (set.mem_image_of_mem _ ha), λ h, mem_Inf.mpr _⟩,
  rintro _ ⟨a, ha, rfl⟩, exact h ⟨a, ha⟩
end

@[simp] lemma torsion_by_singleton_eq : torsion_by_set R M {a} = torsion_by R M a :=
begin
  ext x,
  simp only [mem_torsion_by_set_iff, set_coe.forall, subtype.coe_mk, set.mem_singleton_iff,
    forall_eq, mem_torsion_by_iff]
end

/-- Torsion by a set is torsion by the ideal generated by it. -/
lemma torsion_by_set_eq_torsion_by_span :
  torsion_by_set R M s = torsion_by_set R M (ideal.span s) :=
begin
  refine le_antisymm (λ x hx, _) (torsion_by_set_le_torsion_by_set_of_subset subset_span),
  rw mem_torsion_by_set_iff at hx ⊢,
  suffices : ideal.span s ≤ ideal.torsion_of R M x,
  { rintro ⟨a, ha⟩, exact this ha },
  rw ideal.span_le, exact λ a ha, hx ⟨a, ha⟩
end

lemma torsion_by_span_singleton_eq : torsion_by_set R M (R ∙ a) = torsion_by R M a :=
((torsion_by_set_eq_torsion_by_span _).symm.trans $ torsion_by_singleton_eq _)

lemma torsion_by_le_torsion_by_of_dvd (a b : R) (dvd : a ∣ b) :
  torsion_by R M a ≤ torsion_by R M b :=
begin
  rw [← torsion_by_span_singleton_eq, ← torsion_by_singleton_eq],
  apply torsion_by_set_le_torsion_by_set_of_subset,
  rintro c (rfl : c = b), exact ideal.mem_span_singleton.mpr dvd
end

@[simp] lemma torsion_by_one : torsion_by R M 1 = ⊥ :=
eq_bot_iff.mpr (λ _ h, by { rw [mem_torsion_by_iff, one_smul] at h, exact h })
@[simp] lemma torsion_by_univ : torsion_by_set R M set.univ = ⊥ :=
by { rw [eq_bot_iff, ← torsion_by_one, ← torsion_by_singleton_eq],
  exact torsion_by_set_le_torsion_by_set_of_subset (λ _ _, trivial) }

end submodule
open submodule
namespace module

@[simp] lemma is_torsion_by_singleton_iff : is_torsion_by_set R M {a} ↔ is_torsion_by R M a :=
begin
  refine ⟨λ h x, @h _ ⟨_, set.mem_singleton _⟩, λ h x, _⟩,
  rintro ⟨b, rfl : b = a⟩, exact @h _
end

lemma is_torsion_by_set_iff_torsion_by_set_eq_top :
  is_torsion_by_set R M s ↔ submodule.torsion_by_set R M s = ⊤ :=
⟨λ h, eq_top_iff.mpr (λ _ _, (mem_torsion_by_set_iff _ _).mpr $ @h _),
  λ h x, by { rw [← mem_torsion_by_set_iff, h], trivial }⟩

/-- A `a`-torsion module is a module whose `a`-torsion submodule is the full space. -/
lemma is_torsion_by_iff_torsion_by_eq_top : is_torsion_by R M a ↔ torsion_by R M a = ⊤ :=
by rw [← torsion_by_singleton_eq, ← is_torsion_by_singleton_iff,
  is_torsion_by_set_iff_torsion_by_set_eq_top]

lemma is_torsion_by_set_iff_is_torsion_by_span :
  is_torsion_by_set R M s ↔ is_torsion_by_set R M (ideal.span s) :=
by rw [is_torsion_by_set_iff_torsion_by_set_eq_top, is_torsion_by_set_iff_torsion_by_set_eq_top,
  torsion_by_set_eq_torsion_by_span]

lemma is_torsion_by_span_singleton_iff : is_torsion_by_set R M (R ∙ a) ↔ is_torsion_by R M a :=
((is_torsion_by_set_iff_is_torsion_by_span _).symm.trans $ is_torsion_by_singleton_iff _)

end module
namespace submodule
open module

lemma torsion_by_set_is_torsion_by_set : is_torsion_by_set R (torsion_by_set R M s) s :=
λ ⟨x, hx⟩ a, subtype.ext $ (mem_torsion_by_set_iff _ _).mp hx a

/-- The `a`-torsion submodule is a `a`-torsion module. -/
lemma torsion_by_is_torsion_by : is_torsion_by R (torsion_by R M a) a := λ _, smul_torsion_by _ _

@[simp] lemma torsion_by_torsion_by_eq_top : torsion_by R (torsion_by R M a) a = ⊤ :=
(is_torsion_by_iff_torsion_by_eq_top a).mp $ torsion_by_is_torsion_by a
@[simp] lemma torsion_by_set_torsion_by_set_eq_top :
  torsion_by_set R (torsion_by_set R M s) s = ⊤ :=
(is_torsion_by_set_iff_torsion_by_set_eq_top s).mp $ torsion_by_set_is_torsion_by_set s

variables (R M)
lemma torsion_gc : @galois_connection (submodule R M) (ideal R)ᵒᵈ _ _
  annihilator (λ I, torsion_by_set R M $ I.of_dual) :=
λ A I, ⟨λ h x hx, (mem_torsion_by_set_iff _ _).mpr $ λ ⟨a, ha⟩, mem_annihilator.mp (h ha) x hx,
  λ h a ha, mem_annihilator.mpr $ λ x hx, (mem_torsion_by_set_iff _ _).mp (h hx) ⟨a, ha⟩⟩

variables {R M}
section coprime
open_locale big_operators
variables {ι : Type*} {p : ι → ideal R} {S : finset ι}
variables (hp : (S : set ι).pairwise $ λ i j, p i ⊔ p j = ⊤)
include hp

lemma supr_torsion_by_ideal_eq_torsion_by_infi :
  (⨆ i ∈ S, torsion_by_set R M $ p i) = torsion_by_set R M ↑(⨅ i ∈ S, p i) :=
begin
  cases S.eq_empty_or_nonempty with h h,
  { rw h, convert supr_emptyset, convert torsion_by_univ, convert top_coe, exact infi_emptyset },
  apply le_antisymm,
  { apply supr_le _, intro i, apply supr_le _, intro is,
    apply torsion_by_set_le_torsion_by_set_of_subset,
    exact (infi_le (λ i, ⨅ (H : i ∈ S), p i) i).trans (infi_le _ is), },
  { intros x hx,
    rw mem_supr_finset_iff_exists_sum,
    obtain ⟨μ, hμ⟩ := (mem_supr_finset_iff_exists_sum _ _).mp
      ((ideal.eq_top_iff_one _).mp $ (ideal.supr_infi_eq_top_iff_pairwise h _).mpr hp),
    refine ⟨λ i, ⟨(μ i : R) • x, _⟩, _⟩,
    { rw mem_torsion_by_set_iff at hx ⊢,
      rintro ⟨a, ha⟩, rw smul_smul,
      suffices : a * μ i ∈ ⨅ i ∈ S, p i, from hx ⟨_, this⟩,
      rw mem_infi, intro j, rw mem_infi, intro hj,
      by_cases ij : j = i,
      { rw ij, exact ideal.mul_mem_right _ _ ha },
      { have := coe_mem (μ i), simp only [mem_infi] at this,
        exact ideal.mul_mem_left _ _ (this j hj ij) } },
    { simp_rw coe_mk, rw [← finset.sum_smul, hμ, one_smul] } }
end

lemma sup_indep_torsion_by_ideal : S.sup_indep (λ i, torsion_by_set R M $ p i) :=
λ T hT i hi hiT, begin
  rw [disjoint_iff, finset.sup_eq_supr,
    supr_torsion_by_ideal_eq_torsion_by_infi $ λ i hi j hj ij, hp (hT hi) (hT hj) ij],
  have := @galois_connection.u_inf _ _ (order_dual.to_dual _) (order_dual.to_dual _) _ _ _ _
    (torsion_gc R M), dsimp at this ⊢,
  rw [← this, ideal.sup_infi_eq_top, top_coe, torsion_by_univ],
  intros j hj, apply hp hi (hT hj), rintro rfl, exact hiT hj
end

omit hp
variables {q : ι → R} (hq : (S : set ι).pairwise $ is_coprime on q)
include hq

lemma supr_torsion_by_eq_torsion_by_prod :
  (⨆ i ∈ S, torsion_by R M $ q i) = torsion_by R M (∏ i in S, q i) :=
begin
  rw [← torsion_by_span_singleton_eq, ideal.submodule_span_eq,
    ← ideal.finset_inf_span_singleton _ _ hq, finset.inf_eq_infi,
    ← supr_torsion_by_ideal_eq_torsion_by_infi],
  { congr, ext : 1, congr, ext : 1, exact (torsion_by_span_singleton_eq _).symm },
  { exact λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime _ _).mpr (hq hi hj ij), }
end

lemma sup_indep_torsion_by : S.sup_indep (λ i, torsion_by R M $ q i) :=
begin
  convert sup_indep_torsion_by_ideal
    (λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime (q i) _).mpr $ hq hi hj ij),
  ext : 1, exact (torsion_by_span_singleton_eq _).symm,
end

end coprime
end submodule
end

section needs_group
variables [comm_ring R] [add_comm_group M] [module R M]

namespace submodule
open_locale big_operators
variables {ι : Type*} [decidable_eq ι] {S : finset ι}

/--If the `p i` are pairwise coprime, a `⨅ i, p i`-torsion module is the internal direct sum of
its `p i`-torsion submodules.-/
lemma torsion_by_set_is_internal {p : ι → ideal R}
  (hp : (S : set ι).pairwise $ λ i j, p i ⊔ p j = ⊤)
  (hM : module.is_torsion_by_set R M (⨅ i ∈ S, p i : ideal R)) :
  direct_sum.is_internal (λ i : S, torsion_by_set R M $ p i) :=
direct_sum.is_internal_submodule_of_independent_of_supr_eq_top
  (complete_lattice.independent_iff_sup_indep.mpr $ sup_indep_torsion_by_ideal hp)
  ((supr_subtype'' ↑S $ λ i, torsion_by_set R M $ p i).trans $
    (supr_torsion_by_ideal_eq_torsion_by_infi hp).trans $
    (module.is_torsion_by_set_iff_torsion_by_set_eq_top _).mp hM)

/--If the `q i` are pairwise coprime, a `∏ i, q i`-torsion module is the internal direct sum of
its `q i`-torsion submodules.-/
lemma torsion_by_is_internal {q : ι → R} (hq : (S : set ι).pairwise $ is_coprime on q)
  (hM : module.is_torsion_by R M $ ∏ i in S, q i) :
  direct_sum.is_internal (λ i : S, torsion_by R M $ q i) :=
begin
  rw [← module.is_torsion_by_span_singleton_iff, ideal.submodule_span_eq,
    ← ideal.finset_inf_span_singleton _ _ hq, finset.inf_eq_infi] at hM,
  convert torsion_by_set_is_internal
    (λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime (q i) _).mpr $ hq hi hj ij) hM,
  ext : 1, exact (torsion_by_span_singleton_eq _).symm,
end

end submodule

namespace module
variables {I : ideal R} (hM : is_torsion_by_set R M I)
include hM

/-- can't be an instance because hM can't be inferred -/
def is_torsion_by_set.has_smul : has_smul (R ⧸ I) M :=
{ smul := λ b x, quotient.lift_on' b (• x) $ λ b₁ b₂ h, begin
    show b₁ • x = b₂ • x,
    have : (-b₁ + b₂) • x = 0 := @hM x ⟨_, quotient_add_group.left_rel_apply.mp h⟩,
    rw [add_smul, neg_smul, neg_add_eq_zero] at this,
    exact this
  end }

@[simp] lemma is_torsion_by_set.mk_smul (b : R) (x : M) :
  by haveI := hM.has_smul; exact ideal.quotient.mk I b • x = b • x := rfl

/-- A `(R ⧸ I)`-module is a `R`-module which `is_torsion_by_set R M I`. -/
def is_torsion_by_set.module : module (R ⧸ I) M :=
@function.surjective.module_left _ _ _ _ _ _ _ hM.has_smul
  _ ideal.quotient.mk_surjective (is_torsion_by_set.mk_smul hM)

instance is_torsion_by_set.is_scalar_tower {S : Type*} [has_smul S R] [has_smul S M]
  [is_scalar_tower S R M] [is_scalar_tower S R R] :
  @@is_scalar_tower S (R ⧸ I) M _ (is_torsion_by_set.module hM).to_has_smul _ :=
{ smul_assoc := λ b d x, quotient.induction_on' d $ λ c, (smul_assoc b c x : _) }

omit hM

instance : module (R ⧸ I) (M ⧸ I • (⊤ : submodule R M)) :=
is_torsion_by_set.module (λ x r, begin
  induction x using quotient.induction_on,
  refine (submodule.quotient.mk_eq_zero _).mpr (submodule.smul_mem_smul r.prop _),
  trivial,
end)

end module

namespace submodule

instance (I : ideal R) : module (R ⧸ I) (torsion_by_set R M I) :=
module.is_torsion_by_set.module $ torsion_by_set_is_torsion_by_set I

@[simp] lemma torsion_by_set.mk_smul (I : ideal R) (b : R) (x : torsion_by_set R M I) :
  ideal.quotient.mk I b • x = b • x := rfl

instance (I : ideal R) {S : Type*} [has_smul S R] [has_smul S M]
  [is_scalar_tower S R M] [is_scalar_tower S R R] :
  is_scalar_tower S (R ⧸ I) (torsion_by_set R M I) :=
infer_instance

/-- The `a`-torsion submodule as a `(R ⧸ R∙a)`-module. -/
instance (a : R) : module (R ⧸ R ∙ a) (torsion_by R M a) :=
module.is_torsion_by_set.module $
  (module.is_torsion_by_span_singleton_iff a).mpr $ torsion_by_is_torsion_by a

@[simp] lemma torsion_by.mk_smul (a b : R) (x : torsion_by R M a) :
  ideal.quotient.mk (R ∙ a) b • x = b • x := rfl

instance (a : R) {S : Type*} [has_smul S R] [has_smul S M]
  [is_scalar_tower S R M] [is_scalar_tower S R R] :
  is_scalar_tower S (R ⧸ R ∙ a) (torsion_by R M a) :=
infer_instance

end submodule
end needs_group

namespace submodule
section torsion'
open module

variables [comm_semiring R] [add_comm_monoid M] [module R M]
variables (S : Type*) [comm_monoid S] [distrib_mul_action S M] [smul_comm_class S R M]

@[simp] lemma mem_torsion'_iff (x : M) : x ∈ torsion' R M S ↔ ∃ a : S, a • x = 0 := iff.rfl
@[simp] lemma mem_torsion_iff (x : M) : x ∈ torsion R M ↔ ∃ a : R⁰, a • x = 0 := iff.rfl

@[simps] instance : has_smul S (torsion' R M S) :=
⟨λ s x, ⟨s • x, by { obtain ⟨x, a, h⟩ := x, use a, dsimp, rw [smul_comm, h, smul_zero] }⟩⟩
instance : distrib_mul_action S (torsion' R M S) := subtype.coe_injective.distrib_mul_action
  ((torsion' R M S).subtype).to_add_monoid_hom (λ (c : S) x, rfl)
instance : smul_comm_class S R (torsion' R M S) := ⟨λ s a x, subtype.ext $ smul_comm _ _ _⟩

/-- A `S`-torsion module is a module whose `S`-torsion submodule is the full space. -/
lemma is_torsion'_iff_torsion'_eq_top : is_torsion' M S ↔ torsion' R M S = ⊤ :=
⟨λ h, eq_top_iff.mpr (λ _ _, @h _), λ h x, by { rw [← @mem_torsion'_iff R, h], trivial }⟩

/-- The `S`-torsion submodule is a `S`-torsion module. -/
lemma torsion'_is_torsion' : is_torsion' (torsion' R M S) S := λ ⟨x, ⟨a, h⟩⟩, ⟨a, subtype.ext h⟩

@[simp] lemma torsion'_torsion'_eq_top : torsion' R (torsion' R M S) S = ⊤ :=
(is_torsion'_iff_torsion'_eq_top S).mp $ torsion'_is_torsion' S

/-- The torsion submodule of the torsion submodule (viewed as a module) is the full
torsion module. -/
@[simp] lemma torsion_torsion_eq_top : torsion R (torsion R M) = ⊤ := torsion'_torsion'_eq_top R⁰

/-- The torsion submodule is always a torsion module. -/
lemma torsion_is_torsion : module.is_torsion R (torsion R M) := torsion'_is_torsion' R⁰
end torsion'

section torsion
variables [comm_semiring R] [add_comm_monoid M] [module R M]
open_locale big_operators

lemma is_torsion_by_ideal_of_finite_of_is_torsion [module.finite R M] (hM : module.is_torsion R M) :
  ∃ I : ideal R, (I : set R) ∩ R⁰ ≠ ∅ ∧ module.is_torsion_by_set R M I :=
begin
  cases (module.finite_def.mp infer_instance : (⊤ : submodule R M).fg) with S h,
  refine ⟨∏ x in S, ideal.torsion_of R M x, _, _⟩,
  { refine set.nonempty.ne_empty ⟨_, _, (∏ x in S, (@hM x).some : R⁰).2⟩,
    rw [subtype.val_eq_coe, submonoid.coe_finset_prod],
    apply ideal.prod_mem_prod,
    exact λ x _, (@hM x).some_spec },
  { rw [module.is_torsion_by_set_iff_torsion_by_set_eq_top, eq_top_iff, ← h, span_le],
    intros x hx, apply torsion_by_set_le_torsion_by_set_of_subset,
    { apply ideal.le_of_dvd, exact finset.dvd_prod_of_mem _ hx },
    { rw mem_torsion_by_set_iff, rintro ⟨a, ha⟩, exact ha } }
end

variables [no_zero_divisors R] [nontrivial R]

lemma coe_torsion_eq_annihilator_ne_bot :
  (torsion R M : set M) = { x : M | (R ∙ x).annihilator ≠ ⊥ } :=
begin
  ext x, simp_rw [submodule.ne_bot_iff, mem_annihilator, mem_span_singleton],
  exact ⟨λ ⟨a, hax⟩, ⟨a, λ _ ⟨b, hb⟩, by rw [← hb, smul_comm, ← submonoid.smul_def, hax, smul_zero],
    non_zero_divisors.coe_ne_zero _⟩,
    λ ⟨a, hax, ha⟩, ⟨⟨_, mem_non_zero_divisors_of_ne_zero ha⟩, hax x ⟨1, one_smul _ _⟩⟩⟩
end

/-- A module over a domain has `no_zero_smul_divisors` iff its torsion submodule is trivial. -/
lemma no_zero_smul_divisors_iff_torsion_eq_bot :
  no_zero_smul_divisors R M ↔ torsion R M = ⊥ :=
begin
  split; intro h,
  { haveI : no_zero_smul_divisors R M := h,
    rw eq_bot_iff, rintro x ⟨a, hax⟩,
    change (a : R) • x = 0 at hax,
    cases eq_zero_or_eq_zero_of_smul_eq_zero hax with h0 h0,
    { exfalso, exact non_zero_divisors.coe_ne_zero a h0 }, { exact h0 } },
  { exact { eq_zero_or_eq_zero_of_smul_eq_zero := λ a x hax, begin
      by_cases ha : a = 0,
      { left, exact ha },
      { right, rw [← mem_bot _, ← h],
        exact ⟨⟨a, mem_non_zero_divisors_of_ne_zero ha⟩, hax⟩ }
    end } }
end
end torsion

namespace quotient_torsion

variables [comm_ring R] [add_comm_group M] [module R M]

/-- Quotienting by the torsion submodule gives a torsion-free module. -/
@[simp] lemma torsion_eq_bot : torsion R (M ⧸ torsion R M) = ⊥ :=
eq_bot_iff.mpr $ λ z, quotient.induction_on' z $ λ x ⟨a, hax⟩,
begin
  rw [quotient.mk'_eq_mk, ← quotient.mk_smul, quotient.mk_eq_zero] at hax,
  rw [mem_bot, quotient.mk'_eq_mk, quotient.mk_eq_zero],
  cases hax with b h,
  exact ⟨b * a, (mul_smul _ _ _).trans h⟩
end

instance no_zero_smul_divisors [is_domain R] : no_zero_smul_divisors R (M ⧸ torsion R M) :=
no_zero_smul_divisors_iff_torsion_eq_bot.mpr torsion_eq_bot

end quotient_torsion

section p_torsion
open module
section
variables [monoid R] [add_comm_monoid M] [distrib_mul_action R M]

lemma is_torsion'_powers_iff (p : R) :
  is_torsion' M (submonoid.powers p) ↔ ∀ x : M, ∃ n : ℕ, p ^ n • x = 0 :=
⟨λ h x, let ⟨⟨a, ⟨n, rfl⟩⟩, hx⟩ := @h x in ⟨n, hx⟩,
λ h x, let ⟨n, hn⟩ := h x in ⟨⟨_, ⟨n, rfl⟩⟩, hn⟩⟩

/--In a `p ^ ∞`-torsion module (that is, a module where all elements are cancelled by scalar
multiplication by some power of `p`), the smallest `n` such that `p ^ n • x = 0`.-/
def p_order {p : R} (hM : is_torsion' M $ submonoid.powers p) (x : M)
  [Π n : ℕ, decidable (p ^ n • x = 0)] :=
nat.find $ (is_torsion'_powers_iff p).mp hM x
@[simp] lemma pow_p_order_smul {p : R} (hM : is_torsion' M $ submonoid.powers p) (x : M)
  [Π n : ℕ, decidable (p ^ n • x = 0)] : p ^ p_order hM x • x = 0 :=
nat.find_spec $ (is_torsion'_powers_iff p).mp hM x

end
variables [comm_semiring R] [add_comm_monoid M] [module R M] [Π x : M, decidable (x = 0)]

lemma exists_is_torsion_by {p : R} (hM : is_torsion' M $ submonoid.powers p)
  (d : ℕ) (hd : d ≠ 0) (s : fin d → M) (hs : span R (set.range s) = ⊤) :
  ∃ j : fin d, module.is_torsion_by R M (p ^ p_order hM (s j)) :=
begin
  let oj := list.argmax (λ i, p_order hM $ s i) (list.fin_range d),
  have hoj : oj.is_some := (option.ne_none_iff_is_some.mp $
    λ eq_none, hd $ list.fin_range_eq_nil.mp $ list.argmax_eq_none.mp eq_none),
  use option.get hoj,
  rw [is_torsion_by_iff_torsion_by_eq_top, eq_top_iff, ← hs, submodule.span_le,
    set.range_subset_iff], intro i, change _ • _ = _,
  have : p_order hM (s i) ≤ p_order hM (s $ option.get hoj) :=
    list.le_of_mem_argmax (list.mem_fin_range i) (option.get_mem hoj),
  rw [← nat.sub_add_cancel this, pow_add, mul_smul, pow_p_order_smul, smul_zero]
end

end p_torsion
end submodule

namespace ideal.quotient

open submodule

lemma torsion_by_eq_span_singleton {R : Type*} [comm_ring R] (a b : R) (ha : a ∈ R⁰) :
  torsion_by R (R ⧸ R ∙ a * b) a = R ∙ (mk _ b) :=
begin
  ext x, rw [mem_torsion_by_iff, mem_span_singleton],
  obtain ⟨x, rfl⟩ := mk_surjective x, split; intro h,
  { rw [← mk_eq_mk, ← quotient.mk_smul, quotient.mk_eq_zero, mem_span_singleton] at h,
    obtain ⟨c, h⟩ := h, rw [smul_eq_mul, smul_eq_mul, mul_comm, mul_assoc,
      mul_cancel_left_mem_non_zero_divisor ha, mul_comm] at h,
    use c, rw [← h, ← mk_eq_mk, ← quotient.mk_smul, smul_eq_mul, mk_eq_mk] },
  { obtain ⟨c, h⟩ := h,
    rw [← h, smul_comm, ← mk_eq_mk, ← quotient.mk_smul,
      (quotient.mk_eq_zero _).mpr $ mem_span_singleton_self _, smul_zero] }
end
end ideal.quotient

namespace add_monoid

theorem is_torsion_iff_is_torsion_nat [add_comm_monoid M] :
  add_monoid.is_torsion M ↔ module.is_torsion ℕ M :=
begin
  refine ⟨λ h x, _, λ h x, _⟩,
  { obtain ⟨n, h0, hn⟩ := (is_of_fin_add_order_iff_nsmul_eq_zero x).mp (h x),
    exact ⟨⟨n, mem_non_zero_divisors_of_ne_zero $ ne_of_gt h0⟩, hn⟩ },
  { rw is_of_fin_add_order_iff_nsmul_eq_zero,
    obtain ⟨n, hn⟩ := @h x,
    refine ⟨n, nat.pos_of_ne_zero (non_zero_divisors.coe_ne_zero _), hn⟩ }
end

theorem is_torsion_iff_is_torsion_int [add_comm_group M] :
  add_monoid.is_torsion M ↔ module.is_torsion ℤ M :=
begin
  refine ⟨λ h x, _, λ h x, _⟩,
  { obtain ⟨n, h0, hn⟩ := (is_of_fin_add_order_iff_nsmul_eq_zero x).mp (h x),
    exact ⟨⟨n, mem_non_zero_divisors_of_ne_zero $ ne_of_gt $ int.coe_nat_pos.mpr h0⟩,
      (coe_nat_zsmul _ _).trans hn⟩ },
  { rw is_of_fin_add_order_iff_nsmul_eq_zero,
    obtain ⟨n, hn⟩ := @h x,
    exact exists_nsmul_eq_zero_of_zsmul_eq_zero (non_zero_divisors.coe_ne_zero n) hn }
end

end add_monoid


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.vector3
! leanprover-community/mathlib commit 3d7987cda72abc473c7cdbbb075170e9ac620042
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fin.Fin2
import Mathbin.Tactic.Localized

/-!
# Alternate definition of `vector` in terms of `fin2`

This file provides a locale `vector3` which overrides the `[a, b, c]` notation to create a `vector3`
instead of a `list`.

The `::` notation is also overloaded by this file to mean `vector3.cons`.
-/

open Fin2 Nat

universe u

variable {α : Type _} {m n : ℕ}

/-- Alternate definition of `vector` based on `fin2`. -/
def Vector3 (α : Type u) (n : ℕ) : Type u :=
  Fin2 n → α
#align vector3 Vector3

instance [Inhabited α] : Inhabited (Vector3 α n) :=
  Pi.inhabited _

namespace Vector3

/-- The empty vector -/
@[match_pattern]
def nil : Vector3 α 0 :=
  fun.
#align vector3.nil Vector3.nil

/-- The vector cons operation -/
@[match_pattern]
def cons (a : α) (v : Vector3 α n) : Vector3 α (succ n) := fun i =>
  by
  refine' i.cases' _ _
  exact a
  exact v
#align vector3.cons Vector3.cons

-- mathport name: vector.list
/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
scoped notation3"["(l", "* => foldr (h t => Vector3.cons h t) Vector3.nil)"]" => l

-- mathport name: vector.cons
notation a "::" b => cons a b

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem cons_fz (a : α) (v : Vector3 α n) : (a::v) fz = a :=
  rfl
#align vector3.cons_fz Vector3.cons_fz

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem cons_fs (a : α) (v : Vector3 α n) (i) : (a::v) (fs i) = v i :=
  rfl
#align vector3.cons_fs Vector3.cons_fs

/-- Get the `i`th element of a vector -/
@[reducible]
def nth (i : Fin2 n) (v : Vector3 α n) : α :=
  v i
#align vector3.nth Vector3.nth

/-- Construct a vector from a function on `fin2`. -/
@[reducible]
def ofFn (f : Fin2 n → α) : Vector3 α n :=
  f
#align vector3.of_fn Vector3.ofFn

/-- Get the head of a nonempty vector. -/
def head (v : Vector3 α (succ n)) : α :=
  v fz
#align vector3.head Vector3.head

/-- Get the tail of a nonempty vector. -/
def tail (v : Vector3 α (succ n)) : Vector3 α n := fun i => v (fs i)
#align vector3.tail Vector3.tail

theorem eq_nil (v : Vector3 α 0) : v = [] :=
  funext fun i => nomatch i
#align vector3.eq_nil Vector3.eq_nil

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem cons_head_tail (v : Vector3 α (succ n)) : (head v::tail v) = v :=
  funext fun i => Fin2.cases' rfl (fun _ => rfl) i
#align vector3.cons_head_tail Vector3.cons_head_tail

/-- Eliminator for an empty vector. -/
def nilElim {C : Vector3 α 0 → Sort u} (H : C []) (v : Vector3 α 0) : C v := by
  rw [eq_nil v] <;> apply H
#align vector3.nil_elim Vector3.nilElim

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Recursion principle for a nonempty vector. -/
def consElim {C : Vector3 α (succ n) → Sort u} (H : ∀ (a : α) (t : Vector3 α n), C (a::t))
    (v : Vector3 α (succ n)) : C v := by rw [← cons_head_tail v] <;> apply H
#align vector3.cons_elim Vector3.consElim

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem consElim_cons {C H a t} : @consElim α n C H (a::t) = H a t :=
  rfl
#align vector3.cons_elim_cons Vector3.consElim_cons

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Recursion principle with the vector as first argument. -/
@[elab_as_elim]
protected def recOn {C : ∀ {n}, Vector3 α n → Sort u} {n} (v : Vector3 α n) (H0 : C [])
    (Hs : ∀ {n} (a) (w : Vector3 α n), C w → C (a::w)) : C v :=
  Nat.recOn n (fun v => v.nilElim H0) (fun n IH v => v.consElim fun a t => Hs _ _ (IH _)) v
#align vector3.rec_on Vector3.recOn

@[simp]
theorem recOn_nil {C H0 Hs} : @Vector3.recOn α (@C) 0 [] H0 @Hs = H0 :=
  rfl
#align vector3.rec_on_nil Vector3.recOn_nil

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem recOn_cons {C H0 Hs n a v} :
    @Vector3.recOn α (@C) (succ n) (a::v) H0 @Hs = Hs a v (@Vector3.recOn α (@C) n v H0 @Hs) :=
  rfl
#align vector3.rec_on_cons Vector3.recOn_cons

/-- Append two vectors -/
def append (v : Vector3 α m) (w : Vector3 α n) : Vector3 α (n + m) :=
  Nat.recOn m (fun _ => w)
    (fun m IH v => v.consElim fun a t => @Fin2.cases' (n + m) (fun _ => α) a (IH t)) v
#align vector3.append Vector3.append

-- mathport name: «expr +-+ »
local infixl:65 " +-+ " => Vector3.append

@[simp]
theorem append_nil (w : Vector3 α n) : [] +-+ w = w :=
  rfl
#align vector3.append_nil Vector3.append_nil

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem append_cons (a : α) (v : Vector3 α m) (w : Vector3 α n) : (a::v) +-+ w = a::v +-+ w :=
  rfl
#align vector3.append_cons Vector3.append_cons

@[simp]
theorem append_left :
    ∀ {m} (i : Fin2 m) (v : Vector3 α m) {n} (w : Vector3 α n), (v +-+ w) (left n i) = v i
  | _, @fz m, v, n, w => v.consElim fun a t => by simp [*, left]
  | _, @fs m i, v, n, w => v.consElim fun a t => by simp [*, left]
#align vector3.append_left Vector3.append_left

@[simp]
theorem append_add :
    ∀ {m} (v : Vector3 α m) {n} (w : Vector3 α n) (i : Fin2 n), (v +-+ w) (add i m) = w i
  | 0, v, n, w, i => rfl
  | succ m, v, n, w, i => v.consElim fun a t => by simp [*, add]
#align vector3.append_add Vector3.append_add

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Insert `a` into `v` at index `i`. -/
def insert (a : α) (v : Vector3 α n) (i : Fin2 (succ n)) : Vector3 α (succ n) := fun j =>
  (a::v) (insertPerm i j)
#align vector3.insert Vector3.insert

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem insert_fz (a : α) (v : Vector3 α n) : insert a v fz = a::v := by
  refine' funext fun j => j.cases' _ _ <;> intros <;> rfl
#align vector3.insert_fz Vector3.insert_fz

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem insert_fs (a : α) (b : α) (v : Vector3 α n) (i : Fin2 (succ n)) :
    insert a (b::v) (fs i) = b::insert a v i :=
  funext fun j => by
    refine' j.cases' _ fun j => _ <;> simp [insert, insert_perm]
    refine' Fin2.cases' _ _ (insert_perm i j) <;> simp [insert_perm]
#align vector3.insert_fs Vector3.insert_fs

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem append_insert (a : α) (t : Vector3 α m) (v : Vector3 α n) (i : Fin2 (succ n))
    (e : succ n + m = succ (n + m)) :
    insert a (t +-+ v) (Eq.recOn e (i.add m)) = Eq.recOn e (t +-+ insert a v i) :=
  by
  refine' Vector3.recOn t (fun e => _) (fun k b t IH e => _) e; rfl
  have e' := succ_add n k
  change
    insert a (b::t +-+ v) (Eq.recOn (congr_arg succ e') (fs (add i k))) =
      Eq.recOn (congr_arg succ e') (b::t +-+ insert a v i)
  rw [←
    (Eq.drecOn e' rfl :
      fs (Eq.recOn e' (i.add k) : Fin2 (succ (n + k))) =
        Eq.recOn (congr_arg succ e') (fs (i.add k)))]
  simp; rw [IH]; exact Eq.drecOn e' rfl
#align vector3.append_insert Vector3.append_insert

end Vector3

section Vector3

open Vector3

open Vector3

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- "Curried" exists, i.e. `∃ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def VectorEx : ∀ k, (Vector3 α k → Prop) → Prop
  | 0, f => f []
  | succ k, f => ∃ x : α, VectorEx k fun v => f (x::v)
#align vector_ex VectorEx

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- "Curried" forall, i.e. `∀ x₁ ... xₙ, f [x₁, ..., xₙ]`. -/
def VectorAll : ∀ k, (Vector3 α k → Prop) → Prop
  | 0, f => f []
  | succ k, f => ∀ x : α, VectorAll k fun v => f (x::v)
#align vector_all VectorAll

theorem exists_vector_zero (f : Vector3 α 0 → Prop) : Exists f ↔ f [] :=
  ⟨fun ⟨v, fv⟩ => by rw [← eq_nil v] <;> exact fv, fun f0 => ⟨[], f0⟩⟩
#align exists_vector_zero exists_vector_zero

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem exists_vector_succ (f : Vector3 α (succ n) → Prop) : Exists f ↔ ∃ x v, f (x::v) :=
  ⟨fun ⟨v, fv⟩ => ⟨_, _, by rw [cons_head_tail v] <;> exact fv⟩, fun ⟨x, v, fxv⟩ => ⟨_, fxv⟩⟩
#align exists_vector_succ exists_vector_succ

theorem vectorEx_iff_exists : ∀ {n} (f : Vector3 α n → Prop), VectorEx n f ↔ Exists f
  | 0, f => (exists_vector_zero f).symm
  | succ n, f => Iff.trans (exists_congr fun x => vectorEx_iff_exists _) (exists_vector_succ f).symm
#align vector_ex_iff_exists vectorEx_iff_exists

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem vectorAll_iff_forall : ∀ {n} (f : Vector3 α n → Prop), VectorAll n f ↔ ∀ v, f v
  | 0, f => ⟨fun f0 v => v.nilElim f0, fun al => al []⟩
  | succ n, f =>
    (forall_congr' fun x => vectorAll_iff_forall fun v => f (x::v)).trans
      ⟨fun al v => v.consElim al, fun al x v => al (x::v)⟩
#align vector_all_iff_forall vectorAll_iff_forall

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def VectorAllp (p : α → Prop) (v : Vector3 α n) : Prop :=
  Vector3.recOn v True fun n a v IH =>
    @Vector3.recOn _ (fun n v => Prop) _ v (p a) fun n b v' _ => p a ∧ IH
#align vector_allp VectorAllp

@[simp]
theorem vectorAllp_nil (p : α → Prop) : VectorAllp p [] = True :=
  rfl
#align vector_allp_nil vectorAllp_nil

@[simp]
theorem vectorAllp_singleton (p : α → Prop) (x : α) : VectorAllp p [x] = p x :=
  rfl
#align vector_allp_singleton vectorAllp_singleton

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem vectorAllp_cons (p : α → Prop) (x : α) (v : Vector3 α n) :
    VectorAllp p (x::v) ↔ p x ∧ VectorAllp p v :=
  Vector3.recOn v (and_true_iff _).symm fun n a v IH => Iff.rfl
#align vector_allp_cons vectorAllp_cons

theorem vectorAllp_iff_forall (p : α → Prop) (v : Vector3 α n) : VectorAllp p v ↔ ∀ i, p (v i) :=
  by
  refine' v.rec_on _ _
  · exact ⟨fun _ => Fin2.elim0, fun _ => trivial⟩
  · simp
    refine' fun n a v IH =>
      (and_congr_right fun _ => IH).trans
        ⟨fun ⟨pa, h⟩ i => by
          refine' i.cases' _ _
          exacts[pa, h], fun h => ⟨_, fun i => _⟩⟩
    · have h0 := h fz
      simp at h0
      exact h0
    · have hs := h (fs i)
      simp at hs
      exact hs
#align vector_allp_iff_forall vectorAllp_iff_forall

theorem VectorAllp.imp {p q : α → Prop} (h : ∀ x, p x → q x) {v : Vector3 α n}
    (al : VectorAllp p v) : VectorAllp q v :=
  (vectorAllp_iff_forall _ _).2 fun i => h _ <| (vectorAllp_iff_forall _ _).1 al _
#align vector_allp.imp VectorAllp.imp

end Vector3


import lib.lib tactic data.set_like.basic logic translation

universes u v

namespace fol
open_locale logic_symbol

structure language : Type (u+1) :=
(fn : ℕ → Type u)
(pr : ℕ → Type u)

namespace language
variables (L : language.{u})

protected def empty : language.{u} :=
{ fn := λ _, pempty, pr := λ _, pempty }

instance (n) : is_empty (language.empty.fn n) := ⟨by rintros ⟨⟩⟩

instance (n) : is_empty (language.empty.pr n) := ⟨by rintros ⟨⟩⟩

instance (n) : has_to_string (language.empty.fn n) := ⟨by rintros ⟨⟩⟩

instance (n) : has_to_string (language.empty.pr n) := ⟨by rintros ⟨⟩⟩

class has_equal (L : language) := (eq : L.pr 2)

end language

variables (L : language.{u}) (μ : Type v)

inductive subterm (n : ℕ) : Type (max u v)
| metavar {} : μ → subterm
| var     {} : fin n → subterm
| function   : ∀ {k}, L.fn k → (fin k → subterm) → subterm

@[reducible] def term := subterm L μ 0

@[reducible] def bounded_subterm (m n : ℕ) := subterm L (fin m) n

@[reducible] def bounded_term (m : ℕ) := bounded_subterm L m 0

variables {L μ}

namespace subterm
variables {n : ℕ}

prefix `#`:max := subterm.var
prefix `&`:max := subterm.metavar

def term.const (f : L.fn 0) : subterm L μ n := function f finitary.nil

instance [inhabited μ] : inhabited (subterm L μ n) := ⟨&default⟩

variables (L μ n)

instance inhabited_of_inhabited [inhabited (L.fn 0)] : inhabited (subterm L μ n) := ⟨function default fin.nil⟩

end subterm

variables (L μ)
inductive subformula : ℕ → Type (max u v)
| verum    {n} : subformula n
| relation {n} : ∀ {k}, L.pr k → (fin k → subterm L μ n) → subformula n
| imply    {n} : subformula n → subformula n → subformula n
| neg      {n} : subformula n → subformula n
| fal      {n} : subformula (n + 1) → subformula n

attribute [pattern]  has_negation.neg has_arrow.arrow has_univ_quantifier'.univ has_exists_quantifier'.ex

@[reducible] def formula := subformula L μ 0

@[reducible] def bounded_subformula (m n : ℕ) := subformula L (fin m) n

@[reducible] def bounded_formula (m : ℕ) := bounded_subformula L m 0

@[reducible] def sentence := bounded_formula L 0

namespace subformula
variables {L μ} {n : ℕ}

def and (p : subformula L μ n) (q : subformula L μ n) : subformula L μ n := (p.imply q.neg).neg

def or (p : subformula L μ n) (q : subformula L μ n) : subformula L μ n := p.neg.imply q

def ex (p : subformula L μ (n + 1)) : subformula L μ n := p.neg.fal.neg

instance : has_logic_symbol (subformula L μ n) :=
{ bot := verum.neg,
  top := verum,
  sup := or,
  inf := and,
  arrow := imply,
  neg := neg }

instance : inhabited (subformula L μ n) := ⟨⊤⟩

def equal [L.has_equal] (t u : subterm L μ n) : subformula L μ n := relation language.has_equal.eq (t *> u *> fin.nil)

instance [L.has_equal] : has_eq (subterm L μ n) (subformula L μ n) := ⟨equal⟩

instance : has_univ_quantifier' (subformula L μ) := ⟨@fal L μ⟩

instance : has_exists_quantifier' (subformula L μ) := ⟨@ex L μ⟩

lemma top_eq : @subformula.verum L μ n = (⊤) := rfl
lemma imply_eq : @subformula.imply L μ n = (⟶) := rfl
lemma equal_eq [L.has_equal] : @equal L μ n _ = (=') := rfl
lemma neg_eq : @subformula.neg L μ n = has_negation.neg := rfl
lemma fal_eq : @subformula.fal L μ n = has_univ_quantifier'.univ := rfl
lemma ex_eq : @subformula.ex L μ n = has_exists_quantifier'.ex := rfl

lemma ex_def (p : subformula L μ (n + 1)) : ∃'p = ∼∀'∼p := rfl

lemma bot_def : (⊥ : subformula L μ n) = ∼⊤ := rfl

@[simp] lemma equal.inj' [L.has_equal] (t₁ u₁ t₂ u₂ : subterm L μ n) : (t₁ =' t₂ : subformula L μ n) = (u₁ =' u₂) ↔ t₁ = u₁ ∧ t₂ = u₂ :=
⟨by simp[←equal_eq, equal]; intros h₁ h₂; exact ⟨h₁, h₂⟩, by simp; exact congr_arg2 (=')⟩

@[simp] lemma imply.inj' (p₁ q₁ p₂ q₂ : subformula L μ n) : p₁ ⟶ p₂ = q₁ ⟶ q₂ ↔ p₁ = q₁ ∧ p₂ = q₂ :=
⟨imply.inj, by simp; exact congr_arg2 (⟶)⟩

@[simp] lemma neg.inj' (p q : subformula L μ n) : ∼p = ∼q ↔ p = q := ⟨neg.inj, congr_arg _⟩

@[simp] lemma and.inj' (p₁ q₁ p₂ q₂ : subformula L μ n) : p₁ ⊓ p₂ = q₁ ⊓ q₂ ↔ p₁ = q₁ ∧ p₂ = q₂ :=
by simp[has_inf.inf, and]

@[simp] lemma or.inj' (p₁ q₁ p₂ q₂ : subformula L μ n) : p₁ ⊔ p₂ = q₁ ⊔ q₂ ↔ p₁ = q₁ ∧ p₂ = q₂ :=
by simp[has_sup.sup, or]

@[simp] lemma fal.inj' (p q : subformula L μ (n + 1)) : (∀'p : subformula L μ n) = ∀'q ↔ p = q := ⟨fal.inj, congr_arg _⟩

@[simp] lemma ex.inj' (p q : subformula L μ (n + 1)) : (∃'p : subformula L μ n) = ∃'q ↔ p = q :=
by simp[has_exists_quantifier'.ex, ex]

section ne
variables {k : ℕ} (r : L.pr k) (v : finitary (subterm L μ n) k) (t u : subterm L μ n)
  (p p₁ p₂ : subformula L μ n) (q : subformula L μ (n + 1))

@[simp] lemma verum_ne_predicate : ⊤ ≠ relation r v.
@[simp] lemma verum_ne_imply : ⊤ ≠ (p₁ ⟶ p₂).
@[simp] lemma verum_ne_neg : ⊤ ≠ ∼p.
@[simp] lemma verum_ne_fal : ⊤ ≠ ∀'q.
@[simp] lemma predicate_ne_verum : relation r v ≠ ⊤.
@[simp] lemma predicate_ne_imply : relation r v ≠ p₁ ⟶ p₂.
@[simp] lemma predicate_ne_neg : relation r v ≠ ∼p.
@[simp] lemma predicate_ne_fal : relation r v ≠ ∀'q.
@[simp] lemma imply_ne_verum : p₁ ⟶ p₂ ≠ ⊤.
@[simp] lemma imply_ne_relation : p₁ ⟶ p₂ ≠ relation r v.
@[simp] lemma imply_ne_neg : p₁ ⟶ p₂ ≠ ∼p.
@[simp] lemma imply_ne_fal : p₁ ⟶ p₂ ≠ ∀'q.
@[simp] lemma neg_ne_verum : ∼p ≠ ⊤.
@[simp] lemma neg_ne_relation : ∼p ≠ relation r v.
@[simp] lemma neg_ne_imply : ∼p ≠ p₁ ⟶ p₂.
@[simp] lemma neg_ne_fal : ∼p ≠ ∀'q.
@[simp] lemma fal_ne_verum : ∀'q ≠ ⊤.
@[simp] lemma fal_ne_relation : ∀'q ≠ relation r v.
@[simp] lemma fal_ne_imply : ∀'q ≠ p₁ ⟶ p₂.
@[simp] lemma fal_ne_neg : ∀'q ≠ ∼p.

end ne

@[simp] def complexity : Π {n}, subformula L μ n → ℕ
| n verum          := 0
| n (relation p v) := 0
| n (imply p q)    := max p.complexity q.complexity + 1
| n (neg p)        := p.complexity + 1
| n (fal p)        := p.complexity + 1

@[simp] lemma complexity_top : (⊤ : subformula L μ n).complexity = 0 := by refl

@[simp] lemma complexity_neg (p : subformula L μ n) : (∼p).complexity = p.complexity + 1 := by refl

@[simp] lemma complexity_fal (p : subformula L μ (n + 1)) : (∀'p).complexity = p.complexity + 1 := by refl

@[simp] lemma imply_complexity (p q : subformula L μ n) : (p ⟶ q).complexity = max p.complexity q.complexity + 1 := by refl

def ind {C : Π n, subformula L μ n → Sort*}
  (hverum : Π {n : ℕ}, C n ⊤)
  (hrelation : Π {n l : ℕ} (r : L.pr l) (v : fin l → subterm L μ n), C n (relation r v))
  (himply : Π {n : ℕ} (p q : subformula L μ n), C n p → C n q → C n (p ⟶ q))
  (hneg : Π {n : ℕ} (p : subformula L μ n), C n p → C n ∼p)
  (hfal : Π {n : ℕ} (p : subformula L μ (n + 1)), C (n + 1) p → C n (∀'p)) :
  Π {n : ℕ} (p : subformula L μ n), C n p
| n verum := hverum
| n (relation r v) := hrelation r v
| n (imply p q)    := himply p q (ind p) (ind q)
| n (neg p)        := hneg p (ind p)
| n (fal p)        := hfal p (ind p)

--普通に帰納法をすると論理記号で表示されないから
@[elab_as_eliminator]
protected def ind_on {C : Π n, subformula L μ n → Sort*}
  {n : ℕ} (p : subformula L μ n)
  (verum : Π {n : ℕ}, C n ⊤)
  (relation : Π {n l : ℕ} (r : L.pr l) (v : fin l → subterm L μ n), C n (relation r v))
  (imply : Π {n : ℕ} (p q : subformula L μ n), C n p → C n q → C n (p ⟶ q))
  (neg : Π {n : ℕ} (p : subformula L μ n), C n p → C n ∼p)
  (fal : Π {n : ℕ} (p : subformula L μ (n + 1)), C (n + 1) p → C n (∀'p)) :
  C n p :=
ind @verum @relation @imply @neg @fal p

def ind_succ {C : Π n, subformula L μ (n + 1) → Sort*}
  (hverum : Π {n : ℕ}, C n ⊤)
  (hrelation : Π {n l : ℕ} (r : L.pr l) (v : fin l → subterm L μ (n + 1)), C n (relation r v))
  (himply : Π {n : ℕ} (p q : subformula L μ (n + 1)), C n p → C n q → C n (p ⟶ q))
  (hneg : Π {n : ℕ} (p : subformula L μ (n + 1)), C n p → C n ∼p)
  (hfal : Π {n : ℕ} (p : subformula L μ (n + 1 + 1)), C (n + 1) p → C n (∀'p)) :
  Π {n : ℕ} (p : subformula L μ (n + 1)), C n p
| n verum := hverum
| n (relation r v) := hrelation r v
| n (imply p q)    := himply p q (ind_succ p) (ind_succ q)
| n (neg p)        := hneg p (ind_succ p)
| n (fal p)        := hfal p (ind_succ p)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.complexity)⟩]}

@[elab_as_eliminator]
def ind_succ_on {C : Π n, subformula L μ (n + 1) → Sort*}
  {n : ℕ} (p : subformula L μ (n + 1))
  (verum : Π {n : ℕ}, C n ⊤)
  (relation : Π {n l : ℕ} (r : L.pr l) (v : fin l → subterm L μ (n + 1)), C n (relation r v))
  (imply : Π {n : ℕ} (p q : subformula L μ (n + 1)), C n p → C n q → C n (p ⟶ q))
  (neg : Π {n : ℕ} (p : subformula L μ (n + 1)), C n p → C n ∼p)
  (fal : Π {n : ℕ} (p : subformula L μ (n + 1 + 1)), C (n + 1) p → C n (∀'p)) :
  C n p :=
ind_succ @verum @relation @imply @neg @fal p

end subformula

@[reducible] def preTheory (L : language.{u}) (μ) := logic.Theory (subformula L μ 0)

@[reducible] def bounded_preTheory (L : language.{u}) (m : ℕ) := logic.Theory (subformula L (fin m) 0)

@[reducible] def Theory (L : language.{u}) := logic.Theory (subformula L (fin 0) 0)

namespace subterm

variables {L μ} {μ₁ : Type*} {μ₂ : Type*} {n : ℕ}

def const {n} (c : L.fn 0) : subterm L μ n := function c fin.nil

@[simp] def rew (s : μ₁ → subterm L μ₂ n) : subterm L μ₁ n → subterm L μ₂ n
| (&x)           := s x
| (#x)           := #x
| (function f v) := function f (λ i, (v i).rew)

def map (f : μ₁ → μ₂) : subterm L μ₁ n → subterm L μ₂ n := rew (λ x, &(f x))

section rew
variables {s : μ₁ → subterm L μ₂ n}

@[simp] lemma map_metavar (f : μ₁ → μ₂) (x) : map f (&x : subterm L μ₁ n) = &(f x) := rfl

@[simp] lemma map_var (f : μ₁ → μ₂) (x) : map f (#x : subterm L μ₁ n) = #x := rfl

@[simp] lemma map_function (f : μ₁ → μ₂) {k} (g : L.fn k) (v : fin k → subterm L μ₁ n) :
  map f (function g v) = function g (λ i, map f (v i)) := rfl

lemma eq_rew_of_eq {t : subterm L μ₁ n} {s₁ s₂ : μ₁ → subterm L μ₂ n} (h : s₁ = s₂) :
  rew s₁ t = rew s₂ t := by rw[h]

lemma rew_rew {μ₁ μ₂ μ₃} (s₀ : μ₁ → subterm L μ₂ n) (s₁ : μ₂ → subterm L μ₃ n) :
  ∀ t, rew s₁ (rew s₀ t) = rew (λ i, rew s₁ (s₀ i)) t
| (&x)           := by simp
| (#x)           := by simp
| (function f v) := by simp; funext i; exact rew_rew (v i)

@[simp] lemma map_map {μ₁ μ₂ μ₃} (f₁ : μ₁ → μ₂) (f₂ : μ₂ → μ₃) (t : subterm L μ₁ n) :
  map f₂ (map f₁ t) = map (f₂ ∘ f₁) t :=
by simp[map, rew_rew]

@[simp] lemma rew_metavar (t : subterm L μ n) : rew metavar t = t :=
by induction t; simp*

@[simp] lemma map_id (t : subterm L μ n) : map id t = t := by simp[map]

lemma map_inj_of_inj (f : μ₁ → μ₂) (I : function.injective f) :
  function.injective (map f : subterm L μ₁ n → subterm L μ₂ n)
| &x               &y               := by simp[map]; exact λ h, I h
| &x               #y               := by simp[map]
| &x               (function f v)   := by simp[map]
| #x               &y               := by simp[map]
| #x               #y               := by simp[map]
| #x               (function f v)   := by simp[map]
| (function f₁ v₁) &y               := by simp[map]
| (function f₁ v₁) #y               := by simp[map]
| (function f₁ v₁) (function f₂ v₂) :=
  by { simp[map], rintros rfl rfl,
       simp, intros h, funext i, exact @map_inj_of_inj (v₁ i) (v₂ i) (congr_fun h i) }

end rew

@[simp] def lift : subterm L μ n → subterm L μ (n + 1)
| #x             := #x.succ
| &x             := &x
| (function f v) := function f (λ i, (v i).lift)

section lift

lemma lift_rew (s : μ₁ → subterm L μ₂ n) (t : subterm L μ₁ n) : (t.rew s).lift = t.lift.rew (λ i, lift (s i)) :=
by induction t with x x p f v IH; simp; exact funext IH

@[simp] lemma lift_metavar : lift ∘ (metavar : μ → subterm L μ n) = metavar :=
funext (by simp)

variables {μ₁ μ₂} {f : μ₁ → μ₂}

lemma map_lift (t : subterm L μ₁ n) : map f t.lift = (map f t).lift :=
by induction t; simp*

end lift

section subst

/-
  #0 #1 ... #(n-1) #n &x ...
            ↓subst u
  #0 #1 ... #(n-1) u  &x ...
-/

def subst (u : subterm L μ n) : subterm L μ (n + 1) → subterm L μ n
| &x             := &x
| #x             := (var <* u) x
| (function f v) := function f (λ i, subst $ v i)

variables (u : subterm L μ n)

@[simp] lemma subst_metavar (x) : subst u (&x : subterm L μ (n + 1)) = &x := rfl

@[simp] lemma subst_var_last : subst u (#(fin.last n) : subterm L μ (n + 1)) = u := by simp[subst]

@[simp] lemma subst_var_cast (x : fin n) : subst u (#(x.cast_succ) : subterm L μ (n + 1)) = #x := by simp[subst]

@[simp] lemma subst_var_function {k} (f : L.fn k) (v : fin k → subterm L μ (n + 1)) :
  subst u (function f v) = function f (λ i, subst u $ v i) := by simp[subst]

variables {μ₁ μ₂} (f : μ₁ → μ₂)

lemma map_subst (u : subterm L μ₁ n) (t : subterm L μ₁ (n + 1)) :
  (subst u t).map f = subst (u.map f) (t.map f) :=
by { induction t; simp*, case var : x { refine fin.last_cases _ _ x; simp } }

end subst

section bounded_subterm
variables {L} {m m₁ m₂ : ℕ} {n}

def mlift : bounded_subterm L m n → bounded_subterm L (m + 1) n := map fin.cast_succ

section mlift

@[simp] lemma mlift_metavar (x : fin m) : (&x : bounded_subterm L m n).mlift = &x.cast_succ := rfl

@[simp] lemma mlift_var (x : fin n) : (#x : bounded_subterm L m n).mlift = #x := rfl

@[simp] lemma mlift_function {k} (f : L.fn k) (v : fin k → bounded_subterm L m n) :
  (function f v).mlift = function f (λ i, (v i).mlift) := rfl

lemma mlift_rew (s : fin m₁ → bounded_subterm L m₂ n) (t : bounded_subterm L m₁ n) : (t.rew s).mlift = t.rew (mlift ∘ s) :=
by induction t with x x p f v IH; simp; exact funext IH

lemma mlift_lift (t : bounded_subterm L m n) : t.mlift.lift = t.lift.mlift :=
by induction t; simp*

lemma mlift_inj : function.injective (@mlift L m n) := map_inj_of_inj _ (rel_embedding.injective _)

@[simp] lemma mlift_subst (u : bounded_subterm L m n) (t : bounded_subterm L m (n + 1)) :
  (subst u t).mlift = subst u.mlift t.mlift :=
by { induction t; simp*, case var : x { refine fin.last_cases _ _ x; simp } }

def cast_le (h : m₁ ≤ m₂) : bounded_subterm L m₁ n → bounded_subterm L m₂ n := map (fin.cast_le h)

variables {m₁ m₂} (h : m₁ ≤ m₂)

@[simp] lemma cast_le_metavar (x : fin m₁) : cast_le h (&x : bounded_subterm L m₁ n) = &(fin.cast_le h x) :=
by simp[cast_le]

@[simp] lemma cast_le_var (x : fin n) : cast_le h (#x : bounded_subterm L m₁ n) = #x :=
by simp[cast_le]

@[simp] lemma cast_le_function {k} (f : L.fn k) (v : fin k → bounded_subterm L m₁ n) :
  cast_le h (function f v) = function f (λ i, cast_le h (v i)) :=
by simp[cast_le]

@[simp] lemma cast_le_inj (p q : bounded_subterm L m₁ n) : cast_le h p = cast_le h q ↔ p = q :=
⟨λ h, map_inj_of_inj _ (rel_embedding.injective _) h, λ h, by simp[h]⟩

@[simp] lemma case_le_lift (t : bounded_subterm L m₁ n) : (cast_le h t).lift = cast_le h t.lift :=
by induction t; simp*

@[simp] lemma cast_le_mlift (t : bounded_subterm L m₁ n) (h : m₁ + 1 ≤ m₂) :
  cast_le h (mlift t) = cast_le (nat.le_of_succ_le h) t :=
by { induction t; simp*, case metavar : x { ext; simp } }

@[simp] lemma mlift_cast_le (t : bounded_subterm L m₁ n) (h : m₁ ≤ m₂) :
  mlift (cast_le h t) = cast_le (le_add_right h) t :=
by { induction t; simp*, case metavar : x { ext; simp } }

end mlift

/-
  #0 #1 #2 #3 #4 ... #(n - 1) #n &(m - 1) ... &3 &2 &1 &0
      ↓push                       ↑pull
  #0 #1 #2 #3 #4 ... #(n - 1) &m &(m - 1) ... &3 &2 &1 &0
-/

def push : bounded_subterm L m (n + 1) → bounded_subterm L (m + 1) n
| (&x)           := &x.cast_succ
| (#x)           := (var <* &(fin.last m)) x
| (function f v) := function f (λ i, (v i).push)

section push

@[simp] lemma push_metavar (x) : (&x : bounded_subterm L m (n + 1)).push = &x.cast_succ := rfl

@[simp] lemma push_var_last : (#(fin.last n) : bounded_subterm L m (n + 1)).push = &(fin.last m) := by simp[push]

@[simp] lemma push_var_cast (x) : (#(fin.cast_succ x) : bounded_subterm L m (n + 1)).push = #x := by simp[push]

@[simp] lemma push_function {k} (f : L.fn k) (v : fin k → bounded_subterm L m (n + 1)) :
  (function f v).push = function f (push ∘ v) := by simp[push]

lemma push_lift_comm (t : bounded_subterm L m (n + 1)) : t.lift.push = t.push.lift :=
by { induction t; simp*,
     case var : x { refine fin.last_cases _ _ x; simp[fin.succ_cast_succ], },
     case function : k f v IH
     { funext i, exact IH i } }

@[simp] lemma subst_mlift (t : bounded_subterm L m (n + 1)) : subst &(fin.last m) (mlift t) = push t :=
by { induction t; simp*, case var : x { refine fin.last_cases _ _ x; simp } }

end push

def pull : bounded_subterm L (m + 1) n → bounded_subterm L m (n + 1)
| (&x)           := (metavar <* #(fin.last n)) x
| (#x)           := #x.cast_succ
| (function f v) := function f (λ i, (v i).pull)

section pull

@[simp] lemma pull_metavar_zero : (&(fin.last m) : bounded_subterm L (m + 1) n).pull = #(fin.last n) := by simp[pull]

@[simp] lemma pull_metavar_succ (x : fin m) : (&x.cast_succ : bounded_subterm L (m + 1) n).pull = &x := by simp[pull]

@[simp] lemma pull_var (x) : (#x : bounded_subterm L (m + 1) n).pull = #x.cast_succ := by simp[pull]

@[simp] lemma pull_function {k} (f : L.fn k) (v : fin k → bounded_subterm L (m + 1) n) :
  (function f v).pull = function f (λ i, (v i).pull) := by simp[pull]

@[simp] lemma pull_push (t : bounded_subterm L m (n + 1)) : t.push.pull = t :=
by{ induction t,
    case metavar : x { simp, },
    case var : x { refine fin.last_cases _ _ x; simp },
    case function : p f v IH { simp, funext x, simp[IH] } }

@[simp] lemma push_pull (t : bounded_subterm L (m + 1) n) : t.pull.push = t :=
by{ induction t,
    case metavar : x { refine fin.last_cases _ _ x; simp },
    case var : x { simp },
    case function : p f v IH { simp, funext x, simp[IH] } }

lemma push_rew_pull (t : bounded_subterm L (m₁ + 1) n) (s : fin m₁ → bounded_subterm L m₂ (n + 1)) :
  (rew s t.pull).push = rew (push ∘ s <* &(fin.last m₂)) t :=
by { induction t; simp*,
      case metavar : x { refine fin.last_cases _ _ x; simp },
      case function : k f v IH
      { funext i, exact IH i } }

lemma pull_lift_comm (t : bounded_subterm L (m + 1) n) : t.lift.pull = t.pull.lift :=
by { induction t; simp[*, fin.succ_cast_succ],
     case metavar : x { refine fin.last_cases _ _ x; simp } }

end pull

def dummy : bounded_subterm L m n → bounded_subterm L m (n + 1) := pull ∘ mlift

section dummy

@[simp] lemma dummy_metavar (x) : dummy (&x : bounded_subterm L m n) = &x := by simp[dummy]

@[simp] lemma dummy_var (x) : dummy (#x : bounded_subterm L m n) = #x.cast_succ := by simp[dummy]

@[simp] lemma dummy_function {k} (f : L.fn k) (v : fin k → bounded_subterm L m n) :
  dummy (function f v) = function f (λ i, dummy (v i)) := by simp[dummy]

@[simp] lemma dummy_subst (u : bounded_subterm L m n) (t : bounded_subterm L m n) :
  subst u t.dummy = t :=
by induction t; simp*

lemma dummy_lift_comm (t : bounded_subterm L m n) :
  t.lift.dummy = t.dummy.lift :=
by simp[dummy, ←mlift_lift, pull_lift_comm]

end dummy

end bounded_subterm

end subterm

namespace subformula
open subterm finitary
variables {L μ} {μ₁ : Type*} {μ₂ : Type*} {n : ℕ}

section rew

def rew' {μ₁ μ₂} : Π {n}, (μ₁ → subterm L μ₂ n) → subformula L μ₁ n → subformula L μ₂ n
| n s verum          := ⊤
| n s (relation p v) := relation p (λ i, (v i).rew s)
| n s (imply p q)    := p.rew' s ⟶ q.rew' s
| n s (neg p)        := ∼p.rew' s
| n s (fal p)        := ∀'p.rew' (subterm.lift ∘ s)

def rew (s : μ₁ → subterm L μ₂ n) : subformula L μ₁ n →ₗ subformula L μ₂ n :=
{ to_fun := rew' s,
  map_neg' := λ p, by refl,
  map_imply' := λ p q, by refl,
  map_and' := λ p q, by refl,
  map_or' := λ p q, by refl,
  map_top' := by refl,
  map_bot' := by refl }

def map (f : μ₁ → μ₂) : subformula L μ₁ n →ₗ subformula L μ₂ n := rew (λ x, &(f x))

variables (s : μ₁ → subterm L μ₂ n) (f : μ₁ → μ₂)

lemma rew_def (p : subformula L μ₁ n) : rew s p = rew' s p := rfl

variables {s}

@[simp] lemma rew_relation {k} (r : L.pr k) (v) :
  rew s (relation r v) = relation r (λ x, subterm.rew s (v x)) := rfl

@[simp] lemma rew_fal (p : subformula L μ₁ (n + 1)) :
  rew s (∀'p) = ∀'rew (λ x, (s x).lift) p := rfl

@[simp] lemma rew_ex (p : subformula L μ₁ (n + 1)) :
  rew s (∃'p) = ∃'rew (λ x, (s x).lift) p := by simp[ex_def]

@[simp] lemma map_relation {k} (r : L.pr k) (v : fin k → subterm L μ₁ n) :
  map f (relation r v) = relation r (λ x, subterm.map f (v x)) := rfl

@[simp] lemma map_fal (p : subformula L μ₁ (n + 1)) :
  map f (∀'p) = ∀'map f p := rfl

@[simp] lemma map_ex (p : subformula L μ₁ (n + 1)) :
  map f (∃'p) = ∃'map f p := by simp[ex_def]

lemma rew_eq_self_of_eq {s : μ → subterm L μ n} (h : s = metavar) (p : subformula L μ n) : rew s p = p :=
by induction p using fol.subformula.ind_on; simp[subterm.mlift_rew, *]

@[simp] lemma rew_metavar (p : subformula L μ n) : rew metavar p = p := rew_eq_self_of_eq rfl p

@[simp] lemma map_id (p : subformula L μ n) : map id p = p := rew_eq_self_of_eq rfl p

lemma eq_rew_of_eq {p : subformula L μ₁ n} {s₁ s₂ : μ₁ → subterm L μ₂ n} (h : s₁ = s₂) :
  rew s₁ p = rew s₂ p := by rw[h]

lemma rew_rew {μ₁ μ₂ μ₃} : ∀ {n} (p : subformula L μ₁ n) (s₀ : μ₁ → subterm L μ₂ n) (s₁ : μ₂ → subterm L μ₃ n),
  rew s₁ (rew s₀ p) = rew (λ x, subterm.rew s₁ (s₀ x)) p
| n verum          s₀ s₁ := by simp[top_eq]
| n (relation p v) s₀ s₁ := by simp; funext; simp[subterm.rew_rew]
| n (imply p q)    s₀ s₁ := by simp[imply_eq, rew_rew p, rew_rew q]
| n (neg p)        s₀ s₁ := by simp[neg_eq, rew_rew p]
| n (fal p)        s₀ s₁ := by simp[fal_eq, rew_rew p]; refine eq_rew_of_eq (by funext x; simp[subterm.lift_rew])

@[simp] lemma map_map {μ₁ μ₂ μ₃} (f₁ : μ₁ → μ₂) (f₂ : μ₂ → μ₃) (p : subformula L μ₁ n) :
  map f₂ (map f₁ p) = map (f₂ ∘ f₁) p :=
by simp[map, rew_rew]

@[simp] lemma complexity_rew (p : subformula L μ₁ n) : complexity (rew s p) = complexity p :=
by induction p using fol.subformula.ind_on; simp*

lemma map_inj_of_inj (f : μ₁ → μ₂) (I : function.injective f) :
  function.injective (map f : subformula L μ₁ n → subformula L μ₂ n) := λ p q,
begin
  induction p using fol.subformula.ind_on,
  case verum { cases q; simp[top_eq, equal_eq, imply_eq, neg_eq, fal_eq], },
  case relation : n k r v₁
  { cases q; simp[top_eq, equal_eq, imply_eq, neg_eq, fal_eq];
    case relation : _ _ r₂ v₂
    { rintros rfl rfl, simp, intros h, funext i, exact subterm.map_inj_of_inj f I (congr_fun h i) } },
  case imply : _ p₁ p₂ IH₁ IH₂
  { cases q; simp[top_eq, equal_eq, imply_eq, neg_eq, fal_eq],
      case imply : _ q₁ q₂ { intros h₁ h₂, exact ⟨IH₁ _ h₁, IH₂ _ h₂⟩ } },
  case neg : n p IH
  { cases q; simp[top_eq, equal_eq, imply_eq, neg_eq, fal_eq],
      case neg : _ p₂ { intros h, exact IH _ h } },
  case fal : n p IH
  { cases q; simp[top_eq, equal_eq, imply_eq, neg_eq, fal_eq],
      case fal : _ p₂ { intros h, exact IH _ h } }
end

end rew

section subst

@[simp] def subst' : Π {n}, subterm L μ n → subformula L μ (n + 1) → subformula L μ n
| n u verum          := ⊤
| n u (relation r v) := relation r (λ i, subterm.subst u $ v i)
| n u (imply p q)    := subst' u p ⟶ subst' u q
| n u (neg p)        := ∼subst' u p
| n u (fal p)        := ∀' (subst' u.lift p)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.complexity)⟩]}

def subst (u : subterm L μ n) : subformula L μ (n + 1) →ₗ subformula L μ n :=
{ to_fun := subst' u,
  map_neg' := λ p, by unfold has_negation.neg; simp; refl,
  map_imply' := λ p q, by unfold has_arrow.arrow; simp; refl,
  map_and' := λ p q, by unfold has_inf.inf; simp[and]; refl,
  map_or' := λ p q, by unfold has_sup.sup; simp[or]; refl,
  map_top' := by unfold has_top.top; simp; refl,
  map_bot' := by unfold has_bot.bot; simp; refl }

variables (u : subterm L μ n)

@[simp] lemma subst_relation {k} (r : L.pr k) (v : fin k → subterm L μ (n + 1)) :
  subst u (relation r v) = relation r (λ i, u.subst (v i)) := by simp[subst]

@[simp] lemma subst_fal (p : subformula L μ (n + 1 + 1)) :
  subst u (∀'p) = ∀'subst u.lift p := by simp[←fal_eq, subst]

@[simp] lemma subst_ex (p : subformula L μ (n + 1 + 1)) :
  subst u (∃'p) = ∃'subst u.lift p := by simp[ex_def]

variables {μ₁ μ₂} (f : μ₁ → μ₂)

lemma map_subst (p : subformula L μ₁ (n + 1)) : ∀ (u : subterm L μ₁ n),
  map f (subst u p) = subst (u.map f) (map f p) :=
by apply ind_succ_on p; intros; simp[*, subterm.map_subst, subterm.map_lift]

end subst

section bounded_formula
variables {m : ℕ}

def mlift {m n} : bounded_subformula L m n →ₗ bounded_subformula L (m + 1) n := map fin.cast_succ

section mlift

@[simp] lemma mlift_relation {k} (r : L.pr k) (v : fin k → bounded_subterm L m n) :
  mlift (relation r v) = relation r (λ i, subterm.mlift (v i)) := rfl

@[simp] lemma mlift_fal (p : bounded_subformula L m (n + 1)) :
  mlift (∀'p) = ∀'mlift p := rfl

@[simp] lemma mlift_ex (p : bounded_subformula L m (n + 1)) :
  mlift (∃'p) = ∃'mlift p := by simp[ex_def]

variables {m₁ m₂ : ℕ} (s : fin m₁ → bounded_subterm L m₂ n)

lemma mlift_rew (p : bounded_subformula L m₁ n) : mlift (rew s p) = rew (λ x, (s x).mlift) p :=
by induction p using fol.subformula.ind_on; simp[subterm.mlift_rew, subterm.mlift_lift, *]

@[simp] lemma complexity_mlift (p : bounded_subformula L m n) : p.mlift.complexity = p.complexity :=
by induction p using fol.subformula.ind_on; simp*

lemma mlift_inj : function.injective (@mlift L m n) :=
map_inj_of_inj _ (rel_embedding.injective _)

def cast_le {n} (h : m₁ ≤ m₂) : bounded_subformula L m₁ n →ₗ bounded_subformula L m₂ n := map (fin.cast_le h)

variables (h : m₁ ≤ m₂)

@[simp] lemma cast_le_of_eq (p : bounded_subformula L m n) {h} : cast_le h p = p :=
by simp[cast_le, show ⇑(fin.cast_le h) = id, by ext; simp]

@[simp] lemma cast_le_function {k} (r : L.pr k) (v : fin k → bounded_subterm L m₁ n) :
  cast_le h (relation r v) = relation r (subterm.cast_le h ∘ v) :=
by simp[cast_le]; refl

@[simp] lemma cast_le_fal (p : bounded_subformula L m₁ (n + 1)) :
  cast_le h (∀'p) = ∀'(cast_le h p) :=
by simp[cast_le]; refl

@[simp] lemma cast_le_ex (p : bounded_subformula L m₁ (n + 1)) :
  cast_le h (∃'p) = ∃'(cast_le h p) :=
by simp[cast_le]; refl

lemma cast_le_inj : function.injective (@cast_le L m₁ m₂ n h) :=
map_inj_of_inj _ (rel_embedding.injective _)

end mlift

def push' {m} : Π {n}, bounded_subformula L m (n + 1) → bounded_subformula L (m + 1) n
| n verum          := ⊤
| n (relation p v) := relation p (subterm.push ∘ v)
| n (imply p q)    := p.push' ⟶ q.push'
| n (neg p)        := ∼p.push'
| n (fal p)        := ∀'p.push'
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.complexity)⟩]}

def push : bounded_subformula L m (n + 1) →ₗ bounded_subformula L (m + 1) n :=
{ to_fun := push',
  map_neg' := λ p, by unfold has_negation.neg; simp[push']; refl,
  map_imply' := λ p q, by unfold has_arrow.arrow; simp[push']; refl,
  map_and' := λ p q, by unfold has_inf.inf; simp[and, push']; refl,
  map_or' := λ p q, by unfold has_sup.sup; simp[or, push']; refl,
  map_top' := by unfold has_top.top; simp[push']; refl,
  map_bot' := by unfold has_bot.bot; simp[push']; refl }

section push

lemma push_def (p : bounded_subformula L m (n + 1)) : push p = push' p := rfl

@[simp] lemma push_relation {k} (r : L.pr k) (v : fin k → bounded_subterm L m (n + 1)) :
  push (relation r v) = relation r (λ i, subterm.push (v i)) := by simp[push_def, push']

@[simp] lemma push_fal (p : bounded_subformula L m (n + 1 + 1)) :
  push (∀'p) = ∀'push p := by unfold has_univ_quantifier'.univ; simp[push_def, push']; refl

@[simp] lemma push_ex (p : bounded_subformula L m (n + 1 + 1)) :
  push (∃'p) = ∃'push p := by simp[ex_def]

@[simp] lemma complexity_push {n} (p : bounded_subformula L m (n + 1)) : p.push.complexity = p.complexity :=
by apply ind_succ_on p; intros; simp*

variables {m₁ m₂ : ℕ} (f : fin m₁ → fin m₂)

end push

def pull' {m} : Π {n}, bounded_subformula L (m + 1) n → bounded_subformula L m (n + 1)
| n verum          := ⊤
| n (relation p v) := relation p (subterm.pull ∘ v)
| n (imply p q)    := p.pull' ⟶ q.pull'
| n (neg p)        := ∼p.pull'
| n (fal p)        := ∀'p.pull'

def pull : bounded_subformula L (m + 1) n →ₗ bounded_subformula L m (n + 1) :=
{ to_fun := pull',
  map_neg' := λ p, by refl,
  map_imply' := λ p q, by refl,
  map_and' := λ p q, by refl,
  map_or' := λ p q, by refl,
  map_top' := by refl,
  map_bot' := by refl }

section pull

lemma pull_def (p : bounded_subformula L (m + 1) n) : pull p = pull' p := rfl

@[simp] lemma pull_relation {k} (r : L.pr k) (v : fin k → bounded_subterm L (m + 1) n) :
  pull (relation r v) = relation r (λ i, subterm.pull (v i)) := by refl

@[simp] lemma pull_fal (p : bounded_subformula L (m + 1) (n + 1)) :
  pull (∀'p) = ∀'pull p := by refl

@[simp] lemma pull_ex (p : bounded_subformula L (m + 1) (n + 1)) :
  pull (∃'p) = ∃'pull p := by simp[ex_def]

@[simp] lemma pull_push : ∀ {n} (p : bounded_subformula L m (n + 1)), p.push.pull = p
| n verum          := by simp[top_eq]
| n (relation p v) := by simp; funext x; simp
| n (imply p q)    := by simp[imply_eq]; exact ⟨pull_push p, pull_push q⟩
| n (neg p)        := by simp[neg_eq]; exact pull_push p
| n (fal p)        := by simp[fal_eq]; exact pull_push p
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.complexity)⟩]}

@[simp] lemma push_pull : ∀ {n} (p : bounded_subformula L (m + 1) n), p.pull.push = p
| n verum          := by simp[top_eq]
| n (relation p v) := by simp; funext x; simp
| n (imply p q)    := by simp[imply_eq]; exact ⟨push_pull p, push_pull q⟩
| n (neg p)        := by simp[neg_eq]; exact push_pull p
| n (fal p)        := by simp[fal_eq]; exact push_pull p

lemma push_inj : function.injective (@push L m n) :=
@function.left_inverse.injective _ _ (@pull L m n) _ pull_push

lemma pull_inj : function.injective (@pull L m n) :=
@function.left_inverse.injective _ _ (@push L m n) _ push_pull

lemma push_rew_pull {m₁ m₂} : ∀ {n} (p : bounded_subformula L (m₁ + 1) n) (s : fin m₁ → bounded_subterm L m₂ (n + 1)),
  (rew s p.pull).push = rew (subterm.push ∘ s <* &(fin.last m₂)) p
| n verum          s := by simp[top_eq]
| n (relation p v) s := by simp; funext x; simp[subterm.push_rew_pull]
| n (imply p q)    s := by simp[imply_eq]; exact ⟨push_rew_pull p s, push_rew_pull q s⟩
| n (neg p)        s := by simp[neg_eq]; exact push_rew_pull p s
| n (fal p)        s := by simp[fal_eq]; {
    simp[push_rew_pull p (subterm.lift ∘ s)],
    refine eq_rew_of_eq (by { funext x, refine fin.last_cases _ _ x; simp[subterm.push_lift_comm] }) }

@[simp] lemma complexity_pull (p : bounded_subformula L (m + 1) n) : p.pull.complexity = p.complexity :=
by induction p using fol.subformula.ind_on; intros; simp*

end pull

@[simp] lemma subst_mlift {n} (p : bounded_subformula L m (n + 1)) : subst &(fin.last m) (mlift p) = push p :=
by apply ind_succ_on p; intros; simp*

def dummy : bounded_subformula L m n →ₗ bounded_subformula L m (n + 1) := pull.comp mlift

section dummy

@[simp] lemma dummy_relation {k} (r : L.pr k) (v : fin k → bounded_subterm L m n) :
  dummy (relation r v) = relation r (λ i, (v i).dummy) := by simp[dummy, subterm.dummy]

@[simp] lemma dummy_fal (p : bounded_subformula L m (n + 1)) : dummy (∀'p) = ∀'(dummy p) := by simp[dummy]

@[simp] lemma dummy_ex (p : bounded_subformula L m (n + 1)) : dummy (∃'p) = ∃'(dummy p) := by simp[dummy]

@[simp] lemma push_dummy  (p : bounded_subformula L m n) : push (dummy p) = mlift p := by simp[dummy]

@[simp] lemma dummy_subst (p : bounded_subformula L m n) (t) : (subst t $ dummy p) = p :=
by induction p; intros; simp[top_eq, equal_eq, imply_eq, neg_eq, fal_eq, *]

@[simp] lemma complexity_dummy (p : bounded_subformula L m n) : p.dummy.complexity = p.complexity :=
by simp[dummy]

end dummy

end bounded_formula

def qr : Π {n}, subformula L μ n → ℕ
| n verum          := 0
| n (relation r v) := 0
| n (imply p q)    := max p.qr q.qr
| n (neg p)        := p.qr
| n (fal p)        := p.qr + 1

def is_open (p : subformula L μ n) : Prop := p.qr = 0

section qr
open subformula
variables {n}

@[simp] lemma qr_top : (⊤ : subformula L μ n).qr = 0 := rfl

@[simp] lemma qr_bot : (⊥ : subformula L μ n).qr = 0 := rfl

@[simp] lemma qr_relation {p} (r : L.pr p) (v : finitary (subterm L μ n) p) : (relation r v).qr = 0 := rfl

@[simp] lemma qr_equal [L.has_equal] (t u : subterm L μ n) : (t =' u : subformula L μ n).qr = 0 := rfl

@[simp] lemma qr_imply (p q : subformula L μ n) : (p ⟶ q : subformula L μ n).qr = max p.qr q.qr := rfl

@[simp] lemma qr_and (p q : subformula L μ n) : (p ⊓ q : subformula L μ n).qr = max p.qr q.qr := rfl

@[simp] lemma qr_or (p q : subformula L μ n) : (p ⊔ q : subformula L μ n).qr = max p.qr q.qr := rfl

@[simp] lemma qr_iff (p q : subformula L μ n) : (p ⟷ q : subformula L μ n).qr = max p.qr q.qr := by simp[lrarrow_def, max_comm]

@[simp] lemma qr_neg (p : subformula L μ n) : (∼p).qr = p.qr := rfl

@[simp] lemma qr_fal (p : subformula L μ (n + 1)) : (∀'p).qr = p.qr + 1 := rfl

@[simp] lemma qr_ex (p : subformula L μ (n + 1)) : (∃'p).qr = p.qr + 1 := rfl

@[simp] lemma qr_rew {μ₁ μ₂} : Π {n} (p : subformula L μ₁ n) (s : μ₁ → subterm L μ₂ n), (rew s p).qr = p.qr
| n verum          := by simp[top_eq]
| n (relation p v) := by simp
| n (imply p q)    := by simp[imply_eq, qr_rew p, qr_rew q]
| n (neg p)        := by simp[neg_eq, qr_rew p]
| n (fal p)        := by simp[fal_eq, qr_rew p]

@[simp] def qr_push {m} : Π {n} (p : bounded_subformula L m (n + 1)), p.push.qr = p.qr
| n verum          := by simp[top_eq]
| n (relation p v) := by simp
| n (imply p q)    := by simp[imply_eq, qr_push p, qr_push q]
| n (neg p)        := by simp[neg_eq, qr_push p]
| n (fal p)        := by simp[fal_eq, qr_push p]
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.complexity)⟩]}

@[simp] def qr_pull {m} : Π {n} (p : bounded_subformula L (m + 1) n), p.pull.qr = p.qr
| n verum          := by simp[top_eq]
| n (relation p v) := by simp
| n (imply p q)    := by simp[imply_eq, qr_pull p, qr_pull q]
| n (neg p)        := by simp[neg_eq, qr_pull p]
| n (fal p)        := by simp[fal_eq, qr_pull p]

@[simp] def qr_mlift {m} : Π {n} (p : bounded_subformula L m n), p.mlift.qr = p.qr
| n verum          := by simp[top_eq]
| n (relation p v) := by simp
| n (imply p q)    := by simp[imply_eq, qr_mlift p, qr_mlift q]
| n (neg p)        := by simp[neg_eq, qr_mlift p]
| n (fal p)        := by simp[fal_eq, qr_mlift p]

@[simp] lemma qr_subst (p : subformula L μ (n + 1)) : ∀ (u : subterm L μ n), (subst u p).qr = p.qr :=
by apply ind_succ_on p ; intros; simp*

@[simp] lemma top_open : (⊤ : subformula L μ n).is_open := by simp[is_open]

@[simp] lemma relation_open {k} (r : L.pr k) (v) : (relation r v : subformula L μ n).is_open := by simp[is_open]

@[simp] lemma equal_open [L.has_equal] {t u : subterm L μ n} : (t =' u : subformula L μ n).is_open := by simp[is_open]

@[simp] lemma bot_open : (⊥ : subformula L μ n).is_open := by simp[is_open]

@[simp] lemma imply_open {p q : subformula L μ n} : (p ⟶ q).is_open ↔ p.is_open ∧ q.is_open := by simp[is_open]

@[simp] lemma and_open {p q : subformula L μ n} : (p ⊓ q).is_open ↔ p.is_open ∧ q.is_open := by simp[is_open]

@[simp] lemma iff_open {p q : subformula L μ n} : (p ⟷ q).is_open ↔ p.is_open ∧ q.is_open := by simp[is_open]

@[simp] lemma finitary_conjunction_open {k} {p : fin k → subformula L μ n} :
  (⋀ i, p i).is_open ↔ ∀ i, (p i).is_open :=
by { induction k with k IH; simp*,
  { refine ⟨by { rintros ⟨hlast, hcast⟩, refine fin.last_cases _ _, exact hlast, exact hcast },
    by { intros h, simp[h] }⟩ } }

@[simp] lemma or_open {p q : subformula L μ n} : (p ⊔ q).is_open ↔ p.is_open ∧ q.is_open := by simp[is_open]

@[simp] lemma finitary_disjunction_open {k} {p : fin k → subformula L μ n} :
  (⋁ i, p i).is_open ↔ ∀ i, (p i).is_open :=
by { induction k with k IH; simp*,
  { refine ⟨by { rintros ⟨hcast, hlast⟩, refine fin.last_cases _ _, exact hlast, exact hcast },
    by { intros h, simp[h] }⟩ } }

@[simp] lemma neg_open {p : subformula L μ n} : (∼p).is_open ↔ p.is_open := by simp[is_open]

@[simp] lemma fal_not_open {p : subformula L μ (n + 1)} : ¬(∀'p).is_open := by simp[is_open]

@[simp] lemma ex_not_open {p : subformula L μ (n + 1)} : ¬(∃'p).is_open := by simp[is_open]

@[simp] lemma rew_open {μ₁ μ₂} {p : subformula L μ₁ n} {s : μ₁ → subterm L μ₂ n} :
  (rew s p).is_open ↔ p.is_open := by simp[is_open]

@[simp] lemma subst_open {u} {p : subformula L μ (n + 1)} : (subst u p).is_open ↔ p.is_open := by simp[is_open]

section bounded_formula
variables {m : ℕ}

@[simp] lemma mlift_open {p : bounded_subformula L m n} : (mlift p).is_open ↔ p.is_open := by simp[is_open]

@[simp] lemma push_open {p : bounded_subformula L m (n + 1)} : (push p).is_open ↔ p.is_open := by simp[is_open]

@[simp] lemma pull_open {p : bounded_subformula L (m + 1) n} : (pull p).is_open ↔ p.is_open := by simp[is_open]

@[simp] lemma dummy_open {p : bounded_subformula L m n} : (dummy p).is_open ↔ p.is_open := by simp[dummy]

end bounded_formula

def open_rec {C : Π p : subformula L μ n, p.is_open → Sort*}
  (hverum : C ⊤ top_open)
  (hrel : Π (k) (r : L.pr k) (v : fin k → subterm L μ n), C (subformula.relation r v) (relation_open r v))
  (himply : Π (p q : subformula L μ n) (hp hq), C p hp → C q hq → C (p ⟶ q) (by simp[hp, hq]))
  (hneg : Π (p : subformula L μ n) (hp), C p hp → C (∼p) (by simp[hp])) :
  Π (p : subformula L μ n) (h : p.is_open), C p h
| ⊤                         _ := hverum
| (subformula.relation r v) _ := hrel _ r v
| (p ⟶ q)                   h := have p.is_open ∧ q.is_open, by simpa using h,
    himply p q this.1 this.2 (open_rec p this.1) (open_rec q this.2)
| (∼p)                      h := have p.is_open, by simpa using h, hneg p this (open_rec p this)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.1.complexity)⟩]}

def open_rec_on (p : subformula L μ n) (h : p.is_open) {C : Π p : subformula L μ n, p.is_open → Sort*}
  (hverum : C ⊤ top_open)
  (hrel : Π (k) (r : L.pr k) (v : fin k → subterm L μ n), C (subformula.relation r v) (relation_open r v))
  (himply : Π (p q : subformula L μ n) (hp hq), C p hp → C q hq → C (p ⟶ q) (by simp[hp, hq]))
  (hneg : Π (p : subformula L μ n) (hp), C p hp → C (∼p) (by simp[hp])) :
  C p h := open_rec hverum hrel himply hneg p h

section open_rec
variables {C : Π p : subformula L μ n, p.is_open → Sort*}

@[simp] lemma rec_app_top {hverum hrel himply hneg h} : @open_rec L μ n C hverum hrel himply hneg ⊤ h = hverum :=
by simp[open_rec]

@[simp] lemma rec_app_rel {hverum hrel himply hneg} {k} (r : L.pr k) (v : fin k → subterm L μ n) {h} :
  @open_rec L μ n C hverum hrel himply hneg (subformula.relation r v) h = hrel k r v := by simp[open_rec]

@[simp] lemma rec_app_imply {hverum hrel himply hneg} (p q : subformula L μ n) {h} :
  @open_rec L μ n C hverum hrel himply hneg (p ⟶ q) h =
  himply p q (by simp at h; exact h.1) (by simp at h; exact h.2)
    (open_rec hverum hrel himply hneg p (by simp at h; exact h.1))
    (open_rec hverum hrel himply hneg q (by simp at h; exact h.2)) :=
by simp[open_rec]

@[simp] lemma rec_app_neg {hverum hrel himply hneg} (p : subformula L μ n) {h} :
  @open_rec L μ n C hverum hrel himply hneg (∼p) h =
  hneg p (by simpa using h) (open_rec hverum hrel himply hneg p (by simpa using h)) :=
by simp[open_rec]

end open_rec

end qr

end subformula

namespace bounded_preTheory
variables {L} {m : ℕ} (T U : bounded_preTheory L m)

def mlift : bounded_preTheory L (m + 1) := subformula.mlift '' T

instance : has_coe (bounded_preTheory L m) (bounded_preTheory L (m + 1)) := ⟨mlift⟩

variables {T U}

@[simp] lemma mlift_empty : mlift (∅ : bounded_preTheory L m) = ∅ :=
by simp[bounded_preTheory.mlift]

@[simp] lemma mlift_insert (p : bounded_formula L m) : mlift (insert p T) = insert p.mlift (mlift T) :=
by simp[mlift, set.image_insert_eq]

@[simp] lemma mlift_mem_mlift_iff {p : bounded_formula L m} : p.mlift ∈ T.mlift ↔ p ∈ T :=
function.injective.mem_set_image subformula.mlift_inj

lemma mem_mlift_iff {p} :
  p ∈ T.mlift ↔ ∃ q ∈ T, subformula.mlift q = p :=
by simp[mlift]

def is_open : Prop := ∀ p ∈ T, subformula.is_open p

end bounded_preTheory

end fol


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebraic_geometry.presheafed_space
import category_theory.limits.final
import topology.sheaves.stalks

/-!
# Stalks for presheaved spaces

This file lifts constructions of stalks and pushforwards of stalks to work with
the category of presheafed spaces. Additionally, we prove that restriction of
presheafed spaces does not change the stalks.
-/

noncomputable theory

universes v u v' u'

open category_theory
open category_theory.limits category_theory.category category_theory.functor
open algebraic_geometry
open topological_space
open opposite

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

local attribute [tidy] tactic.op_induction' tactic.auto_cases_opens

open Top.presheaf

namespace algebraic_geometry.PresheafedSpace

/--
The stalk at `x` of a `PresheafedSpace`.
-/
abbreviation stalk (X : PresheafedSpace C) (x : X) : C := X.presheaf.stalk x

/--
A morphism of presheafed spaces induces a morphism of stalks.
-/
def stalk_map {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (x : X) : Y.stalk (α.base x) ⟶ X.stalk x :=
(stalk_functor C (α.base x)).map (α.c) ≫ X.presheaf.stalk_pushforward C α.base x

@[simp, elementwise, reassoc]
lemma stalk_map_germ {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (U : opens Y.carrier)
  (x : (opens.map α.base).obj U) :
  Y.presheaf.germ ⟨α.base x, x.2⟩ ≫ stalk_map α ↑x = α.c.app (op U) ≫ X.presheaf.germ x :=
by rw [stalk_map, stalk_functor_map_germ_assoc, stalk_pushforward_germ]

section restrict

/--
For an open embedding `f : U ⟶ X` and a point `x : U`, we get an isomorphism between the stalk
of `X` at `f x` and the stalk of the restriction of `X` along `f` at t `x`.
-/
def restrict_stalk_iso {U : Top} (X : PresheafedSpace.{v} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (x : U) :
  (X.restrict h).stalk x ≅ X.stalk (f x) :=
begin
  -- As a left adjoint, the functor `h.is_open_map.functor_nhds x` is initial.
  haveI := initial_of_adjunction (h.is_open_map.adjunction_nhds x),
  -- Typeclass resolution knows that the opposite of an initial functor is final. The result
  -- follows from the general fact that postcomposing with a final functor doesn't change colimits.
  exact final.colimit_iso (h.is_open_map.functor_nhds x).op
    ((open_nhds.inclusion (f x)).op ⋙ X.presheaf),
end

@[simp, elementwise, reassoc]
lemma restrict_stalk_iso_hom_eq_germ {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})}
  (h : open_embedding f) (V : opens U) (x : U) (hx : x ∈ V) :
  (X.restrict h).presheaf.germ ⟨x, hx⟩ ≫ (restrict_stalk_iso X h x).hom =
  X.presheaf.germ ⟨f x, show f x ∈ h.is_open_map.functor.obj V, from ⟨x, hx, rfl⟩⟩ :=
colimit.ι_pre ((open_nhds.inclusion (f x)).op ⋙ X.presheaf)
  (h.is_open_map.functor_nhds x).op (op ⟨V, hx⟩)

@[simp, elementwise, reassoc]
lemma restrict_stalk_iso_inv_eq_germ {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})}
  (h : open_embedding f) (V : opens U) (x : U) (hx : x ∈ V) :
  X.presheaf.germ ⟨f x, show f x ∈ h.is_open_map.functor.obj V, from ⟨x, hx, rfl⟩⟩ ≫
  (restrict_stalk_iso X h x).inv = (X.restrict h).presheaf.germ ⟨x, hx⟩ :=
by rw [← restrict_stalk_iso_hom_eq_germ, category.assoc, iso.hom_inv_id, category.comp_id]

lemma restrict_stalk_iso_inv_eq_of_restrict {U : Top} (X : PresheafedSpace.{v} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (x : U) :
    (X.restrict_stalk_iso h x).inv = stalk_map (X.of_restrict h) x :=
begin
  ext V,
  induction V using opposite.rec,
  let i : (h.is_open_map.functor_nhds x).obj ((open_nhds.map f x).obj V) ⟶ V :=
    hom_of_le (set.image_preimage_subset f _),
  erw [iso.comp_inv_eq, colimit.ι_map_assoc, colimit.ι_map_assoc, colimit.ι_pre],
  simp_rw category.assoc,
  erw colimit.ι_pre ((open_nhds.inclusion (f x)).op ⋙ X.presheaf)
    (h.is_open_map.functor_nhds x).op,
  erw ← X.presheaf.map_comp_assoc,
  exact (colimit.w ((open_nhds.inclusion (f x)).op ⋙ X.presheaf) i.op).symm,
end

instance of_restrict_stalk_map_is_iso {U : Top} (X : PresheafedSpace.{v} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (x : U) :
  is_iso (stalk_map (X.of_restrict h) x) :=
by { rw ← restrict_stalk_iso_inv_eq_of_restrict, apply_instance }

end restrict

namespace stalk_map

@[simp] lemma id (X : PresheafedSpace.{v} C) (x : X) : stalk_map (𝟙 X) x = 𝟙 (X.stalk x) :=
begin
  dsimp [stalk_map],
  simp only [stalk_pushforward.id],
  rw [←map_comp],
  convert (stalk_functor C x).map_id X.presheaf,
  tidy,
end

-- TODO understand why this proof is still gross (i.e. requires using `erw`)
@[simp] lemma comp {X Y Z : PresheafedSpace.{v} C} (α : X ⟶ Y) (β : Y ⟶ Z) (x : X) :
  stalk_map (α ≫ β) x =
    (stalk_map β (α.base x) : Z.stalk (β.base (α.base x)) ⟶ Y.stalk (α.base x)) ≫
    (stalk_map α x : Y.stalk (α.base x) ⟶ X.stalk x) :=
begin
  dsimp [stalk_map, stalk_functor, stalk_pushforward],
  ext U,
  induction U using opposite.rec,
  cases U,
  simp only [colimit.ι_map_assoc, colimit.ι_pre_assoc, colimit.ι_pre,
    whisker_left_app, whisker_right_app,
    assoc, id_comp, map_id, map_comp],
  dsimp,
  simp only [map_id, assoc, pushforward.comp_inv_app],
  -- FIXME Why doesn't simp do this:
  erw [category_theory.functor.map_id],
  erw [category_theory.functor.map_id],
  erw [id_comp, id_comp],
end

/--
If `α = β` and `x = x'`, we would like to say that `stalk_map α x = stalk_map β x'`.
Unfortunately, this equality is not well-formed, as their types are not _definitionally_ the same.
To get a proper congruence lemma, we therefore have to introduce these `eq_to_hom` arrows on
either side of the equality.
-/
lemma congr {X Y : PresheafedSpace.{v} C} (α β : X ⟶ Y) (h₁ : α = β) (x x': X) (h₂ : x = x') :
  stalk_map α x ≫ eq_to_hom (show X.stalk x = X.stalk x', by rw h₂) =
  eq_to_hom (show Y.stalk (α.base x) = Y.stalk (β.base x'), by rw [h₁, h₂]) ≫ stalk_map β x' :=
stalk_hom_ext _ $ λ U hx, by { subst h₁, subst h₂, simp }

lemma congr_hom {X Y : PresheafedSpace.{v} C} (α β : X ⟶ Y) (h : α = β) (x : X) :
  stalk_map α x =
  eq_to_hom (show Y.stalk (α.base x) = Y.stalk (β.base x), by rw h) ≫ stalk_map β x :=
by rw [← stalk_map.congr α β h x x rfl, eq_to_hom_refl, category.comp_id]

lemma congr_point {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (x x' : X) (h : x = x') :
  stalk_map α x ≫ eq_to_hom (show X.stalk x = X.stalk x', by rw h) =
  eq_to_hom (show Y.stalk (α.base x) = Y.stalk (α.base x'), by rw h) ≫ stalk_map α x' :=
by rw stalk_map.congr α α rfl x x' h

instance is_iso {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) [is_iso α] (x : X) :
  is_iso (stalk_map α x) :=
{ out := begin
  let β : Y ⟶ X := category_theory.inv α,
  have h_eq : (α ≫ β).base x = x,
  { rw [is_iso.hom_inv_id α, id_base, Top.id_app] },
  -- Intuitively, the inverse of the stalk map of `α` at `x` should just be the stalk map of `β`
  -- at `α x`. Unfortunately, we have a problem with dependent type theory here: Because `x`
  -- is not *definitionally* equal to `β (α x)`, the map `stalk_map β (α x)` has not the correct
  -- type for an inverse.
  -- To get a proper inverse, we need to compose with the `eq_to_hom` arrow
  -- `X.stalk x ⟶ X.stalk ((α ≫ β).base x)`.
  refine ⟨eq_to_hom (show X.stalk x = X.stalk ((α ≫ β).base x), by rw h_eq) ≫
    (stalk_map β (α.base x) : _), _, _⟩,
  { rw [← category.assoc, congr_point α x ((α ≫ β).base x) h_eq.symm, category.assoc],
    erw ← stalk_map.comp β α (α.base x),
    rw [congr_hom _ _ (is_iso.inv_hom_id α), stalk_map.id, eq_to_hom_trans_assoc,
      eq_to_hom_refl, category.id_comp] },
  { rw [category.assoc, ← stalk_map.comp, congr_hom _ _ (is_iso.hom_inv_id α),
    stalk_map.id, eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp] },
end }

/--
An isomorphism between presheafed spaces induces an isomorphism of stalks.
-/
def stalk_iso {X Y : PresheafedSpace.{v} C} (α : X ≅ Y) (x : X) :
  Y.stalk (α.hom.base x) ≅ X.stalk x :=
as_iso (stalk_map α.hom x)

@[simp, reassoc, elementwise]
lemma stalk_specializes_stalk_map {X Y : PresheafedSpace.{v} C} (f : X ⟶ Y) {x y : X} (h : x ⤳ y) :
  Y.presheaf.stalk_specializes (f.base.map_specializes h) ≫ stalk_map f x =
    stalk_map f y ≫ X.presheaf.stalk_specializes h :=
by { delta PresheafedSpace.stalk_map, simp [stalk_map] }

end stalk_map

end algebraic_geometry.PresheafedSpace


import linear_algebra.matrix.nonsingular_inverse

namespace matrix
variables {m n α : Type*}
variables (A : matrix n n α) [comm_ring α] [fintype m] [fintype n] [decidable_eq n]

instance [invertible A] : invertible A⁻¹ :=
by { rw ← inv_of_eq_nonsing_inv, apply_instance }

@[simp] lemma inv_inv_of_invertible [invertible A] : A⁻¹⁻¹ = A :=
by simp only [← inv_of_eq_nonsing_inv, inv_of_inv_of]

end matrix


import category_theory.category

open category_theory
universes v u

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

local notation f `# ` A ` #` g := (f : _ ⟶ A) ≫ g

example {P Q R S : C} (f : P ⟶ Q) (g : Q ⟶ R) (h : R ⟶ S) : f ≫ g ≫ h = ((f ≫ g) ≫ h) :=
begin

end