/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

Partially ordered additive groups, modeled on Isabelle's library. These classes can be refined
if necessary.
-/
import logic.eq data.unit data.sigma data.prod
import algebra.binary algebra.group algebra.order algebra.monotone
open eq eq.ops   -- note: ⁻¹ will be overloaded

variables {A B : Type}

/- partially ordered monoids, such as the natural numbers -/

structure ordered_cancel_comm_monoid [class] (A : Type) extends add_comm_monoid A,
  add_left_cancel_semigroup A, add_right_cancel_semigroup A, order_pair A :=
(add_le_add_left : ∀a b, le a b → ∀c, le (add c a) (add c b))
(le_of_add_le_add_left : ∀a b c, le (add a b) (add a c) → le b c)
(add_lt_add_left : ∀a b, lt a b → ∀c, lt (add c a) (add c b))
(lt_of_add_lt_add_left : ∀a b c, lt (add a b) (add a c) → lt b c)

section
  variables [ordered_cancel_comm_monoid A]
  variables {a b c d e : A}

  theorem add_lt_add_left (H : a < b) (c : A) : c + a < c + b :=
    !ordered_cancel_comm_monoid.add_lt_add_left H c

  theorem add_lt_add_right (H : a < b) (c : A) : a + c < b + c :=
  begin
    rewrite [add.comm, {b + _}add.comm],
    exact (add_lt_add_left H c)
  end

  theorem add_le_add_left (H : a ≤ b) (c : A) : c + a ≤ c + b :=
  !ordered_cancel_comm_monoid.add_le_add_left H c

  theorem add_le_add_right (H : a ≤ b) (c : A) : a + c ≤ b + c :=
  (add.comm c a) ▸ (add.comm c b) ▸ (add_le_add_left H c)

  theorem add_le_add (Hab : a ≤ b) (Hcd : c ≤ d) : a + c ≤ b + d :=
  le.trans (add_le_add_right Hab c) (add_le_add_left Hcd b)

  theorem le_add_of_nonneg_right (H : b ≥ 0) : a ≤ a + b :=
  begin
    have H1 : a + b ≥ a + 0, from add_le_add_left H a,
    rewrite add_zero at H1,
    exact H1
  end

  theorem le_add_of_nonneg_left (H : b ≥ 0) : a ≤ b + a :=
  begin
    have H1 : 0 + a ≤ b + a, from add_le_add_right H a,
    rewrite zero_add at H1,
    exact H1
  end

  theorem add_lt_add (Hab : a < b) (Hcd : c < d) : a + c < b + d :=
  lt.trans (add_lt_add_right Hab c) (add_lt_add_left Hcd b)

  theorem add_lt_add_of_le_of_lt (Hab : a ≤ b) (Hcd : c < d) : a + c < b + d :=
  lt_of_le_of_lt (add_le_add_right Hab c) (add_lt_add_left Hcd b)

  theorem add_lt_add_of_lt_of_le (Hab : a < b) (Hcd : c ≤ d) : a + c < b + d :=
  lt_of_lt_of_le (add_lt_add_right Hab c) (add_le_add_left Hcd b)

  theorem lt_add_of_pos_right (H : b > 0) : a < a + b := !add_zero ▸ add_lt_add_left H a

  theorem lt_add_of_pos_left (H : b > 0) : a < b + a := !zero_add ▸ add_lt_add_right H a

  -- here we start using le_of_add_le_add_left.
  theorem le_of_add_le_add_left (H : a + b ≤ a + c) : b ≤ c :=
  !ordered_cancel_comm_monoid.le_of_add_le_add_left H

  theorem le_of_add_le_add_right (H : a + b ≤ c + b) : a ≤ c :=
  le_of_add_le_add_left (show b + a ≤ b + c, begin rewrite [add.comm, {b + _}add.comm], exact H end)

  theorem lt_of_add_lt_add_left (H : a + b < a + c) : b < c :=
  !ordered_cancel_comm_monoid.lt_of_add_lt_add_left H

  theorem lt_of_add_lt_add_right (H : a + b < c + b) : a < c :=
  lt_of_add_lt_add_left ((add.comm a b) ▸ (add.comm c b) ▸ H)

  theorem add_le_add_left_iff (a b c : A) : a + b ≤ a + c ↔ b ≤ c :=
  iff.intro le_of_add_le_add_left (assume H, add_le_add_left H _)

  theorem add_le_add_right_iff (a b c : A) : a + b ≤ c + b ↔ a ≤ c :=
  iff.intro le_of_add_le_add_right (assume H, add_le_add_right H _)

  theorem add_lt_add_left_iff (a b c : A) : a + b < a + c ↔ b < c :=
  iff.intro lt_of_add_lt_add_left (assume H, add_lt_add_left H _)

  theorem add_lt_add_right_iff (a b c : A) : a + b < c + b ↔ a < c :=
  iff.intro lt_of_add_lt_add_right (assume H, add_lt_add_right H _)

  -- here we start using properties of zero.
  theorem add_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a + b :=
  !zero_add ▸ (add_le_add Ha Hb)

  theorem add_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a + b :=
  !zero_add ▸ (add_lt_add Ha Hb)

  theorem add_pos_of_pos_of_nonneg (Ha : 0 < a) (Hb : 0 ≤ b) : 0 < a + b :=
  !zero_add ▸ (add_lt_add_of_lt_of_le Ha Hb)

  theorem add_pos_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 < a + b :=
  !zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb)

  theorem add_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : a + b ≤ 0 :=
  !zero_add ▸ (add_le_add Ha Hb)

  theorem add_neg (Ha : a < 0) (Hb : b < 0) : a + b < 0 :=
  !zero_add ▸ (add_lt_add Ha Hb)

  theorem add_neg_of_neg_of_nonpos (Ha : a < 0) (Hb : b ≤ 0) : a + b < 0 :=
  !zero_add ▸ (add_lt_add_of_lt_of_le Ha Hb)

  theorem add_neg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : a + b < 0 :=
  !zero_add ▸ (add_lt_add_of_le_of_lt Ha Hb)

  -- TODO: add nonpos version (will be easier with simplifier)
  theorem add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg
    (Ha : 0 ≤ a) (Hb : 0 ≤ b) : a + b = 0 ↔ a = 0 ∧ b = 0 :=
  iff.intro
    (assume Hab : a + b = 0,
      have Ha' : a ≤ 0, from
        calc
          a     = a + 0 : by rewrite add_zero
            ... ≤ a + b : add_le_add_left Hb
            ... = 0     : Hab,
      have Haz : a = 0, from le.antisymm Ha' Ha,
      have Hb' : b ≤ 0, from
        calc
          b     = 0 + b : by rewrite zero_add
            ... ≤ a + b : by exact add_le_add_right Ha _
            ... = 0     : Hab,
      have Hbz : b = 0, from le.antisymm Hb' Hb,
      and.intro Haz Hbz)
    (assume Hab : a = 0 ∧ b = 0,
     obtain Ha' Hb', from Hab,
     by rewrite [Ha', Hb', add_zero])

  theorem le_add_of_nonneg_of_le (Ha : 0 ≤ a) (Hbc : b ≤ c) : b ≤ a + c :=
  !zero_add ▸ add_le_add Ha Hbc

  theorem le_add_of_le_of_nonneg (Hbc : b ≤ c) (Ha : 0 ≤ a) : b ≤ c + a :=
  !add_zero ▸ add_le_add Hbc Ha

  theorem lt_add_of_pos_of_le (Ha : 0 < a) (Hbc : b ≤ c) : b < a + c :=
  !zero_add ▸ add_lt_add_of_lt_of_le Ha Hbc

  theorem lt_add_of_le_of_pos (Hbc : b ≤ c) (Ha : 0 < a) : b < c + a :=
  !add_zero ▸ add_lt_add_of_le_of_lt Hbc Ha

  theorem add_le_of_nonpos_of_le (Ha : a ≤ 0) (Hbc : b ≤ c) : a + b ≤ c :=
  !zero_add ▸ add_le_add Ha Hbc

  theorem add_le_of_le_of_nonpos (Hbc : b ≤ c) (Ha : a ≤ 0) : b + a ≤ c :=
  !add_zero ▸ add_le_add Hbc Ha

  theorem add_lt_of_neg_of_le (Ha : a < 0) (Hbc : b ≤ c) : a + b < c :=
  !zero_add ▸ add_lt_add_of_lt_of_le Ha Hbc

  theorem add_lt_of_le_of_neg (Hbc : b ≤ c) (Ha : a < 0) : b + a < c :=
  !add_zero ▸ add_lt_add_of_le_of_lt Hbc Ha

  theorem lt_add_of_nonneg_of_lt (Ha : 0 ≤ a) (Hbc : b < c) : b < a + c :=
  !zero_add ▸ add_lt_add_of_le_of_lt Ha Hbc

  theorem lt_add_of_lt_of_nonneg (Hbc : b < c) (Ha : 0 ≤ a) : b < c + a :=
  !add_zero ▸ add_lt_add_of_lt_of_le Hbc Ha

  theorem lt_add_of_pos_of_lt (Ha : 0 < a) (Hbc : b < c) : b < a + c :=
  !zero_add ▸ add_lt_add Ha Hbc

  theorem lt_add_of_lt_of_pos (Hbc : b < c) (Ha : 0 < a) : b < c + a :=
  !add_zero ▸ add_lt_add Hbc Ha

  theorem add_lt_of_nonpos_of_lt (Ha : a ≤ 0) (Hbc : b < c) : a + b < c :=
  !zero_add ▸ add_lt_add_of_le_of_lt Ha Hbc

  theorem add_lt_of_lt_of_nonpos (Hbc : b < c) (Ha : a ≤ 0)  : b + a < c :=
  !add_zero ▸ add_lt_add_of_lt_of_le Hbc Ha

  theorem add_lt_of_neg_of_lt (Ha : a < 0) (Hbc : b < c) : a + b < c :=
  !zero_add ▸ add_lt_add Ha Hbc

  theorem add_lt_of_lt_of_neg (Hbc : b < c) (Ha : a < 0) : b + a < c :=
  !add_zero ▸ add_lt_add Hbc Ha

  theorem strictly_increasing_add_left (c : A) : strictly_increasing (λ x, x + c) :=
  take x₁ x₂, assume H, add_lt_add_right H c

  theorem strictly_increasing_add_right (c : A) : strictly_increasing (λ x, c + x) :=
  take x₁ x₂, assume H, add_lt_add_left H c

  theorem nondecreasing_add_left (c : A) : nondecreasing (λ x, x + c) :=
  take x₁ x₂, assume H, add_le_add_right H c

  theorem nondecreasing_add_right (c : A) : nondecreasing (λ x, c + x) :=
  take x₁ x₂, assume H, add_le_add_left H c
end

/- ordered cancelative commutative monoids with a decidable linear order -/

structure decidable_linear_ordered_cancel_comm_monoid [class] (A : Type)
  extends ordered_cancel_comm_monoid A, decidable_linear_order A

section
  variables [decidable_linear_ordered_cancel_comm_monoid A]
  variables {a b c d e : A}

  theorem min_add_add_left : min (a + b) (a + c) = a + min b c :=
  eq.symm (eq_min
    (show a + min b c ≤ a + b, from add_le_add_left !min_le_left _)
    (show a + min b c ≤ a + c, from add_le_add_left !min_le_right _)
    (take d,
      assume H₁ : d ≤ a + b,
      assume H₂ : d ≤ a + c,
      decidable.by_cases
        (suppose b ≤ c, using this, by rewrite [min_eq_left this]; apply H₁)
        (suppose ¬ b ≤ c, using this,
          by rewrite [min_eq_right (le_of_lt (lt_of_not_ge this))]; apply H₂)))

  theorem min_add_add_right : min (a + c) (b + c) = min a b + c :=
  by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply min_add_add_left

  theorem max_add_add_left : max (a + b) (a + c) = a + max b c :=
  eq.symm (eq_max
    (add_le_add_left !le_max_left _)
    (add_le_add_left !le_max_right _)
    (take d,
      assume H₁ : a + b ≤ d,
      assume H₂ : a + c ≤ d,
      decidable.by_cases
        (suppose b ≤ c, using this, by rewrite [max_eq_right this]; apply H₂)
        (suppose ¬ b ≤ c, using this,
          by rewrite [max_eq_left (le_of_lt (lt_of_not_ge this))]; apply H₁)))

  theorem max_add_add_right : max (a + c) (b + c) = max a b + c :=
  by rewrite [add.comm a c, add.comm b c, add.comm _ c]; apply max_add_add_left
end

/- partially ordered groups -/

structure ordered_comm_group [class] (A : Type) extends add_comm_group A, order_pair A :=
(add_le_add_left : ∀a b, le a b → ∀c, le (add c a) (add c b))
(add_lt_add_left : ∀a b, lt a b → ∀ c, lt (add c a) (add c b))

theorem ordered_comm_group.le_of_add_le_add_left [ordered_comm_group A] {a b c : A}
  (H : a + b ≤ a + c) : b ≤ c :=
have H' : -a + (a + b) ≤ -a + (a + c), from ordered_comm_group.add_le_add_left _ _ H _,
by rewrite *neg_add_cancel_left at H'; exact H'

theorem ordered_comm_group.lt_of_add_lt_add_left [ordered_comm_group A] {a b c : A}
  (H : a + b < a + c) : b < c :=
