/-
Copyright (c) 2022 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.complex.unit_disc.basic
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Complex.Circle
import Mathbin.Analysis.NormedSpace.BallAction

/-!
# Poincaré disc

In this file we define `complex.unit_disc` to be the unit disc in the complex plane. We also
introduce some basic operations on this disc.
-/

open Set Function Metric

open BigOperators

noncomputable section

-- mathport name: exprconj'
local notation "conj'" => starRingEnd ℂ

namespace Complex

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler λ α,
has_coe[has_coe] α exprℂ() -/
/-- Complex unit disc. -/
def UnitDisc : Type :=
  ball (0 : ℂ) 1deriving CommSemigroup, HasDistribNeg,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler λ α,
  has_coe[has_coe] α exprℂ()», TopologicalSpace
#align complex.unit_disc Complex.UnitDisc

-- mathport name: expr𝔻
scoped[UnitDisc] notation "𝔻" => Complex.UnitDisc

namespace UnitDisc

theorem coe_injective : Injective (coe : 𝔻 → ℂ) :=
  Subtype.coe_injective
#align complex.unit_disc.coe_injective Complex.UnitDisc.coe_injective

theorem abs_lt_one (z : 𝔻) : abs (z : ℂ) < 1 :=
  mem_ball_zero_iff.1 z.2
#align complex.unit_disc.abs_lt_one Complex.UnitDisc.abs_lt_one

theorem abs_ne_one (z : 𝔻) : abs (z : ℂ) ≠ 1 :=
  z.abs_lt_one.Ne
#align complex.unit_disc.abs_ne_one Complex.UnitDisc.abs_ne_one

