/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.category.Top.opens
import Mathlib.category_theory.filtered
import Mathlib.PostPort

universes u

namespace Mathlib

namespace topological_space

def open_nhds {X : Top} (x : ↥X) :=
  Subtype fun (U : opens ↥X) => x ∈ U

namespace open_nhds

protected instance partial_order {X : Top} (x : ↥X) : partial_order (open_nhds x) :=
  partial_order.mk (fun (U V : open_nhds x) => subtype.val U ≤ subtype.val V)
    (preorder.lt._default fun (U V : open_nhds x) => subtype.val U ≤ subtype.val V) sorry sorry sorry

protected instance lattice {X : Top} (x : ↥X) : lattice (open_nhds x) :=
  lattice.mk (fun (U V : open_nhds x) => { val := subtype.val U ⊔ subtype.val V, property := sorry }) partial_order.le
    partial_order.lt sorry sorry sorry sorry sorry sorry
    (fun (U V : open_nhds x) => { val := subtype.val U ⊓ subtype.val V, property := sorry }) sorry sorry sorry

protected instance order_top {X : Top} (x : ↥X) : order_top (open_nhds x) :=
  order_top.mk { val := ⊤, property := trivial } partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance open_nhds_category {X : Top} (x : ↥X) : category_theory.category (open_nhds x) :=
  eq.mpr sorry (category_theory.full_subcategory fun (U : opens ↥X) => x ∈ U)

protected instance opens_nhds_hom_has_coe_to_fun {X : Top} {x : ↥X} {U : open_nhds x} {V : open_nhds x} : has_coe_to_fun (U ⟶ V) :=
  has_coe_to_fun.mk (fun (f : U ⟶ V) => ↥(subtype.val U) → ↥(subtype.val V))
    fun (f : U ⟶ V) (x_1 : ↥(subtype.val U)) => { val := ↑x_1, property := sorry }

/--
The inclusion `U ⊓ V ⟶ U` as a morphism in the category of open sets.
-/
def inf_le_left {X : Top} {x : ↥X} (U : open_nhds x) (V : open_nhds x) : U ⊓ V ⟶ U :=
  category_theory.hom_of_le sorry

/--
The inclusion `U ⊓ V ⟶ V` as a morphism in the category of open sets.
-/
def inf_le_right {X : Top} {x : ↥X} (U : open_nhds x) (V : open_nhds x) : U ⊓ V ⟶ V :=
  category_theory.hom_of_le sorry

def inclusion {X : Top} (x : ↥X) : open_nhds x ⥤ opens ↥X :=
  category_theory.full_subcategory_inclusion fun (U : opens ↥X) => x ∈ U

@[simp] theorem inclusion_obj {X : Top} (x : ↥X) (U : opens ↥X) (p : x ∈ U) : category_theory.functor.obj (inclusion x) { val := U, property := p } = U :=
  rfl

protected instance open_nhds_is_filtered {X : Top} (x : ↥X) : category_theory.is_filtered (open_nhds xᵒᵖ) :=
  category_theory.is_filtered.mk

def map {X : Top} {Y : Top} (f : X ⟶ Y) (x : ↥X) : open_nhds (coe_fn f x) ⥤ open_nhds x :=
  category_theory.functor.mk
    (fun (U : open_nhds (coe_fn f x)) =>
      { val := category_theory.functor.obj (opens.map f) (subtype.val U), property := sorry })
    fun (U V : open_nhds (coe_fn f x)) (i : U ⟶ V) => category_theory.functor.map (opens.map f) i

@[simp] theorem map_obj {X : Top} {Y : Top} (f : X ⟶ Y) (x : ↥X) (U : opens ↥Y) (q : coe_fn f x ∈ U) : category_theory.functor.obj (map f x) { val := U, property := q } =
  { val := category_theory.functor.obj (opens.map f) U, property := q } :=
  rfl

@[simp] theorem map_id_obj {X : Top} (x : ↥X) (U : open_nhds (coe_fn 𝟙 x)) : category_theory.functor.obj (map 𝟙 x) U = U := sorry

@[simp] theorem map_id_obj' {X : Top} (x : ↥X) (U : set ↥X) (p : is_open U) (q : coe_fn 𝟙 x ∈ { val := U, property := p }) : category_theory.functor.obj (map 𝟙 x) { val := { val := U, property := p }, property := q } =
  { val := { val := U, property := p }, property := q } :=
  rfl

@[simp] theorem map_id_obj_unop {X : Top} (x : ↥X) (U : open_nhds xᵒᵖ) : category_theory.functor.obj (map 𝟙 x) (opposite.unop U) = opposite.unop U := sorry

@[simp] theorem op_map_id_obj {X : Top} (x : ↥X) (U : open_nhds xᵒᵖ) : category_theory.functor.obj (category_theory.functor.op (map 𝟙 x)) U = U := sorry

def inclusion_map_iso {X : Top} {Y : Top} (f : X ⟶ Y) (x : ↥X) : inclusion (coe_fn f x) ⋙ opens.map f ≅ map f x ⋙ inclusion x :=
  category_theory.nat_iso.of_components (fun (U : open_nhds (coe_fn f x)) => category_theory.iso.mk 𝟙 𝟙) sorry

@[simp] theorem inclusion_map_iso_hom {X : Top} {Y : Top} (f : X ⟶ Y) (x : ↥X) : category_theory.iso.hom (inclusion_map_iso f x) = 𝟙 :=
  rfl

@[simp] theorem inclusion_map_iso_inv {X : Top} {Y : Top} (f : X ⟶ Y) (x : ↥X) : category_theory.iso.inv (inclusion_map_iso f x) = 𝟙 :=
  rfl


import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.Int.Basic
import Mathlib.Init.Data.Int.Order
import Mathlib.Data.Equiv.Basic
import Mathlib.Init.Data.Int.Order
import Lean.Data.Json

theorem h100 : ((146096 : Int) / 36524) * 100 = 400 := by decide
theorem h4 : ((146096 : Int) % 36524) / 1461 * 4 = 0 := by decide
theorem h1 : ((Int.fmod 146096 36524) % 1461) / 365 = 0 := by decide
theorem hdiv : (1460 : Int) / 365 = 4 := by decide
theorem hdiv' : ((146096 : Int) % 36524) / 365 = 0 := by decide
theorem pos36524 : (0 : Int) < 36524 := by decide
theorem pos1461 : (0 : Int) < 1461 := by decide
theorem pos1460 : (0 : Int) < 1460 := by decide
theorem pos365 : (0 : Int) < 365 := by decide
theorem pos146097 : (0 : Int) < 146097 := by decide
theorem pos4 : (0 : Int) < 4 := by decide
theorem pos100 : (0 : Int) < 100 := by decide
theorem pos400 : (0 : Int) < 400 := by decide

theorem not_lt_and_gt {day lo hi : Nat} (day_lt_lo : (day < lo)) (lo_lt_hi : lo < hi) : ¬hi < day :=
  fun hi_lt_day => lt_asymm (lt_trans lo_lt_hi hi_lt_day) day_lt_lo

theorem not_le_and_gt {day lo hi : Nat} (day_le_lo : (day <= lo)) (lo_lt_hi : lo < hi) : ¬hi < day :=
  fun hi_lt_day => lt_asymm (lt_of_lt_of_le hi_lt_day day_le_lo) lo_lt_hi

theorem not_le_and_ge_of_lt {day lo hi : Nat} (h0 : day <= lo) (h1 : lo < hi) : ¬hi <= day :=
  fun hi_le_day => absurd hi_le_day (not_le_of_gt <| lt_of_le_of_lt h0 h1)

theorem Nat.lt_of_succ_le_sub {m n l : Nat} (h : l.succ <= m - n) : n < m :=
  Nat.lt_of_sub_eq_succ (Nat.succ_pred (not_eq_zero_of_lt h)).symm

theorem Nat.lt_of_succ_le_sub' {m n l : Nat} (h0 : 0 < l) (h : l <= m - n) : n < m := by
  have h0 : l.pred.succ = l := Nat.succ_pred (not_eq_zero_of_lt h0)
  rw [<- h0] at h
  exact Nat.lt_of_succ_le_sub h

theorem Int.of_nat_nonneg (n : ℕ) : 0 ≤ Int.ofNat n := sorry

theorem Int.mod_nonneg (a : ℤ) {b : ℤ} : b ≠ 0 → 0 ≤ a % b := sorry

theorem Int.mod_lt_of_pos (a : ℤ) {b : ℤ} (H : 0 < b) : a % b < b := sorry

@[simp] theorem Int.zero_mod (b : ℤ) : 0 % b = 0 := sorry

theorem Int.le_sub_one_iff {a b : ℤ} : a ≤ b - 1 ↔ a < b := sorry

theorem Int.lt_add_one_iff {a b : ℤ} : a < b + 1 ↔ a ≤ b := sorry

@[simp]
theorem Int.mul_div_cancel (a : ℤ) {b : ℤ} (H : b ≠ 0) : a * b / b = a := sorry

theorem int.div_add_mod' (m k : ℤ) : m / k * k + m % k = m := sorry

theorem Int.div_eq_zero_of_lt {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < b) : a / b = 0 := sorry

@[simp]
theorem Int.zero_div : ∀ (d : Int), 0 / d = 0 := sorry

theorem Int.fmod_nonneg_of_pos_mod : ∀ (x : Int) {m : Int}, (h : 0 < m) → 0 <= x.fmod m
| _, Int.negSucc _, hm => by cases hm; done
| _, Int.ofNat 0, hm => by cases hm; done
| Int.ofNat 0, Int.ofNat (m+1), hm => by simp [Int.fmod]
| Int.ofNat (x+1), Int.ofNat (m+1), hm => by
  simp [Int.fmod, -Int.ofNat_eq_cast]
  apply Int.ofNat_zero_le
| Int.negSucc xNat, Int.ofNat (mNat+1), hm => by
  have hh : (xNat % (mNat + 1)).succ <= (mNat + 1) := @Nat.mod_lt _ _ (Int.ofNat_lt.mp hm)
  simp [Int.fmod, Int.subNatNat, Nat.sub_eq_zero_of_le hh]
  apply Int.ofNat_zero_le

@[simp]
theorem Int.fdiv_pos_eq_div : ∀ {a b : Int}, 0 <= a → 0 <= b → Int.fdiv a b = a / b
| .ofNat 0, .ofNat b_n, ha, hb => by simp [Int.fdiv]
| .negSucc _, _, ha, hb => by cases ha
| _, .negSucc _, ha, hb => by cases hb
| .ofNat (a_n + 1), .ofNat b_n, ha, hb => by
  simp [Int.fdiv, -Int.ofNat_eq_cast]
  simp [HDiv.hDiv, Div.div, Int.div, -Int.ofNat_eq_cast]

@[simp]
theorem Int.fmod_pos_eq_mod : ∀ {a b : Int}, 0 <= a → 0 <= b → a.fmod b = a % b
| .ofNat 0, .ofNat b_n, ha, hb => by simp [Int.fmod]
| .negSucc _, _, ha, hb => by cases ha
| _, .negSucc _, ha, hb => by cases hb
| .ofNat (a_n + 1), .ofNat b_n, ha, hb => by
  simp [Int.fmod, -Int.ofNat_eq_cast]
  simp [HMod.hMod, Mod.mod, Int.mod, -Int.ofNat_eq_cast]