have H' : -a + (a + b) < -a + (a + c), from ordered_comm_group.add_lt_add_left _ _ H _,
by rewrite *neg_add_cancel_left at H'; exact H'

definition ordered_comm_group.to_ordered_cancel_comm_monoid [trans_instance] [s : ordered_comm_group A] : ordered_cancel_comm_monoid A :=
⦃ ordered_cancel_comm_monoid, s,
  add_left_cancel       := @add.left_cancel A _,
  add_right_cancel      := @add.right_cancel A _,
  le_of_add_le_add_left := @ordered_comm_group.le_of_add_le_add_left A _,
  lt_of_add_lt_add_left := @ordered_comm_group.lt_of_add_lt_add_left A _⦄

section
  variables [ordered_comm_group A] (a b c d e : A)

  theorem neg_le_neg {a b : A} (H : a ≤ b) : -b ≤ -a :=
  have H1 : 0 ≤ -a + b, from !add.left_inv ▸ !(add_le_add_left H),
  !add_neg_cancel_right ▸ !zero_add ▸ add_le_add_right H1 (-b)

  theorem le_of_neg_le_neg {a b : A} (H : -b ≤ -a) : a ≤ b :=
  neg_neg a ▸ neg_neg b ▸ neg_le_neg H

  theorem neg_le_neg_iff_le : -a ≤ -b ↔ b ≤ a :=
  iff.intro le_of_neg_le_neg neg_le_neg

  theorem nonneg_of_neg_nonpos {a : A} (H : -a ≤ 0) : 0 ≤ a :=
  le_of_neg_le_neg (neg_zero⁻¹ ▸ H)

  theorem neg_nonpos_of_nonneg {a : A} (H : 0 ≤ a) : -a ≤ 0 :=
  neg_zero ▸ neg_le_neg H

  theorem neg_nonpos_iff_nonneg : -a ≤ 0 ↔ 0 ≤ a :=
  iff.intro nonneg_of_neg_nonpos neg_nonpos_of_nonneg

  theorem nonpos_of_neg_nonneg {a : A} (H : 0 ≤ -a) : a ≤ 0 :=
  le_of_neg_le_neg (neg_zero⁻¹ ▸ H)

  theorem neg_nonneg_of_nonpos {a : A} (H : a ≤ 0) : 0 ≤ -a :=
  neg_zero ▸ neg_le_neg H

  theorem neg_nonneg_iff_nonpos : 0 ≤ -a ↔ a ≤ 0 :=
  iff.intro nonpos_of_neg_nonneg neg_nonneg_of_nonpos

  theorem neg_lt_neg {a b : A} (H : a < b) : -b < -a :=
  have H1 : 0 < -a + b, from !add.left_inv ▸ !(add_lt_add_left H),
  !add_neg_cancel_right ▸ !zero_add ▸ add_lt_add_right H1 (-b)

  theorem lt_of_neg_lt_neg {a b : A} (H : -b < -a) : a < b :=
  neg_neg a ▸ neg_neg b ▸ neg_lt_neg H

  theorem neg_lt_neg_iff_lt : -a < -b ↔ b < a :=
  iff.intro lt_of_neg_lt_neg neg_lt_neg

  theorem pos_of_neg_neg {a : A} (H : -a < 0) : 0 < a :=
  lt_of_neg_lt_neg (neg_zero⁻¹ ▸ H)

  theorem neg_neg_of_pos {a : A} (H : 0 < a) : -a < 0 :=
  neg_zero ▸ neg_lt_neg H

  theorem neg_neg_iff_pos : -a < 0 ↔ 0 < a :=
  iff.intro pos_of_neg_neg neg_neg_of_pos

  theorem neg_of_neg_pos {a : A} (H : 0 < -a) : a < 0 :=
  lt_of_neg_lt_neg (neg_zero⁻¹ ▸ H)

  theorem neg_pos_of_neg {a : A} (H : a < 0) : 0 < -a :=
  neg_zero ▸ neg_lt_neg H

  theorem neg_pos_iff_neg : 0 < -a ↔ a < 0 :=
  iff.intro neg_of_neg_pos neg_pos_of_neg

  theorem le_neg_iff_le_neg : a ≤ -b ↔ b ≤ -a := !neg_neg ▸ !neg_le_neg_iff_le

  theorem le_neg_of_le_neg {a b : A} : a ≤ -b → b ≤ -a := iff.mp !le_neg_iff_le_neg

  theorem neg_le_iff_neg_le : -a ≤ b ↔ -b ≤ a := !neg_neg ▸ !neg_le_neg_iff_le

  theorem neg_le_of_neg_le {a b : A} : -a ≤ b → -b ≤ a := iff.mp !neg_le_iff_neg_le

  theorem lt_neg_iff_lt_neg : a < -b ↔ b < -a := !neg_neg ▸ !neg_lt_neg_iff_lt

  theorem lt_neg_of_lt_neg {a b : A} : a < -b → b < -a := iff.mp !lt_neg_iff_lt_neg

  theorem neg_lt_iff_neg_lt : -a < b ↔ -b < a := !neg_neg ▸ !neg_lt_neg_iff_lt

  theorem neg_lt_of_neg_lt {a b : A} : -a < b → -b < a := iff.mp !neg_lt_iff_neg_lt

  theorem sub_nonneg_iff_le : 0 ≤ a - b ↔ b ≤ a := !sub_self ▸ !add_le_add_right_iff

  theorem sub_nonneg_of_le {a b : A} : b ≤ a → 0 ≤ a - b := iff.mpr !sub_nonneg_iff_le

  theorem le_of_sub_nonneg {a b : A} : 0 ≤ a - b → b ≤ a := iff.mp !sub_nonneg_iff_le

  theorem sub_nonpos_iff_le : a - b ≤ 0 ↔ a ≤ b := !sub_self ▸ !add_le_add_right_iff

  theorem sub_nonpos_of_le {a b : A} : a ≤ b → a - b ≤ 0 := iff.mpr !sub_nonpos_iff_le

  theorem le_of_sub_nonpos {a b : A} : a - b ≤ 0 → a ≤ b := iff.mp !sub_nonpos_iff_le

  theorem sub_pos_iff_lt : 0 < a - b ↔ b < a := !sub_self ▸ !add_lt_add_right_iff

  theorem sub_pos_of_lt {a b : A} : b < a → 0 < a - b := iff.mpr !sub_pos_iff_lt

  theorem lt_of_sub_pos {a b : A} : 0 < a - b → b < a := iff.mp !sub_pos_iff_lt

  theorem sub_neg_iff_lt : a - b < 0 ↔ a < b := !sub_self ▸ !add_lt_add_right_iff

  theorem sub_neg_of_lt {a b : A} : a < b → a - b < 0 := iff.mpr !sub_neg_iff_lt

  theorem lt_of_sub_neg {a b : A} : a - b < 0 → a < b := iff.mp !sub_neg_iff_lt

  theorem add_le_iff_le_neg_add : a + b ≤ c ↔ b ≤ -a + c :=
  have H: a + b ≤ c ↔ -a + (a + b) ≤ -a + c, from iff.symm (!add_le_add_left_iff),
  !neg_add_cancel_left ▸ H

  theorem add_le_of_le_neg_add {a b c : A} : b ≤ -a + c → a + b ≤ c :=
    iff.mpr !add_le_iff_le_neg_add

  theorem le_neg_add_of_add_le {a b c : A} : a + b ≤ c → b ≤ -a + c :=
    iff.mp !add_le_iff_le_neg_add

  theorem add_le_iff_le_sub_left : a + b ≤ c ↔ b ≤ c - a :=
  by rewrite [sub_eq_add_neg, {c+_}add.comm]; apply add_le_iff_le_neg_add

  theorem add_le_of_le_sub_left {a b c : A} : b ≤ c - a → a + b ≤ c :=
    iff.mpr !add_le_iff_le_sub_left

  theorem le_sub_left_of_add_le {a b c : A} : a + b ≤ c → b ≤ c - a :=
    iff.mp !add_le_iff_le_sub_left

  theorem add_le_iff_le_sub_right : a + b ≤ c ↔ a ≤ c - b :=
  have H: a + b ≤ c ↔ a + b - b ≤ c - b, from iff.symm (!add_le_add_right_iff),
  !add_neg_cancel_right ▸ H

  theorem add_le_of_le_sub_right {a b c : A} : a ≤ c - b → a + b ≤ c :=
    iff.mpr !add_le_iff_le_sub_right

  theorem le_sub_right_of_add_le {a b c : A} : a + b ≤ c → a ≤ c - b :=
    iff.mp !add_le_iff_le_sub_right

  theorem le_add_iff_neg_add_le : a ≤ b + c ↔ -b + a ≤ c :=
  have H: a ≤ b + c ↔ -b + a ≤ -b + (b + c), from iff.symm (!add_le_add_left_iff),
  by rewrite neg_add_cancel_left at H; exact H

  theorem le_add_of_neg_add_le {a b c : A} : -b + a ≤ c → a ≤ b + c :=
    iff.mpr !le_add_iff_neg_add_le

  theorem neg_add_le_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c :=
    iff.mp !le_add_iff_neg_add_le

  theorem le_add_iff_sub_left_le : a ≤ b + c ↔ a - b ≤ c :=
  by rewrite [sub_eq_add_neg, {a+_}add.comm]; apply le_add_iff_neg_add_le

  theorem le_add_of_sub_left_le {a b c : A} : a - b ≤ c → a ≤ b + c :=
    iff.mpr !le_add_iff_sub_left_le

  theorem sub_left_le_of_le_add {a b c : A} : a ≤ b + c → a - b ≤ c :=
    iff.mp !le_add_iff_sub_left_le

  theorem le_add_iff_sub_right_le : a ≤ b + c ↔ a - c ≤ b :=
  have H: a ≤ b + c ↔ a - c ≤ b + c - c, from iff.symm (!add_le_add_right_iff),
  by rewrite [sub_eq_add_neg (b+c) c at H, add_neg_cancel_right at H]; exact H

  theorem le_add_of_sub_right_le {a b c : A} : a - c ≤ b → a ≤ b + c :=
    iff.mpr !le_add_iff_sub_right_le

  theorem sub_right_le_of_le_add {a b c : A} : a ≤ b + c → a - c ≤ b :=
    iff.mp !le_add_iff_sub_right_le

  theorem le_add_iff_neg_add_le_left : a ≤ b + c ↔ -b + a ≤ c :=
  have H: a ≤ b + c ↔ -b + a ≤ -b + (b + c), from iff.symm (!add_le_add_left_iff),
  by rewrite neg_add_cancel_left at H; exact H

  theorem le_add_of_neg_add_le_left {a b c : A} : -b + a ≤ c → a ≤ b + c :=
    iff.mpr !le_add_iff_neg_add_le_left

  theorem neg_add_le_left_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c :=
    iff.mp !le_add_iff_neg_add_le_left

  theorem le_add_iff_neg_add_le_right : a ≤ b + c ↔ -c + a ≤ b :=
  by rewrite add.comm; apply le_add_iff_neg_add_le_left

  theorem le_add_of_neg_add_le_right {a b c : A} : -c + a ≤ b → a ≤ b + c :=
    iff.mpr !le_add_iff_neg_add_le_right

  theorem neg_add_le_right_of_le_add {a b c : A} : a ≤ b + c → -c + a ≤ b :=
    iff.mp  !le_add_iff_neg_add_le_right

  theorem le_add_iff_neg_le_sub_left : c ≤ a + b ↔ -a ≤ b - c :=
  have H : c ≤ a + b ↔ -a + c ≤ b, from !le_add_iff_neg_add_le,
  have H' : -a + c ≤ b ↔ -a ≤ b - c, from !add_le_iff_le_sub_right,
  iff.trans H H'

  theorem le_add_of_neg_le_sub_left {a b c : A} : -a ≤ b - c → c ≤ a + b :=
    iff.mpr !le_add_iff_neg_le_sub_left

  theorem neg_le_sub_left_of_le_add {a b c : A} : c ≤ a + b → -a ≤ b - c :=
    iff.mp !le_add_iff_neg_le_sub_left

  theorem le_add_iff_neg_le_sub_right : c ≤ a + b ↔ -b ≤ a - c :=
  by rewrite add.comm; apply le_add_iff_neg_le_sub_left

  theorem le_add_of_neg_le_sub_right {a b c : A} : -b ≤ a - c → c ≤ a + b :=
    iff.mpr !le_add_iff_neg_le_sub_right

  theorem neg_le_sub_right_of_le_add {a b c : A} : c ≤ a + b → -b ≤ a - c :=
    iff.mp !le_add_iff_neg_le_sub_right

  theorem add_lt_iff_lt_neg_add_left : a + b < c ↔ b < -a + c :=
  have H: a + b < c ↔ -a + (a + b) < -a + c, from iff.symm (!add_lt_add_left_iff),
  begin rewrite neg_add_cancel_left at H, exact H end

  theorem add_lt_of_lt_neg_add_left {a b c : A} : b < -a + c → a + b < c :=
    iff.mpr !add_lt_iff_lt_neg_add_left

  theorem lt_neg_add_left_of_add_lt {a b c : A} : a + b < c → b < -a + c :=
    iff.mp !add_lt_iff_lt_neg_add_left

  theorem add_lt_iff_lt_neg_add_right : a + b < c ↔ a < -b + c :=
  by rewrite add.comm; apply add_lt_iff_lt_neg_add_left

  theorem add_lt_of_lt_neg_add_right {a b c : A} : a < -b + c → a + b < c :=
    iff.mpr !add_lt_iff_lt_neg_add_right

  theorem lt_neg_add_right_of_add_lt {a b c : A} : a + b < c → a < -b + c :=
    iff.mp !add_lt_iff_lt_neg_add_right

  theorem add_lt_iff_lt_sub_left : a + b < c ↔ b < c - a :=
  begin
    rewrite [sub_eq_add_neg, {c+_}add.comm],
    apply add_lt_iff_lt_neg_add_left
  end

  theorem add_lt_of_lt_sub_left {a b c : A} : b < c - a → a + b < c :=
    iff.mpr !add_lt_iff_lt_sub_left

  theorem lt_sub_left_of_add_lt {a b c : A} : a + b < c → b < c - a :=
    iff.mp !add_lt_iff_lt_sub_left

  theorem add_lt_iff_lt_sub_right : a + b < c ↔ a < c - b :=
  have H: a + b < c ↔ a + b - b < c - b, from iff.symm (!add_lt_add_right_iff),
  by rewrite [sub_eq_add_neg at H, add_neg_cancel_right at H]; exact H

  theorem add_lt_of_lt_sub_right {a b c : A} : a < c - b → a + b < c :=
    iff.mpr !add_lt_iff_lt_sub_right

  theorem lt_sub_right_of_add_lt {a b c : A} : a + b < c → a < c - b :=
    iff.mp !add_lt_iff_lt_sub_right

  theorem lt_add_iff_neg_add_lt_left : a < b + c ↔ -b + a < c :=
  have H: a < b + c ↔ -b + a < -b + (b + c), from iff.symm (!add_lt_add_left_iff),
  by rewrite neg_add_cancel_left at H; exact H

  theorem lt_add_of_neg_add_lt_left {a b c : A} : -b + a < c → a < b + c :=
    iff.mpr !lt_add_iff_neg_add_lt_left

  theorem neg_add_lt_left_of_lt_add {a b c : A} : a < b + c → -b + a < c :=
    iff.mp !lt_add_iff_neg_add_lt_left

  theorem lt_add_iff_neg_add_lt_right : a < b + c ↔ -c + a < b :=
  by rewrite add.comm; apply lt_add_iff_neg_add_lt_left

  theorem lt_add_of_neg_add_lt_right {a b c : A} : -c + a < b → a < b + c :=
    iff.mpr !lt_add_iff_neg_add_lt_right

  theorem neg_add_lt_right_of_lt_add {a b c : A} : a < b + c → -c + a < b :=
    iff.mp !lt_add_iff_neg_add_lt_right

  theorem lt_add_iff_sub_lt_left : a < b + c ↔ a - b < c :=
  by rewrite [sub_eq_add_neg, {a + _}add.comm]; apply lt_add_iff_neg_add_lt_left

  theorem lt_add_of_sub_lt_left {a b c : A} : a - b < c → a < b + c :=
    iff.mpr !lt_add_iff_sub_lt_left

  theorem sub_lt_left_of_lt_add {a b c : A} : a < b + c → a - b < c :=
    iff.mp !lt_add_iff_sub_lt_left

  theorem lt_add_iff_sub_lt_right : a < b + c ↔ a - c < b :=
  by rewrite add.comm; apply lt_add_iff_sub_lt_left

  theorem lt_add_of_sub_lt_right {a b c : A} : a - c < b → a < b + c :=
    iff.mpr !lt_add_iff_sub_lt_right

  theorem sub_lt_right_of_lt_add {a b c : A} : a < b + c → a - c < b :=
    iff.mp !lt_add_iff_sub_lt_right

  theorem sub_lt_of_sub_lt {a b c : A} : a - b < c → a - c < b :=
    begin
      intro H,
      apply sub_lt_left_of_lt_add,
      apply lt_add_of_sub_lt_right H
    end

  theorem sub_le_of_sub_le {a b c : A} : a - b ≤ c → a - c ≤ b :=
    begin
      intro H,
      apply sub_left_le_of_le_add,
      apply le_add_of_sub_right_le H
    end

  -- TODO: the Isabelle library has varations on a + b ≤ b ↔ a ≤ 0
  theorem le_iff_le_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a ≤ b ↔ c ≤ d :=
  calc
    a ≤ b ↔ a - b ≤ 0   : iff.symm (sub_nonpos_iff_le a b)
      ... = (c - d ≤ 0) : by rewrite H
      ... ↔ c ≤ d       : sub_nonpos_iff_le c d

  theorem lt_iff_lt_of_sub_eq_sub {a b c d : A} (H : a - b = c - d) : a < b ↔ c < d :=
  calc
    a < b ↔ a - b < 0   : iff.symm (sub_neg_iff_lt a b)
      ... = (c - d < 0) : by rewrite H
      ... ↔ c < d       : sub_neg_iff_lt c d

  theorem sub_le_sub_left {a b : A} (H : a ≤ b) (c : A) : c - b ≤ c - a :=
  add_le_add_left (neg_le_neg H) c

  theorem sub_le_sub_right {a b : A} (H : a ≤ b) (c : A) : a - c ≤ b - c := add_le_add_right H (-c)

  theorem sub_le_sub {a b c d : A} (Hab : a ≤ b) (Hcd : c ≤ d) : a - d ≤ b - c :=
  add_le_add Hab (neg_le_neg Hcd)

  theorem sub_lt_sub_left {a b : A} (H : a < b) (c : A) : c - b < c - a :=
  add_lt_add_left (neg_lt_neg H) c

  theorem sub_lt_sub_right {a b : A} (H : a < b) (c : A) : a - c < b - c := add_lt_add_right H (-c)

  theorem sub_lt_sub {a b c d : A} (Hab : a < b) (Hcd : c < d) : a - d < b - c :=
  add_lt_add Hab (neg_lt_neg Hcd)

  theorem sub_lt_sub_of_le_of_lt {a b c d : A} (Hab : a ≤ b) (Hcd : c < d) : a - d < b - c :=
  add_lt_add_of_le_of_lt Hab (neg_lt_neg Hcd)

  theorem sub_lt_sub_of_lt_of_le {a b c d : A} (Hab : a < b) (Hcd : c ≤ d) : a - d < b - c :=
  add_lt_add_of_lt_of_le Hab (neg_le_neg Hcd)

  theorem sub_le_self (a : A) {b : A} (H : b ≥ 0) : a - b ≤ a :=
  calc
    a - b = a + -b : rfl
      ... ≤ a + 0  : add_le_add_left (neg_nonpos_of_nonneg H)
      ... = a      : by rewrite add_zero

  theorem sub_lt_self (a : A) {b : A} (H : b > 0) : a - b < a :=
  calc
    a - b = a + -b : rfl
      ... < a + 0  : add_lt_add_left (neg_neg_of_pos H)
      ... = a      : by rewrite add_zero

  theorem add_le_add_three {a b c d e f : A} (H1 : a ≤ d) (H2 : b ≤ e) (H3 : c ≤ f) :
        a + b + c ≤ d + e + f :=
  begin
    apply le.trans,
    apply add_le_add,
    apply add_le_add,
    repeat assumption,
    apply le.refl
  end

  theorem sub_le_of_nonneg {b : A} (H : b ≥ 0) : a - b ≤ a :=
  add_le_of_le_of_nonpos (le.refl a) (neg_nonpos_of_nonneg H)

  theorem sub_lt_of_pos {b : A} (H : b > 0) : a - b < a :=
  add_lt_of_le_of_neg (le.refl a) (neg_neg_of_pos H)

  theorem neg_add_neg_le_neg_of_pos {a : A} (H : a > 0) : -a + -a ≤ -a :=
  !neg_add ▸ neg_le_neg (le_add_of_nonneg_left (le_of_lt H))

  variable (A)
  theorem strictly_decreasing_neg : strictly_decreasing (λ x : A, -x) :=
  @neg_lt_neg A _

  variable {A}

  section
    variable [strict_order B]

    theorem strictly_decreasing_neg_of_strictly_increasing {f : B → A}
      (H : strictly_increasing f) : strictly_decreasing (λ x, - f x) :=
    strictly_decreasing_comp_dec_inc (strictly_decreasing_neg A) H

    theorem strictly_increasing_neg_of_strictly_decreasing {f : B → A}
      (H : strictly_decreasing f) : strictly_increasing (λ x, - f x) :=
    strictly_increasing_comp_dec_dec (strictly_decreasing_neg A) H

    theorem strictly_decreasing_of_strictly_increasing_neg {f : B → A}
      (H : strictly_increasing (λ x, - f x)) : strictly_decreasing f :=
    strictly_decreasing_of_strictly_increasing_comp_right (left_inverse_neg A)
        (strictly_decreasing_neg A) H

    theorem strictly_increasing_of_strictly_decreasing_neg {f : B → A}
      (H : strictly_decreasing (λ x, - f x)) : strictly_increasing f :=
    strictly_increasing_of_strictly_decreasing_comp_right (left_inverse_neg A)
        (strictly_decreasing_neg A) H

    theorem strictly_decreasing_neg_iff {f : B → A} :
      strictly_decreasing (λ x, - f x) ↔ strictly_increasing f :=
    iff.intro strictly_increasing_of_strictly_decreasing_neg
       strictly_decreasing_neg_of_strictly_increasing

    theorem strictly_increasing_neg_iff {f : B → A} :
      strictly_increasing (λ x, - f x) ↔ strictly_decreasing f :=
    iff.intro strictly_decreasing_of_strictly_increasing_neg
       strictly_increasing_neg_of_strictly_decreasing

    theorem strictly_decreasing_neg_of_strictly_increasing' {f : A → B}
      (H : strictly_increasing f) : strictly_decreasing (λ x, f (-x)) :=
    strictly_decreasing_comp_inc_dec H (strictly_decreasing_neg A)

    theorem strictly_increasing_neg_of_strictly_decreasing' {f : A → B}
      (H : strictly_decreasing f) : strictly_increasing (λ x, f (-x)) :=
    strictly_increasing_comp_dec_dec H (strictly_decreasing_neg A)

    theorem strictly_decreasing_of_strictly_increasing_neg' {f : A → B}
      (H : strictly_increasing (λ x, f (-x))) : strictly_decreasing f :=
    strictly_decreasing_of_strictly_increasing_comp_left (left_inverse_neg A)
        (strictly_decreasing_neg A) H

    theorem strictly_increasing_of_strictly_decreasing_neg' {f : A → B}
      (H : strictly_decreasing (λ x, f (-x))) : strictly_increasing f :=
    strictly_increasing_of_strictly_decreasing_comp_left (left_inverse_neg A)
        (strictly_decreasing_neg A) H

    theorem strictly_decreasing_neg_iff' {f : A → B} :
      strictly_decreasing (λ x, f (-x)) ↔ strictly_increasing f :=
    iff.intro strictly_increasing_of_strictly_decreasing_neg'
       strictly_decreasing_neg_of_strictly_increasing'

    theorem strictly_increasing_neg_iff' {f : A → B} :
      strictly_increasing (λ x, f (-x)) ↔ strictly_decreasing f :=
    iff.intro strictly_decreasing_of_strictly_increasing_neg'
       strictly_increasing_neg_of_strictly_decreasing'
  end

  section
    variable [weak_order B]

    theorem nondecreasing_of_neg_nonincreasing {f : B → A} (H : nonincreasing (λ x, -f x)) :
      nondecreasing f :=
    take a₁ a₂, suppose a₁ ≤ a₂, le_of_neg_le_neg (H this)

    theorem nonincreasing_neg {f : B → A} (H : nondecreasing f) : nonincreasing (λ x, -f x) :=
    take a₁ a₂, suppose a₁ ≤ a₂, neg_le_neg (H this)

    theorem nonincreasing_neg_iff (f : B → A) : nonincreasing (λ x, - f x) ↔ nondecreasing f :=
    iff.intro nondecreasing_of_neg_nonincreasing nonincreasing_neg

    theorem nonincreasing_of_neg_nondecreasing {f : B → A} (H : nondecreasing (λ x, -f x)) :
      nonincreasing f :=
    take a₁ a₂, suppose a₁ ≤ a₂, le_of_neg_le_neg (H this)

    theorem nondecreasing_neg {f : B → A} (H : nonincreasing f) : nondecreasing (λ x, -f x) :=
    take a₁ a₂, suppose a₁ ≤ a₂, neg_le_neg (H this)

    theorem nondecreasing_neg_iff (f : B → A) : nondecreasing (λ x, - f x) ↔ nonincreasing f :=
    iff.intro nonincreasing_of_neg_nondecreasing nondecreasing_neg

    theorem nondecreasing_of_neg_nonincreasing' {f : A → B} (H : nonincreasing (λ x, f (-x))) :
      nondecreasing f :=
    take a₁ a₂, suppose a₁ ≤ a₂,
    have f(-(-a₁)) ≤ f(-(-a₂)), from H (neg_le_neg this),
    by rewrite *neg_neg at this; exact this

    theorem nonincreasing_neg' {f : A → B} (H : nondecreasing f) : nonincreasing (λ x, f (-x)) :=
    take a₁ a₂, suppose a₁ ≤ a₂, H (neg_le_neg this)

    theorem nonincreasing_neg_iff' (f : A → B) : nonincreasing (λ x, f (- x)) ↔ nondecreasing f :=
    iff.intro nondecreasing_of_neg_nonincreasing' nonincreasing_neg'

    theorem nonincreasing_of_neg_nondecreasing' {f : A → B} (H : nondecreasing (λ x, f (-x))) :
      nonincreasing f :=
    take a₁ a₂, suppose a₁ ≤ a₂,
    have f(-(-a₁)) ≥ f(-(-a₂)), from H (neg_le_neg this),
    by rewrite *neg_neg at this; exact this

    theorem nondecreasing_neg' {f : A → B} (H : nonincreasing f) : nondecreasing (λ x, f (-x)) :=
    take a₁ a₂, suppose a₁ ≤ a₂, H (neg_le_neg this)

    theorem nondecreasing_neg_iff' (f : A → B) : nondecreasing (λ x, f (- x)) ↔ nonincreasing f :=
    iff.intro nonincreasing_of_neg_nondecreasing' nondecreasing_neg'
  end
