import category_theory.category
import category_theory.isomorphism
import category_theory.types
import data.fintype.basic
import data.real.basic
import magma

open category_theory

namespace exercises

variables  {C: Type*} [category C]
variables (A B D A' B' D' X T : C)

-- Exercise 1 page 40
-- the inverse of identity is itself
example : is_iso(𝟙 A) := { inv := 𝟙 A}
-- given two morphisms, if f is isomorphic and has a reverse g, then g is iso and has reverse f
example (f : A ⟶ B) (g : B ⟶ A) (isof : is_iso f) (i : inv f = g) : is_iso g := {inv := f}
-- composition of isomorphisms are isomorphisms
example (f : A ⟶ B) (k : B ⟶ D) (isof : is_iso f) (isok : is_iso k) : is_iso (f ≫ k) :=
{inv := inv k ≫ inv f}

-- Exercise 2 page 42
lemma unique_inverse  (f : A ≅ B) (f' : A ≅ B) (g k : B ⟶ A) :
    f.hom = f'.hom -> f.inv = g → f'.inv = k → g = k :=
begin
    intros ff' finv f'inv,

    calc g = f.inv : by {rw finv}
    ... = f.inv ≫ f'.hom ≫ f'.inv : by {simp}
    ... = f.inv ≫ f.hom ≫ f'.inv : by {rw ← ff'}
    ... = 𝟙 B ≫ f'.inv : by {simp}
    ... = f'.inv : by simp
    ... = k : by {rw f'inv},
end

section alternative_unique_inverse

    lemma unique_inverse2 (g k: B ⟶ A)(f: A ⟶ B) (h1: f ≫ g = 𝟙 A)(h1a: g ≫ f = 𝟙 B)(h2: f ≫ k = 𝟙 A): g = k :=
    begin
        calc g = g ≫ 𝟙 A : by rw [category.comp_id]
        ... = g ≫ (f ≫ k) : by rw ← h2
        ... = (g ≫ f) ≫ k : by rw [category.assoc]
        ... = k : by rw [h1a, category.id_comp]
    end

    lemma unique_inverse3 (g k: B ⟶ A)(f: A ⟶ B) [is_iso f] (h1: inv f = g)(h2: inv f = k): g = k :=
    begin
        calc g = g ≫ 𝟙 A : by rw category.comp_id
        ... = g ≫ (f ≫ inv f) : by rw is_iso.hom_inv_id
        ... = g ≫ (f ≫ k) : by rw h2
        ... = (g ≫ f) ≫ k : by rw category.assoc
        ... = (inv f ≫ f) ≫ k : by rw h1
        ... = (𝟙 B) ≫ k : by rw is_iso.inv_hom_id
        ... = k : by rw category.id_comp,
    end
end alternative_unique_inverse

-- Exercise 3a page 43
lemma iso_cancel_left  (f : A ≅ B) (h k : D ⟶ A) :
h ≫ f.hom = k ≫ f.hom → h = k :=
begin
    intros fhfk,
    calc h = (h ≫ f.hom) ≫ f.inv : by {simp}
    ... = (k ≫ f.hom) ≫ f.inv : by {rw fhfk}
    ... = k : by {simp}
end

section alternative_ex3_page43
    lemma iso_cancel_left2 (f: A ⟶ B) [is_iso f](h k: D ⟶ A): h ≫ f = k ≫ f → h = k :=
    begin
        let g: B ⟶ A := is_iso.inv f,
        intros given,
        /- given : h ≫ f = k ≫ f -/
        calc h = h ≫ 𝟙 A : by rw category.comp_id
        ... = h ≫ (f ≫ g) : by rw is_iso.hom_inv_id
        ... = (h ≫ f) ≫ g: by rw category.assoc
        ... = (k ≫ f) ≫ g: by rw given
        ... = k ≫ (f ≫ g): by rw category.assoc
        ... = k ≫ 𝟙 A : by rw is_iso.hom_inv_id
        ... = k : by rw category.comp_id
    end
end alternative_ex3_page43

-- Exercise 3b page 43
lemma iso_cancel_right (f : A ≅ B) (h k : B ⟶ D) :
f.hom ≫ h = f.hom ≫ k → h = k :=
begin
    intros fhfk,
    calc h = f.inv ≫ (f.hom ≫ h)  : by {simp}
    ... = f.inv ≫ (f.hom ≫ k) : by {rw fhfk}
    ... = k : by {simp}
end

inductive Two : Type
| one | two

def swap : Two → Two
| Two.one := Two.two
| Two.two := Two.one

-- Exercise 3c page 43
lemma iso_cant_cancel_right_left :
∃ (A : Type) (f : A ≅ A) (h k : A ⟶ A), f.hom ≫ h = k ≫ f.hom ∧ h ≠ k :=
begin
    --let swap := ↾ swap,

    let swapswap : swap ∘ swap = id, {apply funext, intro x, cases x, refl, refl },
    --let swapswap : swap ≫ swap = 𝟙 Two, {funext ,},

    let f : Two ≅ Two := ⟨ swap, swap, swapswap, swapswap ⟩ ,
    let h := λ (n: Two), Two.one,
    let k := λ (n: Two), Two.two,
    have prop : f.hom ≫ h = k ≫ f.hom, {apply funext, intro x, cases x, refl, refl,},

    use [Two,f, h, k],

    split,
    {exact prop},

    have foo : h Two.one ≠ k Two.one, {change Two.one ≠ Two.two, simp,},

    --apply funext at H,
    intro H,

--rw funext at H,

    rw H at foo,
    exact foo (by refl),
end

--local attribute classical.prop_decidable

 lemma point_diff {α β : Type} {f1 f2 : α → β} (dif: ∃ x, f1 x ≠ f2 x) : f1 ≠ f2 :=
 begin
 simp,
 by_contradiction H,
 rw H at dif,
 cases dif with x hx,
 exact hx rfl ,
 end

lemma iso_cant_cancel_right_left' :
∃ (A : Type) (f : A ≅ A) (h k : A ⟶ A), f.hom ≫ h = k ≫ f.hom ∧ h ≠ k :=
begin
    have swapinv : swap ∘ swap = id, {funext, cases x; refl},

    let f : Two ≅ Two := ⟨ swap, swap, swapinv, swapinv ⟩ ,
    let h := λ (n: Two), Two.one,
    let k := λ (n: Two), Two.two,

    use [Two, f, h, k],

    split,
    { refl },
    { apply point_diff,
      use Two.one}
end

open bool

lemma iso_cant_cancel_right_left'' :
∃ (A : Type) (f : A ≅ A) (h k : A ⟶ A), f.hom ≫ h = k ≫ f.hom ∧ h ≠ k :=
begin
    have selfinv : bnot ∘ bnot = id, {funext, simp},

    -- have f : bool ≅ bool := ⟨ bnot, bnot, selfinv, selfinv ⟩,
    have f : iso bool bool , {exact ⟨ bnot, bnot, selfinv, selfinv ⟩},
    let h := (λ (n: bool), tt),
    let k := (λ (n: bool), ff),

    -- fixme if I pass f as second argument instead of the expansion, things break
    -- f for some reason doesn't see the "contents" like in iso_cant_cancel_right_left'
    --use [bool, f, h, k],
    use [bool, ⟨ bnot, bnot, selfinv, selfinv ⟩, h, k],

    split,
    { refl },
    { apply point_diff,
      use tt}
end

def has_retraction {A B : C} (f : A ⟶ B) := ∃ r, f ≫ r = 𝟙 A
def has_section {A B : C} (f : A ⟶ B) := ∃ s, s ≫ f = 𝟙 B

-- Exercise 6 page 52
lemma retraction_divides {T: C} (f : A ⟶ B) (ret: has_retraction f) (g: A ⟶ T) :
∃ t : B ⟶ T, f ≫ t = g :=
begin
    cases ret with s hS,
    let t := s ≫ g,
    use t,
    calc f ≫ t = f ≫ (s ≫ g) : by {refl}
    ... = (f ≫ s) ≫ g : by {simp}
    ... = 𝟙 A ≫ g : by {rw hS}
    ... = g : by {simp}
end

-- Exercise 7 page 53
lemma section_cancels_right {T: C} (f : A ⟶ B) (sec: has_section f)  (t₁ t₂: B ⟶ T):
f ≫ t₁ = f ≫ t₂ → t₁ = t₂ :=
begin
    intros h,
    cases sec with s hS,

    calc t₁ = 𝟙 B ≫ t₁ : by {rw category.id_comp}
    ... = (s ≫ f) ≫ t₁ : by {rw ← hS}
    ... = s ≫ f ≫ t₁ : by {apply category.assoc}
    ... = s ≫ f ≫ t₂ : by {rw h}
    ... = (s ≫ f) ≫ t₂ : by {rw category.assoc}
    ... = 𝟙 B ≫ t₂ : by {rw hS}
    ... = t₂ : by {apply category.id_comp},
end

-- Exercise 8 page 54
lemma section_comp_section_has_section (f : A ⟶ B) (g : B ⟶ D) (secf: has_section f) (secg: has_section g) :
has_section (f ≫ g) :=
begin
    cases secf with sf hsf,
    cases secg with sg hsg,

    use (sg ≫ sf),
    calc (sg ≫ sf ) ≫ f ≫ g = sg ≫ (sf ≫ f) ≫ g : by {simp}
    ... = sg ≫ 𝟙 B  ≫ g : by {rw hsf,}
    ... = sg ≫ g : by {simp}
    ... = 𝟙 D : by {rw hsg}
end

class idempotent {X: C} (endo : X ⟶ X) : Prop :=
(repeat : endo ≫ endo = endo)

@[reducible]
def is_retraction {A B : C} (f : A ⟶ B) (r : B ⟶ A) := f ≫ r = 𝟙 A

lemma is_retraction_retracts (f : A ⟶ B) (r : B ⟶ A) (ret: is_retraction f r) :
has_retraction f := ⟨ r, ret ⟩

-- Exercise 9a page 54
lemma retraction_section_is_idemp {f : A ⟶ B} {r : B ⟶ A} (ret: is_retraction f r)
: idempotent (r ≫ f) :=
begin
    split, -- this applies the constructor
    unfold is_retraction at ret, -- this is ugly, i shouldn't need it

    calc (r ≫ f) ≫ r ≫ f = r ≫ (f ≫ r) ≫ f : by {simp}
    ... = r ≫ f : by simp [ret]
end

open category_theory.iso

-- Exercise 9b page 54
lemma retraction_with_iso_is_id (I : A ≅ B) (r : B ⟶ A) (ret: is_retraction I.hom r) :
r ≫ I.hom = 𝟙 B :=
begin
    let f := I.hom,
    let g := I.inv,
    unfold is_retraction at ret,  -- this is ugly, i shouldn't need it

    calc r ≫ f = 𝟙 B ≫ r ≫ f : by rw category.id_comp
    ... = (g ≫ f) ≫ r ≫ f : by rw inv_hom_id
    ... = g ≫ (f ≫ r) ≫ f : by simp
    ... = g ≫ 𝟙 A ≫ f : by {rw ret}
    ... = g ≫ f : by {simp}
    ... = 𝟙 B : by {simp}
end

-- Exercise 10 page 55
lemma exercise_10 (If : A ≅ B) (Ig : B ≅ D) :
  inv (If.hom ≫ Ig.hom) = Ig.inv ≫ If.inv :=
begin
    split, --why is this enough?
end

@[derive decidable_eq]
inductive People11 : Type
| Fatima | Omer | Alysia

@[derive decidable_eq]
inductive Drinks11 : Type
| Coffee | Tea | Cocoa

-- Exercise 11a page 55
example : People11 ≅ Drinks11 :=
begin
    let f : People11 → Drinks11 :=
     λ p, match p with
            | People11.Fatima := Drinks11.Coffee
            | People11.Omer := Drinks11.Tea
            | People11.Alysia := Drinks11.Cocoa
            end,

    let g : Drinks11 → People11 :=
     λ d, match d with
            | Drinks11.Coffee := People11.Fatima
            | Drinks11.Tea := People11.Omer
            | Drinks11.Cocoa := People11.Alysia
            end,

    have id1 : f ∘ g = id, {funext, cases x; refl},
    have id2 : g ∘ f = id, {funext, cases x; refl},
    exact ⟨ ↾f, ↾g ⟩,
end

universes v u

-- this is ugly, why do I need to define this?
abbreviation from_hom {α β : Type} (f : α ⟶ β) : α → β := f

lemma type_isos_are_injective {A B: Type} (i: A ≅ B) :
∀ (a1 a2 : A), a1 ≠ a2 → i.hom a1 ≠ i.hom a2 :=
begin
    intros a1 a2 ne h,
    suffices H: a1 = a2,
    {exact ne H},
    { calc a1 = from_hom (𝟙 A) a1 : by {refl}
        ... = (i.hom ≫ i.inv) a1 : by {rw i.hom_inv_id}
        ... = i.inv (i.hom a1) : by {refl}
        ... = i.inv (i.hom a2) : by {rw h,}
        ... = (i.hom ≫ i.inv) a2 : by {simp}
        ... = from_hom (𝟙 A) a2 : by {rw i.hom_inv_id}
        ... = a2 : by {refl},
    }
end

lemma type_isos_are_surjective {A B: Type} (i: A ≅ B) :
∀ (b : B), ∃ (a : A), i.hom a = b :=
begin
    intros b,
    use i.inv b,
    calc i.hom (i.inv b) = (i.inv ≫ i.hom) b : by {simp}
        ... = from_hom (𝟙 B) b : by {rw i.inv_hom_id}
        ... = b : by {refl}
end

-- Exercise 11b page 55
example :  (People11 ≅ bool) → false :=
begin
    intros i,
    by_cases i.inv tt = i.inv ff,
    {
        -- when i.inv tt = i.inv ff
        apply type_isos_are_injective (symm i) _ _ _ h,
        simp,
    },
    {
        -- when i.inv tt ≠ i.inv ff
        have ugly : ∃ (p : People11), p ≠ i.inv tt ∧ p ≠ i.inv ff,
        {   cases i.inv tt,
            cases i.inv ff,
            use People11.Alysia,
            use People11.Alysia, simp,
            use People11.Omer, simp,
            cases i.inv ff,
            use People11.Alysia, simp, simp,
            use People11.Alysia,
            use People11.Fatima, simp,
            cases i.inv ff,
            use People11.Omer, simp,
            use People11.Fatima, simp,
            use People11.Omer
        },

        cases ugly with u hu,
        cases type_isos_are_surjective (symm i) u with a ha,
        change i.inv a = u at ha,
        cases a,
        exact hu.2 ha.symm,
        exact hu.1 ha.symm,
    }
end

open fintype

instance people_fintype: fintype People11 := {
    elems := [People11.Alysia, People11.Fatima, People11.Omer].to_finset,
    complete := by { intro x, cases x; simp }
}

-- Exercise 11b page 55
example  : (People11 ≃ bool) → false :=
begin
suffices cards : card People11 ≠ card bool,
{ intros h,
  exact cards (card_congr h)
},

{ change 3 ≠ 2, finish,}
end

-- Exercise 1 page 66
example :
 (λ x: ℝ, 2 * x) ∘ (λ x: ℝ, 1/2 * x) = id
 ∧
 (λ x: ℝ, 1/2 * x) ∘ (λ x: ℝ, 2 * x) = id :=
begin
split;
{ funext,
  simp,
  ring}
end

-- Exercise 2 page 66

inductive OddEven : Type
| odd | even

def add_odd_even : OddEven → OddEven → OddEven
| OddEven.odd OddEven.odd := OddEven.even
| OddEven.even OddEven.even := OddEven.even
| OddEven.odd OddEven.even := OddEven.odd
| OddEven.even OddEven.odd := OddEven.odd

inductive PosNeg : Type
| pos | neg

def mul_pos_neg : PosNeg → PosNeg → PosNeg
| PosNeg.pos PosNeg.pos := PosNeg.pos
| PosNeg.neg PosNeg.neg := PosNeg.pos
| PosNeg.pos PosNeg.neg := PosNeg.neg
| PosNeg.neg PosNeg.pos := PosNeg.neg

open magma

instance magma_oddeven: magma OddEven := {mul := add_odd_even}
instance magma_posneg: magma PosNeg := {mul := mul_pos_neg}

def OddEvenMagma : Magma := bundled.of OddEven
def PosNegMagma : Magma := bundled.of PosNeg

def oddeven2posneg : OddEven -> PosNeg
| OddEven.odd := PosNeg.neg
| OddEven.even := PosNeg.pos

def posneg2oddeven : PosNeg -> OddEven
| PosNeg.neg := OddEven.odd
| PosNeg.pos := OddEven.even

def oe2pn :  OddEvenMagma ⟶ PosNegMagma :=
{ to_fun := oddeven2posneg,
  preserves :=  λ x y, by {cases x; cases y; refl} }

def pn2oe :  PosNegMagma ⟶ OddEvenMagma :=
{ to_fun := posneg2oddeven,
  preserves :=  λ x y, by {cases x; cases y; refl} }

example : OddEvenMagma ≅ PosNegMagma :=
begin
    refine ⟨oe2pn, pn2oe, _, _ ⟩ ;
    { apply magma_hom_ext, intros x, cases x; refl}
end

-- Exercise 3 page 70

instance r_plus_magma_alpha_has_neg : has_neg r_plus_Magma.α :=  {
    neg := by {
        intros x,
        have isR : r_plus_Magma.α = ℝ, refl,
        rw isR at *,
        exact -x,
    }
}

def rplus_negate : r_plus_Magma ⟶ r_plus_Magma :=
{to_fun := has_neg.neg,
 preserves := by {
    intros x y,
    have isR : r_plus_Magma.α = ℝ, refl,
    rw isR at *,
    have isP : r_plus_Magma.str.mul = real.has_add.add, refl,
    rw isP,
    norm_num,
    rw add_comm,
 }
}

lemma rplus_negate_iso : rplus_negate ≫ rplus_negate = 𝟙 r_plus_Magma :=
begin
unfold rplus_negate category_struct.comp magma_hom_comp category_struct.id magma_id,
simp,
apply magma_hom_ext,
intros x,
have isR : r_plus_Magma.α = ℝ, refl,
rw isR at *,
simp,
rw neg_neg,
end

-- Exercise 1a page 70
example (A B C: Type) (f: A ⟶ B) (g: B ⟶ C) (a1 a2 : unit ⟶ A) :
a1 ≫ f = a2 ≫ f → a1 ≫ f ≫ g = a2 ≫ f ≫ g :=
begin
    intros h ,
    rw ← category.assoc,
    rw h,
    simp,
end

-- Exercise 2 page 71
example (A B C: Type) (f: A ⟶ B) (g: B ⟶ C) (h: A ⟶ C) (hcomp: h = f ≫ g):
∀ a : unit ⟶ A, ∃ b : unit ⟶ B, a ≫ f ≫ g = b ≫ g :=
begin
intros a,
exact ⟨ a ≫ f, by simp ⟩
end

def aba (A : Type u) (B : Type u) : Prop := nonempty (A ⟶ B)
def has_point (A : Type u) : Prop := nonempty (unit → A)

local infix <| := aba

-- Exercise 1 page 99
example {A : Type*} {B : Type*}  (h: ¬ (has_point A ∧  ¬ has_point B)) : A <| B :=
begin
push_neg at h,
by_cases has:has_point A,
    exact ⟨ λ _, (h has).some unit.star ⟩,
    exact ⟨ λ a, false.elim (has ⟨λ _, a⟩) ⟩
end

-- Exercise 1 page 99 (another approach)
example(A B : Type*)[category Type*] (h: ¬(has_point A ∧ ¬ has_point B )) : A <| B:=
begin
    push_neg at h,
    use  λ (a), (h(nonempty.intro (λ(x),a))).some unit.star,
end

def retractable (A : C) (B : C) := ∃ (s : A ⟶ B) (r : B ⟶ A), s ≫ r = 𝟙 A

infix ` ≤R `:50 := retractable

-- Exercise 2R page 100
example : A ≤R A := ⟨ 𝟙 A, 𝟙 A, category.id_comp _⟩

-- Exercise 2T page 100
example : A ≤R B → B ≤R D → A ≤R D :=
begin
intros ab bd,
rcases ab with ⟨abs, abr, hab⟩,
rcases bd with ⟨bds, bdr, hbd⟩,
use abs ≫ bds,
use bdr ≫ abr,
calc (abs ≫ bds) ≫ bdr ≫ abr = abs ≫ (bds ≫ bdr) ≫ abr : by simp
... = 𝟙 A : by simp [hab, hbd],
end

structure splitting {B: C} (e : B ⟶ B) [idempotent e] :=
(From: C)
(s : From ⟶ B)
(r : B ⟶ From)
(ret: is_retraction s r)
(is_idem: r ≫ s = e)

-- Exercise 3 page 102
lemma two_splittings_iso (e : B ⟶ B) [idempotent e]
(sp: splitting e) (sp': splitting e) : sp.From ≅ sp'.From :=
begin
rcases sp with  ⟨A,  s,  r,  ret,  is_idem ⟩,
rcases sp' with ⟨A', s', r', ret', is_idem'⟩,
unfold is_retraction at ret ret',

let f  : A  ⟶ A' := s ≫ e ≫ r',
let f' : A' ⟶ A := s' ≫ e ≫ r,

have id1 : f ≫ f' = 𝟙 A,
    {
        calc f ≫ f' = s ≫ e ≫ (r' ≫ s') ≫ e ≫ r : by simp
        ... = s ≫ e ≫ e ≫ e ≫ r : by rw is_idem'
        ... = s ≫ (e ≫ e) ≫ e ≫ r : by simp
        ... = s ≫ e ≫ e ≫ r : by simp [idempotent.repeat]
        ... = s ≫ (e ≫ e) ≫ r : by simp
        ... = s ≫ e ≫ r : by rw idempotent.repeat
        ... = s ≫ r ≫ s ≫ r : by {rw ← is_idem, simp}
        ... = 𝟙 A : by simp [ret]
    },

have id2 : f' ≫ f = 𝟙 A',
    {
        calc f' ≫ f = s' ≫ e ≫ r ≫ s ≫ e ≫ r' : by simp
        ... = s' ≫ e ≫ (r ≫ s) ≫ e ≫ r' : by simp
        ... = s' ≫ e ≫ e ≫ e ≫ r' : by rw is_idem
        ... = s' ≫ (e ≫ e) ≫ e ≫ r' : by simp
        ... = s' ≫ e ≫ e ≫ r' : by rw idempotent.repeat
        ... = s' ≫ (e ≫ e) ≫ r' : by simp
        ... = s' ≫ e ≫ r' : by rw idempotent.repeat
        ... = s' ≫ r' ≫ s' ≫ r' : by {rw ← is_idem', simp}
        ... = 𝟙 A' : by simp [ret']
    },

exact ⟨f, f'⟩
end

-- Exercise 2 page 108
example  (p : A ⟶ B) (q : B ⟶ A) (h: p ≫ q ≫ p = p) : idempotent (p ≫ q) :=
begin
split,
calc (p ≫ q) ≫ p ≫ q = (p ≫ q ≫ p) ≫ q : by simp
    ... = p ≫ q : by rw h
end

example  (p : A ⟶ B) (q : B ⟶ A) (h: p ≫ q ≫ p = p) : idempotent (q ≫ p) :=
begin
split,
calc (q ≫ p) ≫ q ≫ p = q ≫ (p ≫ q ≫ p) : by simp
    ... = q ≫ p : by rw h
end

-- Exercise 2* page 108
example  (p : A ⟶ B) (q : B ⟶ A) (h: p ≫ q ≫ p = p) :
∃ (q' : B ⟶ A), (p ≫ q' ≫ p = p)  ∧  (q' ≫ p ≫ q' = q') :=
begin
use q ≫ p ≫ q,
split,

    calc p ≫ (q ≫ p ≫ q) ≫ p = (p ≫ q ≫ p) ≫ q ≫ p : by simp
        ... = p : by rw [h, h],

    calc (q ≫ p ≫ q) ≫ p ≫ q ≫ p ≫ q = q ≫ (p ≫ q ≫ p) ≫ q ≫ p ≫ q : by simp
        ... = q ≫ p ≫ q ≫ p ≫ q : by rw h
        ... = q ≫ (p ≫ q ≫ p) ≫ q : by simp
        ... = q ≫ p ≫ q : by rw h
end

-- Exercise 1* page 108
def inclusionNZ : ℕ ⟶ ℤ := λ n:ℕ, int.of_nat n
def retractionZN : ℤ ⟶ ℕ := λ i:ℤ, int.to_nat i

example : is_retraction inclusionNZ retractionZN :=
begin
unfold is_retraction,
unfold inclusionNZ,
unfold retractionZN,
funext,
simp
end

example (f : ℤ ⟶ ℕ): ¬ is_retraction f inclusionNZ :=
begin
unfold is_retraction,
intros h,
rewrite [types_id, types_comp] at h,
have neg : id (-5 : ℤ) < 0 , by norm_num,
have isnat : f (-5) >= 0, by {apply zero_le},
have pos : (inclusionNZ ∘ f) (-5) >= 0, by simp [isnat],

rw h at pos,
linarith,
end

-- Exercise 2 page 126
lemma fp_of_retraction_fp
    {T : C} {s : A ⟶ X} {r : X ⟶ A} (ret : is_retraction s r)
    (h : ∀ (f : X ⟶ X), ∃ (x : T ⟶ X), x ≫ f = x) :
    ∀ (g : A ⟶ A), ∃ (x : T ⟶ A), x ≫ g = x :=
begin
    intros g,
    cases h (r ≫ g ≫ s) with x hx,
    use x ≫ r,
    unfold is_retraction at ret,
    calc (x ≫ r) ≫ g = x ≫ r ≫ g ≫ 𝟙 A : by {simp}
        ... = x ≫ r ≫ g ≫ (s ≫ r) : by {rw ret,}
        ... = (x ≫ r ≫ g ≫ s) ≫ r : by simp
        ... = x ≫ r : by rw hx,
end

-- Exercise 3 page 126
namespace ex3_page126
section wrap

parameters (CC : Type*) [category CC]
parameters (Circle Disk Term : CC)

parameter antipodal : (Circle ⟶ Circle)
parameter j : (Circle ⟶ Disk)
-- Notice, no axioms on j, so it's arbitrary, not a real inclusion

-- axioms
lemma antipodal_no_fp : ¬ ∃ (x : Term ⟶ Circle), x ≫ antipodal = x  := sorry
lemma has_fp : ∀ (f : Disk ⟶ Disk), ∃ (x : Term ⟶ Disk), x ≫ f = x  := sorry

include Term
include antipodal
example : ¬ ∃ (r : Disk ⟶ Circle), is_retraction j r :=
begin
    by_contradiction contra,
    cases contra with r ret,
    have exist_fp := fp_of_retraction_fp Circle Disk ret (has_fp CC Disk Term) antipodal,
    have not_exist_fp := antipodal_no_fp CC Circle Term antipodal,
    exact not_exist_fp exist_fp,
end
end wrap
end ex3_page126

end exercises


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl, Reid Barton, Sean Leather

! This file was ported from Lean 3 source module category_theory.concrete_category.bundled
! 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.Tactic.Lint.Default

/-!
# Bundled types

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

`bundled c` provides a uniform structure for bundling a type equipped with a type class.

We provide `category` instances for these in `category_theory/unbundled_hom.lean`
(for categories with unbundled homs, e.g. topological spaces)
and in `category_theory/bundled_hom.lean` (for categories with bundled homs, e.g. monoids).
-/

universe u v

namespace CategoryTheory

variable {c d : Type u → Type v} {α : Type u}

#print CategoryTheory.Bundled /-
/-- `bundled` is a type bundled with a type class instance for that type. Only
the type class is exposed as a parameter. -/
@[nolint has_nonempty_instance]
structure Bundled (c : Type u → Type v) : Type max (u + 1) v where
  α : Type u
  str : c α := by infer_instance
#align category_theory.bundled CategoryTheory.Bundled
-/

namespace Bundled

#print CategoryTheory.Bundled.of /-
-- Usually explicit instances will provide their own version of this, e.g. `Mon.of` and `Top.of`.
/-- A generic function for lifting a type equipped with an instance to a bundled object. -/
def of {c : Type u → Type v} (α : Type u) [str : c α] : Bundled c :=
  ⟨α, str⟩
#align category_theory.bundled.of CategoryTheory.Bundled.of
-/

instance : CoeSort (Bundled c) (Type u) :=
  ⟨Bundled.α⟩

#print CategoryTheory.Bundled.coe_mk /-
@[simp]
theorem coe_mk (α) (str) : (@Bundled.mk c α str : Type u) = α :=
  rfl
#align category_theory.bundled.coe_mk CategoryTheory.Bundled.coe_mk
-/

#print CategoryTheory.Bundled.map /-
/-
`bundled.map` is reducible so that, if we define a category

  def Ring : Type (u+1) := induced_category SemiRing (bundled.map @ring.to_semiring)

instance search is able to "see" that a morphism R ⟶ S in Ring is really
a (semi)ring homomorphism from R.α to S.α, and not merely from
`(bundled.map @ring.to_semiring R).α` to `(bundled.map @ring.to_semiring S).α`.
-/
/-- Map over the bundled structure -/
@[reducible]
def map (f : ∀ {α}, c α → d α) (b : Bundled c) : Bundled d :=
  ⟨b, f b.str⟩
#align category_theory.bundled.map CategoryTheory.Bundled.map
-/

end Bundled

end CategoryTheory


import algebra
import algebra.group
import algebra.group.defs
import logic.relation
import order.lexicographic
import declare

instance fin.has_top (k : ℕ) : has_top (fin k.succ) := ⟨k⟩
-- todo instance i2 : linear_order unit := sorry
-- instance i2 (k : ℕ) : linear_order (fin k) := infer_instance
-- instance i3 {α β: Type*} [linear_order α] [linear_order β] : linear_order (lex α β) := infer_instance

universes u v
variables (α β : Type*)

def emit_type (I V : Type*) := option (I × option V)

structure iter (σ I V : Type*) :=
  (δ : function.End σ)
  (emit : σ → emit_type I V)

def_declare one := "variables {σ I V : Type} [linear_order I] (a : iter σ I V)"
def_declare two := "variables {σ₁ σ₂ I I₁ I₂ V V₁ V₂ V₃ : Type} [linear_order I] [linear_order I₁] [linear_order I₂] (a : iter σ₁ I V₁) (b : iter σ₂ I V₂)"
def_declare add := "variables (add : V₁ → V₂ → V₃) [has_zero V₁] [has_zero V₂] [has_zero V₃]"
def_declare mul := "variables (mul : V₁ → V₂ → V₃)"

namespace iter

section params_unary
variables {σ I V : Type} (a : iter σ I V) (s t : σ)

def ι : with_top I := match a.emit s with | none := none | some (i, _) := some i end
def ν :   option V := match a.emit s with | none := none | some (_, v) := v end
--def ν :   option V := option.bind (a.emit s) prod.snd

section semantics
variables [add_monoid V] [decidable_eq I]

def elementary (i : I) (v : V) := λ j, if i = j then v else 0

@[simp] def semantics₁ (s : σ) : I → V :=
  match a.emit s with
  | none := 0
  | some (i, none) := 0
  | some (i, some v) := elementary i v
  end

@[simp] def semantics : σ → ℕ → I → V
| _ 0 := 0
| s (n+1) := a.semantics₁ s + semantics (a.δ s) n

--notation `⟦` a, s `⟧` := a.semantics s
notation `⟦` a, s, j `⟧` := a.semantics s j
--example (j : ℕ) : ∀ i:I, ⟦a, s, j⟧ i = ⟦a, s⟧ j i := λ _, rfl

end semantics

variables [linear_order I]

def reachable := relation.refl_trans_gen (λ s t, t = a.δ s)

namespace transition -- can't use reachable??
open relation.refl_trans_gen
theorem trans {x y z : σ} : reachable a x y → reachable a y z → reachable a x z := trans
def step {x : σ} : reachable a x (a.δ x) := single rfl
end transition

theorem none_top {α : Type*} [linear_order α] : ∀ {i : with_top α}, ⊤ ≤ i → i = none | _ h := le_antisymm le_top h

def step       (s : σ) (i:ℕ) := a.δ^i • s
def monotonic          := ∀ (s t : σ), a.reachable s t → a.ι s ≤ a.ι t
def terminal   (s : σ) := a.ι s = ⊤
def finite     (s : σ) := ∃ (t : σ), reachable a s t ∧ terminal a t
def productive (s : σ) := ν a s ≠ none
def reduced    (s : σ) := ∀ (t t' : σ), a.reachable s t → a.reachable s t' →
  productive a t → productive a t' → ι a t = ι a t' → t = t'

def future (s : σ) : set σ := { t | reachable a s t ∧ ¬ terminal a t}
@[simp] def terminal_by (s : σ) (i : ℕ) := a.terminal (a.step s i)

instance [decidable_eq I] : decidable (terminal a s) := if h : ι a s = none then is_true h else is_false h

lemma some_not_terminal {a : iter σ I V} {s} {i : I} : a.ι s = some i → ¬ a.terminal s :=
λ h1 h2, false.rec _ (option.some_ne_none i (h1 ▸ h2))

open relation.refl_trans_gen
def path_of_index {a : iter σ I V} : ∀ (i:ℕ), a.reachable s (a.step s i)
| 0 := refl
| (n+1) := tail (path_of_index n) rfl

lemma le_of_index_lt {a : iter σ I V} (i j : ℕ) : a.monotonic → i ≤ j → a.ι ((a.δ^i)•s) ≤ a.ι ((a.δ^j) • s) := begin
  intros mono lt, apply mono, induction lt, exact refl, exact tail ‹_› rfl,
end
lemma index_lt_of_ge {a : iter σ I V} (i j : ℕ) : a.monotonic → a.ι ((a.δ^i)•s) < a.ι ((a.δ^j)•s) → i < j := λ mono, begin
have h := mt (le_of_index_lt s j i mono),
simpa using h,
end

@[simp] lemma step_zero : a.step s 0 = s := rfl
@[simp] lemma step_succ (s : σ) (i : ℕ) : a.step s i.succ = a.step (a.δ s) i :=
begin
change a.δ ^ (i+1) • s = a.δ ^ i • a.δ^1 • s,
rw [pow_add, mul_smul],
end

lemma not_terminal_succ {a : iter σ I V} {i : ℕ} {s} : ¬ a.terminal s → a.terminal_by s i → ∃ i':ℕ, i = i'.succ := begin
intros hnt ht, induction i with i hi,
exact false.rec _ (hnt ht),
exact ⟨i, rfl⟩,
end

lemma index_of_path {a : iter σ I V} {s t} : a.reachable s t → ∃ (i: ℕ), t = a.step s i := begin
  intros p, induction p, refine ⟨0 , _⟩, refl,
  case tail : s1 s2 path st h {
    cases h with i hh, refine ⟨i+1, _⟩,
    simp only [step] at *,
    rw [add_comm, pow_add, mul_smul, ← hh], exact st,
  }
end

section lemmas

lemma ι_top_emit_none {a : iter σ I V} {s} : a.ι s = ⊤ ↔ a.emit s = none := begin
split; intro h1,
{ cases h : a.emit s, exact rfl,
  cases val,
  simp only [ι, h] at h1,
  exfalso, apply option.some_ne_none _ h1 },
{ simp only [ι, h1], refl },
end

@[simp]
theorem terminal_succ_terminal {a : iter σ I V} (m : a.monotonic) (h : a.terminal t) : a.terminal (a.δ t) :=
begin
simp only [terminal] at *, apply none_top, rw ←h, exact m _ _ (transition.step _)
end

@[simp]
theorem emit_none_of_terminal {a : iter σ I V} {t} : a.terminal t → a.emit t = none := begin
intro h, simp only [terminal] at h, exact ι_top_emit_none.1 h,
end

end lemmas
end params_unary
end iter

structure stream (σ I V : Type*) :=
  (q : σ)
  (iter : iter σ I V)

namespace stream
variables {σ I V : Type} (s : stream σ I V)

@[simp] def ι := s.iter.ι s.q
@[simp] def ν := s.iter.ν s.q

@[simp] def δ (s : stream σ I V) : stream σ I V :=
{ q := s.iter.δ s.q .. s}

@[simp] def emit : emit_type I V := s.iter.emit s.q

variables [decidable_eq I]

@[simp] def semantics₁ [add_monoid V] (s : stream σ I V) : I → V
:= s.iter.semantics₁ s.q
-- simp?
@[simp] def semantics [add_monoid V] (s : stream σ I V) : ℕ → I → V
:= s.iter.semantics s.q
notation `⟦` s, i `⟧` := s.semantics i

variables [linear_order I]

@[simp] def terminal_by (i : ℕ) := s.iter.terminal_by s.q i

@[simp] def monotonic := s.iter.monotonic

end stream


import hilbert.wr.dc

namespace clfrags
    namespace hilbert
        namespace wr
            namespace dc

                theorem dc₄' {a b c : Prop} (h₁ : dc a b c) : dc b a c :=
                    have h₂ : dc (dc b a c) (dc a b c) (dc a b c), from dc₃ h₁,
                    have h₃ : dc (dc a b c) (dc b a c) (dc b a c), from dc₄ h₂,
                    show dc b a c, from dc₂ h₃

                theorem dc₅' {a b c : Prop} (h₁ : dc a b c) : dc a c b :=
                    have h₂ : dc (dc a c b) (dc a b c) (dc a b c), from dc₃ h₁,
                    have h₃ : dc (dc a b c) (dc a c b) (dc a c b), from dc₅ h₂,
                    show dc a c b, from dc₂ h₃

                theorem dc₆' {a b c d e : Prop}
                    (h₁ : dc d e (dc a b c)) : dc (dc d e a) (dc d e b) c :=
                    let f := dc d e (dc a b c), g := dc (dc d e a) (dc d e b) c in
                        have h₂ : dc g f f, from dc₃ h₁,
                        have h₃ : dc g f g, from dc₆ h₂,
                        have h₄ : dc f g g, from dc₄' h₃,
                        show g, from dc₂ h₄

                theorem dc₇' {a b c d e : Prop}
                    (h₁ : dc (dc d e a) (dc d e b) c) : dc d e (dc a b c) :=
                    let f := dc d e (dc a b c), g := dc (dc d e a) (dc d e b) c in
                        have h₂ : dc f g g, from dc₃ h₁,
                        have h₃ : dc f g f, from dc₇ h₂,
                        have h₄ : dc g f f, from dc₄' h₃,
                        show f, from dc₂ h₄

                theorem dc₁_dc {a b c d e : Prop} (h₁ : dc d e a) (h₂ : dc d e b) :
                    dc d e (dc a b c) :=
                    have h₂ : dc (dc d e a) (dc d e b) c, from dc₁ h₁ h₂,
                    show dc d e (dc a b c), from dc₇' h₂

                theorem dc₂_dc {a b c d : Prop} (h₁ : dc c d (dc b a a)) : dc c d a :=
                    have h₂ : dc d c (dc a b a), from dc₄ h₁,
                    have h₃ : dc c d (dc a a b), from dc₅ h₂,
                    have h₄ : dc (dc c d a) (dc c d a) b, from dc₆' h₃,
                    have h₅ : dc b (dc c d a) (dc c d a), from dc₄' (dc₅' h₄),
                    show dc c d a, from dc₂ h₅

                theorem dc₃_dc {a b c d : Prop} (h₁ : dc c d a) : dc c d (dc b a a) :=
                    have h₂ : dc b (dc c d a) (dc c d a), from dc₃ h₁,
                    have h₃ : dc (dc c d a) (dc c d a) b, from dc₅' (dc₄' h₂),
                    have h₄ : dc c d (dc a a b), from dc₇' h₃,
                    have h₅ : dc d c (dc a b a), from dc₅ h₄,
                    show dc c d (dc b a a), from dc₄ h₅

                theorem dc₄_dc {a b c d e f g : Prop} (h₁ : dc f g (dc d e (dc a b c))) :
                    dc f g (dc e d (dc b a c)) :=
                    have h₂ : dc g f (dc e d (dc a b c)), from dc₄ h₁,
                    have h₃ : dc g f (dc (dc e d a) (dc e d b) c), from dc₆ h₂,
                    have h₄ : dc f g (dc (dc e d b) (dc e d a) c), from dc₄ h₃,
                    show dc f g (dc e d (dc b a c)), from dc₇ h₄

                theorem dc₅_dc {a b c d e f g : Prop} (h₁ : dc f g (dc d e (dc a b c))) :
                    dc f g (dc e d (dc a c b)) :=
                    have h₂ : dc g f (dc e d (dc a b c)), from dc₄ h₁,
                    have h₃ : dc (dc g f e) (dc g f d) (dc a b c), from dc₆' h₂,
                    have h₄ : dc (dc g f d) (dc g f e) (dc a c b), from dc₅ h₃,
                    have h₅ : dc g f (dc d e (dc a c b)), from dc₇' h₄,
                    show dc f g (dc e d (dc a c b)), from dc₄ h₅

                theorem dc₆_dc {a b c d e f g h i : Prop}
                    (h₁ : dc h i (dc f g (dc d e (dc a b c))))
                    : dc h i (dc f g (dc (dc d e a) (dc d e b) c)) :=
                    have h₂ : dc (dc h i f) (dc h i g) (dc d e (dc a b c)), from dc₆' h₁,
                    have h₃ : dc (dc h i f) (dc h i g) (dc (dc d e a) (dc d e b) c), from dc₆ h₂,
                    show dc h i (dc f g (dc (dc d e a) (dc d e b) c)), from dc₇' h₃

                theorem dc₇_dc {a b c d e f g h i : Prop}
                    (h₁ : dc h i (dc f g (dc (dc d e a) (dc d e b) c))) :
                    dc h i (dc f g (dc d e (dc a b c))) :=
                    have h₂ : dc (dc h i f) (dc h i g) (dc (dc d e a) (dc d e b) c), from dc₆' h₁,
                    have h₃ : dc (dc h i f) (dc h i g) (dc d e (dc a b c)), from dc₇ h₂,
                    show dc h i (dc f g (dc d e (dc a b c))), from dc₇' h₃

            end dc
        end wr
    end hilbert
end clfrags


example (P Q : Type) (p : P) (h : P → Q) : Q :=
begin
exact h(p),
end


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.seq.seq
import Mathlib.Lean3Lib.data.dlist
import Mathlib.PostPort

universes u_1 u v w

namespace Mathlib

/-
coinductive wseq (α : Type u) : Type u
| nil : wseq α
| cons : α → wseq α → wseq α
| think : wseq α → wseq α
-/

/-- Weak sequences.

  While the `seq` structure allows for lists which may not be finite,
  a weak sequence also allows the computation of each element to
  involve an indeterminate amount of computation, including possibly
  an infinite loop. This is represented as a regular `seq` interspersed
  with `none` elements to indicate that computation is ongoing.

  This model is appropriate for Haskell style lazy lists, and is closed
  under most interesting computation patterns on infinite lists,
  but conversely it is difficult to extract elements from it. -/
def wseq (α : Type u_1) := seq (Option α)

namespace wseq

/-- Turn a sequence into a weak sequence -/
def of_seq {α : Type u} : seq α → wseq α := Functor.map some

/-- Turn a list into a weak sequence -/
def of_list {α : Type u} (l : List α) : wseq α := of_seq ↑l

/-- Turn a stream into a weak sequence -/
def of_stream {α : Type u} (l : stream α) : wseq α := of_seq ↑l

protected instance coe_seq {α : Type u} : has_coe (seq α) (wseq α) := has_coe.mk of_seq

protected instance coe_list {α : Type u} : has_coe (List α) (wseq α) := has_coe.mk of_list

protected instance coe_stream {α : Type u} : has_coe (stream α) (wseq α) := has_coe.mk of_stream

/-- The empty weak sequence -/
def nil {α : Type u} : wseq α := seq.nil

protected instance inhabited {α : Type u} : Inhabited (wseq α) := { default := nil }

/-- Prepend an element to a weak sequence -/
def cons {α : Type u} (a : α) : wseq α → wseq α := seq.cons (some a)

/-- Compute for one tick, without producing any elements -/
def think {α : Type u} : wseq α → wseq α := seq.cons none

/-- Destruct a weak sequence, to (eventually possibly) produce either
  `none` for `nil` or `some (a, s)` if an element is produced. -/
def destruct {α : Type u} : wseq α → computation (Option (α × wseq α)) :=
  computation.corec fun (s : wseq α) => sorry

def cases_on {α : Type u} {C : wseq α → Sort v} (s : wseq α) (h1 : C nil)
    (h2 : (x : α) → (s : wseq α) → C (cons x s)) (h3 : (s : wseq α) → C (think s)) : C s :=
  seq.cases_on s h1 fun (o : Option α) => option.cases_on o h3 h2

protected def mem {α : Type u} (a : α) (s : wseq α) := seq.mem (some a) s

protected instance has_mem {α : Type u} : has_mem α (wseq α) := has_mem.mk wseq.mem

theorem not_mem_nil {α : Type u} (a : α) : ¬a ∈ nil := seq.not_mem_nil ↑a

/-- Get the head of a weak sequence. This involves a possibly
  infinite computation. -/
def head {α : Type u} (s : wseq α) : computation (Option α) :=
  computation.map (Functor.map prod.fst) (destruct s)

/-- Encode a computation yielding a weak sequence into additional
  `think` constructors in a weak sequence -/
def flatten {α : Type u} : computation (wseq α) → wseq α :=
  seq.corec fun (c : computation (wseq α)) => sorry

/-- Get the tail of a weak sequence. This doesn't need a `computation`
  wrapper, unlike `head`, because `flatten` allows us to hide this
  in the construction of the weak sequence itself. -/
def tail {α : Type u} (s : wseq α) : wseq α :=
  flatten ((fun (o : Option (α × wseq α)) => option.rec_on o nil prod.snd) <$> destruct s)

/-- drop the first `n` elements from `s`. -/
@[simp] def drop {α : Type u} (s : wseq α) : ℕ → wseq α := sorry

/-- Get the nth element of `s`. -/
def nth {α : Type u} (s : wseq α) (n : ℕ) : computation (Option α) := head (drop s n)

/-- Convert `s` to a list (if it is finite and completes in finite time). -/
def to_list {α : Type u} (s : wseq α) : computation (List α) :=
  computation.corec (fun (_x : List α × wseq α) => sorry) ([], s)

/-- Get the length of `s` (if it is finite and completes in finite time). -/
def length {α : Type u} (s : wseq α) : computation ℕ :=
  computation.corec (fun (_x : ℕ × wseq α) => sorry) (0, s)

/-- A weak sequence is finite if `to_list s` terminates. Equivalently,
  it is a finite number of `think` and `cons` applied to `nil`. -/
def is_finite {α : Type u} (s : wseq α) := computation.terminates (to_list s)

protected instance to_list_terminates {α : Type u} (s : wseq α) [h : is_finite s] :
    computation.terminates (to_list s) :=
  h

/-- Get the list corresponding to a finite weak sequence. -/
def get {α : Type u} (s : wseq α) [is_finite s] : List α := computation.get (to_list s)

/-- A weak sequence is *productive* if it never stalls forever - there are
 always a finite number of `think`s between `cons` constructors.
 The sequence itself is allowed to be infinite though. -/
def productive {α : Type u} (s : wseq α) := ∀ (n : ℕ), computation.terminates (nth s n)

protected instance nth_terminates {α : Type u} (s : wseq α) [h : productive s] (n : ℕ) :
    computation.terminates (nth s n) :=
  h

protected instance head_terminates {α : Type u} (s : wseq α) [h : productive s] :
    computation.terminates (head s) :=
  h 0

/-- Replace the `n`th element of `s` with `a`. -/
def update_nth {α : Type u} (s : wseq α) (n : ℕ) (a : α) : wseq α :=
  seq.corec (fun (_x : ℕ × wseq α) => sorry) (n + 1, s)

/-- Remove the `n`th element of `s`. -/
def remove_nth {α : Type u} (s : wseq α) (n : ℕ) : wseq α :=
  seq.corec (fun (_x : ℕ × wseq α) => sorry) (n + 1, s)

/-- Map the elements of `s` over `f`, removing any values that yield `none`. -/
def filter_map {α : Type u} {β : Type v} (f : α → Option β) : wseq α → wseq β :=
  seq.corec fun (s : wseq α) => sorry

/-- Select the elements of `s` that satisfy `p`. -/
def filter {α : Type u} (p : α → Prop) [decidable_pred p] : wseq α → wseq α :=
  filter_map fun (a : α) => ite (p a) (some a) none

-- example of infinite list manipulations

/-- Get the first element of `s` satisfying `p`. -/
def find {α : Type u} (p : α → Prop) [decidable_pred p] (s : wseq α) : computation (Option α) :=
  head (filter p s)

/-- Zip a function over two weak sequences -/
def zip_with {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) (s1 : wseq α) (s2 : wseq β) :
    wseq γ :=
  seq.corec (fun (_x : wseq α × wseq β) => sorry) (s1, s2)

/-- Zip two weak sequences into a single sequence of pairs -/
def zip {α : Type u} {β : Type v} : wseq α → wseq β → wseq (α × β) := zip_with Prod.mk

/-- Get the list of indexes of elements of `s` satisfying `p` -/
def find_indexes {α : Type u} (p : α → Prop) [decidable_pred p] (s : wseq α) : wseq ℕ :=
  filter_map (fun (_x : α × ℕ) => sorry) (zip s ↑stream.nats)

/-- Get the index of the first element of `s` satisfying `p` -/
def find_index {α : Type u} (p : α → Prop) [decidable_pred p] (s : wseq α) : computation ℕ :=
  (fun (o : Option ℕ) => option.get_or_else o 0) <$> head (find_indexes p s)

/-- Get the index of the first occurrence of `a` in `s` -/
def index_of {α : Type u} [DecidableEq α] (a : α) : wseq α → computation ℕ := find_index (Eq a)

/-- Get the indexes of occurrences of `a` in `s` -/
def indexes_of {α : Type u} [DecidableEq α] (a : α) : wseq α → wseq ℕ := find_indexes (Eq a)

/-- `union s1 s2` is a weak sequence which interleaves `s1` and `s2` in
  some order (nondeterministically). -/
def union {α : Type u} (s1 : wseq α) (s2 : wseq α) : wseq α :=
  seq.corec (fun (_x : wseq α × wseq α) => sorry) (s1, s2)

/-- Returns `tt` if `s` is `nil` and `ff` if `s` has an element -/
def is_empty {α : Type u} (s : wseq α) : computation Bool := computation.map option.is_none (head s)

/-- Calculate one step of computation -/
def compute {α : Type u} (s : wseq α) : wseq α := sorry

/-- Get the first `n` elements of a weak sequence -/
def take {α : Type u} (s : wseq α) (n : ℕ) : wseq α :=
  seq.corec (fun (_x : ℕ × wseq α) => sorry) (n, s)

/-- Split the sequence at position `n` into a finite initial segment
  and the weak sequence tail -/
def split_at {α : Type u} (s : wseq α) (n : ℕ) : computation (List α × wseq α) :=
  computation.corec (fun (_x : ℕ × List α × wseq α) => sorry) (n, [], s)

/-- Returns `tt` if any element of `s` satisfies `p` -/
def any {α : Type u} (s : wseq α) (p : α → Bool) : computation Bool :=
  computation.corec (fun (s : wseq α) => sorry) s

/-- Returns `tt` if every element of `s` satisfies `p` -/
def all {α : Type u} (s : wseq α) (p : α → Bool) : computation Bool :=
  computation.corec (fun (s : wseq α) => sorry) s

/-- Apply a function to the elements of the sequence to produce a sequence
  of partial results. (There is no `scanr` because this would require
  working from the end of the sequence, which may not exist.) -/
def scanl {α : Type u} {β : Type v} (f : α → β → α) (a : α) (s : wseq β) : wseq α :=
  cons a (seq.corec (fun (_x : α × wseq β) => sorry) (a, s))

/-- Get the weak sequence of initial segments of the input sequence -/
def inits {α : Type u} (s : wseq α) : wseq (List α) :=
  cons [] (seq.corec (fun (_x : dlist α × wseq α) => sorry) (dlist.empty, s))

/-- Like take, but does not wait for a result. Calculates `n` steps of
  computation and returns the sequence computed so far -/
def collect {α : Type u} (s : wseq α) (n : ℕ) : List α := list.filter_map id (seq.take n s)

/-- Append two weak sequences. As with `seq.append`, this may not use
  the second sequence if the first one takes forever to compute -/
def append {α : Type u} : wseq α → wseq α → wseq α := seq.append

/-- Map a function over a weak sequence -/
def map {α : Type u} {β : Type v} (f : α → β) : wseq α → wseq β := seq.map (option.map f)

/-- Flatten a sequence of weak sequences. (Note that this allows
  empty sequences, unlike `seq.join`.) -/
def join {α : Type u} (S : wseq (wseq α)) : wseq α :=
  seq.join ((fun (o : Option (wseq α)) => sorry) <$> S)

/-- Monadic bind operator for weak sequences -/
def bind {α : Type u} {β : Type v} (s : wseq α) (f : α → wseq β) : wseq β := join (map f s)

@[simp] def lift_rel_o {α : Type u} {β : Type v} (R : α → β → Prop) (C : wseq α → wseq β → Prop) :
    Option (α × wseq α) → Option (β × wseq β) → Prop :=
  sorry

theorem lift_rel_o.imp {α : Type u} {β : Type v} {R : α → β → Prop} {S : α → β → Prop}
    {C : wseq α → wseq β → Prop} {D : wseq α → wseq β → Prop}
    (H1 : ∀ (a : α) (b : β), R a b → S a b) (H2 : ∀ (s : wseq α) (t : wseq β), C s t → D s t)
    {o : Option (α × wseq α)} {p : Option (β × wseq β)} : lift_rel_o R C o p → lift_rel_o S D o p :=
  sorry

theorem lift_rel_o.imp_right {α : Type u} {β : Type v} (R : α → β → Prop)
    {C : wseq α → wseq β → Prop} {D : wseq α → wseq β → Prop}
    (H : ∀ (s : wseq α) (t : wseq β), C s t → D s t) {o : Option (α × wseq α)}
    {p : Option (β × wseq β)} : lift_rel_o R C o p → lift_rel_o R D o p :=
  lift_rel_o.imp (fun (_x : α) (_x_1 : β) => id) H

@[simp] def bisim_o {α : Type u} (R : wseq α → wseq α → Prop) :
    Option (α × wseq α) → Option (α × wseq α) → Prop :=
  lift_rel_o Eq R

theorem bisim_o.imp {α : Type u} {R : wseq α → wseq α → Prop} {S : wseq α → wseq α → Prop}
    (H : ∀ (s t : wseq α), R s t → S s t) {o : Option (α × wseq α)} {p : Option (α × wseq α)} :
    bisim_o R o p → bisim_o S o p :=
  lift_rel_o.imp_right Eq H

/-- Two weak sequences are `lift_rel R` related if they are either both empty,
  or they are both nonempty and the heads are `R` related and the tails are
  `lift_rel R` related. (This is a coinductive definition.) -/
def lift_rel {α : Type u} {β : Type v} (R : α → β → Prop) (s : wseq α) (t : wseq β) :=
  ∃ (C : wseq α → wseq β → Prop),
    C s t ∧
      ∀ {s : wseq α} {t : wseq β},
        C s t → computation.lift_rel (lift_rel_o R C) (destruct s) (destruct t)

/-- If two sequences are equivalent, then they have the same values and
  the same computational behavior (i.e. if one loops forever then so does
  the other), although they may differ in the number of `think`s needed to
  arrive at the answer. -/
def equiv {α : Type u} : wseq α → wseq α → Prop := lift_rel Eq

theorem lift_rel_destruct {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α} {t : wseq β} :
    lift_rel R s t → computation.lift_rel (lift_rel_o R (lift_rel R)) (destruct s) (destruct t) :=
  sorry

theorem lift_rel_destruct_iff {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α}
    {t : wseq β} :
    lift_rel R s t ↔ computation.lift_rel (lift_rel_o R (lift_rel R)) (destruct s) (destruct t) :=
  sorry

infixl:50 " ~ " => Mathlib.wseq.equiv

theorem destruct_congr {α : Type u} {s : wseq α} {t : wseq α} :
    s ~ t → computation.lift_rel (bisim_o equiv) (destruct s) (destruct t) :=
  lift_rel_destruct

theorem destruct_congr_iff {α : Type u} {s : wseq α} {t : wseq α} :
    s ~ t ↔ computation.lift_rel (bisim_o equiv) (destruct s) (destruct t) :=
  lift_rel_destruct_iff

theorem lift_rel.refl {α : Type u} (R : α → α → Prop) (H : reflexive R) : reflexive (lift_rel R) :=
  sorry

theorem lift_rel_o.swap {α : Type u} {β : Type v} (R : α → β → Prop) (C : wseq α → wseq β → Prop) :
    function.swap (lift_rel_o R C) = lift_rel_o (function.swap R) (function.swap C) :=
  sorry

theorem lift_rel.swap_lem {α : Type u} {β : Type v} {R : α → β → Prop} {s1 : wseq α} {s2 : wseq β}
    (h : lift_rel R s1 s2) : lift_rel (function.swap R) s2 s1 :=
  sorry

theorem lift_rel.swap {α : Type u} {β : Type v} (R : α → β → Prop) :
    function.swap (lift_rel R) = lift_rel (function.swap R) :=
  funext
    fun (x : wseq β) =>
      funext fun (y : wseq α) => propext { mp := lift_rel.swap_lem, mpr := lift_rel.swap_lem }

theorem lift_rel.symm {α : Type u} (R : α → α → Prop) (H : symmetric R) : symmetric (lift_rel R) :=
  sorry

theorem lift_rel.trans {α : Type u} (R : α → α → Prop) (H : transitive R) :
    transitive (lift_rel R) :=
  sorry

theorem lift_rel.equiv {α : Type u} (R : α → α → Prop) : equivalence R → equivalence (lift_rel R) :=
  sorry

theorem equiv.refl {α : Type u} (s : wseq α) : s ~ s := lift_rel.refl Eq Eq.refl

theorem equiv.symm {α : Type u} {s : wseq α} {t : wseq α} : s ~ t → t ~ s :=
  lift_rel.symm Eq Eq.symm

theorem equiv.trans {α : Type u} {s : wseq α} {t : wseq α} {u : wseq α} : s ~ t → t ~ u → s ~ u :=
  lift_rel.trans Eq Eq.trans

theorem equiv.equivalence {α : Type u} : equivalence equiv :=
  { left := equiv.refl, right := { left := equiv.symm, right := equiv.trans } }

@[simp] theorem destruct_nil {α : Type u} : destruct nil = computation.return none :=
  computation.destruct_eq_ret rfl

@[simp] theorem destruct_cons {α : Type u} (a : α) (s : wseq α) :
    destruct (cons a s) = computation.return (some (a, s)) :=
  sorry

@[simp] theorem destruct_think {α : Type u} (s : wseq α) :
    destruct (think s) = computation.think (destruct s) :=
  sorry

@[simp] theorem seq_destruct_nil {α : Type u} : seq.destruct nil = none := seq.destruct_nil

@[simp] theorem seq_destruct_cons {α : Type u} (a : α) (s : wseq α) :
    seq.destruct (cons a s) = some (some a, s) :=
  seq.destruct_cons (some a) s

@[simp] theorem seq_destruct_think {α : Type u} (s : wseq α) :
    seq.destruct (think s) = some (none, s) :=
  seq.destruct_cons none s

@[simp] theorem head_nil {α : Type u} : head nil = computation.return none := sorry

@[simp] theorem head_cons {α : Type u} (a : α) (s : wseq α) :
    head (cons a s) = computation.return (some a) :=
  sorry

@[simp] theorem head_think {α : Type u} (s : wseq α) :
    head (think s) = computation.think (head s) :=
  sorry

@[simp] theorem flatten_ret {α : Type u} (s : wseq α) : flatten (computation.return s) = s := sorry

@[simp] theorem flatten_think {α : Type u} (c : computation (wseq α)) :
    flatten (computation.think c) = think (flatten c) :=
  sorry

@[simp] theorem destruct_flatten {α : Type u} (c : computation (wseq α)) :
    destruct (flatten c) = c >>= destruct :=
  sorry

theorem head_terminates_iff {α : Type u} (s : wseq α) :
    computation.terminates (head s) ↔ computation.terminates (destruct s) :=
  computation.terminates_map_iff (Functor.map prod.fst) (destruct s)

@[simp] theorem tail_nil {α : Type u} : tail nil = nil := sorry

@[simp] theorem tail_cons {α : Type u} (a : α) (s : wseq α) : tail (cons a s) = s := sorry

@[simp] theorem tail_think {α : Type u} (s : wseq α) : tail (think s) = think (tail s) := sorry

@[simp] theorem dropn_nil {α : Type u} (n : ℕ) : drop nil n = nil := sorry

@[simp] theorem dropn_cons {α : Type u} (a : α) (s : wseq α) (n : ℕ) :
    drop (cons a s) (n + 1) = drop s n :=
  sorry

@[simp] theorem dropn_think {α : Type u} (s : wseq α) (n : ℕ) :
    drop (think s) n = think (drop s n) :=
  sorry

theorem dropn_add {α : Type u} (s : wseq α) (m : ℕ) (n : ℕ) : drop s (m + n) = drop (drop s m) n :=
  sorry

theorem dropn_tail {α : Type u} (s : wseq α) (n : ℕ) : drop (tail s) n = drop s (n + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (drop (tail s) n = drop s (n + 1))) (add_comm n 1)))
    (Eq.symm (dropn_add s 1 n))

theorem nth_add {α : Type u} (s : wseq α) (m : ℕ) (n : ℕ) : nth s (m + n) = nth (drop s m) n :=
  congr_arg head (dropn_add s m n)

theorem nth_tail {α : Type u} (s : wseq α) (n : ℕ) : nth (tail s) n = nth s (n + 1) :=
  congr_arg head (dropn_tail s n)

@[simp] theorem join_nil {α : Type u} : join nil = nil := seq.join_nil

@[simp] theorem join_think {α : Type u} (S : wseq (wseq α)) : join (think S) = think (join S) :=
  sorry

@[simp] theorem join_cons {α : Type u} (s : wseq α) (S : wseq (wseq α)) :
    join (cons s S) = think (append s (join S)) :=
  sorry

@[simp] theorem nil_append {α : Type u} (s : wseq α) : append nil s = s := seq.nil_append s

@[simp] theorem cons_append {α : Type u} (a : α) (s : wseq α) (t : wseq α) :
    append (cons a s) t = cons a (append s t) :=
  seq.cons_append (some a) s t

@[simp] theorem think_append {α : Type u} (s : wseq α) (t : wseq α) :
    append (think s) t = think (append s t) :=
  seq.cons_append none s t

@[simp] theorem append_nil {α : Type u} (s : wseq α) : append s nil = s := seq.append_nil s

@[simp] theorem append_assoc {α : Type u} (s : wseq α) (t : wseq α) (u : wseq α) :
    append (append s t) u = append s (append t u) :=
  seq.append_assoc s t u

@[simp] def tail.aux {α : Type u} : Option (α × wseq α) → computation (Option (α × wseq α)) := sorry

theorem destruct_tail {α : Type u} (s : wseq α) : destruct (tail s) = destruct s >>= tail.aux :=
  sorry

@[simp] def drop.aux {α : Type u} : ℕ → Option (α × wseq α) → computation (Option (α × wseq α)) :=
  sorry

theorem drop.aux_none {α : Type u} (n : ℕ) : drop.aux n none = computation.return none := sorry

theorem destruct_dropn {α : Type u} (s : wseq α) (n : ℕ) :
    destruct (drop s n) = destruct s >>= drop.aux n :=
  sorry

theorem head_terminates_of_head_tail_terminates {α : Type u} (s : wseq α)
    [T : computation.terminates (head (tail s))] : computation.terminates (head s) :=
  sorry

theorem destruct_some_of_destruct_tail_some {α : Type u} {s : wseq α} {a : α × wseq α}
    (h : some a ∈ destruct (tail s)) : ∃ (a' : α × wseq α), some a' ∈ destruct s :=
  sorry

theorem head_some_of_head_tail_some {α : Type u} {s : wseq α} {a : α} (h : some a ∈ head (tail s)) :
    ∃ (a' : α), some a' ∈ head s :=
  sorry

theorem head_some_of_nth_some {α : Type u} {s : wseq α} {a : α} {n : ℕ} (h : some a ∈ nth s n) :
    ∃ (a' : α), some a' ∈ head s :=
  sorry

protected instance productive_tail {α : Type u} (s : wseq α) [productive s] : productive (tail s) :=
  fun (n : ℕ) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (computation.terminates (nth (tail s) n))) (nth_tail s n)))
      (wseq.nth_terminates s (n + 1))

protected instance productive_dropn {α : Type u} (s : wseq α) [productive s] (n : ℕ) :
    productive (drop s n) :=
  fun (m : ℕ) =>
    eq.mpr
      (id
        (Eq._oldrec (Eq.refl (computation.terminates (nth (drop s n) m)))
          (Eq.symm (nth_add s n m))))
      (wseq.nth_terminates s (n + m))

/-- Given a productive weak sequence, we can collapse all the `think`s to
  produce a sequence. -/
def to_seq {α : Type u} (s : wseq α) [productive s] : seq α :=
  { val := fun (n : ℕ) => computation.get (nth s n), property := sorry }

theorem nth_terminates_le {α : Type u} {s : wseq α} {m : ℕ} {n : ℕ} (h : m ≤ n) :
    computation.terminates (nth s n) → computation.terminates (nth s m) :=
  sorry

theorem head_terminates_of_nth_terminates {α : Type u} {s : wseq α} {n : ℕ} :
    computation.terminates (nth s n) → computation.terminates (head s) :=
  nth_terminates_le (nat.zero_le n)

theorem destruct_terminates_of_nth_terminates {α : Type u} {s : wseq α} {n : ℕ}
    (T : computation.terminates (nth s n)) : computation.terminates (destruct s) :=
  iff.mp (head_terminates_iff s) (head_terminates_of_nth_terminates T)

theorem mem_rec_on {α : Type u} {C : wseq α → Prop} {a : α} {s : wseq α} (M : a ∈ s)
    (h1 : ∀ (b : α) (s' : wseq α), a = b ∨ C s' → C (cons b s'))
    (h2 : ∀ (s : wseq α), C s → C (think s)) : C s :=
  sorry

@[simp] theorem mem_think {α : Type u} (s : wseq α) (a : α) : a ∈ think s ↔ a ∈ s := sorry

theorem eq_or_mem_iff_mem {α : Type u} {s : wseq α} {a : α} {a' : α} {s' : wseq α} :
    some (a', s') ∈ destruct s → (a ∈ s ↔ a = a' ∨ a ∈ s') :=
  sorry

@[simp] theorem mem_cons_iff {α : Type u} (s : wseq α) (b : α) {a : α} :
    a ∈ cons b s ↔ a = b ∨ a ∈ s :=
  sorry

theorem mem_cons_of_mem {α : Type u} {s : wseq α} (b : α) {a : α} (h : a ∈ s) : a ∈ cons b s :=
  iff.mpr (mem_cons_iff s b) (Or.inr h)

theorem mem_cons {α : Type u} (s : wseq α) (a : α) : a ∈ cons a s :=
  iff.mpr (mem_cons_iff s a) (Or.inl rfl)

theorem mem_of_mem_tail {α : Type u} {s : wseq α} {a : α} : a ∈ tail s → a ∈ s := sorry

theorem mem_of_mem_dropn {α : Type u} {s : wseq α} {a : α} {n : ℕ} : a ∈ drop s n → a ∈ s := sorry

theorem nth_mem {α : Type u} {s : wseq α} {a : α} {n : ℕ} : some a ∈ nth s n → a ∈ s := sorry

theorem exists_nth_of_mem {α : Type u} {s : wseq α} {a : α} (h : a ∈ s) :
    ∃ (n : ℕ), some a ∈ nth s n :=
  sorry

theorem exists_dropn_of_mem {α : Type u} {s : wseq α} {a : α} (h : a ∈ s) :
    ∃ (n : ℕ), ∃ (s' : wseq α), some (a, s') ∈ destruct (drop s n) :=
  sorry

theorem lift_rel_dropn_destruct {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α}
    {t : wseq β} (H : lift_rel R s t) (n : ℕ) :
    computation.lift_rel (lift_rel_o R (lift_rel R)) (destruct (drop s n)) (destruct (drop t n)) :=
  sorry

theorem exists_of_lift_rel_left {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α}
    {t : wseq β} (H : lift_rel R s t) {a : α} (h : a ∈ s) : Exists fun {b : β} => b ∈ t ∧ R a b :=
  sorry

theorem exists_of_lift_rel_right {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α}
    {t : wseq β} (H : lift_rel R s t) {b : β} (h : b ∈ t) : Exists fun {a : α} => a ∈ s ∧ R a b :=
  exists_of_lift_rel_left
    (eq.mp
      (Eq._oldrec (Eq.refl (lift_rel R s t)) (Eq.symm (lift_rel.swap fun (x : β) (y : α) => R y x)))
      H)
    h

theorem head_terminates_of_mem {α : Type u} {s : wseq α} {a : α} (h : a ∈ s) :
    computation.terminates (head s) :=
  sorry

theorem of_mem_append {α : Type u} {s₁ : wseq α} {s₂ : wseq α} {a : α} :
    a ∈ append s₁ s₂ → a ∈ s₁ ∨ a ∈ s₂ :=
  seq.of_mem_append

theorem mem_append_left {α : Type u} {s₁ : wseq α} {s₂ : wseq α} {a : α} :
    a ∈ s₁ → a ∈ append s₁ s₂ :=
  seq.mem_append_left

theorem exists_of_mem_map {α : Type u} {β : Type v} {f : α → β} {b : β} {s : wseq α} :
    b ∈ map f s → ∃ (a : α), a ∈ s ∧ f a = b :=
  sorry

@[simp] theorem lift_rel_nil {α : Type u} {β : Type v} (R : α → β → Prop) : lift_rel R nil nil :=
  sorry

@[simp] theorem lift_rel_cons {α : Type u} {β : Type v} (R : α → β → Prop) (a : α) (b : β)
    (s : wseq α) (t : wseq β) : lift_rel R (cons a s) (cons b t) ↔ R a b ∧ lift_rel R s t :=
  sorry

@[simp] theorem lift_rel_think_left {α : Type u} {β : Type v} (R : α → β → Prop) (s : wseq α)
    (t : wseq β) : lift_rel R (think s) t ↔ lift_rel R s t :=
  sorry

@[simp] theorem lift_rel_think_right {α : Type u} {β : Type v} (R : α → β → Prop) (s : wseq α)
    (t : wseq β) : lift_rel R s (think t) ↔ lift_rel R s t :=
  sorry

theorem cons_congr {α : Type u} {s : wseq α} {t : wseq α} (a : α) (h : s ~ t) :
    cons a s ~ cons a t :=
  sorry

theorem think_equiv {α : Type u} (s : wseq α) : think s ~ s :=
  eq.mpr (id (congr_fun (congr_fun equiv.equations._eqn_1 (think s)) s))
    (eq.mpr (id (propext (lift_rel_think_left Eq s s))) (equiv.refl s))

theorem think_congr {α : Type u} {s : wseq α} {t : wseq α} (a : α) (h : s ~ t) :
    think s ~ think t :=
  eq.mpr (id (congr_fun (congr_fun equiv.equations._eqn_1 (think s)) (think t)))
    (eq.mpr
      (id
        (Eq.trans (propext (lift_rel_think_right Eq (think s) t))
          (propext (lift_rel_think_left Eq s t))))
      h)

theorem head_congr {α : Type u} {s : wseq α} {t : wseq α} : s ~ t → head s ~ head t := sorry

theorem flatten_equiv {α : Type u} {c : computation (wseq α)} {s : wseq α} (h : s ∈ c) :
    flatten c ~ s :=
  sorry

theorem lift_rel_flatten {α : Type u} {β : Type v} {R : α → β → Prop} {c1 : computation (wseq α)}
    {c2 : computation (wseq β)} (h : computation.lift_rel (lift_rel R) c1 c2) :
    lift_rel R (flatten c1) (flatten c2) :=
  sorry

theorem flatten_congr {α : Type u} {c1 : computation (wseq α)} {c2 : computation (wseq α)} :
    computation.lift_rel equiv c1 c2 → flatten c1 ~ flatten c2 :=
  lift_rel_flatten

theorem tail_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) : tail s ~ tail t := sorry

theorem dropn_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) (n : ℕ) :
    drop s n ~ drop t n :=
  sorry

theorem nth_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) (n : ℕ) : nth s n ~ nth t n :=
  head_congr (dropn_congr h n)

theorem mem_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) (a : α) : a ∈ s ↔ a ∈ t :=
  sorry

