/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.algebra.equiv
! leanprover-community/mathlib commit bd9851ca476957ea4549eb19b40e7b5ade9428cc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Hom

/-!
# Isomorphisms of `R`-algebras

This file defines bundled isomorphisms of `R`-algebras.

## Main definitions

* `AlgEquiv R A B`: the type of `R`-algebra isomorphisms between `A` and `B`.

## Notations

* `A ≃ₐ[R] B` : `R`-algebra equivalence from `A` to `B`.
-/

open BigOperators

universe u v w u₁ v₁

/-- An equivalence of algebras is an equivalence of rings commuting with the actions of scalars. -/
structure AlgEquiv (R : Type u) (A : Type v) (B : Type w) [CommSemiring R] [Semiring A] [Semiring B]
  [Algebra R A] [Algebra R B] extends A ≃ B, A ≃* B, A ≃+ B, A ≃+* B where
  /-- An equivalence of algebras commutes with the action of scalars. -/
  commutes' : ∀ r : R, toFun (algebraMap R A r) = algebraMap R B r
#align alg_equiv AlgEquiv

attribute [nolint docBlame] AlgEquiv.toRingEquiv
attribute [nolint docBlame] AlgEquiv.toEquiv
attribute [nolint docBlame] AlgEquiv.toAddEquiv
attribute [nolint docBlame] AlgEquiv.toMulEquiv

@[inherit_doc]
notation:50 A " ≃ₐ[" R "] " A' => AlgEquiv R A A'

/-- `AlgEquivClass F R A B` states that `F` is a type of algebra structure preserving
  equivalences. You should extend this class when you extend `AlgEquiv`. -/
class AlgEquivClass (F : Type _) (R A B : outParam (Type _)) [CommSemiring R] [Semiring A]
  [Semiring B] [Algebra R A] [Algebra R B] extends RingEquivClass F A B where
  /-- An equivalence of algebras commutes with the action of scalars. -/
  commutes : ∀ (f : F) (r : R), f (algebraMap R A r) = algebraMap R B r
#align alg_equiv_class AlgEquivClass

-- Porting note: Removed nolint dangerousInstance from AlgEquivClass.toRingEquivClass

namespace AlgEquivClass

-- Porting note: Replaced instances [...] with {_ : ...} below to make them not dangerous
-- See note [lower instance priority]
instance (priority := 100) toAlgHomClass (F R A B : Type _) {_ : CommSemiring R} {_ : Semiring A}
    {_ : Semiring B} {_ : Algebra R A} {_ : Algebra R B} [h : AlgEquivClass F R A B] :
    AlgHomClass F R A B :=
  { h with
    coe := (⇑)
    coe_injective' := FunLike.coe_injective
    map_zero := map_zero
    map_one := map_one }
#align alg_equiv_class.to_alg_hom_class AlgEquivClass.toAlgHomClass

instance (priority := 100) toLinearEquivClass (F R A B : Type _) {_ : CommSemiring R}
    {_ : Semiring A} {_ : Semiring B} {_ : Algebra R A} {_ : Algebra R B}
    [h : AlgEquivClass F R A B] : LinearEquivClass F R A B :=
  { h with map_smulₛₗ := fun f => map_smulₛₗ f }
#align alg_equiv_class.to_linear_equiv_class AlgEquivClass.toLinearEquivClass