end

/- linear ordered group with decidable order -/

structure decidable_linear_ordered_comm_group [class] (A : Type)
    extends add_comm_group A, decidable_linear_order A :=
    (add_le_add_left : ∀ a b, le a b → ∀ c, le (add c a) (add c b))
    (add_lt_add_left : ∀ a b, lt a b → ∀ c, lt (add c a) (add c b))

definition decidable_linear_ordered_comm_group.to_ordered_comm_group
      [trans_instance]
   (A : Type) [s : decidable_linear_ordered_comm_group A] : ordered_comm_group A :=
⦃ ordered_comm_group, s,
  le_of_lt := @le_of_lt A _,
  lt_of_le_of_lt := @lt_of_le_of_lt A _,
  lt_of_lt_of_le := @lt_of_lt_of_le A _ ⦄

definition decidable_linear_ordered_comm_group.to_decidable_linear_ordered_cancel_comm_monoid
    [trans_instance] (A : Type) [s : decidable_linear_ordered_comm_group A] :
  decidable_linear_ordered_cancel_comm_monoid A :=
⦃ decidable_linear_ordered_cancel_comm_monoid, s,
    @ordered_comm_group.to_ordered_cancel_comm_monoid A _ ⦄

section
  variables [s : decidable_linear_ordered_comm_group A]
  variables {a b c d e : A}
  include s

  theorem max_neg_neg : max (-a) (-b) = - min a b  :=
  eq.symm (eq_max
    (show -a ≤ -(min a b), from neg_le_neg !min_le_left)
    (show -b ≤ -(min a b), from neg_le_neg !min_le_right)
    (take d,
      assume H₁ : -a ≤ d,
      assume H₂ : -b ≤ d,
      have H : -d ≤ min a b,
        from le_min (!iff.mp !neg_le_iff_neg_le H₁) (!iff.mp !neg_le_iff_neg_le H₂),
      show -(min a b) ≤ d, from !iff.mp !neg_le_iff_neg_le H))

  theorem min_eq_neg_max_neg_neg : min a b = - max (-a) (-b) :=
  by rewrite [max_neg_neg, neg_neg]

  theorem min_neg_neg : min (-a) (-b) = - max a b :=
  by rewrite [min_eq_neg_max_neg_neg, *neg_neg]

  theorem max_eq_neg_min_neg_neg : max a b = - min (-a) (-b) :=
  by rewrite [min_neg_neg, neg_neg]

  /- absolute value -/
  variables {a b c}

  definition abs (a : A) : A := max a (-a)

  theorem abs_of_nonneg (H : a ≥ 0) : abs a = a :=
  have H' : -a ≤ a, from le.trans (neg_nonpos_of_nonneg H) H,
  max_eq_left H'

  theorem abs_of_pos (H : a > 0) : abs a = a :=
  abs_of_nonneg (le_of_lt H)

  theorem abs_of_nonpos (H : a ≤ 0) : abs a = -a :=
  have H' : a ≤ -a, from le.trans H (neg_nonneg_of_nonpos H),
  max_eq_right H'

  theorem abs_of_neg (H : a < 0) : abs a = -a := abs_of_nonpos (le_of_lt H)

  theorem abs_zero : abs 0 = (0:A) := abs_of_nonneg (le.refl _)

  theorem abs_neg (a : A) : abs (-a) = abs a :=
  by rewrite [↑abs, max.comm, neg_neg]

  theorem abs_pos_of_pos (H : a > 0) : abs a > 0 :=
  by rewrite (abs_of_pos H); exact H

  theorem abs_pos_of_neg (H : a < 0) : abs a > 0 :=
  !abs_neg ▸ abs_pos_of_pos (neg_pos_of_neg H)

  theorem abs_sub (a b : A) : abs (a - b) = abs (b - a) :=
  by rewrite [-neg_sub, abs_neg]

  theorem ne_zero_of_abs_ne_zero {a : A} (H : abs a ≠ 0) : a ≠ 0 :=
   assume Ha, H (Ha⁻¹ ▸ abs_zero)

  /- these assume a linear order -/

  theorem eq_zero_of_neg_eq (H : -a = a) : a = 0 :=
  lt.by_cases
    (assume H1 : a < 0,
      have H2: a > 0, from H ▸ neg_pos_of_neg H1,
      absurd H1 (lt.asymm H2))
    (assume H1 : a = 0, H1)
    (assume H1 : a > 0,
      have H2: a < 0, from H ▸ neg_neg_of_pos H1,
      absurd H1 (lt.asymm H2))

  theorem abs_nonneg (a : A) : abs a ≥ 0 :=
  or.elim (le.total 0 a)
    (assume H : 0 ≤ a, by rewrite (abs_of_nonneg H); exact H)
    (assume H : a ≤ 0,
      calc
          0 ≤ -a    : neg_nonneg_of_nonpos H
        ... = abs a : abs_of_nonpos H)

  theorem abs_abs (a : A) : abs (abs a) = abs a := abs_of_nonneg !abs_nonneg

  theorem le_abs_self (a : A) : a ≤ abs a :=
  or.elim (le.total 0 a)
    (assume H : 0 ≤ a, abs_of_nonneg H ▸ !le.refl)
    (assume H : a ≤ 0, le.trans H !abs_nonneg)

  theorem neg_le_abs_self (a : A) : -a ≤ abs a :=
  !abs_neg ▸ !le_abs_self

  theorem eq_zero_of_abs_eq_zero (H : abs a = 0) : a = 0 :=
  have H1 : a ≤ 0, from H ▸ le_abs_self a,
  have H2 : -a ≤ 0, from H ▸ abs_neg a ▸ le_abs_self (-a),
  le.antisymm H1 (nonneg_of_neg_nonpos H2)

  theorem abs_eq_zero_iff_eq_zero (a : A) : abs a = 0 ↔ a = 0 :=
  iff.intro eq_zero_of_abs_eq_zero (assume H, congr_arg abs H ⬝ !abs_zero)

  theorem eq_of_abs_sub_eq_zero {a b : A} (H : abs (a - b) = 0) : a = b :=
  have a - b = 0, from eq_zero_of_abs_eq_zero H,
  show a = b, from eq_of_sub_eq_zero this

  theorem abs_pos_of_ne_zero (H : a ≠ 0) : abs a > 0 :=
  or.elim (lt_or_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos

  theorem abs.by_cases {P : A → Prop} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) :=
  or.elim (le.total 0 a)
    (assume H : 0 ≤ a, (abs_of_nonneg H)⁻¹ ▸ H1)
    (assume H : a ≤ 0, (abs_of_nonpos H)⁻¹ ▸ H2)

  theorem abs_le_of_le_of_neg_le (H1 : a ≤ b) (H2 : -a ≤ b) : abs a ≤ b :=
  abs.by_cases H1 H2

  theorem abs_lt_of_lt_of_neg_lt (H1 : a < b) (H2 : -a < b) : abs a < b :=
  abs.by_cases H1 H2

  -- the triangle inequality
  section
    private lemma aux1 {a b : A} (H1 : a + b ≥ 0) (H2 : a ≥ 0) : abs (a + b) ≤ abs a + abs b :=
    decidable.by_cases
      (assume H3 : b ≥ 0,
          calc
            abs (a + b) ≤ abs (a + b)   : le.refl
                ... = a + b             : by rewrite (abs_of_nonneg H1)
                ... = abs a + b         : by rewrite (abs_of_nonneg H2)
                ... = abs a + abs b     : by rewrite (abs_of_nonneg H3))
      (assume H3 : ¬ b ≥ 0,
        have H4 : b ≤ 0, from le_of_lt (lt_of_not_ge H3),
        calc
          abs (a + b) = a + b     : by rewrite (abs_of_nonneg H1)
              ... = abs a + b     : by rewrite (abs_of_nonneg H2)
              ... ≤ abs a + 0     : add_le_add_left H4
              ... ≤ abs a + -b    : add_le_add_left (neg_nonneg_of_nonpos H4)
              ... = abs a + abs b : by rewrite (abs_of_nonpos H4))

    private lemma aux2 {a b : A} (H1 : a + b ≥ 0) : abs (a + b) ≤ abs a + abs b :=
    or.elim (le.total b 0)
      (assume H2 : b ≤ 0,
        have H3 : ¬ a < 0, from
          assume H4 : a < 0,
          have H5 : a + b < 0, from !add_zero ▸ add_lt_add_of_lt_of_le H4 H2,
          not_lt_of_ge H1 H5,
        aux1 H1 (le_of_not_gt H3))
      (assume H2 : 0 ≤ b,
        begin
          have H3 : abs (b + a) ≤ abs b + abs a,
          begin
            rewrite add.comm at H1,
            exact aux1 H1 H2
          end,
          rewrite [add.comm, {abs a + _}add.comm],
          exact H3
        end)

    theorem abs_add_le_abs_add_abs (a b : A) : abs (a + b) ≤ abs a + abs b :=
    or.elim (le.total 0 (a + b))
      (assume H2 : 0 ≤ a + b, aux2 H2)
      (assume H2 : a + b ≤ 0,
        have H3 : -a + -b = -(a + b), by rewrite neg_add,
        have H4 : -(a + b) ≥ 0, from iff.mpr (neg_nonneg_iff_nonpos (a+b)) H2,
        have H5   : -a + -b ≥ 0, begin rewrite -H3 at H4, exact H4 end,
        calc
          abs (a + b) = abs (-a + -b)   : by rewrite [-abs_neg, neg_add]
              ... ≤ abs (-a) + abs (-b) : aux2 H5
              ... = abs a + abs b       : by rewrite *abs_neg)

  theorem abs_sub_abs_le_abs_sub (a b : A) : abs a - abs b ≤ abs (a - b) :=
  have H1 : abs a - abs b + abs b ≤ abs (a - b) + abs b, from
    calc
      abs a - abs b + abs b = abs a : by rewrite sub_add_cancel
        ... = abs (a - b + b)       : by rewrite sub_add_cancel
        ... ≤ abs (a - b) + abs b   : abs_add_le_abs_add_abs,
  le_of_add_le_add_right H1

  theorem abs_sub_le (a b c : A) : abs (a - c) ≤ abs (a - b) + abs (b - c) :=
  calc
    abs (a - c) = abs (a - b + (b - c)) :  by rewrite [*sub_eq_add_neg, add.assoc, neg_add_cancel_left]
            ... ≤ abs (a - b) + abs (b - c) : abs_add_le_abs_add_abs

  theorem abs_add_three (a b c : A) : abs (a + b + c) ≤ abs a + abs b + abs c :=
    begin
      apply le.trans,
      apply abs_add_le_abs_add_abs,
      apply le.trans,
      apply add_le_add_right,
      apply abs_add_le_abs_add_abs,
      apply le.refl
    end

  theorem dist_bdd_within_interval {a b lb ub : A} (H : lb < ub) (Hal : lb ≤ a) (Hau : a ≤ ub)
        (Hbl : lb ≤ b) (Hbu : b ≤ ub) : abs (a - b) ≤ ub - lb :=
  begin
    cases (decidable.em (b ≤ a)) with [Hba, Hba],
    rewrite (abs_of_nonneg (iff.mpr !sub_nonneg_iff_le Hba)),
    apply sub_le_sub,
    apply Hau,
    apply Hbl,
    rewrite [abs_of_neg (iff.mpr !sub_neg_iff_lt (lt_of_not_ge Hba)), neg_sub],
    apply sub_le_sub,
    apply Hbu,
    apply Hal
  end

  end