theorem productive_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) :
    productive s ↔ productive t :=
  forall_congr fun (n : ℕ) => computation.terminates_congr (nth_congr h n)

theorem equiv.ext {α : Type u} {s : wseq α} {t : wseq α} (h : ∀ (n : ℕ), nth s n ~ nth t n) :
    s ~ t :=
  sorry

theorem length_eq_map {α : Type u} (s : wseq α) :
    length s = computation.map list.length (to_list s) :=
  sorry

@[simp] theorem of_list_nil {α : Type u} : of_list [] = nil := rfl

@[simp] theorem of_list_cons {α : Type u} (a : α) (l : List α) :
    of_list (a :: l) = cons a (of_list l) :=
  sorry

@[simp] theorem to_list'_nil {α : Type u} (l : List α) :
    computation.corec to_list._match_2 (l, nil) = computation.return (list.reverse l) :=
  computation.destruct_eq_ret rfl

@[simp] theorem to_list'_cons {α : Type u} (l : List α) (s : wseq α) (a : α) :
    computation.corec to_list._match_2 (l, cons a s) =
        computation.think (computation.corec to_list._match_2 (a :: l, s)) :=
  sorry

@[simp] theorem to_list'_think {α : Type u} (l : List α) (s : wseq α) :
    computation.corec to_list._match_2 (l, think s) =
        computation.think (computation.corec to_list._match_2 (l, s)) :=
  sorry

