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

! This file was ported from Lean 3 source module algebra.module.torsion
! leanprover-community/mathlib commit a50170a88a47570ed186b809ca754110590f9476
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.DirectSum.Module
import Mathbin.Algebra.Module.BigOperators
import Mathbin.LinearAlgebra.Isomorphisms
import Mathbin.GroupTheory.Torsion
import Mathbin.RingTheory.Coprime.Ideal
import Mathbin.RingTheory.Finiteness

/-!
# Torsion submodules

## Main definitions

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

## Main statements

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

## Notation

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

## Tags

Torsion, submodule, module, quotient
-/

namespace Ideal

section TorsionOf

variable (R M : Type _) [Semiring R] [AddCommMonoid M] [Module R M]

/-- The torsion ideal of `x`, containing all `a` such that `a • x = 0`.-/
@[simps]
def torsionOf (x : M) : Ideal R :=
  (LinearMap.toSpanSingleton R M x).ker
#align ideal.torsion_of Ideal.torsionOf

@[simp]
theorem torsionOf_zero : torsionOf R M (0 : M) = ⊤ := by simp [torsion_of]
#align ideal.torsion_of_zero Ideal.torsionOf_zero

variable {R M}

@[simp]
theorem mem_torsionOf_iff (x : M) (a : R) : a ∈ torsionOf R M x ↔ a • x = 0 :=
  Iff.rfl
#align ideal.mem_torsion_of_iff Ideal.mem_torsionOf_iff

variable (R)

@[simp]
theorem torsionOf_eq_top_iff (m : M) : torsionOf R M m = ⊤ ↔ m = 0 :=
  by
  refine' ⟨fun h => _, fun h => by simp [h]⟩
  rw [← one_smul R m, ← mem_torsion_of_iff m (1 : R), h]
  exact Submodule.mem_top
#align ideal.torsion_of_eq_top_iff Ideal.torsionOf_eq_top_iff

@[simp]
theorem torsionOf_eq_bot_iff_of_noZeroSMulDivisors [Nontrivial R] [NoZeroSMulDivisors R M] (m : M) :
    torsionOf R M m = ⊥ ↔ m ≠ 0 :=
  by
  refine' ⟨fun h contra => _, fun h => (Submodule.eq_bot_iff _).mpr fun r hr => _⟩
  · rw [contra, torsion_of_zero] at h
    exact bot_ne_top.symm h
  · rw [mem_torsion_of_iff, smul_eq_zero] at hr
    tauto
#align ideal.torsion_of_eq_bot_iff_of_no_zero_smul_divisors Ideal.torsionOf_eq_bot_iff_of_noZeroSMulDivisors