end


/-
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, Bryan Gin-ge Chen
-/
import order.bounded_lattice
/-!
# (Generalized) Boolean algebras

A Boolean algebra is a bounded distributive lattice with a complement operator. Boolean algebras
generalize the (classical) logic of propositions and the lattice of subsets of a set.

Generalized Boolean algebras may be less familiar, but they are essentially Boolean algebras which
do not necessarily have a top element (`⊤`) (and hence not all elements may have complements). One
example in mathlib is `finset α`, the type of all finite subsets of an arbitrary
(not-necessarily-finite) type `α`.

`generalized_boolean_algebra α` is defined to be a distributive lattice with bottom (`⊥`) admitting
a *relative* complement operator, written using "set difference" notation as `x \ y` (`sdiff x y`).
For convenience, the `boolean_algebra` type class is defined to extend `generalized_boolean_algebra`
so that it is also bundled with a `\` operator.

(A terminological point: `x \ y` is the complement of `y` relative to the interval `[⊥, x]`. We do
not yet have relative complements for arbitrary intervals, as we do not even have lattice
intervals.)

## Main declarations

* `has_compl`: a type class for the complement operator
* `generalized_boolean_algebra`: a type class for generalized Boolean algebras
* `boolean_algebra.core`: a type class with the minimal assumptions for a Boolean algebras
* `boolean_algebra`: the main type class for Boolean algebras; it extends both
  `generalized_boolean_algebra` and `boolean_algebra.core`. An instance of `boolean_algebra` can be
  obtained from one of `boolean_algebra.core` using `boolean_algebra.of_core`.
* `boolean_algebra_Prop`: the Boolean algebra instance on `Prop`

## Implementation notes

The `sup_inf_sdiff` and `inf_inf_sdiff` axioms for the relative complement operator in
`generalized_boolean_algebra` are taken from
[Wikipedia](https://en.wikipedia.org/wiki/Boolean_algebra_(structure)#Generalizations).

[Stone's paper introducing generalized Boolean algebras][Stone1935] does not define a relative
complement operator `a \ b` for all `a`, `b`. Instead, the postulates there amount to an assumption
that for all `a, b : α` where `a ≤ b`, the equations `x ⊔ a = b` and `x ⊓ a = ⊥` have a solution
`x`. `disjoint.sdiff_unique` proves that this `x` is in fact `b \ a`.

## Notations

* `xᶜ` is notation for `compl x`
* `x \ y` is notation for `sdiff x y`.

## References

* <https://en.wikipedia.org/wiki/Boolean_algebra_(structure)#Generalizations>
* [*Postulates for Boolean Algebras and Generalized Boolean Algebras*, M.H. Stone][Stone1935]
* [*Lattice Theory: Foundation*, George Grätzer][Gratzer2011]

## Tags

generalized Boolean algebras, Boolean algebras, lattices, sdiff, compl
-/
set_option old_structure_cmd true

universes u v
variables {α : Type u} {w x y z : α}

/-!
### Generalized Boolean algebras

Some of the lemmas in this section are from:

* [*Lattice Theory: Foundation*, George Grätzer][Gratzer2011]
* <https://ncatlab.org/nlab/show/relative+complement>
* <https://people.math.gatech.edu/~mccuan/courses/4317/symmetricdifference.pdf>

-/

export has_sdiff (sdiff)

/-- A generalized Boolean algebra is a distributive lattice with `⊥` and a relative complement
operation `\` (called `sdiff`, after "set difference") satisfying `(a ⊓ b) ⊔ (a \ b) = a` and
`(a ⊓ b) ⊓ (a \ b) = b`, i.e. `a \ b` is the complement of `b` in `a`.

This is a generalization of Boolean algebras which applies to `finset α` for arbitrary
(not-necessarily-`fintype`) `α`. -/
class generalized_boolean_algebra (α : Type u) extends semilattice_sup_bot α, semilattice_inf_bot α,
  distrib_lattice α, has_sdiff α :=
(sup_inf_sdiff : ∀a b:α, (a ⊓ b) ⊔ (a \ b) = a)
(inf_inf_sdiff : ∀a b:α, (a ⊓ b) ⊓ (a \ b) = ⊥)

-- We might want a `is_compl_of` predicate generalizing `is_compl`,
-- however we'd need another type class for lattices with bot, and all the API for that.

section generalized_boolean_algebra
variables [generalized_boolean_algebra α]

@[simp] theorem sup_inf_sdiff (x y : α) : (x ⊓ y) ⊔ (x \ y) = x :=
generalized_boolean_algebra.sup_inf_sdiff _ _
@[simp] theorem inf_inf_sdiff (x y : α) : (x ⊓ y) ⊓ (x \ y) = ⊥ :=
generalized_boolean_algebra.inf_inf_sdiff _ _

@[simp] theorem sup_sdiff_inf (x y : α) : (x \ y) ⊔ (x ⊓ y) = x :=
by rw [sup_comm, sup_inf_sdiff]
@[simp] theorem inf_sdiff_inf (x y : α) : (x \ y) ⊓ (x ⊓ y) = ⊥ :=
by rw [inf_comm, inf_inf_sdiff]

theorem disjoint_inf_sdiff : disjoint (x ⊓ y) (x \ y) := (inf_inf_sdiff x y).le

-- TODO: in distributive lattices, relative complements are unique when they exist
theorem sdiff_unique (s : (x ⊓ y) ⊔ z = x) (i : (x ⊓ y) ⊓ z = ⊥) : x \ y = z :=
begin
  conv_rhs at s { rw [←sup_inf_sdiff x y, sup_comm] },
  rw sup_comm at s,
  conv_rhs at i { rw [←inf_inf_sdiff x y, inf_comm] },
  rw inf_comm at i,
  exact (eq_of_inf_eq_sup_eq i s).symm,
end

theorem sdiff_symm (hy : y ≤ x) (hz : z ≤ x) (H : x \ y = z) : x \ z = y :=
have hyi : x ⊓ y = y := inf_eq_right.2 hy,
have hzi : x ⊓ z = z := inf_eq_right.2 hz,
eq_of_inf_eq_sup_eq
  (begin
    have ixy := inf_inf_sdiff x y,
    rw [H, hyi] at ixy,
    have ixz := inf_inf_sdiff x z,
    rwa [hzi, inf_comm, ←ixy] at ixz,
  end)
  (begin
    have sxz := sup_inf_sdiff x z,
    rw [hzi, sup_comm] at sxz,
    rw sxz,
    symmetry,
    have sxy := sup_inf_sdiff x y,
    rwa [H, hyi] at sxy,
  end)

lemma sdiff_le : x \ y ≤ x :=
calc x \ y ≤ (x ⊓ y) ⊔ (x \ y) : le_sup_right
       ... = x                 : sup_inf_sdiff x y

@[simp] lemma bot_sdiff : ⊥ \ x = ⊥ := le_bot_iff.1 sdiff_le

lemma inf_sdiff_right : x ⊓ (x \ y) = x \ y := by rw [inf_of_le_right (@sdiff_le _ x y _)]
lemma inf_sdiff_left : (x \ y) ⊓ x = x \ y := by rw [inf_comm, inf_sdiff_right]

-- cf. `is_compl_top_bot`
@[simp] lemma sdiff_self : x \ x = ⊥ :=
by rw [←inf_inf_sdiff, inf_idem, inf_of_le_right (@sdiff_le _ x x _)]

@[simp] theorem sup_sdiff_self_right : x ⊔ (y \ x) = x ⊔ y :=
calc x ⊔ (y \ x) = (x ⊔ (x ⊓ y)) ⊔ (y \ x) : by rw sup_inf_self
             ... = x ⊔ ((y ⊓ x) ⊔ (y \ x)) : by ac_refl
             ... = x ⊔ y                   : by rw sup_inf_sdiff

@[simp] theorem sup_sdiff_self_left : (y \ x) ⊔ x = y ⊔ x :=
by rw [sup_comm, sup_sdiff_self_right, sup_comm]

lemma sup_sdiff_symm : x ⊔ (y \ x) = y ⊔ (x \ y) :=
by rw [sup_sdiff_self_right, sup_sdiff_self_right, sup_comm]

lemma sup_sdiff_of_le (h : x ≤ y) : x ⊔ (y \ x) = y :=
by conv_rhs { rw [←sup_inf_sdiff y x, inf_eq_right.2 h] }

@[simp] lemma sup_sdiff_left : x ⊔ (x \ y) = x := by { rw sup_eq_left, exact sdiff_le }
lemma sup_sdiff_right : (x \ y) ⊔ x = x := by rw [sup_comm, sup_sdiff_left]

@[simp] lemma sdiff_inf_sdiff : x \ y ⊓ (y \ x) = ⊥ :=
eq.symm $
  calc ⊥ = (x ⊓ y) ⊓ (x \ y)                           : by rw inf_inf_sdiff
     ... = (x ⊓ (y ⊓ x ⊔ y \ x)) ⊓ (x \ y)             : by rw sup_inf_sdiff
     ... = (x ⊓ (y ⊓ x) ⊔ x ⊓ (y \ x)) ⊓ (x \ y)       : by rw inf_sup_left
     ... = (y ⊓ (x ⊓ x) ⊔ x ⊓ (y \ x)) ⊓ (x \ y)       : by ac_refl
     ... = (y ⊓ x ⊔ x ⊓ (y \ x)) ⊓ (x \ y)             : by rw inf_idem
     ... = (x ⊓ y ⊓ (x \ y)) ⊔ (x ⊓ (y \ x) ⊓ (x \ y)) : by rw [inf_sup_right, @inf_comm _ _ x y]
     ... = x ⊓ (y \ x) ⊓ (x \ y)                       : by rw [inf_inf_sdiff, bot_sup_eq]
     ... = x ⊓ (x \ y) ⊓ (y \ x)                       : by ac_refl
     ... = (x \ y) ⊓ (y \ x)                           : by rw inf_sdiff_right

lemma disjoint_sdiff_sdiff : disjoint (x \ y) (y \ x) := sdiff_inf_sdiff.le

theorem le_sup_sdiff : y ≤ x ⊔ (y \ x) :=
by { rw [sup_sdiff_self_right], exact le_sup_right }

theorem le_sdiff_sup : y ≤ (y \ x) ⊔ x :=
by { rw [sup_comm], exact le_sup_sdiff }

@[simp] theorem inf_sdiff_self_right : x ⊓ (y \ x) = ⊥ :=
calc x ⊓ (y \ x) = ((x ⊓ y) ⊔ (x \ y)) ⊓ (y \ x)         : by rw sup_inf_sdiff
             ... = (x ⊓ y) ⊓ (y \ x) ⊔ (x \ y) ⊓ (y \ x) : by rw inf_sup_right
             ... = ⊥         : by rw [@inf_comm _ _ x y, inf_inf_sdiff, sdiff_inf_sdiff, bot_sup_eq]
@[simp] theorem inf_sdiff_self_left : (y \ x) ⊓ x = ⊥ := by rw [inf_comm, inf_sdiff_self_right]

theorem disjoint_sdiff : disjoint x (y \ x) := inf_sdiff_self_right.le

/- TODO: if we had a typeclass for distributive lattices with `⊥`, we could make an alternative
constructor for `generalized_boolean_algebra` using `disjoint x (y \ x)` and `x ⊔ (y \ x) = y` as
axioms. -/
theorem disjoint.sdiff_eq_of_sup_eq (hi : disjoint x z) (hs : x ⊔ z = y) : y \ x = z :=
have h : y ⊓ x = x := inf_eq_right.2 $ le_sup_left.trans hs.le,
sdiff_unique (by rw [h, hs]) (by rw [h, hi.eq_bot])

lemma disjoint.sup_sdiff_cancel_left (h : disjoint x y) : (x ⊔ y) \ x = y :=
h.sdiff_eq_of_sup_eq rfl
lemma disjoint.sup_sdiff_cancel_right (h : disjoint x y) : (x ⊔ y) \ y = x :=
h.symm.sdiff_eq_of_sup_eq sup_comm

protected theorem disjoint.sdiff_unique (hd : disjoint x z) (hz : z ≤ y) (hs : y ≤ x ⊔ z) :
  y \ x = z :=
sdiff_unique
  (begin
    rw ←inf_eq_right at hs,
    rwa [sup_inf_right, inf_sup_right, @sup_comm _ _ x, inf_sup_self, inf_comm, @sup_comm _ _ z,
      hs, sup_eq_left],
  end)
  (by rw [inf_assoc, hd.eq_bot, inf_bot_eq])

-- cf. `is_compl.disjoint_left_iff` and `is_compl.disjoint_right_iff`
lemma disjoint_sdiff_iff_le (hz : z ≤ y) (hx : x ≤ y) : disjoint z (y \ x) ↔ z ≤ x :=
⟨λ H, le_of_inf_le_sup_le
    (le_trans H bot_le)
    (begin
      rw sup_sdiff_of_le hx,
      refine le_trans (sup_le_sup_left sdiff_le z) _,
      rw sup_eq_right.2 hz,
    end),
 λ H, disjoint_sdiff.mono_left H⟩

-- cf. `is_compl.le_left_iff` and `is_compl.le_right_iff`
lemma le_iff_disjoint_sdiff (hz : z ≤ y) (hx : x ≤ y) : z ≤ x ↔ disjoint z (y \ x) :=
(disjoint_sdiff_iff_le hz hx).symm

-- cf. `is_compl.inf_left_eq_bot_iff` and `is_compl.inf_right_eq_bot_iff`
lemma inf_sdiff_eq_bot_iff (hz : z ≤ y) (hx : x ≤ y) : z ⊓ (y \ x) = ⊥ ↔ z ≤ x :=
by { rw ←disjoint_iff, exact disjoint_sdiff_iff_le hz hx }

-- cf. `is_compl.left_le_iff` and `is_compl.right_le_iff`
lemma le_iff_eq_sup_sdiff (hz : z ≤ y) (hx : x ≤ y) : x ≤ z ↔ y = z ⊔ (y \ x) :=
⟨λ H,
  begin
    apply le_antisymm,
    { conv_lhs { rw ←sup_inf_sdiff y x, },
      apply sup_le_sup_right,
      rwa inf_eq_right.2 hx, },
    { apply le_trans,
      { apply sup_le_sup_right hz, },
      { rw sup_sdiff_left, } }
  end,
 λ H,
  begin
    conv_lhs at H { rw ←sup_sdiff_of_le hx, },
    refine le_of_inf_le_sup_le _ H.le,
    rw inf_sdiff_self_right,
    exact bot_le,
  end⟩

-- cf. `set.union_diff_cancel'`
lemma sup_sdiff_cancel' (hx : x ≤ z) (hz : z ≤ y) : z ⊔ (y \ x) = y :=
((le_iff_eq_sup_sdiff hz (hx.trans hz)).1 hx).symm

