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

! This file was ported from Lean 3 source module category_theory.category.Cat
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.ConcreteCategory.Bundled
import Mathlib.CategoryTheory.DiscreteCategory
import Mathlib.CategoryTheory.Types
import Mathlib.CategoryTheory.Bicategory.Strict

/-!
# Category of categories

This file contains the definition of the category `Cat` of all categories.
In this category objects are categories and
morphisms are functors between these categories.

## Implementation notes

Though `Cat` is not a concrete category, we use `bundled` to define
its carrier type.
-/

universe v u

namespace CategoryTheory

-- intended to be used with explicit universe parameters
/-- Category of categories. -/
@[nolint checkUnivs]
def Cat :=
  Bundled Category.{v, u}
set_option linter.uppercaseLean3 false in
#align category_theory.Cat CategoryTheory.Cat

namespace Cat

instance : Inhabited Cat :=
  ⟨⟨Type u, CategoryTheory.types⟩⟩

--Porting note: maybe this coercion should be defined to be `objects.obj`?
instance : CoeSort Cat (Type u) :=
  ⟨Bundled.α⟩

instance str (C : Cat.{v, u}) : Category.{v, u} C :=
  Bundled.str C
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.str CategoryTheory.Cat.str

/-- Construct a bundled `Cat` from the underlying type and the typeclass. -/
def of (C : Type u) [Category.{v} C] : Cat.{v, u} :=
  Bundled.of C
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.of CategoryTheory.Cat.of

/-- Bicategory structure on `Cat` -/
instance bicategory : Bicategory.{max v u, max v u} Cat.{v, u}
    where
  Hom C D := C ⥤ D
  id C := 𝟭 C
  comp F G := F ⋙ G
  homCategory := fun _ _ => Functor.category
  whiskerLeft {C} {D} {E} F G H η := whiskerLeft F η
  whiskerRight {C} {D} {E} F G η H := whiskerRight η H
  associator {A} {B} {C} D := Functor.associator
  leftUnitor {A} B := Functor.leftUnitor
  rightUnitor {A} B := Functor.rightUnitor
  pentagon := fun {A} {B} {C} {D} {E}=> Functor.pentagon
  triangle {A} {B} {C} := Functor.triangle
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.bicategory CategoryTheory.Cat.bicategory

/-- `Cat` is a strict bicategory. -/
instance bicategory.strict : Bicategory.Strict Cat.{v, u} where
  id_comp {C} {D} F := by cases F; rfl
  comp_id {C} {D} F := by cases F; rfl
  assoc := by intros; rfl
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.bicategory.strict CategoryTheory.Cat.bicategory.strict

/-- Category structure on `Cat` -/
instance category : LargeCategory.{max v u} Cat.{v, u} :=
  StrictBicategory.category Cat.{v, u}
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.category CategoryTheory.Cat.category

@[simp]
theorem id_map {C : Cat} {X Y : C} (f : X ⟶ Y) : (𝟙 C : C ⥤ C).map f = f :=
  Functor.id_map f
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.id_map CategoryTheory.Cat.id_map

@[simp]
theorem comp_obj {C D E : Cat} (F : C ⟶ D) (G : D ⟶ E) (X : C) : (F ≫ G).obj X = G.obj (F.obj X) :=
  Functor.comp_obj F G X
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.comp_obj CategoryTheory.Cat.comp_obj

@[simp]
theorem comp_map {C D E : Cat} (F : C ⟶ D) (G : D ⟶ E) {X Y : C} (f : X ⟶ Y) :
    (F ≫ G).map f = G.map (F.map f) :=
  Functor.comp_map F G f
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.comp_map CategoryTheory.Cat.comp_map

/-- Functor that gets the set of objects of a category. It is not
called `forget`, because it is not a faithful functor. -/
def objects : Cat.{v, u} ⥤ Type u where
  obj C := C
  map F := F.obj
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.objects CategoryTheory.Cat.objects

-- porting note: this instance was needed for CategoryTheory.Category.Cat.Limit
instance (X : Cat.{v, u}) : Category (objects.obj X) := (inferInstance : Category X)

section

attribute [local simp] eqToHom_map

/-- Any isomorphism in `Cat` induces an equivalence of the underlying categories. -/
def equivOfIso {C D : Cat} (γ : C ≅ D) : C ≌ D
    where
  functor := γ.hom
  inverse := γ.inv
  unitIso := eqToIso <| Eq.symm γ.hom_inv_id
  counitIso := eqToIso γ.inv_hom_id
set_option linter.uppercaseLean3 false in
#align category_theory.Cat.equiv_of_iso CategoryTheory.Cat.equivOfIso

end

end Cat

/-- Embedding `Type` into `Cat` as discrete categories.

This ought to be modelled as a 2-functor!
-/
@[simps]
def typeToCat : Type u ⥤ Cat where
  obj X := Cat.of (Discrete X)
  map := fun {X} {Y} f => by
    dsimp
    exact Discrete.functor (Discrete.mk ∘ f)
  map_id X := by
    apply Functor.ext
    · intro X Y f
      cases f
      simp only [id_eq, eqToHom_refl, Cat.id_map, Category.comp_id, Category.id_comp]
      apply ULift.ext
      aesop_cat
    · aesop_cat
  map_comp f g := by apply Functor.ext; aesop_cat
set_option linter.uppercaseLean3 false in
#align category_theory.Type_to_Cat CategoryTheory.typeToCat

instance : Faithful typeToCat.{u} where
  map_injective {_X} {_Y} _f _g h :=
    funext fun x => congr_arg Discrete.as (Functor.congr_obj h ⟨x⟩)

instance : Full typeToCat.{u}
    where
  preimage F := Discrete.as ∘ F.obj ∘ Discrete.mk
  witness := by
    intro X Y F
    apply Functor.ext
    · intro x y f
      dsimp
      apply ULift.ext
      aesop_cat
    · rintro ⟨x⟩
      apply Discrete.ext
      rfl

end CategoryTheory


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

! This file was ported from Lean 3 source module logic.function.conjugate
! 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.Logic.Function.Basic

/-!
# Semiconjugate and commuting maps

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

We define the following predicates:

