/-
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 .group .order
universes u v w
hott_theory
set_option old_structure_cmd true

namespace hott

open algebra

variable {A : Type _}

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

namespace algebra
@[hott, class] structure ordered_mul_cancel_comm_monoid (A : Type _) extends comm_monoid A,
 left_cancel_semigroup A, right_cancel_semigroup A, order_pair A :=
(mul_le_mul_left : Πa b, le a b → Πc, le (mul c a) (mul c b))
(le_of_mul_le_mul_left : Πa b c, le (mul a b) (mul a c) → le b c)
(mul_lt_mul_left : Πa b, lt a b → Πc, lt (mul c a) (mul c b))
(lt_of_mul_lt_mul_left : Πa b c, lt (mul a b) (mul a c) → lt b c)

@[hott, class] def ordered_cancel_comm_monoid : Type _ → Type _ := ordered_mul_cancel_comm_monoid

@[hott, reducible, instance] def add_comm_monoid_of_ordered_cancel_comm_monoid
  (A : Type _) [H : ordered_cancel_comm_monoid A] : add_comm_monoid A :=
@ordered_mul_cancel_comm_monoid.to_comm_monoid A H

@[hott, reducible, instance] def add_left_cancel_semigroup_of_ordered_cancel_comm_monoid
  (A : Type _) [H : ordered_cancel_comm_monoid A] : add_left_cancel_semigroup A :=
@ordered_mul_cancel_comm_monoid.to_left_cancel_semigroup A H

@[hott, reducible, instance] def add_right_cancel_semigroup_of_ordered_cancel_comm_monoid
  (A : Type _) [H : ordered_cancel_comm_monoid A] : add_right_cancel_semigroup A :=
@ordered_mul_cancel_comm_monoid.to_right_cancel_semigroup A H

@[hott, reducible, instance] def order_pair_of_ordered_cancel_comm_monoid
  (A : Type _) [H : ordered_cancel_comm_monoid A] : order_pair A :=
@ordered_mul_cancel_comm_monoid.to_order_pair A H

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

@[hott] def add_lt_add_left (H : a < b) (c : A) : c + a < c + b :=
@ordered_mul_cancel_comm_monoid.mul_lt_mul_left A s a b H c

@[hott] def add_lt_add_right (H : a < b) (c : A) : a + c < b + c :=
begin
  rwr [add.comm, add.comm b],
  exact (add_lt_add_left H c)
end

@[hott] def add_le_add_left (H : a ≤ b) (c : A) : c + a ≤ c + b :=
@ordered_mul_cancel_comm_monoid.mul_le_mul_left A s a b H c

@[hott] def add_le_add_right (H : a ≤ b) (c : A) : a + c ≤ b + c :=
by rwr [add.comm a c, add.comm b c]; exact add_le_add_left H c

@[hott] 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)

@[hott] 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,
  rwr add_zero at H1,
  exact H1
end

@[hott] 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,
  rwr zero_add at H1,
  exact H1
end

@[hott] 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)

@[hott] 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)

@[hott] 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)

@[hott] theorem lt_add_of_pos_right (H : b > 0) : a < a + b :=
by have := add_lt_add_left H a; rwra [add_zero a] at this

@[hott] theorem lt_add_of_pos_left (H : b > 0) : a < b + a :=
by have := add_lt_add_right H a; rwra [zero_add a] at this

-- here we start using le_of_add_le_add_left.
@[hott] def le_of_add_le_add_left (H : a + b ≤ a + c) : b ≤ c :=
@ordered_mul_cancel_comm_monoid.le_of_mul_le_mul_left A s a b c H

@[hott] def 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 rwr [add.comm, add.comm b], exact H end)

@[hott] def lt_of_add_lt_add_left (H : a + b < a + c) : b < c :=
@ordered_mul_cancel_comm_monoid.lt_of_mul_lt_mul_left A s a b c H

@[hott] def lt_of_add_lt_add_right (H : a + b < c + b) : a < c :=
by apply lt_of_add_lt_add_left; rwra [add.comm b a, add.comm b c]

@[hott] def 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 _)

@[hott] def 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 _)

@[hott] def 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 _)

@[hott] def 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.
@[hott] theorem add_nonneg (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a + b :=
by rwr [←zero_add (0 : A)]; exact add_le_add Ha Hb

@[hott] theorem add_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a + b :=
by rwr [←zero_add (0 : A)]; exact add_lt_add Ha Hb

@[hott] theorem add_pos_of_pos_of_nonneg (Ha : 0 < a) (Hb : 0 ≤ b) : 0 < a + b :=
by rwr [←zero_add (0 : A)]; exact add_lt_add_of_lt_of_le Ha Hb

@[hott] theorem add_pos_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 < a + b :=
by rwr [←zero_add (0 : A)]; exact add_lt_add_of_le_of_lt Ha Hb

@[hott] theorem add_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : a + b ≤ 0 :=
by rwr [←zero_add (0 : A)]; exact add_le_add Ha Hb

@[hott] theorem add_neg (Ha : a < 0) (Hb : b < 0) : a + b < 0 :=
by rwr [←zero_add (0 : A)]; exact add_lt_add Ha Hb

@[hott] theorem add_neg_of_neg_of_nonpos (Ha : a < 0) (Hb : b ≤ 0) : a + b < 0 :=
by rwr [←zero_add (0 : A)]; exact add_lt_add_of_lt_of_le Ha Hb

@[hott] theorem add_neg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : a + b < 0 :=
by rwr [←zero_add (0 : A)]; exact add_lt_add_of_le_of_lt Ha Hb

@[hott] theorem add_eq_zero_iff_eq_zero_prod_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 rwr add_zero
          ... ≤ a + b : add_le_add_left Hb a
          ... = 0     : Hab,
    have Haz : a = 0, from le.antisymm Ha' Ha,
    have Hb' : b ≤ 0, from
      calc
        b     = 0 + b : by rwr zero_add
          ... ≤ a + b : add_le_add_right Ha b
          ... = 0     : Hab,
    have Hbz : b = 0, from le.antisymm Hb' Hb,
    pair Haz Hbz)
  (assume Hab : a = 0 × b = 0,
   by rwr [Hab.fst, Hab.snd, add_zero])

@[hott] theorem le_add_of_nonneg_of_le (Ha : 0 ≤ a) (Hbc : b ≤ c) : b ≤ a + c :=
by rwr [←zero_add b]; exact add_le_add Ha Hbc

@[hott] theorem le_add_of_le_of_nonneg (Hbc : b ≤ c) (Ha : 0 ≤ a) : b ≤ c + a :=
by rwr [←add_zero b]; exact add_le_add Hbc Ha

@[hott] theorem lt_add_of_pos_of_le (Ha : 0 < a) (Hbc : b ≤ c) : b < a + c :=
by rwr [←zero_add b]; exact add_lt_add_of_lt_of_le Ha Hbc

@[hott] theorem lt_add_of_le_of_pos (Hbc : b ≤ c) (Ha : 0 < a) : b < c + a :=
by rwr [←add_zero b]; exact add_lt_add_of_le_of_lt Hbc Ha

@[hott] theorem add_le_of_nonpos_of_le (Ha : a ≤ 0) (Hbc : b ≤ c) : a + b ≤ c :=
by rwr [←zero_add c]; exact add_le_add Ha Hbc

@[hott] theorem add_le_of_le_of_nonpos (Hbc : b ≤ c) (Ha : a ≤ 0) : b + a ≤ c :=
by rwr [←add_zero c]; exact add_le_add Hbc Ha

@[hott] theorem add_lt_of_neg_of_le (Ha : a < 0) (Hbc : b ≤ c) : a + b < c :=
by rwr [←zero_add c]; exact add_lt_add_of_lt_of_le Ha Hbc

@[hott] theorem add_lt_of_le_of_neg (Hbc : b ≤ c) (Ha : a < 0) : b + a < c :=
by rwr [←add_zero c]; exact add_lt_add_of_le_of_lt Hbc Ha

@[hott] theorem lt_add_of_nonneg_of_lt (Ha : 0 ≤ a) (Hbc : b < c) : b < a + c :=
by rwr [←zero_add b]; exact add_lt_add_of_le_of_lt Ha Hbc

@[hott] theorem lt_add_of_lt_of_nonneg (Hbc : b < c) (Ha : 0 ≤ a) : b < c + a :=
by rwr [←add_zero b]; exact add_lt_add_of_lt_of_le Hbc Ha

@[hott] theorem lt_add_of_pos_of_lt (Ha : 0 < a) (Hbc : b < c) : b < a + c :=
by rwr [←zero_add b]; exact add_lt_add Ha Hbc

@[hott] theorem lt_add_of_lt_of_pos (Hbc : b < c) (Ha : 0 < a) : b < c + a :=
by rwr [←add_zero b]; exact add_lt_add Hbc Ha

@[hott] theorem add_lt_of_nonpos_of_lt (Ha : a ≤ 0) (Hbc : b < c) : a + b < c :=
by rwr [←zero_add c]; exact add_lt_add_of_le_of_lt Ha Hbc

@[hott] theorem add_lt_of_lt_of_nonpos (Hbc : b < c) (Ha : a ≤ 0)  : b + a < c :=
by rwr [←add_zero c]; exact add_lt_add_of_lt_of_le Hbc Ha

@[hott] theorem add_lt_of_neg_of_lt (Ha : a < 0) (Hbc : b < c) : a + b < c :=
by rwr [←zero_add c]; exact add_lt_add Ha Hbc

@[hott] theorem add_lt_of_lt_of_neg (Hbc : b < c) (Ha : a < 0) : b + a < c :=
by rwr [←add_zero c]; exact add_lt_add Hbc Ha
end

/- partially ordered groups -/

@[hott, class] structure ordered_mul_ab_group (A : Type _) extends ab_group A, order_pair A :=
(mul_le_mul_left : Πa b, le a b → Πc, le (mul c a) (mul c b))
(mul_lt_mul_left : Πa b, lt a b → Π c, lt (mul c a) (mul c b))

@[hott, class] def ordered_ab_group : Type _ → Type _ := ordered_mul_ab_group

@[hott, reducible, instance] def add_ab_group_of_ordered_ab_group (A : Type _)
  [H : ordered_ab_group A] : add_ab_group A :=
@ordered_mul_ab_group.to_ab_group A H

@[hott] def ordered_mul_ab_group.le_of_mul_le_mul_left [s : ordered_mul_ab_group A] {a b c : A}
  (H : a * b ≤ a * c) : b ≤ c :=
have H' : a⁻¹ * (a * b) ≤ a⁻¹ * (a * c), from ordered_mul_ab_group.mul_le_mul_left _ _ H _,
by rwr [inv_mul_cancel_left, inv_mul_cancel_left] at H'; exact H'

@[hott] def ordered_mul_ab_group.lt_of_mul_lt_mul_left [s : ordered_mul_ab_group A] {a b c : A}
  (H : a * b < a * c) : b < c :=
have H' : a⁻¹ * (a * b) < a⁻¹ * (a * c), from ordered_mul_ab_group.mul_lt_mul_left _ _ H _,
by rwr [inv_mul_cancel_left, inv_mul_cancel_left] at H'; exact H'

@[hott, reducible, instance] def ordered_mul_ab_group.to_ordered_mul_cancel_comm_monoid
    [s : ordered_mul_ab_group A] : ordered_mul_cancel_comm_monoid A :=
{ mul_left_cancel       := @mul.left_cancel A _,
  mul_right_cancel      := @mul.right_cancel A _,
  le_of_mul_le_mul_left := @ordered_mul_ab_group.le_of_mul_le_mul_left A _,
  lt_of_mul_lt_mul_left := @ordered_mul_ab_group.lt_of_mul_lt_mul_left A _, ..s}

@[hott, reducible, instance] def ordered_ab_group.to_ordered_cancel_comm_monoid
    [s : ordered_ab_group A] : ordered_cancel_comm_monoid A :=
@ordered_mul_ab_group.to_ordered_mul_cancel_comm_monoid A s

section
variables [s : ordered_ab_group A] (a b c d e : A)
include s

@[hott] theorem neg_le_neg {a b : A} (H : a ≤ b) : -b ≤ -a :=
have H1 : 0 ≤ -a + b, by rwr [←add.left_inv a]; apply add_le_add_left H,
by rwr [←zero_add (-b), ←add_neg_cancel_right (-a) b]; exact add_le_add_right H1 (-b)

@[hott] theorem le_of_neg_le_neg {a b : A} (H : -b ≤ -a) : a ≤ b :=
by rwr [←neg_neg a, ←neg_neg b]; exact neg_le_neg H

@[hott] theorem neg_le_neg_iff_le : -a ≤ -b ↔ b ≤ a :=
iff.intro le_of_neg_le_neg neg_le_neg

@[hott] theorem nonneg_of_neg_nonpos {a : A} (H : -a ≤ 0) : 0 ≤ a :=
by apply le_of_neg_le_neg; rwra neg_zero

@[hott] theorem neg_nonpos_of_nonneg {a : A} (H : 0 ≤ a) : -a ≤ 0 :=
by rwr [←neg_zero]; exact neg_le_neg H

@[hott] theorem neg_nonpos_iff_nonneg : -a ≤ 0 ↔ 0 ≤ a :=
iff.intro nonneg_of_neg_nonpos neg_nonpos_of_nonneg

@[hott] theorem nonpos_of_neg_nonneg {a : A} (H : 0 ≤ -a) : a ≤ 0 :=
by apply le_of_neg_le_neg; rwra neg_zero

@[hott] theorem neg_nonneg_of_nonpos {a : A} (H : a ≤ 0) : 0 ≤ -a :=
by rwr [←neg_zero]; exact neg_le_neg H

@[hott] theorem neg_nonneg_iff_nonpos : 0 ≤ -a ↔ a ≤ 0 :=
iff.intro nonpos_of_neg_nonneg neg_nonneg_of_nonpos

@[hott] def neg_lt_neg {a b : A} (H : a < b) : -b < -a :=
have H1 : 0 < -a + b, by rwr [←add.left_inv a]; apply add_lt_add_left H,
by rwr [←zero_add (-b), ←add_neg_cancel_right (-a) b]; exact add_lt_add_right H1 (-b)

@[hott] def lt_of_neg_lt_neg {a b : A} (H : -b < -a) : a < b :=
by rwr [←neg_neg a, ←neg_neg b]; exact neg_lt_neg H

@[hott] theorem neg_lt_neg_iff_lt : -a < -b ↔ b < a :=
iff.intro lt_of_neg_lt_neg neg_lt_neg