-- cf. `is_compl.sup_inf`
lemma sdiff_sup : y \ (x ⊔ z) = (y \ x) ⊓ (y \ z) :=
sdiff_unique
  (calc y ⊓ (x ⊔ z) ⊔ y \ x ⊓ (y \ z) =
        (y ⊓ (x ⊔ z) ⊔ y \ x) ⊓ (y ⊓ (x ⊔ z) ⊔ (y \ z))         : by rw sup_inf_left
  ... = (y ⊓ x ⊔ y ⊓ z ⊔ y \ x) ⊓ (y ⊓ x ⊔ y ⊓ z ⊔ (y \ z))     : by rw @inf_sup_left _ _ y
  ... = (y ⊓ z ⊔ (y ⊓ x ⊔ y \ x)) ⊓ (y ⊓ x ⊔ (y ⊓ z ⊔ (y \ z))) : by ac_refl
  ... = (y ⊓ z ⊔ y) ⊓ (y ⊓ x ⊔ y)                             : by rw [sup_inf_sdiff, sup_inf_sdiff]
  ... = (y ⊔ y ⊓ z) ⊓ (y ⊔ y ⊓ x)                               : by ac_refl
  ... = y                                            : by rw [sup_inf_self, sup_inf_self, inf_idem])
  (calc y ⊓ (x ⊔ z) ⊓ ((y \ x) ⊓ (y \ z)) =
        (y ⊓ x ⊔ y ⊓ z) ⊓ ((y \ x) ⊓ (y \ z))                             : by rw inf_sup_left
  ... = ((y ⊓ x) ⊓ ((y \ x) ⊓ (y \ z))) ⊔ ((y ⊓ z) ⊓ ((y \ x) ⊓ (y \ z))) : by rw inf_sup_right
  ... = ((y ⊓ x) ⊓ (y \ x) ⊓ (y \ z)) ⊔ ((y \ x) ⊓ ((y \ z) ⊓ (y ⊓ z)))   : by ac_refl
  ... = ⊥ : by rw [inf_inf_sdiff, bot_inf_eq, bot_sup_eq, @inf_comm _ _ (y \ z), inf_inf_sdiff,
              inf_bot_eq])