@[simp]
theorem Int.fmod_fmod_eq (a : Int) {m₀ m₁ : Int} (h : 0 < m₀) (h' : 0 <= m₁) :
  (a.fmod m₀).fmod m₁ = (a.fmod m₀) % m₁ :=
    @Int.fmod_pos_eq_mod (a.fmod m₀) m₁ (Int.fmod_nonneg_of_pos_mod a h) h'

@[simp]
theorem Int.fdiv_fmod_eq_fmod_div (a : Int) {m d : Int} (h : 0 < m) (h' : 0 < d) :
  (a.fmod m).fdiv d = (a.fmod m) / d :=
  @fdiv_pos_eq_div (a.fmod m) d (Int.fmod_nonneg_of_pos_mod _ h) (le_of_lt h')

@[simp]
theorem Int.fdiv_mod_eq_mod_div (a : Int) {m d : Int} (h : 0 < m) (h' : 0 < d) :
  (a % m).fdiv d = (a % m) / d :=
  @fdiv_pos_eq_div (a % m) d (Int.mod_nonneg _ (ne_of_gt h)) (le_of_lt h')

@[simp]
theorem Int.fmodmod (a : Int) {m₀ m₁ m₂ : Int} (h0 : 0 < m₀) (h1 : 0 < m₁) (h2 : 0 < m₂) :
  ((a.fmod m₀) % m₁).fmod m₂ = (a.fmod m₀) % m₁ % m₂ :=
  @Int.fmod_pos_eq_mod (a.fmod m₀ % m₁) m₂ (Int.mod_nonneg _ (ne_of_gt h1)) (le_of_lt h2)

@[simp]
theorem Int.mod_fmod_eq_mod_mod {a m₀ m₁ : Int} (h0 : 0 < m₀) (h1 : 0 <= m₁) :
  (a % m₀).fmod m₁ = (a % m₀) % m₁ :=
    Int.fmod_pos_eq_mod (Int.mod_nonneg _ (ne_of_lt h0).symm) h1

theorem fdiv_neg_eq
  {a_n b_n : Nat}
  {a b : Int}
  (h_a : a = Int.negSucc a_n)
  (h_b : b = Int.ofNat b_n.succ) : Int.fdiv a b = -[1+ a_n / b_n.succ] := by
  simp [Int.fdiv, h_a]
  rw [h_b]
  done

theorem Int.div_add_mod (a b : ℤ) : b * (a / b) + a % b = a := sorry

theorem Int.fmod_lt : ∀ (x : Int) {m : Int}, (h : 0 < m) → x.fmod m < m
| Int.ofNat 0, Int.ofNat mn, hm => hm
| Int.ofNat (xn+1), Int.ofNat mn, hm => by
  simp [Int.fmod]
  refine @Nat.mod_lt (Nat.succ xn) mn ?x
  sorry

  --split
  --next => exact hm
  --next c _ _ _ g =>
  --  simp [Int.le_def] at *
  --  rw [g]
  --  exact Nat.mod_lt c (Int.ofNat_lt.mp (g ▸ hm))
  --next f g => cases g
  --next f g => cases f
  --next f g => cases f
| Int.negSucc x, Int.ofNat m, hm => by
  simp [Int.fmod, Int.subNatNat]
  have hh : (x % m).succ <= m := @Nat.mod_lt x m (Int.ofNat_lt.mp hm)
  simp [Nat.sub_eq_zero_of_le hh]
  apply Nat.sub_lt_of_pos_le (x % m).succ m (Nat.zero_lt_succ _) hh
| _, Int.negSucc _, hm => by cases hm; done

theorem ne_neg_succ_of_zero_le {a : Int} {b : Nat} (h : 0 <= a) : ¬(a = Int.negSucc b) := fun h' => by
  cases a with
  | ofNat _ => cases h'
  | negSucc _ => cases h

theorem ne_of_nat_of_lt_zero {a : Int} {b : Nat} (h : a < 0) : ¬(a = Int.ofNat b) := fun h' => by
  cases a with
  | ofNat _ => cases h
  | negSucc _ => cases h'

theorem Int.add_mul_div_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b ≠ 0) : (a + b * c) / b = a / b + c := sorry

theorem Int.add_mul_div_right (a b : Int) {c : Int} (H : c ≠ 0) :
  (a + b * c) / c = a / c + b := sorry

theorem div_eq_zero_of_lt : ∀ {a b : Int}, 0 <= a → 0 <= b → a < b → a / b = 0
| .ofNat a, .ofNat b, ha, hb, hlt => by
  have hx : a < b := by exact (@Int.ofNat_le (a+1) b).mp hlt
  have hy := Nat.div_eq_of_lt hx
  simp [HDiv.hDiv, Div.div, Int.div] at *
  simp [hy]
| .ofNat a, .negSucc b, ha, hb, hlt => by cases hb
| .negSucc a, .ofNat b, ha, hb, hlt => by cases ha
| .negSucc _, .negSucc _, ha, hb, hlt => by cases ha

theorem neither_lem (a b c : Int) (h0 : 0 <= (a * b)) (h1 : 0 <= c) (hb : 0 < b) (h : c < b) : ((a * b) + c).fdiv b = a := by
  have hsum : 0 <= (a * b + c) := Int.add_nonneg h0 h1
  simp [Int.fdiv_pos_eq_div hsum (le_of_lt hb)]
  have hdiv : (a * b + c) / b = a := by
    have hdiv' := Int.add_mul_div_right c a (ne_of_lt hb).symm
    rwa [add_comm, div_eq_zero_of_lt h1 (le_of_lt hb) h, zero_add] at hdiv'
  exact hdiv

theorem Nat.div_le_div_right {n m : Nat} (h : n ≤ m) {k : Nat} : n / k ≤ m / k := sorry

theorem Int.not_of_nat_le_neg_succ (a b : Nat) : ¬(Int.ofNat a <= Int.negSucc b) := fun h => by
  exact absurd (lt_of_le_of_lt h (Int.neg_succ_lt_zero b)) (not_lt_of_ge (Int.ofNat_zero_le a))

theorem Int.neg_succ_monotone {x y : Nat} (h : x >= y) : Int.negSucc x <= Int.negSucc y := by
  simp [Int.le_def, Int.nonneg_def, Int.sub_eq_add_neg]
  have h0 : - -[1+x] = (x.succ) := PLift.down_up (- -[1+ x])
  simp [h0, -Int.ofNat_eq_cast]
  refine Exists.intro ((x + 1) - (y + 1)) ?h
  have h1 : -[1+ y] + ((↑x) +1) = subNatNat (x+1) (Nat.succ y) := Int.negSucc_ofNat_add_ofNat y (x + 1)
  simp [h1]
  apply Int.subNatNat_of_le
  apply Nat.succ_le_succ
  exact h

theorem Int.neg_succ_monotone_rev {x y : Nat} : Int.negSucc x <= Int.negSucc y → x >= y := by
  simp [Int.le_def, Int.nonneg_def, Int.sub_eq_add_neg]
  have h0 : - -[1+x] = (x.succ) := PLift.down_up (- -[1+ x])
  simp [h0]
  intro sum
  have h1 : -[1+ y] + ((↑x) +1) = subNatNat (x+1) (Nat.succ y) := Int.negSucc_ofNat_add_ofNat y (x + 1)
  simp [h1]
  intro h2
  apply le_of_not_gt
  intro h3
  have h4 := Int.subNatNat_of_lt (Nat.succ_lt_succ h3)
  rw [h2] at h4
  cases h4

theorem Int.fdiv_le_div_right {n₁ n₂ de : Int} (h : n₁ <= n₂) (hde : 0 <= de) : n₁.fdiv de <= n₂.fdiv de := by
  simp [Int.fdiv]
  split
  next =>
    split <;> simp
    next => apply Int.ofNat_le.mpr; simp
    next => cases hde
    repeat cases h
  next a _ =>
    split <;> simp
    next => apply Int.ofNat_le.mpr; simp [Nat.eq_zero_of_le_zero (Int.ofNat_le.mp h)]
    next s _ r => simp [(show a = s by cases r; rfl), Nat.div_le_div_right (Int.ofNat_le.mp h) (k := s)]
    next r => cases r
    repeat exact (absurd h (Int.not_of_nat_le_neg_succ _ _))
  next => cases hde
  next =>
    split <;> simp
    next => apply Int.ofNat_le.mpr; exact Nat.zero_le _
    repeat (next t => cases t)
  next a b =>
    split
    next => exact le_of_lt (Int.neg_succ_lt_zero (a / b.succ))
    next s t => exact le_trans (le_of_lt (Int.neg_succ_lt_zero _)) (Int.ofNat_zero_le (_ / _))
    next t => cases t
    next => exact le_of_lt (Int.neg_succ_lt_zero (a / b.succ))
    next s t =>
      simp [(show b.succ = s.succ by cases t; rfl)]
      apply Int.neg_succ_monotone (Nat.div_le_div_right (Int.neg_succ_monotone_rev h))
    next t => cases t
  next=> cases hde

theorem Int.add_right_nonneg {x n : Int} (h : 0 <= x) (h' : 0 <= n) : 0 <= x + n :=
  Int.add_nonneg h h'

theorem Int.toNat_le_of_le_of_nonneg : ∀ {x : Int} {y : Nat}, 0 <= x → x <= y → x.toNat <= y
| .ofNat n, y, h1, h2 => by
  simp [Int.ofNat_eq_cast] at h2
  simp [Int.toNat, h2]
| .negSucc _, _, h1, h2 => by cases h1

theorem Int.div_le_of_le_mul {a b c : ℤ} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b := sorry
theorem Int.div_lt_of_lt_mul {a b c : ℤ} (H : 0 < c) (H' : a < b * c) : a / c < b := sorry
theorem Int.mul_lt_of_lt_div {a b c : ℤ} (H : 0 < c) (H3 : a < b / c) : a * c < b := sorry
theorem Int.lt_mul_of_div_lt {a b c : ℤ} (H1 : 0 < c) (H2 : a / c < b) : a < b * c := sorry

theorem Int.mul_le_of_le_div {a b c : Int} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b := sorry

theorem Int.mul_le_of_le_fdiv {n d q : Int} (hn : 0 <= n) (hd : 0 < d) (hq : 0 < q) (h : n.fdiv d = q) : q * d <= n := by
  simp [fdiv_pos_eq_div hn (le_of_lt hd)] at h
  exact Int.mul_le_of_le_div hd (le_of_eq h.symm)

@[simp] theorem Int.add_mod_self {a b : Int} : (a + b) % b = a % b := sorry

@[simp] theorem Int.mul_mod_left (a b : Int) : a * b % b = 0 := sorry

@[simp] theorem Int.mul_mod (a b n : Int) : a * b % n = a % n * (b % n) % n := sorry

@[simp] theorem Int.add_mul_mod_self {a b c : ℤ} : (a + b * c) % c = a % c := sorry

--@[simp] theorem Int.mod_eq_zero_lemma (a b c m : Int) : (((a * m) + (b * m)) + c * m) % m = 0 := by simp

@[simp] theorem Int.mod_eq_zero_lemma' (a b m : Int) : (((a * m) + (b * m)) + c) % m = c % m := by
  simp [(Int.distrib_right a b m).symm, add_comm ((a + b) * m) c]

@[simp] theorem Int.mod_eq_of_lt {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < b) : a % b = a := sorry

theorem Int.div_nonneg {a b : ℤ} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a / b := sorry

theorem Int.add_pos_ne_zero_of_nonneg {a b : Int} (h : 0 <= a) (h' : 0 < b) : a + b ≠ 0 := fun hf => by
  have hle : a <= a + b := Int.le_add_of_nonneg_right (le_of_lt h')
  rw [le_antisymm (hf ▸ hle) h] at hf
  simp at hf
  rw [hf] at h'
  exact False.elim $ lt_irrefl _ h'

theorem Int.div_mod_unique {a b r q : ℤ} (h : 0 < b) :
  a / b = q ∧ a % b = r ↔ r + b * q = a ∧ 0 ≤ r ∧ r < b :=
    sorry

theorem Int.div_pigeonhole {x lower c : Int} (hx : 0 <= x) (hlower : 0 < lower) (hc : 0 < c) : c * lower < x → x < c * (lower + 1) → (x / c) = lower := fun h1 h2 => by
  rw [mul_comm] at h2
  have div_lt_plus_one := Int.div_lt_of_lt_mul hc h2
  apply by_contradiction
  intro hne
  cases lt_or_gt_of_ne hne with
  | inl hl =>
    rw [mul_comm] at h1
    exact False.elim ((lt_asymm h1) (Int.lt_mul_of_div_lt hc hl))
  | inr hr =>
    have h_div_le : (x / c) <= lower := Int.le_of_add_le_add_right (Int.div_lt_of_lt_mul hc h2)
    cases lt_or_eq_of_le h_div_le with
    | inl hlx =>
      rw [mul_comm] at h1
      exact False.elim ((lt_asymm h1) (Int.lt_mul_of_div_lt hc hlx))
    | inr hrx => exact False.elim (hne hrx)

@[simp]
theorem Int.add_mul_div_eq (n : Int) {x denom : Int} :
  denom ≠ 0 → 0 <= x → x < denom → (n * denom + x) / denom = n := fun hne hle hlt => by
  rw [add_comm, mul_comm]
  have hx := Int.add_mul_div_left x n hne
  have hx' : x / denom = 0 := Int.div_eq_zero_of_lt hle hlt
  rw [hx'] at hx
  simp [zero_add] at hx
  assumption

@[simp]
theorem Int.add_mul_div_eq' (n : Int) {x denom : Int} :
  denom ≠ 0 → 0 <= x → x < denom → (denom * n + x) / denom = n := by
  rw [mul_comm]; exact add_mul_div_eq n

@[simp]
theorem Int.add_mul_div_eq'' (n : Int) {x denom : Int} :
  denom ≠ 0 → 0 <= x → x < denom → (x + n * denom) / denom = n := by
  rw [add_comm]; exact add_mul_div_eq n

@[simp]
theorem Int.add_mul_div_eq''' (n : Int) {x denom : Int} :
  denom ≠ 0 → 0 <= x → x < denom → (x + denom * n) / denom = n := by
  rw [add_comm, mul_comm]; exact add_mul_div_eq n

theorem toOrdinalDate_helper1 : ∀ {x : Int}, 1 <= x → 1 <= x.toNat
| Int.negSucc _, h => by cases h
| Int.ofNat xN, h => by
  apply Classical.byContradiction
  intro h'
  have h_eq_zero : xN = 0 := Nat.eq_zero_of_le_zero (Nat.le_of_lt_succ (lt_of_not_ge h') : xN <= 0)
  rw [h_eq_zero] at h
  cases h

instance {n : Nat} : Lean.ToJson (Fin n) where
  toJson fin :=
    Lean.Json.mkObj [("val", Lean.ToJson.toJson fin.val)]

instance {n : Nat} : Lean.FromJson (Fin n) where
  fromJson? j := do
    let (val : Nat) ← (Lean.fromJson? (← j.getObjVal? "val"))
    if h : val < n
    then return Fin.mk val h
    else Except.error s!"Fin.val out of range: {val} is not less than {n}"


lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
intros g h,
cases h with hpr hrp,
cases g with gpq gqp,
split,
intro p,
exact hpr(gpq(p)),
intro r,
exact gqp(hrp(r)),
end


lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
    intros pq qr,
    split,
    {
        intro p,
        apply qr.1,
        apply pq.1,
        exact p,
    },
    {
        intro r,
        apply pq.2,
        apply qr.2,
        exact r,
    },
end

lemma iff_trans_2 (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
    intros pq qr,
    rw pq,
    rw qr,
end


import .logic

variables {α β : Type}

inductive fm.dsub : fm α → fm α → Prop
| andl : ∀ p q, fm.dsub p (p ∧' q)
| andr : ∀ p q, fm.dsub q (p ∧' q)
| orl : ∀ p q, fm.dsub p (p ∨' q)
| orr : ∀ p q, fm.dsub q (p ∨' q)
| not : ∀ p, fm.dsub p (¬' p)
| ex : ∀ p, fm.dsub p (∃' p)

inductive fm.sub : fm α → fm α → Prop
| dir : ∀ p q, fm.dsub p q → fm.sub p q
| step : ∀ p q r, fm.sub p q → fm.dsub q r → fm.sub p r

lemma sub_and (p q r : fm α) : fm.sub p (q ∧' r) →
(p = q) ∨ (p = r) ∨ (fm.sub p q) ∨ (fm.sub p r) :=
begin
  intro H, cases H with _ _ H1 _ s _ H2 H3,
  cases H1, apply or.inl, refl,
  apply or.inr, apply or.inl, refl, cases H3,
  apply or.inr, apply or.inr, apply or.inl, assumption,
  apply or.inr, apply or.inr, apply or.inr, assumption
end

lemma sub_or (p q r : fm α) : fm.sub p (q ∨' r) →
(p = q) ∨ (p = r) ∨ (fm.sub p q) ∨ (fm.sub p r) :=
begin
  intro H, cases H with _ _ H1 _ s _ H2 H3,
  cases H1, apply or.inl, refl,
  apply or.inr, apply or.inl, refl, cases H3,
  apply or.inr, apply or.inr, apply or.inl, assumption,
  apply or.inr, apply or.inr, apply or.inr, assumption
end

lemma sub_not (p q : fm α) :
  fm.sub p (¬' q) → (p = q) ∨ (fm.sub p q) :=
begin
  intro H, cases H with _ _ H1 _ r _ H2 H3,
  cases H1, apply or.inl, refl,
  cases H3, apply or.inr, apply H2
end

lemma sub_ex (p q : fm α) :
  fm.sub p (∃' q) → (p = q) ∨ (fm.sub p q) :=
begin
  intro H, cases H with _ _ H1 _ r _ H2 H3,
  cases H1, apply or.inl, refl,
  cases H3, apply or.inr, apply H2
end

lemma srec_on_aux {C : fm α → Prop} (H : ∀ p, (∀ (q : fm α), fm.sub q p → C q) → C p) :
∀ (p q : fm α), fm.sub q p → C q :=
λ p, fm.rec_on p
  (begin
     intros q Hq,
     cases Hq with _ _ H1 x y z _ H2, cases H1, cases H2
   end)
  (begin
     intros q Hq,
     cases Hq with _ _ H1 x y z _ H2, cases H1, cases H2
   end)
  (begin
     intros a q Hq,
     cases Hq with _ _ H1 x y z _ H2, cases H1, cases H2
   end)
  (begin
    intros q r Hq Hr s Hs,
    cases (sub_and _ _ _ Hs) with H1 H2, rewrite H1,
    apply (H _ Hq), cases H2 with H3 H4,
    rewrite H3, apply (H _ Hr), cases H4 with H5 H6,
    apply (Hq _ H5), apply (Hr _ H6)
   end)
  (begin
    intros q r Hq Hr s Hs,
    cases (sub_or _ _ _ Hs) with H1 H2, rewrite H1,
    apply (H _ Hq), cases H2 with H3 H4,
    rewrite H3, apply (H _ Hr), cases H4 with H5 H6,
    apply (Hq _ H5), apply (Hr _ H6)
   end)
   (begin
     intros q Hq r Hr, cases (sub_not _ _ Hr) with H1 H2,
     rewrite H1, apply (H _ Hq), apply (Hq _ H2)
    end)
   (begin
     intros q Hq r Hr, cases (sub_ex _ _ Hr) with H1 H2,
     rewrite H1, apply (H _ Hq), apply (Hq _ H2)
    end)

lemma srec_on {C : fm α → Prop} :
  (∀ p, (∀ (q : fm α), fm.sub q p → C q) → C p) → ∀ (p : fm α), C p :=
by {intros H p, apply H, apply srec_on_aux, apply H}


/-
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
-/
import data.set.pairwise.basic
import data.set.lattice
import data.set_like.basic

/-!
# Chains and flags

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

This file defines chains for an arbitrary relation and flags for an order and proves Hausdorff's
Maximality Principle.

## Main declarations

* `is_chain s`: A chain `s` is a set of comparable elements.
* `max_chain_spec`: Hausdorff's Maximality Principle.
* `flag`: The type of flags, aka maximal chains, of an order.

## Notes

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL/Zorn.html) was written by Jacques D.
Fleuriot, Tobias Nipkow, Christian Sternagel.
-/

open classical set

variables {α β : Type*}

/-! ### Chains -/

section chain
variables (r : α → α → Prop)

local infix ` ≺ `:50 := r

/-- A chain is a set `s` satisfying `x ≺ y ∨ x = y ∨ y ≺ x` for all `x y ∈ s`. -/
def is_chain (s : set α) : Prop := s.pairwise (λ x y, x ≺ y ∨ y ≺ x)

/-- `super_chain s t` means that `t` is a chain that strictly includes `s`. -/
def super_chain (s t : set α) : Prop := is_chain r t ∧ s ⊂ t

/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/
def is_max_chain (s : set α) : Prop := is_chain r s ∧ ∀ ⦃t⦄, is_chain r t → s ⊆ t → s = t

variables {r} {c c₁ c₂ c₃ s t : set α} {a b x y : α}

lemma is_chain_empty : is_chain r ∅ := set.pairwise_empty _

lemma set.subsingleton.is_chain (hs : s.subsingleton) : is_chain r s := hs.pairwise _

lemma is_chain.mono : s ⊆ t → is_chain r t → is_chain r s := set.pairwise.mono

lemma is_chain.mono_rel {r' : α → α → Prop} (h : is_chain r s)
  (h_imp : ∀ x y, r x y → r' x y) : is_chain r' s :=
h.mono' $ λ x y, or.imp (h_imp x y) (h_imp y x)

/-- This can be used to turn `is_chain (≥)` into `is_chain (≤)` and vice-versa. -/
lemma is_chain.symm (h : is_chain r s) : is_chain (flip r) s := h.mono' $ λ _ _, or.symm

lemma is_chain_of_trichotomous [is_trichotomous α r] (s : set α) : is_chain r s :=
λ a _ b _ hab, (trichotomous_of r a b).imp_right $ λ h, h.resolve_left hab

lemma is_chain.insert (hs : is_chain r s) (ha : ∀ b ∈ s, a ≠ b → a ≺ b ∨ b ≺ a) :
  is_chain r (insert a s) :=
hs.insert_of_symmetric (λ _ _, or.symm) ha

lemma is_chain_univ_iff : is_chain r (univ : set α) ↔ is_trichotomous α r :=
begin
  refine ⟨λ h, ⟨λ a b , _⟩, λ h, @is_chain_of_trichotomous _ _ h univ⟩,
  rw [or.left_comm, or_iff_not_imp_left],
  exact h trivial trivial,
end

lemma is_chain.image (r : α → α → Prop) (s : β → β → Prop) (f : α → β)
  (h : ∀ x y, r x y → s (f x) (f y)) {c : set α} (hrc : is_chain r c) :
  is_chain s (f '' c) :=
λ x ⟨a, ha₁, ha₂⟩ y ⟨b, hb₁, hb₂⟩, ha₂ ▸ hb₂ ▸ λ hxy,
  (hrc ha₁ hb₁ $ ne_of_apply_ne f hxy).imp (h _ _) (h _ _)

section total
variables [is_refl α r]

lemma is_chain.total (h : is_chain r s) (hx : x ∈ s) (hy : y ∈ s) : x ≺ y ∨ y ≺ x :=
(eq_or_ne x y).elim (λ e, or.inl $ e ▸ refl _) (h hx hy)

lemma is_chain.directed_on (H : is_chain r s) : directed_on r s :=
λ x hx y hy, (H.total hx hy).elim (λ h, ⟨y, hy, h, refl _⟩) $ λ h, ⟨x, hx, refl _, h⟩

protected lemma is_chain.directed {f : β → α} {c : set β} (h : is_chain (f ⁻¹'o r) c) :
  directed r (λ x : {a : β // a ∈ c}, f x) :=
λ ⟨a, ha⟩ ⟨b, hb⟩, by_cases
  (λ hab : a = b, by simp only [hab, exists_prop, and_self, subtype.exists];
    exact ⟨b, hb, refl _⟩) $
  λ hab, (h ha hb hab).elim (λ h, ⟨⟨b, hb⟩, h, refl _⟩) $ λ h, ⟨⟨a, ha⟩, refl _, h⟩

lemma is_chain.exists3 (hchain : is_chain r s) [is_trans α r] {a b c}
  (mem1 : a ∈ s) (mem2 : b ∈ s) (mem3 : c ∈ s) :
  ∃ (z) (mem4 : z ∈ s), r a z ∧ r b z ∧ r c z :=
begin
  rcases directed_on_iff_directed.mpr (is_chain.directed hchain) a mem1 b mem2 with
    ⟨z, mem4, H1, H2⟩,
  rcases directed_on_iff_directed.mpr (is_chain.directed hchain) z mem4 c mem3 with
    ⟨z', mem5, H3, H4⟩,
  exact ⟨z', mem5, trans H1 H3, trans H2 H3, H4⟩,
end

end total

lemma is_max_chain.is_chain (h : is_max_chain r s) : is_chain r s := h.1
lemma is_max_chain.not_super_chain (h : is_max_chain r s) : ¬super_chain r s t :=
λ ht, ht.2.ne $ h.2 ht.1 ht.2.1

lemma is_max_chain.bot_mem [has_le α] [order_bot α] (h : is_max_chain (≤) s) : ⊥ ∈ s :=
(h.2 (h.1.insert $ λ a _ _, or.inl bot_le) $ subset_insert _ _).symm ▸ mem_insert _ _

lemma is_max_chain.top_mem [has_le α] [order_top α] (h : is_max_chain (≤) s) : ⊤ ∈ s :=
(h.2 (h.1.insert $ λ a _ _, or.inr le_top) $ subset_insert _ _).symm ▸ mem_insert _ _

open_locale classical

/-- Given a set `s`, if there exists a chain `t` strictly including `s`, then `succ_chain s`
is one of these chains. Otherwise it is `s`. -/
def succ_chain (r : α → α → Prop) (s : set α) : set α :=
if h : ∃ t, is_chain r s ∧ super_chain r s t then some h else s

lemma succ_chain_spec (h : ∃ t, is_chain r s ∧ super_chain r s t) :
  super_chain r s (succ_chain r s) :=
let ⟨t, hc'⟩ := h in
have is_chain r s ∧ super_chain r s (some h),
  from @some_spec _ (λ t, is_chain r s ∧ super_chain r s t) _,
by simp [succ_chain, dif_pos, h, this.right]

lemma is_chain.succ (hs : is_chain r s) : is_chain r (succ_chain r s) :=
if h : ∃ t, is_chain r s ∧ super_chain r s t then (succ_chain_spec h).1
  else by { simp [succ_chain, dif_neg, h], exact hs }

lemma is_chain.super_chain_succ_chain (hs₁ : is_chain r s) (hs₂ : ¬ is_max_chain r s) :
  super_chain r s (succ_chain r s) :=
begin
  simp [is_max_chain, not_and_distrib, not_forall_not] at hs₂,
  obtain ⟨t, ht, hst⟩ := hs₂.neg_resolve_left hs₁,
  exact succ_chain_spec ⟨t, hs₁, ht, ssubset_iff_subset_ne.2 hst⟩,
end

lemma subset_succ_chain : s ⊆ succ_chain r s :=
if h : ∃ t, is_chain r s ∧ super_chain r s t then (succ_chain_spec h).2.1
  else by simp [succ_chain, dif_neg, h, subset.rfl]

/-- Predicate for whether a set is reachable from `∅` using `succ_chain` and `⋃₀`. -/
inductive chain_closure (r : α → α → Prop) : set α → Prop
| succ : ∀ {s}, chain_closure s → chain_closure (succ_chain r s)
| union : ∀ {s}, (∀ a ∈ s, chain_closure a) → chain_closure (⋃₀ s)

/-- An explicit maximal chain. `max_chain` is taken to be the union of all sets in `chain_closure`.
-/
def max_chain (r : α → α → Prop) := ⋃₀ set_of (chain_closure r)

lemma chain_closure_empty : chain_closure r ∅ :=
have chain_closure r (⋃₀ ∅),
  from chain_closure.union $ λ a h, h.rec _,
by simpa using this

lemma chain_closure_max_chain : chain_closure r (max_chain r) := chain_closure.union $ λ s, id

private lemma chain_closure_succ_total_aux (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
  (h : ∀ ⦃c₃⦄, chain_closure r c₃ → c₃ ⊆ c₂ → c₂ = c₃ ∨ succ_chain r c₃ ⊆ c₂) :
  succ_chain r c₂ ⊆ c₁ ∨ c₁ ⊆ c₂ :=
begin
  induction hc₁,
  case succ : c₃ hc₃ ih
  { cases ih with ih ih,
    { exact or.inl (ih.trans subset_succ_chain) },
    { exact (h hc₃ ih).imp_left (λ h, h ▸ subset.rfl) } },
  case union : s hs ih
  { refine (or_iff_not_imp_left.2 $ λ hn, sUnion_subset $ λ a ha, _),
    exact (ih a ha).resolve_left (λ h, hn $ h.trans $ subset_sUnion_of_mem ha) }
end

private lemma chain_closure_succ_total (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
  (h : c₁ ⊆ c₂) :
  c₂ = c₁ ∨ succ_chain r c₁ ⊆ c₂ :=
begin
  induction hc₂ generalizing c₁ hc₁ h,
  case succ : c₂ hc₂ ih
  { refine (chain_closure_succ_total_aux hc₁ hc₂ $ λ c₁, ih).imp h.antisymm' (λ h₁, _),
    obtain rfl | h₂ := ih hc₁ h₁,
    { exact subset.rfl },
    { exact h₂.trans subset_succ_chain } },
  case union : s hs ih
  { apply or.imp_left h.antisymm',
    apply classical.by_contradiction,
    simp [not_or_distrib, sUnion_subset_iff, not_forall],
    intros c₃ hc₃ h₁ h₂,
    obtain h | h := chain_closure_succ_total_aux hc₁ (hs c₃ hc₃) (λ c₄, ih _ hc₃),
    { exact h₁ (subset_succ_chain.trans h) },
    obtain h' | h' := ih c₃ hc₃ hc₁ h,
    { exact h₁ h'.subset },
    { exact h₂ (h'.trans $ subset_sUnion_of_mem hc₃) } }
end

lemma chain_closure.total (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂) :
  c₁ ⊆ c₂ ∨ c₂ ⊆ c₁ :=
(chain_closure_succ_total_aux hc₂ hc₁ $ λ c₃ hc₃, chain_closure_succ_total hc₃ hc₁).imp_left
  subset_succ_chain.trans

lemma chain_closure.succ_fixpoint (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
  (hc : succ_chain r c₂ = c₂) :
  c₁ ⊆ c₂ :=
begin
  induction hc₁,
  case succ : s₁ hc₁ h
  { exact (chain_closure_succ_total hc₁ hc₂ h).elim (λ h, h ▸ hc.subset) id },
  case union : s hs ih
  { exact sUnion_subset ih }
end

lemma chain_closure.succ_fixpoint_iff (hc : chain_closure r c) :
  succ_chain r c = c ↔ c = max_chain r :=
⟨λ h, (subset_sUnion_of_mem hc).antisymm $ chain_closure_max_chain.succ_fixpoint hc h,
  λ h, subset_succ_chain.antisymm' $ (subset_sUnion_of_mem hc.succ).trans h.symm.subset⟩

lemma chain_closure.is_chain (hc : chain_closure r c) : is_chain r c :=
begin
  induction hc,
  case succ : c hc h
  { exact h.succ },
  case union : s hs h
  { change ∀ c ∈ s, is_chain r c at h,
    exact λ c₁ ⟨t₁, ht₁, (hc₁ : c₁ ∈ t₁)⟩ c₂ ⟨t₂, ht₂, (hc₂ : c₂ ∈ t₂)⟩ hneq,
      ((hs _ ht₁).total $ hs _ ht₂).elim
        (λ ht, h t₂ ht₂ (ht hc₁) hc₂ hneq)
        (λ ht, h t₁ ht₁ hc₁ (ht hc₂) hneq) }
end

/-- **Hausdorff's maximality principle**

There exists a maximal totally ordered set of `α`.
Note that we do not require `α` to be partially ordered by `r`. -/
lemma max_chain_spec : is_max_chain r (max_chain r) :=
classical.by_contradiction $ λ h,
let ⟨h₁, H⟩ := chain_closure_max_chain.is_chain.super_chain_succ_chain h in
  H.ne (chain_closure_max_chain.succ_fixpoint_iff.mpr rfl).symm

end chain

/-! ### Flags -/

/-- The type of flags, aka maximal chains, of an order. -/
structure flag (α : Type*) [has_le α] :=
(carrier : set α)
(chain' : is_chain (≤) carrier)
(max_chain' : ∀ ⦃s⦄, is_chain (≤) s → carrier ⊆ s → carrier = s)

namespace flag
section has_le
variables [has_le α] {s t : flag α} {a : α}

instance : set_like (flag α) α :=
{ coe := carrier,
  coe_injective' := λ s t h, by { cases s, cases t, congr' } }

@[ext] lemma ext : (s : set α) = t → s = t := set_like.ext'
@[simp] lemma mem_coe_iff : a ∈ (s : set α) ↔ a ∈ s := iff.rfl
@[simp] lemma coe_mk (s : set α) (h₁ h₂) : (mk s h₁ h₂ : set α) = s := rfl
@[simp] lemma mk_coe (s : flag α) : mk (s : set α) s.chain' s.max_chain' = s := ext rfl

lemma chain_le (s : flag α) : is_chain (≤) (s : set α) := s.chain'
protected lemma max_chain (s : flag α) : is_max_chain (≤) (s : set α) := ⟨s.chain_le, s.max_chain'⟩

lemma top_mem [order_top α] (s : flag α) : (⊤ : α) ∈ s := s.max_chain.top_mem
lemma bot_mem [order_bot α] (s : flag α) : (⊥ : α) ∈ s := s.max_chain.bot_mem

end has_le

section preorder
variables [preorder α] {a b : α}

protected lemma le_or_le (s : flag α) (ha : a ∈ s) (hb : b ∈ s) : a ≤ b ∨ b ≤ a :=
s.chain_le.total ha hb

instance [order_top α] (s : flag α) : order_top s := subtype.order_top s.top_mem
instance [order_bot α] (s : flag α) : order_bot s := subtype.order_bot s.bot_mem
instance [bounded_order α] (s : flag α) : bounded_order s :=
subtype.bounded_order s.bot_mem s.top_mem

end preorder

section partial_order
variables [partial_order α]

lemma chain_lt (s : flag α) : is_chain (<) (s : set α) :=
λ a ha b hb h, (s.le_or_le ha hb).imp h.lt_of_le h.lt_of_le'

instance [decidable_eq α] [@decidable_rel α (≤)] [@decidable_rel α (<)] (s : flag α) :
  linear_order s :=
{ le_total := λ a b, s.le_or_le a.2 b.2,
  decidable_eq := subtype.decidable_eq,
  decidable_le := subtype.decidable_le,
  decidable_lt := subtype.decidable_lt,
  ..subtype.partial_order _ }

end partial_order

instance [linear_order α] : unique (flag α) :=
{ default := ⟨univ, is_chain_of_trichotomous _, λ s _, s.subset_univ.antisymm'⟩,
  uniq := λ s, set_like.coe_injective $ s.3 (is_chain_of_trichotomous _) $ subset_univ _ }

end flag


/-
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, Mario Carneiro
-/
import data.equiv.basic
import data.sigma.basic
import algebra.group.defs

/-!
# Injective functions
-/

universes u v w x

namespace function

/-- `α ↪ β` is a bundled injective function. -/
@[nolint has_inhabited_instance] -- depending on cardinalities, an injective function may not exist
structure embedding (α : Sort*) (β : Sort*) :=
(to_fun : α → β)
(inj'   : injective to_fun)

infixr ` ↪ `:25 := embedding

instance {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) := ⟨_, embedding.to_fun⟩

initialize_simps_projections embedding (to_fun → apply)

end function

/-- Convert an `α ≃ β` to `α ↪ β`. -/
@[simps]
protected def equiv.to_embedding {α : Sort u} {β : Sort v} (f : α ≃ β) : α ↪ β :=
⟨f, f.injective⟩

/-- Given an equivalence to a subtype, produce an embedding to the elements of the corresponding
set. -/
@[simps]
def equiv.as_embedding {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) : α ↪ β :=
⟨coe ∘ e, subtype.coe_injective.comp e.injective⟩

@[simp]
lemma equiv.as_embedding_range {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) :
  set.range e.as_embedding = set_of p :=
set.ext $ λ x, ⟨λ ⟨y, h⟩, h ▸ subtype.coe_prop (e y), λ hs, ⟨e.symm ⟨x, hs⟩, by simp⟩⟩

namespace function
namespace embedding

lemma coe_injective {α β} : @function.injective (α ↪ β) (α → β) coe_fn
| ⟨x, _⟩ ⟨y, _⟩ rfl := rfl

@[ext] lemma ext {α β} {f g : embedding α β} (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

lemma ext_iff {α β} {f g : embedding α β} : (∀ x, f x = g x) ↔ f = g :=
⟨ext, λ h _, by rw h⟩

@[simp] theorem to_fun_eq_coe {α β} (f : α ↪ β) : to_fun f = f := rfl

@[simp] theorem coe_fn_mk {α β} (f : α → β) (i) :
  (@mk _ _ f i : α → β) = f := rfl

theorem injective {α β} (f : α ↪ β) : injective f := f.inj'

@[refl, simps {simp_rhs := tt}]
protected def refl (α : Sort*) : α ↪ α :=
⟨id, injective_id⟩

@[trans, simps {simp_rhs := tt}]
protected def trans {α β γ} (f : α ↪ β) (g : β ↪ γ) : α ↪ γ :=
⟨g ∘ f, g.injective.comp f.injective⟩

@[simp]
lemma equiv_to_embedding_trans_symm_to_embedding {α β : Sort*} (e : α ≃ β) :
  e.to_embedding.trans e.symm.to_embedding = embedding.refl _ :=
by { ext, simp, }

@[simp]
lemma equiv_symm_to_embedding_trans_to_embedding {α β : Sort*} (e : α ≃ β) :
  e.symm.to_embedding.trans e.to_embedding = embedding.refl _ :=
by { ext, simp, }

protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x}
  (e₁ : α ≃ β) (e₂ : γ ≃ δ) (f : α ↪ γ) : (β ↪ δ) :=
(equiv.to_embedding e₁.symm).trans (f.trans e₂.to_embedding)

/-- A right inverse `surj_inv` of a surjective function as an `embedding`. -/
protected noncomputable def of_surjective {α β} (f : β → α) (hf : surjective f) :
  α ↪ β :=
⟨surj_inv hf, injective_surj_inv _⟩

/-- Convert a surjective `embedding` to an `equiv` -/
protected noncomputable def equiv_of_surjective {α β} (f : α ↪ β) (hf : surjective f) :
  α ≃ β :=
equiv.of_bijective f ⟨f.injective, hf⟩

protected def of_not_nonempty {α β} (hα : ¬ nonempty α) : α ↪ β :=
⟨λa, (hα ⟨a⟩).elim, assume a, (hα ⟨a⟩).elim⟩

/-- Change the value of an embedding `f` at one point. If the prescribed image
is already occupied by some `f a'`, then swap the values at these two points. -/
def set_value {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
  [∀ a', decidable (f a' = b)] : α ↪ β :=
⟨λ a', if a' = a then b else if f a' = b then f a else f a',
  begin
    intros x y h,
    dsimp at h,
    split_ifs at h; try { substI b }; try { simp only [f.injective.eq_iff] at * }; cc
  end⟩

theorem set_value_eq {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
  [∀ a', decidable (f a' = b)] : set_value f a b a = b :=
by simp [set_value]

/-- Embedding into `option` -/
protected def some {α} : α ↪ option α :=
⟨some, option.some_injective α⟩

/-- Embedding of a `subtype`. -/
def subtype {α} (p : α → Prop) : subtype p ↪ α :=
⟨coe, λ _ _, subtype.ext_val⟩

@[simp] lemma coe_subtype {α} (p : α → Prop) : ⇑(subtype p) = coe := rfl

/-- Choosing an element `b : β` gives an embedding of `punit` into `β`. -/
def punit {β : Sort*} (b : β) : punit ↪ β :=
⟨λ _, b, by { rintros ⟨⟩ ⟨⟩ _, refl, }⟩

/-- Fixing an element `b : β` gives an embedding `α ↪ α × β`. -/
def sectl (α : Sort*) {β : Sort*} (b : β) : α ↪ α × β :=
⟨λ a, (a, b), λ a a' h, congr_arg prod.fst h⟩

/-- Fixing an element `a : α` gives an embedding `β ↪ α × β`. -/
def sectr {α : Sort*} (a : α) (β : Sort*): β ↪ α × β :=
⟨λ b, (a, b), λ b b' h, congr_arg prod.snd h⟩

/-- Restrict the codomain of an embedding. -/
def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
⟨λ a, ⟨f a, H a⟩, λ a b h, f.injective (@congr_arg _ _ _ _ subtype.val h)⟩

@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
  cod_restrict p f H a = ⟨f a, H a⟩ := rfl

/-- If `e₁` and `e₂` are embeddings, then so is `prod.map e₁ e₂ : (a, b) ↦ (e₁ a, e₂ b)`. -/
def prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α × γ ↪ β × δ :=
⟨prod.map e₁ e₂, e₁.injective.prod_map e₂.injective⟩

@[simp] lemma coe_prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
  ⇑(e₁.prod_map e₂) = prod.map e₁ e₂ :=
rfl

section sum
open sum

/-- If `e₁` and `e₂` are embeddings, then so is `sum.map e₁ e₂`. -/
def sum_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α ⊕ γ ↪ β ⊕ δ :=
⟨sum.map e₁ e₂,
    assume s₁ s₂ h, match s₁, s₂, h with
    | inl a₁, inl a₂, h := congr_arg inl $ e₁.injective $ inl.inj h
    | inr b₁, inr b₂, h := congr_arg inr $ e₂.injective $ inr.inj h
    end⟩

@[simp] theorem coe_sum_map {α β γ δ} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
  ⇑(sum_map e₁ e₂) = sum.map e₁ e₂ :=
rfl

/-- The embedding of `α` into the sum `α ⊕ β`. -/
@[simps] def inl {α β : Type*} : α ↪ α ⊕ β :=
⟨sum.inl, λ a b, sum.inl.inj⟩

/-- The embedding of `β` into the sum `α ⊕ β`. -/
@[simps] def inr {α β : Type*} : β ↪ α ⊕ β :=
⟨sum.inr, λ a b, sum.inr.inj⟩

end sum

section sigma

variables {α α' : Type*} {β : α → Type*} {β' : α' → Type*}

/-- `sigma.mk` as an `function.embedding`. -/
@[simps apply] def sigma_mk (a : α) : β a ↪ Σ x, β x :=
⟨sigma.mk a, sigma_mk_injective⟩

/-- If `f : α ↪ α'` is an embedding and `g : Π a, β α ↪ β' (f α)` is a family
of embeddings, then `sigma.map f g` is an embedding. -/
@[simps apply] def sigma_map (f : α ↪ α') (g : Π a, β a ↪ β' (f a)) :
  (Σ a, β a) ↪ Σ a', β' a' :=
⟨sigma.map f (λ a, g a), f.injective.sigma_map (λ a, (g a).injective)⟩

end sigma

def Pi_congr_right {α : Sort*} {β γ : α → Sort*} (e : ∀ a, β a ↪ γ a) : (Π a, β a) ↪ (Π a, γ a) :=
⟨λf a, e a (f a), λ f₁ f₂ h, funext $ λ a, (e a).injective (congr_fun h a)⟩

def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w}
  (e : α ↪ β) : (γ → α) ↪ (γ → β) :=
Pi_congr_right (λ _, e)

noncomputable def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w} [inhabited γ]
  (e : α ↪ β) : (α → γ) ↪ (β → γ) :=
by haveI := classical.prop_decidable; exact
let f' : (α → γ) → (β → γ) := λf b, if h : ∃c, e c = b then f (classical.some h) else default γ in
⟨f', assume f₁ f₂ h, funext $ assume c,
  have ∃c', e c' = e c, from ⟨c, rfl⟩,
  have eq' : f' f₁ (e c) = f' f₂ (e c), from congr_fun h _,
  have eq_b : classical.some this = c, from e.injective $ classical.some_spec this,
  by simp [f', this, if_pos, eq_b] at eq'; assumption⟩

protected def subtype_map {α β} {p : α → Prop} {q : β → Prop} (f : α ↪ β)
  (h : ∀{{x}}, p x → q (f x)) : {x : α // p x} ↪ {y : β // q y} :=
⟨subtype.map f h, subtype.map_injective h f.2⟩

open set

/-- `set.image` as an embedding `set α ↪ set β`. -/
@[simps apply] protected def image {α β} (f : α ↪ β) : set α ↪ set β :=
⟨image f, f.2.image_injective⟩

lemma swap_apply {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y z : α) :
  equiv.swap (f x) (f y) (f z) = f (equiv.swap x y z) :=
f.injective.swap_apply x y z

lemma swap_comp {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y : α) :
  equiv.swap (f x) (f y) ∘ f = f ∘ equiv.swap x y :=
f.injective.swap_comp x y

end embedding
end function

namespace equiv

@[simp]
lemma refl_to_embedding {α : Type*} : (equiv.refl α).to_embedding = function.embedding.refl α := rfl

@[simp]
lemma trans_to_embedding {α β γ : Type*} (e : α ≃ β) (f : β ≃ γ) :
  (e.trans f).to_embedding = e.to_embedding.trans f.to_embedding := rfl

end equiv

namespace set

/-- The injection map is an embedding between subsets. -/
@[simps apply] def embedding_of_subset {α} (s t : set α) (h : s ⊆ t) : s ↪ t :=
⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by { congr, injection h }⟩

end set

-- TODO: these two definitions probably belong somewhere else, so that we can remove the
-- `algebra.group.defs` import.

/--
The embedding of a left cancellative semigroup into itself
by left multiplication by a fixed element.
 -/
@[to_additive
  "The embedding of a left cancellative additive semigroup into itself
   by left translation by a fixed element.", simps]
def mul_left_embedding {G : Type u} [left_cancel_semigroup G] (g : G) : G ↪ G :=
{ to_fun := λ h, g * h, inj' := mul_right_injective g }

/--
The embedding of a right cancellative semigroup into itself
by right multiplication by a fixed element.
 -/
@[to_additive
  "The embedding of a right cancellative additive semigroup into itself
   by right translation by a fixed element.", simps]
def mul_right_embedding {G : Type u} [right_cancel_semigroup G] (g : G) : G ↪ G :=
{ to_fun := λ h, h * g, inj' := mul_left_injective g }


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.mul_add
import Mathlib.group_theory.perm.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Multiplicative and additive group automorphisms

This file defines the automorphism group structure on `add_aut R := add_equiv R R` and
`mul_aut R := mul_equiv R R`.

## Implementation notes

The definition of multiplication in the automorphism groups agrees with function composition,
multiplication in `equiv.perm`, and multiplication in `category_theory.End`, but not with
`category_theory.comp`.

This file is kept separate from `data/equiv/mul_add` so that `group_theory.perm` is free to use
equivalences (and other files that use them) before the group structure is defined.

## Tags

mul_aut, add_aut
-/

/-- The group of multiplicative automorphisms. -/
def mul_aut (M : Type u_1) [Mul M] :=
  M ≃* M

namespace mul_aut

/--
The group operation on multiplicative automorphisms is defined by
`λ g h, mul_equiv.trans h g`.
This means that multiplication agrees with composition, `(g*h)(x) = g (h x)`.
-/
protected instance group (M : Type u_2) [Mul M] : group (mul_aut M) :=
  group.mk (fun (g h : M ≃* M) => mul_equiv.trans h g) sorry (mul_equiv.refl M) sorry sorry mul_equiv.symm
    (fun (a b : M ≃* M) => a * mul_equiv.symm b) sorry

protected instance inhabited (M : Type u_2) [Mul M] : Inhabited (mul_aut M) :=
  { default := 1 }

@[simp] theorem coe_mul (M : Type u_2) [Mul M] (e₁ : mul_aut M) (e₂ : mul_aut M) : ⇑(e₁ * e₂) = ⇑e₁ ∘ ⇑e₂ :=
  rfl

@[simp] theorem coe_one (M : Type u_2) [Mul M] : ⇑1 = id :=
  rfl

theorem mul_def (M : Type u_2) [Mul M] (e₁ : mul_aut M) (e₂ : mul_aut M) : e₁ * e₂ = mul_equiv.trans e₂ e₁ :=
  rfl

theorem one_def (M : Type u_2) [Mul M] : 1 = mul_equiv.refl M :=
  rfl

theorem inv_def (M : Type u_2) [Mul M] (e₁ : mul_aut M) : e₁⁻¹ = mul_equiv.symm e₁ :=
  rfl

@[simp] theorem mul_apply (M : Type u_2) [Mul M] (e₁ : mul_aut M) (e₂ : mul_aut M) (m : M) : coe_fn (e₁ * e₂) m = coe_fn e₁ (coe_fn e₂ m) :=
  rfl

@[simp] theorem one_apply (M : Type u_2) [Mul M] (m : M) : coe_fn 1 m = m :=
  rfl

@[simp] theorem apply_inv_self (M : Type u_2) [Mul M] (e : mul_aut M) (m : M) : coe_fn e (coe_fn (e⁻¹) m) = m :=
  mul_equiv.apply_symm_apply e m

@[simp] theorem inv_apply_self (M : Type u_2) [Mul M] (e : mul_aut M) (m : M) : coe_fn (e⁻¹) (coe_fn e m) = m :=
  mul_equiv.apply_symm_apply (e⁻¹) m

/-- Monoid hom from the group of multiplicative automorphisms to the group of permutations. -/
def to_perm (M : Type u_2) [Mul M] : mul_aut M →* equiv.perm M :=
  monoid_hom.mk mul_equiv.to_equiv sorry sorry

/-- group conjugation as a group homomorphism into the automorphism group.
  `conj g h = g * h * g⁻¹` -/
def conj {G : Type u_3} [group G] : G →* mul_aut G :=
  monoid_hom.mk
    (fun (g : G) => mul_equiv.mk (fun (h : G) => g * h * (g⁻¹)) (fun (h : G) => g⁻¹ * h * g) sorry sorry sorry) sorry
    sorry

@[simp] theorem conj_apply {G : Type u_3} [group G] (g : G) (h : G) : coe_fn (coe_fn conj g) h = g * h * (g⁻¹) :=
  rfl

@[simp] theorem conj_symm_apply {G : Type u_3} [group G] (g : G) (h : G) : coe_fn (mul_equiv.symm (coe_fn conj g)) h = g⁻¹ * h * g :=
  rfl

@[simp] theorem conj_inv_apply {G : Type u_1} [group G] (g : G) (h : G) : coe_fn (coe_fn conj g⁻¹) h = g⁻¹ * h * g :=
  rfl

end mul_aut

namespace add_aut

/--
The group operation on additive automorphisms is defined by
`λ g h, add_equiv.trans h g`.
This means that multiplication agrees with composition, `(g*h)(x) = g (h x)`.
-/
protected instance group (A : Type u_1) [Add A] : group (add_aut A) :=
  group.mk (fun (g h : A ≃+ A) => add_equiv.trans h g) sorry (add_equiv.refl A) sorry sorry add_equiv.symm
    (fun (a b : A ≃+ A) => a * add_equiv.symm b) sorry

protected instance inhabited (A : Type u_1) [Add A] : Inhabited (add_aut A) :=
  { default := 1 }

@[simp] theorem coe_mul (A : Type u_1) [Add A] (e₁ : add_aut A) (e₂ : add_aut A) : ⇑(e₁ * e₂) = ⇑e₁ ∘ ⇑e₂ :=
  rfl

@[simp] theorem coe_one (A : Type u_1) [Add A] : ⇑1 = id :=
  rfl

theorem mul_def (A : Type u_1) [Add A] (e₁ : add_aut A) (e₂ : add_aut A) : e₁ * e₂ = add_equiv.trans e₂ e₁ :=
  rfl

theorem one_def (A : Type u_1) [Add A] : 1 = add_equiv.refl A :=
  rfl

theorem inv_def (A : Type u_1) [Add A] (e₁ : add_aut A) : e₁⁻¹ = add_equiv.symm e₁ :=
  rfl

@[simp] theorem mul_apply (A : Type u_1) [Add A] (e₁ : add_aut A) (e₂ : add_aut A) (a : A) : coe_fn (e₁ * e₂) a = coe_fn e₁ (coe_fn e₂ a) :=
  rfl

@[simp] theorem one_apply (A : Type u_1) [Add A] (a : A) : coe_fn 1 a = a :=
  rfl

@[simp] theorem apply_inv_self (A : Type u_1) [Add A] (e : add_aut A) (a : A) : coe_fn (e⁻¹) (coe_fn e a) = a :=
  add_equiv.apply_symm_apply (e⁻¹) a

@[simp] theorem inv_apply_self (A : Type u_1) [Add A] (e : add_aut A) (a : A) : coe_fn e (coe_fn (e⁻¹) a) = a :=
  add_equiv.apply_symm_apply e a

/-- Monoid hom from the group of multiplicative automorphisms to the group of permutations. -/
def to_perm (A : Type u_1) [Add A] : add_aut A →* equiv.perm A :=
  monoid_hom.mk add_equiv.to_equiv sorry sorry


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import ring_theory.subsemiring.basic
import algebra.group_ring_action
import algebra.pointwise

/-! # Pointwise instances on `subsemiring`s

This file provides the action `subsemiring.pointwise_mul_action` which matches the action of
`mul_action_set`.

This actions is available in the `pointwise` locale.

## Implementation notes

This file is almost identical to `group_theory/submonoid/pointwise.lean`. Where possible, try to
keep them in sync.
-/

variables {M R : Type*}

namespace subsemiring

section monoid
variables [monoid M] [semiring R] [mul_semiring_action M R]

/-- The action on a subsemiring corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action M (subsemiring R) :=
{ smul := λ a S, S.map (mul_semiring_action.to_ring_hom _ _ a),
  one_smul := λ S,
    (congr_arg (λ f, S.map f) (ring_hom.ext $ by exact one_smul M)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (ring_hom.ext $ by exact mul_smul _ _)).trans (S.map_map _ _).symm }

localized "attribute [instance] subsemiring.pointwise_mul_action" in pointwise
open_locale pointwise

lemma pointwise_smul_def {a : M} (S : subsemiring R) :
  a • S = S.map (mul_semiring_action.to_ring_hom _ _ a) := rfl

@[simp] lemma coe_pointwise_smul (m : M) (S : subsemiring R) : ↑(m • S) = m • (S : set R) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (m : M) (S : subsemiring R) :
  (m • S).to_add_submonoid = m • S.to_add_submonoid := rfl

end monoid

section group
variables [group M] [semiring R] [mul_semiring_action M R]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : M} {S : subsemiring R} {x : R} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : M} {S : subsemiring R} {x : R} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : M} {S : subsemiring R} {x : R} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : M} {S T : subsemiring R} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : M} {S T : subsemiring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : M} {S T : subsemiring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

/-! TODO: add `equiv_smul` like we have for subgroup. -/

end group

section group_with_zero
variables [group_with_zero M] [semiring R] [mul_semiring_action M R]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : subsemiring R)
  (x : R) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set R) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : M} (ha : a ≠ 0) (S : subsemiring R) (x : R) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set R) x

lemma mem_inv_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : subsemiring R) (x : R) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set R) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : subsemiring R} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : M} (ha : a ≠ 0) {S T : subsemiring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : subsemiring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end subsemiring


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Ring.basic
import topology.category.Top.basic
import topology.algebra.ring

/-!
# Category of topological commutative rings

We introduce the category `TopCommRing` of topological commutative rings together with the relevant
forgetful functors to topological spaces and commutative rings.
-/

universes u

open category_theory

/-- A bundled topological commutative ring. -/
structure TopCommRing :=
(α : Type u)
[is_comm_ring : comm_ring α]
[is_topological_space : topological_space α]
[is_topological_ring : topological_ring α]

namespace TopCommRing

instance : inhabited TopCommRing := ⟨⟨punit⟩⟩

instance : has_coe_to_sort TopCommRing (Type u) := ⟨TopCommRing.α⟩

attribute [instance] is_comm_ring is_topological_space is_topological_ring

instance : category TopCommRing.{u} :=
{ hom   := λ R S, {f : R →+* S // continuous f },
  id    := λ R, ⟨ring_hom.id R, by obviously⟩, -- TODO remove obviously?
  comp  := λ R S T f g, ⟨g.val.comp f.val,
    begin -- TODO automate
      cases f, cases g,
      dsimp, apply continuous.comp ; assumption
    end⟩ }

instance : concrete_category TopCommRing.{u} :=
{ forget := { obj := λ R, R, map := λ R S f, f.val },
  forget_faithful := { } }

/-- Construct a bundled `TopCommRing` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] : TopCommRing := ⟨X⟩

@[simp] lemma coe_of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] :
  (of X : Type u) = X := rfl

instance forget_topological_space (R : TopCommRing) :
  topological_space ((forget TopCommRing).obj R) :=
R.is_topological_space
instance forget_comm_ring (R : TopCommRing) :
  comm_ring ((forget TopCommRing).obj R) :=
R.is_comm_ring
instance forget_topological_ring (R : TopCommRing) :
  topological_ring ((forget TopCommRing).obj R) :=
R.is_topological_ring

instance has_forget_to_CommRing : has_forget₂ TopCommRing CommRing :=
has_forget₂.mk'
  (λ R, CommRing.of R)
  (λ x, rfl)
  (λ R S f, f.val)
  (λ R S f, heq.rfl)

instance forget_to_CommRing_topological_space (R : TopCommRing) :
  topological_space ((forget₂ TopCommRing CommRing).obj R) :=
R.is_topological_space

/-- The forgetful functor to Top. -/
instance has_forget_to_Top : has_forget₂ TopCommRing Top :=
has_forget₂.mk'
  (λ R, Top.of R)
  (λ x, rfl)
  (λ R S f, ⟨⇑f.1, f.2⟩)
  (λ R S f, heq.rfl)

instance forget_to_Top_comm_ring (R : TopCommRing) :
  comm_ring ((forget₂ TopCommRing Top).obj R) :=
R.is_comm_ring

instance forget_to_Top_topological_ring (R : TopCommRing) :
  topological_ring ((forget₂ TopCommRing Top).obj R) :=
R.is_topological_ring

/--
The forgetful functors to `Type` do not reflect isomorphisms,
but the forgetful functor from `TopCommRing` to `Top` does.
-/
instance : reflects_isomorphisms (forget₂ TopCommRing.{u} Top.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    -- We have an isomorphism in `Top`,
    let i_Top := as_iso ((forget₂ TopCommRing Top).map f),

    -- and a `ring_equiv`.
    let e_Ring : X ≃+* Y := { ..f.1, ..((forget Top).map_iso i_Top).to_equiv },

    -- Putting these together we obtain the isomorphism we're after:
    exact
    ⟨⟨⟨e_Ring.symm, i_Top.inv.2⟩,
      ⟨by { ext x, exact e_Ring.left_inv x, }, by { ext x, exact e_Ring.right_inv x, }⟩⟩⟩
  end }

end TopCommRing


/- INTRODUCTION
This tutorial introduces the basics of interactive theorem proving in Lean.
Key points:
- basic boilerplate at the top of the file,
- basic grammar of stating and proving,
- how to interact with the proof assistant.

We will set ourselves the lofty goal of proving 2 + 2 = 4.
-/

/- COMMENTS
As you can see, one can write comments containing arbitrary text
between the delimiters slash-dash and dash-slash.
Alternatively, one can write one-line comments by prepending the line with dash-dash:

    -- This is a one-line comment.
-/

/- TOP OF THE FILE
Typically, the top of a file will look something like this:

    -- Copied from ring_theory/ideals.lean
    import algebra.module tactic.ring linear_algebra.quotient_module

    universes u v
    variables {α : Type u} {β : Type v} [comm_ring α] {a b : α}
    open set function

    local attribute [instance] classical.prop_decidable

1. The first line is an import statement. It imports definitions and lemmas from other files.
These files are either part of the current project, or part of a separate library.
Separate libraries should be added using leanpkg -- a package manager for Lean.
2. The second line introduces two universe levels. These are like Grothendieck universes in ZFC.
3. The third line declares several variables that may be used throughout this file.
In particular, `α` is a type equipped with the structure of a commutative ring, `β` is an arbitrary type,
and `a,b` are two terms of type `α`.
4. The next line opens two namespaces: set and function. This means that one can now call `univ`
instead of `set.univ`: one no longer has to prepend `set` or `function` to the names of lemmas
that one is using. (Unless there is a naming conflict with other open namespaces.)
5. The final line of this header states that this file uses classical logic. This means that we can
the law of excluded middle can be used, so that `p ∨ ¬p` is true for every proposition `p`.

In this tutorial file we don't actually need any of such header lines,
since the natural numbers are part of core Lean.
-/

/- BASIC GRAMMAR
The most important keywords in Lean are:
- definition (or def)
- lemma (or theorem)
- sorry

The first two explain themselves. The third (sorry) is very useful to use as a stop-gap. It is a keyword
that can prove everything, but Lean will remember and output a warning that lemma such-and-such uses sorry.

Besides `definition` there are other keywords to introduce new types, such as `inductive` for inductive types,
and `structure` and `class` (which be have like tuples with named entries).

Let us illustrate the use of these keywords by stating our lemma:
-/

-- lemma two_add_two : 2 + 2 = 4 := sorry

/-
It is a feature of dependent type theory that there is no strict difference between a definition and a lemma.
We can see this in action by dissecting the example above:

lemma           keyword
two_add_two     name of lemma/definition; a term of the type that follows
:               "is a term of"
2 + 2 = 4       type
:=              "defined as"
sorry           proof/definition

-/

/- BASIC INTERACTION
One of the key features of Lean is that it is interactive. If you have opened this file in an editor with Lean support
then you can interact with Lean while proving a lemma. Examples of such editors are VScode, emacs, and CoCalc (online).
This tutorial assumes you are using VScode and have installed the Lean extension for VScode.

In the upper right hand of your editor window there is a group of buttons. The left-most of these is called
"Info view: Display Goal". Click it, or type Ctrl-Shift-Enter.
-/

-- Uncomment the following line and put your cursor on `sorry`.
-- lemma two_add_two : 2 + 2 = 4 := sorry

-- As mentioned above, Lean will warn you that your lemma is using sorry.

-- In the following line, we introduced some errors. Lean will tell you that something is wrong.
-- lema two_add_two : 2 + 2 =  := srry

-- In the following line, we give a non-proof. Lean will figure this out and tell you.
-- lemma two_add_two : 2 + 2 = 4 := nat.add

-- The window with Lean messages will display:
    -- type mismatch, term
    --   nat.add
    -- has type
    --   ℕ → ℕ → ℕ : Type
    -- but is expected to have type
    --   2 + 2 = 4 : Prop

-- nat.add is a function that takes two natural numbers and returns a third (in fact, the sum of the inputs).
-- Therefore it has type `ℕ → ℕ → ℕ`. Lean correctly figures out that this is not what it expects, namely
-- a term of type `2 + 2 = 4`.

/- PROVING OUR GOAL
Finally, let us actually prove that 2 + 2 = 4. In Lean, the natural numbers are set up in a way that is very similar
to Peano arithmetic. This means that there is a natural number called `zero` (and in fact we can just use `0`);
and there is a function `succ : ℕ → ℕ` that sends a natural number to its successor.
So we get

    2 = succ (succ zero)
    4 = succ (succ (succ (succ zero)))

The definition of addition is also done by induction. We can see this using the interaction.
-/

-- Uncomment the following line. It will print something unreadable, but don't worry.
-- #print nat.add

/-
You can look up the actual definition in two ways: Ctrl-click on `nat.add`, or right-click and select
"Go to Definition". This will open a new tab with a file that belongs to core Lean. It will place you
at the definition of nat.add, which reads as follows

    namespace nat
      protected def add : nat → nat → nat
      | a  zero     := a
      | a  (succ b) := succ (add a b)

    -- .. some more lines
    end nat -- <- this closes the namespac

But this means that `2 + 2` is notation for

    add (succ (succ zero)) (succ (succ zero)) -- which reduces to
    succ (add (succ (succ zero)) (succ zero)) -- which reduces to
    succ (succ (add (succ (succ zero)) zero)) -- which reduces to
    succ (succ (succ (succ zero)))

for which we can use the notation `4`. In other words, our lemma is true by definition, and we can use
reflexivity of equality to prove it:
-/

lemma two_add_two : 2 + 2 = 4 := rfl


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d generalizing x,
  { show (polynomial.bernoulli 0).eval (1 + x) =
    (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from rfl, },
  have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d =
    (d + 1) * (1 + x)^d - d * x^d - x^d, from by rw ← nat.succ_eq_add_one d,
  have h2 : (d + 1) * (1 + x)^d - d * x^d - x^d =
    (d + 1) * (1 + x)^d - d * (x * (1 + x)^(d - 1)) - x^d, from by {rw ← pow_succ},
  have h3 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * (1 + x)^(d - 1) * ((1 + x) - x), from calc
    (d + 1) * (1 + x)^(d - 1) * ((1 + x)^1 - x^1) : by {rw [pow_one,pow_one]}
  ... = _ : by rw pow_add,
  have h4 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * (1 + x + x^2 + ... + x^(d - 1)) * ((1 + x) - x), from by rw pow_one,
  have h5 : (d + 1) * (1 + x)^(d - 1) * ((1 + x) - x) =
    (d + 1) * (x + x^2 + ... + x^(d - 1)) +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h4,
  have h6 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * (x + x^2 + ... + x^(d - 1)) +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h5,
  have h7 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + (d + 1) * (x^2 + ... + x^(d - 1)) +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw pow_one,
  have h8 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + d * x^(d - 1) * x +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw ← mul_add,
  have h9 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + d * x^(d - 1) * x +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h8,
  have h10 : d * x^(d - 1) * x = x * d * x^(d - 1), from by rw mul_comm,
  have h11 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h10,
  have h12 : (d + 1) * ((1 + x)^d - x^d) =
    d * x^(d - 1) * (x + 1) + d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h11,
  have h13 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + d * x^(d - 1) * x +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h10,
  have h14 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    d * x^d + (d + 1) * x^d - d * x^d - x^d, from by rw h13,
  have h15 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    (d + 1) * x^d - d * x^d - x^d, from by rw ← add_sub,
  have h16 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    (d + 1) * x^d - d * x^d - x^d, from by rw h15,
  have h17 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    (d + 1) * x^d - d * x^d - x^d, from by rw h16,
  have h18 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    x^d * (d + 1) - x^d * d - x^d, from by rw ← sub_add,
  have h19 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    x^d * (d + 1) - x^d * d - x^d, from by rw h18,
  have h20 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    x^d * (d + 1) - x^d * d - x^d, from by rw h19,
  have h21 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    d * x^d - x^d, from by rw ← sub_sub,
  have h22 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    d * x^d - x^d, from by rw h21,
  have h23 : (d + 1) * ((1 + x)^d - x^d) =
    (d + 1) * x^(d - 1) + x * d * x^(d - 1) +
    d * x^d - x^d, from by rw h22,
  have h24 : (d + 1) * ((1 + x)^d - x^d) =
    d *
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ (n k : ℕ), (polynomial.bernoulli n).eval x = n * x^(k - 1) →
    (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^k, from
  begin
    assume (n k : ℕ) (h : (polynomial.bernoulli n).eval x = n * x^(k - 1)),
    have h2 : (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^k, from
    begin
      have h1 : (n + 1) * (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * (polynomial.bernoulli (n + 1)).eval x + (n + 1) * (k + 1) * x^k, from
      begin
        have h_one : (polynomial.bernoulli (n + 1)).eval 1 = 1, from begin
          induction (n + 1) with e h_e,
          {rw polynomial.eval_C, refl,},
          {calc (polynomial.bernoulli (e + 1)).eval 1 = (polynomial.bernoulli e).eval (e + 1) + (e + 1) * (polynomial.bernoulli e).eval 0: begin
            rw polynomial.eval_add,
            rw polynomial.eval_mul,
            rw polynomial.eval_X,
            rw polynomial.eval_C,
            rw nat.sub_zero,
            rw polynomial.eval_nat_cast,
            rw polynomial.eval_C,
            rw polynomial.eval_X_nat,
            rw polynomial.eval_zero,
            rw polynomial.eval_one,
            ring,
          end
          ... = (polynomial.bernoulli e).eval (e + 1) + (e + 1) * 0 : begin
            rw polynomial.eval_zero,
            ring,
          end
          ... = (polynomial.bernoulli e).eval (e + 1) : by dcancel_factor (e + 1),
          },
        end,
        rw h_one,
        rw polynomial.eval_X,
        rw polynomial.eval_C,
        rw polynomial.eval_add,
        rw polynomial.eval_mul,
        rw polynomial.eval_X,
        rw polynomial.eval_C,
        rw nat.sub_zero,
        rw polynomial.eval_nat_cast,
        apply calc_line_5,
        calc (polynomial.bernoulli (n + 1)).eval x = (n + 1) * x^k : by rw [h,mul_comm],
        calc (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * (1 + x)^k : by rw [h,mul_comm],
        calc (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * (1 + k * x^k): begin
          rw polynomial.eval_X_nat,
          ring,
        end
        ... = (n + 1) * ((k + 1) * x^k) + (n + 1) * k * x^k : by ring,
        calc (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * ((k + 1) * x^k) : by rw [h,mul_comm],
      end,
      calc (polynomial.bernoulli (n + 1)).eval (1 + x) = (1 / (n + 1)) * ((n + 1) * (polynomial.bernoulli (n + 1)).eval (1 + x)) : by rw [mul_comm,div_mul_cancel (ne.symm (nat.succ_ne_zero (n + 1)))]
      ... = (1 / (n + 1)) * ((n + 1) * (polynomial.bernoulli (n + 1)).eval x + (n + 1) * (k + 1) * x^k) : by rw h1
      ... = (1 / (n + 1)) * ((n + 1) * (polynomial.bernoulli (n + 1)).eval x) + (1 / (n + 1)) * ((n + 1) * (k + 1) * x^k) : by ring
      ... = (1 / (n + 1)) * ((n + 1) * (polynomial.bernoulli (n + 1)).eval x) + (k + 1) * x^k : by rw [mul_comm,div_mul_cancel (ne.symm (nat.succ_ne_zero (n + 1)))]
      ... = (polynomial.bernoulli (n + 1)).eval x + (k + 1) * x^k : by rw [mul_comm,div_mul_cancel (ne.symm (nat.succ_ne_zero (n + 1)))]
    end
    ,
    have h3 : (polynomial.bernoulli (n + 1)).eval x = (n + 1) * x^k, from begin
      have h_two : ∀ x : ℚ, (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * x^k, from begin
        assume x : ℚ,
        rw ← h2,
        rw ← h,
        ring,
      end,
      have h_three : ∀ x : ℚ, (polynomial.bernoulli (n + 1)).eval x = (n + 1) * x^k, from begin
        assume x : ℚ,
        have h_four : (1 : ℚ) + (1 : ℚ) = 2, from by ring,
        rw h_four,
        rw [h_two ((1 : ℚ) + x),add_comm],
        rw ← mul_comm,
        rw ← mul_comm,
        ring,
      end,
      rw h_three x,
    end,
    calc (polynomial.bernoulli (n + 1)).eval x = (n + 1) * x^k : by rw h3
    ... = (n + 1) * x^(k - 1) : by ring,
  end,
  have h2 : ∀ (n k : ℕ), (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * x^k → (n + 1) * x^(k - 1) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^(k - 1), from
  begin
    assume n k (h : (polynomial.bernoulli (n + 1)).eval (1 + x) = (n + 1) * x^k),
    have h2 : (n + 1) * x^(k - 1) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^(k - 1), from
    begin
      have h3 : (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^k, from by rw h,
      have h4 : (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(k - 1), from begin
        have h5 : (polynomial.bernoulli n).eval x = n * x^(k - 1), from begin
          rw ← h,
          rw ← mul_comm,
          ring,
        end,
        rw h1 n (k -
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  { show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(-1), from by
    {rw zero_sub, rw [pow_neg one_ne_zero, mul_zero], ring,},
  },
  { rw polynomial.bernoulli, rw eval_add, rw eval_mul,
    have hthm : d + 1 = (d : ℤ) + (1:ℤ), from by {ring},
    have hthm2 : polynomial.C (1 : ℤ) = 1, from by {refl},
    rw [hthm,hthm2,eval_pow],
    have hthm3 : (d : ℤ) + (1:ℤ) = (d + 1 : ℕ), from by {ring},
    rw [mul_add, mul_one, ← hthm3],
    rw ← polynomial.eval_apply_eq, rw ← polynomial.eval_apply_eq, rw ← polynomial.eval_apply_eq,
    rw ← map_pow,
    have hthm4 : (d : ℤ) = (d : ℕ), from by {refl},
    rw hthm4,
    have hthm5 : (1:ℤ) = (1 : ℕ), from by {refl},
    rw hthm5,
    rw eval_apply, ring,
    rw sub_zero, ring,
    rw hd,
    rw eval_apply, ring,
    rw sub_zero, ring,
    rw pow_one, ring,
    rw sub_zero, ring,
  },
end

--OUTPUT 4
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n using nat.strong_induction_on,
  case nat.zero {rw polynomial.eval_zero,rw polynomial.eval_zero, ring},
  case nat.succ : n hn {
    have h1 : (n : polynomial ℚ) * C x ^ n = n * C x ^ n, from by {unfold polynomial.C, ring,},
    have h2 : ((n : polynomial ℚ) + 1) * C x^n = (n + 1) * C x^n, from by {unfold polynomial.C, ring,},
    have h3 : (C 1 + C x)^n = C 1 ^ n + n * (C 1)^{n-1} * C x, from by {rw power_succ, unfold polynomial.C, ring,},
    have h4 : (C x)^n = C x ^ n, from by {unfold polynomial.C, ring},
    have h5 : (C x)^n * (n + 1) = (n + 1) * C x ^ n, from by {unfold polynomial.C, ring,},
    rw bernoulli,
    rw [← h1,← h2,← h3,← h4,← h5,← h1],
    rw polynomial.eval_add,
    rw polynomial.eval_pow,
    rw polynomial.eval_pow,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_pow,
    rw polynomial.eval_pow,
    rw polynomial.eval_C,
    conv {to_lhs, rw polynomial.eval_C},
    rw show n * x ^ n + n * x ^ n = n * (1 + x) ^ n, by ring,
    rw polynomial.eval_add,
    rw polynomial.eval_pow,
    rw polynomial.eval_pow,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    rw polynomial.eval_pow,
    rw polynomial.eval_pow,
    rw polynomial.eval_C,
    rw polynomial.eval_C,
    conv {to_lhs, rw polynomial.eval_C},
    ring,
  },
end

--OUTPUT 5
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d ih,
  {simp only [polynomial.bernoulli_zero,polynomial.eval_zero], rw one_add, ring},
  {rw polynomial.bernoulli_succ,
  rw polynomial.eval_add,
  rw polynomial.eval_mul,
  rw polynomial.eval_mul,
  rw ← polynomial.eval_X_pow,
  rw ← polynomial.eval_X_pow,
  rw ih,
  rw polynomial.eval_X_pow,
  ring}
end

--OUTPUT 6
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  apply nat.strong_induction_on n,
  { assume n,
    assume h1 : ∀ m : ℕ, m < n →
      (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),
    assume h2 : (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1),
    show (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x ^ ((n + 1) - 1), from
      by {
      have h3 : (n + 1) * (1 + x) ^ (n + 1) - (n + 1) * x ^ (n + 1) =
        ∑ k in range (n + 1), (n + 1) * (polynomial.bernoulli k).eval x*x^(n - k), from
          by {
            have h4 : (n + 1) * (1 + x) ^ n * (1 + x) = (n + 1) * x ^ n * (1 + x) +
              (n + 1) * (1 + x) ^ (n-1) * x, from by {
              rw [add_mul, pow_succ, mul_assoc],
              rw [add_mul, add_mul],
              rw ← add_assoc,
              apply add_comm},
            rw [pow_succ, h2],
            rw [add_mul, h4],
            rw add_assoc,
            ring,
          },
      have h5 : (n + 1) * (1 + x) ^ n * (1 + x) - (n + 1) * x ^ (n + 1) =
        ∑ k in range n, (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n - k) + n * x ^ n, from
          by {
            rw [range_succ, h3],
            ring,
            },
      have h6 : (n + 1) * (1 + x) ^ n * (1 + x) - (n + 1) * x ^ (n + 1) =
        ∑ k in range (n + 1), (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n - k), from
          by {
            rw [range_succ, h5],
            rw [← range_succ],
            ring,
            },
      have h7 : (n + 1) * (1 + x) ^ n * (1 + x) - (n + 1) * x ^ (n + 1) =
        ∑ k in range (n + 1), (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k), from
          by {
            congr,
            rw [range_succ],
          },
      have h8 : ∀ k : ℕ, k ≤ n → ∑ (i : ℕ) in range (n + 1),
        (n + 1) * (polynomial.bernoulli i).eval x * x ^ (n + 1 - i) =
        (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k), from assume (k : ℕ) (hk : k ≤ n),
        begin
          rw [mem_range, mem_range],
          rw [nat.succ_le_iff', hk],
          rw [polynomial.bernoulli_zero_of_gt, polynomial.bernoulli_zero_of_gt],
          ring,
        end,
      have h9 : ∀ k : ℕ, k ≤ n → (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k) =
        n * (polynomial.bernoulli k).eval x * x ^ (n - k), from assume (k : ℕ) (hk : k ≤ n),
        begin
          rw [mul_comm, nat.mul_div_cancel_left],
          simp,
        end,
      have h10 : ∀ k : ℕ, k ≤ n → (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k) =
        n * (polynomial.bernoulli k).eval x * x ^ (n - k) + (polynomial.bernoulli k).eval x * x ^ (n - k), from assume (k : ℕ) (hk : k ≤ n),
        begin
          rw h9 k hk,
          ring,
        end,
      have h11 : ∀ k : ℕ, k ≤ n → (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k) =
        (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n - k) + (polynomial.bernoulli k).eval x * x ^ (n - k), from assume (k : ℕ) (hk : k ≤ n),
        begin
          rw h8 k hk,
          ring,
        end,
      have h12 : ∀ k : ℕ, k ≤ n → (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k) =
        (n + 1) * (polynomial.bernoulli k).eval x * x ^ (n + 1 - k) + (polynomial.bernoulli k).eval x * x ^ (n - k), from assume (k : ℕ) (hk : k ≤ n),
        begin
          rw [← nat.sub_sub, nat.sub_sub],
          rw h11 k hk,
          simp,
        end,
      have h13 : (n + 1) * (1 + x) ^ n * (1 + x) - (n + 1) * x ^ (n + 1) = (n + 1) * (1 + x) ^ n * (1 + x) -
        (n + 1) * (1 + x) ^ n * x, from by ring,
      have h14 : (n + 1) * (1 + x) ^ n * (1 + x) - (n + 1) * x ^ (n + 1) = (n + 1) * (1 + x) ^ n * (1 + x - x), from
        by {
          rw h13,
          ring,
          },
      have h15 : (n + 1) * (1 + x) ^ n * (1 + x - x) = (n + 1) * (1 + x) ^ n * 0, from by {simp},
      have h16 : (n + 1) * (1 + x) ^ n * 0 = (n + 1) * (1 + x) ^ (n - 1) * x, from by rw pow_succ,
      have h17 : (n + 1) * (1 + x) ^ (n - 1) * x = (n + 1) * (polynomial.bernoulli n).eval x * x ^ (n - 1), from
        by {
          rw ← polynomial.eval_hom_C n _,
          rw polynomial.eval_C,
          ring,
          },
      have h18 : (n + 1) * (polynomial.bernoulli n).eval x * x ^ (n - 1) = (polynomial.bernoulli n).eval x * x ^ (n - 1), from
        by {
          rw mul_one,
          },
      have h19 : (n + 1) * (1 + x) ^ n * (1 + x) - (n + 1) * x ^ (n + 1) = (polynomial.bernoulli n).eval x * x ^ (n - 1), from
        by {
          rw [h15, h
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  by_cases h : n = 0,
  {
    rw [h, polynomial.bernoulli, eval_C, eval_add],
    {
      rw eval_C,
      simp,
    },
    {
      simp,
    }
  },
  {
    sorry,
  },
end

--OUTPUT 8
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  revert n, apply nat.strong_induction_on,
  assume (d : ℕ) (hyp : ∀ (n : ℕ), n < d → (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1)),
  have h1 : ∀ (l : ℕ), (l + 1) * (1 + x)^l = ∑ k : ℕ, (l + 1) * ((l + 1) choose k) * x^k, from
    assume (l : ℕ), by rw [mul_one,←mul_one,←@binomial_expansion l (1 + x) ((l+1 : ℚ))],

  have h2 : ∀ (l : ℕ), (l + 1) * (1 + x)^l - (l + 1) * x^l = ∑ k : ℕ, (l + 1) * ((l + 1) choose k) * (x^k - x^(k-1)), from
    assume (l : ℕ), by {simp,rw ←@mul_sub ℚ l ((l+1:ℚ)) x x, ring,},

  have h3 : ∀ (l : ℕ), (l + 1) * (1 + x)^l - (l + 1) * x^l = ∑ k : ℕ, (l + 1) * ((l + 1) choose k) * (k * x^(k - 1)), from
    assume (l : ℕ), by {rw ←@eq_Sum_bij (ℕ) (λ k : ℕ, ↑k * x^(k - 1)) (λ k : ℕ, x^k - x^(k-1)) (λ k, k * (x^k - x^(k-1)))
    _ _ _ _ _, simp, simp,},

  have h4 : ∀ (l : ℕ), (l + 1) * (1 + x)^l - (l + 1) * x^l = ∑ k : ℕ, (l + 1) * ((l + 1) choose k) * (k * x^(k - 1)) - 0, from
    assume (l : ℕ), by simp [h3],

  have h5 : ∀ (l : ℕ), (l + 1) * (1 + x)^l - (l + 1) * x^l = ∑ k : ℕ, (l + 1) * (bernoulli k) * x^(k - 1), from
    assume (l : ℕ), by {rw ←@eq_Sum_bij (ℕ) (λ k : ℕ, (l + 1) * bernoulli k * x^(k - 1)) (λ k : ℕ, (l + 1) * ((l + 1) choose k) * (k * x^(k - 1)))
    (λ k, (l + 1) * k * (bernoulli k * x^(k-1))) _ _ _ _ _, simp, simp,},

  have h6 : (1 : ℚ) = ∑ k : ℕ, bernoulli k * x^(k - 1), from
    by {rw ←@eq_Sum_bij (ℕ) (λ k : ℕ, bernoulli k * x^(k - 1)) (λ k : ℕ, 1 * (k * x^(k - 1)))
    (λ k, 1 * k * (bernoulli k * x^(k-1))) _ _ _ _ _, simp, simp,},

  have h7 : (d + 1) * (1 + x)^d - (d + 1) * x^d = ∑ k : ℕ, (d + 1) * bernoulli k * x^(k - 1), from
    by {rw h5 d},

  have h8 : (d + 1) * (1 + x)^d - (d + 1) * x^d = ∑ k : ℕ, (d + 1) * d * bernoulli k * x^(k - 1), from
    by {rw ←@eq_Sum_bij (ℕ) (λ k : ℕ, (d + 1) * d * bernoulli k * x^(k - 1)) (λ k : ℕ, (d + 1) * bernoulli k * x^(k - 1))
    (λ k, (d + 1) * (d * bernoulli k * x^(k-1))) _ _ _ _ _, simp, simp,},

  have h9 : (d + 1) * x^d = ∑ k : ℕ, (d + 1) * k * bernoulli k * x^(k - 1), from
    by {rw ←@eq_Sum_bij (ℕ) (λ k : ℕ, (d + 1) * k * bernoulli k * x^(k - 1)) (λ k : ℕ, (d + 1) * d * bernoulli k * x^(k - 1))
    (λ k, (d + 1) * (k * bernoulli k * x^(k-1))) _ _ _ _ _, simp, simp,},

  have h10 : (d + 1) * x^d = (d + 1) * ∑ k : ℕ, k * bernoulli k * x^(k - 1), from
    by {rw ←@eq_Sum_bij (ℕ) ((λ k : ℕ, (d + 1) * k * bernoulli k * x^(k - 1))) (λ k : ℕ, k * bernoulli k * x^(k - 1))
    (λ k, (d + 1) * (k * bernoulli k * x^(k-1))) _ _ _ _ _, simp, simp,},

  have h11 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * ∑ k : ℕ, (d - k) * bernoulli k * x^(k - 1), from
    by {rw h8 at h7, rw h9 at h7, rw h10 at h7, simp [h7],},

  have h12 : ∀ (k : ℕ), (d + 1) * (d - k) * bernoulli k * x^(k - 1) = (k + 1) * bernoulli(k + 1) * x^k, from
    by {intro k, calc
        (d + 1) * (d - k) * bernoulli k * x^(k - 1) = (d + 1) * (d - k) * ((bernoulli k) * x^(k - 1)) : by {rw mul_assoc,}
        ... = (d + 1) * ((d - k) * ((bernoulli k) * x^(k - 1))) : by {rw mul_assoc,}
        ... = (d + 1) * ((d - k) * ((bernoulli (k + 1)) * x^k)) : by {rw bernoulli_add_one_mul,}
        ... = (d + 1) * (d - k) * (bernoulli (k + 1)) * x^k : by {rw mul_assoc,}
        ... = (k + 1) * bernoulli(k + 1) * x^k : by {rw dif_pos (nat.succ_pos k),ring,},},

  have h13 : ((d + 1) * (1 + x)^d - (d + 1) * x^d) / (k + 1) = bernoulli(k + 1) * x^k, from
    by {rw ←@eq_Sum_bij (ℕ) (λ k : ℕ, ((d + 1) * (1 + x)^d - (d + 1) * x^d) / (k + 1)) (λ k
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ (x : ℝ), (polynomial.bernoulli n).eval x = 0, from
    assume r : ℝ, by {rw polynomial.bernoulli, rw ← polynomial.eval_sum, show (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (r : ℚ) ^ k) = 0,
      from funext (λ k : ℕ,  by {
        have h2 : (r : ℚ) ^ k = 0, from by {rw_mod_cast polynomial.eval_monomial,exact nat.mod_cast _},
        have h3 : polynomial.C (↑(ber n k)) = 0, from by rw polynomial.C_zero,
        rw [h2,h3], }),
      show ∑ k, (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (r : ℚ) ^ k) k = 0, from eq.trans (sum_const_zero (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (r : ℚ) ^ k))
        (eq.symm (by apply_fun (sum_zero_indexed ℕ) (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (r : ℚ) ^ k) ((polynomial.C (↑(ber n k)) : ℚ) * (r : ℚ) ^ k))),
     },
  have h2 : ∀ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k = ((polynomial.C (↑(ber n k)) : ℚ) * (1 : ℚ)) + ((polynomial.C (↑(ber n k)) : ℚ) * x ^ k), from
    assume k : ℕ, by rw_mod_cast polynomial.eval_monomial,
  have h3 : ∀ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) = 0, from
    assume k : ℕ, by {rw polynomial.C_zero},
  have h4 : ∀ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 : ℚ) = 0, from
    assume k : ℕ, by {rw [h3 k],},
  have h5 : ∀ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * x ^ k = 0, from
    assume k : ℕ, by {rw [h3 k],},
  have h6 : ∀ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k = 0, from
    assume k : ℕ, by {rw [h4 k,h5 k,zero_add],},
  have h7 : polynomial.bernoulli n = 0, from by {rw [← polynomial.eval_eq_zero h1,← polynomial.eval_sum],
    have h8 : ∑ k, (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k) k = 0, from
      eq.trans (sum_const_zero (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k)) (eq.symm (by apply_fun (sum_zero_indexed ℕ) (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k) ((polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k))),
    show ∑ k, (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k) k = 0, from eq.trans h8 (sum_zero_indexed_of_const_zero (λ (k : ℕ), (polynomial.C (↑(ber n k)) : ℚ) * (1 + x) ^ k) h6), },
  have h8 : (polynomial.bernoulli n).eval (1 + x) = 0, from by {rw h7,},
  induction n with d hd,
  {have h9 : (polynomial.bernoulli 0).eval (1 + x) = 1, from by {rw polynomial.bernoulli,rw_mod_cast polynomial.eval_monomial,rw polynomial.C_one,ring},
    rw h9, rw polynomial.bernoulli, rw_mod_cast polynomial.eval_monomial, rw polynomial.C_one, rw zero_mul, ring, },
  {have h10 : (polynomial.bernoulli d).eval (1 + x) = 0, from by {rw polynomial.bernoulli,rw_mod_cast polynomial.eval_sum,
    have h11 : ∑ k, (λ (k : ℕ), (polynomial.C (↑(ber d k)) : ℚ) * ((1 + x) : ℚ) ^ k) k = 0, from by {
      have h12 : ∑ k, (λ (k : ℕ), (polynomial.C (↑(ber d k)) : ℚ) * (1 : ℚ)) k = 0, from by {rw [polynomial.C_sum,polynomial.C_sum],rw_mod_cast polynomial.eval_monomial,
      rw_mod_cast polynomial.eval_monomial,rw_mod_cast polynomial.eval_sum,
      have h13 : ∑ k, (λ (k : ℕ), ((↑(ber d k) : ℚ) * (1 : ℚ)) : ℚ) k = (↑(1 : ℤ) : ℚ), from by {
        have h14 : ∑ k, (λ (k : ℕ), (↑(1 : ℤ) : ℚ)) k = (↑(1 : ℤ) : ℚ), from by {rw [sum_const_one ℕ (λ (k : ℕ), (↑(1 : ℤ) : ℚ))],},
        have h15 : ∑ k, (λ (k : ℕ), (↑(ber d k) : ℚ) * (1 : ℚ)) k = (↑(1 : ℤ) : ℚ), from by {rw_mod_cast polynomial.eval_monomial,rw nat.mod_cast,},
        have h16 : (↑(1 : ℤ) : ℚ) = (↑(1 : ℤ) : ℚ) * (1 : ℚ), from by {rw one_mul,},
        show ∑ k, (λ (k : ℕ), (↑(ber d k) : ℚ) * (1 : ℚ)) k = (↑(1 : ℤ) : ℚ), from eq.trans h15 (by rw h16), },
        show (polynomial.C 1 * x ^ d).eval 1 = 0, from by {rw_mod_cast polynomial.eval_monomial,rw_mod_cast polynomial.eval_monomial,
          have h15 : (1 : ℚ) ^ d = 1, from by {rw_mod_cast polynomial.eval_monomial,rw_mod_cast polynomial.eval_monomial},
        show (1 * 1) = 0, from by {rw [h15,one_mul],},},
      have h14 : ((d + 1) : ℚ) = (↑(d + 1) : ℚ), from by {rw_mod_cast
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h0 : ∀ d : ℕ, (∀ m : ℕ, m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1)) → (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d-1), from
    nat.strong_induction_on n (
      assume (d : ℕ) (hind : ∀ m : ℕ, m < d → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1)),
      show (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d-1), from
        begin
          show ((d + 1) * (1 + x)^d - (d + 1) * x^d) = (sum (λ (l : ℕ), ({d + 1} choose l) * l * x^l)) - {d + 1} * (1 + x)^d, from by ring,
          have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d = sum (λ (l : ℕ), ({d + 1} choose l) * (polynomial.bernoulli l).eval x), from by ring,
          have h2 : (sum (λ (l : ℕ), ({d + 1} choose l) * l * x^l)) - {d + 1} * (1 + x)^d = sum (λ (l : ℕ), ({d + 1} choose l) * (polynomial.bernoulli l).eval x), from by ring,
          have h3 : sum (λ (l : ℕ), ({d + 1} choose l) * l * x^l) = sum (λ (l : ℕ), ({d + 1} choose l) * (l * x^(l - 1))), from by ring,
          have h4 : ({d + 1} choose d) * d * x^(d - 1) = ({d + 1} choose d) * (d * x^(d - 1)), from by ring,
          rw [h2,h1] at hind,
          have h5 : ∀ l : ℕ, (({d + 1} choose l) * l * x^(l - 1)) = ({d + 1} choose l) * (polynomial.bernoulli l).eval x + (({d + 1} choose l) * l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x, from by ring,
          have h6 : ∀ l : ℕ, l ≠ 0 → l < d → ({d + 1} choose l) * (polynomial.bernoulli l).eval x + (({d + 1} choose l) * l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x = ({d + 1} choose l) * (polynomial.bernoulli l).eval x + (({d + 1} choose l) * l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x, from
            by {
              assume (l : ℕ) (h6 : (l ≠ 0) → l < d) (h7 : l < d),
              have h8 : ({d + 1} choose l) * (polynomial.bernoulli l).eval x + (({d + 1} choose l) * l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x = ({d + 1} choose l) * ((polynomial.bernoulli l).eval x + l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x, from by ring,
              have h9 : ({d + 1} choose l) * (polynomial.bernoulli l).eval x + (({d + 1} choose l) * l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x = ({d + 1} choose l) * (polynomial.bernoulli l).eval (1 + x) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x, from by {rw [h8,←hind h7], ring},
              have h10 : ({d + 1} choose l) * (polynomial.bernoulli l).eval x + (({d + 1} choose l) * l * x^(l - 1)) - ({d + 1} choose l) * (polynomial.bernoulli l).eval x = ({d + 1} choose l) * (polynomial.bernoulli l).eval x, from by {rw h9, ring},
              rw h10,
              exact h6 l h7,
            },
          rw [←h3,h5,h4],
          have h7 : {d + 1} choose (d + 1) = 1, from by ring,
          have h8 : ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x + ({d + 1} choose (d + 1)) * (d + 1) * x^d - ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x = ({d + 1} choose (d + 1)) * ((polynomial.bernoulli (d + 1)).eval x + (d + 1) * x^d), from by ring,
          have h9 : ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x + ({d + 1} choose (d + 1)) * (d + 1) * x^d - ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x = ((d + 1) * ((1 + x)^d + x^d)), from by {rw [h8,←h7], ring},
          have h10 : ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x + ({d + 1} choose (d + 1)) * (d + 1) * x^d - ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x = (d + 1) * ((1 + x)^d - x^d), from by {rw h9, ring},
          have h11 : ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x + (({d + 1} choose (d + 1)) * (d + 1) * x^d) - ({d + 1} choose (d + 1)) * (polynomial.bernoulli (d + 1)).eval x = (d + 1) * x^(d - 1), from by {rw h10, ring},
          have h12 : {d + 1} choose (d + 1) = (d + 1), from by ring,
          rw [h12,h11],
        }
    ),

  have h1 : ∀ l : ℕ, (1 + x)^l = ((x + 1)^l), from by obviously,
  have h2 : (1+x)^(n-1) = x^(n-1) + (n-1)*x^(n-2) + (n-1) * (1+x)^(n-2), from by rw [sum_range,sum_range]; assumption, simp,
  have h3 : (polynomial.bernoulli n).eval (1+x) = n * (1 + x)^(n-1) + n * (1 + x)^(n-1), from by ring,
  have h5 : (polynomial.bernoulli n).eval (1+x) = (polynomial.bernoulli n).eval
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import algebra.module.linear_map
import linear_algebra.basic
import data.real.basic

theorem cpge_applin_8_a
(R : Type*) (E : Type*) (F : Type*)
[field R]
[add_comm_group E] [module R E]
(u : linear_map R E E) (F : submodule R E):

u ⁻¹' (u '' F) = F + u.ker

:= sorry


import algebra.module.basic
import algebra.module.linear_map
import linear_algebra.basic
import linear_algebra.prod
import linear_algebra.projection
import order.bounded_lattice

theorem cpge_reduction_3_a (R : Type*) (M : Type*)
[semiring R] [add_comm_monoid M] [module R M]
[E : submodule R M] (u : linear_map R E E)  (v : linear_map R E E) :

(u.comp v) = (v.comp u) -> v '' u.ker ⊂ u.ker ∧ u '' v.ker ⊂ v.ker := sorry