@[hott] theorem pos_of_neg_neg {a : A} (H : -a < 0) : 0 < a :=
by apply lt_of_neg_lt_neg; rwra [neg_zero]

@[hott] theorem neg_neg_of_pos {a : A} (H : 0 < a) : -a < 0 :=
by rwr [←neg_zero]; exact neg_lt_neg H

@[hott] theorem neg_neg_iff_pos : -a < 0 ↔ 0 < a :=
iff.intro pos_of_neg_neg neg_neg_of_pos

@[hott] def neg_of_neg_pos {a : A} (H : 0 < -a) : a < 0 :=
by apply lt_of_neg_lt_neg; rwra neg_zero

@[hott] def neg_pos_of_neg {a : A} (H : a < 0) : 0 < -a :=
by rwr [←neg_zero]; exact neg_lt_neg H

@[hott] def neg_pos_iff_neg : 0 < -a ↔ a < 0 :=
iff.intro neg_of_neg_pos neg_pos_of_neg

@[hott] theorem le_neg_iff_le_neg : a ≤ -b ↔ b ≤ -a :=
by refine iff.trans _ (neg_le_neg_iff_le _ _); rwr neg_neg

@[hott] theorem le_neg_of_le_neg {a b : A} : a ≤ -b → b ≤ -a :=
(le_neg_iff_le_neg _ _).mp

@[hott] theorem neg_le_iff_neg_le : -a ≤ b ↔ -b ≤ a :=
by refine iff.trans _ (neg_le_neg_iff_le _ _); rwr neg_neg

@[hott] theorem neg_le_of_neg_le {a b : A} : -a ≤ b → -b ≤ a :=
(neg_le_iff_neg_le _ _).mp

@[hott] theorem lt_neg_iff_lt_neg : a < -b ↔ b < -a :=
by refine iff.trans _ (neg_lt_neg_iff_lt _ _); rwr neg_neg

@[hott] theorem lt_neg_of_lt_neg {a b : A} : a < -b → b < -a :=
(lt_neg_iff_lt_neg _ _).mp

@[hott] theorem neg_lt_iff_neg_lt : -a < b ↔ -b < a :=
by refine iff.trans _ (neg_lt_neg_iff_lt _ _); rwr neg_neg

@[hott] theorem neg_lt_of_neg_lt {a b : A} : -a < b → -b < a :=
(neg_lt_iff_neg_lt _ _).mp

@[hott] def sub_nonneg_iff_le : 0 ≤ a - b ↔ b ≤ a :=
by rwr [←sub_self b]; apply add_le_add_right_iff

@[hott] def sub_nonneg_of_le {a b : A} : b ≤ a → 0 ≤ a - b :=
(sub_nonneg_iff_le _ _).mpr

@[hott] def le_of_sub_nonneg {a b : A} : 0 ≤ a - b → b ≤ a :=
(sub_nonneg_iff_le _ _).mp

@[hott] theorem sub_nonpos_iff_le : a - b ≤ 0 ↔ a ≤ b :=
by rwr [←sub_self b]; apply add_le_add_right_iff

@[hott] theorem sub_nonpos_of_le {a b : A} : a ≤ b → a - b ≤ 0 :=
(sub_nonpos_iff_le _ _).mpr

@[hott] theorem le_of_sub_nonpos {a b : A} : a - b ≤ 0 → a ≤ b :=
(sub_nonpos_iff_le _ _).mp

@[hott] def sub_pos_iff_lt : 0 < a - b ↔ b < a :=
by rwr [←sub_self b]; apply add_lt_add_right_iff

@[hott] def sub_pos_of_lt {a b : A} : b < a → 0 < a - b :=
(sub_pos_iff_lt _ _).mpr

@[hott] def lt_of_sub_pos {a b : A} : 0 < a - b → b < a :=
(sub_pos_iff_lt _ _).mp

@[hott] theorem sub_neg_iff_lt : a - b < 0 ↔ a < b :=
by rwr [←sub_self b]; apply add_lt_add_right_iff

@[hott] theorem sub_neg_of_lt {a b : A} : a < b → a - b < 0 :=
(sub_neg_iff_lt _ _).mpr

@[hott] theorem lt_of_sub_neg {a b : A} : a - b < 0 → a < b :=
(sub_neg_iff_lt _ _).mp

@[hott] 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 _ _ _),
by rwra neg_add_cancel_left at H

@[hott] theorem add_le_of_le_neg_add {a b c : A} : b ≤ -a + c → a + b ≤ c :=
(add_le_iff_le_neg_add _ _ _).mpr

@[hott] theorem le_neg_add_of_add_le {a b c : A} : a + b ≤ c → b ≤ -a + c :=
(add_le_iff_le_neg_add _ _ _).mp

@[hott] theorem add_le_iff_le_sub_left : a + b ≤ c ↔ b ≤ c - a :=
by rwr [sub_eq_add_neg, add.comm c]; apply add_le_iff_le_neg_add

@[hott] 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 _ _ _)

@[hott] 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 _ _ _)

@[hott] 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 _ _ _),
by rwra add_sub_cancel at H

@[hott] theorem add_le_of_le_sub_right {a b c : A} : a ≤ c - b → a + b ≤ c :=
(add_le_iff_le_sub_right  _ _ _).mpr

@[hott] theorem le_sub_right_of_add_le {a b c : A} : a + b ≤ c → a ≤ c - b :=
(add_le_iff_le_sub_right _ _ _).mp

@[hott] 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 rwr neg_add_cancel_left at H; exact H

@[hott] theorem le_add_of_neg_add_le {a b c : A} : -b + a ≤ c → a ≤ b + c :=
(le_add_iff_neg_add_le _ _ _).mpr

@[hott] theorem neg_add_le_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c :=
(le_add_iff_neg_add_le _ _ _).mp

@[hott] theorem le_add_iff_sub_left_le : a ≤ b + c ↔ a - b ≤ c :=
by rwr [sub_eq_add_neg, add.comm a]; apply le_add_iff_neg_add_le

@[hott] theorem le_add_of_sub_left_le {a b c : A} : a - b ≤ c → a ≤ b + c :=
(le_add_iff_sub_left_le _ _ _).mpr

@[hott] theorem sub_left_le_of_le_add {a b c : A} : a ≤ b + c → a - b ≤ c :=
(le_add_iff_sub_left_le _ _ _).mp

@[hott] 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 rwr [sub_eq_add_neg (b+c) c, add_neg_cancel_right] at H; exact H

@[hott] theorem le_add_of_sub_right_le {a b c : A} : a - c ≤ b → a ≤ b + c :=
(le_add_iff_sub_right_le _ _ _).mpr

@[hott] theorem sub_right_le_of_le_add {a b c : A} : a ≤ b + c → a - c ≤ b :=
(le_add_iff_sub_right_le _ _ _).mp

@[hott] 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 rwr neg_add_cancel_left at H; exact H

@[hott] theorem le_add_of_neg_add_le_left {a b c : A} : -b + a ≤ c → a ≤ b + c :=
(le_add_iff_neg_add_le_left _ _ _).mpr

@[hott] theorem neg_add_le_left_of_le_add {a b c : A} : a ≤ b + c → -b + a ≤ c :=
(le_add_iff_neg_add_le_left _ _ _).mp

@[hott] theorem le_add_iff_neg_add_le_right : a ≤ b + c ↔ -c + a ≤ b :=
by rwr add.comm; apply le_add_iff_neg_add_le_left

@[hott] theorem le_add_of_neg_add_le_right {a b c : A} : -c + a ≤ b → a ≤ b + c :=
(le_add_iff_neg_add_le_right _ _ _).mpr

@[hott] theorem neg_add_le_right_of_le_add {a b c : A} : a ≤ b + c → -c + a ≤ b :=
(le_add_iff_neg_add_le_right _ _ _).mp

@[hott] 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'

@[hott] theorem le_add_of_neg_le_sub_left {a b c : A} : -a ≤ b - c → c ≤ a + b :=
(le_add_iff_neg_le_sub_left _ _ _).mpr

@[hott] theorem neg_le_sub_left_of_le_add {a b c : A} : c ≤ a + b → -a ≤ b - c :=
(le_add_iff_neg_le_sub_left _ _ _).mp

@[hott] theorem le_add_iff_neg_le_sub_right : c ≤ a + b ↔ -b ≤ a - c :=
by rwr add.comm; apply le_add_iff_neg_le_sub_left

@[hott] theorem le_add_of_neg_le_sub_right {a b c : A} : -b ≤ a - c → c ≤ a + b :=
(le_add_iff_neg_le_sub_right _ _ _).mpr

@[hott] theorem neg_le_sub_right_of_le_add {a b c : A} : c ≤ a + b → -b ≤ a - c :=
(le_add_iff_neg_le_sub_right _ _ _).mp

@[hott] 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 rwr neg_add_cancel_left at H, exact H end

@[hott] theorem add_lt_of_lt_neg_add_left {a b c : A} : b < -a + c → a + b < c :=
(add_lt_iff_lt_neg_add_left _ _ _).mpr

@[hott] theorem lt_neg_add_left_of_add_lt {a b c : A} : a + b < c → b < -a + c :=
(add_lt_iff_lt_neg_add_left _ _ _).mp

@[hott] theorem add_lt_iff_lt_neg_add_right : a + b < c ↔ a < -b + c :=
by refine iff.trans _ (add_lt_iff_lt_neg_add_left _ _ _); rwr add.comm

@[hott] theorem add_lt_of_lt_neg_add_right {a b c : A} : a < -b + c → a + b < c :=
(add_lt_iff_lt_neg_add_right _ _ _).mpr

@[hott] theorem lt_neg_add_right_of_add_lt {a b c : A} : a + b < c → a < -b + c :=
(add_lt_iff_lt_neg_add_right _ _ _).mp

@[hott] theorem add_lt_iff_lt_sub_left : a + b < c ↔ b < c - a :=
begin
  rwr [sub_eq_add_neg, add.comm c],
  apply add_lt_iff_lt_neg_add_left
end

@[hott] theorem add_lt_of_lt_sub_left {a b c : A} : b < c - a → a + b < c :=
(add_lt_iff_lt_sub_left _ _ _).mpr

@[hott] theorem lt_sub_left_of_add_lt {a b c : A} : a + b < c → b < c - a :=
(add_lt_iff_lt_sub_left _ _ _).mp

@[hott] 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 rwr [sub_eq_add_neg, add_neg_cancel_right] at H; exact H

@[hott] theorem add_lt_of_lt_sub_right {a b c : A} : a < c - b → a + b < c :=
(add_lt_iff_lt_sub_right _ _ _).mpr

@[hott] theorem lt_sub_right_of_add_lt {a b c : A} : a + b < c → a < c - b :=
(add_lt_iff_lt_sub_right _ _ _).mp

@[hott] 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 rwr neg_add_cancel_left at H; exact H

@[hott] theorem lt_add_of_neg_add_lt_left {a b c : A} : -b + a < c → a < b + c :=
(lt_add_iff_neg_add_lt_left _ _ _).mpr

@[hott] theorem neg_add_lt_left_of_lt_add {a b c : A} : a < b + c → -b + a < c :=
(lt_add_iff_neg_add_lt_left _ _ _).mp

@[hott] theorem lt_add_iff_neg_add_lt_right : a < b + c ↔ -c + a < b :=
by rwr add.comm; apply lt_add_iff_neg_add_lt_left

@[hott] theorem lt_add_of_neg_add_lt_right {a b c : A} : -c + a < b → a < b + c :=
(lt_add_iff_neg_add_lt_right _ _ _).mpr

@[hott] theorem neg_add_lt_right_of_lt_add {a b c : A} : a < b + c → -c + a < b :=
(lt_add_iff_neg_add_lt_right _ _ _).mp

@[hott] theorem lt_add_iff_sub_lt_left : a < b + c ↔ a - b < c :=
by rwr [sub_eq_add_neg, add.comm a]; apply lt_add_iff_neg_add_lt_left

@[hott] theorem lt_add_of_sub_lt_left {a b c : A} : a - b < c → a < b + c :=
(lt_add_iff_sub_lt_left _ _ _).mpr

@[hott] theorem sub_lt_left_of_lt_add {a b c : A} : a < b + c → a - b < c :=
(lt_add_iff_sub_lt_left _ _ _).mp

@[hott] theorem lt_add_iff_sub_lt_right : a < b + c ↔ a - c < b :=
by refine iff.trans _ (lt_add_iff_sub_lt_left _ _ _); rwr add.comm

@[hott] theorem lt_add_of_sub_lt_right {a b c : A} : a - c < b → a < b + c :=
(lt_add_iff_sub_lt_right _ _ _).mpr

@[hott] theorem sub_lt_right_of_lt_add {a b c : A} : a < b + c → a - c < b :=
(lt_add_iff_sub_lt_right _ _ _).mp

@[hott] 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

@[hott] 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
@[hott] 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 rwr H
    ... ↔ c ≤ d       : sub_nonpos_iff_le c d

@[hott] 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 rwr H
    ... ↔ c < d       : sub_neg_iff_lt c d

@[hott] 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

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

@[hott] 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)

@[hott] 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

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

@[hott] 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)

@[hott] 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)

@[hott] 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)

@[hott] 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
    ... = a      : by rwr add_zero

@[hott] 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
    ... = a      : by rwr add_zero

@[hott] 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

@[hott] 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)

@[hott] 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)

@[hott] theorem neg_add_neg_le_neg_of_pos {a : A} (H : a > 0) : -a + -a ≤ -a :=
by rwr [←neg_add]; exact neg_le_neg (le_add_of_nonneg_left (le_of_lt H))
end

/- linear ordered group with decidable order -/

@[hott, class] structure decidable_linear_ordered_mul_ab_group (A : Type _)
    extends ab_group A, decidable_linear_order A :=
    (mul_le_mul_left : Π a b, le a b → Π c, le (mul c a) (mul c b))
    (mul_lt_mul_left : Π a b, lt a b → Π c, lt (mul c a) (mul c b))

@[hott, class] def decidable_linear_ordered_ab_group : Type _ → Type _ :=
decidable_linear_ordered_mul_ab_group

@[hott, reducible, instance] def add_ab_group_of_decidable_linear_ordered_ab_group
  (A : Type _) [H : decidable_linear_ordered_ab_group A] : add_ab_group A :=
@decidable_linear_ordered_mul_ab_group.to_ab_group A H

@[hott, reducible, instance] def decidable_linear_order_of_decidable_linear_ordered_ab_group
  (A : Type _) [H : decidable_linear_ordered_ab_group A] :
  decidable_linear_order A :=