-- cf. `is_compl.inf_sup`
lemma sdiff_inf : y \ (x ⊓ z) = y \ x ⊔ y \ z :=
sdiff_unique
  (calc y ⊓ (x ⊓ z) ⊔ (y \ x ⊔ y \ z) =
        (z ⊓ (y ⊓ x)) ⊔ (y \ x ⊔ y \ z)                     : by ac_refl
  ... = (z ⊔ (y \ x ⊔ y \ z)) ⊓ ((y ⊓ x) ⊔ (y \ x ⊔ y \ z)) : by rw sup_inf_right
  ... = (y \ x ⊔ (y \ z ⊔ z)) ⊓ (y ⊓ x ⊔ (y \ x ⊔ y \ z))   : by ac_refl
  ... = (y ⊔ z) ⊓ ((y ⊓ x) ⊔ (y \ x ⊔ y \ z)) :
                                            by rw [sup_sdiff_self_left, ←sup_assoc, sup_sdiff_right]
  ... = (y ⊔ z) ⊓ y                              : by rw [←sup_assoc, sup_inf_sdiff, sup_sdiff_left]
  ... = y                                                   : by rw [inf_comm, inf_sup_self])
  (calc y ⊓ (x ⊓ z) ⊓ ((y \ x) ⊔ (y \ z)) =
        (y ⊓ (x ⊓ z) ⊓ (y \ x)) ⊔ (y ⊓ (x ⊓ z) ⊓ (y \ z)) : by rw inf_sup_left
  ... = z ⊓ (y ⊓ x ⊓ (y \ x)) ⊔ z ⊓ (y ⊓ x) ⊓ (y \ z)     : by ac_refl
  ... = z ⊓ (y ⊓ x) ⊓ (y \ z)                        : by rw [inf_inf_sdiff, inf_bot_eq, bot_sup_eq]
  ... = x ⊓ ((y ⊓ z) ⊓ (y \ z))                           : by ac_refl
  ... = ⊥                                                 : by rw [inf_inf_sdiff, inf_bot_eq])

@[simp] lemma sdiff_inf_self_right : y \ (x ⊓ y) = y \ x :=
by rw [sdiff_inf, sdiff_self, sup_bot_eq]
@[simp] lemma sdiff_inf_self_left : y \ (y ⊓ x) = y \ x := by rw [inf_comm, sdiff_inf_self_right]

lemma sdiff_eq_sdiff_iff_inf_eq_inf : y \ x = y \ z ↔ y ⊓ x = y ⊓ z :=
⟨λ h, eq_of_inf_eq_sup_eq
  (by rw [inf_inf_sdiff, h, inf_inf_sdiff])
  (by rw [sup_inf_sdiff, h, sup_inf_sdiff]),
 λ h, by rw [←sdiff_inf_self_right, ←@sdiff_inf_self_right _ z y, inf_comm, h, inf_comm]⟩

theorem disjoint.sdiff_eq_left (h : disjoint x y) : x \ y = x :=
by conv_rhs { rw [←sup_inf_sdiff x y, h.eq_bot, bot_sup_eq] }
theorem disjoint.sdiff_eq_right (h : disjoint x y) : y \ x = y := h.symm.sdiff_eq_left

-- cf. `is_compl_bot_top`
@[simp] theorem sdiff_bot : x \ ⊥ = x := disjoint_bot_right.sdiff_eq_left

theorem sdiff_eq_self_iff_disjoint : x \ y = x ↔ disjoint y x :=
calc x \ y = x ↔ x \ y = x \ ⊥ : by rw sdiff_bot
           ... ↔ x ⊓ y = x ⊓ ⊥ : sdiff_eq_sdiff_iff_inf_eq_inf
           ... ↔ disjoint y x  : by rw [inf_bot_eq, inf_comm, disjoint_iff]

theorem sdiff_eq_self_iff_disjoint' : x \ y = x ↔ disjoint x y :=
by rw [sdiff_eq_self_iff_disjoint, disjoint.comm]

-- cf. `is_compl.antimono`
lemma sdiff_le_sdiff_self (h : z ≤ x) : w \ x ≤ w \ z :=
le_of_inf_le_sup_le
  (calc (w \ x) ⊓ (w ⊓ z) ≤ (w \ x) ⊓ (w ⊓ x) : inf_le_inf le_rfl (inf_le_inf le_rfl h)
              ... = ⊥                         : by rw [inf_comm, inf_inf_sdiff]
              ... ≤ (w \ z) ⊓ (w ⊓ z)         : bot_le)
  (calc w \ x ⊔ (w ⊓ z) ≤ w \ x ⊔ (w ⊓ x)   : sup_le_sup le_rfl (inf_le_inf le_rfl h)
                    ... ≤ w                 : by rw [sup_comm, sup_inf_sdiff]
                    ... = (w \ z) ⊔ (w ⊓ z) : by rw [sup_comm, sup_inf_sdiff])

lemma sdiff_le_iff : y \ x ≤ z ↔ y ≤ x ⊔ z :=
⟨λ h, le_of_inf_le_sup_le
  (le_of_eq
    (calc y ⊓ (y \ x) = y \ x                         : inf_sdiff_right
                  ... = (x ⊓ (y \ x)) ⊔ (z ⊓ (y \ x)) :
                                          by rw [inf_eq_right.2 h, inf_sdiff_self_right, bot_sup_eq]
                  ... = (x ⊔ z) ⊓ (y \ x)             : inf_sup_right.symm))
  (calc y ⊔ y \ x = y                 : sup_sdiff_left
              ... ≤ y ⊔ (x ⊔ z)       : le_sup_left
              ... = ((y \ x) ⊔ x) ⊔ z : by rw [←sup_assoc, ←@sup_sdiff_self_left _ x y]
              ... = x ⊔ z ⊔ y \ x     : by ac_refl),
 λ h, le_of_inf_le_sup_le
  (calc y \ x ⊓ x = ⊥     : inf_sdiff_self_left
              ... ≤ z ⊓ x : bot_le)
  (calc y \ x ⊔ x = y ⊔ x       : sup_sdiff_self_left
              ... ≤ (x ⊔ z) ⊔ x : sup_le_sup_right h x
              ... ≤ z ⊔ x       : by rw [sup_assoc, sup_comm, sup_assoc, sup_idem])⟩

lemma sdiff_eq_bot_iff : y \ x = ⊥ ↔ y ≤ x :=
by rw [←le_bot_iff, sdiff_le_iff, sup_bot_eq]

lemma sdiff_le_comm : x \ y ≤ z ↔ x \ z ≤ y :=
by rw [sdiff_le_iff, sup_comm, sdiff_le_iff]

lemma sdiff_le_self_sdiff (h : w ≤ y) : w \ x ≤ y \ x :=
le_of_inf_le_sup_le
  (calc (w \ x) ⊓ (w ⊓ x) = ⊥                 : by rw [inf_comm, inf_inf_sdiff]
                      ... ≤ (y \ x) ⊓ (w ⊓ x) : bot_le)
  (calc w \ x ⊔ (w ⊓ x) = w                       : by rw [sup_comm, sup_inf_sdiff]
                    ... ≤ (y ⊓ (y \ x)) ⊔ w       : le_sup_right
                    ... = (y ⊓ (y \ x)) ⊔ (y ⊓ w) : by rw inf_eq_right.2 h
                    ... = y ⊓ ((y \ x) ⊔ w)       : by rw inf_sup_left
                    ... = ((y \ x) ⊔ (y ⊓ x)) ⊓ ((y \ x) ⊔ w) :
                                                by rw [@sup_comm _ _ (y \ x) (y ⊓ x), sup_inf_sdiff]
                    ... = (y \ x) ⊔ ((y ⊓ x) ⊓ w) : by rw ←sup_inf_left
                    ... = (y \ x) ⊔ ((w ⊓ y) ⊓ x) : by ac_refl
                    ... = (y \ x) ⊔ (w ⊓ x)       : by rw inf_eq_left.2 h)

theorem sdiff_le_sdiff (h₁ : w ≤ y) (h₂ : z ≤ x) : w \ x ≤ y \ z :=
calc w \ x ≤ w \ z : sdiff_le_sdiff_self h₂
       ... ≤ y \ z : sdiff_le_self_sdiff h₁

lemma sup_inf_inf_sdiff : (x ⊓ y) ⊓ z ⊔ (y \ z) = (x ⊓ y) ⊔ (y \ z) :=
calc (x ⊓ y) ⊓ z ⊔ (y \ z) = x ⊓ (y ⊓ z) ⊔ (y \ z) : by rw inf_assoc
                       ... = (x ⊔ (y \ z)) ⊓ y     : by rw [sup_inf_right, sup_inf_sdiff]
                       ... = (x ⊓ y) ⊔ (y \ z)     : by rw [inf_sup_right, inf_sdiff_left]

@[simp] lemma inf_sdiff_sup_left : (x \ z) ⊓ (x ⊔ y) = x \ z :=
by rw [inf_sup_left, inf_sdiff_left, sup_inf_self]
@[simp] lemma inf_sdiff_sup_right : (x \ z) ⊓ (y ⊔ x) = x \ z :=
by rw [sup_comm, inf_sdiff_sup_left]

lemma sdiff_sdiff_right : x \ (y \ z) = (x \ y) ⊔ (x ⊓ y ⊓ z) :=
begin
  rw [sup_comm, inf_comm, ←inf_assoc, sup_inf_inf_sdiff],
  apply sdiff_unique,
  { calc x ⊓ (y \ z) ⊔ (z ⊓ x ⊔ x \ y) =
          (x ⊔ (z ⊓ x ⊔ x \ y)) ⊓ (y \ z ⊔ (z ⊓ x ⊔ x \ y)) : by rw sup_inf_right
    ... = (x ⊔ x ⊓ z ⊔ x \ y) ⊓ (y \ z ⊔ (x ⊓ z ⊔ x \ y))   : by ac_refl
    ... = x ⊓ (y \ z ⊔ x ⊓ z ⊔ x \ y)             : by rw [sup_inf_self, sup_sdiff_left, ←sup_assoc]
    ... = x ⊓ (y \ z ⊓ (z ⊔ y) ⊔ x ⊓ (z ⊔ y) ⊔ x \ y) :
                           by rw [sup_inf_left, sup_sdiff_self_left, inf_sup_right, @sup_comm _ _ y]
    ... = x ⊓ (y \ z ⊔ (x ⊓ z ⊔ x ⊓ y) ⊔ x \ y) :
                                                by rw [inf_sdiff_sup_right, @inf_sup_left _ _ x z y]
    ... = x ⊓ (y \ z ⊔ (x ⊓ z ⊔ (x ⊓ y ⊔ x \ y)))           : by ac_refl
    ... = x ⊓ (y \ z ⊔ (x ⊔ x ⊓ z))                   : by rw [sup_inf_sdiff, @sup_comm _ _ (x ⊓ z)]
    ... = x                                        : by rw [sup_inf_self, sup_comm, inf_sup_self] },
  { calc x ⊓ (y \ z) ⊓ (z ⊓ x ⊔ x \ y) =
          x ⊓ (y \ z) ⊓ (z ⊓ x) ⊔ x ⊓ (y \ z) ⊓ (x \ y) : by rw inf_sup_left
    ... = x ⊓ (y \ z ⊓ z ⊓ x) ⊔ x ⊓ (y \ z) ⊓ (x \ y)   : by ac_refl
    ... = x ⊓ (y \ z) ⊓ (x \ y) :    by rw [inf_sdiff_self_left, bot_inf_eq, inf_bot_eq, bot_sup_eq]
    ... = x ⊓ (y \ z ⊓ y) ⊓ (x \ y)                     : by conv_lhs { rw ←inf_sdiff_left }
    ... = x ⊓ (y \ z ⊓ (y ⊓ (x \ y)))                   : by ac_refl
    ... = ⊥                                 : by rw [inf_sdiff_self_right, inf_bot_eq, inf_bot_eq] }
