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

import Flows.Term
import Flows.Subst

open Classical

set_option codegen false

section

variable {χ : Type u} (α : Type u) [Monoid α] [RAction χ α]

def unifiers (a b : χ) := λ (θ : α) => a • θ = b • θ

def generated_by (θ : α) := λ (φ : α) => ∃ ρ, θ * ρ = φ

def is_mgu (a b : χ) (θ : α) := unifiers α a b = generated_by α θ
def strangers (a b : χ) := unifiers α a b = λ _ => False

def mgu_or_strangers (a b : χ) :=
  (∃ θ : α, unifiers α a b = generated_by α θ) ∨ strangers α a b

end

section

variable {χ : Type u} {α : Type u} [Monoid α] [RAction χ α]

theorem unifies_of_mgu {u v : χ} {θ : α} (h : is_mgu α u v θ) : u • θ = v • θ := by
  suffices unifiers _ _ _ _ by assumption
  exact h ▸ Exists.intro 1 (Monoid.mul_one _)

theorem most_general_of_mgu {a b : χ} {θ φ : α}
  (h₁ : is_mgu α a b θ) (h₂ : a • φ = b • φ) : ∃ ρ, θ * ρ = φ := by
  suffices generated_by α θ φ by assumption
  exact h₁ ▸ h₂

theorem mgu_of_unifies_and_most_general {a b : χ} {θ : α}
  (unifies : a • θ = b • θ)
  (most_general : ∀ φ, a • φ = b • φ → ∃ ρ, θ * ρ = φ) : is_mgu α a b θ := by
  funext φ
  apply propext
  apply Iff.intro (most_general _)
  intro ⟨ ρ, hρ ⟩
  rw [← hρ, ← RAction.smul_mul, ← RAction.smul_mul, unifies]

theorem strangers_iff_no_unifier {u v : χ} :
  strangers α u v ↔ ∀ θ : α, u • θ ≠ v • θ := by
  apply Iff.intro
  focus
    intro h θ h'
    suffices p : unifiers α u v θ by
      rw [h] at p; exact False.elim p
    exact h'
  focus
    intro h
    funext θ
    apply propext
    apply Iff.intro (λ h' => h θ h') (λ h => False.elim h)

end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.matrix.nondegenerate
import linear_algebra.matrix.nonsingular_inverse
import linear_algebra.matrix.to_lin
import ring_theory.localization.fraction_ring
import ring_theory.localization.integer

/-!
# Matrices and linear equivalences

This file gives the map `matrix.to_linear_equiv` from matrices with invertible determinant,
to linear equivs.

## Main definitions

 * `matrix.to_linear_equiv`: a matrix with an invertible determinant forms a linear equiv

## Main results

 * `matrix.exists_mul_vec_eq_zero_iff`: `M` maps some `v ≠ 0` to zero iff `det M = 0`

## Tags

matrix, linear_equiv, determinant, inverse

-/

namespace matrix

open linear_map

variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
variables {n : Type*} [fintype n]

section to_linear_equiv'

variables [decidable_eq n]

/-- An invertible matrix yields a linear equivalence from the free module to itself.