theorem to_list'_map {α : Type u} (l : List α) (s : wseq α) :
    computation.corec to_list._match_2 (l, s) = append (list.reverse l) <$> to_list s :=
  sorry

@[simp] theorem to_list_cons {α : Type u} (a : α) (s : wseq α) :
    to_list (cons a s) = computation.think (List.cons a <$> to_list s) :=
  sorry

@[simp] theorem to_list_nil {α : Type u} : to_list nil = computation.return [] :=
  computation.destruct_eq_ret rfl

theorem to_list_of_list {α : Type u} (l : List α) : l ∈ to_list (of_list l) := sorry

@[simp] theorem destruct_of_seq {α : Type u} (s : seq α) :
    destruct (of_seq s) =
        computation.return (option.map (fun (a : α) => (a, of_seq (seq.tail s))) (seq.head s)) :=
  sorry

@[simp] theorem head_of_seq {α : Type u} (s : seq α) :
    head (of_seq s) = computation.return (seq.head s) :=
  sorry

@[simp] theorem tail_of_seq {α : Type u} (s : seq α) : tail (of_seq s) = of_seq (seq.tail s) :=
  sorry

@[simp] theorem dropn_of_seq {α : Type u} (s : seq α) (n : ℕ) :
    drop (of_seq s) n = of_seq (seq.drop s n) :=
  sorry

