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

! This file was ported from Lean 3 source module algebra.homology.augment
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.Single

/-!
# Augmentation and truncation of `ℕ`-indexed (co)chain complexes.
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

open HomologicalComplex

universe v u

variable {V : Type u} [Category.{v} V]

namespace ChainComplex

/-- The truncation of a `ℕ`-indexed chain complex,
deleting the object at `0` and shifting everything else down.
-/
@[simps]
def truncate [HasZeroMorphisms V] : ChainComplex V ℕ ⥤ ChainComplex V ℕ
    where
  obj C :=
    { pt := fun i => C.pt (i + 1)
      d := fun i j => C.d (i + 1) (j + 1)
      shape' := fun i j w => by
        apply C.shape
        simpa }
  map C D f := { f := fun i => f.f (i + 1) }
#align chain_complex.truncate ChainComplex.truncate

/-- There is a canonical chain map from the truncation of a chain map `C` to
the "single object" chain complex consisting of the truncated object `C.X 0` in degree 0.
The components of this chain map are `C.d 1 0` in degree 0, and zero otherwise.
-/
def truncateTo [HasZeroObject V] [HasZeroMorphisms V] (C : ChainComplex V ℕ) :
    truncate.obj C ⟶ (single₀ V).obj (C.pt 0) :=
  (toSingle₀Equiv (truncate.obj C) (C.pt 0)).symm ⟨C.d 1 0, by tidy⟩
#align chain_complex.truncate_to ChainComplex.truncateTo

-- PROJECT when `V` is abelian (but not generally?)
-- `[∀ n, exact (C.d (n+2) (n+1)) (C.d (n+1) n)] [epi (C.d 1 0)]` iff `quasi_iso (C.truncate_to)`
variable [HasZeroMorphisms V]

/-- We can "augment" a chain complex by inserting an arbitrary object in degree zero
(shifting everything else up), along with a suitable differential.
-/
def augment (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) : ChainComplex V ℕ
    where
  pt i :=
    match i with
    | 0 => X
    | i + 1 => C.pt i
  d i j :=
    match i, j with
    | 1, 0 => f
    | i + 1, j + 1 => C.d i j
    | _, _ => 0
  shape' i j s := by
    simp at s
    rcases i with (_ | _ | i) <;> cases j <;> unfold_aux <;> try simp
    · simpa using s
    · rw [C.shape]
      simpa [← Ne.def, Nat.succ_ne_succ] using s
  d_comp_d' i j k hij hjk :=
    by
    rcases i with (_ | _ | i) <;> rcases j with (_ | _ | j) <;> cases k <;> unfold_aux <;> try simp
    cases i
    · exact w
    · rw [C.shape, zero_comp]
      simpa using i.succ_succ_ne_one.symm
#align chain_complex.augment ChainComplex.augment

@[simp]
theorem augment_x_zero (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
    (augment C f w).pt 0 = X :=
  rfl
#align chain_complex.augment_X_zero ChainComplex.augment_x_zero

@[simp]
theorem augment_x_succ (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0)
    (i : ℕ) : (augment C f w).pt (i + 1) = C.pt i :=
  rfl
#align chain_complex.augment_X_succ ChainComplex.augment_x_succ

@[simp]
theorem augment_d_one_zero (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
    (augment C f w).d 1 0 = f :=
  rfl
#align chain_complex.augment_d_one_zero ChainComplex.augment_d_one_zero

@[simp]
theorem augment_d_succ_succ (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0)
    (i j : ℕ) : (augment C f w).d (i + 1) (j + 1) = C.d i j :=
  by
  dsimp [augment]
  rcases i with (_ | i)
  rfl
  rfl
#align chain_complex.augment_d_succ_succ ChainComplex.augment_d_succ_succ

/-- Truncating an augmented chain complex is isomorphic (with components the identity)
to the original complex.
-/
def truncateAugment (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0) :
    truncate.obj (augment C f w) ≅ C
    where
  Hom := { f := fun i => 𝟙 _ }
  inv :=
    { f := fun i => 𝟙 _
      comm' := fun i j => by
        cases j <;>
          · dsimp
            simp }
  hom_inv_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
  inv_hom_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
#align chain_complex.truncate_augment ChainComplex.truncateAugment

@[simp]
theorem truncateAugment_hom_f (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0)
    (i : ℕ) : (truncateAugment C f w).Hom.f i = 𝟙 (C.pt i) :=
  rfl
#align chain_complex.truncate_augment_hom_f ChainComplex.truncateAugment_hom_f

@[simp]
theorem truncateAugment_inv_f (C : ChainComplex V ℕ) {X : V} (f : C.pt 0 ⟶ X) (w : C.d 1 0 ≫ f = 0)
    (i : ℕ) : (truncateAugment C f w).inv.f i = 𝟙 ((truncate.obj (augment C f w)).pt i) :=
  rfl
#align chain_complex.truncate_augment_inv_f ChainComplex.truncateAugment_inv_f

@[simp]
theorem chainComplex_d_succ_succ_zero (C : ChainComplex V ℕ) (i : ℕ) : C.d (i + 2) 0 = 0 :=
  by
  rw [C.shape]
  simpa using i.succ_succ_ne_one.symm
#align chain_complex.chain_complex_d_succ_succ_zero ChainComplex.chainComplex_d_succ_succ_zero

/-- Augmenting a truncated complex with the original object and morphism is isomorphic
(with components the identity) to the original complex.
-/
def augmentTruncate (C : ChainComplex V ℕ) :
    augment (truncate.obj C) (C.d 1 0) (C.d_comp_d _ _ _) ≅ C
    where
  Hom :=
    { f := fun i => by cases i <;> exact 𝟙 _
      comm' := fun i j => by
        rcases i with (_ | _ | i) <;> cases j <;>
          · dsimp
            simp }
  inv :=
    { f := fun i => by cases i <;> exact 𝟙 _
      comm' := fun i j => by
        rcases i with (_ | _ | i) <;> cases j <;>
          · dsimp
            simp }
  hom_inv_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
  inv_hom_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
#align chain_complex.augment_truncate ChainComplex.augmentTruncate

@[simp]
theorem augmentTruncate_hom_f_zero (C : ChainComplex V ℕ) :
    (augmentTruncate C).Hom.f 0 = 𝟙 (C.pt 0) :=
  rfl
#align chain_complex.augment_truncate_hom_f_zero ChainComplex.augmentTruncate_hom_f_zero

@[simp]
theorem augmentTruncate_hom_f_succ (C : ChainComplex V ℕ) (i : ℕ) :
    (augmentTruncate C).Hom.f (i + 1) = 𝟙 (C.pt (i + 1)) :=
  rfl
#align chain_complex.augment_truncate_hom_f_succ ChainComplex.augmentTruncate_hom_f_succ

@[simp]
theorem augmentTruncate_inv_f_zero (C : ChainComplex V ℕ) :
    (augmentTruncate C).inv.f 0 = 𝟙 (C.pt 0) :=
  rfl
#align chain_complex.augment_truncate_inv_f_zero ChainComplex.augmentTruncate_inv_f_zero

@[simp]
theorem augmentTruncate_inv_f_succ (C : ChainComplex V ℕ) (i : ℕ) :
    (augmentTruncate C).inv.f (i + 1) = 𝟙 (C.pt (i + 1)) :=
  rfl
#align chain_complex.augment_truncate_inv_f_succ ChainComplex.augmentTruncate_inv_f_succ

/-- A chain map from a chain complex to a single object chain complex in degree zero
can be reinterpreted as a chain complex.

Ths is the inverse construction of `truncate_to`.
-/
def toSingle₀AsComplex [HasZeroObject V] (C : ChainComplex V ℕ) (X : V)
    (f : C ⟶ (single₀ V).obj X) : ChainComplex V ℕ :=
  let ⟨f, w⟩ := toSingle₀Equiv C X f
  augment C f w
#align chain_complex.to_single₀_as_complex ChainComplex.toSingle₀AsComplex

end ChainComplex

namespace CochainComplex

/-- The truncation of a `ℕ`-indexed cochain complex,
deleting the object at `0` and shifting everything else down.
-/
@[simps]
def truncate [HasZeroMorphisms V] : CochainComplex V ℕ ⥤ CochainComplex V ℕ
    where
  obj C :=
    { pt := fun i => C.pt (i + 1)
      d := fun i j => C.d (i + 1) (j + 1)
      shape' := fun i j w => by
        apply C.shape
        simpa }
  map C D f := { f := fun i => f.f (i + 1) }
#align cochain_complex.truncate CochainComplex.truncate

/-- There is a canonical chain map from the truncation of a cochain complex `C` to
the "single object" cochain complex consisting of the truncated object `C.X 0` in degree 0.
The components of this chain map are `C.d 0 1` in degree 0, and zero otherwise.
-/
def toTruncate [HasZeroObject V] [HasZeroMorphisms V] (C : CochainComplex V ℕ) :
    (single₀ V).obj (C.pt 0) ⟶ truncate.obj C :=
  (fromSingle₀Equiv (truncate.obj C) (C.pt 0)).symm ⟨C.d 0 1, by tidy⟩
#align cochain_complex.to_truncate CochainComplex.toTruncate

variable [HasZeroMorphisms V]

/-- We can "augment" a cochain complex by inserting an arbitrary object in degree zero
(shifting everything else up), along with a suitable differential.
-/
def augment (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0) (w : f ≫ C.d 0 1 = 0) :
    CochainComplex V ℕ
    where
  pt i :=
    match i with
    | 0 => X
    | i + 1 => C.pt i
  d i j :=
    match i, j with
    | 0, 1 => f
    | i + 1, j + 1 => C.d i j
    | _, _ => 0
  shape' i j s := by
    simp at s
    rcases j with (_ | _ | j) <;> cases i <;> unfold_aux <;> try simp
    · simpa using s
    · rw [C.shape]
      simp only [ComplexShape.up_Rel]
      contrapose! s
      rw [← s]
  d_comp_d' i j k hij hjk :=
    by
    rcases k with (_ | _ | k) <;> rcases j with (_ | _ | j) <;> cases i <;> unfold_aux <;> try simp
    cases k
    · exact w
    · rw [C.shape, comp_zero]
      simp only [Nat.zero_eq, ComplexShape.up_Rel, zero_add]
      exact (Nat.one_lt_succ_succ _).Ne
#align cochain_complex.augment CochainComplex.augment

@[simp]
theorem augment_x_zero (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0) (w : f ≫ C.d 0 1 = 0) :
    (augment C f w).pt 0 = X :=
  rfl
#align cochain_complex.augment_X_zero CochainComplex.augment_x_zero

@[simp]
theorem augment_x_succ (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0) (w : f ≫ C.d 0 1 = 0)
    (i : ℕ) : (augment C f w).pt (i + 1) = C.pt i :=
  rfl
#align cochain_complex.augment_X_succ CochainComplex.augment_x_succ

@[simp]
theorem augment_d_zero_one (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0) (w : f ≫ C.d 0 1 = 0) :
    (augment C f w).d 0 1 = f :=
  rfl
#align cochain_complex.augment_d_zero_one CochainComplex.augment_d_zero_one

@[simp]
theorem augment_d_succ_succ (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0) (w : f ≫ C.d 0 1 = 0)
    (i j : ℕ) : (augment C f w).d (i + 1) (j + 1) = C.d i j :=
  rfl
#align cochain_complex.augment_d_succ_succ CochainComplex.augment_d_succ_succ

/-- Truncating an augmented cochain complex is isomorphic (with components the identity)
to the original complex.
-/
def truncateAugment (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0) (w : f ≫ C.d 0 1 = 0) :
    truncate.obj (augment C f w) ≅ C
    where
  Hom := { f := fun i => 𝟙 _ }
  inv :=
    { f := fun i => 𝟙 _
      comm' := fun i j => by
        cases j <;>
          · dsimp
            simp }
  hom_inv_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
  inv_hom_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
#align cochain_complex.truncate_augment CochainComplex.truncateAugment

@[simp]
theorem truncateAugment_hom_f (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0)
    (w : f ≫ C.d 0 1 = 0) (i : ℕ) : (truncateAugment C f w).Hom.f i = 𝟙 (C.pt i) :=
  rfl
#align cochain_complex.truncate_augment_hom_f CochainComplex.truncateAugment_hom_f

@[simp]
theorem truncateAugment_inv_f (C : CochainComplex V ℕ) {X : V} (f : X ⟶ C.pt 0)
    (w : f ≫ C.d 0 1 = 0) (i : ℕ) :
    (truncateAugment C f w).inv.f i = 𝟙 ((truncate.obj (augment C f w)).pt i) :=
  rfl
#align cochain_complex.truncate_augment_inv_f CochainComplex.truncateAugment_inv_f

@[simp]
theorem cochainComplex_d_succ_succ_zero (C : CochainComplex V ℕ) (i : ℕ) : C.d 0 (i + 2) = 0 :=
  by
  rw [C.shape]
  simp only [ComplexShape.up_Rel, zero_add]
  exact (Nat.one_lt_succ_succ _).Ne
#align cochain_complex.cochain_complex_d_succ_succ_zero CochainComplex.cochainComplex_d_succ_succ_zero

/-- Augmenting a truncated complex with the original object and morphism is isomorphic
(with components the identity) to the original complex.
-/
def augmentTruncate (C : CochainComplex V ℕ) :
    augment (truncate.obj C) (C.d 0 1) (C.d_comp_d _ _ _) ≅ C
    where
  Hom :=
    { f := fun i => by cases i <;> exact 𝟙 _
      comm' := fun i j => by
        rcases j with (_ | _ | j) <;> cases i <;>
          · dsimp
            simp }
  inv :=
    { f := fun i => by cases i <;> exact 𝟙 _
      comm' := fun i j => by
        rcases j with (_ | _ | j) <;> cases i <;>
          · dsimp
            simp }
  hom_inv_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
  inv_hom_id' := by
    ext i
    cases i <;>
      · dsimp
        simp
#align cochain_complex.augment_truncate CochainComplex.augmentTruncate

@[simp]
theorem augmentTruncate_hom_f_zero (C : CochainComplex V ℕ) :
    (augmentTruncate C).Hom.f 0 = 𝟙 (C.pt 0) :=
  rfl
#align cochain_complex.augment_truncate_hom_f_zero CochainComplex.augmentTruncate_hom_f_zero

@[simp]
theorem augmentTruncate_hom_f_succ (C : CochainComplex V ℕ) (i : ℕ) :
    (augmentTruncate C).Hom.f (i + 1) = 𝟙 (C.pt (i + 1)) :=
  rfl
#align cochain_complex.augment_truncate_hom_f_succ CochainComplex.augmentTruncate_hom_f_succ

@[simp]
theorem augmentTruncate_inv_f_zero (C : CochainComplex V ℕ) :
    (augmentTruncate C).inv.f 0 = 𝟙 (C.pt 0) :=
  rfl
#align cochain_complex.augment_truncate_inv_f_zero CochainComplex.augmentTruncate_inv_f_zero

@[simp]
theorem augmentTruncate_inv_f_succ (C : CochainComplex V ℕ) (i : ℕ) :
    (augmentTruncate C).inv.f (i + 1) = 𝟙 (C.pt (i + 1)) :=
  rfl
#align cochain_complex.augment_truncate_inv_f_succ CochainComplex.augmentTruncate_inv_f_succ

/-- A chain map from a single object cochain complex in degree zero to a cochain complex
can be reinterpreted as a cochain complex.

Ths is the inverse construction of `to_truncate`.
-/
def fromSingle₀AsComplex [HasZeroObject V] (C : CochainComplex V ℕ) (X : V)
    (f : (single₀ V).obj X ⟶ C) : CochainComplex V ℕ :=
  let ⟨f, w⟩ := fromSingle₀Equiv C X f
  augment C f w
#align cochain_complex.from_single₀_as_complex CochainComplex.fromSingle₀AsComplex

end CochainComplex


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

! This file was ported from Lean 3 source module ring_theory.free_ring
! leanprover-community/mathlib commit 932872382355f00112641d305ba0619305dc8642
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.FreeAbelianGroup

/-!
# Free rings

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

The theory of the free ring over a type.

## Main definitions

* `free_ring α` : the free (not commutative in general) ring over a type.
* `lift (f : α → R)` : the ring hom `free_ring α →+* R` induced by `f`.
* `map (f : α → β)` : the ring hom `free_ring α →+* free_ring β` induced by `f`.

## Implementation details

`free_ring α` is implemented as the free abelian group over the free monoid on `α`.

## Tags

free ring

-/

universe u v

#print FreeRing /-
/-- The free ring over a type `α`. -/
def FreeRing (α : Type u) : Type u :=
  FreeAbelianGroup <| FreeMonoid α deriving Ring, Inhabited
#align free_ring FreeRing
-/

namespace FreeRing

variable {α : Type u}

#print FreeRing.of /-
/-- The canonical map from α to `free_ring α`. -/
def of (x : α) : FreeRing α :=
  FreeAbelianGroup.of (FreeMonoid.of x)
#align free_ring.of FreeRing.of
-/

#print FreeRing.of_injective /-
theorem of_injective : Function.Injective (of : α → FreeRing α) :=
  FreeAbelianGroup.of_injective.comp FreeMonoid.of_injective
#align free_ring.of_injective FreeRing.of_injective
-/

/- warning: free_ring.induction_on -> FreeRing.induction_on is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {C : (FreeRing.{u1} α) -> Prop} (z : FreeRing.{u1} α), (C (Neg.neg.{u1} (FreeRing.{u1} α) (SubNegMonoid.toHasNeg.{u1} (FreeRing.{u1} α) (AddGroup.toSubNegMonoid.{u1} (FreeRing.{u1} α) (AddGroupWithOne.toAddGroup.{u1} (FreeRing.{u1} α) (AddCommGroupWithOne.toAddGroupWithOne.{u1} (FreeRing.{u1} α) (Ring.toAddCommGroupWithOne.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α)))))) (OfNat.ofNat.{u1} (FreeRing.{u1} α) 1 (OfNat.mk.{u1} (FreeRing.{u1} α) 1 (One.one.{u1} (FreeRing.{u1} α) (AddMonoidWithOne.toOne.{u1} (FreeRing.{u1} α) (AddGroupWithOne.toAddMonoidWithOne.{u1} (FreeRing.{u1} α) (AddCommGroupWithOne.toAddGroupWithOne.{u1} (FreeRing.{u1} α) (Ring.toAddCommGroupWithOne.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α)))))))))) -> (forall (b : α), C (FreeRing.of.{u1} α b)) -> (forall (x : FreeRing.{u1} α) (y : FreeRing.{u1} α), (C x) -> (C y) -> (C (HAdd.hAdd.{u1, u1, u1} (FreeRing.{u1} α) (FreeRing.{u1} α) (FreeRing.{u1} α) (instHAdd.{u1} (FreeRing.{u1} α) (Distrib.toHasAdd.{u1} (FreeRing.{u1} α) (Ring.toDistrib.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α)))) x y))) -> (forall (x : FreeRing.{u1} α) (y : FreeRing.{u1} α), (C x) -> (C y) -> (C (HMul.hMul.{u1, u1, u1} (FreeRing.{u1} α) (FreeRing.{u1} α) (FreeRing.{u1} α) (instHMul.{u1} (FreeRing.{u1} α) (Distrib.toHasMul.{u1} (FreeRing.{u1} α) (Ring.toDistrib.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α)))) x y))) -> (C z)
but is expected to have type
  forall {α : Type.{u1}} {C : (FreeRing.{u1} α) -> Prop} (z : FreeRing.{u1} α), (C (Neg.neg.{u1} (FreeRing.{u1} α) (Ring.toNeg.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α)) (OfNat.ofNat.{u1} (FreeRing.{u1} α) 1 (One.toOfNat1.{u1} (FreeRing.{u1} α) (NonAssocRing.toOne.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))))))) -> (forall (b : α), C (FreeRing.of.{u1} α b)) -> (forall (x : FreeRing.{u1} α) (y : FreeRing.{u1} α), (C x) -> (C y) -> (C (HAdd.hAdd.{u1, u1, u1} (FreeRing.{u1} α) (FreeRing.{u1} α) (FreeRing.{u1} α) (instHAdd.{u1} (FreeRing.{u1} α) (Distrib.toAdd.{u1} (FreeRing.{u1} α) (NonUnitalNonAssocSemiring.toDistrib.{u1} (FreeRing.{u1} α) (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} (FreeRing.{u1} α) (NonAssocRing.toNonUnitalNonAssocRing.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))))))) x y))) -> (forall (x : FreeRing.{u1} α) (y : FreeRing.{u1} α), (C x) -> (C y) -> (C (HMul.hMul.{u1, u1, u1} (FreeRing.{u1} α) (FreeRing.{u1} α) (FreeRing.{u1} α) (instHMul.{u1} (FreeRing.{u1} α) (NonUnitalNonAssocRing.toMul.{u1} (FreeRing.{u1} α) (NonAssocRing.toNonUnitalNonAssocRing.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))))) x y))) -> (C z)
