/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Bryan Gin-ge Chen, Yaël Dillies
Ported by: Frédéric Dupuis

! This file was ported from Lean 3 source module order.symm_diff
! leanprover-community/mathlib commit 6eb334bd8f3433d5b08ba156b8ec3e6af47e1904
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.BooleanAlgebra
import Mathlib.Logic.Equiv.Basic

/-!
# Symmetric difference and bi-implication

This file defines the symmetric difference and bi-implication operators in (co-)Heyting algebras.

## Examples

Some examples are
* The symmetric difference of two sets is the set of elements that are in either but not both.
* The symmetric difference on propositions is `Xor'`.
* The symmetric difference on `Bool` is `Bool.xor`.
* The equivalence of propositions. Two propositions are equivalent if they imply each other.
* The symmetric difference translates to addition when considering a Boolean algebra as a Boolean
  ring.

## Main declarations

* `symmDiff`: The symmetric difference operator, defined as `(a \ b) ⊔ (b \ a)`
* `bihimp`: The bi-implication operator, defined as `(b ⇨ a) ⊓ (a ⇨ b)`

In generalized Boolean algebras, the symmetric difference operator is:

* `symmDiff_comm`: commutative, and
* `symmDiff_assoc`: associative.

## Notations

* `a ∆ b`: `symmDiff a b`
* `a ⇔ b`: `bihimp a b`

## References

The proof of associativity follows the note "Associativity of the Symmetric Difference of Sets: A
Proof from the Book" by John McCuan:

* <https://people.math.gatech.edu/~mccuan/courses/4317/symmetricdifference.pdf>

## Tags

boolean ring, generalized boolean algebra, boolean algebra, symmetric difference, bi-implication,
Heyting
-/

open Function OrderDual

variable {ι α β : Type _} {π : ι → Type _}