theorem nth_of_seq {α : Type u} (s : seq α) (n : ℕ) :
    nth (of_seq s) n = computation.return (seq.nth s n) :=
  sorry

protected instance productive_of_seq {α : Type u} (s : seq α) : productive (of_seq s) :=
  fun (n : ℕ) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (computation.terminates (nth (of_seq s) n))) (nth_of_seq s n)))
      (computation.ret_terminates (seq.nth s n))

theorem to_seq_of_seq {α : Type u} (s : seq α) : to_seq (of_seq s) = s := sorry

/-- The monadic `return a` is a singleton list containing `a`. -/
def ret {α : Type u} (a : α) : wseq α := of_list [a]

@[simp] theorem map_nil {α : Type u} {β : Type v} (f : α → β) : map f nil = nil := rfl

@[simp] theorem map_cons {α : Type u} {β : Type v} (f : α → β) (a : α) (s : wseq α) :
    map f (cons a s) = cons (f a) (map f s) :=
  seq.map_cons (option.map f) (some a) s

@[simp] theorem map_think {α : Type u} {β : Type v} (f : α → β) (s : wseq α) :
    map f (think s) = think (map f s) :=
  seq.map_cons (option.map f) none s

@[simp] theorem map_id {α : Type u} (s : wseq α) : map id s = s := sorry