* `function.semiconj`: `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`;
* `function.semiconj₂: `f : α → β` semiconjugates a binary operation `ga : α → α → α`
  to `gb : β → β → β` if `f (ga x y) = gb (f x) (f y)`;
* `f : α → α` commutes with `g : α → α` if `f ∘ g = g ∘ f`, or equivalently `semiconj f g g`.

-/

namespace Function

variable {α : Type _} {β : Type _} {γ : Type _}

#print Function.Semiconj /-
/-- We say that `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`.
We use `∀ x, f (ga x) = gb (f x)` as the definition, so given `h : function.semiconj f ga gb` and
`a : α`, we have `h a : f (ga a) = gb (f a)` and `h.comp_eq : f ∘ ga = gb ∘ f`. -/
def Semiconj (f : α → β) (ga : α → α) (gb : β → β) : Prop :=
  ∀ x, f (ga x) = gb (f x)
#align function.semiconj Function.Semiconj
-/

namespace Semiconj

variable {f fab : α → β} {fbc : β → γ} {ga ga' : α → α} {gb gb' : β → β} {gc gc' : γ → γ}

/- warning: function.semiconj.comp_eq -> Function.Semiconj.comp_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α} {gb : β -> β}, (Function.Semiconj.{u1, u2} α β f ga gb) -> (Eq.{max (succ u1) (succ u2)} (α -> β) (Function.comp.{succ u1, succ u1, succ u2} α α β f ga) (Function.comp.{succ u1, succ u2, succ u2} α β β gb f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α} {gb : β -> β}, (Function.Semiconj.{u2, u1} α β f ga gb) -> (Eq.{max (succ u2) (succ u1)} (α -> β) (Function.comp.{succ u2, succ u2, succ u1} α α β f ga) (Function.comp.{succ u2, succ u1, succ u1} α β β gb f))
Case conversion may be inaccurate. Consider using '#align function.semiconj.comp_eq Function.Semiconj.comp_eqₓ'. -/
protected theorem comp_eq (h : Semiconj f ga gb) : f ∘ ga = gb ∘ f :=
  funext h
#align function.semiconj.comp_eq Function.Semiconj.comp_eq

/- warning: function.semiconj.eq -> Function.Semiconj.eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α} {gb : β -> β}, (Function.Semiconj.{u1, u2} α β f ga gb) -> (forall (x : α), Eq.{succ u2} β (f (ga x)) (gb (f x)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α} {gb : β -> β}, (Function.Semiconj.{u2, u1} α β f ga gb) -> (forall (x : α), Eq.{succ u1} β (f (ga x)) (gb (f x)))
Case conversion may be inaccurate. Consider using '#align function.semiconj.eq Function.Semiconj.eqₓ'. -/
protected theorem eq (h : Semiconj f ga gb) (x : α) : f (ga x) = gb (f x) :=
  h x
#align function.semiconj.eq Function.Semiconj.eq

/- warning: function.semiconj.comp_right -> Function.Semiconj.comp_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α} {ga' : α -> α} {gb : β -> β} {gb' : β -> β}, (Function.Semiconj.{u1, u2} α β f ga gb) -> (Function.Semiconj.{u1, u2} α β f ga' gb') -> (Function.Semiconj.{u1, u2} α β f (Function.comp.{succ u1, succ u1, succ u1} α α α ga ga') (Function.comp.{succ u2, succ u2, succ u2} β β β gb gb'))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α} {ga' : α -> α} {gb : β -> β} {gb' : β -> β}, (Function.Semiconj.{u2, u1} α β f ga gb) -> (Function.Semiconj.{u2, u1} α β f ga' gb') -> (Function.Semiconj.{u2, u1} α β f (Function.comp.{succ u2, succ u2, succ u2} α α α ga ga') (Function.comp.{succ u1, succ u1, succ u1} β β β gb gb'))
Case conversion may be inaccurate. Consider using '#align function.semiconj.comp_right Function.Semiconj.comp_rightₓ'. -/
theorem comp_right (h : Semiconj f ga gb) (h' : Semiconj f ga' gb') :
    Semiconj f (ga ∘ ga') (gb ∘ gb') := fun x => by rw [comp_app, h.eq, h'.eq]
#align function.semiconj.comp_right Function.Semiconj.comp_right

/- warning: function.semiconj.comp_left -> Function.Semiconj.comp_left is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {fab : α -> β} {fbc : β -> γ} {ga : α -> α} {gb : β -> β} {gc : γ -> γ}, (Function.Semiconj.{u1, u2} α β fab ga gb) -> (Function.Semiconj.{u2, u3} β γ fbc gb gc) -> (Function.Semiconj.{u1, u3} α γ (Function.comp.{succ u1, succ u2, succ u3} α β γ fbc fab) ga gc)
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} {fab : α -> β} {fbc : β -> γ} {ga : α -> α} {gb : β -> β} {gc : γ -> γ}, (Function.Semiconj.{u3, u2} α β fab ga gb) -> (Function.Semiconj.{u2, u1} β γ fbc gb gc) -> (Function.Semiconj.{u3, u1} α γ (Function.comp.{succ u3, succ u2, succ u1} α β γ fbc fab) ga gc)
Case conversion may be inaccurate. Consider using '#align function.semiconj.comp_left Function.Semiconj.comp_leftₓ'. -/
theorem comp_left (hab : Semiconj fab ga gb) (hbc : Semiconj fbc gb gc) :
    Semiconj (fbc ∘ fab) ga gc := fun x => by simp only [comp_app, hab.eq, hbc.eq]
#align function.semiconj.comp_left Function.Semiconj.comp_left

/- warning: function.semiconj.id_right -> Function.Semiconj.id_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β}, Function.Semiconj.{u1, u2} α β f (id.{succ u1} α) (id.{succ u2} β)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β}, Function.Semiconj.{u2, u1} α β f (id.{succ u2} α) (id.{succ u1} β)
Case conversion may be inaccurate. Consider using '#align function.semiconj.id_right Function.Semiconj.id_rightₓ'. -/
theorem id_right : Semiconj f id id := fun _ => rfl
#align function.semiconj.id_right Function.Semiconj.id_right

#print Function.Semiconj.id_left /-
theorem id_left : Semiconj id ga ga := fun _ => rfl
#align function.semiconj.id_left Function.Semiconj.id_left
-/

/- warning: function.semiconj.inverses_right -> Function.Semiconj.inverses_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α} {ga' : α -> α} {gb : β -> β} {gb' : β -> β}, (Function.Semiconj.{u1, u2} α β f ga gb) -> (Function.RightInverse.{succ u1, succ u1} α α ga' ga) -> (Function.LeftInverse.{succ u2, succ u2} β β gb' gb) -> (Function.Semiconj.{u1, u2} α β f ga' gb')
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α} {ga' : α -> α} {gb : β -> β} {gb' : β -> β}, (Function.Semiconj.{u2, u1} α β f ga gb) -> (Function.RightInverse.{succ u2, succ u2} α α ga' ga) -> (Function.LeftInverse.{succ u1, succ u1} β β gb' gb) -> (Function.Semiconj.{u2, u1} α β f ga' gb')
Case conversion may be inaccurate. Consider using '#align function.semiconj.inverses_right Function.Semiconj.inverses_rightₓ'. -/
theorem inverses_right (h : Semiconj f ga gb) (ha : RightInverse ga' ga) (hb : LeftInverse gb' gb) :
    Semiconj f ga' gb' := fun x => by rw [← hb (f (ga' x)), ← h.eq, ha x]
#align function.semiconj.inverses_right Function.Semiconj.inverses_right

/- warning: function.semiconj.option_map -> Function.Semiconj.option_map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α} {gb : β -> β}, (Function.Semiconj.{u1, u2} α β f ga gb) -> (Function.Semiconj.{u1, u2} (Option.{u1} α) (Option.{u2} β) (Option.map.{u1, u2} α β f) (Option.map.{u1, u1} α α ga) (Option.map.{u2, u2} β β gb))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α} {gb : β -> β}, (Function.Semiconj.{u2, u1} α β f ga gb) -> (Function.Semiconj.{u2, u1} (Option.{u2} α) (Option.{u1} β) (Option.map.{u2, u1} α β f) (Option.map.{u2, u2} α α ga) (Option.map.{u1, u1} β β gb))
Case conversion may be inaccurate. Consider using '#align function.semiconj.option_map Function.Semiconj.option_mapₓ'. -/
theorem option_map {f : α → β} {ga : α → α} {gb : β → β} (h : Semiconj f ga gb) :
    Semiconj (Option.map f) (Option.map ga) (Option.map gb)
  | none => rfl
  | some a => congr_arg some <| h _
#align function.semiconj.option_map Function.Semiconj.option_map

end Semiconj

#print Function.Commute /-
/-- Two maps `f g : α → α` commute if `f (g x) = g (f x)` for all `x : α`.
Given `h : function.commute f g` and `a : α`, we have `h a : f (g a) = g (f a)` and
`h.comp_eq : f ∘ g = g ∘ f`. -/
def Commute (f g : α → α) : Prop :=
  Semiconj f g g
#align function.commute Function.Commute
-/

#print Function.Semiconj.commute /-
theorem Semiconj.commute {f g : α → α} (h : Semiconj f g g) : Commute f g :=
  h
#align function.semiconj.commute Function.Semiconj.commute
-/

namespace Commute

variable {f f' g g' : α → α}

#print Function.Commute.refl /-
@[refl]
theorem refl (f : α → α) : Commute f f := fun _ => Eq.refl _
#align function.commute.refl Function.Commute.refl
-/

#print Function.Commute.symm /-
@[symm]
theorem symm (h : Commute f g) : Commute g f := fun x => (h x).symm
#align function.commute.symm Function.Commute.symm
-/

#print Function.Commute.comp_right /-
theorem comp_right (h : Commute f g) (h' : Commute f g') : Commute f (g ∘ g') :=
  h.compRight h'
#align function.commute.comp_right Function.Commute.comp_right
-/

#print Function.Commute.comp_left /-
theorem comp_left (h : Commute f g) (h' : Commute f' g) : Commute (f ∘ f') g :=
  (h.symm.compRight h'.symm).symm
#align function.commute.comp_left Function.Commute.comp_left
-/

#print Function.Commute.id_right /-
theorem id_right : Commute f id :=
  Semiconj.id_right
#align function.commute.id_right Function.Commute.id_right
-/

#print Function.Commute.id_left /-
theorem id_left : Commute id f :=
  Semiconj.id_left
#align function.commute.id_left Function.Commute.id_left
-/

#print Function.Commute.option_map /-
theorem option_map {f g : α → α} : Commute f g → Commute (Option.map f) (Option.map g) :=
  Semiconj.option_map
#align function.commute.option_map Function.Commute.option_map
-/

end Commute

#print Function.Semiconj₂ /-
/-- A map `f` semiconjugates a binary operation `ga` to a binary operation `gb` if
for all `x`, `y` we have `f (ga x y) = gb (f x) (f y)`. E.g., a `monoid_hom`
semiconjugates `(*)` to `(*)`. -/
def Semiconj₂ (f : α → β) (ga : α → α → α) (gb : β → β → β) : Prop :=
  ∀ x y, f (ga x y) = gb (f x) (f y)
#align function.semiconj₂ Function.Semiconj₂
-/

namespace Semiconj₂

variable {f : α → β} {ga : α → α → α} {gb : β → β → β}

/- warning: function.semiconj₂.eq -> Function.Semiconj₂.eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β}, (Function.Semiconj₂.{u1, u2} α β f ga gb) -> (forall (x : α) (y : α), Eq.{succ u2} β (f (ga x y)) (gb (f x) (f y)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β}, (Function.Semiconj₂.{u2, u1} α β f ga gb) -> (forall (x : α) (y : α), Eq.{succ u1} β (f (ga x y)) (gb (f x) (f y)))
Case conversion may be inaccurate. Consider using '#align function.semiconj₂.eq Function.Semiconj₂.eqₓ'. -/
protected theorem eq (h : Semiconj₂ f ga gb) (x y : α) : f (ga x y) = gb (f x) (f y) :=
  h x y
#align function.semiconj₂.eq Function.Semiconj₂.eq

/- warning: function.semiconj₂.comp_eq -> Function.Semiconj₂.comp_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β}, (Function.Semiconj₂.{u1, u2} α β f ga gb) -> (Eq.{max (succ u1) (succ u2)} (α -> α -> β) (Function.bicompr.{u1, u1, u1, u2} α α α β f ga) (Function.bicompl.{u1, u1, u2, u2, u2} α α β β β gb f f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β}, (Function.Semiconj₂.{u2, u1} α β f ga gb) -> (Eq.{max (succ u2) (succ u1)} (α -> α -> β) (Function.bicompr.{u2, u2, u2, u1} α α α β f ga) (Function.bicompl.{u2, u2, u1, u1, u1} α α β β β gb f f))
Case conversion may be inaccurate. Consider using '#align function.semiconj₂.comp_eq Function.Semiconj₂.comp_eqₓ'. -/
protected theorem comp_eq (h : Semiconj₂ f ga gb) : bicompr f ga = bicompl gb f f :=
  funext fun x => funext <| h x
#align function.semiconj₂.comp_eq Function.Semiconj₂.comp_eq

#print Function.Semiconj₂.id_left /-
theorem id_left (op : α → α → α) : Semiconj₂ id op op := fun _ _ => rfl
#align function.semiconj₂.id_left Function.Semiconj₂.id_left
-/

/- warning: function.semiconj₂.comp -> Function.Semiconj₂.comp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β} {f' : β -> γ} {gc : γ -> γ -> γ}, (Function.Semiconj₂.{u2, u3} β γ f' gb gc) -> (Function.Semiconj₂.{u1, u2} α β f ga gb) -> (Function.Semiconj₂.{u1, u3} α γ (Function.comp.{succ u1, succ u2, succ u3} α β γ f' f) ga gc)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u3}} {γ : Type.{u2}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β} {f' : β -> γ} {gc : γ -> γ -> γ}, (Function.Semiconj₂.{u3, u2} β γ f' gb gc) -> (Function.Semiconj₂.{u1, u3} α β f ga gb) -> (Function.Semiconj₂.{u1, u2} α γ (Function.comp.{succ u1, succ u3, succ u2} α β γ f' f) ga gc)
Case conversion may be inaccurate. Consider using '#align function.semiconj₂.comp Function.Semiconj₂.compₓ'. -/
theorem comp {f' : β → γ} {gc : γ → γ → γ} (hf' : Semiconj₂ f' gb gc) (hf : Semiconj₂ f ga gb) :
    Semiconj₂ (f' ∘ f) ga gc := fun x y => by simp only [hf'.eq, hf.eq, comp_app]
#align function.semiconj₂.comp Function.Semiconj₂.comp

/- warning: function.semiconj₂.is_associative_right -> Function.Semiconj₂.isAssociative_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β} [_inst_1 : IsAssociative.{u1} α ga], (Function.Semiconj₂.{u1, u2} α β f ga gb) -> (Function.Surjective.{succ u1, succ u2} α β f) -> (IsAssociative.{u2} β gb)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β} [_inst_1 : IsAssociative.{u2} α ga], (Function.Semiconj₂.{u2, u1} α β f ga gb) -> (Function.Surjective.{succ u2, succ u1} α β f) -> (IsAssociative.{u1} β gb)
Case conversion may be inaccurate. Consider using '#align function.semiconj₂.is_associative_right Function.Semiconj₂.isAssociative_rightₓ'. -/
theorem isAssociative_right [IsAssociative α ga] (h : Semiconj₂ f ga gb) (h_surj : Surjective f) :
    IsAssociative β gb :=
  ⟨h_surj.forall₃.2 fun x₁ x₂ x₃ => by simp only [← h.eq, @IsAssociative.assoc _ ga]⟩
#align function.semiconj₂.is_associative_right Function.Semiconj₂.isAssociative_right

#print Function.Semiconj₂.isAssociative_left /-
theorem isAssociative_left [IsAssociative β gb] (h : Semiconj₂ f ga gb) (h_inj : Injective f) :
    IsAssociative α ga :=
  ⟨fun x₁ x₂ x₃ => h_inj <| by simp only [h.eq, @IsAssociative.assoc _ gb]⟩
#align function.semiconj₂.is_associative_left Function.Semiconj₂.isAssociative_left
-/

/- warning: function.semiconj₂.is_idempotent_right -> Function.Semiconj₂.isIdempotent_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β} [_inst_1 : IsIdempotent.{u1} α ga], (Function.Semiconj₂.{u1, u2} α β f ga gb) -> (Function.Surjective.{succ u1, succ u2} α β f) -> (IsIdempotent.{u2} β gb)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {f : α -> β} {ga : α -> α -> α} {gb : β -> β -> β} [_inst_1 : IsIdempotent.{u2} α ga], (Function.Semiconj₂.{u2, u1} α β f ga gb) -> (Function.Surjective.{succ u2, succ u1} α β f) -> (IsIdempotent.{u1} β gb)
Case conversion may be inaccurate. Consider using '#align function.semiconj₂.is_idempotent_right Function.Semiconj₂.isIdempotent_rightₓ'. -/
theorem isIdempotent_right [IsIdempotent α ga] (h : Semiconj₂ f ga gb) (h_surj : Surjective f) :
    IsIdempotent β gb :=
  ⟨h_surj.forall.2 fun x => by simp only [← h.eq, @IsIdempotent.idempotent _ ga]⟩
#align function.semiconj₂.is_idempotent_right Function.Semiconj₂.isIdempotent_right

#print Function.Semiconj₂.isIdempotent_left /-
theorem isIdempotent_left [IsIdempotent β gb] (h : Semiconj₂ f ga gb) (h_inj : Injective f) :
    IsIdempotent α ga :=
  ⟨fun x => h_inj <| by rw [h.eq, @IsIdempotent.idempotent _ gb]⟩
#align function.semiconj₂.is_idempotent_left Function.Semiconj₂.isIdempotent_left
-/

end Semiconj₂

end Function


open Classical

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : (∃ x : α, r) → r :=
    fun h : ∃ x : α, r =>
      Exists.elim h
        fun a : α =>
          fun h : r => h

example (a : α) : r → (∃ x : α, r) :=
    fun h : r => ⟨a, h⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    Iff.intro
      (fun h1 : ∃ x, p x ∧ r =>
          match h1 with
          | ⟨w, hw⟩ => (
                have expf  := Exists.intro w hw.left
                have rpf   := hw.right
                show (∃ x, p x) ∧ r from ⟨expf, rpf⟩
              )
            )
      (fun h2 : (∃ x, p x) ∧ r =>
        match h2.left with
        | ⟨w, hw⟩ =>  ⟨w, hw, h2.right⟩
      )

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
    Iff.intro
      (fun h1 : ∃ x, p x ∨ q x =>
        match h1 with
        | ⟨w, hw⟩ => (
            Or.elim hw
            (fun hpw : p w => Or.inl ⟨w, hpw⟩)
            (fun hqw : q w => Or.inr ⟨w, hqw⟩)
        )
      )
      (fun h2 : (∃ x, p x) ∨ (∃ x, q x) =>
        Or.elim h2
        (fun hpx : ∃ x, p x =>
          match hpx with
          | ⟨w, hw⟩ => ⟨w, Or.inl hw⟩
        )
        (fun hqx : ∃ x, q x =>
          match hqx with
          | ⟨w, hw⟩ => ⟨w, Or.inr hw⟩
        )
      )

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
    Iff.intro
      (fun h1 : ∀ x, p x =>
        (fun hnpx : ∃ x, ¬ p x =>
          match hnpx with
          | ⟨w, hw⟩ => show False from hw (h1 w)
        )
      )
      (fun h2 : ¬ (∃ x, ¬ p x) =>
        (fun a : α =>
          byContradiction
            fun hcon : ¬ p a => show False from h2 ⟨a, hcon⟩
        )
      )

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
    Iff.intro
      (fun hex : ∃ x, p x =>
        fun hu : ∀ x, ¬ p x =>
          match hex with
          | ⟨w, hw⟩ => (hu w) hw
      )
      (fun hnu : ¬ (∀ x, ¬ p x) =>
        byContradiction
        (fun hne : ¬ (∃ x, p x) =>
          have hu := (
            fun a : α =>
              show ¬ p a from (fun hpa : p a => hne ⟨a, hpa⟩)
           )
           show False from hnu hu
        )
      )

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
    Iff.intro
    (fun h1 : ¬ ∃ x, p x =>
      (fun a : α =>
        fun hpa: p a => show False from h1 ⟨a, hpa⟩
      )
    )
    (fun h2 : ∀ x, ¬ p x =>
      (fun hex : ∃ x, p x =>
        match hex with
        | ⟨w, hw⟩ => show False from (h2 w) hw
      )
    )

theorem t1 : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
    Iff.intro
    (fun h1 : ¬ ∀ x, p x =>
      byContradiction
      (fun hcon1 : ¬ ∃ x, ¬ p x =>
        have neg_h1 := (fun a : α =>
          byContradiction
          (fun hcon2 : ¬ p a => show False from hcon1 (⟨a, hcon2⟩))
        )
        show False from h1 neg_h1
      )
    )
    (fun h2 : ∃ x, ¬ p x =>
      (fun hxp : ∀ x, p x =>
        match h2 with
        | ⟨w, hw⟩ => show False from hw (hxp w)
      )
    )

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
    Iff.intro
    (fun h1 : ∀ x, p x → r =>
      fun hex : ∃ x, p x =>
        match hex with
        | ⟨w, hw⟩ => (h1 w) hw
    )
    (fun h2 : (∃ x, p x) → r =>
      (fun a : α =>
        (fun hpa : p a => show r from h2 ⟨a, hpa⟩)
      )
    )

-- ugh
example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
    Iff.intro
      (fun h1 : (∃ x, p x → r) =>
        match h1 with
        | ⟨w, hw⟩ => (
          fun hpx : ∀ x, p x =>
            show r from hw (hpx w)
        )
      )
      (fun h2: (∀ x, p x) → r =>
        byCases
        (fun hpx : ∀ x, p x => ⟨a, fun hpa : p a => h2 hpx⟩)
        (fun hnpx : ¬ (∀ x, p x) =>
          byContradiction
          (fun hnepx : ¬ (∃ x, p x → r) =>
            have hpx : ∀ x, p x :=
              (fun u : α =>
                byContradiction
                (fun hnpu : ¬ (p u) =>
                  show False from hnepx ⟨u, fun hpu : p u => absurd hpu hnpu⟩
                )
              )
            show False from hnpx hpx
          )
        )
      )

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
    Iff.intro
      (fun h1 : ∃ x, r → p x =>
        (fun hr : r =>
          match h1 with
          | ⟨w, hw⟩ => show ∃ x, p x from ⟨w, hw hr⟩
        )
      )
      (fun h2 : r → ∃ x, p x =>
        byCases
        (fun hr : r =>
          match h2 hr with
          | ⟨w, hw⟩ => ⟨w, (fun h2r : r => hw)⟩
        )
        (fun hnr : ¬ r =>
          byContradiction
          (fun hnex : ¬ (∃ x, r → p x) =>
            have rpa : r → p a := (fun hr : r => absurd hr hnr)
            show False from hnex ⟨a, rpa⟩
          )
        )
      )

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
    Iff.intro
    (fun h1: ∀ x, p x ∧ q x =>
      have ls : ∀ x, p x := (fun x => (h1 x).left)
      have rs : ∀ x, q x := (fun x => (h1 x).right)
      ⟨ls, rs⟩
    )
    (fun h2 : (∀ x, p x) ∧ (∀ x, q x) =>
      (fun x => ⟨h2.left x, h2.right x⟩)
    )

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
    (fun h1 : ∀ x, p x → q x =>
      (fun h2 : ∀ x, p x =>
        fun x => (h1 x) (h2 x)
      )
    )

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
    (fun h : (∀ x, p x) ∨ (∀ x, q x) =>
      Or.elim h
      (fun hpx : ∀ x, p x => fun x => Or.inl (hpx x))
      (fun hqx : ∀ x, q x => fun x => Or.inr (hqx x))
    )

example : α → ((∀ x : α, r) ↔ r) :=
    (fun a : α =>
      Iff.intro
      (fun h1 : ∀ x : α, r => h1 a)
      (fun hr : r => fun x => hr)
    )

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
    Iff.intro
    (fun h1 : ∀ x, p x ∨ r =>
      byCases
      (fun hpx : ∀ x, p x => Or.inl hpx)
      (fun hnpx : ¬ ∀ x, p x =>
        -- cutting some corners here:
        have henpx : ∃ x, ¬ (p x) := (t1 α p).mp hnpx
        match henpx with
        | ⟨w, hw⟩ => (
            Or.elim (h1 w)
            (fun hpw : p w => absurd hpw hw)
            (fun hr : r => Or.inr hr)
        )
      )
    )
    (fun h2 : (∀ x, p x) ∨ r =>
      Or.elim h2
      (fun hpx : ∀ x, p x => fun x => Or.inl (hpx x))
      (fun hr : r => fun x => Or.inr hr)
    )
example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
    Iff.intro
    (fun h1 : ∀ x, r → p x =>
      fun r => fun x => (h1 x) r
    )
    (fun h2 : r → ∀ x, p x =>
      fun x => fun r => (h2 r) x
    )

variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
    Or.elim (em (shaves barber barber))
    (fun h1 : (shaves barber barber) =>
      show False from ((h barber).mp h1) h1
    )
    (fun h2 : ¬ (shaves barber barber) =>
      show False from h2 ((h barber).mpr h2)
    )


import data.pnat.basic

-- El enunciado del IMO 1977 Q6 es el siguiente:
--    Sea `f : ℕ+ → ℕ+` tal que `f(f(n)) < f(n + 1)` para todo
--    `n`. Demostrar que `f(n) = n` para todo `n`.

theorem Extension
  (f : ℕ → ℕ)
  (h1 : ∀ n, f (f n) < f (n + 1))
  : ∀ n, f n = n :=
begin
  have h2: ∀ (k n : ℕ), k ≤ n → k ≤ f n,
  { intro k,
     induction k with k h_ind,
     { intros n hn,
       exact nat.zero_le (f n), },
     { intros n hk,
       apply nat.succ_le_of_lt,
       rw nat.succ_eq_add_one at hk,
       have hk1: k ≤ n-1 := nat.le_sub_right_of_add_le hk,
       have hk2: k ≤ f (n-1):= h_ind (n-1) hk1,
       have hk3: k ≤ f(f(n-1)) := h_ind (f(n-1)) hk2,
       have h11: f (f (n-1)) < f(n-1+1):= h1 (n-1),
       rw nat.sub_add_cancel at h11,
       { calc k ≤ f(f(n-1)) : hk3
            ... < f(n)      : h11,},
       have hk0: 1 ≤ k+1 := nat.succ_le_succ (nat.zero_le k),
       exact (le_trans hk0 hk), }},
  have hf: ∀ n, n ≤ f n,
    { intro n,
      apply h2 n n,
      exact le_rfl, },
  have mon: ∀ n, f n < f(n+1),
    { intro n,
      exact lt_of_le_of_lt (hf (f n)) (h1 n), },
  have f_mon: strict_mono f := strict_mono.nat mon,
  intro n,
  apply nat.eq_of_le_of_lt_succ (hf n),
  exact (f_mon.lt_iff_lt.mp (h1 n)),
end

theorem imo1977_q62
  (f : ℕ+ → ℕ+)
  (h : ∀ n, f (f n) < f (n + 1))
  : ∀ n, f n = n :=
begin
  intro n,
  simpa using Extension (λ m, if 0 < m then f m.to_pnat' else 0) _ n,
  intro x,
  cases x,
  { simp },
  { simpa using h _},
end


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

! This file was ported from Lean 3 source module analysis.calculus.parametric_interval_integral
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.ParametricIntegral
import Mathbin.MeasureTheory.Integral.IntervalIntegral

/-!
# Derivatives of interval integrals depending on parameters

In this file we restate theorems about derivatives of integrals depending on parameters for interval
integrals.  -/

open TopologicalSpace MeasureTheory Filter Metric

open Topology Filter Interval

variable {𝕜 : Type _} [IsROrC 𝕜] {μ : Measure ℝ} {E : Type _} [NormedAddCommGroup E]
  [NormedSpace ℝ E] [NormedSpace 𝕜 E] [CompleteSpace E] {H : Type _} [NormedAddCommGroup H]
  [NormedSpace 𝕜 H] {a b ε : ℝ} {bound : ℝ → ℝ}

namespace intervalIntegral

/-- Differentiation under integral of `x ↦ ∫ t in a..b, F x t` at a given point `x₀`, assuming
`F x₀` is integrable, `x ↦ F x a` is locally Lipschitz on a ball around `x₀` for ae `a`
(with a ball radius independent of `a`) with integrable Lipschitz bound, and `F x` is ae-measurable
for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasFderivAt_integral_of_dominated_loc_of_lip {F : H → ℝ → E} {F' : ℝ → H →L[𝕜] E} {x₀ : H}
    (ε_pos : 0 < ε) (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) (μ.restrict (Ι a b)))
    (hF_int : IntervalIntegrable (F x₀) μ a b)
    (hF'_meas : AeStronglyMeasurable F' (μ.restrict (Ι a b)))
    (h_lip :
      ∀ᵐ t ∂μ, t ∈ Ι a b → LipschitzOnWith (Real.nnabs <| bound t) (fun x => F x t) (ball x₀ ε))
    (bound_integrable : IntervalIntegrable bound μ a b)
    (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → HasFderivAt (fun x => F x t) (F' t) x₀) :
    IntervalIntegrable F' μ a b ∧
      HasFderivAt (fun x => ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' t ∂μ) x₀ :=
  by
  simp only [intervalIntegrable_iff, interval_integral_eq_integral_uIoc, ←
    ae_restrict_iff' measurableSet_uIoc] at *
  have :=
    hasFderivAt_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas h_lip
      bound_integrable h_diff
  exact ⟨this.1, this.2.const_smul _⟩
#align interval_integral.has_fderiv_at_integral_of_dominated_loc_of_lip intervalIntegral.hasFderivAt_integral_of_dominated_loc_of_lip

/-- Differentiation under integral of `x ↦ ∫ F x a` at a given point `x₀`, assuming
`F x₀` is integrable, `x ↦ F x a` is differentiable on a ball around `x₀` for ae `a` with
derivative norm uniformly bounded by an integrable function (the ball radius is independent of `a`),
and `F x` is ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasFderivAt_integral_of_dominated_of_fderiv_le {F : H → ℝ → E} {F' : H → ℝ → H →L[𝕜] E}
    {x₀ : H} (ε_pos : 0 < ε)
    (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) (μ.restrict (Ι a b)))
    (hF_int : IntervalIntegrable (F x₀) μ a b)
    (hF'_meas : AeStronglyMeasurable (F' x₀) (μ.restrict (Ι a b)))
    (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ‖F' x t‖ ≤ bound t)
    (bound_integrable : IntervalIntegrable bound μ a b)
    (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, HasFderivAt (fun x => F x t) (F' x t) x) :
    HasFderivAt (fun x => ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' x₀ t ∂μ) x₀ :=
  by
  simp only [intervalIntegrable_iff, interval_integral_eq_integral_uIoc, ←
    ae_restrict_iff' measurableSet_uIoc] at *
  exact
    (hasFderivAt_integral_of_dominated_of_fderiv_le ε_pos hF_meas hF_int hF'_meas h_bound
          bound_integrable h_diff).const_smul
      _
#align interval_integral.has_fderiv_at_integral_of_dominated_of_fderiv_le intervalIntegral.hasFderivAt_integral_of_dominated_of_fderiv_le

/-- Derivative under integral of `x ↦ ∫ F x a` at a given point `x₀ : 𝕜`, `𝕜 = ℝ` or `𝕜 = ℂ`,
assuming `F x₀` is integrable, `x ↦ F x a` is locally Lipschitz on a ball around `x₀` for ae `a`
(with ball radius independent of `a`) with integrable Lipschitz bound, and `F x` is
ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasDerivAt_integral_of_dominated_loc_of_lip {F : 𝕜 → ℝ → E} {F' : ℝ → E} {x₀ : 𝕜}
    (ε_pos : 0 < ε) (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) (μ.restrict (Ι a b)))
    (hF_int : IntervalIntegrable (F x₀) μ a b)
    (hF'_meas : AeStronglyMeasurable F' (μ.restrict (Ι a b)))
    (h_lipsch :
      ∀ᵐ t ∂μ, t ∈ Ι a b → LipschitzOnWith (Real.nnabs <| bound t) (fun x => F x t) (ball x₀ ε))
    (bound_integrable : IntervalIntegrable (bound : ℝ → ℝ) μ a b)
    (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → HasDerivAt (fun x => F x t) (F' t) x₀) :
    IntervalIntegrable F' μ a b ∧
      HasDerivAt (fun x => ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' t ∂μ) x₀ :=
  by
  simp only [intervalIntegrable_iff, interval_integral_eq_integral_uIoc, ←
    ae_restrict_iff' measurableSet_uIoc] at *
  have :=
    hasDerivAt_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas h_lipsch
      bound_integrable h_diff
  exact ⟨this.1, this.2.const_smul _⟩
#align interval_integral.has_deriv_at_integral_of_dominated_loc_of_lip intervalIntegral.hasDerivAt_integral_of_dominated_loc_of_lip

/-- Derivative under integral of `x ↦ ∫ F x a` at a given point `x₀ : 𝕜`, `𝕜 = ℝ` or `𝕜 = ℂ`,
assuming `F x₀` is integrable, `x ↦ F x a` is differentiable on an interval around `x₀` for ae `a`
(with interval radius independent of `a`) with derivative uniformly bounded by an integrable
function, and `F x` is ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
theorem hasDerivAt_integral_of_dominated_loc_of_deriv_le {F : 𝕜 → ℝ → E} {F' : 𝕜 → ℝ → E} {x₀ : 𝕜}
    (ε_pos : 0 < ε) (hF_meas : ∀ᶠ x in 𝓝 x₀, AeStronglyMeasurable (F x) (μ.restrict (Ι a b)))
    (hF_int : IntervalIntegrable (F x₀) μ a b)
    (hF'_meas : AeStronglyMeasurable (F' x₀) (μ.restrict (Ι a b)))
    (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ‖F' x t‖ ≤ bound t)
    (bound_integrable : IntervalIntegrable bound μ a b)
    (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, HasDerivAt (fun x => F x t) (F' x t) x) :
    IntervalIntegrable (F' x₀) μ a b ∧
      HasDerivAt (fun x => ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' x₀ t ∂μ) x₀ :=
  by
  simp only [intervalIntegrable_iff, interval_integral_eq_integral_uIoc, ←
    ae_restrict_iff' measurableSet_uIoc] at *
  have :=
    hasDerivAt_integral_of_dominated_loc_of_deriv_le ε_pos hF_meas hF_int hF'_meas h_bound
      bound_integrable h_diff
  exact ⟨this.1, this.2.const_smul _⟩
#align interval_integral.has_deriv_at_integral_of_dominated_loc_of_deriv_le intervalIntegral.hasDerivAt_integral_of_dominated_loc_of_deriv_le

end intervalIntegral


import tactic
import data.int.parity
import data.int.modeq
import data.nat.factorization.basic
import number_theory.legendre_symbol.quadratic_reciprocity
import number_theory.class_number.number_field

open_locale classical big_operators polynomial number_field
noncomputable theory

def quad_poly (n : ℤ) (R : Type*) [comm_ring R] [is_domain R] : R[X] := polynomial.X^2 - n

@[derive [field, algebra ℚ, inhabited]]
def quad_field (n : ℤ): Type* := (quad_poly n ℚ).splitting_field

instance {n : ℤ} : polynomial.is_splitting_field ℚ (quad_field n) (quad_poly n ℚ) :=
begin
  apply polynomial.is_splitting_field.splitting_field,
end

instance quad_number_field (n : ℤ) :
  number_field (quad_field n) :=
{ to_char_zero := char_zero_of_injective_algebra_map (algebra_map ℚ (quad_field n)).injective,
  to_finite_dimensional := by {
    convert polynomial.is_splitting_field.finite_dimensional (quad_field n) (quad_poly n ℚ), } }

instance {p : ℤ}: is_fraction_ring (𝓞 (quad_field p )) (quad_field p ) :=
begin
 apply number_field.ring_of_integers.is_fraction_ring,
end

instance {n : ℤ} : finite_dimensional ℚ (quad_field n) :=
begin
  convert (quad_number_field n).to_finite_dimensional,
end

instance quad_class_group_finite {p : ℤ} :
  fintype (class_group (𝓞 (quad_field p )) (quad_field p )) :=
class_group.fintype_of_admissible_of_finite ℚ _ absolute_value.abs_is_admissible

def class_number_cond (n : ℤ) : Prop :=
(3 : ℕ).coprime $ fintype.card $
class_group (𝓞 $ quad_field n) $ quad_field n

def is_square_free (n : ℤ) : Prop := ¬ (∃ k, k^2 ∣ n)

--lemma key_lem (n : ℕ+) (x y : ℤ) (hn : is_square_free n) (hn4 : class_number_cond (-n))

lemma mordel_no_sol_fam (n : ℕ+) (x y : ℤ) (hn : is_square_free n)
(hn2 : n ≡ 1 [ZMOD4] ∨ n ≡ 2 [ZMOD 4]) (hn3 : ¬ ( ∃ a, n = 3*a^2 +1 ∨ n = 3*a^2 -1))
(hn4 : class_number_cond (-n)) :  y^2 ≠ x^3 - n :=
begin

sorry,

end


variables A B : Prop

premise P1 : (A->B)

example : not(A /\ not(B)) :=
assume H1: A /\ not(B),

show false, from
    (show not(B), from and.right H1)
    (show B, from P1 (show A, from and.left H1)).


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.basic
import Mathlib.PostPort

namespace Mathlib

namespace nat

/-- Euler's totient function. This counts the number of positive integers less than `n` which are
coprime with `n`. -/
def totient (n : ℕ) : ℕ := finset.card (finset.filter (coprime n) (finset.range n))

@[simp] theorem totient_zero : totient 0 = 0 := rfl

theorem totient_le (n : ℕ) : totient n ≤ n :=
  trans_rel_left LessEq
    (finset.card_le_of_subset (finset.filter_subset (coprime n) (finset.range n)))
    (finset.card_range n)

theorem totient_pos {n : ℕ} : 0 < n → 0 < totient n := sorry

theorem sum_totient (n : ℕ) :
    (finset.sum (finset.filter (fun (_x : ℕ) => _x ∣ n) (finset.range (Nat.succ n)))
          fun (m : ℕ) => totient m) =
        n :=
  sorry

end Mathlib


import tactic

-- Let X be the set {A,B,C}
@[derive fintype] inductive X
| A : X
| B : X
| C : X

open X

inductive R : X → X → Prop
| AB : R A B
| AC : R A C

instance : decidable_rel R :=
begin
  unfold decidable_rel,
  intros a b,
  cases a; cases b;
  [left, right, right, left, left, left, left, left, left];
  exact R.AB <|> exact R.AC <|> rintro (_ | _),
end

instance : decidable (transitive R) :=
begin
  unfold transitive,
  apply_instance,
end

theorem R_fst {x y : X} : R x y → x = A :=
begin
  rintro (hAB | hAC); refl
end

example : transitive R :=
begin
  exact dec_trivial,
  -- human proof below

  -- intros p q r,
  -- intros hpq hqr,
  -- have hp := R_fst hpq,
  -- subst hp,
  -- have hq := R_fst hqr,
  -- subst hq,
  -- assumption,
end


-- Union_con_la_imagen.lean
-- Unión con la imagen
-- José A. Alonso Jiménez
-- Sevilla, 20 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    f '' (s ∪ f ⁻¹' v) ⊆ f '' s ∪ v
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variable  s : set α
variable  v : set β

-- 1ª demostración
-- ===============

example : f '' (s ∪ f ⁻¹' v) ⊆ f '' s ∪ v :=
begin
  intros y hy,
  cases hy with x hx,
  cases hx with hx1 fxy,
  cases hx1 with xs xv,
  { left,
    use x,
    split,
    { exact xs, },
    { exact fxy, }},
  { right,
    rw ← fxy,
    exact xv, },
end

-- 2ª demostración
-- ===============

example : f '' (s ∪ f ⁻¹' v) ⊆ f '' s ∪ v :=
begin
  rintros y ⟨x, xs | xv, fxy⟩,
  { left,
    use [x, xs, fxy], },
  { right,
    rw ← fxy,
    exact xv, },
end

-- 3ª demostración
-- ===============

example : f '' (s ∪ f ⁻¹' v) ⊆ f '' s ∪ v :=
begin
  rintros y ⟨x, xs | xv, fxy⟩;
  finish,
end


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import field_theory.splitting_field
import ring_theory.integral_closure
import ring_theory.localization.integral

/-!
# Integrally closed rings

An integrally closed domain `R` contains all the elements of `Frac(R)` that are
integral over `R`. A special case of integrally closed domains are the Dedekind domains.

## Main definitions

* `is_integrally_closed R` states `R` contains all integral elements of `Frac(R)`

## Main results

* `is_integrally_closed_iff K`, where `K` is a fraction field of `R`, states `R`
  is integrally closed iff it is the integral closure of `R` in `K`
* `eq_map_mul_C_of_dvd`: if `K = Frac(R)` and `g : K[X]` divides a monic polynomial with
  coefficients in `R`, then `g * (C g.leading_coeff⁻¹)` has coefficients in `R`
-/

open_locale non_zero_divisors polynomial

open polynomial

/-- `R` is integrally closed if all integral elements of `Frac(R)` are also elements of `R`.

This definition uses `fraction_ring R` to denote `Frac(R)`. See `is_integrally_closed_iff`
if you want to choose another field of fractions for `R`.
-/
class is_integrally_closed (R : Type*) [comm_ring R] [is_domain R] : Prop :=
(algebra_map_eq_of_integral :
  ∀ {x : fraction_ring R}, is_integral R x → ∃ y, algebra_map R (fraction_ring R) y = x)

section iff

variables {R : Type*} [comm_ring R] [is_domain R]
variables (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]

/-- `R` is integrally closed iff all integral elements of its fraction field `K`
are also elements of `R`. -/
theorem is_integrally_closed_iff :
  is_integrally_closed R ↔ ∀ {x : K}, is_integral R x → ∃ y, algebra_map R K y = x :=
begin
  let e : K ≃ₐ[R] fraction_ring R := is_localization.alg_equiv R⁰_ _,
  split,
  { rintros ⟨cl⟩,
    refine λ x hx, _,
    obtain ⟨y, hy⟩ := cl ((is_integral_alg_equiv e).mpr hx),
    exact ⟨y, e.algebra_map_eq_apply.mp hy⟩ },
  { rintros cl,
    refine ⟨λ x hx, _⟩,
    obtain ⟨y, hy⟩ := cl ((is_integral_alg_equiv e.symm).mpr hx),
    exact ⟨y, e.symm.algebra_map_eq_apply.mp hy⟩ },
end

/-- `R` is integrally closed iff it is the integral closure of itself in its field of fractions. -/
theorem is_integrally_closed_iff_is_integral_closure :
  is_integrally_closed R ↔ is_integral_closure R R K :=
(is_integrally_closed_iff K).trans $
begin
  let e : K ≃ₐ[R] fraction_ring R := is_localization.alg_equiv R⁰_ _,
  split,
  { intros cl,
    refine ⟨is_fraction_ring.injective _ _, λ x, ⟨cl, _⟩⟩,
    rintros ⟨y, y_eq⟩,
    rw ← y_eq,
    exact is_integral_algebra_map },
  { rintros ⟨-, cl⟩ x hx,
    exact cl.mp hx }
end

end iff

namespace is_integrally_closed

variables {R : Type*} [comm_ring R] [id : is_domain R] [iic : is_integrally_closed R]
variables {K : Type*} [field K] [algebra R K] [ifr : is_fraction_ring R K]

include iic ifr

instance : is_integral_closure R R K := (is_integrally_closed_iff_is_integral_closure K).mp iic

lemma is_integral_iff {x : K} : is_integral R x ↔ ∃ y : R, algebra_map R K y = x :=
is_integral_closure.is_integral_iff

omit iic ifr

lemma exists_algebra_map_eq_of_pow_mem_subalgebra {K : Type*} [field K] [algebra R K]
  {S : subalgebra R K} [is_integrally_closed S] [is_fraction_ring S K] {x : K} {n : ℕ} (hn : 0 < n)
  (hx : x ^ n ∈ S) : ∃ y : S, algebra_map S K y = x :=
exists_algebra_map_eq_of_is_integral_pow hn $ is_integral_iff.mpr ⟨⟨x ^ n, hx⟩, rfl⟩

include id ifr

variables {R} (K)
lemma integral_closure_eq_bot_iff :
  integral_closure R K = ⊥ ↔ is_integrally_closed R :=
begin
  refine eq_bot_iff.trans _,
  split,
  { rw is_integrally_closed_iff K,
    intros h x hx,
    exact set.mem_range.mp (algebra.mem_bot.mp (h hx)),
    assumption },
  { intros h x hx,
    rw [algebra.mem_bot, set.mem_range],
    exactI is_integral_iff.mp hx },
end

include iic
variables (R K)
@[simp] lemma integral_closure_eq_bot : integral_closure R K = ⊥ :=
(integral_closure_eq_bot_iff K).mpr ‹_›

end is_integrally_closed

namespace integral_closure

open is_integrally_closed

variables {R : Type*} [comm_ring R]
variables (K : Type*) [field K] [algebra R K]

theorem mem_lifts_of_monic_of_dvd_map
  {f : R[X]} (hf : f.monic) {g : K[X]} (hg : g.monic) (hd : g ∣ f.map (algebra_map R K)) :
  g ∈ lifts (algebra_map (integral_closure R K) K) :=
begin
  haveI : is_scalar_tower R K g.splitting_field := splitting_field_aux.is_scalar_tower _ _ _,
  have := mem_lift_of_splits_of_roots_mem_range (integral_closure R g.splitting_field)
    ((splits_id_iff_splits _).2 $ splitting_field.splits g) (hg.map _)
    (λ a ha, (set_like.ext_iff.mp (integral_closure R g.splitting_field).range_algebra_map _).mpr $
      roots_mem_integral_closure hf _),
  { rw [lifts_iff_coeff_lifts, ←ring_hom.coe_range, subalgebra.range_algebra_map] at this,
    refine (lifts_iff_coeff_lifts _).2 (λ n, _),
    rw [← ring_hom.coe_range, subalgebra.range_algebra_map],
    obtain ⟨p, hp, he⟩ :=  (set_like.mem_coe.mp (this n)), use [p, hp],
    rw [is_scalar_tower.algebra_map_eq R K, coeff_map, ← eval₂_map, eval₂_at_apply] at he,
    rw eval₂_eq_eval_map, apply (injective_iff_map_eq_zero _).1 _ _ he,
    { apply ring_hom.injective } },
  rw [is_scalar_tower.algebra_map_eq R K _, ← map_map],
  refine multiset.mem_of_le (roots.le_of_dvd ((hf.map _).map _).ne_zero _) ha,
  { apply_instance },
  { exact map_dvd (algebra_map K g.splitting_field) hd },
  { apply splitting_field_aux.is_scalar_tower },
end

variables  [is_domain R] [is_fraction_ring R K]
variables {L : Type*} [field L] [algebra K L] [algebra R L] [is_scalar_tower R K L]

-- Can't be an instance because you need to supply `K`.
lemma is_integrally_closed_of_finite_extension [finite_dimensional K L] :
  is_integrally_closed (integral_closure R L) :=
begin
  letI : is_fraction_ring (integral_closure R L) L := is_fraction_ring_of_finite_extension K L,
  exact (integral_closure_eq_bot_iff L).mp integral_closure_idem
end

end integral_closure

namespace is_integrally_closed

open integral_closure

variables {R : Type*} [comm_ring R] [is_domain R]
variables (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]

/-- If `K = Frac(R)` and `g : K[X]` divides a monic polynomial with coefficients in `R`, then
    `g * (C g.leading_coeff⁻¹)` has coefficients in `R` -/
lemma eq_map_mul_C_of_dvd [is_integrally_closed R] {f : R[X]} (hf : f.monic)
  {g : K[X]} (hg : g ∣ f.map (algebra_map R K)) :
  ∃ g' : R[X], (g'.map (algebra_map R K)) * (C $ leading_coeff g) = g :=
begin
  have g_ne_0 : g ≠ 0 := ne_zero_of_dvd_ne_zero (monic.ne_zero $ hf.map (algebra_map R K)) hg,
  suffices lem : ∃ g' : R[X], g'.map (algebra_map R K) = g * (C g.leading_coeff⁻¹),
  { obtain ⟨g', hg'⟩ := lem,
    use g',
    rw [hg', mul_assoc, ← C_mul, inv_mul_cancel (leading_coeff_ne_zero.mpr g_ne_0), C_1, mul_one] },

  have g_mul_dvd : g * (C g.leading_coeff⁻¹) ∣ f.map (algebra_map R K),
  { rwa associated.dvd_iff_dvd_left (show associated (g * (C (g.leading_coeff⁻¹))) g, from _),
    rw associated_mul_is_unit_left_iff,
    exact is_unit_C.mpr (inv_ne_zero $ leading_coeff_ne_zero.mpr g_ne_0).is_unit },
  let algeq := (subalgebra.equiv_of_eq _ _ $ integral_closure_eq_bot R _).trans
    (algebra.bot_equiv_of_injective $ is_fraction_ring.injective R $ K),
  have : (algebra_map R _).comp algeq.to_alg_hom.to_ring_hom =
    (integral_closure R _).to_subring.subtype,
  { ext, conv_rhs { rw ← algeq.symm_apply_apply x }, refl },
  have H := ((mem_lifts _ ).1
      (mem_lifts_of_monic_of_dvd_map K hf (monic_mul_leading_coeff_inv g_ne_0) g_mul_dvd)),
  refine ⟨map algeq.to_alg_hom.to_ring_hom _, _⟩,
  use classical.some H,
  rw [map_map, this],
  exact classical.some_spec H
end

end is_integrally_closed


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import data.equiv.nat
import order.rel_iso
import order.directed

/-!
# Encodable types

This file defines encodable (constructively countable) types as a typeclass.
This is used to provide explicit encode/decode functions from and to `ℕ`, with the information that
those functions are inverses of each other.
The difference with `denumerable` is that finite types are encodable. For infinite types,
`encodable` and `denumerable` agree.

## Main declarations

* `encodable α`: States that there exists an explicit encoding function `encode : α → ℕ` with a
  partial inverse `decode : ℕ → option α`.
* `decode₂`: Version of `decode` that is equal to `none` outside of the range of `encode`. Useful as
  we do not require this in the definition of `decode`.
* `ulower α`: Any encodable type has an equivalent type living in the lowest universe, namely a
  subtype of `ℕ`. `ulower α` finds it.

## Implementation notes

The point of asking for an explicit partial inverse `decode : ℕ → option α` to `encode : α → ℕ` is
to make the range of `encode` decidable even when the finiteness of `α` is not.
-/

open option list nat function

/-- Constructively countable type. Made from an explicit injection `encode : α → ℕ` and a partial
inverse `decode : ℕ → option α`. Note that finite types *are* countable. See `denumerable` if you
wish to enforce infiniteness. -/
class encodable (α : Type*) :=
(encode : α → ℕ)
(decode [] : ℕ → option α)
(encodek : ∀ a, decode (encode a) = some a)

attribute [simp] encodable.encodek

namespace encodable
variables {α : Type*} {β : Type*}
universe u

theorem encode_injective [encodable α] : function.injective (@encode α _)
| x y e := option.some.inj $ by rw [← encodek, e, encodek]

lemma surjective_decode_iget (α : Type*) [encodable α] [inhabited α] :
  surjective (λ n, (encodable.decode α n).iget) :=
λ x, ⟨encodable.encode x, by simp_rw [encodable.encodek]⟩

/-- An encodable type has decidable equality. Not set as an instance because this is usually not the
best way to infer decidability. -/
def decidable_eq_of_encodable (α) [encodable α] : decidable_eq α
| a b := decidable_of_iff _ encode_injective.eq_iff

/-- If `α` is encodable and there is an injection `f : β → α`, then `β` is encodable as well. -/
def of_left_injection [encodable α]
  (f : β → α) (finv : α → option β) (linv : ∀ b, finv (f b) = some b) : encodable β :=
⟨λ b, encode (f b),
 λ n, (decode α n).bind finv,
 λ b, by simp [encodable.encodek, linv]⟩

/-- If `α` is encodable and `f : β → α` is invertible, then `β` is encodable as well. -/
def of_left_inverse [encodable α]
  (f : β → α) (finv : α → β) (linv : ∀ b, finv (f b) = b) : encodable β :=
of_left_injection f (some ∘ finv) (λ b, congr_arg some (linv b))

/-- Encodability is preserved by equivalence. -/
def of_equiv (α) [encodable α] (e : β ≃ α) : encodable β :=
of_left_inverse e e.symm e.left_inv

@[simp] theorem encode_of_equiv {α β} [encodable α] (e : β ≃ α) (b : β) :
  @encode _ (of_equiv _ e) b = encode (e b) := rfl

@[simp] theorem decode_of_equiv {α β} [encodable α] (e : β ≃ α) (n : ℕ) :
  @decode _ (of_equiv _ e) n = (decode α n).map e.symm := rfl

instance nat : encodable ℕ :=
⟨id, some, λ a, rfl⟩

@[simp] theorem encode_nat (n : ℕ) : encode n = n := rfl
@[simp] theorem decode_nat (n : ℕ) : decode ℕ n = some n := rfl

instance empty : encodable empty :=
⟨λ a, a.rec _, λ n, none, λ a, a.rec _⟩

instance unit : encodable punit :=
⟨λ_, zero, λ n, nat.cases_on n (some punit.star) (λ _, none), λ _, by simp⟩

@[simp] theorem encode_star : encode punit.star = 0 := rfl

@[simp] theorem decode_unit_zero : decode punit 0 = some punit.star := rfl
@[simp] theorem decode_unit_succ (n) : decode punit (succ n) = none := rfl

/-- If `α` is encodable, then so is `option α`. -/
instance option {α : Type*} [h : encodable α] : encodable (option α) :=
⟨λ o, option.cases_on o nat.zero (λ a, succ (encode a)),
 λ n, nat.cases_on n (some none) (λ m, (decode α m).map some),
 λ o, by cases o; dsimp; simp [encodek, nat.succ_ne_zero]⟩

@[simp] theorem encode_none [encodable α] : encode (@none α) = 0 := rfl
@[simp] theorem encode_some [encodable α] (a : α) :
  encode (some a) = succ (encode a) := rfl

@[simp] theorem decode_option_zero [encodable α] : decode (option α) 0 = some none := rfl
@[simp] theorem decode_option_succ [encodable α] (n) :
  decode (option α) (succ n) = (decode α n).map some := rfl

/-- Failsafe variant of `decode`. `decode₂ α n` returns the preimage of `n` under `encode` if it
exists, and returns `none` if it doesn't. This requirement could be imposed directly on `decode` but
is not to help make the definition easier to use. -/
def decode₂ (α) [encodable α] (n : ℕ) : option α :=
(decode α n).bind (option.guard (λ a, encode a = n))

theorem mem_decode₂' [encodable α] {n : ℕ} {a : α} :
  a ∈ decode₂ α n ↔ a ∈ decode α n ∧ encode a = n :=
by simp [decode₂]; exact
⟨λ ⟨_, h₁, rfl, h₂⟩, ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨_, h₁, rfl, h₂⟩⟩

theorem mem_decode₂ [encodable α] {n : ℕ} {a : α} :
  a ∈ decode₂ α n ↔ encode a = n :=
mem_decode₂'.trans (and_iff_right_of_imp $ λ e, e ▸ encodek _)

theorem decode₂_ne_none_iff [encodable α] {n : ℕ} :
  decode₂ α n ≠ none ↔ n ∈ set.range (encode : α → ℕ) :=
by simp_rw [set.range, set.mem_set_of_eq, ne.def, option.eq_none_iff_forall_not_mem,
  encodable.mem_decode₂, not_forall, not_not]

theorem decode₂_is_partial_inv [encodable α] : is_partial_inv encode (decode₂ α) :=
λ a n, mem_decode₂
theorem decode₂_inj [encodable α] {n : ℕ} {a₁ a₂ : α}
  (h₁ : a₁ ∈ decode₂ α n) (h₂ : a₂ ∈ decode₂ α n) : a₁ = a₂ :=
encode_injective $ (mem_decode₂.1 h₁).trans (mem_decode₂.1 h₂).symm

theorem encodek₂ [encodable α] (a : α) : decode₂ α (encode a) = some a :=
mem_decode₂.2 rfl

/-- The encoding function has decidable range. -/
def decidable_range_encode (α : Type*) [encodable α] : decidable_pred (∈ set.range (@encode α _)) :=
λ x, decidable_of_iff (option.is_some (decode₂ α x))
  ⟨λ h, ⟨option.get h, by rw [← decode₂_is_partial_inv (option.get h), option.some_get]⟩,
  λ ⟨n, hn⟩, by rw [← hn, encodek₂]; exact rfl⟩

/-- An encodable type is equivalent to the range of its encoding function. -/
def equiv_range_encode (α : Type*) [encodable α] : α ≃ set.range (@encode α _) :=
{ to_fun := λ a : α, ⟨encode a, set.mem_range_self _⟩,
  inv_fun := λ n, option.get (show is_some (decode₂ α n.1),
    by cases n.2 with x hx; rw [← hx, encodek₂]; exact rfl),
  left_inv := λ a, by dsimp;
    rw [← option.some_inj, option.some_get, encodek₂],
  right_inv := λ ⟨n, x, hx⟩, begin
    apply subtype.eq,
    dsimp,
    conv {to_rhs, rw ← hx},
    rw [encode_injective.eq_iff, ← option.some_inj, option.some_get, ← hx, encodek₂],
  end }

/-- A type with unique element is encodable. This is not an instance to avoid diamonds. -/
def _root_.unique.encodable [unique α] : encodable α :=
⟨λ _, 0, λ _, some (default α), unique.forall_iff.2 rfl⟩

section sum
variables [encodable α] [encodable β]

/-- Explicit encoding function for the sum of two encodable types. -/
def encode_sum : α ⊕ β → ℕ
| (sum.inl a) := bit0 $ encode a
| (sum.inr b) := bit1 $ encode b

/-- Explicit decoding function for the sum of two encodable types. -/
def decode_sum (n : ℕ) : option (α ⊕ β) :=
match bodd_div2 n with
| (ff, m) := (decode α m).map sum.inl
| (tt, m) := (decode β m).map sum.inr
end

/-- If `α` and `β` are encodable, then so is their sum. -/
instance sum : encodable (α ⊕ β) :=
⟨encode_sum, decode_sum, λ s,
  by cases s; simp [encode_sum, decode_sum, encodek]; refl⟩

@[simp] theorem encode_inl (a : α) :
  @encode (α ⊕ β) _ (sum.inl a) = bit0 (encode a) := rfl
@[simp] theorem encode_inr (b : β) :
  @encode (α ⊕ β) _ (sum.inr b) = bit1 (encode b) := rfl
@[simp] theorem decode_sum_val (n : ℕ) :
  decode (α ⊕ β) n = decode_sum n := rfl

end sum

instance bool : encodable bool :=
of_equiv (unit ⊕ unit) equiv.bool_equiv_punit_sum_punit

@[simp] theorem encode_tt : encode tt = 1 := rfl
@[simp] theorem encode_ff : encode ff = 0 := rfl

@[simp] theorem decode_zero : decode bool 0 = some ff := rfl
@[simp] theorem decode_one : decode bool 1 = some tt := rfl

theorem decode_ge_two (n) (h : 2 ≤ n) : decode bool n = none :=
begin
  suffices : decode_sum n = none,
  { change (decode_sum n).map _ = none, rw this, refl },
  have : 1 ≤ div2 n,
  { rw [div2_val, nat.le_div_iff_mul_le],
    exacts [h, dec_trivial] },
  cases exists_eq_succ_of_ne_zero (ne_of_gt this) with m e,
  simp [decode_sum]; cases bodd n; simp [decode_sum]; rw e; refl
end

noncomputable instance «Prop» : encodable Prop :=
of_equiv bool equiv.Prop_equiv_bool

section sigma
variables {γ : α → Type*} [encodable α] [∀ a, encodable (γ a)]

/-- Explicit encoding function for `sigma γ` -/
def encode_sigma : sigma γ → ℕ
| ⟨a, b⟩ := mkpair (encode a) (encode b)

/-- Explicit decoding function for `sigma γ` -/
def decode_sigma (n : ℕ) : option (sigma γ) :=
let (n₁, n₂) := unpair n in
(decode α n₁).bind $ λ a, (decode (γ a) n₂).map $ sigma.mk a

instance sigma : encodable (sigma γ) :=
⟨encode_sigma, decode_sigma, λ ⟨a, b⟩,
  by simp [encode_sigma, decode_sigma, unpair_mkpair, encodek]⟩

@[simp] theorem decode_sigma_val (n : ℕ) : decode (sigma γ) n =
  (decode α n.unpair.1).bind (λ a, (decode (γ a) n.unpair.2).map $ sigma.mk a) :=
show decode_sigma._match_1 _ = _, by cases n.unpair; refl

@[simp] theorem encode_sigma_val (a b) : @encode (sigma γ) _ ⟨a, b⟩ =
  mkpair (encode a) (encode b) := rfl

end sigma

section prod
variables [encodable α] [encodable β]

/-- If `α` and `β` are encodable, then so is their product. -/
instance prod : encodable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

@[simp] theorem decode_prod_val (n : ℕ) : decode (α × β) n =
  (decode α n.unpair.1).bind (λ a, (decode β n.unpair.2).map $ prod.mk a) :=
show (decode (sigma (λ _, β)) n).map (equiv.sigma_equiv_prod α β) = _,
by simp; cases decode α n.unpair.1; simp;
   cases decode β n.unpair.2; refl

@[simp] theorem encode_prod_val (a b) : @encode (α × β) _ (a, b) =
  mkpair (encode a) (encode b) := rfl

end prod

section subtype
open subtype decidable
variables {P : α → Prop} [encA : encodable α] [decP : decidable_pred P]
include encA

/-- Explicit encoding function for a decidable subtype of an encodable type -/
def encode_subtype : {a : α // P a} → ℕ
| ⟨v, h⟩ := encode v

include decP

/-- Explicit decoding function for a decidable subtype of an encodable type -/
def decode_subtype (v : ℕ) : option {a : α // P a} :=
(decode α v).bind $ λ a,
if h : P a then some ⟨a, h⟩ else none

/-- A decidable subtype of an encodable type is encodable. -/
instance subtype : encodable {a : α // P a} :=
⟨encode_subtype, decode_subtype,
 λ ⟨v, h⟩, by simp [encode_subtype, decode_subtype, encodek, h]⟩

lemma subtype.encode_eq (a : subtype P) : encode a = encode a.val :=
by cases a; refl

end subtype

instance fin (n) : encodable (fin n) :=
of_equiv _ (equiv.fin_equiv_subtype _)

instance int : encodable ℤ :=
of_equiv _ equiv.int_equiv_nat

instance pnat : encodable ℕ+ :=
of_equiv _ equiv.pnat_equiv_nat

/-- The lift of an encodable type is encodable. -/
instance ulift [encodable α] : encodable (ulift α) :=
of_equiv _ equiv.ulift

/-- The lift of an encodable type is encodable. -/
instance plift [encodable α] : encodable (plift α) :=
of_equiv _ equiv.plift

/-- If `β` is encodable and there is an injection `f : α → β`, then `α` is encodable as well. -/
noncomputable def of_inj [encodable β] (f : α → β) (hf : injective f) : encodable α :=
of_left_injection f (partial_inv f) (λ x, (partial_inv_of_injective hf _ _).2 rfl)

end encodable

section ulower
local attribute [instance, priority 100] encodable.decidable_range_encode

/-- `ulower α : Type` is an equivalent type in the lowest universe, given `encodable α`. -/
@[derive decidable_eq, derive encodable]
def ulower (α : Type*) [encodable α] : Type :=
set.range (encodable.encode : α → ℕ)

end ulower

namespace ulower
variables (α : Type*) [encodable α]

/-- The equivalence between the encodable type `α` and `ulower α : Type`. -/
def equiv : α ≃ ulower α :=
encodable.equiv_range_encode α

variables {α}

/-- Lowers an `a : α` into `ulower α`. -/
def down (a : α) : ulower α := equiv α a

instance [inhabited α] : inhabited (ulower α) := ⟨down (default _)⟩

/-- Lifts an `a : ulower α` into `α`. -/
def up (a : ulower α) : α := (equiv α).symm a

@[simp] lemma down_up {a : ulower α} : down a.up = a := equiv.right_inv _ _
@[simp] lemma up_down {a : α} : (down a).up = a := equiv.left_inv _ _

@[simp] lemma up_eq_up {a b : ulower α} : a.up = b.up ↔ a = b :=
equiv.apply_eq_iff_eq _

@[simp] lemma down_eq_down {a b : α} : down a = down b ↔ a = b :=
equiv.apply_eq_iff_eq _

@[ext] protected lemma ext {a b : ulower α} : a.up = b.up → a = b :=
up_eq_up.1

end ulower

/-
Choice function for encodable types and decidable predicates.
We provide the following API

choose      {α : Type*} {p : α → Prop} [c : encodable α] [d : decidable_pred p] : (∃ x, p x) → α :=
choose_spec {α : Type*} {p : α → Prop} [c : encodable α] [d : decidable_pred p] (ex : ∃ x, p x) :
  p (choose ex) :=
-/

namespace encodable
section find_a
variables {α : Type*} (p : α → Prop) [encodable α] [decidable_pred p]

private def good : option α → Prop
| (some a) := p a
| none     := false

private def decidable_good : decidable_pred (good p)
| n := by cases n; unfold good; apply_instance
local attribute [instance] decidable_good

open encodable
variable {p}

/-- Constructive choice function for a decidable subtype of an encodable type. -/
def choose_x (h : ∃ x, p x) : {a : α // p a} :=
have ∃ n, good p (decode α n), from
let ⟨w, pw⟩ := h in ⟨encode w, by simp [good, encodek, pw]⟩,
match _, nat.find_spec this : ∀ o, good p o → {a // p a} with
| some a, h := ⟨a, h⟩
end

/-- Constructive choice function for a decidable predicate over an encodable type. -/
def choose (h : ∃ x, p x) : α := (choose_x h).1

lemma choose_spec (h : ∃ x, p x) : p (choose h) := (choose_x h).2

end find_a

theorem axiom_of_choice {α : Type*} {β : α → Type*} {R : Π x, β x → Prop}
  [Π a, encodable (β a)] [∀ x y, decidable (R x y)]
  (H : ∀ x, ∃ y, R x y) : ∃ f : Π a, β a, ∀ x, R x (f x) :=
⟨λ x, choose (H x), λ x, choose_spec (H x)⟩

theorem skolem {α : Type*} {β : α → Type*} {P : Π x, β x → Prop}
  [c : Π a, encodable (β a)] [d : ∀ x y, decidable (P x y)] :
  (∀ x, ∃ y, P x y) ↔ ∃ f : Π a, β a, (∀ x, P x (f x)) :=
⟨axiom_of_choice, λ ⟨f, H⟩ x, ⟨_, H x⟩⟩

/-
There is a total ordering on the elements of an encodable type, induced by the map to ℕ.
-/

/-- The `encode` function, viewed as an embedding. -/
def encode' (α) [encodable α] : α ↪ ℕ :=
⟨encodable.encode, encodable.encode_injective⟩

instance {α} [encodable α] : is_trans _ (encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_trans
instance {α} [encodable α] : is_antisymm _ (encodable.encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_antisymm
instance {α} [encodable α] : is_total _ (encodable.encode' α ⁻¹'o (≤)) :=
(rel_embedding.preimage _ _).is_total

end encodable

namespace directed

open encodable

variables {α : Type*} {β : Type*} [encodable α] [inhabited α]

/-- Given a `directed r` function `f : α → β` defined on an encodable inhabited type,
construct a noncomputable sequence such that `r (f (x n)) (f (x (n + 1)))`
and `r (f a) (f (x (encode a + 1))`. -/
protected noncomputable def sequence {r : β → β → Prop} (f : α → β) (hf : directed r f) : ℕ → α
| 0       := default α
| (n + 1) :=
  let p := sequence n in
  match decode α n with
  | none     := classical.some (hf p p)
  | (some a) := classical.some (hf p a)
  end

lemma sequence_mono_nat {r : β → β → Prop} {f : α → β} (hf : directed r f) (n : ℕ) :
  r (f (hf.sequence f n)) (f (hf.sequence f (n+1))) :=
begin
  dsimp [directed.sequence],
  generalize eq : hf.sequence f n = p,
  cases h : decode α n with a,
  { exact (classical.some_spec (hf p p)).1 },
  { exact (classical.some_spec (hf p a)).1 }
end

lemma rel_sequence {r : β → β → Prop} {f : α → β} (hf : directed r f) (a : α) :
  r (f a) (f (hf.sequence f (encode a + 1))) :=
begin
  simp only [directed.sequence, encodek],
  exact (classical.some_spec (hf _ a)).2
end

variables [preorder β] {f : α → β} (hf : directed (≤) f)

lemma sequence_mono : monotone (f ∘ (hf.sequence f)) :=
monotone_nat_of_le_succ $ hf.sequence_mono_nat

lemma le_sequence (a : α) : f a ≤ f (hf.sequence f (encode a + 1)) :=
hf.rel_sequence a

end directed

section quotient
open encodable quotient
variables {α : Type*} {s : setoid α} [@decidable_rel α (≈)] [encodable α]

/-- Representative of an equivalence class. This is a computable version of `quot.out` for a setoid
on an encodable type. -/
def quotient.rep (q : quotient s) : α :=
choose (exists_rep q)

theorem quotient.rep_spec (q : quotient s) : ⟦q.rep⟧ = q :=
choose_spec (exists_rep q)

/-- The quotient of an encodable space by a decidable equivalence relation is encodable. -/
def encodable_quotient : encodable (quotient s) :=
⟨λ q, encode q.rep,
 λ n, quotient.mk <$> decode α n,
 by rintros ⟨l⟩; rw encodek; exact congr_arg some ⟦l⟧.rep_spec⟩

end quotient


import .love05_inductive_predicates_demo

/-! # LoVe Demo 11: Logical Foundations of Mathematics

We dive deeper into the logical foundations of Lean. Most of the features
described here are especially relevant for defining mathematical objects and
proving theorems about them. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Universes

Not only terms have a type, but also types have a type. For example, by the PAT
principle:

    `@and.intro : ∀a b, a → b → a ∧ b`

Moreover:

    `∀a b, a → b → a ∧ b : Prop`

Now, what is the type of `Prop`? `Prop` has the same type as virtually all other
types we have constructed so far:

    `Prop : Type`

What is the type of `Type`? The typing `Type : Type` would lead to a
contradiction, called **Girard's paradox**, resembling Russel's paradox.
Instead:

    `Type   : Type 1`
    `Type 1 : Type 2`
    `Type 2 : Type 3`
    ⋮

Aliases:

    `Type`   := `Type 0`
    `Prop`   := `Sort 0`
    `Type u` := `Sort (u + 1)`

The types of types (`Sort u`, `Type u`, and `Prop`) are called __universes__.
The `u` in `Sort u` is a __universe level__.

The hierarchy is captured by the following typing judgment:

    ————————————————————————— Sort
    C ⊢ Sort u : Sort (u + 1) -/

#check @and.intro
#check ∀a b : Prop, a → b → a ∧ b
#check Prop
#check ℕ
#check Type
#check Type 1
#check Type 2

universe variables u v

#check Type u

#check Sort 0
#check Sort 1
#check Sort 2
#check Sort u

#check Type*

/-! ## The Peculiarities of Prop

`Prop` is different from the other universes in many respects.

### Impredicativity

The function type `σ → τ` is put into the larger one of the universes that
`σ` and `τ` live in:

    C ⊢ σ : Type u    C ⊢ τ : Type v
    ————————————————————————————————— Arrow-Type
    C ⊢ σ → τ : Type (max u v)

For dependent types, this generalizes to

    C ⊢ σ : Type u    C, x : σ ⊢ τ[x] : Type v
    ——————————————————————————————————————————— Forall-Type
    C ⊢ (∀x : σ, τ[x]) : Type (max u v)

This behavior of the universes `Type v` is called __predicativity__.

To force expressions such as `∀a : Prop, a → a` to be of type `Prop` anyway, we
need a special typing rule for `Prop`:

    C ⊢ σ : Sort u    x : σ ⊢ τ[x] : Prop
    —————————————————————————————————————— Forall-Prop
    C ⊢ (∀x : σ, τ[x]) : Prop

This behavior of `Prop` is called __impredicativity__.

The rules `Forall-Type` and `Forall-Prop` can be generalized into a single rule:

    C ⊢ σ : Sort u    C, x : σ ⊢ τ[x] : Sort v
    ——————————————————————————————————————————— Forall
    C ⊢ (∀x : σ, τ[x]) : Sort (imax u v)

where

    `imax u 0       = 0`
    `imax u (v + 1) = max u (v + 1)` -/

#check λ(α : Type u) (β : Type v), α → β
#check ∀a : Prop, a → a

/-! ### Proof Irrelevance

A second difference between `Prop` and `Type u` is __proof irrelevance__:

    `∀(a : Prop) (h₁ h₂ : a), h₁ = h₂`

This and makes reasoning about dependent types easier.

When viewing a proposition as a type and a proof as an element of that type,
proof irrelevance means that a proposition is either an empty type or has
exactly one inhabitant.

Proof irrelevance can be proved `by refl`.

An unfortunate consequence of proof irrelevance is that it prevents us from
performing rule induction by pattern matching. -/

#check proof_irrel

lemma proof_irrel {a : Prop} (h₁ h₂ : a) :
  h₁ = h₂ :=
by refl

/-! ### No Large Elimination

A further difference between `Prop` and `Type u` is that `Prop` does not allow
__large elimination__, meaning that it impossible to extract data from a proof
of a proposition.

This is necessary to allow proof irrelevance. -/

#check 0

-- fails
def unsquare (i : ℤ) (hsq : ∃j, i = j * j) : ℤ :=
match hsq with
| Exists.intro j _ := j
end

/-! If the above were accepted, we could derive `false` as follows.

Let

    `hsq₁` := `Exists.intro 3 (by linarith)`
    `hsq₂` := `Exists.intro (-3) (by linarith)`

be two proofs of `∃j, (9 : ℤ) = j * j`. Then

    `unsquare 9 hsq₁ = 3`
    `unsquare 9 hsq₂ = -3`

However, by proof irrelevance, `hsq₁ = hsq₂`. Hence

    `unsquare 9 hsq₂ = 3`

Thus

    `3 = -3`

a contradiction.

As a compromise, Lean allows __small elimination__. It is called small
elimination because it eliminate only into `Prop`, whereas large elimination can
eliminate into an arbitrary large universe `Sort u`. This means we can use
`match` to analyze the structure of a proof, extract existential witnesses, and
so on, as long as the `match` expression is itself a proof. We have seen several
examples of this in lecture 5.

As a further compromise, Lean allows large elimination for
__syntactic subsingletons__: types in `Prop` for which it can be established
syntactically that they have cardinality 0 or 1. These are propositions such as
`false` and `a ∧ b` that can be proved in at most one way.

## The Axiom of Choice

Lean's logic includes the axiom of choice, which makes it possible to obtain an
arbitrary element from any nonempty type.

Consider Lean's `nonempty` inductive predicate: -/

#print nonempty

/-! The predicate states that `α` has at least one element.

To prove `nonempty α`, we must provide an `α` value to `nonempty.intro`: -/

lemma nat.nonempty :
  nonempty ℕ :=
nonempty.intro 0

/-! Since `nonempty` lives in `Prop`, large elimination is not available, and
thus we cannot extract the element that was used from a proof of `nonempty α`.

The axiom of choice allows us to obtain some element of type `α` if we can show
`nonempty α`: -/

#print classical.choice

/-! It will just give us an arbitrary element of `α`; we have no way of knowing
whether this is the element that was used to prove `nonempty α`.

The constant `classical.choice` is noncomputable, one of the reasons why some
logicians prefer to work without this axiom. -/

#eval classical.choice nat.nonempty     -- fails
#reduce classical.choice nat.nonempty   -- result: classical.choice _

/-! The axiom of choice is only an axiom in Lean's core library, giving users
the freedom to work with or without it.

Definitions using it must be marked as `noncomputable`: -/

noncomputable def arbitrary_nat : ℕ :=
classical.choice nat.nonempty

/-! The following tools rely on choice.

### Law of Excluded Middle -/

#check classical.em
#check classical.by_contradiction

/-! ### Hilbert Choice -/

#print classical.some
#print classical.some_spec

#check λ(p : ℕ → Prop) (h : ∃n : ℕ, p n), classical.some h
#check λ(p : ℕ → Prop) (h : ∃n : ℕ, p n), classical.some_spec h

/-! ### Set-Theoretic Axiom of Choice -/

#print classical.axiom_of_choice

/-! ## Subtypes

Subtyping is a mechanism to create new types from existing ones.

Given a predicate on the elements of the base type, the __subtype__ contains
only those elements of the base type that fulfill this property. More precisely,
the subtype contains element–proof pairs that combine an element of the base
type and a proof that it fulfills the property.

Subtyping is useful for those types that cannot be defined as an inductive
type. For example, any attempt at defining the type of finite sets along the
following lines is doomed to fail: -/

inductive finset (α : Type) : Type
| empty  : finset
| insert : α → finset → finset

/-! Given a base type and a property, the subtype has the syntax

    `{` _variable_ `:` _base-type_ `//` _property-applied-to-variable_ `}`

Example:

    `{i : ℕ // i ≤ n}`

Alias:

    `{x : τ // P[x]}` := `@subtype τ (λx, P[x])`

### First Example: Full Binary Trees -/

#check btree
#check is_full
#check mirror
#check is_full_mirror
#check mirror_mirror

def full_btree (α : Type) : Type :=
{t : btree α // is_full t}

#print subtype
#check subtype.mk

/-! To define elements of `full_btree`, we must provide a `btree` and a proof
that it is full: -/

def empty_full_btree : full_btree ℕ :=
subtype.mk btree.empty is_full.empty

def full_btree_6 : full_btree ℕ :=
subtype.mk (btree.node 6 btree.empty btree.empty)
  begin
    apply is_full.node,
    apply is_full.empty,
    apply is_full.empty,
    refl
  end

#reduce subtype.val full_btree_6
#check subtype.property full_btree_6

/-! We can lift existing operations on `btree` to `full_btree`: -/

def full_btree.mirror {α : Type} (t : full_btree α) :
  full_btree α :=
subtype.mk (mirror (subtype.val t))
  begin
    apply is_full_mirror,
    apply subtype.property t
  end

#reduce subtype.val (full_btree.mirror full_btree_6)

/-! And of course we can prove lemmas about the lifted operations: -/

lemma full_btree.mirror_mirror {α : Type} (t : full_btree α) :
  (full_btree.mirror (full_btree.mirror t)) = t :=
begin
  apply subtype.eq,
  simp [full_btree.mirror],
  apply mirror_mirror
end

#check subtype.eq

/-! ### Second Example: Vectors -/

#check vector

def vector (α : Type) (n : ℕ) : Type :=
{xs : list α // list.length xs = n}

def vector_123 : vector ℤ 3 :=
subtype.mk [1, 2, 3] (by refl)

def vector.neg {n : ℕ} (v : vector ℤ n) : vector ℤ n :=
subtype.mk (list.map int.neg (subtype.val v))
  begin
    rw list.length_map,
    exact subtype.property v
  end

lemma vector.neg_neg (n : ℕ) (v : vector ℤ n) :
  vector.neg (vector.neg v) = v :=
begin
  apply subtype.eq,
  simp [vector.neg]
end

#check finset

/-! ## Quotient Types

Quotients are a powerful construction in mathematics used to construct `ℤ`, `ℚ`,
`ℝ`, and many other types.

Like subtyping, quotienting constructs a new type from an existing type. Unlike
a subtype, a quotient type contains all of the elements of the base type, but
some elements that were different in the base type are considered equal in the
quotient type. In mathematical terms, the quotient type is isomorphic to a
partition of the base type.

To define a quotient type, we need to provide a type that it is derived from and
a equivalence relation on it that determines which elements are considered
equal. -/

#check quotient
#print setoid

#check quotient.mk
#check quotient.sound
#check quotient.exact

#check quotient.lift
#check quotient.lift₂
#check quotient.induction_on

/-! ## First Example: Integers

Let us build the integers `ℤ` as a quotient over pairs of natural numbers
`ℕ × ℕ`.

A pair `(p, n)` of natural numbers represents the integer `p - n`. Nonnegative
integers `p` can be represented by `(p, 0)`. Negative integers `-n` can be
represented by `(0, n)`. However, many representations of the same integer are
possible; e.g., `(7, 0)`, `(8, 1)`, `(9, 2)`, and `(10, 3)` all represent the
integer `7`.

Which equivalence relation can we use?

We want two pairs `(p₁, n₁)` and `(p₂, n₂)` to be equal if `p₁ - n₁ = p₂ - n₂`.
However, this does not work because subtraction on `ℕ` is ill-behaved (e.g.,
`0 - 1 = 0`). Instead, we use `p₁ + n₂ = p₂ + n₁`. -/

@[instance] def int.rel : setoid (ℕ × ℕ) :=
{ r     :=
    λpn₁ pn₂ : ℕ × ℕ,
      prod.fst pn₁ + prod.snd pn₂ = prod.fst pn₂ + prod.snd pn₁,
  iseqv :=
    begin
      repeat { apply and.intro },
      { intro pn,
        refl },
      { intros pn₁ pn₂ h,
        rw h },
      { intros pn₁ pn₂ pn₃ h₁₂ h₂₃,
        apply @add_right_cancel _ _ _ (prod.snd pn₂),
        cc }
    end }

#print equivalence

lemma int.rel_iff (pn₁ pn₂ : ℕ × ℕ) :
  pn₁ ≈ pn₂ ↔
  prod.fst pn₁ + prod.snd pn₂ = prod.fst pn₂ + prod.snd pn₁ :=
by refl

def int : Type :=
quotient int.rel

def int.zero : int :=
⟦(0, 0)⟧

lemma int.zero_eq (m : ℕ) :
  int.zero = ⟦(m, m)⟧ :=
begin
  rw int.zero,
  apply quotient.sound,
  rw int.rel_iff,
  simp
end

def int.add : int → int → int :=
quotient.lift₂
  (λpn₁ pn₂ : ℕ × ℕ,
     ⟦(prod.fst pn₁ + prod.fst pn₂,
       prod.snd pn₁ + prod.snd pn₂)⟧)
  begin
    intros pn₁ pn₂ pn₁' pn₂' h₁ h₂,
    apply quotient.sound,
    rw int.rel_iff at *,
    linarith
  end

lemma int.add_eq (p₁ n₁ p₂ n₂ : ℕ) :
  int.add ⟦(p₁, n₁)⟧ ⟦(p₂, n₂)⟧ = ⟦(p₁ + p₂, n₁ + n₂)⟧ :=
by refl

lemma int.add_zero (i : int) :
  int.add int.zero i = i :=
begin
  apply quotient.induction_on i,
  intro pn,
  rw int.zero,
  cases' pn with p n,
  rw int.add_eq,
  apply quotient.sound,
  simp
end

/-! This definitional syntax would be nice: -/

-- fails
def int.add : int → int → int
| ⟦(p₁, n₁)⟧ ⟦(p₂, n₂)⟧ := ⟦(p₁ + p₂, n₁ + n₂)⟧

/-! But it would be dangerous: -/

-- fails
def int.fst : int → ℕ
| ⟦(p, n)⟧ := p

/-! Using `int.fst`, we could derive `false`. First, we have

    `int.fst ⟦(0, 0)⟧ = 0`
    `int.fst ⟦(1, 1)⟧ = 1`

But since `⟦(0, 0)⟧ = ⟦(1, 1)⟧`, we get

    `0 = 1` -/

/-! ### Second Example: Unordered Pairs

__Unordered pairs__ are pairs for which no distinction is made between the first
and second components. They are usually written `{a, b}`.

We will introduce the type `upair` of unordered pairs as the quotient of pairs
`(a, b)` with respect to the relation "contains the same elements as". -/

@[instance] def upair.rel (α : Type) : setoid (α × α) :=
{ r     := λab₁ ab₂ : α × α,
    ({prod.fst ab₁, prod.snd ab₁} : set α) =
    ({prod.fst ab₂, prod.snd ab₂} : set α),
  iseqv := by repeat { apply and.intro }; finish }

-- needed for technical reasons, to deprioritize `upair.rel` w.r.t. `int.rel`
attribute [instance, priority 999] upair.rel

lemma upair.rel_iff {α : Type} (ab₁ ab₂ : α × α) :
  ab₁ ≈ ab₂ ↔
  ({prod.fst ab₁, prod.snd ab₁} : set α) =
  ({prod.fst ab₂, prod.snd ab₂} : set α) :=
by refl

def upair (α : Type) : Type :=
quotient (upair.rel α)

def upair.mk {α : Type} (a b : α) : upair α :=
⟦(a, b)⟧

/-! It is easy to prove that the `upair.mk` constructor is symmetric: -/

lemma upair.mk_symm {α : Type} (a b : α) :
  upair.mk a b = upair.mk b a :=
begin
  unfold upair.mk,
  apply quotient.sound,
  rw upair.rel_iff,
  apply set.union_comm
end

/-! Another representation of unordered pairs is as sets of cardinality 1 or 2.
The following operation converts `upair` to that representation: -/

def set_of_upair {α : Type} : upair α → set α :=
quotient.lift (λab : α × α, {prod.fst ab, prod.snd ab})
  begin
    intros ab₁ ab₂ h,
    rw upair.rel_iff at *,
    exact h
  end

/-! ### Alternative Definitions via Normalization and Subtyping

Each element of a quotient type correspond to an `≈`-equivalence class.
If there exists a systematic way to obtain a **canonical representative** for
each class, we can use a subtype instead of a quotient, keeping only the
canonical representatives.

Consider the quotient type `int` above. We could say that a pair `(p, n)` is
__canonical__ if `p` or `n` is `0`. -/

namespace alternative

inductive int.is_canonical : ℕ × ℕ → Prop
| nonpos {n : ℕ} : int.is_canonical (0, n)
| nonneg {p : ℕ} : int.is_canonical (p, 0)

def int : Type :=
{pn : ℕ × ℕ // int.is_canonical pn}

/-! **Normalizing** pairs of natural numbers is easy: -/

def int.normalize : ℕ × ℕ → ℕ × ℕ
| (p, n) := if p ≥ n then (p - n, 0) else (0, n - p)

lemma int.is_canonical_normalize (pn : ℕ × ℕ) :
  int.is_canonical (int.normalize pn) :=
begin
  cases' pn with p n,
  simp [int.normalize],
  split_ifs,
  { exact int.is_canonical.nonneg },
  { exact int.is_canonical.nonpos }
end

/-! For unordered pairs, there is no obvious normal form, except to always put
the smaller element first (or last). This requires a linear order `≤` on `α`. -/

def upair.is_canonical {α : Type} [linear_order α] :
  α × α → Prop
| (a, b) := a ≤ b

def upair (α : Type) [linear_order α] : Type :=
{ab : α × α // upair.is_canonical ab}

end alternative

end LoVe


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import logic.function.iterate
import data.nat.basic

/-!
# Inequalities on iterates

In this file we prove some inequalities comparing `f^[n] x` and `g^[n] x` where `f` and `g` are
two self-maps that commute with each other.

Current selection of inequalities is motivated by formalization of the rotation number of
a circle homeomorphism.
-/
variables {α β : Type*}
open function

namespace monotone

variables [preorder α] {f : α → α} {x y : ℕ → α}

/-!
### Comparison of two sequences

If $f$ is a monotone function, then $∀ k, x_{k+1} ≤ f(x_k)$ implies that $x_k$ grows slower than
$f^k(x_0)$, and similarly for the reversed inequalities. If $x_k$ and $y_k$ are two sequences such
that $x_{k+1} ≤ f(x_k)$ and $y_{k+1} ≥ f(y_k)$ for all $k < n$, then $x_0 ≤ y_0$ implies
$x_n ≤ y_n$, see `monotone.seq_le_seq`.

If some of the inequalities in this lemma are strict, then we have $x_n < y_n$. The rest of the
lemmas in this section formalize this fact for different inequalities made strict.
-/

lemma seq_le_seq (hf : monotone f) (n : ℕ) (h₀ : x 0 ≤ y 0)
  (hx : ∀ k < n, x (k + 1) ≤ f (x k)) (hy : ∀ k < n, f (y k) ≤ y (k + 1)) :
  x n ≤ y n :=
begin
  induction n with n ihn,
  { exact h₀ },
  { refine (hx _ n.lt_succ_self).trans ((hf $ ihn _ _).trans (hy _ n.lt_succ_self)),
    exact λ k hk, hx _ (hk.trans n.lt_succ_self),
    exact λ k hk, hy _ (hk.trans n.lt_succ_self) }
end

lemma seq_pos_lt_seq_of_lt_of_le (hf : monotone f) {n : ℕ} (hn : 0 < n) (h₀ : x 0 ≤ y 0)
  (hx : ∀ k < n, x (k + 1) < f (x k)) (hy : ∀ k < n, f (y k) ≤ y (k + 1)) :
  x n < y n :=
begin
  induction n with n ihn, { exact hn.false.elim },
  suffices : x n ≤ y n,
    from (hx n n.lt_succ_self).trans_le ((hf this).trans $ hy n n.lt_succ_self),
  cases n, { exact h₀ },
  refine (ihn n.zero_lt_succ (λ k hk, hx _ _) (λ k hk, hy _ _)).le;
    exact hk.trans n.succ.lt_succ_self
end

lemma seq_pos_lt_seq_of_le_of_lt (hf : monotone f) {n : ℕ} (hn : 0 < n) (h₀ : x 0 ≤ y 0)
  (hx : ∀ k < n, x (k + 1) ≤ f (x k)) (hy : ∀ k < n, f (y k) < y (k + 1)) :
  x n < y n :=
hf.dual.seq_pos_lt_seq_of_lt_of_le hn h₀ hy hx

lemma seq_lt_seq_of_lt_of_le (hf : monotone f) (n : ℕ) (h₀ : x 0 < y 0)
  (hx : ∀ k < n, x (k + 1) < f (x k)) (hy : ∀ k < n, f (y k) ≤ y (k + 1)) :
  x n < y n :=
by { cases n, exacts [h₀, hf.seq_pos_lt_seq_of_lt_of_le n.zero_lt_succ h₀.le hx hy] }

lemma seq_lt_seq_of_le_of_lt (hf : monotone f) (n : ℕ) (h₀ : x 0 < y 0)
  (hx : ∀ k < n, x (k + 1) ≤ f (x k)) (hy : ∀ k < n, f (y k) < y (k + 1)) :
  x n < y n :=
hf.dual.seq_lt_seq_of_lt_of_le n h₀ hy hx

/-!
### Iterates of two functions

In this section we compare the iterates of a monotone function `f : α → α` to iterates of any
function `g : β → β`. If `h : β → α` satisfies `h ∘ g ≤ f ∘ h`, then `h (g^[n] x)` grows slower
than `f^[n] (h x)`, and similarly for the reversed inequality.

Then we specialize these two lemmas to the case `β = α`, `h = id`.
-/

variables {g : β → β} {h : β → α}
open function

lemma le_iterate_comp_of_le (hf : monotone f) (H : h ∘ g ≤ f ∘ h) (n : ℕ) :
  h ∘ (g^[n]) ≤ (f^[n]) ∘ h :=
λ x, by refine hf.seq_le_seq n _ (λ k hk, _) (λ k hk, _); simp [iterate_succ', H _]

lemma iterate_comp_le_of_le (hf : monotone f) (H : f ∘ h ≤ h ∘ g) (n : ℕ) :
  f^[n] ∘ h ≤ h ∘ (g^[n]) :=
hf.dual.le_iterate_comp_of_le H n

/-- If `f ≤ g` and `f` is monotone, then `f^[n] ≤ g^[n]`. -/

/-- If `f ≤ g` and `g` is monotone, then `f^[n] ≤ g^[n]`. -/
lemma le_iterate_of_le {g : α → α} (hg : monotone g) (h : f ≤ g) (n : ℕ) :
  f^[n] ≤ (g^[n]) :=
hg.dual.iterate_le_of_le h n

end monotone

/-!
### Comparison of iterations and the identity function

If $f(x) ≤ x$ for all $x$ (we express this as `f ≤ id` in the code), then the same is true for
any iterate of $f$, and similarly for the reversed inequality.
-/

namespace function

section preorder
variables [preorder α] {f : α → α}

/-- If $x ≤ f x$ for all $x$ (we write this as `id ≤ f`), then the same is true for any iterate
`f^[n]` of `f`. -/
lemma id_le_iterate_of_id_le (h : id ≤ f) (n : ℕ) : id ≤ (f^[n]) :=
by simpa only [iterate_id] using monotone_id.iterate_le_of_le h n

lemma iterate_le_id_of_le_id (h : f ≤ id) (n : ℕ) : (f^[n]) ≤ id :=
@id_le_iterate_of_id_le (order_dual α) _ f h n

lemma monotone_iterate_of_id_le (h : id ≤ f) : monotone (λ m, f^[m]) :=
monotone_nat_of_le_succ $ λ n x, by { rw iterate_succ_apply', exact h _ }

lemma antitone_iterate_of_le_id (h : f ≤ id) : antitone (λ m, f^[m]) :=
λ m n hmn, @monotone_iterate_of_id_le (order_dual α) _ f h m n hmn

end preorder

/-!
### Iterates of commuting functions

If `f` and `g` are monotone and commute, then `f x ≤ g x` implies `f^[n] x ≤ g^[n] x`, see
`function.commute.iterate_le_of_map_le`. We also prove two strict inequality versions of this lemma,
as well as `iff` versions.
-/

namespace commute

section preorder
variables [preorder α] {f g : α → α}

lemma iterate_le_of_map_le (h : commute f g) (hf : monotone f)  (hg : monotone g)
  {x} (hx : f x ≤ g x) (n : ℕ) :
  f^[n] x ≤ (g^[n]) x :=
by refine hf.seq_le_seq n _ (λ k hk, _) (λ k hk, _);
  simp [iterate_succ' f, h.iterate_right _ _, hg.iterate _ hx]

lemma iterate_pos_lt_of_map_lt (h : commute f g) (hf : monotone f) (hg : strict_mono g)
  {x} (hx : f x < g x) {n} (hn : 0 < n) :
  f^[n] x < (g^[n]) x :=
by refine hf.seq_pos_lt_seq_of_le_of_lt hn _ (λ k hk, _) (λ k hk, _);
  simp [iterate_succ' f, h.iterate_right _ _, hg.iterate _ hx]

lemma iterate_pos_lt_of_map_lt' (h : commute f g) (hf : strict_mono f) (hg : monotone g)
  {x} (hx : f x < g x) {n} (hn : 0 < n) :
  f^[n] x < (g^[n]) x :=
@iterate_pos_lt_of_map_lt (order_dual α) _ g f h.symm hg.dual hf.dual x hx n hn

end preorder

variables [linear_order α] {f g : α → α}

lemma iterate_pos_lt_iff_map_lt (h : commute f g) (hf : monotone f)
  (hg : strict_mono g) {x n} (hn : 0 < n) :
  f^[n] x < (g^[n]) x ↔ f x < g x :=
begin
  rcases lt_trichotomy (f x) (g x) with H|H|H,
  { simp only [*, iterate_pos_lt_of_map_lt] },
  { simp only [*, h.iterate_eq_of_map_eq, lt_irrefl] },
  { simp only [lt_asymm H, lt_asymm (h.symm.iterate_pos_lt_of_map_lt' hg hf H hn)] }
end

lemma iterate_pos_lt_iff_map_lt' (h : commute f g) (hf : strict_mono f)
  (hg : monotone g) {x n} (hn : 0 < n) :
  f^[n] x < (g^[n]) x ↔ f x < g x :=
@iterate_pos_lt_iff_map_lt (order_dual α) _ _ _ h.symm hg.dual hf.dual x n hn

lemma iterate_pos_le_iff_map_le (h : commute f g) (hf : monotone f)
  (hg : strict_mono g) {x n} (hn : 0 < n) :
  f^[n] x ≤ (g^[n]) x ↔ f x ≤ g x :=
by simpa only [not_lt] using not_congr (h.symm.iterate_pos_lt_iff_map_lt' hg hf hn)

lemma iterate_pos_le_iff_map_le' (h : commute f g) (hf : strict_mono f)
  (hg : monotone g) {x n} (hn : 0 < n) :
  f^[n] x ≤ (g^[n]) x ↔ f x ≤ g x :=
by simpa only [not_lt] using not_congr (h.symm.iterate_pos_lt_iff_map_lt hg hf hn)

lemma iterate_pos_eq_iff_map_eq (h : commute f g) (hf : monotone f)
  (hg : strict_mono g) {x n} (hn : 0 < n) :
  f^[n] x = (g^[n]) x ↔ f x = g x :=
by simp only [le_antisymm_iff, h.iterate_pos_le_iff_map_le hf hg hn,
  h.symm.iterate_pos_le_iff_map_le' hg hf hn]

end commute

end function

namespace monotone

variables [preorder α] {f : α → α} {x : α}

/-- If `f` is a monotone map and `x ≤ f x` at some point `x`, then the iterates `f^[n] x` form
a monotone sequence. -/
lemma monotone_iterate_of_le_map (hf : monotone f) (hx : x ≤ f x) : monotone (λ n, f^[n] x) :=
monotone_nat_of_le_succ $ λ n, by { rw iterate_succ_apply, exact hf.iterate n hx  }

/-- If `f` is a monotone map and `f x ≤ x` at some point `x`, then the iterates `f^[n] x` form
a antitone sequence. -/
lemma antitone_iterate_of_map_le (hf : monotone f) (hx : f x ≤ x) : antitone (λ n, f^[n] x) :=
hf.dual.monotone_iterate_of_le_map hx

end monotone

namespace strict_mono

variables [preorder α] {f : α → α} {x : α}

/-- If `f` is a strictly monotone map and `x < f x` at some point `x`, then the iterates `f^[n] x`
form a strictly monotone sequence. -/
lemma strict_mono_iterate_of_lt_map (hf : strict_mono f) (hx : x < f x) :
  strict_mono (λ n, f^[n] x) :=
strict_mono_nat_of_lt_succ $ λ n, by { rw iterate_succ_apply, exact hf.iterate n hx  }

/-- If `f` is a strictly antitone map and `f x < x` at some point `x`, then the iterates `f^[n] x`
form a strictly antitone sequence. -/
lemma strict_anti_iterate_of_map_lt (hf : strict_mono f) (hx : f x < x) :
  strict_anti (λ n, f^[n] x) :=
hf.dual.strict_mono_iterate_of_lt_map hx

end strict_mono