end

lemma sdiff_sdiff_right' : x \ (y \ z) = (x \ y) ⊔ (x ⊓ z) :=
calc  x \ (y \ z) = (x \ y) ⊔ (x ⊓ y ⊓ z) : sdiff_sdiff_right
              ... = z ⊓ x ⊓ y ⊔ (x \ y)   : by ac_refl
              ... = (x \ y) ⊔ (x ⊓ z)     : by rw [sup_inf_inf_sdiff, sup_comm, inf_comm]

@[simp] lemma sdiff_sdiff_right_self : x \ (x \ y) = x ⊓ y :=
by rw [sdiff_sdiff_right, inf_idem, sdiff_self, bot_sup_eq]

lemma sdiff_sdiff_eq_self (h : y ≤ x) : x \ (x \ y) = y :=
by rw [sdiff_sdiff_right_self, inf_of_le_right h]

lemma sdiff_sdiff_left : (x \ y) \ z = x \ (y ⊔ z) :=
begin
  rw sdiff_sup,
  apply sdiff_unique,
  { rw [←inf_sup_left, sup_sdiff_self_right, inf_sdiff_sup_right] },
  { rw [inf_assoc, @inf_comm _ _ z, inf_assoc, inf_sdiff_self_left, inf_bot_eq, inf_bot_eq] }
end

lemma sdiff_sdiff_left' : (x \ y) \ z = (x \ y) ⊓ (x \ z) :=
by rw [sdiff_sdiff_left, sdiff_sup]

lemma sdiff_sdiff_comm : (x \ y) \ z = (x \ z) \ y :=
by rw [sdiff_sdiff_left, sup_comm, sdiff_sdiff_left]

@[simp] lemma sdiff_idem : x \ y \ y = x \ y := by rw [sdiff_sdiff_left, sup_idem]

lemma sdiff_sdiff_sup_sdiff : z \ (x \ y ⊔ y \ x) = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x) :=
calc z \ (x \ y ⊔ y \ x) = (z \ x ⊔ z ⊓ x ⊓ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) :
                                             by rw [sdiff_sup, sdiff_sdiff_right, sdiff_sdiff_right]
... = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) : by rw [sup_inf_left, sup_comm, sup_inf_sdiff]
... = z ⊓ (z \ x ⊔ y) ⊓ (z ⊓ (z \ y ⊔ x)) :
                                          by rw [sup_inf_left, @sup_comm _ _ (z \ y), sup_inf_sdiff]
... = z ⊓ z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x)     : by ac_refl
... = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x)         : by rw inf_idem

lemma sdiff_sdiff_sup_sdiff' : z \ (x \ y ⊔ y \ x) = z ⊓ x ⊓ y ⊔ ((z \ x) ⊓ (z \ y)) :=
calc z \ (x \ y ⊔ y \ x) =
      z \ (x \ y) ⊓ (z \ (y \ x))               : sdiff_sup
... = (z \ x ⊔ z ⊓ x ⊓ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) : by rw [sdiff_sdiff_right, sdiff_sdiff_right]
... = (z \ x ⊔ z ⊓ y ⊓ x) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) : by ac_refl
... = (z \ x) ⊓ (z \ y) ⊔ z ⊓ y ⊓ x             : sup_inf_right.symm
... = z ⊓ x ⊓ y ⊔ ((z \ x) ⊓ (z \ y))           : by ac_refl

lemma sup_sdiff : (x ⊔ y) \ z = (x \ z) ⊔ (y \ z) :=
sdiff_unique
  (calc (x ⊔ y) ⊓ z ⊔ (x \ z ⊔ y \ z) =
        (x ⊓ z ⊔ y ⊓ z) ⊔ (x \ z ⊔ y \ z) : by rw inf_sup_right
  ... = x ⊓ z ⊔ x \ z ⊔ y \ z ⊔ y ⊓ z     : by ac_refl
  ... = x ⊔ (y ⊓ z ⊔ y \ z)               : by rw [sup_inf_sdiff, sup_assoc, @sup_comm _ _ (y \ z)]
  ... = x ⊔ y                             : by rw sup_inf_sdiff)
  (calc (x ⊔ y) ⊓ z ⊓ (x \ z ⊔ y \ z) =
        (x ⊓ z ⊔ y ⊓ z) ⊓ (x \ z ⊔ y \ z)                       : by rw inf_sup_right
  ... = (x ⊓ z ⊔ y ⊓ z) ⊓ (x \ z) ⊔ ((x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)) :
                                                           by rw [@inf_sup_left _ _ (x ⊓ z ⊔ y ⊓ z)]
  ... = (y ⊓ z ⊓ (x \ z)) ⊔ ((x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)) :
                                                    by rw [inf_sup_right, inf_inf_sdiff, bot_sup_eq]
  ... = (x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)  : by rw [inf_assoc, inf_sdiff_self_right, inf_bot_eq, bot_sup_eq]
  ... = x ⊓ z ⊓ (y \ z)                           : by rw [inf_sup_right, inf_inf_sdiff, sup_bot_eq]
  ... = ⊥                                     : by rw [inf_assoc, inf_sdiff_self_right, inf_bot_eq])

lemma sup_sdiff_right_self : (x ⊔ y) \ y = x \ y :=
by rw [sup_sdiff, sdiff_self, sup_bot_eq]

lemma sup_sdiff_left_self : (x ⊔ y) \ x = y \ x :=
by rw [sup_comm, sup_sdiff_right_self]

lemma inf_sdiff : (x ⊓ y) \ z = (x \ z) ⊓ (y \ z) :=
sdiff_unique
  (calc (x ⊓ y) ⊓ z ⊔ ((x \ z) ⊓ (y \ z)) =
        ((x ⊓ y) ⊓ z ⊔ (x \ z)) ⊓ ((x ⊓ y) ⊓ z ⊔ (y \ z)) : by rw [sup_inf_left]
  ... = (x ⊓ y ⊓ (z ⊔ x) ⊔ x \ z) ⊓ (x ⊓ y ⊓ z ⊔ y \ z) :
                     by rw [sup_inf_right, sup_sdiff_self_right, inf_sup_right, inf_sdiff_sup_right]
  ... = (y ⊓ (x ⊓ (x ⊔ z)) ⊔ x \ z) ⊓ (x ⊓ y ⊓ z ⊔ y \ z) : by ac_refl
  ... = ((y ⊓ x) ⊔ (x \ z)) ⊓ ((x ⊓ y) ⊔ (y \ z))         : by rw [inf_sup_self, sup_inf_inf_sdiff]
  ... = (x ⊓ y) ⊔ ((x \ z) ⊓ (y \ z))                     : by rw [@inf_comm _ _ y, sup_inf_left]
  ... = x ⊓ y                                        : sup_eq_left.2 (inf_le_inf sdiff_le sdiff_le))
  (calc (x ⊓ y) ⊓ z ⊓ ((x \ z) ⊓ (y \ z)) =
        x ⊓ y ⊓ (z ⊓ (x \ z)) ⊓ (y \ z) : by ac_refl
  ... = ⊥                               : by rw [inf_sdiff_self_right, inf_bot_eq, bot_inf_eq])

lemma inf_sdiff_assoc : (x ⊓ y) \ z = x ⊓ (y \ z) :=
sdiff_unique
  (calc x ⊓ y ⊓ z ⊔ x ⊓ (y \ z) = x ⊓ (y ⊓ z) ⊔ x ⊓ (y \ z) : by rw inf_assoc
                            ... = x ⊓ ((y ⊓ z) ⊔ y \ z)     : inf_sup_left.symm
                            ... = x ⊓ y                     : by rw sup_inf_sdiff)
  (calc x ⊓ y ⊓ z ⊓ (x ⊓ (y \ z)) = x ⊓ x ⊓ ((y ⊓ z) ⊓ (y \ z)) : by ac_refl
                              ... = ⊥                           : by rw [inf_inf_sdiff, inf_bot_eq])

lemma sup_eq_sdiff_sup_sdiff_sup_inf : x ⊔ y = (x \ y) ⊔ (y \ x) ⊔ (x ⊓ y) :=
eq.symm $
  calc (x \ y) ⊔ (y \ x) ⊔ (x ⊓ y) =
        ((x \ y) ⊔ (y \ x) ⊔ x) ⊓ ((x \ y) ⊔ (y \ x) ⊔ y)   : by rw sup_inf_left
  ... = ((x \ y) ⊔ x ⊔ (y \ x)) ⊓ ((x \ y) ⊔ ((y \ x) ⊔ y)) : by ac_refl
  ... = (x ⊔ (y \ x)) ⊓ ((x \ y) ⊔ y)                     : by rw [sup_sdiff_right, sup_sdiff_right]
  ... = x ⊔ y                          : by rw [sup_sdiff_self_right, sup_sdiff_self_left, inf_idem]

instance pi.generalized_boolean_algebra {α : Type u} {β : Type v} [generalized_boolean_algebra β] :
  generalized_boolean_algebra (α → β) :=
by pi_instance

end generalized_boolean_algebra

/-!
### Boolean algebras
-/

/-- Set / lattice complement -/
class has_compl (α : Type*) := (compl : α → α)

export has_compl (compl)

postfix `ᶜ`:(max+1) := compl

/-- This class contains the core axioms of a Boolean algebra. The `boolean_algebra` class extends
both this class and `generalized_boolean_algebra`, see Note [forgetful inheritance]. -/
class boolean_algebra.core (α : Type u) extends bounded_distrib_lattice α, has_compl α :=
(inf_compl_le_bot : ∀x:α, x ⊓ xᶜ ≤ ⊥)
(top_le_sup_compl : ∀x:α, ⊤ ≤ x ⊔ xᶜ)

section boolean_algebra_core
variables [boolean_algebra.core α]

@[simp] theorem inf_compl_eq_bot : x ⊓ xᶜ = ⊥ :=
bot_unique $ boolean_algebra.core.inf_compl_le_bot x

@[simp] theorem compl_inf_eq_bot : xᶜ ⊓ x = ⊥ :=
eq.trans inf_comm inf_compl_eq_bot

@[simp] theorem sup_compl_eq_top : x ⊔ xᶜ = ⊤ :=
top_unique $ boolean_algebra.core.top_le_sup_compl x

@[simp] theorem compl_sup_eq_top : xᶜ ⊔ x = ⊤ :=
eq.trans sup_comm sup_compl_eq_top

theorem is_compl_compl : is_compl x xᶜ :=
is_compl.of_eq inf_compl_eq_bot sup_compl_eq_top

theorem is_compl.eq_compl (h : is_compl x y) : x = yᶜ :=
h.left_unique is_compl_compl.symm

theorem is_compl.compl_eq (h : is_compl x y) : xᶜ = y :=
(h.right_unique is_compl_compl).symm

theorem disjoint_compl_right : disjoint x xᶜ := is_compl_compl.disjoint
theorem disjoint_compl_left : disjoint xᶜ x := disjoint_compl_right.symm

theorem compl_unique (i : x ⊓ y = ⊥) (s : x ⊔ y = ⊤) : xᶜ = y :=
(is_compl.of_eq i s).compl_eq

@[simp] theorem compl_top : ⊤ᶜ = (⊥:α) :=
is_compl_top_bot.compl_eq

@[simp] theorem compl_bot : ⊥ᶜ = (⊤:α) :=
is_compl_bot_top.compl_eq

@[simp] theorem compl_compl (x : α) : xᶜᶜ = x :=
is_compl_compl.symm.compl_eq

theorem compl_injective : function.injective (compl : α → α) :=
function.involutive.injective compl_compl

@[simp] theorem compl_inj_iff : xᶜ = yᶜ ↔ x = y :=
compl_injective.eq_iff

theorem is_compl.compl_eq_iff (h : is_compl x y) : zᶜ = y ↔ z = x :=
h.compl_eq ▸ compl_inj_iff

@[simp] theorem compl_eq_top : xᶜ = ⊤ ↔ x = ⊥ :=
is_compl_bot_top.compl_eq_iff

@[simp] theorem compl_eq_bot : xᶜ = ⊥ ↔ x = ⊤ :=
is_compl_top_bot.compl_eq_iff

@[simp] theorem compl_inf : (x ⊓ y)ᶜ = xᶜ ⊔ yᶜ :=
(is_compl_compl.inf_sup is_compl_compl).compl_eq

@[simp] theorem compl_sup : (x ⊔ y)ᶜ = xᶜ ⊓ yᶜ :=
(is_compl_compl.sup_inf is_compl_compl).compl_eq