Case conversion may be inaccurate. Consider using '#align free_ring.induction_on FreeRing.induction_onₓ'. -/
@[elab_as_elim]
protected theorem induction_on {C : FreeRing α → Prop} (z : FreeRing α) (hn1 : C (-1))
    (hb : ∀ b, C (of b)) (ha : ∀ x y, C x → C y → C (x + y)) (hm : ∀ x y, C x → C y → C (x * y)) :
    C z :=
  have hn : ∀ x, C x → C (-x) := fun x ih => neg_one_mul x ▸ hm _ _ hn1 ih
  have h1 : C 1 := neg_neg (1 : FreeRing α) ▸ hn _ hn1
  FreeAbelianGroup.induction_on z (add_left_neg (1 : FreeRing α) ▸ ha _ _ hn1 h1)
    (fun m => List.recOn m h1 fun a m ih => hm _ _ (hb a) ih) (fun m ih => hn _ ih) ha
#align free_ring.induction_on FreeRing.induction_on

section lift

variable {R : Type v} [Ring R] (f : α → R)

#print FreeRing.lift /-
/-- The ring homomorphism `free_ring α →+* R` induced from a map `α → R`. -/
def lift : (α → R) ≃ (FreeRing α →+* R) :=
  FreeMonoid.lift.trans FreeAbelianGroup.liftMonoid
#align free_ring.lift FreeRing.lift
-/

/- warning: free_ring.lift_of -> FreeRing.lift_of is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {R : Type.{u2}} [_inst_1 : Ring.{u2} R] (f : α -> R) (x : α), Eq.{succ u2} R (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) (fun (_x : RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) => (FreeRing.{u1} α) -> R) (RingHom.hasCoeToFun.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) (coeFn.{max 1 (succ u1) (succ u2), max (succ u1) (succ u2)} (Equiv.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (α -> R) (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) (fun (_x : Equiv.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (α -> R) (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) => (α -> R) -> (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) (Equiv.hasCoeToFun.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (α -> R) (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) (FreeRing.lift.{u1, u2} α R _inst_1) f) (FreeRing.of.{u1} α x)) (f x)
but is expected to have type
  forall {α : Type.{u1}} {R : Type.{u2}} [_inst_1 : Ring.{u2} R] (f : α -> R) (x : α), Eq.{succ u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : FreeRing.{u1} α) => R) (FreeRing.of.{u1} α x)) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α -> R) => RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) f) (FreeRing.{u1} α) (fun (_x : FreeRing.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : FreeRing.{u1} α) => R) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α -> R) => RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) f) (FreeRing.{u1} α) R (NonUnitalNonAssocSemiring.toMul.{u1} (FreeRing.{u1} α) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (FreeRing.{u1} α) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))))) (NonUnitalNonAssocSemiring.toMul.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α -> R) => RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) f) (FreeRing.{u1} α) R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (FreeRing.{u1} α) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α)))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{max u1 u2, u1, u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α -> R) => RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) f) (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))))) (FunLike.coe.{max (succ u2) (succ u1), max (succ u2) (succ u1), max (succ u2) (succ u1)} (Equiv.{max (succ u1) (succ u2), max (succ u2) (succ u1)} (α -> R) (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) (α -> R) (fun (_x : α -> R) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : α -> R) => RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1))) _x) (Equiv.instFunLikeEquiv.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (α -> R) (RingHom.{u1, u2} (FreeRing.{u1} α) R (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} R (Ring.toNonAssocRing.{u2} R _inst_1)))) (FreeRing.lift.{u1, u2} α R _inst_1) f) (FreeRing.of.{u1} α x)) (f x)
Case conversion may be inaccurate. Consider using '#align free_ring.lift_of FreeRing.lift_ofₓ'. -/
@[simp]
theorem lift_of (x : α) : lift f (of x) = f x :=
  congr_fun (lift.left_inv f) x
#align free_ring.lift_of FreeRing.lift_of

#print FreeRing.lift_comp_of /-
@[simp]
theorem lift_comp_of (f : FreeRing α →+* R) : lift (f ∘ of) = f :=
  lift.right_inv f
#align free_ring.lift_comp_of FreeRing.lift_comp_of
-/

#print FreeRing.hom_ext /-
@[ext]
theorem hom_ext ⦃f g : FreeRing α →+* R⦄ (h : ∀ x, f (of x) = g (of x)) : f = g :=
  lift.symm.Injective (funext h)
#align free_ring.hom_ext FreeRing.hom_ext
-/

end lift

variable {β : Type v} (f : α → β)

#print FreeRing.map /-
/-- The canonical ring homomorphism `free_ring α →+* free_ring β` generated by a map `α → β`. -/
def map : FreeRing α →+* FreeRing β :=
  lift <| of ∘ f
#align free_ring.map FreeRing.map
-/

