/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import group_theory.submonoid.pointwise
import logic.equiv.transfer_instance
import ring_theory.finiteness
import ring_theory.localization.at_prime
import ring_theory.localization.away
import ring_theory.localization.integer
import ring_theory.localization.submodule
import ring_theory.nilpotent

/-!
# Local properties of commutative rings

In this file, we provide the proofs of various local properties.

## Naming Conventions

* `localization_P` : `P` holds for `S⁻¹R` if `P` holds for `R`.
* `P_of_localization_maximal` : `P` holds for `R` if `P` holds for `Aₘ` for all maximal `m`.
* `P_of_localization_span` : `P` holds for `R` if given a spanning set `{fᵢ}`, `P` holds for all
  `A_{fᵢ}`.

## Main results

The following properties are covered:

* The triviality of an ideal or an element:
  `ideal_eq_zero_of_localization`, `eq_zero_of_localization`
* `is_reduced` : `localization_is_reduced`, `is_reduced_of_localization_maximal`.
* `finite`: `localization_finite`, `finite_of_localization_span`
* `finite_type`: `localization_finite_type`, `finite_type_of_localization_span`

-/

open_locale pointwise classical big_operators

universe u

variables {R S : Type u} [comm_ring R] [comm_ring S] (M : submonoid R)
variables (N : submonoid S) (R' S' : Type u) [comm_ring R'] [comm_ring S'] (f : R →+* S)
variables [algebra R R'] [algebra S S']

section properties

section comm_ring

variable (P : ∀ (R : Type u) [comm_ring R], Prop)

include P

/-- A property `P` of comm rings is said to be preserved by localization
  if `P` holds for `M⁻¹R` whenever `P` holds for `R`. -/
def localization_preserves : Prop :=
  ∀ {R : Type u} [hR : comm_ring R] (M : by exactI submonoid R) (S : Type u) [hS : comm_ring S]
    [by exactI algebra R S] [by exactI is_localization M S], @P R hR → @P S hS

/-- A property `P` of comm rings satisfies `of_localization_maximal` if
  if `P` holds for `R` whenever `P` holds for `Rₘ` for all maximal ideal `m`. -/
def of_localization_maximal : Prop :=
  ∀ (R : Type u) [comm_ring R],
    by exactI (∀ (J : ideal R) (hJ : J.is_maximal), by exactI P (localization.at_prime J)) → P R

end comm_ring

section ring_hom

variable (P : ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S), Prop)

include P

/-- A property `P` of ring homs is said to be preserved by localization
 if `P` holds for `M⁻¹R →+* M⁻¹S` whenever `P` holds for `R →+* S`. -/