/-- See also `complete_lattice.independent.linear_independent` which provides the same conclusion
but requires the stronger hypothesis `no_zero_smul_divisors R M`. -/
theorem CompleteLattice.Independent.linear_independent' {ι R M : Type _} {v : ι → M} [Ring R]
    [AddCommGroup M] [Module R M] (hv : CompleteLattice.Independent fun i => R ∙ v i)
    (h_ne_zero : ∀ i, Ideal.torsionOf R M (v i) = ⊥) : LinearIndependent R v :=
  by
  refine' linear_independent_iff_not_smul_mem_span.mpr fun i r hi => _
  replace hv := complete_lattice.independent_def.mp hv i
  simp only [supᵢ_subtype', ← Submodule.span_range_eq_supᵢ, disjoint_iff] at hv
  have : r • v i ∈ ⊥ := by
    rw [← hv, Submodule.mem_inf]
    refine' ⟨submodule.mem_span_singleton.mpr ⟨r, rfl⟩, _⟩
    convert hi
    ext
    simp
  rw [← Submodule.mem_bot R, ← h_ne_zero i]
  simpa using this
#align ideal.complete_lattice.independent.linear_independent' Ideal.CompleteLattice.Independent.linear_independent'

end TorsionOf

section

variable (R M : Type _) [Ring R] [AddCommGroup M] [Module R M]

/-- The span of `x` in `M` is isomorphic to `R` quotiented by the torsion ideal of `x`.-/
noncomputable def quotTorsionOfEquivSpanSingleton (x : M) : (R ⧸ torsionOf R M x) ≃ₗ[R] R ∙ x :=
  (LinearMap.toSpanSingleton R M x).quotKerEquivRange.trans <|
    LinearEquiv.ofEq _ _ (LinearMap.span_singleton_eq_range R M x).symm
#align ideal.quot_torsion_of_equiv_span_singleton Ideal.quotTorsionOfEquivSpanSingleton

variable {R M}

@[simp]
theorem quotTorsionOfEquivSpanSingleton_apply_mk (x : M) (a : R) :
    quotTorsionOfEquivSpanSingleton R M x (Submodule.Quotient.mk a) =
      a • ⟨x, Submodule.mem_span_singleton_self x⟩ :=
  rfl
#align ideal.quot_torsion_of_equiv_span_singleton_apply_mk Ideal.quotTorsionOfEquivSpanSingleton_apply_mk

end

end Ideal

open nonZeroDivisors

section Defs

variable (R M : Type _) [CommSemiring R] [AddCommMonoid M] [Module R M]

namespace Submodule

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

/-- The submodule containing all elements `x` of `M` such that `a • x = 0` for all `a` in `s`. -/
@[simps]
def torsionBySet (s : Set R) : Submodule R M :=
  infₛ (torsionBy R M '' s)
#align submodule.torsion_by_set Submodule.torsionBySet

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

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

end Submodule

namespace Module

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

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

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

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

end Module

end Defs

variable {R M : Type _}

section

variable [CommSemiring R] [AddCommMonoid M] [Module R M] (s : Set R) (a : R)

namespace Submodule

@[simp]
theorem smul_torsionBy (x : torsionBy R M a) : a • x = 0 :=
  Subtype.ext x.Prop
#align submodule.smul_torsion_by Submodule.smul_torsionBy

@[simp]
theorem smul_coe_torsionBy (x : torsionBy R M a) : a • (x : M) = 0 :=
  x.Prop
#align submodule.smul_coe_torsion_by Submodule.smul_coe_torsionBy

@[simp]
theorem mem_torsionBy_iff (x : M) : x ∈ torsionBy R M a ↔ a • x = 0 :=
  Iff.rfl
#align submodule.mem_torsion_by_iff Submodule.mem_torsionBy_iff

@[simp]
theorem mem_torsionBySet_iff (x : M) : x ∈ torsionBySet R M s ↔ ∀ a : s, (a : R) • x = 0 :=
  by
  refine' ⟨fun h ⟨a, ha⟩ => mem_Inf.mp h _ (Set.mem_image_of_mem _ ha), fun h => mem_Inf.mpr _⟩
  rintro _ ⟨a, ha, rfl⟩; exact h ⟨a, ha⟩
#align submodule.mem_torsion_by_set_iff Submodule.mem_torsionBySet_iff

@[simp]
theorem torsionBy_singleton_eq : torsionBySet R M {a} = torsionBy R M a :=
  by
  ext x
  simp only [mem_torsion_by_set_iff, SetCoe.forall, Subtype.coe_mk, Set.mem_singleton_iff,
    forall_eq, mem_torsion_by_iff]
#align submodule.torsion_by_singleton_eq Submodule.torsionBy_singleton_eq

theorem torsionBySet_le_torsionBySet_of_subset {s t : Set R} (st : s ⊆ t) :
    torsionBySet R M t ≤ torsionBySet R M s :=
  infₛ_le_infₛ fun _ ⟨a, ha, h⟩ => ⟨a, st ha, h⟩
#align submodule.torsion_by_set_le_torsion_by_set_of_subset Submodule.torsionBySet_le_torsionBySet_of_subset

/-- Torsion by a set is torsion by the ideal generated by it. -/
theorem torsionBySet_eq_torsion_by_span : torsionBySet R M s = torsionBySet R M (Ideal.span s) :=
  by
  refine' le_antisymm (fun x hx => _) (torsion_by_set_le_torsion_by_set_of_subset subset_span)
  rw [mem_torsion_by_set_iff] at hx⊢
  suffices Ideal.span s ≤ Ideal.torsionOf R M x
    by
    rintro ⟨a, ha⟩
    exact this ha
  rw [Ideal.span_le]
  exact fun a ha => hx ⟨a, ha⟩
#align submodule.torsion_by_set_eq_torsion_by_span Submodule.torsionBySet_eq_torsion_by_span

theorem torsionBy_span_singleton_eq : torsionBySet R M (R ∙ a) = torsionBy R M a :=
  (torsionBySet_eq_torsion_by_span _).symm.trans <| torsionBy_singleton_eq _
#align submodule.torsion_by_span_singleton_eq Submodule.torsionBy_span_singleton_eq

theorem torsionBy_le_torsionBy_of_dvd (a b : R) (dvd : a ∣ b) : torsionBy R M a ≤ torsionBy R M b :=
  by
  rw [← torsion_by_span_singleton_eq, ← torsion_by_singleton_eq]
  apply torsion_by_set_le_torsion_by_set_of_subset
  rintro c (rfl : c = b); exact ideal.mem_span_singleton.mpr dvd
#align submodule.torsion_by_le_torsion_by_of_dvd Submodule.torsionBy_le_torsionBy_of_dvd

@[simp]
theorem torsionBy_one : torsionBy R M 1 = ⊥ :=
  eq_bot_iff.mpr fun _ h => by
    rw [mem_torsion_by_iff, one_smul] at h
    exact h
#align submodule.torsion_by_one Submodule.torsionBy_one

@[simp]
theorem torsion_by_univ : torsionBySet R M Set.univ = ⊥ :=
  by
  rw [eq_bot_iff, ← torsion_by_one, ← torsion_by_singleton_eq]
  exact torsion_by_set_le_torsion_by_set_of_subset fun _ _ => trivial
#align submodule.torsion_by_univ Submodule.torsion_by_univ

end Submodule

open Submodule

namespace Module

@[simp]
theorem isTorsionBy_singleton_iff : IsTorsionBySet R M {a} ↔ IsTorsionBy R M a :=
  by
  refine' ⟨fun h x => @h _ ⟨_, Set.mem_singleton _⟩, fun h x => _⟩
  rintro ⟨b, rfl : b = a⟩; exact @h _
#align module.is_torsion_by_singleton_iff Module.isTorsionBy_singleton_iff

theorem isTorsionBySet_iff_torsionBySet_eq_top :
    IsTorsionBySet R M s ↔ Submodule.torsionBySet R M s = ⊤ :=
  ⟨fun h => eq_top_iff.mpr fun _ _ => (mem_torsionBySet_iff _ _).mpr <| @h _, fun h x =>
    by
    rw [← mem_torsion_by_set_iff, h]
    trivial⟩
#align module.is_torsion_by_set_iff_torsion_by_set_eq_top Module.isTorsionBySet_iff_torsionBySet_eq_top

/-- A `a`-torsion module is a module whose `a`-torsion submodule is the full space. -/
theorem isTorsionBy_iff_torsionBy_eq_top : IsTorsionBy R M a ↔ torsionBy R M a = ⊤ := by
  rw [← torsion_by_singleton_eq, ← is_torsion_by_singleton_iff,
    is_torsion_by_set_iff_torsion_by_set_eq_top]
#align module.is_torsion_by_iff_torsion_by_eq_top Module.isTorsionBy_iff_torsionBy_eq_top

theorem isTorsionBySet_iff_is_torsion_by_span :
    IsTorsionBySet R M s ↔ IsTorsionBySet R M (Ideal.span s) := by
  rw [is_torsion_by_set_iff_torsion_by_set_eq_top, is_torsion_by_set_iff_torsion_by_set_eq_top,
    torsion_by_set_eq_torsion_by_span]
#align module.is_torsion_by_set_iff_is_torsion_by_span Module.isTorsionBySet_iff_is_torsion_by_span

theorem isTorsionBy_span_singleton_iff : IsTorsionBySet R M (R ∙ a) ↔ IsTorsionBy R M a :=
  (isTorsionBySet_iff_is_torsion_by_span _).symm.trans <| isTorsionBy_singleton_iff _
#align module.is_torsion_by_span_singleton_iff Module.isTorsionBy_span_singleton_iff

end Module

namespace Submodule

open Module

theorem torsionBySet_isTorsionBySet : IsTorsionBySet R (torsionBySet R M s) s := fun ⟨x, hx⟩ a =>
  Subtype.ext <| (mem_torsionBySet_iff _ _).mp hx a
#align submodule.torsion_by_set_is_torsion_by_set Submodule.torsionBySet_isTorsionBySet

/-- The `a`-torsion submodule is a `a`-torsion module. -/
theorem torsionBy_isTorsionBy : IsTorsionBy R (torsionBy R M a) a := fun _ => smul_torsionBy _ _
#align submodule.torsion_by_is_torsion_by Submodule.torsionBy_isTorsionBy

@[simp]
theorem torsionBy_torsionBy_eq_top : torsionBy R (torsionBy R M a) a = ⊤ :=
  (isTorsionBy_iff_torsionBy_eq_top a).mp <| torsionBy_isTorsionBy a
#align submodule.torsion_by_torsion_by_eq_top Submodule.torsionBy_torsionBy_eq_top

@[simp]
theorem torsionBySet_torsionBySet_eq_top : torsionBySet R (torsionBySet R M s) s = ⊤ :=
  (isTorsionBySet_iff_torsionBySet_eq_top s).mp <| torsionBySet_isTorsionBySet s
#align submodule.torsion_by_set_torsion_by_set_eq_top Submodule.torsionBySet_torsionBySet_eq_top

variable (R M)

theorem torsion_gc :
    @GaloisConnection (Submodule R M) (Ideal R)ᵒᵈ _ _ annihilator fun I =>
      torsionBySet R M <| I.ofDual :=
  fun A I =>
  ⟨fun h x hx => (mem_torsionBySet_iff _ _).mpr fun ⟨a, ha⟩ => mem_annihilator.mp (h ha) x hx,
    fun h a ha => mem_annihilator.mpr fun x hx => (mem_torsionBySet_iff _ _).mp (h hx) ⟨a, ha⟩⟩
#align submodule.torsion_gc Submodule.torsion_gc

variable {R M}

section Coprime

open BigOperators

variable {ι : Type _} {p : ι → Ideal R} {S : Finset ι}

variable (hp : (S : Set ι).Pairwise fun i j => p i ⊔ p j = ⊤)

include hp

theorem supᵢ_torsion_by_ideal_eq_torsion_by_infᵢ :
    (⨆ i ∈ S, torsionBySet R M <| p i) = torsionBySet R M ↑(⨅ i ∈ S, p i) :=
  by
  cases' S.eq_empty_or_nonempty with h h
  · rw [h]
    convert supᵢ_emptyset
    convert torsion_by_univ
    convert top_coe
    exact infᵢ_emptyset
  apply le_antisymm
  · apply supᵢ_le _
    intro i
    apply supᵢ_le _
    intro is
    apply torsion_by_set_le_torsion_by_set_of_subset
    exact (infᵢ_le (fun i => ⨅ H : i ∈ S, p i) i).trans (infᵢ_le _ is)
  · intro x hx
    rw [mem_supr_finset_iff_exists_sum]
    obtain ⟨μ, hμ⟩ :=
      (mem_supr_finset_iff_exists_sum _ _).mp
        ((Ideal.eq_top_iff_one _).mp <| (Ideal.supᵢ_infᵢ_eq_top_iff_pairwise h _).mpr hp)
    refine' ⟨fun i => ⟨(μ i : R) • x, _⟩, _⟩
    · rw [mem_torsion_by_set_iff] at hx⊢
      rintro ⟨a, ha⟩
      rw [smul_smul]
      suffices : a * μ i ∈ ⨅ i ∈ S, p i
      exact hx ⟨_, this⟩
      rw [mem_infi]
      intro j
      rw [mem_infi]
      intro hj
      by_cases ij : j = i
      · rw [ij]
        exact Ideal.mul_mem_right _ _ ha
      · have := coe_mem (μ i)
        simp only [mem_infi] at this
        exact Ideal.mul_mem_left _ _ (this j hj ij)
    · simp_rw [coe_mk]
      rw [← Finset.sum_smul, hμ, one_smul]
#align submodule.supr_torsion_by_ideal_eq_torsion_by_infi Submodule.supᵢ_torsion_by_ideal_eq_torsion_by_infᵢ

theorem supIndep_torsion_by_ideal : S.SupIndep fun i => torsionBySet R M <| p i :=
  fun T hT i hi hiT =>
  by
  rw [disjoint_iff, Finset.sup_eq_supᵢ,
    supr_torsion_by_ideal_eq_torsion_by_infi fun i hi j hj ij => hp (hT hi) (hT hj) ij]
  have :=
    @GaloisConnection.u_inf _ _ (OrderDual.toDual _) (OrderDual.toDual _) _ _ _ _ (torsion_gc R M)
  dsimp at this⊢
  rw [← this, Ideal.sup_infᵢ_eq_top, top_coe, torsion_by_univ]
  intro j hj; apply hp hi (hT hj); rintro rfl; exact hiT hj
#align submodule.sup_indep_torsion_by_ideal Submodule.supIndep_torsion_by_ideal

omit hp

variable {q : ι → R} (hq : (S : Set ι).Pairwise <| (IsCoprime on q))

include hq

theorem supᵢ_torsionBy_eq_torsionBy_prod :
    (⨆ i ∈ S, torsionBy R M <| q i) = torsionBy R M (∏ i in S, q i) :=
  by
  rw [← torsion_by_span_singleton_eq, Ideal.submodule_span_eq, ←
    Ideal.finset_inf_span_singleton _ _ hq, Finset.inf_eq_infᵢ, ←
    supr_torsion_by_ideal_eq_torsion_by_infi]
  · congr
    ext : 1
    congr
    ext : 1
    exact (torsion_by_span_singleton_eq _).symm
  · exact fun i hi j hj ij => (Ideal.sup_eq_top_iff_isCoprime _ _).mpr (hq hi hj ij)
#align submodule.supr_torsion_by_eq_torsion_by_prod Submodule.supᵢ_torsionBy_eq_torsionBy_prod

theorem supIndep_torsionBy : S.SupIndep fun i => torsionBy R M <| q i :=
  by
  convert sup_indep_torsion_by_ideal fun i hi j hj ij =>
      (Ideal.sup_eq_top_iff_isCoprime (q i) _).mpr <| hq hi hj ij
  ext : 1; exact (torsion_by_span_singleton_eq _).symm
#align submodule.sup_indep_torsion_by Submodule.supIndep_torsionBy

end Coprime

end Submodule

end

section NeedsGroup

variable [CommRing R] [AddCommGroup M] [Module R M]

namespace Submodule

open BigOperators

variable {ι : Type _} [DecidableEq ι] {S : Finset ι}

/-- If the `p i` are pairwise coprime, a `⨅ i, p i`-torsion module is the internal direct sum of
its `p i`-torsion submodules.-/
theorem torsionBySet_isInternal {p : ι → Ideal R}
    (hp : (S : Set ι).Pairwise fun i j => p i ⊔ p j = ⊤)
    (hM : Module.IsTorsionBySet R M (⨅ i ∈ S, p i : Ideal R)) :
    DirectSum.IsInternal fun i : S => torsionBySet R M <| p i :=
  DirectSum.isInternal_submodule_of_independent_of_supᵢ_eq_top
    (CompleteLattice.independent_iff_supIndep.mpr <| supIndep_torsion_by_ideal hp)
    ((supᵢ_subtype'' ↑S fun i => torsionBySet R M <| p i).trans <|
      (supᵢ_torsion_by_ideal_eq_torsion_by_infᵢ hp).trans <|
        (Module.isTorsionBySet_iff_torsionBySet_eq_top _).mp hM)
#align submodule.torsion_by_set_is_internal Submodule.torsionBySet_isInternal

/-- If the `q i` are pairwise coprime, a `∏ i, q i`-torsion module is the internal direct sum of
its `q i`-torsion submodules.-/
theorem torsionBy_isInternal {q : ι → R} (hq : (S : Set ι).Pairwise <| (IsCoprime on q))
    (hM : Module.IsTorsionBy R M <| ∏ i in S, q i) :
    DirectSum.IsInternal fun i : S => torsionBy R M <| q i :=
  by
  rw [← Module.isTorsionBy_span_singleton_iff, Ideal.submodule_span_eq, ←
    Ideal.finset_inf_span_singleton _ _ hq, Finset.inf_eq_infᵢ] at hM
  convert torsion_by_set_is_internal
      (fun i hi j hj ij => (Ideal.sup_eq_top_iff_isCoprime (q i) _).mpr <| hq hi hj ij) hM
  ext : 1; exact (torsion_by_span_singleton_eq _).symm
#align submodule.torsion_by_is_internal Submodule.torsionBy_isInternal

end Submodule

namespace Module

variable {I : Ideal R} (hM : IsTorsionBySet R M I)

include hM

/-- can't be an instance because hM can't be inferred -/
def IsTorsionBySet.hasSmul : SMul (R ⧸ I) M
    where smul b x :=
    Quotient.liftOn' b (· • x) fun b₁ b₂ h =>
      by
      show b₁ • x = b₂ • x
      have : (-b₁ + b₂) • x = 0 := @hM x ⟨_, quotient_add_group.left_rel_apply.mp h⟩
      rw [add_smul, neg_smul, neg_add_eq_zero] at this
      exact this
#align module.is_torsion_by_set.has_smul Module.IsTorsionBySet.hasSmul

@[simp]
theorem IsTorsionBySet.mk_smul (b : R) (x : M) :
    haveI := hM.has_smul
    Ideal.Quotient.mk I b • x = b • x :=
  rfl
#align module.is_torsion_by_set.mk_smul Module.IsTorsionBySet.mk_smul

/-- A `(R ⧸ I)`-module is a `R`-module which `is_torsion_by_set R M I`. -/
def IsTorsionBySet.module : Module (R ⧸ I) M :=
  @Function.Surjective.moduleLeft _ _ _ _ _ _ _ hM.SMul _ Ideal.Quotient.mk_surjective
    (IsTorsionBySet.mk_smul hM)
#align module.is_torsion_by_set.module Module.IsTorsionBySet.module

instance IsTorsionBySet.isScalarTower {S : Type _} [SMul S R] [SMul S M] [IsScalarTower S R M]
    [IsScalarTower S R R] : @IsScalarTower S (R ⧸ I) M _ (IsTorsionBySet.module hM).toSMul _
    where smul_assoc b d x := Quotient.inductionOn' d fun c => (smul_assoc b c x : _)
#align module.is_torsion_by_set.is_scalar_tower Module.IsTorsionBySet.isScalarTower

omit hM

instance : Module (R ⧸ I) (M ⧸ I • (⊤ : Submodule R M)) :=
  IsTorsionBySet.module fun x r =>
    by
    induction x using Quotient.inductionOn
    refine' (Submodule.Quotient.mk_eq_zero _).mpr (Submodule.smul_mem_smul r.prop _)
    trivial

end Module

namespace Submodule

instance (I : Ideal R) : Module (R ⧸ I) (torsionBySet R M I) :=
  Module.IsTorsionBySet.module <| torsionBySet_isTorsionBySet I

@[simp]
theorem torsionBySet.mk_smul (I : Ideal R) (b : R) (x : torsionBySet R M I) :
    Ideal.Quotient.mk I b • x = b • x :=
  rfl
#align submodule.torsion_by_set.mk_smul Submodule.torsionBySet.mk_smul

instance (I : Ideal R) {S : Type _} [SMul S R] [SMul S M] [IsScalarTower S R M]
    [IsScalarTower S R R] : IsScalarTower S (R ⧸ I) (torsionBySet R M I) :=
  inferInstance

/-- The `a`-torsion submodule as a `(R ⧸ R∙a)`-module. -/
instance (a : R) : Module (R ⧸ R ∙ a) (torsionBy R M a) :=
  Module.IsTorsionBySet.module <|
    (Module.isTorsionBy_span_singleton_iff a).mpr <| torsionBy_isTorsionBy a

@[simp]
theorem torsionBy.mk_smul (a b : R) (x : torsionBy R M a) :
    Ideal.Quotient.mk (R ∙ a) b • x = b • x :=
  rfl
#align submodule.torsion_by.mk_smul Submodule.torsionBy.mk_smul

instance (a : R) {S : Type _} [SMul S R] [SMul S M] [IsScalarTower S R M] [IsScalarTower S R R] :
    IsScalarTower S (R ⧸ R ∙ a) (torsionBy R M a) :=
  inferInstance

end Submodule

end NeedsGroup

namespace Submodule

section Torsion'

open Module

variable [CommSemiring R] [AddCommMonoid M] [Module R M]

variable (S : Type _) [CommMonoid S] [DistribMulAction S M] [SMulCommClass S R M]

@[simp]
theorem mem_torsion'_iff (x : M) : x ∈ torsion' R M S ↔ ∃ a : S, a • x = 0 :=
  Iff.rfl
#align submodule.mem_torsion'_iff Submodule.mem_torsion'_iff

@[simp]
theorem mem_torsion_iff (x : M) : x ∈ torsion R M ↔ ∃ a : R⁰, a • x = 0 :=
  Iff.rfl
#align submodule.mem_torsion_iff Submodule.mem_torsion_iff

@[simps]
instance : SMul S (torsion' R M S) :=
  ⟨fun s x =>
    ⟨s • x, by
      obtain ⟨x, a, h⟩ := x
      use a
      dsimp
      rw [smul_comm, h, smul_zero]⟩⟩

instance : DistribMulAction S (torsion' R M S) :=
  Subtype.coe_injective.DistribMulAction (torsion' R M S).Subtype.toAddMonoidHom fun (c : S) x =>
    rfl

instance : SMulCommClass S R (torsion' R M S) :=
  ⟨fun s a x => Subtype.ext <| smul_comm _ _ _⟩

/-- A `S`-torsion module is a module whose `S`-torsion submodule is the full space. -/
theorem isTorsion'_iff_torsion'_eq_top : IsTorsion' M S ↔ torsion' R M S = ⊤ :=
  ⟨fun h => eq_top_iff.mpr fun _ _ => @h _, fun h x =>
    by
    rw [← @mem_torsion'_iff R, h]
    trivial⟩
#align submodule.is_torsion'_iff_torsion'_eq_top Submodule.isTorsion'_iff_torsion'_eq_top

/-- The `S`-torsion submodule is a `S`-torsion module. -/
theorem torsion'_isTorsion' : IsTorsion' (torsion' R M S) S := fun ⟨x, ⟨a, h⟩⟩ => ⟨a, Subtype.ext h⟩
#align submodule.torsion'_is_torsion' Submodule.torsion'_isTorsion'

@[simp]
theorem torsion'_torsion'_eq_top : torsion' R (torsion' R M S) S = ⊤ :=
  (isTorsion'_iff_torsion'_eq_top S).mp <| torsion'_isTorsion' S
#align submodule.torsion'_torsion'_eq_top Submodule.torsion'_torsion'_eq_top

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

/-- The torsion submodule is always a torsion module. -/
theorem torsion_isTorsion : Module.IsTorsion R (torsion R M) :=
  torsion'_isTorsion' R⁰
#align submodule.torsion_is_torsion Submodule.torsion_isTorsion

end Torsion'

section Torsion

variable [CommSemiring R] [AddCommMonoid M] [Module R M]

open BigOperators

theorem isTorsion_by_ideal_of_finite_of_isTorsion [Module.Finite R M] (hM : Module.IsTorsion R M) :
    ∃ I : Ideal R, (I : Set R) ∩ R⁰ ≠ ∅ ∧ Module.IsTorsionBySet R M I :=
  by
  cases' (module.finite_def.mp inferInstance : (⊤ : Submodule R M).Fg) with S h
  refine' ⟨∏ x in S, Ideal.torsionOf R M x, _, _⟩
  · refine' Set.Nonempty.ne_empty ⟨_, _, (∏ x in S, (@hM x).some : R⁰).2⟩
    rw [Subtype.val_eq_coe, Submonoid.coe_finset_prod]
    apply Ideal.prod_mem_prod
    exact fun x _ => (@hM x).choose_spec
  · rw [Module.isTorsionBySet_iff_torsionBySet_eq_top, eq_top_iff, ← h, span_le]
    intro x hx
    apply torsion_by_set_le_torsion_by_set_of_subset
    · apply Ideal.le_of_dvd
      exact Finset.dvd_prod_of_mem _ hx
    · rw [mem_torsion_by_set_iff]
      rintro ⟨a, ha⟩
      exact ha
#align submodule.is_torsion_by_ideal_of_finite_of_is_torsion Submodule.isTorsion_by_ideal_of_finite_of_isTorsion

variable [NoZeroDivisors R] [Nontrivial R]

theorem coe_torsion_eq_annihilator_ne_bot :
    (torsion R M : Set M) = { x : M | (R ∙ x).annihilator ≠ ⊥ } :=
  by
  ext x; simp_rw [Submodule.ne_bot_iff, mem_annihilator, mem_span_singleton]
  exact
    ⟨fun ⟨a, hax⟩ =>
      ⟨a, fun _ ⟨b, hb⟩ => by rw [← hb, smul_comm, ← Submonoid.smul_def, hax, smul_zero],
        nonZeroDivisors.coe_ne_zero _⟩,
      fun ⟨a, hax, ha⟩ => ⟨⟨_, mem_nonZeroDivisors_of_ne_zero ha⟩, hax x ⟨1, one_smul _ _⟩⟩⟩
#align submodule.coe_torsion_eq_annihilator_ne_bot Submodule.coe_torsion_eq_annihilator_ne_bot

/-- A module over a domain has `no_zero_smul_divisors` iff its torsion submodule is trivial. -/
theorem noZeroSMulDivisors_iff_torsion_eq_bot : NoZeroSMulDivisors R M ↔ torsion R M = ⊥ :=
  by
  constructor <;> intro h
  · haveI : NoZeroSMulDivisors R M := h
    rw [eq_bot_iff]
    rintro x ⟨a, hax⟩
    change (a : R) • x = 0 at hax
    cases' eq_zero_or_eq_zero_of_smul_eq_zero hax with h0 h0
    · exfalso
      exact nonZeroDivisors.coe_ne_zero a h0
    · exact h0
  ·
    exact
      {
        eq_zero_or_eq_zero_of_smul_eq_zero := fun a x hax =>
          by
          by_cases ha : a = 0
          · left
            exact ha
          · right
            rw [← mem_bot _, ← h]
            exact ⟨⟨a, mem_nonZeroDivisors_of_ne_zero ha⟩, hax⟩ }
#align submodule.no_zero_smul_divisors_iff_torsion_eq_bot Submodule.noZeroSMulDivisors_iff_torsion_eq_bot

end Torsion

namespace QuotientTorsion

variable [CommRing R] [AddCommGroup M] [Module R M]

/-- Quotienting by the torsion submodule gives a torsion-free module. -/
@[simp]
theorem torsion_eq_bot : torsion R (M ⧸ torsion R M) = ⊥ :=
  eq_bot_iff.mpr fun z =>
    Quotient.inductionOn' z fun x ⟨a, hax⟩ =>
      by
      rw [Quotient.mk''_eq_mk', ← quotient.mk_smul, quotient.mk_eq_zero] at hax
      rw [mem_bot, Quotient.mk''_eq_mk', quotient.mk_eq_zero]
      cases' hax with b h
      exact ⟨b * a, (mul_smul _ _ _).trans h⟩
#align submodule.quotient_torsion.torsion_eq_bot Submodule.QuotientTorsion.torsion_eq_bot

instance noZeroSMulDivisors [IsDomain R] : NoZeroSMulDivisors R (M ⧸ torsion R M) :=
  noZeroSMulDivisors_iff_torsion_eq_bot.mpr torsion_eq_bot
#align submodule.quotient_torsion.no_zero_smul_divisors Submodule.QuotientTorsion.noZeroSMulDivisors

end QuotientTorsion

section PTorsion

open Module

section

variable [Monoid R] [AddCommMonoid M] [DistribMulAction R M]

theorem isTorsion'_powers_iff (p : R) :
    IsTorsion' M (Submonoid.powers p) ↔ ∀ x : M, ∃ n : ℕ, p ^ n • x = 0 :=
  ⟨fun h x =>
    let ⟨⟨a, ⟨n, rfl⟩⟩, hx⟩ := @h x
    ⟨n, hx⟩,
    fun h x =>
    let ⟨n, hn⟩ := h x
    ⟨⟨_, ⟨n, rfl⟩⟩, hn⟩⟩
#align submodule.is_torsion'_powers_iff Submodule.isTorsion'_powers_iff

/-- In a `p ^ ∞`-torsion module (that is, a module where all elements are cancelled by scalar
multiplication by some power of `p`), the smallest `n` such that `p ^ n • x = 0`.-/
def pOrder {p : R} (hM : IsTorsion' M <| Submonoid.powers p) (x : M)
    [∀ n : ℕ, Decidable (p ^ n • x = 0)] :=
  Nat.find <| (isTorsion'_powers_iff p).mp hM x
#align submodule.p_order Submodule.pOrder

@[simp]
theorem pow_pOrder_smul {p : R} (hM : IsTorsion' M <| Submonoid.powers p) (x : M)
    [∀ n : ℕ, Decidable (p ^ n • x = 0)] : p ^ pOrder hM x • x = 0 :=
  Nat.find_spec <| (isTorsion'_powers_iff p).mp hM x
#align submodule.pow_p_order_smul Submodule.pow_pOrder_smul

end

variable [CommSemiring R] [AddCommMonoid M] [Module R M] [∀ x : M, Decidable (x = 0)]

theorem exists_isTorsionBy {p : R} (hM : IsTorsion' M <| Submonoid.powers p) (d : ℕ) (hd : d ≠ 0)
    (s : Fin d → M) (hs : span R (Set.range s) = ⊤) :
    ∃ j : Fin d, Module.IsTorsionBy R M (p ^ pOrder hM (s j)) :=
  by
  let oj := List.argmax (fun i => p_order hM <| s i) (List.finRange d)
  have hoj : oj.is_some :=
    option.ne_none_iff_is_some.mp fun eq_none =>
      hd <| list.fin_range_eq_nil.mp <| list.argmax_eq_none.mp eq_none
  use Option.get hoj
  rw [is_torsion_by_iff_torsion_by_eq_top, eq_top_iff, ← hs, Submodule.span_le,
    Set.range_subset_iff]
  intro i; change _ • _ = _
  have : p_order hM (s i) ≤ p_order hM (s <| Option.get hoj) :=
    List.le_of_mem_argmax (List.mem_finRange i) (Option.get_mem hoj)
  rw [← Nat.sub_add_cancel this, pow_add, mul_smul, pow_p_order_smul, smul_zero]
#align submodule.exists_is_torsion_by Submodule.exists_isTorsionBy

end PTorsion

end Submodule

namespace Ideal.Quotient

open Submodule

theorem torsionBy_eq_span_singleton {R : Type _} [CommRing R] (a b : R) (ha : a ∈ R⁰) :
    torsionBy R (R ⧸ R ∙ a * b) a = R ∙ mk _ b :=
  by
  ext x; rw [mem_torsion_by_iff, mem_span_singleton]
  obtain ⟨x, rfl⟩ := mk_surjective x; constructor <;> intro h
  · rw [← mk_eq_mk, ← quotient.mk_smul, quotient.mk_eq_zero, mem_span_singleton] at h
    obtain ⟨c, h⟩ := h
    rw [smul_eq_mul, smul_eq_mul, mul_comm, mul_assoc, mul_cancel_left_mem_nonZeroDivisors ha,
      mul_comm] at h
    use c
    rw [← h, ← mk_eq_mk, ← quotient.mk_smul, smul_eq_mul, mk_eq_mk]
  · obtain ⟨c, h⟩ := h
    rw [← h, smul_comm, ← mk_eq_mk, ← quotient.mk_smul,
      (quotient.mk_eq_zero _).mpr <| mem_span_singleton_self _, smul_zero]
#align ideal.quotient.torsion_by_eq_span_singleton Ideal.Quotient.torsionBy_eq_span_singleton

end Ideal.Quotient

namespace AddMonoid

theorem isTorsion_iff_isTorsion_nat [AddCommMonoid M] :
    AddMonoid.IsTorsion M ↔ Module.IsTorsion ℕ M :=
  by
  refine' ⟨fun h x => _, fun h x => _⟩
  · obtain ⟨n, h0, hn⟩ := (isOfFinAddOrder_iff_nsmul_eq_zero x).mp (h x)
    exact ⟨⟨n, mem_nonZeroDivisors_of_ne_zero <| ne_of_gt h0⟩, hn⟩
  · rw [isOfFinAddOrder_iff_nsmul_eq_zero]
    obtain ⟨n, hn⟩ := @h x
    refine' ⟨n, Nat.pos_of_ne_zero (nonZeroDivisors.coe_ne_zero _), hn⟩
#align add_monoid.is_torsion_iff_is_torsion_nat AddMonoid.isTorsion_iff_isTorsion_nat

theorem isTorsion_iff_isTorsion_int [AddCommGroup M] :
    AddMonoid.IsTorsion M ↔ Module.IsTorsion ℤ M :=
  by
  refine' ⟨fun h x => _, fun h x => _⟩
  · obtain ⟨n, h0, hn⟩ := (isOfFinAddOrder_iff_nsmul_eq_zero x).mp (h x)
    exact
      ⟨⟨n, mem_nonZeroDivisors_of_ne_zero <| ne_of_gt <| int.coe_nat_pos.mpr h0⟩,
        (coe_nat_zsmul _ _).trans hn⟩
  · rw [isOfFinAddOrder_iff_nsmul_eq_zero]
    obtain ⟨n, hn⟩ := @h x
    exact exists_nsmul_eq_zero_of_zsmul_eq_zero (nonZeroDivisors.coe_ne_zero n) hn
#align add_monoid.is_torsion_iff_is_torsion_int AddMonoid.isTorsion_iff_isTorsion_int

end AddMonoid


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import analysis.convex.function
import topology.algebra.affine
import topology.local_extr
import topology.metric_space.basic

/-!
# Minima and maxima of convex functions

We show that if a function `f : E → β` is convex, then a local minimum is also
a global minimum, and likewise for concave functions.
-/

variables {E β : Type*} [add_comm_group E] [topological_space E]
  [module ℝ E] [topological_add_group E] [has_continuous_smul ℝ E]
  [linear_ordered_add_comm_group β] [module ℝ β] [ordered_smul ℝ β]
  {s : set E}

open set filter
open_locale classical

/--
Helper lemma for the more general case: `is_min_on.of_is_local_min_on_of_convex_on`.
-/
lemma is_min_on.of_is_local_min_on_of_convex_on_Icc {f : ℝ → β} {a b : ℝ} (a_lt_b : a < b)
  (h_local_min : is_local_min_on f (Icc a b) a) (h_conv : convex_on ℝ (Icc a b) f) :
  ∀ x ∈ Icc a b, f a ≤ f x :=
begin
  by_contra' H_cont,
  rcases H_cont with ⟨x, ⟨h_ax, h_xb⟩, fx_lt_fa⟩,
  obtain ⟨z, hz, ge_on_nhd⟩ : ∃ z > a, ∀ y ∈ (Icc a z), f y ≥ f a,
  { rcases eventually_iff_exists_mem.mp h_local_min with ⟨U, U_in_nhds_within, fy_ge_fa⟩,
    rw [nhds_within_Icc_eq_nhds_within_Ici a_lt_b, mem_nhds_within_Ici_iff_exists_Icc_subset]
        at U_in_nhds_within,
    rcases U_in_nhds_within with ⟨ε, ε_in_Ioi, Ioc_in_U⟩,
    exact ⟨ε, mem_Ioi.mp ε_in_Ioi, λ y y_in_Ioc, fy_ge_fa y $ Ioc_in_U y_in_Ioc⟩ },
  have a_lt_x : a < x := lt_of_le_of_ne h_ax (λ H, by subst H; exact lt_irrefl (f a) fx_lt_fa),
  have lt_on_nhd : ∀ y ∈ Ioc a x, f y < f a,
  { intros y y_in_Ioc,
    rcases (convex.mem_Ioc a_lt_x).mp y_in_Ioc with ⟨ya, yx, ya_pos, yx_pos, yax, y_combo⟩,
    calc
      f y = f (ya * a + yx * x)       : by rw [y_combo]
      ... ≤ ya • f a + yx • f x
                : h_conv.2 (left_mem_Icc.mpr (le_of_lt a_lt_b)) ⟨h_ax, h_xb⟩ (ya_pos)
                    (le_of_lt yx_pos) yax
      ... < ya • f a + yx • f a       : add_lt_add_left (smul_lt_smul_of_pos fx_lt_fa yx_pos) _
      ... = f a                       : by rw [←add_smul, yax, one_smul] },
  by_cases h_xz : x ≤ z,
  { exact not_lt_of_ge (ge_on_nhd x (show x ∈ Icc a z, by exact ⟨h_ax, h_xz⟩)) fx_lt_fa, },
  { have h₁ : z ∈ Ioc a x := ⟨hz, le_of_not_ge h_xz⟩,
    have h₂ : z ∈ Icc a z := ⟨le_of_lt hz, le_refl z⟩,
    exact not_lt_of_ge (ge_on_nhd z h₂) (lt_on_nhd z h₁) }
end

/--
A local minimum of a convex function is a global minimum, restricted to a set `s`.
-/
lemma is_min_on.of_is_local_min_on_of_convex_on {f : E → β} {a : E}
  (a_in_s : a ∈ s) (h_localmin : is_local_min_on f s a) (h_conv : convex_on ℝ s f) :
  ∀ x ∈ s, f a ≤ f x :=
begin
  by_contra' H_cont,
  rcases H_cont with ⟨x, ⟨x_in_s, fx_lt_fa⟩⟩,
  let g : ℝ →ᵃ[ℝ] E := affine_map.line_map a x,
  have hg0 : g 0 = a := affine_map.line_map_apply_zero a x,
  have hg1 : g 1 = x := affine_map.line_map_apply_one a x,
  have fg_local_min_on : is_local_min_on (f ∘ g) (g ⁻¹' s) 0,
  { rw ←hg0 at h_localmin,
    refine is_local_min_on.comp_continuous_on h_localmin subset.rfl
      (continuous.continuous_on (affine_map.line_map_continuous)) _,
    simp [mem_preimage, hg0, a_in_s] },
  have fg_min_on : ∀ x ∈ (Icc 0 1 : set ℝ), (f ∘ g) 0 ≤ (f ∘ g) x,
  { have Icc_in_s' : Icc 0 1 ⊆ (g ⁻¹' s),
    { have h0 : (0 : ℝ) ∈ (g ⁻¹' s) := by simp [mem_preimage, a_in_s],
      have h1 : (1 : ℝ) ∈ (g ⁻¹' s) := by simp [mem_preimage, hg1, x_in_s],
      rw ←segment_eq_Icc (show (0 : ℝ) ≤ 1, by linarith),
      exact (convex.affine_preimage g h_conv.1).segment_subset
        (by simp [mem_preimage, hg0, a_in_s]) (by simp [mem_preimage, hg1, x_in_s]) },
    have fg_local_min_on' : is_local_min_on (f ∘ g) (Icc 0 1) 0 :=
      is_local_min_on.on_subset fg_local_min_on Icc_in_s',
    refine is_min_on.of_is_local_min_on_of_convex_on_Icc (by linarith) fg_local_min_on' _,
    exact (convex_on.comp_affine_map g h_conv).subset Icc_in_s' (convex_Icc 0 1) },
  have gx_lt_ga : (f ∘ g) 1 < (f ∘ g) 0 := by simp [hg1, fx_lt_fa, hg0],
  exact not_lt_of_ge (fg_min_on 1 (mem_Icc.mpr ⟨zero_le_one, le_refl 1⟩)) gx_lt_ga,
end

/-- A local maximum of a concave function is a global maximum, restricted to a set `s`. -/
lemma is_max_on.of_is_local_max_on_of_concave_on {f : E → β} {a : E}
  (a_in_s : a ∈ s) (h_localmax: is_local_max_on f s a) (h_conc : concave_on ℝ s f) :
  ∀ x ∈ s, f x ≤ f a :=
@is_min_on.of_is_local_min_on_of_convex_on
  _ (order_dual β) _ _ _ _ _ _ _ _ s f a a_in_s h_localmax h_conc

/-- A local minimum of a convex function is a global minimum. -/
lemma is_min_on.of_is_local_min_of_convex_univ {f : E → β} {a : E}
  (h_local_min : is_local_min f a) (h_conv : convex_on ℝ univ f) : ∀ x, f a ≤ f x :=
λ x, (is_min_on.of_is_local_min_on_of_convex_on (mem_univ a)
        (is_local_min.on h_local_min univ) h_conv) x (mem_univ x)

/-- A local maximum of a concave function is a global maximum. -/
lemma is_max_on.of_is_local_max_of_convex_univ {f : E → β} {a : E}
  (h_local_max : is_local_max f a) (h_conc : concave_on ℝ univ f) : ∀ x, f x ≤ f a :=
@is_min_on.of_is_local_min_of_convex_univ _ (order_dual β) _ _ _ _ _ _ _ _ f a h_local_max h_conc


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yaël Dillies
-/
import data.set.pointwise
import order.filter.n_ary
import order.filter.ultrafilter

/-!
# Pointwise operations on filters

This file defines pointwise operations on filters. This is useful because usual algebraic operations
distribute over pointwise operations. For example,
* `(f₁ * f₂).map m  = f₁.map m * f₂.map m`
* `𝓝 (x * y) = 𝓝 x * 𝓝 y`

## Main declarations

* `0` (`filter.has_zero`): Pure filter at `0 : α`, or alternatively principal filter at `0 : set α`.
* `1` (`filter.has_one`): Pure filter at `1 : α`, or alternatively principal filter at `1 : set α`.
* `f + g` (`filter.has_add`): Addition, filter generated by all `s + t` where `s ∈ f` and `t ∈ g`.
* `f * g` (`filter.has_mul`): Multiplication, filter generated by all `s * t` where `s ∈ f` and
  `t ∈ g`.
* `-f` (`filter.has_neg`): Negation, filter of all `-s` where `s ∈ f`.
* `f⁻¹` (`filter.has_inv`): Inversion, filter of all `s⁻¹` where `s ∈ f`.
* `f - g` (`filter.has_sub`): Subtraction, filter generated by all `s - t` where `s ∈ f` and
  `t ∈ g`.
* `f / g` (`filter.has_div`): Division, filter generated by all `s / t` where `s ∈ f` and `t ∈ g`.
* `f +ᵥ g` (`filter.has_vadd`): Scalar addition, filter generated by all `s +ᵥ t` where `s ∈ f` and
  `t ∈ g`.
* `f -ᵥ g` (`filter.has_vsub`): Scalar subtraction, filter generated by all `s -ᵥ t` where `s ∈ f`
  and `t ∈ g`.
* `f • g` (`filter.has_scalar`): Scalar multiplication, filter generated by all `s • t` where
  `s ∈ f` and `t ∈ g`.
* `a +ᵥ f` (`filter.has_vadd_filter`): Translation, filter of all `a +ᵥ s` where `s ∈ f`.
* `a • f` (`filter.has_scalar_filter`): Scaling, filter of all `a • s` where `s ∈ f`.

For `α` a semigroup/monoid, `filter α` is a semigroup/monoid.
As an unfortunate side effect, this means that `n • f`, where `n : ℕ`, is ambiguous between
pointwise scaling and repeated pointwise addition. See note [pointwise nat action].

## Implementation notes

We put all instances in the locale `pointwise`, so that these instances are not available by
default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
since we expect the locale to be open whenever the instances are actually used (and making the
instances reducible changes the behavior of `simp`.

## Tags

filter multiplication, filter addition, pointwise addition, pointwise multiplication,
-/

open function set
open_locale filter pointwise

variables {F α β γ δ ε : Type*}

namespace filter

/-! ### `0`/`1` as filters -/

section has_one
variables [has_one α] {f : filter α} {s : set α}

/-- `1 : filter α` is defined as the filter of sets containing `1 : α` in locale `pointwise`. -/
@[to_additive "`0 : filter α` is defined as the filter of sets containing `0 : α` in locale
`pointwise`."]
protected def has_one : has_one (filter α) := ⟨pure 1⟩

localized "attribute [instance] filter.has_one filter.has_zero" in pointwise

@[simp, to_additive] lemma mem_one : s ∈ (1 : filter α) ↔ (1 : α) ∈ s := mem_pure
@[to_additive] lemma one_mem_one : (1 : set α) ∈ (1 : filter α) := mem_pure.2 one_mem_one
@[simp, to_additive] lemma pure_one : pure 1 = (1 : filter α) := rfl
@[simp, to_additive] lemma principal_one : 𝓟 1 = (1 : filter α) := principal_singleton _
@[to_additive] lemma one_ne_bot : (1 : filter α).ne_bot := filter.pure_ne_bot
@[simp, to_additive] protected lemma map_one' (f : α → β) : (1 : filter α).map f = pure (f 1) := rfl
@[simp, to_additive] lemma le_one_iff : f ≤ 1 ↔ (1 : set α) ∈ f := le_pure_iff
@[to_additive] protected lemma ne_bot.le_one_iff (h : f.ne_bot) : f ≤ 1 ↔ f = 1 := h.le_pure_iff
@[simp, to_additive] lemma eventually_one {p : α → Prop} : (∀ᶠ x in 1, p x) ↔ p 1 := eventually_pure
@[simp, to_additive] lemma tendsto_one {a : filter β} {f : β → α} :
   tendsto f a 1 ↔ ∀ᶠ x in a, f x = 1 :=
tendsto_pure

/-- `pure` as a `one_hom`. -/
@[to_additive "`pure` as a `zero_hom`."]
def pure_one_hom : one_hom α (filter α) := ⟨pure, pure_one⟩

@[simp, to_additive]

variables [has_one β]

@[simp, to_additive]
protected lemma map_one [one_hom_class F α β] (φ : F) : map φ 1 = 1 :=
by rw [filter.map_one', map_one, pure_one]

end has_one

/-! ### Filter negation/inversion -/

section has_inv
variables [has_inv α] {f g : filter α} {s : set α} {a : α}

/-- The inverse of a filter is the pointwise preimage under `⁻¹` of its sets. -/
@[to_additive "The negation of a filter is the pointwise preimage under `-` of its sets."]
instance : has_inv (filter α) := ⟨map has_inv.inv⟩

@[simp, to_additive] protected lemma map_inv : f.map has_inv.inv = f⁻¹ := rfl
@[to_additive] lemma mem_inv : s ∈ f⁻¹ ↔ has_inv.inv ⁻¹' s ∈ f := iff.rfl
@[to_additive] protected lemma inv_le_inv (hf : f ≤ g) : f⁻¹ ≤ g⁻¹ := map_mono hf
@[simp, to_additive] lemma inv_pure : (pure a : filter α)⁻¹ = pure a⁻¹ := rfl
@[simp, to_additive] lemma inv_eq_bot_iff : f⁻¹ = ⊥ ↔ f = ⊥  := map_eq_bot_iff
@[simp, to_additive] lemma ne_bot_inv_iff : f⁻¹.ne_bot ↔ ne_bot f := map_ne_bot_iff _
@[to_additive] lemma ne_bot.inv : f.ne_bot → f⁻¹.ne_bot := λ h, h.map _

end has_inv

section has_involutive_inv
variables [has_involutive_inv α] {f : filter α} {s : set α}

@[to_additive] lemma inv_mem_inv (hs : s ∈ f) : s⁻¹ ∈ f⁻¹ := by rwa [mem_inv, inv_preimage, inv_inv]

/-- Inversion is involutive on `filter α` if it is on `α`. -/
@[to_additive "Negation is involutive on `filter α` if it is on `α`."]
protected def has_involutive_inv : has_involutive_inv (filter α) :=
{ inv_inv := λ f, map_map.trans $ by rw [inv_involutive.comp_self, map_id],
  ..filter.has_inv }

end has_involutive_inv

/-! ### Filter addition/multiplication -/

section has_mul
variables [has_mul α] [has_mul β] {f f₁ f₂ g g₁ g₂ h : filter α} {s t : set α} {a b : α}

/-- The filter `f * g` is generated by `{s * t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
@[to_additive "The filter `f + g` is generated by `{s + t | s ∈ f, t ∈ g}` in locale `pointwise`."]
protected def has_mul : has_mul (filter α) :=
/- This is defeq to `map₂ (*) f g`, but the hypothesis unfolds to `t₁ * t₂ ⊆ s` rather than all the
way to `set.image2 (*) t₁ t₂ ⊆ s`. -/
⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ * t₂ ⊆ s}, ..map₂ (*) f g }⟩

localized "attribute [instance] filter.has_mul filter.has_add" in pointwise

@[simp, to_additive] lemma map₂_mul : map₂ (*) f g = f * g := rfl
@[to_additive] lemma mem_mul : s ∈ f * g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ * t₂ ⊆ s := iff.rfl
@[to_additive] lemma mul_mem_mul : s ∈ f → t ∈ g → s * t ∈ f * g := image2_mem_map₂
@[simp, to_additive] lemma bot_mul : ⊥ * g = ⊥ := map₂_bot_left
@[simp, to_additive] lemma mul_bot : f * ⊥ = ⊥ := map₂_bot_right
@[simp, to_additive] lemma mul_eq_bot_iff : f * g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := map₂_eq_bot_iff
@[simp, to_additive] lemma mul_ne_bot_iff : (f * g).ne_bot ↔ f.ne_bot ∧ g.ne_bot := map₂_ne_bot_iff
@[to_additive] lemma ne_bot.mul : ne_bot f → ne_bot g → ne_bot (f * g) := ne_bot.map₂
@[to_additive] lemma ne_bot.of_mul_left : (f * g).ne_bot → f.ne_bot := ne_bot.of_map₂_left
@[to_additive] lemma ne_bot.of_mul_right : (f * g).ne_bot → g.ne_bot := ne_bot.of_map₂_right
@[simp, to_additive] lemma pure_mul : pure a * g = g.map ((*) a)  := map₂_pure_left
@[simp, to_additive] lemma mul_pure : f * pure b = f.map (* b)  := map₂_pure_right
@[simp, to_additive] lemma pure_mul_pure : (pure a : filter α) * pure b = pure (a * b) := map₂_pure
@[simp, to_additive] lemma le_mul_iff : h ≤ f * g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → s * t ∈ h :=
le_map₂_iff

@[to_additive] instance covariant_mul : covariant_class (filter α) (filter α) (*) (≤) :=
⟨λ f g h, map₂_mono_left⟩

@[to_additive] instance covariant_swap_mul : covariant_class (filter α) (filter α) (swap (*)) (≤) :=
⟨λ f g h, map₂_mono_right⟩

@[to_additive]
protected lemma map_mul [mul_hom_class F α β] (m : F) : (f₁ * f₂).map m = f₁.map m * f₂.map m :=
map_map₂_distrib $ map_mul m

/-- `pure` operation as a `mul_hom`. -/
@[to_additive "The singleton operation as an `add_hom`."]
def pure_mul_hom : α →ₙ* filter α := ⟨pure, λ a b, pure_mul_pure.symm⟩

@[simp, to_additive] lemma coe_pure_mul_hom : (pure_mul_hom : α → filter α) = pure := rfl
@[simp, to_additive] lemma pure_mul_hom_apply (a : α) : pure_mul_hom a = pure a := rfl

end has_mul

/-! ### Filter subtraction/division -/

section div
variables [has_div α] {f f₁ f₂ g g₁ g₂ h : filter α} {s t : set α} {a b : α}

/-- The filter `f / g` is generated by `{s / t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
@[to_additive "The filter `f - g` is generated by `{s - t | s ∈ f, t ∈ g}` in locale `pointwise`."]
protected def has_div : has_div (filter α) :=
/- This is defeq to `map₂ (/) f g`, but the hypothesis unfolds to `t₁ / t₂ ⊆ s` rather than all the
way to `set.image2 (/) t₁ t₂ ⊆ s`. -/
⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ / t₂ ⊆ s}, ..map₂ (/) f g }⟩

localized "attribute [instance] filter.has_div filter.has_sub" in pointwise

@[simp, to_additive] lemma map₂_div : map₂ (/) f g = f / g := rfl
@[to_additive] lemma mem_div : s ∈ f / g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ / t₂ ⊆ s := iff.rfl
@[to_additive] lemma div_mem_div : s ∈ f → t ∈ g → s / t ∈ f / g := image2_mem_map₂
@[simp, to_additive] lemma bot_div : ⊥ / g = ⊥ := map₂_bot_left
@[simp, to_additive] lemma div_bot : f / ⊥ = ⊥ := map₂_bot_right
@[simp, to_additive] lemma div_eq_bot_iff : f / g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := map₂_eq_bot_iff
@[simp, to_additive] lemma div_ne_bot_iff : (f / g).ne_bot ↔ f.ne_bot ∧ g.ne_bot := map₂_ne_bot_iff
@[to_additive] lemma ne_bot.div : ne_bot f → ne_bot g → ne_bot (f / g) := ne_bot.map₂
@[to_additive] lemma ne_bot.of_div_left : (f / g).ne_bot → f.ne_bot := ne_bot.of_map₂_left
@[to_additive] lemma ne_bot.of_div_right : (f / g).ne_bot → g.ne_bot := ne_bot.of_map₂_right
@[simp, to_additive] lemma pure_div : pure a / g = g.map ((/) a)  := map₂_pure_left
@[simp, to_additive] lemma div_pure : f / pure b = f.map (/ b)  := map₂_pure_right
@[simp, to_additive] lemma pure_div_pure : (pure a : filter α) / pure b = pure (a / b) := map₂_pure
@[to_additive] protected lemma div_le_div : f₁ ≤ f₂ → g₁ ≤ g₂ → f₁ / g₁ ≤ f₂ / g₂ := map₂_mono
@[to_additive] protected lemma div_le_div_left : g₁ ≤ g₂ → f / g₁ ≤ f / g₂ := map₂_mono_left
@[to_additive] protected lemma div_le_div_right : f₁ ≤ f₂ → f₁ / g ≤ f₂ / g := map₂_mono_right
@[simp, to_additive] protected lemma le_div_iff :
  h ≤ f / g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → s / t ∈ h :=
le_map₂_iff

@[to_additive] instance covariant_div : covariant_class (filter α) (filter α) (/) (≤) :=
⟨λ f g h, map₂_mono_left⟩

@[to_additive] instance covariant_swap_div : covariant_class (filter α) (filter α) (swap (/)) (≤) :=
⟨λ f g h, map₂_mono_right⟩

end div

open_locale pointwise

/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `filter`. See
Note [pointwise nat action].-/
protected def has_nsmul [has_zero α] [has_add α] : has_scalar ℕ (filter α) := ⟨nsmul_rec⟩

/-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a
`filter`. See Note [pointwise nat action]. -/
@[to_additive]
protected def has_npow [has_one α] [has_mul α] : has_pow (filter α) ℕ := ⟨λ s n, npow_rec n s⟩

/-- Repeated pointwise addition/subtraction (not the same as pointwise repeated
addition/subtraction!) of a `filter`. See Note [pointwise nat action]. -/
protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_scalar ℤ (filter α) :=
⟨zsmul_rec⟩

/-- Repeated pointwise multiplication/division (not the same as pointwise repeated
multiplication/division!) of a `filter`. See Note [pointwise nat action]. -/
@[to_additive] protected def has_zpow [has_one α] [has_mul α] [has_inv α] : has_pow (filter α) ℤ :=
⟨λ s n, zpow_rec n s⟩

localized "attribute [instance] filter.has_nsmul filter.has_npow filter.has_zsmul filter.has_zpow"
  in pointwise

/-- `filter α` is a `semigroup` under pointwise operations if `α` is.-/
@[to_additive "`filter α` is an `add_semigroup` under pointwise operations if `α` is."]
protected def semigroup [semigroup α] : semigroup (filter α) :=
{ mul := (*),
  mul_assoc := λ f g h, map₂_assoc mul_assoc }

/-- `filter α` is a `comm_semigroup` under pointwise operations if `α` is. -/
@[to_additive "`filter α` is an `add_comm_semigroup` under pointwise operations if `α` is."]
protected def comm_semigroup [comm_semigroup α] : comm_semigroup (filter α) :=
{ mul_comm := λ f g, map₂_comm mul_comm,
  ..filter.semigroup }

section mul_one_class
variables [mul_one_class α] [mul_one_class β]

/-- `filter α` is a `mul_one_class` under pointwise operations if `α` is. -/
@[to_additive "`filter α` is an `add_zero_class` under pointwise operations if `α` is."]
protected def mul_one_class : mul_one_class (filter α) :=
{ one := 1,
  mul := (*),
  one_mul := λ f, by simp only [←pure_one, ←map₂_mul, map₂_pure_left, one_mul, map_id'],
  mul_one := λ f, by simp only [←pure_one, ←map₂_mul, map₂_pure_right, mul_one, map_id'] }

localized "attribute [instance] filter.semigroup filter.add_semigroup filter.comm_semigroup
  filter.add_comm_semigroup filter.mul_one_class filter.add_zero_class" in pointwise

/-- If `φ : α →* β` then `map_monoid_hom φ` is the monoid homomorphism
`filter α →* filter β` induced by `map φ`. -/
@[to_additive "If `φ : α →+ β` then `map_add_monoid_hom φ` is the monoid homomorphism
`filter α →+ filter β` induced by `map φ`."]
def map_monoid_hom [monoid_hom_class F α β] (φ : F) : filter α →* filter β :=
{ to_fun := map φ,
  map_one' := filter.map_one φ,
  map_mul' := λ _ _, filter.map_mul φ }

-- The other direction does not hold in general
@[to_additive]
lemma comap_mul_comap_le [mul_hom_class F α β] (m : F) {f g : filter β} :
  f.comap m * g.comap m ≤ (f * g).comap m  :=
λ s ⟨t, ⟨t₁, t₂, ht₁, ht₂, t₁t₂⟩, mt⟩,
  ⟨m ⁻¹' t₁, m ⁻¹' t₂, ⟨t₁, ht₁, subset.rfl⟩, ⟨t₂, ht₂, subset.rfl⟩,
    (preimage_mul_preimage_subset _).trans $ (preimage_mono t₁t₂).trans mt⟩

@[to_additive]
lemma tendsto.mul_mul [mul_hom_class F α β] (m : F) {f₁ g₁ : filter α} {f₂ g₂ : filter β} :
  tendsto m f₁ f₂ → tendsto m g₁ g₂ → tendsto m (f₁ * g₁) (f₂ * g₂) :=
λ hf hg, (filter.map_mul m).trans_le $ mul_le_mul' hf hg

/-- `pure` as a `monoid_hom`. -/
@[to_additive "`pure` as an `add_monoid_hom`."]
def pure_monoid_hom : α →* filter α := { ..pure_mul_hom, ..pure_one_hom }

@[simp, to_additive] lemma coe_pure_monoid_hom : (pure_monoid_hom : α → filter α) = pure := rfl
@[simp, to_additive] lemma pure_monoid_hom_apply (a : α) : pure_monoid_hom a = pure a := rfl

end mul_one_class

section monoid
variables [monoid α] {f g : filter α} {s : set α} {a : α} {m n : ℕ}

/-- `filter α` is a `monoid` under pointwise operations if `α` is. -/
@[to_additive "`filter α` is an `add_monoid` under pointwise operations if `α` is."]
protected def monoid : monoid (filter α) :=
{ ..filter.mul_one_class, ..filter.semigroup, ..filter.has_npow }

localized "attribute [instance] filter.monoid filter.add_monoid" in pointwise

@[to_additive] lemma pow_mem_pow (hs : s ∈ f) : ∀ n : ℕ, s ^ n ∈ f ^ n
| 0 := by { rw pow_zero, exact one_mem_one }
| (n + 1) := by { rw pow_succ, exact mul_mem_mul hs (pow_mem_pow _) }

@[simp, to_additive nsmul_bot] lemma bot_pow {n : ℕ} (hn : n ≠ 0) : (⊥  : filter α) ^ n = ⊥ :=
by rw [←tsub_add_cancel_of_le (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn), pow_succ, bot_mul]

@[to_additive] lemma mul_top_of_one_le (hf : 1 ≤ f) : f * ⊤ = ⊤ :=
begin
  refine top_le_iff.1 (λ s, _),
  simp only [mem_mul, mem_top, exists_and_distrib_left, exists_eq_left],
  rintro ⟨t, ht, hs⟩,
  rwa [mul_univ_of_one_mem (mem_one.1 $ hf ht), univ_subset_iff] at hs,
end

@[to_additive] lemma top_mul_of_one_le (hf : 1 ≤ f) : ⊤ * f = ⊤ :=
begin
  refine top_le_iff.1 (λ s, _),
  simp only [mem_mul, mem_top, exists_and_distrib_left, exists_eq_left],
  rintro ⟨t, ht, hs⟩,
  rwa [univ_mul_of_one_mem (mem_one.1 $ hf ht), univ_subset_iff] at hs,
end

@[simp, to_additive] lemma top_mul_top : (⊤ : filter α) * ⊤ = ⊤ := mul_top_of_one_le le_top

--TODO: `to_additive` trips up on the `1 : ℕ` used in the pattern-matching.
lemma nsmul_top {α : Type*} [add_monoid α] : ∀ {n : ℕ}, n ≠ 0 → n • (⊤ : filter α) = ⊤
| 0 := λ h, (h rfl).elim
| 1 := λ _, one_nsmul _
| (n + 2) := λ _, by { rw [succ_nsmul, nsmul_top n.succ_ne_zero, top_add_top] }

@[to_additive nsmul_top] lemma top_pow : ∀ {n : ℕ}, n ≠ 0 → (⊤ : filter α) ^ n = ⊤
| 0 := λ h, (h rfl).elim
| 1 := λ _, pow_one _
| (n + 2) := λ _, by { rw [pow_succ, top_pow n.succ_ne_zero, top_mul_top] }

@[to_additive] protected lemma _root_.is_unit.filter : is_unit a → is_unit (pure a : filter α) :=
is_unit.map (pure_monoid_hom : α →* filter α)

end monoid

/-- `filter α` is a `comm_monoid` under pointwise operations if `α` is. -/
@[to_additive "`filter α` is an `add_comm_monoid` under pointwise operations if `α` is."]
protected def comm_monoid [comm_monoid α] : comm_monoid (filter α) :=
{ ..filter.mul_one_class, ..filter.comm_semigroup }

open_locale pointwise

section division_monoid
variables [division_monoid α] {f g : filter α}

@[to_additive]
protected lemma mul_eq_one_iff : f * g = 1 ↔ ∃ a b, f = pure a ∧ g = pure b ∧ a * b = 1 :=
begin
  refine ⟨λ hfg, _, _⟩,
  { obtain ⟨t₁, t₂, h₁, h₂, h⟩ : (1 : set α) ∈ f * g := hfg.symm.subst one_mem_one,
    have hfg : (f * g).ne_bot := hfg.symm.subst one_ne_bot,
    rw [(hfg.nonempty_of_mem $ mul_mem_mul h₁ h₂).subset_one_iff, set.mul_eq_one_iff] at h,
    obtain ⟨a, b, rfl, rfl, h⟩ := h,
    refine ⟨a, b, _, _, h⟩,
    { rwa [←hfg.of_mul_left.le_pure_iff, le_pure_iff] },
    { rwa [←hfg.of_mul_right.le_pure_iff, le_pure_iff] } },
  { rintro ⟨a, b, rfl, rfl, h⟩,
    rw [pure_mul_pure, h, pure_one] }
end

/-- `filter α` is a division monoid under pointwise operations if `α` is. -/
@[to_additive subtraction_monoid "`filter α` is a subtraction monoid under pointwise
operations if `α` is."]
protected def division_monoid : division_monoid (filter α) :=
{ mul_inv_rev := λ s t, map_map₂_antidistrib mul_inv_rev,
  inv_eq_of_mul := λ s t h, begin
    obtain ⟨a, b, rfl, rfl, hab⟩ := filter.mul_eq_one_iff.1 h,
    rw [inv_pure, inv_eq_of_mul_eq_one_right hab],
  end,
  div_eq_mul_inv := λ f g, map_map₂_distrib_right div_eq_mul_inv,
  ..filter.monoid, ..filter.has_involutive_inv, ..filter.has_div, ..filter.has_zpow }

@[to_additive] lemma is_unit_iff : is_unit f ↔ ∃ a, f = pure a ∧ is_unit a :=
begin
  split,
  { rintro ⟨u, rfl⟩,
    obtain ⟨a, b, ha, hb, h⟩ := filter.mul_eq_one_iff.1 u.mul_inv,
    refine ⟨a, ha, ⟨a, b, h, pure_injective _⟩, rfl⟩,
    rw [←pure_mul_pure, ←ha, ←hb],
    exact u.inv_mul },
  { rintro ⟨a, rfl, ha⟩,
    exact ha.filter }
end

end division_monoid

/-- `filter α` is a commutative division monoid under pointwise operations if `α` is. -/
@[to_additive subtraction_comm_monoid "`filter α` is a commutative subtraction monoid under
pointwise operations if `α` is."]
protected def division_comm_monoid [division_comm_monoid α] : division_comm_monoid (filter α) :=
{ ..filter.division_monoid, ..filter.comm_semigroup }

/-- `filter α` has distributive negation if `α` has. -/
protected def has_distrib_neg [has_mul α] [has_distrib_neg α] : has_distrib_neg (filter α) :=
{ neg_mul := λ _ _, map₂_map_left_comm neg_mul,
  mul_neg := λ _ _, map_map₂_right_comm mul_neg,
  ..filter.has_involutive_neg }

localized "attribute [instance] filter.comm_monoid filter.add_comm_monoid filter.division_monoid
  filter.subtraction_monoid filter.division_comm_monoid filter.subtraction_comm_monoid
  filter.has_distrib_neg" in pointwise

section distrib
variables [distrib α] {f g h : filter α}

/-!
Note that `filter α` is not a `distrib` because `f * g + f * h` has cross terms that `f * (g + h)`
lacks.
-/

lemma mul_add_subset : f * (g + h) ≤ f * g + f * h := map₂_distrib_le_left mul_add
lemma add_mul_subset : (f + g) * h ≤ f * h + g * h := map₂_distrib_le_right add_mul

end distrib

section mul_zero_class
variables [mul_zero_class α] {f g : filter α}

/-! Note that `filter` is not a `mul_zero_class` because `0 * ⊥ ≠ 0`. -/

lemma ne_bot.mul_zero_nonneg (hf : f.ne_bot) : 0 ≤ f * 0 :=
le_mul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨a, ha⟩ := hf.nonempty_of_mem h₁ in ⟨_, _, ha, h₂, mul_zero _⟩

lemma ne_bot.zero_mul_nonneg (hg : g.ne_bot) : 0 ≤ 0 * g :=
le_mul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨b, hb⟩ := hg.nonempty_of_mem h₂ in ⟨_, _, h₁, hb, zero_mul _⟩

end mul_zero_class

section group
variables [group α] [division_monoid β] [monoid_hom_class F α β] (m : F) {f g f₁ g₁ : filter α}
  {f₂ g₂ : filter β}

/-! Note that `filter α` is not a group because `f / f ≠ 1` in general -/

@[simp, to_additive] protected lemma one_le_div_iff : 1 ≤ f / g ↔ ¬ disjoint f g :=
begin
  refine ⟨λ h hfg, _, _⟩,
  { obtain ⟨s, hs, t, ht, hst⟩ := hfg (mem_bot : ∅ ∈ ⊥),
    exact set.one_mem_div_iff.1 (h $ div_mem_div hs ht) (disjoint_iff.2 hst.symm) },
  { rintro h s ⟨t₁, t₂, h₁, h₂, hs⟩,
    exact hs (set.one_mem_div_iff.2 $ λ ht, h $ disjoint_of_disjoint_of_mem ht h₁ h₂) }
end

@[to_additive] lemma not_one_le_div_iff : ¬ 1 ≤ f / g ↔ disjoint f g :=
filter.one_le_div_iff.not_left

@[to_additive] lemma ne_bot.one_le_div (h : f.ne_bot) : 1 ≤ f / f :=
begin
  rintro s ⟨t₁, t₂, h₁, h₂, hs⟩,
  obtain ⟨a, ha₁, ha₂⟩ := set.not_disjoint_iff.1 (h.not_disjoint h₁ h₂),
  rw [mem_one, ←div_self' a],
  exact hs (set.div_mem_div ha₁ ha₂),
end

@[to_additive] lemma is_unit_pure (a : α) : is_unit (pure a : filter α) := (group.is_unit a).filter

@[simp] lemma is_unit_iff_singleton : is_unit f ↔ ∃ a, f = pure a :=
by simp only [is_unit_iff, group.is_unit, and_true]

include β

@[to_additive] lemma map_inv' : f⁻¹.map m = (f.map m)⁻¹ := map_comm (funext $ map_inv m) _

@[to_additive] lemma tendsto.inv_inv : tendsto m f₁ f₂ → tendsto m f₁⁻¹ f₂⁻¹ :=
λ hf, (filter.map_inv' m).trans_le $ filter.inv_le_inv hf

@[to_additive] protected lemma map_div : (f / g).map m = f.map m / g.map m :=
map_map₂_distrib $ map_div m

@[to_additive]
lemma tendsto.div_div : tendsto m f₁ f₂ → tendsto m g₁ g₂ → tendsto m (f₁ / g₁) (f₂ / g₂) :=
λ hf hg, (filter.map_div m).trans_le $ filter.div_le_div hf hg

end group

open_locale pointwise

section group_with_zero
variables [group_with_zero α] {f g : filter α}

lemma ne_bot.div_zero_nonneg (hf : f.ne_bot) : 0 ≤ f / 0 :=
filter.le_div_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨a, ha⟩ := hf.nonempty_of_mem h₁ in
  ⟨_, _, ha, h₂, div_zero _⟩

lemma ne_bot.zero_div_nonneg (hg : g.ne_bot) : 0 ≤ 0 / g :=
filter.le_div_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨b, hb⟩ := hg.nonempty_of_mem h₂ in
  ⟨_, _, h₁, hb, zero_div _⟩

end group_with_zero

/-! ### Scalar addition/multiplication of filters -/

section smul
variables [has_scalar α β] {f f₁ f₂ : filter α} {g g₁ g₂ h : filter β} {s : set α} {t : set β}
  {a : α} {b : β}

/-- The filter `f • g` is generated by `{s • t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
@[to_additive filter.has_vadd
"The filter `f +ᵥ g` is generated by `{s +ᵥ t | s ∈ f, t ∈ g}` in locale `pointwise`."]
protected def has_scalar : has_scalar (filter α) (filter β) :=
/- This is defeq to `map₂ (•) f g`, but the hypothesis unfolds to `t₁ • t₂ ⊆ s` rather than all the
way to `set.image2 (•) t₁ t₂ ⊆ s`. -/
⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ • t₂ ⊆ s}, ..map₂ (•) f g }⟩

localized "attribute [instance] filter.has_scalar filter.has_vadd" in pointwise

@[simp, to_additive] lemma map₂_smul : map₂ (•) f g = f • g := rfl
@[to_additive] lemma mem_smul : t ∈ f • g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ • t₂ ⊆ t := iff.rfl
@[to_additive] lemma smul_mem_smul : s ∈ f → t ∈ g → s • t ∈ f • g :=  image2_mem_map₂
@[simp, to_additive] lemma bot_smul : (⊥ : filter α) • g = ⊥ := map₂_bot_left
@[simp, to_additive] lemma smul_bot : f • (⊥ : filter β) = ⊥ := map₂_bot_right
@[simp, to_additive] lemma smul_eq_bot_iff : f • g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := map₂_eq_bot_iff
@[simp, to_additive] lemma smul_ne_bot_iff : (f • g).ne_bot ↔ f.ne_bot ∧ g.ne_bot := map₂_ne_bot_iff
@[to_additive] lemma ne_bot.smul : ne_bot f → ne_bot g → ne_bot (f • g) := ne_bot.map₂
@[to_additive] lemma ne_bot.of_smul_left : (f • g).ne_bot → f.ne_bot := ne_bot.of_map₂_left
@[to_additive] lemma ne_bot.of_smul_right : (f • g).ne_bot → g.ne_bot := ne_bot.of_map₂_right
@[simp, to_additive] lemma pure_smul : (pure a : filter α) • g = g.map ((•) a)  := map₂_pure_left
@[simp, to_additive] lemma smul_pure : f • pure b = f.map (• b)  := map₂_pure_right
@[simp, to_additive] lemma pure_smul_pure :
  (pure a : filter α) • (pure b : filter β) = pure (a • b) := map₂_pure
@[to_additive] lemma smul_le_smul : f₁ ≤ f₂ → g₁ ≤ g₂ → f₁ • g₁ ≤ f₂ • g₂ := map₂_mono
@[to_additive] lemma smul_le_smul_left : g₁ ≤ g₂ → f • g₁ ≤ f • g₂ := map₂_mono_left
@[to_additive] lemma smul_le_smul_right : f₁ ≤ f₂ → f₁ • g ≤ f₂ • g := map₂_mono_right
@[simp, to_additive] lemma le_smul_iff : h ≤ f • g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → s • t ∈ h :=
le_map₂_iff

@[to_additive] instance covariant_smul : covariant_class (filter α) (filter β) (•) (≤) :=
⟨λ f g h, map₂_mono_left⟩

end smul

/-! ### Scalar subtraction of filters -/

section vsub
variables [has_vsub α β] {f f₁ f₂ g g₁ g₂ : filter β} {h : filter α} {s t : set β} {a b : β}
include α

/-- The filter `f -ᵥ g` is generated by `{s -ᵥ t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
protected def has_vsub : has_vsub (filter α) (filter β) :=
/- This is defeq to `map₂ (-ᵥ) f g`, but the hypothesis unfolds to `t₁ -ᵥ t₂ ⊆ s` rather than all
the way to `set.image2 (-ᵥ) t₁ t₂ ⊆ s`. -/
⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ -ᵥ t₂ ⊆ s}, ..map₂ (-ᵥ) f g }⟩

localized "attribute [instance] filter.has_vsub" in pointwise

@[simp] lemma map₂_vsub : map₂ (-ᵥ) f g = f -ᵥ g := rfl
lemma mem_vsub {s : set α} : s ∈ f -ᵥ g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ -ᵥ t₂ ⊆ s := iff.rfl
lemma vsub_mem_vsub : s ∈ f → t ∈ g → s -ᵥ t ∈ f -ᵥ g :=  image2_mem_map₂
@[simp] lemma bot_vsub : (⊥ : filter β) -ᵥ g = ⊥ := map₂_bot_left
@[simp] lemma vsub_bot : f -ᵥ (⊥ : filter β) = ⊥ := map₂_bot_right
@[simp] lemma vsub_eq_bot_iff : f -ᵥ g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := map₂_eq_bot_iff
@[simp] lemma vsub_ne_bot_iff : (f -ᵥ g : filter α).ne_bot ↔ f.ne_bot ∧ g.ne_bot := map₂_ne_bot_iff
lemma ne_bot.vsub : ne_bot f → ne_bot g → ne_bot (f -ᵥ g) := ne_bot.map₂
lemma ne_bot.of_vsub_left : (f -ᵥ g : filter α).ne_bot → f.ne_bot := ne_bot.of_map₂_left
lemma ne_bot.of_vsub_right : (f -ᵥ g : filter α).ne_bot → g.ne_bot := ne_bot.of_map₂_right
@[simp] lemma pure_vsub : (pure a : filter β) -ᵥ g = g.map ((-ᵥ) a)  := map₂_pure_left
@[simp] lemma vsub_pure : f -ᵥ pure b = f.map (-ᵥ b)  := map₂_pure_right
@[simp] lemma pure_vsub_pure : (pure a : filter β) -ᵥ pure b = (pure (a -ᵥ b) : filter α) :=
map₂_pure
lemma vsub_le_vsub : f₁ ≤ f₂ → g₁ ≤ g₂ → f₁ -ᵥ g₁ ≤ f₂ -ᵥ g₂ := map₂_mono
lemma vsub_le_vsub_left : g₁ ≤ g₂ → f -ᵥ g₁ ≤ f -ᵥ g₂ := map₂_mono_left
lemma vsub_le_vsub_right : f₁ ≤ f₂ → f₁ -ᵥ g ≤ f₂ -ᵥ g := map₂_mono_right
@[simp] lemma le_vsub_iff : h ≤ f -ᵥ g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → s -ᵥ t ∈ h := le_map₂_iff

end vsub

/-! ### Translation/scaling of filters -/

section smul
variables [has_scalar α β] {f f₁ f₂ : filter β} {s : set β} {a : α}

/-- `a • f` is the map of `f` under `a •` in locale `pointwise`. -/
@[to_additive filter.has_vadd_filter
"`a +ᵥ f` is the map of `f` under `a +ᵥ` in locale `pointwise`."]
protected def has_scalar_filter : has_scalar α (filter β) := ⟨λ a, map ((•) a)⟩

localized "attribute [instance] filter.has_scalar_filter filter.has_vadd_filter" in pointwise

@[simp, to_additive] lemma map_smul : map (λ b, a • b) f = a • f := rfl
@[to_additive] lemma mem_smul_filter : s ∈ a • f ↔ (•) a ⁻¹' s ∈ f := iff.rfl

@[to_additive] lemma smul_set_mem_smul_filter : s ∈ f → a • s ∈ a • f := image_mem_map
@[simp, to_additive] lemma smul_filter_bot : a • (⊥ : filter β) = ⊥ := map_bot
@[simp, to_additive] lemma smul_filter_eq_bot_iff : a • f = ⊥ ↔ f = ⊥ := map_eq_bot_iff
@[simp, to_additive] lemma smul_filter_ne_bot_iff : (a • f).ne_bot ↔ f.ne_bot := map_ne_bot_iff _
@[to_additive] lemma ne_bot.smul_filter : f.ne_bot → (a • f).ne_bot := λ h, h.map _
@[to_additive] lemma ne_bot.of_smul_filter : (a • f).ne_bot → f.ne_bot := ne_bot.of_map
@[to_additive] lemma smul_filter_le_smul_filter (hf : f₁ ≤ f₂) : a • f₁ ≤ a • f₂ :=
map_mono hf

@[to_additive] instance covariant_smul_filter : covariant_class α (filter β) (•) (≤) :=
⟨λ f, map_mono⟩

end smul

open_locale pointwise

@[to_additive]
instance smul_comm_class_filter [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class α β (filter γ) :=
⟨λ _ _ _,  map_comm (funext $ smul_comm _ _) _⟩

@[to_additive]
instance smul_comm_class_filter' [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class α (filter β) (filter γ) :=
⟨λ a f g, map_map₂_distrib_right $ smul_comm a⟩

@[to_additive]
instance smul_comm_class_filter'' [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class (filter α) β (filter γ) :=
by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _

@[to_additive]
instance smul_comm_class [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class (filter α) (filter β) (filter γ) :=
⟨λ f g h, map₂_left_comm smul_comm⟩

instance is_scalar_tower [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
  [is_scalar_tower α β γ] :
  is_scalar_tower α β (filter γ) :=
⟨λ a b f, by simp only [←map_smul, map_map, smul_assoc]⟩

instance is_scalar_tower' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
  [is_scalar_tower α β γ] :
  is_scalar_tower α (filter β) (filter γ) :=
⟨λ a f g, by { refine (map_map₂_distrib_left $ λ _ _, _).symm, exact (smul_assoc a _ _).symm }⟩

instance is_scalar_tower'' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
  [is_scalar_tower α β γ] :
  is_scalar_tower (filter α) (filter β) (filter γ) :=
⟨λ f g h, map₂_assoc smul_assoc⟩

instance is_central_scalar [has_scalar α β] [has_scalar αᵐᵒᵖ β] [is_central_scalar α β] :
  is_central_scalar α (filter β) :=
⟨λ a f, congr_arg (λ m, map m f) $ by exact funext (λ _, op_smul_eq_smul _ _)⟩

/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of
`filter α` on `filter β`. -/
@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action
of `filter α` on `filter β`"]
protected def mul_action [monoid α] [mul_action α β] : mul_action (filter α) (filter β) :=
{ one_smul := λ f, map₂_pure_left.trans $ by simp_rw [one_smul, map_id'],
  mul_smul := λ f g h, map₂_assoc mul_smul }

/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `filter β`.
-/
@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action on
`filter β`."]
protected def mul_action_filter [monoid α] [mul_action α β] : mul_action α (filter β) :=
{ mul_smul := λ a b f, by simp only [←map_smul, map_map, function.comp, ←mul_smul],
  one_smul := λ f, by simp only [←map_smul, one_smul, map_id'] }

localized "attribute [instance] filter.mul_action filter.add_action filter.mul_action_filter
  filter.add_action_filter" in pointwise

/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
multiplicative action on `filter β`. -/
protected def distrib_mul_action_filter [monoid α] [add_monoid β] [distrib_mul_action α β] :
  distrib_mul_action α (filter β) :=
{ smul_add := λ _ _ _, map_map₂_distrib $ smul_add _,
  smul_zero := λ _, (map_pure _ _).trans $ by rw [smul_zero, pure_zero] }

/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/
protected def mul_distrib_mul_action_filter [monoid α] [monoid β] [mul_distrib_mul_action α β] :
  mul_distrib_mul_action α (set β) :=
{ smul_mul := λ _ _ _, image_image2_distrib $ smul_mul' _,
  smul_one := λ _, image_singleton.trans $ by rw [smul_one, singleton_one] }

localized "attribute [instance] filter.distrib_mul_action_filter
  filter.mul_distrib_mul_action_filter" in pointwise

section smul_with_zero
variables [has_zero α] [has_zero β] [smul_with_zero α β] {f : filter α} {g : filter β}

/-!
Note that we have neither `smul_with_zero α (filter β)` nor `smul_with_zero (filter α) (filter β)`
because `0 * ⊥ ≠ 0`.
-/

lemma ne_bot.smul_zero_nonneg (hf : f.ne_bot) : 0 ≤ f • (0 : filter β) :=
le_smul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨a, ha⟩ := hf.nonempty_of_mem h₁ in
  ⟨_, _, ha, h₂, smul_zero' _ _⟩

lemma ne_bot.zero_smul_nonneg (hg : g.ne_bot) : 0 ≤ (0 : filter α) • g :=
le_smul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨b, hb⟩ := hg.nonempty_of_mem h₂ in ⟨_, _, h₁, hb, zero_smul _ _⟩

lemma zero_smul_filter_nonpos : (0 : α) • g ≤ 0 :=
begin
  refine λ s hs, mem_smul_filter.2 _,
  convert univ_mem,
  refine eq_univ_iff_forall.2 (λ a, _),
  rwa [mem_preimage, zero_smul],
end

lemma zero_smul_filter (hg : g.ne_bot) : (0 : α) • g = 0 :=
zero_smul_filter_nonpos.antisymm $ le_map_iff.2 $ λ s hs, begin
  simp_rw [set.image_eta, zero_smul, (hg.nonempty_of_mem hs).image_const],
  exact zero_mem_zero,
end

end smul_with_zero

end filter


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import computability.primrec
import data.nat.psub
import data.pfun

/-!
# The partial recursive functions

The partial recursive functions are defined similarly to the primitive
recursive functions, but now all functions are partial, implemented
using the `roption` monad, and there is an additional operation, called
μ-recursion, which performs unbounded minimization.

## References

* [Mario Carneiro, *Formalizing computability theory via partial recursive functions*][carneiro2019]
-/

open encodable denumerable roption

namespace nat

section rfind
parameter (p : ℕ →. bool)

private def lbp (m n : ℕ) : Prop := m = n + 1 ∧ ∀ k ≤ n, ff ∈ p k

parameter (H : ∃ n, tt ∈ p n ∧ ∀ k < n, (p k).dom)

private def wf_lbp : well_founded lbp :=
⟨let ⟨n, pn⟩ := H in begin
  suffices : ∀m k, n ≤ k + m → acc (lbp p) k,
  { from λa, this _ _ (nat.le_add_left _ _) },
  intros m k kn,
  induction m with m IH generalizing k;
    refine ⟨_, λ y r, _⟩; rcases r with ⟨rfl, a⟩,
  { injection mem_unique pn.1 (a _ kn) },
  { exact IH _ (by rw nat.add_right_comm; exact kn) }
end⟩

def rfind_x : {n // tt ∈ p n ∧ ∀m < n, ff ∈ p m} :=
suffices ∀ k, (∀n < k, ff ∈ p n) → {n // tt ∈ p n ∧ ∀m < n, ff ∈ p m},
from this 0 (λ n, (nat.not_lt_zero _).elim),
@well_founded.fix _ _ lbp wf_lbp begin
  intros m IH al,
  have pm : (p m).dom,
  { rcases H with ⟨n, h₁, h₂⟩,
    rcases lt_trichotomy m n with h₃|h₃|h₃,
    { exact h₂ _ h₃ },
    { rw h₃, exact h₁.fst },
    { injection mem_unique h₁ (al _ h₃) } },
  cases e : (p m).get pm,
  { suffices,
    exact IH _ ⟨rfl, this⟩ (λ n h, this _ (le_of_lt_succ h)),
    intros n h, cases decidable.lt_or_eq_of_le h with h h,
    { exact al _ h },
    { rw h, exact ⟨_, e⟩ } },
  { exact ⟨m, ⟨_, e⟩, al⟩ }
end

end rfind

def rfind (p : ℕ →. bool) : roption ℕ :=
⟨_, λ h, (rfind_x p h).1⟩

theorem rfind_spec {p : ℕ →. bool} {n : ℕ} (h : n ∈ rfind p) : tt ∈ p n :=
h.snd ▸ (rfind_x p h.fst).2.1

theorem rfind_min {p : ℕ →. bool} {n : ℕ} (h : n ∈ rfind p) :
  ∀ {m : ℕ}, m < n → ff ∈ p m :=
h.snd ▸ (rfind_x p h.fst).2.2

@[simp] theorem rfind_dom {p : ℕ →. bool} :
  (rfind p).dom ↔ ∃ n, tt ∈ p n ∧ ∀ {m : ℕ}, m < n → (p m).dom :=
iff.rfl

theorem rfind_dom' {p : ℕ →. bool} :
  (rfind p).dom ↔ ∃ n, tt ∈ p n ∧ ∀ {m : ℕ}, m ≤ n → (p m).dom :=
exists_congr $ λ n, and_congr_right $ λ pn,
⟨λ H m h, (eq_or_lt_of_le h).elim (λ e, e.symm ▸ pn.fst) (H _),
 λ H m h, H (le_of_lt h)⟩

@[simp] theorem mem_rfind {p : ℕ →. bool} {n : ℕ} :
  n ∈ rfind p ↔ tt ∈ p n ∧ ∀ {m : ℕ}, m < n → ff ∈ p m :=
⟨λ h, ⟨rfind_spec h, @rfind_min _ _ h⟩,
  λ ⟨h₁, h₂⟩, let ⟨m, hm⟩ := dom_iff_mem.1 $
    (@rfind_dom p).2 ⟨_, h₁, λ m mn, (h₂ mn).fst⟩ in
  begin
    rcases lt_trichotomy m n with h|h|h,
    { injection mem_unique (h₂ h) (rfind_spec hm) },
    { rwa ← h },
    { injection mem_unique h₁ (rfind_min hm h) },
  end⟩

theorem rfind_min' {p : ℕ → bool} {m : ℕ} (pm : p m) :
  ∃ n ∈ rfind p, n ≤ m :=
have tt ∈ (p : ℕ →. bool) m, from ⟨trivial, pm⟩,
let ⟨n, hn⟩ := dom_iff_mem.1 $
  (@rfind_dom p).2 ⟨m, this, λ k h, ⟨⟩⟩ in
⟨n, hn, not_lt.1 $ λ h,
  by injection mem_unique this (rfind_min hn h)⟩

theorem rfind_zero_none
  (p : ℕ →. bool) (p0 : p 0 = none) : rfind p = none :=
eq_none_iff.2 $ λ a h,
let ⟨n, h₁, h₂⟩ := rfind_dom'.1 h.fst in
(p0 ▸ h₂ (zero_le _) : (@roption.none bool).dom)

def rfind_opt {α} (f : ℕ → option α) : roption α :=
(rfind (λ n, (f n).is_some)).bind (λ n, f n)

theorem rfind_opt_spec {α} {f : ℕ → option α} {a}
 (h : a ∈ rfind_opt f) : ∃ n, a ∈ f n :=
let ⟨n, h₁, h₂⟩ := mem_bind_iff.1 h in ⟨n, mem_coe.1 h₂⟩

theorem rfind_opt_dom {α} {f : ℕ → option α} :
  (rfind_opt f).dom ↔ ∃ n a, a ∈ f n :=
⟨λ h, (rfind_opt_spec ⟨h, rfl⟩).imp (λ n h, ⟨_, h⟩),
 λ h, begin
  have h' : ∃ n, (f n).is_some :=
    h.imp (λ n, option.is_some_iff_exists.2),
  have s := nat.find_spec h',
  have fd : (rfind (λ n, (f n).is_some)).dom :=
    ⟨nat.find h', by simpa using s.symm, λ _ _, trivial⟩,
  refine ⟨fd, _⟩,
  have := rfind_spec (get_mem fd),
  simp at this ⊢,
  cases option.is_some_iff_exists.1 this.symm with a e,
  rw e, trivial
end⟩

theorem rfind_opt_mono {α} {f : ℕ → option α}
  (H : ∀ {a m n}, m ≤ n → a ∈ f m → a ∈ f n)
  {a} : a ∈ rfind_opt f ↔ ∃ n, a ∈ f n :=
⟨rfind_opt_spec, λ ⟨n, h⟩, begin
  have h' := rfind_opt_dom.2 ⟨_, _, h⟩,
  cases rfind_opt_spec ⟨h', rfl⟩ with k hk,
  have := (H (le_max_left _ _) h).symm.trans
          (H (le_max_right _ _) hk),
  simp at this, simp [this, get_mem]
end⟩

inductive partrec : (ℕ →. ℕ) → Prop
| zero : partrec (pure 0)
| succ : partrec succ
| left : partrec ↑(λ n : ℕ, n.unpair.1)
| right : partrec ↑(λ n : ℕ, n.unpair.2)
| pair {f g} : partrec f → partrec g → partrec (λ n, mkpair <$> f n <*> g n)
| comp {f g} : partrec f → partrec g → partrec (λ n, g n >>= f)
| prec {f g} : partrec f → partrec g → partrec (unpaired (λ a n,
    n.elim (f a) (λ y IH, do i ← IH, g (mkpair a (mkpair y i)))))
| rfind {f} : partrec f → partrec (λ a,
    rfind (λ n, (λ m, m = 0) <$> f (mkpair a n)))

namespace partrec

theorem of_eq {f g : ℕ →. ℕ} (hf : partrec f) (H : ∀ n, f n = g n) : partrec g :=
(funext H : f = g) ▸ hf

theorem of_eq_tot {f : ℕ →. ℕ} {g : ℕ → ℕ}
  (hf : partrec f) (H : ∀ n, g n ∈ f n) : partrec g :=
hf.of_eq (λ n, eq_some_iff.2 (H n))

theorem of_primrec {f : ℕ → ℕ} (hf : primrec f) : partrec f :=
begin
  induction hf,
  case nat.primrec.zero { exact zero },
  case nat.primrec.succ { exact succ },
  case nat.primrec.left { exact left },
  case nat.primrec.right { exact right },
  case nat.primrec.pair : f g hf hg pf pg {
    refine (pf.pair pg).of_eq_tot (λ n, _),
    simp [has_seq.seq] },
  case nat.primrec.comp : f g hf hg pf pg {
    refine (pf.comp pg).of_eq_tot (λ n, _),
    simp },
  case nat.primrec.prec : f g hf hg pf pg {
    refine (pf.prec pg).of_eq_tot (λ n, _),
    simp,
    induction n.unpair.2 with m IH, {simp},
    simp, exact ⟨_, IH, rfl⟩ },
end

protected theorem some : partrec some := of_primrec primrec.id

theorem none : partrec (λ n, none) :=
(of_primrec (nat.primrec.const 1)).rfind.of_eq $
λ n, eq_none_iff.2 $ λ a ⟨h, e⟩, by simpa using h

theorem prec' {f g h}
  (hf : partrec f) (hg : partrec g) (hh : partrec h) :
  partrec (λ a, (f a).bind (λ n, n.elim (g a)
    (λ y IH, do i ← IH, h (mkpair a (mkpair y i))))) :=
((prec hg hh).comp (pair partrec.some hf)).of_eq $
λ a, ext $ λ s, by simp [(<*>)]; exact
⟨λ ⟨n, h₁, h₂⟩, ⟨_, ⟨_, h₁, rfl⟩, by simpa using h₂⟩,
 λ ⟨_, ⟨n, h₁, rfl⟩, h₂⟩, ⟨_, h₁, by simpa using h₂⟩⟩

theorem ppred : partrec (λ n, ppred n) :=
have primrec₂ (λ n m, if n = nat.succ m then 0 else 1),
from (primrec.ite
  (@@primrec_rel.comp _ _ _ _ _ _ _ primrec.eq
    primrec.fst
    (_root_.primrec.succ.comp primrec.snd))
  (_root_.primrec.const 0) (_root_.primrec.const 1)).to₂,
(of_primrec (primrec₂.unpaired'.2 this)).rfind.of_eq $
λ n, begin
  cases n; simp,
  { exact eq_none_iff.2 (λ a ⟨⟨m, h, _⟩, _⟩,
      by simpa [show 0 ≠ m.succ, by intro h; injection h] using h) },
  { refine eq_some_iff.2 _,
    simp, intros m h, simp [ne_of_gt h] }
end

end partrec

end nat

def partrec {α σ} [primcodable α] [primcodable σ]
  (f : α →. σ) := nat.partrec (λ n,
  roption.bind (decode α n) (λ a, (f a).map encode))

def partrec₂ {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  (f : α → β →. σ) := partrec (λ p : α × β, f p.1 p.2)

def computable {α σ} [primcodable α] [primcodable σ] (f : α → σ) := partrec (f : α →. σ)

def computable₂ {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  (f : α → β → σ) := computable (λ p : α × β, f p.1 p.2)

theorem primrec.to_comp {α σ} [primcodable α] [primcodable σ]
  {f : α → σ} (hf : primrec f) : computable f :=
(nat.partrec.ppred.comp (nat.partrec.of_primrec hf)).of_eq $
λ n, by simp; cases decode α n; simp

theorem primrec₂.to_comp {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  {f : α → β → σ} (hf : primrec₂ f) : computable₂ f := hf.to_comp

theorem computable.part {α σ} [primcodable α] [primcodable σ]
  {f : α → σ} (hf : computable f) : partrec (f : α →. σ) := hf

theorem computable₂.part {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  {f : α → β → σ} (hf : computable₂ f) : partrec₂ (λ a, (f a : β →. σ)) := hf

namespace computable
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

theorem of_eq {f g : α → σ} (hf : computable f) (H : ∀ n, f n = g n) : computable g :=
(funext H : f = g) ▸ hf

theorem const (s : σ) : computable (λ a : α, s) :=
(primrec.const _).to_comp

theorem of_option {f : α → option β}
  (hf : computable f) : partrec (λ a, (f a : roption β)) :=
(nat.partrec.ppred.comp hf).of_eq $ λ n, begin
  cases decode α n with a; simp,
  cases f a with b; simp
end

theorem to₂ {f : α × β → σ} (hf : computable f) : computable₂ (λ a b, f (a, b)) :=
hf.of_eq $ λ ⟨a, b⟩, rfl

protected theorem id : computable (@id α) := primrec.id.to_comp

theorem fst : computable (@prod.fst α β) := primrec.fst.to_comp

theorem snd : computable (@prod.snd α β) := primrec.snd.to_comp

theorem pair {f : α → β} {g : α → γ}
  (hf : computable f) (hg : computable g) : computable (λ a, (f a, g a)) :=
(hf.pair hg).of_eq $
λ n, by cases decode α n; simp [(<*>)]

theorem unpair : computable nat.unpair := primrec.unpair.to_comp

theorem succ : computable nat.succ := primrec.succ.to_comp
theorem pred : computable nat.pred := primrec.pred.to_comp
theorem nat_bodd : computable nat.bodd := primrec.nat_bodd.to_comp
theorem nat_div2 : computable nat.div2 := primrec.nat_div2.to_comp

theorem sum_inl : computable (@sum.inl α β) := primrec.sum_inl.to_comp
theorem sum_inr : computable (@sum.inr α β) := primrec.sum_inr.to_comp

theorem list_cons : computable₂ (@list.cons α) := primrec.list_cons.to_comp
theorem list_reverse : computable (@list.reverse α) := primrec.list_reverse.to_comp
theorem list_nth : computable₂ (@list.nth α) := primrec.list_nth.to_comp
theorem list_append : computable₂ ((++) : list α → list α → list α) := primrec.list_append.to_comp
theorem list_concat : computable₂ (λ l (a:α), l ++ [a]) := primrec.list_concat.to_comp
theorem list_length : computable (@list.length α) := primrec.list_length.to_comp

theorem vector_cons {n} : computable₂ (@vector.cons α n) := primrec.vector_cons.to_comp
theorem vector_to_list {n} : computable (@vector.to_list α n) := primrec.vector_to_list.to_comp
theorem vector_length {n} : computable (@vector.length α n) := primrec.vector_length.to_comp
theorem vector_head {n} : computable (@vector.head α n) := primrec.vector_head.to_comp
theorem vector_tail {n} : computable (@vector.tail α n) := primrec.vector_tail.to_comp
theorem vector_nth {n} : computable₂ (@vector.nth α n) := primrec.vector_nth.to_comp
theorem vector_nth' {n} : computable (@vector.nth α n) := primrec.vector_nth'.to_comp
theorem vector_of_fn' {n} : computable (@vector.of_fn α n) := primrec.vector_of_fn'.to_comp

theorem fin_app {n} : computable₂ (@id (fin n → σ)) := primrec.fin_app.to_comp

protected theorem encode : computable (@encode α _) :=
primrec.encode.to_comp

protected theorem decode : computable (decode α) :=
primrec.decode.to_comp

protected theorem of_nat (α) [denumerable α] : computable (of_nat α) :=
(primrec.of_nat _).to_comp

theorem encode_iff {f : α → σ} : computable (λ a, encode (f a)) ↔ computable f :=
iff.rfl

theorem option_some : computable (@option.some α) :=
primrec.option_some.to_comp

end computable

namespace partrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

open computable

theorem of_eq {f g : α →. σ} (hf : partrec f) (H : ∀ n, f n = g n) : partrec g :=
(funext H : f = g) ▸ hf

theorem of_eq_tot {f : α →. σ} {g : α → σ}
  (hf : partrec f) (H : ∀ n, g n ∈ f n) : computable g :=
hf.of_eq (λ a, eq_some_iff.2 (H a))

theorem none : partrec (λ a : α, @roption.none σ) :=
nat.partrec.none.of_eq $ λ n, by cases decode α n; simp

protected theorem some : partrec (@roption.some α) := computable.id

theorem const' (s : roption σ) : partrec (λ a : α, s) :=
by haveI := classical.dec s.dom; exact
(of_option (const (to_option s))).of_eq (λ a, of_to_option s)

protected

theorem map {f : α →. β} {g : α → β → σ}
  (hf : partrec f) (hg : computable₂ g) : partrec (λ a, (f a).map (g a)) :=
by simpa [bind_some_eq_map] using
   @@partrec.bind _ _ _ (λ a b, roption.some (g a b)) hf hg

theorem to₂ {f : α × β →. σ} (hf : partrec f) : partrec₂ (λ a b, f (a, b)) :=
hf.of_eq $ λ ⟨a, b⟩, rfl

theorem nat_elim
  {f : α → ℕ} {g : α →. σ} {h : α → ℕ × σ →. σ}
  (hf : computable f) (hg : partrec g) (hh : partrec₂ h) :
  partrec (λ a, (f a).elim (g a) (λ y IH, IH.bind (λ i, h a (y, i)))) :=
(nat.partrec.prec' hf hg hh).of_eq $ λ n, begin
  cases e : decode α n with a; simp [e],
  induction f a with m IH; simp,
  rw [IH, bind_map],
  congr, funext s,
  simp [encodek]
end

theorem comp {f : β →. σ} {g : α → β}
  (hf : partrec f) (hg : computable g) : partrec (λ a, f (g a)) :=
(hf.comp hg).of_eq $
λ n, by simp; cases e : decode α n with a;
  simp [e, encodek]

theorem nat_iff {f : ℕ →. ℕ} : partrec f ↔ nat.partrec f :=
by simp [partrec, map_id']

theorem map_encode_iff {f : α →. σ} : partrec (λ a, (f a).map encode) ↔ partrec f :=
iff.rfl

end partrec

namespace partrec₂
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable δ] [primcodable σ]

theorem unpaired {f : ℕ → ℕ →. α} : partrec (nat.unpaired f) ↔ partrec₂ f :=
⟨λ h, by simpa using h.comp primrec₂.mkpair.to_comp,
 λ h, h.comp primrec.unpair.to_comp⟩

theorem unpaired' {f : ℕ → ℕ →. ℕ} : nat.partrec (nat.unpaired f) ↔ partrec₂ f :=
partrec.nat_iff.symm.trans unpaired

theorem comp
  {f : β → γ →. σ} {g : α → β} {h : α → γ}
  (hf : partrec₂ f) (hg : computable g) (hh : computable h) :
  partrec (λ a, f (g a) (h a)) := hf.comp (hg.pair hh)

theorem comp₂
  {f : γ → δ →. σ} {g : α → β → γ} {h : α → β → δ}
  (hf : partrec₂ f) (hg : computable₂ g) (hh : computable₂ h) :
  partrec₂ (λ a b, f (g a b) (h a b)) := hf.comp hg hh

end partrec₂

namespace computable
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

theorem comp {f : β → σ} {g : α → β}
  (hf : computable f) (hg : computable g) :
  computable (λ a, f (g a)) := hf.comp hg

theorem comp₂ {f : γ → σ} {g : α → β → γ}
  (hf : computable f) (hg : computable₂ g) :
  computable₂ (λ a b, f (g a b)) := hf.comp hg

end computable

namespace computable₂
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable δ] [primcodable σ]

theorem comp
  {f : β → γ → σ} {g : α → β} {h : α → γ}
  (hf : computable₂ f) (hg : computable g) (hh : computable h) :
  computable (λ a, f (g a) (h a)) := hf.comp (hg.pair hh)

theorem comp₂
  {f : γ → δ → σ} {g : α → β → γ} {h : α → β → δ}
  (hf : computable₂ f) (hg : computable₂ g) (hh : computable₂ h) :
  computable₂ (λ a b, f (g a b) (h a b)) := hf.comp hg hh

end computable₂

namespace partrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

open computable

theorem rfind {p : α → ℕ →. bool} (hp : partrec₂ p) :
  partrec (λ a, nat.rfind (p a)) :=
(nat.partrec.rfind $ hp.map
  ((primrec.dom_bool (λ b, cond b 0 1))
    .comp primrec.snd).to₂.to_comp).of_eq $
λ n, begin
  cases e : decode α n with a;
    simp [e, nat.rfind_zero_none, map_id'],
  congr, funext n,
  simp [roption.map_map, (∘)],
  apply map_id' (λ b, _),
  cases b; refl
end

theorem rfind_opt {f : α → ℕ → option σ} (hf : computable₂ f) :
  partrec (λ a, nat.rfind_opt (f a)) :=
(rfind (primrec.option_is_some.to_comp.comp hf).part.to₂).bind
  (of_option hf)

theorem nat_cases_right
  {f : α → ℕ} {g : α → σ} {h : α → ℕ →. σ}
  (hf : computable f) (hg : computable g) (hh : partrec₂ h) :
  partrec (λ a, (f a).cases (some (g a)) (h a)) :=
(nat_elim hf hg (hh.comp fst (pred.comp $ hf.comp fst)).to₂).of_eq $
λ a, begin
  simp, cases f a; simp,
  refine ext (λ b, ⟨λ H, _, λ H, _⟩),
  { rcases mem_bind_iff.1 H with ⟨c, h₁, h₂⟩, exact h₂ },
  { have : ∀ m, (nat.elim (roption.some (g a))
      (λ y IH, IH.bind (λ _, h a n)) m).dom,
    { intro, induction m; simp [*, H.fst] },
    exact ⟨⟨this n, H.fst⟩, H.snd⟩ }
end

theorem bind_decode2_iff {f : α →. σ} : partrec f ↔
  nat.partrec (λ n, roption.bind (decode2 α n) (λ a, (f a).map encode)) :=
⟨λ hf, nat_iff.1 $ (of_option primrec.decode2.to_comp).bind $
  (map hf (computable.encode.comp snd).to₂).comp snd,
λ h, map_encode_iff.1 $ by simpa [encodek2]
  using (nat_iff.2 h).comp (@computable.encode α _)⟩

theorem vector_m_of_fn : ∀ {n} {f : fin n → α →. σ}, (∀ i, partrec (f i)) →
  partrec (λ (a : α), vector.m_of_fn (λ i, f i a))
| 0     f hf := const _
| (n+1) f hf := by simp [vector.m_of_fn]; exact
  (hf 0).bind (partrec.bind ((vector_m_of_fn (λ i, hf i.succ)).comp fst)
    (primrec.vector_cons.to_comp.comp (snd.comp fst) snd))

end partrec

@[simp] theorem vector.m_of_fn_roption_some {α n} : ∀ (f : fin n → α),
  vector.m_of_fn (λ i, roption.some (f i)) = roption.some (vector.of_fn f) :=
vector.m_of_fn_pure

namespace computable
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

theorem option_some_iff {f : α → σ} : computable (λ a, some (f a)) ↔ computable f :=
⟨λ h, encode_iff.1 $ primrec.pred.to_comp.comp $ encode_iff.2 h,
 option_some.comp⟩

theorem bind_decode_iff {f : α → β → option σ} : computable₂ (λ a n,
  (decode β n).bind (f a)) ↔ computable₂ f :=
⟨λ hf, nat.partrec.of_eq
    (((partrec.nat_iff.2 (nat.partrec.ppred.comp $
        nat.partrec.of_primrec $ primcodable.prim β)).comp snd).bind
      (computable.comp hf fst).to₂.part) $
  λ n, by simp;
    cases decode α n.unpair.1; simp;
    cases decode β n.unpair.2; simp,
λ hf, begin
  have : partrec (λ a : α × ℕ, (encode (decode β a.2)).cases
    (some option.none) (λ n, roption.map (f a.1) (decode β n))) :=
  partrec.nat_cases_right (primrec.encdec.to_comp.comp snd)
    (const none) ((of_option (computable.decode.comp snd)).map
      (hf.comp (fst.comp $ fst.comp fst) snd).to₂),
  refine this.of_eq (λ a, _),
  simp, cases decode β a.2; simp [encodek]
end⟩

theorem map_decode_iff {f : α → β → σ} : computable₂ (λ a n,
  (decode β n).map (f a)) ↔ computable₂ f :=
bind_decode_iff.trans option_some_iff

theorem nat_elim
  {f : α → ℕ} {g : α → σ} {h : α → ℕ × σ → σ}
  (hf : computable f) (hg : computable g) (hh : computable₂ h) :
  computable (λ a, (f a).elim (g a) (λ y IH, h a (y, IH))) :=
(partrec.nat_elim hf hg hh.part).of_eq $
λ a, by simp; induction f a; simp *

theorem nat_cases {f : α → ℕ} {g : α → σ} {h : α → ℕ → σ}
  (hf : computable f) (hg : computable g) (hh : computable₂ h) :
  computable (λ a, (f a).cases (g a) (h a)) :=
nat_elim hf hg (hh.comp fst $ fst.comp snd).to₂

theorem cond {c : α → bool} {f : α → σ} {g : α → σ}
  (hc : computable c) (hf : computable f) (hg : computable g) :
  computable (λ a, cond (c a) (f a) (g a)) :=
(nat_cases (encode_iff.2 hc) hg (hf.comp fst).to₂).of_eq $
λ a, by cases c a; refl

theorem option_cases {o : α → option β} {f : α → σ} {g : α → β → σ}
  (ho : computable o) (hf : computable f) (hg : computable₂ g) :
  @computable _ σ _ _ (λ a, option.cases_on (o a) (f a) (g a)) :=
option_some_iff.1 $
(nat_cases (encode_iff.2 ho) (option_some_iff.2 hf)
    (map_decode_iff.2 hg)).of_eq $
λ a, by cases o a; simp [encodek]; refl

theorem option_bind {f : α → option β} {g : α → β → option σ}
  (hf : computable f) (hg : computable₂ g) :
  computable (λ a, (f a).bind (g a)) :=
(option_cases hf (const option.none) hg).of_eq $
λ a, by cases f a; refl

theorem option_map {f : α → option β} {g : α → β → σ}
  (hf : computable f) (hg : computable₂ g) : computable (λ a, (f a).map (g a)) :=
option_bind hf (option_some.comp₂ hg)

theorem option_get_or_else {f : α → option β} {g : α → β}
  (hf : computable f) (hg : computable g) :
  computable (λ a, (f a).get_or_else (g a)) :=
(computable.option_cases hf hg (show computable₂ (λ a b, b), from computable.snd)).of_eq $
λ a, by cases f a; refl

theorem subtype_mk {f : α → β} {p : β → Prop} [decidable_pred p] {h : ∀ a, p (f a)}
    (hp : primrec_pred p) (hf : computable f) :
  @computable _ _ _ (primcodable.subtype hp) (λ a, (⟨f a, h a⟩ : subtype p)) :=
hf

theorem sum_cases
  {f : α → β ⊕ γ} {g : α → β → σ} {h : α → γ → σ}
  (hf : computable f) (hg : computable₂ g) (hh : computable₂ h) :
  @computable _ σ _ _ (λ a, sum.cases_on (f a) (g a) (h a)) :=
option_some_iff.1 $
(cond (nat_bodd.comp $ encode_iff.2 hf)
  (option_map (computable.decode.comp $ nat_div2.comp $ encode_iff.2 hf) hh)
  (option_map (computable.decode.comp $ nat_div2.comp $ encode_iff.2 hf) hg)).of_eq $
λ a, by cases f a with b c;
  simp [nat.div2_bit, nat.bodd_bit, encodek]; refl

theorem nat_strong_rec
  (f : α → ℕ → σ) {g : α → list σ → option σ} (hg : computable₂ g)
  (H : ∀ a n, g a ((list.range n).map (f a)) = some (f a n)) : computable₂ f :=
suffices computable₂ (λ a n, (list.range n).map (f a)), from
  option_some_iff.1 $
  (list_nth.comp (this.comp fst (succ.comp snd)) snd).to₂.of_eq $
  λ a, by simp [list.nth_range (nat.lt_succ_self a.2)]; refl,
option_some_iff.1 $
(nat_elim snd (const (option.some [])) (to₂ $
  option_bind (snd.comp snd) $ to₂ $
  option_map
    (hg.comp (fst.comp $ fst.comp fst) snd)
    (to₂ $ list_concat.comp (snd.comp fst) snd))).of_eq $
λ a, begin
  simp, induction a.2 with n IH, {refl},
  simp [IH, H, list.range_succ]
end

theorem list_of_fn : ∀ {n} {f : fin n → α → σ},
  (∀ i, computable (f i)) → computable (λ a, list.of_fn (λ i, f i a))
| 0     f hf := const []
| (n+1) f hf := by simp [list.of_fn_succ]; exact
  list_cons.comp (hf 0) (list_of_fn (λ i, hf i.succ))

theorem vector_of_fn {n} {f : fin n → α → σ}
  (hf : ∀ i, computable (f i)) : computable (λ a, vector.of_fn (λ i, f i a)) :=
(partrec.vector_m_of_fn hf).of_eq $ λ a, by simp

end computable

namespace partrec
variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ]

open computable

theorem option_some_iff {f : α →. σ} :
  partrec (λ a, (f a).map option.some) ↔ partrec f :=
⟨λ h, (nat.partrec.ppred.comp h).of_eq $
   λ n, by simp [roption.bind_assoc, bind_some_eq_map],
 λ hf, hf.map (option_some.comp snd).to₂⟩

theorem option_cases_right {o : α → option β} {f : α → σ} {g : α → β →. σ}
  (ho : computable o) (hf : computable f) (hg : partrec₂ g) :
  @partrec _ σ _ _ (λ a, option.cases_on (o a) (some (f a)) (g a)) :=
have partrec (λ (a : α), nat.cases (roption.some (f a))
  (λ n, roption.bind (decode β n) (g a)) (encode (o a))) :=
nat_cases_right (encode_iff.2 ho) hf.part $
  ((@computable.decode β _).comp snd).of_option.bind
    (hg.comp (fst.comp fst) snd).to₂,
this.of_eq $ λ a, by cases o a with b; simp [encodek]

theorem sum_cases_right
  {f : α → β ⊕ γ} {g : α → β → σ} {h : α → γ →. σ}
  (hf : computable f) (hg : computable₂ g) (hh : partrec₂ h) :
  @partrec _ σ _ _ (λ a, sum.cases_on (f a) (λ b, some (g a b)) (h a)) :=
have partrec (λ a, (option.cases_on
  (sum.cases_on (f a) (λ b, option.none) option.some : option γ)
  (some (sum.cases_on (f a) (λ b, some (g a b))
     (λ c, option.none)))
  (λ c, (h a c).map option.some) : roption (option σ))) :=
option_cases_right
  (sum_cases hf (const option.none).to₂ (option_some.comp snd).to₂)
  (sum_cases hf (option_some.comp hg) (const option.none).to₂)
  (option_some_iff.2 hh),
option_some_iff.1 $ this.of_eq $ λ a, by cases f a; simp

theorem sum_cases_left
  {f : α → β ⊕ γ} {g : α → β →. σ} {h : α → γ → σ}
  (hf : computable f) (hg : partrec₂ g) (hh : computable₂ h) :
  @partrec _ σ _ _ (λ a, sum.cases_on (f a) (g a) (λ c, some (h a c))) :=
(sum_cases_right (sum_cases hf
  (sum_inr.comp snd).to₂ (sum_inl.comp snd).to₂) hh hg).of_eq $
λ a, by cases f a; simp

private lemma fix_aux
  {f : α →. σ ⊕ α} (hf : partrec f)
  (a : α) (b : σ) :
  let F : α → ℕ →. σ ⊕ α := λ a n,
    n.elim (some (sum.inr a)) $ λ y IH, IH.bind $ λ s,
    sum.cases_on s (λ _, roption.some s) f in
  (∃ (n : ℕ), ((∃ (b' : σ), sum.inl b' ∈ F a n) ∧
        ∀ {m : ℕ}, m < n → (∃ (b : α), sum.inr b ∈ F a m)) ∧
      sum.inl b ∈ F a n) ↔ b ∈ pfun.fix f a :=
begin
  intro, refine ⟨λ h, _, λ h, _⟩,
  { rcases h with ⟨n, ⟨_x, h₁⟩, h₂⟩,
    have : ∀ m a' (_: sum.inr a' ∈ F a m)
      (_: b ∈ pfun.fix f a'), b ∈ pfun.fix f a,
    { intros m a' am ba,
      induction m with m IH generalizing a'; simp [F] at am,
      { rwa ← am },
      rcases am with ⟨a₂, am₂, fa₂⟩,
      exact IH _ am₂ (pfun.mem_fix_iff.2 (or.inr ⟨_, fa₂, ba⟩)) },
    cases n; simp [F] at h₂, {cases h₂},
    rcases h₂ with h₂ | ⟨a', am', fa'⟩,
    { cases h₁ (nat.lt_succ_self _) with a' h,
      injection mem_unique h h₂ },
    { exact this _ _ am' (pfun.mem_fix_iff.2 (or.inl fa')) } },
  { suffices : ∀ a' (_: b ∈ pfun.fix f a') k (_: sum.inr a' ∈ F a k),
       ∃ n, sum.inl b ∈ F a n ∧
         ∀ (m < n) (_ : k ≤ m), ∃ a₂, sum.inr a₂ ∈ F a m,
    { rcases this _ h 0 (by simp [F]) with ⟨n, hn₁, hn₂⟩,
      exact ⟨_, ⟨⟨_, hn₁⟩, λ m mn, hn₂ m mn (nat.zero_le _)⟩, hn₁⟩ },
    intros a₁ h₁,
    apply pfun.fix_induction h₁, intros a₂ h₂ IH k hk,
    rcases pfun.mem_fix_iff.1 h₂ with h₂ | ⟨a₃, am₃, fa₃⟩,
    { refine ⟨k.succ, _, λ m mk km, ⟨a₂, _⟩⟩,
      { simp [F], exact or.inr ⟨_, hk, h₂⟩ },
      { rwa le_antisymm (nat.le_of_lt_succ mk) km } },
    { rcases IH _ fa₃ am₃ k.succ _ with ⟨n, hn₁, hn₂⟩,
      { refine ⟨n, hn₁, λ m mn km, _⟩,
        cases lt_or_eq_of_le km with km km,
        { exact hn₂ _ mn km },
        { exact km ▸ ⟨_, hk⟩ } },
      { simp [F], exact ⟨_, hk, am₃⟩ } } }
end

theorem fix
  {f : α →. σ ⊕ α} (hf : partrec f) : partrec (pfun.fix f) :=
let F : α → ℕ →. σ ⊕ α := λ a n,
  n.elim (some (sum.inr a)) $ λ y IH, IH.bind $ λ s,
  sum.cases_on s (λ _, roption.some s) f in
have hF : partrec₂ F :=
partrec.nat_elim snd (sum_inr.comp fst).part
  (sum_cases_right (snd.comp snd)
    (snd.comp $ snd.comp fst).to₂
    (hf.comp snd).to₂).to₂,
let p := λ a n, @roption.map _ bool
  (λ s, sum.cases_on s (λ_, tt) (λ _, ff)) (F a n) in
have hp : partrec₂ p := hF.map ((sum_cases computable.id
  (const tt).to₂ (const ff).to₂).comp snd).to₂,
(hp.rfind.bind (hF.bind
  (sum_cases_right snd snd.to₂ none.to₂).to₂).to₂).of_eq $
λ a, ext $ λ b, by simp; apply fix_aux hf

end partrec