/- warning: free_ring.map_of -> FreeRing.map_of is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (x : α), Eq.{succ u2} (FreeRing.{u2} β) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (RingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (FreeRing.ring.{u2} β)))) (fun (_x : RingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (FreeRing.ring.{u2} β)))) => (FreeRing.{u1} α) -> (FreeRing.{u2} β)) (RingHom.hasCoeToFun.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (FreeRing.ring.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (FreeRing.ring.{u2} β)))) (FreeRing.map.{u1, u2} α β f) (FreeRing.of.{u1} α x)) (FreeRing.of.{u2} β (f x))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (x : α), Eq.{succ u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : FreeRing.{u1} α) => FreeRing.{u2} β) (FreeRing.of.{u1} α x)) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (RingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β)))) (FreeRing.{u1} α) (fun (_x : FreeRing.{u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : FreeRing.{u1} α) => FreeRing.{u2} β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (RingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β)))) (FreeRing.{u1} α) (FreeRing.{u2} β) (NonUnitalNonAssocSemiring.toMul.{u1} (FreeRing.{u1} α) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (FreeRing.{u1} α) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))))) (NonUnitalNonAssocSemiring.toMul.{u2} (FreeRing.{u2} β) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β))))) (NonUnitalRingHomClass.toMulHomClass.{max u1 u2, u1, u2} (RingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β)))) (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (FreeRing.{u1} α) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α)))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β)))) (RingHomClass.toNonUnitalRingHomClass.{max u1 u2, u1, u2} (RingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β)))) (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β))) (RingHom.instRingHomClassRingHom.{u1, u2} (FreeRing.{u1} α) (FreeRing.{u2} β) (NonAssocRing.toNonAssocSemiring.{u1} (FreeRing.{u1} α) (Ring.toNonAssocRing.{u1} (FreeRing.{u1} α) (instRingFreeRing.{u1} α))) (NonAssocRing.toNonAssocSemiring.{u2} (FreeRing.{u2} β) (Ring.toNonAssocRing.{u2} (FreeRing.{u2} β) (instRingFreeRing.{u2} β))))))) (FreeRing.map.{u1, u2} α β f) (FreeRing.of.{u1} α x)) (FreeRing.of.{u2} β (f x))
Case conversion may be inaccurate. Consider using '#align free_ring.map_of FreeRing.map_ofₓ'. -/
@[simp]
theorem map_of (x : α) : map f (of x) = of (f x) :=
  lift_of _ _
#align free_ring.map_of FreeRing.map_of

end FreeRing


import o_minimal.examples.from_finite_inters

namespace o_minimal

open_locale finvec

universe u

variables (R : Type u)

/-
Let R be any type. A *function family* on R consists of,
for each n, a family of functions Rⁿ → R, such that:

* All constant functions belong to the family.
* All coordinate functions belong to the family.
[TODO: We could reduce the above to constants R⁰ → R and the identity R¹ → R
 by using the extension property we require below.]
* Functions can be "extended" by adding irrelevant arguments on the left or right.
  That is, if f : Rⁿ → R belongs to the family, then the functions gₗ and gᵣ defined by
    gₗ(y, x₁, ..., xₙ) = f(x₁, ..., xₙ)
    gᵣ(x₁, ..., xₙ, y) = f(x₁, ..., xₙ)
  also belong to the family.

We do not require any other properties (like closure under composition),
even though in practice they would always be satisfied.

Examples:
- only constants and coordinate functions;
- all K-linear functions (where R is a K-module);
- all polynomial functions (where R is a ring).

We use a separate indexing type `carrier` to represent the functions
(rather than something like `Π (n : ℕ), set (finvec n R → R)`)
to make it easier to operate on the functions in a specific context
(for example, to simplify constraints).
-/
-- TODO: Turns out we need `finvec.tail` after all?
structure function_family : Type (u+1) :=
(carrier : Π (n : ℕ), Type u)
(to_fun : Π {n : ℕ}, carrier n → finvec n R → R)
(const : Π {n : ℕ} (r : R), carrier n)
(to_fun_const :
  ∀ {n : ℕ} (r : R), @to_fun n (const r) = λ _, r)
(coord : Π {n : ℕ} (i : fin n), carrier n)
(to_fun_coord :
  ∀ {n : ℕ} (i : fin n), to_fun (coord i) = λ x, x i)
(extend_left : Π {n : ℕ}, carrier n → carrier (n+1))
(to_fun_extend_left :
  ∀ {n : ℕ} (f : carrier n), to_fun (extend_left f) = to_fun f ∘ finvec.tail)
(extend_right : Π {n : ℕ}, carrier n → carrier (n+1))
(to_fun_extend_right :
  ∀ {n : ℕ} (f : carrier n), to_fun (extend_right f) = to_fun f ∘ finvec.init)

instance has_coe_to_fun.function_family : has_coe_to_fun (function_family R) :=
⟨_, function_family.carrier⟩

instance has_coe_to_fun.F (F : function_family R) (n : ℕ) : has_coe_to_fun (F n) :=
⟨λ _, finvec n R → R, λ f, F.to_fun f⟩

@[simp] lemma function_family.const_app (F : function_family R) {n : ℕ} {r : R} {x : finvec n R} :
  F.const r x = r :=
congr_fun (function_family.to_fun_const F r) x

@[simp] lemma function_family.coord_app (F : function_family R) {n : ℕ} {i : fin n} {x} :
  F.coord i x = x i :=
congr_fun (function_family.to_fun_coord F i) x

@[simp] lemma function_family.extend_left_app (F : function_family R) {n : ℕ} {f : F n} {x} :
  F.extend_left f x = f (finvec.tail x) :=
congr_fun (F.to_fun_extend_left f) x

@[simp] lemma function_family.extend_right_app (F : function_family R) {n : ℕ} {f : F n} {x} :
  F.extend_right f x = f (finvec.init x) :=
congr_fun (F.to_fun_extend_right f) x

@[simp] lemma function_family.to_fun_eq_coe (F : function_family R) {n : ℕ} {f : F n} :
  F.to_fun f = f := rfl

section linear_order

/-
Now suppose that the type R has an ordering.
Relative to a fixed function family F, we define a *primitive set*
to be a set of one of the forms
  {x | f(x) = g(x)},  {x | f(x) < g(x)}
where f and g are functions belonging to F.
We assume that R is linearly ordered,
so that the complement of such a set is a finite union of sets of the same form.

We'll define a basic set to be a finite intersection of primitive sets
and a definable set to be a finite union of basic sets.
Our aim in this module is to describe conditions
under which the definable sets formed in this way make up an o-minimal structure.
-/

variables {R} [linear_order R] (F : function_family R)

inductive constrained {n : ℕ} : set (finvec n R) → Prop
| EQ (f g : F n) : constrained {x | f x = g x}
| LT (f g : F n) : constrained {x | f x < g x}

variables {F}

lemma constrained.r_prod {n : ℕ} {s : set (finvec n R)} (hs : constrained F s) :
  constrained F (finvec.univ_prod 1 s) :=
begin
  refine (finvec.univ_prod_one_like_preimage_tail _).mpr _,
  rcases hs with ⟨f,g⟩|⟨f,g⟩;
  [ convert constrained.EQ (F.extend_left f) (F.extend_left g) using 1,
    convert constrained.LT (F.extend_left f) (F.extend_left g) using 1 ];
  { ext x, simp, refl }
end

lemma constrained.prod_r {n : ℕ} {s : set (finvec n R)} (hs : constrained F s) :
  constrained F (finvec.prod_univ s 1) :=
begin
  rcases hs with ⟨f,g⟩|⟨f,g⟩;
  [ convert constrained.EQ (F.extend_right f) (F.extend_right g),
    convert constrained.LT (F.extend_right f) (F.extend_right g) ];
  { ext x, simp, refl }         -- TODO: lemma?
end

-- TODO: for_mathlib
@[simp] lemma lt_self_iff_false {α : Type*} [preorder α] (x : α) : (x < x) ↔ false :=
by { rw iff_false, exact lt_irrefl x }

section empty

/-
The assumption that R is nonempty is annoying, mainly because it shouldn't really be needed.
The problem is that it's *almost* true that the projection of a basic set is basic,
if we define a basic set to be a finite intersection of constrained ones,
and in the structure defined by just (R, <), for example.
The issue is that ∅ = {x | x < x} ⊆ R¹ is basic, but its projection to R⁰ is not basic,
because there are no simple functions at all on R⁰ when R is empty!
It is still definable though, as the empty union.

Options for dealing with this include:
0. [the current choice] Just assume R is nonempty here, because it eventually will be anyways.
1. Work with "basic or empty" sets in the context of isolating families.
2. Include `empty` as another constructor of `constrained`,
   and let it affect the definition of the eventual definable sets.