def ring_hom.localization_preserves :=
  ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S) (M : by exactI submonoid R)
    (R' S' : Type u) [comm_ring R'] [comm_ring S'] [by exactI algebra R R']
    [by exactI algebra S S'] [by exactI is_localization M R']
    [by exactI is_localization (M.map (f : R →* S)) S'],
    by exactI (P f → P (is_localization.map S' f (submonoid.le_comap_map M) : R' →+* S'))

/-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span`
if `P` holds for `R →+* S` whenever there exists a finite set `{ r }` that spans `R` such that
`P` holds for `Rᵣ →+* Sᵣ`.

Note that this is equivalent to `ring_hom.of_localization_span` via
`ring_hom.of_localization_span_iff_finite`, but this is easier to prove. -/
def ring_hom.of_localization_finite_span :=
  ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
    (s : finset R) (hs : by exactI ideal.span (s : set R) = ⊤)
    (H : by exactI (∀ (r : s), P (localization.away_map f r))), by exactI P f

/-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span`
if `P` holds for `R →+* S` whenever there exists a set `{ r }` that spans `R` such that
`P` holds for `Rᵣ →+* Sᵣ`.

Note that this is equivalent to `ring_hom.of_localization_finite_span` via
`ring_hom.of_localization_span_iff_finite`, but this has less restrictions when applying. -/
def ring_hom.of_localization_span :=
  ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
    (s : set R) (hs : by exactI ideal.span s = ⊤)
    (H : by exactI (∀ (r : s), P (localization.away_map f r))), by exactI P f

lemma ring_hom.of_localization_span_iff_finite :
  ring_hom.of_localization_span @P ↔ ring_hom.of_localization_finite_span @P :=
begin
  delta ring_hom.of_localization_span ring_hom.of_localization_finite_span,
  apply forall₅_congr, -- TODO: Using `refine` here breaks `resetI`.
  introsI,
  split,
  { intros h s, exact h s },
  { intros h s hs hs',
    obtain ⟨s', h₁, h₂⟩ := (ideal.span_eq_top_iff_finite s).mp hs,
    exact h s' h₂ (λ x, hs' ⟨_, h₁ x.prop⟩) }
end

variables {P f R' S'}

-- Almost all arguments are implicit since this is not intended to use mid-proof.
lemma ring_hom.localization_away_of_localization_preserves
  (H : ring_hom.localization_preserves @P) {r : R} [is_localization.away r R']
  [is_localization.away (f r) S'] (hf : P f) :
    P (by exactI is_localization.away.map R' S' f r) :=
begin
  resetI,
  haveI : is_localization ((submonoid.powers r).map (f : R →* S)) S',
  { rw submonoid.map_powers, assumption },
  exact H f (submonoid.powers r) R' S' hf,
end

end ring_hom

end properties

section ideal

-- This proof should work for all modules, but we do not know how to localize a module yet.
/-- An ideal is trivial if its localization at every maximal ideal is trivial. -/
lemma ideal_eq_zero_of_localization (I : ideal R)
   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
      by exactI is_localization.coe_submodule (localization.at_prime J) I = 0) : I = 0 :=
begin
  by_contradiction hI,
  obtain ⟨x, hx, hx'⟩ := set.exists_of_ssubset (bot_lt_iff_ne_bot.mpr hI),
  rw [submodule.bot_coe, set.mem_singleton_iff] at hx',
  have H : (ideal.span ({x} : set R)).annihilator ≠ ⊤,
  { rw [ne.def, submodule.annihilator_eq_top_iff],
    by_contra,
    apply hx',
    rw [← set.mem_singleton_iff, ← @submodule.bot_coe R, ← h],
    exact ideal.subset_span (set.mem_singleton x) },
  obtain ⟨p, hp₁, hp₂⟩ := ideal.exists_le_maximal _ H,
  resetI,
  specialize h p hp₁,
  have : algebra_map R (localization.at_prime p) x = 0,
  { rw ← set.mem_singleton_iff,
    change algebra_map R (localization.at_prime p) x ∈ (0 : submodule R (localization.at_prime p)),
    rw ← h,
    exact submodule.mem_map_of_mem hx },
  rw is_localization.map_eq_zero_iff p.prime_compl at this,
  obtain ⟨m, hm⟩ := this,
  apply m.prop,
  refine hp₂ _,
  erw submodule.mem_annihilator_span_singleton,
  rwa mul_comm at hm,
end

lemma eq_zero_of_localization (r : R)
   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
      by exactI algebra_map R (localization.at_prime J) r = 0) : r = 0 :=
begin
  rw ← ideal.span_singleton_eq_bot,
  apply ideal_eq_zero_of_localization,
  intros J hJ,
  delta is_localization.coe_submodule,
  erw [submodule.map_span, submodule.span_eq_bot],
  rintro _ ⟨_, h', rfl⟩,
  cases set.mem_singleton_iff.mpr h',
  exact h J hJ,
end

end ideal

section reduced

lemma localization_is_reduced : localization_preserves (λ R hR, by exactI is_reduced R) :=
begin
  introv R _ _,
  resetI,
  constructor,
  rintro x ⟨(_|n), e⟩,
  { simpa using congr_arg (*x) e },
  obtain ⟨⟨y, m⟩, hx⟩ := is_localization.surj M x,
  dsimp only at hx,
  let hx' := congr_arg (^ n.succ) hx,
  simp only [mul_pow, e, zero_mul, ← ring_hom.map_pow] at hx',
  rw [← (algebra_map R S).map_zero] at hx',
  obtain ⟨m', hm'⟩ := (is_localization.eq_iff_exists M S).mp hx',
  apply_fun (*m'^n) at hm',
  simp only [mul_assoc, zero_mul] at hm',
  rw [mul_comm, ← pow_succ, ← mul_pow] at hm',
  replace hm' := is_nilpotent.eq_zero ⟨_, hm'.symm⟩,
  rw [← (is_localization.map_units S m).mul_left_inj, hx, zero_mul,
    is_localization.map_eq_zero_iff M],
  exact ⟨m', by rw [← hm', mul_comm]⟩
end

instance [is_reduced R] : is_reduced (localization M) := localization_is_reduced M _ infer_instance

lemma is_reduced_of_localization_maximal :
  of_localization_maximal (λ R hR, by exactI is_reduced R) :=
begin
  introv R h,
  constructor,
  intros x hx,
  apply eq_zero_of_localization,
  intros J hJ,
  specialize h J hJ,
  resetI,
  exact (hx.map $ algebra_map R $ localization.at_prime J).eq_zero,
end

end reduced

section finite

/-- If `S` is a finite `R`-algebra, then `S' = M⁻¹S` is a finite `R' = M⁻¹R`-algebra. -/
lemma localization_finite : ring_hom.localization_preserves @ring_hom.finite :=
begin
  introv R hf,
  -- Setting up the `algebra` and `is_scalar_tower` instances needed
  classical,
  letI := f.to_algebra,
  letI := ((algebra_map S S').comp f).to_algebra,
  let f' : R' →+* S' := is_localization.map S' f (submonoid.le_comap_map M),
  letI := f'.to_algebra,
  haveI : is_scalar_tower R R' S' :=
    is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,
  let fₐ : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S') (λ c x, ring_hom.map_mul _ _ _),

  -- We claim that if `S` is generated by `T` as an `R`-module,
  -- then `S'` is generated by `T` as an `R'`-module.
  unfreezingI { obtain ⟨T, hT⟩ := hf },
  use T.image (algebra_map S S'),
  rw eq_top_iff,
  rintro x -,

  -- By the hypotheses, for each `x : S'`, we have `x = y / (f r)` for some `y : S` and `r : M`.
  -- Since `S` is generated by `T`, the image of `y` should fall in the span of the image of `T`.
  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map (f : R →* S)) x,
  rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, finset.coe_image],
  have hy : y ∈ submodule.span R ↑T, by { rw hT, trivial },
  replace hy : algebra_map S S' y ∈ submodule.map fₐ.to_linear_map (submodule.span R T) :=
    submodule.mem_map_of_mem hy,
  rw submodule.map_span fₐ.to_linear_map T at hy,
  have H : submodule.span R ((algebra_map S S') '' T) ≤
    (submodule.span R' ((algebra_map S S') '' T)).restrict_scalars R,
  { rw submodule.span_le, exact submodule.subset_span },

  -- Now, since `y ∈ span T`, and `(f r)⁻¹ ∈ R'`, `x / (f r)` is in `span T` as well.
  convert (submodule.span R' ((algebra_map S S') '' T)).smul_mem
    (is_localization.mk' R' (1 : R) ⟨r, hr⟩) (H hy) using 1,
  rw algebra.smul_def,
  erw is_localization.map_mk',
  rw map_one,
  refl,
end

lemma localization_away_map_finite (r : R) [is_localization.away r R']
  [is_localization.away (f r) S'] (hf : f.finite) :
    (is_localization.away.map R' S' f r).finite :=
ring_hom.localization_away_of_localization_preserves @localization_finite hf

/--
Let `S` be an `R`-algebra, `M` an submonoid of `R`, and `S' = M⁻¹S`.
If the image of some `x : S` falls in the span of some finite `s ⊆ S'` over `R`,
then there exists some `m : M` such that `m • x` falls in the
span of `finset_integer_multiple _ s` over `R`.
-/
lemma is_localization.smul_mem_finset_integer_multiple_span [algebra R S]
  [algebra R S'] [is_scalar_tower R S S']
  [is_localization (M.map (algebra_map R S : R →* S)) S'] (x : S)
  (s : finset S') (hx : algebra_map S S' x ∈ submodule.span R (s : set S')) :
    ∃ m : M, m • x ∈ submodule.span R
      (is_localization.finset_integer_multiple (M.map (algebra_map R S : R →* S)) s : set S) :=
begin
  let g : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S')
    (λ c x, by simp [algebra.algebra_map_eq_smul_one]),

  -- We first obtain the `y' ∈ M` such that `s' = y' • s` is falls in the image of `S` in `S'`.
  let y := is_localization.common_denom_of_finset (M.map (algebra_map R S : R →* S)) s,
  have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
  obtain ⟨y', hy', e : algebra_map R S y' = y⟩ := y.prop,
  have : algebra_map R S y' • (s : set S') = y' • s :=
    by simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul],
  rw [← e, this] at hx₁,
  replace hx₁ := congr_arg (submodule.span R) hx₁,
  rw submodule.span_smul_eq at hx₁,
  replace hx : _ ∈ y' • submodule.span R (s : set S') := set.smul_mem_smul_set hx,
  rw hx₁ at hx,
  erw [← g.map_smul, ← submodule.map_span (g : S →ₗ[R] S')] at hx,
  -- Since `x` falls in the span of `s` in `S'`, `y' • x : S` falls in the span of `s'` in `S'`.
  -- That is, there exists some `x' : S` in the span of `s'` in `S` and `x' = y' • x` in `S'`.
  -- Thus `a • (y' • x) = a • x' ∈ span s'` in `S` for some `a ∈ M`.
  obtain ⟨x', hx', hx'' : algebra_map _ _ _ = _⟩ := hx,
  obtain ⟨⟨_, a, ha₁, rfl⟩, ha₂⟩ := (is_localization.eq_iff_exists
    (M.map (algebra_map R S : R →* S)) S').mp hx'',
  use (⟨a, ha₁⟩ : M) * (⟨y', hy'⟩ : M),
  convert (submodule.span R (is_localization.finset_integer_multiple
    (submonoid.map (algebra_map R S : R →* S) M) s : set S)).smul_mem a hx' using 1,
  convert ha₂.symm,
  { rw [mul_comm (y' • x), subtype.coe_mk, submonoid.smul_def, submonoid.coe_mul, ← smul_smul],
    exact algebra.smul_def _ _ },
  { rw mul_comm, exact algebra.smul_def _ _ }
end

/-- If `S` is an `R' = M⁻¹R` algebra, and `x ∈ span R' s`,
then `t • x ∈ span R s` for some `t : M`.-/
lemma multiple_mem_span_of_mem_localization_span [algebra R' S] [algebra R S]
  [is_scalar_tower R R' S] [is_localization M R']
  (s : set S) (x : S) (hx : x ∈ submodule.span R' s) :
    ∃ t : M, t • x ∈ submodule.span R s :=
begin
  classical,
  obtain ⟨s', hss', hs'⟩ := submodule.mem_span_finite_of_mem_span hx,
  suffices : ∃ t : M, t • x ∈ submodule.span R (s' : set S),
  { obtain ⟨t, ht⟩ := this,
    exact ⟨t, submodule.span_mono hss' ht⟩ },
  clear hx hss' s,
  revert x,
  apply s'.induction_on,
  { intros x hx, use 1, simpa using hx },
  rintros a s ha hs x hx,
  simp only [finset.coe_insert, finset.image_insert, finset.coe_image, subtype.coe_mk,
    submodule.mem_span_insert] at hx ⊢,
  rcases hx with ⟨y, z, hz, rfl⟩,
  rcases is_localization.surj M y with ⟨⟨y', s'⟩, e⟩,
  replace e : _ * a = _ * a := (congr_arg (λ x, algebra_map R' S x * a) e : _),
  simp_rw [ring_hom.map_mul, ← is_scalar_tower.algebra_map_apply, mul_comm (algebra_map R' S y),
    mul_assoc, ← algebra.smul_def] at e,
  rcases hs _ hz with ⟨t, ht⟩,
  refine ⟨t*s', t*y', _, (submodule.span R (s : set S)).smul_mem s' ht, _⟩,
  rw [smul_add, ← smul_smul, mul_comm, ← smul_smul, ← smul_smul, ← e],
  refl,
end

/-- If `S` is an `R' = M⁻¹R` algebra, and `x ∈ adjoin R' s`,
then `t • x ∈ adjoin R s` for some `t : M`.-/
lemma multiple_mem_adjoin_of_mem_localization_adjoin [algebra R' S] [algebra R S]
  [is_scalar_tower R R' S] [is_localization M R']
  (s : set S) (x : S) (hx : x ∈ algebra.adjoin R' s) :
    ∃ t : M, t • x ∈ algebra.adjoin R s :=
begin
  change ∃ (t : M), t • x ∈ (algebra.adjoin R s).to_submodule,
  change x ∈ (algebra.adjoin R' s).to_submodule at hx,
  simp_rw [algebra.adjoin_eq_span] at hx ⊢,
  exact multiple_mem_span_of_mem_localization_span M R' _ _ hx
end

lemma finite_of_localization_span : ring_hom.of_localization_span @ring_hom.finite :=
begin
  rw ring_hom.of_localization_span_iff_finite,
  introv R hs H,
  -- We first setup the instances
  classical,
  letI := f.to_algebra,
  letI := λ (r : s), (localization.away_map f r).to_algebra,
  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S : R →* S))
    (localization.away (f r)),
  { intro r, rw submonoid.map_powers, exact localization.is_localization },
  haveI : ∀ r : s, is_scalar_tower R (localization.away (r : R)) (localization.away (f r)) :=
    λ r, is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,

  -- By the hypothesis, we may find a finite generating set for each `Sᵣ`. This set can then be
  -- lifted into `R` by multiplying a sufficiently large power of `r`. I claim that the union of
  -- these generates `S`.
  constructor,
  replace H := λ r, (H r).1,
  choose s₁ s₂ using H,
  let sf := λ (x : s), is_localization.finset_integer_multiple (submonoid.powers (f x)) (s₁ x),
  use s.attach.bUnion sf,
  rw [submodule.span_attach_bUnion, eq_top_iff],

  -- It suffices to show that `r ^ n • x ∈ span T` for each `r : s`, since `{ r ^ n }` spans `R`.
  -- This then follows from the fact that each `x : R` is a linear combination of the generating set
  -- of `Sᵣ`. By multiplying a sufficiently large power of `r`, we can cancel out the `r`s in the
  -- denominators of both the generating set and the coefficients.
  rintro x -,
  apply submodule.mem_of_span_eq_top_of_smul_pow_mem _ (s : set R) hs _ _,
  intro r,
  obtain ⟨⟨_, n₁, rfl⟩, hn₁⟩ := multiple_mem_span_of_mem_localization_span
    (submonoid.powers (r : R)) (localization.away (r : R)) (s₁ r : set (localization.away (f r)))
      (algebra_map S _ x) (by { rw s₂ r, trivial }),
  rw [submonoid.smul_def, algebra.smul_def, is_scalar_tower.algebra_map_apply R S,
    subtype.coe_mk, ← map_mul] at hn₁,
  obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.smul_mem_finset_integer_multiple_span
    (submonoid.powers (r : R)) (localization.away (f r)) _ (s₁ r) hn₁,
  rw [submonoid.smul_def, ← algebra.smul_def, smul_smul, subtype.coe_mk, ← pow_add] at hn₂,
  use n₂ + n₁,
  refine le_supr (λ (x : s), submodule.span R (sf x : set S)) r _,
  change _ ∈ submodule.span R
    ((is_localization.finset_integer_multiple _ (s₁ r) : finset S) : set S),
  convert hn₂,
  rw submonoid.map_powers, refl,
end

end finite

section finite_type

lemma localization_finite_type : ring_hom.localization_preserves @ring_hom.finite_type :=
begin
  introv R hf,
  -- mirrors the proof of `localization_map_finite`
  classical,
  letI := f.to_algebra,
  letI := ((algebra_map S S').comp f).to_algebra,
  let f' : R' →+* S' := is_localization.map S' f (submonoid.le_comap_map M),
  letI := f'.to_algebra,
  haveI : is_scalar_tower R R' S' :=
    is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,
  let fₐ : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S') (λ c x, ring_hom.map_mul _ _ _),

  obtain ⟨T, hT⟩ := id hf,
  use T.image (algebra_map S S'),
  rw eq_top_iff,
  rintro x -,
  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map (f : R →* S)) x,
  rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, finset.coe_image],
  have hy : y ∈ algebra.adjoin R (T : set S), by { rw hT, trivial },
  replace hy : algebra_map S S' y ∈ (algebra.adjoin R (T : set S)).map fₐ :=
    subalgebra.mem_map.mpr ⟨_, hy, rfl⟩,
  rw fₐ.map_adjoin T at hy,
  have H : algebra.adjoin R ((algebra_map S S') '' T) ≤
    (algebra.adjoin R' ((algebra_map S S') '' T)).restrict_scalars R,
  { rw algebra.adjoin_le_iff, exact algebra.subset_adjoin },
  convert (algebra.adjoin R' ((algebra_map S S') '' T)).smul_mem (H hy)
    (is_localization.mk' R' (1 : R) ⟨r, hr⟩) using 1,
  rw algebra.smul_def,
  erw is_localization.map_mk',
  rw map_one,
  refl,
end

lemma localization_away_map_finite_type (r : R) [is_localization.away r R']
  [is_localization.away (f r) S'] (hf : f.finite_type) :
    (is_localization.away.map R' S' f r).finite_type :=
ring_hom.localization_away_of_localization_preserves @localization_finite_type hf

/--
Let `S` be an `R`-algebra, `M` an submonoid of `R`, and `S' = M⁻¹S`.
If the image of some `x : S` falls in the adjoin of some finite `s ⊆ S'` over `R`,
then there exists some `m : M` such that `m • x` falls in the
adjoin of `finset_integer_multiple _ s` over `R`.
-/
lemma is_localization.lift_mem_adjoin_finset_integer_multiple [algebra R S]
  [algebra R S'] [is_scalar_tower R S S']
  [is_localization (M.map (algebra_map R S : R →* S)) S'] (x : S)
  (s : finset S') (hx : algebra_map S S' x ∈ algebra.adjoin R (s : set S')) :
    ∃ m : M, m • x ∈ algebra.adjoin R
      (is_localization.finset_integer_multiple (M.map (algebra_map R S : R →* S)) s : set S) :=
begin
  -- mirrors the proof of `is_localization.smul_mem_finset_integer_multiple_span`
  let g : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S')
    (λ c x, by simp [algebra.algebra_map_eq_smul_one]),

  let y := is_localization.common_denom_of_finset (M.map (algebra_map R S : R →* S)) s,
  have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
  obtain ⟨y', hy', e : algebra_map R S y' = y⟩ := y.prop,
  have : algebra_map R S y' • (s : set S') = y' • s :=
    by simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul],
  rw [← e, this] at hx₁,
  replace hx₁ := congr_arg (algebra.adjoin R) hx₁,
  obtain ⟨n, hn⟩ := algebra.pow_smul_mem_adjoin_smul _ y' (s : set S') hx,
  specialize hn n (le_of_eq rfl),
  erw [hx₁, ← g.map_smul, ← g.map_adjoin] at hn,
  obtain ⟨x', hx', hx''⟩ := hn,
  obtain ⟨⟨_, a, ha₁, rfl⟩, ha₂⟩ := (is_localization.eq_iff_exists
    (M.map (algebra_map R S : R →* S)) S').mp hx'',
  use (⟨a, ha₁⟩ : M) * (⟨y', hy'⟩ : M) ^ n,
  convert (algebra.adjoin R (is_localization.finset_integer_multiple
    (submonoid.map (algebra_map R S : R →* S) M) s : set S)).smul_mem hx' a using 1,
  convert ha₂.symm,
  { rw [mul_comm (y' ^ n • x), subtype.coe_mk, submonoid.smul_def, submonoid.coe_mul, ← smul_smul,
    algebra.smul_def, submonoid.coe_pow], refl },
  { rw mul_comm, exact algebra.smul_def _ _ }
end

lemma finite_type_of_localization_span : ring_hom.of_localization_span @ring_hom.finite_type :=
begin
  rw ring_hom.of_localization_span_iff_finite,
  introv R hs H,
  -- mirrors the proof of `finite_of_localization_span`
  classical,
  letI := f.to_algebra,
  letI := λ (r : s), (localization.away_map f r).to_algebra,
  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S : R →* S))
    (localization.away (f r)),
  { intro r, rw submonoid.map_powers, exact localization.is_localization },
  haveI : ∀ r : s, is_scalar_tower R (localization.away (r : R)) (localization.away (f r)) :=
    λ r, is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,

  constructor,
  replace H := λ r, (H r).1,
  choose s₁ s₂ using H,
  let sf := λ (x : s), is_localization.finset_integer_multiple (submonoid.powers (f x)) (s₁ x),
  use s.attach.bUnion sf,
  convert (algebra.adjoin_attach_bUnion sf).trans _,
  rw eq_top_iff,
  rintro x -,
  apply (⨆ (x : s), algebra.adjoin R (sf x : set S)).to_submodule
    .mem_of_span_eq_top_of_smul_pow_mem _ hs _ _,
  intro r,
  obtain ⟨⟨_, n₁, rfl⟩, hn₁⟩ := multiple_mem_adjoin_of_mem_localization_adjoin
    (submonoid.powers (r : R)) (localization.away (r : R)) (s₁ r : set (localization.away (f r)))
      (algebra_map S (localization.away (f r)) x) (by { rw s₂ r, trivial }),
  rw [submonoid.smul_def, algebra.smul_def, is_scalar_tower.algebra_map_apply R S,
    subtype.coe_mk, ← map_mul] at hn₁,
  obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.lift_mem_adjoin_finset_integer_multiple
    (submonoid.powers (r : R)) (localization.away (f r)) _ (s₁ r) hn₁,
  rw [submonoid.smul_def, ← algebra.smul_def, smul_smul, subtype.coe_mk, ← pow_add] at hn₂,
  use n₂ + n₁,
  refine le_supr (λ (x : s), algebra.adjoin R (sf x : set S)) r _,
  change _ ∈ algebra.adjoin R
    ((is_localization.finset_integer_multiple _ (s₁ r) : finset S) : set S),
  convert hn₂,
  rw submonoid.map_powers,
  refl,
end

end finite_type


import recover

-- We are given two fields, `K` and `F`
variables {K F : Type*} [field K] [field F]

open module finite_dimensional
open_locale tensor_product

/-
NOTE: This introduces notation `[a]ₘ` for `a : Kˣ`, where `[a]ₘ` is the element of
the base-change `F ⊗[ℤ] (additive Kˣ)` corresponding to `a`.
-/
notation `[`:max a`]ₘ`:max := 1 ⊗ₜ (additive.of_mul a)

lemma one_tmul_mul (a b : Kˣ) : ([a * b]ₘ : F ⊗[ℤ] additive Kˣ) =
  [a]ₘ + [b]ₘ :=
tensor_product.tmul_add _ _ _

lemma one_tmul_inv (a : Kˣ) : ([a⁻¹]ₘ : F ⊗[ℤ] additive Kˣ) = - [a]ₘ :=
tensor_product.tmul_neg _ _

/-
We consider the weak topology on `dual F (F ⊗[ℤ] additive Kˣ)`.
This is just the pointwise convergence topology, i.e. the topology
induced by the product topology on the type of functions `F ⊗[ℤ] additive Kˣ → F`
where `F` is given the discrete topology.
-/
def module.dual.weak_topology :
  topological_space (dual F (F ⊗[ℤ] additive Kˣ)) :=
topological_space.induced (λ e a, e a) $
(@Pi.topological_space (F ⊗[ℤ] additive Kˣ) (λ _, F) $ λ a, ⊥)

/-
We only activate this topological space instance for this file.
-/
local attribute [instance]
  module.dual.weak_topology

-- We give ourselves to natural numbers, `p` and `ℓ`, with `p` being prime.
variables (p ℓ : ℕ) [fact (nat.prime p)]
-- Assume that `K` has characteristic `p`.
variable [char_p K p]
-- Assume that `F` satisfies `[char_p F ℓ]`.
-- NB: If `ℓ = 0`, this is *weaker* than the assumption that `F` has characteristic zero.
-- See the docstring for the `char_p` for more information.
variable [char_p F ℓ]

/- The main theorem of alternating pairs (positive characteristic case). -/
theorem main_alternating_theorem_pos_char
  -- Assume that `p` and `ℓ` are different
  (HH : p ≠ ℓ)
  -- and that 2 is invertible in `F`.
  (htwo : (2 : F) ≠ 0)
  -- Given a submodule `D` of `dual F (F ⊗[ℤ] additive Kˣ)`,
  (D : submodule F (dual F (F ⊗[ℤ] additive Kˣ)))
  -- which is: (1) closed with respect to the topology introduced above;
  (h1 : is_closed (D : set (dual F (F ⊗[ℤ] additive Kˣ))))
  -- (2) every element of `D` maps `[(-1 : Kˣ)]ₘ` to zero;
  (h2 : ∀ (f : dual F (F ⊗[ℤ] additive Kˣ)) (hf : f ∈ D), f [-1]ₘ = 0)
  -- (3) satisfies the alternating condition, i.e. whenever `u v : Kˣ` satisfy
  -- `(u : K) + v = 1`, then `f [u]ₘ * g [v]ₘ = f [v]ₘ * g [u]ₘ`.
  (h3 : ∀ (u v : Kˣ) (huv : (u : K) + v = 1)
    (f g : dual F (F ⊗[ℤ] additive Kˣ))
    (hf : f ∈ D) (hg : g ∈ D),
    f [u]ₘ * g [v]ₘ = f [v]ₘ * g [u]ₘ) :
  -- Then there exists a valuation subring `R` of `K`,
  ∃ (R : valuation_subring K)
  -- and another submodule `I` of `dual F (F ⊗[ℤ] additive Kˣ)`
    (I : submodule F (dual F (F ⊗[ℤ] additive Kˣ)))
    -- which is closed, and such that the following hold:
    (Iclosed : is_closed (I : set (dual F (F ⊗[ℤ] additive Kˣ))))
    -- (1) `I` is contained in `D`;
    (le : I ≤ D)
    -- (2) the elements `f` of `I` satisfy `f [u]ₘ = 0` for `R`-units;
    (units : ∀ (u : Kˣ) (hu : u ∈ R.unit_group)
      (f : dual F (F ⊗[ℤ] additive Kˣ))
      (hf : f ∈ I), f [u]ₘ = 0)
    -- (3) the elements `f` of `D` satisfy `f [u]ₘ = 0` for `R`-principal-units;
    (punits : ∀ (u : Kˣ) (hu : u ∈ R.principal_unit_group)
      (f : dual F (F ⊗[ℤ] additive Kˣ))
      (hf : f ∈ D), f [u]ₘ = 0)
    -- (4) the quotient `D / I` is finite dimensional;
    (fd : finite_dimensional F (↥D ⧸ I.comap D.subtype)),
    -- and `I` has codimension at most one in `D`.
    finrank F (↥D ⧸ I.comap D.subtype) ≤ 1 :=
begin
  rw submodule.is_closed_iff at h1,
  let T := D.dual_annihilator_comap,
  have hTD : T.dual_annihilator = D,
  { dsimp only [T],
    exact h1.dual_comap_dual },
  have hacl : D.acl,
  { refine ⟨h1, h3, h2⟩ },
  have hacl' : T.dual_annihilator.acl,
  { convert hacl },
  obtain ⟨R,H,le,units,principal_units,fd,codim⟩ :=
    main_theorem_mul_char p ℓ HH htwo T hacl',
  let I := H.dual_annihilator,
  obtain ⟨e⟩ : nonempty ((↥D ⧸ submodule.comap D.subtype I) ≃ₗ[F]
    (dual F (↥H ⧸ T.comap H.subtype))),
  { dsimp [I],
    rw ← hTD,
    have e := submodule.dual_mod_comap_iso T H le,
    apply nonempty.intro,
    exact e },
  refine ⟨R, I, _, _, _, _, _, _⟩,
  { rw submodule.is_closed_iff, apply submodule.is_closed_dual_annihilator },
  { intros f hf, rw [← hTD, submodule.mem_dual_annihilator],
    intros w hw,
    dsimp [I] at hf,
    erw submodule.mem_dual_annihilator at hf,
    apply hf, apply le, assumption },
  { intros u hu,
    rw ← submodule.mem_dual_annihilator_comap_iff,
    dsimp [I], rw submodule.dual_annihilator_dual_annihilator_comap,
    apply units, assumption },
  { intros u hu,
    rw ← submodule.mem_dual_annihilator_comap_iff,
    apply principal_units, assumption },
  { resetI, apply e.symm.finite_dimensional },
  { resetI, rwa [e.finrank_eq, subspace.dual_finrank_eq] },
end


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Module.kernels
import Mathlib.algebra.category.Module.limits
import Mathlib.category_theory.abelian.exact
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# The category of left R-modules is abelian.

Additionally, two linear maps are exact in the categorical sense iff `range f = ker g`.
-/

namespace Module

/-- In the category of modules, every monomorphism is normal. -/
def normal_mono {R : Type u} [ring R] {M : Module R} {N : Module R} (f : M ⟶ N) (hf : category_theory.mono f) : category_theory.normal_mono f :=
  category_theory.normal_mono.mk (of R (submodule.quotient (linear_map.range f))) (submodule.mkq (linear_map.range f))
    sorry
    (category_theory.limits.is_kernel.iso_kernel (submodule.mkq (linear_map.range f)) f
      (kernel_is_limit (submodule.mkq (linear_map.range f)))
      (linear_equiv.to_Module_iso'
        (linear_equiv.trans (linear_equiv.symm (submodule.quot_equiv_of_eq_bot (linear_map.ker f) (ker_eq_bot_of_mono f)))
          (linear_equiv.trans (linear_map.quot_ker_equiv_range f)
            (linear_equiv.of_eq (linear_map.range f) (linear_map.ker (submodule.mkq (linear_map.range f))) sorry))))
      sorry)

/-- In the category of modules, every epimorphism is normal. -/
def normal_epi {R : Type u} [ring R] {M : Module R} {N : Module R} (f : M ⟶ N) (hf : category_theory.epi f) : category_theory.normal_epi f :=
  category_theory.normal_epi.mk (of R ↥(linear_map.ker f)) (submodule.subtype (linear_map.ker f)) sorry
    (category_theory.limits.is_cokernel.cokernel_iso (submodule.subtype (linear_map.ker f)) f
      (cokernel_is_colimit (submodule.subtype (linear_map.ker f)))
      (linear_equiv.to_Module_iso'
        (linear_equiv.trans
          (linear_equiv.trans
            (submodule.quot_equiv_of_eq (linear_map.range (submodule.subtype (linear_map.ker f))) (linear_map.ker f)
              sorry)
            (linear_map.quot_ker_equiv_range f))
          (linear_equiv.of_top (linear_map.range f) (range_eq_top_of_epi f))))
      sorry)

/-- The category of R-modules is abelian. -/
protected instance category_theory.abelian {R : Type u} [ring R] : category_theory.abelian (Module R) :=
  category_theory.abelian.mk (fun (X Y : Module R) => normal_mono) fun (X Y : Module R) => normal_epi

theorem exact_iff {R : Type u} [ring R] {M : Module R} {N : Module R} (f : M ⟶ N) {O : Module R} (g : N ⟶ O) : category_theory.exact f g ↔ linear_map.range f = linear_map.ker g := sorry


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  case left => exact hp
  case right =>
    apply And.intro
    case left => exact hq
    case right => exact hp


import data.list.basic
import category.traversable.instances

universes u v

def foldl (α : Type u) (β : Type v) := α → α
def foldr (α : Type u) (β : Type v) := α → α

instance {α} : applicative (foldr α) :=
{ pure := λ _ _, id,
  seq := λ _ _ f x, f ∘ x }

instance {α} : applicative (foldl α) :=
{ pure := λ _ _, id,
  seq := λ _ _ f x, x ∘ f }

instance {α} : is_lawful_applicative (foldr α) :=
by refine { .. }; intros; refl

instance {α} : is_lawful_applicative (foldl α) :=
by refine { .. }; intros; refl

def foldr.eval {α β} (x : foldr α β) : α → α := x

def foldl.eval {α β} (x : foldl α β) : α → α := x

def foldl.cons {α β} (x : α) : foldl (list α) β :=
list.cons x

def foldr.cons {α β} (x : α) : foldr (list α) β :=
list.cons x

def foldl.cons' {α} (x : α) : foldl (list α) punit :=
list.cons x

def foldl.lift {α} (x : α → α) : foldl α punit := x
def foldr.lift {α} (x : α → α) : foldr α punit := x

namespace traversable

variables {t : Type u → Type u} [traversable t]

def to_list {α} (x : t α) : list α :=
(foldl.eval (traverse foldl.cons' x) []).reverse

def foldl {α β} (f : α → β → α) (x : α) (xs : t β) : α :=
foldl.eval (traverse (foldl.lift ∘ flip f) xs) x

def foldr {α β} (f : α → β → β) (x : β) (xs : t α) : β :=
foldr.eval (traverse (foldr.lift ∘ f) xs) x

open ulift

def length {α} (xs : t α) : ℕ :=
down $ foldl (λ l _, up $ 1+down l) (up 0) xs

lemma list_foldl_eq {α β} (f : α → β → α) (x : α) (xs : list β) :
  foldl f x xs = list.foldl f x xs :=
begin
  simp [foldl,foldl.eval,traverse,foldl.lift,(∘),flip,list.foldl],
  symmetry,
  induction xs generalizing x, refl,
  simp [list.traverse,list.foldl,xs_ih,(<*>),(<$>)],
end

lemma list_foldr_eq {α β} (f : α → β → β) (x : β) (xs : list α) :
  foldr f x xs = list.foldr f x xs :=
begin
  simp [foldr,foldr.eval,traverse,foldr.lift,(∘),flip,list.foldr],
  symmetry, induction xs, refl,
  simp [list.traverse,list.foldl,xs_ih,(<*>),(<$>)],
end

end traversable

open traversable

lemma list.to_list_eq_self {α} (xs : list α) :
  to_list xs = xs :=
begin
  simp [traversable.to_list,traverse,foldl.eval],
  suffices : ∀ s, (list.traverse foldl.cons' xs s).reverse = s.reverse ++ xs,
  { rw [this], simp },
  induction xs; intros s;
  simp [list.traverse,pure,(<*>),(<$>),foldl.cons',*],
end

lemma list.length_to_list {α} (xs : list α) :
  length (to_list xs) = xs.length :=
by { rw [length,list_foldl_eq,list.to_list_eq_self,← list.foldr_reverse,← list.length_reverse],
     generalize : list.reverse xs = l,
     induction l; simp *, }
#check @traverse
instance {α : Type u} : traversable (prod.{u u} α) :=
{ map := λ β γ f (x : α × β), prod.mk x.1 $ f x.2,
  traverse := λ m _ β γ f (x : α × β), by exactI prod.mk x.1 <$> f x.2 }


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Kevin Buzzard
-/

import algebra.homology.exact
import category_theory.types
import category_theory.preadditive.projective
import category_theory.limits.shapes.biproducts

/-!
# Injective objects and categories with enough injectives

An object `J` is injective iff every morphism into `J` can be obtained by extending a monomorphism.
-/

noncomputable theory

open category_theory
open category_theory.limits

universes v u

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

/--
An object `J` is injective iff every morphism into `J` can be obtained by extending a monomorphism.
-/
class injective (J : C) : Prop :=
(factors : ∀ {X Y : C} (g : X ⟶ J) (f : X ⟶ Y) [mono f], ∃ h : Y ⟶ J, f ≫ h = g)

section
/--
An injective presentation of an object `X` consists of a monomorphism `f : X ⟶ J`
to some injective object `J`.
-/
@[nolint has_inhabited_instance]
structure injective_presentation (X : C) :=
(J : C)
(injective : injective J . tactic.apply_instance)
(f : X ⟶ J)
(mono : mono f . tactic.apply_instance)

variables (C)

/-- A category "has enough injectives" if every object has an injective presentation,
i.e. if for every object `X` there is an injective object `J` and a monomorphism `X ↪ J`. -/
class enough_injectives : Prop :=
(presentation : ∀ (X : C), nonempty (injective_presentation X))

end

namespace injective

/--
Let `J` be injective and `g` a morphism into `J`, then `g` can be factored through any monomorphism.
-/
def factor_thru {J X Y : C} [injective J] (g : X ⟶ J) (f : X ⟶ Y) [mono f] : Y ⟶ J :=
(injective.factors g f).some

@[simp] lemma comp_factor_thru {J X Y : C} [injective J] (g : X ⟶ J) (f : X ⟶ Y) [mono f] :
  f ≫ factor_thru g f = g :=
(injective.factors g f).some_spec

section
open_locale zero_object

instance zero_injective [has_zero_object C] [has_zero_morphisms C] : injective (0 : C) :=
{ factors := λ X Y g f mono, ⟨0, by ext⟩ }

end

lemma of_iso {P Q : C} (i : P ≅ Q) (hP : injective P) : injective Q :=
{ factors := λ X Y g f mono, begin
  obtain ⟨h, h_eq⟩ := @injective.factors C _ P _ _ _ (g ≫ i.inv) f mono,
  refine ⟨h ≫ i.hom, _⟩,
  rw [←category.assoc, h_eq, category.assoc, iso.inv_hom_id, category.comp_id],
end }

lemma iso_iff {P Q : C} (i : P ≅ Q) : injective P ↔ injective Q :=
⟨of_iso i, of_iso i.symm⟩

/-- The axiom of choice says that every nonempty type is an injective object in `Type`. -/
instance (X : Type u) [nonempty X] : injective X :=
{ factors := λ Y Z g f mono,
  ⟨λ z, by classical; exact
    if h : z ∈ set.range f
    then g (classical.some h)
    else nonempty.some infer_instance, begin
    ext y,
    change dite _ _ _ = _,
    split_ifs,
    { rw mono_iff_injective at mono,
      rw mono (classical.some_spec h) },
    { exact false.elim (h ⟨y, rfl⟩) },
  end⟩ }

instance Type.enough_injectives : enough_injectives (Type u) :=
{ presentation := λ X, nonempty.intro
  { J := with_bot X,
    injective := infer_instance,
    f := option.some,
    mono := by { rw [mono_iff_injective], exact option.some_injective X, } } }

instance {P Q : C} [has_binary_product P Q] [injective P] [injective Q] :
  injective (P ⨯ Q) :=
{ factors := λ X Y g f mono, begin
  resetI,
  use limits.prod.lift (factor_thru (g ≫ limits.prod.fst) f) (factor_thru (g ≫ limits.prod.snd) f),
  simp only [prod.comp_lift, comp_factor_thru],
  ext,
  { simp only [prod.lift_fst] },
  { simp only [prod.lift_snd] },
end }

instance {β : Type v} (c : β → C) [has_product c] [∀ b, injective (c b)] :
  injective (∏ c) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨pi.lift (λ b, factor_thru (g ≫ (pi.π c _)) f), _⟩,
  ext,
  simp only [category.assoc, limit.lift_π, fan.mk_π_app, comp_factor_thru],
end }

instance {P Q : C} [has_zero_morphisms C] [has_binary_biproduct P Q]
  [injective P] [injective Q] :
  injective (P ⊞ Q) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨biprod.lift (factor_thru (g ≫ biprod.fst) f) (factor_thru (g ≫ biprod.snd) f), _⟩,
  ext,
  { simp only [category.assoc, biprod.lift_fst, comp_factor_thru] },
  { simp only [category.assoc, biprod.lift_snd, comp_factor_thru] },
end }

instance {β : Type v} [decidable_eq β] (c : β → C) [has_zero_morphisms C] [has_biproduct c]
  [∀ b, injective (c b)] : injective (⨁ c) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨biproduct.lift (λ b, factor_thru (g ≫ biproduct.π _ _) f), _⟩,
  ext,
  simp only [category.assoc, biproduct.lift_π, comp_factor_thru],
end }

instance {P : Cᵒᵖ} [projective P] : injective (P.unop) :=
{ factors := λ X Y g f mono, begin
  resetI,
  refine ⟨(@projective.factor_thru Cᵒᵖ _ P (opposite.op X) (opposite.op Y) _ g.op f.op _).unop, _⟩,
  convert congr_arg quiver.hom.unop (@projective.factor_thru_comp Cᵒᵖ _ P
    (opposite.op X) (opposite.op Y) _ g.op f.op _),
end }

instance {J : C} [injective J] : projective (opposite.op J) :=
{ factors := λ E X f e epi, begin
  resetI,
  refine ⟨(@factor_thru C _ J _ _ _ f.unop e.unop _).op, _⟩,
  convert congr_arg quiver.hom.op (@comp_factor_thru C _ J _ _ _ f.unop e.unop _),
end }

section enough_injectives
variable [enough_injectives C]

/--
`injective.under X` provides an arbitrarily chosen injective object equipped with
an monomorphism `injective.ι : X ⟶ injective.under X`.
-/
def under (X : C) : C :=
(enough_injectives.presentation X).some.J

instance injective_under (X : C) : injective (under X) :=
(enough_injectives.presentation X).some.injective

/--
The monomorphism `injective.ι : X ⟶ injective.under X`
from the arbitrarily chosen injective object under `X`.
-/
def ι (X : C) : X ⟶ under X :=
(enough_injectives.presentation X).some.f

instance ι_mono (X : C) : mono (ι X) :=
(enough_injectives.presentation X).some.mono

section
variables [has_zero_morphisms C] {X Y : C} (f : X ⟶ Y) [has_cokernel f]

/--
When `C` has enough injectives, the object `injective.syzygies f` is
an arbitrarily chosen injective object under `cokernel f`.
-/
@[derive injective]
def syzygies : C := under (cokernel f)

/--
When `C` has enough injective,
`injective.d f : Y ⟶ syzygies f` is the composition
`cokernel.π f ≫ ι (cokernel f)`.

(When `C` is abelian, we have `exact f (injective.d f)`.)
-/
abbreviation d : Y ⟶ syzygies f :=
cokernel.π f ≫ ι (cokernel f)

end

end enough_injectives

open injective

section
variables [has_zero_morphisms C] [has_images Cᵒᵖ] [has_equalizers Cᵒᵖ]

/--
Given a pair of exact morphism `f : Q ⟶ R` and `g : R ⟶ S` and a map `h : R ⟶ J` to an injective
object `J` such that `f ≫ h = 0`, then `g` descents to a map `S ⟶ J`. See below:

```
Q --- f --> R --- g --> S
            |
            | h
            v
            J
```
-/
def exact.desc {J Q R S : C} [injective J] (h : R ⟶ J) (f : Q ⟶ R) (g : R ⟶ S)
  (hgf : exact g.op f.op) (w : f ≫ h = 0)  : S ⟶ J :=
(exact.lift h.op g.op f.op hgf (congr_arg quiver.hom.op w)).unop

@[simp] lemma exact.comp_desc {J Q R S : C} [injective J] (h : R ⟶ J) (f : Q ⟶ R) (g : R ⟶ S)
  (hgf : exact g.op f.op) (w : f ≫ h = 0) : g ≫ exact.desc h f g hgf w = h :=
by convert congr_arg quiver.hom.unop
  (exact.lift_comp h.op g.op f.op hgf (congr_arg quiver.hom.op w))

end

end injective

end category_theory


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ x : ℚ, (x + 1)^(n : ℕ) = x^n + (n : ℕ) * x^(n - 1) + polynomial.bernoulli n x, from sorry,
  have h2 : ∀ x : ℚ, polynomial.eval (polynomial.bernoulli n) (x + 1) = polynomial.eval (polynomial.bernoulli n)  x + (n : ℕ) * x^(n - 1), from sorry,
  show (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1), from sorry,
end

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  sorry,
end

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  sorry
end

--OUTPUT 4
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  sorry,
end

--OUTPUT 5
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  sorry
end

--OUTPUT 6
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  apply nat.strong_induction_on n,
  assume (d : ℕ) (h1 : ∀ (k : ℕ), k < d → (polynomial.bernoulli k).eval (1 + x) = (polynomial.bernoulli k).eval x + k * x^(k - 1)),
  assume h2 : ∀ (k : ℕ), k < d → (polynomial.bernoulli (succ k)).eval (1 + x) = (polynomial.bernoulli (succ k)).eval x + (succ k) * x^(succ k - 1),
  rw [polynomial.bernoulli_eval_add, polynomial.bernoulli_eval_one],
  have h3 : (polynomial.bernoulli d).eval x + d * x^(d - 1) = (polynomial.bernoulli d).eval (1 + x) - x^d + d * x^(d - 1), from sorry,
  sorry,
end

--OUTPUT 7
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
    simp,
  -- TODO: This is a little bit ugly, but it works.
  have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h2 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d), from sorry,
  have h3 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h4 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h5 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h6 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h7 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h8 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h9 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h10 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h11 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d, from sorry,
  have h12 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
            (d + 1) * (1 + x)^d - (d + 1) * x^d + (d + 1) * (x^d - x^d) + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) * x^d - (d + 1) * x^d + (d + 1) *
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  sorry
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


lemma le_zero (a : mynat) (h : a ≤ 0) : a = 0 :=
begin
cases h with b hd,
symmetry at hd,
exact add_right_eq_zero hd,
end


import tactic

-- First we do the question using Prop (optimised for proving)

variables (P Q R S U : Prop)

example : ∃ P Q R S U : Prop,
(Q ∨ P ∨ U) ∧ (U ∨ ¬Q ∨ S) ∧ (U ∨ Q ∨ ¬R) ∧ (P ∨ R ∨ ¬S) ∧
(P ∨ S ∨ R) ∧ (R ∨ ¬U ∨ Q) ∧ (R ∨ S ∨ ¬U) ∧ (¬S ∨ ¬R ∨ U) ∧
(U ∨ ¬Q ∨ ¬R) ∧ (¬Q ∨ U ∨ ¬S) ∧ (¬P ∨ ¬R ∨ Q) ∧ (S ∨ ¬U ∨ ¬P) ∧
(¬R ∨ ¬P ∨ U) ∧ (S ∨ ¬R ∨ ¬U) ∧ (¬R ∨ ¬Q ∨ ¬S) ∧ (Q ∨ R ∨ S) ∧
(¬U ∨ P ∨ ¬Q) ∧ (R ∨ ¬Q ∨ ¬P) ∧ (P ∨ R ∨ ¬Q) ∧ (S ∨ P ∨ Q) ∧
(R ∨ P ∨ U) ∧ (¬U ∨ Q ∨ R) ∧ (¬U ∨ R ∨ ¬Q) ∧ (¬S ∨ ¬U ∨ ¬Q) ∧
(¬U ∨ ¬S ∨ R) ∧ (¬S ∨ P ∨ U) ∧ (P ∨ Q ∨ ¬R) ∧ (¬S ∨ ¬R ∨ U) ∧
(¬Q ∨ ¬S ∨ U) ∧ (P ∨ R ∨ ¬Q) ∧ (P ∨ Q ∨ ¬S) ∧ (U ∨ ¬S ∨ ¬P) ∧
(¬U ∨ R ∨ ¬P) ∧ (¬U ∨ P ∨ ¬Q) ∧ (¬R ∨ ¬P ∨ S) ∧ (R ∨ S ∨ ¬U) ∧
(P ∨ ¬U ∨ Q) ∧ (¬S ∨ R ∨ P) ∧ (¬P ∨ ¬Q ∨ ¬R) ∧ (¬P ∨ R ∨ ¬S) :=
begin
  -- unprovable according to bool calc
  sorry
end

theorem trick {Q : Prop} (hQ : Q) : Q ↔ true :=
iff_of_true hQ trivial
theorem trick2 {Q : Prop} (hQ : ¬ Q) : Q ↔ false :=
iff_false_intro hQ

example : ∀ P Q R S U : Prop,
  ¬ (
(Q ∨ P ∨ U) ∧ (U ∨ ¬Q ∨ S) ∧ (U ∨ Q ∨ ¬R) ∧ (P ∨ R ∨ ¬S) ∧
(P ∨ S ∨ R) ∧ (R ∨ ¬U ∨ Q) ∧ (R ∨ S ∨ ¬U) ∧ (¬S ∨ ¬R ∨ U) ∧
(U ∨ ¬Q ∨ ¬R) ∧ (¬Q ∨ U ∨ ¬S) ∧ (¬P ∨ ¬R ∨ Q) ∧ (S ∨ ¬U ∨ ¬P) ∧
(¬R ∨ ¬P ∨ U) ∧ (S ∨ ¬R ∨ ¬U) ∧ (¬R ∨ ¬Q ∨ ¬S) ∧ (Q ∨ R ∨ S) ∧
(¬U ∨ P ∨ ¬Q) ∧ (R ∨ ¬Q ∨ ¬P) ∧ (P ∨ R ∨ ¬Q) ∧ (S ∨ P ∨ Q) ∧
(R ∨ P ∨ U) ∧ (¬U ∨ Q ∨ R) ∧ (¬U ∨ R ∨ ¬Q) ∧ (¬S ∨ ¬U ∨ ¬Q) ∧
(¬U ∨ ¬S ∨ R) ∧ (¬S ∨ P ∨ U) ∧ (P ∨ Q ∨ ¬R) ∧ (¬S ∨ ¬R ∨ U) ∧
(¬Q ∨ ¬S ∨ U) ∧ (P ∨ R ∨ ¬Q) ∧ (P ∨ Q ∨ ¬S) ∧ (U ∨ ¬S ∨ ¬P) ∧
(¬U ∨ R ∨ ¬P) ∧ (¬U ∨ P ∨ ¬Q) ∧ (¬R ∨ ¬P ∨ S) ∧ (R ∨ S ∨ ¬U) ∧
(P ∨ ¬U ∨ Q) ∧ (¬S ∨ R ∨ P) ∧ (¬P ∨ ¬Q ∨ ¬R) ∧ (¬P ∨ R ∨ ¬S)) :=
begin
  intros,
  by_cases hP : P;rw trick hP; try {rw iff_false_intro hP}; clear hP; simp;
  by_cases hP : Q;rw trick hP; try {rw iff_false_intro hP}; clear hP; simp;
  by_cases hP : R;rw trick hP; try {rw iff_false_intro hP}; clear hP; simp;
  by_cases hP : S;rw trick hP; try {rw iff_false_intro hP}; clear hP; simp;
  by_cases hP : U;rw trick hP; try {rw iff_false_intro hP}; clear hP; simp,
end

example : ∃ P Q R S U : bool,
(Q || P || U) && (U || !Q || S) && (U || Q || !R) && (P || R || !S) &&
(P || S || R) && (R || !U || Q) && (R || S || !U) && (!S || !R || U) &&
(U || !Q || !R) && (!Q || U || !S) && (!P || !R || Q) && (S || !U || !P) &&
(!R || !P || U) && (S || !R || !U) && (!R || !Q || !S) && (Q || R || S) &&
(!U || P || !Q) && (R || !Q || !P) && (P || R || !Q) && (S || P || Q) &&
(R || P || U) && (!U || Q || R) && (!U || R || !Q) && (!S || !U || !Q) &&
(!U || !S || R) && (!S || P || U) && (P || Q || !R) && (!S || !R || U) &&
(!Q || !S || U) && (P || R || !Q) && (P || Q || !S) && (U || !S || !P) &&
(!U || R || !P) && (!U || P || !Q) && (!R || !P || S) && (R || S || !U) &&
(P || !U || Q) && (!S || R || P) && (!P || !Q || !R) && (!P || R || !S) = tt :=
begin
  simp,
  -- ⊢ false
  -- oops
  sorry
end

example : ∀ P Q R S U : bool,
(Q || P || U) && (U || !Q || S) && (U || Q || !R) && (P || R || !S) &&
(P || S || R) && (R || !U || Q) && (R || S || !U) && (!S || !R || U) &&
(U || !Q || !R) && (!Q || U || !S) && (!P || !R || Q) && (S || !U || !P) &&
(!R || !P || U) && (S || !R || !U) && (!R || !Q || !S) && (Q || R || S) &&
(!U || P || !Q) && (R || !Q || !P) && (P || R || !Q) && (S || P || Q) &&
(R || P || U) && (!U || Q || R) && (!U || R || !Q) && (!S || !U || !Q) &&
(!U || !S || R) && (!S || P || U) && (P || Q || !R) && (!S || !R || U) &&
(!Q || !S || U) && (P || R || !Q) && (P || Q || !S) && (U || !S || !P) &&
(!U || R || !P) && (!U || P || !Q) && (!R || !P || S) && (R || S || !U) &&
(P || !U || Q) && (!S || R || P) && (!P || !Q || !R) && (!P || R || !S) = ff :=
begin
  --simp -- this works
  -- but `squeeze_simp` gives information about how `simp` did it
  -- and it tells us that this works too:
  --simp only [bnot_eq_ff_eq_eq_tt, bor_eq_false_eq_eq_ff_and_eq_ff,
  --  bool.forall_bool, eq_self_iff_true, or_false, or_true, and_self,
  --  and_false, false_and, band_eq_false_eq_eq_ff_or_eq_ff],

  -- Clearly it's using reasoning. Here's a real proof by cases:
  rintros (P|P) (Q|Q) (R|R) (S|S) (T|T); -- 32 goals at this point, change `;` to `,` to see them
  refl,
end


namespace Hidden
inductive Bool where
  | false : Bool
  | true  : Bool

def and (a b : Bool) : Bool :=
  match a with
  | Hidden.Bool.true => b
  | Hidden.Bool.false => Hidden.Bool.false

def or (a b : Bool) : Bool :=
  match a, b with
  | Hidden.Bool.true, _ => Hidden.Bool.true
  | _, Hidden.Bool.true => Hidden.Bool.true
  | _, _ => Hidden.Bool.false

def not (a : Bool) : Bool :=
  match a with
  | Hidden.Bool.true => Hidden.Bool.false
  | Hidden.Bool.false => Hidden.Bool.true

end Hidden

-- namespace Hidden
-- inductive List (α : Type u) where
-- | nil  : List α
-- | cons : α → List α → List α

-- namespace List
-- def append (as bs : List α) : List α :=
--  match as with
--  | nil       => bs
--  | cons a as => cons a (append as bs)

-- theorem nil_append (as : List α) : append nil as = as :=
--  rfl

-- theorem cons_append (a : α) (as bs : List α)
--                     : append (cons a as) bs = cons a (append as bs) :=
--  rfl

-- #check @Nat.recOn
-- -- @Nat.recOn : {motive : Nat → Sort u_1} →
-- -- (t : Nat) → motive Nat.zero → ((n : Nat) → motive n → motive (Nat.succ n)) → motive t

-- #check @List.recOn
-- -- @List.recOn : {α : Type u_2} →
-- -- {motive : List α → Sort u_1} →
-- -- (t : List α) → motive nil → ((a : α) → (a_1 : List α) → motive a_1 → motive (cons a a_1)) → motive t

-- theorem append_nil (as : List α) : append as nil = as :=
--   List.recOn (motive := fun xs => append xs nil = xs) as
--   (by simp [nil_append]) -- rfl also works
--   (fun α xs f => by simp [cons_append, f])

-- theorem append_assoc (as bs cs : List α)
--         : append (append as bs) cs = append as (append bs cs) :=
--   List.recOn (motive := fun xs => append (append xs bs) cs = append xs (append bs cs)) as
--   rfl
--   (fun α xs f => by simp [cons_append, f])

-- def length {α : Type u} (xs : List α) : Nat :=
--   match xs with
--   | nil => 0
--   | cons _ xs => 1 + (length xs)

-- def as := cons 1 (cons 2 (cons 3 nil))
-- def bs := cons 4 nil

-- #eval length (append as bs) = length as + length bs

-- end List
-- end Hidden

open Nat

example (n : Nat) (h : n ≠ 0) : succ (pred n) = n := by
  cases n with
  | zero =>
    -- goal: h : 0 ≠ 0 ⊢ succ (pred 0) = 0
    apply absurd rfl h
  | succ m =>
    -- second goal: h : succ m ≠ 0 ⊢ succ (pred (succ m)) = succ m
    rfl

open Nat

example (p : Nat → Prop) (hz : p 0) (hs : ∀ n, p (succ n)) (m k : Nat)
        : p (m + 3 * k) := by
  cases m + 3 * k -- occurs in the goal
  exact hz   -- goal is p 0
  apply hs   -- goal is a : ℕ ⊢ p (succ a)

open Nat

example (p : Nat → Prop) (hz : p 0) (hs : ∀ n, p (succ n)) (m k : Nat)
        : p (m + 3 * k) := by
  generalize m + 3 * k = n
  cases n
  exact hz   -- goal is p 0
  apply hs   -- goal is a : ℕ ⊢ p (succ a)

example : s ∧ q ∧ r → p ∧ r → q ∧ p := by
  intro ⟨_, ⟨hq, _⟩⟩ ⟨hp, _⟩
  exact ⟨hq, hp⟩

example :
    (fun (x : Nat × Nat) (y : Nat × Nat) => x.1 + y.2)
    =
    (fun (x : Nat × Nat) (z : Nat × Nat) => z.2 + x.1) := by
  funext (a, b) (c, d) -- not clear
  show a + d = d + a
  rw [Nat.add_comm]

example (m n k : Nat) (h : succ (succ m) = succ (succ n))
        : n + k = m + k := by
  injection h with h'
  injection h' with h''
  rw [h'']

example (m n : Nat) (h : succ m = 0) : n = n + 7 := by
  injection h

example (m n : Nat) (h : succ m = 0) : n = n + 7 := by
  contradiction

example (h : 7 = 4) : False := by
  contradiction

namespace Hidden
inductive Vector (α : Type u) : Nat → Type u where
  | nil  : Vector α 0
  | cons : α → {n : Nat} → Vector α n → Vector α (n+1)
end Hidden

namespace Hidden
theorem symm {α : Type u} {a b : α} (h : Eq a b) : Eq b a :=
  match h with
  | rfl => rfl

theorem trans {α : Type u} {a b c : α} (h₁ : Eq a b) (h₂ : Eq b c) : Eq a c := by
  rw [h₁, h₂]

theorem congr {α β : Type u} {a b : α} (f : α → β) (h : Eq a b) : Eq (f a) (f b) := by
  simp [h]

end Hidden

mutual
  inductive Even : Nat → Prop where
    | even_zero : Even 0
    | even_succ : (n : Nat) → Odd n → Even (n + 1)

  inductive Odd : Nat → Prop where
    | odd_succ : (n : Nat) → Even n → Odd (n + 1)
end

-- -------------------------- EXERCISES --------------------------------------
-- 1

namespace Hidden

def mul (n1 : Nat) (n2 : Nat) : Nat :=
  match n1, n2 with
  | zero, _ => zero
  | _, zero => zero
  | x, succ y => Nat.add x (mul x y)

instance : Mul Nat where
  mul := mul

#eval mul 3 0

def pred (n : Nat) : Nat :=
  match n with
  | zero => 0
  | succ x => x

#eval pred 4

def sub (n : Nat) (m : Nat) : Nat :=
  match n,m with
  | zero, _ => 0
  | a, zero => a
  | a, succ b => if b >= (a - 1) then 0 else pred (sub a b)

#eval sub 3 6

def exp (n : Nat) (m : Nat) : Nat :=
  match m with
  | zero => 1
  | succ x => mul n (exp n x)

#eval exp 3 3

theorem mul_zero (m : Nat) : m * zero = zero := by
  cases m
  case zero => rfl
  case succ x => rfl

theorem zero_mul (m : Nat) : zero * m = zero := by
  cases m
  case zero => rfl
  case succ x => rfl

theorem mul_com (n m : Nat) : m * n = n * m := by
  cases n
  case zero => simp [mul_zero, zero_mul]
  case succ x => sorry

theorem mul_distr (a b c: Nat) : a * (b + c) = a * b + a * c := sorry

end Hidden

namespace Hidden
inductive List (α : Type u) where
| nil  : List α
| cons : α → List α → List α
deriving Repr

namespace List
def append (as bs : List α) : List α :=
 match as with
 | nil       => bs
 | cons a as => cons a (append as bs)

theorem nil_append (as : List α) : append nil as = as :=
 rfl

theorem cons_append (a : α) (as bs : List α)
                    : append (cons a as) bs = cons a (append as bs) :=
 rfl

#check @Nat.recOn
-- @Nat.recOn : {motive : Nat → Sort u_1} →
-- (t : Nat) → motive Nat.zero → ((n : Nat) → motive n → motive (Nat.succ n)) → motive t

#check @List.recOn
-- @List.recOn : {α : Type u_2} →
-- {motive : List α → Sort u_1} →
-- (t : List α) → motive nil → ((a : α) → (a_1 : List α) → motive a_1 → motive (cons a a_1)) → motive t

theorem append_nil (as : List α) : append as nil = as :=
  List.recOn (motive := fun xs => append xs nil = xs) as
  (by simp [nil_append]) -- rfl also works
  (fun α xs f => by simp [cons_append, f])

theorem append_assoc (as bs cs : List α)
        : append (append as bs) cs = append as (append bs cs) :=
  List.recOn (motive := fun xs => append (append xs bs) cs = append xs (append bs cs)) as
  rfl
  (fun α xs f => by simp [cons_append, f])

-- 2
def length {α : Type u} (xs : List α) : Nat :=
  match xs with
  | nil => 0
  | cons _ xs => 1 + (length xs)

def as := cons 1 (cons 2 (cons 3 nil))
def bs := cons 4 nil

#eval length (append as bs) = length as + length bs

def reverse {α : Type u} (xs : List α) : List α :=
  match xs with
  | nil => nil
  | cons x xs => append (reverse xs) (cons x nil)

#eval reverse (cons 1 (cons 2 (cons 3 nil)))

theorem length_nil (s : List α) (h : s = nil) : length s = 0 := by
  rw [h]
  rfl

theorem length_theorem (s t : List α) : length (append s t) = length s + length t := sorry

theorem length_reverse (t : List α) : length (reverse t) = length t := sorry

theorem reverse_theorem (t : List α) : reverse (reverse t) = t := sorry

end List
end Hidden

-- 3
namespace Hidden

inductive Expr where
  | const : Nat -> Expr
  | var : Nat -> Expr
  | plus : Expr -> Expr -> Expr
  | times : Expr -> Expr -> Expr
deriving Repr

def eval (e : Expr) : Nat :=
  match e with
  | Expr.const x => x
  | Expr.var x => x
  | Expr.plus e1 e2 => (eval e1) + (eval e2)
  | Expr.times e1 e2 => (eval e1) * (eval e2)

#eval eval (Expr.plus (Expr.const 5) (Expr.var 3))

end Hidden

-- 4


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units {p : ℕ} [hp : prime p] (x : ℕ) : coprime x p → is_unit (⟨x, hp⟩ : ℤp) :=
begin
  assume hx,
  have h1 : ∀ x : ℤp, is_unit x ↔ norm x = 1, from by sorry,
  have h2 : norm (⟨x, hp⟩ : ℤp) ≠ 1, from by sorry,
  have h3 : norm (⟨x, hp⟩ : ℤp) < 1, from by sorry,
  have h4 : p ∣ x, from by sorry,
  have h5 : ¬ coprime x p, from by sorry,
  have h6 : ¬ is_unit (⟨x, hp⟩ : ℤp), from by sorry,
  show is_unit (⟨x, hp⟩ : ℤp), from sorry,
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) (hp : prime p) (x : ℕ) (hx : coprime p x) : is_unit (ℤ_[p] x) :=
begin
  have h1 : ¬ is_unit (ℤ_[p] x) → p ∣ x, from sorry,
  have h2 : ¬ is_unit (ℤ_[p] x) → ¬ coprime p x, from sorry,
  show is_unit (ℤ_[p] x), from sorry,
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) (hp : p.prime) (x : ℕ) (hx : x.coprime p) : (x : ℤp) ∈ (units ℤp) :=
begin
  have h1 : ¬(↥x:ℤp) ∈ units ℤp → (p ∣ x), from sorry,
  have h2 : ¬(↥x:ℤp) ∈ units ℤp, from sorry,
  show (↥x : ℤp) ∈ units ℤp, from sorry,
end

--OUTPUT 4
theorem p_adic_units (p : ℕ) (x : ℕ) :
    x.prime → (x.coprime p) → (x.nat_abs.val.nth_root p).val.norm_val = 1 :=
begin
  assume (h1 : x.prime) (h2 : x.coprime p),
  have h3 : p.coprime x, from sorry,
  have h4 : (p : ℤ) ∣ x, from sorry,
  have h5 : (x : ℤ) ∣ p, from sorry,
  sorry,
end

--OUTPUT 5
theorem p_adic_units (p : ℕ) (x : ℕ) (h : x.coprime p) : x.nat_abs.val.is_unit_of_padic_int p :=
begin
  sorry,
end

--OUTPUT 6
theorem p_adic_units (p : ℕ) [prime p] (x : ℕ) (h1 : coprime x p) : is_unit (x : ℤ_[p]) :=
begin
  sorry,
end

--OUTPUT 7
theorem p_adic_units (p : ℕ) (x : ℕ) : (coprime x p) → (∃ y : ℕ, x * y = 1) :=
begin
  assume h : coprime x p,
  have h1 : ∀ x : ℕ, ∃ y : ℕ, x * y = 1 → coprime x p, from sorry,
  have h2 : ∀ x : ℕ, ∃ y : ℕ, x * y = 1 → ∃ y : ℕ, y * x = 1, from sorry,
  have h3 : ∀ x : ℕ, ∃ y : ℕ, x * y = 1 → ∃ y : ℕ, (x * y = 1) ∧ (y * x = 1), from sorry,
  have h4 : ∀ x : ℕ, ∃ y : ℕ, x * y = 1 → ∃ y : ℕ, x * y = 1 ∧ y * x = 1, from sorry,

  have h5 : ∃ y : ℕ, x * y = 1, from sorry,
  have h6 : ∃ y : ℕ, x * y = 1 ∧ y * x = 1, from sorry,
  have h7 : ∃ y : ℕ, (x * y = 1) ∧ (y * x = 1), from sorry,
  have h8 : ∃ y : ℕ, y * x = 1, from sorry,
  show ∃ y : ℕ, x * y = 1, from sorry,
end

--OUTPUT 8
theorem padic_units (p : ℕ) (x : ℕ) : prime p → coprime x p → is_unit (ℤ p) x :=
begin
  assume (hp : prime p) (h1 : coprime x p),
  have h2 : is_unit (ℤ p) x ↔ x ≠ 0 ∧ ∀ n : ℕ, n > 0 → ¬(p^n ∣ x), from sorry,
  have h3 : ¬(is_unit (ℤ p) x), from sorry,
  have h4 : x = 0 ∨ ∃ n : ℕ, n > 0 ∧ (p^n ∣ x), from sorry,
  have h5 : x = 0 ∨ ¬ coprime x p, from sorry,
  have h6 : ¬ coprime x p → x = 0, from sorry,
  have h7 : x = 0, from sorry,
  show is_unit (ℤ p) x, from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/