theorem compl_le_compl (h : y ≤ x) : xᶜ ≤ yᶜ :=
is_compl_compl.antimono is_compl_compl h

@[simp] theorem compl_le_compl_iff_le : yᶜ ≤ xᶜ ↔ x ≤ y :=
⟨assume h, by have h := compl_le_compl h; simp at h; assumption,
  compl_le_compl⟩

theorem le_compl_of_le_compl (h : y ≤ xᶜ) : x ≤ yᶜ :=
by simpa only [compl_compl] using compl_le_compl h

theorem compl_le_of_compl_le (h : yᶜ ≤ x) : xᶜ ≤ y :=
by simpa only [compl_compl] using compl_le_compl h

theorem le_compl_iff_le_compl : y ≤ xᶜ ↔ x ≤ yᶜ :=
⟨le_compl_of_le_compl, le_compl_of_le_compl⟩

theorem compl_le_iff_compl_le : xᶜ ≤ y ↔ yᶜ ≤ x :=
⟨compl_le_of_compl_le, compl_le_of_compl_le⟩

namespace boolean_algebra

@[priority 100]
instance : is_complemented α := ⟨λ x, ⟨xᶜ, is_compl_compl⟩⟩

end boolean_algebra

end boolean_algebra_core

/-- A Boolean algebra is a bounded distributive lattice with
a complement operator `ᶜ` such that `x ⊓ xᶜ = ⊥` and `x ⊔ xᶜ = ⊤`.
For convenience, it must also provide a set difference operation `\`
satisfying `x \ y = x ⊓ yᶜ`.

This is a generalization of (classical) logic of propositions, or
the powerset lattice. -/
-- Lean complains about metavariables in the type if the universe is not specified
class boolean_algebra (α : Type u) extends generalized_boolean_algebra α, boolean_algebra.core α :=
(sdiff_eq : ∀x y:α, x \ y = x ⊓ yᶜ)
-- TODO: is there a way to automatically fill in the proofs of sup_inf_sdiff and inf_inf_sdiff given
-- everything in `boolean_algebra.core` and `sdiff_eq`? The following doesn't work:
-- (sup_inf_sdiff := λ a b, by rw [sdiff_eq, ←inf_sup_left, sup_compl_eq_top, inf_top_eq])

/-- Create a `boolean_algebra` instance from a `boolean_algebra.core` instance, defining `x \ y` to
be `x ⊓ yᶜ`.

For some types, it may be more convenient to create the `boolean_algebra` instance by hand in order
to have a simpler `sdiff` operation. -/
def boolean_algebra.of_core (B : boolean_algebra.core α) :
  boolean_algebra α :=
{ sdiff := λ x y, x ⊓ yᶜ,
  sdiff_eq := λ _ _, rfl,
  sup_inf_sdiff := λ a b, by rw [←inf_sup_left, sup_compl_eq_top, inf_top_eq],
  inf_inf_sdiff := λ a b, by rw [inf_left_right_swap, @inf_assoc _ _ a, compl_inf_eq_bot,
    inf_bot_eq, bot_inf_eq],
  ..B }

section boolean_algebra
variables [boolean_algebra α]

theorem sdiff_eq : x \ y = x ⊓ yᶜ := boolean_algebra.sdiff_eq x y

theorem sdiff_compl : x \ yᶜ = x ⊓ y := by rw [sdiff_eq, compl_compl]

theorem top_sdiff : ⊤ \ x = xᶜ := by rw [sdiff_eq, top_inf_eq]
@[simp] theorem sdiff_top : x \ ⊤ = ⊥ := by rw [sdiff_eq, compl_top, inf_bot_eq]

end boolean_algebra

instance boolean_algebra_Prop : boolean_algebra Prop :=
boolean_algebra.of_core
{ compl := not,
  inf_compl_le_bot := λ p ⟨Hp, Hpc⟩, Hpc Hp,
  top_le_sup_compl := λ p H, classical.em p,
  .. bounded_distrib_lattice_Prop }

instance pi.boolean_algebra {α : Type u} {β : Type v} [boolean_algebra β] :
  boolean_algebra (α → β) :=
by pi_instance


/-
Copyright (c) 2023 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 analysis.normed_space.quaternion_exponential
! leanprover-community/mathlib commit da3fc4a33ff6bc75f077f691dc94c217b8d41559
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Quaternion
import Mathbin.Analysis.NormedSpace.Exponential
import Mathbin.Analysis.InnerProductSpace.PiL2
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Series

/-!
# Lemmas about `exp` on `quaternion`s

This file contains results about `exp` on `quaternion ℝ`.

## Main results

* `quaternion.exp_eq`: the general expansion of the quaternion exponential in terms of `real.cos`
  and `real.sin`.
* `quaternion.exp_of_re_eq_zero`: the special case when the quaternion has a zero real part.
* `quaternion.norm_exp`: the norm of the quaternion exponential is the norm of the exponential of
  the real part.

-/

open Quaternion Nat

namespace Quaternion

theorem conj_exp (q : ℍ[ℝ]) : conj (exp ℝ q) = exp ℝ (conj q) :=
  star_exp q
#align quaternion.conj_exp Quaternion.conj_exp

@[simp, norm_cast]
theorem exp_coe (r : ℝ) : exp ℝ (r : ℍ[ℝ]) = ↑(exp ℝ r) :=
  (map_exp ℝ (algebraMap ℝ ℍ[ℝ]) (continuous_algebraMap _ _) _).symm
#align quaternion.exp_coe Quaternion.exp_coe

/-- Auxiliary result; if the power series corresponding to `real.cos` and `real.sin` evaluated
at `‖q‖` tend to `c` and `s`, then the exponential series tends to `c + (s / ‖q‖)`. -/
theorem hasSum_expSeries_of_imaginary {q : Quaternion ℝ} (hq : q.re = 0) {c s : ℝ}
    (hc : HasSum (fun n => (-1) ^ n * ‖q‖ ^ (2 * n) / (2 * n)!) c)
    (hs : HasSum (fun n => (-1) ^ n * ‖q‖ ^ (2 * n + 1) / (2 * n + 1)!) s) :
    HasSum (fun n => expSeries ℝ _ n fun _ => q) (↑c + (s / ‖q‖) • q) :=
  by
  replace hc := has_sum_coe.mpr hc
  replace hs := (hs.div_const ‖q‖).smul_const q
  obtain rfl | hq0 := eq_or_ne q 0
  · simp_rw [expSeries_apply_zero, norm_zero, div_zero, zero_smul, add_zero]
    simp_rw [norm_zero] at hc
    convert hc
    ext (_ | n) : 1
    ·
      rw [pow_zero, MulZeroClass.mul_zero, pow_zero, Nat.factorial_zero, Nat.cast_one, div_one,
        one_mul, Pi.single_eq_same, coe_one]
    ·
      rw [zero_pow (mul_pos two_pos (Nat.succ_pos _)), MulZeroClass.mul_zero, zero_div,
        Pi.single_eq_of_ne n.succ_ne_zero, coe_zero]
  simp_rw [expSeries_apply_eq]
  have hq2 : q ^ 2 = -norm_sq q := sq_eq_neg_norm_sq.mpr hq
  have hqn := norm_ne_zero_iff.mpr hq0
  refine' HasSum.even_add_odd _ _
  · convert hc using 1
    ext n : 1
    let k : ℝ := ↑(2 * n)!
    calc
      k⁻¹ • q ^ (2 * n) = k⁻¹ • (-norm_sq q) ^ n := by rw [pow_mul, hq2]
      _ = k⁻¹ • ↑((-1) ^ n * ‖q‖ ^ (2 * n)) := _
      _ = ↑((-1) ^ n * ‖q‖ ^ (2 * n) / k) := _

    · congr 1
      rw [neg_pow, norm_sq_eq_norm_sq, pow_mul, sq]
      push_cast
    · rw [← coe_mul_eq_smul, div_eq_mul_inv]
      norm_cast
      ring_nf
  · convert hs using 1
    ext n : 1
    let k : ℝ := ↑(2 * n + 1)!
    calc
      k⁻¹ • q ^ (2 * n + 1) = k⁻¹ • ((-norm_sq q) ^ n * q) := by rw [pow_succ', pow_mul, hq2]
      _ = k⁻¹ • ((-1) ^ n * ‖q‖ ^ (2 * n)) • q := _
      _ = ((-1) ^ n * ‖q‖ ^ (2 * n + 1) / k / ‖q‖) • q := _

    · congr 1
      rw [neg_pow, norm_sq_eq_norm_sq, pow_mul, sq, ← coe_mul_eq_smul]
      push_cast
    · rw [smul_smul]
      congr 1
      simp_rw [pow_succ', mul_div_assoc, div_div_cancel_left' hqn]
      ring
#align quaternion.has_sum_exp_series_of_imaginary Quaternion.hasSum_expSeries_of_imaginary

/-- The closed form for the quaternion exponential on imaginary quaternions. -/
theorem exp_of_re_eq_zero (q : Quaternion ℝ) (hq : q.re = 0) :
    exp ℝ q = ↑(Real.cos ‖q‖) + (Real.sin ‖q‖ / ‖q‖) • q :=
  by
  rw [exp_eq_tsum]
  refine' HasSum.tsum_eq _
  simp_rw [← expSeries_apply_eq]
  exact has_sum_exp_series_of_imaginary hq (Real.hasSum_cos _) (Real.hasSum_sin _)
#align quaternion.exp_of_re_eq_zero Quaternion.exp_of_re_eq_zero

/-- The closed form for the quaternion exponential on arbitrary quaternions. -/
theorem exp_eq (q : Quaternion ℝ) :
    exp ℝ q = exp ℝ q.re • (↑(Real.cos ‖q.im‖) + (Real.sin ‖q.im‖ / ‖q.im‖) • q.im) :=
  by
  rw [← exp_of_re_eq_zero q.im q.im_re, ← coe_mul_eq_smul, ← exp_coe, ← exp_add_of_commute,
    re_add_im]
  exact Algebra.commutes q.re (_ : ℍ[ℝ])
#align quaternion.exp_eq Quaternion.exp_eq

theorem re_exp (q : ℍ[ℝ]) : (exp ℝ q).re = exp ℝ q.re * Real.cos ‖q - q.re‖ := by simp [exp_eq]
#align quaternion.re_exp Quaternion.re_exp

theorem im_exp (q : ℍ[ℝ]) : (exp ℝ q).im = (exp ℝ q.re * (Real.sin ‖q.im‖ / ‖q.im‖)) • q.im := by
  simp [exp_eq, smul_smul]
#align quaternion.im_exp Quaternion.im_exp

theorem normSq_exp (q : ℍ[ℝ]) : normSq (exp ℝ q) = exp ℝ q.re ^ 2 :=
  calc
    normSq (exp ℝ q) =
        normSq (exp ℝ q.re • (↑(Real.cos ‖q.im‖) + (Real.sin ‖q.im‖ / ‖q.im‖) • q.im)) :=
      by rw [exp_eq]
    _ = exp ℝ q.re ^ 2 * normSq (↑(Real.cos ‖q.im‖) + (Real.sin ‖q.im‖ / ‖q.im‖) • q.im) := by
      rw [norm_sq_smul]
    _ = exp ℝ q.re ^ 2 * (Real.cos ‖q.im‖ ^ 2 + Real.sin ‖q.im‖ ^ 2) :=
      by
      congr 1
      obtain hv | hv := eq_or_ne ‖q.im‖ 0
      · simp [hv]
      rw [norm_sq_add, norm_sq_smul, conj_smul, coe_mul_eq_smul, smul_re, smul_re, conj_re, im_re,
        smul_zero, smul_zero, MulZeroClass.mul_zero, add_zero, div_pow, norm_sq_coe,
        norm_sq_eq_norm_sq, ← sq, div_mul_cancel _ (pow_ne_zero _ hv)]
    _ = exp ℝ q.re ^ 2 := by rw [Real.cos_sq_add_sin_sq, mul_one]

#align quaternion.norm_sq_exp Quaternion.normSq_exp

/-- Note that this implies that exponentials of pure imaginary quaternions are unit quaternions
since in that case the RHS is `1` via `exp_zero` and `norm_one`. -/
@[simp]
theorem norm_exp (q : ℍ[ℝ]) : ‖exp ℝ q‖ = ‖exp ℝ q.re‖ := by
  rw [norm_eq_sqrt_real_inner (exp ℝ q), inner_self, norm_sq_exp, Real.sqrt_sq_eq_abs,
    Real.norm_eq_abs]
#align quaternion.norm_exp Quaternion.norm_exp

end Quaternion


import tactic
/--------------------------------------------------------------------------

``refine``

  If ``P`` is the target of the current goal
  and ``hp`` is a term of type ``P``,
  then ``refine hp,`` will close the goal.

``rintro``

  If the target of the current goal is a function ``P → Q``, then
  ``rintro hp,`` will produce a hypothesis
  ``hp : P`` and change the target to  ``Q``.

Delete the ``sorry,`` below and replace them with a legitimate proof.

--------------------------------------------------------------------------/

theorem tautology (P : Prop) (hp : P) : P :=
begin
  sorry,
end

theorem tautology' (P : Prop) : P → P :=
begin
  sorry,
end

example (P Q : Prop): (P → (Q → P)) :=
begin
  sorry,
end

-- Can you find two different ways of proving the following?
example (P Q : Prop) : ((Q → P) → (Q → P)) :=
begin
  sorry,
end