3. Include `empty` as another constructor of `constrained`,
   but then prove we get the same definable sets in the end as if it didn't exist.
   (Especially if we only add `constrained.empty` for `n = 0`, this doesn't seem too taxing.)
-/
lemma constrained.empty [h : nonempty R] {n : ℕ} : constrained F (∅ : set (finvec n R)) :=
begin
  casesI h with r,
  convert constrained.LT (F.const r) (F.const r),
  simp
end

end empty

variables (F) (D B P : Π ⦃n : ℕ⦄, set (set (finvec n R)))

/-- Hypotheses for a structure. -/
structure function_family_struc_hypotheses : Prop :=
(definable_iff_finite_union_basic :
  ∀ {n} {s : set (finvec n R)}, D s ↔ s ∈ finite_union_closure (@B n))
(basic_iff_finite_inter_primitive :
  ∀ {n} {s : set (finvec n R)}, B s ↔ s ∈ finite_inter_closure (@P n))
(primitive_iff_constrained :
  ∀ {n} {s : set (finvec n R)}, P s ↔ constrained F s)
(definable_proj1_basic :
  ∀ {n} {s : set (finvec (n + 1) R)}, B s → D (finvec.init '' s))

variables {F D B P}

-- Strategy: Conclude `finite_inter_struc_hypotheses D B P`.
-- First we work under the assumption that `P` is `constrained F`.

local notation `P₀` := (λ {n : ℕ}, constrained F)
-- local notation `B₀` := (λ {n : ℕ}, finite_inter_closure (@P n))
-- local notation `D₀` := (λ {n : ℕ}, finite_union_closure (finite_inter_closure (@P n)))

private lemma key
  (H : function_family_struc_hypotheses F D B P₀) :
  finite_inter_struc_hypotheses D B P₀ :=
have basic_of_constrained : ∀ {n} {s : set (finvec n R)}, constrained F s → B s,
from λ n s hs,
  (function_family_struc_hypotheses.basic_iff_finite_inter_primitive H).mpr
    (finite_inter_closure.basic hs),
{ definable_iff_finite_union_basic := H.definable_iff_finite_union_basic,
  basic_iff_finite_inter_primitive := H.basic_iff_finite_inter_primitive,
  definable_compl_primitive := begin
    rintros n s (⟨f,g⟩|⟨f,g⟩); rw H.definable_iff_finite_union_basic,
    { convert_to ({x | f x < g x} ∪ {x | g x < f x}) ∈ _,
      { ext x, exact ne_iff_lt_or_gt },
      apply finite_union_closure.union; apply finite_union_closure.basic; apply basic_of_constrained,
      { exact constrained.LT f g },
      { exact constrained.LT g f } },
    { convert_to ({x | f x = g x} ∪ {x | g x < f x}) ∈ _,
      { ext x, exact not_lt_iff_eq_or_lt }, -- library_search failed?
      apply finite_union_closure.union; apply finite_union_closure.basic; apply basic_of_constrained,
      { exact constrained.EQ f g },
      { exact constrained.LT g f } }
  end,
  basic_r_prod_primitive := λ n s hs, basic_of_constrained hs.r_prod,
  basic_primitive_prod_r := λ n s hs, basic_of_constrained hs.prod_r,
  definable_eq_outer := λ n,
    (function_family_struc_hypotheses.definable_iff_finite_union_basic H).mpr $
    finite_union_closure.basic $
    basic_of_constrained $
    begin
      convert constrained.EQ (F.coord 0) (F.coord (fin.last n)),
      ext x, simp [finvec.last]
    end,
  definable_proj1_basic := H.definable_proj1_basic }

variables (H : function_family_struc_hypotheses F D B P)
include H

lemma function_family_struc_hypotheses.finite_inter_struc_hypotheses :
  finite_inter_struc_hypotheses D B P :=
begin
  have : @P = @constrained _ _ F,
  { ext, apply H.primitive_iff_constrained },
  subst P,
  exact key H
end

def struc_of_function_family : struc R :=
struc_of_finite_inter H.finite_inter_struc_hypotheses

end linear_order

section o_minimal

variables {R} [DUNLO R] (F : function_family R) (D B P : Π ⦃n : ℕ⦄, set (set (finvec n R)))

structure function_family_o_minimal_hypotheses extends function_family_struc_hypotheses F D B P : Prop :=
(tame_of_constrained : ∀ {s : set (finvec 1 R)}, constrained F s → tame {r | (λ _, r : finvec 1 R) ∈ s})

variables {F D B P} (H : function_family_o_minimal_hypotheses F D B P)

lemma o_minimal_of_function_family :
  o_minimal (struc_of_function_family H.to_function_family_struc_hypotheses) :=
have definable_of_constrained : ∀ {n} {s : set (finvec n R)}, constrained F s → D s := λ n s hs,
  -- TODO: This is terrible
  (function_family_struc_hypotheses.definable_iff_finite_union_basic H.to_function_family_struc_hypotheses).mpr $
  finite_union_closure.basic $
  (function_family_struc_hypotheses.basic_iff_finite_inter_primitive H.to_function_family_struc_hypotheses).mpr $
  finite_inter_closure.basic $
  (function_family_struc_hypotheses.primitive_iff_constrained H.to_function_family_struc_hypotheses).mpr hs,
o_minimal_of_finite_inter
{ definable_lt := by simpa using definable_of_constrained (constrained.LT (F.coord 0) (F.coord 1)),
  definable_const := λ r, by simpa using definable_of_constrained (constrained.EQ (F.coord 0) (F.const r)),
  tame_of_primitive := λ s hs, by { rw H.primitive_iff_constrained at hs, exact H.tame_of_constrained hs },
  .. H.to_function_family_struc_hypotheses.finite_inter_struc_hypotheses }

end o_minimal

end o_minimal


import tactic
import group_theory.coset
import group_theory.quotient_group
import group_theory.index
import group_theory.finiteness
import data.setoid.partition

namespace chapter2.section2

variables {G : Type*} [group G]

-- 定义 2-1
-- #check subgroup.one_mem'
-- #check subgroup.mul_mem'
-- #check subgroup.inv_mem'
-- #check subgroup.one_mem
-- #check subgroup.mul_mem
-- #check subgroup.inv_mem
-- variables  (H : subgroup G)
def subgroup_trans_2_1 (H : subgroup G) (K : subgroup H) := subgroup.map H.subtype K

namespace lemma_2_1

-- (H_sub_G: H ⊆ set.univ)
def lemma_2_1_1 (H: set G) (H_n_empty: H.nonempty) (h1 : ∀ a b, a ∈ H → b ∈ H → (a * b ∈ H)) (h2 : ∀ a, a ∈ H → a⁻¹ ∈ H) : subgroup G :=
{
  carrier := H,
  one_mem' := begin
    induction H_n_empty with a a_in_H,
    have a_inv_in_H := h2 a a_in_H,
    have := h1 _ _ a_in_H a_inv_in_H,
    rw mul_inv_self at this,
    exact this,
  end,
  mul_mem' := h1,
  inv_mem' := h2,
}

def lemma_2_1_2 (H: set G) (H_n_empty: H.nonempty) (h : ∀ a b, a ∈ H → b ∈ H → (a * b⁻¹ ∈ H)) : subgroup G :=
begin
  have one_mem: (1 : G) ∈ H := begin
    cases H_n_empty with a a_in_H,
    have := h a a a_in_H a_in_H,
    rw mul_inv_self at this,
    exact this
  end,

  exact {
    carrier := H,
    one_mem' := one_mem,
    mul_mem' := begin
      intros a b ha hb,
      replace hb := h _ _ one_mem hb,
      rw one_mul at hb,
      have := h _ _ ha hb,
      rw inv_inv at this,
      exact this,
    end,
    inv_mem' := begin
      intros a ha,
      have := h _ _ one_mem ha,
      rw one_mul at this,
      exact this,
    end,
  },
end

def lemma_2_1_3 (H: finset G) (s_nonempty: H.nonempty)  (h1 : ∀ a b, a ∈ H → b ∈ H → (a * b ∈ H)) : subgroup G := lemma_2_1_1 H (finset.coe_nonempty.mpr s_nonempty) h1 (λ x h_x, begin
  have my_set_map: set.maps_to (λ (n : ℕ), x ^ (n + 1)) set.univ H := begin
    intros n hn,
    simp,
    induction n,
    { simp, assumption },
    {
      specialize n_ih (set.mem_univ n_n),
      specialize h1 _ _ n_ih h_x,
      rw pow_add, rw pow_one,
      exact h1,
    }
  end,
  obtain ⟨r, -, s, -, H_r_neq_s, H4⟩ := set.infinite.exists_ne_map_eq_of_maps_to set.infinite_univ my_set_map (finset.finite_to_set H),
  clear my_set_map,
  simp at H4,
  wlog H_r_s : s < r, { exact (ne.symm H_r_neq_s).lt_or_lt }, clear H_r_neq_s,

  have h:= pow_mul_pow_sub x (nat.succ_le_succ (le_of_lt H_r_s)),
  rw H4 at h,
  clear H4,
  simp at h,
  have h1: r - s > 0 := tsub_pos_of_lt H_r_s,

  have h2: ∀ x , x > 0 → ∃ (t : ℕ), t + 1 = x := begin intros x hx, induction x, linarith, use x_n, end,
  replace h2 := h2 _ h1,
  obtain ⟨t, h2⟩ := h2,
  clear h1,
  rw ← h2 at h,
  clear h2 H_r_s r s,
  have h3: ∀ u, x ^ (u + 1) ∈ H := begin
    intro u,
    induction u,
    { simpa using h_x },
    {
      have := h1 _ _ u_ih h_x,
      rw [pow_add, pow_one],
      exact this,
    },
  end,

  convert_to x ^ t ∈ ↑H,
  {
    rw [pow_add, pow_one] at h,
    rw mul_eq_one_iff_eq_inv at h,
    exact eq.symm h,
  },

  have h4 := h3 (t + t),
  rw [add_assoc,pow_add] at h4,
  rw h at h4,
  rw mul_one at h4,
  exact h4,
end)

end lemma_2_1

-- #check quotient_group.subgroup.has_quotient

-- #check set.center
-- #check subgroup.center
-- 命题2-2
def lemma_2_2 : subgroup G :=
{
  carrier := set.center G,
  one_mem' := begin
    dunfold set.center,
    dunfold has_mem.mem set.mem set_of,
    simp,
  end,
  mul_mem' := begin
    dunfold set.center,
    dunfold has_mem.mem set.mem set_of,
    intros a b ha hb g,
    exact by calc
      g * (a * b) = (g * a) * b : by group
      ...         = (a * g) * b : by rw ha
      ...         = a * (g * b) : by group
      ...         = a * (b * g) : by rw hb
      ...         = a * b * g : by group
  end,
  inv_mem' := begin
    dunfold set.center,
    dunfold has_mem.mem set.mem set_of,
    intros g h a,
    specialize h a,
    rw ← eq_mul_inv_iff_mul_eq at h,
    rw mul_assoc at h,
    rw ← inv_mul_eq_iff_eq_mul at h,
    rw h,
  end,
}

-- 定义2-3
-- #check subgroup.mem_closure
-- Schreier's lemma
-- https://leanprover-community.github.io/mathlib_docs/group_theory/schreier.html#subgroup.closure_mul_image_eq
-- #check subgroup.closure_mul_image_eq

-- 命题2-3
-- lemma lemma_2_3 (S : set G) : ∃ (S': subgroup G),  subgroup.closure S = S' ∧ S'.carrier = { |}
-- TODO: 做不来

-- 定义2-4
-- #check is_of_fin_order
-- #check order_of
-- lemma lemma_2_4   (a : G) (h : is_of_fin_order a) : subgroup.closure ({ a } : set G) = subgroup.closure ({ a } : set G)  := begin
--   induction h,
-- end

-- 定义2-5
-- #check @left_coset

lemma xz_2_1_1_r (H : subgroup G) (a b: G) : (right_coset ↑H a = right_coset ↑H b) ↔ a * b⁻¹ ∈ H :=
begin
  dunfold right_coset set.image,
  rw set.ext_iff,
  simp,
  split,
  {
    intro h,
    replace h := (h a).mp,
    replace h := h ⟨1, one_mem H, by group⟩,
    rcases h with ⟨g, hg, hg_eq⟩,
    rw ← eq_mul_inv_iff_mul_eq at hg_eq,
    rw hg_eq at *,
    assumption,
  },
  {
    intros h1 g,
    split,
    {
      rintros ⟨h, hh, hh_eq⟩,
      replace hh_eq := eq_mul_inv_of_mul_eq hh_eq,
      rw hh_eq at *, clear hh_eq h,
      use g * b⁻¹,
      have := mul_mem hh h1,
      simpa [mul_assoc] using this,
    },
    {
      rintros ⟨h, hh, hh_eq⟩,
      replace hh_eq := eq_mul_inv_of_mul_eq hh_eq,
      rw hh_eq at *, clear hh_eq h,
      use g * a⁻¹,
      replace h1 := inv_mem h1,
      simp at h1,
      have := mul_mem hh h1,
      simpa [mul_assoc] using this,
    }
  }
end

-- 性质 _2_1_1_l
-- #check left_coset_eq_iff
lemma my_left_coset_eq_iff (H : subgroup G) {a b: G} : (left_coset a H = left_coset b H) ↔ a⁻¹ * b ∈ H :=
begin
  dunfold left_coset,
  dunfold set.image,
  -- have := left_coset_equivalence_rel ↑H,
  -- unfold equivalence left_coset_equivalence reflexive symmetric transitive at this,
  split,
  {
    rw set.ext_iff,
    simp,
    intro h,
    replace h := (h a).mp,
    replace h := h ⟨1, one_mem H, by group⟩,
    rcases h with ⟨g, hg, hg_eq⟩,
    rw ← eq_inv_mul_iff_mul_eq at hg_eq,
    rw hg_eq at hg, clear hg_eq,
    simpa using inv_mem hg,
  },
  {
    intro h1,
    ext g,
    split;simp,
    {
      rintros h hh rfl,
      use b⁻¹ * a * h,
      refine ⟨_, by group⟩,
      replace h1 := inv_mem h1,
      simp at h1,
      exact mul_mem h1 hh,
    },
    {
      rintros h hh rfl,
      use a⁻¹ * b * h,
      refine ⟨_, by group⟩,
      exact mul_mem h1 hh,
    }
  }
end

def xz_2 (H : subgroup G) (a b: G) : (right_coset ↑H a ≃ right_coset ↑H b) :=
{
  to_fun := begin
    rintro ⟨c, hc⟩,
    use c * a⁻¹ * b,
    rcases hc with ⟨d,hd,rfl⟩,
    use d,
    exact ⟨hd, by group⟩,
  end,
  inv_fun := begin
    -- dunfold right_coset set.image,
    rintro ⟨c, hc⟩,
    -- simp at *,
    use c * b⁻¹ * a,
    rcases hc with ⟨d,hd,rfl⟩,
    use d,
    exact ⟨hd, by group⟩,
  end,
  left_inv := begin
    rw function.left_inverse,
    simp,
  end,
  right_inv :=begin
    rw function.right_inverse,
    rw function.left_inverse,
    simp,
  end,
}

lemma xz_2_1_3_r (H : subgroup G) (a b: G) : (right_coset ↑H a ≠ right_coset ↑H b) → right_coset ↑H a ∩ right_coset ↑H b = ∅ :=
begin
  rw ne,
  rw xz_2_1_1_r,
  intro h,
  contrapose! h,
  rw [set.ne_empty_iff_nonempty, set.nonempty_def] at h,
  rcases h with ⟨g, ⟨h1, hg1, hg1'⟩, ⟨h2, hg2, hg2'⟩⟩, simp at *,
  obtain rfl := eq_mul_inv_of_mul_eq hg1', clear hg1',
  obtain rfl := eq_mul_inv_of_mul_eq hg2', clear hg2',
  have := mul_mem (inv_mem hg1) hg2,
  simpa [mul_assoc] using this,
end

-- #check left_coset_equivalence
-- #check left_coset_equivalence_rel
-- #check quotient_group.left_rel
-- #check quotient_group.right_rel
def my_quotient_group_left_rel (H : subgroup G) : setoid G := {
  r := λ x y, x⁻¹ * y ∈ H,
  iseqv:= begin
    simp_rw ←left_coset_eq_iff,
    refine ⟨_,_,_⟩,
    {
      intro x,
      reflexivity,
    },
    {
      intros x y H,
      exact H.symm,
    },
    {
      intros x y z hxy hyz,
      rw hxy,
      rw hyz,
    }
  end,
}

-- variable (H : subgroup G)
-- #check quotient (quotient_group.left_rel H)
-- #check ⟦ quotient_group.left_rel H ⟧
-- #check quotient1

-- #check (quotient_group.left_rel H)
-- #check quot.mk (quotient_group.left_rel H).r
-- #check quotient.mk (1: set H)

-- #check quotient.exists_rep (quot.mk (quotient_group.left_rel H).r)

example (H : subgroup G) : quotient (quotient_group.left_rel H) = (G ⧸ H) :=
begin
  unfold quotient,

  unfold has_quotient.quotient,
  unfold has_quotient.quotient',
  unfold quotient_group.left_rel,
  unfold quotient,
  have := quot.mk (quotient_group.left_rel H).r,
  change quot setoid.r = (G ⧸ H),
  refl,
end

-- #check subgroup.index_mul_card
-- #check  finset
-- lemma index_mul_card [fintype G] (H : subgroup G) [hH : fintype H] :
--   H.index * fintype.card H = fintype.card G :=
-- begin
--   unfold subgroup.index,
--   -- convert_to nat.card (G ⧸ H) * fintype.card ↥H = fintype.card G,
--   have := @nat.card_eq_fintype_card (G ⧸ H),
--   -- unfold subgroup.index has_quotient.quotient has_quotient.quotient' quotient_group.left_rel coe_sort coe_sort has_coe_to_sort.coe nat.card,
--   -- unfold coe_fn has_coe_to_sort.coe cardinal.to_nat,
--   -- simp,
--   sorry,
-- end
#check subgroup.card_eq_card_quotient_mul_card_subgroup

lemma my_subgroup_card_eq_card_quotient_mul_card_subgroup
  [fintype G] (H : subgroup G) [fintype H] [decidable_pred (λ a, a ∈ H)] :
  fintype.card G = fintype.card (G ⧸ H) * fintype.card H :=
begin
  rw ←fintype.card_prod,
  apply fintype.card_congr,
  sorry
end
end chapter2.section2


/-
Copyright (c) 2022 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.integral.bochner
import measure_theory.group.measure

/-!
# Integration on Groups

We develop properties of integrals with a group as domain.
This file contains properties about integrability, Lebesgue integration and Bochner integration.
-/

namespace measure_theory

open measure topological_space
open_locale ennreal

variables {𝕜 G E F : Type*} [measurable_space G]
variables [normed_group E] [normed_space ℝ E] [complete_space E] [normed_group F]
variables {μ : measure G} {f : G → E} {g : G}

section measurable_inv

variables [group G] [has_measurable_inv G]

@[to_additive]
lemma integrable.comp_inv [is_inv_invariant μ] {f : G → F} (hf : integrable f μ) :
  integrable (λ t, f t⁻¹) μ :=
(hf.mono_measure (map_inv_eq_self μ).le).comp_measurable measurable_inv

@[to_additive]
lemma integral_inv_eq_self (f : G → E) (μ : measure G) [is_inv_invariant μ] :
  ∫ x, f (x⁻¹) ∂μ = ∫ x, f x ∂μ :=
begin
  have h : measurable_embedding (λ x : G, x⁻¹) :=
  (measurable_equiv.inv G).measurable_embedding,
  rw [← h.integral_map, map_inv_eq_self]
end

end measurable_inv

section measurable_mul

variables [group G] [has_measurable_mul G]

/-- Translating a function by left-multiplication does not change its `lintegral` with respect to
a left-invariant measure. -/
@[to_additive]
lemma lintegral_mul_left_eq_self [is_mul_left_invariant μ] (f : G → ℝ≥0∞) (g : G) :
  ∫⁻ x, f (g * x) ∂μ = ∫⁻ x, f x ∂μ :=
begin
  convert (lintegral_map_equiv f $ measurable_equiv.mul_left g).symm,
  simp [map_mul_left_eq_self μ g]
end

/-- Translating a function by right-multiplication does not change its `lintegral` with respect to
a right-invariant measure. -/
@[to_additive]
lemma lintegral_mul_right_eq_self [is_mul_right_invariant μ] (f : G → ℝ≥0∞) (g : G) :
  ∫⁻ x, f (x * g) ∂μ = ∫⁻ x, f x ∂μ :=
begin
  convert (lintegral_map_equiv f $ measurable_equiv.mul_right g).symm,
  simp [map_mul_right_eq_self μ g]
end

/-- Translating a function by left-multiplication does not change its integral with respect to a
left-invariant measure. -/
@[to_additive]
lemma integral_mul_left_eq_self [is_mul_left_invariant μ] (f : G → E) (g : G) :
  ∫ x, f (g * x) ∂μ = ∫ x, f x ∂μ :=
begin
  have h_mul : measurable_embedding (λ x, g * x) :=
    (measurable_equiv.mul_left g).measurable_embedding,
  rw [← h_mul.integral_map, map_mul_left_eq_self]
end

/-- Translating a function by right-multiplication does not change its integral with respect to a
right-invariant measure. -/
@[to_additive]
lemma integral_mul_right_eq_self [is_mul_right_invariant μ] (f : G → E) (g : G) :
  ∫ x, f (x * g) ∂μ = ∫ x, f x ∂μ :=
begin
  have h_mul : measurable_embedding (λ x, x * g) :=
    (measurable_equiv.mul_right g).measurable_embedding,
  rw [← h_mul.integral_map, map_mul_right_eq_self]
end

/-- If some left-translate of a function negates it, then the integral of the function with respect
to a left-invariant measure is 0. -/
@[to_additive]
lemma integral_eq_zero_of_mul_left_eq_neg [is_mul_left_invariant μ] (hf' : ∀ x, f (g * x) = - f x) :
  ∫ x, f x ∂μ = 0 :=
by simp_rw [← self_eq_neg ℝ E, ← integral_neg, ← hf', integral_mul_left_eq_self]

/-- If some right-translate of a function negates it, then the integral of the function with respect
to a right-invariant measure is 0. -/
@[to_additive]
lemma integral_eq_zero_of_mul_right_eq_neg [is_mul_right_invariant μ]
  (hf' : ∀ x, f (x * g) = - f x) : ∫ x, f x ∂μ = 0 :=
by simp_rw [← self_eq_neg ℝ E, ← integral_neg, ← hf', integral_mul_right_eq_self]

@[to_additive]
lemma integrable.comp_mul_left {f : G → F} [is_mul_left_invariant μ] (hf : integrable f μ)
  (g : G) : integrable (λ t, f (g * t)) μ :=
(hf.mono_measure (map_mul_left_eq_self μ g).le).comp_measurable $ measurable_const_mul g

@[to_additive]
lemma integrable.comp_mul_right {f : G → F} [is_mul_right_invariant μ] (hf : integrable f μ)
  (g : G) : integrable (λ t, f (t * g)) μ :=
(hf.mono_measure (map_mul_right_eq_self μ g).le).comp_measurable $ measurable_mul_const g

@[to_additive]
lemma integrable.comp_div_right {f : G → F} [is_mul_right_invariant μ] (hf : integrable f μ)
  (g : G) : integrable (λ t, f (t / g)) μ :=
by { simp_rw [div_eq_mul_inv], exact hf.comp_mul_right g⁻¹ }

variables [has_measurable_inv G]

@[to_additive]
lemma integrable.comp_div_left {f : G → F}
  [is_inv_invariant μ] [is_mul_left_invariant μ] (hf : integrable f μ) (g : G) :
  integrable (λ t, f (g / t)) μ :=
begin
  rw [← map_mul_right_inv_eq_self μ g⁻¹, integrable_map_measure, function.comp],
  { simp_rw [div_inv_eq_mul, mul_inv_cancel_left], exact hf },
  { refine ae_strongly_measurable.comp_measurable _ (measurable_id.const_div g),
    simp_rw [map_map (measurable_id'.const_div g) (measurable_id'.const_mul g⁻¹).inv,
      function.comp, div_inv_eq_mul, mul_inv_cancel_left, map_id'],
    exact hf.ae_strongly_measurable },
  { exact (measurable_id'.const_mul g⁻¹).inv }
end

@[to_additive]
lemma integral_div_left_eq_self (f : G → E) (μ : measure G) [is_inv_invariant μ]
  [is_mul_left_invariant μ] (x' : G) : ∫ x, f (x' / x) ∂μ = ∫ x, f x ∂μ :=
by simp_rw [div_eq_mul_inv, integral_inv_eq_self (λ x, f (x' * x)) μ,
  integral_mul_left_eq_self f x']

end measurable_mul

section topological_group

variables [topological_space G] [group G] [topological_group G] [borel_space G]
  [is_mul_left_invariant μ]

/-- For nonzero regular left invariant measures, the integral of a continuous nonnegative function
  `f` is 0 iff `f` is 0. -/
@[to_additive]
lemma lintegral_eq_zero_of_is_mul_left_invariant [regular μ] (hμ : μ ≠ 0)
  {f : G → ℝ≥0∞} (hf : continuous f) :
  ∫⁻ x, f x ∂μ = 0 ↔ f = 0 :=
begin
  haveI := is_open_pos_measure_of_mul_left_invariant_of_regular hμ,
  rw [lintegral_eq_zero_iff hf.measurable, hf.ae_eq_iff_eq μ continuous_zero]
end

end topological_group

end measure_theory


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.set.lattice

universes u v w x

/-- A `pequiv` is a partial equivalence, a representation of a bijection between a subset
  of `α` and a subset of `β` -/
structure pequiv (α : Type u) (β : Type v) :=
(to_fun : α → option β)
(inv_fun : β → option α)
(inv : ∀ (a : α) (b : β), a ∈ inv_fun b ↔ b ∈ to_fun a)

infixr ` ≃. `:25 := pequiv

namespace pequiv
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}
open function option

instance : has_coe_to_fun (α ≃. β) := ⟨_, to_fun⟩

@[simp] lemma coe_mk_apply (f₁ : α → option β) (f₂ : β → option α) (h) (x : α) :
  (pequiv.mk f₁ f₂ h : α → option β) x = f₁ x := rfl

@[ext] lemma ext : ∀ {f g : α ≃. β} (h : ∀ x, f x = g x), f = g
| ⟨f₁, f₂, hf⟩ ⟨g₁, g₂, hg⟩ h :=
have h : f₁ = g₁, from funext h,
have ∀ b, f₂ b = g₂ b,
  begin
    subst h,
    assume b,
    have hf := λ a, hf a b,
    have hg := λ a, hg a b,
    cases h : g₂ b with a,
    { simp only [h, option.not_mem_none, false_iff] at hg,
      simp only [hg, iff_false] at hf,
      rwa [option.eq_none_iff_forall_not_mem] },
    { rw [← option.mem_def, hf, ← hg, h, option.mem_def] }
  end,
by simp [*, funext_iff]

lemma ext_iff {f g : α ≃. β} : f = g ↔ ∀ x, f x = g x :=
⟨congr_fun ∘ congr_arg _, ext⟩

@[refl] protected def refl (α : Type*) : α ≃. α :=
{ to_fun := some,
  inv_fun := some,
  inv := λ _ _, eq_comm }

@[symm] protected def symm (f : α ≃. β) : β ≃. α :=
{ to_fun := f.2,
  inv_fun := f.1,
  inv := λ _ _, (f.inv _ _).symm }

lemma mem_iff_mem (f : α ≃. β) : ∀ {a : α} {b : β}, a ∈ f.symm b ↔ b ∈ f a := f.3

lemma eq_some_iff (f : α ≃. β) : ∀ {a : α} {b : β}, f.symm b = some a ↔ f a = some b := f.3

@[trans] protected def trans (f : α ≃. β) (g : β ≃. γ) : pequiv α γ :=
{ to_fun := λ a, (f a).bind g,
  inv_fun := λ a, (g.symm a).bind f.symm,
  inv := λ a b, by simp [*, and.comm, eq_some_iff f, eq_some_iff g] at * }

@[simp] lemma refl_apply (a : α) : pequiv.refl α a = some a := rfl

@[simp] lemma symm_refl : (pequiv.refl α).symm = pequiv.refl α := rfl

@[simp] lemma symm_symm (f : α ≃. β) : f.symm.symm = f := by cases f; refl

lemma symm_injective : function.injective (@pequiv.symm α β) :=
left_inverse.injective symm_symm

lemma trans_assoc (f : α ≃. β) (g : β ≃. γ) (h : γ ≃. δ) :
  (f.trans g).trans h = f.trans (g.trans h) :=
ext (λ _, option.bind_assoc _ _ _)

lemma mem_trans (f : α ≃. β) (g : β ≃. γ) (a : α) (c : γ) :
  c ∈ f.trans g a ↔ ∃ b, b ∈ f a ∧ c ∈ g b := option.bind_eq_some'

lemma trans_eq_some (f : α ≃. β) (g : β ≃. γ) (a : α) (c : γ) :
  f.trans g a = some c ↔ ∃ b, f a = some b ∧ g b = some c := option.bind_eq_some'

lemma trans_eq_none (f : α ≃. β) (g : β ≃. γ) (a : α) :
  f.trans g a = none ↔ (∀ b c, b ∉ f a ∨ c ∉ g b) :=
begin
  simp only [eq_none_iff_forall_not_mem, mem_trans, imp_iff_not_or.symm],
  push_neg, tauto
end

@[simp] lemma refl_trans (f : α ≃. β) : (pequiv.refl α).trans f = f :=
by ext; dsimp [pequiv.trans]; refl

@[simp] lemma trans_refl (f : α ≃. β) : f.trans (pequiv.refl β) = f :=
by ext; dsimp [pequiv.trans]; simp

protected lemma inj (f : α ≃. β) {a₁ a₂ : α} {b : β} (h₁ : b ∈ f a₁) (h₂ : b ∈ f a₂) : a₁ = a₂ :=
by rw ← mem_iff_mem at *; cases h : f.symm b; simp * at *

lemma injective_of_forall_ne_is_some (f : α ≃. β) (a₂ : α)
  (h : ∀ (a₁ : α), a₁ ≠ a₂ → is_some (f a₁)) : injective f :=
has_left_inverse.injective
  ⟨λ b, option.rec_on b a₂ (λ b', option.rec_on (f.symm b') a₂ id),
    λ x, begin
      classical,
      cases hfx : f x,
      { have : x = a₂, from not_imp_comm.1 (h x) (hfx.symm ▸ by simp), simp [this] },
      { simp only [hfx], rw [(eq_some_iff f).2 hfx], refl }
    end⟩

lemma injective_of_forall_is_some {f : α ≃. β}
  (h : ∀ (a : α), is_some (f a)) : injective f :=
(classical.em (nonempty α)).elim
  (λ hn, injective_of_forall_ne_is_some f (classical.choice hn)
    (λ a _, h a))
  (λ hn x, (hn ⟨x⟩).elim)

section of_set
variables (s : set α) [decidable_pred s]

def of_set (s : set α) [decidable_pred s] : α ≃. α :=
{ to_fun := λ a, if a ∈ s then some a else none,
  inv_fun := λ a, if a ∈ s then some a else none,
  inv := λ a b, by split_ifs; finish [eq_comm] }

lemma mem_of_set_self_iff {s : set α} [decidable_pred s] {a : α} : a ∈ of_set s a ↔ a ∈ s :=
by dsimp [of_set]; split_ifs; simp *

lemma mem_of_set_iff {s : set α} [decidable_pred s] {a b : α} : a ∈ of_set s b ↔ a = b ∧ a ∈ s :=
by dsimp [of_set]; split_ifs; split; finish

@[simp] lemma of_set_eq_some_iff {s : set α} {h : decidable_pred s} {a b : α} :
  of_set s b = some a ↔ a = b ∧ a ∈ s := mem_of_set_iff

@[simp] lemma of_set_eq_some_self_iff {s : set α} {h : decidable_pred s} {a : α} :
  of_set s a = some a ↔ a ∈ s := mem_of_set_self_iff

@[simp] lemma of_set_symm : (of_set s).symm = of_set s := rfl

@[simp] lemma of_set_univ : of_set set.univ = pequiv.refl α := rfl

@[simp]

end of_set

lemma symm_trans_rev (f : α ≃. β) (g : β ≃. γ) : (f.trans g).symm = g.symm.trans f.symm := rfl

lemma trans_symm (f : α ≃. β) : f.trans f.symm = of_set {a | (f a).is_some} :=
begin
  ext,
  dsimp [pequiv.trans],
  simp only [eq_some_iff f, option.is_some_iff_exists, option.mem_def, bind_eq_some',
    of_set_eq_some_iff],
  split,
  { rintros ⟨b, hb₁, hb₂⟩,
    exact ⟨pequiv.inj _ hb₂ hb₁, b, hb₂⟩ },
  { simp {contextual := tt} }
end

lemma symm_trans (f : α ≃. β) : f.symm.trans f = of_set {b | (f.symm b).is_some} :=
symm_injective $ by simp [symm_trans_rev, trans_symm, -symm_symm]

lemma trans_symm_eq_iff_forall_is_some {f : α ≃. β} :
  f.trans f.symm = pequiv.refl α ↔ ∀ a, is_some (f a) :=
by rw [trans_symm, of_set_eq_refl, set.eq_univ_iff_forall]; refl

instance : has_bot (α ≃. β) :=
⟨{ to_fun := λ _, none,
   inv_fun := λ _, none,
   inv := by simp }⟩

@[simp] lemma bot_apply (a : α) : (⊥ : α ≃. β) a = none := rfl

@[simp] lemma symm_bot : (⊥ : α ≃. β).symm = ⊥ := rfl

@[simp] lemma trans_bot (f : α ≃. β) : f.trans (⊥ : β ≃. γ) = ⊥ :=
by ext; dsimp [pequiv.trans]; simp

@[simp] lemma bot_trans (f : β ≃. γ) : (⊥ : α ≃. β).trans f = ⊥ :=
by ext; dsimp [pequiv.trans]; simp

lemma is_some_symm_get (f : α ≃. β) {a : α} (h : is_some (f a)) :
  is_some (f.symm (option.get h)) :=
is_some_iff_exists.2 ⟨a, by rw [f.eq_some_iff, some_get]⟩

section single
variables [decidable_eq α] [decidable_eq β] [decidable_eq γ]

def single (a : α) (b : β) : α ≃. β :=
{ to_fun := λ x, if x = a then some b else none,
  inv_fun := λ x, if x = b then some a else none,
  inv := λ _ _, by simp; split_ifs; cc }

lemma mem_single (a : α) (b : β) : b ∈ single a b a := if_pos rfl

lemma mem_single_iff (a₁ a₂ : α) (b₁ b₂ : β) : b₁ ∈ single a₂ b₂ a₁ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
by dsimp [single]; split_ifs; simp [*, eq_comm]

@[simp] lemma symm_single (a : α) (b : β) : (single a b).symm = single b a := rfl

@[simp] lemma single_apply (a : α) (b : β) : single a b a = some b := if_pos rfl

lemma single_apply_of_ne {a₁ a₂ : α} (h : a₁ ≠ a₂) (b : β) : single a₁ b a₂ = none := if_neg h.symm

lemma single_trans_of_mem (a : α) {b : β} {c : γ} {f : β ≃. γ} (h : c ∈ f b) :
  (single a b).trans f = single a c :=
begin
  ext,
  dsimp [single, pequiv.trans],
  split_ifs; simp * at *
end

lemma trans_single_of_mem {a : α} {b : β} (c : γ) {f : α ≃. β} (h : b ∈ f a) :
  f.trans (single b c) = single a c :=
symm_injective $ single_trans_of_mem _ ((mem_iff_mem f).2 h)

@[simp]
lemma single_trans_single (a : α) (b : β) (c : γ) : (single a b).trans (single b c) = single a c :=
single_trans_of_mem _ (mem_single _ _)

@[simp] lemma single_subsingleton_eq_refl [subsingleton α] (a b : α) : single a b = pequiv.refl α :=
begin
  ext i j,
  dsimp [single],
  rw [if_pos (subsingleton.elim i a), subsingleton.elim i j, subsingleton.elim b j]
end

lemma trans_single_of_eq_none {b : β} (c : γ) {f : δ ≃. β} (h : f.symm b = none) :
  f.trans (single b c) = ⊥ :=
begin
  ext,
  simp only [eq_none_iff_forall_not_mem, option.mem_def, f.eq_some_iff] at h,
  dsimp [pequiv.trans, single],
  simp,
  intros,
  split_ifs;
  simp * at *
end

lemma single_trans_of_eq_none (a : α) {b : β} {f : β ≃. δ} (h : f b = none) :
  (single a b).trans f = ⊥ :=
symm_injective $ trans_single_of_eq_none _ h

lemma single_trans_single_of_ne {b₁ b₂ : β} (h : b₁ ≠ b₂) (a : α) (c : γ) :
  (single a b₁).trans (single b₂ c) = ⊥ :=
single_trans_of_eq_none _ (single_apply_of_ne h.symm _)

end single

section order

instance : partial_order (α ≃. β) :=
{ le := λ f g, ∀ (a : α) (b : β), b ∈ f a → b ∈ g a,
  le_refl := λ _ _ _, id,
  le_trans := λ f g h fg gh a b, (gh a b) ∘ (fg a b),
  le_antisymm := λ f g fg gf, ext begin
    assume a,
    cases h : g a with b,
    { exact eq_none_iff_forall_not_mem.2
       (λ b hb, option.not_mem_none b $ h ▸ fg a b hb) },
    { exact gf _ _ h }
  end }

lemma le_def {f g : α ≃. β} : f ≤ g ↔ (∀ (a : α) (b : β), b ∈ f a → b ∈ g a) := iff.rfl

instance : order_bot (α ≃. β) :=
{ bot_le := λ _ _  _ h, (not_mem_none _ h).elim,
  ..pequiv.partial_order,
  ..pequiv.has_bot }

instance [decidable_eq α] [decidable_eq β] : semilattice_inf_bot (α ≃. β) :=
{ inf := λ f g,
  { to_fun := λ a, if f a = g a then f a else none,
    inv_fun := λ b, if f.symm b = g.symm b then f.symm b else none,
    inv := λ a b, begin
      have := @mem_iff_mem _ _ f a b,
      have := @mem_iff_mem _ _ g a b,
      split_ifs; finish
    end },
  inf_le_left := λ _ _ _ _, by simp; split_ifs; cc,
  inf_le_right := λ _ _ _ _, by simp; split_ifs; cc,
  le_inf := λ f g h fg gh a b, begin
    have := fg a b,
    have := gh a b,
    simp [le_def],
    split_ifs; finish
  end,
  ..pequiv.order_bot }

end order

end pequiv

namespace equiv
variables {α : Type*} {β : Type*} {γ : Type*}

def to_pequiv (f : α ≃ β) : α ≃. β :=
{ to_fun := some ∘ f,
  inv_fun := some ∘ f.symm,
  inv := by simp [equiv.eq_symm_apply, eq_comm] }

@[simp] lemma to_pequiv_refl : (equiv.refl α).to_pequiv = pequiv.refl α := rfl

lemma to_pequiv_trans (f : α ≃ β) (g : β ≃ γ) : (f.trans g).to_pequiv =
  f.to_pequiv.trans g.to_pequiv := rfl

lemma to_pequiv_symm (f : α ≃ β) : f.symm.to_pequiv = f.to_pequiv.symm := rfl

lemma to_pequiv_apply (f : α ≃ β) (x : α) : f.to_pequiv x = some (f x) := rfl

end equiv


import algebra.homology.homological_complex
import algebra.homology.additive

noncomputable theory

universes v

open category_theory category_theory.limits

variables {C D : Type*} [category C] [category D]
variables {M : Type*} {c : complex_shape M}

namespace category_theory

namespace functor

variables [preadditive C] [preadditive D]
variables (F : C ⥤ D) [functor.additive F] (X Y : homological_complex C c)

def obj_X_prev (i : M) : F.obj (X.X_prev i) ≅ ((F.map_homological_complex c).obj X).X_prev i :=
iso.refl _

lemma obj_X_prev_hom_eq (i : M) : (F.obj_X_prev X i).hom = 𝟙 _ := rfl

lemma map_prev_iso_hom (j i : M) (hij : c.rel j i) :
  F.map (X.X_prev_iso hij).hom = (((F.map_homological_complex c).obj X).X_prev_iso hij).hom :=
by { obtain rfl := c.prev_eq' hij, exact F.map_id _ }

def obj_X_next {M : Type*} {c : complex_shape M} (X : homological_complex C c) (i : M) :
  F.obj (X.X_next i) ≅ ((F.map_homological_complex c).obj X).X_next i :=
iso.refl _

lemma obj_X_next_hom_eq (i : M) : (F.obj_X_next X i).hom = 𝟙 _ := rfl

lemma map_next_iso_inv (i j : M) (hij : c.rel i j) :
  F.map (X.X_next_iso hij).inv = (((F.map_homological_complex c).obj X).X_next_iso hij).inv :=
by { obtain rfl := c.next_eq' hij, exact F.map_id _ }

lemma map_d_to (i : M) :
  F.map (X.d_to i) = ((F.map_homological_complex c).obj X).d_to i := rfl

lemma d_from_map (i : M) :
  F.map (X.d_from i) = ((F.map_homological_complex c).obj X).d_from i := rfl

variables {X Y}

lemma map_prev (f : X ⟶ Y) (i : M) :
  F.map (homological_complex.hom.prev f i) =
    homological_complex.hom.prev ((F.map_homological_complex c).map f) i := rfl

lemma map_next (f : X ⟶ Y) (i : M) :
  F.map (homological_complex.hom.next f i) =
    homological_complex.hom.next ((F.map_homological_complex c).map f) i := rfl

end functor

namespace nat_trans

variables [preadditive C] [preadditive D]
  {F G : C ⥤ D} [functor.additive F] [functor.additive G] (φ : F ⟶ G)
  (X : homological_complex C c)

lemma map_prev (i : M) : φ.app (X.X_prev i) =
    homological_complex.hom.prev ((nat_trans.map_homological_complex φ c).app X) i := rfl

lemma map_next (i : M) : φ.app (X.X_next i) =
    homological_complex.hom.next ((nat_trans.map_homological_complex φ c).app X) i := rfl

end nat_trans

end category_theory


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.calculus.specific_functions
import geometry.manifold.times_cont_mdiff

/-!
# Smooth bump functions on a smooth manifold

In this file we define `smooth_bump_function I c` to be a bundled smooth "bump" function centered at
`c`. It is a structure that consists of two real numbers `0 < r < R` with small enough `R`. We
define a coercion to function for this type, and for `f : smooth_bump_function I c`, the function
`⇑f` written in the extended chart at `c` has the following properties:

* `f x = 1` in the closed euclidean ball of radius `f.r` centered at `c`;
* `f x = 0` outside of the euclidean ball of radius `f.R` centered at `c`;
* `0 ≤ f x ≤ 1` for all `x`.

The actual statements involve (pre)images under `ext_chart_at I f` and are given as lemmas in the
`smooth_bump_function` namespace.

## Tags

manifold, smooth bump function
-/

universes uE uF uH uM
variables
{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
{H : Type uH} [topological_space H] (I : model_with_corners ℝ E H)
{M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]

open function filter finite_dimensional set
open_locale topological_space manifold classical filter big_operators

noncomputable theory

/-!
### Smooth bump function

In this section we define a structure for a bundled smooth bump function and prove its properties.
-/

/-- Given a smooth manifold modelled on a finite dimensional space `E`,
`f : smooth_bump_function I M` is a smooth function on `M` such that in the extended chart `e` at
`f.c`:

* `f x = 1` in the closed euclidean ball of radius `f.r` centered at `f.c`;
* `f x = 0` outside of the euclidean ball of radius `f.R` centered at `f.c`;
* `0 ≤ f x ≤ 1` for all `x`.

The structure contains data required to construct a function with these properties. The function is
available as `⇑f` or `f x`. Formal statements of the properties listed above involve some
(pre)images under `ext_chart_at I f.c` and are given as lemmas in the `smooth_bump_function`
namespace. -/
structure smooth_bump_function (c : M) extends times_cont_diff_bump (ext_chart_at I c c) :=
(closed_ball_subset :
  (euclidean.closed_ball (ext_chart_at I c c) R) ∩ range I ⊆ (ext_chart_at I c).target)

variable {M}

namespace smooth_bump_function

open euclidean (renaming dist -> eudist)

variables {c : M} (f : smooth_bump_function I c) {x : M} {I}

/-- The function defined by `f : smooth_bump_function c`. Use automatic coercion to function
instead. -/
def to_fun : M → ℝ :=
indicator (chart_at H c).source (f.to_times_cont_diff_bump ∘ ext_chart_at I c)

instance : has_coe_to_fun (smooth_bump_function I c) (λ _, M → ℝ) := ⟨to_fun⟩

lemma coe_def :
  ⇑f = indicator (chart_at H c).source (f.to_times_cont_diff_bump ∘ ext_chart_at I c) :=
rfl

lemma R_pos : 0 < f.R := f.to_times_cont_diff_bump.R_pos

lemma ball_subset :
  ball (ext_chart_at I c c) f.R ∩ range I ⊆ (ext_chart_at I c).target :=
subset.trans (inter_subset_inter_left _ ball_subset_closed_ball) f.closed_ball_subset

lemma eq_on_source :
  eq_on f (f.to_times_cont_diff_bump ∘ ext_chart_at I c) (chart_at H c).source :=
eq_on_indicator

lemma eventually_eq_of_mem_source (hx : x ∈ (chart_at H c).source) :
  f =ᶠ[𝓝 x] f.to_times_cont_diff_bump ∘ ext_chart_at I c :=
f.eq_on_source.eventually_eq_of_mem $ is_open.mem_nhds (chart_at H c).open_source hx

lemma one_of_dist_le (hs : x ∈ (chart_at H c).source)
  (hd : eudist (ext_chart_at I c x) (ext_chart_at I c c) ≤ f.r) :
  f x = 1 :=
by simp only [f.eq_on_source hs, (∘), f.to_times_cont_diff_bump.one_of_mem_closed_ball hd]

lemma support_eq_inter_preimage :
  support f =
    (chart_at H c).source ∩ (ext_chart_at I c ⁻¹' ball (ext_chart_at I c c) f.R) :=
by rw [coe_def, support_indicator, (∘), support_comp_eq_preimage, ← ext_chart_at_source I,
  ← (ext_chart_at I c).symm_image_target_inter_eq',
  ← (ext_chart_at I c).symm_image_target_inter_eq', f.to_times_cont_diff_bump.support_eq]

lemma open_support : is_open (support f) :=
by { rw support_eq_inter_preimage, exact ext_chart_preimage_open_of_open I c is_open_ball }

lemma support_eq_symm_image :
  support f = (ext_chart_at I c).symm '' (ball (ext_chart_at I c c) f.R ∩ range I) :=
begin
  rw [f.support_eq_inter_preimage, ← ext_chart_at_source I,
    ← (ext_chart_at I c).symm_image_target_inter_eq', inter_comm],
  congr' 1 with y,
  exact and.congr_right_iff.2
    (λ hy, ⟨λ h, ext_chart_at_target_subset_range _ _ h, λ h, f.ball_subset ⟨hy, h⟩⟩)
end

lemma support_subset_source : support f ⊆ (chart_at H c).source :=
by { rw [f.support_eq_inter_preimage, ← ext_chart_at_source I], exact inter_subset_left _ _ }

lemma image_eq_inter_preimage_of_subset_support {s : set M} (hs : s ⊆ support f) :
  ext_chart_at I c '' s =
    closed_ball (ext_chart_at I c c) f.R ∩ range I ∩ (ext_chart_at I c).symm ⁻¹' s :=
begin
  rw [support_eq_inter_preimage, subset_inter_iff, ← ext_chart_at_source I,
    ← image_subset_iff] at hs,
  cases hs with hse hsf,
  apply subset.antisymm,
  { refine subset_inter (subset_inter (subset.trans hsf ball_subset_closed_ball) _) _,
    { rintro _ ⟨x, -, rfl⟩, exact mem_range_self _ },
    { rw [(ext_chart_at I c).image_eq_target_inter_inv_preimage hse],
      exact inter_subset_right _ _ } },
  { refine subset.trans (inter_subset_inter_left _ f.closed_ball_subset) _,
    rw [(ext_chart_at I c).image_eq_target_inter_inv_preimage hse] }
end

lemma mem_Icc : f x ∈ Icc (0 : ℝ) 1 :=
begin
  have : f x = 0 ∨ f x = _, from indicator_eq_zero_or_self _ _ _,
  cases this; rw this,
  exacts [left_mem_Icc.2 zero_le_one,
    ⟨f.to_times_cont_diff_bump.nonneg, f.to_times_cont_diff_bump.le_one⟩]
end

lemma nonneg : 0 ≤ f x := f.mem_Icc.1

lemma le_one : f x ≤ 1 := f.mem_Icc.2

lemma eventually_eq_one_of_dist_lt (hs : x ∈ (chart_at H c).source)
  (hd : eudist (ext_chart_at I c x) (ext_chart_at I c c) < f.r) :
  f =ᶠ[𝓝 x] 1 :=
begin
  filter_upwards [is_open.mem_nhds (ext_chart_preimage_open_of_open I c is_open_ball) ⟨hs, hd⟩],
  rintro z ⟨hzs, hzd : _ < _⟩,
  exact f.one_of_dist_le hzs hzd.le
end

lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 :=
f.eventually_eq_one_of_dist_lt (mem_chart_source _ _) $
by { rw [euclidean.dist, dist_self], exact f.r_pos }

@[simp] lemma eq_one : f c = 1 := f.eventually_eq_one.eq_of_nhds

lemma support_mem_nhds : support f ∈ 𝓝 c :=
f.eventually_eq_one.mono $ λ x hx, by { rw hx, exact one_ne_zero }

lemma closure_support_mem_nhds : closure (support f) ∈ 𝓝 c :=
mem_of_superset f.support_mem_nhds subset_closure

lemma c_mem_support : c ∈ support f := mem_of_mem_nhds f.support_mem_nhds

lemma nonempty_support : (support f).nonempty := ⟨c, f.c_mem_support⟩

lemma compact_symm_image_closed_ball :
  is_compact ((ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)) :=
(is_compact_closed_ball.inter_right I.closed_range).image_of_continuous_on $
  (ext_chart_at_continuous_on_symm _ _).mono f.closed_ball_subset

/-- Given a smooth bump function `f : smooth_bump_function I c`, the closed ball of radius `f.R` is
known to include the support of `f`. These closed balls (in the model normed space `E`) intersected
with `set.range I` form a basis of `𝓝[range I] (ext_chart_at I c c)`. -/
lemma nhds_within_range_basis :
  (𝓝[range I] (ext_chart_at I c c)).has_basis (λ f : smooth_bump_function I c, true)
    (λ f, closed_ball (ext_chart_at I c c) f.R ∩ range I) :=
begin
  refine ((nhds_within_has_basis euclidean.nhds_basis_closed_ball _).restrict_subset
      (ext_chart_at_target_mem_nhds_within _ _)).to_has_basis' _ _,
  { rintro R ⟨hR0, hsub⟩,
    exact ⟨⟨⟨⟨R / 2, R, half_pos hR0, half_lt_self hR0⟩⟩, hsub⟩, trivial, subset.rfl⟩ },
  { exact λ f _, inter_mem (mem_nhds_within_of_mem_nhds $ closed_ball_mem_nhds f.R_pos)
      self_mem_nhds_within }
end

lemma closed_image_of_closed {s : set M} (hsc : is_closed s) (hs : s ⊆ support f) :
  is_closed (ext_chart_at I c '' s) :=
begin
  rw f.image_eq_inter_preimage_of_subset_support hs,
  refine continuous_on.preimage_closed_of_closed
    ((ext_chart_continuous_on_symm _ _).mono f.closed_ball_subset) _ hsc,
  exact is_closed.inter is_closed_closed_ball I.closed_range
end

/-- If `f` is a smooth bump function and `s` closed subset of the support of `f` (i.e., of the open
ball of radius `f.R`), then there exists `0 < r < f.R` such that `s` is a subset of the open ball of
radius `r`. Formally, `s ⊆ e.source ∩ e ⁻¹' (ball (e c) r)`, where `e = ext_chart_at I c`. -/
lemma exists_r_pos_lt_subset_ball {s : set M} (hsc : is_closed s) (hs : s ⊆ support f) :
  ∃ r (hr : r ∈ Ioo 0 f.R), s ⊆
    (chart_at H c).source ∩ ext_chart_at I c ⁻¹' (ball (ext_chart_at I c c) r) :=
begin
  set e := ext_chart_at I c,
  have : is_closed (e '' s) := f.closed_image_of_closed hsc hs,
  rw [support_eq_inter_preimage, subset_inter_iff, ← image_subset_iff] at hs,
  rcases euclidean.exists_pos_lt_subset_ball f.R_pos this hs.2 with ⟨r, hrR, hr⟩,
  exact ⟨r, hrR, subset_inter hs.1 (image_subset_iff.1 hr)⟩
end

/-- Replace `r` with another value in the interval `(0, f.R)`. -/
def update_r (r : ℝ) (hr : r ∈ Ioo 0 f.R) : smooth_bump_function I c :=
⟨⟨⟨r, f.R, hr.1, hr.2⟩⟩, f.closed_ball_subset⟩

@[simp] lemma update_r_R {r : ℝ} (hr : r ∈ Ioo 0 f.R) : (f.update_r r hr).R = f.R := rfl

@[simp] lemma update_r_r {r : ℝ} (hr : r ∈ Ioo 0 f.R) : (f.update_r r hr).r = r := rfl

@[simp] lemma support_update_r {r : ℝ} (hr : r ∈ Ioo 0 f.R) :
  support (f.update_r r hr) = support f :=
by simp only [support_eq_inter_preimage, update_r_R]

instance : inhabited (smooth_bump_function I c) :=
classical.inhabited_of_nonempty nhds_within_range_basis.nonempty

variables [t2_space M]

lemma closed_symm_image_closed_ball :
  is_closed ((ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)) :=
f.compact_symm_image_closed_ball.is_closed

lemma closure_support_subset_symm_image_closed_ball :
  closure (support f) ⊆
    (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I) :=
begin
  rw support_eq_symm_image,
  exact closure_minimal (image_subset _ $ inter_subset_inter_left _ ball_subset_closed_ball)
    f.closed_symm_image_closed_ball
end

lemma closure_support_subset_ext_chart_at_source :
  closure (support f) ⊆ (ext_chart_at I c).source :=
calc closure (support f)
    ⊆ (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I) :
  f.closure_support_subset_symm_image_closed_ball
... ⊆ (ext_chart_at I c).symm '' (ext_chart_at I c).target :
  image_subset _ f.closed_ball_subset
... = (ext_chart_at I c).source :
  (ext_chart_at I c).symm_image_target_eq_source

lemma closure_support_subset_chart_at_source :
  closure (support f) ⊆ (chart_at H c).source :=
by simpa only [ext_chart_at_source] using f.closure_support_subset_ext_chart_at_source

lemma compact_closure_support : is_compact (closure $ support f) :=
compact_of_is_closed_subset f.compact_symm_image_closed_ball is_closed_closure
 f.closure_support_subset_symm_image_closed_ball

variables (I c)

/-- The closures of supports of smooth bump functions centered at `c` form a basis of `𝓝 c`.
In other words, each of these closures is a neighborhood of `c` and each neighborhood of `c`
includes `closure (support f)` for some `f : smooth_bump_function I c`. -/
lemma nhds_basis_closure_support :
  (𝓝 c).has_basis (λ f : smooth_bump_function I c, true) (λ f, closure $ support f) :=
begin
  have : (𝓝 c).has_basis (λ f : smooth_bump_function I c, true)
    (λ f, (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)),
  { rw [← ext_chart_at_symm_map_nhds_within_range I c],
    exact nhds_within_range_basis.map _ },
  refine this.to_has_basis' (λ f hf, ⟨f, trivial, f.closure_support_subset_symm_image_closed_ball⟩)
    (λ f _, f.closure_support_mem_nhds),
end

variable {c}

/-- Given `s ∈ 𝓝 c`, the supports of smooth bump functions `f : smooth_bump_function I c` such that
`closure (support f) ⊆ s` form a basis of `𝓝 c`.  In other words, each of these supports is a
neighborhood of `c` and each neighborhood of `c` includes `support f` for some `f :
smooth_bump_function I c` such that `closure (support f) ⊆ s`. -/
lemma nhds_basis_support {s : set M} (hs : s ∈ 𝓝 c) :
  (𝓝 c).has_basis (λ f : smooth_bump_function I c, closure (support f) ⊆ s) (λ f, support f) :=
((nhds_basis_closure_support I c).restrict_subset hs).to_has_basis'
  (λ f hf, ⟨f, hf.2, subset_closure⟩) (λ f hf, f.support_mem_nhds)

variables [smooth_manifold_with_corners I M] {I}

/-- A smooth bump function is infinitely smooth. -/
protected lemma smooth : smooth I 𝓘(ℝ) f :=
begin
  refine times_cont_mdiff_of_support (λ x hx, _),
  have : x ∈ (chart_at H c).source := f.closure_support_subset_chart_at_source hx,
  refine times_cont_mdiff_at.congr_of_eventually_eq _
    (f.eq_on_source.eventually_eq_of_mem $ is_open.mem_nhds (chart_at _ _).open_source this),
  exact f.to_times_cont_diff_bump.times_cont_diff_at.times_cont_mdiff_at.comp _
    (times_cont_mdiff_at_ext_chart_at' this)
end

protected lemma smooth_at {x} : smooth_at I 𝓘(ℝ) f x := f.smooth.smooth_at

protected lemma continuous : continuous f := f.smooth.continuous

/-- If `f : smooth_bump_function I c` is a smooth bump function and `g : M → G` is a function smooth
on the source of the chart at `c`, then `f • g` is smooth on the whole manifold. -/
lemma smooth_smul {G} [normed_group G] [normed_space ℝ G]
  {g : M → G} (hg : smooth_on I 𝓘(ℝ, G) g (chart_at H c).source) :
  smooth I 𝓘(ℝ, G) (λ x, f x • g x) :=
begin
  apply times_cont_mdiff_of_support (λ x hx, _),
  have : x ∈ (chart_at H c).source,
  calc x ∈ closure (support (λ x, f x • g x)) : hx
     ... ⊆ closure (support f) : closure_mono (support_smul_subset_left _ _)
     ... ⊆ (chart_at _ c).source : f.closure_support_subset_chart_at_source,
  exact f.smooth_at.smul ((hg _ this).times_cont_mdiff_at $
    is_open.mem_nhds (chart_at _ _).open_source this)
end

end smooth_bump_function


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import geometry.manifold.algebra.structures

/-!
# Algebraic structures over smooth functions

In this file, we define instances of algebraic structures over smooth functions.
-/

noncomputable theory

open_locale manifold

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{N : Type*} [topological_space N] [charted_space H N]
{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{N' : Type*} [topological_space N'] [charted_space H'' N']

namespace smooth_map

@[to_additive]
instance has_mul {G : Type*} [has_mul G] [topological_space G] [charted_space H' G]
  [has_smooth_mul I' G] :
  has_mul C^∞⟮I, N; I', G⟯ :=
⟨λ f g, ⟨f * g, f.smooth.mul g.smooth⟩⟩

@[simp, to_additive]
lemma coe_mul {G : Type*} [has_mul G] [topological_space G] [charted_space H' G]
  [has_smooth_mul I' G] (f g : C^∞⟮I, N; I', G⟯) :
  ⇑(f * g) = f * g := rfl

@[simp, to_additive] lemma mul_comp {G : Type*} [has_mul G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] (f g : C^∞⟮I'', N'; I', G⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(f * g).comp h = (f.comp h) * (g.comp h) :=
by ext; simp only [times_cont_mdiff_map.comp_apply, coe_mul, pi.mul_apply]

@[to_additive]
instance has_one {G : Type*} [monoid G] [topological_space G] [charted_space H' G] :
  has_one C^∞⟮I, N; I', G⟯ :=
⟨times_cont_mdiff_map.const (1 : G)⟩

@[simp, to_additive]
lemma coe_one {G : Type*} [monoid G] [topological_space G] [charted_space H' G] :
  ⇑(1 : C^∞⟮I, N; I', G⟯) = 1 := rfl

section group_structure

/-!
### Group structure

In this section we show that smooth functions valued in a Lie group inherit a group structure
under pointwise multiplication.
-/

@[to_additive]
instance semigroup {G : Type*} [semigroup G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  semigroup C^∞⟮I, N; I', G⟯ :=
{ mul_assoc := λ a b c, by ext; exact mul_assoc _ _ _,
  ..smooth_map.has_mul}

@[to_additive]
instance monoid {G : Type*} [monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  monoid C^∞⟮I, N; I', G⟯ :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  ..smooth_map.semigroup,
  ..smooth_map.has_one }

/-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
@[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
  simps]
def coe_fn_monoid_hom {G : Type*} [monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] : C^∞⟮I, N; I', G⟯ →* (N → G) :=
{ to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }

@[to_additive]
instance comm_monoid {G : Type*} [comm_monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  comm_monoid C^∞⟮I, N; I', G⟯ :=
{ mul_comm := λ a b, by ext; exact mul_comm _ _,
  ..smooth_map.monoid,
  ..smooth_map.has_one }

@[to_additive]
instance group {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] :
  group C^∞⟮I, N; I', G⟯ :=
{ inv := λ f, ⟨λ x, (f x)⁻¹, f.smooth.inv⟩,
  mul_left_inv := λ a, by ext; exact mul_left_inv _,
  div := λ f g, ⟨f / g, f.smooth.div g.smooth⟩,
  div_eq_mul_inv := λ f g, by ext; exact div_eq_mul_inv _ _,
  .. smooth_map.monoid }

@[simp, to_additive]
lemma coe_inv {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] (f : C^∞⟮I, N; I', G⟯) :
  ⇑f⁻¹ = f⁻¹ := rfl

@[simp, to_additive]
lemma coe_div {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] (f g : C^∞⟮I, N; I', G⟯) :
  ⇑(f / g) = f / g :=
rfl

@[to_additive]
instance comm_group {G : Type*} [comm_group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] :
  comm_group C^∞⟮I, N; I', G⟯ :=
{ ..smooth_map.group,
  ..smooth_map.comm_monoid }

end group_structure

section ring_structure

/-!
### Ring stucture

In this section we show that smooth functions valued in a smooth ring `R` inherit a ring structure
under pointwise multiplication.
-/

instance semiring {R : Type*} [semiring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  semiring C^∞⟮I, N; I', R⟯ :=
{ left_distrib := λ a b c, by ext; exact left_distrib _ _ _,
  right_distrib := λ a b c, by ext; exact right_distrib _ _ _,
  zero_mul := λ a, by ext; exact zero_mul _,
  mul_zero := λ a, by ext; exact mul_zero _,
  ..smooth_map.add_comm_monoid,
  ..smooth_map.monoid }

instance ring {R : Type*} [ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  ring C^∞⟮I, N; I', R⟯ :=
{ ..smooth_map.semiring,
  ..smooth_map.add_comm_group, }

instance comm_ring {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  comm_ring C^∞⟮I, N; I', R⟯ :=
{ ..smooth_map.semiring,
  ..smooth_map.add_comm_group,
  ..smooth_map.comm_monoid,}

/-- Coercion to a function as a `ring_hom`. -/
@[simps]
def coe_fn_ring_hom {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] : C^∞⟮I, N; I', R⟯ →+* (N → R) :=
{ to_fun := coe_fn,
  ..(coe_fn_monoid_hom : C^∞⟮I, N; I', R⟯ →* _),
  ..(coe_fn_add_monoid_hom : C^∞⟮I, N; I', R⟯ →+ _) }

/-- `function.eval` as a `ring_hom` on the ring of smooth functions. -/
def eval_ring_hom {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] (n : N) : C^∞⟮I, N; I', R⟯ →+* R :=
(pi.eval_ring_hom _ n : (N → R) →+* R).comp smooth_map.coe_fn_ring_hom

end ring_structure

section module_structure

/-!
### Semiodule stucture

In this section we show that smooth functions valued in a vector space `M` over a normed
field `𝕜` inherit a vector space structure.
-/

instance has_scalar {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  has_scalar 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
⟨λ r f, ⟨r • f, smooth_const.smul f.smooth⟩⟩

@[simp]
lemma coe_smul {V : Type*} [normed_group V] [normed_space 𝕜 V]
  (r : 𝕜) (f : C^∞⟮I, N; 𝓘(𝕜, V), V⟯) :
  ⇑(r • f) = r • f := rfl

@[simp] lemma smul_comp {V : Type*} [normed_group V] [normed_space 𝕜 V]
  (r : 𝕜) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(r • g).comp h = r • (g.comp h) := rfl

instance module {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  module 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
module.of_core $
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add c (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul c₁ c₂ (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul c₁ c₂ (f x),
  one_smul := λ f, by ext x; exact one_smul 𝕜 (f x), }

/-- Coercion to a function as a `linear_map`. -/
@[simps]
def coe_fn_linear_map {V : Type*} [normed_group V] [normed_space 𝕜 V] :
C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →ₗ[𝕜] (N → V) :=
{ to_fun := coe_fn,
  map_smul' := coe_smul,
  ..(coe_fn_add_monoid_hom : C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →+ _) }

end module_structure

section algebra_structure

/-!
### Algebra structure

In this section we show that smooth functions valued in a normed algebra `A` over a normed field `𝕜`
inherit an algebra structure.
-/

variables {A : Type*} [normed_ring A] [normed_algebra 𝕜 A] [smooth_ring 𝓘(𝕜, A) A]

/-- Smooth constant functions as a `ring_hom`. -/
def C : 𝕜 →+* C^∞⟮I, N; 𝓘(𝕜, A), A⟯ :=
{ to_fun    := λ c : 𝕜, ⟨λ x, ((algebra_map 𝕜 A) c), smooth_const⟩,
  map_one'  := by ext x; exact (algebra_map 𝕜 A).map_one,
  map_mul'  := λ c₁ c₂, by ext x; exact (algebra_map 𝕜 A).map_mul _ _,
  map_zero' := by ext x; exact (algebra_map 𝕜 A).map_zero,
  map_add'  := λ c₁ c₂, by ext x; exact (algebra_map 𝕜 A).map_add _ _ }

instance algebra : algebra 𝕜 C^∞⟮I, N; 𝓘(𝕜, A), A⟯ :=
{ smul := λ r f,
  ⟨r • f, smooth_const.smul f.smooth⟩,
  to_ring_hom := smooth_map.C,
  commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
  smul_def' := λ c f, by ext x; exact algebra.smul_def' _ _,
  ..smooth_map.semiring }

/-- Coercion to a function as an `alg_hom`. -/
@[simps]
def coe_fn_alg_hom : C^∞⟮I, N; 𝓘(𝕜, A), A⟯ →ₐ[𝕜] (N → A) :=
{ to_fun := coe_fn,
  commutes' := λ r, rfl,
  -- `..(smooth_map.coe_fn_ring_hom : C^∞⟮I, N; 𝓘(𝕜, A), A⟯ →+* _)` times out for some reason
  map_zero' := smooth_map.coe_zero,
  map_one' := smooth_map.coe_one,
  map_add' := smooth_map.coe_add,
  map_mul' := smooth_map.coe_mul }

end algebra_structure

section module_over_continuous_functions

/-!
### Structure as module over scalar functions

If `V` is a module over `𝕜`, then we show that the space of smooth functions from `N` to `V`
is naturally a vector space over the ring of smooth functions from `N` to `𝕜`. -/

instance has_scalar' {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  has_scalar C^∞⟮I, N; 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
⟨λ f g, ⟨λ x, (f x) • (g x), (smooth.smul f.2 g.2)⟩⟩

@[simp] lemma smul_comp' {V : Type*} [normed_group V] [normed_space 𝕜 V]
  (f : C^∞⟮I'', N'; 𝕜⟯) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(f • g).comp h = (f.comp h) • (g.comp h) := rfl

instance module' {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  module C^∞⟮I, N; 𝓘(𝕜), 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul (c₁ x) (c₂ x) (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul (c₁ x) (c₂ x) (f x),
  one_smul := λ f, by ext x; exact one_smul 𝕜 (f x),
  zero_smul := λ f, by ext x; exact zero_smul _ _,
  smul_zero := λ r, by ext x; exact smul_zero _, }

end module_over_continuous_functions

end smooth_map