@decidable_linear_ordered_mul_ab_group.to_decidable_linear_order A H

@[hott, reducible, instance]
def decidable_linear_ordered_mul_ab_group.to_ordered_mul_ab_group
  (A : Type _) [s : decidable_linear_ordered_mul_ab_group A] : ordered_mul_ab_group A :=
{ 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 _, ..s }

@[hott, reducible, instance] def decidable_linear_ordered_ab_group.to_ordered_ab_group
   (A : Type _) [s : decidable_linear_ordered_ab_group A] : ordered_ab_group A :=
@decidable_linear_ordered_mul_ab_group.to_ordered_mul_ab_group A s

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

/- these can be generalized to a lattice ordered group -/

@[hott] theorem min_add_add_left : min (a + b) (a + c) = a + min b c :=
inverse (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 _ _) _)
  (λ d,
    assume H₁ : d ≤ a + b,
    assume H₂ : d ≤ a + c,
    have H : d - a ≤ min b c,
      from le_min (sub_left_le_of_le_add H₁) (sub_left_le_of_le_add H₂),
    show d ≤ a + min b c, from le_add_of_sub_left_le H))

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

@[hott] theorem max_add_add_left : max (a + b) (a + c) = a + max b c :=
inverse (eq_max
  (add_le_add_left (le_max_left _ _) _)
  (add_le_add_left (le_max_right _ _) _)
  (λ d H₁ H₂,
    have H : max b c ≤ d - a,
      from max_le (le_sub_left_of_add_le H₁) (le_sub_left_of_add_le H₂),
    show a + max b c ≤ d, from add_le_of_le_sub_left H))

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

@[hott] theorem max_neg_neg : max (-a) (-b) = - min a b  :=
inverse (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 _ _))
  (λ d,
    assume H₁ : -a ≤ d,
    assume H₂ : -b ≤ d,
    have H : -d ≤ min a b,
      from le_min (neg_le_of_neg_le H₁) (neg_le_of_neg_le H₂),
    show -(min a b) ≤ d, from neg_le_of_neg_le H))

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

@[hott] theorem min_neg_neg : min (-a) (-b) = - max a b :=
by rwr [min_eq_neg_max_neg_neg, neg_neg, neg_neg]

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

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

@[hott] def abs (a : A) : A := max a (-a)

@[hott] 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'

@[hott] theorem abs_of_pos (H : a > 0) : abs a = a :=
abs_of_nonneg (le_of_lt H)

@[hott] 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'

@[hott] theorem abs_of_neg (H : a < 0) : abs a = -a := abs_of_nonpos (le_of_lt H)

@[hott] theorem abs_zero : abs 0 = (0:A) := abs_of_nonneg (le.refl _)

@[hott] theorem abs_neg (a : A) : abs (-a) = abs a :=
by delta hott.algebra.abs; rwr [max.comm, neg_neg]

@[hott] theorem abs_pos_of_pos (H : a > 0) : abs a > 0 :=
by rwr (abs_of_pos H); exact H

@[hott] theorem abs_pos_of_neg (H : a < 0) : abs a > 0 :=
by have := abs_pos_of_pos (neg_pos_of_neg H); rwra abs_neg at this

@[hott] theorem abs_sub (a b : A) : abs (a - b) = abs (b - a) :=
by rwr [←neg_sub, abs_neg]

@[hott] theorem ne_zero_of_abs_ne_zero {a : A} (H : abs a ≠ 0) : a ≠ 0 :=
begin intro Ha, apply H, rwr Ha, exact abs_zero end

/- these assume a linear order -/

@[hott] theorem eq_zero_of_neg_eq (H : -a = a) : a = 0 :=
lt.by_cases
  (assume H1 : a < 0,
    have H2: a > 0, by rwr ←H; exact neg_pos_of_neg H1,
    absurd H1 (lt.asymm H2))
  (assume H1 : a = 0, H1)
  (assume H1 : a > 0,
    have H2: a < 0, by rwr ←H; exact neg_neg_of_pos H1,
    absurd H1 (lt.asymm H2))

@[hott] theorem abs_nonneg (a : A) : abs a ≥ 0 :=
sum.elim (le.total 0 a)
  (assume H : 0 ≤ a, by rwr (abs_of_nonneg H); exact H)
  (assume H : a ≤ 0,
    calc
        0 ≤ -a    : neg_nonneg_of_nonpos H
      ... = abs a : (abs_of_nonpos H)⁻¹)

@[hott] theorem abs_abs (a : A) : abs (abs a) = abs a := abs_of_nonneg (abs_nonneg _)

@[hott] theorem le_abs_self (a : A) : a ≤ abs a :=
sum.elim (le.total 0 a)
  (assume H : 0 ≤ a, le_of_eq (abs_of_nonneg H)⁻¹)
  (assume H : a ≤ 0, le.trans H (abs_nonneg _))

@[hott] theorem neg_le_abs_self (a : A) : -a ≤ abs a :=
by refine le.trans (le_abs_self _) _; rwr [abs_neg]

@[hott] 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)

@[hott] theorem abs_eq_zero_iff_eq_zero (a : A) : abs a = 0 ↔ a = 0 :=
iff.intro eq_zero_of_abs_eq_zero (assume H, ap abs H ⬝ abs_zero)

@[hott] 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

@[hott] theorem abs_pos_of_ne_zero (H : a ≠ 0) : abs a > 0 :=
sum.elim (lt_sum_gt_of_ne H) abs_pos_of_neg abs_pos_of_pos

@[hott] theorem abs.by_cases {P : A → Type _} {a : A} (H1 : P a) (H2 : P (-a)) : P (abs a) :=
sum.elim (le.total 0 a)
  (assume H : 0 ≤ a, (abs_of_nonneg H)⁻¹ ▸ H1)
  (assume H : a ≤ 0, (abs_of_nonpos H)⁻¹ ▸ H2)

-- @[hott] theorem abs_le_of_le_of_neg_le (H1 : a ≤ b) (H2 : -a ≤ b) : abs a ≤ b :=
-- abs.by_cases H1 H2

-- @[hott] 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
-- @[hott] 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 rwr (abs_of_nonneg H1)
--               ... = abs a + b         : by rwr (abs_of_nonneg H2)
--               ... = abs a + abs b     : by rwr (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 rwr (abs_of_nonneg H1)
--             ... = abs a + b     : by rwr (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 rwr (abs_of_nonpos H4))

--   @[hott] private lemma aux2 {a b : A} (H1 : a + b ≥ 0) : abs (a + b) ≤ abs a + abs b :=
--   sum.elim (le.total b 0)
--     (assume H2 : b ≤ 0,
--       have H3 : ¬ a < 0, from
--         assume H4 : a < 0,
--         have H5 : a + b < 0, by rwr [←add_zero 0]; exact 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
--           rwr add.comm at H1,
--           exact aux1 H1 H2
--         end,
--         rwr [add.comm, {abs a + _}add.comm],
--         exact H3
--       end)

--   @[hott] theorem abs_add_le_abs_add_abs (a b : A) : abs (a + b) ≤ abs a + abs b :=
--   sum.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 rwr neg_add,
--       have H4 : -(a + b) ≥ 0, from iff.mpr (neg_nonneg_iff_nonpos (a+b)) H2,
--       have H5   : -a + -b ≥ 0, begin rwr -H3 at H4, exact H4 end,
--       calc
--         abs (a + b) = abs (-a + -b)   : by rwr [←abs_neg, neg_add]
--             ... ≤ abs (-a) + abs (-b) : aux2 H5
--             ... = abs a + abs b       : by rwr *abs_neg)

-- @[hott] 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 rwr sub_add_cancel
--       ... = abs (a - b + b)       : by rwr sub_add_cancel
--       ... ≤ abs (a - b) + abs b   : abs_add_le_abs_add_abs,
-- le_of_add_le_add_right H1

-- @[hott] 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 rwr [*sub_eq_add_neg, add.assoc, neg_add_cancel_left]
--           ... ≤ abs (a - b) + abs (b - c) : abs_add_le_abs_add_abs

-- @[hott] 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

-- @[hott] 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],
--   rwr (abs_of_nonneg (iff.mpr !sub_nonneg_iff_le Hba)),
--   apply sub_le_sub,
--   apply Hau,
--   apply Hbl,
--   rwr [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

end algebra
end hott


import ..myrat.le
import ..myring.order
import ..mynat.max
import ..sequence

namespace hidden

open myring
open ordered_myring
open myfield
open ordered_myfield

def is_cau_seq (f : sequence myrat) : Prop :=
∀ ε : myrat, 0 < ε → ∃ N : mynat, ∀ n m : mynat,
N ≤ n → N ≤ m → abs (f m - f n) < ε

-- Create the type of Cauchy sequences
def cau_seq := {f : sequence myrat // is_cau_seq f}

namespace cau_seq

-- Two cauchy sequences are equivalent if their difference
-- tends to zero
def equivalent (f g : cau_seq) : Prop :=
∀ ε : myrat, 0 < ε → ∃ N : mynat,
∀ n : mynat, N ≤ n → abs (f.val n - g.val n) < ε

private theorem equivalent_refl: reflexive equivalent :=
begin
    intros f ε,
    assume hepos,
    cases f.property ε hepos with N hN,
    existsi N,
    intro n,
    assume hNn,
    from hN n n hNn hNn,
end

private theorem equivalent_symm: symmetric equivalent :=
begin
    intros f g,
    assume hfeqg,
    intro ε,
    assume hepos,
    cases hfeqg ε hepos with N hN,
    existsi N,
    intro n,
    assume hNn,
    have := hN n hNn,
    rwa [←abs_neg, sub_def, neg_distr, neg_neg, add_comm, ←sub_def],
end

private theorem equivalent_trans: transitive equivalent :=
begin
    intros f g h,
    assume hfeqg hgeqh,
    intro ε,
    assume hepos,
    cases hfeqg (ε / 2) (half_pos hepos) with N1 hN1,
    cases hgeqh (ε / 2) (half_pos hepos) with N2 hN2,
    existsi mynat.max N1 N2,
    intro n,
    assume hN1N2n,
    have hN1e := hN1 n (mynat.max_le_cancel_left hN1N2n),
    have hN2e := hN2 n (mynat.max_le_cancel_right hN1N2n),
    have := triangle_ineq (f.val n - g.val n) (g.val n - h.val n),
    conv at this {
      congr,
      rw [sub_def, sub_def, add_assoc],
      congr, congr, skip,
      rw ←add_assoc,
      congr,
      rw [add_comm, ←sub_def, sub_self],
    },
    rw [zero_add, ←sub_def] at this,
    have hcomb := lt_comb hN1e hN2e,
    rw half_plus_half at hcomb,
    apply le_lt_chain (abs (f.val n - g.val n) + abs (g.val n - h.val n)); assumption,
    assume water,
    apply nontrivial_zero_ne_two myrat.nontrivial,
    symmetry, assumption,
end

instance real_setoid: setoid cau_seq :=
⟨equivalent, equivalent_refl, equivalent_symm,
equivalent_trans⟩

theorem setoid_equiv (f g : cau_seq) :
f ≈ g ↔ equivalent f g := iff.rfl

theorem seq_eq_impl_eq (f g : cau_seq) : (∀ n, f.val n = g.val n) → f = g :=
begin
  cases f, cases g,
  dsimp only [],
  intros h,
  congr, -- Good old congr
  apply funext,
  assumption,
end

theorem seq_eq_impl_cau_seq_equiv (f g : cau_seq) : (∀ n, f.val n = g.val n) → f ≈ g :=
begin
  assume h,
  rw setoid_equiv,
  unfold equivalent,
  intros ε hε,
  existsi (0 : mynat),
  intros n hn,
  rwa [h n, sub_self],
end

theorem constant_cauchy (x : myrat) : is_cau_seq (λ n, x) :=
begin
  dsimp only [is_cau_seq],
  rw sub_self,
  intros ε hε,
  existsi (0 : mynat),
  intros m n hm hn,
  rwa abs_zero,
end

instance: has_zero cau_seq := ⟨⟨λ n, 0, constant_cauchy 0⟩⟩

instance: has_one cau_seq := ⟨⟨λ n, 1, constant_cauchy 1⟩⟩

local attribute [instance] classical.prop_decidable

theorem abs_bounded_above (f : cau_seq) :
∃ (u : myrat), 0 < u ∧ ∀ n, abs (f.val n) < u:=
begin
  cases f.property 1 (ordered_myring.nontrivial_zero_lt_one myrat.nontrivial) with N h,
  existsi max (1 + (max_upto N $ λ n, abs (f.val n))) (abs (f.val N) + 1),
  split, {
    apply lt_le_chain (abs (f.val N) + 1),
      rw ←add_zero (0 : myrat),
      apply le_lt_comb,
        exact abs_nonneg _,
      exact (ordered_myring.nontrivial_zero_lt_one myrat.nontrivial),
    apply ordered_myring.le_max_right,
  }, {
    intros n,
    have := h n N,
    by_cases hNn : N ≤ n, {
      have := this hNn (@mynat.le_refl N),
      apply lt_le_chain (abs (f.val N) + 1), {
        rw lt_add_cancel_left _ _ (-abs (f.val N)),
        rw add_comm,
        rw ←add_assoc,
        rw neg_add,
        rw zero_add,
        apply le_lt_chain (abs (f.val N - f.val n)), {
          transitivity abs (abs (f.val n) + -abs (f.val N)),
            apply self_le_abs,
          rw ←sub_def,
          rw abs_sub_switch,
          apply triangle_ineq_sub,
        }, {
          assumption,
        },
      }, {
        apply ordered_myring.le_max_right,
      },
    }, {
      change n < N at hNn,
      have hNn₂ := mynat.lt_impl_le hNn,
      apply lt_le_chain (1 + max_upto N (λ (n : mynat), abs (f.val n))), {
        rw ←zero_add (abs (f.val n)),
        apply lt_le_comb, {
          exact (ordered_myring.nontrivial_zero_lt_one myrat.nontrivial),
        }, {
          -- `change` comes into its own
          change ((λ (n : mynat), abs (f.val n)) n) ≤ _,
          apply max_upto_ge_before,
          assumption,
        },
      }, {
        apply ordered_myring.le_max_left,
      },
    },
  },
end

-- Why was this so hard ffs
theorem nzero_impl_abs_eventually_bounded_below (f : cau_seq) (hnf0 : ¬f ≈ 0) :
∃ (δ : myrat) (N : mynat), 0 < δ ∧ ∀ n : mynat, N ≤ n → δ < abs (f.val n) :=
begin
  change ¬(f.equivalent 0) at hnf0,
  unfold cau_seq.equivalent at hnf0,
  rw not_forall at hnf0,
  cases hnf0 with ε hnf0,
  rw not_imp at hnf0,
  cases hnf0 with hε hnf0,
  rw not_exists at hnf0,
  have hfcau := f.property (ε / 2) (half_pos hε),
  cases hfcau with N hfcau,
  existsi (ε / 2),
  existsi N,
  split,
    exact half_pos hε,
  intros n hn,
  have hfN := hnf0 N,
  rw not_forall at hfN,
  cases hfN with m hm,
  rw not_imp at hm,
  cases hm with hNm hm,
  change ¬abs (f.val m - 0) < ε at hm,
  rw [sub_def, neg_zero, myring.add_zero] at hm,
  have := hfcau _ _ hn hNm,
  change ¬¬ε ≤ abs (f.val m) at hm,
  rw not_not at hm,
  clear hnf0 hn hNm hfcau,
  -- This is why P ≠ NP
  rw ←abs_abs,
  rw ←myring.add_zero (abs (f.val n)),
  rw ←myring.neg_add (abs (f.val m)),
  rw ←myring.add_assoc,
  rw ←neg_neg (abs (f.val n)),
  rw add_comm _ (-abs _),
  rw ←abs_neg,
  rw neg_distr,
  rw neg_distr,
  rw neg_neg,
  rw neg_neg,
  rw ←sub_def,
  rw ←sub_def,
  apply lt_le_chain (abs (abs (abs (f.val m) - abs (f.val n)) - abs (abs (f.val m)))), {
    rw abs_abs,
    rw abs_sub_switch,
    apply lt_le_chain (abs (f.val m) - abs (abs (f.val m) - abs (f.val n))), {
      rw sub_def,
      rw ←minus_half myrat.two_nzero,
      rw sub_def,
      apply le_lt_comb, assumption, {
        rw ←lt_neg_switch_iff,
        apply le_lt_chain (abs (f.val m - f.val n)),
          exact triangle_ineq_sub _ _,
        assumption,
      },
    },
    exact self_le_abs _,
  },
  exact triangle_ineq_sub _ _,
end

end cau_seq

end hidden


/-
Copyright (c) 2020 Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jalex Stark, Scott Morrison, Eric Wieser, Oliver Nash
-/
import data.matrix.basic
import linear_algebra.matrix.trace

/-!
# Matrices with a single non-zero element.

This file provides `matrix.std_basis_matrix`. The matrix `matrix.std_basis_matrix i j c` has `c`
at position `(i, j)`, and zeroes elsewhere.
-/

variables {l m n : Type*}
variables {R α : Type*}

namespace matrix
open_locale matrix
open_locale big_operators

variables [decidable_eq l] [decidable_eq m] [decidable_eq n]

variables [semiring α]

/--
`std_basis_matrix i j a` is the matrix with `a` in the `i`-th row, `j`-th column,
and zeroes elsewhere.
-/
def std_basis_matrix (i : m) (j : n) (a : α) : matrix m n α :=
(λ i' j', if i = i' ∧ j = j' then a else 0)

@[simp] lemma smul_std_basis_matrix (i : m) (j : n) (a b : α) :
b • std_basis_matrix i j a = std_basis_matrix i j (b • a) :=
by { unfold std_basis_matrix, ext, simp }

@[simp] lemma std_basis_matrix_zero (i : m) (j : n) :
std_basis_matrix i j (0 : α) = 0 :=
by { unfold std_basis_matrix, ext, simp }

lemma std_basis_matrix_add (i : m) (j : n) (a b : α) :
std_basis_matrix i j (a + b) = std_basis_matrix i j a + std_basis_matrix i j b :=
begin
  unfold std_basis_matrix, ext,
  split_ifs with h; simp [h],
end

lemma matrix_eq_sum_std_basis [fintype m] [fintype n] (x : matrix m n α) :
  x = ∑ (i : m) (j : n), std_basis_matrix i j (x i j) :=
begin
  ext, symmetry,
  iterate 2 { rw finset.sum_apply },
  convert fintype.sum_eq_single i _,
  { simp [std_basis_matrix] },
  { intros j hj,
    simp [std_basis_matrix, hj], }
end

-- TODO: tie this up with the `basis` machinery of linear algebra
-- this is not completely trivial because we are indexing by two types, instead of one

-- TODO: add `std_basis_vec`
lemma std_basis_eq_basis_mul_basis (i : m) (j : n) :
  std_basis_matrix i j 1 = vec_mul_vec (λ i', ite (i = i') 1 0) (λ j', ite (j = j') 1 0) :=