@[simp] theorem map_ret {α : Type u} {β : Type v} (f : α → β) (a : α) : map f (ret a) = ret (f a) :=
  sorry

@[simp] theorem map_append {α : Type u} {β : Type v} (f : α → β) (s : wseq α) (t : wseq α) :
    map f (append s t) = append (map f s) (map f t) :=
  seq.map_append (option.map f) s t

theorem map_comp {α : Type u} {β : Type v} {γ : Type w} (f : α → β) (g : β → γ) (s : wseq α) :
    map (g ∘ f) s = map g (map f s) :=
  sorry

theorem mem_map {α : Type u} {β : Type v} (f : α → β) {a : α} {s : wseq α} :
    a ∈ s → f a ∈ map f s :=
  seq.mem_map (option.map f)

-- The converse is not true without additional assumptions

theorem exists_of_mem_join {α : Type u} {a : α} {S : wseq (wseq α)} :
    a ∈ join S → ∃ (s : wseq α), s ∈ S ∧ a ∈ s :=
  sorry

theorem exists_of_mem_bind {α : Type u} {β : Type v} {s : wseq α} {f : α → wseq β} {b : β}
    (h : b ∈ bind s f) : ∃ (a : α), ∃ (H : a ∈ s), b ∈ f a :=
  sorry