See `matrix.to_linear_equiv` for the same map on arbitrary modules.
-/
def to_linear_equiv' (P : matrix n n R) (h : invertible P) : (n → R) ≃ₗ[R] (n → R) :=
{ inv_fun   := (⅟P).to_lin',
  left_inv  := λ v,
    show ((⅟P).to_lin'.comp P.to_lin') v = v,
    by rw [← matrix.to_lin'_mul, P.inv_of_mul_self, matrix.to_lin'_one, linear_map.id_apply],
  right_inv := λ v,
    show (P.to_lin'.comp (⅟P).to_lin') v = v,
    by rw [← matrix.to_lin'_mul, P.mul_inv_of_self, matrix.to_lin'_one, linear_map.id_apply],
  ..P.to_lin' }

@[simp]

@[simp] lemma to_linear_equiv'_symm_apply (P : matrix n n R) (h : invertible P) :
  (↑(P.to_linear_equiv' h).symm : module.End R (n → R)) = P⁻¹.to_lin' :=
show (⅟P).to_lin' = _, from congr_arg _ P.inv_of_eq_nonsing_inv

end to_linear_equiv'

section to_linear_equiv

variables (b : basis n R M)

include b

/-- Given `hA : is_unit A.det` and `b : basis R b`, `A.to_linear_equiv b hA` is
the `linear_equiv` arising from `to_lin b b A`.

See `matrix.to_linear_equiv'` for this result on `n → R`.
-/
@[simps apply]
noncomputable def to_linear_equiv [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  M ≃ₗ[R] M :=
begin
  refine
  { to_fun := to_lin b b A,
    inv_fun := to_lin b b A⁻¹,
    left_inv := λ x, _,
    right_inv := λ x, _,
    .. to_lin b b A };
  rw ← linear_map.comp_apply;
  simp only [← matrix.to_lin_mul b b b,
             matrix.nonsing_inv_mul _ hA, matrix.mul_nonsing_inv _ hA,
             to_lin_one, linear_map.id_apply]
end

lemma ker_to_lin_eq_bot [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  (to_lin b b A).ker = ⊥ :=
ker_eq_bot.mpr (to_linear_equiv b A hA).injective

lemma range_to_lin_eq_top [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  (to_lin b b A).range = ⊤ :=
range_eq_top.mpr (to_linear_equiv b A hA).surjective

end to_linear_equiv

section nondegenerate

open_locale matrix

/-- This holds for all integral domains (see `matrix.exists_mul_vec_eq_zero_iff`),
not just fields, but it's easier to prove it for the field of fractions first. -/
lemma exists_mul_vec_eq_zero_iff_aux {K : Type*} [decidable_eq n] [field K] {M : matrix n n K} :
  (∃ (v ≠ 0), M.mul_vec v = 0) ↔ M.det = 0 :=
begin
  split,
  { rintros ⟨v, hv, mul_eq⟩,
    contrapose! hv,
    exact eq_zero_of_mul_vec_eq_zero hv mul_eq },
  { contrapose!,
    intros h,
    have : function.injective M.to_lin',
    { simpa only [← linear_map.ker_eq_bot, ker_to_lin'_eq_bot_iff, not_imp_not] using h },
    have : M ⬝ linear_map.to_matrix'
      ((linear_equiv.of_injective_endo M.to_lin' this).symm : (n → K) →ₗ[K] (n → K)) = 1,
    { refine matrix.to_lin'.injective (linear_map.ext $ λ v, _),
      rw [matrix.to_lin'_mul, matrix.to_lin'_one, matrix.to_lin'_to_matrix', linear_map.comp_apply],
      exact (linear_equiv.of_injective_endo M.to_lin' this).apply_symm_apply v },
    exact matrix.det_ne_zero_of_right_inverse this }
end

lemma exists_mul_vec_eq_zero_iff' {A : Type*} (K : Type*) [decidable_eq n]
  [comm_ring A] [nontrivial A]
  [field K] [algebra A K] [is_fraction_ring A K]
  {M : matrix n n A} :
  (∃ (v ≠ 0), M.mul_vec v = 0) ↔ M.det = 0 :=
begin
  have : (∃ (v ≠ 0), mul_vec ((algebra_map A K).map_matrix M) v = 0) ↔ _ :=
    exists_mul_vec_eq_zero_iff_aux,
  rw [← ring_hom.map_det, is_fraction_ring.to_map_eq_zero_iff] at this,
  refine iff.trans _ this, split; rintro ⟨v, hv, mul_eq⟩,
  { refine ⟨λ i, algebra_map _ _ (v i), mt (λ h, funext $ λ i, _) hv, _⟩,
    { exact is_fraction_ring.to_map_eq_zero_iff.mp (congr_fun h i) },
    { ext i,
      refine (ring_hom.map_mul_vec _ _ _ i).symm.trans _,
      rw [mul_eq, pi.zero_apply, ring_hom.map_zero, pi.zero_apply] } },
  { letI := classical.dec_eq K,
    obtain ⟨⟨b, hb⟩, ba_eq⟩ := is_localization.exist_integer_multiples_of_finset
      (non_zero_divisors A) (finset.univ.image v),
    choose f hf using ba_eq,
    refine ⟨λ i, f _ (finset.mem_image.mpr ⟨i, finset.mem_univ i, rfl⟩),
            mt (λ h, funext $ λ i, _) hv, _⟩,
    { have := congr_arg (algebra_map A K) (congr_fun h i),
      rw [hf, subtype.coe_mk, pi.zero_apply, ring_hom.map_zero, algebra.smul_def,
          mul_eq_zero, is_fraction_ring.to_map_eq_zero_iff] at this,
      exact this.resolve_left (non_zero_divisors.ne_zero hb), },
    { ext i,
      refine is_fraction_ring.injective A K _,
      calc algebra_map A K (M.mul_vec (λ (i : n), f (v i) _) i)
          = ((algebra_map A K).map_matrix M).mul_vec
              (algebra_map _ K b • v) i : _
      ... = 0 : _
      ... = algebra_map A K 0 : (ring_hom.map_zero _).symm,
      { simp_rw [ring_hom.map_mul_vec, mul_vec, dot_product, function.comp_app, hf,
          subtype.coe_mk, ring_hom.map_matrix_apply, pi.smul_apply, smul_eq_mul,
          algebra.smul_def] },
      { rw [mul_vec_smul, mul_eq, pi.smul_apply, pi.zero_apply, smul_zero] } } },
end

lemma exists_mul_vec_eq_zero_iff {A : Type*} [decidable_eq n] [comm_ring A] [is_domain A]
  {M : matrix n n A} :
  (∃ (v ≠ 0), M.mul_vec v = 0) ↔ M.det = 0 :=
exists_mul_vec_eq_zero_iff' (fraction_ring A)

lemma exists_vec_mul_eq_zero_iff {A : Type*} [decidable_eq n] [comm_ring A] [is_domain A]
  {M : matrix n n A} :
  (∃ (v ≠ 0), M.vec_mul v = 0) ↔ M.det = 0 :=
by simpa only [← M.det_transpose, ← mul_vec_transpose] using exists_mul_vec_eq_zero_iff

theorem nondegenerate_iff_det_ne_zero {A : Type*} [decidable_eq n] [comm_ring A] [is_domain A]
  {M : matrix n n A} :
  nondegenerate M ↔ M.det ≠ 0 :=
begin
  refine iff.trans _ (not_iff_not.mpr exists_vec_mul_eq_zero_iff),
  simp only [not_exists],
  split,
  { intros hM v hv hMv,
    obtain ⟨w, hwMv⟩ := hM.exists_not_ortho_of_ne_zero hv,
    simpa only [dot_product_mul_vec, hMv, zero_dot_product] using hwMv },
  { intros h v hv,
    refine not_imp_not.mp (h v) (funext $ λ i, _),
    simpa only [dot_product_mul_vec, dot_product_single, mul_one] using hv (pi.single i 1) }
end

alias nondegenerate_iff_det_ne_zero ↔ nondegenerate.det_ne_zero nondegenerate.of_det_ne_zero

end nondegenerate

end matrix


import natural.definition natural.addition natural.equality

def z_rel (a b : N × N) := a.1 + b.2 = a.2 + b.1
def Z' : Type := quot z_rel

namespace Z'

def reflex : reflexive z_rel := begin
  intro h,
  rw z_rel,
  rw N.add_comm,
end
def symmet : symmetric z_rel := begin
  intro x,
  intro y,
  intro h,
  rw z_rel,
  rw z_rel at h,
  rw N.add_comm at h,
  rw h,
  rw N.add_comm,
end
def trans : transitive z_rel := begin
  intros x y z,
  repeat {rw z_rel},
  intro p,
  intro q,
  rw ← N.eq_add _ _ z.fst at p,
  rw N.add_assoc at p,
  rw ← q at p,
  rw N.add_assoc x.snd _ _ at p,
  repeat {rw N.add_comm y.fst _ at p},
  repeat {rw ← N.add_assoc at p},
  rw N.eq_add _ _ y.fst at p,
  exact p,
end

instance : setoid (N × N) := ⟨ z_rel, ⟨ reflex, symmet, trans ⟩ ⟩

def one : Z' := ⟦(1, 0)⟧
instance : has_one Z' := ⟨ one ⟩

lemma one_eq_one : 1 = one := rfl

def zero : Z' := ⟦(0, 0)⟧
instance : has_zero Z' := ⟨ zero ⟩

lemma zero_eq_zero : 0 = zero := rfl

def fromN (a : N) : Z' := ⟦(a, 0)⟧

private lemma double_succ_gt (a b : N) : N.to_N (a + b) < N.to_N(N.succ a + N.succ b) := begin
  rw N.add_succ,
  rw N.succ_add,
  repeat {rw N.to_N},
  cases N.to_N (a + b),
  repeat {rw nat.add_one},
  simp,
  have q := nat.lt.base 0,
  have t := nat.lt.step q,
  exact t,
  have q := nat.lt.base n.succ,
  have t := nat.lt.step q,
  exact t,
end

def eqq : (N × N) -> (N × N)
| (0, 0) := (0, 0)
| (0, N.succ a) := (0, N.succ a)
| (N.succ a, 0) := (N.succ a, 0)
| (N.succ a, N.succ b) := begin
  exact have N.to_N (a + b) < N.to_N (a.succ + b.succ) := double_succ_gt a b,
    eqq (a, b)
end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ a, begin
  cases a with x y,
  exact N.to_N (x + y),
end)⟩] }

lemma eqq_0_0 : eqq (0, 0) = (0, 0) := by { rw eqq }
lemma eqq_0_succ_a (a : N) : eqq (0, N.succ a) = (0, N.succ a) := by { rw eqq }
lemma eqq_succ_a_0 (a : N) : eqq (N.succ a, 0) = (N.succ a, 0) := by { rw eqq }
lemma eqq_succ_succ (a b : N) : eqq (N.succ a, N.succ b) = eqq (a, b) := by { rw eqq }

lemma eqq_0_a (a : N) : eqq (0, a) = (0, a) := begin
  cases a,
  exact eqq_0_0,
  exact eqq_0_succ_a a,
end
lemma eqq_a_0 (a : N) : eqq (a, 0) = (a, 0) := begin
  cases a,
  rw N.zero_eq_zero,
  exact eqq_0_0,
  exact eqq_succ_a_0 _,
end
lemma eqq_a_a (a : N) : eqq (a, a) = (0, 0) := begin
  induction a with a ah,
  rw N.zero_eq_zero,
  rw eqq_0_0,
  rw eqq_succ_succ,
  exact ah,
end

lemma eqq_plus_a_fir (a b : N) : eqq (a + b, a) = (b, 0) :=
begin
  induction a with a ah,
  rw N.zero_eq_zero,
  rw N.zero_add,
  exact eqq_a_0 _,
  rw N.succ_add,
  rw eqq_succ_succ,
  exact ah,
end
lemma eqq_a_plus_fir (a b : N) : eqq (b + a, a) = (b, 0) :=
begin
  rw N.add_comm,
  exact eqq_plus_a_fir _ _,
end

lemma eqq_plus_a_sec (a b : N) : eqq (a, a + b) = (0, b) :=
begin
  induction a with a ah,
  rw N.zero_eq_zero,
  rw N.zero_add,
  exact eqq_0_a _,
  rw N.succ_add,
  rw eqq_succ_succ,
  exact ah,
end
lemma eqq_a_plus_sec (a b : N) : eqq (a, b + a) = (0, b) :=
begin
  rw N.add_comm,
  exact eqq_plus_a_sec _ _,
end

lemma eqq_plus_right (a b c : N) : eqq (a + c, b + c) = eqq (a, b) :=
begin
  induction c with c ch,
  rw N.zero_eq_zero,
  repeat {rw N.add_zero},
  repeat {rw N.add_succ},
  rw eqq_succ_succ,
  exact ch,
end
lemma eqq_plus_left (a b c : N) : eqq (c + a, c + b) = eqq (a, b) :=
begin
  repeat {rw N.add_comm c},
  exact eqq_plus_right _ _ _,
end

lemma fst_eq (a b : N) : (a, b).fst = a := rfl
lemma snd_eq (a b : N) : (a, b).snd = b := rfl
lemma pair_deconstruct (a : N × N) : a = (a.fst, a.snd) := begin
  cases a,
  rw fst_eq,
end

lemma eqq_symm: ∀ (a b : N), eqq (a, b) = ((eqq (b, a)).snd, (eqq (b, a)).fst)
| 0 b := begin
  rw eqq_0_a,
  rw eqq_a_0,
end
| a 0 := begin
  rw eqq_0_a,
  rw eqq_a_0,
end
| (N.succ a) (N.succ b) := begin
  repeat {rw eqq_succ_succ},
  exact eqq_symm a b,
end

private def eqq_eq_helper: ∀ (a b c d : N), z_rel (a, b) (c, d) -> eqq (a, b) = eqq (c, d)
| 0 b c d := begin
  intro h,
    rw z_rel at h,
    repeat {rw fst_eq at h, rw snd_eq at h},
    rw N.zero_add at h,
    rw h,
    rw eqq_0_a,
    rw eqq_a_plus_sec _ _,
end
| a 0 c d := begin
  intro h,
  rw z_rel at h,
  repeat {rw fst_eq at h, rw snd_eq at h},
  rw N.zero_add at h,
  rw ← h,
  rw eqq_a_0,
  rw eqq_a_plus_fir,
end
| (N.succ a) (N.succ b) c d := begin
  intro h,
  rw z_rel at h,
  repeat {rw fst_eq at h, rw snd_eq at h},
  repeat {rw N.succ_add at h},
  have q := N.succ_eq _ _ h,
  rw eqq_succ_succ,
  exact eqq_eq_helper a b c d q,
end

lemma eqq_cont_zero : ∀ (a b : N), (eqq (a, b)).fst = 0 ∨ (eqq (a, b)).snd = 0
| 0 b := begin
  rw eqq_0_a,
  rw fst_eq,
  left,
  refl,
end
| a 0 := begin
  rw eqq_a_0,
  rw snd_eq,
  right,
  refl,
end
| (N.succ a) (N.succ b) := begin
  rw eqq_succ_succ,
  exact eqq_cont_zero a b,
end

def eqq_eq (a b : N × N) : z_rel a b -> eqq a = eqq b :=
begin
  cases a,
  cases b,
  exact eqq_eq_helper a_fst a_snd b_fst b_snd,
end

lemma paren_eq_mk (a : N × N): ⟦a⟧ = quot.mk z_rel a := rfl

lemma a_norm_eq_a_helper: ∀ (a b : N), (eqq (a, b)).fst + b = (eqq (a, b)).snd + a
| 0 b := begin
  rw eqq_0_a,
  rw fst_eq,
  rw snd_eq,
  rw N.add_comm,
end
| a 0 := begin
  rw eqq_a_0,
  rw fst_eq,
  rw snd_eq,
  rw N.add_comm,
end
| (N.succ a) (N.succ b) := begin
  rw eqq_succ_succ,
  repeat {rw N.add_succ},
  rw a_norm_eq_a_helper a b,
end

def norm (a : Z') : N × N := quot.lift eqq eqq_eq a
lemma norm_deconstruction (a b : N) : norm ⟦(a, b)⟧ = eqq (a, b) := rfl
lemma a_norm_eq_a (a : Z') : ⟦((norm a).fst, (norm a).snd)⟧ = a := begin
  rw paren_eq_mk,
  induction a,
  apply quot.sound,
  rw z_rel,
  rw fst_eq,
  rw snd_eq (norm (quot.mk z_rel a)).fst (norm (quot.mk z_rel a)).snd,
  rw ← paren_eq_mk,
  cases a,
  rw norm_deconstruction,
  exact a_norm_eq_a_helper a_fst a_snd,
  refl,
end
lemma norm_eq_a (a: Z') : ⟦norm a⟧ = a := begin
  rw pair_deconstruct (a.norm),
  exact a_norm_eq_a a,
end
lemma zero_norm : norm 0 = (0, 0) := begin
  rw zero_eq_zero, rw zero,
  rw norm_deconstruction,
  rw eqq_0_0,
end
lemma one_norm : norm 1 = (1, 0) := begin
  rw one_eq_one,
  rw one,
  rw norm_deconstruction,
  rw eqq_a_0,
end

lemma norm_cont_zero (a : Z') : ((norm a).fst = 0) ∨ ((norm a).snd = 0) := begin
  induction a,
  cases a,
  rw ← paren_eq_mk,
  rw norm_deconstruction,
  exact eqq_cont_zero a_fst a_snd,
  refl,
end

lemma norm_symm (a b : N) : norm ⟦(b, a)⟧ = ((norm ⟦(a, b)⟧).snd, (norm ⟦(a, b)⟧).fst) := begin
  rw norm_deconstruction,
  rw norm_deconstruction,
  rw eqq_symm,
end

end Z'


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

! This file was ported from Lean 3 source module algebra.big_operators.intervals
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.Module.Basic
import Mathlib.Data.Nat.Interval
import Mathlib.Tactic.Linarith

/-!
# Results about big operators over intervals

We prove results about big operators over intervals (mostly the `ℕ`-valued `Ico m n`).
-/

universe u v w

open BigOperators
open Nat

namespace Finset

section Generic

variable {α : Type u} {β : Type v} {γ : Type w} {s₂ s₁ s : Finset α} {a : α} {g f : α → β}

variable [CommMonoid β]

@[to_additive]
theorem prod_Ico_add' [OrderedCancelAddCommMonoid α] [ExistsAddOfLE α] [LocallyFiniteOrder α]
    (f : α → β) (a b c : α) : (∏ x in Ico a b, f (x + c)) = ∏ x in Ico (a + c) (b + c), f x := by
  rw [← map_add_right_Ico, prod_map]
  rfl
#align finset.prod_Ico_add' Finset.prod_Ico_add'
#align finset.sum_Ico_add' Finset.sum_Ico_add'

@[to_additive]
theorem prod_Ico_add [OrderedCancelAddCommMonoid α] [ExistsAddOfLE α] [LocallyFiniteOrder α]
    (f : α → β) (a b c : α) : (∏ x in Ico a b, f (c + x)) = ∏ x in Ico (a + c) (b + c), f x := by
  convert prod_Ico_add' f a b c using 2
  rw [add_comm]
#align finset.prod_Ico_add Finset.prod_Ico_add
#align finset.sum_Ico_add Finset.sum_Ico_add

@[to_additive]
theorem prod_Ico_succ_top {a b : ℕ} (hab : a ≤ b) (f : ℕ → β) :
    (∏ k in Ico a (b + 1), f k) = (∏ k in Ico a b, f k) * f b := by
  rw [Nat.Ico_succ_right_eq_insert_Ico hab, prod_insert right_not_mem_Ico, mul_comm]
#align finset.prod_Ico_succ_top Finset.prod_Ico_succ_top
#align finset.sum_Ico_succ_top Finset.sum_Ico_succ_top

@[to_additive]
theorem prod_eq_prod_Ico_succ_bot {a b : ℕ} (hab : a < b) (f : ℕ → β) :
    (∏ k in Ico a b, f k) = f a * ∏ k in Ico (a + 1) b, f k := by
  have ha : a ∉ Ico (a + 1) b := by simp
  rw [← prod_insert ha, Nat.Ico_insert_succ_left hab]
#align finset.prod_eq_prod_Ico_succ_bot Finset.prod_eq_prod_Ico_succ_bot
#align finset.sum_eq_sum_Ico_succ_bot Finset.sum_eq_sum_Ico_succ_bot

@[to_additive]
theorem prod_Ico_consecutive (f : ℕ → β) {m n k : ℕ} (hmn : m ≤ n) (hnk : n ≤ k) :
    ((∏ i in Ico m n, f i) * ∏ i in Ico n k, f i) = ∏ i in Ico m k, f i :=
  Ico_union_Ico_eq_Ico hmn hnk ▸ Eq.symm (prod_union (Ico_disjoint_Ico_consecutive m n k))
#align finset.prod_Ico_consecutive Finset.prod_Ico_consecutive
#align finset.sum_Ico_consecutive Finset.sum_Ico_consecutive

@[to_additive]
theorem prod_Ioc_consecutive (f : ℕ → β) {m n k : ℕ} (hmn : m ≤ n) (hnk : n ≤ k) :
    ((∏ i in Ioc m n, f i) * ∏ i in Ioc n k, f i) = ∏ i in Ioc m k, f i := by
  rw [← Ioc_union_Ioc_eq_Ioc hmn hnk, prod_union]
  apply disjoint_left.2 fun x hx h'x => _
  intros x hx h'x
  exact lt_irrefl _ ((mem_Ioc.1 h'x).1.trans_le (mem_Ioc.1 hx).2)
#align finset.prod_Ioc_consecutive Finset.prod_Ioc_consecutive
#align finset.sum_Ioc_consecutive Finset.sum_Ioc_consecutive

@[to_additive]
theorem prod_Ioc_succ_top {a b : ℕ} (hab : a ≤ b) (f : ℕ → β) :
    (∏ k in Ioc a (b + 1), f k) = (∏ k in Ioc a b, f k) * f (b + 1) := by
  rw [← prod_Ioc_consecutive _ hab (Nat.le_succ b), Nat.Ioc_succ_singleton, prod_singleton]
#align finset.prod_Ioc_succ_top Finset.prod_Ioc_succ_top
#align finset.sum_Ioc_succ_top Finset.sum_Ioc_succ_top

@[to_additive]
theorem prod_range_mul_prod_Ico (f : ℕ → β) {m n : ℕ} (h : m ≤ n) :
    ((∏ k in range m, f k) * ∏ k in Ico m n, f k) = ∏ k in range n, f k :=
  Nat.Ico_zero_eq_range ▸ Nat.Ico_zero_eq_range ▸ prod_Ico_consecutive f m.zero_le h
#align finset.prod_range_mul_prod_Ico Finset.prod_range_mul_prod_Ico
#align finset.sum_range_add_sum_Ico Finset.sum_range_add_sum_Ico

@[to_additive]
theorem prod_Ico_eq_mul_inv {δ : Type _} [CommGroup δ] (f : ℕ → δ) {m n : ℕ} (h : m ≤ n) :
    (∏ k in Ico m n, f k) = (∏ k in range n, f k) * (∏ k in range m, f k)⁻¹ :=
  eq_mul_inv_iff_mul_eq.2 <| by (rw [mul_comm]; exact prod_range_mul_prod_Ico f h)
#align finset.prod_Ico_eq_mul_inv Finset.prod_Ico_eq_mul_inv
#align finset.sum_Ico_eq_add_neg Finset.sum_Ico_eq_add_neg

@[to_additive]
theorem prod_Ico_eq_div {δ : Type _} [CommGroup δ] (f : ℕ → δ) {m n : ℕ} (h : m ≤ n) :
    (∏ k in Ico m n, f k) = (∏ k in range n, f k) / ∏ k in range m, f k := by
  simpa only [div_eq_mul_inv] using prod_Ico_eq_mul_inv f h
#align finset.prod_Ico_eq_div Finset.prod_Ico_eq_div
#align finset.sum_Ico_eq_sub Finset.sum_Ico_eq_sub

@[to_additive]
theorem prod_range_sub_prod_range {α : Type _} [CommGroup α] {f : ℕ → α} {n m : ℕ} (hnm : n ≤ m) :
    ((∏ k in range m, f k) / ∏ k in range n, f k) = ∏ k in (range m).filter fun k => n ≤ k, f k :=
  by
  rw [← prod_Ico_eq_div f hnm]
  congr
  apply Finset.ext
  simp only [mem_Ico, mem_filter, mem_range, *]
  tauto
#align finset.prod_range_sub_prod_range Finset.prod_range_sub_prod_range
#align finset.sum_range_sub_sum_range Finset.sum_range_sub_sum_range

/-- The two ways of summing over `(i,j)` in the range `a<=i<=j<b` are equal. -/
theorem sum_Ico_Ico_comm {M : Type _} [AddCommMonoid M] (a b : ℕ) (f : ℕ → ℕ → M) :
    (∑ i in Finset.Ico a b, ∑ j in Finset.Ico i b, f i j) =
      ∑ j in Finset.Ico a b, ∑ i in Finset.Ico a (j + 1), f i j := by
  rw [Finset.sum_sigma', Finset.sum_sigma']
  refine'
    Finset.sum_bij' (fun (x : Σ _ : ℕ, ℕ) _ => (⟨x.2, x.1⟩ : Σ _ : ℕ, ℕ)) _ (fun _ _ => rfl)
      (fun (x : Σ _ : ℕ, ℕ) _ => (⟨x.2, x.1⟩ : Σ _ : ℕ, ℕ)) _ (by (rintro ⟨⟩ _; rfl))
      (by (rintro ⟨⟩ _; rfl)) <;>
  simp only [Finset.mem_Ico, Sigma.forall, Finset.mem_sigma] <;>
  rintro a b ⟨⟨h₁, h₂⟩, ⟨h₃, h₄⟩⟩ <;>
  refine' ⟨⟨_, _⟩, ⟨_, _⟩⟩ <;>
  linarith
#align finset.sum_Ico_Ico_comm Finset.sum_Ico_Ico_comm

@[to_additive]

theorem prod_Ico_reflect (f : ℕ → β) (k : ℕ) {m n : ℕ} (h : m ≤ n + 1) :
    (∏ j in Ico k m, f (n - j)) = ∏ j in Ico (n + 1 - m) (n + 1 - k), f j := by
  have : ∀ i < m, i ≤ n := by
    intro i hi
    exact (add_le_add_iff_right 1).1 (le_trans (Nat.lt_iff_add_one_le.1 hi) h)
  cases' lt_or_le k m with hkm hkm
  · rw [← Nat.Ico_image_const_sub_eq_Ico (this _ hkm)]
    refine' (prod_image _).symm
    simp only [mem_Ico]
    rintro i ⟨_, im⟩ j ⟨_, jm⟩ Hij
    rw [← tsub_tsub_cancel_of_le (this _ im), Hij, tsub_tsub_cancel_of_le (this _ jm)]
  · have : n + 1 - k ≤ n + 1 - m := by
      rw [tsub_le_tsub_iff_left h]
      exact hkm
    simp only [ge_iff_le, hkm, Ico_eq_empty_of_le, prod_empty, tsub_le_iff_right, Ico_eq_empty_of_le
      this]
#align finset.prod_Ico_reflect Finset.prod_Ico_reflect

theorem sum_Ico_reflect {δ : Type _} [AddCommMonoid δ] (f : ℕ → δ) (k : ℕ) {m n : ℕ}
    (h : m ≤ n + 1) : (∑ j in Ico k m, f (n - j)) = ∑ j in Ico (n + 1 - m) (n + 1 - k), f j :=
  @prod_Ico_reflect (Multiplicative δ) _ f k m n h
#align finset.sum_Ico_reflect Finset.sum_Ico_reflect

theorem prod_range_reflect (f : ℕ → β) (n : ℕ) :
    (∏ j in range n, f (n - 1 - j)) = ∏ j in range n, f j := by
  cases n
  · simp
  · simp only [← Nat.Ico_zero_eq_range, Nat.succ_sub_succ_eq_sub, tsub_zero]
    rw [prod_Ico_reflect _ _ le_rfl]
    simp
#align finset.prod_range_reflect Finset.prod_range_reflect

theorem sum_range_reflect {δ : Type _} [AddCommMonoid δ] (f : ℕ → δ) (n : ℕ) :
    (∑ j in range n, f (n - 1 - j)) = ∑ j in range n, f j :=
  @prod_range_reflect (Multiplicative δ) _ f n
#align finset.sum_range_reflect Finset.sum_range_reflect

@[simp]
theorem prod_Ico_id_eq_factorial : ∀ n : ℕ, (∏ x in Ico 1 (n + 1), x) = n !
  | 0 => rfl
  | n + 1 => by
    rw [prod_Ico_succ_top <| Nat.succ_le_succ <| Nat.zero_le n, Nat.factorial_succ,
      prod_Ico_id_eq_factorial n, Nat.succ_eq_add_one, mul_comm]
#align finset.prod_Ico_id_eq_factorial Finset.prod_Ico_id_eq_factorial

@[simp]
theorem prod_range_add_one_eq_factorial : ∀ n : ℕ, (∏ x in range n, (x + 1)) = n !
  | 0 => rfl
  | n + 1 => by simp [Finset.range_succ, prod_range_add_one_eq_factorial n]
#align finset.prod_range_add_one_eq_factorial Finset.prod_range_add_one_eq_factorial

section GaussSum

/-- Gauss' summation formula -/
theorem sum_range_id_mul_two (n : ℕ) : (∑ i in range n, i) * 2 = n * (n - 1) :=
  calc
    (∑ i in range n, i) * 2 = (∑ i in range n, i) + ∑ i in range n, (n - 1 - i) :=
    by rw [sum_range_reflect (fun i => i) n, mul_two]
    _ = ∑ i in range n, (i + (n - 1 - i)) := sum_add_distrib.symm
    _ = ∑ i in range n, (n - 1) :=
      sum_congr rfl fun i hi => add_tsub_cancel_of_le <| Nat.le_pred_of_lt <| mem_range.1 hi
    _ = n * (n - 1) := by rw [sum_const, card_range, Nat.nsmul_eq_mul]
#align finset.sum_range_id_mul_two Finset.sum_range_id_mul_two

/-- Gauss' summation formula -/
theorem sum_range_id (n : ℕ) : (∑ i in range n, i) = n * (n - 1) / 2 := by
  rw [← sum_range_id_mul_two n, Nat.mul_div_cancel _ zero_lt_two]
#align finset.sum_range_id Finset.sum_range_id

end GaussSum

end Generic

section Nat

variable {β : Type _}

variable (f g : ℕ → β) {m n : ℕ}

section Group

variable [CommGroup β]

@[to_additive]
theorem prod_range_succ_div_prod : ((∏ i in range (n + 1), f i) / ∏ i in range n, f i) = f n :=
  div_eq_iff_eq_mul'.mpr <| prod_range_succ f n
#align finset.prod_range_succ_div_prod Finset.prod_range_succ_div_prod
#align finset.sum_range_succ_sub_sum Finset.sum_range_succ_sub_sum

@[to_additive]
theorem prod_range_succ_div_top : (∏ i in range (n + 1), f i) / f n = ∏ i in range n, f i :=
  div_eq_iff_eq_mul.mpr <| prod_range_succ f n
#align finset.prod_range_succ_div_top Finset.prod_range_succ_div_top
#align finset.sum_range_succ_sub_top Finset.sum_range_succ_sub_top

@[to_additive]
theorem prod_Ico_div_bot (hmn : m < n) : (∏ i in Ico m n, f i) / f m = ∏ i in Ico (m + 1) n, f i :=
  div_eq_iff_eq_mul'.mpr <| prod_eq_prod_Ico_succ_bot hmn _
#align finset.prod_Ico_div_bot Finset.prod_Ico_div_bot
#align finset.sum_Ico_sub_bot Finset.sum_Ico_sub_bot

@[to_additive]
theorem prod_Ico_succ_div_top (hmn : m ≤ n) :
    (∏ i in Ico m (n + 1), f i) / f n = ∏ i in Ico m n, f i :=
  div_eq_iff_eq_mul.mpr <| prod_Ico_succ_top hmn _
#align finset.prod_Ico_succ_div_top Finset.prod_Ico_succ_div_top
#align finset.sum_Ico_succ_sub_top Finset.sum_Ico_succ_sub_top

end Group

end Nat

section Module

variable {R M : Type _} [Ring R] [AddCommGroup M] [Module R M] (f : ℕ → R) (g : ℕ → M) {m n : ℕ}

open Finset

-- The partial sum of `g`, starting from zero
local notation "G " n:80 => ∑ i in range n, g i

/-- **Summation by parts**, also known as **Abel's lemma** or an **Abel transformation** -/
theorem sum_Ico_by_parts (hmn : m < n) :
    (∑ i in Ico m n, f i • g i) =
      f (n - 1) • G n - f m • G m - ∑ i in Ico m (n - 1), (f (i + 1) - f i) • G (i + 1) := by
  have h₁ : (∑ i in Ico (m + 1) n, f i • G i) = ∑ i in Ico m (n - 1), f (i + 1) • G (i + 1) := by
    rw [← Nat.sub_add_cancel (Nat.one_le_of_lt hmn), ← sum_Ico_add']
    simp only [ge_iff_le, tsub_le_iff_right, add_le_iff_nonpos_left, nonpos_iff_eq_zero,
      tsub_eq_zero_iff_le, add_tsub_cancel_right]
  have h₂ :
    (∑ i in Ico (m + 1) n, f i • G (i + 1)) =
      (∑ i in Ico m (n - 1), f i • G (i + 1)) + f (n - 1) • G n - f m • G (m + 1) := by
    rw [← sum_Ico_sub_bot _ hmn, ← sum_Ico_succ_sub_top _ (Nat.le_pred_of_lt hmn),
      Nat.sub_add_cancel (pos_of_gt hmn), sub_add_cancel]
  rw [sum_eq_sum_Ico_succ_bot hmn]
  -- porting note: the following used to be done with `conv`
  have h₃: (Finset.sum (Ico (m + 1) n) fun i => f i • g i) =
             (Finset.sum (Ico (m + 1) n) fun i =>
                f i • ((Finset.sum (Finset.range (i + 1)) g) -
                        (Finset.sum (Finset.range i) g))) := by
    congr; funext; rw [← sum_range_succ_sub_sum g]
  rw [h₃]
  simp_rw [smul_sub, sum_sub_distrib, h₂, h₁]
  -- porting note: the following used to be done with `conv`
  have h₄ : ((((Finset.sum (Ico m (n - 1)) fun i => f i • Finset.sum (range (i + 1)) fun i => g i) +
      f (n - 1) • Finset.sum (range n) fun i => g i) -
      f m • Finset.sum (range (m + 1)) fun i => g i) -
      Finset.sum (Ico m (n - 1)) fun i => f (i + 1) • Finset.sum (range (i + 1)) fun i => g i) =
      f (n - 1) • (range n).sum g - f m • (range (m + 1)).sum g +
      Finset.sum (Ico m (n - 1)) (fun i => f i • (range (i + 1)).sum g -
      f (i + 1) • (range (i + 1)).sum g) := by
    rw [← add_sub, add_comm, ←add_sub, ← sum_sub_distrib]
  rw [h₄]
  have : ∀ i, f i • G (i + 1) - f (i + 1) • G (i + 1) = -((f (i + 1) - f i) • G (i + 1)) := by
    intro i
    rw [sub_smul]
    abel
  simp_rw [this, sum_neg_distrib, sum_range_succ, smul_add]
  abel
#align finset.sum_Ico_by_parts Finset.sum_Ico_by_parts

variable (n)

/-- **Summation by parts** for ranges -/
theorem sum_range_by_parts :
    (∑ i in range n, f i • g i) =
      f (n - 1) • G n - ∑ i in range (n - 1), (f (i + 1) - f i) • G (i + 1) := by
  by_cases hn : n = 0
  · simp [hn]
  · rw [range_eq_Ico, sum_Ico_by_parts f g (Nat.pos_of_ne_zero hn), sum_range_zero, smul_zero,
      sub_zero, range_eq_Ico]
#align finset.sum_range_by_parts Finset.sum_range_by_parts

end Module

end Finset


import prelim.collections prelim.embed prelim.size prelim.induction prelim.minmax finsum.fin_api
import matroid.pointcount matroid.simple
import matroid.submatroid.projection matroid.submatroid.minor_iso
import matroid.constructions.uniform

noncomputable theory
open_locale classical big_operators

open set matroid

universes u v w

section uniform

variables {α : Type*} [fintype α] {M N : matroid α} {a b : ℤ}

/-- the property of having a `U_{a,b}` -minor -/
def matroid.has_unif_minor (M : matroid α) (a b : ℤ) :=
  M.has_iminor (canonical_unif a b)

lemma has_unif_minor_def :
  M.has_unif_minor a b ↔ (canonical_unif a b).is_iminor_of M :=
iff.rfl

lemma has_unif_minor_def' :
  M.has_unif_minor a b ↔ M.has_iminor (canonical_unif a b) :=
iff.rfl

lemma has_unif_minor_iff (ha : 0 ≤ a) (hb : 0 ≤ b) :
  M.has_unif_minor a b ↔
    ∃ S C : set α,  disjoint S C
                  ∧ size S = b
                  ∧ ∀ X ⊆ S, min a (size X) = M.r (X ∪ C) - M.r C :=
begin
  rw [has_unif_minor_def, iminor_of_iff_exists_embedding],
  split,
  { rintros ⟨ φ, C, hdisj, hr⟩,
    refine ⟨range φ, C, hdisj, _, λ X hX, _⟩,
    { rwa [← image_univ, size_image_emb, size_fin'_univ],  },
    convert hr (φ ⁻¹' X),
    rw [canonical_unif_r ha, size_preimage_embed_subset_range _ _ hX],
    rw image_preimage_eq_of_subset hX, },
  rintros ⟨S, C, hdisj, hsize, hr⟩,
  rw [eq_comm, ← size_fin' _ hb] at hsize,
  obtain ⟨φ, rfl⟩ := exists_emb_of_type_size_eq_size_set hsize,
  refine ⟨φ, C, hdisj, λ F, _⟩,
  convert hr (φ '' F) (λ x, by tidy),
  rw [size_image_emb, canonical_unif_r ha],
end

lemma has_good_C_of_has_unif_minor (ha : 0 ≤ a) (hab : a ≤ b) :
  M.has_unif_minor a b →
    ∃ S C : set α,  disjoint S C
                  ∧ size S = b
                  ∧ (∀ X ⊆ S, min a (size X) = M.r (X ∪ C) - M.r C)
                  ∧ M.is_indep C
                  ∧ M.r C = M.r univ - a :=
begin
  rw [has_unif_minor_def, iminor_of_iff_exists_good_C],
  rintros ⟨ φ, C, hdisj, hr, hind, hrank⟩,
  refine ⟨range φ, C, (disjoint_iff_inter_eq_empty.mpr hdisj), _, λ X hX, _, hind, _⟩,
  { rw [← image_univ, size_image_emb, size_fin'_univ], exact le_trans ha hab,  },
  { convert hr (φ ⁻¹' X),
    rw [canonical_unif_r ha, size_preimage_embed_subset_range _ _ hX],
    rw image_preimage_eq_of_subset hX},
  rw [canonical_unif_r ha, ← type_size_eq, size_fin' _ (le_trans ha hab), min_eq_left hab] at hrank,
  linarith,
end

def matroid.has_unif_restr (M : matroid α) (a b : ℤ) :=
  M.has_irestr (canonical_unif a b)

lemma has_unif_restr_def :
  M.has_unif_restr a b ↔ (canonical_unif a b).is_irestr_of M :=
iff.rfl

lemma has_unif_restr_iff (ha : 0 ≤ a) (hb : 0 ≤ b) :
  M.has_unif_restr a b ↔ ∃ S : set α, (size S = b) ∧ (∀ X ⊆ S, M.r X = min a (size X)) :=
begin
  rw [has_unif_restr_def, irestr_of_iff_exists_map],
  split,
  { rintros ⟨φ, hr⟩,
    refine ⟨range φ, _, λ X hX, _⟩,
    { rw [← image_univ, size_image_emb], convert size_fin' _ hb},
    convert (hr (φ ⁻¹' X)).symm using 1,
    rw image_preimage_eq_of_subset hX,
    rw [canonical_unif_r ha, size_preimage_embed_subset_range _ _ hX],  },
  rintros ⟨S, hsize, hr⟩,
  rw [eq_comm, ← size_fin' _ hb] at hsize,
  obtain ⟨φ, rfl⟩ := exists_emb_of_type_size_eq_size_set hsize,
  refine ⟨φ, λ F, _⟩,
  convert (hr (φ '' F) (λ x, by tidy)).symm using 1,
  rw [size_image_emb, canonical_unif_r ha],
end

lemma matroid.has_unif_minor_iff_si_has_unif_minor (ha : 2 ≤ a) :
  M.has_unif_minor a b ↔ (si M).has_unif_minor a b :=
(iminor_iff_iminor_si (canonical_unif_simple_of_two_le_r ha)).symm

lemma has_uniform_minor_of_has_unif_restriction (h : M.has_unif_restr a b):
  M.has_unif_minor a b :=
iminor_of_irestr h

def matroid.has_no_uniform_minor (M : matroid α)(a b : ℤ) :=
  ¬ M.has_unif_minor a b

def pminor_has_no_uniform_minor (ha : 1 ≤ a) (hb : 2 ≤ b) (hNM : N.is_pminor_of M):
  (M.has_no_uniform_minor a b) → (N.has_no_uniform_minor a b) :=
begin
  simp_rw [matroid.has_no_uniform_minor, matroid.has_unif_minor], contrapose!, intro hN,
  apply iminor_of_iminor_of_pminor _ hN hNM,
  rwa canonical_unif_loopless_iff (by linarith : 0 ≤ a) (by linarith : 1 ≤ b),
end

end uniform

section line

variables {α : Type*} [fintype α] {M : matroid α} {l a b: ℤ} {X Y L : set α}

/-- the property of not having a rank-2 uniform matroid on n elements as a minor -/
def matroid.has_no_line_minor (M : matroid α) (n : ℤ) :=
  ¬ M.has_unif_minor 2 n

lemma line_restr_of_simple_set (hl : 0 ≤ l)(hr : M.r L ≤ 2) (hL : M.is_simple_set L)
(hsize : l ≤ size L):
  M.has_unif_restr 2 l :=
begin
  rw has_unif_restr_iff (by norm_num : (0 : ℤ) ≤ 2) hl,
  obtain ⟨L', hL', hsizeL'⟩ := has_subset_of_size (by linarith : 0 ≤ l) hsize,
  refine ⟨L', hsizeL', λ X hXL', _⟩,
  rcases le_or_lt (size X) 2 with (hX | hX),
  { rw [rank_subset_simple_set hL (subset.trans hXL' hL') hX, min_eq_right hX]},
  rw min_eq_left (le_of_lt hX),
  refine le_antisymm (le_trans (M.rank_mono (subset.trans hXL' hL')) hr) _,
  convert rank_subset_simple_set_lb hL (subset.trans hXL' hL'),
  rw min_eq_left (le_of_lt hX),
end

lemma line_restr_of_ε {L : set α}(hl : 0 ≤ l)(hr : M.r L ≤ 2)(hL : l ≤ M.ε L):
  M.has_unif_restr 2 l :=
begin
  rw ε_eq_largest_simple_subset at hL,
  obtain ⟨⟨L₀,hL₀⟩, h', -⟩ := max_spec (λ (S : M.simple_subset_of L), size (S : set α)),
  rw ← h' at hL,
  exact line_restr_of_simple_set hl (le_trans (M.rank_mono hL₀.2) hr) hL₀.1 hL,
end

lemma line_restr_ub_ε (hl : 0 ≤ l){L : set α}(hM : M.has_no_line_minor (l+2))(hL : M.is_line L):
  M.ε L ≤ l+1 :=
begin
  by_contra hn, push_neg at hn,
  refine hM (has_uniform_minor_of_has_unif_restriction
    (line_restr_of_ε (by linarith : 0 ≤ l+2) (hL.r.le) _)),
  have := (int.add_one_le_of_lt hn),
  rwa [add_assoc] at this,
end

end line


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Joey van Langen, Casper Putz
-/

import data.nat.choose
import data.int.modeq
import algebra.iterate_hom
import group_theory.order_of_element
/-!
# Characteristic of semirings
-/

universes u v

variables (R : Type u)

/-- The generator of the kernel of the unique homomorphism ℕ → R for a semiring R -/
class char_p [add_monoid R] [has_one R] (p : ℕ) : Prop :=
(cast_eq_zero_iff [] : ∀ x:ℕ, (x:R) = 0 ↔ p ∣ x)

theorem char_p.cast_eq_zero [add_monoid R] [has_one R] (p : ℕ) [char_p R p] :
  (p:R) = 0 :=
(char_p.cast_eq_zero_iff R p p).2 (dvd_refl p)

@[simp] lemma char_p.cast_card_eq_zero [add_group R] [has_one R] [fintype R] :
  (fintype.card R : R) = 0 :=
by rw [← nsmul_one, card_nsmul_eq_zero]

lemma char_p.int_cast_eq_zero_iff [add_group R] [has_one R] (p : ℕ) [char_p R p]
  (a : ℤ) :
  (a : R) = 0 ↔ (p:ℤ) ∣ a :=
begin
  rcases lt_trichotomy a 0 with h|rfl|h,
  { rw [← neg_eq_zero, ← int.cast_neg, ← dvd_neg],
    lift -a to ℕ using neg_nonneg.mpr (le_of_lt h) with b,
    rw [int.cast_coe_nat, char_p.cast_eq_zero_iff R p, int.coe_nat_dvd] },
  { simp only [int.cast_zero, eq_self_iff_true, dvd_zero] },
  { lift a to ℕ using (le_of_lt h) with b,
    rw [int.cast_coe_nat, char_p.cast_eq_zero_iff R p, int.coe_nat_dvd] }
end

lemma char_p.int_coe_eq_int_coe_iff [add_group R] [has_one R] (p : ℕ) [char_p R p] (a b : ℤ) :
  (a : R) = (b : R) ↔ a ≡ b [ZMOD p] :=
by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub,
       char_p.int_cast_eq_zero_iff R p, int.modeq.modeq_iff_dvd]

theorem char_p.eq [add_monoid R] [has_one R] {p q : ℕ} (c1 : char_p R p) (c2 : char_p R q) :
  p = q :=
nat.dvd_antisymm
  ((char_p.cast_eq_zero_iff R p q).1 (char_p.cast_eq_zero _ _))
  ((char_p.cast_eq_zero_iff R q p).1 (char_p.cast_eq_zero _ _))

instance char_p.of_char_zero [add_monoid R] [has_one R] [char_zero R] : char_p R 0 :=
⟨λ x, by rw [zero_dvd_iff, ← nat.cast_zero, nat.cast_inj]⟩

theorem char_p.exists [semiring R] : ∃ p, char_p R p :=
by letI := classical.dec_eq R; exact
classical.by_cases
  (assume H : ∀ p:ℕ, (p:R) = 0 → p = 0, ⟨0,
    ⟨λ x, by rw [zero_dvd_iff]; exact ⟨H x, by rintro rfl; refl⟩⟩⟩)
  (λ H, ⟨nat.find (not_forall.1 H), ⟨λ x,
    ⟨λ H1, nat.dvd_of_mod_eq_zero (by_contradiction $ λ H2,
      nat.find_min (not_forall.1 H)
        (nat.mod_lt x $ nat.pos_of_ne_zero $ not_of_not_imp $
          nat.find_spec (not_forall.1 H))
        (not_imp_of_and_not ⟨by rwa [← nat.mod_add_div x (nat.find (not_forall.1 H)),
          nat.cast_add, nat.cast_mul, of_not_not (not_not_of_not_imp $ nat.find_spec
            (not_forall.1 H)),
          zero_mul, add_zero] at H1, H2⟩)),
    λ H1, by rw [← nat.mul_div_cancel' H1, nat.cast_mul,
      of_not_not (not_not_of_not_imp $ nat.find_spec (not_forall.1 H)), zero_mul]⟩⟩⟩)

theorem char_p.exists_unique [semiring R] : ∃! p, char_p R p :=
let ⟨c, H⟩ := char_p.exists R in ⟨c, H, λ y H2, char_p.eq R H2 H⟩

theorem char_p.congr {R : Type u} [semiring R] {p : ℕ} (q : ℕ) [hq : char_p R q] (h : q = p) :
  char_p R p :=
h ▸ hq

/-- Noncomputable function that outputs the unique characteristic of a semiring. -/
noncomputable def ring_char [semiring R] : ℕ :=
classical.some (char_p.exists_unique R)

namespace ring_char
variables [semiring R]

theorem spec : ∀ x:ℕ, (x:R) = 0 ↔ ring_char R ∣ x :=
by letI := (classical.some_spec (char_p.exists_unique R)).1;
unfold ring_char; exact char_p.cast_eq_zero_iff R (ring_char R)

theorem eq {p : ℕ} (C : char_p R p) : p = ring_char R :=
(classical.some_spec (char_p.exists_unique R)).2 p C

instance char_p : char_p R (ring_char R) :=
⟨spec R⟩

variables {R}

theorem of_eq {p : ℕ} (h : ring_char R = p) : char_p R p :=
char_p.congr (ring_char R) h

theorem eq_iff {p : ℕ} : ring_char R = p ↔ char_p R p :=
⟨of_eq, eq.symm ∘ eq R⟩

theorem dvd {x : ℕ} (hx : (x : R) = 0) : ring_char R ∣ x :=
(spec R x).1 hx

@[simp]
lemma eq_zero [char_zero R] : ring_char R = 0 := (eq R (char_p.of_char_zero R)).symm

end ring_char

theorem add_pow_char_of_commute [semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) (h : commute x y) :
  (x + y)^p = x^p + y^p :=
begin
  rw [commute.add_pow h, finset.sum_range_succ_comm, nat.sub_self, pow_zero, nat.choose_self],
  rw [nat.cast_one, mul_one, mul_one], congr' 1,
  convert finset.sum_eq_single 0 _ _,
  { simp only [mul_one, one_mul, nat.choose_zero_right, nat.sub_zero, nat.cast_one, pow_zero] },
  { intros b h1 h2,
    suffices : (p.choose b : R) = 0, { rw this, simp },
    rw char_p.cast_eq_zero_iff R p,
    refine nat.prime.dvd_choose_self (pos_iff_ne_zero.mpr h2) _ (fact.out _),
    rwa ← finset.mem_range },
  { intro h1,
    contrapose! h1,
    rw finset.mem_range,
    exact nat.prime.pos (fact.out _) }
end

theorem add_pow_char_pow_of_commute [semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) (h : commute x y) :
  (x + y) ^ (p ^ n) = x ^ (p ^ n) + y ^ (p ^ n) :=
begin
  induction n, { simp, },
  rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih],
  apply add_pow_char_of_commute, apply commute.pow_pow h,
end

theorem sub_pow_char_of_commute [ring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) (h : commute x y) :
  (x - y)^p = x^p - y^p :=
begin
  rw [eq_sub_iff_add_eq, ← add_pow_char_of_commute _ _ _ (commute.sub_left h rfl)],
  simp, repeat {apply_instance},
end

theorem sub_pow_char_pow_of_commute [ring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) (h : commute x y) :
  (x - y) ^ (p ^ n) = x ^ (p ^ n) - y ^ (p ^ n) :=
begin
  induction n, { simp, },
  rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih],
  apply sub_pow_char_of_commute, apply commute.pow_pow h,
end

theorem add_pow_char [comm_semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) : (x + y)^p = x^p + y^p :=
add_pow_char_of_commute _ _ _ (commute.all _ _)

theorem add_pow_char_pow [comm_semiring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) :
  (x + y) ^ (p ^ n) = x ^ (p ^ n) + y ^ (p ^ n) :=
add_pow_char_pow_of_commute _ _ _ (commute.all _ _)

theorem sub_pow_char [comm_ring R] {p : ℕ} [fact p.prime]
  [char_p R p] (x y : R) : (x - y)^p = x^p - y^p :=
sub_pow_char_of_commute _ _ _ (commute.all _ _)

theorem sub_pow_char_pow [comm_ring R] {p : ℕ} [fact p.prime]
  [char_p R p] {n : ℕ} (x y : R) :
  (x - y) ^ (p ^ n) = x ^ (p ^ n) - y ^ (p ^ n) :=
sub_pow_char_pow_of_commute _ _ _ (commute.all _ _)

lemma eq_iff_modeq_int [ring R] (p : ℕ) [char_p R p] (a b : ℤ) :
  (a : R) = b ↔ a ≡ b [ZMOD p] :=
by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub,
       char_p.int_cast_eq_zero_iff R p, int.modeq.modeq_iff_dvd]

lemma char_p.neg_one_ne_one [ring R] (p : ℕ) [char_p R p] [fact (2 < p)] :
  (-1 : R) ≠ (1 : R) :=
begin
  suffices : (2 : R) ≠ 0,
  { symmetry, rw [ne.def, ← sub_eq_zero, sub_neg_eq_add], exact this },
  assume h,
  rw [show (2 : R) = (2 : ℕ), by norm_cast] at h,
  have := (char_p.cast_eq_zero_iff R p 2).mp h,
  have := nat.le_of_dvd dec_trivial this,
  rw fact_iff at *, linarith,
end

lemma ring_hom.char_p_iff_char_p {K L : Type*} [field K] [field L] (f : K →+* L) (p : ℕ) :
  char_p K p ↔ char_p L p :=
begin
  split;
  { introI _c, constructor, intro n,
    rw [← @char_p.cast_eq_zero_iff _ _ _ p _c n, ← f.injective.eq_iff, f.map_nat_cast, f.map_zero] }
end

section frobenius

section comm_semiring

variables [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) (g : R →+* S)
  (p : ℕ) [fact p.prime] [char_p R p]  [char_p S p] (x y : R)

/-- The frobenius map that sends x to x^p -/
def frobenius : R →+* R :=
{ to_fun := λ x, x^p,
  map_one' := one_pow p,
  map_mul' := λ x y, mul_pow x y p,
  map_zero' := zero_pow (lt_trans zero_lt_one (fact.out (nat.prime p)).one_lt),
  map_add' := add_pow_char R }

variable {R}

theorem frobenius_def : frobenius R p x = x ^ p := rfl

theorem iterate_frobenius (n : ℕ) : (frobenius R p)^[n] x = x ^ p ^ n :=
begin
  induction n, {simp},
  rw [function.iterate_succ', pow_succ', pow_mul, function.comp_apply, frobenius_def, n_ih]
end

theorem frobenius_mul : frobenius R p (x * y) = frobenius R p x * frobenius R p y :=
(frobenius R p).map_mul x y

theorem frobenius_one : frobenius R p 1 = 1 := one_pow _

theorem monoid_hom.map_frobenius : f (frobenius R p x) = frobenius S p (f x) :=
f.map_pow x p

theorem ring_hom.map_frobenius : g (frobenius R p x) = frobenius S p (g x) :=
g.map_pow x p

theorem monoid_hom.map_iterate_frobenius (n : ℕ) :
  f (frobenius R p^[n] x) = (frobenius S p^[n] (f x)) :=
function.semiconj.iterate_right (f.map_frobenius p) n x

theorem ring_hom.map_iterate_frobenius (n : ℕ) :
  g (frobenius R p^[n] x) = (frobenius S p^[n] (g x)) :=
g.to_monoid_hom.map_iterate_frobenius p x n

theorem monoid_hom.iterate_map_frobenius (f : R →* R) (p : ℕ) [fact p.prime] [char_p R p] (n : ℕ) :
  f^[n] (frobenius R p x) = frobenius R p (f^[n] x) :=
f.iterate_map_pow _ _ _

theorem ring_hom.iterate_map_frobenius (f : R →+* R) (p : ℕ) [fact p.prime] [char_p R p] (n : ℕ) :
  f^[n] (frobenius R p x) = frobenius R p (f^[n] x) :=
f.iterate_map_pow _ _ _

variable (R)

theorem frobenius_zero : frobenius R p 0 = 0 := (frobenius R p).map_zero

theorem frobenius_add : frobenius R p (x + y) = frobenius R p x + frobenius R p y :=
(frobenius R p).map_add x y

theorem frobenius_nat_cast (n : ℕ) : frobenius R p n = n := (frobenius R p).map_nat_cast n

end comm_semiring

section comm_ring

variables [comm_ring R] {S : Type v} [comm_ring S] (f : R →* S) (g : R →+* S)
  (p : ℕ) [fact p.prime] [char_p R p]  [char_p S p] (x y : R)

theorem frobenius_neg : frobenius R p (-x) = -frobenius R p x := (frobenius R p).map_neg x

theorem frobenius_sub : frobenius R p (x - y) = frobenius R p x - frobenius R p y :=
(frobenius R p).map_sub x y

end comm_ring

end frobenius

theorem frobenius_inj [comm_ring R] [no_zero_divisors R]
  (p : ℕ) [fact p.prime] [char_p R p] :
  function.injective (frobenius R p) :=
λ x h H, by { rw ← sub_eq_zero at H ⊢, rw ← frobenius_sub at H, exact pow_eq_zero H }

namespace char_p

section
variables [ring R]

lemma char_p_to_char_zero [char_p R 0] : char_zero R :=
char_zero_of_inj_zero $
  λ n h0, eq_zero_of_zero_dvd ((cast_eq_zero_iff R 0 n).mp h0)

lemma cast_eq_mod (p : ℕ) [char_p R p] (k : ℕ) : (k : R) = (k % p : ℕ) :=
calc (k : R) = ↑(k % p + p * (k / p)) : by rw [nat.mod_add_div]
         ... = ↑(k % p)               : by simp[cast_eq_zero]

theorem char_ne_zero_of_fintype (p : ℕ) [hc : char_p R p] [fintype R] : p ≠ 0 :=
assume h : p = 0,
have char_zero R := @char_p_to_char_zero R _ (h ▸ hc),
absurd (@nat.cast_injective R _ _ this) (not_injective_infinite_fintype coe)

end

section semiring
open nat

variables [semiring R]

theorem char_ne_one [nontrivial R] (p : ℕ) [hc : char_p R p] : p ≠ 1 :=
assume hp : p = 1,
have ( 1 : R) = 0, by simpa using (cast_eq_zero_iff R p 1).mpr (hp ▸ dvd_refl p),
absurd this one_ne_zero

section no_zero_divisors

variable [no_zero_divisors R]

theorem char_is_prime_of_two_le (p : ℕ) [hc : char_p R p] (hp : 2 ≤ p) : nat.prime p :=
suffices ∀d ∣ p, d = 1 ∨ d = p, from ⟨hp, this⟩,
assume (d : ℕ) (hdvd : ∃ e, p = d * e),
let ⟨e, hmul⟩ := hdvd in
have (p : R) = 0, from (cast_eq_zero_iff R p p).mpr (dvd_refl p),
have (d : R) * e = 0, from (@cast_mul R _ d e) ▸ (hmul ▸ this),
or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this)
  (assume hd : (d : R) = 0,
  have p ∣ d, from (cast_eq_zero_iff R p d).mp hd,
  show d = 1 ∨ d = p, from or.inr (dvd_antisymm ⟨e, hmul⟩ this))
  (assume he : (e : R) = 0,
  have p ∣ e, from (cast_eq_zero_iff R p e).mp he,
  have e ∣ p, from dvd_of_mul_left_eq d (eq.symm hmul),
  have e = p, from dvd_antisymm ‹e ∣ p› ‹p ∣ e›,
  have h₀ : p > 0, from gt_of_ge_of_gt hp (nat.zero_lt_succ 1),
  have d * p = 1 * p, by rw ‹e = p› at hmul; rw [one_mul]; exact eq.symm hmul,
  show d = 1 ∨ d = p, from or.inl (eq_of_mul_eq_mul_right h₀ this))

section nontrivial

variables [nontrivial R]

theorem char_is_prime_or_zero (p : ℕ) [hc : char_p R p] : nat.prime p ∨ p = 0 :=
match p, hc with
| 0,     _  := or.inr rfl
| 1,     hc := absurd (eq.refl (1 : ℕ)) (@char_ne_one R _ _ (1 : ℕ) hc)
| (m+2), hc := or.inl (@char_is_prime_of_two_le R _ _ (m+2) hc (nat.le_add_left 2 m))
end

lemma char_is_prime_of_pos (p : ℕ) [h : fact (0 < p)] [char_p R p] : fact p.prime :=
⟨(char_p.char_is_prime_or_zero R _).resolve_right (pos_iff_ne_zero.1 h.1)⟩

end nontrivial

end no_zero_divisors

end semiring

section ring

variables (R) [ring R] [no_zero_divisors R] [nontrivial R] [fintype R]

theorem char_is_prime (p : ℕ) [char_p R p] :
  p.prime :=
or.resolve_right (char_is_prime_or_zero R p) (char_ne_zero_of_fintype R p)

end ring

section char_one

variables {R} [semiring R]

@[priority 100]  -- see Note [lower instance priority]
instance [char_p R 1] : subsingleton R :=
subsingleton.intro $
suffices ∀ (r : R), r = 0,
  from assume a b, show a = b, by rw [this a, this b],
assume r,
calc r = 1 * r       : by rw one_mul
   ... = (1 : ℕ) * r : by rw nat.cast_one
   ... = 0 * r       : by rw char_p.cast_eq_zero
   ... = 0           : by rw zero_mul

lemma false_of_nontrivial_of_char_one [nontrivial R] [char_p R 1] : false :=
false_of_nontrivial_of_subsingleton R

lemma ring_char_ne_one [nontrivial R] : ring_char R ≠ 1 :=
by { intros h, apply @zero_ne_one R, symmetry, rw [←nat.cast_one, ring_char.spec, h], }

lemma nontrivial_of_char_ne_one {v : ℕ} (hv : v ≠ 1) [hr : char_p R v] :
  nontrivial R :=
⟨⟨(1 : ℕ), 0, λ h, hv $ by rwa [char_p.cast_eq_zero_iff _ v, nat.dvd_one] at h; assumption ⟩⟩

end char_one

end char_p

section

variables (R) [comm_ring R] [fintype R] (n : ℕ)

lemma char_p_of_ne_zero (hn : fintype.card R = n) (hR : ∀ i < n, (i : R) = 0 → i = 0) :
  char_p R n :=
{ cast_eq_zero_iff :=
  begin
    have H : (n : R) = 0, by { rw [← hn, char_p.cast_card_eq_zero] },
    intro k,
    split,
    { intro h,
      rw [← nat.mod_add_div k n, nat.cast_add, nat.cast_mul, H, zero_mul, add_zero] at h,
      rw nat.dvd_iff_mod_eq_zero,
      apply hR _ (nat.mod_lt _ _) h,
      rw [← hn, fintype.card_pos_iff],
      exact ⟨0⟩, },
    { rintro ⟨k, rfl⟩, rw [nat.cast_mul, H, zero_mul] }
  end }

lemma char_p_of_prime_pow_injective (p : ℕ) [hp : fact p.prime] (n : ℕ)
  (hn : fintype.card R = p ^ n) (hR : ∀ i ≤ n, (p ^ i : R) = 0 → i = n) :
  char_p R (p ^ n) :=
begin
  obtain ⟨c, hc⟩ := char_p.exists R, resetI,
  have hcpn : c ∣ p ^ n,
  { rw [← char_p.cast_eq_zero_iff R c, ← hn, char_p.cast_card_eq_zero], },
  obtain ⟨i, hi, hc⟩ : ∃ i ≤ n, c = p ^ i, by rwa nat.dvd_prime_pow hp.1 at hcpn,
  obtain rfl : i = n,
  { apply hR i hi, rw [← nat.cast_pow, ← hc, char_p.cast_eq_zero] },
  rwa ← hc
end

end


import Category.Init

/-!
# Category **Poset**

`Poset` is the **Poset** category:
- objects are all the partially-ordered sets, and
- arrows are all the order-preserving functions between objects.
-/

namespace Cat.Poset

  structure All where
    Elm : α
    ord : PartialOrder Elm

  def All.le {self : All} (a : self.Elm) (b : self.Elm) : Prop :=
    self.ord.le a b

  local infix:50 " ≤ " => All.le

  structure ProperFn (p₁ p₂ : All) where
    apply : p₁.Elm → p₂.Elm
    apply_post (a₁ b₁ : p₁.Elm) :
      a₁ ≤ b₁ → apply a₁ ≤ apply b₁

  def ProperFn.compose
    (g : ProperFn p₂ p₃)
    (f : ProperFn p₁ p₂)
    : ProperFn p₁ p₃
  where
    apply a₁ :=
      f.apply a₁
      |> g.apply
    apply_post a₁ b₁ h₁ :=
      let a₂ := f.apply a₁
      let b₂ := f.apply b₁
      let h₂ := f.apply_post a₁ b₁ h₁
      g.apply_post a₂ b₂ h₂

  theorem ProperFn.compose_assoc
    (h : ProperFn p₃ p₄)
    (g : ProperFn p₂ p₃)
    (f : ProperFn p₁ p₂)
    : h.compose (g.compose f) = (h.compose g).compose f
  :=
    rfl

  protected def ProperFn.id {p : outParam All} : ProperFn p p where
    apply := id
    apply_post _ _ := id

  theorem ProperFn.compose_id
    (f : ProperFn s₁ s₂)
    : f.compose ProperFn.id = f
  :=
    rfl

  theorem ProperFn.id_compose
    (f : ProperFn s₁ s₂)
    : ProperFn.id.compose f = f
  :=
    rfl

end Cat.Poset

instance Cat.Poset : Cat.Abstract Poset.All Poset.ProperFn where
  compose :=
    Poset.ProperFn.compose
  compose_assoc :=
    Poset.ProperFn.compose_assoc

  id :=
    @Poset.ProperFn.id
  compose_id :=
    @Poset.ProperFn.compose_id
  id_compose :=
    @Poset.ProperFn.id_compose

--- Category which objects are the elements of a poset.
---
--- There is an array between `α` and `β` iff `α ≤ β`.
---
--- Note that this allows to see `Cat.Poset` as a category of categories.
instance Cat.PosetPairs
  [ord : PartialOrder Object]
: Cat.Abstract Object (fun e₁ e₂ => e₁ ≤ e₂) where
  compose {α β γ} f g :=
    ord.le_trans α β γ g f
  compose_assoc f g h :=
    by simp

  id {α} :=
    ord.le_refl α
  compose_id :=
    by simp
  id_compose :=
    by simp


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

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

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

namespace ideal

open polynomial

section is_jacobson
variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}

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

theorem is_jacobson_iff {R} [comm_ring R] :
  is_jacobson R ↔ ∀ (I : ideal R), I.radical = I → I.jacobson = I :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_jacobson.out {R} [comm_ring R] :
  is_jacobson R → ∀ {I : ideal R}, I.radical = I → I.jacobson = I := is_jacobson_iff.1

/--  A ring is a Jacobson ring if and only if for all prime ideals `P`,
 the Jacobson radical of `P` is equal to `P`. -/
lemma is_jacobson_iff_prime_eq : is_jacobson R ↔ ∀ P : ideal R, is_prime P → P.jacobson = P :=
begin
  refine is_jacobson_iff.trans ⟨λ h I hI, h I (is_prime.radical hI), _⟩,
  refine λ h I hI, le_antisymm (λ x hx, _) (λ x hx, mem_Inf.mpr (λ _ hJ, hJ.left hx)),
  rw [← hI, radical_eq_Inf I, mem_Inf],
  intros P hP,
  rw set.mem_set_of_eq at hP,
  erw mem_Inf at hx,
  erw [← h P hP.right, mem_Inf],
  exact λ J hJ, hx ⟨le_trans hP.left hJ.left, hJ.right⟩
end

/-- A ring `R` is Jacobson if and only if for every prime ideal `I`,
 `I` can be written as the infimum of some collection of maximal ideals.
 Allowing ⊤ in the set `M` of maximal ideals is equivalent, but makes some proofs cleaner. -/
lemma is_jacobson_iff_Inf_maximal : is_jacobson R ↔
  ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
⟨λ H I h, eq_jacobson_iff_Inf_maximal.1 (H.out (is_prime.radical h)),
  λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal.2 (H hP))⟩

lemma is_jacobson_iff_Inf_maximal' : is_jacobson R ↔
  ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R),
  (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
⟨λ H I h, eq_jacobson_iff_Inf_maximal'.1 (H.out (is_prime.radical h)),
  λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal'.2 (H hP))⟩

lemma radical_eq_jacobson [H : is_jacobson R] (I : ideal R) : I.radical = I.jacobson :=
le_antisymm (le_Inf (λ J ⟨hJ, hJ_max⟩, (is_prime.radical_le_iff hJ_max.is_prime).mpr hJ))
            ((H.out (radical_idem I)) ▸ (jacobson_mono le_radical))

/-- Fields have only two ideals, and the condition holds for both of them.  -/
@[priority 100]
instance is_jacobson_field {K : Type*} [field K] : is_jacobson K :=
⟨λ I hI, or.rec_on (eq_bot_or_top I)
(λ h, le_antisymm
  (Inf_le ⟨le_of_eq rfl, (eq.symm h) ▸ bot_is_maximal⟩)
  ((eq.symm h) ▸ bot_le))
(λ h, by rw [h, jacobson_eq_top_iff])⟩

theorem is_jacobson_of_surjective [H : is_jacobson R] :
  (∃ (f : R →+* S), function.surjective f) → is_jacobson S :=
begin
  rintros ⟨f, hf⟩,
  rw is_jacobson_iff_Inf_maximal,
  intros p hp,
  use map f '' {J : ideal R | comap f p ≤ J ∧ J.is_maximal },
  use λ j ⟨J, hJ, hmap⟩, hmap ▸ or.symm (map_eq_top_or_is_maximal_of_surjective f hf hJ.right),
  have : p = map f ((comap f p).jacobson),
  from (is_jacobson.out' (comap f p) (by rw [← comap_radical, is_prime.radical hp])).symm
    ▸ (map_comap_of_surjective f hf p).symm,
  exact eq.trans this (map_Inf hf (λ J ⟨hJ, _⟩, le_trans (ideal.ker_le_comap f) hJ)),
end

@[priority 100]
instance is_jacobson_quotient [is_jacobson R] : is_jacobson (quotient I) :=
is_jacobson_of_surjective ⟨quotient.mk I, (by rintro ⟨x⟩; use x; refl)⟩

lemma is_jacobson_iso (e : R ≃+* S) : is_jacobson R ↔ is_jacobson S :=
⟨λ h, @is_jacobson_of_surjective _ _ _ _ h ⟨(e : R →+* S), e.surjective⟩,
  λ h, @is_jacobson_of_surjective _ _ _ _ h ⟨(e.symm : S →+* R), e.symm.surjective⟩⟩

lemma is_jacobson_of_is_integral [algebra R S] (hRS : algebra.is_integral R S)
  (hR : is_jacobson R) : is_jacobson S :=
begin
  rw is_jacobson_iff_prime_eq,
  introsI P hP,
  by_cases hP_top : comap (algebra_map R S) P = ⊤,
  { simp [comap_eq_top_iff.1 hP_top] },
  { haveI : nontrivial (comap (algebra_map R S) P).quotient := quotient.nontrivial hP_top,
    rw jacobson_eq_iff_jacobson_quotient_eq_bot,
    refine eq_bot_of_comap_eq_bot (is_integral_quotient_of_is_integral hRS) _,
    rw [eq_bot_iff, ← jacobson_eq_iff_jacobson_quotient_eq_bot.1 ((is_jacobson_iff_prime_eq.1 hR)
      (comap (algebra_map R S) P) (comap_is_prime _ _)), comap_jacobson],
    refine Inf_le_Inf (λ J hJ, _),
    simp only [true_and, set.mem_image, bot_le, set.mem_set_of_eq],
    haveI : J.is_maximal := by simpa using hJ,
    exact exists_ideal_over_maximal_of_is_integral (is_integral_quotient_of_is_integral hRS) J
      (comap_bot_le_of_injective _ algebra_map_quotient_injective) }
end

lemma is_jacobson_of_is_integral' (f : R →+* S) (hf : f.is_integral)
  (hR : is_jacobson R) : is_jacobson S :=
@is_jacobson_of_is_integral _ _ _ _ f.to_algebra hf hR

end is_jacobson

section localization
open localization_map submonoid
variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}
variables {y : R} (f : away_map y S)

lemma disjoint_powers_iff_not_mem (hI : I.radical = I) :
  disjoint ((submonoid.powers y) : set R) ↑I ↔ y ∉ I.1 :=
begin
  refine ⟨λ h, set.disjoint_left.1 h (mem_powers _), λ h, (disjoint_iff).mpr (eq_bot_iff.mpr _)⟩,
  rintros x ⟨⟨n, rfl⟩, hx'⟩,
  rw [← hI] at hx',
  exact absurd (hI ▸ mem_radical_of_pow_mem hx' : y ∈ I.carrier) h
end

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its comap.
See `le_rel_iso_of_maximal` for the more general relation isomorphism -/
lemma is_maximal_iff_is_maximal_disjoint [H : is_jacobson R] (J : ideal S) :
  J.is_maximal ↔ (comap f.to_map J).is_maximal ∧ y ∉ ideal.comap f.to_map J :=
begin
  split,
  { refine λ h, ⟨_, λ hy, h.ne_top (ideal.eq_top_of_is_unit_mem _ hy
      (map_units f ⟨y, submonoid.mem_powers _⟩))⟩,
    have hJ : J.is_prime := is_maximal.is_prime h,
    rw is_prime_iff_is_prime_disjoint f at hJ,
    have : y ∉ (comap f.to_map J).1 :=
      set.disjoint_left.1 hJ.right (submonoid.mem_powers _),
    erw [← H.out (is_prime.radical hJ.left), mem_Inf] at this,
    push_neg at this,
    rcases this with ⟨I, hI, hI'⟩,
    convert hI.right,
    by_cases hJ : J = map f.to_map I,
    { rw [hJ, comap_map_of_is_prime_disjoint f I (is_maximal.is_prime hI.right)],
      rwa disjoint_powers_iff_not_mem (is_maximal.is_prime hI.right).radical},
    { have hI_p : (map f.to_map I).is_prime,
      { refine is_prime_of_is_prime_disjoint f I hI.right.is_prime _,
        rwa disjoint_powers_iff_not_mem (is_maximal.is_prime hI.right).radical },
      have : J ≤ map f.to_map I := (map_comap f J) ▸ (map_mono hI.left),
      exact absurd (h.1.2 _ (lt_of_le_of_ne this hJ)) hI_p.1 } },
  { refine λ h, ⟨⟨λ hJ, h.1.ne_top (eq_top_iff.2 _), λ I hI, _⟩⟩,
    { rwa [eq_top_iff, ← f.order_embedding.le_iff_le] at hJ },
    { have := congr_arg (map f.to_map) (h.1.1.2 _ ⟨comap_mono (le_of_lt hI), _⟩),
      rwa [map_comap f I, map_top f.to_map] at this,
      refine λ hI', hI.right _,
      rw [← map_comap f I, ← map_comap f J],
      exact map_mono hI' } }
end

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its map.
See `le_rel_iso_of_maximal` for the more general statement, and the reverse of this implication -/
lemma is_maximal_of_is_maximal_disjoint [is_jacobson R] (I : ideal R) (hI : I.is_maximal)
  (hy : y ∉ I) : (map f.to_map I).is_maximal :=
begin
  rw [is_maximal_iff_is_maximal_disjoint f,
    comap_map_of_is_prime_disjoint f I (is_maximal.is_prime hI)
    ((disjoint_powers_iff_not_mem (is_maximal.is_prime hI).radical).2 hy)],
  exact ⟨hI, hy⟩
end

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y` -/
def order_iso_of_maximal [is_jacobson R] :
  {p : ideal S // p.is_maximal} ≃o {p : ideal R // p.is_maximal ∧ y ∉ p} :=
{ to_fun := λ p, ⟨ideal.comap f.to_map p.1, (is_maximal_iff_is_maximal_disjoint f p.1).1 p.2⟩,
  inv_fun := λ p, ⟨ideal.map f.to_map p.1, is_maximal_of_is_maximal_disjoint f p.1 p.2.1 p.2.2⟩,
  left_inv := λ J, subtype.eq (map_comap f J),
  right_inv := λ I, subtype.eq (comap_map_of_is_prime_disjoint f I.1 (is_maximal.is_prime I.2.1)
    ((disjoint_powers_iff_not_mem I.2.1.is_prime.radical).2 I.2.2)),
  map_rel_iff' := λ I I', ⟨λ h, (show I.val ≤ I'.val,
    from (map_comap f I.val) ▸ (map_comap f I'.val) ▸ (ideal.map_mono h)), λ h x hx, h hx⟩ }

/-- If `S` is the localization of the Jacobson ring `R` at the submonoid generated by `y : R`, then
`S` is Jacobson. -/
lemma is_jacobson_localization [H : is_jacobson R]
  (f : away_map y S) : is_jacobson S :=
begin
  rw is_jacobson_iff_prime_eq,
  refine λ P' hP', le_antisymm _ le_jacobson,
  obtain ⟨hP', hPM⟩ := (localization_map.is_prime_iff_is_prime_disjoint f P').mp hP',
  have hP := H.out (is_prime.radical hP'),
  refine le_trans (le_trans (le_of_eq (localization_map.map_comap f P'.jacobson).symm) (map_mono _))
    (le_of_eq (localization_map.map_comap f P')),
  have : Inf { I : ideal R | comap f.to_map P' ≤ I ∧ I.is_maximal ∧ y ∉ I } ≤ comap f.to_map P',
  { intros x hx,
    have hxy : x * y ∈ (comap f.to_map P').jacobson,
    { rw [ideal.jacobson, mem_Inf],
      intros J hJ,
      by_cases y ∈ J,
      { exact J.smul_mem x h },
      { exact (mul_comm y x) ▸ J.smul_mem y ((mem_Inf.1 hx) ⟨hJ.left, ⟨hJ.right, h⟩⟩) } },
    rw hP at hxy,
    cases hP'.mem_or_mem hxy with hxy hxy,
    { exact hxy },
    { exact (hPM ⟨submonoid.mem_powers _, hxy⟩).elim } },
  refine le_trans _ this,
  rw [ideal.jacobson, comap_Inf', Inf_eq_infi],
  refine infi_le_infi_of_subset (λ I hI, ⟨map f.to_map I, ⟨_, _⟩⟩),
  { exact ⟨le_trans (le_of_eq ((localization_map.map_comap f P').symm)) (map_mono hI.1),
    is_maximal_of_is_maximal_disjoint f _ hI.2.1 hI.2.2⟩ },
  { exact localization_map.comap_map_of_is_prime_disjoint f I (is_maximal.is_prime hI.2.1)
    ((disjoint_powers_iff_not_mem hI.2.1.is_prime.radical).2 hI.2.2) }
end

end localization

namespace polynomial
open polynomial

section comm_ring
variables {R S : Type*} [comm_ring R] [integral_domain S]
variables {Rₘ Sₘ : Type*} [comm_ring Rₘ] [comm_ring Sₘ]

/-- If `I` is a prime ideal of `polynomial R` and `pX ∈ I` is a non-constant polynomial,
  then the map `R →+* R[x]/I` descends to an integral map when localizing at `pX.leading_coeff`.
  In particular `X` is integral because it satisfies `pX`, and constants are trivially integral,
  so integrality of the entire extension follows by closure under addition and multiplication. -/
lemma is_integral_localization_map_polynomial_quotient
  (P : ideal (polynomial R)) [P.is_prime] (pX : polynomial R) (hpX : pX ∈ P)
  (ϕ : localization_map (submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff) Rₘ)
  (ϕ' : localization_map ((submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).map
    (quotient_map P C le_rfl) : submonoid P.quotient) Sₘ) :
  (ϕ.map ((submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).mem_map_of_mem
      (quotient_map P C le_rfl : (P.comap C : ideal R).quotient →* P.quotient)) ϕ').is_integral :=
begin
  let P' : ideal R := P.comap C,
  let M : submonoid P'.quotient :=
  submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff,
  let φ : P'.quotient →+* P.quotient := quotient_map P C le_rfl,
  let φ' := (ϕ.map (M.mem_map_of_mem (φ : P'.quotient →* P.quotient)) ϕ'),
  have hφ' : φ.comp (quotient.mk P') = (quotient.mk P).comp C := rfl,
  intro p,
  obtain ⟨⟨p', ⟨q, hq⟩⟩, hp⟩ := ϕ'.surj p,
  suffices : φ'.is_integral_elem (ϕ'.to_map p'),
  { obtain ⟨q', hq', rfl⟩ := hq,
    obtain ⟨q'', hq''⟩ := is_unit_iff_exists_inv'.1 (ϕ.map_units ⟨q', hq'⟩),
    refine φ'.is_integral_of_is_integral_mul_unit p (ϕ'.to_map (φ q')) q'' _ (hp.symm ▸ this),
    convert trans (trans (φ'.map_mul _ _).symm (congr_arg φ' hq'')) φ'.map_one using 2,
    rw [← φ'.comp_apply, localization_map.map_comp, ϕ'.to_map.comp_apply, subtype.coe_mk] },
  refine is_integral_of_mem_closure''
    ((ϕ'.to_map.comp (quotient.mk P)) '' (insert X {p | p.degree ≤ 0})) _ _ _,
  { rintros x ⟨p, hp, rfl⟩,
    refine hp.rec_on (λ hy, _) (λ hy, _),
    { refine hy.symm ▸ (φ.is_integral_elem_localization_at_leading_coeff ((quotient.mk P) X)
        (pX.map (quotient.mk P')) _ M ⟨1, pow_one _⟩ _ _),
      rwa [eval₂_map, hφ', ← hom_eval₂, quotient.eq_zero_iff_mem, eval₂_C_X] },
    { rw [set.mem_set_of_eq, degree_le_zero_iff] at hy,
      refine hy.symm ▸ ⟨X - C (ϕ.to_map ((quotient.mk P') (p.coeff 0))), monic_X_sub_C _, _⟩,
      simp only [eval₂_sub, eval₂_C, eval₂_X],
      rw [sub_eq_zero, ← φ'.comp_apply, localization_map.map_comp, ring_hom.comp_apply],
      refl } },
  { obtain ⟨p, rfl⟩ := quotient.mk_surjective p',
    refine polynomial.induction_on p
      (λ r, subring.subset_closure $ set.mem_image_of_mem _ (or.inr degree_C_le))
      (λ _ _ h1 h2, _) (λ n _ hr, _),
    { convert subring.add_mem _ h1 h2,
      rw [ring_hom.map_add, ring_hom.map_add] },
    { rw [pow_succ X n, mul_comm X, ← mul_assoc, ring_hom.map_mul, ϕ'.to_map.map_mul],
      exact subring.mul_mem _ hr (subring.subset_closure (set.mem_image_of_mem _ (or.inl rfl))) } },
end

/-- If `f : R → S` descends to an integral map in the localization at `x`,
  and `R` is a Jacobson ring, then the intersection of all maximal ideals in `S` is trivial -/
lemma jacobson_bot_of_integral_localization {R : Type*} [integral_domain R] [is_jacobson R]
  (φ : R →+* S) (hφ : function.injective φ) (x : R) (hx : x ≠ 0)
  (ϕ : localization_map (submonoid.powers x) Rₘ)
  (ϕ' : localization_map ((submonoid.powers x).map φ : submonoid S) Sₘ)
  (hφ' : (ϕ.map ((submonoid.powers x).mem_map_of_mem (φ : R →* S)) ϕ').is_integral) :
  (⊥ : ideal S).jacobson = ⊥ :=
begin
  have hM : ((submonoid.powers x).map φ : submonoid S) ≤ non_zero_divisors S :=
    map_le_non_zero_divisors_of_injective hφ (powers_le_non_zero_divisors_of_domain hx),
  letI : integral_domain Sₘ := localization_map.integral_domain_of_le_non_zero_divisors ϕ' hM,
  let φ' : Rₘ →+* Sₘ := ϕ.map ((submonoid.powers x).mem_map_of_mem (φ : R →* S)) ϕ',
  suffices : ∀ I : ideal Sₘ, I.is_maximal → (I.comap ϕ'.to_map).is_maximal,
  { have hϕ' : comap ϕ'.to_map ⊥ = ⊥,
    { simpa [ring_hom.injective_iff_ker_eq_bot, ring_hom.ker_eq_comap_bot] using ϕ'.injective hM },
    refine eq_bot_iff.2 (le_trans _ (le_of_eq hϕ')),
    have hSₘ : is_jacobson Sₘ := is_jacobson_of_is_integral' φ' hφ' (is_jacobson_localization ϕ),
    rw [← hSₘ.out radical_bot_of_integral_domain, comap_jacobson],
    exact Inf_le_Inf (λ j hj, ⟨bot_le, let ⟨J, hJ⟩ := hj in hJ.2 ▸ this J hJ.1.2⟩) },
  introsI I hI,
  -- Remainder of the proof is pulling and pushing ideals around the square and the quotient square
  haveI : (I.comap ϕ'.to_map).is_prime := comap_is_prime ϕ'.to_map I,
  haveI : (I.comap φ').is_prime := comap_is_prime φ' I,
  haveI : (⊥ : ideal (I.comap ϕ'.to_map).quotient).is_prime := bot_prime,
  have hcomm: φ'.comp ϕ.to_map = ϕ'.to_map.comp φ := ϕ.map_comp _,
  let f := quotient_map (I.comap ϕ'.to_map) φ le_rfl,
  let g := quotient_map I ϕ'.to_map le_rfl,
  have := is_maximal_comap_of_is_integral_of_is_maximal' φ' hφ' I
    (by convert hI; casesI _inst_4; refl),
  have := ((is_maximal_iff_is_maximal_disjoint ϕ _).1 this).left,
  have : ((I.comap ϕ'.to_map).comap φ).is_maximal,
  { rwa [comap_comap, hcomm, ← comap_comap] at this },
  rw ← bot_quotient_is_maximal_iff at this ⊢,
  refine is_maximal_of_is_integral_of_is_maximal_comap' f _ ⊥
    ((eq_bot_iff.2 (comap_bot_le_of_injective f quotient_map_injective)).symm ▸ this),
  exact f.is_integral_tower_bot_of_is_integral g quotient_map_injective
    ((comp_quotient_map_eq_of_comp_eq hcomm I).symm ▸
    (ring_hom.is_integral_trans _ _ (ring_hom.is_integral_of_surjective _
      (localization_map.surjective_quotient_map_of_maximal_of_localization
      (by rwa [comap_comap, hcomm, ← bot_quotient_is_maximal_iff])))
      (ring_hom.is_integral_quotient_of_is_integral _ hφ'))),
end

/-- Used to bootstrap the proof of `is_jacobson_polynomial_iff_is_jacobson`.
  That theorem is more general and should be used instead of this one. -/
private lemma is_jacobson_polynomial_of_domain (R : Type*) [integral_domain R] [hR : is_jacobson R]
  (P : ideal (polynomial R)) [is_prime P] (hP : ∀ (x : R), C x ∈ P → x = 0) :
  P.jacobson = P :=
begin
  by_cases Pb : (P = ⊥),
  { exact Pb.symm ▸ jacobson_bot_polynomial_of_jacobson_bot
      (hR.out radical_bot_of_integral_domain) },
  { refine jacobson_eq_iff_jacobson_quotient_eq_bot.mpr _,
    haveI : (P.comap (C : R →+* polynomial R)).is_prime := comap_is_prime C P,
    obtain ⟨p, pP, p0⟩ := exists_nonzero_mem_of_ne_bot Pb hP,
    refine jacobson_bot_of_integral_localization (quotient_map P C le_rfl) quotient_map_injective
      _ _ (localization.of (submonoid.powers (p.map (quotient.mk (P.comap C))).leading_coeff))
      (localization.of _)
      (by apply (is_integral_localization_map_polynomial_quotient P _ pP _ _)),
    rwa [ne.def, leading_coeff_eq_zero] }
end

lemma is_jacobson_polynomial_of_is_jacobson (hR : is_jacobson R) :
  is_jacobson (polynomial R) :=
begin
  refine is_jacobson_iff_prime_eq.mpr (λ I, _),
  introI hI,
  let R' : subring I.quotient := ((quotient.mk I).comp C).range,
  let i : R →+* R' := ((quotient.mk I).comp C).range_restrict,
  have hi : function.surjective (i : R → R') := ((quotient.mk I).comp C).range_restrict_surjective,
  have hi' : (polynomial.map_ring_hom i : polynomial R →+* polynomial R').ker ≤ I,
  { refine λ f hf, polynomial_mem_ideal_of_coeff_mem_ideal I f (λ n, _),
    replace hf := congr_arg (λ (g : polynomial (((quotient.mk I).comp C).range)), g.coeff n) hf,
    change (polynomial.map ((quotient.mk I).comp C).range_restrict f).coeff n = 0 at hf,
    rw [coeff_map, subtype.ext_iff] at hf,
    rwa [mem_comap, ← quotient.eq_zero_iff_mem, ← ring_hom.comp_apply] },
  haveI : (ideal.map (map_ring_hom i) I).is_prime :=
    map_is_prime_of_surjective (map_surjective i hi) hi',
  suffices : (I.map (polynomial.map_ring_hom i)).jacobson = (I.map (polynomial.map_ring_hom i)),
  { replace this := congr_arg (comap (polynomial.map_ring_hom i)) this,
    rw [← map_jacobson_of_surjective _ hi',
      comap_map_of_surjective _ _, comap_map_of_surjective _ _] at this,
    refine le_antisymm (le_trans (le_sup_left_of_le le_rfl)
      (le_trans (le_of_eq this) (sup_le le_rfl hi'))) le_jacobson,
    all_goals {exact polynomial.map_surjective i hi} },
  exact @is_jacobson_polynomial_of_domain R' _ (is_jacobson_of_surjective ⟨i, hi⟩)
    (map (map_ring_hom i) I) _ (eq_zero_of_polynomial_mem_map_range I),
end

theorem is_jacobson_polynomial_iff_is_jacobson :
  is_jacobson (polynomial R) ↔ is_jacobson R :=
begin
  refine ⟨_, is_jacobson_polynomial_of_is_jacobson⟩,
  introI H,
  exact is_jacobson_of_surjective ⟨eval₂_ring_hom (ring_hom.id _) 1, λ x,
    ⟨C x, by simp only [coe_eval₂_ring_hom, ring_hom.id_apply, eval₂_C]⟩⟩,
end

instance [is_jacobson R] : is_jacobson (polynomial R) :=
is_jacobson_polynomial_iff_is_jacobson.mpr ‹is_jacobson R›

end comm_ring

section integral_domain
variables {R : Type*} [integral_domain R] [is_jacobson R]
variables (P : ideal (polynomial R)) [hP : P.is_maximal]

include P hP

lemma is_maximal_comap_C_of_is_maximal (hP' : ∀ (x : R), C x ∈ P → x = 0) :
  is_maximal (comap C P : ideal R) :=
begin
  haveI hp'_prime : (P.comap C : ideal R).is_prime := comap_is_prime C P,
  obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_of_maximal P polynomial_not_is_field),
  have : (m : polynomial R) ≠ 0, rwa [ne.def, submodule.coe_eq_zero],
  let φ : (P.comap C : ideal R).quotient →+* P.quotient := quotient_map P C le_rfl,
  let M : submonoid (P.comap C : ideal R).quotient :=
    submonoid.powers ((m : polynomial R).map (quotient.mk (P.comap C : ideal R))).leading_coeff,
  rw ← bot_quotient_is_maximal_iff at hP ⊢,
  have hp0 : ((m : polynomial R).map (quotient.mk (P.comap C : ideal R))).leading_coeff ≠ 0 :=
    λ hp0', this $ map_injective (quotient.mk (P.comap C : ideal R))
      ((quotient.mk (P.comap C : ideal R)).injective_iff.2 (λ x hx,
      by rwa [quotient.eq_zero_iff_mem, (by rwa eq_bot_iff : (P.comap C : ideal R) = ⊥)] at hx))
      (by simpa only [leading_coeff_eq_zero, map_zero] using hp0'),
  let ϕ : localization_map M (localization M) := localization.of M,
  have hM : (0 : ((P.comap C : ideal R)).quotient) ∉ M := λ ⟨n, hn⟩, hp0 (pow_eq_zero hn),
  suffices : (⊥ : ideal (localization M)).is_maximal,
  { rw ← ϕ.comap_map_of_is_prime_disjoint ⊥ bot_prime (λ x hx, hM (hx.2 ▸ hx.1)),
    refine ((is_maximal_iff_is_maximal_disjoint ϕ _).mp _).1,
    rwa map_bot },
  let M' : submonoid P.quotient := M.map φ,
  have hM' : (0 : P.quotient) ∉ M' :=
    λ ⟨z, hz⟩, hM (quotient_map_injective (trans hz.2 φ.map_zero.symm) ▸ hz.1),
  letI : integral_domain (localization M') :=
    localization_map.integral_domain_localization (le_non_zero_divisors_of_domain hM'),
  let ϕ' : localization_map (M.map ↑φ) (localization (M.map ↑φ)) := localization.of (M.map ↑φ),
  suffices : (⊥ : ideal (localization M')).is_maximal,
  { rw le_antisymm bot_le (comap_bot_le_of_injective _ (map_injective_of_injective _
      quotient_map_injective M ϕ ϕ' (le_non_zero_divisors_of_domain hM'))),
    refine is_maximal_comap_of_is_integral_of_is_maximal' _ _ ⊥ this,
    apply is_integral_localization_map_polynomial_quotient P _ (submodule.coe_mem m) ϕ (ϕ' : _) },
  rw (map_bot.symm : (⊥ : ideal (localization M')) = map ϕ'.to_map ⊥),
  refine map.is_maximal ϕ'.to_map (localization_map_bijective_of_field hM' _ ϕ') hP,
  rwa [← quotient.maximal_ideal_iff_is_field_quotient, ← bot_quotient_is_maximal_iff],
end

/-- Used to bootstrap the more general `quotient_mk_comp_C_is_integral_of_jacobson` -/
private lemma quotient_mk_comp_C_is_integral_of_jacobson' (hR : is_jacobson R)
  (hP' : ∀ (x : R), C x ∈ P → x = 0) :
  ((quotient.mk P).comp C : R →+* P.quotient).is_integral :=
begin
  refine (is_integral_quotient_map_iff _).mp _,
  let P' : ideal R := P.comap C,
  obtain ⟨pX, hpX, hp0⟩ :=
    exists_nonzero_mem_of_ne_bot (ne_of_lt (bot_lt_of_maximal P polynomial_not_is_field)).symm hP',
  let M : submonoid P'.quotient := submonoid.powers (pX.map (quotient.mk P')).leading_coeff,
  let φ : P'.quotient →+* P.quotient := quotient_map P C le_rfl,
  let ϕ' : localization_map (M.map ↑φ) (localization (M.map ↑φ)) := localization.of (M.map ↑φ),
  haveI hp'_prime : P'.is_prime := comap_is_prime C P,
  have hM : (0 : P'.quotient) ∉ M := λ ⟨n, hn⟩, hp0 $ leading_coeff_eq_zero.mp (pow_eq_zero hn),
  refine ((quotient_map P C le_rfl).is_integral_tower_bot_of_is_integral
    (localization.of (M.map ↑(quotient_map P C le_rfl))).to_map _ _),
  { refine ϕ'.injective (le_non_zero_divisors_of_domain (λ hM', hM _)),
    exact (let ⟨z, zM, z0⟩ := hM' in (quotient_map_injective (trans z0 φ.map_zero.symm)) ▸ zM) },
  { let ϕ : localization_map M (localization M) := localization.of M,
    rw ← (ϕ.map_comp _),
    refine ring_hom.is_integral_trans ϕ.to_map
      (ϕ.map (M.mem_map_of_mem (φ : P'.quotient →* P.quotient)) ϕ') _ _,
    { exact ϕ.to_map.is_integral_of_surjective (localization_map_bijective_of_field hM
        ((quotient.maximal_ideal_iff_is_field_quotient _).mp
        (is_maximal_comap_C_of_is_maximal P hP')) _).2 },
    { exact is_integral_localization_map_polynomial_quotient P pX hpX _ _ } }
end

/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `polynomial R`,
  then `R → (polynomial R)/P` is an integral map. -/
lemma quotient_mk_comp_C_is_integral_of_jacobson :
  ((quotient.mk P).comp C : R →+* P.quotient).is_integral :=
begin
  let P' : ideal R := P.comap C,
  haveI : P'.is_prime := comap_is_prime C P,
  let f : polynomial R →+* polynomial P'.quotient := polynomial.map_ring_hom (quotient.mk P'),
  have hf : function.surjective f := map_surjective (quotient.mk P') quotient.mk_surjective,
  have hPJ : P = (P.map f).comap f,
  { rw comap_map_of_surjective _ hf,
    refine le_antisymm (le_sup_left_of_le le_rfl) (sup_le le_rfl _),
    refine λ p hp, polynomial_mem_ideal_of_coeff_mem_ideal P p (λ n, quotient.eq_zero_iff_mem.mp _),
    simpa only [coeff_map, coe_map_ring_hom] using (polynomial.ext_iff.mp hp) n },
  refine ring_hom.is_integral_tower_bot_of_is_integral _ _ (injective_quotient_le_comap_map P) _,
  rw ← quotient_mk_maps_eq,
  refine ring_hom.is_integral_trans _ _
    ((quotient.mk P').is_integral_of_surjective quotient.mk_surjective) _,
  apply quotient_mk_comp_C_is_integral_of_jacobson' _ _ (λ x hx, _),
  any_goals { exact ideal.is_jacobson_quotient },
  { exact or.rec_on (map_eq_top_or_is_maximal_of_surjective f hf hP)
    (λ h, absurd (trans (h ▸ hPJ : P = comap f ⊤) comap_top : P = ⊤) hP.ne_top) id },
  { obtain ⟨z, rfl⟩ := quotient.mk_surjective x,
    rwa [quotient.eq_zero_iff_mem, mem_comap, hPJ, mem_comap, coe_map_ring_hom, map_C] }
end

lemma is_maximal_comap_C_of_is_jacobson : (P.comap (C : R →+* polynomial R)).is_maximal :=
begin
  rw [← @mk_ker _ _ P, ring_hom.ker_eq_comap_bot, comap_comap],
  exact is_maximal_comap_of_is_integral_of_is_maximal' _
    (quotient_mk_comp_C_is_integral_of_jacobson P) ⊥ ((bot_quotient_is_maximal_iff _).mpr hP),
end

omit P hP

lemma comp_C_integral_of_surjective_of_jacobson
  {S : Type*} [field S] (f : (polynomial R) →+* S) (hf : function.surjective f) :
  (f.comp C).is_integral :=
begin
  haveI : (f.ker).is_maximal := @comap_is_maximal_of_surjective _ _ _ _ f ⊥ hf bot_is_maximal,
  let g : f.ker.quotient →+* S := ideal.quotient.lift f.ker f (λ _ h, h),
  have hfg : (g.comp (quotient.mk f.ker)) = f := ring_hom_ext' rfl rfl,
  rw [← hfg, ring_hom.comp_assoc],
  refine ring_hom.is_integral_trans _ g (quotient_mk_comp_C_is_integral_of_jacobson f.ker)
    (g.is_integral_of_surjective _), --(quotient.lift_surjective f.ker f _ hf)),
  rw [← hfg] at hf,
  exact function.surjective.of_comp hf,
end

end integral_domain

end polynomial

namespace mv_polynomial
open mv_polynomial ring_hom

lemma is_jacobson_mv_polynomial_fin {R : Type*} [comm_ring R] [H : is_jacobson R] :
  ∀ (n : ℕ), is_jacobson (mv_polynomial (fin n) R)
| 0 := ((is_jacobson_iso ((rename_equiv R
  (equiv.equiv_pempty $ fin.elim0)).to_ring_equiv.trans (pempty_ring_equiv R))).mpr H)
| (n+1) := (is_jacobson_iso (fin_succ_equiv R n).to_ring_equiv).2
  (polynomial.is_jacobson_polynomial_iff_is_jacobson.2 (is_jacobson_mv_polynomial_fin n))

/-- General form of the nullstellensatz for Jacobson rings, since in a Jacobson ring we have
  `Inf {P maximal | P ≥ I} = Inf {P prime | P ≥ I} = I.radical`. Fields are always Jacobson,
  and in that special case this is (most of) the classical Nullstellensatz,
  since `I(V(I))` is the intersection of maximal ideals containing `I`, which is then `I.radical` -/
instance {R : Type*} [comm_ring R] {ι : Type*} [fintype ι] [is_jacobson R] :
  is_jacobson (mv_polynomial ι R) :=
begin
  haveI := classical.dec_eq ι,
  let e := fintype.equiv_fin ι,
  rw is_jacobson_iso (rename_equiv R e).to_ring_equiv,
  exact is_jacobson_mv_polynomial_fin _
end

variables {n : ℕ}

lemma quotient_mk_comp_C_is_integral_of_jacobson {R : Type*} [integral_domain R] [is_jacobson R]
  (P : ideal (mv_polynomial (fin n) R)) [P.is_maximal] :
  ((quotient.mk P).comp mv_polynomial.C : R →+* P.quotient).is_integral :=
begin
  unfreezingI {induction n with n IH},
  { refine ring_hom.is_integral_of_surjective _ (function.surjective.comp quotient.mk_surjective _),
    exact C_surjective_fin_0 },
  { rw [← fin_succ_equiv_comp_C_eq_C, ← ring_hom.comp_assoc, ← ring_hom.comp_assoc,
      ← quotient_map_comp_mk le_rfl, ring_hom.comp_assoc (polynomial.C),
      ← quotient_map_comp_mk le_rfl, ring_hom.comp_assoc, ring_hom.comp_assoc,
      ← quotient_map_comp_mk le_rfl, ← ring_hom.comp_assoc (quotient.mk _)],
    refine ring_hom.is_integral_trans _ _ _ _,
    { refine ring_hom.is_integral_trans _ _ (is_integral_of_surjective _ quotient.mk_surjective) _,
      refine ring_hom.is_integral_trans _ _ _ _,
      { apply (is_integral_quotient_map_iff _).mpr (IH _),
        apply polynomial.is_maximal_comap_C_of_is_jacobson _,
        { exact mv_polynomial.is_jacobson_mv_polynomial_fin n },
        { apply comap_is_maximal_of_surjective,
          exact (fin_succ_equiv R n).symm.surjective } },
      { refine (is_integral_quotient_map_iff _).mpr _,
        rw ← quotient_map_comp_mk le_rfl,
        refine ring_hom.is_integral_trans _ _ _ ((is_integral_quotient_map_iff _).mpr _),
        { exact ring_hom.is_integral_of_surjective _ quotient.mk_surjective },
        { apply polynomial.quotient_mk_comp_C_is_integral_of_jacobson _,
          { exact mv_polynomial.is_jacobson_mv_polynomial_fin n },
          { exact comap_is_maximal_of_surjective _ (fin_succ_equiv R n).symm.surjective } } } },
    { refine (is_integral_quotient_map_iff _).mpr _,
      refine ring_hom.is_integral_trans _ _ _ (is_integral_of_surjective _ quotient.mk_surjective),
      exact ring_hom.is_integral_of_surjective _ (fin_succ_equiv R n).symm.surjective } }
end

lemma comp_C_integral_of_surjective_of_jacobson {R : Type*} [integral_domain R] [is_jacobson R]
  {σ : Type*} [fintype σ] {S : Type*} [field S] (f : mv_polynomial σ R →+* S)
  (hf : function.surjective f) : (f.comp C).is_integral :=
begin
  haveI := classical.dec_eq σ,
  obtain ⟨e⟩ := fintype.trunc_equiv_fin σ,
  let f' : mv_polynomial (fin _) R →+* S :=
    f.comp (rename_equiv R e.symm).to_ring_equiv.to_ring_hom,
  have hf' : function.surjective f' :=
    ((function.surjective.comp hf (rename_equiv R e.symm).surjective)),
  have : (f'.comp C).is_integral,
  { haveI : (f'.ker).is_maximal := @comap_is_maximal_of_surjective _ _ _ _ f' ⊥ hf' bot_is_maximal,
    let g : f'.ker.quotient →+* S := ideal.quotient.lift f'.ker f' (λ _ h, h),
    have hfg : (g.comp (quotient.mk f'.ker)) = f' := ring_hom_ext (λ r, rfl) (λ i, rfl),
    rw [← hfg, ring_hom.comp_assoc],
    refine ring_hom.is_integral_trans _ g (quotient_mk_comp_C_is_integral_of_jacobson f'.ker)
      (g.is_integral_of_surjective _),
    rw ← hfg at hf',
    exact function.surjective.of_comp hf' },
  rw ring_hom.comp_assoc at this,
  convert this,
  refine ring_hom.ext (λ x, _),
  exact ((rename_equiv R e.symm).commutes' x).symm,
end

end mv_polynomial

end ideal


inductive mynat where
  | zero : mynat
  | succ : mynat → mynat
  deriving Repr

namespace mynat

def myofnat (n : Nat) :=
  match n with
  | 0 => mynat.zero
  | Nat.succ n' => mynat.succ (myofnat n')

instance : OfNat mynat n where
  ofNat := myofnat n

def toNat (n : mynat) :=
  match n with
  | mynat.zero => 0
  | mynat.succ n' => Nat.succ (toNat n')

instance : Coe mynat Nat where
  coe := toNat

theorem mynat_zero_eq_zero : mynat.zero = 0 := rfl
theorem one_eq_succ_zero : 1 = mynat.succ 0 := rfl

end mynat


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

! This file was ported from Lean 3 source module category_theory.linear.functor_category
! leanprover-community/mathlib commit 829895f162a1f29d0133f4b3538f4cd1fb5bffd3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Preadditive.FunctorCategory
import Mathlib.CategoryTheory.Linear.Basic

/-!
# Linear structure on functor categories

If `C` and `D` are categories and `D` is `R`-linear,
then `C ⥤ D` is also `R`-linear.

-/

open BigOperators

namespace CategoryTheory

open CategoryTheory.Limits Linear

variable {R : Type _} [Semiring R]

variable {C D : Type _} [Category C] [Category D] [Preadditive D] [Linear R D]

instance functorCategoryLinear : Linear R (C ⥤ D)
    where
  homModule F G :=
    { smul := fun r α =>
        { app := fun X => r • α.app X
          naturality := by
            intros
            rw [comp_smul, smul_comp, α.naturality] }
      one_smul := by
        intros
        ext
        apply one_smul
      zero_smul := by
        intros
        ext
        apply zero_smul
      smul_zero := by
        intros
        ext
        apply smul_zero
      add_smul := by
        intros
        ext
        apply add_smul
      smul_add := by
        intros
        ext
        apply smul_add
      mul_smul := by
        intros
        ext
        apply mul_smul }
  smul_comp := by
    intros
    ext
    apply smul_comp
  comp_smul := by
    intros
    ext
    apply comp_smul
#align category_theory.functor_category_linear CategoryTheory.functorCategoryLinear

namespace NatTrans

variable {F G : C ⥤ D}

/-- Application of a natural transformation at a fixed object,
as group homomorphism -/
@[simps]
def appLinearMap (X : C) : (F ⟶ G) →ₗ[R] F.obj X ⟶ G.obj X where
  toFun α := α.app X
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
#align category_theory.nat_trans.app_linear_map CategoryTheory.NatTrans.appLinearMap

@[simp]
theorem app_smul (X : C) (r : R) (α : F ⟶ G) : (r • α).app X = r • α.app X :=
  rfl
#align category_theory.nat_trans.app_smul CategoryTheory.NatTrans.app_smul

end NatTrans

end CategoryTheory


namespace exlean
namespace parser

/-
This is a translation into Lean of the `parsing` module described in the first edition of
"Programming in Haskell", by Graham Hutton, Chapter 8:
http://www.cs.nott.ac.uk/~pszgmh/Parsing.lhs
-/

inductive Parser (α : Type)
  | P : (string → option (α × string)) → Parser

open Parser

variables {α β : Type}

def parse : Parser α → string → option (α × string)
  | (P p) inp := p inp

def item : Parser char :=
  P (λ inp, match inp.data with
              | [] := none
              | (x::xs) := some (x, ⟨xs⟩)
            end )

instance : monad Parser :=
{ pure := λ α v, P (λ inp, some (v, inp)),
  bind := λ α β p f, P (λ inp,  match (parse p inp) with
                                  | none := none
                                  | some (v, out) := parse (f v) out
                                end ) }

-- `return` is a synonym for `pure`.
example : α → Parser α := return

-- `>>=` is notation for `bind`.
example (f : α → Parser β) (p : Parser α) : Parser β := p >>= f

/-
Some parsers:
-/

example : parse (return 1) "abc" = some (1, "abc") := rfl

example : parse item "" = none := rfl

example : parse item "abc" = some ('a', "bc") := rfl

def failure' : Parser α := P (λ _, none)

def return_first_and_third : Parser (char × char) :=
  do  x ← item,
      item,
      y ← item,
      return (x, y)

example : parse return_first_and_third "ribena" = some ( ('r', 'b'), "ena") := rfl

/-
Alternatives and failure.
-/
instance : alternative Parser :=
{ failure := λ α, P (λ _, none),
  orelse := λ α p q, P (λ inp,  match parse p inp with
                                  | none := parse q inp
                                  | some (v, out) := some (v, out)
                                end) }

-- We need to specifiy the type of `failure` in the example below. I've chosen `Parser unit`
-- for no special reason other than the fact that `failure` should convey no information.
example : parse (failure : Parser unit) "abc" = none := rfl

example : parse (item <|> return 'd') "abc" = some ('a', "bc") := rfl

example : parse (item <|> return 'd') "" = some ('d', "") := rfl

example : parse (failure : Parser unit) "abc" = none := rfl

example : parse ((failure <|> failure) : Parser unit) "abc" = none := rfl

/-
Derived primatives
-/
def sat (p : char → bool) : Parser char :=
  do  x ← item,
      if p x then return x else failure

def digit : Parser char := sat (λ c, to_bool c.is_digit)

def lower : Parser char := sat (λ c, to_bool c.is_lower)

def upper : Parser char := sat (λ c, to_bool c.is_upper)

def letter : Parser char := sat (λ c, to_bool c.is_alpha)

def alphanum : Parser char := sat (λ c, to_bool c.is_alphanum)

def is_space : Parser char := sat (λ c, to_bool c.is_whitespace)

def charp (x : char) : Parser char := sat (λ c, c = x)

example : parse digit "123" = some ('1', "23") := rfl

example : parse digit "abc" = none := rfl

example : parse (charp 'a') "abc" = some ('a', "bc") := rfl

example : parse (charp 'a') "123" = none := rfl

def list_char_parser : list char → Parser string
  | [] := return ""
  | (x::xs) := do charp x,
                  list_char_parser xs,
                  return ⟨x :: xs⟩

def stringp (s : string) : Parser string := list_char_parser (s.data)

example : parse (stringp "abc") "abcdef" = some ("abc", "def") := rfl

example : parse (stringp "abc") "ab1234" = none := rfl

/-
Repetition
-/

def once (p : Parser α) : Parser (list α) :=
  P (λ inp, match parse p inp with
              | none := none
              | some (v, out) := some ([v], out)
            end )

def one_or_zero (p : Parser α) : Parser (list α) :=
  P (λ inp, match parse p inp with
              | none := some ([], inp)
              | some (v, out) := some ([v], out)
            end )

example : parse (one_or_zero digit) "a123" = some ([], "a123") := rfl

example : parse (one_or_zero digit) "123" = some (['1'], "23") := rfl

/-
`n_or_less p n` succeeds if `n` or fewer applications of `p` succeed. Else it fails.
-/
def n_or_less (p : Parser α) : ℕ → Parser (list α)
  | 0 := return []
  | (n+1) := do x <- p,
                xs ← n_or_less n,
                return (x :: xs)

example : parse (n_or_less lower 600000) "gihanIIHAN" = none := rfl

example : parse (n_or_less lower 4) "gihanIIHAN" = some (['g', 'i', 'h', 'a'], "nIIHAN") := rfl

/-
`many p` does `p` repeatedly until failure. It always succeeds.
It's a `meta def` as it uses unbounded recursion.
The Lean parser module gets around this by using a natural number to store the position in the string.

Note: Graham Hutton used mutual recursion to define `many` and `many1`. I didn't choose this
approach as Lean 3 has limited support for mutual recursion.
-/
meta def many (p : Parser α) : Parser (list α) :=
  (do x ← p, xs ← many, return (x :: xs)) <|> return []

#eval parse (many digit) "754asdf"

#eval parse (many digit) "abc" -- succeeds and returns the empty list.

/-
`many1 p` is like `many` except that it will fail if `p` doesn't succeed at least once.
-/
meta def many1 (p : Parser α) : Parser (list α) :=
  (do x ← p, xs ← many p, return (x :: xs)) <|> failure

#eval parse (many1 digit) "754asdf"

#eval parse (many1 digit) "abc" -- fails

meta def identc : Parser (list char) :=
  do  x ← lower,
      xs ← many alphanum,
      return (x :: xs)

meta def ident : Parser string := do xs ← identc, return ⟨xs⟩

#eval parse ident "abc343[]!!" -- returns "abc343"

#eval parse ident "121abc343[]!!" -- fails

/-
`char_to_nat c` converts the character `c` to a corresponding `ℕ`.
As Lean functions are total, we choose to convert `c` to `0` if `c` is not a digit.
-/
def char_to_nat : char → ℕ
  | '0' := 0
  | '1' := 1
  | '2' := 2
  | '3' := 3
  | '4' := 4
  | '5' := 5
  | '6' := 6
  | '7' := 7
  | '8' := 8
  | '9' := 9
  | _ := 0

-- Converts a list of digits (in 'big-endian' order) into a natural number.
def list_nat_to_nat : list ℕ → ℕ
  | [] := 0
  | (x :: xs) := x + 10 * list_nat_to_nat xs

example : list_nat_to_nat [1,9,4] = 491 := rfl

def list_char_to_nat (xs : list char) : ℕ :=
  list_nat_to_nat (list.map char_to_nat (list.reverse xs))

example : list_char_to_nat ['1','2','3'] = 123 := rfl

-- Recall non-digit chars are converted to `0`:
example : list_char_to_nat ['1','p', '3'] = 103 := rfl

meta def natp : Parser ℕ :=
  do  xs ← many1 digit,
      return (list_char_to_nat xs)

#eval parse natp "4563bob" -- gets `4563` as a natural number

meta def intp : Parser ℤ :=
  (do  charp '-',
      n ← natp,
      return (-n))
  <|> do n ← natp, return n

#eval parse intp "132bob"

#eval parse intp "-123bob"

meta def space : Parser unit := do many is_space, return ()

#eval parse space " ▸  ¬ fish" -- consumes the whitespace, returning `star`.

meta def token (p : Parser α) : Parser α :=
  do  space,
      v ← p,
      space,
      return v

#eval parse (token natp) "    123" -- returns the natural number `123`

meta def identifier : Parser string := token ident

#eval parse identifier "   gill   sdfd"

meta def natural : Parser ℕ := token natp

#eval parse natural "   1232"

meta def symbol (xs : string) : Parser string := token (stringp xs)

#eval parse (symbol "hema") "   hema"

meta def test_parser1 : Parser (list ℕ) :=
  do  symbol "[",
      n ← natural,
      ns ← many (do symbol ",", natural),
      symbol "]",
      return (n :: ns)

#eval parse test_parser1 "  [1,2,  3 ] rubbish" -- returns `[1, 2, 3] : list ℕ`.

end parser
end exlean