begin
  ext,
  norm_num [std_basis_matrix, vec_mul_vec],
  exact ite_and _ _ _ _,
end

-- todo: the old proof used fintypes, I don't know `finsupp` but this feels generalizable
@[elab_as_eliminator] protected lemma induction_on' [fintype m] [fintype n]
  {P : matrix m n α → Prop} (M : matrix m n α)
  (h_zero : P 0)
  (h_add : ∀ p q, P p → P q → P (p + q))
  (h_std_basis : ∀ (i : m) (j : n) (x : α), P (std_basis_matrix i j x)) :
  P M :=
begin
  rw [matrix_eq_sum_std_basis M, ← finset.sum_product'],
  apply finset.sum_induction _ _ h_add h_zero,
  { intros, apply h_std_basis, }
end

@[elab_as_eliminator] protected lemma induction_on [fintype m] [fintype n]
  [nonempty m] [nonempty n] {P : matrix m n α → Prop} (M : matrix m n α)
  (h_add : ∀ p q, P p → P q → P (p + q))
  (h_std_basis : ∀ i j x, P (std_basis_matrix i j x)) :
  P M :=
matrix.induction_on' M
begin
  inhabit m,
  inhabit n,
  simpa using h_std_basis default default 0
end
h_add h_std_basis

namespace std_basis_matrix

section

variables (i : m) (j : n) (c : α) (i' : m) (j' : n)

@[simp] lemma apply_same : std_basis_matrix i j c i j = c := if_pos (and.intro rfl rfl)

@[simp] lemma apply_of_ne (h : ¬((i = i') ∧ (j = j'))) :
  std_basis_matrix i j c i' j' = 0 :=
by { simp only [std_basis_matrix, and_imp, ite_eq_right_iff], tauto }

@[simp] lemma apply_of_row_ne {i i' : m} (hi : i ≠ i') (j j' : n) (a : α) :
  std_basis_matrix i j a i' j' = 0 :=
by simp [hi]

@[simp] lemma apply_of_col_ne (i i' : m) {j j' : n} (hj : j ≠ j') (a : α) :
  std_basis_matrix i j a i' j' = 0 :=
by simp [hj]

end

section

variables (i j : n) (c : α) (i' j' : n)

@[simp] lemma diag_zero (h : j ≠ i) : diag (std_basis_matrix i j c) = 0 :=
funext $ λ k, if_neg $ λ ⟨e₁, e₂⟩, h (e₂.trans e₁.symm)

@[simp] lemma diag_same : diag (std_basis_matrix i i c) = pi.single i c :=
by { ext j, by_cases hij : i = j; try {rw hij}; simp [hij] }

variable [fintype n]

@[simp] lemma trace_zero (h : j ≠ i) : trace (std_basis_matrix i j c) = 0 := by simp [trace, h]

@[simp] lemma trace_eq : trace (std_basis_matrix i i c) = c := by simp [trace]

@[simp] lemma mul_left_apply_same (b : n) (M : matrix n n α) :
  (std_basis_matrix i j c ⬝ M) i b = c * M j b :=
by simp [mul_apply, std_basis_matrix]

@[simp] lemma mul_right_apply_same (a : n) (M : matrix n n α) :
  (M ⬝ std_basis_matrix i j c) a j = M a i * c :=
by simp [mul_apply, std_basis_matrix, mul_comm]

@[simp] lemma mul_left_apply_of_ne (a b : n) (h : a ≠ i) (M : matrix n n α) :
  (std_basis_matrix i j c ⬝ M) a b = 0 :=
by simp [mul_apply, h.symm]

@[simp] lemma mul_right_apply_of_ne (a b : n) (hbj : b ≠ j) (M : matrix n n α) :
  (M ⬝ std_basis_matrix i j c) a b = 0 :=
by simp [mul_apply, hbj.symm]

@[simp] lemma mul_same (k : n) (d : α) :
  std_basis_matrix i j c ⬝ std_basis_matrix j k d = std_basis_matrix i k (c * d) :=
begin
  ext a b,
  simp only [mul_apply, std_basis_matrix, boole_mul],
  by_cases h₁ : i = a; by_cases h₂ : k = b;
  simp [h₁, h₂],
end

@[simp] lemma mul_of_ne {k l : n} (h : j ≠ k) (d : α) :
  std_basis_matrix i j c ⬝ std_basis_matrix k l d = 0 :=
begin
  ext a b,
  simp only [mul_apply, boole_mul, std_basis_matrix],
  by_cases h₁ : i = a;
  simp [h₁, h, h.symm],
end

end

end std_basis_matrix

end matrix


import init.data.nat.basic

variable A : Type*
variables P Q : A → Prop
variable R : Prop

-- 1
example : (∀ x, P x ∧ Q x) ↔ (∀ x, P x) ∧ (∀ x, Q x) :=
begin
  split,
  assume h, split,
    assume x, from (h x).left,
    assume x, from (h x).right,
  assume h, assume x, split,
    from h.left x,
    from h.right x
end

example : (∀ x, P x → Q x) → (∀ x, P x) → (∀ x, Q x) :=
begin
  assume h h' x,
  from h x (h' x)
end

example : (∀ x, P x) ∨ (∀ x, Q x) → ∀ x, P x ∨ Q x :=
begin
  assume h x, cases h,
    left, from h x,
    right, from h x
end

-- 2

example : A → ((∀ x : A, R) ↔ R) :=
begin
  assume x, split,
    assume f, from f x,
    assume r, from assume _, r
end

example : (∀ x, P x ∨ R) ↔ (∀ x, P x) ∨ R :=
begin
  split,

  assume h, by_cases r : R,
    right, from r,
    left, assume x,
      have h' : P x ∨ R, from h x,
      cases h' with px r',
        from px,
        exfalso, from r r',

  assume h, cases h with px r,
    assume x, left, from px x,
    assume x, right, from r
end

example : (∀ x, R → P x) ↔ (R → ∀ x, P x) :=
begin
  split,
    assume f r x, from f x r,
    assume f x r, from f r x
end

-- 3
variables (men : Type*) (barber : men)
variable (shaves : men → men → Prop)
example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
begin
  have hb : shaves barber barber ↔ ¬ shaves barber barber,
    from h barber,
  cases hb with hn hp,
  have f : ¬ shaves barber barber,
    assume s, show false, from (hn s) s,
  have t : shaves barber barber,
    from hp f,

  show false, from f t
end

-- 4
def exp : ℕ → ℕ → ℕ
| x 0 := 1
| x (y+1) := x * (exp x y)

def even (n : ℕ) : Prop := nat.mod n 2 = 0

def prime (n : ℕ) : Prop :=
  ∀ x : ℕ, nat.mod n x = 0 → (x = 1 ∨ x = n)
def infinitely_many_primes : Prop :=
  ∀ x : ℕ, ∃ y : ℕ, x ≤ y ∧ prime y
def Fermat_prime (n : ℕ) : Prop :=
  prime n ∧ ∃ x : ℕ, n = (exp 2 (exp 2 x)) + 1
def infinitely_many_Fermat_primes : Prop :=
  ∀ x : ℕ, ∃ y : ℕ, x ≤ y ∧ Fermat_prime y
def goldbach_conjecture : Prop :=
  ∀ x : ℕ, even x → 2 ≤ x → ∃ y z : ℕ, prime y ∧ prime z ∧ x = y + z
def Goldbach's_weak_conjecture : Prop :=
  ∀ x : ℕ, ¬ even x → 5 ≤ x →
    ∃ w y z : ℕ, prime w ∧ prime y ∧ prime z ∧ x = w + y + z
def Fermat's_last_theorem : Prop := ∀ n a b c : ℕ,
  3 ≤ n → ¬ (exp a n = (exp b n) + (exp c n))

-- ex
example : (∃ x : A, R) → R :=
begin
  assume ex, cases ex with _ r, exact r
end

variable a : A

example : R → (∃ x : A, R) :=
  assume : R, exists.intro a ‹ R ›

example : (∃ x, P x ∧ R) ↔ (∃ x, P x) ∧ R :=
begin split,
    assume h : ∃ x, P x ∧  R ,
    exact match h with ⟨ w , ℘₁ , ℘₂ ⟩ := ⟨ ⟨ w , ℘₁⟩ , ℘₂ ⟩ end,

    assume h : (∃ x, P x) ∧ R ,
    exact match h with ⟨ ⟨ w , ℘₁ ⟩ , ℘₂ ⟩ := ⟨ w , ℘₁ , ℘₂ ⟩ end
end

example : (∃ x, P x ∨ Q x) ↔ (∃ x, P x) ∨ (∃ x, Q x) :=
begin split,
  assume : ∃ x, P x ∨ Q x,
  cases ‹ ∃ x, P x ∨ Q x › with x,
  cases ‹ P x ∨ Q x ›,
    left, existsi x, exact ‹ P x ›,
    right, existsi x, exact ‹ Q x ›,

  assume : (∃ x, P x) ∨ (∃ x, Q x),
  cases ‹ (∃ x, P x) ∨ (∃ x, Q x) ›,
    cases ‹ ∃ x, P x › with x,
    existsi x,
      show P x ∨ Q x, left, exact ‹ P x ›,
    cases ‹ ∃ x, Q x › with x,
    existsi x,
      show P x ∨ Q x, right, exact ‹ Q x ›
end

example : (∀ x, P x) ↔ ¬ (∃ x, ¬ P x) :=
begin split,
  assume : ∀ x, P x, assume : ∃ x, ¬ P x,
  cases ‹ ∃ x, ¬ P x › with x,
  show false, from ‹ ¬ P x › (‹ ∀ x, P x › x),

  assume : ¬∃ (x : A), ¬P x, assume x,by_contradiction,
  have : ∃ x, ¬ P x,
    existsi x, from ‹ ¬ P x ›,
  show false, from ‹ ¬∃ (x : A), ¬P x › this,
end

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
begin
  split,
  intros epx all_np,
    cases epx with x px,
      exact (all_np x) px ,
  intro h₀,
    by_contradiction ,
      have all : ∀ x, ¬p x ,
        assume x ,
        assume hpx ,
        exact h ( ⟨ x , hpx ⟩ ),
      exact h₀ all ,
end
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
begin
  split,
    intros nh x px,
    exact nh ⟨ x , px ⟩,

    intros h epx,
      cases epx,
      exact h epx_w epx_h
end

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
begin
  split,
  --L_R
  intro nallp ,
  by_contradiction ℘,
    have allp : ∀ x,p x,
      assume x,
      by_contradiction ψ ,
        exact ℘ ⟨ x , ψ ⟩ ,
      exact nallp allp,
  --R_L
  intros h₀ h₁,
  cases h₀ ,
  exact h₀_h ( h₁ h₀_w )
end

example : (∀ x, P x → R) ↔ (∃ x, P x) → R := sorry
example : (∃ x, P x → R) ↔ (∀ x, P x) → R := sorry
example : (∃ x, R → P x) ↔ (R → ∃ x, P x) := sorry

variables (α : Type*) (p q : α → Prop)
variable r : Prop
variables ℘ ψ : Prop
example : α → ((∀ x : α, r) ↔ r) :=
begin
  intro α ,
  split ,
  --LR
  intro αr ,
  exact αr α ,
  --RL
  intros r α ,
  exact r ,
end
example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
begin
  split,
  --LR
  intros h₀ r x , exact h₀ x r ,
  --RL
  intros h₀ x r , exact h₀ r x ,
end


/-
Copyright (c) 2020 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen, Kevin Lacker
-/
import tactic.ring
/-!
# Identities

This file contains some "named" commutative ring identities.
-/

variables {R : Type*} [comm_ring R]
{a b x₁ x₂ x₃ x₄ x₅ x₆ x₇ x₈ y₁ y₂ y₃ y₄ y₅ y₆ y₇ y₈ n : R}

/--
Brahmagupta-Fibonacci identity or Diophantus identity, see
<https://en.wikipedia.org/wiki/Brahmagupta%E2%80%93Fibonacci_identity>.

This sign choice here corresponds to the signs obtained by multiplying two complex numbers.
-/
theorem sq_add_sq_mul_sq_add_sq :
  (x₁^2 + x₂^2) * (y₁^2 + y₂^2) = (x₁*y₁ - x₂*y₂)^2 + (x₁*y₂ + x₂*y₁)^2 :=
by ring

/--
Brahmagupta's identity, see <https://en.wikipedia.org/wiki/Brahmagupta%27s_identity>
-/
theorem sq_add_mul_sq_mul_sq_add_mul_sq :
  (x₁^2 + n*x₂^2) * (y₁^2 + n*y₂^2) = (x₁*y₁ - n*x₂*y₂)^2 + n*(x₁*y₂ + x₂*y₁)^2 :=
by ring

/--
Sophie Germain's identity, see <https://www.cut-the-knot.org/blue/SophieGermainIdentity.shtml>.
-/
theorem pow_four_add_four_mul_pow_four : a^4 + 4*b^4 = ((a - b)^2 + b^2) * ((a + b)^2 + b^2) :=
by ring

/--
Sophie Germain's identity, see <https://www.cut-the-knot.org/blue/SophieGermainIdentity.shtml>.
-/
theorem pow_four_add_four_mul_pow_four' :
  a^4 + 4*b^4 = (a^2 - 2*a*b + 2*b^2) * (a^2 + 2*a*b + 2*b^2) :=
by ring

/--
Euler's four-square identity, see <https://en.wikipedia.org/wiki/Euler%27s_four-square_identity>.

This sign choice here corresponds to the signs obtained by multiplying two quaternions.
-/
theorem sum_four_sq_mul_sum_four_sq : (x₁^2 + x₂^2 + x₃^2 + x₄^2) * (y₁^2 + y₂^2 + y₃^2 + y₄^2) =
  (x₁*y₁ - x₂*y₂ - x₃*y₃ - x₄*y₄)^2 + (x₁*y₂ + x₂*y₁ + x₃*y₄ - x₄*y₃)^2 +
  (x₁*y₃ - x₂*y₄ + x₃*y₁ + x₄*y₂)^2 + (x₁*y₄ + x₂*y₃ - x₃*y₂ + x₄*y₁)^2 :=
by ring

/--
Degen's eight squares identity, see <https://en.wikipedia.org/wiki/Degen%27s_eight-square_identity>.

This sign choice here corresponds to the signs obtained by multiplying two octonions.
-/
theorem sum_eight_sq_mul_sum_eight_sq : (x₁^2 + x₂^2 + x₃^2 + x₄^2 + x₅^2 + x₆^2 + x₇^2 + x₈^2) *
  (y₁^2 + y₂^2 + y₃^2 + y₄^2 + y₅^2 + y₆^2 + y₇^2 + y₈^2) =
  (x₁*y₁ - x₂*y₂ - x₃*y₃ - x₄*y₄ - x₅*y₅ - x₆*y₆ - x₇*y₇ - x₈*y₈)^2 +
  (x₁*y₂ + x₂*y₁ + x₃*y₄ - x₄*y₃ + x₅*y₆ - x₆*y₅ - x₇*y₈ + x₈*y₇)^2 +
  (x₁*y₃ - x₂*y₄ + x₃*y₁ + x₄*y₂ + x₅*y₇ + x₆*y₈ - x₇*y₅ - x₈*y₆)^2 +
  (x₁*y₄ + x₂*y₃ - x₃*y₂ + x₄*y₁ + x₅*y₈ - x₆*y₇ + x₇*y₆ - x₈*y₅)^2 +
  (x₁*y₅ - x₂*y₆ - x₃*y₇ - x₄*y₈ + x₅*y₁ + x₆*y₂ + x₇*y₃ + x₈*y₄)^2 +
  (x₁*y₆ + x₂*y₅ - x₃*y₈ + x₄*y₇ - x₅*y₂ + x₆*y₁ - x₇*y₄ + x₈*y₃)^2 +
  (x₁*y₇ + x₂*y₈ + x₃*y₅ - x₄*y₆ - x₅*y₃ + x₆*y₄ + x₇*y₁ - x₈*y₂)^2 +
  (x₁*y₈ - x₂*y₇ + x₃*y₆ + x₄*y₅ - x₅*y₄ - x₆*y₃ + x₇*y₂ + x₈*y₁)^2 :=
by ring


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.coeff

/-!
# Theory of univariate polynomials

The main results are `induction_on` and `as_sum`.
-/

noncomputable theory

open finsupp finset

namespace polynomial
open_locale polynomial
universes u v w x y z
variables {R : Type u} {S : Type v} {T : Type w} {ι : Type x} {k : Type y} {A : Type z}
  {a b : R} {m n : ℕ}

section semiring
variables [semiring R] {p q r : R[X]}

lemma sum_C_mul_X_eq (p : R[X]) : p.sum (λn a, C a * X^n) = p :=
begin
  ext n,
  simp only [polynomial.sum, X_pow_eq_monomial, coeff_monomial, mul_one, finset_sum_coeff,
    C_mul_monomial, not_not, mem_support_iff, finset.sum_ite_eq', ite_eq_left_iff],
  exact λ h, h.symm
end

lemma sum_monomial_eq (p : R[X]) : p.sum (λn a, monomial n a) = p :=
by simp only [monomial_eq_C_mul_X, sum_C_mul_X_eq]

@[elab_as_eliminator] protected lemma induction_on {M : R[X] → Prop} (p : R[X])
  (h_C : ∀a, M (C a))
  (h_add : ∀p q, M p → M q → M (p + q))
  (h_monomial : ∀(n : ℕ) (a : R), M (C a * X^n) → M (C a * X^(n+1))) :
  M p :=
begin
  have A : ∀{n:ℕ} {a}, M (C a * X^n),
  { assume n a,
    induction n with n ih,
    { simp only [pow_zero, mul_one, h_C] },
    { exact h_monomial _ _ ih } },
  have B : ∀ (s : finset ℕ), M (s.sum (λ (n : ℕ), C (p.coeff n) * X ^ n)),
  { apply finset.induction,
    { convert h_C 0, exact C_0.symm },
    { assume n s ns ih, rw sum_insert ns, exact h_add _ _ A ih, } },
  rw [← sum_C_mul_X_eq p, polynomial.sum],
  exact B _
end

/--
To prove something about polynomials,
it suffices to show the condition is closed under taking sums,
and it holds for monomials.
-/
@[elab_as_eliminator] protected lemma induction_on' {M : R[X] → Prop} (p : R[X])
  (h_add : ∀p q, M p → M q → M (p + q))
  (h_monomial : ∀(n : ℕ) (a : R), M (monomial n a)) :
  M p :=
polynomial.induction_on p (h_monomial 0) h_add
(λ n a h, by { rw ← monomial_eq_C_mul_X at ⊢, exact h_monomial _ _ })

section coeff

theorem coeff_mul_monomial (p : R[X]) (n d : ℕ) (r : R) :
  coeff (p * monomial n r) (d + n) = coeff p d * r :=
by rw [monomial_eq_C_mul_X, ←X_pow_mul, ←mul_assoc, coeff_mul_C, coeff_mul_X_pow]

theorem coeff_monomial_mul (p : R[X]) (n d : ℕ) (r : R) :
  coeff (monomial n r * p) (d + n) = r * coeff p d :=
by rw [monomial_eq_C_mul_X, mul_assoc, coeff_C_mul, X_pow_mul, coeff_mul_X_pow]

-- This can already be proved by `simp`.
theorem coeff_mul_monomial_zero (p : R[X]) (d : ℕ) (r : R) :
  coeff (p * monomial 0 r) d = coeff p d * r :=
coeff_mul_monomial p 0 d r

-- This can already be proved by `simp`.
theorem coeff_monomial_zero_mul (p : R[X]) (d : ℕ) (r : R) :
  coeff (monomial 0 r * p) d = r * coeff p d :=
coeff_monomial_mul p 0 d r

end coeff

open submodule polynomial set
variables {f : R[X]} {I : submodule R[X] R[X]}

/--  If the coefficients of a polynomial belong to n ideal contains the submodule span of the
coefficients of a polynomial. -/
lemma span_le_of_coeff_mem_C_inverse (cf : ∀ (i : ℕ), f.coeff i ∈ (C ⁻¹' I.carrier)) :
  (span R[X] {g | ∃ i, g = C (f.coeff i)}) ≤ I :=
begin
  refine bInter_subset_of_mem _,
  rintros _ ⟨i, rfl⟩,
  exact set_like.mem_coe.mpr (cf i),
end

lemma mem_span_C_coeff :
  f ∈ span R[X] {g : R[X] | ∃ i : ℕ, g = (C (coeff f i))} :=
begin
  let p := span R[X] {g : R[X] | ∃ i : ℕ, g = (C (coeff f i))},
  nth_rewrite 0 (sum_C_mul_X_eq f).symm,
  refine submodule.sum_mem _ (λ n hn, _),
  dsimp,
  have : C (coeff f n) ∈ p, by { apply subset_span, simp },
  have : (monomial n (1 : R)) • C (coeff f n) ∈ p := p.smul_mem _ this,
  convert this using 1,
  simp only [monomial_mul_C, one_mul, smul_eq_mul],
  rw monomial_eq_C_mul_X,
end

lemma exists_coeff_not_mem_C_inverse :
  f ∉ I → ∃ i : ℕ , coeff f i ∉ (C ⁻¹'  I.carrier) :=
imp_of_not_imp_not _ _
  (λ cf, not_not.mpr ((span_le_of_coeff_mem_C_inverse (not_exists_not.mp cf)) mem_span_C_coeff))

end semiring

end polynomial


/-
Copyright (c) 2021 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best
-/
import data.set.pointwise
import group_theory.group_action.pi

/-!
# Pointwise actions on sets in Pi types

This file contains lemmas about pointwise actions on sets in Pi types.

## Tags

set multiplication, set addition, pointwise addition, pointwise multiplication, pi

-/

open_locale pointwise
open set

variables {K ι : Type*} {R : ι → Type*}

@[to_additive]
lemma smul_pi_subset [∀ i, has_scalar K (R i)] (r : K) (s : set ι) (t : Π i, set (R i)) :
  r • pi s t ⊆ pi s (r • t) :=
begin
  rintros x ⟨y, h, rfl⟩ i hi,
  exact smul_mem_smul_set (h i hi),
end

@[to_additive]
lemma smul_univ_pi [∀ i, has_scalar K (R i)] (r : K) (t : Π i, set (R i)) :
  r • pi (univ : set ι) t = pi (univ : set ι) (r • t) :=
subset.antisymm (smul_pi_subset _ _ _) $ λ x h, begin
  refine ⟨λ i, classical.some (h i $ set.mem_univ _), λ i hi, _, funext $ λ i, _⟩,
  { exact (classical.some_spec (h i _)).left, },
  { exact (classical.some_spec (h i _)).right, },
end

@[to_additive]
lemma smul_pi [group K] [∀ i, mul_action K (R i)] (r : K) (S : set ι) (t : Π i, set (R i)) :
  r • S.pi t = S.pi (r • t) :=
subset.antisymm (smul_pi_subset _ _ _) $ λ x h,
  ⟨r⁻¹ • x, λ i hiS, mem_smul_set_iff_inv_smul_mem.mp (h i hiS), smul_inv_smul _ _⟩

lemma smul_pi₀ [group_with_zero K] [∀ i, mul_action K (R i)] {r : K} (S : set ι)
  (t : Π i, set (R i)) (hr : r ≠ 0) : r • S.pi t = S.pi (r • t) :=
smul_pi (units.mk0 r hr) S t


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

import data.finset.nat_antidiagonal
import algebra.big_operators.basic

/-!
# Big operators for `nat_antidiagonal`

This file contains theorems relevant to big operators over `finset.nat.antidiagonal`.
-/

open_locale big_operators

variables {M N : Type*} [comm_monoid M] [add_comm_monoid N]

namespace finset
namespace nat

lemma prod_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → M} :
  ∏ p in antidiagonal (n + 1), f p = f (0, n + 1) * ∏ p in antidiagonal n, f (p.1 + 1, p.2) :=
begin
  rw [antidiagonal_succ, prod_insert, prod_map], refl,
  intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩,
  simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2,
  apply nat.succ_ne_zero a h2.1,
end

lemma sum_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → N} :
  ∑ p in antidiagonal (n + 1), f p = f (0, n + 1) + ∑ p in antidiagonal n, f (p.1 + 1, p.2) :=
@prod_antidiagonal_succ (multiplicative N) _ _ _

@[to_additive]
lemma prod_antidiagonal_swap {n : ℕ} {f : ℕ × ℕ → M} :
  ∏ p in antidiagonal n, f p.swap = ∏ p in antidiagonal n, f p :=
by { nth_rewrite 1 ← map_swap_antidiagonal, rw [prod_map], refl }

lemma prod_antidiagonal_succ' {n : ℕ} {f : ℕ × ℕ → M} :
  ∏ p in antidiagonal (n + 1), f p = f (n + 1, 0) * ∏ p in antidiagonal n, f (p.1, p.2 + 1) :=
begin
  rw [← prod_antidiagonal_swap, prod_antidiagonal_succ, ← prod_antidiagonal_swap],
  refl
end

lemma sum_antidiagonal_succ' {n : ℕ} {f : ℕ × ℕ → N} :
  ∑ p in antidiagonal (n + 1), f p = f (n + 1, 0) + ∑ p in antidiagonal n, f (p.1, p.2 + 1) :=
@prod_antidiagonal_succ' (multiplicative N) _ _ _

@[to_additive]
lemma prod_antidiagonal_subst {n : ℕ} {f : ℕ × ℕ → ℕ → M} :
  ∏ p in antidiagonal n, f p n = ∏ p in antidiagonal n, f p (p.1 + p.2) :=
prod_congr rfl $ λ p hp, by rw [nat.mem_antidiagonal.1 hp]

@[to_additive]
lemma prod_antidiagonal_eq_prod_range_succ_mk {M : Type*} [comm_monoid M] (f : ℕ × ℕ → M) (n : ℕ) :
  ∏ ij in finset.nat.antidiagonal n, f ij = ∏ k in range n.succ, f (k, n - k) :=
begin
  convert prod_map _ ⟨λ i, (i, n - i), λ x y h, (prod.mk.inj h).1⟩ _,
  refl,
end

/-- This lemma matches more generally than `finset.nat.prod_antidiagonal_eq_prod_range_succ_mk` when
using `rw ←`. -/
@[to_additive]
lemma prod_antidiagonal_eq_prod_range_succ {M : Type*} [comm_monoid M] (f : ℕ → ℕ → M) (n : ℕ) :
  ∏ ij in finset.nat.antidiagonal n, f ij.1 ij.2 = ∏ k in range n.succ, f k (n - k) :=
prod_antidiagonal_eq_prod_range_succ_mk _ _

end nat

end finset


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.gcd_monoid.basic
import data.multiset.lattice

/-!
# GCD and LCM operations on multisets

## Main definitions

- `multiset.gcd` - the greatest common denominator of a `multiset` of elements of a `gcd_monoid`
- `multiset.lcm` - the least common multiple of a `multiset` of elements of a `gcd_monoid`

## Implementation notes

TODO: simplify with a tactic and `data.multiset.lattice`

## Tags

multiset, gcd
-/

namespace multiset
variables {α : Type*} [comm_cancel_monoid_with_zero α] [normalized_gcd_monoid α]

/-! ### lcm -/
section lcm

/-- Least common multiple of a multiset -/
def lcm (s : multiset α) : α := s.fold gcd_monoid.lcm 1

@[simp] lemma lcm_zero : (0 : multiset α).lcm = 1 :=
fold_zero _ _

@[simp] lemma lcm_cons (a : α) (s : multiset α) :
  (a ::ₘ s).lcm = gcd_monoid.lcm a s.lcm :=
fold_cons_left _ _ _ _

@[simp] lemma lcm_singleton {a : α} : ({a} : multiset α).lcm = normalize a :=
(fold_singleton _ _ _).trans $ lcm_one_right _

@[simp] lemma lcm_add (s₁ s₂ : multiset α) : (s₁ + s₂).lcm = gcd_monoid.lcm s₁.lcm s₂.lcm :=
eq.trans (by simp [lcm]) (fold_add _ _ _ _ _)

lemma lcm_dvd {s : multiset α} {a : α} : s.lcm ∣ a ↔ (∀ b ∈ s, b ∣ a) :=
multiset.induction_on s (by simp)
  (by simp [or_imp_distrib, forall_and_distrib, lcm_dvd_iff] {contextual := tt})

lemma dvd_lcm {s : multiset α} {a : α} (h : a ∈ s) : a ∣ s.lcm :=
lcm_dvd.1 dvd_rfl _ h

lemma lcm_mono {s₁ s₂ : multiset α} (h : s₁ ⊆ s₂) : s₁.lcm ∣ s₂.lcm :=
lcm_dvd.2 $ assume b hb, dvd_lcm (h hb)

@[simp] lemma normalize_lcm (s : multiset α) : normalize (s.lcm) = s.lcm :=
multiset.induction_on s (by simp) $ λ a s IH, by simp

@[simp] theorem lcm_eq_zero_iff [nontrivial α] (s : multiset α) : s.lcm = 0 ↔ (0 : α) ∈ s :=
begin
  induction s using multiset.induction_on with a s ihs,
  { simp only [lcm_zero, one_ne_zero, not_mem_zero] },
  { simp only [mem_cons, lcm_cons, lcm_eq_zero_iff, ihs, @eq_comm _ a] },
end

variables [decidable_eq α]

@[simp] lemma lcm_erase_dup (s : multiset α) : (erase_dup s).lcm = s.lcm :=
multiset.induction_on s (by simp) $ λ a s IH, begin
  by_cases a ∈ s; simp [IH, h],
  unfold lcm,
  rw [← cons_erase h, fold_cons_left, ← lcm_assoc, lcm_same],
  apply lcm_eq_of_associated_left (associated_normalize _),
end

@[simp] lemma lcm_ndunion (s₁ s₂ : multiset α) :
  (ndunion s₁ s₂).lcm = gcd_monoid.lcm s₁.lcm s₂.lcm :=
by { rw [← lcm_erase_dup, erase_dup_ext.2, lcm_erase_dup, lcm_add], simp }

@[simp] lemma lcm_union (s₁ s₂ : multiset α) :
  (s₁ ∪ s₂).lcm = gcd_monoid.lcm s₁.lcm s₂.lcm :=
by { rw [← lcm_erase_dup, erase_dup_ext.2, lcm_erase_dup, lcm_add], simp }

@[simp] lemma lcm_ndinsert (a : α) (s : multiset α) :
  (ndinsert a s).lcm = gcd_monoid.lcm a s.lcm :=
by { rw [← lcm_erase_dup, erase_dup_ext.2, lcm_erase_dup, lcm_cons], simp }

end lcm

/-! ### gcd -/
section gcd

/-- Greatest common divisor of a multiset -/
def gcd (s : multiset α) : α := s.fold gcd_monoid.gcd 0

@[simp] lemma gcd_zero : (0 : multiset α).gcd = 0 :=
fold_zero _ _

@[simp] lemma gcd_cons (a : α) (s : multiset α) :
  (a ::ₘ s).gcd = gcd_monoid.gcd a s.gcd :=
fold_cons_left _ _ _ _

@[simp] lemma gcd_singleton {a : α} : ({a} : multiset α).gcd = normalize a :=
(fold_singleton _ _ _).trans $ gcd_zero_right _

@[simp] lemma gcd_add (s₁ s₂ : multiset α) : (s₁ + s₂).gcd = gcd_monoid.gcd s₁.gcd s₂.gcd :=
eq.trans (by simp [gcd]) (fold_add _ _ _ _ _)

lemma dvd_gcd {s : multiset α} {a : α} : a ∣ s.gcd ↔ (∀ b ∈ s, a ∣ b) :=
multiset.induction_on s (by simp)
  (by simp [or_imp_distrib, forall_and_distrib, dvd_gcd_iff] {contextual := tt})

lemma gcd_dvd {s : multiset α} {a : α} (h : a ∈ s) : s.gcd ∣ a :=
dvd_gcd.1 dvd_rfl _ h

lemma gcd_mono {s₁ s₂ : multiset α} (h : s₁ ⊆ s₂) : s₂.gcd ∣ s₁.gcd :=
dvd_gcd.2 $ assume b hb, gcd_dvd (h hb)

@[simp] lemma normalize_gcd (s : multiset α) : normalize (s.gcd) = s.gcd :=
multiset.induction_on s (by simp) $ λ a s IH, by simp

theorem gcd_eq_zero_iff (s : multiset α) : s.gcd = 0 ↔ ∀ (x : α), x ∈ s → x = 0 :=
begin
  split,
  { intros h x hx,
    apply eq_zero_of_zero_dvd,
    rw ← h,
    apply gcd_dvd hx },
  { apply s.induction_on,
    { simp },
    intros a s sgcd h,
    simp [h a (mem_cons_self a s), sgcd (λ x hx, h x (mem_cons_of_mem hx))] }
end

variables [decidable_eq α]

@[simp] lemma gcd_erase_dup (s : multiset α) : (erase_dup s).gcd = s.gcd :=
multiset.induction_on s (by simp) $ λ a s IH, begin
  by_cases a ∈ s; simp [IH, h],
  unfold gcd,
  rw [← cons_erase h, fold_cons_left, ← gcd_assoc, gcd_same],
  apply (associated_normalize _).gcd_eq_left,
end

@[simp] lemma gcd_ndunion (s₁ s₂ : multiset α) :
  (ndunion s₁ s₂).gcd = gcd_monoid.gcd s₁.gcd s₂.gcd :=
by { rw [← gcd_erase_dup, erase_dup_ext.2, gcd_erase_dup, gcd_add], simp }

@[simp] lemma gcd_union (s₁ s₂ : multiset α) :
  (s₁ ∪ s₂).gcd = gcd_monoid.gcd s₁.gcd s₂.gcd :=
by { rw [← gcd_erase_dup, erase_dup_ext.2, gcd_erase_dup, gcd_add], simp }

@[simp] lemma gcd_ndinsert (a : α) (s : multiset α) :
  (ndinsert a s).gcd = gcd_monoid.gcd a s.gcd :=
by { rw [← gcd_erase_dup, erase_dup_ext.2, gcd_erase_dup, gcd_cons], simp }

end gcd

end multiset


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yury Kudryashov
-/
import data.set.lattice

/-!
# Extra lemmas about intervals

This file contains lemmas about intervals that cannot be included into `data.set.intervals.basic`
because this would create an `import` cycle. Namely, lemmas in this file can use definitions
from `data.set.lattice`, including `disjoint`.
-/

universes u v w

variables {ι : Sort u} {α : Type v} {β : Type w}

open set order_dual (to_dual)

namespace set

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

@[simp] lemma Iic_disjoint_Ioi (h : a ≤ b) : disjoint (Iic a) (Ioi b) :=
λ x ⟨ha, hb⟩, not_le_of_lt (h.trans_lt hb) ha

@[simp] lemma Iic_disjoint_Ioc (h : a ≤ b) : disjoint (Iic a) (Ioc b c) :=
(Iic_disjoint_Ioi h).mono le_rfl (λ _, and.left)

@[simp] lemma Ioc_disjoint_Ioc_same {a b c : α} : disjoint (Ioc a b) (Ioc b c) :=
(Iic_disjoint_Ioc (le_refl b)).mono (λ _, and.right) le_rfl

@[simp] lemma Ico_disjoint_Ico_same {a b c : α} : disjoint (Ico a b) (Ico b c) :=
λ x hx, not_le_of_lt hx.1.2 hx.2.1

@[simp] lemma Ici_disjoint_Iic : disjoint (Ici a) (Iic b) ↔ ¬(a ≤ b) :=
by rw [set.disjoint_iff_inter_eq_empty, Ici_inter_Iic, Icc_eq_empty_iff]

@[simp] lemma Iic_disjoint_Ici : disjoint (Iic a) (Ici b) ↔ ¬(b ≤ a) :=
disjoint.comm.trans Ici_disjoint_Iic

end preorder

section linear_order
variables [linear_order α] {a₁ a₂ b₁ b₂ : α}

@[simp] lemma Ico_disjoint_Ico : disjoint (Ico a₁ a₂) (Ico b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
by simp_rw [set.disjoint_iff_inter_eq_empty, Ico_inter_Ico, Ico_eq_empty_iff,
  inf_eq_min, sup_eq_max, not_lt]

@[simp] lemma Ioc_disjoint_Ioc : disjoint (Ioc a₁ a₂) (Ioc b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
have h : _ ↔ min (to_dual a₁) (to_dual b₁) ≤ max (to_dual a₂) (to_dual b₂) := Ico_disjoint_Ico,
by simpa only [dual_Ico] using h

/-- If two half-open intervals are disjoint and the endpoint of one lies in the other,
  then it must be equal to the endpoint of the other. -/
lemma eq_of_Ico_disjoint {x₁ x₂ y₁ y₂ : α}
  (h : disjoint (Ico x₁ x₂) (Ico y₁ y₂)) (hx : x₁ < x₂) (h2 : x₂ ∈ Ico y₁ y₂) :
  y₁ = x₂ :=
begin
  rw [Ico_disjoint_Ico, min_eq_left (le_of_lt h2.2), le_max_iff] at h,
  apply le_antisymm h2.1,
  exact h.elim (λ h, absurd hx (not_lt_of_le h)) id
end

@[simp] lemma Union_Ico_eq_Iio_self_iff {f : ι → α} {a : α} :
  (⋃ i, Ico (f i) a) = Iio a ↔ ∀ x < a, ∃ i, f i ≤ x :=
by simp [← Ici_inter_Iio, ← Union_inter, subset_def]

@[simp] lemma Union_Ioc_eq_Ioi_self_iff {f : ι → α} {a : α} :
  (⋃ i, Ioc a (f i)) = Ioi a ↔ ∀ x, a < x → ∃ i, x ≤ f i :=
by simp [← Ioi_inter_Iic, ← inter_Union, subset_def]

@[simp] lemma bUnion_Ico_eq_Iio_self_iff {p : ι → Prop} {f : Π i, p i → α} {a : α} :
  (⋃ i (hi : p i), Ico (f i hi) a) = Iio a ↔ ∀ x < a, ∃ i hi, f i hi ≤ x :=
by simp [← Ici_inter_Iio, ← Union_inter, subset_def]

@[simp]

end linear_order

end set

section Union_Ixx

variables [linear_order α] {s : set α} {a : α} {f : ι → α}

lemma is_glb.bUnion_Ioi_eq (h : is_glb s a) : (⋃ x ∈ s, Ioi x) = Ioi a :=
begin
  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
  { exact Ioi_subset_Ioi (h.1 hx) },
  { rcases h.exists_between hx with ⟨y, hys, hay, hyx⟩,
    exact mem_bUnion hys hyx }
end

lemma is_glb.Union_Ioi_eq (h : is_glb (range f) a) :
  (⋃ x, Ioi (f x)) = Ioi a :=
bUnion_range.symm.trans h.bUnion_Ioi_eq

lemma is_lub.bUnion_Iio_eq (h : is_lub s a) :
  (⋃ x ∈ s, Iio x) = Iio a :=
h.dual.bUnion_Ioi_eq

lemma is_lub.Union_Iio_eq (h : is_lub (range f) a) :
  (⋃ x, Iio (f x)) = Iio a :=
h.dual.Union_Ioi_eq

end Union_Ixx


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import rank_one_valuation
import ring_seminorm
import topology.algebra.valuation

/-!
# Correspondence between nontrivial nonarchimedean norms and rank one valuations

Nontrivial nonarchimedean norms correspond to rank one valuations.

## Main Definitions
* `normed_field.to_valued` : the valued field structure on a nonarchimedean normed field `K`,
  determined by the norm.
* `valued_field.to_normed_field` : the normed field structure determined by a rank one valuation.

## Main Results
* `real.exists_strict_mono_lt` : if `Γ₀ˣ` is nontrivial and `f : Γ₀ →*₀ ℝ≥0` is a strict
  monomorphism, then for any positive real `r`, there exists `d : Γ₀ˣ` with `f d < r`.

## Tags

norm, nonarchimedean, nontrivial, valuation, rank one
-/

noncomputable theory

open_locale nnreal

variables {K : Type*} [hK : normed_field K]
include hK

/-- The valuation on a nonarchimedean normed field `K` defined as `nnnorm`. -/
def valuation_from_norm (h : is_nonarchimedean (norm : K → ℝ)) : valuation K ℝ≥0 :=
{ to_fun    := nnnorm,
  map_zero' := nnnorm_zero,
  map_one'  := nnnorm_one,
  map_mul'  := nnnorm_mul,
  map_add_le_max' := h }

lemma valuation_from_norm_apply (h : is_nonarchimedean (norm : K → ℝ)) (x : K):
  valuation_from_norm h x = ‖ x ‖₊ := rfl

/-- The valued field structure on a nonarchimedean normed field `K`, determined by the norm. -/
def normed_field.to_valued (h : is_nonarchimedean (norm : K → ℝ)) : valued K ℝ≥0 :=
{ v := valuation_from_norm h,
  is_topological_valuation := λ U,
  begin
    rw metric.mem_nhds_iff,
    refine ⟨λ h, _, λ h, _⟩,
    { obtain ⟨ε, hε, h⟩ := h,
      use units.mk0 ⟨ε, le_of_lt hε⟩ (ne_of_gt hε),
      intros x hx,
      exact h (mem_ball_zero_iff.mpr hx) },
    { obtain ⟨ε, hε⟩ := h,
      use [(ε : ℝ), nnreal.coe_pos.mpr (units.zero_lt _)],
      intros x hx,
      exact hε  (mem_ball_zero_iff.mp hx) },
  end,
  ..hK.to_uniform_space,
  ..non_unital_normed_ring.to_normed_add_comm_group }

omit hK

variables {L : Type*} [hL : field L] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
  [val : valued L Γ₀] [hv : is_rank_one val.v]

/-- If `Γ₀ˣ` is nontrivial and `f : Γ₀ →*₀ ℝ≥0` is a strict monomorphism, then for any positive
  `r : ℝ≥0`, there exists `d : Γ₀ˣ` with `f d < r`. -/
lemma nnreal.exists_strict_mono_lt {g : Γ₀ˣ} (hg1 : g ≠ 1) {f : Γ₀ →*₀ ℝ≥0} (hf : strict_mono f)
  {r : ℝ≥0} (hr : 0 < r) :  ∃ d : Γ₀ˣ, f d < r :=
begin
  set u : Γ₀ˣ := if g < 1 then g else g⁻¹ with hu,
  have hfu : f u < 1,
  { rw hu,
    split_ifs with hu1,
    { rw ← map_one f, exact hf hu1, },
    { have hfg0 : f g ≠ 0,
      { intro h0,
        exact (units.ne_zero g)  ((map_eq_zero f).mp h0), },
      have hg1' : 1 < g,
      { exact lt_of_le_of_ne (not_lt.mp hu1) hg1.symm },
      simp only [units.coe_inv, map_inv₀],
      rw [nnreal.inv_lt_one_iff hfg0, ← map_one f],
      exact hf hg1', }},
  obtain ⟨n, hn⟩ := nnreal.exists_pow_lt_of_lt_one hr hfu,
  use u^n,
  rw [units.coe_pow, map_pow],
  exact hn,
end

/-- If `Γ₀ˣ` is nontrivial and `f : Γ₀ →*₀ ℝ≥0` is a strict monomorphism, then for any positive
  real `r`, there exists `d : Γ₀ˣ` with `f d < r`. -/
lemma real.exists_strict_mono_lt {g : Γ₀ˣ} (hg1 : g ≠ 1) {f : Γ₀ →*₀ ℝ≥0} (hf : strict_mono f)
  {r : ℝ} (hr : 0 < r) :  ∃ d : Γ₀ˣ, (f d : ℝ) < r :=
begin
  set s : nnreal := ⟨r, le_of_lt hr⟩,
  have hs : 0 < s := hr,
  exact nnreal.exists_strict_mono_lt hg1 hf hs,
end

include hL val hv

namespace rank_one_valuation

/-- The norm function determined by a rank one valuation on a field `L`. -/
def norm_def : L → ℝ := λ x : L, hv.hom (valued.v x)

lemma norm_def_nonneg (x : L) : 0 ≤ norm_def x := by simp only [norm_def, nnreal.zero_le_coe]

lemma norm_def_add_le  (x y : L) :
  norm_def (x + y) ≤ max (norm_def x) (norm_def y) :=
begin
  simp only [norm_def, nnreal.coe_le_coe, le_max_iff, strict_mono.le_iff_le hv.strict_mono],
  exact le_max_iff.mp (valuation.map_add_le_max' val.v _ _),
end

lemma norm_def_eq_zero {x : L} (hx : norm_def x = 0) : x = 0 :=
by simpa [norm_def, nnreal.coe_eq_zero, is_rank_one_hom_eq_zero_iff, valuation.zero_iff] using hx

/-- The normed field structure determined by a rank one valuation. -/
def valued_field.to_normed_field : normed_field L :=
{ norm               := norm_def,
  dist               := λ x y, norm_def (x - y),
  dist_self          := λ x, by simp only [sub_self, norm_def, valuation.map_zero,
    (hv.hom).map_zero, nnreal.coe_zero],
  dist_comm          := λ x y, by { simp only [norm_def], rw [← neg_sub, valuation.map_neg] },
  dist_triangle      := λ x y z,
  begin
    simp only [← sub_add_sub_cancel x y z],
    exact le_trans (norm_def_add_le _ _)
      (max_le_add_of_nonneg (norm_def_nonneg _) (norm_def_nonneg _)),
  end,
  eq_of_dist_eq_zero := λ x y hxy, eq_of_sub_eq_zero (norm_def_eq_zero hxy),
  dist_eq            := λ x y, rfl,
  norm_mul'          := λ x y, by { simp only [norm_def, ← nnreal.coe_mul, map_mul], },
  to_uniform_space   := valued.to_uniform_space,
  uniformity_dist    :=
  begin
    ext U,
    rw [filter.has_basis_iff.mp (valued.has_basis_uniformity L Γ₀), infi_subtype',
      filter.mem_infi_of_directed],
    { simp only [exists_true_left, filter.mem_principal, subtype.exists, gt_iff_lt, subtype.coe_mk,
        exists_prop, true_and],
      refine ⟨λ h, _, λ h, _⟩,
      { obtain ⟨ε,  hε⟩ := h,
        set δ : ℝ≥0 := hv.hom ε with hδ,
        have hδ_pos : 0 < δ,
        { rw [hδ, ← map_zero hv.hom],
        exact hv.strict_mono (units.zero_lt ε), },
        use [δ, hδ_pos],
        apply subset_trans _ hε,
        intros x hx,
        simp only [set.mem_set_of_eq, norm_def, hδ, nnreal.val_eq_coe, nnreal.coe_lt_coe] at hx,
        rw [set.mem_set_of, ← neg_sub, valuation.map_neg],
        exact hv.strict_mono.lt_iff_lt.mp hx },
      { obtain ⟨r, hr_pos, hr⟩ := h,
        obtain ⟨u, hu⟩ :=
        real.exists_strict_mono_lt (is_rank_one_unit_ne_one val.v) hv.strict_mono hr_pos,
        use u,
        apply subset_trans _ hr,
        intros x hx,
        simp only [norm_def, set.mem_set_of_eq],
        apply lt_trans _ hu,
        rw [nnreal.coe_lt_coe, ← neg_sub, valuation.map_neg],
        exact hv.strict_mono.lt_iff_lt.mpr hx, }},
    { simp only [gt_iff_lt, ge_iff_le, directed],
      intros x y,
      use min x y,
      simp only [filter.le_principal_iff, filter.mem_principal, set.set_of_subset_set_of,
          prod.forall],
      exact ⟨λ a b hab, lt_of_lt_of_le hab (min_le_left _ _),
        λ a b hab, lt_of_lt_of_le hab (min_le_right _ _)⟩ }
  end,
  ..hL, }

  end rank_one_valuation


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

import order.filter.bases
import topology.algebra.module
/-!
# Group and ring filter bases

A `group_filter_basis` is a `filter_basis` on a group with some properties relating
the basis to the group structure. The main theorem is that a `group_filter_basis`
on a group gives a topology on the group which makes it into a topological group
with neighborhoods of the neutral element generated by the given basis.

## Main definitions and results

Given a group `G` and a ring `R`:

* `group_filter_basis G`: the type of filter bases that will become neighborhood of `1`
  for a topology on `G` compatible with the group structure
* `group_filter_basis.topology`: the associated topology
* `group_filter_basis.is_topological_group`: the compatibility between the above topology
  and the group structure
* `ring_filter_basis R`: the type of filter bases that will become neighborhood of `0`
  for a topology on `R` compatible with the ring structure
* `ring_filter_basis.topology`: the associated topology
* `ring_filter_basis.is_topological_ring`: the compatibility between the above topology
  and the ring structure

## References

* [N. Bourbaki, *General Topology*][bourbaki1966]
-/

open filter set topological_space function
open_locale topological_space filter pointwise

universe u

/-- A `group_filter_basis` on a group is a `filter_basis` satisfying some additional axioms.
  Example : if `G` is a topological group then the neighbourhoods of the identity are a
  `group_filter_basis`. Conversely given a `group_filter_basis` one can define a topology
  compatible with the group structure on `G`.  -/
class group_filter_basis (G : Type u) [group G] extends filter_basis G :=
(one' : ∀ {U}, U ∈ sets → (1 : G) ∈ U)
(mul' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V * V ⊆ U)
(inv' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, x⁻¹) ⁻¹' U)
(conj' : ∀ x₀, ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, x₀*x*x₀⁻¹) ⁻¹' U)

/-- A `add_group_filter_basis` on an additive group is a `filter_basis` satisfying some additional
  axioms. Example : if `G` is a topological group then the neighbourhoods of the identity are a
  `add_group_filter_basis`. Conversely given a `add_group_filter_basis` one can define a topology
  compatible with the group structure on `G`. -/
class add_group_filter_basis (A : Type u) [add_group A] extends filter_basis A :=
(zero' : ∀ {U}, U ∈ sets → (0 : A) ∈ U)
(add' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V + V ⊆ U)
(neg' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, -x) ⁻¹' U)
(conj' : ∀ x₀, ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, x₀+x+-x₀) ⁻¹' U)

attribute [to_additive] group_filter_basis
attribute [to_additive] group_filter_basis.one'
attribute [to_additive] group_filter_basis.mul'
attribute [to_additive] group_filter_basis.inv'
attribute [to_additive] group_filter_basis.conj'
attribute [to_additive] group_filter_basis.to_filter_basis

/-- `group_filter_basis` constructor in the commutative group case. -/
@[to_additive "`add_group_filter_basis` constructor in the commutative group case."]
def group_filter_basis_of_comm {G : Type*} [comm_group G]
  (sets                   : set (set G))
  (nonempty               : sets.nonempty)
  (inter_sets  : ∀ (x y), x ∈ sets → y ∈ sets → ∃ z ∈ sets, z ⊆ x ∩ y)
  (one : ∀ U ∈ sets, (1 : G) ∈ U)
  (mul : ∀ U ∈ sets, ∃ V ∈ sets, V * V ⊆ U)
  (inv : ∀ U ∈ sets, ∃ V ∈ sets, V ⊆ (λ x, x⁻¹) ⁻¹' U) : group_filter_basis G :=
{ sets := sets,
  nonempty := nonempty,
  inter_sets := inter_sets,
  one' := one,
  mul' := mul,
  inv' := inv,
  conj' := λ x U U_in, ⟨U, U_in, by simp⟩ }

namespace group_filter_basis
variables {G : Type u} [group G] {B : group_filter_basis G}

@[to_additive]
instance : has_mem (set G) (group_filter_basis G) :=
⟨λ s f, s ∈ f.sets⟩

@[to_additive] lemma one {U : set G} : U ∈ B → (1 : G) ∈ U := group_filter_basis.one'

@[to_additive] lemma mul {U : set G} : U ∈ B → ∃ V ∈ B, V*V ⊆ U := group_filter_basis.mul'

@[to_additive] lemma inv {U : set G} : U ∈ B → ∃ V ∈ B, V ⊆ (λ x, x⁻¹) ⁻¹' U :=
group_filter_basis.inv'

@[to_additive]
lemma conj : ∀ x₀, ∀ {U}, U ∈ B → ∃ V ∈ B, V ⊆ (λ x, x₀*x*x₀⁻¹) ⁻¹' U :=
group_filter_basis.conj'

/-- The trivial group filter basis consists of `{1}` only. The associated topology
is discrete. -/
@[to_additive "The trivial additive group filter basis consists of `{0}` only. The associated
topology is discrete."]
instance : inhabited (group_filter_basis G) :=
⟨begin
  refine { sets := {{1}}, nonempty := singleton_nonempty _, .. },
  all_goals { simp only [exists_prop, mem_singleton_iff] },
  { rintros - - rfl rfl,
    use {1},
    simp },
  { simp },
  { rintro - rfl,
    use {1},
    simp },
  { rintro - rfl,
    use {1},
    simp },
  { rintro x₀ - rfl,
    use {1},
    simp }
end⟩

@[to_additive]
lemma prod_subset_self (B : group_filter_basis G) {U : set G} (h : U ∈ B) : U ⊆ U * U :=
λ x x_in, ⟨1, x, one h, x_in, one_mul x⟩

/-- The neighborhood function of a `group_filter_basis` -/
@[to_additive "The neighborhood function of a `add_group_filter_basis`"]
def N (B : group_filter_basis G) : G → filter G :=
λ x, map (λ y, x*y) B.to_filter_basis.filter

@[simp, to_additive]
lemma N_one (B : group_filter_basis G) : B.N 1 = B.to_filter_basis.filter :=
by simp only [N, one_mul, map_id']

@[to_additive]
protected lemma has_basis (B : group_filter_basis G) (x : G) :
  has_basis (B.N x) (λ V : set G, V ∈ B) (λ V, (λ y, x*y) '' V) :=
has_basis.map (λ y, x * y) to_filter_basis.has_basis

/-- The topological space structure coming from a group filter basis. -/
@[to_additive "The topological space structure coming from an additive group filter basis."]
def topology (B : group_filter_basis G) : topological_space G :=
topological_space.mk_of_nhds B.N

@[to_additive]
lemma nhds_eq (B : group_filter_basis G) {x₀ : G} :
  @nhds G (B.topology) x₀ = B.N x₀ :=
begin
  rw [topological_space.nhds_mk_of_nhds],
  { intros x U U_in,
    rw (B.has_basis x).mem_iff at U_in,
    rcases U_in with ⟨V, V_in, H⟩,
    simpa [mem_pure] using H (mem_image_of_mem _ (group_filter_basis.one V_in)), },
  { intros x U U_in,
    rw (B.has_basis x).mem_iff at U_in,
    rcases U_in with ⟨V, V_in, H⟩,
    rcases group_filter_basis.mul V_in with ⟨W, W_in, hW⟩,
    use [(λ y, x*y) '' W, image_mem_map (filter_basis.mem_filter_of_mem _ W_in)],
    split,
    { rw image_subset_iff at H ⊢,
      exact ((B.prod_subset_self W_in).trans hW).trans H },
    { rintros y ⟨t, tW, rfl⟩,
      rw (B.has_basis _).mem_iff,
      use [W, W_in],
      apply subset.trans _ H, clear H,
      rintros z ⟨w, wW, rfl⟩,
      exact ⟨t*w, hW (mul_mem_mul tW wW), by simp [mul_assoc]⟩ } }
end

@[to_additive]

@[to_additive]
lemma nhds_has_basis (B : group_filter_basis G) (x₀ : G) :
has_basis (@nhds G B.topology x₀) (λ V : set G, V ∈ B) (λ V, (λ y, x₀ * y) '' V)  :=
by { rw B.nhds_eq, apply B.has_basis }

@[to_additive]
lemma nhds_one_has_basis (B : group_filter_basis G) :
has_basis (@nhds G B.topology 1) (λ V : set G, V ∈ B) id  :=
by { rw B.nhds_one_eq, exact B.to_filter_basis.has_basis }

@[to_additive]
lemma mem_nhds_one (B : group_filter_basis G) {U : set G} (hU : U ∈ B) : U ∈ @nhds G B.topology 1 :=
begin
  rw B.nhds_one_has_basis.mem_iff,
  exact ⟨U, hU, rfl.subset⟩
end

/-- If a group is endowed with a topological structure coming from
a group filter basis then it's a topological group. -/
@[to_additive, priority 100]
instance is_topological_group (B : group_filter_basis G) :
  @topological_group G B.topology _ :=
begin
  letI := B.topology,
  have basis := B.nhds_one_has_basis,
  have basis' := basis.prod basis,
  refine topological_group.of_nhds_one _ _ _ _,
  { rw basis'.tendsto_iff basis,
    suffices : ∀ U ∈ B, ∃ V W, (V ∈ B ∧ W ∈ B) ∧ ∀ a b, a ∈ V → b ∈ W → a * b ∈ U, by simpa,
    intros U U_in,
    rcases mul U_in with ⟨V, V_in, hV⟩,
    use [V, V, V_in, V_in],
    intros a b a_in b_in,
    exact hV ⟨a, b, a_in, b_in, rfl⟩ },
  { rw basis.tendsto_iff basis,
    intros U U_in,
    simpa using inv U_in },
  { intro x₀,
    rw [nhds_eq, nhds_one_eq],
    refl },
  { intro x₀,
    rw basis.tendsto_iff basis,
    intros U U_in,
    exact conj x₀ U_in }
end

end group_filter_basis

/-- A `ring_filter_basis` on a ring is a `filter_basis` satisfying some additional axioms.
  Example : if `R` is a topological ring then the neighbourhoods of the identity are a
  `ring_filter_basis`. Conversely given a `ring_filter_basis` on a ring `R`, one can define a
  topology on `R` which is compatible with the ring structure.  -/
class ring_filter_basis (R : Type u) [ring R] extends add_group_filter_basis R :=
(mul' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V * V ⊆ U)
(mul_left' : ∀ (x₀ : R) {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, x₀*x) ⁻¹' U)
(mul_right' : ∀ (x₀ : R) {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, x*x₀) ⁻¹' U)

namespace ring_filter_basis

variables {R : Type u} [ring R] (B : ring_filter_basis R)

instance : has_mem (set R) (ring_filter_basis R) :=
⟨λ s B, s ∈ B.sets⟩

lemma mul {U : set R} (hU : U ∈ B) : ∃ V ∈ B, V * V ⊆ U :=
mul' hU

lemma mul_left (x₀ : R) {U : set R} (hU : U ∈ B) :
  ∃ V ∈ B, V ⊆ (λ x, x₀*x) ⁻¹' U :=
mul_left' x₀ hU

lemma mul_right (x₀ : R) {U : set R} (hU : U ∈ B) :
  ∃ V ∈ B, V ⊆ (λ x, x*x₀) ⁻¹' U :=
mul_right' x₀ hU

/-- The topology associated to a ring filter basis.
It has the given basis as a basis of neighborhoods of zero. -/
def topology : topological_space R := B.to_add_group_filter_basis.topology

/-- If a ring is endowed with a topological structure coming from
a ring filter basis then it's a topological ring. -/
@[priority 100]
instance is_topological_ring {R : Type u} [ring R] (B : ring_filter_basis R) :
  @topological_ring R B.topology _ :=
begin
  let B' := B.to_add_group_filter_basis,
  letI := B'.topology,
  have basis := B'.nhds_zero_has_basis,
  have basis' := basis.prod basis,
  haveI := B'.is_topological_add_group,
  apply topological_ring.of_add_group_of_nhds_zero,
  { rw basis'.tendsto_iff basis,
    suffices : ∀ U ∈ B', ∃ V W, (V ∈ B' ∧ W ∈ B') ∧ ∀ a b, a ∈ V → b ∈ W → a * b ∈ U, by simpa,
    intros U U_in,
    rcases B.mul U_in with ⟨V, V_in, hV⟩,
    use [V, V, V_in, V_in],
    intros a b a_in b_in,
    exact hV ⟨a, b, a_in, b_in, rfl⟩ },
  { intro x₀,
    rw basis.tendsto_iff basis,
    intros U,
    simpa using B.mul_left x₀ },
  { intro x₀,
    rw basis.tendsto_iff basis,
    intros U,
    simpa using B.mul_right x₀ },
end

end ring_filter_basis

/-- A `module_filter_basis` on a module is a `filter_basis` satisfying some additional axioms.
  Example : if `M` is a topological module then the neighbourhoods of zero are a
  `module_filter_basis`. Conversely given a `module_filter_basis` one can define a topology
  compatible with the module structure on `M`.  -/
structure module_filter_basis (R M : Type*) [comm_ring R] [topological_space R]
  [add_comm_group M] [module R M] extends add_group_filter_basis M :=
(smul' : ∀ {U}, U ∈ sets → ∃ (V ∈ 𝓝 (0 : R)) (W ∈ sets), V • W ⊆ U)
(smul_left' : ∀ (x₀ : R) {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (λ x, x₀ • x) ⁻¹' U)
(smul_right' : ∀ (m₀ : M) {U}, U ∈ sets → ∀ᶠ x in 𝓝 (0 : R), x • m₀ ∈ U)

namespace module_filter_basis
variables {R M : Type*} [comm_ring R] [topological_space R]
  [add_comm_group M] [module R M] (B : module_filter_basis R M)

instance group_filter_basis.has_mem : has_mem (set M) (module_filter_basis R M) :=
⟨λ s B, s ∈ B.sets⟩

lemma smul  {U : set M} (hU : U ∈ B) : ∃ (V ∈ 𝓝 (0 : R)) (W ∈ B), V • W ⊆ U :=
B.smul' hU

lemma smul_left (x₀ : R) {U : set M} (hU : U ∈ B) : ∃ V ∈ B, V ⊆ (λ x, x₀ • x) ⁻¹' U :=
B.smul_left' x₀ hU

lemma smul_right (m₀ : M) {U : set M} (hU : U ∈ B) : ∀ᶠ x in 𝓝 (0 : R), x • m₀ ∈ U :=
B.smul_right' m₀ hU

/-- If `R` is discrete then the trivial additive group filter basis on any `R`-module is a
module filter basis. -/
instance [discrete_topology R] : inhabited (module_filter_basis R M) :=
⟨{ smul' := begin
     rintro U (h : U ∈ {{(0 : M)}}),
     rw mem_singleton_iff at h,
     use [univ, univ_mem, {0}, rfl],
     rintros a ⟨x, m, -, hm, rfl⟩,
     simp [mem_singleton_iff.1 hm, h]
   end,
   smul_left' := begin
     rintro x₀ U (h : U ∈ {{(0 : M)}}),
     rw mem_singleton_iff at h,
     use [{0}, rfl],
     simp [h]
   end,
   smul_right' := begin
     rintro m₀ U (h : U ∈ {{(0 : M)}}),
     rw mem_singleton_iff at h,
     simp [h, nhds_discrete]
   end,
   ..(default $ add_group_filter_basis M) }⟩

/-- The topology associated to a module filter basis on a module over a topological ring.
It has the given basis as a basis of neighborhoods of zero. -/
def topology : topological_space M := B.to_add_group_filter_basis.topology

/-- The topology associated to a module filter basis on a module over a topological ring.
It has the given basis as a basis of neighborhoods of zero. This version gets the ring
topology by unification instead of type class inference. -/
def topology' {R M : Type*} [comm_ring R] {tR : topological_space R}
  [add_comm_group M] [module R M] (B : module_filter_basis R M) : topological_space M :=
  B.to_add_group_filter_basis.topology

/-- If a module is endowed with a topological structure coming from
a module filter basis then it's a topological module. -/
@[priority 100]
instance has_continuous_smul [topological_ring R] :
  @has_continuous_smul R M _ _ B.topology  :=
begin
  let B' := B.to_add_group_filter_basis,
  letI := B'.topology,
  have basis := B'.nhds_zero_has_basis,
  haveI := B'.is_topological_add_group,
  apply has_continuous_smul.of_nhds_zero,
  { rw basis.tendsto_right_iff,
    intros U U_in,
    rcases B.smul U_in with ⟨V, V_in, W, W_in, H⟩,
    apply mem_of_superset (prod_mem_prod V_in $ B'.mem_nhds_zero W_in),
    rintros ⟨v, w⟩ ⟨v_in : v ∈ V, w_in : w ∈ W⟩,
    exact H (set.mem_smul_of_mem v_in w_in) },
  { intro m₀,
    rw basis.tendsto_right_iff,
    intros U U_in,
    exact B.smul_right m₀ U_in },
  { intro x₀,
    rw basis.tendsto_right_iff,
    intros U U_in,
    rcases B.smul_left x₀ U_in with ⟨V, V_in, hV⟩,
    exact mem_of_superset (B'.mem_nhds_zero V_in) hV },
end

/-- Build a module filter basis from compatible ring and additive group filter bases. -/
def of_bases {R M : Type*} [comm_ring R]
  [add_comm_group M] [module R M] (BR : ring_filter_basis R) (BM : add_group_filter_basis M)
  (smul : ∀ {U}, U ∈ BM → ∃ (V ∈ BR) (W ∈ BM), V • W ⊆ U)
  (smul_left : ∀ (x₀ : R) {U}, U ∈ BM → ∃ V ∈ BM, V ⊆ (λ x, x₀ • x) ⁻¹' U)
  (smul_right : ∀ (m₀ : M) {U}, U ∈ BM → ∃ V ∈ BR, V ⊆ (λ x, x • m₀) ⁻¹' U) :
  @module_filter_basis R M _ BR.topology _ _ :=
{ smul' := begin
    intros U U_in,
    rcases smul U_in with ⟨V, V_in, W, W_in, H⟩,
    exact ⟨V, BR.to_add_group_filter_basis.mem_nhds_zero V_in, W, W_in, H⟩
  end,
  smul_left' := smul_left,
  smul_right' := begin
    intros m₀ U U_in,
    rcases smul_right m₀ U_in with ⟨V, V_in, H⟩,
    exact mem_of_superset (BR.to_add_group_filter_basis.mem_nhds_zero V_in) H
  end,
  ..BM }

end module_filter_basis


-- Union_con_interseccion_general.lean
-- Unión con intersección general
-- José A. Alonso Jiménez
-- Sevilla, 4 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s)
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variable  {α : Type}
variable  s : set α
variables A : ℕ → set α

-- 1ª demostración
-- ===============

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext x,
  simp only [mem_union, mem_Inter],
  split,
  { intros h i,
    cases h with xs xAi,
    { right,
      exact xs },
    { left,
      exact xAi i, }},
  { intro h,
    by_cases xs : x ∈ s,
    { left,
      exact xs },
    { right,
      intro i,
      cases h i with xAi xs,
      { exact xAi, },
      { contradiction, }}},
end

-- 2ª demostración
-- ===============

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext x,
  simp only [mem_union, mem_Inter],
  split,
  { rintros (xs | xI) i,
    { right,
      exact xs },
    { left,
      exact xI i }},
  { intro h,
    by_cases xs : x ∈ s,
    { left,
      exact xs },
    { right,
      intro i,
      cases h i,
      { assumption },
      { contradiction }}},
end

-- 3ª demostración
-- ===============

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext x,
  simp only [mem_union, mem_Inter],
  split,
  { finish, },
  { finish, },
end

-- 4ª demostración
-- ===============

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext,
  simp only [mem_union, mem_Inter],
  split ; finish,
end

-- 5ª demostración
-- ===============

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext,
  simp only [mem_union, mem_Inter],
  finish [iff_def],
end

-- 6ª demostración
-- ===============

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
by finish [ext_iff, mem_union, mem_Inter, iff_def]