/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison, Bhavik Mehta, Jakob von Raumer

! This file was ported from Lean 3 source module category_theory.monoidal.category
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Products.Basic

/-!
# Monoidal categories

A monoidal category is a category equipped with a tensor product, unitors, and an associator.
In the definition, we provide the tensor product as a pair of functions
* `tensorObj : C → C → C`
* `tensorHom : (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → ((X₁ ⊗ X₂) ⟶ (Y₁ ⊗ Y₂))`
and allow use of the overloaded notation `⊗` for both.
The unitors and associator are provided componentwise.

The tensor product can be expressed as a functor via `tensor : C × C ⥤ C`.
The unitors and associator are gathered together as natural
isomorphisms in `leftUnitor_nat_iso`, `rightUnitor_nat_iso` and `associator_nat_iso`.

Some consequences of the definition are proved in other files,
e.g. `(λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom` in `CategoryTheory.Monoidal.UnitorsEqual`.

## Implementation
Dealing with unitors and associators is painful, and at this stage we do not have a useful
implementation of coherence for monoidal categories.

In an effort to lessen the pain, we put some effort into choosing the right `simp` lemmas.
Generally, the rule is that the component index of a natural transformation "weighs more"
in considering the complexity of an expression than does a structural isomorphism (associator, etc).

As an example when we prove Proposition 2.2.4 of
<http://www-math.mit.edu/~etingof/egnobookfinal.pdf>
we state it as a `@[simp]` lemma as
```
(λ_ (X ⊗ Y)).hom = (α_ (𝟙_ C) X Y).inv ≫ (λ_ X).hom ⊗ (𝟙 Y)
```

This is far from completely effective, but seems to prove a useful principle.

## References
* Tensor categories, Etingof, Gelaki, Nikshych, Ostrik,
  http://www-math.mit.edu/~etingof/egnobookfinal.pdf
* <https://stacks.math.columbia.edu/tag/0FFK>.
-/

open CategoryTheory

universe v u

open CategoryTheory

open CategoryTheory.Category

open CategoryTheory.Iso

namespace CategoryTheory

/--
In a monoidal category, we can take the tensor product of objects, `X ⊗ Y` and of morphisms `f ⊗ g`.
Tensor product does not need to be strictly associative on objects, but there is a
specified associator, `α_ X Y Z : (X ⊗ Y) ⊗ Z ≅ X ⊗ (Y ⊗ Z)`. There is a tensor unit `𝟙_ C`,
with specified left and right unitor isomorphisms `λ_ X : 𝟙_ C ⊗ X ≅ X` and `ρ_ X : X ⊗ 𝟙_ C ≅ X`.
These associators and unitors satisfy the pentagon and triangle equations.