instance (F R A B : Type _) [CommSemiring R] [Semiring A] [Semiring B] [Algebra R A] [Algebra R B]
    [_h : AlgEquivClass F R A B] : CoeTC F (A ≃ₐ[R] B) where
  coe f :=
    { (f : A ≃+* B) with
      toFun := f
      invFun := EquivLike.inv f
      commutes' := AlgHomClass.commutes f }
end AlgEquivClass

namespace AlgEquiv

variable {R : Type u} {A₁ : Type v} {A₂ : Type w} {A₃ : Type u₁}

section Semiring

variable [CommSemiring R] [Semiring A₁] [Semiring A₂] [Semiring A₃]

variable [Algebra R A₁] [Algebra R A₂] [Algebra R A₃]

variable (e : A₁ ≃ₐ[R] A₂)

instance : AlgEquivClass (A₁ ≃ₐ[R] A₂) R A₁ A₂ where
  coe f := f.toFun
  inv f := f.invFun
  coe_injective' f g h₁ h₂ := by
    obtain ⟨⟨f,_⟩,_⟩ := f
    obtain ⟨⟨g,_⟩,_⟩ := g
    congr
  map_add := map_add'
  map_mul := map_mul'
  commutes := commutes'
  left_inv f := f.left_inv
  right_inv f := f.right_inv

-- Porting note: replaced with EquivLike instance
-- /-- Helper instance for when there's too many metavariables to apply
-- `fun_like.has_coe_to_fun` directly. -/
-- instance : CoeFun (A₁ ≃ₐ[R] A₂) fun _ => A₁ → A₂ :=
--   ⟨AlgEquiv.toFun⟩

instance : EquivLike (A₁ ≃ₐ[R] A₂) A₁ A₂ where
  coe f := f.toFun
  inv f := f.invFun
  left_inv f := f.left_inv
  right_inv f := f.right_inv
  coe_injective' f g h₁ h₂ := by
    obtain ⟨⟨f,_⟩,_⟩ := f
    obtain ⟨⟨g,_⟩,_⟩ := g
    congr

-- Porting note: the default simps projection was `e.toEquiv.toFun`, it should be `FunLike.coe`
/-- See Note [custom simps projection] -/
def Simps.apply (e : A₁ ≃ₐ[R] A₂) : A₁ → A₂ :=
  e

-- Porting note: the default simps projection was `e.toEquiv`, it should be `EquivLike.toEquiv`
/-- See Note [custom simps projection] -/
def Simps.toEquiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ A₂ :=
  e

-- Porting note: `protected` used to be an attribute below
@[simp]
protected theorem coe_coe {F : Type _} [AlgEquivClass F R A₁ A₂] (f : F) :
    ⇑(f : A₁ ≃ₐ[R] A₂) = f :=
  rfl
#align alg_equiv.coe_coe AlgEquiv.coe_coe

@[ext]
theorem ext {f g : A₁ ≃ₐ[R] A₂} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align alg_equiv.ext AlgEquiv.ext

protected theorem congr_arg {f : A₁ ≃ₐ[R] A₂} {x x' : A₁} : x = x' → f x = f x' :=
  FunLike.congr_arg f
#align alg_equiv.congr_arg AlgEquiv.congr_arg

protected theorem congr_fun {f g : A₁ ≃ₐ[R] A₂} (h : f = g) (x : A₁) : f x = g x :=
  FunLike.congr_fun h x
#align alg_equiv.congr_fun AlgEquiv.congr_fun

protected theorem ext_iff {f g : A₁ ≃ₐ[R] A₂} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align alg_equiv.ext_iff AlgEquiv.ext_iff

theorem coe_fun_injective : @Function.Injective (A₁ ≃ₐ[R] A₂) (A₁ → A₂) fun e => (e : A₁ → A₂) :=
  FunLike.coe_injective
#align alg_equiv.coe_fun_injective AlgEquiv.coe_fun_injective

-- Porting note: Made to CoeOut instance from Coe, not dangerous anymore
instance hasCoeToRingEquiv : CoeOut (A₁ ≃ₐ[R] A₂) (A₁ ≃+* A₂) :=
  ⟨AlgEquiv.toRingEquiv⟩
#align alg_equiv.has_coe_to_ring_equiv AlgEquiv.hasCoeToRingEquiv

@[simp]
theorem coe_mk {toFun invFun left_inv right_inv map_mul map_add commutes} :
    ⇑(⟨⟨toFun, invFun, left_inv, right_inv⟩, map_mul, map_add, commutes⟩ : A₁ ≃ₐ[R] A₂) = toFun :=
  rfl
#align alg_equiv.coe_mk AlgEquiv.coe_mk

@[simp]
theorem mk_coe (e : A₁ ≃ₐ[R] A₂) (e' h₁ h₂ h₃ h₄ h₅) :
    (⟨⟨e, e', h₁, h₂⟩, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂) = e :=
  ext fun _ => rfl
#align alg_equiv.mk_coe AlgEquiv.mk_coe

-- Porting note: `toFun_eq_coe` no longer needed in Lean4
#noalign alg_equiv.to_fun_eq_coe

@[simp]
theorem toEquiv_eq_coe : e.toEquiv = e :=
  rfl
#align alg_equiv.to_equiv_eq_coe AlgEquiv.toEquiv_eq_coe

@[simp]
theorem toRingEquiv_eq_coe : e.toRingEquiv = e :=
  rfl
#align alg_equiv.to_ring_equiv_eq_coe AlgEquiv.toRingEquiv_eq_coe

@[simp, norm_cast]
theorem coe_ringEquiv : ((e : A₁ ≃+* A₂) : A₁ → A₂) = e :=
  rfl
#align alg_equiv.coe_ring_equiv AlgEquiv.coe_ringEquiv

theorem coe_ringEquiv' : (e.toRingEquiv : A₁ → A₂) = e :=
  rfl
#align alg_equiv.coe_ring_equiv' AlgEquiv.coe_ringEquiv'

theorem coe_ringEquiv_injective : Function.Injective ((↑) : (A₁ ≃ₐ[R] A₂) → A₁ ≃+* A₂) :=
  fun _ _ h => ext <| RingEquiv.congr_fun h
#align alg_equiv.coe_ring_equiv_injective AlgEquiv.coe_ringEquiv_injective

protected

protected theorem map_zero : e 0 = 0 :=
  map_zero e
#align alg_equiv.map_zero AlgEquiv.map_zero

protected theorem map_mul : ∀ x y, e (x * y) = e x * e y :=
  map_mul e
#align alg_equiv.map_mul AlgEquiv.map_mul

protected theorem map_one : e 1 = 1 :=
  map_one e
#align alg_equiv.map_one AlgEquiv.map_one

@[simp]
theorem commutes : ∀ r : R, e (algebraMap R A₁ r) = algebraMap R A₂ r :=
  e.commutes'
#align alg_equiv.commutes AlgEquiv.commutes

-- @[simp] -- Porting note: simp can prove this
theorem map_smul (r : R) (x : A₁) : e (r • x) = r • e x := by
  simp only [Algebra.smul_def, map_mul, commutes]
#align alg_equiv.map_smul AlgEquiv.map_smul

theorem map_sum {ι : Type _} (f : ι → A₁) (s : Finset ι) : e (∑ x in s, f x) = ∑ x in s, e (f x) :=
  e.toAddEquiv.map_sum f s
#align alg_equiv.map_sum AlgEquiv.map_sum

theorem map_finsupp_sum {α : Type _} [Zero α] {ι : Type _} (f : ι →₀ α) (g : ι → α → A₁) :
    e (f.sum g) = f.sum fun i b => e (g i b) :=
  e.map_sum _ _
#align alg_equiv.map_finsupp_sum AlgEquiv.map_finsupp_sum

-- Porting note: Added [coe] attribute
/-- Interpret an algebra equivalence as an algebra homomorphism.

This definition is included for symmetry with the other `to*Hom` projections.
The `simp` normal form is to use the coercion of the `AlgHomClass.coeTC` instance. -/
@[coe]
def toAlgHom : A₁ →ₐ[R] A₂ :=
  { e with
    map_one' := e.map_one
    map_zero' := e.map_zero }
#align alg_equiv.to_alg_hom AlgEquiv.toAlgHom

@[simp]
theorem toAlgHom_eq_coe : e.toAlgHom = e :=
  rfl
#align alg_equiv.to_alg_hom_eq_coe AlgEquiv.toAlgHom_eq_coe

@[simp, norm_cast]
theorem coe_algHom : FunLike.coe (e.toAlgHom) = FunLike.coe e :=
  rfl
#align alg_equiv.coe_alg_hom AlgEquiv.coe_algHom

theorem coe_algHom_injective : Function.Injective ((↑) : (A₁ ≃ₐ[R] A₂) → A₁ →ₐ[R] A₂) :=
  fun _ _ h => ext <| AlgHom.congr_fun h
#align alg_equiv.coe_alg_hom_injective AlgEquiv.coe_algHom_injective

/-- The two paths coercion can take to a `RingHom` are equivalent -/
theorem coe_ringHom_commutes : ((e : A₁ →ₐ[R] A₂) : A₁ →+* A₂) = ((e : A₁ ≃+* A₂) : A₁ →+* A₂) :=
  rfl
#align alg_equiv.coe_ring_hom_commutes AlgEquiv.coe_ringHom_commutes

protected theorem map_pow : ∀ (x : A₁) (n : ℕ), e (x ^ n) = e x ^ n :=
  map_pow _
#align alg_equiv.map_pow AlgEquiv.map_pow

protected theorem injective : Function.Injective e :=
  EquivLike.injective e
#align alg_equiv.injective AlgEquiv.injective

protected theorem surjective : Function.Surjective e :=
  EquivLike.surjective e
#align alg_equiv.surjective AlgEquiv.surjective

protected theorem bijective : Function.Bijective e :=
  EquivLike.bijective e
#align alg_equiv.bijective AlgEquiv.bijective

/-- Algebra equivalences are reflexive. -/
@[refl]
def refl : A₁ ≃ₐ[R] A₁ :=
  { (1 : A₁ ≃+* A₁) with commutes' := fun _ => rfl }
#align alg_equiv.refl AlgEquiv.refl

instance : Inhabited (A₁ ≃ₐ[R] A₁) :=
  ⟨refl⟩

@[simp]
theorem refl_to_algHom : ↑(refl : A₁ ≃ₐ[R] A₁) = AlgHom.id R A₁ :=
  rfl
#align alg_equiv.refl_to_alg_hom AlgEquiv.refl_to_algHom

@[simp]
theorem coe_refl : ⇑(refl : A₁ ≃ₐ[R] A₁) = id :=
  rfl
#align alg_equiv.coe_refl AlgEquiv.coe_refl

/-- Algebra equivalences are symmetric. -/
@[symm]
def symm (e : A₁ ≃ₐ[R] A₂) : A₂ ≃ₐ[R] A₁ :=
  { e.toRingEquiv.symm with
    commutes' := fun r =>
      by
      rw [← e.toRingEquiv.symm_apply_apply (algebraMap R A₁ r)]
      congr
      change _ = e _
      rw [e.commutes] }
#align alg_equiv.symm AlgEquiv.symm

/-- See Note [custom simps projection] -/
def Simps.symm_apply (e : A₁ ≃ₐ[R] A₂) : A₂ → A₁ :=
  e.symm
#align alg_equiv.simps.symm_apply AlgEquiv.Simps.symm_apply

initialize_simps_projections AlgEquiv (toFun → apply, invFun → symm_apply)

--@[simp] -- Porting note: simp can prove this once symm_mk is introduced
theorem coe_apply_coe_coe_symm_apply {F : Type _} [AlgEquivClass F R A₁ A₂] (f : F) (x : A₂) :
    f ((f : A₁ ≃ₐ[R] A₂).symm x) = x :=
  EquivLike.right_inv f x
#align alg_equiv.coe_apply_coe_coe_symm_apply AlgEquiv.coe_apply_coe_coe_symm_apply

--@[simp] -- Porting note: simp can prove this once symm_mk is introduced
theorem coe_coe_symm_apply_coe_apply {F : Type _} [AlgEquivClass F R A₁ A₂] (f : F) (x : A₁) :
    (f : A₁ ≃ₐ[R] A₂).symm (f x) = x :=
  EquivLike.left_inv f x
#align alg_equiv.coe_coe_symm_apply_coe_apply AlgEquiv.coe_coe_symm_apply_coe_apply

-- Porting note: `simp` normal form of `invFun_eq_symm`
@[simp]
theorem symm_toEquiv_eq_symm {e : A₁ ≃ₐ[R] A₂} : (e : A₁ ≃ A₂).symm = e.symm :=
  rfl

theorem invFun_eq_symm {e : A₁ ≃ₐ[R] A₂} : e.invFun = e.symm :=
  rfl
#align alg_equiv.inv_fun_eq_symm AlgEquiv.invFun_eq_symm

@[simp]
theorem symm_symm (e : A₁ ≃ₐ[R] A₂) : e.symm.symm = e := by
  ext
  rfl
#align alg_equiv.symm_symm AlgEquiv.symm_symm

theorem symm_bijective : Function.Bijective (symm : (A₁ ≃ₐ[R] A₂) → A₂ ≃ₐ[R] A₁) :=
  Equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩
#align alg_equiv.symm_bijective AlgEquiv.symm_bijective

@[simp]
theorem mk_coe' (e : A₁ ≃ₐ[R] A₂) (f h₁ h₂ h₃ h₄ h₅) :
    (⟨⟨f, e, h₁, h₂⟩, h₃, h₄, h₅⟩ : A₂ ≃ₐ[R] A₁) = e.symm :=
  symm_bijective.injective <| ext fun _ => rfl
#align alg_equiv.mk_coe' AlgEquiv.mk_coe'

@[simp]
theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅) :
    (⟨⟨f, f', h₁, h₂⟩, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm =
      {(⟨⟨f, f', h₁, h₂⟩, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm with
        toFun := f'
        invFun := f } :=
  rfl
#align alg_equiv.symm_mk AlgEquiv.symm_mk

@[simp]
theorem refl_symm : (AlgEquiv.refl : A₁ ≃ₐ[R] A₁).symm = AlgEquiv.refl :=
  rfl
#align alg_equiv.refl_symm AlgEquiv.refl_symm

--this should be a simp lemma but causes a lint timeout
theorem to_ringEquiv_symm (f : A₁ ≃ₐ[R] A₁) : (f : A₁ ≃+* A₁).symm = f.symm :=
  rfl
#align alg_equiv.to_ring_equiv_symm AlgEquiv.to_ringEquiv_symm

@[simp]
theorem symm_to_ringEquiv : (e.symm : A₂ ≃+* A₁) = (e : A₁ ≃+* A₂).symm :=
  rfl
#align alg_equiv.symm_to_ring_equiv AlgEquiv.symm_to_ringEquiv

/-- Algebra equivalences are transitive. -/
@[trans]
def trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : A₁ ≃ₐ[R] A₃ :=
  { e₁.toRingEquiv.trans e₂.toRingEquiv with
    commutes' := fun r => show e₂.toFun (e₁.toFun _) = _ by rw [e₁.commutes', e₂.commutes'] }
#align alg_equiv.trans AlgEquiv.trans

@[simp]
theorem apply_symm_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e (e.symm x) = x :=
  e.toEquiv.apply_symm_apply
#align alg_equiv.apply_symm_apply AlgEquiv.apply_symm_apply

@[simp]
theorem symm_apply_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e.symm (e x) = x :=
  e.toEquiv.symm_apply_apply
#align alg_equiv.symm_apply_apply AlgEquiv.symm_apply_apply

@[simp]
theorem symm_trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₃) :
    (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) :=
  rfl
#align alg_equiv.symm_trans_apply AlgEquiv.symm_trans_apply

@[simp]
theorem coe_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ :=
  rfl
#align alg_equiv.coe_trans AlgEquiv.coe_trans

@[simp]
theorem trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₁) : (e₁.trans e₂) x = e₂ (e₁ x) :=
  rfl
#align alg_equiv.trans_apply AlgEquiv.trans_apply

@[simp]
theorem comp_symm (e : A₁ ≃ₐ[R] A₂) : AlgHom.comp (e : A₁ →ₐ[R] A₂) ↑e.symm = AlgHom.id R A₂ := by
  ext
  simp
#align alg_equiv.comp_symm AlgEquiv.comp_symm

@[simp]
theorem symm_comp (e : A₁ ≃ₐ[R] A₂) : AlgHom.comp ↑e.symm (e : A₁ →ₐ[R] A₂) = AlgHom.id R A₁ := by
  ext
  simp
#align alg_equiv.symm_comp AlgEquiv.symm_comp

theorem leftInverse_symm (e : A₁ ≃ₐ[R] A₂) : Function.LeftInverse e.symm e :=
  e.left_inv
#align alg_equiv.left_inverse_symm AlgEquiv.leftInverse_symm

theorem rightInverse_symm (e : A₁ ≃ₐ[R] A₂) : Function.RightInverse e.symm e :=
  e.right_inv
#align alg_equiv.right_inverse_symm AlgEquiv.rightInverse_symm

/-- If `A₁` is equivalent to `A₁'` and `A₂` is equivalent to `A₂'`, then the type of maps
`A₁ →ₐ[R] A₂` is equivalent to the type of maps `A₁' →ₐ[R] A₂'`. -/
def arrowCongr {A₁' A₂' : Type _} [Semiring A₁'] [Semiring A₂'] [Algebra R A₁'] [Algebra R A₂']
    (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : (A₁ →ₐ[R] A₂) ≃ (A₁' →ₐ[R] A₂')
    where
  toFun f := (e₂.toAlgHom.comp f).comp e₁.symm.toAlgHom
  invFun f := (e₂.symm.toAlgHom.comp f).comp e₁.toAlgHom
  left_inv f := by
    simp only [AlgHom.comp_assoc, toAlgHom_eq_coe, symm_comp]
    simp only [← AlgHom.comp_assoc, symm_comp, AlgHom.id_comp, AlgHom.comp_id]
  right_inv f := by
    simp only [AlgHom.comp_assoc, toAlgHom_eq_coe, comp_symm]
    simp only [← AlgHom.comp_assoc, comp_symm, AlgHom.id_comp, AlgHom.comp_id]
#align alg_equiv.arrow_congr AlgEquiv.arrowCongr

theorem arrowCongr_comp {A₁' A₂' A₃' : Type _} [Semiring A₁'] [Semiring A₂'] [Semiring A₃']
    [Algebra R A₁'] [Algebra R A₂'] [Algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂')
    (e₃ : A₃ ≃ₐ[R] A₃') (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₃) :
    arrowCongr e₁ e₃ (g.comp f) = (arrowCongr e₂ e₃ g).comp (arrowCongr e₁ e₂ f) := by
  ext
  simp only [arrowCongr, Equiv.coe_fn_mk, AlgHom.comp_apply]
  congr
  exact (e₂.symm_apply_apply _).symm
#align alg_equiv.arrow_congr_comp AlgEquiv.arrowCongr_comp

@[simp]
theorem arrowCongr_refl : arrowCongr AlgEquiv.refl AlgEquiv.refl = Equiv.refl (A₁ →ₐ[R] A₂) := by
  ext
  rfl
#align alg_equiv.arrow_congr_refl AlgEquiv.arrowCongr_refl

@[simp]
theorem arrowCongr_trans {A₁' A₂' A₃' : Type _} [Semiring A₁'] [Semiring A₂'] [Semiring A₃']
    [Algebra R A₁'] [Algebra R A₂'] [Algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₂) (e₁' : A₁' ≃ₐ[R] A₂')
    (e₂ : A₂ ≃ₐ[R] A₃) (e₂' : A₂' ≃ₐ[R] A₃') :
    arrowCongr (e₁.trans e₂) (e₁'.trans e₂') = (arrowCongr e₁ e₁').trans (arrowCongr e₂ e₂') := by
  ext
  rfl
#align alg_equiv.arrow_congr_trans AlgEquiv.arrowCongr_trans

@[simp]
theorem arrowCongr_symm {A₁' A₂' : Type _} [Semiring A₁'] [Semiring A₂'] [Algebra R A₁']
    [Algebra R A₂'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') :
    (arrowCongr e₁ e₂).symm = arrowCongr e₁.symm e₂.symm := by
  ext
  rfl
#align alg_equiv.arrow_congr_symm AlgEquiv.arrowCongr_symm

/-- If an algebra morphism has an inverse, it is a algebra isomorphism. -/
def ofAlgHom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ : f.comp g = AlgHom.id R A₂)
    (h₂ : g.comp f = AlgHom.id R A₁) : A₁ ≃ₐ[R] A₂ :=
  { f with
    toFun := f
    invFun := g
    left_inv := AlgHom.ext_iff.1 h₂
    right_inv := AlgHom.ext_iff.1 h₁ }
#align alg_equiv.of_alg_hom AlgEquiv.ofAlgHom

theorem coe_algHom_ofAlgHom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
    ↑(ofAlgHom f g h₁ h₂) = f :=
  AlgHom.ext fun _ => rfl
#align alg_equiv.coe_alg_hom_of_alg_hom AlgEquiv.coe_algHom_ofAlgHom

@[simp]
theorem ofAlgHom_coe_algHom (f : A₁ ≃ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
    ofAlgHom (↑f) g h₁ h₂ = f :=
  ext fun _ => rfl
#align alg_equiv.of_alg_hom_coe_alg_hom AlgEquiv.ofAlgHom_coe_algHom

theorem ofAlgHom_symm (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
    (ofAlgHom f g h₁ h₂).symm = ofAlgHom g f h₂ h₁ :=
  rfl
#align alg_equiv.of_alg_hom_symm AlgEquiv.ofAlgHom_symm

/-- Promotes a bijective algebra homomorphism to an algebra equivalence. -/
noncomputable def ofBijective (f : A₁ →ₐ[R] A₂) (hf : Function.Bijective f) : A₁ ≃ₐ[R] A₂ :=
  { RingEquiv.ofBijective (f : A₁ →+* A₂) hf, f with }
#align alg_equiv.of_bijective AlgEquiv.ofBijective

@[simp]
theorem coe_ofBijective {f : A₁ →ₐ[R] A₂} {hf : Function.Bijective f} :
    (AlgEquiv.ofBijective f hf : A₁ → A₂) = f :=
  rfl
#align alg_equiv.coe_of_bijective AlgEquiv.coe_ofBijective

theorem ofBijective_apply {f : A₁ →ₐ[R] A₂} {hf : Function.Bijective f} (a : A₁) :
    (AlgEquiv.ofBijective f hf) a = f a :=
  rfl
#align alg_equiv.of_bijective_apply AlgEquiv.ofBijective_apply

/-- Forgetting the multiplicative structures, an equivalence of algebras is a linear equivalence. -/
-- Porting note: writing the `@[simps apply]`-generated lemma by hand
-- Maybe fixed by the changes in #2435?
def toLinearEquiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ₗ[R] A₂ :=
  { e with
    toFun := e
    map_smul' := e.map_smul
    invFun := e.symm }
#align alg_equiv.to_linear_equiv AlgEquiv.toLinearEquiv

-- Porting note: writing the `@[simps apply]`-generated lemma by hand
-- Maybe fixed by the changes in #2435?
@[simp]
theorem toLinearEquiv_apply : e.toLinearEquiv x = e x :=
  rfl
#align alg_equiv.to_linear_equiv_apply AlgEquiv.toLinearEquiv_apply

@[simp]
theorem toLinearEquiv_refl : (AlgEquiv.refl : A₁ ≃ₐ[R] A₁).toLinearEquiv = LinearEquiv.refl R A₁ :=
  rfl
#align alg_equiv.to_linear_equiv_refl AlgEquiv.toLinearEquiv_refl

@[simp]
theorem toLinearEquiv_symm (e : A₁ ≃ₐ[R] A₂) : e.toLinearEquiv.symm = e.symm.toLinearEquiv :=
  rfl
#align alg_equiv.to_linear_equiv_symm AlgEquiv.toLinearEquiv_symm

@[simp]
theorem toLinearEquiv_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
    (e₁.trans e₂).toLinearEquiv = e₁.toLinearEquiv.trans e₂.toLinearEquiv :=
  rfl
#align alg_equiv.to_linear_equiv_trans AlgEquiv.toLinearEquiv_trans

theorem toLinearEquiv_injective : Function.Injective (toLinearEquiv : _ → A₁ ≃ₗ[R] A₂) :=
  fun _ _ h => ext <| LinearEquiv.congr_fun h
#align alg_equiv.to_linear_equiv_injective AlgEquiv.toLinearEquiv_injective

/-- Interpret an algebra equivalence as a linear map. -/
def toLinearMap : A₁ →ₗ[R] A₂ :=
  e.toAlgHom.toLinearMap
#align alg_equiv.to_linear_map AlgEquiv.toLinearMap

@[simp]
theorem to_algHom_toLinearMap : (e : A₁ →ₐ[R] A₂).toLinearMap = e.toLinearMap :=
  rfl
#align alg_equiv.to_alg_hom_to_linear_map AlgEquiv.to_algHom_toLinearMap

@[simp]
theorem toLinearEquiv_toLinearMap : e.toLinearEquiv.toLinearMap = e.toLinearMap :=
  rfl
#align alg_equiv.to_linear_equiv_to_linear_map AlgEquiv.toLinearEquiv_toLinearMap

@[simp]
theorem toLinearMap_apply (x : A₁) : e.toLinearMap x = e x :=
  rfl
#align alg_equiv.to_linear_map_apply AlgEquiv.toLinearMap_apply

theorem toLinearMap_injective : Function.Injective (toLinearMap : _ → A₁ →ₗ[R] A₂) := fun _ _ h =>
  ext <| LinearMap.congr_fun h
#align alg_equiv.to_linear_map_injective AlgEquiv.toLinearMap_injective

@[simp]
theorem trans_toLinearMap (f : A₁ ≃ₐ[R] A₂) (g : A₂ ≃ₐ[R] A₃) :
    (f.trans g).toLinearMap = g.toLinearMap.comp f.toLinearMap :=
  rfl
#align alg_equiv.trans_to_linear_map AlgEquiv.trans_toLinearMap

section OfLinearEquiv

variable (l : A₁ ≃ₗ[R] A₂) (map_mul : ∀ x y : A₁, l (x * y) = l x * l y)
  (commutes : ∀ r : R, l (algebraMap R A₁ r) = algebraMap R A₂ r)

/-- Upgrade a linear equivalence to an algebra equivalence,
given that it distributes over multiplication and action of scalars.
-/
@[simps apply]
def ofLinearEquiv : A₁ ≃ₐ[R] A₂ :=
  { l with
    toFun := l
    invFun := l.symm
    map_mul' := map_mul
    commutes' := commutes }
#align alg_equiv.of_linear_equiv AlgEquiv.ofLinearEquiv

@[simp]
theorem ofLinearEquiv_symm :
    (ofLinearEquiv l map_mul commutes).symm =
      ofLinearEquiv l.symm (ofLinearEquiv l map_mul commutes).symm.map_mul
        (ofLinearEquiv l map_mul commutes).symm.commutes :=
  rfl
#align alg_equiv.of_linear_equiv_symm AlgEquiv.ofLinearEquiv_symm

@[simp]
theorem ofLinearEquiv_toLinearEquiv (map_mul) (commutes) :
    ofLinearEquiv e.toLinearEquiv map_mul commutes = e := by
  ext
  rfl
#align alg_equiv.of_linear_equiv_to_linear_equiv AlgEquiv.ofLinearEquiv_toLinearEquiv

@[simp]
theorem toLinearEquiv_ofLinearEquiv : toLinearEquiv (ofLinearEquiv l map_mul commutes) = l := by
  ext
  rfl
#align alg_equiv.to_linear_equiv_of_linear_equiv AlgEquiv.toLinearEquiv_ofLinearEquiv

end OfLinearEquiv

section OfRingEquiv

/-- Promotes a linear ring_equiv to an AlgEquiv. -/
@[simps apply symm_apply toEquiv] -- Porting note: don't want redundant `toEquiv_symm_apply` simps
def ofRingEquiv {f : A₁ ≃+* A₂} (hf : ∀ x, f (algebraMap R A₁ x) = algebraMap R A₂ x) :
    A₁ ≃ₐ[R] A₂ :=
  { f with
    toFun := f
    invFun := f.symm
    commutes' := hf }
#align alg_equiv.of_ring_equiv AlgEquiv.ofRingEquiv

end OfRingEquiv

-- Porting note: projections mul & one not found, removed [simps] and added theorems manually
-- @[simps (config := .lemmasOnly) one]
instance aut : Group (A₁ ≃ₐ[R] A₁) where
  mul ϕ ψ := ψ.trans ϕ
  mul_assoc ϕ ψ χ := rfl
  one := refl
  one_mul ϕ := ext fun x => rfl
  mul_one ϕ := ext fun x => rfl
  inv := symm
  mul_left_inv ϕ := ext <| symm_apply_apply ϕ
#align alg_equiv.aut AlgEquiv.aut

theorem aut_mul (ϕ ψ : A₁ ≃ₐ[R] A₁): ϕ * ψ = ψ.trans ϕ :=
  rfl

theorem aut_one : 1 = AlgEquiv.refl (R:= R) (A₁ := A₁) :=
  rfl

@[simp]
theorem one_apply (x : A₁) : (1 : A₁ ≃ₐ[R] A₁) x = x :=
  rfl
#align alg_equiv.one_apply AlgEquiv.one_apply

@[simp]
theorem mul_apply (e₁ e₂ : A₁ ≃ₐ[R] A₁) (x : A₁) : (e₁ * e₂) x = e₁ (e₂ x) :=
  rfl
#align alg_equiv.mul_apply AlgEquiv.mul_apply

/-- An algebra isomorphism induces a group isomorphism between automorphism groups -/
@[simps apply]
def autCongr (ϕ : A₁ ≃ₐ[R] A₂) : (A₁ ≃ₐ[R] A₁) ≃* A₂ ≃ₐ[R] A₂
    where
  toFun ψ := ϕ.symm.trans (ψ.trans ϕ)
  invFun ψ := ϕ.trans (ψ.trans ϕ.symm)
  left_inv ψ := by
    ext
    simp_rw [trans_apply, symm_apply_apply]
  right_inv ψ := by
    ext
    simp_rw [trans_apply, apply_symm_apply]
  map_mul' ψ χ := by
    ext
    simp only [mul_apply, trans_apply, symm_apply_apply]
#align alg_equiv.aut_congr AlgEquiv.autCongr

@[simp]
theorem autCongr_refl : autCongr AlgEquiv.refl = MulEquiv.refl (A₁ ≃ₐ[R] A₁) := by
  ext
  rfl
#align alg_equiv.aut_congr_refl AlgEquiv.autCongr_refl

@[simp]
theorem autCongr_symm (ϕ : A₁ ≃ₐ[R] A₂) : (autCongr ϕ).symm = autCongr ϕ.symm :=
  rfl
#align alg_equiv.aut_congr_symm AlgEquiv.autCongr_symm

@[simp]
theorem autCongr_trans (ϕ : A₁ ≃ₐ[R] A₂) (ψ : A₂ ≃ₐ[R] A₃) :
    (autCongr ϕ).trans (autCongr ψ) = autCongr (ϕ.trans ψ) :=
  rfl
#align alg_equiv.aut_congr_trans AlgEquiv.autCongr_trans

/-- The tautological action by `A₁ ≃ₐ[R] A₁` on `A₁`.

This generalizes `function.End.apply_mul_action`. -/
instance applyMulSemiringAction : MulSemiringAction (A₁ ≃ₐ[R] A₁) A₁
    where
  smul := (· <| ·)
  smul_zero := AlgEquiv.map_zero
  smul_add := AlgEquiv.map_add
  smul_one := AlgEquiv.map_one
  smul_mul := AlgEquiv.map_mul
  one_smul _ := rfl
  mul_smul _ _ _ := rfl
#align alg_equiv.apply_mul_semiring_action AlgEquiv.applyMulSemiringAction

@[simp]
protected theorem smul_def (f : A₁ ≃ₐ[R] A₁) (a : A₁) : f • a = f a :=
  rfl
#align alg_equiv.smul_def AlgEquiv.smul_def

instance apply_faithfulSMul : FaithfulSMul (A₁ ≃ₐ[R] A₁) A₁ :=
  ⟨AlgEquiv.ext⟩
#align alg_equiv.apply_has_faithful_smul AlgEquiv.apply_faithfulSMul

instance apply_smulCommClass : SMulCommClass R (A₁ ≃ₐ[R] A₁) A₁
    where smul_comm r e a := (e.map_smul r a).symm
#align alg_equiv.apply_smul_comm_class AlgEquiv.apply_smulCommClass

instance apply_smulCommClass' : SMulCommClass (A₁ ≃ₐ[R] A₁) R A₁
    where smul_comm e r a := e.map_smul r a
#align alg_equiv.apply_smul_comm_class' AlgEquiv.apply_smulCommClass'

@[simp]
theorem algebraMap_eq_apply (e : A₁ ≃ₐ[R] A₂) {y : R} {x : A₁} :
    algebraMap R A₂ y = e x ↔ algebraMap R A₁ y = x :=
  ⟨fun h => by simpa using e.symm.toAlgHom.algebraMap_eq_apply h, fun h =>
    e.toAlgHom.algebraMap_eq_apply h⟩
#align alg_equiv.algebra_map_eq_apply AlgEquiv.algebraMap_eq_apply

end Semiring

section CommSemiring

variable [CommSemiring R] [CommSemiring A₁] [CommSemiring A₂]

variable [Algebra R A₁] [Algebra R A₂] (e : A₁ ≃ₐ[R] A₂)

-- Porting note: Added nonrec
nonrec theorem map_prod {ι : Type _} (f : ι → A₁) (s : Finset ι) :
    e (∏ x in s, f x) = ∏ x in s, e (f x) :=
  map_prod _ f s
#align alg_equiv.map_prod AlgEquiv.map_prod

-- Porting note: Added nonrec
nonrec theorem map_finsupp_prod {α : Type _} [Zero α] {ι : Type _} (f : ι →₀ α) (g : ι → α → A₁) :
    e (f.prod g) = f.prod fun i a => e (g i a) :=
  map_finsupp_prod _ f g
#align alg_equiv.map_finsupp_prod AlgEquiv.map_finsupp_prod

end CommSemiring

section Ring

variable [CommSemiring R] [Ring A₁] [Ring A₂]

variable [Algebra R A₁] [Algebra R A₂] (e : A₁ ≃ₐ[R] A₂)

protected theorem map_neg (x) : e (-x) = -e x :=
  map_neg e x
#align alg_equiv.map_neg AlgEquiv.map_neg

protected theorem map_sub (x y) : e (x - y) = e x - e y :=
  map_sub e x y
#align alg_equiv.map_sub AlgEquiv.map_sub

end Ring

end AlgEquiv

namespace MulSemiringAction

variable {M G : Type _} (R A : Type _) [CommSemiring R] [Semiring A] [Algebra R A]

section

variable [Group G] [MulSemiringAction G A] [SMulCommClass G R A]

/-- Each element of the group defines a algebra equivalence.

This is a stronger version of `MulSemiringAction.toRingEquiv` and
`DistribMulAction.toLinearEquiv`. -/
@[simps! apply symm_apply toEquiv] -- Porting note: don't want redundant simps lemma `toEquiv_symm`
def toAlgEquiv (g : G) : A ≃ₐ[R] A :=
  { MulSemiringAction.toRingEquiv _ _ g, MulSemiringAction.toAlgHom R A g with }
#align mul_semiring_action.to_alg_equiv MulSemiringAction.toAlgEquiv

theorem toAlgEquiv_injective [FaithfulSMul G A] :
    Function.Injective (MulSemiringAction.toAlgEquiv R A : G → A ≃ₐ[R] A) := fun _ _ h =>
  eq_of_smul_eq_smul fun r => AlgEquiv.ext_iff.1 h r
#align mul_semiring_action.to_alg_equiv_injective MulSemiringAction.toAlgEquiv_injective

end

end MulSemiringAction

-- porting note: disable `dupNamespace` linter for aux lemmas
open Lean in
run_cmd do
  for i in List.range 2 do
    Elab.Command.elabCommand (← `(attribute [nolint dupNamespace]
      $(mkCIdent (.num `Mathlib.Algebra.Algebra.Equiv._auxLemma (i + 1)))))


/-
Copyright (c) 2021 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.computation.approximations
import algebra.continued_fractions.convergents_equiv
import algebra.order.archimedean
import topology.algebra.order.field

/-!
# Corollaries From Approximation Lemmas (`algebra.continued_fractions.computation.approximations`)

## Summary

We show that the generalized_continued_fraction given by `generalized_continued_fraction.of` in fact
is a (regular) continued fraction. Using the equivalence of the convergents computations
(`generalized_continued_fraction.convergents` and `generalized_continued_fraction.convergents'`) for
continued fractions (see `algebra.continued_fractions.convergents_equiv`), it follows that the
convergents computations for `generalized_continued_fraction.of` are equivalent.

Moreover, we show the convergence of the continued fractions computations, that is
`(generalized_continued_fraction.of v).convergents` indeed computes `v` in the limit.

## Main Definitions

- `continued_fraction.of` returns the (regular) continued fraction of a value.

## Main Theorems

- `generalized_continued_fraction.of_convergents_eq_convergents'` shows that the convergents
  computations for `generalized_continued_fraction.of` are equivalent.
- `generalized_continued_fraction.of_convergence` shows that
  `(generalized_continued_fraction.of v).convergents` converges to `v`.

## Tags

convergence, fractions
-/

variables {K : Type*} (v : K) [linear_ordered_field K] [floor_ring K]

open generalized_continued_fraction (of)
open generalized_continued_fraction

lemma generalized_continued_fraction.of_is_simple_continued_fraction :
  (of v).is_simple_continued_fraction :=
(λ _ _ nth_part_num_eq, of_part_num_eq_one nth_part_num_eq)

/-- Creates the simple continued fraction of a value. -/
def simple_continued_fraction.of : simple_continued_fraction K :=
⟨of v, generalized_continued_fraction.of_is_simple_continued_fraction v⟩

lemma simple_continued_fraction.of_is_continued_fraction :
  (simple_continued_fraction.of v).is_continued_fraction :=
(λ _ denom nth_part_denom_eq, lt_of_lt_of_le zero_lt_one
  (of_one_le_nth_part_denom nth_part_denom_eq))

/-- Creates the continued fraction of a value. -/
def continued_fraction.of : continued_fraction K :=
⟨simple_continued_fraction.of v, simple_continued_fraction.of_is_continued_fraction v⟩

namespace generalized_continued_fraction

lemma of_convergents_eq_convergents' :
  (of v).convergents = (of v).convergents' :=
@continued_fraction.convergents_eq_convergents'  _ _ (continued_fraction.of v)

/--
The recurrence relation for the `convergents` of the continued fraction expansion
of an element `v` of `K` in terms of the convergents of the inverse of its fractional part.
-/
lemma convergents_succ (n : ℕ) :
  (of v).convergents (n + 1) = ⌊v⌋ + 1 / (of (int.fract v)⁻¹).convergents n :=
by rw [of_convergents_eq_convergents', convergents'_succ, of_convergents_eq_convergents']

section convergence
/-!
### Convergence

We next show that `(generalized_continued_fraction.of v).convergents v` converges to `v`.
-/

variable [archimedean K]
open nat

theorem of_convergence_epsilon :
  ∀ (ε > (0 : K)), ∃ (N : ℕ), ∀ (n ≥ N), |v - (of v).convergents n| < ε :=
begin
  assume ε ε_pos,
  -- use the archimedean property to obtian a suitable N
  rcases (exists_nat_gt (1 / ε) : ∃ (N' : ℕ), 1 / ε < N') with ⟨N', one_div_ε_lt_N'⟩,
  let N := max N' 5, -- set minimum to 5 to have N ≤ fib N work
  existsi N,
  assume n n_ge_N,
  let g := of v,
  cases decidable.em (g.terminated_at n) with terminated_at_n not_terminated_at_n,
  { have : v = g.convergents n, from of_correctness_of_terminated_at terminated_at_n,
    have : v - g.convergents n = 0, from sub_eq_zero.elim_right this,
    rw [this],
    exact_mod_cast ε_pos },
  { let B := g.denominators n,
    let nB := g.denominators (n + 1),
    have abs_v_sub_conv_le : |v - g.convergents n| ≤ 1 / (B * nB), from
      abs_sub_convergents_le not_terminated_at_n,
    suffices : 1 / (B * nB) < ε, from lt_of_le_of_lt abs_v_sub_conv_le this,
    -- show that `0 < (B * nB)` and then multiply by `B * nB` to get rid of the division
    have nB_ineq : (fib (n + 2) : K) ≤ nB, by
    { have : ¬g.terminated_at (n + 1 - 1), from not_terminated_at_n,
      exact (succ_nth_fib_le_of_nth_denom (or.inr this)) },
    have B_ineq : (fib (n + 1) : K) ≤ B, by
    { have : ¬g.terminated_at (n - 1), from mt (terminated_stable n.pred_le) not_terminated_at_n,
      exact (succ_nth_fib_le_of_nth_denom (or.inr this)) },
    have zero_lt_B : 0 < B, by
    { have : (0 : K) < fib (n + 1), by exact_mod_cast fib_pos n.zero_lt_succ,
      exact (lt_of_lt_of_le this B_ineq) },
    have zero_lt_mul_conts : 0 < B * nB, by
    { have : 0 < nB, by
      { have : (0 : K) < fib (n + 2), by exact_mod_cast fib_pos (n + 1).zero_lt_succ,
        exact (lt_of_lt_of_le this nB_ineq) },
      solve_by_elim [mul_pos] },
    suffices : 1 < ε * (B * nB), from (div_lt_iff zero_lt_mul_conts).elim_right this,
    -- use that `N ≥ n` was obtained from the archimedean property to show the following
    have one_lt_ε_mul_N : 1 < ε * n, by
    { have one_lt_ε_mul_N' : 1 < ε * (N' : K), from (div_lt_iff' ε_pos).elim_left one_div_ε_lt_N',
      have : (N' : K) ≤ N, by exact_mod_cast (le_max_left  _ _),
      have : ε * N' ≤ ε * n, from
        (mul_le_mul_left ε_pos).elim_right (le_trans this (by exact_mod_cast n_ge_N)),
      exact (lt_of_lt_of_le one_lt_ε_mul_N' this) },
    suffices : ε * n ≤ ε * (B * nB), from lt_of_lt_of_le one_lt_ε_mul_N this,
    -- cancel `ε`
    suffices : (n : K) ≤ B * nB, from (mul_le_mul_left ε_pos).elim_right this,
    show (n : K) ≤ B * nB,
      calc (n : K)
          ≤ fib n                     : by exact_mod_cast (le_fib_self $ le_trans
                                           (le_max_right N' 5) n_ge_N)
      ... ≤ fib (n + 1)               : by exact_mod_cast fib_le_fib_succ
      ... ≤ fib (n + 1) * fib (n + 1) : by exact_mod_cast ((fib (n + 1)).le_mul_self)
      ... ≤ fib (n + 1) * fib (n + 2) : mul_le_mul_of_nonneg_left
                                          (by exact_mod_cast fib_le_fib_succ)
                                          (by exact_mod_cast (fib (n + 1)).zero_le)
      ... ≤ B * nB                    : mul_le_mul B_ineq nB_ineq
                                          (by exact_mod_cast (fib (n + 2)).zero_le)
                                          (le_of_lt zero_lt_B) }
end

local attribute [instance] preorder.topology

theorem of_convergence [order_topology K] :
  filter.tendsto ((of v).convergents) filter.at_top $ nhds v :=
by simpa [linear_ordered_add_comm_group.tendsto_nhds, abs_sub_comm] using (of_convergence_epsilon v)

end convergence

end generalized_continued_fraction


set_option trace.simplify.rewrite true

lemma simp_rule :
    forall (A B C : Type)
           (xs : list A)
           (f: A → B)
           (g: B → C), (list.map g $ (list.map f) xs) = list.map (g ∘ f) xs :=
begin
    intros,
    induction xs,
    simp [list.map],
    simp [list.map],
end

lemma simp_wildcard :
forall (A B C : Type)
(a b : list A)
(a' b' : list C)
(f : A → B)
(g h : B → C),
(list.map g $ list.map f a) = a' ->
(list.map h $ list.map f b) = b' ->
a' = list.map (g ∘ f) a ∧ b' = list.map (h ∘ f) b :=
begin
    intros A B C a b a' b' f g h a₁ a₂,
    simp [simp_rule] at *,
    rw [a₁, a₂],
    split; reflexivity
end

run_cmd mk_simp_attr `foo
run_cmd mk_simp_attr `bar

constants (f : ℕ → ℕ) (a b c : ℕ) (fab : f a = f b) (fbc : f b = f c)
constants (p : ℕ → Prop) (pfa : p (f a)) (pfb : p (f b)) (pfc :p (f c))

attribute [simp, foo] fbc

example : p (f a) :=
by simp [fab]; exact pfc

example : p (f a) :=
by simp only [fab]; exact pfb

example : p (f a) :=
by simp only [fab] with foo bar; exact pfc

example (h : p (f a)) : p (f c) :=
by simp [fab] at h; assumption

example (h : p (f a)) : p (f b) :=
by simp only [fab] at h; assumption

example (h₁ : p (f a)) (h₂ : p (f a)) : p (f a) :=
begin
  simp only [fab] at h₁ ⊢,
  tactic.fail_if_success `[exact h₂],
  exact h₁
end


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

! This file was ported from Lean 3 source module measure_theory.integral.divergence_theorem
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.BoxIntegral.DivergenceTheorem
import Mathbin.Analysis.BoxIntegral.Integrability
import Mathbin.MeasureTheory.Integral.IntervalIntegral

/-!
# Divergence theorem for Bochner integral

In this file we prove the Divergence theorem for Bochner integral on a box in
`ℝⁿ⁺¹ = fin (n + 1) → ℝ`. More precisely, we prove the following theorem.

Let `E` be a complete normed space. If `f : ℝⁿ⁺¹ → Eⁿ⁺¹` is
continuous on a rectangular box `[a, b] : set ℝⁿ⁺¹`, `a ≤ b`, differentiable on its interior with
derivative `f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹`, and the divergence `λ x, ∑ i, f' x eᵢ i` is integrable on
`[a, b]`, where `eᵢ = pi.single i 1` is the `i`-th basis vector, then its integral is equal to the
sum of integrals of `f` over the faces of `[a, b]`, taken with appropriate signs. Moreover, the same
is true if the function is not differentiable at countably many points of the interior of `[a, b]`.

Once we prove the general theorem, we deduce corollaries for functions `ℝ → E` and pairs of
functions `(ℝ × ℝ) → E`.

## Notations

We use the following local notation to make the statement more readable. Note that the documentation
website shows the actual terms, not those abbreviated using local notations.

* `ℝⁿ`, `ℝⁿ⁺¹`, `Eⁿ⁺¹`: `fin n → ℝ`, `fin (n + 1) → ℝ`, `fin (n + 1) → E`;
* `face i`: the `i`-th face of the box `[a, b]` as a closed segment in `ℝⁿ`, namely `[a ∘
  fin.succ_above i, b ∘ fin.succ_above i]`;
* `e i` : `i`-th basis vector `pi.single i 1`;
* `front_face i`, `back_face i`: embeddings `ℝⁿ → ℝⁿ⁺¹` corresponding to the front face
  `{x | x i = b i}` and back face `{x | x i = a i}` of the box `[a, b]`, respectively.
  They are given by `fin.insert_nth i (b i)` and `fin.insert_nth i (a i)`.

## TODO

* Add a version that assumes existence and integrability of partial derivatives.

## Tags

divergence theorem, Bochner integral
-/

open Set Finset TopologicalSpace Function BoxIntegral MeasureTheory Filter

open BigOperators Classical Topology Interval

universe u

namespace MeasureTheory

variable {E : Type u} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]

section

variable {n : ℕ}

-- mathport name: «exprℝⁿ»
local notation "ℝⁿ" => Fin n → ℝ

-- mathport name: «exprℝⁿ⁺¹»
local notation "ℝⁿ⁺¹" => Fin (n + 1) → ℝ

-- mathport name: «exprEⁿ⁺¹»
local notation "Eⁿ⁺¹" => Fin (n + 1) → E

-- mathport name: «expre »
local notation "e " i => Pi.single i 1

section

/-!
### Divergence theorem for functions on `ℝⁿ⁺¹ = fin (n + 1) → ℝ`.

In this section we use the divergence theorem for a Henstock-Kurzweil-like integral
`box_integral.has_integral_GP_divergence_of_forall_has_deriv_within_at` to prove the divergence
theorem for Bochner integral. The divergence theorem for Bochner integral
`measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable` assumes that the function
itself is continuous on a closed box, differentiable at all but countably many points of its
interior, and the divergence is integrable on the box.

This statement differs from `box_integral.has_integral_GP_divergence_of_forall_has_deriv_within_at`
in several aspects.

* We use Bochner integral instead of a Henstock-Kurzweil integral. This modification is done in
  `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable_aux₁`. As a side effect
  of this change, we need to assume that the divergence is integrable.

* We don't assume differentiability on the boundary of the box. This modification is done in
  `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable_aux₂`. To prove it, we
  choose an increasing sequence of smaller boxes that cover the interior of the original box, then
  apply the previous lemma to these smaller boxes and take the limit of both sides of the equation.

* We assume `a ≤ b` instead of `∀ i, a i < b i`. This is the last step of the proof, and it is done
  in the main theorem `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable`.
-/

/-- An auxiliary lemma for
`measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable`. This is exactly
`box_integral.has_integral_GP_divergence_of_forall_has_deriv_within_at` reformulated for the
Bochner integral. -/
theorem integral_divergence_of_hasFderivWithinAt_off_countable_aux₁ (I : Box (Fin (n + 1)))
    (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : Set ℝⁿ⁺¹) (hs : s.Countable)
    (Hc : ContinuousOn f I.Icc) (Hd : ∀ x ∈ I.Icc \ s, HasFderivWithinAt f (f' x) I.Icc x)
    (Hi : IntegrableOn (fun x => ∑ i, f' x (e i) i) I.Icc) :
    (∫ x in I.Icc, ∑ i, f' x (e i) i) =
      ∑ i : Fin (n + 1),
        (∫ x in (I.face i).Icc, f (i.insertNth (I.upper i) x) i) -
          ∫ x in (I.face i).Icc, f (i.insertNth (I.lower i) x) i :=
  by
  simp only [← set_integral_congr_set_ae (box.coe_ae_eq_Icc _)]
  have A := (Hi.mono_set box.coe_subset_Icc).hasBoxIntegral ⊥ rfl
  have B :=
    has_integral_GP_divergence_of_forall_has_deriv_within_at I f f' (s ∩ I.Icc)
      (hs.mono (inter_subset_left _ _)) (fun x hx => Hc _ hx.2) fun x hx =>
      Hd _ ⟨hx.1, fun h => hx.2 ⟨h, hx.1⟩⟩
  rw [continuousOn_pi] at Hc
  refine' (A.unique B).trans (sum_congr rfl fun i hi => _)
  refine' congr_arg₂ Sub.sub _ _
  · have := box.continuous_on_face_Icc (Hc i) (Set.right_mem_Icc.2 (I.lower_le_upper i))
    have := (this.integrable_on_compact (box.is_compact_Icc _)).monoSet box.coe_subset_Icc
    exact (this.has_box_integral ⊥ rfl).integral_eq
    infer_instance
  · have := box.continuous_on_face_Icc (Hc i) (Set.left_mem_Icc.2 (I.lower_le_upper i))
    have := (this.integrable_on_compact (box.is_compact_Icc _)).monoSet box.coe_subset_Icc
    exact (this.has_box_integral ⊥ rfl).integral_eq
    infer_instance
#align measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable_aux₁ MeasureTheory.integral_divergence_of_hasFderivWithinAt_off_countable_aux₁

/-- An auxiliary lemma for
`measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable`. Compared to the previous
lemma, here we drop the assumption of differentiability on the boundary of the box. -/
theorem integral_divergence_of_has_fderiv_within_at_off_countable_aux₂ (I : Box (Fin (n + 1)))
    (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : Set ℝⁿ⁺¹) (hs : s.Countable)
    (Hc : ContinuousOn f I.Icc) (Hd : ∀ x ∈ I.Ioo \ s, HasFderivAt f (f' x) x)
    (Hi : IntegrableOn (fun x => ∑ i, f' x (e i) i) I.Icc) :
    (∫ x in I.Icc, ∑ i, f' x (e i) i) =
      ∑ i : Fin (n + 1),
        (∫ x in (I.face i).Icc, f (i.insertNth (I.upper i) x) i) -
          ∫ x in (I.face i).Icc, f (i.insertNth (I.lower i) x) i :=
  by
  /- Choose a monotone sequence `J k` of subboxes that cover the interior of `I` and prove that
    these boxes satisfy the assumptions of the previous lemma. -/
  rcases I.exists_seq_mono_tendsto with ⟨J, hJ_sub, hJl, hJu⟩
  have hJ_sub' : ∀ k, (J k).Icc ⊆ I.Icc := fun k => (hJ_sub k).trans I.Ioo_subset_Icc
  have hJ_le : ∀ k, J k ≤ I := fun k => box.le_iff_Icc.2 (hJ_sub' k)
  have HcJ : ∀ k, ContinuousOn f (J k).Icc := fun k => Hc.mono (hJ_sub' k)
  have HdJ : ∀ (k), ∀ x ∈ (J k).Icc \ s, HasFderivWithinAt f (f' x) (J k).Icc x := fun k x hx =>
    (Hd x ⟨hJ_sub k hx.1, hx.2⟩).HasFderivWithinAt
  have HiJ : ∀ k, integrable_on (fun x => ∑ i, f' x (e i) i) (J k).Icc := fun k =>
    Hi.mono_set (hJ_sub' k)
  -- Apply the previous lemma to `J k`.
  have HJ_eq := fun k =>
    integral_divergence_of_has_fderiv_within_at_off_countable_aux₁ (J k) f f' s hs (HcJ k) (HdJ k)
      (HiJ k)
  -- Note that the LHS of `HJ_eq k` tends to the LHS of the goal as `k → ∞`.
  have hI_tendsto :
    tendsto (fun k => ∫ x in (J k).Icc, ∑ i, f' x (e i) i) at_top
      (𝓝 (∫ x in I.Icc, ∑ i, f' x (e i) i)) :=
    by
    simp only [integrable_on, ← measure.restrict_congr_set (box.Ioo_ae_eq_Icc _)] at Hi⊢
    rw [← box.Union_Ioo_of_tendsto J.monotone hJl hJu] at Hi⊢
    exact
      tendsto_set_integral_of_monotone (fun k => (J k).measurableSet_Ioo) (box.Ioo.comp J).Monotone
        Hi
  -- Thus it suffices to prove the same about the RHS.
  refine' tendsto_nhds_unique_of_eventuallyEq hI_tendsto _ (eventually_of_forall HJ_eq)
  clear hI_tendsto
  rw [tendsto_pi_nhds] at hJl hJu
  /- We'll need to prove a similar statement about the integrals over the front sides and the
    integrals over the back sides. In order to avoid repeating ourselves, we formulate a lemma. -/
  suffices
    ∀ (i : Fin (n + 1)) (c : ℕ → ℝ) (d),
      (∀ k, c k ∈ Icc (I.lower i) (I.upper i)) →
        tendsto c at_top (𝓝 d) →
          tendsto (fun k => ∫ x in ((J k).face i).Icc, f (i.insertNth (c k) x) i) at_top
            (𝓝 <| ∫ x in (I.face i).Icc, f (i.insertNth d x) i)
    by
    rw [box.Icc_eq_pi] at hJ_sub'
    refine' tendsto_finset_sum _ fun i hi => (this _ _ _ _ (hJu _)).sub (this _ _ _ _ (hJl _))
    exacts[fun k => hJ_sub' k (J k).upper_mem_icc _ trivial, fun k =>
      hJ_sub' k (J k).lower_mem_icc _ trivial]
  intro i c d hc hcd
  /- First we prove that the integrals of the restriction of `f` to `{x | x i = d}` over increasing
    boxes `((J k).face i).Icc` tend to the desired limit. The proof mostly repeats the one above. -/
  have hd : d ∈ Icc (I.lower i) (I.upper i) :=
    is_closed_Icc.mem_of_tendsto hcd (eventually_of_forall hc)
  have Hic : ∀ k, integrable_on (fun x => f (i.insert_nth (c k) x) i) (I.face i).Icc := fun k =>
    (box.continuous_on_face_Icc ((continuous_apply i).comp_continuousOn Hc) (hc k)).integrableOnIcc
  have Hid : integrable_on (fun x => f (i.insert_nth d x) i) (I.face i).Icc :=
    (box.continuous_on_face_Icc ((continuous_apply i).comp_continuousOn Hc) hd).integrableOnIcc
  have H :
    tendsto (fun k => ∫ x in ((J k).face i).Icc, f (i.insert_nth d x) i) at_top
      (𝓝 <| ∫ x in (I.face i).Icc, f (i.insert_nth d x) i) :=
    by
    have hIoo : (⋃ k, ((J k).face i).Ioo) = (I.face i).Ioo :=
      box.Union_Ioo_of_tendsto ((box.monotone_face i).comp J.monotone)
        (tendsto_pi_nhds.2 fun _ => hJl _) (tendsto_pi_nhds.2 fun _ => hJu _)
    simp only [integrable_on, ← measure.restrict_congr_set (box.Ioo_ae_eq_Icc _), ← hIoo] at Hid⊢
    exact
      tendsto_set_integral_of_monotone (fun k => ((J k).face i).measurableSet_Ioo)
        (box.Ioo.monotone.comp ((box.monotone_face i).comp J.monotone)) Hid
  /- Thus it suffices to show that the distance between the integrals of the restrictions of `f` to
    `{x | x i = c k}` and `{x | x i = d}` over `((J k).face i).Icc` tends to zero as `k → ∞`. Choose
    `ε > 0`. -/
  refine' H.congr_dist (metric.nhds_basis_closed_ball.tendsto_right_iff.2 fun ε εpos => _)
  have hvol_pos : ∀ J : box (Fin n), 0 < ∏ j, J.upper j - J.lower j := fun J =>
    prod_pos fun j hj => sub_pos.2 <| J.lower_lt_upper _
  /- Choose `δ > 0` such that for any `x y ∈ I.Icc` at distance at most `δ`, the distance between
    `f x` and `f y` is at most `ε / volume (I.face i).Icc`, then the distance between the integrals
    is at most `(ε / volume (I.face i).Icc) * volume ((J k).face i).Icc ≤ ε`. -/
  rcases Metric.uniformContinuousOn_iff_le.1
      (I.is_compact_Icc.uniform_continuous_on_of_continuous Hc)
      (ε / ∏ j, (I.face i).upper j - (I.face i).lower j) (div_pos εpos (hvol_pos (I.face i))) with
    ⟨δ, δpos, hδ⟩
  refine' (hcd.eventually (Metric.ball_mem_nhds _ δpos)).mono fun k hk => _
  have Hsub : ((J k).face i).Icc ⊆ (I.face i).Icc := box.le_iff_Icc.1 (box.face_mono (hJ_le _) i)
  rw [mem_closedBall_zero_iff, Real.norm_eq_abs, abs_of_nonneg dist_nonneg, dist_eq_norm, ←
    integral_sub (Hid.mono_set Hsub) ((Hic _).monoSet Hsub)]
  calc
    ‖∫ x in ((J k).face i).Icc, f (i.insert_nth d x) i - f (i.insert_nth (c k) x) i‖ ≤
        (ε / ∏ j, (I.face i).upper j - (I.face i).lower j) * (volume ((J k).face i).Icc).toReal :=
      by
      refine'
        norm_set_integral_le_of_norm_le_const' (((J k).face i).measure_Icc_lt_top _)
          ((J k).face i).measurableSet_Icc fun x hx => _
      rw [← dist_eq_norm]
      calc
        dist (f (i.insert_nth d x) i) (f (i.insert_nth (c k) x) i) ≤
            dist (f (i.insert_nth d x)) (f (i.insert_nth (c k) x)) :=
          dist_le_pi_dist (f (i.insert_nth d x)) (f (i.insert_nth (c k) x)) i
        _ ≤ ε / ∏ j, (I.face i).upper j - (I.face i).lower j :=
          hδ _ (I.maps_to_insert_nth_face_Icc hd <| Hsub hx) _
            (I.maps_to_insert_nth_face_Icc (hc _) <| Hsub hx) _

      rw [Fin.dist_insertNth_insertNth, dist_self, dist_comm]
      exact max_le hk.le δpos.lt.le
    _ ≤ ε :=
      by
      rw [box.Icc_def, Real.volume_Icc_pi_toReal ((J k).face i).lower_le_upper, ←
        le_div_iff (hvol_pos _)]
      refine'
        div_le_div_of_le_left εpos.le (hvol_pos _) (prod_le_prod (fun j hj => _) fun j hj => _)
      exacts[sub_nonneg.2 (box.lower_le_upper _ _),
        sub_le_sub ((hJ_sub' _ (J _).upper_mem_icc).2 _) ((hJ_sub' _ (J _).lower_mem_icc).1 _)]

#align measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable_aux₂ MeasureTheory.integral_divergence_of_has_fderiv_within_at_off_countable_aux₂

variable (a b : ℝⁿ⁺¹)

-- mathport name: «exprface »
local notation "face " i => Set.Icc (a ∘ Fin.succAbove i) (b ∘ Fin.succAbove i)

-- mathport name: «exprfront_face »
local notation "front_face " i:2000 => Fin.insertNth i (b i)

-- mathport name: «exprback_face »
local notation "back_face " i:2000 => Fin.insertNth i (a i)

/-- **Divergence theorem** for Bochner integral. If `f : ℝⁿ⁺¹ → Eⁿ⁺¹` is continuous on a rectangular
box `[a, b] : set ℝⁿ⁺¹`, `a ≤ b`, is differentiable on its interior with derivative
`f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹` and the divergence `λ x, ∑ i, f' x eᵢ i` is integrable on `[a, b]`,
where `eᵢ = pi.single i 1` is the `i`-th basis vector, then its integral is equal to the sum of
integrals of `f` over the faces of `[a, b]`, taken with appropriat signs.

Moreover, the same is true if the function is not differentiable at countably many
points of the interior of `[a, b]`.

We represent both faces `x i = a i` and `x i = b i` as the box
`face i = [a ∘ fin.succ_above i, b ∘ fin.succ_above i]` in `ℝⁿ`, where
`fin.succ_above : fin n ↪o fin (n + 1)` is the order embedding with range `{i}ᶜ`. The restrictions
of `f : ℝⁿ⁺¹ → Eⁿ⁺¹` to these faces are given by `f ∘ back_face i` and `f ∘ front_face i`, where
`back_face i = fin.insert_nth i (a i)` and `front_face i = fin.insert_nth i (b i)` are embeddings
`ℝⁿ → ℝⁿ⁺¹` that take `y : ℝⁿ` and insert `a i` (resp., `b i`) as `i`-th coordinate. -/
theorem integral_divergence_of_has_fderiv_within_at_off_countable (hle : a ≤ b) (f : ℝⁿ⁺¹ → Eⁿ⁺¹)
    (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : Set ℝⁿ⁺¹) (hs : s.Countable) (Hc : ContinuousOn f (Icc a b))
    (Hd : ∀ x ∈ (Set.pi univ fun i => Ioo (a i) (b i)) \ s, HasFderivAt f (f' x) x)
    (Hi : IntegrableOn (fun x => ∑ i, f' x (e i) i) (Icc a b)) :
    (∫ x in Icc a b, ∑ i, f' x (e i) i) =
      ∑ i : Fin (n + 1),
        (∫ x in face i, f ((front_face (i)) x) i) - ∫ x in face i, f ((back_face (i)) x) i :=
  by
  rcases em (∃ i, a i = b i) with (⟨i, hi⟩ | hne)
  · -- First we sort out the trivial case `∃ i, a i = b i`.
    simp only [volume_pi, ← set_integral_congr_set_ae measure.univ_pi_Ioc_ae_eq_Icc]
    have hi' : Ioc (a i) (b i) = ∅ := Ioc_eq_empty hi.not_lt
    have : (pi Set.univ fun j => Ioc (a j) (b j)) = ∅ := univ_pi_eq_empty hi'
    rw [this, integral_empty, sum_eq_zero]
    rintro j -
    rcases eq_or_ne i j with (rfl | hne)
    · simp [hi]
    · rcases Fin.exists_succAbove_eq hne with ⟨i, rfl⟩
      have : (pi Set.univ fun k : Fin n => Ioc (a <| j.succ_above k) (b <| j.succ_above k)) = ∅ :=
        univ_pi_eq_empty hi'
      rw [this, integral_empty, integral_empty, sub_self]
  · -- In the non-trivial case `∀ i, a i < b i`, we apply a lemma we proved above.
    have hlt : ∀ i, a i < b i := fun i => (hle i).lt_of_ne fun hi => hne ⟨i, hi⟩
    convert integral_divergence_of_has_fderiv_within_at_off_countable_aux₂ ⟨a, b, hlt⟩ f f' s hs Hc
        Hd Hi
#align measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable MeasureTheory.integral_divergence_of_has_fderiv_within_at_off_countable

/-- **Divergence theorem** for a family of functions `f : fin (n + 1) → ℝⁿ⁺¹ → E`. See also
`measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable'` for a version formulated
in terms of a vector-valued function `f : ℝⁿ⁺¹ → Eⁿ⁺¹`. -/
theorem integral_divergence_of_has_fderiv_within_at_off_countable' (hle : a ≤ b)
    (f : Fin (n + 1) → ℝⁿ⁺¹ → E) (f' : Fin (n + 1) → ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] E) (s : Set ℝⁿ⁺¹)
    (hs : s.Countable) (Hc : ∀ i, ContinuousOn (f i) (Icc a b))
    (Hd : ∀ x ∈ (pi Set.univ fun i => Ioo (a i) (b i)) \ s, ∀ (i), HasFderivAt (f i) (f' i x) x)
    (Hi : IntegrableOn (fun x => ∑ i, f' i x (e i)) (Icc a b)) :
    (∫ x in Icc a b, ∑ i, f' i x (e i)) =
      ∑ i : Fin (n + 1),
        (∫ x in face i, f i ((front_face (i)) x)) - ∫ x in face i, f i ((back_face (i)) x) :=
  integral_divergence_of_has_fderiv_within_at_off_countable a b hle (fun x i => f i x)
    (fun x => ContinuousLinearMap.pi fun i => f' i x) s hs (continuousOn_pi.2 Hc)
    (fun x hx => hasFderivAt_pi.2 (Hd x hx)) Hi
#align measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable' MeasureTheory.integral_divergence_of_has_fderiv_within_at_off_countable'

end

/-- An auxiliary lemma that is used to specialize the general divergence theorem to spaces that do
not have the form `fin n → ℝ`. -/
theorem integral_divergence_of_has_fderiv_within_at_off_countable_of_equiv {F : Type _}
    [NormedAddCommGroup F] [NormedSpace ℝ F] [PartialOrder F] [MeasureSpace F] [BorelSpace F]
    (eL : F ≃L[ℝ] ℝⁿ⁺¹) (he_ord : ∀ x y, eL x ≤ eL y ↔ x ≤ y)
    (he_vol : MeasurePreserving eL volume volume) (f : Fin (n + 1) → F → E)
    (f' : Fin (n + 1) → F → F →L[ℝ] E) (s : Set F) (hs : s.Countable) (a b : F) (hle : a ≤ b)
    (Hc : ∀ i, ContinuousOn (f i) (Icc a b))
    (Hd : ∀ x ∈ interior (Icc a b) \ s, ∀ (i), HasFderivAt (f i) (f' i x) x) (DF : F → E)
    (hDF : ∀ x, DF x = ∑ i, f' i x (eL.symm <| e i)) (Hi : IntegrableOn DF (Icc a b)) :
    (∫ x in Icc a b, DF x) =
      ∑ i : Fin (n + 1),
        (∫ x in Icc (eL a ∘ i.succAbove) (eL b ∘ i.succAbove),
            f i (eL.symm <| i.insertNth (eL b i) x)) -
          ∫ x in Icc (eL a ∘ i.succAbove) (eL b ∘ i.succAbove),
            f i (eL.symm <| i.insertNth (eL a i) x) :=
  have he_emb : MeasurableEmbedding eL := eL.toHomeomorph.toMeasurableEquiv.MeasurableEmbedding
  have hIcc : eL ⁻¹' Icc (eL a) (eL b) = Icc a b :=
    by
    ext1 x
    simp only [Set.mem_preimage, Set.mem_Icc, he_ord]
  have hIcc' : Icc (eL a) (eL b) = eL.symm ⁻¹' Icc a b := by rw [← hIcc, eL.symm_preimage_preimage]
  calc
    (∫ x in Icc a b, DF x) = ∫ x in Icc a b, ∑ i, f' i x (eL.symm <| e i) := by simp only [hDF]
    _ = ∫ x in Icc (eL a) (eL b), ∑ i, f' i (eL.symm x) (eL.symm <| e i) :=
      by
      rw [← he_vol.set_integral_preimage_emb he_emb]
      simp only [hIcc, eL.symm_apply_apply]
    _ =
        ∑ i : Fin (n + 1),
          (∫ x in Icc (eL a ∘ i.succAbove) (eL b ∘ i.succAbove),
              f i (eL.symm <| i.insertNth (eL b i) x)) -
            ∫ x in Icc (eL a ∘ i.succAbove) (eL b ∘ i.succAbove),
              f i (eL.symm <| i.insertNth (eL a i) x) :=
      by
      convert integral_divergence_of_has_fderiv_within_at_off_countable' (eL a) (eL b)
          ((he_ord _ _).2 hle) (fun i x => f i (eL.symm x))
          (fun i x => f' i (eL.symm x) ∘L (eL.symm : ℝⁿ⁺¹ →L[ℝ] F)) (eL.symm ⁻¹' s)
          (hs.preimage eL.symm.injective) _ _ _
      · exact fun i => (Hc i).comp eL.symm.continuous_on hIcc'.subset
      · refine' fun x hx i => (Hd (eL.symm x) ⟨_, hx.2⟩ i).comp x eL.symm.has_fderiv_at
        rw [← hIcc]
        refine' preimage_interior_subset_interior_preimage eL.continuous _
        simpa only [Set.mem_preimage, eL.apply_symm_apply, ← pi_univ_Icc,
          interior_pi_set finite_univ, interior_Icc] using hx.1
      · rw [← he_vol.integrable_on_comp_preimage he_emb, hIcc]
        simp [← hDF, (· ∘ ·), Hi]

#align measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable_of_equiv MeasureTheory.integral_divergence_of_has_fderiv_within_at_off_countable_of_equiv

end

open Interval

open ContinuousLinearMap (smul_right)

-- mathport name: «exprℝ¹»
local notation "ℝ¹" => Fin 1 → ℝ

-- mathport name: «exprℝ²»
local notation "ℝ²" => Fin 2 → ℝ

-- mathport name: «exprE¹»
local notation "E¹" => Fin 1 → E

-- mathport name: «exprE²»
local notation "E²" => Fin 2 → E

/-- **Fundamental theorem of calculus, part 2**. This version assumes that `f` is continuous on the
interval and is differentiable off a countable set `s`.

See also

* `interval_integral.integral_eq_sub_of_has_deriv_right_of_le` for a version that only assumes right
differentiability of `f`;

* `measure_theory.integral_eq_of_has_deriv_within_at_off_countable` for a version that works both
  for `a ≤ b` and `b ≤ a` at the expense of using unordered intervals instead of `set.Icc`. -/
theorem integral_eq_of_has_deriv_within_at_off_countable_of_le (f f' : ℝ → E) {a b : ℝ}
    (hle : a ≤ b) {s : Set ℝ} (hs : s.Countable) (Hc : ContinuousOn f (Icc a b))
    (Hd : ∀ x ∈ Ioo a b \ s, HasDerivAt f (f' x) x) (Hi : IntervalIntegrable f' volume a b) :
    (∫ x in a..b, f' x) = f b - f a :=
  by
  set e : ℝ ≃L[ℝ] ℝ¹ := (ContinuousLinearEquiv.funUnique (Fin 1) ℝ ℝ).symm
  have e_symm : ∀ x, e.symm x = x 0 := fun x => rfl
  set F' : ℝ → ℝ →L[ℝ] E := fun x => smul_right (1 : ℝ →L[ℝ] ℝ) (f' x)
  have hF' : ∀ x y, F' x y = y • f' x := fun x y => rfl
  calc
    (∫ x in a..b, f' x) = ∫ x in Icc a b, f' x := by
      simp only [intervalIntegral.integral_of_le hle, set_integral_congr_set_ae Ioc_ae_eq_Icc]
    _ =
        ∑ i : Fin 1,
          (∫ x in Icc (e a ∘ i.succAbove) (e b ∘ i.succAbove),
              f (e.symm <| i.insertNth (e b i) x)) -
            ∫ x in Icc (e a ∘ i.succAbove) (e b ∘ i.succAbove),
              f (e.symm <| i.insertNth (e a i) x) :=
      by
      simp only [← interior_Icc] at Hd
      refine'
        integral_divergence_of_has_fderiv_within_at_off_countable_of_equiv e _ _ (fun _ => f)
          (fun _ => F') s hs a b hle (fun i => Hc) (fun x hx i => Hd x hx) _ _ _
      · exact fun x y => (OrderIso.funUnique (Fin 1) ℝ).symm.le_iff_le
      · exact (volume_preserving_fun_unique (Fin 1) ℝ).symm _
      · intro x
        rw [Fin.sum_univ_one, hF', e_symm, Pi.single_eq_same, one_smul]
      · rw [intervalIntegrable_iff_integrable_Ioc_of_le hle] at Hi
        exact Hi.congr_set_ae Ioc_ae_eq_Icc.symm
    _ = f b - f a := by
      simp only [Fin.sum_univ_one, e_symm]
      have : ∀ c : ℝ, const (Fin 0) c = isEmptyElim := fun c => Subsingleton.elim _ _
      simp [this, volume_pi, measure.pi_of_empty fun _ : Fin 0 => volume]

#align measure_theory.integral_eq_of_has_deriv_within_at_off_countable_of_le MeasureTheory.integral_eq_of_has_deriv_within_at_off_countable_of_le

/-- **Fundamental theorem of calculus, part 2**. This version assumes that `f` is continuous on the
interval and is differentiable off a countable set `s`.

See also `measure_theory.interval_integral.integral_eq_sub_of_has_deriv_right` for a version that
only assumes right differentiability of `f`.
-/
theorem integral_eq_of_has_deriv_within_at_off_countable (f f' : ℝ → E) {a b : ℝ} {s : Set ℝ}
    (hs : s.Countable) (Hc : ContinuousOn f [a, b])
    (Hd : ∀ x ∈ Ioo (min a b) (max a b) \ s, HasDerivAt f (f' x) x)
    (Hi : IntervalIntegrable f' volume a b) : (∫ x in a..b, f' x) = f b - f a :=
  by
  cases' le_total a b with hab hab
  · simp only [uIcc_of_le hab, min_eq_left hab, max_eq_right hab] at *
    exact integral_eq_of_has_deriv_within_at_off_countable_of_le f f' hab hs Hc Hd Hi
  · simp only [uIcc_of_ge hab, min_eq_right hab, max_eq_left hab] at *
    rw [intervalIntegral.integral_symm, neg_eq_iff_eq_neg, neg_sub]
    exact integral_eq_of_has_deriv_within_at_off_countable_of_le f f' hab hs Hc Hd Hi.symm
#align measure_theory.integral_eq_of_has_deriv_within_at_off_countable MeasureTheory.integral_eq_of_has_deriv_within_at_off_countable

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- **Divergence theorem** for functions on the plane along rectangles. It is formulated in terms of
two functions `f g : ℝ × ℝ → E` and an integral over `Icc a b = [a.1, b.1] × [a.2, b.2]`, where
`a b : ℝ × ℝ`, `a ≤ b`. When thinking of `f` and `g` as the two coordinates of a single function
`F : ℝ × ℝ → E × E` and when `E = ℝ`, this is the usual statement that the integral of the
divergence of `F` inside the rectangle equals the integral of the normal derivative of `F` along the
boundary.

See also `measure_theory.integral2_divergence_prod_of_has_fderiv_within_at_off_countable` for a
version that does not assume `a ≤ b` and uses iterated interval integral instead of the integral
over `Icc a b`. -/
theorem integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le (f g : ℝ × ℝ → E)
    (f' g' : ℝ × ℝ → ℝ × ℝ →L[ℝ] E) (a b : ℝ × ℝ) (hle : a ≤ b) (s : Set (ℝ × ℝ)) (hs : s.Countable)
    (Hcf : ContinuousOn f (Icc a b)) (Hcg : ContinuousOn g (Icc a b))
    (Hdf : ∀ x ∈ Ioo a.1 b.1 ×ˢ Ioo a.2 b.2 \ s, HasFderivAt f (f' x) x)
    (Hdg : ∀ x ∈ Ioo a.1 b.1 ×ˢ Ioo a.2 b.2 \ s, HasFderivAt g (g' x) x)
    (Hi : IntegrableOn (fun x => f' x (1, 0) + g' x (0, 1)) (Icc a b)) :
    (∫ x in Icc a b, f' x (1, 0) + g' x (0, 1)) =
      (((∫ x in a.1 ..b.1, g (x, b.2)) - ∫ x in a.1 ..b.1, g (x, a.2)) +
          ∫ y in a.2 ..b.2, f (b.1, y)) -
        ∫ y in a.2 ..b.2, f (a.1, y) :=
  let e : (ℝ × ℝ) ≃L[ℝ] ℝ² := (ContinuousLinearEquiv.finTwoArrow ℝ ℝ).symm
  calc
    (∫ x in Icc a b, f' x (1, 0) + g' x (0, 1)) =
        ∑ i : Fin 2,
          (∫ x in Icc (e a ∘ i.succAbove) (e b ∘ i.succAbove),
              ![f, g] i (e.symm <| i.insertNth (e b i) x)) -
            ∫ x in Icc (e a ∘ i.succAbove) (e b ∘ i.succAbove),
              ![f, g] i (e.symm <| i.insertNth (e a i) x) :=
      by
      refine'
        integral_divergence_of_has_fderiv_within_at_off_countable_of_equiv e _ _ ![f, g] ![f', g'] s
          hs a b hle _ (fun x hx => _) _ _ Hi
      · exact fun x y => (OrderIso.finTwoArrowIso ℝ).symm.le_iff_le
      · exact (volume_preserving_fin_two_arrow ℝ).symm _
      · exact Fin.forall_fin_two.2 ⟨Hcf, Hcg⟩
      · rw [Icc_prod_eq, interior_prod_eq, interior_Icc, interior_Icc] at hx
        exact Fin.forall_fin_two.2 ⟨Hdf x hx, Hdg x hx⟩
      · intro x
        rw [Fin.sum_univ_two]
        simp
    _ =
        ((∫ y in Icc a.2 b.2, f (b.1, y)) - ∫ y in Icc a.2 b.2, f (a.1, y)) +
          ((∫ x in Icc a.1 b.1, g (x, b.2)) - ∫ x in Icc a.1 b.1, g (x, a.2)) :=
      by
      have :
        ∀ (a b : ℝ¹) (f : ℝ¹ → E), (∫ x in Icc a b, f x) = ∫ x in Icc (a 0) (b 0), f fun _ => x :=
        by
        intro a b f
        convert(((volume_preserving_fun_unique (Fin 1) ℝ).symm _).set_integral_preimage_emb
              (MeasurableEquiv.measurableEmbedding _) _ _).symm
        exact ((OrderIso.funUnique (Fin 1) ℝ).symm.preimage_Icc a b).symm
      simp only [Fin.sum_univ_two, this]
      rfl
    _ =
        (((∫ x in a.1 ..b.1, g (x, b.2)) - ∫ x in a.1 ..b.1, g (x, a.2)) +
            ∫ y in a.2 ..b.2, f (b.1, y)) -
          ∫ y in a.2 ..b.2, f (a.1, y) :=
      by
      simp only [intervalIntegral.integral_of_le hle.1, intervalIntegral.integral_of_le hle.2,
        set_integral_congr_set_ae Ioc_ae_eq_Icc]
      abel

#align measure_theory.integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le MeasureTheory.integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- **Divergence theorem** for functions on the plane. It is formulated in terms of two functions
`f g : ℝ × ℝ → E` and iterated integral `∫ x in a₁..b₁, ∫ y in a₂..b₂, _`, where
`a₁ a₂ b₁ b₂ : ℝ`. When thinking of `f` and `g` as the two coordinates of a single function
`F : ℝ × ℝ → E × E` and when `E = ℝ`, this is the usual statement that the integral of the
divergence of `F` inside the rectangle with vertices `(aᵢ, bⱼ)`, `i, j =1,2`, equals the integral of
the normal derivative of `F` along the boundary.

See also `measure_theory.integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le`
for a version that uses an integral over `Icc a b`, where `a b : ℝ × ℝ`, `a ≤ b`. -/
theorem integral2_divergence_prod_of_has_fderiv_within_at_off_countable (f g : ℝ × ℝ → E)
    (f' g' : ℝ × ℝ → ℝ × ℝ →L[ℝ] E) (a₁ a₂ b₁ b₂ : ℝ) (s : Set (ℝ × ℝ)) (hs : s.Countable)
    (Hcf : ContinuousOn f ([a₁, b₁] ×ˢ [a₂, b₂])) (Hcg : ContinuousOn g ([a₁, b₁] ×ˢ [a₂, b₂]))
    (Hdf :
      ∀ x ∈ Ioo (min a₁ b₁) (max a₁ b₁) ×ˢ Ioo (min a₂ b₂) (max a₂ b₂) \ s, HasFderivAt f (f' x) x)
    (Hdg :
      ∀ x ∈ Ioo (min a₁ b₁) (max a₁ b₁) ×ˢ Ioo (min a₂ b₂) (max a₂ b₂) \ s, HasFderivAt g (g' x) x)
    (Hi : IntegrableOn (fun x => f' x (1, 0) + g' x (0, 1)) ([a₁, b₁] ×ˢ [a₂, b₂])) :
    (∫ x in a₁..b₁, ∫ y in a₂..b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1)) =
      (((∫ x in a₁..b₁, g (x, b₂)) - ∫ x in a₁..b₁, g (x, a₂)) + ∫ y in a₂..b₂, f (b₁, y)) -
        ∫ y in a₂..b₂, f (a₁, y) :=
  by
  wlog h₁ : a₁ ≤ b₁ generalizing a₁ b₁
  · specialize this b₁ a₁
    rw [uIcc_comm b₁ a₁, min_comm b₁ a₁, max_comm b₁ a₁] at this
    simp only [intervalIntegral.integral_symm b₁ a₁]
    refine' (congr_arg Neg.neg (this Hcf Hcg Hdf Hdg Hi (le_of_not_le h₁))).trans _
    abel
  wlog h₂ : a₂ ≤ b₂ generalizing a₂ b₂
  · specialize this b₂ a₂
    rw [uIcc_comm b₂ a₂, min_comm b₂ a₂, max_comm b₂ a₂] at this
    simp only [intervalIntegral.integral_symm b₂ a₂, intervalIntegral.integral_neg]
    refine' (congr_arg Neg.neg (this Hcf Hcg Hdf Hdg Hi (le_of_not_le h₂))).trans _
    abel
  simp only [uIcc_of_le h₁, uIcc_of_le h₂, min_eq_left, max_eq_right, h₁, h₂] at Hcf Hcg Hdf Hdg Hi
  calc
    (∫ x in a₁..b₁, ∫ y in a₂..b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1)) =
        ∫ x in Icc a₁ b₁, ∫ y in Icc a₂ b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1) :=
      by
      simp only [intervalIntegral.integral_of_le, h₁, h₂, set_integral_congr_set_ae Ioc_ae_eq_Icc]
    _ = ∫ x in Icc a₁ b₁ ×ˢ Icc a₂ b₂, f' x (1, 0) + g' x (0, 1) := (set_integral_prod _ Hi).symm
    _ =
        (((∫ x in a₁..b₁, g (x, b₂)) - ∫ x in a₁..b₁, g (x, a₂)) + ∫ y in a₂..b₂, f (b₁, y)) -
          ∫ y in a₂..b₂, f (a₁, y) :=
      by
      rw [Icc_prod_Icc] at *
      apply
          integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le f g f' g'
            (a₁, a₂) (b₁, b₂) ⟨h₁, h₂⟩ s <;>
        assumption

#align measure_theory.integral2_divergence_prod_of_has_fderiv_within_at_off_countable MeasureTheory.integral2_divergence_prod_of_has_fderiv_within_at_off_countable

end MeasureTheory


/-
Another implementation of locally nameless representation, more faithful to Chaugeuraud's specification. Thank you to Floris for the code underlying preterms and preformulas. ---Jesse 2018-10-15T19:59:39
-/

structure Language :=
(relations : Π n : nat, Type) (functions : Π  n : nat, Type)
section
parameter L : Language

/-- preterm n is a partially applied term. If applied to n terms, it becomes a term. --/
inductive preterm  : ℕ → Type
| bvar : ℕ → preterm 0
| fvar : ℕ → preterm 0 -- this should be fine; later we can pretty-print free variables with the indices as the underscores.
| func : ∀ {n : nat}, L.functions n → preterm n
| apply : ∀ {n : nat}, preterm (n + 1) → preterm 0 → preterm n

open preterm
def term := preterm 0

/-- Given a preterm, return a list of free variables which occur in it--/
def free_vars_preterm : Π n : ℕ, preterm n → list ℕ
| _ (bvar L k) := []
| _ (fvar L s) := [s]
| _ (@func L _ f) := []
| _ (@apply L n t1 t2) := (free_vars_preterm (n+1) t1 ∪ free_vars_preterm 0 t2)

/-- Given a preterm, return a list of bound variables which occur in it--/
def bound_vars_preterm : Π n : ℕ, preterm n → list ℕ
| _ (bvar L k) := [k]
| _ (fvar L s) := []
| _ (@func L _ f) := []
| _ (@apply L n t1 t2) := (free_vars_preterm (n+1) t1 ∪ free_vars_preterm 0 t2)

def free_vars_term : term → list ℕ := free_vars_preterm 0

def bound_vars_term : term → list ℕ := bound_vars_preterm 0

-- lemma free_var_preterm_coercionl (n : ℕ) (t1 : preterm (n+1)) (t2 : term) : {x : ℕ // x ∈ (free_vars_preterm (n+1) t1)} → {x : ℕ // x ∈ (free_vars_preterm n (apply t1 t2))} := sorry

-- def substitute_preterm : Π n : ℕ, Π (t : preterm n), term → {x : ℕ // x ∈ (free_vars_preterm n t)} → preterm n
-- | _ (bvar L k) t x := (bvar k)
-- | _ (fvar L s) t x := sorry
-- | _ (@func L _ f) t x := (func f)
-- | _ (@apply L n t1 t2) t x := sorry
end

section

parameter L : Language
/- preformula n is a partially applied formula. if applied to n terms, it becomes a formula -/
inductive preformula : ℕ → Type
| true : preformula 0
| false : preformula 0
| equal : (term L)  → (term L) → preformula 0
| rel : ∀ {n : nat}, L.relations n → preformula n
| apprel : ∀ {n : nat}, preformula (n + 1) → (term L) → preformula n
| imp : preformula 0 → preformula 0 → preformula 0
| all : preformula 0 → preformula 0

open preformula
def formula := preformula 0

def free_vars_preformula : Π n : ℕ, preformula n → list ℕ
| _ (true L) := []
| _ (false L) := []
| _ (equal t1 t2) := free_vars_term L t1 ∪ free_vars_term L t2
| _ (@rel L n R) := []
| _ (@apprel L n ψ t) := free_vars_preformula _ ψ ∪ free_vars_term L t
| _ (imp ϕ ψ) := free_vars_preformula _ ϕ ∪ free_vars_preformula _ ψ
| _ (all ψ) := free_vars_preformula _ ψ

def bound_vars_preformula : Π n : ℕ, preformula n → list ℕ
| _ (true L) := []
| _ (false L) := []
| _ (equal t1 t2) := bound_vars_term L t1 ∪ bound_vars_term L t2
| _ (@rel L n R) := []
| _ (@apprel L n ψ t) := bound_vars_preformula _ ψ ∪ bound_vars_term L t
| _ (imp ϕ ψ) := bound_vars_preformula _ ϕ ∪ bound_vars_preformula _ ψ
| _ (all ψ) := bound_vars_preformula _ ψ

def free_vars_formula : formula → list ℕ := free_vars_preformula 0
def bound_vars_formula : formula → list ℕ := bound_vars_preformula 0

-- def fresh_var : list ℕ → ℕ := λ xs, xs.foldr max 0
/- OPERATIONS ON LOCALLY NAMELESS FORMULAS -/
/- Variable opening -/
-- I quote:
-- With the named representation, an abstraction takes the form “λx. t”. To investigate
-- the body of this abstraction, we simply works with the term t. With the locally nameless
-- representation, an abstraction has the form “abs t” and it is our responsibility to provide
-- a fresh name x to open the abstraction. The result of applying the variable opening oper-
-- ation to t and x is a term, written t x , that describes the body of the abstraction “abs t”.
-- More precisely, given an abstraction “abs t” and a variable name x that does not appear
-- in t, the term t x is a copy of t in which all the bound variables referring to the outer
-- abstraction of “abs t” have been replaced with the free variable “fvar x”. For example,
-- consider the abstraction “abs (app (abs (app (bvar 0) (bvar 1))) (bvar 0))”; the opening of
-- its body with the name x is the term “app (abs (app (bvar 0) (fvar x)))(fvar x) ”.
-- The implementation of variable opening needs to traverse a term recursively, and
-- find all the leaves of the form “bvar i” whose index i is equal to the number of abstrac-
-- tions enclosing that variable. Variable opening is thus defined in terms of a recursive
-- function, written “{k → x} t”, that keeps track of the number k of abstractions that
-- have been passed by. Initially, the value of k is 0, so variable opening is defined as:
-- t x ≡ {0 → x} t

-- The value of k is then incremented each time an abstraction is traversed. When reaching
-- a bound variable with index i, the value of i is compared against the current value of k.
-- If i is equal to k, then the bound variable is replaced with the free variable named x,
-- otherwise it is unchanged. Note that free variables already occurring in the term are
-- never affected by a variable opening operation.
-- We will need this to perform generalization of constants.

-- def var_open_term : ℕ → term L → term L
-- | k (preterm.bvar _ i) := if (i = k)
-- then preterm.fvar _ (fresh_var (free_vars_term _ (preterm.bvar L i)))
-- else (preterm.bvar _ i)
-- | k (preterm.fvar _ y) := preterm.fvar _ y
-- | k (preterm.func f) := preterm.func f
-- | k (preterm.apply (t1 : preterm L 1) (t2 : preterm L 0) := preterm.apply (var_open_term k t1) (var_open_term k t2)

--- funnily enough, if you try to do this for *just* terms, like above, the equation compiler complains about well-founded recursion. But as you see below, there's *no* problem if we do it for all preterms

def fresh_var : list ℕ → ℕ := λ xs, (xs.foldr max 0) + 1

def var_open_preterm : Π n : ℕ, ℕ → preterm L n  → preterm L n -- first ℕ is the preterm level, second is the bound index we're opening
| 0 k (preterm.bvar L i) := if (i = k)
then preterm.fvar _ (fresh_var (free_vars_term _ (preterm.bvar L i)))
else (preterm.bvar _ i)
| 0 k (preterm.fvar L y) := preterm.fvar _ y
| n k (preterm.func f) := preterm.func f
| n k (preterm.apply (t1 : preterm L (n+1)) (t2 : preterm L 0)) := preterm.apply (var_open_preterm (n+1) k t1) (var_open_preterm 0 k t2)

/- opens the outermost abstraction of an n-preformula with a free variable fvar k-/
def var_open_preformula : Π (n : ℕ), ℕ → preformula n → preformula n
| 0 k (true L) := true
| 0 k (false L) := false
| 0 k (equal t1 t2) := equal (var_open_preterm _ k t1) (var_open_preterm _ k t2)
| 0 k (imp ϕ ψ) := imp (var_open_preformula 0 k ϕ) (var_open_preformula 0 k ψ)
| 0 0 (all ϕ) := var_open_preformula 0 1 ϕ -- careful! we only strip the quantifier and increase the count when we hit the _first_ quantifier, after that, only increase the count
| 0 (n+1) (all ϕ) := (all (var_open_preformula 0 (n+1) ϕ))
| n k (rel R) := (rel R)
| n k (apprel (ψ : preformula (n+1)) t) := apprel (var_open_preformula (n+1) k ψ) (var_open_preterm 0 k t)

/-Variable closing-/
-- I quote: Symmetrically to variable opening, we may want to build an abstraction given its
-- body. With the named representation, we consider a term t and a name x, and we
-- simply build the abstraction “λx. t”. All the variables named x are abstracted, except
-- those that already appear below an abstraction named x. With the locally nameless
-- representation, we consider a term t and a name x to be abstracted in t, and we
-- build a term, written \x t, by applying the variable closing operation to t and x. All
-- the variables named x occurring in t are abstracted, without exception (indeed, no
-- shadowing is possible with the locally nameless syntax). The abstraction may then be
-- constructed as “abs ( \x t)”. More precisely, the term \x t is a copy of t in which all the
-- free variables named x have been replaced with a bound variable. The indices of those
-- variables are chosen in such a way that all the bound variables introduced are pointing
-- towards the outer abstraction of “abs ( \x t)”.
-- The implementation of variable closing follows a pattern similar to the implemen-
-- tation of variable opening. Its implementation is based on a recursive function, written
-- “{k ← x} t”, that keeps track of the number k of abstractions that have been passed by.
-- Again, the value of k is 0 initially and it is incremented at each abstraction. Variable
-- closing is defined as follows:
-- \x
-- t ≡ {0 ← x} t
-- When the recursive function reaches a free variable with name y, it compares the name
-- y with the name x. If the two names match, then the free variable y is replaced with
-- a bound variable of index k, otherwise it is left unchanged. Note that bound variables
-- already occurring in the term are never affected by variable closing.

def var_close_preterm : Π n : ℕ, ℕ → preterm L n  → preterm L n -- first ℕ is the preterm level, second is the open index we're closing
| 0 k (preterm.fvar L i) := if (i = k)
then preterm.bvar _ k
else (preterm.fvar _ i)
| 0 k (preterm.bvar L y) := preterm.fvar _ y
| n k (preterm.func f) := preterm.func f
| n k (preterm.apply (t1 : preterm L (n+1)) (t2 : preterm L 0)) := preterm.apply (var_close_preterm (n+1) k t1) (var_close_preterm 0 k t2)

/- wraps an abstraction around an n-preformula, binding a specified free variable-/
def var_close_preformula : Π (n : ℕ), ℕ → preformula n → preformula n
| 0 k (true L) := true
| 0 k (false L) := false
| 0 k (equal t1 t2) := equal (var_close_preterm _ k t1) (var_close_preterm _ k t2)
| 0 k (imp ϕ ψ) := imp (var_close_preformula 0 k ϕ) (var_close_preformula 0 k ψ)
| 0 k (all ϕ) := all (var_close_preformula 0 (k+1) ϕ)
| n k (rel R) := (rel R)
| n k (apprel (ψ : preformula (n+1)) t) := apprel (var_close_preformula (n+1) k ψ) (var_close_preterm 0 k t)

/-***********************************-/

/- LOCALLY CLOSED TERMS -/
-- unfortunately, we need a well-formedness predicate. Again, to quote Chargueraud:
-- As suggested in the previous section, the locally nameless syntax contains objects
-- that do not correspond to any valid λ-term. For instance, “abs 3” is such an improper
-- syntactic object, since the bound variable with index 3 does not refer to any abstraction
-- inside the term. We need to ensure that terms do not contain any such dangling bound
-- variable. We say of well-formed terms that they are locally closed. The purpose of this
-- section is to give a formal characterization of the set of locally closed terms.
-- Two approaches are possible. The first one consists in investigating the term recur-
-- sively, opening every abstraction with a name, and checking that no bound variable is
-- ever reached. The second possible approach relies on an analysis of bound variables,
-- for checking that each bound variable has an index smaller than the number of enclos-
-- ing abstractions. We start by describing the first approach, which is the most helpful
-- for formally reasoning on terms represented in locally nameless style, and study the
-- approach based on indices afterwards.
-- The local closure predicate, written “lc t”, characterizes terms that are locally
-- closed. It is defined using three inductive rules. The first one states that any free
-- variable is locally closed. The second one states that an application is locally closed if
-- its two branches are locally closed. The third and last one states that an abstraction
-- is locally closed if its body opened with some name is itself locally closed. Notice that
-- a bound variable on its own is never locally closed.

-- In practice, we use a slightly different rule to deal with abstractions. In the rule
-- lc-var’, the premise lc (t x ) is required to hold for one single name x. Instead, we are
-- going to require lc (t x ) to hold for cofinitely-many names x. More precisely, we consider
-- that an abstraction “abs t” is locally closed if there exists a finite set of names L such
-- that, for any name x not in L, the term t x is locally closed.

-- The motivation for the cofinite quantification will be discussed in details later on (§4.2)

-- Arthur's talking crazy. I'm going with the counting-of-bound-variables.
end

variable L : Language

def locally_closed_preterm : Π n : ℕ, ℕ → preterm L n → Prop
| 0 k (preterm.bvar L i) := nat.lt i k
| 0 k (preterm.fvar L i) := true
| n k (preterm.func f) := true
| n k (preterm.apply t1 t2) := (locally_closed_preterm (n+1) k t1) ∧ (locally_closed_preterm 0 k t2)

def locally_closed_preformula : Π n : ℕ, ℕ → preformula L n → Prop
| 0 k (preformula.true L) := true
| 0 k (preformula.false L) := tt
| 0 k (preformula.equal t1 t2) := (locally_closed_preterm L 0 k t1) ∧ (locally_closed_preterm L 0 k t2)
| 0 k (preformula.imp ψ ϕ) := (locally_closed_preformula 0 k ψ) ∧ (locally_closed_preformula 0 k ϕ)
| 0 k (preformula.all ψ) := (locally_closed_preformula 0 (k+1) ψ)
| n k (preformula.rel R) := tt
| n k (preformula.apprel ψ t) := (locally_closed_preformula (n+1) k ψ) ∧ (locally_closed_preterm L 0 k t)

-- NOTE: "locally closed" means the same as "well-formed". Therefore, we introduce the following aliases

/-- A well-formed term, by itself, has no bound variables --/
def well_formed_term : term L → Prop := locally_closed_preterm L 0 0

/-- A well-formed formula is a locally closed preformula. Remember the second nat parameter counts the number of quantifiers we have passed.--/
def well_formed_formula : formula L → Prop := locally_closed_preformula L 0 0
/-***********************************-/

/-FREE VARIABLES AND SUBSTITUTION-/
-- Note that we can define the substitution t/x for x not even occuring in a term or formula. In that case, the substitution operation does nothing. If we have to prove this later, it shouldn't be hard.

/-- Given an n-preterm, a term t, and a fvar x, return that n-preterm with all instances of x replaced with t--/
def substitute_preterm : Π n : ℕ, preterm L n → term L → ℕ → preterm L n
| 0 (preterm.bvar L i) t k := preterm.bvar L i
| 0 (preterm.fvar _ i) t k := if i = k then t else (preterm.fvar _ i)
| n (preterm.func f) t k := (preterm.func f)
| n (preterm.apply t1 t2) t k := preterm.apply (substitute_preterm (n+1) t1 t k) (substitute_preterm 0 t2 t k)

/-- Given an n-preformula, a term t, and a fvar x, return that n-preterm with all instances of x replaced with t--/
def substitute_preformula : Π n : ℕ, preformula L n → term L → ℕ → preformula L n
| _ (preformula.true L) _ _ := preformula.true L
| _ (preformula.false L) _ _ := preformula.false L
| _ (preformula.equal t1 t2) t k := preformula.equal (substitute_preterm L 0 t1 t k) (substitute_preterm L 0 t2 t k)
| _ (preformula.rel R) t k := preformula.rel R
| _ (preformula.apprel ϕ s) t k := preformula.apprel (substitute_preformula _ ϕ t k) (substitute_preterm L _ s t k)
| _ (preformula.imp ϕ ψ) t k := preformula.imp (substitute_preformula _ ϕ t k) (substitute_preformula _ ψ t k)
| _ (preformula.all ψ) t k := preformula.all (substitute_preformula _ ψ t k)

/-***********************************-/

/- ignore the rest of this file-/

-- def raise_depth_formula : ∀ {l}, preformula l → ℕ → ℕ → preformula l
-- | _ (true L) n m := true
-- | _ (false L) n m := false
-- | _ (equal t1 t2) n m := equal (raise_depth_term t1 n m) (raise_depth_term t2 n m)
-- | _ (rel R) n m := rel R
-- | _ (apprel f t) n m := apprel (raise_depth_formula f n m) (raise_depth_term t n m)
-- | _ (imp f1 f2) n m := imp (raise_depth_formula f1 n m) (raise_depth_formula f2 n m)
-- | _ (all f) n m := all (raise_depth_formula f n (m+1))

-- def substitute_formula : ∀ {l}, preformula l → (term L) → ℕ → preformula l
-- | _ (true L) s n := true
-- | _ (false L) s n := false
-- | _ (equal t1 t2) s n := equal (substitute_term L t1 s n) (substitute_term L t2 s n)
-- | _ (rel R) s n := rel R
-- | _ (apprel f t) s n := apprel (substitute_formula f s n) (substitute_term t s n)
-- | _ (imp f1 f2) s n := imp (substitute_formula f1 s n) (substitute_formula f2 s n)
-- | _ (all f) s n := all (substitute_formula f s (n+1))

-- def substitute_preformula : Π n : ℕ, Π (ψ : preformula n), term → {x : ℕ // x ∈ (free_vars_preformula _ ψ)} → preformula n
-- | _ (true L) t x := true
-- | _ (false L) t x := false
-- | _ (equal t1 t2) := equal (substitute_preformula _ _ _ _ t1) (substitute_preformula _ _ _ _ t2)


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.polynomial.derivative
import data.nat.choose.sum
import ring_theory.polynomial.pochhammer
import data.polynomial.algebra_map
import linear_algebra.linear_independent
import data.mv_polynomial.pderiv

/-!
# Bernstein polynomials

The definition of the Bernstein polynomials
```
bernstein_polynomial (R : Type*) [comm_ring R] (n ν : ℕ) : R[X] :=
(choose n ν) * X^ν * (1 - X)^(n - ν)
```
and the fact that for `ν : fin (n+1)` these are linearly independent over `ℚ`.

We prove the basic identities
* `(finset.range (n + 1)).sum (λ ν, bernstein_polynomial R n ν) = 1`
* `(finset.range (n + 1)).sum (λ ν, ν • bernstein_polynomial R n ν) = n • X`
* `(finset.range (n + 1)).sum (λ ν, (ν * (ν-1)) • bernstein_polynomial R n ν) = (n * (n-1)) • X^2`

## Notes

See also `analysis.special_functions.bernstein`, which defines the Bernstein approximations
of a continuous function `f : C([0,1], ℝ)`, and shows that these converge uniformly to `f`.
-/

noncomputable theory

open nat (choose)
open polynomial (X)
open_locale big_operators polynomial

variables (R : Type*) [comm_ring R]

/--
`bernstein_polynomial R n ν` is `(choose n ν) * X^ν * (1 - X)^(n - ν)`.

Although the coefficients are integers, it is convenient to work over an arbitrary commutative ring.
-/
def bernstein_polynomial (n ν : ℕ) : R[X] := choose n ν * X^ν * (1 - X)^(n - ν)

example : bernstein_polynomial ℤ 3 2 = 3 * X^2 - 3 * X^3 :=
begin
  norm_num [bernstein_polynomial, choose],
  ring,
end

namespace bernstein_polynomial

lemma eq_zero_of_lt {n ν : ℕ} (h : n < ν) : bernstein_polynomial R n ν = 0 :=
by simp [bernstein_polynomial, nat.choose_eq_zero_of_lt h]

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

@[simp] lemma map (f : R →+* S) (n ν : ℕ) :
  (bernstein_polynomial R n ν).map f = bernstein_polynomial S n ν :=
by simp [bernstein_polynomial]

end

lemma flip (n ν : ℕ) (h : ν ≤ n) :
  (bernstein_polynomial R n ν).comp (1-X) = bernstein_polynomial R n (n-ν) :=
by simp [bernstein_polynomial, h, tsub_tsub_assoc, mul_right_comm]

lemma flip' (n ν : ℕ) (h : ν ≤ n) :
  bernstein_polynomial R n ν = (bernstein_polynomial R n (n-ν)).comp (1-X) :=
by simp [←flip _ _ _ h, polynomial.comp_assoc]

lemma eval_at_0 (n ν : ℕ) : (bernstein_polynomial R n ν).eval 0 = if ν = 0 then 1 else 0 :=
begin
  rw [bernstein_polynomial],
  split_ifs,
  { subst h, simp, },
  { simp [zero_pow (nat.pos_of_ne_zero h)], },
end

lemma eval_at_1 (n ν : ℕ) : (bernstein_polynomial R n ν).eval 1 = if ν = n then 1 else 0 :=
begin
  rw [bernstein_polynomial],
  split_ifs,
  { subst h, simp, },
  { obtain w | w := (n - ν).eq_zero_or_pos,
    { simp [nat.choose_eq_zero_of_lt ((tsub_eq_zero_iff_le.mp w).lt_of_ne (ne.symm h))] },
    { simp [zero_pow w] } },
end.

lemma derivative_succ_aux (n ν : ℕ) :
  (bernstein_polynomial R (n+1) (ν+1)).derivative =
    (n+1) * (bernstein_polynomial R n ν - bernstein_polynomial R n (ν + 1)) :=
begin
  rw [bernstein_polynomial],
  suffices :
    ↑((n + 1).choose (ν + 1)) * (↑(ν + 1) * X ^ ν) * (1 - X) ^ (n - ν)
      -(↑((n + 1).choose (ν + 1)) * X ^ (ν + 1) * (↑(n - ν) * (1 - X) ^ (n - ν - 1))) =
    ↑(n + 1) * (↑(n.choose ν) * X ^ ν * (1 - X) ^ (n - ν) -
         ↑(n.choose (ν + 1)) * X ^ (ν + 1) * (1 - X) ^ (n - (ν + 1))),
  { simpa only [polynomial.derivative_pow, ←sub_eq_add_neg, nat.succ_sub_succ_eq_sub,
      polynomial.derivative_mul, polynomial.derivative_nat_cast, zero_mul, nat.cast_add,
      algebra_map.coe_one, polynomial.derivative_X, mul_one, zero_add,
      polynomial.derivative_sub, polynomial.derivative_one, zero_sub, mul_neg,
      nat.sub_zero, ← nat.cast_succ, polynomial.C_eq_nat_cast], },
  conv_rhs { rw mul_sub, },
  -- We'll prove the two terms match up separately.
  refine congr (congr_arg has_sub.sub _) _,
  { simp only [←mul_assoc],
    refine congr (congr_arg (*) (congr (congr_arg (*) _) rfl)) rfl,
    -- Now it's just about binomial coefficients
    exact_mod_cast congr_arg (λ m : ℕ, (m : R[X])) (nat.succ_mul_choose_eq n ν).symm, },
  { rw [← tsub_add_eq_tsub_tsub, ← mul_assoc, ← mul_assoc], congr' 1,
    rw [mul_comm, ←mul_assoc, ←mul_assoc], congr' 1,
    norm_cast,
    congr' 1,
    convert (nat.choose_mul_succ_eq n (ν + 1)).symm using 1,
    { convert mul_comm _ _ using 2,
      simp, },
    { apply mul_comm, }, },
end

lemma derivative_succ (n ν : ℕ) :
  (bernstein_polynomial R n (ν+1)).derivative =
    n * (bernstein_polynomial R (n-1) ν - bernstein_polynomial R (n-1) (ν+1)) :=
begin
  cases n,
  { simp [bernstein_polynomial], },
  { rw nat.cast_succ, apply derivative_succ_aux, }
end

lemma derivative_zero (n : ℕ) :
  (bernstein_polynomial R n 0).derivative = -n * bernstein_polynomial R (n-1) 0 :=
by simp [bernstein_polynomial, polynomial.derivative_pow]

lemma iterate_derivative_at_0_eq_zero_of_lt (n : ℕ) {ν k : ℕ} :
  k < ν → (polynomial.derivative^[k] (bernstein_polynomial R n ν)).eval 0 = 0 :=
begin
  cases ν,
  { rintro ⟨⟩, },
  { rw nat.lt_succ_iff,
    induction k with k ih generalizing n ν,
    { simp [eval_at_0], },
    { simp only [derivative_succ, int.coe_nat_eq_zero, mul_eq_zero,
        function.comp_app, function.iterate_succ,
        polynomial.iterate_derivative_sub, polynomial.iterate_derivative_nat_cast_mul,
        polynomial.eval_mul, polynomial.eval_nat_cast, polynomial.eval_sub],
      intro h,
      apply mul_eq_zero_of_right,
      rw [ih _ _ (nat.le_of_succ_le h), sub_zero],
      convert ih _ _ (nat.pred_le_pred h),
      exact (nat.succ_pred_eq_of_pos (k.succ_pos.trans_le h)).symm } },
end

@[simp]
lemma iterate_derivative_succ_at_0_eq_zero (n ν : ℕ) :
  (polynomial.derivative^[ν] (bernstein_polynomial R n (ν+1))).eval 0 = 0 :=
iterate_derivative_at_0_eq_zero_of_lt R n (lt_add_one ν)

open polynomial

@[simp]

lemma iterate_derivative_at_0_ne_zero [char_zero R] (n ν : ℕ) (h : ν ≤ n) :
  (polynomial.derivative^[ν] (bernstein_polynomial R n ν)).eval 0 ≠ 0 :=
begin
  simp only [int.coe_nat_eq_zero, bernstein_polynomial.iterate_derivative_at_0, ne.def,
    nat.cast_eq_zero],
  simp only [←pochhammer_eval_cast],
  norm_cast,
  apply ne_of_gt,
  obtain rfl|h' := nat.eq_zero_or_pos ν,
  { simp, },
  { rw ← nat.succ_pred_eq_of_pos h' at h,
    exact pochhammer_pos _ _ (tsub_pos_of_lt (nat.lt_of_succ_le h)) }
end

/-!
Rather than redoing the work of evaluating the derivatives at 1,
we use the symmetry of the Bernstein polynomials.
-/
lemma iterate_derivative_at_1_eq_zero_of_lt (n : ℕ) {ν k : ℕ} :
  k < n - ν → (polynomial.derivative^[k] (bernstein_polynomial R n ν)).eval 1 = 0 :=
begin
  intro w,
  rw flip' _ _ _ (tsub_pos_iff_lt.mp (pos_of_gt w)).le,
  simp [polynomial.eval_comp, iterate_derivative_at_0_eq_zero_of_lt R n w],
end

@[simp]
lemma iterate_derivative_at_1 (n ν : ℕ) (h : ν ≤ n) :
  (polynomial.derivative^[n-ν] (bernstein_polynomial R n ν)).eval 1 =
    (-1)^(n-ν) * (pochhammer R (n - ν)).eval (ν + 1) :=
begin
  rw flip' _ _ _ h,
  simp [polynomial.eval_comp, h],
  obtain rfl | h' := h.eq_or_lt,
  { simp, },
  { congr,
    norm_cast,
    rw [← tsub_add_eq_tsub_tsub, tsub_tsub_cancel_of_le (nat.succ_le_iff.mpr h')] },
end

lemma iterate_derivative_at_1_ne_zero [char_zero R] (n ν : ℕ) (h : ν ≤ n) :
  (polynomial.derivative^[n-ν] (bernstein_polynomial R n ν)).eval 1 ≠ 0 :=
begin
  rw [bernstein_polynomial.iterate_derivative_at_1 _ _ _ h, ne.def, neg_one_pow_mul_eq_zero_iff,
    ←nat.cast_succ, ←pochhammer_eval_cast, ←nat.cast_zero, nat.cast_inj],
  exact (pochhammer_pos _ _ (nat.succ_pos ν)).ne',
end

open submodule

lemma linear_independent_aux (n k : ℕ) (h : k ≤ n + 1):
  linear_independent ℚ (λ ν : fin k, bernstein_polynomial ℚ n ν) :=
begin
  induction k with k ih,
  { apply linear_independent_empty_type, },
  { apply linear_independent_fin_succ'.mpr,
    fsplit,
    { exact ih (le_of_lt h), },
    { -- The actual work!
      -- We show that the (n-k)-th derivative at 1 doesn't vanish,
      -- but vanishes for everything in the span.
      clear ih,
      simp only [nat.succ_eq_add_one, add_le_add_iff_right] at h,
      simp only [fin.coe_last, fin.init_def],
      dsimp,
      apply not_mem_span_of_apply_not_mem_span_image ((@polynomial.derivative ℚ _)^(n-k)),
      simp only [not_exists, not_and, submodule.mem_map, submodule.span_image],
      intros p m,
      apply_fun (polynomial.eval (1 : ℚ)),
      simp only [linear_map.pow_apply],
      -- The right hand side is nonzero,
      -- so it will suffice to show the left hand side is always zero.
      suffices : (polynomial.derivative^[n-k] p).eval 1 = 0,
      { rw [this],
        exact (iterate_derivative_at_1_ne_zero ℚ n k h).symm, },
      apply span_induction m,
      { simp,
        rintro ⟨a, w⟩, simp only [fin.coe_mk],
        rw [iterate_derivative_at_1_eq_zero_of_lt ℚ n ((tsub_lt_tsub_iff_left_of_le h).mpr w)] },
      { simp, },
      { intros x y hx hy, simp [hx, hy], },
      { intros a x h, simp [h], }, }, },
end

/--
The Bernstein polynomials are linearly independent.

We prove by induction that the collection of `bernstein_polynomial n ν` for `ν = 0, ..., k`
are linearly independent.
The inductive step relies on the observation that the `(n-k)`-th derivative, evaluated at 1,
annihilates `bernstein_polynomial n ν` for `ν < k`, but has a nonzero value at `ν = k`.
-/

lemma linear_independent (n : ℕ) :
  linear_independent ℚ (λ ν : fin (n+1), bernstein_polynomial ℚ n ν) :=
linear_independent_aux n (n+1) le_rfl

lemma sum (n : ℕ) : ∑ ν in finset.range (n + 1), bernstein_polynomial R n ν = 1 :=
calc ∑ ν in finset.range (n + 1), bernstein_polynomial R n ν = (X + (1 - X)) ^ n :
  by { rw add_pow, simp only [bernstein_polynomial, mul_comm, mul_assoc, mul_left_comm] }
... = 1 : by simp

open polynomial
open mv_polynomial

lemma sum_smul (n : ℕ) :
  ∑ ν in finset.range (n + 1), ν • bernstein_polynomial R n ν = n • X :=
begin

  -- We calculate the `x`-derivative of `(x+y)^n`, evaluated at `y=(1-x)`,
  -- either directly or by using the binomial theorem.

  -- We'll work in `mv_polynomial bool R`.
  let x : mv_polynomial bool R := mv_polynomial.X tt,
  let y : mv_polynomial bool R := mv_polynomial.X ff,

  have pderiv_tt_x : pderiv tt x = 1, { rw [pderiv_X], refl, },
  have pderiv_tt_y : pderiv tt y = 0, { rw [pderiv_X], refl, },

  let e : bool → R[X] := λ i, cond i X (1-X),

  -- Start with `(x+y)^n = (x+y)^n`,
  -- take the `x`-derivative, evaluate at `x=X, y=1-X`, and multiply by `X`:
  transitivity aeval e (pderiv tt ((x + y) ^ n)) * X,

  -- On the left hand side we'll use the binomial theorem, then simplify.

  { -- We first prepare a tedious rewrite:
    have w : ∀ k : ℕ,
      k • bernstein_polynomial R n k =
        ↑k * polynomial.X ^ (k - 1) * (1 - polynomial.X) ^ (n - k) * ↑(n.choose k) * polynomial.X,
    { rintro (_|k),
      { simp, },
      { rw [bernstein_polynomial],
        simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
        push_cast,
        ring, }, },

    rw [add_pow, (pderiv tt).map_sum, (mv_polynomial.aeval e).map_sum, finset.sum_mul],
    -- Step inside the sum:
    refine finset.sum_congr rfl (λ k hk, (w k).trans _),
    simp only [pderiv_tt_x, pderiv_tt_y, algebra.id.smul_eq_mul, nsmul_eq_mul,
      e, bool.cond_tt, bool.cond_ff, add_zero, mul_one, mul_zero, smul_zero,
      mv_polynomial.aeval_X, mv_polynomial.pderiv_mul,
      derivation.leibniz_pow, derivation.map_coe_nat,
      map_nat_cast, map_pow, map_mul], },

  { rw [(pderiv tt).leibniz_pow, (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y],
    simp only [algebra.id.smul_eq_mul, nsmul_eq_mul,
      map_nat_cast, map_pow, map_add, map_mul, e, bool.cond_tt, bool.cond_ff,
      mv_polynomial.aeval_X, add_sub_cancel'_right, one_pow, add_zero, mul_one] },
end

lemma sum_mul_smul (n : ℕ) :
  ∑ ν in finset.range (n + 1), (ν * (ν-1)) • bernstein_polynomial R n ν = (n * (n-1)) • X^2 :=
begin
  -- We calculate the second `x`-derivative of `(x+y)^n`, evaluated at `y=(1-x)`,
  -- either directly or by using the binomial theorem.

  -- We'll work in `mv_polynomial bool R`.
  let x : mv_polynomial bool R := mv_polynomial.X tt,
  let y : mv_polynomial bool R := mv_polynomial.X ff,

  have pderiv_tt_x : pderiv tt x = 1, { rw [pderiv_X], refl, },
  have pderiv_tt_y : pderiv tt y = 0, { rw [pderiv_X], refl, },

  let e : bool → R[X] := λ i, cond i X (1-X),

  -- Start with `(x+y)^n = (x+y)^n`,
  -- take the second `x`-derivative, evaluate at `x=X, y=1-X`, and multiply by `X`:
  transitivity aeval e (pderiv tt (pderiv tt ((x + y) ^ n))) * X ^ 2,

  -- On the left hand side we'll use the binomial theorem, then simplify.
  { -- We first prepare a tedious rewrite:
    have w : ∀ k : ℕ,
      (k * (k-1)) • bernstein_polynomial R n k =
        ↑(n.choose k) * ((1 - polynomial.X) ^ (n - k) *
          (↑k * (↑(k-1) * polynomial.X ^ (k - 1 - 1)))) * polynomial.X^2,
    { rintro (_|_|k),
      { simp, },
      { simp, },
      { rw [bernstein_polynomial],
        simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
        push_cast,
        ring, }, },

    rw [add_pow, (pderiv tt).map_sum, (pderiv tt).map_sum, (mv_polynomial.aeval e).map_sum,
      finset.sum_mul],
    -- Step inside the sum:
    refine finset.sum_congr rfl (λ k hk, (w k).trans _),
    simp only [pderiv_tt_x, pderiv_tt_y, algebra.id.smul_eq_mul, nsmul_eq_mul,
      e, bool.cond_tt, bool.cond_ff, add_zero, zero_add, mul_zero, smul_zero, mul_one,
      mv_polynomial.aeval_X, mv_polynomial.pderiv_X_self, mv_polynomial.pderiv_X_of_ne,
      derivation.leibniz_pow, derivation.leibniz, derivation.map_coe_nat,
      map_nat_cast, map_pow, map_mul, map_add], },

  -- On the right hand side, we'll just simplify.
  { simp only [pderiv_one, pderiv_mul, (pderiv _).leibniz_pow, (pderiv _).map_coe_nat,
      (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y, algebra.id.smul_eq_mul, add_zero, mul_one,
      derivation.map_smul_of_tower, map_nsmul, map_pow, map_add, e, bool.cond_tt, bool.cond_ff,
      mv_polynomial.aeval_X, add_sub_cancel'_right, one_pow, smul_smul, smul_one_mul] },
end

/--
A certain linear combination of the previous three identities,
which we'll want later.
-/
lemma variance (n : ℕ) :
  ∑ ν in finset.range (n+1), (n • polynomial.X - ν)^2 * bernstein_polynomial R n ν =
    n • polynomial.X * (1 - polynomial.X) :=
begin
  have p :
    (finset.range (n+1)).sum (λ ν, (ν * (ν-1)) • bernstein_polynomial R n ν) +
    (1 - (2 * n) • polynomial.X) * (finset.range (n+1)).sum (λ ν, ν • bernstein_polynomial R n ν) +
    (n^2 • X^2) * (finset.range (n+1)).sum (λ ν, bernstein_polynomial R n ν) = _ := rfl,
  conv at p { to_lhs,
    rw [finset.mul_sum, finset.mul_sum, ←finset.sum_add_distrib, ←finset.sum_add_distrib],
    simp only [←nat_cast_mul],
    simp only [←mul_assoc],
    simp only [←add_mul], },
  conv at p { to_rhs,
    rw [sum, sum_smul, sum_mul_smul, ←nat_cast_mul], },
  calc _ = _ : finset.sum_congr rfl (λ k m, _)
     ... = _ : p
     ... = _ : _,
  { congr' 1, simp only [←nat_cast_mul] with push_cast,
    cases k; { simp, ring, }, },
  { simp only [←nat_cast_mul] with push_cast,
    cases n,
    { simp, },
    { simp, ring, }, },
end

end bernstein_polynomial