theorem normSq_lt_one (z : 𝔻) : normSq z < 1 :=
  @one_pow ℝ _ 2 ▸ (Real.sqrt_lt' one_pos).1 z.abs_lt_one
#align complex.unit_disc.norm_sq_lt_one Complex.UnitDisc.normSq_lt_one

theorem coe_ne_one (z : 𝔻) : (z : ℂ) ≠ 1 :=
  ne_of_apply_ne abs <| (map_one abs).symm ▸ z.abs_ne_one
#align complex.unit_disc.coe_ne_one Complex.UnitDisc.coe_ne_one

theorem coe_ne_neg_one (z : 𝔻) : (z : ℂ) ≠ -1 :=
  ne_of_apply_ne abs <| by
    rw [abs.map_neg, map_one]
    exact z.abs_ne_one
#align complex.unit_disc.coe_ne_neg_one Complex.UnitDisc.coe_ne_neg_one

theorem one_add_coe_ne_zero (z : 𝔻) : (1 + z : ℂ) ≠ 0 :=
  mt neg_eq_iff_add_eq_zero.2 z.coe_ne_neg_one.symm
#align complex.unit_disc.one_add_coe_ne_zero Complex.UnitDisc.one_add_coe_ne_zero

@[simp, norm_cast]
theorem coe_mul (z w : 𝔻) : ↑(z * w) = (z * w : ℂ) :=
  rfl
#align complex.unit_disc.coe_mul Complex.UnitDisc.coe_mul

/-- A constructor that assumes `abs z < 1` instead of `dist z 0 < 1` and returns an element
of `𝔻` instead of `↥metric.ball (0 : ℂ) 1`. -/
def mk (z : ℂ) (hz : abs z < 1) : 𝔻 :=
  ⟨z, mem_ball_zero_iff.2 hz⟩
#align complex.unit_disc.mk Complex.UnitDisc.mk

@[simp]
theorem coe_mk (z : ℂ) (hz : abs z < 1) : (mk z hz : ℂ) = z :=
  rfl
#align complex.unit_disc.coe_mk Complex.UnitDisc.coe_mk

@[simp]
theorem mk_coe (z : 𝔻) (hz : abs (z : ℂ) < 1 := z.abs_lt_one) : mk z hz = z :=
  Subtype.eta _ _
#align complex.unit_disc.mk_coe Complex.UnitDisc.mk_coe

@[simp]
theorem mk_neg (z : ℂ) (hz : abs (-z) < 1) : mk (-z) hz = -mk z (abs.map_neg z ▸ hz) :=
  rfl
#align complex.unit_disc.mk_neg Complex.UnitDisc.mk_neg

instance : SemigroupWithZero 𝔻 :=
  {
    UnitDisc.commSemigroup with
    zero := mk 0 <| (map_zero _).trans_lt one_pos
    zero_mul := fun z => coe_injective <| MulZeroClass.zero_mul _
    mul_zero := fun z => coe_injective <| MulZeroClass.mul_zero _ }

@[simp]
theorem coe_zero : ((0 : 𝔻) : ℂ) = 0 :=
  rfl
#align complex.unit_disc.coe_zero Complex.UnitDisc.coe_zero

@[simp]
theorem coe_eq_zero {z : 𝔻} : (z : ℂ) = 0 ↔ z = 0 :=
  coe_injective.eq_iff' coe_zero
#align complex.unit_disc.coe_eq_zero Complex.UnitDisc.coe_eq_zero

instance : Inhabited 𝔻 :=
  ⟨0⟩

instance circleAction : MulAction circle 𝔻 :=
  mulActionSphereBall
#align complex.unit_disc.circle_action Complex.UnitDisc.circleAction

instance isScalarTower_circle_circle : IsScalarTower circle circle 𝔻 :=
  isScalarTower_sphere_sphere_ball
#align complex.unit_disc.is_scalar_tower_circle_circle Complex.UnitDisc.isScalarTower_circle_circle

instance isScalarTower_circle : IsScalarTower circle 𝔻 𝔻 :=
  isScalarTower_sphere_ball_ball
#align complex.unit_disc.is_scalar_tower_circle Complex.UnitDisc.isScalarTower_circle

instance sMulCommClass_circle : SMulCommClass circle 𝔻 𝔻 :=
  sMulCommClass_sphere_ball_ball
#align complex.unit_disc.smul_comm_class_circle Complex.UnitDisc.sMulCommClass_circle

instance sMulCommClass_circle' : SMulCommClass 𝔻 circle 𝔻 :=
  SMulCommClass.symm _ _ _
#align complex.unit_disc.smul_comm_class_circle' Complex.UnitDisc.sMulCommClass_circle'

@[simp, norm_cast]
theorem coe_smul_circle (z : circle) (w : 𝔻) : ↑(z • w) = (z * w : ℂ) :=
  rfl
#align complex.unit_disc.coe_smul_circle Complex.UnitDisc.coe_smul_circle

instance closedBallAction : MulAction (closedBall (0 : ℂ) 1) 𝔻 :=
  mulActionClosedBallBall
#align complex.unit_disc.closed_ball_action Complex.UnitDisc.closedBallAction

instance isScalarTower_closedBall_closedBall :
    IsScalarTower (closedBall (0 : ℂ) 1) (closedBall (0 : ℂ) 1) 𝔻 :=
  isScalarTower_closedBall_closedBall_ball
#align complex.unit_disc.is_scalar_tower_closed_ball_closed_ball Complex.UnitDisc.isScalarTower_closedBall_closedBall

instance isScalarTower_closedBall : IsScalarTower (closedBall (0 : ℂ) 1) 𝔻 𝔻 :=
  isScalarTower_closedBall_ball_ball
#align complex.unit_disc.is_scalar_tower_closed_ball Complex.UnitDisc.isScalarTower_closedBall

instance sMulCommClass_closedBall : SMulCommClass (closedBall (0 : ℂ) 1) 𝔻 𝔻 :=
  ⟨fun a b c => Subtype.ext <| mul_left_comm _ _ _⟩
#align complex.unit_disc.smul_comm_class_closed_ball Complex.UnitDisc.sMulCommClass_closedBall

instance sMulCommClass_closed_ball' : SMulCommClass 𝔻 (closedBall (0 : ℂ) 1) 𝔻 :=
  SMulCommClass.symm _ _ _
#align complex.unit_disc.smul_comm_class_closed_ball' Complex.UnitDisc.sMulCommClass_closed_ball'

instance sMulCommClass_circle_closedBall : SMulCommClass circle (closedBall (0 : ℂ) 1) 𝔻 :=
  sMulCommClass_sphere_closedBall_ball
#align complex.unit_disc.smul_comm_class_circle_closed_ball Complex.UnitDisc.sMulCommClass_circle_closedBall

instance sMulCommClass_closedBall_circle : SMulCommClass (closedBall (0 : ℂ) 1) circle 𝔻 :=
  SMulCommClass.symm _ _ _
#align complex.unit_disc.smul_comm_class_closed_ball_circle Complex.UnitDisc.sMulCommClass_closedBall_circle

@[simp, norm_cast]
theorem coe_smul_closedBall (z : closedBall (0 : ℂ) 1) (w : 𝔻) : ↑(z • w) = (z * w : ℂ) :=
  rfl
#align complex.unit_disc.coe_smul_closed_ball Complex.UnitDisc.coe_smul_closedBall

/-- Real part of a point of the unit disc. -/
def re (z : 𝔻) : ℝ :=
  re z
#align complex.unit_disc.re Complex.UnitDisc.re

/-- Imaginary part of a point of the unit disc. -/
def im (z : 𝔻) : ℝ :=
  im z
#align complex.unit_disc.im Complex.UnitDisc.im

@[simp, norm_cast]
theorem re_coe (z : 𝔻) : (z : ℂ).re = z.re :=
  rfl
#align complex.unit_disc.re_coe Complex.UnitDisc.re_coe

@[simp, norm_cast]
theorem im_coe (z : 𝔻) : (z : ℂ).im = z.im :=
  rfl
#align complex.unit_disc.im_coe Complex.UnitDisc.im_coe

@[simp]
theorem re_neg (z : 𝔻) : (-z).re = -z.re :=
  rfl
#align complex.unit_disc.re_neg Complex.UnitDisc.re_neg

@[simp]
theorem im_neg (z : 𝔻) : (-z).im = -z.im :=
  rfl
#align complex.unit_disc.im_neg Complex.UnitDisc.im_neg

/-- Conjugate point of the unit disc. -/
def conj (z : 𝔻) : 𝔻 :=
  mk (conj' ↑z) <| (abs_conj z).symm ▸ z.abs_lt_one
#align complex.unit_disc.conj Complex.UnitDisc.conj

@[simp, norm_cast]
theorem coe_conj (z : 𝔻) : (z.conj : ℂ) = conj' ↑z :=
  rfl
#align complex.unit_disc.coe_conj Complex.UnitDisc.coe_conj

@[simp]
theorem conj_zero : conj 0 = 0 :=
  coe_injective (map_zero conj')
#align complex.unit_disc.conj_zero Complex.UnitDisc.conj_zero

@[simp]
theorem conj_conj (z : 𝔻) : conj (conj z) = z :=
  coe_injective <| Complex.conj_conj z
#align complex.unit_disc.conj_conj Complex.UnitDisc.conj_conj

@[simp]
theorem conj_neg (z : 𝔻) : (-z).conj = -z.conj :=
  rfl
#align complex.unit_disc.conj_neg Complex.UnitDisc.conj_neg

@[simp]
theorem re_conj (z : 𝔻) : z.conj.re = z.re :=
  rfl
#align complex.unit_disc.re_conj Complex.UnitDisc.re_conj

@[simp]
theorem im_conj (z : 𝔻) : z.conj.im = -z.im :=
  rfl
#align complex.unit_disc.im_conj Complex.UnitDisc.im_conj

@[simp]
theorem conj_mul (z w : 𝔻) : (z * w).conj = z.conj * w.conj :=
  Subtype.ext <| map_mul _ _ _
#align complex.unit_disc.conj_mul Complex.UnitDisc.conj_mul

end UnitDisc

end Complex


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module logic.pairwise
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Function.Basic
import Mathlib.Logic.Relation
import Mathlib.Init.Set

/-!
# Relations holding pairwise

This file defines pairwise relations.

## Main declarations

* `Pairwise`: `Pairwise r` states that `r i j` for all `i ≠ j`.
* `Set.Pairwise`: `s.Pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
-/

open Set Function

variable {α β γ ι ι' : Type _} {r p q : α → α → Prop}

section Pairwise

variable {f g : ι → α} {s t u : Set α} {a b : α}

/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
def Pairwise (r : α → α → Prop) :=
  ∀ ⦃i j⦄, i ≠ j → r i j
#align pairwise Pairwise

theorem Pairwise.mono (hr : Pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : Pairwise p :=
  fun _i _j hij => h <| hr hij
#align pairwise.mono Pairwise.mono

protected theorem Pairwise.eq (h : Pairwise r) : ¬r a b → a = b :=
  not_imp_comm.1 <| @h _ _
#align pairwise.eq Pairwise.eq

theorem Function.injective_iff_pairwise_ne : Injective f ↔ Pairwise ((· ≠ ·) on f) :=
  forall₂_congr fun _i _j => not_imp_not.symm
#align function.injective_iff_pairwise_ne Function.injective_iff_pairwise_ne

alias Function.injective_iff_pairwise_ne ↔ Function.Injective.pairwise_ne _
#align function.injective.pairwise_ne Function.Injective.pairwise_ne

namespace Set

/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
protected def Pairwise (s : Set α) (r : α → α → Prop) :=
  ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → r x y
#align set.pairwise Set.Pairwise

theorem pairwise_of_forall (s : Set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.Pairwise r :=
  fun a _ b _ _ => h a b
#align set.pairwise_of_forall Set.pairwise_of_forall

theorem Pairwise.imp_on (h : s.Pairwise r) (hrp : s.Pairwise fun ⦃a b : α⦄ => r a b → p a b) :
    s.Pairwise p :=
  fun _a ha _b hb hab => hrp ha hb hab <| h ha hb hab
#align set.pairwise.imp_on Set.Pairwise.imp_on

theorem Pairwise.imp (h : s.Pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.Pairwise p :=
  h.imp_on <| pairwise_of_forall s _ hpq
#align set.pairwise.imp Set.Pairwise.imp

protected theorem Pairwise.eq (hs : s.Pairwise r) (ha : a ∈ s) (hb : b ∈ s) (h : ¬r a b) : a = b :=
  of_not_not fun hab => h <| hs ha hb hab
#align set.pairwise.eq Set.Pairwise.eq

theorem _root_.Reflexive.set_pairwise_iff (hr : Reflexive r) :
    s.Pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
  forall₄_congr fun a _ _ _ => or_iff_not_imp_left.symm.trans <| or_iff_right_of_imp <| Eq.ndrec <|
    hr a
#align reflexive.set_pairwise_iff Reflexive.set_pairwise_iff

theorem Pairwise.on_injective (hs : s.Pairwise r) (hf : Function.Injective f) (hfs : ∀ x, f x ∈ s) :
    Pairwise (r on f) := fun i j hij => hs (hfs i) (hfs j) (hf.ne hij)
#align set.pairwise.on_injective Set.Pairwise.on_injective

end Set

theorem Pairwise.set_pairwise (h : Pairwise r) (s : Set α) : s.Pairwise r := fun _ _ _ _ w => h w
#align pairwise.set_pairwise Pairwise.set_pairwise

end Pairwise


/- Propositional Extensionality -/

namespace pe

  axiom propext {a b : Prop} : (a ↔ b) → a = b

  theorem th1 (a b c d e : Prop) (h : a ↔ b)
      : (c ∧ a ∧ d → e) ↔ (c ∧ b ∧ d → e) :=
    propext h ▸ Iff.refl _

  theorem th2 (a b : Prop) (p : Prop → Prop) (h : a ↔ b) (h1 : p a) : p b :=
    propext h ▸ h1

end pe

/- Function Extensionality -/

namespace fe

  universe u v
  #check (@funext :
            {α : Type u}
          → {β : α → Type u}
          → {f g : (x : α) → β x}
          → (∀ (x : α), f x = g x)
          → f = g)

  #print funext

  def Set (α : Type u) := α → Prop

  namespace Set

    def mem (x : α) (s : Set α) := s x

    infix:50 (priority := high) "∈" => mem

    theorem setext {a b : Set α} (h : ∀ x, x ∈ a ↔ x ∈ b)
        : a = b :=
      funext (fun x => propext (h x))

    def empty : Set α := fun x => False

    notation (priority := high) "∅" => empty

    def inter (a b : Set α) : Set α :=
      fun x => a x ∧ b x

    infix:70 " ∩ " => inter

    theorem inter_self (a : Set α) : a ∩ a = a :=
      setext fun x => Iff.intro
        (fun (And.intro h _) => h) -- a x → a x
        (fun h => And.intro h h) -- a x → a x ∧ a x

    theorem inter_empty (a : Set α) : a ∩ ∅ = ∅ :=
      setext fun x => Iff.intro
        (fun (And.intro _ h) => h)
        (fun h => False.elim h)

    theorem empty_inter (a : Set α) : ∅ ∩ a = ∅ :=
      setext fun x => Iff.intro
        (fun (And.intro h _) => h)
        (fun h => False.elim h)

    theorem inter_comm (a b : Set α) : a ∩ b = b ∩ a :=
      setext fun x => Iff.intro
        (fun (And.intro ha hb) => And.intro hb ha)
        (fun (And.intro hb ha) => And.intro ha hb)

  end Set

end fe

/- Quotients -/

namespace quo

  universe u v

  axiom Quot : {α : Sort u} → (α → α → Prop) → Sort u

  axiom Quot.mk : {α : Sort u} → (r : α → α → Prop) → α → Quot r

  axiom Quot.ind : ∀ {α : Sort u} {r : α → α → Prop} {β : Quot r → Prop},
      (∀ a, β (Quot.mk r a)) → (q : Quot r) → β q

  axiom Quot.lift : {α : Sort u} → {r : α → α → Prop} → {β : Sort u} → (f : α → β)
      → (∀ a b, r a b → f a = f b) → Quot r → β

  def mod7rel (a b : Nat) : Prop :=
    a % 7 = b % 7

  #check (Quot mod7rel : Type)

  #check (Quot.mk mod7rel 4 : Quot mod7rel) -- equiv class

  def f (x : Nat) : Bool :=
    x % 7 = 0

  theorem f_respects (a b : Nat) (h : mod7rel a b) : f a = f b := by
    simp [mod7rel, f]
    rw [h]

  axiom Quot.sound : ∀ {α : Sort u} {r : α → α → Prop} {a b : α},
      r a b → Quot.mk r a = Quot.mk r b

  class Setoid (α : Sort u) where
    r : α → α → Prop
    iseq : Equivalence r

  instance {α : Sort u} [Setoid α] : HasEquiv α :=
    HasEquiv.mk Setoid.r

  namespace Setoid

    variable {α : Sort u} [Setoid α]

    theorem refl (a : α) : a ≈ a :=
      iseq.refl a

    theorem symm (a b : α) (h : a ≈ b) : b ≈ a :=
      iseq.symm h

    theorem trans (a b c : α) (h1 : a ≈ b) (h2 : b ≈ c) : a ≈ c :=
      iseq.trans h1 h2

  end Setoid

  def Quotient {α : Sort u} (s : Setoid α) :=
    @Quot α Setoid.r

end quo

namespace eq

  private def eqv (p₁ p₂ : α × α) : Prop :=
    (p₁.1 = p₂.1 ∧ p₁.2 = p₂.2) ∨ (p₁.1 = p₂.2 ∧ p₁.2 = p₂.1)

  infix:50 "~" => eqv

  private theorem eqv.refl (p : α × α) : p ~ p :=
    Or.inl (And.intro rfl rfl)

  private theorem eqv.symm : ∀ {p q : α × α}, p ~ q →  q ~ p := by
    intro p q h
    match h with
    | Or.inl (And.intro h1 h2) => exact Or.inl (And.intro h1.symm h2.symm)
    | Or.inr (And.intro h1 h2) => exact Or.inr (And.intro h2.symm h1.symm)

  private theorem eqv.trans : ∀ {p q r : α × α}, p ~ q → q ~ r → p ~ r := by
    intro p q r hp hq
    match hp with
    | Or.inl (And.intro h1 h2) => match hq with
      | Or.inl (And.intro h3 h4) => apply Or.inl; constructor; exact h1.trans h3; exact h2.trans h4
      | Or.inr (And.intro h3 h4) => apply Or.inr; constructor; exact h1.trans h3; exact h2.trans h4
    | Or.inr (And.intro h1 h2) => match hq with
      | Or.inl (And.intro h3 h4) => apply Or.inr; constructor; exact h1.trans h4; exact h2.trans h3
      | Or.inr (And.intro h3 h4) => apply Or.inl; constructor; exact h1.trans h4; exact h2.trans h3

  private theorem is_equivalence : Equivalence (@eqv α) :=
    {refl := eqv.refl, symm := eqv.symm, trans := eqv.trans}

  instance uprodSetoid (α : Type u) : Setoid (α × α) where
    r := eqv
    iseqv := is_equivalence

  def UProd (α : Type u) : Type u :=
    Quotient (uprodSetoid α)

    namespace UProd

      def mk {α : Type} (a₁ a₂ : α) : UProd α :=
        Quotient.mk' (a₁, a₂)

      notation "{" a ", " b "}" => mk a b

      theorem mk_eq_mk (a b : α) : {a, b} = {b, a} :=
        Quot.sound (Or.inr (And.intro rfl rfl))

      private def mem_fn (a : α) : α × α → Prop
        | (b, c) => a = b ∨ a = c

      private theorem mem_swap {a : α} :
          ∀ {p : α × α}, mem_fn a p = mem_fn a (p.2, p.1) := by
        intro
        | (b, c) =>
          apply propext
          apply Iff.intro
          . intro
            | Or.inl h => exact Or.inr h
            | Or.inr h => exact Or.inl h
          . intro
            | Or.inl h => exact Or.inr h
            | Or.inr h => exact Or.inl h

      private theorem mem_respects
          : {p q : α × α} → (a : α) → p ~ q → mem_fn a p = mem_fn a q
        | (b, c), (d, e), a, (Or.inl (And.intro bd ce)) => by simp_all
        | (b, c), (d, e), a, (Or.inr (And.intro bd ce)) => by simp_all; apply mem_swap

    end UProd

end eq

/- Axiom of Choice -/

namespace ch

  universe u

  class inductive Nonempty (α : Sort u) : Prop where
    | intro : (val : α) → Nonempty α

  example (α : Type u) : Nonempty α ↔ ∃ x : α, True :=
    Iff.intro (fun (Nonempty.intro a) => Exists.intro a trivial) (fun (Exists.intro a _) => Nonempty.intro a)

  axiom choice {α : Sort u} : Nonempty α → α

  noncomputable def indefiniteDescription {α : Sort u} (p : α → Prop)
      (h : ∃ x, p x) : {x // p x} :=
    choice <| let (Exists.intro x px) := h; ⟨⟨x, px⟩⟩

end ch

/- Law of the Excluded Middle -/

namespace lem

  open Classical

  theorem em (p : Prop) : p ∨ ¬ p :=
    let U (x : Prop) := x = True ∨ p
    let V (x : Prop) := x = False ∨ p

    have exU : ∃ x, U x := Exists.intro True (Or.inl rfl)
    have exV : ∃ x, V x := Exists.intro False (Or.inl rfl)

    let u : Prop := choose exU
    let v : Prop := choose exV

    have u_def : U u := choose_spec exU
    have v_def : V v := choose_spec exV

    have not_uv_or_p : u ≠ v ∨ p :=
      match u_def, v_def with
      | Or.inr h, _ => Or.inr h
      | _, Or.inr h => Or.inr h
      | Or.inl hu, Or.inl hv =>
        have hn : u ≠ v := by simp [hu, hv]
        Or.inl hn

    have p_implies_uv : p → u = v :=
      fun hp =>
      have hpred : U = V :=
        funext fun x =>
          have hl : (x = True ∨ p) → (x = False ∨ p) :=
            fun _ => Or.inr hp
          have hr : (x = False ∨ p) → (x = True ∨ p) :=
            fun _ => Or.inr hp
          show (x = True ∨ p) = (x = False ∨ p) from
            propext (Iff.intro hl hr)
      have h₀ : ∀ exU exV, @choose _ U exU = @choose _ V exV := by
        rw [hpred]; intros; rfl
      show u = v from h₀ _ _

    match not_uv_or_p with
    | Or.inl hne => Or.inr (mt p_implies_uv hne)
    | Or.inr hp => Or.inl hp

end lem


import ring_theory.noetherian
import algebra.direct_limit
import tactic

set_option pp.beta true
set_option trace.simplify.rewrite true

/-
Establish some basic properties about the order structure on the type of finitely
generated submodules. Big takeaways are the definition of `fin_submodule`, establishing
a couple instances `semilattice_sup (fin_submodule R M)` and `is_directed (fin_submodule R M) (≤)`
-/
section basic_properties

universes u v

variables (R : Type u) (M : Type v) [ring R] [add_comm_group M] [module R M]

def fin_submodule : Type v := { N : submodule R M // N.fg }

namespace fin_submodule

/-
Not sure I need any of this actually...
-/
-- @[protected, instance] def set_like : set_like (fin_submodule R M) M := { coe := λ⟨N, _⟩, N,
--   coe_injective' := λ ⟨N, hN⟩ ⟨P, hP⟩ hNP, by congr; exact set_like.ext' hNP }

-- variable N : fin_submodule R M

-- lemma add_mem {x y : M} (h₁ : x ∈ N) (h₂ : y ∈ N) : x + y ∈ N :=
-- begin
-- cases N,
-- apply submodule.add_mem, exact h₁, exact h₂,
-- end

-- instance has_add' : has_add N := { add := λx y, ⟨x + y, add_mem R M N (by simp) (by simp)⟩ }

-- instance has_zero' : has_zero N := { zero := begin cases N, exact ⟨0, by apply submodule.zero_mem'⟩ end }

-- instance has_smul' : has_scalar R N := { smul := λr m, ⟨r • m, begin end⟩ }

-- @[instance] def associated_comm_group (N : fin_submodule R M) : add_comm_monoid N := {
--   add_assoc := _,
--   zero_add := _,
--   add_zero := _,
--   nsmul := _,
--   nsmul_zero' := _,
--   nsmul_succ' := _,
--   add_comm := _,
--   ..has_add' R M N,
--   ..has_zero' R M N}

-- @[simp] def associated_submodule (N : fin_submodule R M) : submodule R M := N.1

-- instance module (N : fin_submodule R M) : module R N := { smul := _,
--   one_smul := _,
--   mul_smul := _,
--   smul_add := _,
--   smul_zero := _,
--   add_smul := _,
--   zero_smul := _ }

instance have_sup : has_sup (fin_submodule R M) :=
{ sup := λ⟨N, hN⟩ ⟨P, hP⟩, ⟨N ⊔ P, submodule.fg_sup hN hP⟩ }

instance have_le : has_le (fin_submodule R M) := { le := λ⟨N, _⟩ ⟨P, _⟩, N ≤ P }

instance have_lt : has_lt (fin_submodule R M) := { lt := λ⟨N, _⟩ ⟨P, _⟩, N ≤ P ∧ ¬ P ≤ N }

instance have_partial_order : partial_order (fin_submodule R M) :=
{ le_refl := λ⟨N, _⟩, partial_order.le_refl N,
  le_trans := λ⟨N, _⟩ ⟨O, _⟩ ⟨P, _⟩, partial_order.le_trans N O P,
  lt_iff_le_not_le :=
  begin
    rintros ⟨N, hN⟩ ⟨O, hO⟩,
    split,
    { rintros ⟨h1, h2⟩,
      exact ⟨h1, h2⟩, },
    { rintros ⟨h1, h2⟩,
      exact ⟨h1, h2⟩ },
  end,
  le_antisymm :=
  begin
    rintros ⟨N, hN⟩ ⟨O, hO⟩ h1 h2,
    change N ≤ O  at h1,
    change O ≤ N at h2,
    congr,
    exact partial_order.le_antisymm N O h1 h2,
  end,
  ..have_le R M,
  ..have_lt R M }

instance have_semilattice_sup : semilattice_sup (fin_submodule R M) :=
{ le_sup_left :=
  begin
    rintros ⟨N, hN⟩ ⟨O, hO⟩,
    exact complete_lattice.le_sup_left N O,
  end,
  le_sup_right :=
  begin
    rintros ⟨N, hN⟩ ⟨O, hO⟩,
    exact complete_lattice.le_sup_right N O,
  end,
  sup_le :=
  begin
    rintros ⟨N, hN⟩ ⟨O, hO⟩ ⟨P, hP⟩ h1 h2,
    change N ≤ P at h1,
    change O ≤ P at h2,
    change N ⊔ O ≤ P,
    rw sup_le_iff,
    exact ⟨h1, h2⟩,
  end,
  .. have_partial_order R M,
  .. have_sup R M }

instance have_directed : is_directed (fin_submodule R M) (≤) := { directed :=
begin
  rintros ⟨N, hN⟩ ⟨P, hP⟩,
  use N ⊔ P,
  exact submodule.fg_sup hN hP,
  split,
  change N ≤ N ⊔ P,
  exact le_sup_left,
  change P ≤ N ⊔ P,
  exact le_sup_right,
end }

-- Might have to worry about this at some point too?
-- instance have_something : nonempty (fin_submodule R M) := _

end fin_submodule
end basic_properties

/-
Goal: Prove some stuff about direct limits more generally. Big takeaways are `equiv_with_top`
which shows a direct limit over an `order_top ι` is linearly equivalent with `G ⊤`, and
`injective_of_direct_limit` which should be helpful in the main goal
-/
section direct_limits

universes u v w u₁

open submodule
open function (injective)
open module.direct_limit

variables {R : Type u} [ring R]
variables {ι : Type v}
variables [decidable_eq ι] [preorder ι]
variables (G : ι → Type w)
variables [Π i, add_comm_group (G i)] [Π i, module R (G i)]
variables (f : Π i j, i ≤ j → G i →ₗ[R] G j) [directed_system G (λ i j h, f i j h)]

namespace module.direct_limit

def map_to_top [order_top ι] : module.direct_limit G f →ₗ[R] G ⊤ :=
lift R ι G f (λi, f i ⊤ (le_top)) (λi j hij x, module.directed_system.map_map f hij le_top x)

/-
This lemma obviously doesn't work for any non-fg module, but it didn't seem like it was in mathlib
yet so I wrote it (before I realized I couldn't use it lol)
-/
def equiv_with_top [order_top ι] : module.direct_limit G f ≃ₗ[R] G ⊤  := {
  to_fun := map_to_top G f,
  map_add' := by simp, -- kind of slow
  map_smul' := by simp, -- kind of slow
  inv_fun := of R ι G f ⊤,
  left_inv :=
  begin
    intro x,
    have H := exists_of x,
    cases H with i1 H1,
    cases H1 with y H,
    rw ← H,
    dunfold map_to_top,
    rw [lift_of, of_f],
  end,
  right_inv :=
  begin
    intro x,
    dunfold map_to_top,
    rw lift_of,
    exact module.directed_system.map_self f ⊤ x _,
  end }

variables {P : Type u} [add_comm_group P] [module R P] (h : Π i j, injective $ f i j)

def direct_limit_map_component (g : module.direct_limit G f →ₗ[R] P) : Π i, G i →ₗ[R] P := λi,
{ to_fun := g ∘ (module.direct_limit.of R ι G f i),
  map_add' := by simp, -- kind of slow
  map_smul' := by simp  -- kind of slow}
}

variables [is_directed ι (≤)] [nonempty ι]

-- TODO: Rewrite this with rcases once I figure out how that works
lemma injective_of_direct_limit (g : module.direct_limit G f →ₗ[R] P)
(h : Π i, injective (direct_limit_map_component G f g i)) : injective g :=
begin
intros x y heq,
have Hx := exists_of x,
cases Hx with ix Hix,
cases Hix with xi Hxi,
have Hy := exists_of y,
cases Hy with iy Hiy,
cases Hiy with yi Hyi,
have H2 := @is_directed.directed ι (≤) _ ix iy,
cases H2 with j Hj,
have Hx : x = of R ι G f j (f ix j (Hj.1) xi) := by simp [Hxi],
have Hy : y = of R ι G f j (f iy j (Hj.2) yi) := by simp [Hyi],
have main_H : direct_limit_map_component G f g j (f ix j (Hj.1) xi) =
              direct_limit_map_component G f g j (f iy j (Hj.2) yi) :=
  begin
  dunfold direct_limit_map_component,
  dsimp,
  rw Hx at heq,
  rw Hy at heq,
  exact heq
  end,
have main_H2 : (f ix j (Hj.1) xi) = (f iy j (Hj.2) yi) := h j main_H,
simp [Hx, Hy, main_H2],
end

end module.direct_limit
end direct_limits

/-
In this section the goal is to prove any module is linearly equivalent to the direct limit over
the directed system of its finitely generated submodules.
-/
section module_from_finite_submodules

namespace fin_submodule

open function (injective)

universes u v

variables {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M]
[dec_ι : decidable_eq (fin_submodule R M)] -- Do I need to prove this?

-- Ok I am definitely doing something wrong... All these definitions are like pulling teeth
def associated_inclusion {N P : fin_submodule R M} (h : N ≤ P) : N.1 →ₗ[R] P.1 :=
{ to_fun := λ⟨x, hx⟩, ⟨x, begin clear _x, clear _fun_match, cases N, cases P,
  change N_val ≤ P_val at h,
  simp [h hx],
  end⟩,
  map_add' := λ⟨x, hx⟩ ⟨y, hy⟩, by refl,
  map_smul' := λr ⟨x, hx⟩, by refl }

def associated_system (N P : fin_submodule R M) : N ≤ P → ↥N.1 →ₗ[R] ↥P.1 := λh, associated_inclusion h

def inclusion_of_comp (N : fin_submodule R M) : N.1 →ₗ[R] M :=
{ to_fun := λx, x,
  map_add' := by simp,
  map_smul' := by simp }

def system_of_inclusions : Π (N : fin_submodule R M), N.1 →ₗ[R] M := λN, inclusion_of_comp N

lemma inc_is_injective {N P : fin_submodule R M} (h : N ≤ P) : injective $ associated_inclusion h :=
begin
rintros ⟨x, hx⟩ ⟨y, hy⟩ heq,
dunfold fin_submodule.associated_inclusion at heq,
dsimp at heq,
congr,
dunfold fin_submodule.associated_inclusion._match_1 at heq,
cases heq,
refl
end

-- variable N : submodule R M

-- #check N.module

#check @associated_system R M _ _ _

-- @[instance]def inst1 :Π (N : fin_submodule R M), add_comm_group ↥N := λ⟨N, hN⟩, N.add_comm_group

@[instance]def inst1 : Π (N : fin_submodule R M), add_comm_group ↥N.val := λ⟨N, hN⟩, submodule.add_comm_group N

-- @[instance]def inst2 : Π (N : fin_submodule R M), module R ↥N.val := λ⟨N, hN⟩, submodule.module N

#check @module.direct_limit R _ (fin_submodule R M) _ _ (λN, N.1) _ (λ⟨K, hK⟩, submodule.module K) begin
have H := @associated_system R M _ _ _ ,
sorry,
end

#check @module.direct_limit

end fin_submodule
end module_from_finite_submodules

/-
This is exactly lemma: [10.8.4](https://stacks.math.columbia.edu/tag/00D7)!
-/
#check module.direct_limit.of.zero_exact


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Core
import Init.NotationExtra

universe u v

/-! # Classical reasoning support -/

namespace Classical

noncomputable def indefiniteDescription {α : Sort u} (p : α → Prop) (h : ∃ x, p x) : {x // p x} :=
  choice <| let ⟨x, px⟩ := h; ⟨⟨x, px⟩⟩

noncomputable def choose {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : α :=
  (indefiniteDescription p h).val

theorem choose_spec {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : p (choose h) :=
  (indefiniteDescription p h).property

/-- Diaconescu's theorem: excluded middle from choice, Function extensionality and propositional extensionality. -/
theorem em (p : Prop) : p ∨ ¬p :=
  let U (x : Prop) : Prop := x = True ∨ p
  let V (x : Prop) : Prop := x = False ∨ p
  have exU : ∃ x, U x := ⟨True, Or.inl rfl⟩
  have exV : ∃ x, V x := ⟨False, Or.inl rfl⟩
  let u : Prop := choose exU
  let v : Prop := choose exV
  have u_def : U u := choose_spec exU
  have v_def : V v := choose_spec exV
  have not_uv_or_p : u ≠ v ∨ p :=
    match u_def, v_def with
    | Or.inr h, _ => Or.inr h
    | _, Or.inr h => Or.inr h
    | Or.inl hut, Or.inl hvf =>
      have hne : u ≠ v := by simp [hvf, hut, true_ne_false]
      Or.inl hne
  have p_implies_uv : p → u = v :=
    fun hp =>
    have hpred : U = V :=
      funext fun x =>
        have hl : (x = True ∨ p) → (x = False ∨ p) :=
          fun _ => Or.inr hp
        have hr : (x = False ∨ p) → (x = True ∨ p) :=
          fun _ => Or.inr hp
        show (x = True ∨ p) = (x = False ∨ p) from
          propext (Iff.intro hl hr)
    have h₀ : ∀ exU exV, @choose _ U exU = @choose _ V exV := by
      rw [hpred]; intros; rfl
    show u = v from h₀ _ _
  match not_uv_or_p with
  | Or.inl hne => Or.inr (mt p_implies_uv hne)
  | Or.inr h   => Or.inl h

theorem exists_true_of_nonempty {α : Sort u} : Nonempty α → ∃ _ : α, True
  | ⟨x⟩ => ⟨x, trivial⟩

noncomputable def inhabited_of_nonempty {α : Sort u} (h : Nonempty α) : Inhabited α :=
  ⟨choice h⟩

noncomputable def inhabited_of_exists {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : Inhabited α :=
  inhabited_of_nonempty (Exists.elim h (fun w _ => ⟨w⟩))

/-- All propositions are `Decidable`. -/
noncomputable scoped instance (priority := low) propDecidable (a : Prop) : Decidable a :=
  choice <| match em a with
    | Or.inl h => ⟨isTrue h⟩
    | Or.inr h => ⟨isFalse h⟩

noncomputable def decidableInhabited (a : Prop) : Inhabited (Decidable a) where
  default := inferInstance

noncomputable def typeDecidableEq (α : Sort u) : DecidableEq α :=
  fun _ _ => inferInstance

noncomputable def typeDecidable (α : Sort u) : PSum α (α → False) :=
  match (propDecidable (Nonempty α)) with
  | (isTrue hp)  => PSum.inl (@default _ (inhabited_of_nonempty hp))
  | (isFalse hn) => PSum.inr (fun a => absurd (Nonempty.intro a) hn)

noncomputable def strongIndefiniteDescription {α : Sort u} (p : α → Prop) (h : Nonempty α) : {x : α // (∃ y : α, p y) → p x} :=
  @dite _ (∃ x : α, p x) (propDecidable _)
    (fun (hp : ∃ x : α, p x) =>
      show {x : α // (∃ y : α, p y) → p x} from
      let xp := indefiniteDescription _ hp;
      ⟨xp.val, fun _ => xp.property⟩)
    (fun hp => ⟨choice h, fun h => absurd h hp⟩)

/-- the Hilbert epsilon Function -/
noncomputable def epsilon {α : Sort u} [h : Nonempty α] (p : α → Prop) : α :=
  (strongIndefiniteDescription p h).val

theorem epsilon_spec_aux {α : Sort u} (h : Nonempty α) (p : α → Prop) : (∃ y, p y) → p (@epsilon α h p) :=
  (strongIndefiniteDescription p h).property

theorem epsilon_spec {α : Sort u} {p : α → Prop} (hex : ∃ y, p y) : p (@epsilon α (nonempty_of_exists hex) p) :=
  epsilon_spec_aux (nonempty_of_exists hex) p hex

theorem epsilon_singleton {α : Sort u} (x : α) : @epsilon α ⟨x⟩ (fun y => y = x) = x :=
  @epsilon_spec α (fun y => y = x) ⟨x, rfl⟩

/-- the axiom of choice -/
theorem axiomOfChoice {α : Sort u} {β : α → Sort v} {r : ∀ x, β x → Prop} (h : ∀ x, ∃ y, r x y) : ∃ (f : ∀ x, β x), ∀ x, r x (f x) :=
  ⟨_, fun x => choose_spec (h x)⟩

theorem skolem {α : Sort u} {b : α → Sort v} {p : ∀ x, b x → Prop} : (∀ x, ∃ y, p x y) ↔ ∃ (f : ∀ x, b x), ∀ x, p x (f x) :=
  ⟨axiomOfChoice, fun ⟨f, hw⟩ (x) => ⟨f x, hw x⟩⟩

theorem propComplete (a : Prop) : a = True ∨ a = False :=
  match em a with
  | Or.inl ha => Or.inl (propext (Iff.intro (fun _ => ⟨⟩) (fun _ => ha)))
  | Or.inr hn => Or.inr (propext (Iff.intro (fun h => hn h) (fun h => False.elim h)))

-- this supercedes byCases in Decidable
theorem byCases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
  Decidable.byCases (dec := propDecidable _) hpq hnpq

-- this supercedes byContradiction in Decidable
theorem byContradiction {p : Prop} (h : ¬p → False) : p :=
  Decidable.byContradiction (dec := propDecidable _) h

/--
`by_cases (h :)? p` splits the main goal into two cases, assuming `h : p` in the first branch, and `h : ¬ p` in the second branch.
-/
syntax "by_cases " (atomic(ident " : "))? term : tactic

macro_rules
  | `(tactic| by_cases $h : $e) =>
    `(tactic|
      cases em $e with
      | inl $h => _
      | inr $h => _)
  | `(tactic| by_cases $e) =>
    `(tactic|
      cases em $e with
      | inl h => _
      | inr h => _)

end Classical


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

This is about matching problems.  We have two sets `A` and `B`,
and a relation between them (formalised as `E : finset (A × B)`).
Everything is assumed to be finite and decidable.  Standard
motivating examples:

- `A` is a set of jobs, `B` is a set of people, `(a,b)` lies
  in `E` iff person `b` is qualified for job `a`.  We seek
  to assign jobs to qualified people in such a way that
  no one has more than one job.

- `A` and `B` are sets of people such that people in `A` are
  only interested in marrying people in `B` and vice-versa.
  A pair `(a,b)` lies in `E` iff `a` and `b` would be content
  to marry each other.  We seek to assign marriage partners
  in such a way that everyone is content.

Formally, a (partial) matching is a subset `M ⊆ E` such that
the projections `M → A` and `M → B` are both injective.  The
theory contains various results about the existence or number
of partial matchings with various additional properties.  The
key result is Hall's Marriage Theorem; we have not yet written
either the statement or the proof.

The main result that we have written is the inclusion-exclusion
principle.  To explain this, note that each `b ∈ B` gives us
a "column set" `col E b = {a : (a,b) ∈ E}`.  (There are also
"row sets", defined in a similar way, and we have lots of fairly
trivial lemmas translating information about `E` into information
about row sets or column sets and vice versa.)  The
inclusion-exclusion principle is usually formulated as an
equation for the order of the union of a finite family of
finite sets.  Such a family can be encoded as the column sets
of a matching problem as above; then the union of the columns
corresponds to the set of nonempty rows.  It is tidier to
count the number of empty rows, which is the complement of the
union of the columns.  The inclusion-exclusion principle says
that the number of empty rows is the sum over `U ⊆ B` of
`(-1)^|U| * |X_U|`, where `X_U` is the intersection of the sets
`col E b` for `b ∈ U`.  In Lean notation, the number
`(-1)^|U|` is `card_sign U`, and the set `X_U` is
`col_inter E U`.  The IEP is formalised as
`combinatorics.matching.inclusion_exclusion`.

-/

import data.fintype.basic
import combinatorics.card_sign

open finset

lemma finset.mem_univ_filter {α : Type*} [fintype α]
 {p : α → Prop} [decidable_pred p] {a : α} :
  a ∈ univ.filter p ↔ p a :=
by {rw[mem_filter],simp only [mem_univ a,true_and],}

lemma finset.mem_bind_univ
 {α : Type*} [fintype α]  {β : Type*} [decidable_eq β]
  {f : α → finset β} {b : β} :
    b ∈ univ.bUnion f ↔ ∃ a : α, b ∈ (f a) :=
by {split,
    {intro h,rcases mem_bUnion.mp h with ⟨a,_,ha⟩,exact ⟨a,ha⟩},
    {rintro ⟨a,ha⟩,exact mem_bUnion.mpr ⟨a,⟨mem_univ a,ha⟩⟩}}

namespace combinatorics
namespace matching

universes u v

variables {A : Type u} [fintype A] [decidable_eq A]
variables {B : Type u} [fintype B] [decidable_eq B]

def swap : A × B → B × A := λ ab, ⟨ab.2,ab.1⟩

lemma swap_swap : ∀ ab : (A × B), swap (swap ab) = ab
| ⟨a,b⟩ := rfl

lemma fst_swap : prod.fst ∘ (swap : A × B → B × A) = prod.snd :=
 by { ext ⟨a,b⟩, refl }

lemma snd_swap : prod.snd ∘ (swap : A × B → B × A) = prod.fst :=
 by { ext ⟨a,b⟩, refl }

def swap_equiv : (A × B) ≃ (B × A) := {
 to_fun := swap, inv_fun := swap,
 left_inv := swap_swap, right_inv := swap_swap
}

def sswap : finset (A × B) → finset (B × A) :=
 λ M, M.map swap_equiv.to_embedding

lemma mem_sswap (M : finset (A × B)) (ba : B × A) :
 ba ∈ sswap M ↔ swap ba ∈ M :=
begin
 split,
 {intro h,rcases mem_map.mp h with ⟨ab,⟨hab,e⟩⟩,
  change swap ab = ba at e,rw[← e,swap_swap],exact hab,
 },{
  intro hba,apply mem_map.mpr,use swap ba,use hba,
  exact swap_swap ba,
 }
end

lemma mem_sswap' (M : finset (A × B)) (a : A) (b : B) :
 prod.mk b a ∈ sswap M ↔ prod.mk a b ∈ M :=
  by {rw[mem_sswap,swap],}

lemma sswap_sswap (M : finset (A × B)) : sswap (sswap M) = M :=
 by {ext ⟨a,b⟩,rw[mem_sswap',mem_sswap']}

def incl (a : A) : B ↪ (A × B) :=
 ⟨λ b,prod.mk a b,λ b₀ b₁ e, congr_arg prod.snd e⟩

def incr (b : B) : A ↪ (A × B) :=
 ⟨λ a,prod.mk a b,λ a₀ a₁ e,congr_arg prod.fst e⟩

lemma mem_incl {U : finset B} {a : A} : ∀ {xy : A × B},
 xy ∈ U.map (incl a) ↔ xy.1 = a ∧ xy.2 ∈ U
| ⟨x,y⟩ := begin
 split,
 {rintro hxy,rcases mem_map.mp hxy with ⟨b,⟨hb,e⟩⟩,
  have ea : a = x := congr_arg prod.fst e,
  have eb : b = y := congr_arg prod.snd e,
  rw[← ea,← eb],exact ⟨rfl,hb⟩,
 },{
  rintro ⟨ex,hy⟩,change x = a at ex,change y ∈ U at hy,
  rw[ex],exact mem_map.mpr ⟨y,hy,rfl⟩,
 }
end

lemma mem_incr {T : finset A} {b : B} : ∀ {xy : A × B},
 xy ∈ T.map (incr b) ↔ xy.1 ∈ T ∧ xy.2 = b
| ⟨x,y⟩ := begin
 split,
 {rintro hxy,rcases mem_map.mp hxy with ⟨a,⟨ha,e⟩⟩,
  have ea : a = x := congr_arg prod.fst e,
  have eb : b = y := congr_arg prod.snd e,
  rw[← ea,← eb],exact ⟨ha,rfl⟩,
 },{
  rintro ⟨hx,ey⟩,change x ∈ T at hx,change y = b at ey,
  rw[ey],exact mem_map.mpr ⟨x,hx,rfl⟩,
 }
end

variable E : finset (A × B)

def row (a : A) : finset B := univ.filter (λ b, (prod.mk a b) ∈ E)

def row' (a : A) := E.filter (λ ab, ab.1 = a)

def col (b : B) : finset A := univ.filter (λ a, (prod.mk a b) ∈ E)

def col' (b : B) := E.filter (λ ab, ab.2 = b)

def row_union (T : finset A) := T.bUnion (row E)

def col_union (U : finset B) := U.bUnion (col E)

def row_inter (T : finset A) : finset B := univ.filter (λ b, T ⊆ col E b)

def col_inter (U : finset B) : finset A := univ.filter (λ a, U ⊆ row E a)

def clear_rows : finset A := univ.filter (λ a, row E a = ∅)

def clear_cols : finset B := univ.filter (λ b, col E b = ∅)

lemma mem_row (a : A) {b : B} : b ∈ row E a ↔ (prod.mk a b  ∈ E) :=
 by {apply finset.mem_univ_filter,}

lemma mem_col (b : B) {a : A} : a ∈ col E b ↔ (prod.mk a b  ∈ E) :=
 by {apply finset.mem_univ_filter,}

lemma mem_row_col {a : A} {b : B} : b ∈ row E a ↔ a ∈ col E b :=
 by {rw[mem_row,mem_col]}

lemma mem_row_union (T : finset A) (b : B) :
 b ∈ row_union E T ↔ ∃ a ∈ T, b ∈ row E a :=
  by {rw[row_union,mem_bUnion]}

lemma mem_col_union (U : finset B) (a : A) :
 a ∈ col_union E U ↔ ∃ b ∈ U, a ∈ col E b :=
  by {rw[col_union,mem_bUnion]}

lemma mem_row_inter (T : finset A) (b : B) :
 b ∈ row_inter E T ↔ ∀ a ∈ T, b ∈ row E a :=
  by {
   rw[row_inter,finset.mem_univ_filter],
   split; intros h a haT,
   {exact (mem_row E a).mpr ((mem_col E b).mp (h haT)),},
   {exact (mem_col E b).mpr ((mem_row E a).mp (h a haT)),}
  }

lemma mem_col_inter (U : finset B) (a : A) :
 a ∈ col_inter E U ↔ ∀ b ∈ U, a ∈ col E b :=
  by {
   rw[col_inter,finset.mem_univ_filter],
   split; intros h b hbU,
   {exact (mem_col E b).mpr ((mem_row E a).mp (h hbU)),},
   {exact (mem_row E a).mpr ((mem_col E b).mp (h b hbU)),}
  }

lemma mem_clear_rows (a : A) : a ∈ clear_rows E ↔ row E a = ∅ :=
 by {rw[clear_rows,finset.mem_univ_filter],}

lemma mem_clear_cols (b : B) : b ∈ clear_cols E ↔ col E b = ∅ :=
 by {rw[clear_cols,finset.mem_univ_filter],}

lemma row_sswap (b : B) : row (sswap E) b = col E b :=
 by {ext a,rw[mem_row,mem_col,mem_sswap'],}

lemma col_sswap (a : A) : col (sswap E) a = row E a :=
 by {ext b,rw[mem_row,mem_col,mem_sswap'],}

lemma row'_sswap (b : B) : row' (sswap E) b = sswap (col' E b) :=
 by {ext  ⟨x,y⟩,
     rw[mem_sswap',row',col',mem_filter,mem_filter,mem_sswap'],}

lemma col'_sswap (a : A) : col' (sswap E) a = sswap (row' E a) :=
 by {ext  ⟨x,y⟩,
     rw[mem_sswap',row',col',mem_filter,mem_filter,mem_sswap'],}

lemma row_union_sswap (U : finset B) : row_union (sswap E) U = col_union E U :=
 by {ext a,rw[mem_row_union,mem_col_union],
  split; rintro ⟨b,⟨hb,h⟩⟩; use b; use hb,
  {rw[row_sswap] at h,exact h},
  {rw[row_sswap] at ⊢,exact h}
 }

lemma col_union_sswap (T : finset A) : col_union (sswap E) T = row_union E T :=
 by {ext b,rw[mem_row_union,mem_col_union],
  split; rintro ⟨a,⟨ha,h⟩⟩; use a; use ha,
  {rw[col_sswap] at h,exact h},
  {rw[col_sswap] at ⊢,exact h}
 }

lemma row_inter_sswap (U : finset B) : row_inter (sswap E) U = col_inter E U :=
 by {ext a,rw[mem_row_inter,mem_col_inter],
  split; intros h b b_in_U; let h' := h b b_in_U,
  {rw[row_sswap] at h',exact h'},
  {rw[row_sswap] at ⊢ ,exact h'}
 }

lemma clear_rows_sswap : clear_rows (sswap E) = clear_cols E :=
 by {ext b,rw[mem_clear_rows,mem_clear_cols,row_sswap],}

lemma clear_cols_sswap : clear_cols (sswap E) = clear_rows E :=
 by {ext a,rw[mem_clear_rows,mem_clear_cols,col_sswap],}

lemma row_of_row' (a : A) : row E a = (row' E a).image prod.snd :=
 begin
  ext b,rw[mem_row,mem_image],split,
  {intro h,use ⟨a,b⟩,
   have : (prod.mk a b) ∈ row' E a :=
    by {rw[row',mem_filter],simp only [h,true_and],},
   use this,
  },{
   rintro ⟨⟨a',b'⟩,hab',hb⟩,
   rcases mem_filter.mp hab' with ⟨hab'',ha⟩,
   change a' = a at ha, change b' = b at hb,rw[← ha,← hb],exact hab''
  }
 end

lemma row'_of_row (a : A) : row' E a = (row E a).map (incl a) :=
 begin
  ext ⟨a',b⟩,
  rw[row',mem_filter,mem_incl,mem_row],
  split,
  {rintro ⟨h,e⟩,change a' = a at e,rw[e] at h ⊢,exact ⟨rfl,h⟩,},
  {rintro ⟨e,h⟩,change a' = a at e,rw[e] at h ⊢,exact ⟨h,rfl⟩,}
 end

lemma col_of_col' (b : B) : col E b = (col' E b).image prod.fst :=
begin
 let f : (A × B) ≃ (B × A) := swap_equiv,
 let fe := f.to_embedding,
 let C := col' E b,
 rw[← row_sswap,row_of_row',row'_sswap,sswap],
 change (C.map fe).image prod.snd = C.image prod.fst,
 rw[finset.map_eq_image,finset.image_image],
 change C.image (prod.snd ∘ swap) = C.image prod.fst,
 rw[snd_swap],
end

lemma col'_of_col (b : B) : col' E b = (col E b).map (incr b) :=
begin
 let f : (B × A) ≃ (A × B) := swap_equiv,
 let fe := f.to_embedding,
 let C := col E b,
 let e := (congr_arg sswap (row'_sswap E b)).trans (sswap_sswap _),
 rw[← e,row'_of_row,row_sswap,sswap],
 change (C.map (incl b)).map fe = C.map (incr b),
 rw[finset.map_map],congr,
end

def is_matching (M : finset (A × B)) :=
 M ⊆ E ∧
 (∀ x y : (A × B), x ∈ M → y ∈ M → x.1 = y.1 → x = y) ∧
 (∀ x y : (A × B), x ∈ M → y ∈ M → x.2 = y.2 → x = y)

lemma inclusion_exclusion :
 ((clear_rows E).card : ℤ) =
  (@univ B _).powerset.sum (λ U, (card_sign U) * (card (col_inter E U))) :=
begin
 let i : A → ((finset B) ↪ (A × (finset B))) := incl,
 let j : (finset B) → (A ↪ (A × (finset B))) := incr,
 let p : A → finset (A × (finset B)) := (λ a, (row E a).powerset.map (i a)),
 let q : finset B → finset (A × (finset B)) := (λ U, (col_inter E U).map (j U)),
 let Y := (@univ A _).bUnion p,
 let Z := (@univ (finset B) _).bUnion q,
 let c : A × (finset B) → ℤ := λ aU, aU.2.card_sign,
 have p_disjoint : ∀ a₀ a₁, a₀ ≠ a₁ → disjoint (p a₀) (p a₁) :=
  λ a₀ a₁ h, disjoint_iff.mpr $ by {
      change (p a₀) ∩ (p a₁) = ∅,
      apply eq_empty_of_forall_not_mem, rintros ⟨a,U⟩ h',
      rw[mem_inter,mem_incl,mem_incl] at h',
      exact h (h'.1.1.symm.trans h'.2.1) },
 have q_disjoint : ∀ U₀ U₁, U₀ ≠ U₁ → disjoint (q U₀) (q U₁) :=
  λ U₀ U₁ h, disjoint_iff.mpr $  by {
      change (q U₀) ∩ (q U₁) = ∅,
      apply eq_empty_of_forall_not_mem,rintros ⟨a,U⟩ h',
      rw[mem_inter,mem_incr,mem_incr] at h',
      exact h (h'.1.2.symm.trans h'.2.2) },
 have e : Y = Z := begin
  ext ⟨a,U⟩,
  split,
  {intro hY,rcases finset.mem_bind_univ.mp hY with ⟨a',hY'⟩,
   have ea : a = a'  := (mem_incl.mp hY').left,
   let hU : U ⊆ row E a' := mem_powerset.mp (mem_incl.mp hY').right,
   rw[← ea] at hU,
   apply finset.mem_bind_univ.mpr,use U,
   let haU : a ∈ col_inter E U := (mem_col_inter E U a).mpr
     (λ b hb, (mem_col E b).mpr ((mem_row E a).mp (hU hb))),
   apply mem_map.mpr,use a,use haU,refl,
  },
  {intro hZ,rcases finset.mem_bind_univ.mp hZ with ⟨U',hU'⟩,
   have eU : U = U' := (mem_incr.mp hU').right,
   let ha : a ∈ col_inter E U' := (mem_incr.mp hU').left,
   rw[← eU] at ha,
   let ha' := (mem_col_inter E U a).mp ha,
   have hU'' : U ∈ (row E a).powerset := begin
    rw[mem_powerset],intros b b_in_U,exact (mem_row_col E).mpr (ha' b b_in_U),
   end,
   apply finset.mem_bind_univ.mpr,use a,
   apply mem_incl.mpr,
   exact ⟨rfl,hU''⟩,
   }
 end,
 let Y_sum : Y.sum c = (@univ A _).sum (λ a, (p a).sum c) :=
  sum_bUnion (λ a₀ _ a₁ _ h, p_disjoint a₀ a₁ h),
 let Z_sum : Z.sum c = (@univ (finset B) _).sum (λ U, (q U).sum c) :=
  sum_bUnion (λ U₀ _ U₁ _ h, q_disjoint U₀ U₁ h),
 have p_sum : ∀ a, (p a).sum c = if (row E a) = ∅ then 1 else 0 :=
 λ a, begin
  let h := card_sign_sum_eq (row E a),
  dsimp[card_sign_sum] at h,
  dsimp[p],rw[sum_map,← h],congr,
 end,
 let A₀ := clear_rows E,
 let A₁ := univ \ A₀,
 have p_sum₀ : ∀ a, a ∈ A₀ → (p a).sum c = 1 := λ a ha,
  begin
   let h := p_sum a,
   rw[if_pos (finset.mem_univ_filter.mp ha)] at h,
   exact h,
  end,
 have p_sum₁ : ∀ a, a ∈ A₁ → (p a).sum c = 0 := λ a ha,
  begin
   let h := p_sum a,
   let ha' :=
    (mem_sdiff.mp ha).right ∘ finset.mem_univ_filter.mpr,
   rw[if_neg ha'] at h,
   exact h,
  end,
 let Y_sum' := calc
  Y.sum c = univ.sum (λ a, (p a).sum c) : Y_sum
  ... = (A₀ ∪ A₁).sum (λ a, (p a).sum c) :
        by rw[union_sdiff_of_subset (subset_univ A₀)]
  ... = A₀.sum (λ a, (p a).sum c) + A₁.sum (λ a, (p a).sum c) :
         by { rw[sum_union (disjoint_iff.mpr (inter_sdiff_self _ _))] }
  ... = A₀.sum (λ a, 1) + A₁.sum (λ a, 0) :
         by rw[sum_congr rfl p_sum₀, sum_congr rfl p_sum₁]
  ... = A₀.sum (λ a, 1) : by rw[sum_const_zero,add_zero]
  ... = A₀.card • 1 : by { rw[sum_const] }
  ... = A₀.card : by simp only[nsmul_one,int.nat_cast_eq_coe_nat]
   ,
 have q_sum : ∀ U, (q U).sum c = (card_sign U) * (card (col_inter E U)) :=
  λ U,begin
   dsimp[q],
   have : (λ a, c ((j U) a)) = (λ a, card_sign U) := by {ext,refl},
   rw[sum_map,this,sum_const,nsmul_eq_mul',int.nat_cast_eq_coe_nat],
  end,
 exact calc
  ((clear_rows E).card : ℤ) = Y.sum c : Y_sum'.symm
  ... = Z.sum c : by rw[e]
  ... = univ.sum (λ U, (q U).sum c) : Z_sum
  ... = univ.sum (λ U, (card_sign U) * (card (col_inter E U))) :
         by {congr, ext, rw[q_sum]}
end

end matching
end combinatorics


import set_theory.surreal
open surreal
namespace surreal

theorem zero_add : ∀ x : surreal, 0 + x = x :=
sorry

theorem add_zero : ∀ x : surreal, x + 0 = x :=
sorry

instance : add_monoid surreal := {
  add := add,
  add_assoc := add_assoc,
  zero := 0,
  zero_add := zero_add,
  add_zero := add_zero }

-- add_group, add_comm_semigroup, add_comm_group, ordered_add_comm_group,
end


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

! This file was ported from Lean 3 source module category_theory.adjunction.comma
! leanprover-community/mathlib commit 8a318021995877a44630c898d0b2bc376fceef3b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Adjunction.Basic
import Mathlib.CategoryTheory.PUnit
import Mathlib.CategoryTheory.StructuredArrow

/-!
# Properties of comma categories relating to adjunctions

This file shows that for a functor `G : D ⥤ C` the data of an initial object in each
`StructuredArrow` category on `G` is equivalent to a left adjoint to `G`, as well as the dual.

Specifically, `adjunctionOfStructuredArrowInitials` gives the left adjoint assuming the
appropriate initial objects exist, and `mkInitialOfLeftAdjoint` constructs the initial objects
provided a left adjoint.

The duals are also shown.
-/

universe v₁ v₂ u₁ u₂

noncomputable section

namespace CategoryTheory

open Limits

variable {C : Type u₁} {D : Type u₂} [Category.{v₁} C] [Category.{v₂} D] (G : D ⥤ C)

section OfInitials

variable [∀ A, HasInitial (StructuredArrow A G)]

/-- Implementation: If each structured arrow category on `G` has an initial object, an equivalence
which is helpful for constructing a left adjoint to `G`.
-/
@[simps]
def leftAdjointOfStructuredArrowInitialsAux (A : C) (B : D) :
    ((⊥_ StructuredArrow A G).right ⟶ B) ≃ (A ⟶ G.obj B)
    where
  toFun g := (⊥_ StructuredArrow A G).hom ≫ G.map g
  invFun f := CommaMorphism.right (initial.to (StructuredArrow.mk f))
  left_inv g :=
    by
    let B' : StructuredArrow A G := StructuredArrow.mk ((⊥_ StructuredArrow A G).hom ≫ G.map g)
    let g' : ⊥_ StructuredArrow A G ⟶ B' := StructuredArrow.homMk g rfl
    have : initial.to _ = g' := by
      apply colimit.hom_ext
      rintro ⟨⟨⟩⟩
    change CommaMorphism.right (initial.to B') = _
    rw [this]
    rfl
  right_inv f := by
    let B' : StructuredArrow A G := StructuredArrow.mk f
    apply (CommaMorphism.w (initial.to B')).symm.trans (Category.id_comp _)
#align category_theory.left_adjoint_of_structured_arrow_initials_aux CategoryTheory.leftAdjointOfStructuredArrowInitialsAux

/--
If each structured arrow category on `G` has an initial object, construct a left adjoint to `G`. It
is shown that it is a left adjoint in `adjunctionOfStructuredArrowInitials`.
-/
def leftAdjointOfStructuredArrowInitials : C ⥤ D :=
  Adjunction.leftAdjointOfEquiv (leftAdjointOfStructuredArrowInitialsAux G) fun _ _ => by simp
#align category_theory.left_adjoint_of_structured_arrow_initials CategoryTheory.leftAdjointOfStructuredArrowInitials

/--
If each structured arrow category on `G` has an initial object, we have a constructed left adjoint
to `G`.
-/
def adjunctionOfStructuredArrowInitials : leftAdjointOfStructuredArrowInitials G ⊣ G :=
  Adjunction.adjunctionOfEquivLeft _ _
#align category_theory.adjunction_of_structured_arrow_initials CategoryTheory.adjunctionOfStructuredArrowInitials

/-- If each structured arrow category on `G` has an initial object, `G` is a right adjoint. -/
def isRightAdjointOfStructuredArrowInitials : IsRightAdjoint G
    where
  left := _
  adj := adjunctionOfStructuredArrowInitials G
#align category_theory.is_right_adjoint_of_structured_arrow_initials CategoryTheory.isRightAdjointOfStructuredArrowInitials

end OfInitials

section OfTerminals

variable [∀ A, HasTerminal (CostructuredArrow G A)]

/-- Implementation: If each costructured arrow category on `G` has a terminal object, an equivalence
which is helpful for constructing a right adjoint to `G`.
-/
@[simps]
def rightAdjointOfCostructuredArrowTerminalsAux (B : D) (A : C) :
    (G.obj B ⟶ A) ≃ (B ⟶ (⊤_ CostructuredArrow G A).left)
    where
  toFun g := CommaMorphism.left (terminal.from (CostructuredArrow.mk g))
  invFun g := G.map g ≫ (⊤_ CostructuredArrow G A).hom
  left_inv := by aesop_cat
  right_inv g :=
    by
    let B' : CostructuredArrow G A :=
      CostructuredArrow.mk (G.map g ≫ (⊤_ CostructuredArrow G A).hom)
    let g' : B' ⟶ ⊤_ CostructuredArrow G A := CostructuredArrow.homMk g rfl
    have : terminal.from _ = g' := by
      apply limit.hom_ext
      rintro ⟨⟨⟩⟩
    change CommaMorphism.left (terminal.from B') = _
    rw [this]
    rfl
#align category_theory.right_adjoint_of_costructured_arrow_terminals_aux CategoryTheory.rightAdjointOfCostructuredArrowTerminalsAux

/--
If each costructured arrow category on `G` has a terminal object, construct a right adjoint to `G`.
It is shown that it is a right adjoint in `adjunctionOfStructuredArrowInitials`.
-/
def rightAdjointOfCostructuredArrowTerminals : C ⥤ D :=
  Adjunction.rightAdjointOfEquiv (rightAdjointOfCostructuredArrowTerminalsAux G) fun B₁ B₂ A f g =>
    by
    rw [← Equiv.eq_symm_apply]
    simp
#align category_theory.right_adjoint_of_costructured_arrow_terminals CategoryTheory.rightAdjointOfCostructuredArrowTerminals

/-- If each costructured arrow category on `G` has a terminal object, we have a constructed right
adjoint to `G`.
-/
def adjunctionOfCostructuredArrowTerminals : G ⊣ rightAdjointOfCostructuredArrowTerminals G :=
  Adjunction.adjunctionOfEquivRight _ _
#align category_theory.adjunction_of_costructured_arrow_terminals CategoryTheory.adjunctionOfCostructuredArrowTerminals

/-- If each costructured arrow category on `G` has an terminal object, `G` is a left adjoint. -/
def isLeftAdjointOfCostructuredArrowTerminals : IsLeftAdjoint G
    where
  right := rightAdjointOfCostructuredArrowTerminals G
  adj := Adjunction.adjunctionOfEquivRight _ _
#align category_theory.is_left_adjoint_of_costructured_arrow_terminals CategoryTheory.isLeftAdjointOfCostructuredArrowTerminals

end OfTerminals

section

variable {F : C ⥤ D}

-- porting note: aesop can't seem to add something locally. Also no tactic.discrete_cases.
-- attribute [local tidy] tactic.discrete_cases

/-- Given a left adjoint to `G`, we can construct an initial object in each structured arrow
category on `G`. -/
def mkInitialOfLeftAdjoint (h : F ⊣ G) (A : C) :
    IsInitial (StructuredArrow.mk (h.unit.app A) : StructuredArrow A G)
    where
  desc B := StructuredArrow.homMk ((h.homEquiv _ _).symm B.pt.hom) (by aesop_cat)
  fac _ := by rintro ⟨⟨⟩⟩
  uniq s m _ := by
    apply StructuredArrow.ext
    dsimp
    rw [Equiv.eq_symm_apply, Adjunction.homEquiv_unit]
    apply StructuredArrow.w m
#align category_theory.mk_initial_of_left_adjoint CategoryTheory.mkInitialOfLeftAdjoint

/-- Given a right adjoint to `F`, we can construct a terminal object in each costructured arrow
category on `F`. -/
def mkTerminalOfRightAdjoint (h : F ⊣ G) (A : D) :
    IsTerminal (CostructuredArrow.mk (h.counit.app A) : CostructuredArrow F A)
    where
  lift B := CostructuredArrow.homMk (h.homEquiv _ _ B.pt.hom) (by aesop_cat)
  fac _ := by rintro ⟨⟨⟩⟩
  uniq s m _ := by
    apply CostructuredArrow.ext
    dsimp
    rw [h.eq_homEquiv_apply, Adjunction.homEquiv_counit]
    exact CostructuredArrow.w m
#align category_theory.mk_terminal_of_right_adjoint CategoryTheory.mkTerminalOfRightAdjoint

end

theorem nonempty_isRightAdjoint_iff_hasInitial_structuredArrow {G : D ⥤ C} :
    Nonempty (IsRightAdjoint G) ↔ ∀ A, HasInitial (StructuredArrow A G) :=
  ⟨fun ⟨h⟩ A => (mkInitialOfLeftAdjoint _ h.adj A).hasInitial, fun _ =>
    ⟨isRightAdjointOfStructuredArrowInitials _⟩⟩
#align category_theory.nonempty_is_right_adjoint_iff_has_initial_structured_arrow CategoryTheory.nonempty_isRightAdjoint_iff_hasInitial_structuredArrow

theorem nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow {F : C ⥤ D} :
    Nonempty (IsLeftAdjoint F) ↔ ∀ A, HasTerminal (CostructuredArrow F A) :=
  ⟨fun ⟨h⟩ A => (mkTerminalOfRightAdjoint _ h.adj A).hasTerminal, fun _ =>
    ⟨isLeftAdjointOfCostructuredArrowTerminals _⟩⟩
#align category_theory.nonempty_is_left_adjoint_iff_has_terminal_costructured_arrow CategoryTheory.nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow

end CategoryTheory


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

! This file was ported from Lean 3 source module category_theory.adjunction.mates
! leanprover-community/mathlib commit cea27692b3fdeb328a2ddba6aabf181754543184
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Adjunction.Basic
import Mathlib.CategoryTheory.Conj

/-!
# Mate of natural transformations

This file establishes the bijection between the 2-cells

         L₁                  R₁
      C --→ D             C ←-- D
    G ↓  ↗  ↓ H         G ↓  ↘  ↓ H
      E --→ F             E ←-- F
         L₂                  R₂

where `L₁ ⊣ R₁` and `L₂ ⊣ R₂`, and shows that in the special case where `G,H` are identity then the
bijection preserves and reflects isomorphisms (i.e. we have bijections `(L₂ ⟶ L₁) ≃ (R₁ ⟶ R₂)`, and
if either side is an iso then the other side is as well).

On its own, this bijection is not particularly useful but it includes a number of interesting cases
as specializations.

For instance, this generalises the fact that adjunctions are unique (since if `L₁ ≅ L₂` then we
deduce `R₁ ≅ R₂`).
Another example arises from considering the square representing that a functor `H` preserves
products, in particular the morphism `HA ⨯ H- ⟶ H(A ⨯ -)`. Then provided `(A ⨯ -)` and `HA ⨯ -` have
left adjoints (for instance if the relevant categories are cartesian closed), the transferred
natural transformation is the exponential comparison morphism: `H(A ^ -) ⟶ HA ^ H-`.
Furthermore if `H` has a left adjoint `L`, this morphism is an isomorphism iff its mate
`L(HA ⨯ -) ⟶ A ⨯ L-` is an isomorphism, see
https://ncatlab.org/nlab/show/Frobenius+reciprocity#InCategoryTheory.
This also relates to Grothendieck's yoga of six operations, though this is not spelled out in
mathlib: https://ncatlab.org/nlab/show/six+operations.
-/

universe v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

namespace CategoryTheory

open Category

variable {C : Type u₁} {D : Type u₂} [Category.{v₁} C] [Category.{v₂} D]

section Square

variable {E : Type u₃} {F : Type u₄} [Category.{v₃} E] [Category.{v₄} F]

variable {G : C ⥤ E} {H : D ⥤ F} {L₁ : C ⥤ D} {R₁ : D ⥤ C} {L₂ : E ⥤ F} {R₂ : F ⥤ E}

variable (adj₁ : L₁ ⊣ R₁) (adj₂ : L₂ ⊣ R₂)

--include adj₁ adj₂

/-- Suppose we have a square of functors (where the top and bottom are adjunctions `L₁ ⊣ R₁` and
`L₂ ⊣ R₂` respectively).

      C ↔ D
    G ↓   ↓ H
      E ↔ F

Then we have a bijection between natural transformations `G ⋙ L₂ ⟶ L₁ ⋙ H` and
`R₁ ⋙ G ⟶ H ⋙ R₂`.
This can be seen as a bijection of the 2-cells:

         L₁                  R₁
      C --→ D             C ←-- D
    G ↓  ↗  ↓ H         G ↓  ↘  ↓ H
      E --→ F             E ←-- F
         L₂                  R₂

Note that if one of the transformations is an iso, it does not imply the other is an iso.
-/
def transferNatTrans : (G ⋙ L₂ ⟶ L₁ ⋙ H) ≃ (R₁ ⋙ G ⟶ H ⋙ R₂)
    where
  toFun h :=
    { app := fun X => adj₂.unit.app _ ≫ R₂.map (h.app _ ≫ H.map (adj₁.counit.app _))
      naturality := fun X Y f => by
        dsimp
        rw [assoc, ← R₂.map_comp, assoc, ← H.map_comp, ← adj₁.counit_naturality, H.map_comp, ←
          Functor.comp_map L₁, ← h.naturality_assoc]
        simp }
  invFun h :=
    { app := fun X => L₂.map (G.map (adj₁.unit.app _) ≫ h.app _) ≫ adj₂.counit.app _
      naturality := fun X Y f => by
        dsimp
        rw [← L₂.map_comp_assoc, ← G.map_comp_assoc, ← adj₁.unit_naturality, G.map_comp_assoc, ←
          Functor.comp_map, h.naturality]
        simp }
  left_inv h := by
    ext X
    dsimp
    simp only [L₂.map_comp, assoc, adj₂.counit_naturality, adj₂.left_triangle_components_assoc, ←
      Functor.comp_map G L₂, h.naturality_assoc, Functor.comp_map L₁, ← H.map_comp,
      adj₁.left_triangle_components]
    dsimp
    simp only [id_comp, ← Functor.comp_map, ← Functor.comp_obj, NatTrans.naturality_assoc]
    simp only [Functor.comp_obj, Functor.comp_map, ← Functor.map_comp]
    have : Prefunctor.map L₁.toPrefunctor (NatTrans.app adj₁.unit X) ≫
        NatTrans.app adj₁.counit (Prefunctor.obj L₁.toPrefunctor X) = 𝟙 _ := by simp
    simp [this]
  -- See library note [dsimp, simp].
  right_inv h := by
    ext X
    dsimp
    simp [-Functor.comp_map, ← Functor.comp_map H, Functor.comp_map R₁, -NatTrans.naturality, ←
      h.naturality, -Functor.map_comp, ← Functor.map_comp_assoc G, R₂.map_comp]
#align category_theory.transfer_nat_trans CategoryTheory.transferNatTrans

theorem transferNatTrans_counit (f : G ⋙ L₂ ⟶ L₁ ⋙ H) (Y : D) :
    L₂.map ((transferNatTrans adj₁ adj₂ f).app _) ≫ adj₂.counit.app _ =
      f.app _ ≫ H.map (adj₁.counit.app Y) := by
  erw [Functor.map_comp]
  simp
#align category_theory.transfer_nat_trans_counit CategoryTheory.transferNatTrans_counit

theorem unit_transferNatTrans (f : G ⋙ L₂ ⟶ L₁ ⋙ H) (X : C) :
    G.map (adj₁.unit.app X) ≫ (transferNatTrans adj₁ adj₂ f).app _ =
      adj₂.unit.app _ ≫ R₂.map (f.app _) := by
  dsimp [transferNatTrans]
  rw [← adj₂.unit_naturality_assoc, ← R₂.map_comp, ← Functor.comp_map G L₂, f.naturality_assoc,
    Functor.comp_map, ← H.map_comp]
  dsimp; simp
#align category_theory.unit_transfer_nat_trans CategoryTheory.unit_transferNatTrans

-- See library note [dsimp, simp]
end Square

section Self

variable {L₁ L₂ L₃ : C ⥤ D} {R₁ R₂ R₃ : D ⥤ C}

variable (adj₁ : L₁ ⊣ R₁) (adj₂ : L₂ ⊣ R₂) (adj₃ : L₃ ⊣ R₃)

/-- Given two adjunctions `L₁ ⊣ R₁` and `L₂ ⊣ R₂` both between categories `C`, `D`, there is a
bijection between natural transformations `L₂ ⟶ L₁` and natural transformations `R₁ ⟶ R₂`.
This is defined as a special case of `transferNatTrans`, where the two "vertical" functors are
identity.
TODO: Generalise to when the two vertical functors are equivalences rather than being exactly `𝟭`.

Furthermore, this bijection preserves (and reflects) isomorphisms, i.e. a transformation is an iso
iff its image under the bijection is an iso, see eg `CategoryTheory.transferNatTransSelf_iso`.
This is in contrast to the general case `transferNatTrans` which does not in general have this
property.
-/
def transferNatTransSelf : (L₂ ⟶ L₁) ≃ (R₁ ⟶ R₂) :=
  calc
    (L₂ ⟶ L₁) ≃ _ := (Iso.homCongr L₂.leftUnitor L₁.rightUnitor).symm
    _ ≃ _ := transferNatTrans adj₁ adj₂
    _ ≃ (R₁ ⟶ R₂) := R₁.rightUnitor.homCongr R₂.leftUnitor

#align category_theory.transfer_nat_trans_self CategoryTheory.transferNatTransSelf

theorem transferNatTransSelf_counit (f : L₂ ⟶ L₁) (X) :
    L₂.map ((transferNatTransSelf adj₁ adj₂ f).app _) ≫ adj₂.counit.app X =
      f.app _ ≫ adj₁.counit.app X := by
  dsimp [transferNatTransSelf]
  rw [id_comp, comp_id]
  have := transferNatTrans_counit adj₁ adj₂ (L₂.leftUnitor.hom ≫ f ≫ L₁.rightUnitor.inv) X
  dsimp at this
  rw [this]
  simp
#align category_theory.transfer_nat_trans_self_counit CategoryTheory.transferNatTransSelf_counit

theorem unit_transferNatTransSelf (f : L₂ ⟶ L₁) (X) :
    adj₁.unit.app _ ≫ (transferNatTransSelf adj₁ adj₂ f).app _ =
      adj₂.unit.app X ≫ R₂.map (f.app _) := by
  dsimp [transferNatTransSelf]
  rw [id_comp, comp_id]
  have := unit_transferNatTrans adj₁ adj₂ (L₂.leftUnitor.hom ≫ f ≫ L₁.rightUnitor.inv) X
  dsimp at this
  rw [this]
  simp
#align category_theory.unit_transfer_nat_trans_self CategoryTheory.unit_transferNatTransSelf

@[simp]
theorem transferNatTransSelf_id : transferNatTransSelf adj₁ adj₁ (𝟙 _) = 𝟙 _ := by
  ext
  dsimp [transferNatTransSelf, transferNatTrans]
  simp
#align category_theory.transfer_nat_trans_self_id CategoryTheory.transferNatTransSelf_id

-- See library note [dsimp, simp]
@[simp]
theorem transferNatTransSelf_symm_id : (transferNatTransSelf adj₁ adj₁).symm (𝟙 _) = 𝟙 _ := by
  rw [Equiv.symm_apply_eq]
  simp
#align category_theory.transfer_nat_trans_self_symm_id CategoryTheory.transferNatTransSelf_symm_id

theorem transferNatTransSelf_comp (f g) :
    transferNatTransSelf adj₁ adj₂ f ≫ transferNatTransSelf adj₂ adj₃ g =
      transferNatTransSelf adj₁ adj₃ (g ≫ f) := by
  ext
  dsimp [transferNatTransSelf, transferNatTrans]
  simp only [id_comp, comp_id]
  rw [← adj₃.unit_naturality_assoc, ← R₃.map_comp, g.naturality_assoc, L₂.map_comp, assoc,
    adj₂.counit_naturality, adj₂.left_triangle_components_assoc, assoc]
  simp
#align category_theory.transfer_nat_trans_self_comp CategoryTheory.transferNatTransSelf_comp

theorem transferNatTransSelf_adjunction_id {L R : C ⥤ C} (adj : L ⊣ R) (f : 𝟭 C ⟶ L) (X : C) :
    (transferNatTransSelf adj Adjunction.id f).app X = f.app (R.obj X) ≫ adj.counit.app X := by
  dsimp [transferNatTransSelf, transferNatTrans, Adjunction.id]
  simp only [comp_id, id_comp]
#align category_theory.transfer_nat_trans_self_adjunction_id CategoryTheory.transferNatTransSelf_adjunction_id

theorem transferNatTransSelf_adjunction_id_symm {L R : C ⥤ C} (adj : L ⊣ R) (g : R ⟶ 𝟭 C) (X : C) :
    ((transferNatTransSelf adj Adjunction.id).symm g).app X = adj.unit.app X ≫ g.app (L.obj X) := by
  dsimp [transferNatTransSelf, transferNatTrans, Adjunction.id]
  simp only [comp_id, id_comp]
#align category_theory.transfer_nat_trans_self_adjunction_id_symm CategoryTheory.transferNatTransSelf_adjunction_id_symm

theorem transferNatTransSelf_symm_comp (f g) :
    (transferNatTransSelf adj₂ adj₁).symm f ≫ (transferNatTransSelf adj₃ adj₂).symm g =
      (transferNatTransSelf adj₃ adj₁).symm (g ≫ f) := by
  rw [Equiv.eq_symm_apply, ← transferNatTransSelf_comp _ adj₂]
  simp
#align category_theory.transfer_nat_trans_self_symm_comp CategoryTheory.transferNatTransSelf_symm_comp

theorem transferNatTransSelf_comm {f g} (gf : g ≫ f = 𝟙 _) :
    transferNatTransSelf adj₁ adj₂ f ≫ transferNatTransSelf adj₂ adj₁ g = 𝟙 _ := by
  rw [transferNatTransSelf_comp, gf, transferNatTransSelf_id]
#align category_theory.transfer_nat_trans_self_comm CategoryTheory.transferNatTransSelf_comm

theorem transferNatTransSelf_symm_comm {f g} (gf : g ≫ f = 𝟙 _) :
    (transferNatTransSelf adj₁ adj₂).symm f ≫ (transferNatTransSelf adj₂ adj₁).symm g = 𝟙 _ := by
  rw [transferNatTransSelf_symm_comp, gf, transferNatTransSelf_symm_id]
#align category_theory.transfer_nat_trans_self_symm_comm CategoryTheory.transferNatTransSelf_symm_comm

/-- If `f` is an isomorphism, then the transferred natural transformation is an isomorphism.
The converse is given in `transferNatTransSelf_of_iso`.
-/
instance transferNatTransSelf_iso (f : L₂ ⟶ L₁) [IsIso f] :
    IsIso (transferNatTransSelf adj₁ adj₂ f) :=
  ⟨⟨transferNatTransSelf adj₂ adj₁ (inv f),
      ⟨transferNatTransSelf_comm _ _ (by simp), transferNatTransSelf_comm _ _ (by simp)⟩⟩⟩
#align category_theory.transfer_nat_trans_self_iso CategoryTheory.transferNatTransSelf_iso

/-- If `f` is an isomorphism, then the un-transferred natural transformation is an isomorphism.
The converse is given in `transferNatTransSelf_symm_of_iso`.
-/
instance transferNatTransSelf_symm_iso (f : R₁ ⟶ R₂) [IsIso f] :
    IsIso ((transferNatTransSelf adj₁ adj₂).symm f) :=
  ⟨⟨(transferNatTransSelf adj₂ adj₁).symm (inv f),
      ⟨transferNatTransSelf_symm_comm _ _ (by simp), transferNatTransSelf_symm_comm _ _ (by simp)⟩⟩⟩
#align category_theory.transfer_nat_trans_self_symm_iso CategoryTheory.transferNatTransSelf_symm_iso

/-- If `f` is a natural transformation whose transferred natural transformation is an isomorphism,
then `f` is an isomorphism.
The converse is given in `transferNatTransSelf_iso`.
-/
theorem transferNatTransSelf_of_iso (f : L₂ ⟶ L₁) [IsIso (transferNatTransSelf adj₁ adj₂ f)] :
    IsIso f := by
  suffices IsIso ((transferNatTransSelf adj₁ adj₂).symm (transferNatTransSelf adj₁ adj₂ f))
    by simpa using this
  infer_instance
#align category_theory.transfer_nat_trans_self_of_iso CategoryTheory.transferNatTransSelf_of_iso

/--
If `f` is a natural transformation whose un-transferred natural transformation is an isomorphism,
then `f` is an isomorphism.
The converse is given in `transferNatTransSelf_symm_iso`.
-/
theorem transferNatTransSelf_symm_of_iso (f : R₁ ⟶ R₂)
    [IsIso ((transferNatTransSelf adj₁ adj₂).symm f)] : IsIso f := by
  suffices IsIso ((transferNatTransSelf adj₁ adj₂) ((transferNatTransSelf adj₁ adj₂).symm f))
    by simpa using this
  infer_instance
#align category_theory.transfer_nat_trans_self_symm_of_iso CategoryTheory.transferNatTransSelf_symm_of_iso

end Self

end CategoryTheory


import Mathlib
import LeanAide

/-!
## A bit of AI

We use `leanaide` for a bit of AI. For more direct use (such as debugging), can use

```lean
#eval translateViewM "There are infinitely many odd numbers"
```

For more details on using the AI, please see the [README](https://github.com/siddhartha-gadgil/LeanAide#readme) of the LeanAide project.

We also complete the proof as an example.
-/

/- There are infinitely many odd numbers -/
example : ∀ (n : ℕ), ∃ m, m > n ∧ m % 2 = 1 := by
  intro n -- introduce a variable n
  use 2 * n + 1 -- use `m = 2 * n + 1`
  apply And.intro -- apply the constructor of `∧` to split goals
  · linarith -- solve the first goal using `linarith`
  · simp [Nat.add_mod] -- solve the second goal using `simp` with the lemma `Nat.add_mod`


import algebra.group_with_zero.power

-- Vseobecny subor pre skusanie kdecoho elementarneho v leane

-- definicie

def x:ℕ :=5

-- typ sa da inferovat, netreba ho pisat

def x' := 5

-- funkcia "plna definicia"

def f:ℕ → ℕ := λ x:ℕ , 5+x

-- typova inferencia

def f' := λ x:ℕ , 5+x

def f'' := λ x, 5+x

def fz := λ x:ℤ , 5+x

-- syntakticky cukor pre definovanie funkcii
-- zatvorky musia byt!

def f'''(x:ℕ):= 5+x

-- typova inferencia

def f''''(x) := 5+x

-- funkcia dvoch argumentov
def s(x:ℕ) (y:ℕ) := x+y -- s : ℕ → ℕ → ℕ

-- parcialna evaluacia

def sp := s 5 -- sp : ℕ → ℕ

-- toto nejde typovo inferovat:

-- def s'(x) (y) := x + y

-- ale toto ano

 def s''(x) (y) := x+y+0

-- polymorfizmus cez typeclass -- pokus

def s'''{α : Type*} (x:α) (y:α) [has_add α] := x+y

#reduce s''' 5 5 -- ide
--#reduce s''' 5 -5 -- nejde, usudi asi ze -5 musi byt ℕ
#check s''' 5 (-5:ℤ)
#reduce s''' 5 (-5:ℤ) -- ale toto ide!

def a:ℤ := -5
def b:ℤ := -5

#reduce s''' a b -- ide
#reduce s''' a 10 -- ide tiez

-- lokalne definicie cez let

#eval let x:=5 in x+1
#eval let x:=1, y:=x+x in y*3

-- zavisle typy

universe u

def dependtype (α: Type u) :=
  Π (α : Type u) , (α → α) → (α → α)

#check dependtype -- Type u_1 → Type (u_1+1)
#check dependtype ℕ

-- explicitne uvedenie typu, komplet

def sqf : Π (α : Type u) , (α → α) → (α → α) :=
  λ (α: Type u) (f: α → α), f∘f

-- explicitne uvedenie typu + typova inferencia

def sqf' (α : Type u) :=
  λ (f: α → α), f∘f

def sqf'' :=
  λ (α: Type u) (f: α → α), f∘f

-- typy v lambde sa daju inferovat

def sqf''' : Π (α : Type u) , (α → α) → (α → α) :=
  λ α f, f∘f

#check sqf
#check sqf'
#check sqf''
#check sqf ℕ f
#eval sqf ℕ f 5 -- 15
#eval sqf'' ℕ f 5 -- 15

-- verzia horeuvedeneho s implicitnym typovym argumentom
-- pouzitie kuceravych zatvoriek

def sqf_implicit : Π {α : Type u} , (α → α) → (α → α) :=
  λ (α: Type u) (f: α → α), f∘f

def sqf_implicit' {α: Type u} :=
  λ (f: α → α), f∘f

def sqf_implicit'' :=
  λ {α: Type u} (f: α → α), f∘f

#check sqf_implicit -- (?M_1 → ?M_1) → ?M_1 → ?M_1

#check @sqf_implicit'' -- odimplicitenie
-- sqf_implicit'' : Π {α : Type u_1}, (α → α) → α → α

#check sqf_implicit'
#check sqf_implicit''
#eval sqf_implicit f 5 -- 15
#eval @sqf_implicit ℕ f 5 -- 15

-- syntakticky cukrik

#eval nat.add 5 5 -- toto je realny vyraz
#eval let x:=5 in x.add 5 -- toto su skratky
#eval (5:ℕ).add 5

#check (→) -- takto sa zabrani tomu, aby doslo k syntaktickej chybe
#check (1=1) → (2=2)

-- assume je iba alias pre λ

#eval (assume n:ℕ , n) 2

#check or (1=1) (2=1) -- treba zatvorkovat
#check 1=1 ∨ 2=1 -- netreba zatvorkovat
#eval (1=1 ∨ 2=1:bool) -- Prop sa da castnut ako bool, potom ho mozeme vypisat

section pred

variables (α: Type*) (p q :α → Prop)

example: (∀ x: α, p x ∧ q x) → ∀ y: α, p y :=
  begin
    intro h1,
    intro y,
    specialize h1 y,
    exact h1.left,
  end

end pred

def fib: ℕ → ℤ
| 0 := 0
| 1 := 1
| (n+2) := fib(n+1) + fib n

#print instances has_pow

theorem cassini : ∀ (n : ℕ), fib(n)*fib(n+2)-fib(n+1)*fib(n+1)=(-1:ℤ)^(n+1) :=
begin
  intro,
  induction n,
  {finish,},
  sorry,
end

-- typeclasses

#check has_le.le 1 2


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

! This file was ported from Lean 3 source module linear_algebra.basis.bilinear
! leanprover-community/mathlib commit 87c54600fe3cdc7d32ff5b50873ac724d86aef8d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.Basis
import Mathlib.LinearAlgebra.BilinearMap

/-!
# Lemmas about bilinear maps with a basis over each argument
-/

namespace LinearMap

variable {ι₁ ι₂ : Type _}

variable {R R₂ S S₂ M N P : Type _}

variable {Mₗ Nₗ Pₗ : Type _}

variable [CommSemiring R] [CommSemiring S] [CommSemiring R₂] [CommSemiring S₂]

section AddCommMonoid

variable [AddCommMonoid M] [AddCommMonoid N] [AddCommMonoid P]

variable [AddCommMonoid Mₗ] [AddCommMonoid Nₗ] [AddCommMonoid Pₗ]

variable [Module R M] [Module S N] [Module R₂ P] [Module S₂ P]

variable [Module R Mₗ] [Module R Nₗ] [Module R Pₗ]

variable [SMulCommClass S₂ R₂ P]

variable {ρ₁₂ : R →+* R₂} {σ₁₂ : S →+* S₂}

variable (b₁ : Basis ι₁ R M) (b₂ : Basis ι₂ S N) (b₁' : Basis ι₁ R Mₗ) (b₂' : Basis ι₂ R Nₗ)

/-- Two bilinear maps are equal when they are equal on all basis vectors. -/
theorem ext_basis {B B' : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (h : ∀ i j, B (b₁ i) (b₂ j) = B' (b₁ i) (b₂ j)) :
    B = B' :=
  b₁.ext fun i => b₂.ext fun j => h i j
#align linear_map.ext_basis LinearMap.ext_basis

/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis.

Version for semi-bilinear maps, see `sum_repr_mul_repr_mul` for the bilinear version. -/
theorem sum_repr_mul_repr_mulₛₗ {B : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (x y) :
    ((b₁.repr x).sum fun i xi => (b₂.repr y).sum fun j yj => ρ₁₂ xi • σ₁₂ yj • B (b₁ i) (b₂ j)) =
      B x y := by
  conv_rhs => rw [← b₁.total_repr x, ← b₂.total_repr y]
  simp_rw [Finsupp.total_apply, Finsupp.sum, map_sum₂, map_sum, LinearMap.map_smulₛₗ₂,
    LinearMap.map_smulₛₗ]
#align linear_map.sum_repr_mul_repr_mulₛₗ LinearMap.sum_repr_mul_repr_mulₛₗ

/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis.

Version for bilinear maps, see `sum_repr_mul_repr_mulₛₗ` for the semi-bilinear version. -/
theorem sum_repr_mul_repr_mul {B : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ} (x y) :
    ((b₁'.repr x).sum fun i xi => (b₂'.repr y).sum fun j yj => xi • yj • B (b₁' i) (b₂' j)) =
      B x y := by
  conv_rhs => rw [← b₁'.total_repr x, ← b₂'.total_repr y]
  simp_rw [Finsupp.total_apply, Finsupp.sum, map_sum₂, map_sum, LinearMap.map_smul₂,
    LinearMap.map_smul]
#align linear_map.sum_repr_mul_repr_mul LinearMap.sum_repr_mul_repr_mul

end AddCommMonoid

end LinearMap