theorem destruct_map {α : Type u} {β : Type v} (f : α → β) (s : wseq α) :
    destruct (map f s) = computation.map (option.map (prod.map f (map f))) (destruct s) :=
  sorry

theorem lift_rel_map {α : Type u} {β : Type v} {γ : Type w} {δ : Type u_1} (R : α → β → Prop)
    (S : γ → δ → Prop) {s1 : wseq α} {s2 : wseq β} {f1 : α → γ} {f2 : β → δ} (h1 : lift_rel R s1 s2)
    (h2 : ∀ {a : α} {b : β}, R a b → S (f1 a) (f2 b)) : lift_rel S (map f1 s1) (map f2 s2) :=
  sorry

theorem map_congr {α : Type u} {β : Type v} (f : α → β) {s : wseq α} {t : wseq α} (h : s ~ t) :
    map f s ~ map f t :=
  lift_rel_map Eq Eq h fun (_x _x_1 : α) => congr_arg fun (_x : α) => f _x

@[simp] def destruct_append.aux {α : Type u} (t : wseq α) :
    Option (α × wseq α) → computation (Option (α × wseq α)) :=
  sorry

theorem destruct_append {α : Type u} (s : wseq α) (t : wseq α) :
    destruct (append s t) = computation.bind (destruct s) (destruct_append.aux t) :=
  sorry

@[simp] def destruct_join.aux {α : Type u} :
    Option (wseq α × wseq (wseq α)) → computation (Option (α × wseq α)) :=
  sorry

theorem destruct_join {α : Type u} (S : wseq (wseq α)) :
    destruct (join S) = computation.bind (destruct S) destruct_join.aux :=
  sorry

theorem lift_rel_append {α : Type u} {β : Type v} (R : α → β → Prop) {s1 : wseq α} {s2 : wseq α}
    {t1 : wseq β} {t2 : wseq β} (h1 : lift_rel R s1 t1) (h2 : lift_rel R s2 t2) :
    lift_rel R (append s1 s2) (append t1 t2) :=
  sorry

theorem lift_rel_join.lem {α : Type u} {β : Type v} (R : α → β → Prop) {S : wseq (wseq α)}
    {T : wseq (wseq β)} {U : wseq α → wseq β → Prop} (ST : lift_rel (lift_rel R) S T)
    (HU :
      ∀ (s1 : wseq α) (s2 : wseq β),
        (∃ (s : wseq α),
            ∃ (t : wseq β),
              ∃ (S : wseq (wseq α)),
                ∃ (T : wseq (wseq β)),
                  s1 = append s (join S) ∧
                    s2 = append t (join T) ∧ lift_rel R s t ∧ lift_rel (lift_rel R) S T) →
          U s1 s2)
    {a : Option (α × wseq α)} (ma : a ∈ destruct (join S)) :
    Exists fun {b : Option (β × wseq β)} => b ∈ destruct (join T) ∧ lift_rel_o R U a b :=
  sorry

theorem lift_rel_join {α : Type u} {β : Type v} (R : α → β → Prop) {S : wseq (wseq α)}
    {T : wseq (wseq β)} (h : lift_rel (lift_rel R) S T) : lift_rel R (join S) (join T) :=
  sorry

theorem join_congr {α : Type u} {S : wseq (wseq α)} {T : wseq (wseq α)} (h : lift_rel equiv S T) :
    join S ~ join T :=
  lift_rel_join Eq h

theorem lift_rel_bind {α : Type u} {β : Type v} {γ : Type w} {δ : Type u_1} (R : α → β → Prop)
    (S : γ → δ → Prop) {s1 : wseq α} {s2 : wseq β} {f1 : α → wseq γ} {f2 : β → wseq δ}
    (h1 : lift_rel R s1 s2) (h2 : ∀ {a : α} {b : β}, R a b → lift_rel S (f1 a) (f2 b)) :
    lift_rel S (bind s1 f1) (bind s2 f2) :=
  lift_rel_join S (lift_rel_map R (lift_rel S) h1 h2)

theorem bind_congr {α : Type u} {β : Type v} {s1 : wseq α} {s2 : wseq α} {f1 : α → wseq β}
    {f2 : α → wseq β} (h1 : s1 ~ s2) (h2 : ∀ (a : α), f1 a ~ f2 a) : bind s1 f1 ~ bind s2 f2 :=
  lift_rel_bind Eq Eq h1
    fun (a b : α) (h : a = b) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (lift_rel Eq (f1 a) (f2 b))) h)) (h2 b)

@[simp] theorem join_ret {α : Type u} (s : wseq α) : join (ret s) ~ s := sorry

@[simp] theorem join_map_ret {α : Type u} (s : wseq α) : join (map ret s) ~ s := sorry

@[simp] theorem join_append {α : Type u} (S : wseq (wseq α)) (T : wseq (wseq α)) :
    join (append S T) ~ append (join S) (join T) :=
  sorry

@[simp] theorem bind_ret {α : Type u} {β : Type v} (f : α → β) (s : wseq α) :
    bind s (ret ∘ f) ~ map f s :=
  id
    (eq.mpr (id (Eq._oldrec (Eq.refl (join (map (ret ∘ f) s) ~ map f s)) (map_comp f ret s)))
      (join_map_ret (map f s)))

@[simp] theorem ret_bind {α : Type u} {β : Type v} (a : α) (f : α → wseq β) :
    bind (ret a) f ~ f a :=
  sorry

@[simp] theorem map_join {α : Type u} {β : Type v} (f : α → β) (S : wseq (wseq α)) :
    map f (join S) = join (map (map f) S) :=
  sorry

@[simp] theorem join_join {α : Type u} (SS : wseq (wseq (wseq α))) :
    join (join SS) ~ join (map join SS) :=
  sorry

@[simp] theorem bind_assoc {α : Type u} {β : Type v} {γ : Type w} (s : wseq α) (f : α → wseq β)
    (g : β → wseq γ) : bind (bind s f) g ~ bind s fun (x : α) => bind (f x) g :=
  sorry

protected instance monad : Monad wseq :=
  { toApplicative :=
      { toFunctor := { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β },
        toPure := { pure := ret },
        toSeq :=
          { seq :=
              fun (α β : Type u_1) (f : wseq (α → β)) (x : wseq α) =>
                bind f fun (_x : α → β) => map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u_1) (a : wseq α) (b : wseq β) =>
                (fun (α β : Type u_1) (f : wseq (α → β)) (x : wseq α) =>
                    bind f fun (_x : α → β) => map _x x)
                  β α (map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : wseq α) (b : wseq β) =>
                (fun (α β : Type u_1) (f : wseq (α → β)) (x : wseq α) =>
                    bind f fun (_x : α → β) => map _x x)
                  β β (map (function.const α id) a) b } },
    toBind := { bind := bind } }

end Mathlib


import sheaves_of_modules.defs
/-

# Pushforward and pullback of sheaves of modules

-/

variables {X Y : RINGED_SPACE}
namespace SHEAF_OF_MODULES

section experiment

--#check @Top.sheaf.pushforward

variable (f : X ⟶ Y)

example : (X : TOP) ⟶ Y := f.base

end experiment

--#check Top.presheaf.pushforward_obj
--set_option pp.notation false

/-
instance (𝓜 : SHEAF_OF_MODULES X) (U : (opens (X : TOP))ᵒᵖ) :
  module ((𝓞_ X) U) (𝓜.obj U) := 𝓜.module_structure U
-/

--instance (U) : module
--#print notation _*
--#check Top.presheaf.pushforward_obj

/-

/-- Pushforward a presheaf on `X` along a continuous map `f : X ⟶ Y`, obtaining a presheaf
on `Y`. -/
def pushforward_obj {X Y : Top.{w}} (f : X ⟶ Y) (ℱ : X.presheaf C) : Y.presheaf C :=
(opens.map f).op ⋙ ℱ

infix ` _* `: 80 := pushforward_obj
-/

--#where
def map (f : X ⟶ Y) (𝓜 : SHEAF_OF_MODULES X) : SHEAF_OF_MODULES Y :=
{ ab_sheaf := (Top.sheaf.pushforward.{0} f.base).obj 𝓜.ab_sheaf,
  module_structure := λ U, by letI : module ↥((f.base _* X.to_PresheafedSpace.presheaf).obj U)
    ↥(((Top.sheaf.pushforward f.base).obj 𝓜.ab_sheaf).val.obj U) := obj.module 𝓜 ((topological_space.opens.map f.base).op.obj U); exact
    module.comp_hom (𝓜.obj ((topological_space.opens.map f.base).op.obj U)) (f.c.app U),
--   module_structure := λ U, begin
-- --    delta Top.sheaf.pushforward,
-- --    dsimp only,
-- --    delta Top.presheaf.pushforward_obj,
-- --    change module _ (𝓜.obj _),
--     let V : (topological_space.opens (X : TOP))ᵒᵖ := (topological_space.opens.map f.base).op.obj U,
--     change module ((𝓞_ Y) U) (𝓜.obj V),
-- --    letI baz : module ((𝓞_ X) V) (𝓜.obj V) := infer_instance, -- show_term {apply_instance}
--     letI : module ↥((f.base _* X.to_PresheafedSpace.presheaf).obj U) ↥(𝓜.obj V) := obj.module 𝓜 V,
-- --    let foo : (𝓞_ Y) U →+* (𝓞_ X) V := f.c.app U,
--     exact module.comp_hom (𝓜.obj V) (f.c.app U),
--   end,
  compatibility_bit := λ U V i, begin
    rintro s (n : 𝓜.ab_sheaf.val.obj _),
    change ↥((𝓞_ Y) U) at s,
    have foo := f.c.naturality i,
    let j : ((topological_space.opens.map f.base).op.obj U) ⟶ ((topological_space.opens.map f.base).op.obj V) :=
      ((topological_space.opens.map f.base).op.map i),
    let r : (𝓞_ X) ((topological_space.opens.map f.base).op.obj U) := f.c.app U s,
    --have bar := 𝓜.compatibility_bit _ _ j r n,
    convert 𝓜.compatibility_bit _ _ j r n using 1,
    rw fun_like.ext_iff at foo,
    specialize foo s,
    have moo : (f.base _* X.to_PresheafedSpace.presheaf).map i = X.to_PresheafedSpace.presheaf.map j,
      refl,
    rw fun_like.ext_iff at moo,
    specialize moo r,
    rw ← moo,
    change _ = ((f.c.app U ≫ (f.base _* X.to_PresheafedSpace.presheaf).map i) s) • _,
    rw ← foo,
    refl,

    -- need to pull back i; need to fix implicits
    -- might need pen and paper here
    --convert bar _ _,
    /-
    Have foo: O_Y(U)->O_Y(V)->f_*O_X(V) = O_Y(U)->f_*O_X(U)->f_*O_X(V)
    have bar : ∀ r ∈ O_X(f⁻¹(U)), m ∈ 𝓜(f⁻¹(U)),
      res(r•m) ∈ 𝓜(f⁻¹(V)) = (res(r) : O_X(f⁻¹(V)))•res(m)

    Want: ∀ s ∈ O_Y(U), ∀ n ∈ f_*𝓜(U) := 𝓜(f⁻¹(U)), res(s•n)=res(s)•res(n)
    Proof: define r=image of s in O_X(f⁻¹(U))=f_*O_X(U).

    -/
    --letI : module (Y.to_PresheafedSpace.presheaf.obj U)
    --  (((Top.sheaf.pushforward f.base).obj 𝓜.ab_sheaf).val.obj U) := module_structure 𝓜 ((topological_space.opens.map f.base).op.obj U),

    --calc
    --(((Top.sheaf.pushforward f.base).obj 𝓜.ab_sheaf).val.map i) (s • n) =
    --((Y.to_PresheafedSpace.presheaf.map i) s : (𝓞_ Y) V) • (((Top.sheaf.pushforward f.base).obj 𝓜.ab_sheaf).val.map i) n : sorry
  end }

infix (name := hi) ` _* `: 80 := map

--#check Top.sheaf.pushforward

variables (f : X ⟶ Y) (𝓜 : SHEAF_OF_MODULES X)