/-- The symmetric difference operator on a type with `⊔` and `\` is `(A \ B) ⊔ (B \ A)`. -/
def symmDiff [Sup α] [SDiff α] (a b : α) : α :=
  a \ b ⊔ b \ a
#align symm_diff symmDiff

/-- The Heyting bi-implication is `(b ⇨ a) ⊓ (a ⇨ b)`. This generalizes equivalence of
propositions. -/
def bihimp [Inf α] [HImp α] (a b : α) : α :=
  (b ⇨ a) ⊓ (a ⇨ b)
#align bihimp bihimp

/- This notation might conflict with the Laplacian once we have it. Feel free to put it in locale
  `order` or `symm_diff` if that happens. -/
/-- Notation for symmDiff -/
infixl:100 " ∆ " =>  symmDiff

/-- Notation for bihimp -/
infixl:100 " ⇔ " => bihimp

theorem symmDiff_def [Sup α] [SDiff α] (a b : α) : a ∆ b = a \ b ⊔ b \ a :=
  rfl
#align symm_diff_def symmDiff_def

theorem bihimp_def [Inf α] [HImp α] (a b : α) : a ⇔ b = (b ⇨ a) ⊓ (a ⇨ b) :=
  rfl
#align bihimp_def bihimp_def

theorem symmDiff_eq_Xor' (p q : Prop) : p ∆ q = Xor' p q :=
  rfl
#align symm_diff_eq_xor symmDiff_eq_Xor'

@[simp]
theorem bihimp_iff_iff {p q : Prop} : p ⇔ q ↔ (p ↔ q) :=
  (iff_iff_implies_and_implies _ _).symm.trans Iff.comm
#align bihimp_iff_iff bihimp_iff_iff

@[simp]
theorem Bool.symmDiff_eq_xor : ∀ p q : Bool, p ∆ q = xor p q := by decide
#align bool.symm_diff_eq_bxor Bool.symmDiff_eq_xor

section GeneralizedCoheytingAlgebra

variable [GeneralizedCoheytingAlgebra α] (a b c d : α)

@[simp]
theorem toDual_symmDiff : toDual (a ∆ b) = toDual a ⇔ toDual b :=
  rfl
#align to_dual_symm_diff toDual_symmDiff

@[simp]
theorem ofDual_bihimp (a b : αᵒᵈ) : ofDual (a ⇔ b) = ofDual a ∆ ofDual b :=
  rfl
#align of_dual_bihimp ofDual_bihimp

theorem symmDiff_comm : a ∆ b = b ∆ a := by simp only [symmDiff, sup_comm]
#align symm_diff_comm symmDiff_comm

instance symmDiff_isCommutative : IsCommutative α (· ∆ ·) :=
  ⟨symmDiff_comm⟩
#align symm_diff_is_comm symmDiff_isCommutative

@[simp]
theorem symmDiff_self : a ∆ a = ⊥ := by rw [symmDiff, sup_idem, sdiff_self]
#align symm_diff_self symmDiff_self

@[simp]
theorem symmDiff_bot : a ∆ ⊥ = a := by rw [symmDiff, sdiff_bot, bot_sdiff, sup_bot_eq]
#align symm_diff_bot symmDiff_bot

@[simp]
theorem bot_symmDiff : ⊥ ∆ a = a := by rw [symmDiff_comm, symmDiff_bot]
#align bot_symm_diff bot_symmDiff

@[simp]
theorem symmDiff_eq_bot {a b : α} : a ∆ b = ⊥ ↔ a = b := by
  simp_rw [symmDiff, sup_eq_bot_iff, sdiff_eq_bot_iff, le_antisymm_iff]
#align symm_diff_eq_bot symmDiff_eq_bot

theorem symmDiff_of_le {a b : α} (h : a ≤ b) : a ∆ b = b \ a := by
  rw [symmDiff, sdiff_eq_bot_iff.2 h, bot_sup_eq]
#align symm_diff_of_le symmDiff_of_le

theorem symmDiff_of_ge {a b : α} (h : b ≤ a) : a ∆ b = a \ b := by
  rw [symmDiff, sdiff_eq_bot_iff.2 h, sup_bot_eq]
#align symm_diff_of_ge symmDiff_of_ge

theorem symmDiff_le {a b c : α} (ha : a ≤ b ⊔ c) (hb : b ≤ a ⊔ c) : a ∆ b ≤ c :=
  sup_le (sdiff_le_iff.2 ha) <| sdiff_le_iff.2 hb
#align symm_diff_le symmDiff_le

theorem symmDiff_le_iff {a b c : α} : a ∆ b ≤ c ↔ a ≤ b ⊔ c ∧ b ≤ a ⊔ c := by
  simp_rw [symmDiff, sup_le_iff, sdiff_le_iff]
#align symm_diff_le_iff symmDiff_le_iff

@[simp]
theorem symmDiff_le_sup {a b : α} : a ∆ b ≤ a ⊔ b :=
  sup_le_sup sdiff_le sdiff_le
#align symm_diff_le_sup symmDiff_le_sup

theorem symmDiff_eq_sup_sdiff_inf : a ∆ b = (a ⊔ b) \ (a ⊓ b) := by simp [sup_sdiff, symmDiff]
#align symm_diff_eq_sup_sdiff_inf symmDiff_eq_sup_sdiff_inf

theorem Disjoint.symmDiff_eq_sup {a b : α} (h : Disjoint a b) : a ∆ b = a ⊔ b := by
  rw [symmDiff, h.sdiff_eq_left, h.sdiff_eq_right]
#align disjoint.symm_diff_eq_sup Disjoint.symmDiff_eq_sup

theorem symmDiff_sdiff : a ∆ b \ c = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) := by
  rw [symmDiff, sup_sdiff_distrib, sdiff_sdiff_left, sdiff_sdiff_left]
#align symm_diff_sdiff symmDiff_sdiff

@[simp]
theorem symmDiff_sdiff_inf : a ∆ b \ (a ⊓ b) = a ∆ b := by
  rw [symmDiff_sdiff]
  simp [symmDiff]
#align symm_diff_sdiff_inf symmDiff_sdiff_inf

@[simp]
theorem symmDiff_sdiff_eq_sup : a ∆ (b \ a) = a ⊔ b := by
  rw [symmDiff, sdiff_idem]
  exact
    le_antisymm (sup_le_sup sdiff_le sdiff_le)
      (sup_le le_sdiff_sup <| le_sdiff_sup.trans <| sup_le le_sup_right le_sdiff_sup)
#align symm_diff_sdiff_eq_sup symmDiff_sdiff_eq_sup

@[simp]
theorem sdiff_symmDiff_eq_sup : (a \ b) ∆ b = a ⊔ b := by
  rw [symmDiff_comm, symmDiff_sdiff_eq_sup, sup_comm]
#align sdiff_symm_diff_eq_sup sdiff_symmDiff_eq_sup

@[simp]
theorem symmDiff_sup_inf : a ∆ b ⊔ a ⊓ b = a ⊔ b := by
  refine' le_antisymm (sup_le symmDiff_le_sup inf_le_sup) _
  rw [sup_inf_left, symmDiff]
  refine' sup_le (le_inf le_sup_right _) (le_inf _ le_sup_right)
  · rw [sup_right_comm]
    exact le_sup_of_le_left le_sdiff_sup
  · rw [sup_assoc]
    exact le_sup_of_le_right le_sdiff_sup
#align symm_diff_sup_inf symmDiff_sup_inf

@[simp]
theorem inf_sup_symmDiff : a ⊓ b ⊔ a ∆ b = a ⊔ b := by rw [sup_comm, symmDiff_sup_inf]
#align inf_sup_symm_diff inf_sup_symmDiff

@[simp]
theorem symmDiff_symmDiff_inf : a ∆ b ∆ (a ⊓ b) = a ⊔ b := by
  rw [← symmDiff_sdiff_inf a, sdiff_symmDiff_eq_sup, symmDiff_sup_inf]
#align symm_diff_symm_diff_inf symmDiff_symmDiff_inf

@[simp]
theorem inf_symmDiff_symmDiff : (a ⊓ b) ∆ (a ∆ b) = a ⊔ b := by
  rw [symmDiff_comm, symmDiff_symmDiff_inf]
#align inf_symm_diff_symm_diff inf_symmDiff_symmDiff

theorem symmDiff_triangle : a ∆ c ≤ a ∆ b ⊔ b ∆ c := by
  refine' (sup_le_sup (sdiff_triangle a b c) <| sdiff_triangle _ b _).trans_eq _
  rw [@sup_comm _ _ (c \ b), sup_sup_sup_comm, symmDiff, symmDiff]
#align symm_diff_triangle symmDiff_triangle

end GeneralizedCoheytingAlgebra

section GeneralizedHeytingAlgebra

variable [GeneralizedHeytingAlgebra α] (a b c d : α)

@[simp]
theorem toDual_bihimp : toDual (a ⇔ b) = toDual a ∆ toDual b :=
  rfl
#align to_dual_bihimp toDual_bihimp

@[simp]
theorem ofDual_symmDiff (a b : αᵒᵈ) : ofDual (a ∆ b) = ofDual a ⇔ ofDual b :=
  rfl
#align of_dual_symm_diff ofDual_symmDiff

theorem bihimp_comm : a ⇔ b = b ⇔ a := by simp only [(· ⇔ ·), inf_comm]
#align bihimp_comm bihimp_comm

instance bihimp_isCommutative : IsCommutative α (· ⇔ ·) :=
  ⟨bihimp_comm⟩
#align bihimp_is_comm bihimp_isCommutative

@[simp]
theorem bihimp_self : a ⇔ a = ⊤ := by rw [bihimp, inf_idem, himp_self]
#align bihimp_self bihimp_self

@[simp]
theorem bihimp_top : a ⇔ ⊤ = a := by rw [bihimp, himp_top, top_himp, inf_top_eq]
#align bihimp_top bihimp_top

@[simp]
theorem top_bihimp : ⊤ ⇔ a = a := by rw [bihimp_comm, bihimp_top]
#align top_bihimp top_bihimp

@[simp]
theorem bihimp_eq_top {a b : α} : a ⇔ b = ⊤ ↔ a = b :=
  @symmDiff_eq_bot αᵒᵈ _ _ _
#align bihimp_eq_top bihimp_eq_top

theorem bihimp_of_le {a b : α} (h : a ≤ b) : a ⇔ b = b ⇨ a := by
  rw [bihimp, himp_eq_top_iff.2 h, inf_top_eq]
#align bihimp_of_le bihimp_of_le

theorem bihimp_of_ge {a b : α} (h : b ≤ a) : a ⇔ b = a ⇨ b := by
  rw [bihimp, himp_eq_top_iff.2 h, top_inf_eq]
#align bihimp_of_ge bihimp_of_ge

theorem le_bihimp {a b c : α} (hb : a ⊓ b ≤ c) (hc : a ⊓ c ≤ b) : a ≤ b ⇔ c :=
  le_inf (le_himp_iff.2 hc) <| le_himp_iff.2 hb
#align le_bihimp le_bihimp

theorem le_bihimp_iff {a b c : α} : a ≤ b ⇔ c ↔ a ⊓ b ≤ c ∧ a ⊓ c ≤ b := by
  simp_rw [bihimp, le_inf_iff, le_himp_iff, and_comm]
#align le_bihimp_iff le_bihimp_iff

@[simp]
theorem inf_le_bihimp {a b : α} : a ⊓ b ≤ a ⇔ b :=
  inf_le_inf le_himp le_himp
#align inf_le_bihimp inf_le_bihimp

theorem bihimp_eq_inf_himp_inf : a ⇔ b = a ⊔ b ⇨ a ⊓ b := by simp [himp_inf_distrib, bihimp]
#align bihimp_eq_inf_himp_inf bihimp_eq_inf_himp_inf

theorem Codisjoint.bihimp_eq_inf {a b : α} (h : Codisjoint a b) : a ⇔ b = a ⊓ b := by
  rw [bihimp, h.himp_eq_left, h.himp_eq_right]
#align codisjoint.bihimp_eq_inf Codisjoint.bihimp_eq_inf

theorem himp_bihimp : a ⇨ b ⇔ c = (a ⊓ c ⇨ b) ⊓ (a ⊓ b ⇨ c) := by
  rw [bihimp, himp_inf_distrib, himp_himp, himp_himp]
#align himp_bihimp himp_bihimp

@[simp]
theorem sup_himp_bihimp : a ⊔ b ⇨ a ⇔ b = a ⇔ b := by
  rw [himp_bihimp]
  simp [bihimp]
#align sup_himp_bihimp sup_himp_bihimp

@[simp]
theorem bihimp_himp_eq_inf : a ⇔ (a ⇨ b) = a ⊓ b :=
  @symmDiff_sdiff_eq_sup αᵒᵈ _ _ _
#align bihimp_himp_eq_inf bihimp_himp_eq_inf

@[simp]
theorem himp_bihimp_eq_inf : (b ⇨ a) ⇔ b = a ⊓ b :=
  @sdiff_symmDiff_eq_sup αᵒᵈ _ _ _
#align himp_bihimp_eq_inf himp_bihimp_eq_inf

@[simp]
theorem bihimp_inf_sup : a ⇔ b ⊓ (a ⊔ b) = a ⊓ b :=
  @symmDiff_sup_inf αᵒᵈ _ _ _
#align bihimp_inf_sup bihimp_inf_sup

@[simp]
theorem sup_inf_bihimp : (a ⊔ b) ⊓ a ⇔ b = a ⊓ b :=
  @inf_sup_symmDiff αᵒᵈ _ _ _
#align sup_inf_bihimp sup_inf_bihimp

@[simp]
theorem bihimp_bihimp_sup : a ⇔ b ⇔ (a ⊔ b) = a ⊓ b :=
  @symmDiff_symmDiff_inf αᵒᵈ _ _ _
#align bihimp_bihimp_sup bihimp_bihimp_sup

@[simp]
theorem sup_bihimp_bihimp : (a ⊔ b) ⇔ (a ⇔ b) = a ⊓ b :=
  @inf_symmDiff_symmDiff αᵒᵈ _ _ _
#align sup_bihimp_bihimp sup_bihimp_bihimp

theorem bihimp_triangle : a ⇔ b ⊓ b ⇔ c ≤ a ⇔ c :=
  @symmDiff_triangle αᵒᵈ _ _ _ _
#align bihimp_triangle bihimp_triangle

end GeneralizedHeytingAlgebra

section CoheytingAlgebra

variable [CoheytingAlgebra α] (a : α)

@[simp]
theorem symmDiff_top' : a ∆ ⊤ = ￢a := by simp [symmDiff]
#align symm_diff_top' symmDiff_top'

@[simp]
theorem top_symmDiff' : ⊤ ∆ a = ￢a := by simp [symmDiff]
#align top_symm_diff' top_symmDiff'

@[simp]
theorem hnot_symmDiff_self : (￢a) ∆ a = ⊤ := by
  rw [eq_top_iff, symmDiff, hnot_sdiff, sup_sdiff_self]
  exact Codisjoint.top_le codisjoint_hnot_left
#align hnot_symm_diff_self hnot_symmDiff_self

@[simp]
theorem symmDiff_hnot_self : a ∆ (￢a) = ⊤ := by rw [symmDiff_comm, hnot_symmDiff_self]
#align symm_diff_hnot_self symmDiff_hnot_self

theorem IsCompl.symmDiff_eq_top {a b : α} (h : IsCompl a b) : a ∆ b = ⊤ := by
  rw [h.eq_hnot, hnot_symmDiff_self]
#align is_compl.symm_diff_eq_top IsCompl.symmDiff_eq_top

end CoheytingAlgebra

section HeytingAlgebra

variable [HeytingAlgebra α] (a : α)

@[simp]
theorem bihimp_bot : a ⇔ ⊥ = aᶜ := by simp [bihimp]
#align bihimp_bot bihimp_bot

@[simp]
theorem bot_bihimp : ⊥ ⇔ a = aᶜ := by simp [bihimp]
#align bot_bihimp bot_bihimp

@[simp]
theorem compl_bihimp_self : aᶜ ⇔ a = ⊥ :=
  @hnot_symmDiff_self αᵒᵈ _ _
#align compl_bihimp_self compl_bihimp_self

@[simp]
theorem bihimp_hnot_self : a ⇔ aᶜ = ⊥ :=
  @symmDiff_hnot_self αᵒᵈ _ _
#align bihimp_hnot_self bihimp_hnot_self

theorem IsCompl.bihimp_eq_bot {a b : α} (h : IsCompl a b) : a ⇔ b = ⊥ := by
  rw [h.eq_compl, compl_bihimp_self]
#align is_compl.bihimp_eq_bot IsCompl.bihimp_eq_bot

end HeytingAlgebra

section GeneralizedBooleanAlgebra

variable [GeneralizedBooleanAlgebra α] (a b c d : α)

@[simp]
theorem sup_sdiff_symmDiff : (a ⊔ b) \ a ∆ b = a ⊓ b :=
  sdiff_eq_symm inf_le_sup (by rw [symmDiff_eq_sup_sdiff_inf])
#align sup_sdiff_symm_diff sup_sdiff_symmDiff

theorem disjoint_symmDiff_inf : Disjoint (a ∆ b) (a ⊓ b) := by
  rw [symmDiff_eq_sup_sdiff_inf]
  exact disjoint_sdiff_self_left
#align disjoint_symm_diff_inf disjoint_symmDiff_inf

theorem inf_symmDiff_distrib_left : a ⊓ b ∆ c = (a ⊓ b) ∆ (a ⊓ c) := by
  rw [symmDiff_eq_sup_sdiff_inf, inf_sdiff_distrib_left, inf_sup_left, inf_inf_distrib_left,
    symmDiff_eq_sup_sdiff_inf]
#align inf_symm_diff_distrib_left inf_symmDiff_distrib_left

theorem inf_symmDiff_distrib_right : a ∆ b ⊓ c = (a ⊓ c) ∆ (b ⊓ c) := by
  simp_rw [@inf_comm _ _ _ c, inf_symmDiff_distrib_left]
#align inf_symm_diff_distrib_right inf_symmDiff_distrib_right

theorem sdiff_symmDiff : c \ a ∆ b = c ⊓ a ⊓ b ⊔ c \ a ⊓ c \ b := by
  simp only [(· ∆ ·), sdiff_sdiff_sup_sdiff']
#align sdiff_symm_diff sdiff_symmDiff

theorem sdiff_symmDiff' : c \ a ∆ b = c ⊓ a ⊓ b ⊔ c \ (a ⊔ b) := by
  rw [sdiff_symmDiff, sdiff_sup, sup_comm]
#align sdiff_symm_diff' sdiff_symmDiff'

@[simp]
theorem symmDiff_sdiff_left : a ∆ b \ a = b \ a := by
  rw [symmDiff_def, sup_sdiff, sdiff_idem, sdiff_sdiff_self, bot_sup_eq]
#align symm_diff_sdiff_left symmDiff_sdiff_left

@[simp]
theorem symmDiff_sdiff_right : a ∆ b \ b = a \ b := by rw [symmDiff_comm, symmDiff_sdiff_left]
#align symm_diff_sdiff_right symmDiff_sdiff_right

@[simp]
theorem sdiff_symmDiff_left : a \ a ∆ b = a ⊓ b := by simp [sdiff_symmDiff]
#align sdiff_symm_diff_left sdiff_symmDiff_left

@[simp]
theorem sdiff_symmDiff_right : b \ a ∆ b = a ⊓ b := by
  rw [symmDiff_comm, inf_comm, sdiff_symmDiff_left]
#align sdiff_symm_diff_right sdiff_symmDiff_right

theorem symmDiff_eq_sup : a ∆ b = a ⊔ b ↔ Disjoint a b := by
  refine' ⟨fun h => _, Disjoint.symmDiff_eq_sup⟩
  rw [symmDiff_eq_sup_sdiff_inf, sdiff_eq_self_iff_disjoint] at h
  exact h.of_disjoint_inf_of_le le_sup_left
#align symm_diff_eq_sup symmDiff_eq_sup

@[simp]
theorem le_symmDiff_iff_left : a ≤ a ∆ b ↔ Disjoint a b := by
  refine' ⟨fun h => _, fun h => h.symmDiff_eq_sup.symm ▸ le_sup_left⟩
  rw [symmDiff_eq_sup_sdiff_inf] at h
  exact disjoint_iff_inf_le.mpr (le_sdiff_iff.1 <| inf_le_of_left_le h).le
#align le_symm_diff_iff_left le_symmDiff_iff_left

@[simp]
theorem le_symmDiff_iff_right : b ≤ a ∆ b ↔ Disjoint a b := by
  rw [symmDiff_comm, le_symmDiff_iff_left, disjoint_comm]
#align le_symm_diff_iff_right le_symmDiff_iff_right

theorem symmDiff_symmDiff_left :
    a ∆ b ∆ c = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) ⊔ c \ (a ⊔ b) ⊔ a ⊓ b ⊓ c :=
  calc
    a ∆ b ∆ c = a ∆ b \ c ⊔ c \ a ∆ b := symmDiff_def _ _
    _ = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) ⊔ (c \ (a ⊔ b) ⊔ c ⊓ a ⊓ b) := by
        { rw [sdiff_symmDiff', @sup_comm _ _ (c ⊓ a ⊓ b), symmDiff_sdiff] }
    _ = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) ⊔ c \ (a ⊔ b) ⊔ a ⊓ b ⊓ c := by ac_rfl
#align symm_diff_symm_diff_left symmDiff_symmDiff_left

theorem symmDiff_symmDiff_right :
    a ∆ (b ∆ c) = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) ⊔ c \ (a ⊔ b) ⊔ a ⊓ b ⊓ c :=
  calc
    a ∆ (b ∆ c) = a \ b ∆ c ⊔ b ∆ c \ a := symmDiff_def _ _
    _ = a \ (b ⊔ c) ⊔ a ⊓ b ⊓ c ⊔ (b \ (c ⊔ a) ⊔ c \ (b ⊔ a)) := by
        { rw [sdiff_symmDiff', @sup_comm _ _ (a ⊓ b ⊓ c), symmDiff_sdiff] }
    _ = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) ⊔ c \ (a ⊔ b) ⊔ a ⊓ b ⊓ c := by ac_rfl
#align symm_diff_symm_diff_right symmDiff_symmDiff_right

theorem symmDiff_assoc : a ∆ b ∆ c = a ∆ (b ∆ c) := by
  rw [symmDiff_symmDiff_left, symmDiff_symmDiff_right]
#align symm_diff_assoc symmDiff_assoc

instance symmDiff_isAssociative : IsAssociative α (· ∆ ·) :=
  ⟨symmDiff_assoc⟩
#align symm_diff_is_assoc symmDiff_isAssociative

theorem symmDiff_left_comm : a ∆ (b ∆ c) = b ∆ (a ∆ c) := by
  simp_rw [← symmDiff_assoc, symmDiff_comm]
#align symm_diff_left_comm symmDiff_left_comm

theorem symmDiff_right_comm : a ∆ b ∆ c = a ∆ c ∆ b := by simp_rw [symmDiff_assoc, symmDiff_comm]
#align symm_diff_right_comm symmDiff_right_comm

theorem symmDiff_symmDiff_symmDiff_comm : a ∆ b ∆ (c ∆ d) = a ∆ c ∆ (b ∆ d) := by
  simp_rw [symmDiff_assoc, symmDiff_left_comm]
#align symm_diff_symm_diff_symm_diff_comm symmDiff_symmDiff_symmDiff_comm

@[simp]
theorem symmDiff_symmDiff_cancel_left : a ∆ (a ∆ b) = b := by simp [← symmDiff_assoc]
#align symm_diff_symm_diff_cancel_left symmDiff_symmDiff_cancel_left

@[simp]
theorem symmDiff_symmDiff_cancel_right : b ∆ a ∆ a = b := by simp [symmDiff_assoc]
#align symm_diff_symm_diff_cancel_right symmDiff_symmDiff_cancel_right

@[simp]
theorem symmDiff_symmDiff_self' : a ∆ b ∆ a = b := by
  rw [symmDiff_comm, symmDiff_symmDiff_cancel_left]
#align symm_diff_symm_diff_self' symmDiff_symmDiff_self'

theorem symmDiff_left_involutive (a : α) : Involutive (· ∆ a) :=
  symmDiff_symmDiff_cancel_right _
#align symm_diff_left_involutive symmDiff_left_involutive

theorem symmDiff_right_involutive (a : α) : Involutive ((· ∆ ·) a) :=
  symmDiff_symmDiff_cancel_left _
#align symm_diff_right_involutive symmDiff_right_involutive

theorem symmDiff_left_injective (a : α) : Injective (· ∆ a) :=
  Function.Involutive.injective (symmDiff_left_involutive a)
#align symm_diff_left_injective symmDiff_left_injective

theorem symmDiff_right_injective (a : α) : Injective ((· ∆ ·) a) :=
  Function.Involutive.injective (symmDiff_right_involutive _)
#align symm_diff_right_injective symmDiff_right_injective

theorem symmDiff_left_surjective (a : α) : Surjective (· ∆ a) :=
  Function.Involutive.surjective (symmDiff_left_involutive _)
#align symm_diff_left_surjective symmDiff_left_surjective

theorem symmDiff_right_surjective (a : α) : Surjective ((· ∆ ·) a) :=
  Function.Involutive.surjective (symmDiff_right_involutive _)
#align symm_diff_right_surjective symmDiff_right_surjective

variable {a b c}

@[simp]
theorem symmDiff_left_inj : a ∆ b = c ∆ b ↔ a = c :=
  (symmDiff_left_injective _).eq_iff
#align symm_diff_left_inj symmDiff_left_inj

@[simp]
theorem symmDiff_right_inj : a ∆ b = a ∆ c ↔ b = c :=
  (symmDiff_right_injective _).eq_iff
#align symm_diff_right_inj symmDiff_right_inj

@[simp]
theorem symmDiff_eq_left : a ∆ b = a ↔ b = ⊥ :=
  calc
    a ∆ b = a ↔ a ∆ b = a ∆ ⊥ := by rw [symmDiff_bot]
    _ ↔ b = ⊥ := by rw [symmDiff_right_inj]
#align symm_diff_eq_left symmDiff_eq_left

@[simp]
theorem symmDiff_eq_right : a ∆ b = b ↔ a = ⊥ := by rw [symmDiff_comm, symmDiff_eq_left]
#align symm_diff_eq_right symmDiff_eq_right

protected theorem Disjoint.symmDiff_left (ha : Disjoint a c) (hb : Disjoint b c) :
    Disjoint (a ∆ b) c := by
  rw [symmDiff_eq_sup_sdiff_inf]
  exact (ha.sup_left hb).disjoint_sdiff_left
#align disjoint.symm_diff_left Disjoint.symmDiff_left

protected theorem Disjoint.symmDiff_right (ha : Disjoint a b) (hb : Disjoint a c) :
    Disjoint a (b ∆ c) :=
  (ha.symm.symmDiff_left hb.symm).symm
#align disjoint.symm_diff_right Disjoint.symmDiff_right

theorem symmDiff_eq_iff_sdiff_eq (ha : a ≤ c) : a ∆ b = c ↔ c \ a = b := by
  rw [← symmDiff_of_le ha]
  exact ((symmDiff_right_involutive a).toPerm _).apply_eq_iff_eq_symm_apply.trans eq_comm
#align symm_diff_eq_iff_sdiff_eq symmDiff_eq_iff_sdiff_eq

end GeneralizedBooleanAlgebra

section BooleanAlgebra

variable [BooleanAlgebra α] (a b c d : α)

/- `CogeneralizedBooleanAlgebra` isn't actually a typeclass, but the lemmas in here are dual to
the `GeneralizedBooleanAlgebra` ones -/
section CogeneralizedBooleanAlgebra

@[simp]
theorem inf_himp_bihimp : a ⇔ b ⇨ a ⊓ b = a ⊔ b :=
  @sup_sdiff_symmDiff αᵒᵈ _ _ _
#align inf_himp_bihimp inf_himp_bihimp

theorem codisjoint_bihimp_sup : Codisjoint (a ⇔ b) (a ⊔ b) :=
  @disjoint_symmDiff_inf αᵒᵈ _ _ _
#align codisjoint_bihimp_sup codisjoint_bihimp_sup

@[simp]
theorem himp_bihimp_left : a ⇨ a ⇔ b = a ⇨ b :=
  @symmDiff_sdiff_left αᵒᵈ _ _ _
#align himp_bihimp_left himp_bihimp_left

@[simp]
theorem himp_bihimp_right : b ⇨ a ⇔ b = b ⇨ a :=
  @symmDiff_sdiff_right αᵒᵈ _ _ _
#align himp_bihimp_right himp_bihimp_right

@[simp]
theorem bihimp_himp_left : a ⇔ b ⇨ a = a ⊔ b :=
  @sdiff_symmDiff_left αᵒᵈ _ _ _
#align bihimp_himp_left bihimp_himp_left

@[simp]
theorem bihimp_himp_right : a ⇔ b ⇨ b = a ⊔ b :=
  @sdiff_symmDiff_right αᵒᵈ _ _ _
#align bihimp_himp_right bihimp_himp_right

@[simp]
theorem bihimp_eq_inf : a ⇔ b = a ⊓ b ↔ Codisjoint a b :=
  @symmDiff_eq_sup αᵒᵈ _ _ _
#align bihimp_eq_inf bihimp_eq_inf

@[simp]
theorem bihimp_le_iff_left : a ⇔ b ≤ a ↔ Codisjoint a b :=
  @le_symmDiff_iff_left αᵒᵈ _ _ _
#align bihimp_le_iff_left bihimp_le_iff_left

@[simp]
theorem bihimp_le_iff_right : a ⇔ b ≤ b ↔ Codisjoint a b :=
  @le_symmDiff_iff_right αᵒᵈ _ _ _
#align bihimp_le_iff_right bihimp_le_iff_right

theorem bihimp_assoc : a ⇔ b ⇔ c = a ⇔ (b ⇔ c) :=
  @symmDiff_assoc αᵒᵈ _ _ _ _
#align bihimp_assoc bihimp_assoc

instance bihimp_isAssociative : IsAssociative α (· ⇔ ·) :=
  ⟨bihimp_assoc⟩
#align bihimp_is_assoc bihimp_isAssociative

theorem bihimp_left_comm : a ⇔ (b ⇔ c) = b ⇔ (a ⇔ c) := by simp_rw [← bihimp_assoc, bihimp_comm]
#align bihimp_left_comm bihimp_left_comm

theorem bihimp_right_comm : a ⇔ b ⇔ c = a ⇔ c ⇔ b := by simp_rw [bihimp_assoc, bihimp_comm]
#align bihimp_right_comm bihimp_right_comm

theorem bihimp_bihimp_bihimp_comm : a ⇔ b ⇔ (c ⇔ d) = a ⇔ c ⇔ (b ⇔ d) := by
  simp_rw [bihimp_assoc, bihimp_left_comm]
#align bihimp_bihimp_bihimp_comm bihimp_bihimp_bihimp_comm

@[simp]
theorem bihimp_bihimp_cancel_left : a ⇔ (a ⇔ b) = b := by simp [← bihimp_assoc]
#align bihimp_bihimp_cancel_left bihimp_bihimp_cancel_left

@[simp]
theorem bihimp_bihimp_cancel_right : b ⇔ a ⇔ a = b := by simp [bihimp_assoc]
#align bihimp_bihimp_cancel_right bihimp_bihimp_cancel_right

@[simp]
theorem bihimp_bihimp_self : a ⇔ b ⇔ a = b := by rw [bihimp_comm, bihimp_bihimp_cancel_left]
#align bihimp_bihimp_self bihimp_bihimp_self

theorem bihimp_left_involutive (a : α) : Involutive (· ⇔ a) :=
  bihimp_bihimp_cancel_right _
#align bihimp_left_involutive bihimp_left_involutive

theorem bihimp_right_involutive (a : α) : Involutive ((· ⇔ ·) a) :=
  bihimp_bihimp_cancel_left _
#align bihimp_right_involutive bihimp_right_involutive

theorem bihimp_left_injective (a : α) : Injective (· ⇔ a) :=
  @symmDiff_left_injective αᵒᵈ _ _
#align bihimp_left_injective bihimp_left_injective

theorem bihimp_right_injective (a : α) : Injective ((· ⇔ ·) a) :=
  @symmDiff_right_injective αᵒᵈ _ _
#align bihimp_right_injective bihimp_right_injective

theorem bihimp_left_surjective (a : α) : Surjective (· ⇔ a) :=
  @symmDiff_left_surjective αᵒᵈ _ _
#align bihimp_left_surjective bihimp_left_surjective

theorem bihimp_right_surjective (a : α) : Surjective ((· ⇔ ·) a) :=
  @symmDiff_right_surjective αᵒᵈ _ _
#align bihimp_right_surjective bihimp_right_surjective

variable {a b c}

@[simp]
theorem bihimp_left_inj : a ⇔ b = c ⇔ b ↔ a = c :=
  (bihimp_left_injective _).eq_iff
#align bihimp_left_inj bihimp_left_inj

@[simp]
theorem bihimp_right_inj : a ⇔ b = a ⇔ c ↔ b = c :=
  (bihimp_right_injective _).eq_iff
#align bihimp_right_inj bihimp_right_inj

@[simp]
theorem bihimp_eq_left : a ⇔ b = a ↔ b = ⊤ :=
  @symmDiff_eq_left αᵒᵈ _ _ _
#align bihimp_eq_left bihimp_eq_left

@[simp]
theorem bihimp_eq_right : a ⇔ b = b ↔ a = ⊤ :=
  @symmDiff_eq_right αᵒᵈ _ _ _
#align bihimp_eq_right bihimp_eq_right

protected theorem Codisjoint.bihimp_left (ha : Codisjoint a c) (hb : Codisjoint b c) :
    Codisjoint (a ⇔ b) c :=
  (ha.inf_left hb).mono_left inf_le_bihimp
#align codisjoint.bihimp_left Codisjoint.bihimp_left

protected theorem Codisjoint.bihimp_right (ha : Codisjoint a b) (hb : Codisjoint a c) :
    Codisjoint a (b ⇔ c) :=
  (ha.inf_right hb).mono_right inf_le_bihimp
#align codisjoint.bihimp_right Codisjoint.bihimp_right

end CogeneralizedBooleanAlgebra

theorem symmDiff_eq : a ∆ b = a ⊓ bᶜ ⊔ b ⊓ aᶜ := by simp only [(· ∆ ·), sdiff_eq]
#align symm_diff_eq symmDiff_eq

theorem bihimp_eq : a ⇔ b = (a ⊔ bᶜ) ⊓ (b ⊔ aᶜ) := by simp only [(· ⇔ ·), himp_eq]
#align bihimp_eq bihimp_eq

theorem symmDiff_eq' : a ∆ b = (a ⊔ b) ⊓ (aᶜ ⊔ bᶜ) := by
  rw [symmDiff_eq_sup_sdiff_inf, sdiff_eq, compl_inf]
#align symm_diff_eq' symmDiff_eq'

theorem bihimp_eq' : a ⇔ b = a ⊓ b ⊔ aᶜ ⊓ bᶜ :=
  @symmDiff_eq' αᵒᵈ _ _ _
#align bihimp_eq' bihimp_eq'

theorem symmDiff_top : a ∆ ⊤ = aᶜ :=
  symmDiff_top' _
#align symm_diff_top symmDiff_top

theorem top_symmDiff : ⊤ ∆ a = aᶜ :=
  top_symmDiff' _
#align top_symm_diff top_symmDiff

@[simp]
theorem compl_symmDiff : (a ∆ b)ᶜ = a ⇔ b := by
  simp_rw [symmDiff, compl_sup_distrib, compl_sdiff, bihimp, inf_comm]
#align compl_symm_diff compl_symmDiff

@[simp]
theorem compl_bihimp : (a ⇔ b)ᶜ = a ∆ b :=
  @compl_symmDiff αᵒᵈ _ _ _
#align compl_bihimp compl_bihimp

@[simp]
theorem compl_symmDiff_compl : aᶜ ∆ bᶜ = a ∆ b :=
  sup_comm.trans <| by simp_rw [compl_sdiff_compl, sdiff_eq, symmDiff_eq]
#align compl_symm_diff_compl compl_symmDiff_compl

@[simp]
theorem compl_bihimp_compl : aᶜ ⇔ bᶜ = a ⇔ b :=
  @compl_symmDiff_compl αᵒᵈ _ _ _
#align compl_bihimp_compl compl_bihimp_compl

@[simp]
theorem symmDiff_eq_top : a ∆ b = ⊤ ↔ IsCompl a b := by
  rw [symmDiff_eq', ← compl_inf, inf_eq_top_iff, compl_eq_top, isCompl_iff, disjoint_iff,
    codisjoint_iff, and_comm]
#align symm_diff_eq_top symmDiff_eq_top

@[simp]
theorem bihimp_eq_bot : a ⇔ b = ⊥ ↔ IsCompl a b := by
  rw [bihimp_eq', ← compl_sup, sup_eq_bot_iff, compl_eq_bot, isCompl_iff, disjoint_iff,
    codisjoint_iff]
#align bihimp_eq_bot bihimp_eq_bot

@[simp]
theorem compl_symmDiff_self : aᶜ ∆ a = ⊤ :=
  hnot_symmDiff_self _
#align compl_symm_diff_self compl_symmDiff_self

@[simp]
theorem symmDiff_compl_self : a ∆ aᶜ = ⊤ :=
  symmDiff_hnot_self _
#align symm_diff_compl_self symmDiff_compl_self

theorem symmDiff_symmDiff_right' :
    a ∆ (b ∆ c) = a ⊓ b ⊓ c ⊔ a ⊓ bᶜ ⊓ cᶜ ⊔ aᶜ ⊓ b ⊓ cᶜ ⊔ aᶜ ⊓ bᶜ ⊓ c :=
  calc
    a ∆ (b ∆ c) = a ⊓ (b ⊓ c ⊔ bᶜ ⊓ cᶜ) ⊔ (b ⊓ cᶜ ⊔ c ⊓ bᶜ) ⊓ aᶜ := by
        { rw [symmDiff_eq, compl_symmDiff, bihimp_eq', symmDiff_eq] }
    _ = a ⊓ b ⊓ c ⊔ a ⊓ bᶜ ⊓ cᶜ ⊔ b ⊓ cᶜ ⊓ aᶜ ⊔ c ⊓ bᶜ ⊓ aᶜ := by
        { rw [inf_sup_left, inf_sup_right, ← sup_assoc, ← inf_assoc, ← inf_assoc] }
    _ = a ⊓ b ⊓ c ⊔ a ⊓ bᶜ ⊓ cᶜ ⊔ aᶜ ⊓ b ⊓ cᶜ ⊔ aᶜ ⊓ bᶜ ⊓ c := (by
      congr 1
      · congr 1
        rw [inf_comm, inf_assoc]
      · apply inf_left_right_swap)
#align symm_diff_symm_diff_right' symmDiff_symmDiff_right'

variable {a b c}

theorem Disjoint.le_symmDiff_sup_symmDiff_left (h : Disjoint a b) : c ≤ a ∆ c ⊔ b ∆ c := by
  trans c \ (a ⊓ b)
  · rw [h.eq_bot, sdiff_bot]
  · rw [sdiff_inf]
    exact sup_le_sup le_sup_right le_sup_right
#align disjoint.le_symm_diff_sup_symm_diff_left Disjoint.le_symmDiff_sup_symmDiff_left

theorem Disjoint.le_symmDiff_sup_symmDiff_right (h : Disjoint b c) : a ≤ a ∆ b ⊔ a ∆ c := by
  simp_rw [symmDiff_comm a]
  exact h.le_symmDiff_sup_symmDiff_left
#align disjoint.le_symm_diff_sup_symm_diff_right Disjoint.le_symmDiff_sup_symmDiff_right

theorem Codisjoint.bihimp_inf_bihimp_le_left (h : Codisjoint a b) : a ⇔ c ⊓ b ⇔ c ≤ c :=
  h.dual.le_symmDiff_sup_symmDiff_left
#align codisjoint.bihimp_inf_bihimp_le_left Codisjoint.bihimp_inf_bihimp_le_left

theorem Codisjoint.bihimp_inf_bihimp_le_right (h : Codisjoint b c) : a ⇔ b ⊓ a ⇔ c ≤ a :=
  h.dual.le_symmDiff_sup_symmDiff_right
#align codisjoint.bihimp_inf_bihimp_le_right Codisjoint.bihimp_inf_bihimp_le_right

end BooleanAlgebra

/-! ### Prod -/

section Prod

@[simp]
theorem symmDiff_fst [GeneralizedCoheytingAlgebra α] [GeneralizedCoheytingAlgebra β]
    (a b : α × β) : (a ∆ b).1 = a.1 ∆ b.1 :=
  rfl
#align symm_diff_fst symmDiff_fst

@[simp]
theorem symmDiff_snd [GeneralizedCoheytingAlgebra α] [GeneralizedCoheytingAlgebra β]
    (a b : α × β) : (a ∆ b).2 = a.2 ∆ b.2 :=
  rfl
#align symm_diff_snd symmDiff_snd

@[simp]
theorem bihimp_fst [GeneralizedHeytingAlgebra α] [GeneralizedHeytingAlgebra β] (a b : α × β) :
    (a ⇔ b).1 = a.1 ⇔ b.1 :=
  rfl
#align bihimp_fst bihimp_fst

@[simp]
theorem bihimp_snd [GeneralizedHeytingAlgebra α] [GeneralizedHeytingAlgebra β] (a b : α × β) :
    (a ⇔ b).2 = a.2 ⇔ b.2 :=
  rfl
#align bihimp_snd bihimp_snd

end Prod

/-! ### Pi -/

namespace Pi

theorem symmDiff_def [∀ i, GeneralizedCoheytingAlgebra (π i)] (a b : ∀ i, π i) :
    a ∆ b = fun i => a i ∆ b i :=
  rfl
#align pi.symm_diff_def Pi.symmDiff_def

theorem bihimp_def [∀ i, GeneralizedHeytingAlgebra (π i)] (a b : ∀ i, π i) :
    a ⇔ b = fun i => a i ⇔ b i :=
  rfl
#align pi.bihimp_def Pi.bihimp_def

@[simp]
theorem symmDiff_apply [∀ i, GeneralizedCoheytingAlgebra (π i)] (a b : ∀ i, π i) (i : ι) :
    (a ∆ b) i = a i ∆ b i :=
  rfl
#align pi.symm_diff_apply Pi.symmDiff_apply

@[simp]
theorem bihimp_apply [∀ i, GeneralizedHeytingAlgebra (π i)] (a b : ∀ i, π i) (i : ι) :
    (a ⇔ b) i = a i ⇔ b i :=
  rfl
#align pi.bihimp_apply Pi.bihimp_apply

end Pi


import tactic
import data.nat.prime
import data.nat.parity
import algebra.divisibility
import algebra.big_operators
import data.set.finite
import number_theory.bernoulli
import data.finset
import data.finset.basic
import data.nat.basic
import data.finset.nat_antidiagonal

import ring_theory.power_series.basic

open power_series

theorem expand_tonelli (n:ℕ):
(finset.range n).sum(λ k, power_series.mk (λ n, (k:ℚ)^n / n.factorial)) =
power_series.mk (λ p, (finset.range n).sum(λ k, k^p)/p.factorial) :=
begin
  induction n with n h,
  { simp only [zero_div, finset.sum_empty, finset.range_zero],
  refl },
  rw [finset.sum_range_succ, h],
  ext,
  simp only [coeff_mk, linear_map.map_add],
  rw [finset.sum_range_succ, add_div],
end

def expk (k:ℕ) : power_series ℚ := power_series.mk (λ n, (k:ℚ)^n / n.factorial)

lemma expkrw (k:ℕ ): (expk k) = power_series.mk (λ n, (k:ℚ)^n / n.factorial)
  := by refl

-- some version of this might be useful to have in mathlib?!
lemma expk' (k:ℕ): (exp ℚ)^k = expk k :=
begin
  induction k with k h,
  {rw [expk],
  ext,
  simp only [coeff_mk, coeff_one, nat.nat_zero_eq_zero, nat.factorial,
  nat.cast_zero, pow_zero],
  split_ifs,
  { simp [h] },
  { simp [h] } },
  simp only [pow_succ, h],
  ext,
  rw [coeff_mul],
  simp only [expk, exp, one_div, coeff_mk, nat.factorial, ring_hom.id_apply,
  nat.cast_succ, rat.algebra_map_rat_rat],
  have hf: (n.factorial:ℚ) ≠ 0 := by simp only [n.factorial_ne_zero, ne.def,
  nat.cast_eq_zero, not_false_iff],
  rw [mul_mul_div ((finset.nat.antidiagonal n).sum
  (λ (x : ℕ × ℕ), (↑(x.fst.factorial))⁻¹ *
  (↑k ^ x.snd / ↑(x.snd.factorial)))) hf],
  rw [←div_eq_mul_one_div, div_left_inj' hf],
  let  f: ℕ →  ℕ → ℚ := λ a : ℕ, λ b : ℕ,
  ((↑(a.factorial))⁻¹ * (↑k ^ b / ↑(b.factorial))),
  simp only [finset.nat.sum_antidiagonal_eq_sum_range_succ f],
  have hfab: ∀ (a b:ℕ), f a b =
  ((↑(a.factorial))⁻¹ * (↑k ^ b / ↑(b.factorial))) :=
  begin
    intros,
    refl,
  end,
  rw [add_comm ↑k, add_pow, finset.sum_mul],
  have hsucc: n.succ = n + 1 := by refl,
  simp only [←hsucc],
  refine finset.sum_congr rfl _,
  intros m hm,
  rw [hfab],
  rw [finset.mem_range] at hm,
  have hnmn: n - m ≤ n :=
  begin
    apply nat.sub_le_left_of_le_add,
    apply nat.le_add_left,
  end,
  have hnm: m ≤ n := nat.le_of_lt_succ hm,
  rw [←nat.choose_symm hnm, nat.choose_eq_factorial_div_factorial hnmn],
  have hnnm: n - (n - m) = m := nat.sub_sub_self hnm,
  rw [hnnm],
  simp only [one_pow, one_mul],
  rw [mul_comm  ((m.factorial):ℚ)⁻¹],
  simp only [nat.factorial_mul_factorial_dvd_factorial hnm],
  rw ← division_def,
  rw div_div_eq_div_mul,
  rw mul_comm,
  have hfacprod:  ↑(m.factorial * (n - m).factorial) ≠  0 :=
  begin
    have hmfacnezero: m.factorial ≠ 0:= ne_of_gt m.factorial_pos,
    have hnmfacnezero: (n-m).factorial ≠ 0 :=
    begin
      have hk: ∃ k, k = n - m:= by simp only [exists_apply_eq_apply],
      refine ne_of_gt _,
      cases hk with k hk,
      have hkfac: k.factorial >0 :=  k.factorial_pos,
      rw hk at hkfac,
      exact hkfac,
    end,
    have hnn: m.factorial * (n - m).factorial ≠ 0 := mul_ne_zero hmfacnezero hnmfacnezero,
    simp [hnn],
  end,
  rw [nat.cast_dvd, nat.cast_mul],
  simp only [← mul_div_assoc, mul_comm],
  rw mul_comm,
  exact nat.factorial_mul_factorial_dvd_factorial hnm,
  simp only [ne.def, nat.cast_eq_zero, mul_eq_zero],
  simp only [nat.factorial_ne_zero, not_false_iff, or_self],
end

lemma expk_minus_one_coeff (n m:ℕ): (coeff ℚ m) ((expk n) - 1) =
( if (m > 0) then ((coeff ℚ m) (expk n)) else (((coeff ℚ 0) (expk n) - 1) ) ):=
begin
  split_ifs with h h,
  { simp only [coeff_one, linear_map.map_sub],
  have hnm: ¬(m = 0) := by apply ne_of_gt h,
  simp only [hnm, sub_zero, if_false] },
  simp only [coeff_one, coeff_zero_eq_constant_coeff, linear_map.map_sub],
  have hm: m = 0 := by linarith,
  rw [hm],
  simp only [if_true, eq_self_iff_true, coeff_zero_eq_constant_coeff],
end

lemma minus_one_minus_expk (n:ℕ): (1 - expk n) = - ((expk n) - 1) := by ring

theorem sum_geo_seq (n:ℕ) (φ : (power_series ℚ)):
((finset.range n).sum(λ k, φ^k) * (φ - 1)) = ((φ^n) - 1) :=
begin
  induction n with n h,
  { simp only [finset.sum_empty, zero_mul, finset.range_zero, pow_zero, sub_self] },
  simp only [finset.sum_range_succ, pow_succ', add_mul ,h],
  ring,
end

theorem special_sum_inf_geo_seq (n:ℕ):
 (exp ℚ - 1) * (finset.range n).sum(λ k, expk k) = ((expk n) - 1) :=
begin
  have hone: ((finset.range n).sum(λ k, (exp ℚ)^k) * ((exp ℚ) - 1)) =
  (((exp ℚ)^n) - 1) := sum_geo_seq n ((exp ℚ)),
  simp only [expk', mul_comm] at *,
  exact hone,
end

theorem expand_fraction (n:ℕ):
(1 - expk n) * X * (exp ℚ - 1)  = (1 - exp ℚ) * (expk n - 1) * X := by ring

theorem right_series (n:ℕ):
(expk n - 1) = X*power_series.mk (λ p, n^p.succ/(p.succ.factorial)) :=
begin
  ext,
  rw [power_series.coeff_mul],
  rw [expk_minus_one_coeff],
  split_ifs with h_ge_zero h_zero,
  rw [expk],
  rw [power_series.coeff_mk],
  simp only [coeff_X, coeff_mk, nat.factorial, boole_mul, nat.cast_succ,
  nat.factorial_succ, nat.cast_mul],
  have hnsucc: ∃ (m:ℕ), m.succ = n_1 :=
  begin
    use n_1 - 1,
    exact nat.succ_pred_eq_of_pos h_ge_zero,
  end,
  cases hnsucc with m hm,
  rw [←hm],
  rw [finset.nat.sum_antidiagonal_succ],
  simp only [add_left_eq_self, nat.factorial, nat.cast_succ,
  nat.factorial_succ, if_false, nat.cast_add, zero_add, nat.cast_one,
  nat.cast_mul, zero_ne_one],
  by_cases hmz: m = 0,
  rw [hmz, finset.nat.antidiagonal_zero],
  simp,
  have hmsucc: ∃ (p:ℕ), p.succ = m :=
  begin
    have h_ge_zero: m > 0 :=
    begin
      exact nat.pos_of_ne_zero hmz,
    end,
    use m - 1,
    exact nat.succ_pred_eq_of_pos h_ge_zero,
  end,
  cases hmsucc with p hp,
  rw [←hp, finset.nat.sum_antidiagonal_succ],
  by_cases hpz: p = 0,
  rw [hpz],
  simp only [add_zero, if_true, eq_self_iff_true, add_eq_zero_iff,
  if_false, one_ne_zero, finset.sum_const_zero, and_false],
  simp only [add_zero, if_true, eq_self_iff_true, nat.cast_succ,
  add_eq_zero_iff, if_false, one_ne_zero, finset.sum_const_zero,
  and_false],
  have hn_1: n_1 = 0 := by linarith,
  rw [expk],
  simp only [hn_1],
  rw [power_series.coeff_mk],
  simp,
end

lemma minus_X_fw (φ ψ: power_series ℚ):
(φ = ψ) →  (
  mk(λ n, (-1)^n*(coeff ℚ n) φ) =
  mk(λ n, (-1)^n*(coeff ℚ n) ψ)) :=
begin
  rintro rfl,
  refl,
end

lemma minus_X (φ ψ: power_series ℚ):
(φ = ψ) ↔  (
  mk(λ n, (-1:ℚ)^n*(coeff ℚ n) φ) =
  mk(λ n, (-1)^n*(coeff ℚ n) ψ)) :=
begin
  split,
  { exact minus_X_fw φ ψ },
  intro h,
  have g: mk(λ n,
  (-1:ℚ)^n*(coeff ℚ n) (mk(λ n, (-1)^n*(coeff ℚ n) φ))) =
  mk(λ n,
  (-1)^n*(coeff ℚ n) (mk(λ n, (-1)^n*(coeff ℚ n) ψ))) := (minus_X_fw (mk(λ n, (-1)^n*(coeff ℚ n) φ))
  (mk(λ n, (-1)^n*(coeff ℚ n) ψ))) h,
  simp only [coeff_mk] at g,
  simp only [power_series.ext_iff] at g,
  simp only [or_self_right, coeff_mk, mul_eq_mul_left_iff] at g,
  have hpn: ∀ n:ℕ, ((-1:ℚ)^n) ≠ 0 :=
  begin
    intro n,
    apply pow_ne_zero,
    rw [ne.def, neg_eq_zero],
    exact one_ne_zero,
  end,
  simp only [hpn, or_false] at g,
  exact power_series.ext_iff.mpr g,
 end

 lemma minus_X_mul (φ ψ: power_series ℚ):
 (mk(λ n, (-1:ℚ)^n*(coeff ℚ n) φ) * mk(λ n, (-1:ℚ)^n*(coeff ℚ n) ψ)) =
 mk(λ n, (-1:ℚ)^n*(coeff ℚ n) (φ*ψ)) :=
 (ring_hom.map_mul (rescale (-1 : ℚ)) φ ψ).symm

-- useful to have in mathlib?
lemma exp_inv:  (exp ℚ) * mk (λ (n : ℕ), (-1) ^ n * (coeff ℚ n) (exp ℚ))  = 1 :=
begin
  ext,
  rw [coeff_mul],
  simp only [one_div, coeff_mk, coeff_one, nat.factorial,
  coeff_exp, ring_hom.id_apply, rat.algebra_map_rat_rat],
  have zero_pow_ite_fac: 0^n/((n.factorial:ℚ)) =(ite(n=0) (1:ℚ) 0):=
  begin
    induction n with n hn,
    simp only [mul_one, nat.factorial_zero, if_true, eq_self_iff_true,
    nat.factorial_one, nat.cast_one, pow_zero],
    simp only [div_one],
    have hnsucc_zero: ¬ n.succ = 0 := nat.succ_ne_zero n,
    simp only [hnsucc_zero, if_false],
    have hsuccfac: n.succ.factorial ≠  0 := ne_of_gt (nat.factorial_pos _),
    simp only [nat.succ_pos', div_eq_zero_iff, true_or, zero_pow_eq_zero],
  end,
  rw [←zero_pow_ite_fac],
  have one_minus_one_eq_zero: 1 + (-1) = (0:ℚ) :=
  begin
    simp only [add_right_neg],
  end,
  rw [←one_minus_one_eq_zero],
  rw [add_pow],
  let f:ℕ → ℕ → ℚ := λ a : ℕ, λ b : ℕ,
  (((a.factorial))⁻¹ * ((-1) ^ b * ((b.factorial))⁻¹)),
  rw [finset.nat.sum_antidiagonal_eq_sum_range_succ f],
  have hfacnezero: (n.factorial:ℚ)  ≠ 0 := by exact_mod_cast n.factorial_ne_zero,
  symmetry,
  rw [div_eq_iff hfacnezero],
  rw [finset.sum_mul],
  have hsucc: n.succ = n + 1 := by refl,
  simp only [←hsucc],
  refine finset.sum_congr rfl _,
  intro m,
  intro hm,
  simp only [f],
  have hmn: m ≤ n :=
  begin
     rw [finset.mem_range] at hm,
     exact nat.le_of_lt_succ hm,
  end,
  simp only [nat.choose_eq_factorial_div_factorial hmn],
  simp only [one_pow, one_mul],
  rw ← mul_assoc,
  simp only,
  ring,
  simp only [mul_eq_mul_right_iff],
  left,
  have hfacprod:  ↑(m.factorial * (n - m).factorial) ≠  0 :=
  begin
    have hmfacnezero: m.factorial ≠ 0:= ne_of_gt m.factorial_pos,
    have hnmfacnezero: (n-m).factorial ≠ 0 :=
    begin
      have hk: ∃ k, k = n - m:=
      begin
        simp only [exists_apply_eq_apply],
      end,
      refine ne_of_gt _,
      cases hk with k hk,
      have hkfac: k.factorial >0 :=  k.factorial_pos,
      rw hk at hkfac,
      exact hkfac,
    end,
    have hnn: m.factorial * (n - m).factorial ≠ 0
    := mul_ne_zero hmfacnezero hnmfacnezero,
    simp [hnn],
  end,
  rw nat.cast_dvd,
  simp only [nat.cast_mul],
  rw ←division_def,
  rw ←division_def,
  rw div_div_eq_div_mul,
  simp only [mul_comm],
  exact nat.factorial_mul_factorial_dvd_factorial hmn,
  simp only [ne.def, nat.cast_eq_zero, mul_eq_zero],
  simp only [nat.factorial_ne_zero, not_false_iff, or_self],
end

lemma expmxm1: mk (λ (n : ℕ), (-1:ℚ) ^ n * (coeff ℚ n) (exp ℚ - 1)) =
 (1 - exp ℚ)* mk (λ (n : ℕ), (-1) ^ n * (coeff ℚ n) (exp ℚ)) :=
 begin
   simp only [sub_mul, exp_inv],
   ext,
   simp only [one_div, coeff_mk, coeff_one, one_mul, coeff_exp,
   ring_hom.id_apply, linear_map.map_sub, rat.algebra_map_rat_rat],
   cases n,
   simp only [mul_one, nat.factorial_zero, if_true, eq_self_iff_true,
   nat.factorial_one, inv_one, nat.cast_one, mul_zero, pow_zero, sub_self],
   simp only [n.succ_ne_zero, sub_zero, if_false],
 end

variables {R : Type*} [ring R]

@[simp] lemma neg_one_pow_succ_succ {m : ℕ} : (-1 : R)^m.succ.succ = (-1)^m :=
begin
  change _ ^ (m + 2) = _,
  simp [pow_add],
end

@[simp] lemma neg_one_pow_succ_of_odd {m : ℕ}: (-1 : R) ^ (m + 1) = -(-1)^m :=
by simp [pow_add]

#check @power_series.coeff_zero_mul_X
#check @power_series.coeff_zero_X_mul

lemma power_series.coeff_zero_X_mul (φ : power_series R) : coeff R 0 (φ * X) = 0
:= by simp

lemma aux_exp2: mk (λ (n : ℕ), (-1:ℚ) ^ n * (coeff ℚ n) (X * exp ℚ)) =
(-X)*mk (λ (n : ℕ), (-1) ^ n * (coeff ℚ n) (exp ℚ)) :=
begin
  ext n,
  cases n,
  { simp only [←neg_mul_eq_neg_mul, power_series.coeff_zero_X_mul, coeff_mk,
      linear_map.map_neg, mul_zero, neg_zero],
    simp only [zero_mul, constant_coeff_X, coeff_zero_eq_constant_coeff,
    mul_zero, ring_hom.map_mul, neg_zero], },
  rw [mul_comm X, ←neg_mul_eq_neg_mul, mul_comm X, linear_map.map_neg],
  simp only [coeff_succ_mul_X, neg_mul_eq_neg_mul_symm, neg_one_pow_succ_of_odd, coeff_mk],
end

-- useful to have in mathlib?
theorem bernoulli_power_series':
  (exp ℚ - 1) * power_series.mk (λ n,
  ((-1)^n * bernoulli n / nat.factorial n : ℚ)) = X :=
begin
  have h: power_series.mk (λ n, (bernoulli n / nat.factorial n : ℚ)) * (exp ℚ - 1)
  = X * exp ℚ :=
  begin
    simp only [bernoulli_power_series],
  end,
  rw [minus_X, ←minus_X_mul, expmxm1, aux_exp2] at h,
  let f1 := mk (λ (n : ℕ), (-1:ℚ) ^ n * (coeff ℚ n) (mk (λ (n : ℕ), bernoulli n / ↑(n.factorial)))),
  let f2 := 1 - exp ℚ,
  have hf2 : f2 = 1 - exp ℚ := by refl,
  let f3 := mk (λ (n : ℕ), (-1) ^ n * (coeff ℚ n) (exp ℚ)),
  rw [←(mul_assoc f1 f2 f3)] at h,
  have hf3: f3 = mk (λ (n : ℕ), (-1) ^ n * (coeff ℚ n) (exp ℚ)) := by refl,
  rw [←hf3] at h,
  have hf3_nonzero: f3 ≠ 0 :=
  begin
    rw [hf3],
    simp [power_series.ext_iff],
    use 1,
    simp,
  end,
  have g: f1*f2 = -X :=
  begin
    apply mul_right_cancel' hf3_nonzero h,
  end,
  have hf1: f1 = mk (λ (n : ℕ), (-1:ℚ) ^ n * (coeff ℚ n) (mk (λ (n : ℕ), bernoulli n / ↑(n.factorial)))) := by refl,
  simp only [coeff_mk] at hf1,
  have hf1': f1 = mk (λ (n : ℕ), (-1) ^ n * bernoulli n / ↑(n.factorial)) :=
  begin
    simp only [hf1],
    simp only [ext_iff, coeff_mk],
    intro n,
    rw [mul_div_assoc],
  end,
  rw [←hf1'],
  have hf2':  - f2 = (exp ℚ - 1) :=
  begin
    rw [hf2],
    ring,
  end,
  rw [←hf2', ←neg_one_mul, mul_assoc, mul_comm f2, g],
  simp only [neg_mul_eq_neg_mul_symm, one_mul, neg_neg],
end

theorem cauchy_prod (n:ℕ):
power_series.mk (λ n,
  ((-1)^n* bernoulli n / nat.factorial n : ℚ))*
  power_series.mk (λ p, (n:ℚ)^p.succ/(p.succ.factorial))  =
 power_series.mk (λp,
 ((finset.range p.succ).sum(λ i,
 (-1)^i*(bernoulli i)*(p.succ.choose i)*n^(p + 1 - i)/((p.factorial)*(p + 1))))) :=
begin
  ext q,
  rw [power_series.coeff_mul],
  simp only [coeff_mk, coeff_mk, nat.factorial, nat.cast_succ,
  nat.factorial_succ, nat.cast_mul],
  let f: ℕ →  ℕ → ℚ := λ (a : ℕ), λ (b: ℕ),
  (-1) ^ a * bernoulli a / ↑(a.factorial) *
    (↑n ^ b.succ / ((↑(b) + 1) * ↑(b.factorial))),
  rw [finset.nat.sum_antidiagonal_eq_sum_range_succ f],
  have h: ∀ k:ℕ, (k ∈ (finset.range q.succ)) →
   (f k (q - k) = (-1) ^ k * bernoulli k * ↑(q.succ.choose k) *
  ↑n ^ (q + 1 - k) / (↑(q.factorial) * (↑q + 1)) ):=
  begin
    simp only [finset.mem_range],
    intros k g,
    simp [f],
    ring,
    have hfac:
    ((↑(q - k) + 1) * ↑((q - k).factorial))⁻¹ * ↑n ^ (q - k).succ * (↑(k.factorial))⁻¹ =
  (↑(q.factorial) * (↑q + (1:ℚ )))⁻¹ * ↑n ^ (q + 1 - k) * ↑(q.succ.choose k):=
    begin
      have exp_succ: (q - k).succ = (q + 1 - k) := by omega,
      rw [exp_succ],
      have h_choose: (q.succ.choose k) =
      ((q + 1).factorial)/((k.factorial)*(q + 1 - k).factorial) :=
      begin
        rw nat.choose_eq_factorial_div_factorial,
        exact le_of_lt g,
      end,
      rw [h_choose],
      have h_exp_fac2: (q + 1 - k).factorial
        =((((q - k)).factorial)*(q - k +1)) :=
        begin
          have hqk1: q -k + 1 = (q - k).succ := by refl,
          rw [hqk1, nat.mul_comm, ←nat.factorial_succ],
          have hq1: q + 1 - k = (q - k).succ := eq.symm exp_succ,
          rw [hq1],
        end,
      rw [h_exp_fac2, mul_comm ↑(q.factorial)],
      have hqqsucc: (q:ℚ) + 1 = q.succ := by rw [←nat.cast_succ],
      have hqqsucc': (q:ℕ) + 1 = q.succ := by simp,
      simp only [hqqsucc],
      have hcoeq: ((q.succ):ℚ) * ((q.factorial):ℚ) =(((q.succ.factorial:ℕ)):ℚ) := by norm_cast,
      rw [hcoeq, mul_comm (↑(q.succ.factorial))⁻¹ , mul_assoc ((n:ℚ) ^ (q + 1 - k))],
      simp only [div_eq_mul_inv],
      rw [hqqsucc'],
      have hqsuccnezero: q.succ ≠ 0 := by contradiction,
      rw [mul_assoc, inv_eq_one_div ↑(q.succ.factorial),  ← division_def, div_eq_mul_one_div],
      have hfacprod:  ↑(k.factorial * (q + 1 - k).factorial) ≠  0 :=
      begin
        have hmfacnezero: k.factorial ≠ 0:= ne_of_gt k.factorial_pos,
        have hnmfacnezero: (q + 1 - k).factorial ≠ 0 :=
          begin
           have hm: ∃ m, m = q + 1 - k:=
            begin
              simp only [exists_apply_eq_apply],
           end,
          refine ne_of_gt _,
          cases hm with m hm,
          have hmfac: m.factorial >0 :=  m.factorial_pos,
          rw hm at hmfac,
          exact hmfac,
        end,
        have hnn: k.factorial * (q + 1 - k).factorial ≠ 0 := mul_ne_zero hmfacnezero hnmfacnezero,
        simp only [hnn, nat.cast_id, ne.def, not_false_iff],
      end,
      rw [←h_exp_fac2, nat.cast_dvd],
      simp only [← mul_div_assoc],
      rw [one_div_mul_cancel, ←nat.cast_add_one, ←nat.cast_mul,
      mul_comm (q - k + 1) _, ← h_exp_fac2, mul_comm, ← division_def,
      div_div_eq_div_mul, nat.cast_mul, mul_comm (↑(k.factorial)) _],
      simp,
      rw not_or_distrib,
      split,
      refine ne.elim _,
      exact nat.cast_add_one_ne_zero q,
      refine ne.elim _,
      exact nat.factorial_ne_zero q,
      rw hqqsucc',
      exact nat.factorial_mul_factorial_dvd_factorial (nat.le_of_lt g),
      simp only [ne.def, nat.cast_eq_zero, mul_eq_zero],
      simp only [nat.factorial_ne_zero, not_false_iff, or_self],
      end,
    rw [hfac],
  end,
  refine finset.sum_congr rfl _,
  exact h,
end

theorem power_series_equal (n:ℕ):
(power_series.mk (λ p, (finset.range n).sum(λk, (k:ℚ)^p)/(p.factorial))) =
 (power_series.mk (λ p,((finset.range p.succ).sum(λ i,
 (-1)^i*(bernoulli i)*(p.succ.choose i)*n^(p + 1 - i)/((p.factorial)*(p + 1)))))) :=
 begin
   let left := (power_series.mk (λ p, (finset.range n).sum(λk, (k:ℚ)^p)/(p.factorial))) ,
   have hleft: left =(power_series.mk (λ p, (finset.range n).sum(λk, (k:ℚ)^p)/(p.factorial))) := by refl,
   let right := (power_series.mk (λ p,((finset.range p.succ).sum(λ i,
 (-1)^i*(bernoulli i)*(p.succ.choose i)*n^(p + 1 - i)/((p.factorial)*(p + 1)))))),
   have hright: right =(power_series.mk (λ p,((finset.range p.succ).sum(λ i,
 (-1)^i*(bernoulli i)*(p.succ.choose i)*n^(p + 1 - i)/((p.factorial)*(p + 1)))))) := by refl,
  have h: (exp ℚ - 1)*left = (exp ℚ - 1)*right :=
  begin
   rw [hleft, ←expand_tonelli],
   have hfin: (finset.range n).sum (λ (k : ℕ),
   mk (λ (n : ℕ), (k:ℚ) ^ n / ↑(n.factorial))) =
   (finset.range n).sum(λ k, expk k) :=
   begin
     simp only [expkrw],
   end,
   rw [hfin, special_sum_inf_geo_seq, right_series, ←bernoulli_power_series',
   mul_assoc, cauchy_prod],
  end,
  have hexpnezero: (exp ℚ - 1) ≠ 0 :=
  begin
    rw [exp],
    simp only [ext_iff, linear_map.map_zero, one_div, coeff_mk, coeff_one,
    ring_hom.id_apply, linear_map.map_sub, ne.def, not_forall,
    rat.algebra_map_rat_rat],
    use 1,
    simp only [nat.factorial_one, sub_zero, if_false, inv_one, not_false_iff,
    one_ne_zero, nat.cast_one],
  end,
  apply mul_left_cancel' hexpnezero h,
 end

theorem faulhaber_long' (n: ℕ): ∀p,
(coeff ℚ p) (power_series.mk (λ p, (finset.range n).sum(λk, (k:ℚ)^p)/(p.factorial))) =
 (coeff ℚ p) (power_series.mk (λp,
 ((finset.range p.succ).sum(λ i, (-1)^i*(bernoulli i)*
 (p.succ.choose i)*n^(p + 1 - i)/((p.factorial)*(p + 1))))))  :=
 begin
   exact power_series.ext_iff.mp (power_series_equal n),
 end

theorem faulhaber' (n p:ℕ):
(finset.range n).sum(λk, (k:ℚ)^p) =
((finset.range p.succ).sum(λ i,
 (-1)^i*(bernoulli i)*(p.succ.choose i)*n^(p + 1 - i)/p.succ)) :=
begin
 have hfaulhaber_long': (coeff ℚ p) (power_series.mk (λ p, (finset.range n).sum(λk, (k:ℚ)^p)/(p.factorial))) =
 (coeff ℚ p) (power_series.mk (λp,
 ((finset.range p.succ).sum(λ i, (-1)^i*(bernoulli i)*
 (p.succ.choose i)*n^(p + 1 - i)/((p.factorial)*(p + 1)) )))) := faulhaber_long' n p,
 simp only [power_series.coeff_mk] at hfaulhaber_long',
 rw [div_eq_mul_inv, mul_comm ((p.factorial):ℚ ) _] at hfaulhaber_long',
 have hfl: (finset.range n).sum (λ (k : ℕ), ↑k ^ p) * (↑(p.factorial))⁻¹ =
  ((finset.range p.succ).sum
    (λ (i : ℕ), (-1) ^ i * bernoulli i * ↑(p.succ.choose i) * ↑n ^ (p + 1 - i))
    / ((↑p + 1) * ↑(p.factorial))) :=
    begin
      simp [hfaulhaber_long'],
      rw div_eq_mul_one_div,
      simp only [finset.sum_mul, one_div],
      refine finset.sum_congr  _ _,
      refl,
      intros k hk,
      rw [div_eq_mul_one_div, one_div],
    end,
 clear hfaulhaber_long',
 rw [div_mul_eq_div_mul_one_div ] at hfl,
 simp at hfl,
 have hp: (p.factorial) ≠ 0:= nat.factorial_ne_zero p,
 cases hfl,
 simp only [nat.cast_succ],
 rw [hfl, div_eq_mul_one_div],
 simp only [finset.sum_mul, one_div],
 refine finset.sum_congr  _ _,
 refl,
 intro k,
 intro hk,
 rw [div_eq_mul_one_div, one_div],
 by_contradiction,
 exact hp hfl,
end
-- useful to have in mathlib?
lemma bernoulli_fst_snd (n:ℕ): 1 < n → bernoulli n = (-1)^n * bernoulli n :=
begin
  intro hn,
  by_cases odd n,
  rw [bernoulli_odd_eq_zero h hn],
  simp only [mul_zero],
  have heven: even n := nat.even_iff_not_odd.mpr h,
  have heven_power: even n → (-(1:ℚ))^n = 1 := nat.neg_one_pow_of_even,
  rw [heven_power heven],
  simp only [one_mul],
end

lemma faulhaber (n:ℕ) (p:ℕ) (hp: 0 <p):
(finset.range n.succ).sum (λ k, ↑k^p) =
((finset.range p.succ).sum (λ j, ((bernoulli j)*(nat.choose p.succ j))
*n^(p + 1 - j)/(p.succ))) :=
begin
  rw [finset.sum_range_succ, faulhaber' n p],
  have h2: (1:ℕ).succ ≤ p.succ :=
  begin
    apply nat.succ_le_succ,
    exact nat.one_le_of_lt hp,
  end,
  rw [finset.range_eq_Ico],
  have hsplit:
  finset.Ico 0 (1:ℕ).succ ∪ finset.Ico (1:ℕ).succ p.succ =
  finset.Ico 0 p.succ :=
  finset.Ico.union_consecutive (nat.zero_le (1:ℕ).succ)   h2,
  have hdisjoint:
  disjoint (finset.Ico 0 (1:ℕ).succ)  (finset.Ico (1:ℕ).succ p.succ) :=
  finset.Ico.disjoint_consecutive 0 (1:ℕ).succ p.succ,
  rw [←hsplit, finset.sum_union hdisjoint, ←finset.range_eq_Ico,
  finset.sum_range_succ],
  have h_zeroth_summand:
  (finset.range (1:ℕ)).sum (λ (x : ℕ), (-1) ^ x * bernoulli x *
  ↑(p.succ.choose x) * ↑n ^ (p + 1 - x) / ↑(p.succ)) =
  (finset.range 1).sum (λ (x : ℕ), bernoulli x *
  ↑(p.succ.choose x) * ↑n ^ (p + 1 - x) / ↑(p.succ)) :=
  begin
    simp only [one_mul, finset.sum_singleton, finset.range_one, pow_zero],
  end,
  have h_fst_summand'':
  (n:ℚ)^p*(p.succ) + (((-1) ^ 1)  * (bernoulli 1) * (p.succ.choose 1) * n ^(p + 1 - 1)) =
  ((bernoulli 1) * (p.succ.choose 1) * n ^(p + 1 - 1)) :=
  begin
    simp only [neg_mul_eq_neg_mul_symm, one_div, bernoulli_one,
    neg_one_pow_succ_of_odd, nat.add_succ_sub_one, add_zero, one_mul,
    nat.choose_one_right, nat.cast_succ, pow_zero],
    ring,
  end,
   have h_fst_summand':
  ((n:ℚ)^p*(p.succ) + (((-1) ^ 1) * (bernoulli 1) * (p.succ.choose 1) * n ^(p + 1 - 1)))/p.succ =
  ((bernoulli 1) * (p.succ.choose 1) * n ^(p + 1 - 1))/p.succ :=
  begin
    rw [←h_fst_summand''],
  end,
   have h_fst_summand:
  (n:ℚ)^p + (((-1) ^ 1) * (bernoulli 1) * (p.succ.choose 1) * n ^(p + 1 - 1))/p.succ =
  ((bernoulli 1) * (p.succ.choose 1) * n ^(p + 1 - 1))/p.succ :=
  begin
    rw [←h_fst_summand', eq_div_iff_mul_eq],
    simp only [neg_mul_eq_neg_mul_symm, one_div, bernoulli_one,
    neg_one_pow_succ_of_odd, nat.add_succ_sub_one, add_zero, one_mul,
    nat.choose_one_right, nat.cast_succ, pow_zero],
    rw [add_mul],
    simp only [add_right_inj],
    rw [neg_div, neg_mul_eq_neg_mul_symm, mul_assoc],
    have hpnezero: (p.succ:ℚ)  ≠ 0 :=
    begin
      apply ne_of_gt,
      simp only [gt_iff_lt, nat.cast_succ],
      exact nat.cast_add_one_pos _,
    end,
    simp only [neg_inj],
    { field_simp, ring },
    apply ne_of_gt,
    simp only [gt_iff_lt, nat.cast_succ],
    exact nat.cast_add_one_pos _,
  end,
  have h_large_summands:
  (finset.Ico (1:ℕ).succ p.succ).sum  (λ (x : ℕ), (-1) ^ x * bernoulli x
  * ↑(p.succ.choose x) * ↑n ^ (p + 1 - x) / ↑(p.succ)) =
  (finset.Ico (1:ℕ).succ p.succ).sum  (λ (x : ℕ), bernoulli x
  * ↑(p.succ.choose x) * ↑n ^ (p + 1 - x) / ↑(p.succ)) :=
  begin
    refine finset.sum_congr _ _,
    refl,
    intros x hin,
    have h1x: 1 < x :=
    begin
      rw [finset.Ico.mem] at hin,
      exact_mod_cast hin.1,
    end,
    rw [←bernoulli_fst_snd x h1x],
  end,
  simp only [←add_assoc, h_zeroth_summand, h_fst_summand, h_large_summands],
  simp only [←(finset.sum_range_succ (λ (x : ℕ), bernoulli x * ↑(p.succ.choose x) *
   ↑n ^ (p + 1 - x) / ↑(p.succ)) 1)],
   rw [finset.range_eq_Ico],
   have honeone: 1 + 1 = (1:ℕ).succ := rfl,
   rw [honeone, ←finset.sum_union hdisjoint],
end


theorem Ex004(a b c : Prop):(a → (b ∧ c)) → (a → b) :=
assume H1:(a → (b ∧ c)),
  assume H2:a,
  have A:b ∧ c, from H1 H2,
  show b, from and.elim_left A


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin
-/
import group_theory.free_abelian_group

/-!
# Free rings

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

The theory of the free ring over a type.

## Main definitions

* `free_ring α` : the free (not commutative in general) ring over a type.
* `lift (f : α → R)` : the ring hom `free_ring α →+* R` induced by `f`.
* `map (f : α → β)` : the ring hom `free_ring α →+* free_ring β` induced by `f`.

## Implementation details

`free_ring α` is implemented as the free abelian group over the free monoid on `α`.

## Tags

free ring

-/

universes u v

/-- The free ring over a type `α`. -/
@[derive [ring, inhabited]]
def free_ring (α : Type u) : Type u :=
free_abelian_group $ free_monoid α

namespace free_ring

variables {α : Type u}

/-- The canonical map from α to `free_ring α`. -/
def of (x : α) : free_ring α :=
free_abelian_group.of (free_monoid.of x)

lemma of_injective : function.injective (of : α → free_ring α) :=
free_abelian_group.of_injective.comp free_monoid.of_injective

@[elab_as_eliminator] protected lemma induction_on
  {C : free_ring α → Prop} (z : free_ring α)
  (hn1 : C (-1)) (hb : ∀ b, C (of b))
  (ha : ∀ x y, C x → C y → C (x + y))
  (hm : ∀ x y, C x → C y → C (x * y)) : C z :=
have hn : ∀ x, C x → C (-x), from λ x ih, neg_one_mul x ▸ hm _ _ hn1 ih,
have h1 : C 1, from neg_neg (1 : free_ring α) ▸ hn _ hn1,
free_abelian_group.induction_on z
  (add_left_neg (1 : free_ring α) ▸ ha _ _ hn1 h1)
  (λ m, list.rec_on m h1 $ λ a m ih, hm _ _ (hb a) ih)
  (λ m ih, hn _ ih)
  ha

section lift

variables {R : Type v} [ring R] (f : α → R)

/-- The ring homomorphism `free_ring α →+* R` induced from a map `α → R`. -/
def lift : (α → R) ≃ (free_ring α →+* R) :=
free_monoid.lift.trans free_abelian_group.lift_monoid

@[simp] lemma lift_of (x : α) : lift f (of x) = f x :=
congr_fun (lift.left_inv f) x

@[simp] lemma lift_comp_of (f : free_ring α →+* R) : lift (f ∘ of) = f :=
lift.right_inv f

@[ext]
lemma hom_ext ⦃f g : free_ring α →+* R⦄ (h : ∀ x, f (of x) = g (of x)) :
  f = g :=
lift.symm.injective (funext h)

end lift

variables {β : Type v} (f : α → β)

/-- The canonical ring homomorphism `free_ring α →+* free_ring β` generated by a map `α → β`. -/
def map : free_ring α →+* free_ring β :=
lift $ of ∘ f

@[simp]
lemma map_of (x : α) : map f (of x) = of (f x) := lift_of _ _

end free_ring


variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  ⟨ λ pq : p ∧ q => ⟨pq.2 , pq.1⟩
  , λ qp : q ∧ p => ⟨qp.2 , qp.1⟩ ⟩

example : p ∨ q ↔ q ∨ p :=
  ⟨ λ pq : p ∨ q =>
    pq.elim
      (λ x : p => Or.inr x)
      (λ x : q => Or.inl x)
  , λ qp : q ∨ p =>
    qp.elim
      (λ x : q => Or.inr x)
      (λ x : p => Or.inl x) ⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  ⟨ λ x : (p ∧ q) ∧ r =>
    ⟨x.1.1, ⟨x.1.2, x.2⟩⟩
  , λ x : p ∧ (q ∧ r) =>
    ⟨⟨x.1, x.2.1⟩, x.2.2⟩ ⟩

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  ⟨ λ pqr : (p ∨ q) ∨ r =>
    pqr.elim
      (λ pq : p ∨ q =>
        pq.elim
          (λ x : p => Or.inl x)
          (λ x : q => Or.inr (Or.inl x)))
      (λ x : r => Or.inr (Or.inr x))
  , λ pqr : p ∨ (q ∨ r) =>
    pqr.elim
      (λ x : p => Or.inl (Or.inl x))
      (λ qr : q ∨ r =>
        qr.elim
          (λ x : q => Or.inl (Or.inr x))
          (λ x : r => Or.inr x)) ⟩

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  ⟨ λ pqr : p ∧ (q ∨ r) =>
    pqr.2.elim
      (λ y : q =>
        Or.inl ⟨pqr.1, y⟩ )
      (λ y : r =>
        Or.inr ⟨pqr.1, y⟩ )
  , λ pqpr : (p ∧ q) ∨ (p ∧ r) =>
    pqpr.elim
      (λ pq : p ∧ q =>
        ⟨pq.1, Or.inl pq.2⟩)
      (λ pr : p ∧ r =>
        ⟨pr.1, Or.inr pr.2⟩)⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  ⟨ λ pqr : p ∨ (q ∧ r) =>
    pqr.elim
      (λ x : p =>
        ⟨Or.inl x, Or.inl x⟩)
      (λ qr : q ∧ r =>
        ⟨Or.inr qr.1, Or.inr qr.2⟩),
    λ pqpr : (p ∨ q) ∧ (p ∨ r) =>
      pqpr.1.elim
        (λ x : p => Or.inl x)
        (λ x : q =>
          pqpr.2.elim
            (λ y : p => Or.inl y)
            (λ y : r => Or.inr ⟨x, y⟩)) ⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  Iff.intro
    (λ hpqr : p → q → r =>
        λ hpq : p ∧ q =>
          hpqr hpq.1 hpq.2)
    (λ hpqr : (p ∧ q) → r =>
        λ hp : p =>
          λ hq : q =>
            hpqr ⟨hp, hq⟩)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  ⟨ λ h : (p ∨ q) → r =>
    ⟨ λ hp : p =>
      h (Or.inl hp)
    , λ hq : q =>
      h (Or.inr hq) ⟩
  , λ h : (p → r) ∧ (q → r) =>
    λ hpq : p ∨ q =>
      hpq.elim h.left h.right⟩

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  ⟨
    λ h : ¬(p ∨ q) =>
      ⟨ λ hp : p => h (Or.inl hp)
      , λ hq : q => h (Or.inr hq)⟩,
    λ h : ¬p ∧ ¬q =>
      λ hpq : p ∨ q =>
        hpq.elim h.left h.right
  ⟩

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  λ h : ¬p ∨ ¬q =>
    λ hpq : p ∧ q =>
      h.elim
        (λ hnp : ¬p => hnp hpq.left)
        (λ hnq : ¬q => hnq hpq.right)

example : ¬(p ∧ ¬p) :=
  λ h : p ∧ ¬p => h.right h.left

example : p ∧ ¬q → ¬(p → q) :=
  λ h : p ∧ ¬q =>
    λ npq : p → q =>
      h.right (npq h.left)

example : ¬p → (p → q) :=
  λ hnp : ¬p =>
    λ hp : p =>
      absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
  λ h : ¬p ∨ q =>
    λ hp : p =>
      h.elim
        (λ hnp : ¬p => absurd hp hnp)
        (λ hq : q => hq)

example : p ∨ False ↔ p :=
  ⟨
    λ h : p ∨ False =>
      h.elim
        (λ hp : p => hp)
        (λ hFalse : False => False.elim hFalse),
    λ h : p =>
      Or.inl h
  ⟩

example : p ∧ False ↔ False :=
  ⟨
    λ h : p ∧ False => h.right,
    λ h : False => ⟨False.elim h, h⟩
  ⟩

example : (p → q) → (¬q → ¬p) :=
  λ h : p → q =>
    λ hnq : ¬q =>
      λ hp : p =>
        hnq (h hp)

open Classical

example : (p → q ∨ r) → ((p → q) ∨ (p → r)) :=
  λ h : p → q ∨ r =>
    (em p).elim
      (λ hp : p =>
        (h hp).elim
          (λ hq : q => Or.inl (λ _ : p => hq))
          (λ hr : r => Or.inr (λ _ : p => hr)))
      (λ hnp : ¬p =>
        Or.inl (λ hp : p => absurd hp hnp))

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  λ h : ¬(p ∧ q) =>
    Or.elim (em p)
      (λ hp : p =>
        Or.elim (em q)
          (λ hq : q => absurd ⟨hp, hq⟩ h )
          (λ hnq : ¬q => Or.inr hnq))
      (λ hnp : ¬p => Or.inl hnp)

example : ¬(p → q) → p ∧ ¬q :=
  λ h : ¬(p → q) =>
    Or.elim (em q)
      (λ hq : q =>
        absurd (λ _ : p => hq) h)
      (λ hnq : ¬q =>
        Or.elim (em p)
          (λ hp : p => ⟨ hp, hnq ⟩)
          (λ hnp : ¬p =>
            absurd (λ hp : p => absurd hp hnp) h))

example : (p → q) → (¬p ∨ q) :=
  λ h : p → q =>
    Or.elim (em p)
      (λ hp : p => Or.inr (h hp))
      (λ hnp : ¬p => Or.inl hnp)

example : (¬q → ¬p) → (p → q) :=
  λ h : ¬q → ¬p =>
    Or.elim (em p)
      (λ hp : p =>
        Or.elim (em q)
          (λ hq : q =>
            λ _ : p => hq)
          (λ hnq : ¬q => absurd hp (h hnq)))
      (λ hnp : ¬p =>
        λ hp : p => absurd hp hnp)

example : p ∨ ¬p :=
  em p

example : (((p → q) → p) → p) :=
  λ h : (p → q) → p =>
    Or.elim (em p)
      (λ hp : p => hp)
      (λ hnp : ¬p =>
        h (λ hp : p => absurd hp hnp))

-- Prove ¬(p ↔ ¬p) without using classical logic.
example : ¬(p ↔ ¬p) :=
  λ ⟨h1, h2⟩ =>
    let hp := h2 (λ hp => (h1 hp) hp)
    (h1 hp) hp


namespace xena

inductive xnat
| zero : xnat
| succ (n : xnat) : xnat

open xnat

--instance : has_zero xnat := ⟨zero⟩

def add : xnat → xnat → xnat
| m zero := m
| m (succ n) := succ (add m n)

instance : has_add xnat := ⟨add⟩

lemma add_zero (n : xnat) : n + zero = n :=
begin
  refl
end

lemma zero_add (n : xnat) : zero + n = n :=
begin
  induction n with d hd,
  {
    refl
  },
  {
    show succ (zero + d) = succ d,
    rw hd
  }
end

lemma add_assoc (a b c : xnat) : (a + b) + c = a + (b + c) :=
begin
  induction c with d hd,
  { -- (a + b) + zero = a + (b + zero)
    show (a + b) = a + (b + zero),
    show a + b = a + b,
    refl,
  },
  { -- (a + b) + succ d = a + (b + succ d)
    show succ ((a + b) + d) = a + succ (b + d),
    show succ ((a + b) + d) = succ (a + (b + d)),
    rw hd,
  }
end

def one := succ zero
definition two := succ one

example : one + one = two :=
begin
refl
end

lemma add_one (n : xnat) : n + one = succ n :=
begin
  refl
end

lemma one_add (n : xnat) : one + n = succ n :=
begin
  induction n with d hd,
  {
    refl
  },
  {
    show succ (one + d) = _,
    rw hd
  }
end

-- trying to prove add_comm immediately fails, because
-- this is missing:

lemma succ_add (a b : xnat) : succ a + b = succ (a + b) :=
begin
  induction b with d hd,
  {
    refl
  },
  {
    show succ (succ a + d) = _,
    rw hd,
    refl
  }
end

-- theorem add_succ_equals_succ (a b : xnat) : a + (succ b) = succ (a + b) := sorry

lemma add_comm (a b : xnat) : a + b = b + a :=
begin
  induction b with d hd,
  {
    rw zero_add,
    rw add_zero
  },
  {
    show succ (a + d) = _,
    rw hd,
    rw succ_add,
  }
end

/-
theorem eq_iff_succ_eq_succ (a b : xnat) : succ a = succ b ↔ a = b :=
begin
split,
  exact succ.inj,
assume H : a = b,
rw [H]
end

theorem add_cancel_right (a b t : xnat) :  a = b ↔ a+t = b+t :=
begin
split,
assume H : a = b,
rw [H],
assume P : a+t = b+t,
induction t with s Qs,
have h3: a = a + zero, by exact add_zero a,
have h4: b = b+ zero, by exact add_zero b,
rw [h3, h4], assumption,
rw [Qs],
unfold add at P,
rw [eq_iff_succ_eq_succ] at P,assumption
end

lemma zero_of_add_eq (a b : ℕ) : a + b = a → b = 0 :=
begin
  intro h,
  induction a with a ha,
    rw zero_add at h, assumption,
  apply ha,
  apply succ_inj,
  rw ←h,
  simp,
end

-/

def mul : xnat → xnat → xnat
| m zero := zero
| m (succ n) := mul m n + m

instance : has_mul xnat := ⟨mul⟩
-- notation a * b := mul a b

example : one * one = one :=
begin
refl
end

lemma mul_zero (m : xnat) : m * zero = zero := rfl

lemma zero_mul (m : xnat) : zero * m = zero :=
begin
  induction m with d hd,
  {
    refl
  },
  {
    show zero * d + _ = _,
    rw hd,
    refl
  }
end

lemma mul_one (m : xnat) : m * one = m :=
begin
  exact zero_add m, -- good exercise: see why this works
end

lemma one_mul (m : xnat) : one * m = m :=
begin
  induction m with d hd,
  {
    refl,
  },
  {
    show one * d + one = _,
    rw hd,
    refl
  }
end

-- mul_assoc immediately, leads to this:
-- ⊢ a * (b * d) + a * b = a * (b * d + b)

lemma mul_add (a b c : xnat) : a * (b + c) = a * b + a * c :=
begin
  induction c with d hd,
  {
    refl
  },
  {
    show a * succ (b + d) = _,
    show a * (b + d) + _ = _,
    rw hd,
    apply add_assoc, -- ;-)
  }
end

lemma mul_assoc (a b c : xnat) : (a * b) * c = a * (b * c) :=
begin
  induction c with d hd,
  {
    refl
  },
  {
    show (a * b) * d + (a * b) = _,
    rw hd,
    show _ = a * (b * d + _),
    rw mul_add
  }
end

-- mul_comm leads to ⊢ a * d + a = succ d * a
-- so perhaps we need add_mul
-- but add_mul leads to either a+b+c=a+c+b or (a+b)+(c+d)=(a+c)+(b+d)
-- (depending on whether we do induction on b or c)

lemma add_right_comm (a b c : xnat) : a + b + c = a + c + b :=
begin
  rw add_assoc,
  rw add_comm b c,
  rw ←add_assoc,
end

lemma succ_mul (a b : xnat) : succ a * b = a * b + b :=
begin
  induction b with d hd,
  {
    refl
  },
  {
    show (succ a) * d + (succ a) = (a * d + a) + _,
    rw hd,
    show succ (a * d + d + a) = succ (a * d + a + d),
    rw add_right_comm
  }
end

-- turns out I don't actually need this for mul_comm
lemma add_mul (a b c : xnat) : (a + b) * c = a * c + b * c :=
begin
  induction b with d hd,
  {
    rw zero_mul,
    refl,
  },
  {
    change succ (a + d) * c = _,
    rw succ_mul,
    rw hd,
    rw succ_mul,
    rw add_assoc
  }
end

lemma mul_comm (a b : xnat) : a * b = b * a :=
begin
  induction b with d hd,
  {
    rw zero_mul,
    refl
  },
  {
    rw succ_mul,
    rw ←hd,
    show a * (d + one) = _,
    rw mul_add,
    rw mul_one
  }
end

-- axiom 4 would follow from
theorem mul_pos (a b : xnat) : a ≠ zero → b ≠ zero → a * b ≠ zero := sorry

inductive le2 : xnat → xnat → Prop
| refl (a : xnat) : le2 a a
| succ (a b : xnat) : le2 a b → le2 a (succ b)

/-

definition lt : xnat → xnat → Prop
| zero zero := false
| (succ m) zero := false
| zero (succ p) := true
| (succ m) (succ p) := lt m p

definition gt : xnat → xnat → Prop
| zero zero := false
| (succ m) zero := true
| zero (succ p) := false
| (succ m) (succ p) := gt m p

-/

instance : has_le xnat := ⟨le2⟩
-- notation a < b := lt a b
-- notation b > a := lt a b

lemma zero_le (a : xnat) : zero ≤ a :=
begin
  induction a with d hd,
  {
    exact le2.refl zero
  },
  {
    exact le2.succ zero d hd
  }
end

lemma le_zero (a : xnat) : a ≤ zero → a = zero :=
begin
  intro h,
  cases h,
  refl
end

lemma le_refl (a : xnat) : a ≤ a :=
begin
  exact le2.refl a
end

lemma succ_le_succ (a b : xnat) (h : a ≤ b) : succ a ≤ succ b :=
begin
  revert a,
  induction b with d hd,
  {
    intros a ha,
    rw le_zero a ha,
    exact le_refl _
  },
  {
    intros a ha,
    cases ha with _ _ b hb, -- le2 leakage and random _'s
    { apply le2.refl,
    },
    {
      apply le2.succ, -- le2 leakage
      apply hd,
      assumption
    }
  }
end

-- axiom 1
theorem le_add_right (a b t : xnat) : a ≤ b → (a + t) ≤ (b + t) :=
begin
  intro h,
  induction t with d hd,
  {
    exact h
  },
  {
    show succ (a + d) ≤ succ (b + d),
    exact succ_le_succ _ _ hd
  }
end

-- axiom 2
theorem le_trans (a b c : xnat) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
begin
  revert a b,
  induction c with d hd,
  {
    intros a b hab hb0,
    cases hb0,
    cases hab,
    apply le_refl
  },
  {
    intros a b hab hb,
    cases hb with _ _ c hc,
      assumption,
    apply le2.succ,
    apply hd a b hab,
    assumption
  }
end

-- axiom 3.1
theorem le_symm_thing (a b : xnat) : a ≤ b ∨ b ≤ a :=
begin
  revert a,
  induction b with c hc,
    intro a, right, apply zero_le,
  intro a,
  induction a with d hd,
    left, apply zero_le,
  cases hc d with h h,
    left, exact succ_le_succ _ _ h,
    right, exact succ_le_succ _ _ h,
end

theorem le_succ (a : xnat) : a ≤ succ a :=
begin
  apply le2.succ,
  apply le2.refl
end

theorem le_of_succ_le_succ (a b : xnat) : succ a ≤ succ b → a ≤ b :=
begin
  intro h,
  cases h with _ _ a ha,
    apply le_refl,
  apply le_trans _ _ _ _ ha,
  apply le_succ
end

-- axiom 3.2
theorem le_symm_other_thing (a b : xnat) : a ≤ b → b ≤ a → a = b :=
begin
  revert a,
  induction b with d hd,
  {
    intros a ha h,
    cases ha,
    refl,
  },
  { intro a,
    cases a with a,
      intros h1 h2, cases h2,
    intros had hda,
    congr,
    apply hd,
      exact le_of_succ_le_succ _ _ had,
      exact le_of_succ_le_succ _ _ hda
  }
end

end xena

#exit

/-
import data.nat.dist -- distance function
import data.nat.gcd -- gcd
import data.nat.modeq -- modular arithmetic
import data.nat.prime -- prime number stuff
import data.nat.sqrt  -- square roots

-- factorials

example (a : ℕ) : fact a > 0 := fact_pos a

example : fact 4 = 24 := rfl -- factorial

-- distances

example : dist 6 4 = 2 := rfl -- distance function

example (a b : ℕ) : a ≠ b → dist a b > 0 := dist_pos_of_ne

-- gcd

example (a b : ℕ) : gcd a b ∣ a ∧ gcd a b ∣ b := gcd_dvd a b

example : lcm 6 4 = 12 := rfl

example (a b : ℕ) : lcm a b = lcm b a := lcm_comm a b
example (a b : ℕ) : gcd a b * lcm a b = a * b := gcd_mul_lcm a b

example (a b : ℕ) : (∀ k : ℕ, k > 1 → k ∣ a → ¬ (k ∣ b) ) → coprime a b := coprime_of_dvd

-- type the congruence symbol with \==

example : 5 ≡ 8 [MOD 3] := rfl

example (a b c d m : ℕ) : a ≡ b [MOD m] → c ≡ d [MOD m] → a * c ≡ b * d [MOD m] := modeq.modeq_mul

-- nat.sqrt is integer square root (it rounds down).

#eval sqrt 1000047
-- returns 1000

example (a : ℕ) : sqrt (a * a) = a := sqrt_eq a

example (a b : ℕ) : sqrt a < b ↔ a < b * b := sqrt_lt

-- nat.prime n returns whether n is prime or not.
-- We can prove 59 is prime if we first tell Lean that primality
-- is decidable. But it's slow because the algorithms are
-- not optimised for the kernel.

instance : decidable (prime 59) := decidable_prime_1 59
example : prime 59 := dec_trivial

example (p : ℕ) : prime p → p ≥ 2 := prime.ge_two

example (p : ℕ) : prime p ↔ p ≥ 2 ∧ ∀ m, 2 ≤ m → m ≤ sqrt p → ¬ (m ∣ p) := prime_def_le_sqrt

example (p : ℕ) : prime p → (∀ m, coprime p m ∨ p ∣ m) := coprime_or_dvd_of_prime

example : ∀ n, ∃ p, p ≥ n ∧ prime p := exists_infinite_primes

-- min_fac returns the smallest prime factor of n (or junk if it doesn't have one)

example : min_fac 12 = 2 := rfl

-- `factors n` is the prime factorization of `n`, listed in increasing order.
-- As far as I can see this isn't decidable, and doesn't seem to reduce either.
-- But we can evaluate it in the virtual machine using #eval .

#eval factors (2^32+1)
-- [641, 6700417]

Prove every positive integer is uniquely the product of primes?

subtraction with weird notation

-/


def hello := "world"

variable (p q : Prop)

variable (p q r : Prop)

example (h: p -> q) (nq : ¬q) : ¬p :=
  fun hp : p => nq (h hp)

-- Note that (p->q) -> (not q -> not p) is constructive
-- But (not q -> not p) -> (p -> q) is classical

#check Trans
#check And.intro

def f (x y z : Nat) : Nat :=
  match x, y, z with
  | 5, _, _ => y
  | _, 5, _ => y
  | _, _, 5 => y
  | _, _, _ => 1

example (x y z : Nat) : x ≠ 5 → y ≠ 5 → z ≠ 5 → z = w → f x y w = 1 := by
  intros
  simp [f]
  split
  . contradiction
  . contradiction
  . contradiction
  . rfl

example (p q : Prop) : p ∨ q → q ∨ p := by
  intro h
  cases h with
  | inl hp => apply Or.inr; exact hp
  | inr hq => apply Or.inl; exact hq

example (h : p ∧ q) : q ∧ p :=
  have hp: p := h.left;
  have hq: q := h.right;
  And.intro hq hp

inductive NN where
| zero : NN
| succ : NN -> NN
deriving Repr

open NN

def leftAdd (n : NN) : (NN -> NN) :=
  match n with
  | NN.zero => fun (m: NN) => m
  | NN.succ n1 => fun (m : NN) => (leftAdd n1 m |> NN.succ)

instance : Add NN where
  add := leftAdd

def leftAddZero (m : NN) : zero + m = m := by rfl;
def leftAddZero1 (m : NN) : m = zero + m := by
  exact Eq.symm (leftAddZero m);
def leftAddSucc (n m : NN) : succ n + m = succ (n +m) := by rfl;

theorem leftAddFromRightByZero (n : NN) : n + NN.zero = n := by
apply NN.recOn (motive := fun x => x + NN.zero = x);
rfl;
intro a;
intro h1;
calc
  ((NN.succ a) + NN.zero) = (a + NN.zero |> NN.succ) := rfl
  _ = (a |> NN.succ) := by rw [h1];

theorem leftAddFromRightBySucc (n m:NN): n + (NN.succ m) = ((n + m) |> NN.succ) := by
  apply NN.recOn (motive := fun x => x + (NN.succ m) = ((x + m) |> NN.succ));
  rfl;
  intro a;
  intro h1;
  calc
    ((succ a) + (succ m)) = ((a + (succ m)) |> succ) := rfl
    _ = ((a + m) |> succ |> succ) := by rw [h1]

theorem leftAddCommutative (n m: NN) : n + m = m +n := by
  apply NN.recOn (motive := fun x => x + m = m + x);
  calc
    zero + m = m  := by rfl
    m = m + zero := by exact leftAddFromRightByZero m |> Eq.symm
  intro a;
  intro h1;
  apply Eq.symm;
  calc
    m + succ a = ((m + a) |> succ) := by exact leftAddFromRightBySucc m a
    _ = ((a + m) |> succ) := by rw [h1]
--    succ a + m = ((a + m) |> succ) := by rfl

theorem leftAddAssociative (a b c: NN) : (a + b) + c = a + (b + c) := by
  apply Eq.symm;
  apply NN.recOn (motive := fun x => x + (b+c) = (x+b) + c);
  rfl;
  intro a;
  intro h1;
  calc
    succ a + (b+c) = succ (a + (b+c)) := rfl
    _ = succ (a + b+ c) := by rw [h1]

theorem succCancellation (a b : NN) : succ a = succ b -> a = b := by
  intro h;
  injection h with h';
  assumption;

theorem succNotZero (a: NN) : ((succ a) ≠ NN.zero) := by
  intro h;
  injection h;

theorem leftAddSuccCancellation (a b c: NN) : succ a + b = succ a + c -> a + b = a + c := by
  intro h1;
  exact succCancellation (a+b) (a+c) h1;

theorem A (a b: Prop): a -> (a -> b) -> b := by
  intro a;
  intro h1;
  exact h1 a;

theorem leftAddCancellation (a b c: NN) : a + b = a + c -> b = c := by
  apply NN.recOn (motive := fun a => a + b = a + c -> b = c)
  rw [leftAddZero b]
  rw [leftAddZero c]
  intro h1; exact h1;
  intro a;
  intro h1;
  intro h2;
  exact h1 ((leftAddSuccCancellation a b c) h2);

def isPositive (n : NN) : Prop :=
  n ≠ zero

theorem constructiveContrapositive (p q: Prop) : (p -> q) -> (¬q -> ¬p) := by
  intro h1;
  intro h2;
  exact fun h : p => h2 (h1 h);

theorem sumEqualsZeroImpliesZero (a b : NN) : a + b = zero -> b = zero := by
  cases a with
  | zero => intro h; assumption;
  | succ c =>
    intro h1;
    have h2 : succ c + b = succ (c+b) := leftAddSucc c b;
    rw [h2] at h1;
    have f := succNotZero (c + b) h1;
    exact False.elim f;

theorem addingToPositiveIsPositive (a b: NN) : isPositive b -> isPositive (a + b) := by
  exact constructiveContrapositive (a + b = zero) (b = zero) (sumEqualsZeroImpliesZero a b);

theorem addToZeroImpliesZero (a b: NN) : a + b = zero -> a = zero ∧ b = zero := by
  simp;
  intro p;
  apply And.intro;
  rw [leftAddCommutative] at p;
  exact sumEqualsZeroImpliesZero b a p;
  exact sumEqualsZeroImpliesZero a b p;

theorem reflProducer (t: Sort u) (a: t) : a = a := by
  rfl;

#check Exists.intro

example (p q : Nat → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x := by
  intro h
  cases h with
  | intro x px => exists x; apply Or.inl; exact px

theorem positiveImpliesExistenceSuccInverse (a b: NN) : isPositive b -> ∃a, succ a = b := by
  intro h;
  cases b with
  | zero => exact False.elim (h rfl);
  | succ c =>
  exact Exists.intro c (reflProducer NN (succ c));

def isGTEQThan (m n: NN) : Prop :=
  ∃a:NN,  m = a + n

def isGTThan (m n: NN) : Prop :=
  -- (isGTEQThan m n) ∧ (m ≠ n)
  ∃a:NN,  (m = a + n) ∧ (isPositive a)

theorem reflexivityOfGTEQ (a : NN) : isGTEQThan a a := by
  exact Exists.intro zero (leftAddZero1 a);

#check leftAddAssociative

theorem transitiveOfGTEQ (a b c: NN)
  (p : isGTEQThan a b) (q : isGTEQThan b c) : isGTEQThan a c := by
  cases p with
  | intro x1 p =>
  cases q with
  | intro x2 q =>
  rw [q] at p;
  rw [←(leftAddAssociative x1 x2 c)] at p;
  exact Exists.intro (x1 + x2) (p);

#check leftAddZero
#check leftAddCancellation

#check leftAddCommutative
#check addToZeroImpliesZero

theorem leftAddCancellation1 (a b c: NN) (h : b + a = c + a) : b = c := by
   rw [leftAddCommutative, leftAddCommutative c a] at h;
   exact leftAddCancellation a b c h;

theorem antisymmetryOfGTEQ (a b: NN)
  (p : isGTEQThan a b) (q : isGTEQThan b a) : a = b := by
  cases p with
  | intro x1 p =>
  cases q with
  | intro x2 q =>
  have h1 := leftAddZero a;
  rw [←h1] at p;
  rw [q] at p;
  rw [←(leftAddAssociative x1 x2 a)] at p;
  have h2 := Eq.symm (leftAddCancellation1 a zero (x1 + x2) p);
  have h3 := addToZeroImpliesZero x1 x2 h2;
  have h4 := h3.right;
  rw [h4] at q;
  have h5 := leftAddZero a;
  rw [h5] at q;
  exact Eq.symm q;

theorem addConstantToBothSides (a b c: NN) (p : a = b) : c + a = c + b := by
  rw [p];

#check leftAddAssociative

theorem additionPreservesGTEQ (a b c :NN) (p : isGTEQThan a b): isGTEQThan (c + a) (c + b) := by
  cases p with
  | intro x1 p =>
  have h : c + a = x1 + (c + b) := by
    have h1 := (addConstantToBothSides a (x1 + b) c) p;
    rw [leftAddCommutative x1 b, ←leftAddAssociative c b x1, (leftAddCommutative (c + b) x1)] at h1;
    exact h1;
  exact Exists.intro x1 h;

theorem additionPreservesGTEQ1 (a b c :NN) (p : isGTEQThan (c + a) (c + b)): isGTEQThan a b := by
  cases p with
  | intro x1 p =>
  have h1 : a = x1 + b := by sorry;
  exact Exists.intro x1 h1;

theorem notEqualImpliesGT (m n: NN) (p : isGTThan m n) : (isGTEQThan m n) ∧ (m ≠ n) := by
  -- same witness
  sorry

theorem succGTEQImpliesGT (a b :NN) (p: isGTEQThan b (succ a)) : isGTThan b a := by
  -- same witness
  sorry

theorem trichotomy (a b : NN) : ∃ c, (a = c + b) ∨ (b = c + a) := by
  induction a with
  | zero =>
  have h: b = b + zero := by
    have h1 := leftAddZero1 b;
    rw [leftAddCommutative] at h1;
    exact h1;
  exact Exists.intro (b) (Or.inr h);
  | succ a h =>
  cases h with
  | intro x1 p =>
  cases p with
  | inl h1 =>
  have q : (succ a) = (succ x1) + b := by sorry;
  exact Exists.intro (succ x1) (Or.inl  q);
  | inr h1 =>
  cases x1 with
  | zero =>
  have hhh: succ a = (succ zero) + b := by sorry;
  exact Exists.intro (succ zero) (Or.inl hhh);
  | succ x1 =>
  have h2 : b = x1 + succ a := by sorry;
  exact Exists.intro (x1) (Or.inr h2);

theorem GTEQTrichotomy (a b : NN) : (isGTThan a b) ∨ a = b ∨ (isGTThan b a) := by sorry

theorem nothingLessThanZero (m : NN) (p:isGTThan zero m) : False := by sorry

theorem zeroGTEQThanZero (a : NN) (p: isGTEQThan zero a) : a = zero := by sorry

#check nothingLessThanZero
#check False.elim

theorem gtImpliesGTEQSucc {a b :NN} (p: isGTThan (succ b) a) : isGTEQThan b a := by
  -- same witness
  sorry

theorem GTEQImpliesGTOrEqual {m n: NN} (p: isGTEQThan m n) : (isGTThan m n) ∨ (m = n) := by
  sorry

--
-- THIS WAS A FUCKING DISASTER NGL
--
theorem strongInductionNNBaseZeroPart1 (P : NN -> Prop)
  (q : ∀m : NN, (∀ m': NN, (isGTThan m m') -> (P m')) -> P m)
  : ∀m : NN, (∀ m' : NN, (isGTEQThan m m') -> (P m')) := by
  intro m;
  induction m with
  | zero =>
  intro m1;
  intro h0;
  have h1 : m1 = zero := zeroGTEQThanZero m1 h0;
  have p := q zero;
  --rw [nothingLessThanZero m'] at p;
  have f : (∀ (m' : NN), isGTThan zero m' → P m') := (fun m: NN =>
  (fun p: isGTThan zero m => (False.elim (nothingLessThanZero m p))));
  rw [h1];
  exact p f;
  | succ m2 h1 =>
  have h2 : ∀ (m' : NN), isGTThan (succ m2) m' → P m' := by
    exact (fun m' => (fun x => (h1 m') (gtImpliesGTEQSucc x)));
  --have h3 := q m1;
  intro m1;
  intro h6;
  have h3 := (q (succ m2));
  have h5 := h3 h2;
  --have h5 :=
  have h7 : isGTThan (succ m2) m1 ∨ (succ m2 = m1) := by
    exact GTEQImpliesGTOrEqual h6;
  cases h7 with
  | inl h8 => exact ((h2 m1) h8);
  | inr h9 =>
    rw [← h9];
    exact h5;

-- -- In the future lets make this
-- -- into a semigroup
-- -- and then we can just assert that a diferent base
-- -- will be a new semigroup
-- theorem strongInductionNNBaseZero (P : NN -> Prop)
--   (q : ∀m : NN, (∀ m': NN, (isGTThan m m') -> (P m')) -> P m)
--   : ∀m : NN, P m := by
--   intro m;
--   -- we need to induct with the extra criteria that
--   -- (∀ m': NN, (isGTThan m m') -> (P m'))

--   intro m1;
--   induction m1 with
--   | zero =>
--   have p := q zero;
--   --rw [nothingLessThanZero m'] at p;
--   have f : (∀ (m' : NN), isGTThan zero m' → P m') := (fun m: NN =>
--   (fun p: isGTThan zero m => (False.elim (nothingLessThanZero m p))));
--   exact p f;
--   | succ m1 h1 =>

-- ======================================================================
-- ON TO MULTIPLICATION

def leftMult (n : NN) : NN -> NN :=
  match n with
  | zero => fun (_ : NN) => zero
  | succ n => fun (m : NN) => m + ((leftMult n) m)

instance : Mul NN where
  mul := leftMult

theorem leftMultZero (n : NN) : leftMult zero n = zero := by rfl;
theorem leftMultSucc (n m: NN) : leftMult (succ n) m = m + leftMult n m := by rfl;

theorem leftMultZero1 (n : NN) : leftMult n zero = zero := by
  induction n with
  | zero => rfl;
  | succ n h0 =>
    rw [leftMultSucc]
    rw [h0]
    rfl

theorem leftMultSucc1 (n m: NN) : leftMult m (succ n) = m + leftMult m n := by
  induction m with
  | zero =>
    rw [leftMultZero]
    rw [leftMultZero]
    rfl;
  | succ m h0 =>
    rw [leftMultSucc]
    rw [h0]
    rw [leftMultSucc]
    sorry;

theorem leftMultCommutative (n m : NN) : leftMult n m = leftMult m n := by
  induction n with
  | zero => rw [leftMultZero1 m]; rfl;
  | succ n h0 =>
    rw [leftMultSucc]
    rw [leftMultSucc1]
    rw [h0];

#check Or.inl

theorem leftMultZeroDivisors (n m: NN) (p : leftMult n m = zero) :
  n = zero ∨ m = zero := by
  cases n with
  | zero => exact Or.inl rfl;
  | succ n =>
    rw [leftMultSucc] at p
    -- m + something = zero implies m = zero
    have h1 : m = zero := by sorry;
    exact Or.inr h1;

theorem leftMultDistributive (a b c: NN)
  : leftMult a (b+c) = (leftMult a b) + (leftMult a c) := by
  induction a with
  | zero =>
    rw [leftMultZero]
    rw [leftMultZero]
    rfl
  | succ a h0 =>
    rw [leftMultSucc]
    rw [leftMultSucc]
    rw [leftMultSucc]
    rw [h0]
    sorry -- just addition here

theorem leftMultDistributive1 (a b c: NN)
  : leftMult (a + b) c = (leftMult a c) + (leftMult b c) := by
  induction c with
  | zero =>
    rw [leftMultZero1]
    rw [leftMultZero1]
    rw [leftMultZero1]
    rfl
  | succ c h0 =>
    rw [leftMultSucc1]
    rw [leftMultSucc1]
    rw [leftMultSucc1]
    rw [h0]
    sorry -- just addition here

theorem leftMultAssoc (a b c: NN)
  : leftMult (leftMult a b) c = leftMult a (leftMult b c) := by
  induction a with
  | zero =>
    rw [leftMultZero]
    rw [leftMultZero]
    rw [leftMultZero]
  | succ a h0 =>
    rw [leftMultSucc]
    rw [leftMultSucc]
    rw [←h0]
    rw [leftMultDistributive1]


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

! This file was ported from Lean 3 source module data.multiset.interval
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.LocallyFinite
import Mathlib.Data.Dfinsupp.Interval
import Mathlib.Data.Dfinsupp.Multiset
import Mathlib.Data.Nat.Interval

/-!
# Finite intervals of multisets

This file provides the `LocallyFiniteOrder` instance for `Multiset α` and calculates the
cardinality of its finite intervals.

## Implementation notes

We implement the intervals via the intervals on `Dfinsupp`, rather than via filtering
`Multiset.Powerset`; this is because `(Multiset.replicate n x).Powerset` has `2^n` entries not `n+1`
entries as it contains duplicates. We do not go via `Finsupp` as this would be noncomputable, and
multisets are typically used computationally.

-/

open Finset Dfinsupp Function

open BigOperators Pointwise

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

namespace Multiset

variable [DecidableEq α] (f g : Multiset α)

instance : LocallyFiniteOrder (Multiset α) :=
  LocallyFiniteOrder.ofIcc (Multiset α)
    (fun f g =>
      (Finset.Icc (Multiset.toDfinsupp f) (Multiset.toDfinsupp g)).map
      Multiset.equivDfinsupp.toEquiv.symm.toEmbedding)
    fun f g x => by simp

theorem Icc_eq :
    Finset.Icc f g =
      (Finset.Icc (Multiset.toDfinsupp f) (Multiset.toDfinsupp g)).map
      Multiset.equivDfinsupp.toEquiv.symm.toEmbedding :=
  rfl
#align multiset.Icc_eq Multiset.Icc_eq

theorem card_Icc :
    (Finset.Icc f g).card = ∏ i in f.toFinset ∪ g.toFinset, (g.count i + 1 - f.count i) := by
  simp_rw [Icc_eq, Finset.card_map, Dfinsupp.card_Icc, Nat.card_Icc, Multiset.toDfinsupp_apply,
    toDfinsupp_support]
#align multiset.card_Icc Multiset.card_Icc

theorem card_Ico :
    (Finset.Ico f g).card = ∏ i in f.toFinset ∪ g.toFinset, (g.count i + 1 - f.count i) - 1 := by
  rw [card_Ico_eq_card_Icc_sub_one, card_Icc]
#align multiset.card_Ico Multiset.card_Ico

theorem card_Ioc :
    (Finset.Ioc f g).card = ∏ i in f.toFinset ∪ g.toFinset, (g.count i + 1 - f.count i) - 1 := by
  rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]
#align multiset.card_Ioc Multiset.card_Ioc

theorem card_Ioo :
    (Finset.Ioo f g).card = ∏ i in f.toFinset ∪ g.toFinset, (g.count i + 1 - f.count i) - 2 := by
  rw [card_Ioo_eq_card_Icc_sub_two, card_Icc]
#align multiset.card_Ioo Multiset.card_Ioo

theorem card_Iic : (Finset.Iic f).card = ∏ i in f.toFinset, (f.count i + 1) := by
  simp_rw [Iic_eq_Icc, card_Icc, bot_eq_zero, toFinset_zero, empty_union, count_zero, tsub_zero]
#align multiset.card_Iic Multiset.card_Iic

end Multiset


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth
-/
import analysis.normed.field.unit_ball
import analysis.normed_space.basic

/-!
# Multiplicative actions of/on balls and spheres

Let `E` be a normed vector space over a normed field `𝕜`. In this file we define the following
multiplicative actions.

- The closed unit ball in `𝕜` acts on open balls and closed balls centered at `0` in `E`.
- The unit sphere in `𝕜` acts on open balls, closed balls, and spheres centered at `0` in `E`.
-/
open metric set
variables {𝕜 𝕜' E : Type*} [normed_field 𝕜] [normed_field 𝕜']
  [seminormed_add_comm_group E] [normed_space 𝕜 E] [normed_space 𝕜' E] {r : ℝ}

section closed_ball

instance mul_action_closed_ball_ball : mul_action (closed_ball (0 : 𝕜) 1) (ball (0 : E) r) :=
{ smul := λ c x, ⟨(c : 𝕜) • x, mem_ball_zero_iff.2 $
    by simpa only [norm_smul, one_mul]
      using mul_lt_mul' (mem_closed_ball_zero_iff.1 c.2) (mem_ball_zero_iff.1 x.2)
        (norm_nonneg _) one_pos⟩,
  one_smul := λ x, subtype.ext $ one_smul 𝕜 _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_closed_ball_ball :
  has_continuous_smul (closed_ball (0 : 𝕜) 1) (ball (0 : E) r) :=
⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩

instance mul_action_closed_ball_closed_ball :
  mul_action (closed_ball (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
{ smul := λ c x, ⟨(c : 𝕜) • x, mem_closed_ball_zero_iff.2 $
    by simpa only [norm_smul, one_mul]
      using mul_le_mul (mem_closed_ball_zero_iff.1 c.2) (mem_closed_ball_zero_iff.1 x.2)
        (norm_nonneg _) zero_le_one⟩,
  one_smul := λ x, subtype.ext $ one_smul 𝕜 _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_closed_ball_closed_ball :
  has_continuous_smul (closed_ball (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩

end closed_ball

section sphere

instance mul_action_sphere_ball : mul_action (sphere (0 : 𝕜) 1) (ball (0 : E) r) :=
{ smul := λ c x, inclusion sphere_subset_closed_ball c • x,
  one_smul := λ x, subtype.ext $ one_smul _ _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_sphere_ball :
  has_continuous_smul (sphere (0 : 𝕜) 1) (ball (0 : E) r) :=
⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩

instance mul_action_sphere_closed_ball : mul_action (sphere (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
{ smul := λ c x, inclusion sphere_subset_closed_ball c • x,
  one_smul := λ x, subtype.ext $ one_smul _ _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_sphere_closed_ball :
  has_continuous_smul (sphere (0 : 𝕜) 1) (closed_ball (0 : E) r) :=
⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩

instance mul_action_sphere_sphere : mul_action (sphere (0 : 𝕜) 1) (sphere (0 : E) r) :=
{ smul := λ c x, ⟨(c : 𝕜) • x, mem_sphere_zero_iff_norm.2 $
    by rw [norm_smul, mem_sphere_zero_iff_norm.1 c.coe_prop, mem_sphere_zero_iff_norm.1 x.coe_prop,
      one_mul]⟩,
  one_smul := λ x, subtype.ext $ one_smul _ _,
  mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ }

instance has_continuous_smul_sphere_sphere :
  has_continuous_smul (sphere (0 : 𝕜) 1) (sphere (0 : E) r) :=
⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩

end sphere

section is_scalar_tower

variables [normed_algebra 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' E]

instance is_scalar_tower_closed_ball_closed_ball_closed_ball :
  is_scalar_tower (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_closed_ball_closed_ball_ball :
  is_scalar_tower (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_sphere_closed_ball_closed_ball :
  is_scalar_tower (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_sphere_closed_ball_ball :
  is_scalar_tower (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_sphere_sphere_closed_ball :
  is_scalar_tower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (closed_ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_sphere_sphere_ball :
  is_scalar_tower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_sphere_sphere_sphere :
  is_scalar_tower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (sphere (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩

instance is_scalar_tower_sphere_ball_ball :
  is_scalar_tower (sphere (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩

instance is_scalar_tower_closed_ball_ball_ball :
  is_scalar_tower (closed_ball (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) :=
⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩

end is_scalar_tower

section smul_comm_class

variables [smul_comm_class 𝕜 𝕜' E]

instance smul_comm_class_closed_ball_closed_ball_closed_ball :
  smul_comm_class (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

instance smul_comm_class_closed_ball_closed_ball_ball :
  smul_comm_class (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

instance smul_comm_class_sphere_closed_ball_closed_ball :
  smul_comm_class (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

instance smul_comm_class_sphere_closed_ball_ball :
  smul_comm_class (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

instance smul_comm_class_sphere_ball_ball [normed_algebra 𝕜 𝕜'] :
  smul_comm_class (sphere (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩

instance smul_comm_class_sphere_sphere_closed_ball :
  smul_comm_class (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (closed_ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

instance smul_comm_class_sphere_sphere_ball :
  smul_comm_class (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (ball (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

instance smul_comm_class_sphere_sphere_sphere :
  smul_comm_class (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (sphere (0 : E) r) :=
⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩

end smul_comm_class

variables (𝕜) [char_zero 𝕜]

lemma ne_neg_of_mem_sphere {r : ℝ} (hr : r ≠ 0) (x : sphere (0:E) r) : x ≠ - x :=
λ h, ne_zero_of_mem_sphere hr x ((self_eq_neg 𝕜 _).mp (by { conv_lhs {rw h}, simp }))

lemma ne_neg_of_mem_unit_sphere (x : sphere (0:E) 1) : x ≠ - x :=
ne_neg_of_mem_sphere 𝕜 one_ne_zero x


theorem not_succ_le_self (a : mynat) : ¬ (succ a ≤ a) :=
begin
intro h,
have h2 := (le_antisymm a (succ a)) (le_succ_self a) h,
exact (ne_succ_self a) h2,
end