See <https://stacks.math.columbia.edu/tag/0FFK>.
-/
-- Porting note: The Mathport did not translate the temporary notation
class MonoidalCategory (C : Type u) [𝒞 : Category.{v} C] where
  /-- curried tensor product of objects -/
  tensorObj : C → C → C
  /-- curried tensor product of morphisms -/
  tensorHom : ∀ {X₁ Y₁ X₂ Y₂ : C}, (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → (tensorObj X₁ X₂ ⟶ tensorObj Y₁ Y₂)
  /-- Tensor product of identiy maps is the identity: `(𝟙 X₁ ⊗ 𝟙 X₂) = 𝟙 (X₁ ⊗ X₂)` -/
  tensor_id : ∀ X₁ X₂ : C, tensorHom (𝟙 X₁) (𝟙 X₂) = 𝟙 (tensorObj X₁ X₂) := by aesop_cat
  /--
  Composition of tensor products is tensor product of compositions:
  `(f₁ ⊗ g₁) ∘ (f₂ ⊗ g₂) = (f₁ ∘ f₂) ⊗ (g₁ ⊗ g₂)`
  -/
  tensor_comp :
    ∀ {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂),
      tensorHom (f₁ ≫ g₁) (f₂ ≫ g₂) = tensorHom f₁ f₂ ≫ tensorHom g₁ g₂ := by
    aesop_cat
  -- Porting note: Adding a prime here, so I can later define `tensorUnit` unprimed with explicit
  --               argument `C`
  /-- The tensor unity in the monoidal structure `𝟙_C` -/
  tensorUnit' : C
  /-- The associator isomorphism `(X ⊗ Y) ⊗ Z ≃ X ⊗ (Y ⊗ Z)` -/
  associator : ∀ X Y Z : C, tensorObj (tensorObj X Y) Z ≅ tensorObj X (tensorObj Y Z)
  /-- Naturality of the associator isomorphism: `(f₁ ⊗ f₂) ⊗ f₃ ≃ f₁ ⊗ (f₂ ⊗ f₃)` -/
  associator_naturality :
    ∀ {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃),
      tensorHom (tensorHom f₁ f₂) f₃ ≫ (associator Y₁ Y₂ Y₃).hom =
        (associator X₁ X₂ X₃).hom ≫ tensorHom f₁ (tensorHom f₂ f₃) := by
    aesop_cat
  /-- The left unitor: `𝟙_C ⊗ X ≃ X` -/
  leftUnitor : ∀ X : C, tensorObj tensorUnit' X ≅ X
  /--
  Naturality of the left unitor, commutativity of `𝟙_C ⊗ X ⟶ 𝟙_C ⊗ Y ⟶ Y` and `𝟙_C ⊗ X ⟶ X ⟶ Y`
  -/
  leftUnitor_naturality :
    ∀ {X Y : C} (f : X ⟶ Y),
      tensorHom (𝟙 tensorUnit') f ≫ (leftUnitor Y).hom = (leftUnitor X).hom ≫ f := by
    aesop_cat
  /-- The right unitor: `X ⊗ 𝟙_C ≃ X` -/
  rightUnitor : ∀ X : C, tensorObj X tensorUnit' ≅ X
  /--
  Naturality of the right unitor: commutativity of `X ⊗ 𝟙_C ⟶ Y ⊗ 𝟙_C ⟶ Y` and `X ⊗ 𝟙_C ⟶ X ⟶ Y`
  -/
  rightUnitor_naturality :
    ∀ {X Y : C} (f : X ⟶ Y),
      tensorHom f (𝟙 tensorUnit') ≫ (rightUnitor Y).hom = (rightUnitor X).hom ≫ f := by
    aesop_cat
  /--
  The pentagon identity relating the isomorphism between `X ⊗ (Y ⊗ (Z ⊗ W))` and `((X ⊗ Y) ⊗ Z) ⊗ W`
  -/
  pentagon :
    ∀ W X Y Z : C,
      tensorHom (associator W X Y).hom (𝟙 Z) ≫
          (associator W (tensorObj X Y) Z).hom ≫ tensorHom (𝟙 W) (associator X Y Z).hom =
        (associator (tensorObj W X) Y Z).hom ≫ (associator W X (tensorObj Y Z)).hom := by
    aesop_cat
  /--
  The identity relating the isomorphisms between `X ⊗ (𝟙_C ⊗ Y)`, `(X ⊗ 𝟙_C) ⊗ Y` and `X ⊗ Y`
  -/
  triangle :
    ∀ X Y : C,
      (associator X tensorUnit' Y).hom ≫ tensorHom (𝟙 X) (leftUnitor Y).hom =
        tensorHom (rightUnitor X).hom (𝟙 Y) := by
    aesop_cat
#align category_theory.monoidal_category CategoryTheory.MonoidalCategory

-- Porting Note: `restate_axiom` doesn't seem to be necessary in Lean 4
-- restate_axiom MonoidalCategory.tensor_id'

attribute [simp] MonoidalCategory.tensor_id

-- Porting Note: same as above
-- restate_axiom MonoidalCategory.tensor_comp'

attribute [reassoc] MonoidalCategory.tensor_comp

-- This would be redundant in the simp set.
attribute [simp] MonoidalCategory.tensor_comp

-- Porting Note: same as above
-- restate_axiom MonoidalCategory.associator_naturality'

attribute [reassoc] MonoidalCategory.associator_naturality

-- Porting Note: same as above
-- restate_axiom MonoidalCategory.leftUnitor_naturality'

attribute [reassoc] MonoidalCategory.leftUnitor_naturality

-- Porting Note: same as above
-- restate_axiom MonoidalCategory.rightUnitor_naturality'

attribute [reassoc] MonoidalCategory.rightUnitor_naturality

-- Porting Note: same as above
-- restate_axiom MonoidalCategory.pentagon'

-- Porting Note: same as above
-- restate_axiom MonoidalCategory.triangle'

attribute [reassoc] MonoidalCategory.pentagon

attribute [reassoc (attr := simp)] MonoidalCategory.triangle

-- Porting Note: This is here to make `tensorUnit` explicitly depend on `C`, which was done in
--               Lean 3 using the `[]` notation in the `tensorUnit'` field.
open CategoryTheory.MonoidalCategory in
/-- The tensor unity in the monoidal structure `𝟙_C` -/
abbrev MonoidalCategory.tensorUnit (C : Type u) [Category.{v} C] [MonoidalCategory C] : C :=
  tensorUnit' (C := C)

open MonoidalCategory

-- mathport name: tensor_obj
/-- Notation for `tensorObj`, the tensor product of objects in a monoidal category -/
infixr:70 " ⊗ " => tensorObj

-- mathport name: tensor_hom
/-- Notation for `tensorHom`, the tensor product of morphisms in a monoidal category -/
infixr:70 " ⊗ " => tensorHom

-- mathport name: «expr𝟙_»
/-- Notation for `tensorUnit`, the two-sided identity of `⊗` -/
notation "𝟙_" => tensorUnit

-- mathport name: exprα_
/-- Notation for the monoidal `associator`: `(X ⊗ Y) ⊗ Z) ≃ X ⊗ (Y ⊗ Z)` -/
notation "α_" => associator

-- mathport name: «exprλ_»
/-- Notation for the `leftUnitor`: `𝟙_C ⊗ X ≃ X` -/
notation "λ_" => leftUnitor

-- mathport name: exprρ_
/-- Notation for the `rightUnitor`: `X ⊗ 𝟙_C ≃ X` -/
notation "ρ_" => rightUnitor

variable (C : Type u) [𝒞 : Category.{v} C] [MonoidalCategory C]

/-- The tensor product of two isomorphisms is an isomorphism. -/
@[simps]
def tensorIso {C : Type u} {X Y X' Y' : C} [Category.{v} C] [MonoidalCategory.{v} C] (f : X ≅ Y)
    (g : X' ≅ Y') : X ⊗ X' ≅ Y ⊗ Y' where
  hom := f.hom ⊗ g.hom
  inv := f.inv ⊗ g.inv
  hom_inv_id := by rw [← tensor_comp, Iso.hom_inv_id, Iso.hom_inv_id, ← tensor_id]
  inv_hom_id := by rw [← tensor_comp, Iso.inv_hom_id, Iso.inv_hom_id, ← tensor_id]
#align category_theory.tensor_iso CategoryTheory.tensorIso

-- mathport name: tensor_iso
/-- Notation for `tensorIso`, the tensor product of isomorphisms -/
infixr:70 " ⊗ " => tensorIso

namespace MonoidalCategory

section

variable {C : Type u} [Category.{v} C] [MonoidalCategory.{v} C]

instance tensor_isIso {W X Y Z : C} (f : W ⟶ X) [IsIso f] (g : Y ⟶ Z) [IsIso g] : IsIso (f ⊗ g) :=
  IsIso.of_iso (asIso f ⊗ asIso g)
#align category_theory.monoidal_category.tensor_is_iso CategoryTheory.MonoidalCategory.tensor_isIso

@[simp]
theorem inv_tensor {W X Y Z : C} (f : W ⟶ X) [IsIso f] (g : Y ⟶ Z) [IsIso g] :
    inv (f ⊗ g) = inv f ⊗ inv g := by
  -- Porting note: Replaced `ext` with `aesop_cat_nonterminal`
  aesop_cat_nonterminal
  simp [← tensor_comp]
#align category_theory.monoidal_category.inv_tensor CategoryTheory.MonoidalCategory.inv_tensor

variable {U V W X Y Z : C}

theorem tensor_dite {P : Prop} [Decidable P] {W X Y Z : C} (f : W ⟶ X) (g : P → (Y ⟶ Z))
    (g' : ¬P → (Y ⟶ Z)) : (f ⊗ if h : P then g h else g' h) = if h : P then f ⊗ g h else f ⊗ g' h :=
  by split_ifs <;> rfl
#align category_theory.monoidal_category.tensor_dite CategoryTheory.MonoidalCategory.tensor_dite

theorem dite_tensor {P : Prop} [Decidable P] {W X Y Z : C} (f : W ⟶ X) (g : P → (Y ⟶ Z))
    (g' : ¬P → (Y ⟶ Z)) : (if h : P then g h else g' h) ⊗ f = if h : P then g h ⊗ f else g' h ⊗ f :=
  by split_ifs <;> rfl
#align category_theory.monoidal_category.dite_tensor CategoryTheory.MonoidalCategory.dite_tensor

@[reassoc, simp]
theorem comp_tensor_id (f : W ⟶ X) (g : X ⟶ Y) : f ≫ g ⊗ 𝟙 Z = (f ⊗ 𝟙 Z) ≫ (g ⊗ 𝟙 Z) :=
  by
  rw [← tensor_comp]
  simp
#align category_theory.monoidal_category.comp_tensor_id CategoryTheory.MonoidalCategory.comp_tensor_id

@[reassoc, simp]
theorem id_tensor_comp (f : W ⟶ X) (g : X ⟶ Y) : 𝟙 Z ⊗ f ≫ g = (𝟙 Z ⊗ f) ≫ (𝟙 Z ⊗ g) :=
  by
  rw [← tensor_comp]
  simp
#align category_theory.monoidal_category.id_tensor_comp CategoryTheory.MonoidalCategory.id_tensor_comp

@[reassoc (attr := simp)]
theorem id_tensor_comp_tensor_id (f : W ⟶ X) (g : Y ⟶ Z) : (𝟙 Y ⊗ f) ≫ (g ⊗ 𝟙 X) = g ⊗ f :=
  by
  rw [← tensor_comp]
  simp
#align category_theory.monoidal_category.id_tensor_comp_tensor_id CategoryTheory.MonoidalCategory.id_tensor_comp_tensor_id

@[reassoc (attr := simp)]
theorem tensor_id_comp_id_tensor (f : W ⟶ X) (g : Y ⟶ Z) : (g ⊗ 𝟙 W) ≫ (𝟙 Z ⊗ f) = g ⊗ f :=
  by
  rw [← tensor_comp]
  simp
#align category_theory.monoidal_category.tensor_id_comp_id_tensor CategoryTheory.MonoidalCategory.tensor_id_comp_id_tensor

@[simp]
theorem rightUnitor_conjugation {X Y : C} (f : X ⟶ Y) :
    f ⊗ 𝟙 (𝟙_ C) = (ρ_ X).hom ≫ f ≫ (ρ_ Y).inv := by
  rw [← rightUnitor_naturality_assoc, Iso.hom_inv_id, Category.comp_id]

#align category_theory.monoidal_category.right_unitor_conjugation CategoryTheory.MonoidalCategory.rightUnitor_conjugation

@[simp]
theorem leftUnitor_conjugation {X Y : C} (f : X ⟶ Y) : 𝟙 (𝟙_ C) ⊗ f = (λ_ X).hom ≫ f ≫ (λ_ Y).inv
  := by rw [← leftUnitor_naturality_assoc, Iso.hom_inv_id, Category.comp_id]

#align category_theory.monoidal_category.left_unitor_conjugation CategoryTheory.MonoidalCategory.leftUnitor_conjugation

@[reassoc]
theorem leftUnitor_inv_naturality {X X' : C} (f : X ⟶ X') :
    f ≫ (λ_ X').inv = (λ_ X).inv ≫ (𝟙 _ ⊗ f) := by simp
#align category_theory.monoidal_category.left_unitor_inv_naturality CategoryTheory.MonoidalCategory.leftUnitor_inv_naturality

@[reassoc]
theorem rightUnitor_inv_naturality {X X' : C} (f : X ⟶ X') :
    f ≫ (ρ_ X').inv = (ρ_ X).inv ≫ (f ⊗ 𝟙 _) := by simp
#align category_theory.monoidal_category.right_unitor_inv_naturality CategoryTheory.MonoidalCategory.rightUnitor_inv_naturality

theorem tensor_left_iff {X Y : C} (f g : X ⟶ Y) : 𝟙 (𝟙_ C) ⊗ f = 𝟙 (𝟙_ C) ⊗ g ↔ f = g := by simp
#align category_theory.monoidal_category.tensor_left_iff CategoryTheory.MonoidalCategory.tensor_left_iff

theorem tensor_right_iff {X Y : C} (f g : X ⟶ Y) : f ⊗ 𝟙 (𝟙_ C) = g ⊗ 𝟙 (𝟙_ C) ↔ f = g := by simp
#align category_theory.monoidal_category.tensor_right_iff CategoryTheory.MonoidalCategory.tensor_right_iff

/-! The lemmas in the next section are true by coherence,
but we prove them directly as they are used in proving the coherence theorem. -/

section

@[reassoc]
theorem pentagon_inv (W X Y Z : C) :
    (𝟙 W ⊗ (α_ X Y Z).inv) ≫ (α_ W (X ⊗ Y) Z).inv ≫ ((α_ W X Y).inv ⊗ 𝟙 Z) =
      (α_ W X (Y ⊗ Z)).inv ≫ (α_ (W ⊗ X) Y Z).inv :=
  CategoryTheory.eq_of_inv_eq_inv (by simp [pentagon])
#align category_theory.monoidal_category.pentagon_inv CategoryTheory.MonoidalCategory.pentagon_inv

@[reassoc, simp]
theorem rightUnitor_tensor (X Y : C) :
    (ρ_ (X ⊗ Y)).hom = (α_ X Y (𝟙_ C)).hom ≫ (𝟙 X ⊗ (ρ_ Y).hom) := by
  rw [← tensor_right_iff, comp_tensor_id, ← cancel_mono (α_ X Y (𝟙_ C)).hom, assoc,
    associator_naturality, ← triangle_assoc, ← triangle, id_tensor_comp, pentagon_assoc, ←
    associator_naturality, tensor_id]
#align category_theory.monoidal_category.right_unitor_tensor CategoryTheory.MonoidalCategory.rightUnitor_tensor

@[reassoc, simp]
theorem rightUnitor_tensor_inv (X Y : C) :
    (ρ_ (X ⊗ Y)).inv = (𝟙 X ⊗ (ρ_ Y).inv) ≫ (α_ X Y (𝟙_ C)).inv :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.monoidal_category.right_unitor_tensor_inv CategoryTheory.MonoidalCategory.rightUnitor_tensor_inv

@[reassoc (attr := simp)]
theorem triangle_assoc_comp_right (X Y : C) :
    (α_ X (𝟙_ C) Y).inv ≫ ((ρ_ X).hom ⊗ 𝟙 Y) = 𝟙 X ⊗ (λ_ Y).hom := by
  rw [← triangle, Iso.inv_hom_id_assoc]
#align category_theory.monoidal_category.triangle_assoc_comp_right CategoryTheory.MonoidalCategory.triangle_assoc_comp_right

@[reassoc (attr := simp)]

end

@[reassoc]
theorem associator_inv_naturality {X Y Z X' Y' Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') :
    (f ⊗ g ⊗ h) ≫ (α_ X' Y' Z').inv = (α_ X Y Z).inv ≫ ((f ⊗ g) ⊗ h) :=
  by
  rw [comp_inv_eq, assoc, associator_naturality]
  simp
#align category_theory.monoidal_category.associator_inv_naturality CategoryTheory.MonoidalCategory.associator_inv_naturality

@[reassoc, simp]
theorem associator_conjugation {X X' Y Y' Z Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') :
    (f ⊗ g) ⊗ h = (α_ X Y Z).hom ≫ (f ⊗ g ⊗ h) ≫ (α_ X' Y' Z').inv := by
  rw [associator_inv_naturality, hom_inv_id_assoc]
#align category_theory.monoidal_category.associator_conjugation CategoryTheory.MonoidalCategory.associator_conjugation

@[reassoc]
theorem associator_inv_conjugation {X X' Y Y' Z Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') :
    f ⊗ g ⊗ h = (α_ X Y Z).inv ≫ ((f ⊗ g) ⊗ h) ≫ (α_ X' Y' Z').hom := by
  rw [associator_naturality, inv_hom_id_assoc]
#align category_theory.monoidal_category.associator_inv_conjugation CategoryTheory.MonoidalCategory.associator_inv_conjugation

-- TODO these next two lemmas aren't so fundamental, and perhaps could be removed
-- (replacing their usages by their proofs).
@[reassoc]
theorem id_tensor_associator_naturality {X Y Z Z' : C} (h : Z ⟶ Z') :
    (𝟙 (X ⊗ Y) ⊗ h) ≫ (α_ X Y Z').hom = (α_ X Y Z).hom ≫ (𝟙 X ⊗ 𝟙 Y ⊗ h) := by
  rw [← tensor_id, associator_naturality]
#align category_theory.monoidal_category.id_tensor_associator_naturality CategoryTheory.MonoidalCategory.id_tensor_associator_naturality

@[reassoc]
theorem id_tensor_associator_inv_naturality {X Y Z X' : C} (f : X ⟶ X') :
    (f ⊗ 𝟙 (Y ⊗ Z)) ≫ (α_ X' Y Z).inv = (α_ X Y Z).inv ≫ ((f ⊗ 𝟙 Y) ⊗ 𝟙 Z) := by
  rw [← tensor_id, associator_inv_naturality]
#align category_theory.monoidal_category.id_tensor_associator_inv_naturality CategoryTheory.MonoidalCategory.id_tensor_associator_inv_naturality

@[reassoc (attr := simp)]
theorem hom_inv_id_tensor {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
    (f.hom ⊗ g) ≫ (f.inv ⊗ h) = (𝟙 V ⊗ g) ≫ (𝟙 V ⊗ h) := by
  rw [← tensor_comp, f.hom_inv_id, id_tensor_comp]
#align category_theory.monoidal_category.hom_inv_id_tensor CategoryTheory.MonoidalCategory.hom_inv_id_tensor

@[reassoc (attr := simp)]
theorem inv_hom_id_tensor {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
    (f.inv ⊗ g) ≫ (f.hom ⊗ h) = (𝟙 W ⊗ g) ≫ (𝟙 W ⊗ h) := by
  rw [← tensor_comp, f.inv_hom_id, id_tensor_comp]
#align category_theory.monoidal_category.inv_hom_id_tensor CategoryTheory.MonoidalCategory.inv_hom_id_tensor

@[reassoc (attr := simp)]
theorem tensorHom_inv_id {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
    (g ⊗ f.hom) ≫ (h ⊗ f.inv) = (g ⊗ 𝟙 V) ≫ (h ⊗ 𝟙 V) := by
  rw [← tensor_comp, f.hom_inv_id, comp_tensor_id]
#align category_theory.monoidal_category.tensor_hom_inv_id CategoryTheory.MonoidalCategory.tensorHom_inv_id

@[reassoc (attr := simp)]
theorem tensor_inv_hom_id {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
    (g ⊗ f.inv) ≫ (h ⊗ f.hom) = (g ⊗ 𝟙 W) ≫ (h ⊗ 𝟙 W) := by
  rw [← tensor_comp, f.inv_hom_id, comp_tensor_id]
#align category_theory.monoidal_category.tensor_inv_hom_id CategoryTheory.MonoidalCategory.tensor_inv_hom_id

@[reassoc (attr := simp)]
theorem hom_inv_id_tensor' {V W X Y Z : C} (f : V ⟶ W) [IsIso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
    (f ⊗ g) ≫ (inv f ⊗ h) = (𝟙 V ⊗ g) ≫ (𝟙 V ⊗ h) := by
  rw [← tensor_comp, IsIso.hom_inv_id, id_tensor_comp]
#align category_theory.monoidal_category.hom_inv_id_tensor' CategoryTheory.MonoidalCategory.hom_inv_id_tensor'

@[reassoc (attr := simp)]
theorem inv_hom_id_tensor' {V W X Y Z : C} (f : V ⟶ W) [IsIso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
    (inv f ⊗ g) ≫ (f ⊗ h) = (𝟙 W ⊗ g) ≫ (𝟙 W ⊗ h) := by
  rw [← tensor_comp, IsIso.inv_hom_id, id_tensor_comp]
#align category_theory.monoidal_category.inv_hom_id_tensor' CategoryTheory.MonoidalCategory.inv_hom_id_tensor'

@[reassoc (attr := simp)]
theorem tensorHom_inv_id' {V W X Y Z : C} (f : V ⟶ W) [IsIso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
    (g ⊗ f) ≫ (h ⊗ inv f) = (g ⊗ 𝟙 V) ≫ (h ⊗ 𝟙 V) := by
  rw [← tensor_comp, IsIso.hom_inv_id, comp_tensor_id]
#align category_theory.monoidal_category.tensor_hom_inv_id' CategoryTheory.MonoidalCategory.tensorHom_inv_id'

@[reassoc (attr := simp)]
theorem tensor_inv_hom_id' {V W X Y Z : C} (f : V ⟶ W) [IsIso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
    (g ⊗ inv f) ≫ (h ⊗ f) = (g ⊗ 𝟙 W) ≫ (h ⊗ 𝟙 W) := by
  rw [← tensor_comp, IsIso.inv_hom_id, comp_tensor_id]
#align category_theory.monoidal_category.tensor_inv_hom_id' CategoryTheory.MonoidalCategory.tensor_inv_hom_id'

end

section

variable (C : Type u) [Category.{v} C] [MonoidalCategory.{v} C]

/-- The tensor product expressed as a functor. -/
@[simps]
def tensor : C × C ⥤ C where
  obj X := X.1 ⊗ X.2
  map {X Y : C × C} (f : X ⟶ Y) := f.1 ⊗ f.2
#align category_theory.monoidal_category.tensor CategoryTheory.MonoidalCategory.tensor

/-- The left-associated triple tensor product as a functor. -/
def leftAssocTensor : C × C × C ⥤ C
    where
  obj X := (X.1 ⊗ X.2.1) ⊗ X.2.2
  map {X Y : C × C × C} (f : X ⟶ Y) := (f.1 ⊗ f.2.1) ⊗ f.2.2
#align category_theory.monoidal_category.left_assoc_tensor CategoryTheory.MonoidalCategory.leftAssocTensor

@[simp]
theorem leftAssocTensor_obj (X) : (leftAssocTensor C).obj X = (X.1 ⊗ X.2.1) ⊗ X.2.2 :=
  rfl
#align category_theory.monoidal_category.left_assoc_tensor_obj CategoryTheory.MonoidalCategory.leftAssocTensor_obj

@[simp]
theorem leftAssocTensor_map {X Y} (f : X ⟶ Y) : (leftAssocTensor C).map f = (f.1 ⊗ f.2.1) ⊗ f.2.2 :=
  rfl
#align category_theory.monoidal_category.left_assoc_tensor_map CategoryTheory.MonoidalCategory.leftAssocTensor_map

/-- The right-associated triple tensor product as a functor. -/
def rightAssocTensor : C × C × C ⥤ C
    where
  obj X := X.1 ⊗ X.2.1 ⊗ X.2.2
  map {X Y : C × C × C} (f : X ⟶ Y) := f.1 ⊗ f.2.1 ⊗ f.2.2
#align category_theory.monoidal_category.right_assoc_tensor CategoryTheory.MonoidalCategory.rightAssocTensor

@[simp]
theorem rightAssocTensor_obj (X) : (rightAssocTensor C).obj X = X.1 ⊗ X.2.1 ⊗ X.2.2 :=
  rfl
#align category_theory.monoidal_category.right_assoc_tensor_obj CategoryTheory.MonoidalCategory.rightAssocTensor_obj

@[simp]
theorem rightAssocTensor_map {X Y} (f : X ⟶ Y) : (rightAssocTensor C).map f = f.1 ⊗ f.2.1 ⊗ f.2.2 :=
  rfl
#align category_theory.monoidal_category.right_assoc_tensor_map CategoryTheory.MonoidalCategory.rightAssocTensor_map

/-- The functor `λ X, 𝟙_ C ⊗ X`. -/
def tensorUnitLeft : C ⥤ C where
  obj X := 𝟙_ C ⊗ X
  map {X Y : C} (f : X ⟶ Y) := 𝟙 (𝟙_ C) ⊗ f
#align category_theory.monoidal_category.tensor_unit_left CategoryTheory.MonoidalCategory.tensorUnitLeft

/-- The functor `λ X, X ⊗ 𝟙_ C`. -/
def tensorUnitRight : C ⥤ C where
  obj X := X ⊗ 𝟙_ C
  map {X Y : C} (f : X ⟶ Y) := f ⊗ 𝟙 (𝟙_ C)
#align category_theory.monoidal_category.tensor_unit_right CategoryTheory.MonoidalCategory.tensorUnitRight

-- We can express the associator and the unitors, given componentwise above,
-- as natural isomorphisms.
-- Porting Note: Had to add a `simps!` because Lean was complaining this wasn't a constructor app.
/-- The associator as a natural isomorphism. -/
@[simps!]
def associatorNatIso : leftAssocTensor C ≅ rightAssocTensor C :=
  NatIso.ofComponents
    (by
      intros
      apply MonoidalCategory.associator)
    (by
      intros
      apply MonoidalCategory.associator_naturality)
#align category_theory.monoidal_category.associator_nat_iso CategoryTheory.MonoidalCategory.associatorNatIso

-- Porting Note: same as above
/-- The left unitor as a natural isomorphism. -/
@[simps!]
def leftUnitorNatIso : tensorUnitLeft C ≅ 𝟭 C :=
  NatIso.ofComponents
    (by
      intros
      apply MonoidalCategory.leftUnitor)
    (by
      intros
      apply MonoidalCategory.leftUnitor_naturality)
#align category_theory.monoidal_category.left_unitor_nat_iso CategoryTheory.MonoidalCategory.leftUnitorNatIso

-- Porting Note: same as above
/-- The right unitor as a natural isomorphism. -/
@[simps!]
def rightUnitorNatIso : tensorUnitRight C ≅ 𝟭 C :=
  NatIso.ofComponents
    (by
      intros
      apply MonoidalCategory.rightUnitor)
    (by
      intros
      apply MonoidalCategory.rightUnitor_naturality)
#align category_theory.monoidal_category.right_unitor_nat_iso CategoryTheory.MonoidalCategory.rightUnitorNatIso

section

-- Porting Note: This used to be `variable {C}` but it seems like Lean 4 parses that differently
variable {C : Type u} [Category.{v} C] [MonoidalCategory.{v} C]

/-- Tensoring on the left with a fixed object, as a functor. -/
@[simps]
def tensorLeft (X : C) : C ⥤ C where
  obj Y := X ⊗ Y
  map {Y} {Y'} f := 𝟙 X ⊗ f
#align category_theory.monoidal_category.tensor_left CategoryTheory.MonoidalCategory.tensorLeft

/-- Tensoring on the left with `X ⊗ Y` is naturally isomorphic to
tensoring on the left with `Y`, and then again with `X`.
-/
def tensorLeftTensor (X Y : C) : tensorLeft (X ⊗ Y) ≅ tensorLeft Y ⋙ tensorLeft X :=
  NatIso.ofComponents (associator _ _) fun {Z} {Z'} f =>
    by
    dsimp
    rw [← tensor_id]
    apply associator_naturality
#align category_theory.monoidal_category.tensor_left_tensor CategoryTheory.MonoidalCategory.tensorLeftTensor

@[simp]
theorem tensorLeftTensor_hom_app (X Y Z : C) :
    (tensorLeftTensor X Y).hom.app Z = (associator X Y Z).hom :=
  rfl
#align category_theory.monoidal_category.tensor_left_tensor_hom_app CategoryTheory.MonoidalCategory.tensorLeftTensor_hom_app

@[simp]
theorem tensorLeftTensor_inv_app (X Y Z : C) :
    (tensorLeftTensor X Y).inv.app Z = (associator X Y Z).inv := by simp [tensorLeftTensor]
#align category_theory.monoidal_category.tensor_left_tensor_inv_app CategoryTheory.MonoidalCategory.tensorLeftTensor_inv_app

/-- Tensoring on the right with a fixed object, as a functor. -/
@[simps]
def tensorRight (X : C) : C ⥤ C where
  obj Y := Y ⊗ X
  map {Y} {Y'} f := f ⊗ 𝟙 X
#align category_theory.monoidal_category.tensor_right CategoryTheory.MonoidalCategory.tensorRight

-- Porting Note: This used to be `variable (C)` but it seems like Lean 4 parses that differently
variable (C : Type u) [Category.{v} C] [MonoidalCategory.{v} C]

/-- Tensoring on the left, as a functor from `C` into endofunctors of `C`.

TODO: show this is a op-monoidal functor.
-/
@[simps]
def tensoringLeft : C ⥤ C ⥤ C where
  obj := tensorLeft
  map {X} {Y} f := { app := fun Z => f ⊗ 𝟙 Z }
#align category_theory.monoidal_category.tensoring_left CategoryTheory.MonoidalCategory.tensoringLeft

instance : Faithful (tensoringLeft C) where
  map_injective {X} {Y} f g h := by
    injections h
    replace h := congr_fun h (𝟙_ C)
    simpa using h

/-- Tensoring on the right, as a functor from `C` into endofunctors of `C`.

We later show this is a monoidal functor.
-/
@[simps]
def tensoringRight : C ⥤ C ⥤ C where
  obj := tensorRight
  map {X} {Y} f := { app := fun Z => 𝟙 Z ⊗ f }
#align category_theory.monoidal_category.tensoring_right CategoryTheory.MonoidalCategory.tensoringRight

instance : Faithful (tensoringRight C) where
  map_injective {X} {Y} f g h := by
    injections h
    replace h := congr_fun h (𝟙_ C)
    simpa using h

-- Porting Note: This used to be `variable {C}` but it seems like Lean 4 parses that differently
variable {C : Type u} [Category.{v} C] [MonoidalCategory.{v} C]

/-- Tensoring on the right with `X ⊗ Y` is naturally isomorphic to
tensoring on the right with `X`, and then again with `Y`.
-/
def tensorRightTensor (X Y : C) : tensorRight (X ⊗ Y) ≅ tensorRight X ⋙ tensorRight Y :=
  NatIso.ofComponents (fun Z => (associator Z X Y).symm) fun {Z} {Z'} f =>
    by
    dsimp
    rw [← tensor_id]
    apply associator_inv_naturality
#align category_theory.monoidal_category.tensor_right_tensor CategoryTheory.MonoidalCategory.tensorRightTensor

@[simp]
theorem tensorRightTensor_hom_app (X Y Z : C) :
    (tensorRightTensor X Y).hom.app Z = (associator Z X Y).inv :=
  rfl
#align category_theory.monoidal_category.tensor_right_tensor_hom_app CategoryTheory.MonoidalCategory.tensorRightTensor_hom_app

@[simp]
theorem tensorRightTensor_inv_app (X Y Z : C) :
    (tensorRightTensor X Y).inv.app Z = (associator Z X Y).hom := by simp [tensorRightTensor]
#align category_theory.monoidal_category.tensor_right_tensor_inv_app CategoryTheory.MonoidalCategory.tensorRightTensor_inv_app

end

end

section

universe v₁ v₂ u₁ u₂

variable (C₁ : Type u₁) [Category.{v₁} C₁] [MonoidalCategory.{v₁} C₁]

variable (C₂ : Type u₂) [Category.{v₂} C₂] [MonoidalCategory.{v₂} C₂]

attribute [local simp] associator_naturality leftUnitor_naturality rightUnitor_naturality pentagon

@[simps! tensorObj tensorHom tensorUnit' associator]
instance prodMonoidal : MonoidalCategory (C₁ × C₂) where
  tensorObj X Y := (X.1 ⊗ Y.1, X.2 ⊗ Y.2)
  tensorHom f g := (f.1 ⊗ g.1, f.2 ⊗ g.2)
  tensorUnit' := (𝟙_ C₁, 𝟙_ C₂)
  associator X Y Z := (α_ X.1 Y.1 Z.1).prod (α_ X.2 Y.2 Z.2)
  leftUnitor := fun ⟨X₁, X₂⟩ => (λ_ X₁).prod (λ_ X₂)
  rightUnitor := fun ⟨X₁, X₂⟩ => (ρ_ X₁).prod (ρ_ X₂)
#align category_theory.monoidal_category.prod_monoidal CategoryTheory.MonoidalCategory.prodMonoidal

@[simp]
theorem prodMonoidal_leftUnitor_hom_fst (X : C₁ × C₂) :
    ((λ_ X).hom : 𝟙_ _ ⊗ X ⟶ X).1 = (λ_ X.1).hom :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_left_unitor_hom_fst CategoryTheory.MonoidalCategory.prodMonoidal_leftUnitor_hom_fst

@[simp]
theorem prodMonoidal_leftUnitor_hom_snd (X : C₁ × C₂) :
    ((λ_ X).hom : 𝟙_ _ ⊗ X ⟶ X).2 = (λ_ X.2).hom :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_left_unitor_hom_snd CategoryTheory.MonoidalCategory.prodMonoidal_leftUnitor_hom_snd

@[simp]
theorem prodMonoidal_leftUnitor_inv_fst (X : C₁ × C₂) :
    ((λ_ X).inv : X ⟶ 𝟙_ _ ⊗ X).1 = (λ_ X.1).inv :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_left_unitor_inv_fst CategoryTheory.MonoidalCategory.prodMonoidal_leftUnitor_inv_fst

@[simp]
theorem prodMonoidal_leftUnitor_inv_snd (X : C₁ × C₂) :
    ((λ_ X).inv : X ⟶ 𝟙_ _ ⊗ X).2 = (λ_ X.2).inv :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_left_unitor_inv_snd CategoryTheory.MonoidalCategory.prodMonoidal_leftUnitor_inv_snd

@[simp]
theorem prodMonoidal_rightUnitor_hom_fst (X : C₁ × C₂) :
    ((ρ_ X).hom : X ⊗ 𝟙_ _ ⟶ X).1 = (ρ_ X.1).hom :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_right_unitor_hom_fst CategoryTheory.MonoidalCategory.prodMonoidal_rightUnitor_hom_fst

@[simp]
theorem prodMonoidal_rightUnitor_hom_snd (X : C₁ × C₂) :
    ((ρ_ X).hom : X ⊗ 𝟙_ _ ⟶ X).2 = (ρ_ X.2).hom :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_right_unitor_hom_snd CategoryTheory.MonoidalCategory.prodMonoidal_rightUnitor_hom_snd

@[simp]
theorem prodMonoidal_rightUnitor_inv_fst (X : C₁ × C₂) :
    ((ρ_ X).inv : X ⟶ X ⊗ 𝟙_ _).1 = (ρ_ X.1).inv :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_right_unitor_inv_fst CategoryTheory.MonoidalCategory.prodMonoidal_rightUnitor_inv_fst

@[simp]
theorem prodMonoidal_rightUnitor_inv_snd (X : C₁ × C₂) :
    ((ρ_ X).inv : X ⟶ X ⊗ 𝟙_ _).2 = (ρ_ X.2).inv :=
  by
  cases X
  rfl
#align category_theory.monoidal_category.prod_monoidal_right_unitor_inv_snd CategoryTheory.MonoidalCategory.prodMonoidal_rightUnitor_inv_snd

end

end MonoidalCategory

end CategoryTheory


import tactic

variables (x y z : ℕ)

open nat

theorem Q2a : 1 * x = x ∧ x = x * 1 :=
begin
  sorry
end

theorem Q2b : (x + y) * z = x * z + y * z :=
begin
  sorry,
end

theorem Q2c : (x * y) * z = x * (y * z) :=
begin
  sorry
end


import .group_representation
import .morphism
universe variables u v w
variables {G : Type u} {R : Type v} {M : Type w} [group G] [ring R] [add_comm_group M] [module R M]

namespace stability

variables {p : submodule R M}
/--
  Technical lemma to deal with `submodule p` of `M`.
-/

lemma submodule_ext (x y : p) : (x : M) = (y : M)  → x = y :=
begin
  intros,rcases x,rcases y,congr, try {assumption},
end
/--
  Let `ρ : G →* M ≃ₗ[R] M` a representation. A submodule `p` of `M` is `ρ-stable` when :
      `∀ g ∈ G, ∀ x ∈ p, ρ g x ∈ p`. It induce a `sub-representation`  : ` Res ρ  p : G →* p ≃ₗ[R] p `
-/
class stable_submodule (ρ : group_representation G R M)(p : submodule R M) :=
                   (stability :  ∀ g : G, ∀  x : M, x ∈ p →   ρ g x ∈ p)

/--
    `Trivial submodule` : `⊥` and `⊤`
-/
def is_trivial (p : submodule R M) := (p = ⊤ ∨  p = ⊥)
/--
    `Irreducible ρ` : only `⊥` and `⊤` for ` ρ-stable submodule`
-/
class Irreductible ( ρ : group_representation G R M)  :=
 (certif: ∀ (p : submodule R M)[stable_submodule ρ p], is_trivial p)

def Trivial (ρ : group_representation G R M)(p : submodule R M) [Irreductible ρ] [stable_submodule ρ p]:=
                Irreductible.certif ρ  p

variables (ρ : group_representation G R M)

lemma stab [stable_submodule ρ p](g : G) {x : M} :  (x ∈ p )  →   (ρ g x ∈ p) :=
stable_submodule.stability g x

lemma map' (g : G) [stable_submodule ρ p] : submodule.map (ρ g) p ≤  p := begin
    rw submodule.le_def', intros x hyp, rw submodule.mem_map at hyp, rcases hyp with ⟨y,hyp_y ⟩,
    rw ←  hyp_y.2,
    apply (stab ρ g), exact hyp_y.1, assumption,
end

lemma map (g : G) [stable_submodule ρ p] : submodule.map (ρ g) p = p :=
begin
  apply le_antisymm, apply map',
  rw submodule.le_def', intros x hyp_x, rw submodule.mem_map, use (ρ g⁻¹ ) x,  split,
  apply stab ρ g⁻¹, exact hyp_x, assumption, change (ρ g ⊚ ρ g⁻¹ ) x = _,
  rw ← map_comp, rw mul_inv_self, rw ρ.map_one, exact rfl,
end

/--
  Restriction map : `res ρ : G → (p → p)`.
-/
def res  [stable_submodule ρ p] :  G → p → p  :=  λ g x, {
  val      := ρ g x,
  property := stab ρ g x.property
  }

variables [stable_submodule ρ p]

lemma res_add (g : G) (x y : p) : res ρ g (x+y) = res ρ g x + res ρ  g y :=
begin
    apply submodule_ext, change ρ _ _ = _,
    erw (ρ g).map_add,
    exact rfl,
end

lemma res_smul (g : G) (r : R) ( x : p) : res ρ  g ( r • x) = r • res ρ g x :=
begin
    apply submodule_ext, change ρ _ _ = _,
    erw (ρ g).map_smul,
    exact rfl,
end
/--
   `res` is linear map.
-/
def res_linear [stable_submodule ρ p] (g : G) : p →ₗ[R]p := {
  to_fun := res ρ  g,
  add    := res_add ρ  g,
  smul   := res_smul ρ  g }
/--
  ` ∀ g :G, res ρ g` has an inverse given by ` res ρ g⁻¹`.
-/

lemma res_mul (g1 g2 : G) : (res ρ (g1 * g2) : p → p) = res  ρ  g1 ∘ (res ρ  g2) :=
 begin
    ext, apply submodule_ext, change ρ (g1 * g2) x = _,
    erw ρ.map_mul, exact rfl,
end
lemma res_one  : (res ρ 1 : p → p) = id :=
begin
  ext,apply submodule_ext, change ρ 1 x = _,
  erw ρ.map_one, exact rfl,
end

/--
   the restriction representation `G →* p ≃ₗ[R]p`
-/
def Res  : group_representation G R p := {
  to_fun   := res_linear ρ ,
  map_one' := begin  ext,apply submodule_ext, change (ρ 1) x = _,  rw ρ.map_one,  exact rfl, end,
  map_mul' :=
   begin
    intros g1 g2,
    ext, apply submodule_ext,
    change  (ρ (g1 *  g2))  x = _ ,  rw  ρ.map_mul,
    exact rfl,
  end
}
def res.subtype  : Res ρ  ⟶ᵣ ρ  := {
  ℓ       := submodule.subtype p,
  commute := by {intros g, exact rfl}
}
end stability


inductive EQ {α : Type} (a : α) : α → Type where
  | refl : EQ a a

def EQ.trans (h₁ : EQ a b) (h₂ : EQ b c) : EQ a c := by
  cases h₁; cases h₂; constructor

instance : Trans (@EQ α) (@EQ α) (@EQ α) where
  trans := EQ.trans

infix:50 " ≋ " => EQ

example (h₁ : EQ a b) (h₂ : b = c) (h₃ : EQ c d) : EQ a d := by
  calc a ≋ b := h₁
       _ = c := h₂
       _ ≋ d := h₃


import data.fintype.basic
import tactic
import finset

-- TODO:
-- matroid constructions: subtype, contraction, direct sum, map
-- dual matroid, matroid isomorphism
-- base theorem, base construction
-- circuit theorem, circuit construction
-- rank theorem, rank construction
-- closure theorem, closure construction
-- examples

structure matroid (α : Type*) [fintype α] [decidable_eq α] :=
  (ind : set (finset α))
  [ind_dec : decidable_pred ind]
  (ind_empty : ind ∅)
  (ind_subset : ∀ (A B), A ⊆ B → ind B → ind A)
  (ind_exchange : ∀ (A B : finset α), ind A → ind B → A.card < B.card →
    (∃ (c ∈ B), (c ∉ A) ∧ ind (insert c A)))

variables {α : Type*} [fintype α] [decidable_eq α] {m : matroid α} {A B X : finset α}

open finset

namespace matroid

@[simp] lemma ind_empty_def : m.ind ∅ := m.ind_empty

@[simp] lemma ind_subset_def : A ⊆ B → m.ind B → m.ind A := m.ind_subset _ _

@[simp] lemma dep_superset {A B} : A ⊆ B → ¬m.ind A → ¬m.ind B := λ h hA hB, hA (m.ind_subset _ _ h hB)

def base (m : matroid α) (A : finset α) := m.ind A ∧ ∀ x ∉ A, ¬m.ind (insert x A)

def base_of (m : matroid α) (A B : finset α) := B ⊆ A ∧ m.ind B ∧ ∀ (x ∉ B), (x ∈ A) → ¬m.ind (insert x B)

@[simp] lemma base_ind : m.base A → m.ind A := λ h, h.1

@[simp] lemma base_of_ind : m.base_of X A → m.ind A := λ h, h.2.1

@[simp] lemma base_of_subset : m.base_of X A → A ⊆ X := λ h, h.1

@[simp] lemma base_of_univ_iff_base {A : finset α} : m.base_of univ A ↔ m.base A :=
  ⟨λ ⟨_, h_ind, h_ins⟩, ⟨h_ind, λ x hx, h_ins x hx (mem_univ x)⟩, λ ⟨h_ind, h_ins⟩, ⟨subset_univ A, h_ind, λ x hx _, h_ins x hx⟩⟩

def circuit (m : matroid α) (A : finset α) := ¬ m.ind A ∧ ∀ x ∈ A, m.ind (A.erase x)

@[simp] lemma circuit_dep : m.circuit A → ¬ m.ind A := λ x, x.1

end matroid


def there_is_no_largest_nat := ¬ ∃ (n : nat), ∀ (k : nat), n > k

inductive friend : Type
| harsh : friend
| joe : friend
| will : friend
| sullivan : friend

inductive taller : friend → friend → Prop
| trans : ∀ (a b c : friend), (taller a b) → (taller b c) → taller a c

open friend
def joe_taller_harsh := taller joe harsh
def harsh_taller_kevin := taller harsh sullivan
def joe_taller_kevin := taller joe sullivan

axiom tallest : ∀ (f : friend), taller will f

def mtransitive {α : Type} (r : α → α → Prop) : (Prop) := ∀ (a b c : α), r a b → r b c → r a c

example : taller joe harsh → taller harsh sullivan → taller joe sullivan :=
begin
    apply taller.trans,
end

def myreverse {α : Type} : list α → list α
| list.nil := []
| (list.cons a t) := list.append (myreverse t) [a]

#eval myreverse [1,2,3]


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.monad
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4

namespace Mathlib

/-!
## Expand multivariate polynomials

Given a multivariate polynomial `φ`, one may replace every occurence of `X i` by `X i ^ n`,
for some natural number `n`.
This operation is called `mv_polynomial.expand` and it is an algebra homomorphism.

### Main declaration

* `mv_polynomial.expand`: expand a polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`.
-/

namespace mv_polynomial

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`.

See also `polynomial.expand`. -/
def expand {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) : alg_hom R (mv_polynomial σ R) (mv_polynomial σ R) :=
  alg_hom.mk (ring_hom.to_fun (eval₂_hom C fun (i : σ) => X i ^ p)) sorry sorry sorry sorry sorry

@[simp] theorem expand_C {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) (r : R) : coe_fn (expand p) (coe_fn C r) = coe_fn C r :=
  eval₂_hom_C C (fun (n : σ) => (fun (i : σ) => X i ^ p) n) r

@[simp] theorem expand_X {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) (i : σ) : coe_fn (expand p) (X i) = X i ^ p :=
  eval₂_hom_X' C (fun (n : σ) => (fun (i : σ) => X i ^ p) n) i

@[simp] theorem expand_monomial {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) (d : σ →₀ ℕ) (r : R) : coe_fn (expand p) (monomial d r) = coe_fn C r * finset.prod (finsupp.support d) fun (i : σ) => (X i ^ p) ^ coe_fn d i :=
  bind₁_monomial (fun (i : σ) => X i ^ p) d r

theorem expand_one_apply {σ : Type u_1} {R : Type u_3} [comm_semiring R] (f : mv_polynomial σ R) : coe_fn (expand 1) f = f := sorry

@[simp] theorem expand_one {σ : Type u_1} {R : Type u_3} [comm_semiring R] : expand 1 = alg_hom.id R (mv_polynomial σ R) := sorry

theorem expand_comp_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] (p : ℕ) (f : σ → mv_polynomial τ R) : alg_hom.comp (expand p) (bind₁ f) = bind₁ fun (i : σ) => coe_fn (expand p) (f i) := sorry

theorem expand_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] (p : ℕ) (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) : coe_fn (expand p) (coe_fn (bind₁ f) φ) = coe_fn (bind₁ fun (i : σ) => coe_fn (expand p) (f i)) φ := sorry

@[simp] theorem map_expand {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R] [comm_semiring S] (f : R →+* S) (p : ℕ) (φ : mv_polynomial σ R) : coe_fn (map f) (coe_fn (expand p) φ) = coe_fn (expand p) (coe_fn (map f) φ) := sorry

@[simp] theorem rename_expand {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] (f : σ → τ) (p : ℕ) (φ : mv_polynomial σ R) : coe_fn (rename f) (coe_fn (expand p) φ) = coe_fn (expand p) (coe_fn (rename f) φ) := sorry

@[simp] theorem rename_comp_expand {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] (f : σ → τ) (p : ℕ) : alg_hom.comp (rename f) (expand p) = alg_hom.comp (expand p) (rename f) := sorry


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.prod
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Product measures

In this file we define and prove properties about finite products of measures
(and at some point, countable products of measures).

## Main definition

* `measure_theory.measure.pi`: The product of finitely many σ-finite measures.
  Given `μ : Π i : ι, measure (α i)` for `[fintype ι]` it has type `measure (Π i : ι, α i)`.

## Implementation Notes

We define `measure_theory.outer_measure.pi`, the product of finitely many outer measures, as the
maximal outer measure `n` with the property that `n (pi univ s) ≤ ∏ i, m i (s i)`,
where `pi univ s` is the product of the sets `{ s i | i : ι }`.

We then show that this induces a product of measures, called `measure_theory.measure.pi`.
For a collection of σ-finite measures `μ` and a collection of measurable sets `s` we show that
`measure.pi μ (pi univ s) = ∏ i, m i (s i)`. To do this, we follow the following steps:
* We know that there is some ordering on `ι`, given by an element of `[encodable ι]`.
* Using this, we have an equivalence `measurable_equiv.pi_measurable_equiv_tprod` between
  `Π ι, α i` and an iterated product of `α i`, called `list.tprod α l` for some list `l`.
* On this iterated product we can easily define a product measure `measure_theory.measure.tprod`
  by iterating `measure_theory.measure.prod`
* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for encodable
  `ι`.
* We know that `measure_theory.measure.pi'` sends products of sets to products of measures, and
  since `measure_theory.measure.pi` is the maximal such measure (or at least, it comes from an outer
  measure which is the maximal such outer measure), we get the same rule for
  `measure_theory.measure.pi`.

## Tags

finitary product measure

-/

namespace measure_theory

/-- An upper bound for the measure in a finite product space.
  It is defined to by taking the image of the set under all projections, and taking the product
  of the measures of these images.
  For measurable boxes it is equal to the correct measure. -/
@[simp] def pi_premeasure {ι : Type u_1} [fintype ι] {α : ι → Type u_2} (m : (i : ι) → outer_measure (α i)) (s : set ((i : ι) → α i)) : ennreal :=
  finset.prod finset.univ fun (i : ι) => coe_fn (m i) (function.eval i '' s)

theorem pi_premeasure_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} {m : (i : ι) → outer_measure (α i)} {s : (i : ι) → set (α i)} (hs : set.nonempty (set.pi set.univ s)) : pi_premeasure m (set.pi set.univ s) = finset.prod finset.univ fun (i : ι) => coe_fn (m i) (s i) := sorry

theorem pi_premeasure_pi' {ι : Type u_1} [fintype ι] {α : ι → Type u_2} {m : (i : ι) → outer_measure (α i)} [Nonempty ι] {s : (i : ι) → set (α i)} : pi_premeasure m (set.pi set.univ s) = finset.prod finset.univ fun (i : ι) => coe_fn (m i) (s i) := sorry

theorem pi_premeasure_pi_mono {ι : Type u_1} [fintype ι] {α : ι → Type u_2} {m : (i : ι) → outer_measure (α i)} {s : set ((i : ι) → α i)} {t : set ((i : ι) → α i)} (h : s ⊆ t) : pi_premeasure m s ≤ pi_premeasure m t :=
  finset.prod_le_prod'
    fun (i : ι) (_x : i ∈ finset.univ) => outer_measure.mono' (m i) (set.image_subset (function.eval i) h)

theorem pi_premeasure_pi_eval {ι : Type u_1} [fintype ι] {α : ι → Type u_2} {m : (i : ι) → outer_measure (α i)} [Nonempty ι] {s : set ((i : ι) → α i)} : pi_premeasure m (set.pi set.univ fun (i : ι) => function.eval i '' s) = pi_premeasure m s := sorry

namespace outer_measure

/-- `outer_measure.pi m` is the finite product of the outer measures `{m i | i : ι}`.
  It is defined to be the maximal outer measure `n` with the property that
  `n (pi univ s) ≤ ∏ i, m i (s i)`, where `pi univ s` is the product of the sets
  `{ s i | i : ι }`. -/
protected def pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} (m : (i : ι) → outer_measure (α i)) : outer_measure ((i : ι) → α i) :=
  bounded_by (pi_premeasure m)

theorem pi_pi_le {ι : Type u_1} [fintype ι] {α : ι → Type u_2} (m : (i : ι) → outer_measure (α i)) (s : (i : ι) → set (α i)) : coe_fn (outer_measure.pi m) (set.pi set.univ s) ≤ finset.prod finset.univ fun (i : ι) => coe_fn (m i) (s i) := sorry

theorem le_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} {m : (i : ι) → outer_measure (α i)} {n : outer_measure ((i : ι) → α i)} : n ≤ outer_measure.pi m ↔
  ∀ (s : (i : ι) → set (α i)),
    set.nonempty (set.pi set.univ s) →
      coe_fn n (set.pi set.univ s) ≤ finset.prod finset.univ fun (i : ι) => coe_fn (m i) (s i) := sorry

end outer_measure

namespace measure

/-- A product of measures in `tprod α l`. -/
-- for some reason the equation compiler doesn't like this definition

protected def tprod {δ : Type u_3} {π : δ → Type u_4} [(x : δ) → measurable_space (π x)] (l : List δ) (μ : (i : δ) → measure (π i)) : measure (list.tprod π l) :=
  List.rec (dirac PUnit.unit) (fun (i : δ) (l : List δ) (ih : measure (list.tprod π l)) => measure.prod (μ i) ih) l

@[simp] theorem tprod_nil {δ : Type u_3} {π : δ → Type u_4} [(x : δ) → measurable_space (π x)] (μ : (i : δ) → measure (π i)) : measure.tprod [] μ = dirac PUnit.unit :=
  rfl

@[simp] theorem tprod_cons {δ : Type u_3} {π : δ → Type u_4} [(x : δ) → measurable_space (π x)] (i : δ) (l : List δ) (μ : (i : δ) → measure (π i)) : measure.tprod (i :: l) μ = measure.prod (μ i) (measure.tprod l μ) :=
  rfl

protected instance sigma_finite_tprod {δ : Type u_3} {π : δ → Type u_4} [(x : δ) → measurable_space (π x)] (l : List δ) (μ : (i : δ) → measure (π i)) [∀ (i : δ), sigma_finite (μ i)] : sigma_finite (measure.tprod l μ) :=
  List.rec
    (eq.mpr (id (Eq._oldrec (Eq.refl (sigma_finite (measure.tprod [] μ))) (tprod_nil μ)))
      (finite_measure.to_sigma_finite (dirac PUnit.unit)))
    (fun (i : δ) (l : List δ) (ih : sigma_finite (measure.tprod l μ)) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (sigma_finite (measure.tprod (i :: l) μ))) (tprod_cons i l μ))) prod.sigma_finite)
    l

theorem tprod_tprod {δ : Type u_3} {π : δ → Type u_4} [(x : δ) → measurable_space (π x)] (l : List δ) (μ : (i : δ) → measure (π i)) [∀ (i : δ), sigma_finite (μ i)] {s : (i : δ) → set (π i)} (hs : ∀ (i : δ), is_measurable (s i)) : coe_fn (measure.tprod l μ) (set.tprod l s) = list.prod (list.map (fun (i : δ) => coe_fn (μ i) (s i)) l) := sorry

theorem tprod_tprod_le {δ : Type u_3} {π : δ → Type u_4} [(x : δ) → measurable_space (π x)] (l : List δ) (μ : (i : δ) → measure (π i)) [∀ (i : δ), sigma_finite (μ i)] (s : (i : δ) → set (π i)) : coe_fn (measure.tprod l μ) (set.tprod l s) ≤ list.prod (list.map (fun (i : δ) => coe_fn (μ i) (s i)) l) := sorry

/-- The product measure on an encodable finite type, defined by mapping `measure.tprod` along the
  equivalence `measurable_equiv.pi_measurable_equiv_tprod`.
  The definition `measure_theory.measure.pi` should be used instead of this one. -/
def pi' {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [encodable ι] : measure ((i : ι) → α i) :=
  coe_fn (map (list.tprod.elim' encodable.mem_sorted_univ)) (measure.tprod (encodable.sorted_univ ι) μ)

theorem pi'_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [encodable ι] [∀ (i : ι), sigma_finite (μ i)] {s : (i : ι) → set (α i)} (hs : ∀ (i : ι), is_measurable (s i)) : coe_fn (pi' μ) (set.pi set.univ s) = finset.prod finset.univ fun (i : ι) => coe_fn (μ i) (s i) := sorry

theorem pi'_pi_le {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [encodable ι] [∀ (i : ι), sigma_finite (μ i)] {s : (i : ι) → set (α i)} : coe_fn (pi' μ) (set.pi set.univ s) ≤ finset.prod finset.univ fun (i : ι) => coe_fn (μ i) (s i) := sorry

theorem pi_caratheodory {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) : measurable_space.pi ≤ outer_measure.caratheodory (outer_measure.pi fun (i : ι) => to_outer_measure (μ i)) := sorry

/-- `measure.pi μ` is the finite product of the measures `{μ i | i : ι}`.
  It is defined to be measure corresponding to `measure_theory.outer_measure.pi`. -/
protected def pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) : measure ((i : ι) → α i) :=
  outer_measure.to_measure (outer_measure.pi fun (i : ι) => to_outer_measure (μ i)) sorry

theorem pi_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [∀ (i : ι), sigma_finite (μ i)] (s : (i : ι) → set (α i)) (hs : ∀ (i : ι), is_measurable (s i)) : coe_fn (measure.pi μ) (set.pi set.univ s) = finset.prod finset.univ fun (i : ι) => coe_fn (μ i) (s i) := sorry

theorem pi_eval_preimage_null {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [∀ (i : ι), sigma_finite (μ i)] {i : ι} {s : set (α i)} (hs : coe_fn (μ i) s = 0) : coe_fn (measure.pi μ) (function.eval i ⁻¹' s) = 0 := sorry

theorem pi_hyperplane {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [∀ (i : ι), sigma_finite (μ i)] (i : ι) [has_no_atoms (μ i)] (x : α i) : coe_fn (measure.pi μ) (set_of fun (f : (i : ι) → α i) => f i = x) = 0 :=
  (fun (this : coe_fn (measure.pi μ) (function.eval i ⁻¹' singleton x) = 0) => this)
    (pi_eval_preimage_null μ (measure_singleton x))

theorem ae_eval_ne {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] (μ : (i : ι) → measure (α i)) [∀ (i : ι), sigma_finite (μ i)] (i : ι) [has_no_atoms (μ i)] (x : α i) : filter.eventually (fun (y : (i : ι) → α i) => y i ≠ x) (ae (measure.pi μ)) :=
  iff.mpr compl_mem_ae_iff (pi_hyperplane μ i x)

theorem tendsto_eval_ae_ae {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] {i : ι} : filter.tendsto (function.eval i) (ae (measure.pi μ)) (ae (μ i)) :=
  fun (s : set (α i)) (hs : s ∈ ae (μ i)) => pi_eval_preimage_null μ hs

-- TODO: should we introduce `filter.pi` and prove some basic facts about it?

-- The same combinator appears here and in `nhds_pi`

theorem ae_pi_le_infi_comap {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] : ae (measure.pi μ) ≤ infi fun (i : ι) => filter.comap (function.eval i) (ae (μ i)) :=
  le_infi fun (i : ι) => filter.tendsto.le_comap tendsto_eval_ae_ae

theorem ae_eq_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] {β : ι → Type u_3} {f : (i : ι) → α i → β i} {f' : (i : ι) → α i → β i} (h : ∀ (i : ι), filter.eventually_eq (ae (μ i)) (f i) (f' i)) : filter.eventually_eq (ae (measure.pi μ)) (fun (x : (i : ι) → α i) (i : ι) => f i (x i))
  fun (x : (i : ι) → α i) (i : ι) => f' i (x i) :=
  filter.eventually.mono (iff.mpr filter.eventually_all fun (i : ι) => filter.tendsto.eventually tendsto_eval_ae_ae (h i))
    fun (x : (x : ι) → α x) (hx : ∀ (i : ι), f i (function.eval i x) = f' i (function.eval i x)) => funext hx

theorem ae_le_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] {β : ι → Type u_3} [(i : ι) → preorder (β i)] {f : (i : ι) → α i → β i} {f' : (i : ι) → α i → β i} (h : ∀ (i : ι), filter.eventually_le (ae (μ i)) (f i) (f' i)) : filter.eventually_le (ae (measure.pi μ)) (fun (x : (i : ι) → α i) (i : ι) => f i (x i))
  fun (x : (i : ι) → α i) (i : ι) => f' i (x i) :=
  filter.eventually.mono (iff.mpr filter.eventually_all fun (i : ι) => filter.tendsto.eventually tendsto_eval_ae_ae (h i))
    fun (x : (x : ι) → α x) (hx : ∀ (i : ι), f i (function.eval i x) ≤ f' i (function.eval i x)) => hx

theorem ae_le_set_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] {I : set ι} {s : (i : ι) → set (α i)} {t : (i : ι) → set (α i)} (h : ∀ (i : ι), i ∈ I → filter.eventually_le (ae (μ i)) (s i) (t i)) : filter.eventually_le (ae (measure.pi μ)) (set.pi I s) (set.pi I t) := sorry

theorem ae_eq_set_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] {I : set ι} {s : (i : ι) → set (α i)} {t : (i : ι) → set (α i)} (h : ∀ (i : ι), i ∈ I → filter.eventually_eq (ae (μ i)) (s i) (t i)) : filter.eventually_eq (ae (measure.pi μ)) (set.pi I s) (set.pi I t) :=
  filter.eventually_le.antisymm (ae_le_set_pi fun (i : ι) (hi : i ∈ I) => filter.eventually_eq.le (h i hi))
    (ae_le_set_pi fun (i : ι) (hi : i ∈ I) => filter.eventually_eq.le (filter.eventually_eq.symm (h i hi)))

theorem pi_Iio_ae_eq_pi_Iic {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {s : set ι} {f : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi s fun (i : ι) => set.Iio (f i)) (set.pi s fun (i : ι) => set.Iic (f i)) :=
  ae_eq_set_pi fun (i : ι) (hi : i ∈ s) => Iio_ae_eq_Iic

theorem pi_Ioi_ae_eq_pi_Ici {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {s : set ι} {f : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi s fun (i : ι) => set.Ioi (f i)) (set.pi s fun (i : ι) => set.Ici (f i)) :=
  ae_eq_set_pi fun (i : ι) (hi : i ∈ s) => Ioi_ae_eq_Ici

theorem univ_pi_Iio_ae_eq_Iic {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {f : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi set.univ fun (i : ι) => set.Iio (f i)) (set.Iic f) := sorry

theorem univ_pi_Ioi_ae_eq_Ici {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {f : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi set.univ fun (i : ι) => set.Ioi (f i)) (set.Ici f) := sorry

theorem pi_Ioo_ae_eq_pi_Icc {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {s : set ι} {f : (i : ι) → α i} {g : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi s fun (i : ι) => set.Ioo (f i) (g i))
  (set.pi s fun (i : ι) => set.Icc (f i) (g i)) :=
  ae_eq_set_pi fun (i : ι) (hi : i ∈ s) => Ioo_ae_eq_Icc

theorem univ_pi_Ioo_ae_eq_Icc {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {f : (i : ι) → α i} {g : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi set.univ fun (i : ι) => set.Ioo (f i) (g i)) (set.Icc f g) := sorry

theorem pi_Ioc_ae_eq_pi_Icc {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {s : set ι} {f : (i : ι) → α i} {g : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi s fun (i : ι) => set.Ioc (f i) (g i))
  (set.pi s fun (i : ι) => set.Icc (f i) (g i)) :=
  ae_eq_set_pi fun (i : ι) (hi : i ∈ s) => Ioc_ae_eq_Icc

theorem univ_pi_Ioc_ae_eq_Icc {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {f : (i : ι) → α i} {g : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi set.univ fun (i : ι) => set.Ioc (f i) (g i)) (set.Icc f g) := sorry

theorem pi_Ico_ae_eq_pi_Icc {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {s : set ι} {f : (i : ι) → α i} {g : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi s fun (i : ι) => set.Ico (f i) (g i))
  (set.pi s fun (i : ι) => set.Icc (f i) (g i)) :=
  ae_eq_set_pi fun (i : ι) (hi : i ∈ s) => Ico_ae_eq_Icc

theorem univ_pi_Ico_ae_eq_Icc {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → partial_order (α i)] [∀ (i : ι), has_no_atoms (μ i)] {f : (i : ι) → α i} {g : (i : ι) → α i} : filter.eventually_eq (ae (measure.pi μ)) (set.pi set.univ fun (i : ι) => set.Ico (f i) (g i)) (set.Icc f g) := sorry

/-- If one of the measures `μ i` has no atoms, them `measure.pi µ`
has no atoms. The instance below assumes that all `μ i` have no atoms. -/
theorem pi_has_no_atoms {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] (i : ι) [has_no_atoms (μ i)] : has_no_atoms (measure.pi μ) :=
  has_no_atoms.mk
    fun (x : (i : ι) → α i) => flip measure_mono_null (pi_hyperplane μ i (x i)) (iff.mpr set.singleton_subset_iff rfl)

protected instance pi.measure_theory.has_no_atoms {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [h : Nonempty ι] [∀ (i : ι), has_no_atoms (μ i)] : has_no_atoms (measure.pi μ) :=
  nonempty.elim h fun (i : ι) => pi_has_no_atoms i

protected instance pi.measure_theory.locally_finite_measure {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measurable_space (α i)] {μ : (i : ι) → measure (α i)} [∀ (i : ι), sigma_finite (μ i)] [(i : ι) → topological_space (α i)] [∀ (i : ι), opens_measurable_space (α i)] [∀ (i : ι), locally_finite_measure (μ i)] : locally_finite_measure (measure.pi μ) := sorry

end measure

protected instance measure_space.pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measure_space (α i)] : measure_space ((i : ι) → α i) :=
  measure_space.mk (measure.pi fun (i : ι) => volume)

theorem volume_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measure_space (α i)] : volume = measure.pi fun (i : ι) => volume :=
  rfl

theorem volume_pi_pi {ι : Type u_1} [fintype ι] {α : ι → Type u_2} [(i : ι) → measure_space (α i)] [ι → sigma_finite volume] (s : (i : ι) → set (α i)) (hs : ∀ (i : ι), is_measurable (s i)) : coe_fn volume (set.pi set.univ s) = finset.prod finset.univ fun (i : ι) => coe_fn volume (s i) :=
  measure.pi_pi (fun (i : ι) => volume) s hs


import algebra.category.CommRing
import algebra.category.Module.basic

open category_theory

instance restriction_of_scalar.has_scalar {R S : CommRing} (f : R ⟶ S) (N : Module S) :
   has_scalar R N :=
{ smul := λ r m, f r • m }

@[reducible] def restriction_of_scalar.restrict {R S : CommRing} (f : R ⟶ S) (N : Module S) :
  Module R :=
{ carrier := N,
  is_module :=
  { one_smul := λ b, begin
      unfold has_scalar.smul,
      rw [ring_hom.map_one, one_smul],
    end,
    mul_smul := λ _ _ _, begin
      unfold has_scalar.smul,
      rw [ring_hom.map_mul, mul_smul],
    end,
    smul_add := λ _ _ _,by { unfold has_scalar.smul, rw [smul_add] },
    smul_zero := λ _, by { unfold has_scalar.smul, rw [smul_zero] },
    add_smul := λ _ _ _, begin
      unfold has_scalar.smul,
      rw [ring_hom.map_add, add_smul],
    end,
    zero_smul := λ _, begin
      unfold has_scalar.smul,
      rw [ring_hom.map_zero, zero_smul],
    end,
    ..(restriction_of_scalar.has_scalar f N) } }

instance restriction_of_scalar.has_scalar' {R S : CommRing} (f : R ⟶ S) (N : Module S) :
  has_scalar S (restriction_of_scalar.restrict f N) :=
{ smul := λ r n, r • n }

open restriction_of_scalar

@[simp] lemma restriction_of_scalar.smul_def' {R S : CommRing} (f : R ⟶ S)
  (r : R) (N : Module S)
  (n : restriction_of_scalar.restrict f N) :
  (r • n) = (f r • n) := rfl

def restriction_of_scalar.functor
  {R S : CommRing} (f : R ⟶ S) : Module S ⥤ Module R :=
{ obj := λ m, restriction_of_scalar.restrict f m,
  map := λ m1 m2 l,
    { to_fun := l,
      map_add' := λ x y, by rw [linear_map.map_add],
      map_smul' := λ r y, begin
        simp only [restriction_of_scalar.smul_def', ring_hom.id_apply],
        convert linear_map.map_smul l (f r) y,
      end } }

structure BundledModule :=
(R : CommRing)
(M : Module R.α)

def restriction_of_scalar {M1 M2 : BundledModule} (f : M1.R ⟶ M2.R) : BundledModule :=
{ R := M1.R,
  M := restriction_of_scalar.restrict f M2.M }

@[simp] lemma restriction_of_scalar.R {M1 M2 : BundledModule} (f : M1.R ⟶ M2.R) :
  (restriction_of_scalar f).R = M1.R := rfl
@[simp] lemma restriction_of_scalar.M {M1 M2 : BundledModule} (f : M1.R ⟶ M2.R) :
  (restriction_of_scalar f).M = restriction_of_scalar.restrict f M2.M := rfl

def bundledMap (M1 M2 : BundledModule) : Type* :=
Σ (f : M1.R ⟶ M2.R), M1.M ⟶ (restriction_of_scalar f).M

instance BundledModule.is_cat : large_category BundledModule :=
{ hom := λ M1 M2, bundledMap M1 M2,
  id := λ M, ⟨𝟙 M.R, { to_fun := λ m, m,
                       map_add' := λ _ _, rfl,
                       map_smul' := λ _ _, rfl }⟩,
  comp := λ M1 M2 M3 f g,
    ⟨f.1 ≫ g.1,
     { to_fun := λ m, g.2 (f.2 m),
       map_add' := λ m1 m2, by simp only [linear_map.map_add],
       map_smul' := λ r m, begin
        rcases f with ⟨f, f'⟩,
        rcases g with ⟨g, g'⟩,
        dsimp only,
        rw [ring_hom.id_apply, linear_map.map_smulₛₗ, ring_hom.id_apply,
          restriction_of_scalar.smul_def', restriction_of_scalar.smul_def', comp_apply],
        convert linear_map.map_smul g' (f r) (f' m),
      end }⟩,
  comp_id' := λ M1 M2 f, begin
    ext, refl, rw heq_iff_eq, ext, refl,
  end,
  id_comp' := λ M1 M2 f, begin
    ext, refl, rw heq_iff_eq, ext, refl,
  end }

def BundledModule.forget : @category_theory.functor BundledModule BundledModule.is_cat CommRing _ :=
{ obj := λ M, M.R,
  map := λ M1 M2 f, f.1 }


import data.real.basic
import algebra.big_operators.intervals
import measure_theory.measurable_space
import topology.basic
import measure_theory.borel_space

noncomputable theory

open set topological_space finsupp real

open_locale big_operators classical

-- Following https://www.isa-afp.org/browser_info/current/AFP/Affine_Arithmetic/document.pdf.
section affine_arithmetic

structure affine_form (E : Type*) [normed_group E] [normed_space ℝ E] :=
(x₀ : E) (x : ℕ →₀ E)

namespace affine_form

/-- In order to evaluate noise symbols, we will use a function of type `noise`, which is simply
`ℕ → [0,1]`. -/
def error_interval : set ℝ := Icc (-1) 1

def noise := ℕ → error_interval

variable (n : ℕ)

variables {E : Type*} [normed_field E] [normed_space ℝ E]

/-- Constant affine form. -/
def const (c : E) : affine_form E := ⟨c, 0⟩

instance : inhabited (affine_form E) := ⟨const 0⟩

/-- Degree of an affine form. -/
def degree (A : affine_form E) : ℕ := A.x.support.card

/-- Total deviation of an affine form. -/
def total_deviation (A : affine_form E) : ℝ := ∑ i in A.x.support, ∥A.x i∥

/--- Given valuation for noise symbols `ε` and affine form `A`, the value of `A` with `ε` is given
by the formula ⟦A, ε⟧ := x₀ + ∑ εᵢ * xᵢ. -/
def eval (ε : noise) (A : affine_form E) : E :=
A.x₀ + ∑ i in A.x.support, (ε i).val • (A.x i)

/-- The image over all possible noises gives a set, which is how we usually think of the affine form
`A`. It is computted as ⟦A⟧ := { ⟦A, ε⟧ | ε : ℕ → [-1, 1] }. -/
def set (A : affine_form E) : set E :=
set.image (λ ε, eval ε A) ⊤

section operations

/-- Update affine form, i.e. add a partial. -/
def update (A : affine_form E) (y : E) : affine_form E :=
⟨A.x₀, A.x + finsupp.single (degree A + 1) y⟩

/-- Negation of affine forms. -/
def neg (A : affine_form E) : affine_form E :=
⟨-A.x₀, -A.x⟩

instance : has_neg (affine_form E) := ⟨neg⟩

@[simp] lemma neg_centre (A : affine_form E)
: (-A).x₀ = -A.x₀ := rfl

@[simp] lemma neg_partials (A : affine_form E)
: (-A).x = -A.x := rfl

@[simp] lemma eval_neg_eq_neg_eval (ε : noise) (A : affine_form E)
: eval ε (-A) = -(eval ε A) :=
by { simp [eval, neg_centre, neg_partials, finsupp.support_neg, neg_add], }

/-- Scaling of affine forms. -/
def smul (k : ℝ) (A : affine_form E) : affine_form E :=
⟨k • A.x₀, k • A.x⟩

instance : has_scalar ℝ (affine_form E) := ⟨smul⟩

@[simp] lemma smul_centre (k : ℝ) (A : affine_form E)
: (k • A).x₀ = k • A.x₀ := rfl

@[simp] lemma smul_partials (k : ℝ) (A : affine_form E)
: (k • A).x = k • A.x := rfl

-- TODO: Move (finsupp/basic).
lemma support_smul_nonzero {α M} {R}
  [division_ring R] [add_comm_group M] [module R M] {b : R} (hb : b ≠ 0) {g : α →₀ M}
  : (b • g).support = g.support :=
begin
  ext x, split,
  { intros h, exact finsupp.support_smul h, },
  { intros h, simp only [smul_apply', mem_support_iff, ne.def] at *,
    intros hc, rw [smul_eq_zero] at hc, cases hc,
    { exact hb hc, }, { exact h hc, }, },
end

@[simp] lemma eval_smul_eq_smul_eval (ε : noise) (k : ℝ) (hk : k ≠ 0) (A : affine_form E)
: eval ε (k • A) = k • (eval ε A) :=
by { simp [eval, smul_centre, smul_partials, support_smul_nonzero hk,
      smul_add, finset.smul_sum, smul_smul, mul_comm], }

/-- Addition of affine forms. The lemma `eval_add_eq_add_eval` shows that it is defined
correctly. -/
def add (A₁ A₂ : affine_form E) : affine_form E :=
⟨A₁.x₀ + A₂.x₀, A₁.x + A₂.x⟩

instance : has_add (affine_form E) := ⟨add⟩

@[simp] lemma add_centre (A₁ A₂ : affine_form E)
: (A₁ + A₂).x₀ = A₁.x₀ + A₂.x₀ := rfl

@[simp] lemma add_partials (A₁ A₂ : affine_form E)
: (A₁ + A₂).x = A₁.x + A₂.x := rfl

private lemma eval_add_eq_sum_union (ε : noise) (A₁ A₂ : affine_form E)
: eval ε (A₁ + A₂) =
  (A₁.x₀ + A₂.x₀)
  + (∑ i in A₁.x.support ∪ A₂.x.support, ((ε i).val • (A₁.x i) + (ε i).val • (A₂.x i))) :=
begin
  simp [eval, add_centre, add_partials],
  apply finset.sum_subset,
  { convert @finsupp.support_add ℕ E _ (A₁.x) (A₂.x), },
  { intros x hx hxns,
    simp [←smul_add, ←add_apply, not_mem_support_iff.1 hxns], },
end

private lemma eval_add_eq_def (ε : noise) (A₁ A₂ : affine_form E)
: eval ε (A₁ + A₂) =
  (A₁.x₀ + A₂.x₀)
  + (∑ i in A₁.x.support, (ε i).val • (A₁.x i)
  + ∑ i in A₂.x.support, (ε i).val • (A₂.x i)) :=
begin
  simp [eval_add_eq_sum_union ε A₁ A₂, finset.sum_add_distrib],
  apply congr_arg2 (+),
  -- TODO: Lemma here about sums over unions?
  { symmetry, apply finset.sum_subset (finset.subset_union_left _ _),
    intros x hx hxns, simp [not_mem_support_iff.1 hxns], },
  { symmetry, apply finset.sum_subset (finset.subset_union_right _ _),
    intros x hx hxns, simp [not_mem_support_iff.1 hxns], },
end

@[simp] lemma eval_add_eq_add_eval (ε : noise) (A₁ A₂ : affine_form E)
: eval ε (A₁ + A₂) = (eval ε A₁) + (eval ε A₂) :=
by { simp only [eval_add_eq_def], dsimp [eval], abel, }

/-- Multiplication of affine forms. -/
def mul (A₁ A₂ : affine_form E) : affine_form E :=
-- TODO: Does this calculation of the error work for ℝ^n?
let e := (∑ i in A₁.x.support, ∥A₁.x i∥) * (∑ i in A₂.x.support, ∥A₂.x i∥) in
update ⟨A₁.x₀ * A₂.x₀, (A₁.x₀ • A₁.x) + (A₂.x₀ • A₂.x)⟩ (e • 1)

end operations

section real

-- I prove that a real affine form is enclosed by the total deviation interval.
theorem affine_form_enclosed (A : affine_form ℝ)
: set A ⊆ Icc (A.x₀ - total_deviation A) (A.x₀ + total_deviation A) :=
begin
  intros x hx, rcases hx with ⟨ε, ⟨hε, (hx : eval ε A = x)⟩⟩,
  simp only [←hx, eval, total_deviation, mem_Icc], split,
  { simp only [sub_eq_add_neg, ←finset.sum_neg_distrib],
    apply add_le_add (le_refl _), apply finset.sum_le_sum, intros n hn,
    show _ ≤ _ * _,
    by_cases h : 0 < A.x n,
    { rw [neg_le, neg_mul_eq_neg_mul], refine le_trans _ (le_abs_self _),
      rw [mul_le_iff_le_one_left h, neg_le], exact (ε n).2.1, },
    { replace h := le_of_not_lt h, rw [neg_le, neg_mul_eq_mul_neg],
      refine le_trans _ (neg_le_abs_self _),
      rw mul_le_iff_le_one_left _,
      { exact (ε n).2.2, },
      { rw [lt_neg, neg_zero], exact lt_of_le_of_ne h (mem_support_iff.1 hn), }, }, },
  { apply add_le_add (le_refl _), apply finset.sum_le_sum, intros n hn,
    show _ * _ ≤ _,
    by_cases h : 0 < A.x n,
    { refine le_trans _ (le_abs_self _), rw mul_le_iff_le_one_left h, exact (ε n).2.2, },
    { replace h := le_of_not_lt h,
      refine le_trans _ (neg_le_abs_self _),
      erw [←neg_neg (_ * _), neg_mul_eq_neg_mul, neg_mul_eq_mul_neg],
      rw mul_le_iff_le_one_left _,
      { rw neg_le, exact (ε n).2.1, },
      { rw [lt_neg, neg_zero], exact lt_of_le_of_ne h (mem_support_iff.1 hn), } }, },
end

-- This is proved in picard_lindelof/interval_arithmetic.
lemma mem_Icc_iff_exists_affine_form (a b : ℝ) (h : a < b)
: ∀ x, x ∈ Icc a b ↔
  ∃ γ ∈ (Icc (-1 : ℝ) (1 : ℝ)), x = ((a + b) / 2) + γ * ((b - a) / 2) :=
begin
  replace h := sub_pos.2 h,
  have h2 : 0 < (b - a) / 2 := div_pos h (by linarith),
  intros x, split,
  { rintros ⟨hax, hxb⟩,
    use [(2*x - a - b) / (b - a)], refine ⟨⟨_, _⟩, _⟩,
      { simp [le_div_iff h], linarith, },
      { simp [div_le_iff h], linarith, },
      { simp [mul_comm, ←mul_div_assoc, mul_div_cancel_left _ (ne_of_gt h)], ring, }, },
  { rintros ⟨γ, ⟨hγlb, hγub⟩, hx⟩, rw hx, split,
    { apply le_add_of_sub_left_le,
      refine le_trans _ ((mul_le_mul_right h2).2 hγlb),
      linarith, },
    { apply add_le_of_le_sub_left,
      refine le_trans ((mul_le_mul_right h2).2 hγub) _,
      linarith, }, },
end

-- Conversely, an interval is contained in an affine form.
-- TODO: Integrate proof above.
theorem interval_affine (A : affine_form ℝ) (a b : ℝ) (h : a < b)
: Icc a b ⊆ set ⟨(a + b) / 2, single 0 ((b - a) / 2)⟩ :=
begin
  intros x hx,
  rcases ((mem_Icc_iff_exists_affine_form a b h x).1 hx) with ⟨γ, hγ, heq⟩,
  use (λ n, ⟨γ, hγ⟩), split, { trivial, }, simp [eval],
  have h2 : (b - a) / 2 ≠ 0 := ne_of_gt (div_pos (sub_pos.2 h) (by linarith)),
  rw [support_single_ne_zero h2, finset.sum_singleton, single_eq_same, heq],
end

end real

-- THEOREM 5.
-- lemma add_aform'E:
--   fixes X Y::"real aform"
--   assumes e: "e ∈ UNIV → {- 1..1}"
--     and xn: "pdevs_apply (snd X) n = 0"
--     and yn: "pdevs_apply (snd Y) n = 0"
--   obtains err
--   where "aform_val e (add_aform X Y) = aform_val (e(n:=err)) (add_aform' p n X Y)" "err ∈ {-1 .. 1}"

-- theorem add_add' (ε : noise n) (A₁ A₂ : affine_form E n)
-- : ∃ E : error_interval,
--     eval n ε (add n A₁ A₂) =
--     eval (n + 1) (noise.insert_left n ε E) (add' n A₁ A₂) := sorry

end affine_form

-- Skipping all to do with expressions.

end affine_arithmetic


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

! This file was ported from Lean 3 source module algebra.group_with_zero.semiconj
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GroupWithZero.Units.Basic
import Mathbin.Algebra.Group.Semiconj

/-!
# Lemmas about semiconjugate elements in a `group_with_zero`.

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

-/

variable {α M₀ G₀ M₀' G₀' F F' : Type _}

namespace SemiconjBy

/- warning: semiconj_by.zero_right -> SemiconjBy.zero_right is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : MulZeroClass.{u1} G₀] (a : G₀), SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ _inst_1) a (OfNat.ofNat.{u1} G₀ 0 (OfNat.mk.{u1} G₀ 0 (Zero.zero.{u1} G₀ (MulZeroClass.toHasZero.{u1} G₀ _inst_1)))) (OfNat.ofNat.{u1} G₀ 0 (OfNat.mk.{u1} G₀ 0 (Zero.zero.{u1} G₀ (MulZeroClass.toHasZero.{u1} G₀ _inst_1))))
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : MulZeroClass.{u1} G₀] (a : G₀), SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ _inst_1) a (OfNat.ofNat.{u1} G₀ 0 (Zero.toOfNat0.{u1} G₀ (MulZeroClass.toZero.{u1} G₀ _inst_1))) (OfNat.ofNat.{u1} G₀ 0 (Zero.toOfNat0.{u1} G₀ (MulZeroClass.toZero.{u1} G₀ _inst_1)))
Case conversion may be inaccurate. Consider using '#align semiconj_by.zero_right SemiconjBy.zero_rightₓ'. -/
@[simp]
theorem zero_right [MulZeroClass G₀] (a : G₀) : SemiconjBy a 0 0 := by
  simp only [SemiconjBy, MulZeroClass.mul_zero, MulZeroClass.zero_mul]
#align semiconj_by.zero_right SemiconjBy.zero_right

/- warning: semiconj_by.zero_left -> SemiconjBy.zero_left is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : MulZeroClass.{u1} G₀] (x : G₀) (y : G₀), SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ _inst_1) (OfNat.ofNat.{u1} G₀ 0 (OfNat.mk.{u1} G₀ 0 (Zero.zero.{u1} G₀ (MulZeroClass.toHasZero.{u1} G₀ _inst_1)))) x y
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : MulZeroClass.{u1} G₀] (x : G₀) (y : G₀), SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ _inst_1) (OfNat.ofNat.{u1} G₀ 0 (Zero.toOfNat0.{u1} G₀ (MulZeroClass.toZero.{u1} G₀ _inst_1))) x y
Case conversion may be inaccurate. Consider using '#align semiconj_by.zero_left SemiconjBy.zero_leftₓ'. -/
@[simp]
theorem zero_left [MulZeroClass G₀] (x y : G₀) : SemiconjBy 0 x y := by
  simp only [SemiconjBy, MulZeroClass.mul_zero, MulZeroClass.zero_mul]
#align semiconj_by.zero_left SemiconjBy.zero_left

variable [GroupWithZero G₀] {a x y x' y' : G₀}

/- warning: semiconj_by.inv_symm_left_iff₀ -> SemiconjBy.inv_symm_left_iff₀ is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, Iff (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) (Inv.inv.{u1} G₀ (DivInvMonoid.toHasInv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1)) a) x y) (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a y x)
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, Iff (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) (Inv.inv.{u1} G₀ (GroupWithZero.toInv.{u1} G₀ _inst_1) a) x y) (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a y x)
Case conversion may be inaccurate. Consider using '#align semiconj_by.inv_symm_left_iff₀ SemiconjBy.inv_symm_left_iff₀ₓ'. -/
@[simp]
theorem inv_symm_left_iff₀ : SemiconjBy a⁻¹ x y ↔ SemiconjBy a y x :=
  by_cases (fun ha : a = 0 => by simp only [ha, inv_zero, SemiconjBy.zero_left]) fun ha =>
    @units_inv_symm_left_iff _ _ (Units.mk0 a ha) _ _
#align semiconj_by.inv_symm_left_iff₀ SemiconjBy.inv_symm_left_iff₀

/- warning: semiconj_by.inv_symm_left₀ -> SemiconjBy.inv_symm_left₀ is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y) -> (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) (Inv.inv.{u1} G₀ (DivInvMonoid.toHasInv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1)) a) y x)
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y) -> (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) (Inv.inv.{u1} G₀ (GroupWithZero.toInv.{u1} G₀ _inst_1) a) y x)
Case conversion may be inaccurate. Consider using '#align semiconj_by.inv_symm_left₀ SemiconjBy.inv_symm_left₀ₓ'. -/
theorem inv_symm_left₀ (h : SemiconjBy a x y) : SemiconjBy a⁻¹ y x :=
  SemiconjBy.inv_symm_left_iff₀.2 h
#align semiconj_by.inv_symm_left₀ SemiconjBy.inv_symm_left₀

/- warning: semiconj_by.inv_right₀ -> SemiconjBy.inv_right₀ is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y) -> (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a (Inv.inv.{u1} G₀ (DivInvMonoid.toHasInv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1)) x) (Inv.inv.{u1} G₀ (DivInvMonoid.toHasInv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1)) y))
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y) -> (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a (Inv.inv.{u1} G₀ (GroupWithZero.toInv.{u1} G₀ _inst_1) x) (Inv.inv.{u1} G₀ (GroupWithZero.toInv.{u1} G₀ _inst_1) y))
Case conversion may be inaccurate. Consider using '#align semiconj_by.inv_right₀ SemiconjBy.inv_right₀ₓ'. -/
theorem inv_right₀ (h : SemiconjBy a x y) : SemiconjBy a x⁻¹ y⁻¹ :=
  by
  by_cases ha : a = 0
  · simp only [ha, zero_left]
  by_cases hx : x = 0
  · subst x
    simp only [SemiconjBy, MulZeroClass.mul_zero, @eq_comm _ _ (y * a), mul_eq_zero] at h
    simp [h.resolve_right ha]
  · have := mul_ne_zero ha hx
    rw [h.eq, mul_ne_zero_iff] at this
    exact @units_inv_right _ _ _ (Units.mk0 x hx) (Units.mk0 y this.1) h
#align semiconj_by.inv_right₀ SemiconjBy.inv_right₀

/- warning: semiconj_by.inv_right_iff₀ -> SemiconjBy.inv_right_iff₀ is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, Iff (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a (Inv.inv.{u1} G₀ (DivInvMonoid.toHasInv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1)) x) (Inv.inv.{u1} G₀ (DivInvMonoid.toHasInv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1)) y)) (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y)
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀}, Iff (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a (Inv.inv.{u1} G₀ (GroupWithZero.toInv.{u1} G₀ _inst_1) x) (Inv.inv.{u1} G₀ (GroupWithZero.toInv.{u1} G₀ _inst_1) y)) (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y)
Case conversion may be inaccurate. Consider using '#align semiconj_by.inv_right_iff₀ SemiconjBy.inv_right_iff₀ₓ'. -/
@[simp]
theorem inv_right_iff₀ : SemiconjBy a x⁻¹ y⁻¹ ↔ SemiconjBy a x y :=
  ⟨fun h => inv_inv x ▸ inv_inv y ▸ h.inv_right₀, inv_right₀⟩
#align semiconj_by.inv_right_iff₀ SemiconjBy.inv_right_iff₀

/- warning: semiconj_by.div_right -> SemiconjBy.div_right is a dubious translation:
lean 3 declaration is
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀} {x' : G₀} {y' : G₀}, (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y) -> (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x' y') -> (SemiconjBy.{u1} G₀ (MulZeroClass.toHasMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a (HDiv.hDiv.{u1, u1, u1} G₀ G₀ G₀ (instHDiv.{u1} G₀ (DivInvMonoid.toHasDiv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1))) x x') (HDiv.hDiv.{u1, u1, u1} G₀ G₀ G₀ (instHDiv.{u1} G₀ (DivInvMonoid.toHasDiv.{u1} G₀ (GroupWithZero.toDivInvMonoid.{u1} G₀ _inst_1))) y y'))
but is expected to have type
  forall {G₀ : Type.{u1}} [_inst_1 : GroupWithZero.{u1} G₀] {a : G₀} {x : G₀} {y : G₀} {x' : G₀} {y' : G₀}, (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x y) -> (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a x' y') -> (SemiconjBy.{u1} G₀ (MulZeroClass.toMul.{u1} G₀ (MulZeroOneClass.toMulZeroClass.{u1} G₀ (MonoidWithZero.toMulZeroOneClass.{u1} G₀ (GroupWithZero.toMonoidWithZero.{u1} G₀ _inst_1)))) a (HDiv.hDiv.{u1, u1, u1} G₀ G₀ G₀ (instHDiv.{u1} G₀ (GroupWithZero.toDiv.{u1} G₀ _inst_1)) x x') (HDiv.hDiv.{u1, u1, u1} G₀ G₀ G₀ (instHDiv.{u1} G₀ (GroupWithZero.toDiv.{u1} G₀ _inst_1)) y y'))
Case conversion may be inaccurate. Consider using '#align semiconj_by.div_right SemiconjBy.div_rightₓ'. -/
theorem div_right (h : SemiconjBy a x y) (h' : SemiconjBy a x' y') :
    SemiconjBy a (x / x') (y / y') :=
  by
  rw [div_eq_mul_inv, div_eq_mul_inv]
  exact h.mul_right h'.inv_right₀
#align semiconj_by.div_right SemiconjBy.div_right

end SemiconjBy


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

import algebra.order.hom.monoid
import set_theory.game.ordinal

/-!
# Surreal numbers

The basic theory of surreal numbers, built on top of the theory of combinatorial (pre-)games.

A pregame is `numeric` if all the Left options are strictly smaller than all the Right options, and
all those options are themselves numeric. In terms of combinatorial games, the numeric games have
"frozen"; you can only make your position worse by playing, and Left is some definite "number" of
moves ahead (or behind) Right.

A surreal number is an equivalence class of numeric pregames.

In fact, the surreals form a complete ordered field, containing a copy of the reals (and much else
besides!) but we do not yet have a complete development.

## Order properties

Surreal numbers inherit the relations `≤` and `<` from games (`surreal.has_le` and
`surreal.has_lt`), and these relations satisfy the axioms of a partial order.

## Algebraic operations

We show that the surreals form a linear ordered commutative group.

One can also map all the ordinals into the surreals!

### Multiplication of surreal numbers

The proof that multiplication lifts to surreal numbers is surprisingly difficult and is currently
missing in the library. A sample proof can be found in Theorem 3.8 in the second reference below.
The difficulty lies in the length of the proof and the number of theorems that need to proven
simultaneously. This will make for a fun and challenging project.

The branch `surreal_mul` contains some progress on this proof.

### Todo

- Define the field structure on the surreals.

## References

* [Conway, *On numbers and games*][conway2001]
* [Schleicher, Stoll, *An introduction to Conway's games and numbers*][schleicher_stoll]
-/

universes u

local infix ` ≈ ` := pgame.equiv
local infix ` ⧏ `:50 := pgame.lf

namespace pgame

/-- A pre-game is numeric if everything in the L set is less than everything in the R set,
and all the elements of L and R are also numeric. -/
def numeric : pgame → Prop
| ⟨l, r, L, R⟩ :=
  (∀ i j, L i < R j) ∧ (∀ i, numeric (L i)) ∧ (∀ j, numeric (R j))

lemma numeric_def {x : pgame} : numeric x ↔ (∀ i j, x.move_left i < x.move_right j) ∧
  (∀ i, numeric (x.move_left i)) ∧ (∀ j, numeric (x.move_right j)) :=
by { cases x, refl }

namespace numeric

lemma mk {x : pgame} (h₁ : ∀ i j, x.move_left i < x.move_right j)
  (h₂ : ∀ i, numeric (x.move_left i)) (h₃ : ∀ j, numeric (x.move_right j)) : numeric x :=
numeric_def.2 ⟨h₁, h₂, h₃⟩

lemma left_lt_right {x : pgame} (o : numeric x) (i : x.left_moves) (j : x.right_moves) :
  x.move_left i < x.move_right j :=
by { cases x, exact o.1 i j }
lemma move_left {x : pgame} (o : numeric x) (i : x.left_moves) :
  numeric (x.move_left i) :=
by { cases x, exact o.2.1 i }
lemma move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
  numeric (x.move_right j) :=
by { cases x, exact o.2.2 j }

end numeric

@[elab_as_eliminator]
theorem numeric_rec {C : pgame → Prop}
  (H : ∀ l r (L : l → pgame) (R : r → pgame),
    (∀ i j, L i < R j) → (∀ i, numeric (L i)) → (∀ i, numeric (R i)) →
    (∀ i, C (L i)) → (∀ i, C (R i)) → C ⟨l, r, L, R⟩) :
  ∀ x, numeric x → C x
| ⟨l, r, L, R⟩ ⟨h, hl, hr⟩ :=
  H _ _ _ _ h hl hr (λ i, numeric_rec _ (hl i)) (λ i, numeric_rec _ (hr i))

theorem lf_asymm {x y : pgame} (ox : numeric x) (oy : numeric y) : x ⧏ y → ¬ y ⧏ x :=
begin
  refine numeric_rec (λ xl xr xL xR hx oxl oxr IHxl IHxr, _) x ox y oy,
  refine numeric_rec (λ yl yr yL yR hy oyl oyr IHyl IHyr, _),
  rw [mk_lf_mk, mk_lf_mk], rintro (⟨i, h₁⟩ | ⟨j, h₁⟩) (⟨i, h₂⟩ | ⟨j, h₂⟩),
  { exact IHxl _ _ (oyl _) (move_left_lf_of_le _ h₁) (move_left_lf_of_le _ h₂) },
  { exact (le_trans h₂ h₁).not_gf (lf_of_lt (hy _ _)) },
  { exact (le_trans h₁ h₂).not_gf (lf_of_lt (hx _ _)) },
  { exact IHxr _ _ (oyr _) (lf_move_right_of_le _ h₁) (lf_move_right_of_le _ h₂) },
end

theorem le_of_lf {x y : pgame} (h : x ⧏ y) (ox : numeric x) (oy : numeric y) : x ≤ y :=
not_lf.1 (lf_asymm ox oy h)

alias le_of_lf ← pgame.lf.le

theorem lt_of_lf {x y : pgame} (h : x ⧏ y) (ox : numeric x) (oy : numeric y) : x < y :=
(lt_or_fuzzy_of_lf h).resolve_right (not_fuzzy_of_le (h.le ox oy))

alias lt_of_lf ← pgame.lf.lt

theorem lf_iff_lt {x y : pgame} (ox : numeric x) (oy : numeric y) : x ⧏ y ↔ x < y :=
⟨λ h, h.lt ox oy, lf_of_lt⟩

/-- Definition of `x ≤ y` on numeric pre-games, in terms of `<` -/
theorem le_iff_forall_lt {x y : pgame} (ox : x.numeric) (oy : y.numeric) :
  x ≤ y ↔ (∀ i, x.move_left i < y) ∧ ∀ j, x < y.move_right j :=
begin
  refine le_iff_forall_lf.trans (and_congr _ _);
  refine forall_congr (λ i, lf_iff_lt _ _);
  apply_rules [numeric.move_left, numeric.move_right]
end

/-- Definition of `x < y` on numeric pre-games, in terms of `≤` -/
theorem lt_iff_exists_le {x y : pgame} (ox : x.numeric) (oy : y.numeric) :
  x < y ↔ (∃ i, x ≤ y.move_left i) ∨ ∃ j, x.move_right j ≤ y :=
by rw [←lf_iff_lt ox oy, lf_iff_exists_le]

theorem lt_of_exists_le {x y : pgame} (ox : x.numeric) (oy : y.numeric) :
  ((∃ i, x ≤ y.move_left i) ∨ ∃ j, x.move_right j ≤ y) → x < y :=
(lt_iff_exists_le ox oy).2

/-- The definition of `x < y` on numeric pre-games, in terms of `<` two moves later. -/
theorem lt_def {x y : pgame} (ox : x.numeric) (oy : y.numeric) : x < y ↔
  (∃ i, (∀ i', x.move_left i' < y.move_left i)  ∧ ∀ j, x < (y.move_left i).move_right j) ∨
   ∃ j, (∀ i, (x.move_right j).move_left i < y) ∧ ∀ j', x.move_right j < y.move_right j' :=
begin
  rw [←lf_iff_lt ox oy, lf_def],
  refine or_congr _ _;
    refine exists_congr (λ x_1, _);
    refine and_congr _ _;
    refine (forall_congr $ λ i, lf_iff_lt _ _);
    apply_rules [numeric.move_left, numeric.move_right]
end

theorem not_fuzzy {x y : pgame} (ox : numeric x) (oy : numeric y) : ¬ fuzzy x y :=
λ h, not_lf.2 ((lf_of_fuzzy h).le ox oy) h.2

theorem lt_or_equiv_or_gt {x y : pgame} (ox : numeric x) (oy : numeric y) : x < y ∨ x ≈ y ∨ y < x :=
(lf_or_equiv_or_gf x y).imp (λ h, h.lt ox oy) $ or.imp_right $ λ h, h.lt oy ox

theorem numeric_of_is_empty (x : pgame) [is_empty x.left_moves] [is_empty x.right_moves] :
  numeric x :=
numeric.mk is_empty_elim is_empty_elim is_empty_elim

theorem numeric_of_is_empty_left_moves (x : pgame) [is_empty x.left_moves] :
  (∀ j, numeric (x.move_right j)) → numeric x :=
numeric.mk is_empty_elim is_empty_elim

theorem numeric_of_is_empty_right_moves (x : pgame) [is_empty x.right_moves]
  (H : ∀ i, numeric (x.move_left i)) : numeric x :=
numeric.mk (λ _, is_empty_elim) H is_empty_elim

theorem numeric_zero : numeric 0 := numeric_of_is_empty 0
theorem numeric_one : numeric 1 := numeric_of_is_empty_right_moves 1 $ λ _, numeric_zero

theorem numeric.neg : Π {x : pgame} (o : numeric x), numeric (-x)
| ⟨l, r, L, R⟩ o := ⟨λ j i, neg_lt_neg_iff.2 (o.1 i j), λ j, (o.2.2 j).neg, λ i, (o.2.1 i).neg⟩

namespace numeric

theorem lt_move_right {x : pgame} (o : numeric x) (j) : x < x.move_right j :=
(pgame.lf_move_right j).lt o (o.move_right j)
theorem le_move_right {x : pgame} (o : numeric x) (j) : x ≤ x.move_right j :=
(o.lt_move_right j).le

theorem add : Π {x y : pgame} (ox : numeric x) (oy : numeric y), numeric (x + y)
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ox oy :=
⟨begin
   rintros (ix|iy) (jx|jy),
   { exact add_lt_add_right (ox.1 ix jx) _ },
   { exact (add_lf_add_of_lf_of_le (pgame.lf_mk _ _ ix) (oy.le_move_right jy)).lt
     ((ox.move_left ix).add oy) (ox.add (oy.move_right jy)) },
   { exact (add_lf_add_of_lf_of_le (pgame.mk_lf _ _ jx) (oy.move_left_le iy)).lt
      (ox.add (oy.move_left iy)) ((ox.move_right jx).add oy) },
   { exact add_lt_add_left (oy.1 iy jy) ⟨xl, xr, xL, xR⟩ }
 end,
 begin
   split,
   { rintros (ix|iy),
     { exact (ox.move_left ix).add oy },
     { exact ox.add (oy.move_left iy) } },
   { rintros (jx|jy),
     { apply (ox.move_right jx).add oy },
     { apply ox.add (oy.move_right jy) } }
 end⟩
using_well_founded { dec_tac := pgame_wf_tac }

lemma sub {x y : pgame} (ox : numeric x) (oy : numeric y) : numeric (x - y) := ox.add oy.neg

end numeric

/-- Pre-games defined by natural numbers are numeric. -/
theorem numeric_nat : Π (n : ℕ), numeric n
| 0 := numeric_zero
| (n + 1) := (numeric_nat n).add numeric_one

/-- Ordinal games are numeric. -/
theorem numeric_to_pgame (o : ordinal) : o.to_pgame.numeric :=
begin
  induction o using ordinal.induction with o IH,
  apply numeric_of_is_empty_right_moves,
  simpa using λ i, IH _ (ordinal.to_left_moves_to_pgame_symm_lt i)
end

end pgame

/-- The equivalence on numeric pre-games. -/
def surreal.equiv (x y : {x // pgame.numeric x}) : Prop := x.1.equiv y.1

open pgame

instance surreal.setoid : setoid {x // pgame.numeric x} :=
⟨λ x y, x.1 ≈ y.1,
 λ x, equiv_rfl,
 λ x y, pgame.equiv.symm,
 λ x y z, pgame.equiv.trans⟩

/-- The type of surreal numbers. These are the numeric pre-games quotiented
by the equivalence relation `x ≈ y ↔ x ≤ y ∧ y ≤ x`. In the quotient,
the order becomes a total order. -/
def surreal := quotient surreal.setoid

namespace surreal

/-- Construct a surreal number from a numeric pre-game. -/
def mk (x : pgame) (h : x.numeric) : surreal := ⟦⟨x, h⟩⟧

instance : has_zero surreal := ⟨mk 0 numeric_zero⟩
instance : has_one surreal := ⟨mk 1 numeric_one⟩
instance : inhabited surreal := ⟨0⟩

/-- Lift an equivalence-respecting function on pre-games to surreals. -/
def lift {α} (f : ∀ x, numeric x → α)
  (H : ∀ {x y} (hx : numeric x) (hy : numeric y), x.equiv y → f x hx = f y hy) : surreal → α :=
quotient.lift (λ x : {x // numeric x}, f x.1 x.2) (λ x y, H x.2 y.2)

/-- Lift a binary equivalence-respecting function on pre-games to surreals. -/
def lift₂ {α} (f : ∀ x y, numeric x → numeric y → α)
  (H : ∀ {x₁ y₁ x₂ y₂} (ox₁ : numeric x₁) (oy₁ : numeric y₁) (ox₂ : numeric x₂) (oy₂ : numeric y₂),
    x₁.equiv x₂ → y₁.equiv y₂ → f x₁ y₁ ox₁ oy₁ = f x₂ y₂ ox₂ oy₂) : surreal → surreal → α :=
lift (λ x ox, lift (λ y oy, f x y ox oy) (λ y₁ y₂ oy₁ oy₂, H _ _ _ _ equiv_rfl))
  (λ x₁ x₂ ox₁ ox₂ h, funext $ quotient.ind $ by exact λ ⟨y, oy⟩, H _ _ _ _ h equiv_rfl)

instance : has_le surreal :=
⟨lift₂ (λ x y _ _, x ≤ y) (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, propext (le_congr hx hy))⟩

instance : has_lt surreal :=
⟨lift₂ (λ x y _ _, x < y) (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, propext (lt_congr hx hy))⟩

/-- Addition on surreals is inherited from pre-game addition:
the sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
instance : has_add surreal  :=
⟨surreal.lift₂
  (λ (x y : pgame) (ox) (oy), ⟦⟨x + y, ox.add oy⟩⟧)
  (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, quotient.sound (pgame.add_congr hx hy))⟩

/-- Negation for surreal numbers is inherited from pre-game negation:
the negation of `{L | R}` is `{-R | -L}`. -/
instance : has_neg surreal  :=
⟨surreal.lift
  (λ x ox, ⟦⟨-x, ox.neg⟩⟧)
  (λ _ _ _ _ a, quotient.sound (pgame.neg_equiv_neg_iff.2 a))⟩

instance : ordered_add_comm_group surreal :=
{ add               := (+),
  add_assoc         := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, exact quotient.sound add_assoc_equiv },
  zero              := 0,
  zero_add          := by { rintros ⟨_⟩, exact quotient.sound (pgame.zero_add_equiv a) },
  add_zero          := by { rintros ⟨_⟩, exact quotient.sound (pgame.add_zero_equiv a) },
  neg               := has_neg.neg,
  add_left_neg      := by { rintros ⟨_⟩, exact quotient.sound (pgame.add_left_neg_equiv a) },
  add_comm          := by { rintros ⟨_⟩ ⟨_⟩, exact quotient.sound pgame.add_comm_equiv },
  le                := (≤),
  lt                := (<),
  le_refl           := by { rintros ⟨_⟩, apply @le_rfl pgame },
  le_trans          := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, apply @le_trans pgame },
  lt_iff_le_not_le  := by { rintros ⟨_, ox⟩ ⟨_, oy⟩, apply @lt_iff_le_not_le pgame },
  le_antisymm       := by { rintros ⟨_⟩ ⟨_⟩ h₁ h₂, exact quotient.sound ⟨h₁, h₂⟩ },
  add_le_add_left   := by { rintros ⟨_⟩ ⟨_⟩ hx ⟨_⟩, exact @add_le_add_left pgame _ _ _ _ _ hx _ } }

noncomputable instance : linear_ordered_add_comm_group surreal :=
{ le_total := by rintro ⟨⟨x, ox⟩⟩ ⟨⟨y, oy⟩⟩; classical; exact
    or_iff_not_imp_left.2 (λ h, (pgame.not_le.1 h).le oy ox),
  decidable_le := classical.dec_rel _,
  ..surreal.ordered_add_comm_group }

instance : add_monoid_with_one surreal := add_monoid_with_one.unary

/-- Casts a `surreal` number into a `game`. -/
def to_game : surreal →+o game :=
{ to_fun := lift (λ x _, ⟦x⟧) (λ x y ox oy, quot.sound),
  map_zero' := rfl,
  map_add' := by { rintros ⟨_, _⟩ ⟨_, _⟩, refl },
  monotone' := by { rintros ⟨_, _⟩ ⟨_, _⟩, exact id } }

theorem zero_to_game : to_game 0 = 0 := rfl
@[simp] theorem one_to_game : to_game 1 = 1 := rfl
@[simp] theorem nat_to_game : ∀ n : ℕ, to_game n = n := map_nat_cast' _ one_to_game

end surreal

open surreal

namespace ordinal

/-- Converts an ordinal into the corresponding surreal. -/
noncomputable def to_surreal : ordinal ↪o surreal :=
{ to_fun := λ o, mk _ (numeric_to_pgame o),
  inj' := λ a b h, to_pgame_equiv_iff.1 (quotient.exact h),
  map_rel_iff' := @to_pgame_le_iff }

end ordinal