def map_id (𝓜 : SHEAF_OF_MODULES X) : (𝟙 X) _* 𝓜 ≅ 𝓜 :=
{ hom :=
  { ab_sheaf :=
    { val :=
      { app := λ U, 𝓜.ab_sheaf.val.map $ category_theory.op_hom_of_le $ λ x hx, hx,
        naturality' := begin
          intros U V f,
          ext,
          simp only [category_theory.comp_apply],
          sorry,
        end } },
      map_smul := begin
        intros,
        simp only [category_theory.op_hom_of_le],
        sorry,
      end },
    inv :=
    { ab_sheaf :=
      { val :=
        { app := λ U, 𝓜.ab_sheaf.val.map $ category_theory.op_hom_of_le $ λ x hx, hx,
          naturality' := begin
            intros U V g,
            ext,
            simp only [category_theory.comp_apply],
            sorry,
          end } },
      map_smul := sorry },
  hom_inv_id' := begin
    ext U m,
    --dsimp only [category_theory.comp_apply],
    unfold_coes,
    dsimp only,
    sorry,
  end,
  inv_hom_id' := sorry }

end SHEAF_OF_MODULES

example (Z : Type) [topological_space Z] (U V : (topological_space.opens Z)ᵒᵖ) (h : V.unop ⊆ U.unop):
  U ⟶ V :=
begin
  refine category_theory.op_hom_of_le h,
end


-- import data.int.basic -- this doesnt work
-- import data.real.basic -- this doesnt work

open classical

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

example : (∃ x : α, r) → r :=
assume h,
  exists.elim h
    (assume w,
     assume hw,
            hw)
-- ⇯ I don't truly grokk what is going on here. Just following the syntax lol
-- Another way of doing that is using tactics that
-- I learnt in the number game

-- begin
-- cases h, exact h_h
-- end

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

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
  (assume hl,
  exists.elim hl
  (assume w,
  assume hw,
  ⟨⟨w, hw.left⟩,hw.right ⟩)) --
  (assume hr,
  exists.elim hr.left
    (assume w,
    assume hw,
  ⟨w, hw, hr.right⟩))  --

-- another way of solving
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
(assume hl,
  match hl with ⟨w, hw ⟩ :=
  ⟨⟨w, hw.left⟩, hw.right ⟩
  end)
(assume hr,
  match hr.left with ⟨w, hw⟩ :=
  ⟨w, hw, hr.right⟩
  end)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
iff.intro
(assume hl,
  exists.elim hl
  (assume w,
  assume hw,
  or.elim hw
  (assume hpw, (or.inl ⟨w, hpw⟩))
  (assume hqw,(or.inr ⟨w, hqw⟩))))
(assume hr, or.elim hr
  (assume hepx,
  exists.elim hepx
  (assume w,
  assume hw, ⟨w, (or.inl hw)⟩))
  (assume hepq,
  exists.elim hepq
  (assume w,
  assume hw, ⟨w, (or.inr hw)⟩)))

-- neater way

-- example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
-- iff.intro
-- (assume hl,
--  match hl with ⟨w, hw⟩ :=
--     or.elim hw
--     (assume hpw, (or.inl ⟨w, hpw⟩))
--     (assume hqw,(or.inr ⟨w, hqw⟩))
--     end)
-- (assume hr,
--   or.elim hr
--   (assume hepx,
--   match hepx with ⟨w,hw⟩ :=
--   ⟨w, (or.inl hw)⟩
--   end)
-- (assume hepw,
--   match hepw with ⟨w,hw⟩ := ⟨w, (or.inr hw)⟩ end ))

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := iff.intro
(assume hl,
  by_contradiction
  (assume h1,
  have h2 : (∃ (x : α), ¬p x),
  from dne h1,
  exists.elim h2
  (assume w,
  assume hw, absurd (hl w) hw)))
(assume hr,
 assume foo,
 by_contradiction
 (assume bar, hr ⟨foo,bar⟩))

 variables a : α

 example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
 iff.intro
 (assume hl,
 by_contradiction
  (assume f,
  have bar : ∀ (x : α), ¬p x, from dne f,
   exists.elim hl
    (assume w,
     assume hw,
     absurd hw (bar w))) )
 (assume hr,
 by_contradiction
 (assume h1,
  have h2 : ∀ x, ¬ p x, from
      assume x,
      assume h3 : p x,
      have h4 : ∃ x, p x, from  ⟨x, h3⟩,
      show false, from h1 h4,
    show false, from hr h2))
-- this one was true dark magic
-- I don't know what is happening
-- but I created h2,x,h3 out of nothing ness LOLL

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
iff.intro
(assume hl,
  assume h1,
  assume h2, hl ⟨h1, h2⟩)
(assume hr,
assume h1,
exists.elim h1
(assume w,
assume hw,
absurd hw (hr w)))

example: (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
iff.intro
(assume hl,
  by_contradiction
    (assume bar,_))      --
--  have h1 : ∀ (x : α), p x, from
(assume hr,
assume h1,
exists.elim hr
  (assume w,
  assume hw,
  absurd (h1 w) hw)) --

-- example: (∀ x, p x → r) ↔ (∃ x, p x) → r := sorry
-- example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := sorry
-- example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := sorry

-- -- *    Prove these equivalences:

-- example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := sorry

-- example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := sorry

-- example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := sorry

-- --  You should also try to understand why the reverse implication is not
-- --    derivable in the last example. It is often possible to bring a component
-- --    of a formula outside a universal quantifier, when it does not depend on
-- --    the quantified variable. Try proving these (one direction of the second of
-- --    these requires classical logic):

-- example : α → ((∀ x : α, r) ↔ r) := sorry
-- example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := sorry
-- example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := sorry

-- -- Consider the “barber paradox,” that is, the claim that in a certain town
-- -- there is a (male) barber that shaves all and only the men who do not
-- -- shave themselves. Prove that this is a contradiction:

-- variables (men : Type*) (barber : men)
-- variable  (shaves : men → men → Prop)

-- example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
-- false := sorry

-- --  Remember that, without any parameters, an expression of type Prop is just
-- --  an assertion. Fill in the definitions of prime and Fermat_prime below,
-- --  and construct each of the given assertions. For example, you can say that
-- --  there are infinitely many primes by asserting that for every natural
-- --  number n, there is a prime number greater than n. Goldbach’s weak
-- --  conjecture states that every odd number greater than 5 is the sum of
-- --  three primes. Look up the definition of a Fermat prime or any of the
-- --  other statements, if necessary.

-- #check even

-- def prime (n : ℕ) : Prop := sorry
-- def infinitely_many_primes : Prop := sorry
-- def Fermat_prime (n : ℕ) : Prop := sorry
-- def infinitely_many_Fermat_primes : Prop := sorry
-- def goldbach_conjecture : Prop := sorry
-- def Goldbach's_weak_conjecture : Prop := sorry
-- def Fermat's_last_theorem : Prop := sorry

-- --  Give a calculational proof of the theorem log_mul below.

-- variables log exp     : real → real
-- variable  log_exp_eq : ∀ x, log (exp x) = x
-- variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
-- variable  exp_pos    : ∀ x, exp x > 0
-- variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

--  -- this ensures the assumptions are available in tactic proofs
--  include log_exp_eq exp_log_eq exp_pos exp_add

-- example (x y z : real) :
--     exp (x + y + z) = exp x * exp y * exp z :=
--   by rw [exp_add, exp_add]
-- example (y : real) (h : y > 0)  : exp (log y) = y :=
--   exp_log_eq h
-- theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
--     log (x * y) = log x + log y :=
--   sorry

-- --  Prove the theorem below, using only the ring properties of ℤ enumerated in
-- --  Section 4.2 and the theorem sub_self.

-- #check sub_self
-- example (x : ℤ) : x * 0 = 0 :=
--  sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import category_theory.simple
import category_theory.linear
import category_theory.endomorphism
import field_theory.algebraic_closure

/-!
# Schur's lemma
We first prove the part of Schur's Lemma that holds in any preadditive category with kernels,
that any nonzero morphism between simple objects
is an isomorphism.

Second, we prove Schur's lemma for `𝕜`-linear categories with finite dimensional hom spaces,
over an algebraically closed field `𝕜`:
the hom space `X ⟶ Y` between simple objects `X` and `Y` is at most one dimensional,
and is 1-dimensional iff `X` and `Y` are isomorphic.

## Future work
It might be nice to provide a `division_ring` instance on `End X` when `X` is simple.
This is an easy consequence of the results here,
but may take some care setting up usable instances.
-/

namespace category_theory

open category_theory.limits

universes v u
variables {C : Type u} [category.{v} C]
variables [preadditive C]

/--
The part of Schur's lemma that holds in any preadditive category with kernels:
that a nonzero morphism between simple objects is an isomorphism.
-/
lemma is_iso_of_hom_simple [has_kernels C] {X Y : C} [simple X] [simple Y] {f : X ⟶ Y} (w : f ≠ 0) :
  is_iso f :=
begin
  haveI : mono f := preadditive.mono_of_kernel_zero (kernel_zero_of_nonzero_from_simple w),
  exact is_iso_of_mono_of_nonzero w
end

/--
As a corollary of Schur's lemma for preadditive categories,
any morphism between simple objects is (exclusively) either an isomorphism or zero.
-/
lemma is_iso_iff_nonzero [has_kernels C] {X Y : C} [simple.{v} X] [simple.{v} Y] (f : X ⟶ Y) :
  is_iso.{v} f ↔ f ≠ 0 :=
⟨λ I,
  begin
    introI h,
    apply id_nonzero X,
    simp only [←is_iso.hom_inv_id f, h, zero_comp],
  end,
  λ w, is_iso_of_hom_simple w⟩

open finite_dimensional

variables (𝕜 : Type*) [field 𝕜]

/--
Part of Schur's lemma for `𝕜`-linear categories:
the hom space between two non-isomorphic simple objects is 0-dimensional.
-/
lemma finrank_hom_simple_simple_eq_zero_of_not_iso
  [has_kernels C] [linear 𝕜 C] {X Y : C} [simple.{v} X] [simple.{v} Y]
  (h : (X ≅ Y) → false):
  finrank 𝕜 (X ⟶ Y) = 0 :=
begin
  haveI := subsingleton_of_forall_eq (0 : X ⟶ Y) (λ f, begin
    have p := not_congr (is_iso_iff_nonzero f),
    simp only [not_not, ne.def] at p,
    refine p.mp (λ _, by exactI h (as_iso f)),
  end),
  exact finrank_zero_of_subsingleton,
end

variables [is_alg_closed 𝕜] [linear 𝕜 C]

-- In the proof below we have some difficulty using `I : finite_dimensional 𝕜 (X ⟶ X)`
-- where we need a `finite_dimensional 𝕜 (End X)`.
-- These are definitionally equal, but without eta reduction Lean can't see this.
-- To get around this, we use `convert I`,
-- then check the various instances agree field-by-field,
-- using `ext` equipped with the following extra lemmas:
local attribute [ext] add_comm_group module distrib_mul_action mul_action has_scalar

/--
An auxiliary lemma for Schur's lemma.

If `X ⟶ X` is finite dimensional, and every nonzero endomorphism is invertible,
then `X ⟶ X` is 1-dimensional.
-/
-- We prove this with the explicit `is_iso_iff_nonzero` assumption,
-- rather than just `[simple X]`, as this form is useful for
-- Müger's formulation of semisimplicity.
lemma finrank_endomorphism_eq_one
  {X : C} (is_iso_iff_nonzero : ∀ f : X ⟶ X, is_iso f ↔ f ≠ 0)
  [I : finite_dimensional 𝕜 (X ⟶ X)] :
  finrank 𝕜 (X ⟶ X) = 1 :=
begin
  have id_nonzero := (is_iso_iff_nonzero (𝟙 X)).mp (by apply_instance),
  apply finrank_eq_one (𝟙 X),
  { exact id_nonzero, },
  { intro f,
    haveI : nontrivial (End X) := nontrivial_of_ne _ _ id_nonzero,
    obtain ⟨c, nu⟩ := @exists_spectrum_of_is_alg_closed_of_finite_dimensional 𝕜 _ _ (End X) _ _ _
      (by { convert I, ext; refl, ext; refl, }) (End.of f),
    use c,
    rw [is_unit_iff_is_iso, is_iso_iff_nonzero, ne.def, not_not, sub_eq_zero,
      algebra.algebra_map_eq_smul_one] at nu,
    exact nu.symm, },
end

variables [has_kernels C]

/--
Schur's lemma for endomorphisms in `𝕜`-linear categories.
-/
lemma finrank_endomorphism_simple_eq_one
  (X : C) [simple.{v} X] [I : finite_dimensional 𝕜 (X ⟶ X)] :
  finrank 𝕜 (X ⟶ X) = 1 :=
finrank_endomorphism_eq_one 𝕜 is_iso_iff_nonzero

lemma endomorphism_simple_eq_smul_id
  {X : C} [simple.{v} X] [I : finite_dimensional 𝕜 (X ⟶ X)] (f : X ⟶ X) :
  ∃ c : 𝕜, c • 𝟙 X = f :=
(finrank_eq_one_iff_of_nonzero' (𝟙 X) (id_nonzero X)).mp (finrank_endomorphism_simple_eq_one 𝕜 X) f

/--
Schur's lemma for `𝕜`-linear categories:
if hom spaces are finite dimensional, then the hom space between simples is at most 1-dimensional.

See `finrank_hom_simple_simple_eq_one_iff` and `finrank_hom_simple_simple_eq_zero_iff` below
for the refinements when we know whether or not the simples are isomorphic.
-/
-- We don't really need `[∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)]` here,
-- just at least one of `[finite_dimensional 𝕜 (X ⟶ X)]` or `[finite_dimensional 𝕜 (Y ⟶ Y)]`.
lemma finrank_hom_simple_simple_le_one
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) ≤ 1 :=
begin
  cases subsingleton_or_nontrivial (X ⟶ Y) with h,
  { resetI,
    convert zero_le_one,
    exact finrank_zero_of_subsingleton, },
  { obtain ⟨f, nz⟩ := (nontrivial_iff_exists_ne 0).mp h,
    haveI fi := (is_iso_iff_nonzero f).mpr nz,
    apply finrank_le_one f,
    intro g,
    obtain ⟨c, w⟩ := endomorphism_simple_eq_smul_id 𝕜 (g ≫ inv f),
    exact ⟨c, by simpa using w =≫ f⟩, },
end

lemma finrank_hom_simple_simple_eq_one_iff
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) = 1 ↔ nonempty (X ≅ Y) :=
begin
  fsplit,
  { intro h,
    rw finrank_eq_one_iff' at h,
    obtain ⟨f, nz, -⟩ := h,
    rw ←is_iso_iff_nonzero at nz,
    exactI ⟨as_iso f⟩, },
  { rintro ⟨f⟩,
    have le_one := finrank_hom_simple_simple_le_one 𝕜 X Y,
    have zero_lt : 0 < finrank 𝕜 (X ⟶ Y) :=
      finrank_pos_iff_exists_ne_zero.mpr ⟨f.hom, (is_iso_iff_nonzero f.hom).mp infer_instance⟩,
    linarith, }
end

lemma finrank_hom_simple_simple_eq_zero_iff
  (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple.{v} X] [simple.{v} Y] :
  finrank 𝕜 (X ⟶ Y) = 0 ↔ ¬ nonempty (X ≅ Y) :=
begin
  rw ←not_congr (finrank_hom_simple_simple_eq_one_iff 𝕜 X Y),
  refine ⟨λ h, by { rw h, simp, }, λ h, _⟩,
  have := finrank_hom_simple_simple_le_one 𝕜 X Y,
  interval_cases finrank 𝕜 (X ⟶ Y) with h',
  { exact h', },
  { exact false.elim (h h'), },
end

end category_theory


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.traversable.lemmas
import data.equiv.basic

/-!
# Transferring `traversable` instances along isomorphisms

This file allows to transfer `traversable` instances along isomorphisms.

## Main declarations

* `equiv.map`: Turns functorially a function `α → β` into a function `t' α → t' β` using the functor
  `t` and the equivalence `Π α, t α ≃ t' α`.
* `equiv.functor`: `equiv.map` as a functor.
* `equiv.traverse`: Turns traversably a function `α → m β` into a function `t' α → m (t' β)` using
  the traversable functor `t` and the equivalence `Π α, t α ≃ t' α`.
* `equiv.traversable`: `equiv.traverse` as a traversable functor.
* `equiv.is_lawful_traversable`: `equiv.traverse` as a lawful traversable functor.
-/

universes u

namespace equiv

section functor
parameters {t t' : Type u → Type u}
parameters (eqv : Π α, t α ≃ t' α)
variables [functor t]

open functor

/-- Given a functor `t`, a function `t' : Type u → Type u`, and
equivalences `t α ≃ t' α` for all `α`, then every function `α → β` can
be mapped to a function `t' α → t' β` functorially (see
`equiv.functor`). -/
protected def map {α β : Type u} (f : α → β) (x : t' α) : t' β :=
eqv β $ map f ((eqv α).symm x)

/-- The function `equiv.map` transfers the functoriality of `t` to
`t'` using the equivalences `eqv`.  -/
protected def functor : functor t' :=
{ map := @equiv.map _ }

variables [is_lawful_functor t]

protected lemma id_map {α : Type u} (x : t' α) : equiv.map id x = x :=
by simp [equiv.map, id_map]

protected lemma comp_map {α β γ : Type u} (g : α → β) (h : β → γ) (x : t' α) :
  equiv.map (h ∘ g) x = equiv.map h (equiv.map g x) :=
by simp [equiv.map]; apply comp_map

protected lemma is_lawful_functor : @is_lawful_functor _ equiv.functor :=
{ id_map := @equiv.id_map _ _,
  comp_map := @equiv.comp_map _ _ }

protected lemma is_lawful_functor' [F : _root_.functor t']
  (h₀ : ∀ {α β} (f : α → β), _root_.functor.map f = equiv.map f)
  (h₁ : ∀ {α β} (f : β), _root_.functor.map_const f = (equiv.map ∘ function.const α) f) :
  _root_.is_lawful_functor t' :=
begin
  have : F = equiv.functor,
  { casesI F, dsimp [equiv.functor],
    congr; ext; [rw ← h₀, rw ← h₁] },
  substI this,
  exact equiv.is_lawful_functor
end

end functor

section traversable
parameters {t t' : Type u → Type u}
parameters (eqv : Π α, t α ≃ t' α)
variables [traversable t]
variables {m : Type u → Type u} [applicative m]
variables {α β : Type u}

/-- Like `equiv.map`, a function `t' : Type u → Type u` can be given
the structure of a traversable functor using a traversable functor
`t'` and equivalences `t α ≃ t' α` for all α.  See `equiv.traversable`. -/
protected def traverse (f : α → m β) (x : t' α) : m (t' β) :=
eqv β <$> traverse f ((eqv α).symm x)

/-- The function `equiv.traverse` transfers a traversable functor
instance across the equivalences `eqv`. -/
protected def traversable : traversable t' :=
{ to_functor := equiv.functor eqv,
  traverse := @equiv.traverse _ }

end traversable

section equiv
parameters {t t' : Type u → Type u}
parameters (eqv : Π α, t α ≃ t' α)
variables [traversable t] [is_lawful_traversable t]
variables {F G : Type u → Type u} [applicative F] [applicative G]
variables [is_lawful_applicative F] [is_lawful_applicative G]
variables (η : applicative_transformation F G)
variables {α β γ : Type u}

open is_lawful_traversable functor

protected lemma id_traverse (x : t' α) :
  equiv.traverse eqv id.mk x = x :=
by simp! [equiv.traverse,id_bind,id_traverse,functor.map] with functor_norm

protected lemma traverse_eq_map_id (f : α → β) (x : t' α) :
  equiv.traverse eqv (id.mk ∘ f) x = id.mk (equiv.map eqv f x) :=
by simp [equiv.traverse, traverse_eq_map_id] with functor_norm; refl

protected lemma comp_traverse (f : β → F γ) (g : α → G β) (x : t' α) :
  equiv.traverse eqv (comp.mk ∘ functor.map f ∘ g) x =
  comp.mk (equiv.traverse eqv f <$> equiv.traverse eqv g x) :=
by simp [equiv.traverse,comp_traverse] with functor_norm; congr; ext; simp

protected lemma naturality (f : α → F β) (x : t' α) :
  η (equiv.traverse eqv f x) = equiv.traverse eqv (@η _ ∘ f) x :=
by simp only [equiv.traverse] with functor_norm

/-- The fact that `t` is a lawful traversable functor carries over the
equivalences to `t'`, with the traversable functor structure given by
`equiv.traversable`. -/
protected def is_lawful_traversable : @is_lawful_traversable t' (equiv.traversable eqv) :=
{ to_is_lawful_functor := @equiv.is_lawful_functor _ _ eqv _ _,
  id_traverse := @equiv.id_traverse _ _,
  comp_traverse := @equiv.comp_traverse _ _,
  traverse_eq_map_id := @equiv.traverse_eq_map_id _ _,
  naturality := @equiv.naturality _ _ }

/-- If the `traversable t'` instance has the properties that `map`,
`map_const`, and `traverse` are equal to the ones that come from
carrying the traversable functor structure from `t` over the
equivalences, then the fact that `t` is a lawful traversable functor
carries over as well. -/
protected def is_lawful_traversable' [_i : traversable t']
  (h₀ : ∀ {α β} (f : α → β),
         map f = equiv.map eqv f)
  (h₁ : ∀ {α β} (f : β),
         map_const f = (equiv.map eqv ∘ function.const α) f)
  (h₂ : ∀ {F : Type u → Type u} [applicative F],
        by exactI ∀ [is_lawful_applicative F]
          {α β} (f : α → F β),
         traverse f = equiv.traverse eqv f) :
  _root_.is_lawful_traversable t' :=
begin
    -- we can't use the same approach as for `is_lawful_functor'` because
    -- h₂ needs a `is_lawful_applicative` assumption
  refine {to_is_lawful_functor :=
    equiv.is_lawful_functor' eqv @h₀ @h₁, ..}; introsI,
  { rw [h₂, equiv.id_traverse], apply_instance },
  { rw [h₂, equiv.comp_traverse f g x, h₂], congr,
    rw [h₂], all_goals { apply_instance } },
  { rw [h₂, equiv.traverse_eq_map_id, h₀]; apply_instance },
  { rw [h₂, equiv.naturality, h₂]; apply_instance }
end

end equiv
end equiv


/-
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, Johan Commelin, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.basic
import Mathlib.PostPort

universes u_1 u_2 u_4 u_5 u_3

namespace Mathlib

/-!
# Renaming variables of polynomials

This file establishes the `rename` operation on multivariate polynomials,
which modifies the set of variables.

## Main declarations

* `mv_polynomial.rename`

## Notation

As in other polynomial files, we typically use the notation:

+ `σ τ α : Type*` (indexing the variables)

+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `r : R` elements of the coefficient ring

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ α`

-/

namespace mv_polynomial

/-- Rename all the variables in a multivariable polynomial. -/
def rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ) :
    alg_hom R (mv_polynomial σ R) (mv_polynomial τ R) :=
  aeval (X ∘ f)

@[simp] theorem rename_C {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (r : R) : coe_fn (rename f) (coe_fn C r) = coe_fn C r :=
  eval₂_C (algebra_map R (mv_polynomial τ R)) (fun (n : σ) => function.comp X f n) r

@[simp] theorem rename_X {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (i : σ) : coe_fn (rename f) (X i) = X (f i) :=
  eval₂_X (algebra_map R (mv_polynomial τ R)) (fun (n : σ) => function.comp X f n) i

theorem map_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (g : σ → τ) (p : mv_polynomial σ R) :
    coe_fn (map f) (coe_fn (rename g) p) = coe_fn (rename g) (coe_fn (map f) p) :=
  sorry

@[simp] theorem rename_rename {σ : Type u_1} {τ : Type u_2} {α : Type u_3} {R : Type u_4}
    [comm_semiring R] (f : σ → τ) (g : τ → α) (p : mv_polynomial σ R) :
    coe_fn (rename g) (coe_fn (rename f) p) = coe_fn (rename (g ∘ f)) p :=
  sorry

@[simp] theorem rename_id {σ : Type u_1} {R : Type u_4} [comm_semiring R] (p : mv_polynomial σ R) :
    coe_fn (rename id) p = p :=
  eval₂_eta p

theorem rename_monomial {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (d : σ →₀ ℕ) (r : R) : coe_fn (rename f) (monomial d r) = monomial (finsupp.map_domain f d) r :=
  sorry

theorem rename_eq {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (p : mv_polynomial σ R) : coe_fn (rename f) p = finsupp.map_domain (finsupp.map_domain f) p :=
  sorry

theorem rename_injective {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (hf : function.injective f) : function.injective ⇑(rename f) :=
  sorry

theorem eval₂_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (k : σ → τ) (g : τ → S) (p : mv_polynomial σ R) :
    eval₂ f g (coe_fn (rename k) p) = eval₂ f (g ∘ k) p :=
  sorry

theorem eval₂_hom_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5}
    [comm_semiring R] [comm_semiring S] (f : R →+* S) (k : σ → τ) (g : τ → S)
    (p : mv_polynomial σ R) :
    coe_fn (eval₂_hom f g) (coe_fn (rename k) p) = coe_fn (eval₂_hom f (g ∘ k)) p :=
  eval₂_rename f k (fun (n : τ) => g n) p

theorem aeval_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5} [comm_semiring R]
    [comm_semiring S] (k : σ → τ) (g : τ → S) (p : mv_polynomial σ R) [algebra R S] :
    coe_fn (aeval g) (coe_fn (rename k) p) = coe_fn (aeval (g ∘ k)) p :=
  eval₂_hom_rename (algebra_map R S) k (fun (n : τ) => g n) p

theorem rename_eval₂ {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (k : σ → τ)
    (p : mv_polynomial σ R) (g : τ → mv_polynomial σ R) :
    coe_fn (rename k) (eval₂ C (g ∘ k) p) = eval₂ C (⇑(rename k) ∘ g) (coe_fn (rename k) p) :=
  sorry

theorem rename_prodmk_eval₂ {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (p : mv_polynomial σ R) (j : τ) (g : σ → mv_polynomial σ R) :
    coe_fn (rename (Prod.mk j)) (eval₂ C g p) =
        eval₂ C (fun (x : σ) => coe_fn (rename (Prod.mk j)) (g x)) p :=
  sorry

theorem eval₂_rename_prodmk {σ : Type u_1} {τ : Type u_2} {R : Type u_4} {S : Type u_5}
    [comm_semiring R] [comm_semiring S] (f : R →+* S) (g : σ × τ → S) (i : σ)
    (p : mv_polynomial τ R) :
    eval₂ f g (coe_fn (rename (Prod.mk i)) p) = eval₂ f (fun (j : τ) => g (i, j)) p :=
  sorry

theorem eval_rename_prodmk {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (g : σ × τ → R) (i : σ) (p : mv_polynomial τ R) :
    coe_fn (eval g) (coe_fn (rename (Prod.mk i)) p) = coe_fn (eval fun (j : τ) => g (i, j)) p :=
  eval₂_rename_prodmk (ring_hom.id R) (fun (n : σ × τ) => g n) i p

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_finset_rename {σ : Type u_1} {R : Type u_4} [comm_semiring R]
    (p : mv_polynomial σ R) :
    ∃ (s : finset σ),
        ∃ (q : mv_polynomial (Subtype fun (x : σ) => x ∈ s) R), p = coe_fn (rename coe) q :=
  sorry

/-- Every polynomial is a polynomial in finitely many variables. -/
theorem exists_fin_rename {σ : Type u_1} {R : Type u_4} [comm_semiring R] (p : mv_polynomial σ R) :
    ∃ (n : ℕ),
        ∃ (f : fin n → σ),
          ∃ (hf : function.injective f), ∃ (q : mv_polynomial (fin n) R), p = coe_fn (rename f) q :=
  sorry

theorem eval₂_cast_comp {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ)
    (c : ℤ →+* R) (g : τ → R) (p : mv_polynomial σ ℤ) :
    eval₂ c (g ∘ f) p = eval₂ c g (coe_fn (rename f) p) :=
  sorry

@[simp] theorem coeff_rename_map_domain {σ : Type u_1} {τ : Type u_2} {R : Type u_4}
    [comm_semiring R] (f : σ → τ) (hf : function.injective f) (φ : mv_polynomial σ R) (d : σ →₀ ℕ) :
    coeff (finsupp.map_domain f d) (coe_fn (rename f) φ) = coeff d φ :=
  sorry

theorem coeff_rename_eq_zero {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ)
    (h : ∀ (u : σ →₀ ℕ), finsupp.map_domain f u = d → coeff u φ = 0) :
    coeff d (coe_fn (rename f) φ) = 0 :=
  sorry

theorem coeff_rename_ne_zero {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R]
    (f : σ → τ) (φ : mv_polynomial σ R) (d : τ →₀ ℕ) (h : coeff d (coe_fn (rename f) φ) ≠ 0) :
    ∃ (u : σ →₀ ℕ), finsupp.map_domain f u = d ∧ coeff u φ ≠ 0 :=
  sorry

@[simp] theorem constant_coeff_rename {σ : Type u_1} {R : Type u_4} [comm_semiring R] {τ : Type u_2}
    (f : σ → τ) (φ : mv_polynomial σ R) :
    coe_fn constant_coeff (coe_fn (rename f) φ) = coe_fn constant_coeff φ :=
  sorry

end Mathlib


inductive Foo where
  | c1 (x : Nat) | c2 | c3 | c4

def bla : Foo → Nat
  | .c1 x => x + 1
  | _     => 2

example (x : Foo) : bla x > 0 := by
  cases x with
  | _  => decide -- Error
  | c1 => decide

example (x : Foo) : bla x > 0 := by
  induction x with
  | _  => decide -- Error
  | c1 => decide

example (x : Foo) : bla x > 0 := by
  cases x with
  | c1 x => simp_arith [bla]
  | _    => decide

example (x : Foo) : bla x > 0 := by
  induction x with
  | c1 x => simp_arith [bla]
  | _    => decide