import tactic

namespace hidden

lemma not_not_1 {P : Prop} : ¬ ¬ P → P :=
assume a1 :  ¬ ¬ P,
by_contradiction (
  assume a2 : ¬ P,
  show false, from a1 a2
)

lemma not_not_2 {P : Prop} : P → ¬ ¬ P :=
assume a1 : P,
assume a2 : ¬ P,
show false, from a2 a1

lemma not_not {P : Prop} : ¬ ¬ P ↔ P :=
iff.intro not_not_1 not_not_2

--------------------------------------------------------------------------------

lemma contrapose_1 {P Q : Prop} : (P → Q) → (¬ Q → ¬ P) :=
assume a1 : P → Q,
assume a2: ¬ Q,
by_contradiction (
  assume a3 : ¬ ¬ P,
  have s1 : P := not_not_1 a3,
  have s2 : Q := a1 s1,
  show false, from a2 s2
)

lemma contrapose_2 {P Q : Prop} : (P → ¬ Q) → (Q → ¬ P) :=
assume a1 : P → ¬ Q,
assume a2 : Q,
by_contradiction (
  assume a3 : ¬ ¬ P,
  have s1 : P := not_not_1 a3,
  have s2 : ¬ Q := a1 s1,
  show false, from s2 a2
)

lemma contrapose_3 {P Q : Prop} : (¬ P → Q) → (¬ Q → P) :=
assume a1 : ¬ P → Q,
assume a2 : ¬ Q,
by_contradiction (
  assume a3 : ¬ P,
  have s1 : Q := a1 a3,
  show false, from a2 s1
)

lemma contrapose_4 {P Q : Prop} : (¬ P → ¬ Q) → (Q → P) :=
assume a1 : ¬ P → ¬ Q,
assume a2 : Q,
by_contradiction (
  assume a3 : ¬ P,
  have s1 : ¬ Q := a1 a3,
  show false, from s1 a2
)

--------------------------------------------------------------------------------

lemma dm_1_a {P Q : Prop} : ¬ (P ∧ Q) → (¬ P ∨ ¬ Q) :=
assume a1 : ¬ (P ∧ Q),
by_contradiction (
  assume a2 : ¬ (¬ P ∨ ¬ Q),
  have s1 : P := (
    by_contradiction (
      assume a3 : ¬ P,
      have s2 : ¬ P ∨ ¬ Q := or.intro_left (¬ Q) a3,
      show false, from a2 s2
    )
  ),
  have s3 : Q := (
    by_contradiction (
      assume a4 : ¬ Q,
      have s4 : ¬ P ∨ ¬ Q := or.intro_right (¬ P) a4,
      show false, from a2 s4
    )
  ),
  have s5 : P ∧ Q := and.intro s1 s3,
  show false, from a1 s5
)

lemma dm_1_b {P Q : Prop} : ¬ (P ∧ ¬ Q) → (¬ P ∨ Q) :=
assume a1 : ¬ (P ∧ ¬ Q),
by_contradiction (
  assume a2 : ¬ (¬ P ∨ Q),
  have s1 : P := (
    by_contradiction (
      assume a3 : ¬ P,
      have s2 : ¬ P ∨ Q := or.intro_left Q a3,
      show false, from a2 s2
    )
  ),
  have s3 : ¬ Q := (
    by_contradiction (
      assume a4 : ¬ ¬ Q,
      have s4 : Q := not_not_1 a4,
      have s5 : ¬ P ∨ Q := or.intro_right (¬ P) s4,
      show false, from a2 s5
    )
  ),
  have s6 : P ∧ ¬ Q := and.intro s1 s3,
  show false, from a1 s6
)

lemma dm_1_c {P Q : Prop} : ¬ (¬ P ∧ Q) → (P ∨ ¬ Q) :=
assume a1 : ¬ (¬ P ∧ Q),
by_contradiction (
  assume a2 : ¬ (P ∨ ¬ Q),
  have s1 : ¬ P := (
    by_contradiction (
      assume a3 : ¬ ¬ P,
      have s2 : P := not_not_1 a3,
      have s3 : P ∨ ¬ Q := or.intro_left (¬ Q) s2,
      show false, from a2 s3
    )
  ),
  have s4 : Q := (
    by_contradiction (
      assume a4 : ¬ Q,
      have s5 : P ∨ ¬ Q := or.intro_right P a4,
      show false, from a2 s5
    )
  ),
  have s6 : ¬ P ∧ Q := and.intro s1 s4,
  show false, from a1 s6
)

lemma dm_1_d {P Q : Prop} : ¬ (¬ P ∧ ¬ Q) → (P ∨ Q) :=
assume a1 : ¬ (¬ P ∧ ¬ Q),
by_contradiction (
  assume a2 : ¬ (P ∨ Q),
  have s1 : ¬ P := (
    by_contradiction (
      assume a3 : ¬ ¬ P,
      have s2 : P := not_not_1 a3,
      have s3 : P ∨ Q := or.intro_left Q s2,
      show false, from a2 s3
    )
  ),
  have s4 : ¬ Q := (
    by_contradiction (
      assume a4 : ¬ ¬ Q,
      have s5 : Q := not_not_1 a4,
      have s6 : P ∨ Q := or.intro_right P s5,
      show false, from a2 s6
    )
  ),
  have s7 : ¬ P ∧ ¬ Q := and.intro s1 s4,
  show false, from a1 s7
)

lemma dm_2_a {P Q : Prop} : (¬ P ∨ ¬ Q) → ¬ (P ∧ Q) :=
assume a1 : ¬ P ∨ ¬ Q,
assume a2 : P ∧ Q,
or.elim a1
(
  assume a3 : ¬ P,
  have s1 : P := and.left a2,
  show false, from a3 s1
)
(
  assume a4 : ¬ Q,
  have s2 : Q := and.right a2,
  show false, from a4 s2
)

lemma dm_2_b {P Q : Prop} : (¬ P ∨ Q) → ¬ (P ∧ ¬ Q) :=
assume a1 : ¬ P ∨ Q,
assume a2 : P ∧ ¬ Q,
or.elim a1
(
  assume a3 : ¬ P,
  have s1 : P := and.left a2,
  show false, from a3 s1
)
(
  assume a4 : Q,
  have s2 : ¬ Q := and.right a2,
  show false, from s2 a4
)

lemma dm_2_c {P Q : Prop} : (P ∨ ¬ Q) → ¬ (¬ P ∧ Q) :=
assume a1 : P ∨ ¬ Q,
assume a2 : ¬ P ∧ Q,
or.elim a1
(
  assume a3 : P,
  have s1 : ¬ P := and.left a2,
  show false, from s1 a3
)
(
  assume a4 : ¬ Q,
  have s2 : Q := and.right a2,
  show false, from a4 s2
)

lemma dm_2_d {P Q : Prop} : (P ∨ Q) → ¬ (¬ P ∧ ¬ Q) :=
assume a1 : P ∨ Q,
assume a2 : ¬ P ∧ ¬ Q,
or.elim a1
(
  assume a3 : P,
  have s1 : ¬ P := and.left a2,
  show false, from s1 a3
)
(
  assume a4 : Q,
  have s2 : ¬ Q := and.right a2,
  show false, from s2 a4
)

lemma dm_a {P Q : Prop} : ¬ (P ∧ Q) ↔ (¬ P ∨ ¬ Q) :=
iff.intro dm_1_a dm_2_a

lemma dm_3_a {P Q : Prop} : ¬ (P ∨ Q) → (¬ P ∧ ¬ Q) :=
assume a1 : ¬ (P ∨ Q),
have s1 : ¬ P := (
  by_contradiction (
    assume a2 : ¬ ¬ P,
    have s2 : P := not_not_1 a2,
    have s3 : P ∨ Q := or.intro_left Q s2,
    show false, from a1 s3
  )
),
have s4 : ¬ Q := (
  by_contradiction (
    assume a3 : ¬ ¬ Q,
    have s5 : Q := not_not_1 a3,
    have s6 : P ∨ Q := or.intro_right P s5,
    show false, from a1 s6
  )
),
and.intro s1 s4

lemma dm_3_b {P Q : Prop} : ¬ (P ∨ ¬ Q) → (¬ P ∧ Q) :=
assume a1 : ¬ (P ∨ ¬ Q),
have s1 : ¬ P := (
  by_contradiction (
    assume a2 : ¬ ¬ P,
    have s2 : P := not_not_1 a2,
    have s3 : P ∨ ¬ Q := or.intro_left (¬ Q) s2,
    show false, from a1 s3
  )
),
have s4 : Q := (
  by_contradiction (
    assume a3 : ¬ Q,
    have s5 : P ∨ ¬ Q := or.intro_right P a3,
    show false, from a1 s5
  )
),
and.intro s1 s4

lemma dm_3_c {P Q : Prop} : ¬ (¬ P ∨ Q) → (P ∧ ¬ Q) :=
assume a1 : ¬ (¬ P ∨ Q),
have s1 : P := (
  by_contradiction (
    assume a2 : ¬ P,
    have s2 : ¬ P ∨ Q := or.intro_left Q a2,
    show false, from a1 s2
  )
),
have s3 : ¬ Q := (
  by_contradiction (
    assume a3 : ¬ ¬ Q,
    have s4 : Q := not_not_1 a3,
    have s5 : ¬ P ∨ Q := or.intro_right (¬ P) s4,
    show false, from a1 s5
  )
),
and.intro s1 s3

lemma dm_3_d {P Q : Prop} : ¬ (¬ P ∨ ¬ Q) → (P ∧ Q) :=
assume a1 : ¬ (¬ P ∨ ¬ Q),
have s1 : P := (
  by_contradiction (
    assume a2 : ¬ P,
    have s2 : ¬ P ∨ ¬ Q := or.intro_left (¬ Q) a2,
    show false, from a1 s2
  )
),
have s3 : Q := (
  by_contradiction (
    assume a3 : ¬ Q,
    have s4 : ¬ P ∨ ¬ Q := or.intro_right (¬ P) a3,
    show false, from a1 s4
  )
),
and.intro s1 s3

lemma dm_4_a {P Q : Prop} : (¬ P ∧ ¬ Q) → ¬ (P ∨ Q) :=
assume a1 : ¬ P ∧ ¬ Q,
assume a2 : P ∨ Q,
or.elim a2
(
  assume a3 : P,
  have s1 : ¬ P := and.left a1,
  show false, from s1 a3
)
(
  assume a4 : Q,
  have s2 : ¬ Q := and.right a1,
  show false, from s2 a4
)

lemma dm_4_b {P Q : Prop} : (¬ P ∧ Q) → ¬ (P ∨ ¬ Q) :=
assume a1 : ¬ P ∧ Q,
assume a2 : P ∨ ¬ Q,
or.elim a2
(
  assume a3 : P,
  have s1 : ¬ P := and.left a1,
  show false, from s1 a3
)
(
  assume a4 : ¬ Q,
  have s2 : Q := and.right a1,
  show false, from a4 s2
)

lemma dm_4_c {P Q : Prop} : (P ∧ ¬ Q) → ¬ (¬ P ∨ Q) :=
assume a1 : P ∧ ¬ Q,
assume a2 : ¬ P ∨ Q,
or.elim a2
(
  assume a3 : ¬ P,
  have s1 : P := and.left a1,
  show false, from a3 s1
)
(
  assume a4 : Q,
  have s2 : ¬ Q := and.right a1,
  show false, from s2 a4
)

lemma dm_4_d {P Q : Prop} : (P ∧ Q) → ¬ (¬ P ∨ ¬ Q) :=
assume a1 : P ∧ Q,
assume a2 : ¬ P ∨ ¬ Q,
or.elim a2
(
  assume a3 : ¬ P,
  have s1 : P := and.left a1,
  show false, from a3 s1
)
(
  assume a4 : ¬ Q,
  have s2 : Q := and.right a1,
  show false, from a4 s2
)

lemma dm_b {P Q : Prop} : ¬ (P ∨ Q) ↔ (¬ P ∧ ¬ Q) :=
iff.intro dm_3_a dm_4_a

--------------------------------------------------------------------------------

lemma dm_quant_cp_1 {α : Type} {P : α → Prop} : ¬ (∃ x : α, ¬ P x) → (∀ x : α, P x) :=
assume a1 : ¬ (∃ x : α, ¬ P x),
assume x' : α,
by_contradiction (
  assume a2 : ¬ P x',
  have s1 : ∃ x : α, ¬ P x := exists.intro x' a2,
  show false, from a1 s1
)

lemma dm_quant_1 {α : Type} {P : α → Prop} : ¬ (∀ x : α, P x) → (∃ x : α, ¬ P x) :=
contrapose_3 dm_quant_cp_1

lemma dm_quant_2 {α : Type} {P : α → Prop} : (∃ x : α, ¬ P x) → ¬ (∀ x : α, P x) :=
assume a1 : ∃ x : α, ¬ P x,
exists.elim a1 (
  assume x' : α,
  assume a2 : ¬ P x',
  assume a3 : ∀ x : α, P x,
  have s1 : P x' := a3 x',
  show false, from a2 s1
)

lemma dm_quant_a {α : Type} {P : α → Prop} : ¬ (∀ x : α, P x) ↔ (∃ x : α, ¬ P x) :=
iff.intro dm_quant_1 dm_quant_2

lemma dm_quant_3 {α : Type} {P : α → Prop} : ¬ (∃ x : α, P x) → (∀ x : α, ¬ P x) :=
assume a1 : ¬ (∃ x : α, P x),
assume x' : α,
by_contradiction (
  assume a2 : ¬ ¬ P x',
  have s1 : P x' := not_not_1 a2,
  have s2 : ∃ x : α, P x := exists.intro x' s1,
  show false, from a1 s2
)

lemma dm_quant_4 {α : Type} {P : α → Prop} : (∀ x : α, ¬ P x) → ¬ (∃ x : α, P x) :=
assume a1 : ∀ x : α, ¬ P x,
assume a2 : ∃ x : α, P x,
exists.elim a2 (
  assume x' : α,
  assume a3 : P x',
  have s1 : ¬ P x' := a1 x',
  show false, from s1 a3
)

lemma dm_quant_b {α : Type} {P : α → Prop} : ¬ (∃ x : α, P x) ↔ (∀ x : α, ¬ P x) :=
iff.intro dm_quant_3 dm_quant_4

--------------------------------------------------------------------------------

lemma dm_quant_set_cp_1 {α : Type} {S : set α} {P : α → Prop} : ¬ (∃ x ∈ S, ¬ P x) → (∀ x ∈ S, P x) :=
assume a1 : ¬ (∃ x ∈ S, ¬ P x),
assume x' : α,
assume a2 : x' ∈ S,
by_contradiction (
  assume a3 : ¬ P x',
  have s1 : ∃ x ∈ S, ¬ P x := exists.intro x' (exists.intro a2 a3),
  show false, from a1 s1
)

lemma dm_quant_set_1 {α : Type} {S : set α} {P : α → Prop} : ¬ (∀ x ∈ S, P x) → (∃ x ∈ S, ¬ P x) :=
contrapose_3 dm_quant_set_cp_1

lemma dm_quant_set_2 {α : Type} {S : set α} {P : α → Prop} : (∃ x ∈ S, ¬ P x) → ¬ (∀ x ∈ S, P x) :=
assume a1 : ∃ x ∈ S, ¬ P x,
exists.elim a1 (
  assume x' : α,
  assume a2 : ∃ (H : x' ∈ S), ¬ P x',
  exists.elim a2 (
    assume H0 : x' ∈ S,
    assume a3 : ¬ P x',
    assume a4 : ∀ x ∈ S, P x,
    have s1 : P x' := a4 x' H0,
    show false, from a3 s1
  )
)

lemma dm_quant_set_a {α : Type} {S : set α} {P : α → Prop} : ¬ (∀ x ∈ S, P x) ↔ (∃ x ∈ S, ¬ P x) :=
iff.intro dm_quant_set_1 dm_quant_set_2

lemma dm_quant_set_3 {α : Type} {S : set α} {P : α → Prop} : ¬ (∃ x ∈ S, P x) → (∀ x ∈ S, ¬ P x) :=
assume a1 : ¬ (∃ x ∈ S, P x),
assume x' : α,
assume a2 : x' ∈ S,
by_contradiction (
  assume a3 : ¬ ¬ P x',
  have s1 : P x' := not_not_1 a3,
  have s2 : ∃ x ∈ S, P x := exists.intro x' (exists.intro a2 s1),
  show false, from a1 s2
)

lemma dm_quant_set_4 {α : Type} {S : set α} {P : α → Prop} : (∀ x ∈ S, ¬ P x) → ¬ (∃ x ∈ S, P x) :=
assume a1 : ∀ x ∈ S, ¬ P x,
assume a2 : ∃ x ∈ S, P x,
exists.elim a2 (
  assume x' : α,
  assume a3 : ∃ (H : x' ∈ S), P x',
  exists.elim a3 (
    assume H0 : x' ∈ S,
    assume a4 : P x',
    have s1 : ¬ P x' := a1 x' H0,
    show false, from s1 a4
  )
)

lemma dm_quant_set_b {α : Type} {S : set α} {P : α → Prop} : ¬ (∃ x ∈ S, P x) ↔ (∀ x ∈ S, ¬ P x) :=
iff.intro dm_quant_set_3 dm_quant_set_4

--------------------------------------------------------------------------------

example {α : Type} {P Q : α → Prop} (h : ∀ x : α, P x → Q x) : (∀ x : α, P x) → (∀ x : α, Q x) :=
assume a1 : ∀ x : α, P x,
assume x' : α,
have s1 : P x' := a1 x',
have s2 : P x' → Q x' := h x',
s2 s1

example {α : Type} {S : set α} {P Q : α → Prop} (h : ∀ x ∈ S, P x → Q x) : (∀ x ∈ S, P x) → (∀ x ∈ S, Q x) :=
assume a1 : ∀ x ∈ S, P x,
assume x' : α,
assume a2 : x' ∈ S,
have s1 : P x' := a1 x' a2,
have s2 : P x' → Q x' := h x' a2,
s2 s1

example {α : Type} {P Q : α → Prop} (h : ∀ x : α, P x → Q x) : (∃ x : α, P x) → (∃ x : α, Q x) :=
assume a1 : ∃ x : α, P x,
exists.elim a1 (
  assume x' : α,
  assume a2 : P x',
  have s1 : P x' → Q x' := h x',
  have s2 : Q x' := s1 a2,
  exists.intro x' s2
)

example {α : Type} {S : set α} {P Q : α → Prop} (h : ∀ x ∈ S, P x → Q x) : (∃ x ∈ S, P x) → (∃ x ∈ S, Q x) :=
assume a1 : ∃ x ∈ S, P x,
exists.elim a1 (
  assume x' : α,
  assume a2 : ∃ (H : x' ∈ S), P x',
  exists.elim a2 (
    assume H0 : x' ∈ S,
    assume a3 : P x',
    have s1 : P x' → Q x' := h x' H0,
    have s2 : Q x' := s1 a3,
    exists.intro x' (exists.intro H0 s2)
  )
)

--------------------------------------------------------------------------------

lemma or_comm {P Q : Prop} : (P ∨ Q) → (Q ∨ P) :=
assume a1 : P ∨ Q,
or.elim a1
(
  assume a2 : P,
  or.intro_right Q a2
)
(
  assume a3 : Q,
  or.intro_left P a3
)

lemma or_implies_1 {P Q : Prop} : (P ∨ Q) → ¬ P → Q :=
assume a1 : P ∨ Q,
assume a2 : ¬ P,
or.elim a1
(
  assume a3 : P,
  false.elim (a2 a3)
)
(
  assume a4 : Q,
  a4
)

lemma or_implies_2 {P Q : Prop} : (P ∨ ¬ Q) → ¬ P → ¬ Q :=
assume a1 : P ∨ ¬ Q,
assume a2 : ¬ P,
or.elim a1
(
  assume a3 : P,
  false.elim (a2 a3)
)
(
  assume a4 : ¬ Q,
  a4
)

lemma or_implies_3 {P Q : Prop} : (¬ P ∨ Q) → P → Q :=
assume a1 : ¬ P ∨ Q,
assume a2 : P,
or.elim a1
(
  assume a3 : ¬ P,
  false.elim (a3 a2)
)
(
  assume a4 : Q,
  a4
)

lemma or_implies_4 {P Q : Prop} : (¬ P ∨ ¬ Q) → P → ¬ Q :=
assume a1 : ¬ P ∨ ¬ Q,
assume a2 : P,
or.elim a1
(
  assume a3 : ¬ P,
  false.elim (a3 a2)
)
(
  assume a4 : ¬ Q,
  a4
)

--------------------------------------------------------------------------------

lemma not_and_implies_1 {P Q : Prop} : ¬ (P ∧ Q) → P → ¬ Q :=
assume a1 : ¬ (P ∧ Q),
or_implies_4 (dm_1_a a1)

lemma not_and_implies_2 {P Q : Prop} : ¬ (P ∧ Q) → Q → ¬ P :=
assume a1 : ¬ (P ∧ Q),
or_implies_4 (or_comm (dm_1_a a1))

lemma not_and_implies_3 {P Q : Prop} : ¬ (P ∧ ¬ Q) → P → Q :=
assume a1 : ¬ (P ∧ ¬ Q),
or_implies_3 (dm_1_b a1)

lemma not_and_implies_4 {P Q : Prop} : ¬ (P ∧ ¬ Q) → ¬ Q → ¬ P :=
assume a1 : ¬ (P ∧ ¬ Q),
or_implies_2 (or_comm (dm_1_b a1))

lemma not_and_implies_5 {P Q : Prop} : ¬ (¬ P ∧ Q) → ¬ P → ¬ Q :=
assume a1 : ¬ (¬ P ∧ Q),
or_implies_2 (dm_1_c a1)

lemma not_and_implies_6 {P Q : Prop} : ¬ (¬ P ∧ Q) → Q → P :=
assume a1 : ¬ (¬ P ∧ Q),
or_implies_3 (or_comm (dm_1_c a1))

lemma not_and_implies_7 {P Q : Prop} : ¬ (¬ P ∧ ¬ Q) → ¬ P → Q :=
assume a1 : ¬ (¬ P ∧ ¬ Q),
or_implies_1 (dm_1_d a1)

lemma not_and_implies_8 {P Q : Prop} : ¬ (¬ P ∧ ¬ Q) → ¬ Q → P :=
assume a1 : ¬ (¬ P ∧ ¬ Q),
or_implies_1 (or_comm (dm_1_d a1))

--------------------------------------------------------------------------------

def set (α : Type) := α → Prop

-- a is an element of the set s.
def mem {α : Type} (a : α) (s : set α) : Prop := s a

notation x `∈` S := mem x S
notation x `∉` S := ¬ mem x S

-- The set containing only a.
def singleton {α : Type} (a : α) : set α := fun x, x = a

notation `{` x `}` := singleton x

example {α : Type} {a b : α} : mem a (singleton b) = (a = b) := by refl

-- The union of the sets s and t.
def union {α : Type} (s t : set α) : set α :=
fun x, (mem x s) ∨ (mem x t)

notation s `∪`  t := union s t

example {α : Type} {s t : set α} {x : α} : mem x (union s t) = ((mem x s) ∨ (mem x t)) := by refl

-- The intersection of the sets s and t.
def inter {α : Type} (s t : set α) : set α :=
fun x, (mem x s) ∧ (mem x t)

notation s `∩` t := inter s t

example {α : Type} {s t : set α} {x : α} : mem x (inter s t) = ((mem x s) ∧ (mem x t)) := by refl

-- The difference of the sets s and t.
def diff {α : Type} (s t : set α) : set α :=
fun x, (mem x s) ∧ ¬ (mem x t)

notation s `\` t := diff s t

example {α : Type} {s t : set α} {x : α} : mem x (diff s t) = ((mem x s) ∧ ¬ (mem x t)) := by refl

-- The complement of the set s.
def compl {α : Type} (s : set α) : set α :=
fun x, ¬ mem x s

example {α : Type} {s t : set α} {x : α} : mem x (compl s) = ¬ mem x s := by refl

--------------------------------------------------------------------------------

def var := ℕ

inductive pre_term : Type
| var : var → pre_term
| app : pre_term → pre_term → pre_term
| abs : var → pre_term → pre_term

notation `λ` y `.` P := pre_term.abs y P

def FV : pre_term → set var
| (pre_term.var x) := {x}
| (pre_term.app P Q) := (FV P) ∪ (FV Q)
| (pre_term.abs x P) := (FV P) \ {x}

-- sub_is_def M x N means M [ x := N ] is defined
inductive sub_is_def : pre_term → var → pre_term → Prop

-- y [ x := N ] is defined
| var (y : var) (x : var) (N : pre_term) :
  sub_is_def (pre_term.var y) x N

-- P [ x := N ] is defined → Q [ x := N ] is defined → (P Q) [ x := N ] is defined
| app (P : pre_term) (Q : pre_term) (x : var) (N : pre_term) :
  sub_is_def P x N → sub_is_def Q x N → sub_is_def (pre_term.app P Q) x N

-- x = y → ( λ y . P ) [ x := N ] is defined
| abs_same (y : var) (P : pre_term) (x : var) (N : pre_term) :
  x = y → sub_is_def (pre_term.abs y P) x N

-- x ≠ y → x ∉ FV ( λ y . P ) → ( λ y . P ) [ x := N ] is defined
| abs_diff_nel (y : var) (P : pre_term) (x : var) (N : pre_term) :
  x ≠ y → x ∉ FV (pre_term.abs y P) → sub_is_def (pre_term.abs y P) x N

-- x ≠ y → y ∉ FV ( N ) → P [ x := N ] is defined → ( λ y . P ) [ x := N ] is defined
| abs_diff (y : var) (P : pre_term) (x : var) (N : pre_term) :
  x ≠ y → y ∉ FV N → sub_is_def P x N → sub_is_def (pre_term.abs y P) x N

notation M `[` x `:=` N `]` `is_def` := sub_is_def M x N

-- M [ x := N ]
def sub : pre_term → var → pre_term → pre_term
-- if x = y then y [ x := N ] = N else y [ x := N ] = y
| (pre_term.var y) x N := if (x = y) then N else (pre_term.var y)

-- (P Q) [ x := N ] = (P [ x := N ] Q [ x := N ])
| (pre_term.app P Q) x N := pre_term.app (sub P x N) (sub Q x N)

-- if x = y then ( λ y . P ) [ x := N ] = ( λ y . P ) else ( λ y . P ) [ x := N ] = ( λ y . P [ x := N ] )
| (pre_term.abs y P) x N := if x = y then (pre_term.abs y P) else (pre_term.abs y (sub P x N))

notation M `[` x `:=` N `]` := sub M x N

lemma lemma_1_2_5_i_a (M : pre_term) (x : var) (N : pre_term) : x ∉ FV M → M [ x := N ] is_def :=
begin
assume a1 : x ∉ FV M,
induction M,
case pre_term.var : y
{
  -- M = pre_term.var y
  show (pre_term.var y) [ x := N ] is_def, by exact sub_is_def.var y x N
},
case pre_term.app : P Q IH_1 IH_2
{
  -- M = pre_term.app P Q
  have s1 : x ∉ FV (pre_term.app P Q), by exact a1,
  have s2 : x ∉ FV P → P [ x := N ] is_def, by exact IH_1,
  have s3 : x ∉ FV Q → Q [ x := N ] is_def, by exact IH_2,
  have s4 : (x ∉ FV P) ∧ (x ∉ FV Q), by exact dm_3_a s1,
  have s5 : P [ x := N ] is_def, by exact s2 (and.left s4),
  have s6 : Q [ x := N ] is_def, by exact s3 (and.right s4),
  show (pre_term.app P Q) [ x := N ] is_def, by exact sub_is_def.app P Q x N s5 s6
},
case pre_term.abs : y P
{
  -- M = pre_term.abs y P
  by_cases x = y,
  {
    have s7: x = y, by exact h,
    show (pre_term.abs y P) [ x := N ] is_def, by exact (sub_is_def.abs_same y P x N) s7
  },
  {
    have s8 : x ≠ y, by exact h,
    have s9 : x ∉ FV (pre_term.abs y P), by exact a1,
    show (pre_term.abs y P) [ x := N ] is_def, by exact (sub_is_def.abs_diff_nel y P x N) s8 s9
  }
}
end

lemma lemma_1_2_5_i_b (M : pre_term) (x : var) (N : pre_term) : x ∉ FV M → M [ x := N ] = M :=
begin
assume a1 : x ∉ FV M,
induction M,
case pre_term.var : y
{
  -- M = pre_term.var y
  have s1 : x ≠ y, by exact a1,
  show (pre_term.var y) [ x := N ] = (pre_term.var y), by exact if_neg s1
},
case pre_term.app : P Q IH_1 IH_2
{
  -- M = pre_term.app P Q
  have s2 : x ∉ FV (pre_term.app P Q), by exact a1,
  have s3 : x ∉ FV P → P [ x := N ] = P, by exact IH_1,
  have s4 : x ∉ FV Q → Q [ x := N ] = Q, by exact IH_2,
  have s5 : (x ∉ FV P) ∧ (x ∉ FV Q), by exact dm_3_a s2,
  have s6 : P [ x := N ] = P, by exact s3 (and.left s5),
  have s7 : Q [ x := N ] = Q, by exact s4 (and.right s5),
  have s8 : (pre_term.app P Q) [ x := N ] = pre_term.app (P [ x := N ]) (Q [ x := N ]), by refl,
  have s9 : pre_term.app (P [ x := N ]) (Q [ x := N ]) = pre_term.app P (Q [ x := N ]), by rw s6,
  have s10 : pre_term.app P (Q [ x := N ]) = pre_term.app P Q, by rw s7,
  show (pre_term.app P Q) [ x := N ] = pre_term.app P Q, by exact eq.trans (eq.trans s8 s9) s10
},
case pre_term.abs : y P IH
{
  -- M = pre_term.abs y P
  by_cases (x = y),
  {
    have s11 : x = y, by exact h,
    show (pre_term.abs y P) [ x := N ] = pre_term.abs y P, by exact if_pos s11
  },
  {
    have s12 : x ≠ y, by exact h,
    have s13 : x ∉ FV (pre_term.abs y P), by exact a1,
    have s14 : x ∉ FV P → P [ x := N ] = P, by exact IH,
    have s15 : x ∉ FV P, by exact not_and_implies_4 s13 s12,
    have s16 : P [ x := N ] = P, by exact s14 s15,
    have s17 : (pre_term.abs y P) [ x := N ] = pre_term.abs y (P [ x := N ]), by exact if_neg s12,
    have s18 : pre_term.abs y (P [ x := N ]) = pre_term.abs y P, by rw s16,
    show (pre_term.abs y P) [ x := N ] = pre_term.abs y P, by exact eq.trans s17 s18
  }
}
end

--------------------------------------------------------------------------------

class total_order (T : Type*) :=
(le : T → T → Prop)
(le_asymm : ∀ {x y : T}, le x y → le y x → x = y)
(le_trans : ∀ {x y z : T}, le x y → le y z → le x z)
(le_conn : ∀ {x y : T}, le x y ∨ le y x)

open total_order

-- x < y
def lt {T : Type*} [total_order T] (x y : T) : Prop := le x y ∧ ¬ x = y

-- x ≥ y
def ge {T : Type*} [total_order T] (x y : T) : Prop := le y x

-- x > y
def gt {T : Type*} [total_order T] (x y : T) : Prop := ge x y ∧ ¬ x = y

lemma ne_symm {α : Type*} {x y : α} : ¬ x = y → ¬ y = x :=
assume a1 : ¬ x = y,
assume a2 : y = x,
have s1 : x = y := eq.symm a2,
show false, from a1 s1

lemma lt_to_gt {T : Type*} [total_order T] {x y : T} : lt x y → gt y x :=
assume a1 : lt x y,
have s1 : le x y := and.left a1,
have s2 : ge y x := s1,
have s3 : ¬ x = y := and.right a1,
have s4 : ¬ y = x := ne_symm s3,
and.intro s1 s4

lemma gt_to_lt {T : Type*} [total_order T] {x y : T} : gt x y → lt y x :=
assume a1 : gt x y,
have s1 : ge x y := and.left a1,
have s2 : le y x := s1,
have s3 : ¬ x = y := and.right a1,
have s4 : ¬ y = x := ne_symm s3,
and.intro s1 s4

lemma ge_asymm {T : Type*} [total_order T] {x y : T} : ge x y → ge y x → x = y :=
assume a1 : ge x y,
assume a2 : ge y x,
have s1 : le y x := a1,
have s2 : le x y := a2,
le_asymm s2 s1

lemma ge_trans {T : Type*} [total_order T] {x y z : T} : ge x y → ge y z → ge x z :=
assume a1 : ge x y,
assume a2 : ge y z,
have s1 : le y x := a1,
have s2 : le z y := a2,
le_trans s2 s1

lemma ge_conn {T : Type*} [total_order T] {x y : T} : ge x y ∨ ge y x :=
have s1 : le x y ∨ le y x := le_conn,
or.elim s1
(
  assume a1 : le x y,
  have s2 : ge y x := a1,
  or.intro_right (ge x y) s2
)
(
  assume a2 : le y x,
  have s3 : ge x y := a2,
  or.intro_left (ge y x) s3
)

lemma le_refl {T : Type*} [total_order T] {x : T} : le x x :=
have s1 : le x x ∨ le x x := le_conn,
or.elim s1
(
  assume a1 : le x x,
  a1
)
(
  assume a2 : le x x,
  a2
)

lemma ge_refl {T : Type*} [total_order T] {x : T} : ge x x :=
have s1 : ge x x ∨ ge x x := ge_conn,
or.elim s1
(
  assume a1 : ge x x,
  a1
)
(
  assume a2 : ge x x,
  a2
)

lemma not_lt_refl {T : Type*} [total_order T] {x : T} : ¬ lt x x :=
assume a1 : lt x x,
have s1 : ¬ x = x := and.right a1,
have s2 : x = x := eq.refl x,
show false, from s1 s2

lemma not_gt_refl {T : Type*} [total_order T] {x : T} : ¬ gt x x :=
assume a1 : gt x x,
have s1 : ¬ x = x := and.right a1,
have s2 : x = x := eq.refl x,
show false, from s1 s2

lemma le_lt_trans {T : Type*} [total_order T] {x y z : T} : le x y → lt y z → lt x z :=
assume a1 : le x y,
assume a2 : lt y z,
have s1 : le y z := and.left a2,
have s2 : ¬ y = z := and.right a2,
have s3 : le x z := le_trans a1 s1,
have s4 : ¬ x = z :=
by_contradiction (
  assume a3: ¬ ¬ x = z,
  have s5 : x = z := not_not_1 a3,
  have s6 : le z y := eq.subst s5 a1,
  have s7 : y = z := le_asymm s1 s6,
  show false, from s2 s7
),
and.intro s3 s4

lemma lt_le_trans {T : Type*} [total_order T] {x y z : T} : lt x y → le y z → lt x z :=
assume a1 : lt x y,
assume a2 : le y z,
have s1 : le x y := and.left a1,
have s2 : ¬ x = y := and.right a1,
have s3 : le x z := le_trans s1 a2,
have s4 : ¬ x = z :=
by_contradiction (
  assume a3 : ¬ ¬ x = z,
  have s5 : x = z := not_not_1 a3,
  have s6 : le y x := eq.subst (eq.symm s5) a2,
  have s7 : x = y := le_asymm s1 s6,
  show false, from s2 s7
),
and.intro s3 s4

lemma lt_lt_trans {T : Type*} [total_order T] {x y z : T} : lt x y → lt y z → lt x z :=
assume a1 : lt x y,
assume a2 : lt y z,
have s1 : le x y := and.left a1,
le_lt_trans s1 a2

lemma ge_gt_trans {T : Type*} [total_order T] {x y z : T} : ge x y → gt y z → gt x z :=
assume a1 : ge x y,
assume a2 : gt y z,
have s1 : ge y z := and.left a2,
have s2 : ¬ y = z := and.right a2,
have s3 : ge x z := ge_trans a1 s1,
have s4 : ¬ x = z :=
by_contradiction (
  assume a3: ¬ ¬ x = z,
  have s5 : x = z := not_not_1 a3,
  have s6 : ge z y := eq.subst s5 a1,
  have s7 : y = z := ge_asymm s1 s6,
  show false, from s2 s7
),
and.intro s3 s4

lemma gt_ge_trans {T : Type*} [total_order T] {x y z : T} : gt x y → ge y z → gt x z :=
assume a1 : gt x y,
assume a2 : ge y z,
have s1 : ge x y := and.left a1,
have s2 : ¬ x = y := and.right a1,
have s3 : ge x z := ge_trans s1 a2,
have s4 : ¬ x = z :=
by_contradiction (
  assume a3 : ¬ ¬ x = z,
  have s5 : x = z := not_not_1 a3,
  have s6 : ge y x := eq.subst (eq.symm s5) a2,
  have s7 : x = y := ge_asymm s1 s6,
  show false, from s2 s7
),
and.intro s3 s4

lemma gt_gt_trans {T : Type*} [total_order T] {x y z : T} : gt x y → gt y z → gt x z :=
assume a1 : gt x y,
assume a2 : gt y z,
have s1 : ge x y := and.left a1,
ge_gt_trans s1 a2

lemma le_to_or {T : Type*} [total_order T] {x y : T} : le x y → (lt x y ∨ x = y) :=
assume a1 : le x y,
by_contradiction (
  assume a2 : ¬ (lt x y ∨ x = y),
  have s1 : ¬ lt x y ∧ ¬ x = y := dm_3_a a2,
  have s2 : ¬ (le x y ∧ ¬ x = y) := and.left s1,
  have s3 : ¬ x = y := and.right s1,
  have s4 : ¬ le x y ∨ x = y := dm_1_b s2,
  or.elim s4
  (
    assume a3 : ¬ le x y,
    show false, from a3 a1
  )
  (
    assume a4 : x = y,
    show false, from s3 a4
  )
)

lemma or_to_le {T : Type*} [total_order T] {x y : T} : (lt x y ∨ x = y) → le x y :=
assume a1 : lt x y ∨ x = y,
or.elim a1
(
  assume a2 : lt x y,
  have s1 : le x y ∧ ¬ x = y := a2,
  and.left s1
)
(
  assume a3 : x = y,
  have s2 : le x x := le_refl,
  eq.subst a3 s2
)

lemma ge_to_or {T : Type*} [total_order T] {x y : T} : ge x y → (gt x y ∨ x = y) :=
assume a1 : ge x y,
by_contradiction (
  assume a2 : ¬ (gt x y ∨ x = y),
  have s1 : ¬ gt x y ∧ ¬ x = y := dm_3_a a2,
  have s2 : ¬ (ge x y ∧ ¬ x = y) := and.left s1,
  have s3 : ¬ x = y := and.right s1,
  have s4 : ¬ ge x y ∨ x = y := dm_1_b s2,
  or.elim s4
  (
    assume a3 : ¬ ge x y,
    show false, from a3 a1
  )
  (
    assume a4 : x = y,
    show false, from s3 a4
  )
)

lemma or_to_ge {T : Type*} [total_order T] {x y : T} : (gt x y ∨ x = y) → ge x y :=
assume a1 : gt x y ∨ x = y,
or.elim a1
(
  assume a2 : gt x y,
  have s1 : ge x y ∧ ¬ x = y := a2,
  and.left s1
)
(
  assume a3 : x = y,
  have s2 : ge x x := ge_refl,
  eq.subst a3 s2
)

example {T : Type*} [total_order T] {x y : T} : lt x y → ¬ ge x y :=
assume a1 : lt x y,
assume a2 : ge x y,
have s1 : le x y := and.left a1,
have s2 : ¬ x = y := and.right a1,
have s3 : le y x := a2,
have s4 : x = y := le_asymm s1 s3,
show false, from s2 s4

example {T : Type*} [total_order T] {x y : T} : ¬ ge x y → ¬ x = y :=
assume a1 : ¬ ge x y,
assume a2 : x = y,
have s1 : ge x x := ge_refl,
have s2 : ge x y := eq.subst a2 s1,
show false, from a1 s2

example {T : Type*} [total_order T] {x y : T} : ¬ ge x y → le x y :=
assume a1 : ¬ ge x y,
have s1 : ¬ le y x := a1,
have s2 : le x y ∨ le y x := le_conn,
or.elim s2
(
  assume a2 : le x y,
  a2
)
(
  assume a3 : le y x,
  false.elim (s1 a3)
)

example {T : Type*} [total_order T] {x y : T} : gt x y → ¬ le x y :=
assume a1 : gt x y,
assume a2 : le x y,
have s1 : ge x y := and.left a1,
have s2 : ¬ x = y := and.right a1,
have s3 : ge y x := a2,
have s4 : x = y := ge_asymm s1 s3,
show false, from s2 s4

example {T : Type*} [total_order T] {x y : T} : ¬ le x y → ¬ x = y :=
assume a1 : ¬ le x y,
assume a2 : x = y,
have s1 : le x x := le_refl,
have s2 : le x y := eq.subst a2 s1,
show false, from a1 s2

example {T : Type*} [total_order T] {x y : T} : ¬ le x y → ge x y :=
assume a1 : ¬ le x y,
have s1 : ¬ ge y x := a1,
have s2 : ge x y ∨ ge y x := ge_conn,
or.elim s2
(
  assume a2 : ge x y,
  a2
)
(
  assume a3 : ge y x,
  false.elim (s1 a3)
)

--------------------------------------------------------------------------------

class field (F : Type) extends has_add F, has_neg F, has_zero F, has_mul F, has_inv F, has_one F :=
(add_assoc : ∀ x y z : F, x + (y + z) = (x + y) + z)
(add_comm : ∀ x y : F, x + y = y + x)
(add_neg_left : ∀ x : F, -x + x = 0)
(add_zero_left : ∀ x : F, 0 + x = x)
(mul_assoc : ∀ x y z : F, x * (y * z) = (x * y) * z)
(mul_comm : ∀ x y : F, x * y = y * x)
(mul_inv_left : ∀ x : F, ¬ x = 0 → x⁻¹ * x = 1)
(mul_one_left : ∀ x : F, 1 * x = x)
(dist_left : ∀ x y z : F, x * (y + z) = (x * y) + (x * z))
(zero_inv : (0 : F)⁻¹ = 0)

open hidden.field

lemma add_idempotent {F : Type} [field F] : ∀ x : F, x + x = x → x = 0 :=
assume x : F,
assume a1 : x + x = x,
calc
x   = 0 + x        : eq.symm (add_zero_left x)
... = (-x + x) + x : by rw (add_neg_left x)
... = -x + (x + x) : eq.symm (add_assoc (-x) x x)
... = -x + x       : by rw a1
... = 0            : add_neg_left x

lemma add_neg_right {F : Type} [field F] : ∀ x : F, x + -x = 0 :=
assume x : F,
have s1 : (x + -x) + (x + -x) = x + -x := (
calc
(x + -x) + (x + -x) = x + (-x + (x + -x)) : eq.symm (add_assoc x (-x) (x + -x))
                ... = x + ((-x + x) + -x) : by rw (add_assoc (-x) x (-x))
                ... = x + (0 + -x)        : by rw (add_neg_left x)
                ... = x + -x              : by rw (add_zero_left (-x))
),
add_idempotent (x + -x) s1

lemma add_zero_right {F : Type} [field F] : ∀ x : F, x + 0 = x :=
assume x : F,
calc
x + 0 = x + (-x + x) : by rw (add_neg_left x)
  ... = (x + -x) + x : add_assoc x (-x) x
  ... = 0 + x        : by rw add_neg_right
  ... = x            : add_zero_left x

example (F : Type) [field F] (neg' : F → F) (add_neg_left' : ∀ x : F, (neg' x) + x = 0) : ∀ x : F, neg' x = -x :=
assume x : F,
calc
neg' x = neg' x + 0        : eq.symm (add_zero_right (neg' x))
   ... = neg' x + (x + -x) : by rw (add_neg_right x)
   ... = (neg' x + x) + -x : add_assoc (neg' x) x (-x)
   ... = 0 + -x            : by rw (add_neg_left' x)
   ... = -x                : add_zero_left (-x)

example (F : Type) [field F] (zero' : F) (add_zero_left' : ∀ x : F, zero' + x = x) : zero' = 0 :=
have s1 : zero' + zero' = zero' := add_zero_left' zero',
add_idempotent zero' s1

lemma add_left_cancel {F : Type} [field F] : ∀ x y z : F, x + y = x + z → y = z :=
assume x y z : F,
assume a1 : x + y = x + z,
calc
y   = 0 + y        : eq.symm (add_zero_left y)
... = (-x + x) + y : by rw (add_neg_left x)
... = -x + (x + y) : eq.symm (add_assoc (-x) x y)
... = -x + (x + z) : by rw a1
... = (-x + x) + z : add_assoc (-x) x z
... = 0 + z        : by rw (add_neg_left x)
... = z            : add_zero_left z

lemma add_right_cancel {F : Type} [field F] : ∀ x y z : F, y + x = z + x → y = z :=
assume x y z : F,
assume a1 : y + x = z + x,
calc
y   = y + 0        : eq.symm (add_zero_right y)
... = y + (x + -x) : by rw (add_neg_right x)
... = (y + x) + -x : add_assoc y x (-x)
... = (z + x) + -x : by rw a1
... = z + (x + -x) : eq.symm (add_assoc z x (-x))
... = z + 0        : by rw (add_neg_right x)
... = z            : add_zero_right z

lemma add_1 {F : Type} [field F] : ∀ x y : F, x + y = x → y = 0 :=
assume x y : F,
assume a1 : x + y = x,
have s1 : x = x + 0 := eq.symm (add_zero_right x),
have s2 : x + y = x + 0 := eq.trans a1 s1,
add_left_cancel x y 0 s2

lemma add_2 {F : Type} [field F] : ∀ x y : F, x + y = 0 → y = -x :=
assume x y : F,
assume a1 : x + y = 0,
have s1 : 0 = x + -x := eq.symm (add_neg_right x),
have s2 : x + y = x + -x := eq.trans a1 s1,
add_left_cancel x y (-x) s2

lemma neg_neg {F : Type} [field F] : ∀ x : F, x = -(-x) :=
assume x : F,
have s1 : -x + x = 0 := add_neg_left x,
add_2 (-x) x s1

lemma mul_idempotent {F : Type} [field F] : ∀ x : F, ¬ x = 0 → x * x = x → x = 1 :=
assume x : F,
assume a1 : ¬ x = 0,
assume a2 : x * x = x,
calc
x   = 1 * x         : eq.symm (mul_one_left x)
... = (x⁻¹ * x) * x : by rw (mul_inv_left x a1)
... = x⁻¹ * (x * x) : eq.symm (mul_assoc x⁻¹ x x)
... = x⁻¹ * x       : by rw a2
... = 1             : mul_inv_left x a1

lemma mul_zero_right {F : Type} [field F] : ∀ x : F, x * 0 = 0 :=
assume x : F,
calc
x * 0 = 0 + (x * 0)                    : eq.symm (add_zero_left (x * 0))
  ... = (-(x * 0) + (x * 0)) + (x * 0) : by rw (add_neg_left (x * 0))
  ... = -(x * 0) + ((x * 0) + (x * 0)) : eq.symm (add_assoc (-(x * 0)) (x * 0) (x * 0))
  ... = -(x * 0) + (x * (0 + 0))       : by rw (dist_left x 0 0)
  ... = -(x * 0) + (x * 0)             : by rw (add_zero_left (0 : F))
  ... = 0                              : add_neg_left (x * 0)

end hidden


import tactic
import data.nat.prime
-- the next two lines let us use the by_cases tactic without trouble
-- noncomputable theory
-- open_locale classical

-- 2.1.2. Proofs as functions

-- Every time you successfully construct a proof of a theorem say
theorem tautology (P : Prop) : P → P :=
begin
  intro hp,
  exact hp,
end

-- Lean constructs a proof term tautology : ∀ P : Prop, P → P (you can see this by typing #check tautology).
#check tautology

-- Once constructed, any term can be used in a later proof. For example,
example (P Q : Prop) : (P → Q) → (P → Q) :=
begin
  exact tautology (P → Q),
end

-- This is how Lean simulates mathematics.
-- Every time you prove a theorem using tactics a proof term gets created.
-- Because of proof irrelevance, Lean forgets the exact content of the proof and only remembers its type.
-- All the proof terms can then be used in later proofs.
-- All of this falls under the giant umbrella of the Curry–Howard correspondence.

-- 2.2 And / Or

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

``cases``

  ``cases`` is a general tactic that breaks up complicated terms.
  If ``hpq`` is a term of type ``P ∧ Q`` or ``P ∨ Q`` or ``P ↔ Q``, then use
  ``cases hpq with hp hq,``.

``split``

  If the target of the current goal is ``P ∧ Q`` or ``P ↔ Q``, then use
  ``split,``.

``left``/``right``

  If the target of the current goal is ``P ∨ Q``, then use
  either ``left,`` or ``right,`` (choose wisely).

``exfalso``

  Changes the target of the current goal to ``false``.

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

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

example (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
  intro hpq,
  cases hpq with hp hq,
  split,
  exact hq,
  exact hp,
end

example (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
  intro hpq,
  cases hpq with hp hq,
  {
    right,
    exact hp,
  }, {
    left,
    exact hq,
  }
end

example (P Q R : Prop) : P ∧ false ↔ false :=
begin
  split,
  {
    -- here we need to prove P ∧ false → false
    intro hPnFalse,
    cases hPnFalse with hp hfalse,
    exact hfalse,
  },
  {
      -- here we need to prove false → P ∧ false
      intro h,
      exfalso,
      exact h,
  }
end

theorem principle_of_explosion (P Q : Prop) : P ∧ ¬ P → Q :=
begin
  intro hPnP,
  cases hPnP with hP hnP,
  exfalso,
  apply hnP,
  exact hP,
end

-- 2.3. Quantifiers

-- 2.3.1. Barber paradox

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

``by_cases``

  If ``P`` is a proposition, then ``by_cases P,`` creates two goals,
    the first with a hypothesis ``hp: P`` and
    second with a hypothesis ``hp: ¬ P``.

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

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

-- men is type.
-- x : men means x is a man in the town
-- shaves x y is inhabited if x shaves y

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

/--------------------------------------------------------------------------
The claim is that in a certain town there is a (male) barber that shaves all
the men who do not shave themselves. (Why is this a paradox?) Prove that this
is a contradiction.

I found this complicated - the outline of the proof is as follows:

Use proof by contradiction, so first assume
  shaves barber x ↔ ¬ shaves x x
I.e. we are assuming both
  p1: shaves barber x → ¬ shaves x x
and
  p2: ¬ shaves x x → shaves barber x

assume shaves barber x
then by p1, we also have ¬ shaves x x
but barber is a man and this means ¬ shaves barber x
which is a contradiction.
This contradiction means the assumption above is invalid and so ¬ assume shaves barber x

Now assuming
¬ shaves barber x
then by p2 we must have shaves barber x
this is also a contraction.

This second contraction, means the initial assumption was wrong and so
this completes the proof.
---------------------------------------------------------------------------/

example : ¬ (∀ x : men, shaves barber x ↔ ¬ shaves x x) :=
begin
  -- we prove by contradiction, so assume it's true
  by_contradiction,
  -- x is a barber
  have x := barber,
  -- h is currently (x : men), shaves barber x ↔ ¬shaves x x
  -- so lets specialize to just get
  -- h : h: shaves barber barber ↔ ¬shaves barber barber
  specialize h barber,
  -- since h is a ↔ hypothesis, we do cases on it.
  cases h with p1 p2,
  by_cases shaves barber barber,
  {
    -- goal here is false, and have h : shaves barber barber
    -- show false, from p1 h h, -- this is one line that will solve the goal
    -- apply p1 h h, -- this line also on it's own solves the goal
    apply p1 h,
    exact h,
    -- remember, goal was false and
    -- ¬ shaves barber barber is the same as shaves barber barber → false
    -- so applying p1: shaves barber barber → ¬shaves barber barber
    -- gives shaves barber barber and this is exactly h
  },
  {
    -- goal here is false and have h : ¬ shaves barber barber
    -- show false, from h (p2 h), -- solves this is onle line
    -- apply h (p2 h), -- this also solves the goal in one line
    apply h,
    apply p2,
    exact h,
    -- again goal was false, and h is
    -- ¬shaves barber barber which is the same as shaves barber barber → false
    -- so we can apply h on false to give goal of
    -- shaves barber barber
    -- now p2 is  ¬shaves barber barber → shaves barber barber
    -- so after applying this, we get goal of ¬ shaves barber barber
    -- and this is exactly h.

  }
end

--- temp, the following are various proofs found on the internet that I used to help me to write the proof above.

-- standalone
-- See https://github.com/hyponymous/theorem-proving-in-lean-solutions/blob/a95320ae81c90c1b15da04574602cd378794400d/4.6.3.lean
example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
have hparadox : shaves barber barber ↔ ¬shaves barber barber, from
    (h barber),
have hn_self_shave : ¬shaves barber barber, from
    (show shaves barber barber → false, from
        assume h_self_shave : shaves barber barber,
        absurd h_self_shave (hparadox.mp h_self_shave)),
absurd (hparadox.mpr hn_self_shave) hn_self_shave

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
begin
  -- goal is false
  have hparadox : shaves barber barber ↔ ¬shaves barber barber, from
      (h barber),
  -- now have hypothesis : shaves barber barber ↔ ¬shaves barber barber
  have hn_self_shave : ¬shaves barber barber, from
      (show shaves barber barber → false, from
          assume h_self_shave : shaves barber barber,
          absurd h_self_shave (hparadox.mp h_self_shave)),
  -- now also have hypotheisis :  ¬shaves barber barber
  -- this line comes from suggest, but what is it doing ?
  exact (not_congr hparadox).mp hn_self_shave hn_self_shave,
  --absurd (hparadox.mpr hn_self_shave) hn_self_shave
end

-- another proof from zulip chat
variables (Man : Type) (tshaves : Man → Man → Prop)
theorem NoSuchBarber ( h : ∃ x : Man,  ∀ y : Man, tshaves x y ↔ ¬ tshaves y y )
: false :=
    exists.elim h
  ( assume barber,
    begin
        intro h,
        have hbarbermpr : ¬tshaves barber barber → tshaves barber barber,
            from iff.mpr (h barber),
        have hbarbermp  : tshaves barber barber → ¬tshaves barber barber,
            from iff.mp (h barber),
        have nsbb : ¬tshaves barber barber, from
            assume sbb : tshaves barber barber,
            show false, from hbarbermp sbb sbb,
        show false, from nsbb (hbarbermpr nsbb)
    end
)
#print NoSuchBarber

-- from Kevin Buzzard
--variables (Man : Type) (shaves : Man → Man → Prop)
theorem NoSuchBarber2 ( h : ∃ x : Man,  ∀ y : Man, tshaves x y ↔ ¬ tshaves y y )
: false :=
    exists.elim h
  ( assume barber,
    begin
        intro h2, -- I don't want two hypotheses called h
        have hbarber := h2 barber, -- human-generated good idea
        tauto!, -- computer can finish it off
    end
)

-- trying to rewrite this
-- theorem NoSuchBarber ( h : ∃ x : Man,  ∀ y : Man, tshaves x y ↔ ¬ tshaves y y )
example : ¬ (∀ x : men, shaves barber x ↔ ¬ shaves x x) :=
begin
  by_contradiction,
  have x := barber,
  specialize h barber,
  cases h with p1 p2,
  by_cases shaves barber barber,
  {
    show false, from p1 h h,
  },
  {
    show false, from h (p2 h),
  }
end

-- 2.3.2. Mathcampers singing paradox

-- Assume that the main lounge is non-empty. At a fixed moment in time,
-- there is someone in the lounge such that, if they are singing, then
-- everyone in the lounge is singing.

-- Note: This paradox is a rewording of the Drinker paradox.
-- See https://en.wikipedia.org/wiki/Drinker_paradox
-- "There is someone in the pub such that, if he is drinking, then everyone in the pub is drinking."

-- The outline of the proof from wikipedia.
-- The proof begins by recognizing it is true that either:
--  [1] everyone in the pub is drinking, or
--  [2] at least one person in the pub is not drinking.
-- Consequently, there are two cases to consider:
-- [1] Suppose everyone is drinking.
--     For any particular person, it cannot be wrong to say that if that particular person is drinking,
--     then everyone in the pub is drinking—because everyone is drinking.
--     Because everyone is drinking, then that one person must drink because when that person drinks everybody drinks
--     everybody includes that person.
-- [2] Otherwise at least one person is not drinking.
--     For any nondrinking person, the statement if that particular person is drinking,
--     then everyone in the pub is drinking is formally true:
--     its antecedent ("that particular person is drinking") is false, therefore the statement is true due to the
--     nature of material implication in formal logic, which states that
--     "If P, then Q" is always true if P is false.

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

``by_cases``

  If ``P`` is a proposition, then ``by_cases P,`` creates two goals,
    the first with a hypothesis ``hp: P`` and
    second with a hypothesis ``hp: ¬ P``.

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

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

-- camper is a type.
-- If x : camper then x is a camper in the main lounge.
-- singing(x) is inhabited if x is singing

theorem math_campers_singing_paradox
  (camper : Type)
  (singing : camper → Prop)
  (alice : camper) -- making sure that there is at least one camper in the lounge
  : ∃ x : camper, (singing x → (∀ y : camper, singing y)) :=
begin
  -- Following the proof structure above we first create two goals,
  -- in which either everyone sings, or someone is not singing
  by_cases (∃ bob : camper, ¬ singing bob),
  {
    -- Here we have the case:
    -- h: ∃ (bob : camper), ¬singing bob
    -- So this is case [2] above, the one where not everyone is singing.
    -- h says there exists a bob such that bob is not singing. The line
    cases h with bob h_bob_not_singing,
    -- gives us the hypotheiss that bob isn't singing
    use bob, -- vacuously proving the goal.
  },
  {
    -- Here we have the case where everyone sings, but it is written with a negative
    -- h: ¬∃ (bob : camper), ¬singing bob
    -- push_neg will sort this out
    push_neg at h,
    -- we now have
    -- h: ∀ (bob : camper), singing bob
    -- Our goal is a "there exists", we only know alice is in the lounge so lets use alice.
    use alice,
    -- goal is now singing alice → ∀ (y : camper), singing y
    -- Which is an implication, so lets use intro.
    intro h2, -- gives h2: singing alice
    -- goal is now : camper), singing y
    -- which is exactly h
    exact h,
  }
end

-- 2.3.3. Relationship conundrum

/--------------------------------------------------------------------------
  A relation r on a type X is a map r : X → X → Prop. We say that x is related to y if r x y is inhabited.

  r is reflexive if ∀ x : X, x is related to itself.
  r is symmetric if ∀ x y : X, x is related to y implies y is related to x.
  r is transitive if ∀ x y z : X, x is related to y and y is related to x implies z is related to z.
  r is connected if for all x : X there is a y : Y such that x is related to y.
---------------------------------------------------------------------------/

-- Show that if a relation is symmetric, transitive, and connected, then it is also reflexive.

variable X : Type

theorem reflexive_of_symmetric_transitive_and_connected
  (r : X → X → Prop)
  (h_symm : ∀ x y : X, r x y → r y x)
  (h_trans : ∀ x y z : X, r x y → r y z → r x z)
  (h_connected : ∀ x, ∃ y, r x y)
: (∀ x : X, r x x) :=
begin
  -- out goal is ∀ x : X, so lets introduce an arbitary x : X
  intro x,
  -- Either r x x is true, or it is false
  by_cases (r x x), {
    -- it's true, we are done as this is simpley h
    exact h,
  }, {
    -- we now need to prove r x x when we know ¬ r x x, which we do by contradiction
    by_contradiction,
    -- from h_connected we know there exists a y such that r x y
    -- by h_conneced is written as ∀ first, so we specialise on the x we have
    specialize h_connected x,
    -- we can now use cases on this to introduce the y : X such that we have h_rxy
    cases h_connected with y h_rxy,
    -- we now have h_rxy : r x y
    -- we have also h_ryx y x := by applying h_symm,
    have h_ryx : r y x := begin
      apply h_symm,
      assumption,
    end,
    -- and h_rxy and h_ryx and h_trans we have h_rxx
    have h_rxx : r x x := begin
      -- first specialize h_trans with the variables we want
      specialize h_trans x y x,
      -- our goal of r x x is now the result of applying this
      exact h_trans h_rxy h_ryx,
    end,
    -- we now have h : ¬ r x x and h_rxx : r x x which is the contradtion we need to prove the goal of false.
    show false, from h h_rxx,
  }
end

-- note: a similar proof from the course notes solutions
theorem reflexive_of_symmetric_and_transitive' (r : ℕ → ℕ → Prop)
  (h_symm : symmetric r)
  (h_trans : transitive r)
  (h_connected : ∀ x, ∃ y, r x y) :
  reflexive r :=
begin
  intro x,
  have hxy := h_connected x,
  cases hxy with y hy,
  apply h_trans hy,
  apply h_symm hy,
end

-- 2.4. Proving “trivial” statements

/--
   In mathlib, divisibility for natural numbers is defined as the following proposition.

   a ∣ b := (∃ k : ℕ, a = b * k)

  For example, 2 | 4 will be a proposition ∃ k : ℕ, 4 = 2 * k.
  Very important. The statement 2 | 4 is not saying that “2 divides 4 is true”.
  It is simply a proposition that requires a proof.

  Similarly, the mathlib library also contains the following definition of prime.

def nat.prime (p : ℕ) : Prop :=
  2 ≤ p                                       -- p is at least 2
  ∧                                           -- and
  ∀ (m : ℕ), m ∣ p → m = 1 ∨ m = p            -- if m divides p, then m = 1 or m = p.

--/

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

  These tactics in Lean are useful for proving trivial proofs such as these.

``norm_num``

  Useful for arithmetic.

``ring``

  Useful for basic algebra.

``linarith``

  Useful for inequalities.

``simp``

  Complex simplifier. Use only to close goals.

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

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

example : 1 > 0 :=
begin
  norm_num,
end

example (m a b : ℕ) :  m^2 + (a + b) * m + a * b = (m + a) * (m + b) :=
begin
  ring,
end

example : 101 ∣ 2020 :=
begin
  norm_num,
end

example : nat.prime 3 :=
begin
  norm_num,
end

example : nat.prime 101 :=
begin
  -- note you need to have
  --    import data.nat.prime
  -- for this one line proof to work.
  -- I spent quite a bit of time trying to prove it without this line.
  norm_num,
 end

-- you will need the definition
-- a ∣ b := (∃ k : ℕ, a = b * k)
example (m a b : ℕ) :  m + a ∣ m^2 + (a + b) * m + a * b :=
begin
  -- Our proof of this is to first observe that the rhs factorises
  -- m^2 (a + b)m + ab = (m + a)(m + b)
  -- from the definition of a | b we have a ∃ k, so in this case
  -- our k is m + b
  use m + b,
  -- we are just left to prove that
  -- m ^ 2 + (a + b) * m + a * b = (m + a) * (m + b)
  ring, -- and now this is easily solved with ring!
end

-- try ``unfold nat.prime at hp,`` to get started
example (p : ℕ) (hp : nat.prime p) : ¬ (p = 1) :=
begin
  unfold nat.prime at hp,
  -- after unfolding hp is
  -- hp: 2 ≤ p ∧ ∀ (m : ℕ), m ∣ p → m = 1 ∨ m = p
  -- this is two hypotheses via an and which we can split with
  -- cases hp,
  -- but in fact this isn't necessary as the linarith tatic clears the goal
  linarith,
end

-- if none of the simplifiers work, try doing ``contrapose!``
-- sometimes the simplifiers need a little help
example (n : ℕ) : 0 < n ↔ n ≠ 0 :=
begin
  -- Since we have ↔, split to → and ← .
  split,
  {
    -- this is where the hint is needed, contrapose before simp
    contrapose,
    simp,
  },
  {
    contrapose,
    simp,
  }
end

-- extra note, since the two split proofs above are the same, this above
-- proof can be reduced to

example (n : ℕ) : 0 < n ↔ n ≠ 0 :=
begin
  split;  -- here the ; means apply the following to both goals.
  {
    contrapose,
    simp,
  }
end


import Math.Algebra.Basic

namespace Algebra

class Monoid (α : Type u) extends Mul α, One α, MulOne α where
  mul_assoc : ∀ (x y z : α), x * (y * z) = (x * y) * z

attribute [simp] Monoid.mul_assoc Monoid.mul_one Monoid.one_mul

namespace Monoid

variable [Monoid α]

def npow (x : α) (n : Nat) : α := match n with
| Nat.zero => 1
| Nat.succ n => x * (npow x n)

instance : Pow α Nat where pow := npow

@[simp] theorem npow_zero (x : α) : x ^ (0 : Nat) = 1 := by rfl;
@[simp] theorem npow_succ (x : α) (n : Nat) : x ^ n.succ = x * x ^ n := by rfl;
@[simp] theorem npow_one (x : α) : x ^ (1 : Nat) = x := by have q := npow_succ x 0; rw [npow_zero, mul_one] at q; exact q;
@[simp] theorem npow_mul (x : α) (m n : Nat) : x ^ (n + m) = x ^ n * x ^ m := by {
  induction n with
  | zero => simp
  | succ n hn => simp [Nat.succ_add, hn];
}

theorem left_inv_eq_right_inv {x y z : α} (h₁ : x * y = 1) (h₂ : y * z = 1) : x = z :=
  by rw [← mul_one x, ← h₂, mul_assoc, h₁, one_mul]

end Monoid

class abbrev MonoidHom (f : α → β) [Monoid α] [Monoid β] : Prop := MulHom f, OneHom f

-- Very good!
-- variable (g : β → γ) (f : α → β) [Monoid α] [Monoid β] [Monoid γ] [MonoidHom f] [MonoidHom g]
-- #check (inferInstance : MonoidHom (id : α → α))
-- #check (inferInstance :  MonoidHom (g ∘ f))

end Algebra


import data.real.basic

variables {x y : ℝ}

example (h : y > x^2) : y > 0 ∨ y < -1 :=
by { left, linarith [pow_two_nonneg x] }

example (h : -y > x^2 + 1) : y > 0 ∨ y < -1 :=
by { right, linarith [pow_two_nonneg x] }

example : x < abs y → x < y ∨ x < -y :=
begin
  cases le_or_gt 0 y with h h,
  { rw abs_of_nonneg h,
    intro h,
    from or.inl h,
  },
  { rw abs_of_neg h,
    intro h,
    from or.inr h,
  },
end

namespace my_abs

theorem le_abs_self (x : ℝ) : x ≤ |x| :=
begin
  cases le_or_gt 0 x with h h,
  { rw abs_of_nonneg h,
  },
  { rw abs_of_neg h,
    apply le_of_lt,
    apply lt_trans h,
    rw neg_pos,
    from h,
  }
end

theorem neg_le_abs_self (x : ℝ) : -x ≤ |x| :=
begin
  cases le_or_gt 0 x with h h,
  { rw abs_of_nonneg h,
    apply le_trans,
    rw neg_nonpos,
    repeat {from h},
  },
  { rw abs_of_neg h,
  },
end

theorem abs_add (x y : ℝ) : |x + y| ≤ |x| + |y| :=
begin
  cases le_or_gt 0 (x + y) with h h,
  { rw abs_of_nonneg h,
    apply add_le_add; apply le_abs_self,
  },
  {
    rw abs_of_neg h,
    rw neg_add,
    apply add_le_add; apply neg_le_abs_self,
  },
end

theorem lt_abs : x < |y| ↔ x < y ∨ x < -y :=
begin
  split,
  { intro h,
    cases le_or_gt 0 y with h' h',
    { rw abs_of_nonneg h' at h,
      left, from h,
    },
    { rw abs_of_neg h' at h,
      right, from h,
    },
  },
  { intro h,
    cases h with hy hny,
    { apply lt_of_lt_of_le,
      from hy,
      apply le_abs_self,
    },
    { apply lt_of_lt_of_le,
      from hny,
      apply neg_le_abs_self,
    },
  },
end

theorem abs_lt : |x| < y ↔ - y < x ∧ x < y :=
begin
  split,
  { intro h,
    cases le_or_gt 0 x with h' h',
    { rw abs_of_nonneg h' at h,
      split; linarith,
    },
    { rw abs_of_neg h' at h,
      split; linarith,
    }
  },
  { intro h,
    cases le_or_gt 0 x with h' h',
    { rw abs_of_nonneg h',
      from h.right,
    },
    { rw abs_of_neg h',
      linarith,
    }
  }

end

end my_abs

example {x : ℝ} (h : x ≠ 0) : x < 0 ∨ x > 0 :=
begin
  rcases lt_trichotomy x 0 with xlt | xeq | xgt,
  { left, exact xlt },
  { contradiction },
  right, exact xgt
end

example {m n k : ℕ} (h : m ∣ n ∨ m ∣ k) : m ∣ n * k :=
begin
  rcases h with ⟨a, rfl⟩ | ⟨b, rfl⟩,
  { rw [mul_assoc],
    apply dvd_mul_right,
  },
  { rw [mul_comm, mul_assoc],
    apply dvd_mul_right,
  }
end

example {z : ℝ} (h : ∃ x y, z = x^2 + y^2 ∨ z = x^2 + y^2 + 1) :
  z ≥ 0 :=
by {rcases h with ⟨x, y, rfl | rfl⟩; linarith [sq_nonneg x, sq_nonneg y],}

example {x : ℝ} (h : x^2 = 1) : x = 1 ∨ x = -1 :=
begin
  have : (x - 1) * (x + 1) = 0 := by linarith,
  have : x - 1 = 0 ∨ x + 1 = 0 := eq_zero_or_eq_zero_of_mul_eq_zero this,
  cases this,
    left, linarith,
    right, linarith,
end

example {x y : ℝ} (h : x^2 = y^2) : x = y ∨ x = -y :=
begin
  have : (x - y) * (x + y) = 0 := by linarith,
  have : x - y = 0 ∨ x + y = 0 := eq_zero_or_eq_zero_of_mul_eq_zero this,
  cases this,
    left, linarith,
    right, linarith,
end

example (P : Prop) : ¬ ¬ P → P :=
begin
  intro h,
  cases classical.em P,
  { assumption },
  contradiction
end

example (P Q : Prop) : (P → Q) ↔ ¬ P ∨ Q :=
begin
  split,
  { intro hp,
    by_cases P,
    { right,
      from hp h,
    },
    { left,
      assumption,
    },
  },
  { rintros (hnp | hq) hp,
    { contradiction,
    },
    { from hq
    }
  }
end


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Div

namespace Nat

private def gcdF (x : Nat) : (∀ x₁, x₁ < x → Nat → Nat) → Nat → Nat :=
  match x with
  | 0      => fun _ y => y
  | succ x => fun f y => f (y % succ x) (mod_lt _ (zero_lt_succ  _)) (succ x)

@[extern "lean_nat_gcd"]
def gcd (a b : @& Nat) : Nat :=
  WellFounded.fix lt_wf gcdF a b

@[simp] theorem gcd_zero_left (y : Nat) : gcd 0 y = y :=
  rfl

theorem gcd_succ (x y : Nat) : gcd (succ x) y = gcd (y % succ x) (succ x) :=
  rfl

@[simp] theorem gcd_one_left (n : Nat) : gcd 1 n = 1 := by
  rw [gcd_succ, mod_one]
  rfl

@[simp] theorem gcd_zero_right (n : Nat) : gcd n 0 = n := by
  cases n <;> simp [gcd_succ]

@[simp] theorem gcd_self (n : Nat) : gcd n n = n := by
  cases n <;> simp [gcd_succ]

end Nat


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

! This file was ported from Lean 3 source module algebra.order.lattice_group
! leanprover-community/mathlib commit 10b4e499f43088dd3bb7b5796184ad5216648ab1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Basic
import Mathlib.Algebra.Order.Group.Abs
import Mathlib.Tactic.NthRewrite
/-!
# Lattice ordered groups

Lattice ordered groups were introduced by [Birkhoff][birkhoff1942].
They form the algebraic underpinnings of vector lattices, Banach lattices, AL-space, AM-space etc.

This file develops the basic theory, concentrating on the commutative case.

## Main statements

- `pos_div_neg`: Every element `a` of a lattice ordered commutative group has a decomposition
  `a⁺-a⁻` into the difference of the positive and negative component.
- `pos_inf_neg_eq_one`: The positive and negative components are coprime.
- `abs_triangle`: The absolute value operation satisfies the triangle inequality.

It is shown that the inf and sup operations are related to the absolute value operation by a
number of equations and inequalities.

## Notations

- `a⁺ = a ⊔ 0`: The *positive component* of an element `a` of a lattice ordered commutative group
- `a⁻ = (-a) ⊔ 0`: The *negative component* of an element `a` of a lattice ordered commutative group
- `|a| = a⊔(-a)`: The *absolute value* of an element `a` of a lattice ordered commutative group

## Implementation notes

A lattice ordered commutative group is a type `α` satisfying:

* `[Lattice α]`
* `[CommGroup α]`
* `[CovariantClass α α (*) (≤)]`

The remainder of the file establishes basic properties of lattice ordered commutative groups. A
number of these results also hold in the non-commutative case ([Birkhoff][birkhoff1942],
[Fuchs][fuchs1963]) but we have not developed that here, since we are primarily interested in vector
lattices.

## References

* [Birkhoff, Lattice-ordered Groups][birkhoff1942]
* [Bourbaki, Algebra II][bourbaki1981]
* [Fuchs, Partially Ordered Algebraic Systems][fuchs1963]
* [Zaanen, Lectures on "Riesz Spaces"][zaanen1966]
* [Banasiak, Banach Lattices in Applications][banasiak]

## Tags

lattice, ordered, group
-/

-- Needed for squares
-- Needed for squares
universe u

-- A linearly ordered additive commutative group is a lattice ordered commutative group
-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) LinearOrderedCommGroup.to_covariantClass (α : Type u)
    [LinearOrderedCommGroup α] :
    CovariantClass α α (· * ·)
      (· ≤ ·) where elim a _ _ bc := OrderedCommGroup.mul_le_mul_left _ _ bc a
#align linear_ordered_comm_group.to_covariant_class LinearOrderedCommGroup.to_covariantClass
#align linear_ordered_add_comm_group.to_covariant_class LinearOrderedAddCommGroup.to_covariantClass

variable {α : Type u} [Lattice α] [CommGroup α]

-- Special case of Bourbaki A.VI.9 (1)
-- c + (a ⊔ b) = (c + a) ⊔ (c + b)
@[to_additive]
theorem mul_sup [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) : c * (a ⊔ b) = c * a ⊔ c * b := by
  refine' le_antisymm _ _
  rw [← mul_le_mul_iff_left (c⁻¹), ← mul_assoc, inv_mul_self, one_mul]
  apply sup_le
  rw [le_inv_mul_iff_mul_le]
  exact le_sup_left'
  rw [le_inv_mul_iff_mul_le]
  exact le_sup_right
  rw [sup_le_iff, mul_le_mul_iff_left, mul_le_mul_iff_left, and_iff_left le_sup_right]
  exact le_sup_left
#align mul_sup mul_sup
#align add_sup add_sup

@[to_additive]
theorem mul_inf [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) : c * (a ⊓ b) = c * a ⊓ c * b := by
  refine' le_antisymm _ _
  rw [le_inf_iff, mul_le_mul_iff_left, mul_le_mul_iff_left, and_iff_left inf_le_right]
  exact inf_le_left
  rw [← mul_le_mul_iff_left (c⁻¹), ← mul_assoc, inv_mul_self, one_mul]
  apply le_inf
  rw [inv_mul_le_iff_le_mul]
  exact inf_le_left
  rw [inv_mul_le_iff_le_mul]
  exact inf_le_right
#align mul_inf mul_inf
#align add_inf add_inf

-- Special case of Bourbaki A.VI.9 (2)
-- -(a ⊔ b)=(-a) ⊓ (-b)
@[to_additive]
theorem inv_sup_eq_inv_inf_inv [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) :
    (a ⊔ b)⁻¹ = a⁻¹ ⊓ b⁻¹ := by
  apply le_antisymm
  · refine' le_inf _ _
    · rw [inv_le_inv_iff]
      exact le_sup_left
    · rw [inv_le_inv_iff]
      exact le_sup_right
  · rw [← inv_le_inv_iff, inv_inv]
    refine' sup_le _ _
    · rw [← inv_le_inv_iff]
      simp
    · rw [← inv_le_inv_iff]
      simp
#align inv_sup_eq_inv_inf_inv inv_sup_eq_inv_inf_inv
#align neg_sup_eq_neg_inf_neg neg_sup_eq_neg_inf_neg

-- -(a ⊓ b) = -a ⊔ -b
@[to_additive]
theorem inv_inf_eq_sup_inv [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) : (a ⊓ b)⁻¹ = a⁻¹ ⊔ b⁻¹ :=
  by rw [← inv_inv (a⁻¹ ⊔ b⁻¹), inv_sup_eq_inv_inf_inv a⁻¹ b⁻¹, inv_inv, inv_inv]
#align inv_inf_eq_sup_inv inv_inf_eq_sup_inv
#align neg_inf_eq_sup_neg neg_inf_eq_sup_neg

-- Bourbaki A.VI.10 Prop 7
-- a ⊓ b + (a ⊔ b) = a + b
@[to_additive]
theorem inf_mul_sup [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) : (a ⊓ b) * (a ⊔ b) = a * b :=
  calc
    (a ⊓ b) * (a ⊔ b) = (a ⊓ b) * (a * b * (b⁻¹ ⊔ a⁻¹)) :=
    by
      rw [mul_sup b⁻¹ a⁻¹ (a * b)]
      simp
    _ = (a ⊓ b) * (a * b * (a ⊓ b)⁻¹) := by rw [inv_inf_eq_sup_inv, sup_comm]
    _ = a * b := by rw [mul_comm, inv_mul_cancel_right]

#align inf_mul_sup inf_mul_sup
#align inf_add_sup inf_add_sup

namespace LatticeOrderedCommGroup

-- see Note [lower instance priority]
/--
Let `α` be a lattice ordered commutative group with identity `1`. For an element `a` of type `α`,
the element `a ⊔ 1` is said to be the *positive component* of `a`, denoted `a⁺`.
-/
@[to_additive
      "Let `α` be a lattice ordered commutative group with identity `0`. For an element `a` of type
      `α`,the element `a ⊔ 0` is said to be the *positive component* of `a`, denoted `a⁺`."]
instance (priority := 100) hasOneLatticeHasPosPart : PosPart α :=
  ⟨fun a => a ⊔ 1⟩
#align lattice_ordered_comm_group.has_one_lattice_has_pos_part LatticeOrderedCommGroup.hasOneLatticeHasPosPart
#align lattice_ordered_comm_group.has_zero_lattice_has_pos_part LatticeOrderedCommGroup.hasZeroLatticeHasPosPart

@[to_additive pos_part_def]
theorem m_pos_part_def (a : α) : a⁺ = a ⊔ 1 :=
  rfl
#align lattice_ordered_comm_group.m_pos_part_def LatticeOrderedCommGroup.m_pos_part_def
#align lattice_ordered_comm_group.pos_part_def LatticeOrderedCommGroup.pos_part_def

-- see Note [lower instance priority]
/--
Let `α` be a lattice ordered commutative group with identity `1`. For an element `a` of type `α`,
the element `(-a) ⊔ 1` is said to be the *negative component* of `a`, denoted `a⁻`.
-/
@[to_additive
      "Let `α` be a lattice ordered commutative group with identity `0`. For an element `a` of type
      `α`, the element `(-a) ⊔ 0` is said to be the *negative component* of `a`, denoted `a⁻`."]
instance (priority := 100) hasOneLatticeHasNegPart : NegPart α :=
  ⟨fun a => a⁻¹ ⊔ 1⟩
#align lattice_ordered_comm_group.has_one_lattice_has_neg_part LatticeOrderedCommGroup.hasOneLatticeHasNegPart
#align lattice_ordered_comm_group.has_zero_lattice_has_neg_part LatticeOrderedCommGroup.hasZeroLatticeHasNegPart

@[to_additive neg_part_def]
theorem m_neg_part_def (a : α) : a⁻ = a⁻¹ ⊔ 1 :=
  rfl
#align lattice_ordered_comm_group.m_neg_part_def LatticeOrderedCommGroup.m_neg_part_def
#align lattice_ordered_comm_group.neg_part_def LatticeOrderedCommGroup.neg_part_def

@[to_additive (attr := simp)]
theorem pos_one : (1 : α)⁺ = 1 :=
  sup_idem
#align lattice_ordered_comm_group.pos_one LatticeOrderedCommGroup.pos_one
#align lattice_ordered_comm_group.pos_zero LatticeOrderedCommGroup.pos_zero

@[to_additive (attr := simp)]
theorem neg_one : (1 : α)⁻ = 1 := by rw [m_neg_part_def, inv_one, sup_idem]
#align lattice_ordered_comm_group.neg_one LatticeOrderedCommGroup.neg_one
#align lattice_ordered_comm_group.neg_zero LatticeOrderedCommGroup.neg_zero

-- a⁻ = -(a ⊓ 0)
@[to_additive]
theorem neg_eq_inv_inf_one [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : a⁻ = (a ⊓ 1)⁻¹ := by
  rw [m_neg_part_def, ← inv_inj, inv_sup_eq_inv_inf_inv, inv_inv, inv_inv, inv_one]
#align lattice_ordered_comm_group.neg_eq_inv_inf_one LatticeOrderedCommGroup.neg_eq_inv_inf_one
#align lattice_ordered_comm_group.neg_eq_neg_inf_zero LatticeOrderedCommGroup.neg_eq_neg_inf_zero

@[to_additive le_abs]
theorem le_mabs (a : α) : a ≤ |a| :=
  le_sup_left
#align lattice_ordered_comm_group.le_mabs LatticeOrderedCommGroup.le_mabs
#align lattice_ordered_comm_group.le_abs LatticeOrderedCommGroup.le_abs

-- -a ≤ |a|
@[to_additive]
theorem inv_le_abs (a : α) : a⁻¹ ≤ |a| :=
  le_sup_right
#align lattice_ordered_comm_group.inv_le_abs LatticeOrderedCommGroup.inv_le_abs
#align lattice_ordered_comm_group.neg_le_abs LatticeOrderedCommGroup.neg_le_abs

-- 0 ≤ a⁺
@[to_additive pos_nonneg]
theorem one_le_pos (a : α) : 1 ≤ a⁺ :=
  le_sup_right
#align lattice_ordered_comm_group.one_le_pos LatticeOrderedCommGroup.one_le_pos
#align lattice_ordered_comm_group.pos_nonneg LatticeOrderedCommGroup.pos_nonneg

-- 0 ≤ a⁻
@[to_additive neg_nonneg]
theorem one_le_neg (a : α) : 1 ≤ a⁻ :=
  le_sup_right
#align lattice_ordered_comm_group.one_le_neg LatticeOrderedCommGroup.one_le_neg
#align lattice_ordered_comm_group.neg_nonneg LatticeOrderedCommGroup.neg_nonneg

-- pos_nonpos_iff
@[to_additive]
theorem pos_le_one_iff {a : α} : a⁺ ≤ 1 ↔ a ≤ 1 := by
  rw [m_pos_part_def, sup_le_iff]
  simp
#align lattice_ordered_comm_group.pos_le_one_iff LatticeOrderedCommGroup.pos_le_one_iff
#align lattice_ordered_comm_group.pos_nonpos_iff LatticeOrderedCommGroup.pos_nonpos_iff

-- neg_nonpos_iff
@[to_additive]
theorem neg_le_one_iff {a : α} : a⁻ ≤ 1 ↔ a⁻¹ ≤ 1 := by
  rw [m_neg_part_def, sup_le_iff]
  simp
#align lattice_ordered_comm_group.neg_le_one_iff LatticeOrderedCommGroup.neg_le_one_iff
#align lattice_ordered_comm_group.neg_nonpos_iff LatticeOrderedCommGroup.neg_nonpos_iff

@[to_additive]
theorem pos_eq_one_iff {a : α} : a⁺ = 1 ↔ a ≤ 1 := by
  rw [le_antisymm_iff]
  simp only [one_le_pos, and_true_iff]
  exact pos_le_one_iff
#align lattice_ordered_comm_group.pos_eq_one_iff LatticeOrderedCommGroup.pos_eq_one_iff
#align lattice_ordered_comm_group.pos_eq_zero_iff LatticeOrderedCommGroup.pos_eq_zero_iff

@[to_additive]
theorem neg_eq_one_iff' {a : α} : a⁻ = 1 ↔ a⁻¹ ≤ 1 := by
  rw [le_antisymm_iff]
  simp only [one_le_neg, and_true_iff]
  rw [neg_le_one_iff]
#align lattice_ordered_comm_group.neg_eq_one_iff' LatticeOrderedCommGroup.neg_eq_one_iff'
#align lattice_ordered_comm_group.neg_eq_zero_iff' LatticeOrderedCommGroup.neg_eq_zero_iff'

@[to_additive]
theorem neg_eq_one_iff [CovariantClass α α Mul.mul LE.le] {a : α} : a⁻ = 1 ↔ 1 ≤ a := by
  rw [le_antisymm_iff]
  simp only [one_le_neg, and_true_iff]
  rw [neg_le_one_iff, inv_le_one']
#align lattice_ordered_comm_group.neg_eq_one_iff LatticeOrderedCommGroup.neg_eq_one_iff
#align lattice_ordered_comm_group.neg_eq_zero_iff LatticeOrderedCommGroup.neg_eq_zero_iff

@[to_additive le_pos]
theorem m_le_pos (a : α) : a ≤ a⁺ :=
  le_sup_left
#align lattice_ordered_comm_group.m_le_pos LatticeOrderedCommGroup.m_le_pos
#align lattice_ordered_comm_group.le_pos LatticeOrderedCommGroup.le_pos

-- -a ≤ a⁻
@[to_additive]
theorem inv_le_neg (a : α) : a⁻¹ ≤ a⁻ :=
  le_sup_left
#align lattice_ordered_comm_group.inv_le_neg LatticeOrderedCommGroup.inv_le_neg
#align lattice_ordered_comm_group.neg_le_neg LatticeOrderedCommGroup.neg_le_neg

-- Bourbaki A.VI.12
--  a⁻ = (-a)⁺
@[to_additive]
theorem neg_eq_pos_inv (a : α) : a⁻ = a⁻¹⁺ :=
  rfl
#align lattice_ordered_comm_group.neg_eq_pos_inv LatticeOrderedCommGroup.neg_eq_pos_inv
#align lattice_ordered_comm_group.neg_eq_pos_neg LatticeOrderedCommGroup.neg_eq_pos_neg

-- a⁺ = (-a)⁻
@[to_additive]
theorem pos_eq_neg_inv (a : α) : a⁺ = a⁻¹⁻ := by simp [neg_eq_pos_inv]
#align lattice_ordered_comm_group.pos_eq_neg_inv LatticeOrderedCommGroup.pos_eq_neg_inv
#align lattice_ordered_comm_group.pos_eq_neg_neg LatticeOrderedCommGroup.pos_eq_neg_neg

-- We use this in Bourbaki A.VI.12  Prop 9 a)
-- c + (a ⊓ b) = (c + a) ⊓ (c + b)
@[to_additive]
theorem mul_inf_eq_mul_inf_mul [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) :
    c * (a ⊓ b) = c * a ⊓ c * b := by
  refine' le_antisymm _ _
  rw [le_inf_iff, mul_le_mul_iff_left, mul_le_mul_iff_left]
  simp
  rw [← mul_le_mul_iff_left c⁻¹, ← mul_assoc, inv_mul_self, one_mul, le_inf_iff,
    inv_mul_le_iff_le_mul, inv_mul_le_iff_le_mul]
  simp
#align lattice_ordered_comm_group.mul_inf_eq_mul_inf_mul LatticeOrderedCommGroup.mul_inf_eq_mul_inf_mul
#align lattice_ordered_comm_group.add_inf_eq_add_inf_add LatticeOrderedCommGroup.add_inf_eq_add_inf_add

-- Bourbaki A.VI.12  Prop 9 a)
-- a = a⁺ - a⁻
@[to_additive (attr := simp)]
theorem pos_div_neg [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : a⁺ / a⁻ = a := by
  symm
  rw [div_eq_mul_inv]
  apply eq_mul_inv_of_mul_eq
  rw [m_neg_part_def, mul_sup, mul_one, mul_right_inv, sup_comm, m_pos_part_def]
#align lattice_ordered_comm_group.pos_div_neg LatticeOrderedCommGroup.pos_div_neg
#align lattice_ordered_comm_group.pos_sub_neg LatticeOrderedCommGroup.pos_sub_neg

-- Bourbaki A.VI.12  Prop 9 a)
-- a⁺ ⊓ a⁻ = 0 (`a⁺` and `a⁻` are co-prime, and, since they are positive, disjoint)
@[to_additive]
theorem pos_inf_neg_eq_one [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : a⁺ ⊓ a⁻ = 1 := by
  rw [← mul_right_inj (a⁻)⁻¹, mul_inf_eq_mul_inf_mul, mul_one, mul_left_inv, mul_comm, ←
    div_eq_mul_inv, pos_div_neg, neg_eq_inv_inf_one, inv_inv]
#align lattice_ordered_comm_group.pos_inf_neg_eq_one LatticeOrderedCommGroup.pos_inf_neg_eq_one
#align lattice_ordered_comm_group.pos_inf_neg_eq_zero LatticeOrderedCommGroup.pos_inf_neg_eq_zero

-- Bourbaki A.VI.12 (with a and b swapped)
-- a⊔b = b + (a - b)⁺
@[to_additive]
theorem sup_eq_mul_pos_div [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) : a ⊔ b = b * (a / b)⁺ :=
  calc
    a ⊔ b = b * (a / b) ⊔ b * 1 :=
      by rw [mul_one b, div_eq_mul_inv, mul_comm a, mul_inv_cancel_left]
    _ = b * (a / b ⊔ 1) := by rw [← mul_sup (a / b) 1 b]

#align lattice_ordered_comm_group.sup_eq_mul_pos_div LatticeOrderedCommGroup.sup_eq_mul_pos_div
#align lattice_ordered_comm_group.sup_eq_add_pos_sub LatticeOrderedCommGroup.sup_eq_add_pos_sub

-- Bourbaki A.VI.12 (with a and b swapped)
-- a⊓b = a - (a - b)⁺
@[to_additive]
theorem inf_eq_div_pos_div [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) : a ⊓ b = a / (a / b)⁺ :=
  calc
    a ⊓ b = a * 1 ⊓ a * (b / a) :=
      by rw [mul_one a, div_eq_mul_inv, mul_comm b, mul_inv_cancel_left]
    _ = a * (1 ⊓ b / a) := by rw [← mul_inf_eq_mul_inf_mul 1 (b / a) a]
    _ = a * (b / a ⊓ 1) := by rw [inf_comm]
    _ = a * ((a / b)⁻¹ ⊓ 1) :=
      by
        rw [div_eq_mul_inv]
        nth_rw 1 [← inv_inv b]
        rw [← mul_inv, mul_comm b⁻¹, ← div_eq_mul_inv]
    _ = a * ((a / b)⁻¹ ⊓ 1⁻¹) := by rw [inv_one]
    _ = a / (a / b ⊔ 1) := by rw [← inv_sup_eq_inv_inf_inv, ← div_eq_mul_inv]

#align lattice_ordered_comm_group.inf_eq_div_pos_div LatticeOrderedCommGroup.inf_eq_div_pos_div
#align lattice_ordered_comm_group.inf_eq_sub_pos_sub LatticeOrderedCommGroup.inf_eq_sub_pos_sub

-- Bourbaki A.VI.12 Prop 9 c)
@[to_additive le_iff_pos_le_neg_ge]
theorem m_le_iff_pos_le_neg_ge [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) :
    a ≤ b ↔ a⁺ ≤ b⁺ ∧ b⁻ ≤ a⁻ := by
  constructor <;> intro h
  · constructor
    · exact sup_le (h.trans (m_le_pos b)) (one_le_pos b)
    · rw [← inv_le_inv_iff] at h
      exact sup_le (h.trans (inv_le_neg a)) (one_le_neg a)
  · rw [← pos_div_neg a, ← pos_div_neg b]
    exact div_le_div'' h.1 h.2
#align lattice_ordered_comm_group.m_le_iff_pos_le_neg_ge LatticeOrderedCommGroup.m_le_iff_pos_le_neg_ge
#align lattice_ordered_comm_group.le_iff_pos_le_neg_ge LatticeOrderedCommGroup.le_iff_pos_le_neg_ge

@[to_additive neg_abs]
theorem m_neg_abs [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : |a|⁻ = 1 := by
  refine' le_antisymm _ _
  · rw [← pos_inf_neg_eq_one a]
    apply le_inf
    · rw [pos_eq_neg_inv]
      exact ((m_le_iff_pos_le_neg_ge _ _).mp (inv_le_abs a)).right
    · exact And.right (Iff.mp (m_le_iff_pos_le_neg_ge _ _) (le_mabs a))
  · exact one_le_neg _
#align lattice_ordered_comm_group.m_neg_abs LatticeOrderedCommGroup.m_neg_abs
#align lattice_ordered_comm_group.neg_abs LatticeOrderedCommGroup.neg_abs

@[to_additive pos_abs]
theorem m_pos_abs [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : |a|⁺ = |a| := by
  nth_rw 2 [← pos_div_neg (|a|)]
  rw [div_eq_mul_inv]
  symm
  rw [mul_right_eq_self, inv_eq_one]
  exact m_neg_abs a
#align lattice_ordered_comm_group.m_pos_abs LatticeOrderedCommGroup.m_pos_abs
#align lattice_ordered_comm_group.pos_abs LatticeOrderedCommGroup.pos_abs

@[to_additive abs_nonneg]
theorem one_le_abs [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : 1 ≤ |a| := by
  rw [← m_pos_abs]
  exact one_le_pos _
#align lattice_ordered_comm_group.one_le_abs LatticeOrderedCommGroup.one_le_abs
#align lattice_ordered_comm_group.abs_nonneg LatticeOrderedCommGroup.abs_nonneg

-- The proof from Bourbaki A.VI.12 Prop 9 d)
-- |a| = a⁺ - a⁻
@[to_additive]
theorem pos_mul_neg [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : |a| = a⁺ * a⁻ := by
  refine' le_antisymm _ _
  · refine' sup_le _ _
    · nth_rw 1 [← mul_one a]
      exact mul_le_mul' (m_le_pos a) (one_le_neg a)
    · nth_rw 1 [← one_mul a⁻¹]
      exact mul_le_mul' (one_le_pos a) (inv_le_neg a)
  · rw [← inf_mul_sup, pos_inf_neg_eq_one, one_mul, ← m_pos_abs a]
    apply sup_le
    · exact ((m_le_iff_pos_le_neg_ge _ _).mp (le_mabs a)).left
    · rw [neg_eq_pos_inv]
      exact ((m_le_iff_pos_le_neg_ge _ _).mp (inv_le_abs a)).left
#align lattice_ordered_comm_group.pos_mul_neg LatticeOrderedCommGroup.pos_mul_neg
#align lattice_ordered_comm_group.pos_add_neg LatticeOrderedCommGroup.pos_add_neg

-- a ⊔ b - (a ⊓ b) = |b - a|
@[to_additive]
theorem sup_div_inf_eq_abs_div [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) :
    (a ⊔ b) / (a ⊓ b) = |b / a| := by
  rw [sup_eq_mul_pos_div, inf_comm, inf_eq_div_pos_div, div_eq_mul_inv, div_eq_mul_inv b ((b / a)⁺),
    mul_inv_rev, inv_inv, mul_comm, ← mul_assoc, inv_mul_cancel_right, pos_eq_neg_inv (a / b),
    div_eq_mul_inv a b, mul_inv_rev, ← div_eq_mul_inv, inv_inv, ← pos_mul_neg]
#align lattice_ordered_comm_group.sup_div_inf_eq_abs_div LatticeOrderedCommGroup.sup_div_inf_eq_abs_div
#align lattice_ordered_comm_group.sup_sub_inf_eq_abs_sub LatticeOrderedCommGroup.sup_sub_inf_eq_abs_sub

-- 2•(a ⊔ b) = a + b + |b - a|
@[to_additive two_sup_eq_add_add_abs_sub]
theorem sup_sq_eq_mul_mul_abs_div [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) :
    (a ⊔ b) ^ 2 = a * b * |b / a| := by
  rw [← inf_mul_sup a b, ← sup_div_inf_eq_abs_div, div_eq_mul_inv, ← mul_assoc, mul_comm, mul_assoc,
    ← pow_two, inv_mul_cancel_left]
#align lattice_ordered_comm_group.sup_sq_eq_mul_mul_abs_div LatticeOrderedCommGroup.sup_sq_eq_mul_mul_abs_div
#align lattice_ordered_comm_group.two_sup_eq_add_add_abs_sub LatticeOrderedCommGroup.two_sup_eq_add_add_abs_sub

-- 2•(a ⊓ b) = a + b - |b - a|
@[to_additive two_inf_eq_add_sub_abs_sub]
theorem inf_sq_eq_mul_div_abs_div [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) :
    (a ⊓ b) ^ 2 = a * b / |b / a| := by
  rw [← inf_mul_sup a b, ← sup_div_inf_eq_abs_div, div_eq_mul_inv, div_eq_mul_inv, mul_inv_rev,
    inv_inv, mul_assoc, mul_inv_cancel_comm_assoc, ← pow_two]
#align lattice_ordered_comm_group.inf_sq_eq_mul_div_abs_div LatticeOrderedCommGroup.inf_sq_eq_mul_div_abs_div
#align lattice_ordered_comm_group.two_inf_eq_add_sub_abs_sub LatticeOrderedCommGroup.two_inf_eq_add_sub_abs_sub

/-- Every lattice ordered commutative group is a distributive lattice
-/
@[to_additive "Every lattice ordered commutative additive group is a distributive lattice"]
def latticeOrderedCommGroupToDistribLattice (α : Type u) [s : Lattice α] [CommGroup α]
    [CovariantClass α α (· * ·) (· ≤ ·)] : DistribLattice α :=
  { s with
    le_sup_inf := by
      intros x y z
      rw [← mul_le_mul_iff_left (x ⊓ (y ⊓ z)), inf_mul_sup x (y ⊓ z), ← inv_mul_le_iff_le_mul,
        le_inf_iff]
      constructor
      · rw [inv_mul_le_iff_le_mul, ← inf_mul_sup x y]
        apply mul_le_mul'
        · apply inf_le_inf_left
          apply inf_le_left
        · apply inf_le_left
      · rw [inv_mul_le_iff_le_mul, ← inf_mul_sup x z]
        apply mul_le_mul'
        · apply inf_le_inf_left
          apply inf_le_right
        · apply inf_le_right }
#align lattice_ordered_comm_group.lattice_ordered_comm_group_to_distrib_lattice LatticeOrderedCommGroup.latticeOrderedCommGroupToDistribLattice
#align lattice_ordered_comm_group.lattice_ordered_add_comm_group_to_distrib_lattice LatticeOrderedCommGroup.latticeOrderedAddCommGroupToDistribLattice

-- See, e.g. Zaanen, Lectures on Riesz Spaces
-- 3rd lecture
-- |a ⊔ c - (b ⊔ c)| + |a ⊓ c-b ⊓ c| = |a - b|
@[to_additive]
theorem abs_div_sup_mul_abs_div_inf [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) :
    |(a ⊔ c) / (b ⊔ c)| * |(a ⊓ c) / (b ⊓ c)| = |a / b| := by
  letI : DistribLattice α := LatticeOrderedCommGroup.latticeOrderedCommGroupToDistribLattice α
  calc
    |(a ⊔ c) / (b ⊔ c)| * |(a ⊓ c) / (b ⊓ c)| =
        (b ⊔ c ⊔ (a ⊔ c)) / ((b ⊔ c) ⊓ (a ⊔ c)) * |(a ⊓ c) / (b ⊓ c)| :=
      by rw [sup_div_inf_eq_abs_div]
    _ = (b ⊔ c ⊔ (a ⊔ c)) / ((b ⊔ c) ⊓ (a ⊔ c)) * ((b ⊓ c ⊔ a ⊓ c) / (b ⊓ c ⊓ (a ⊓ c))) :=
      by rw [sup_div_inf_eq_abs_div (b ⊓ c) (a ⊓ c)]
    _ = (b ⊔ a ⊔ c) / (b ⊓ a ⊔ c) * (((b ⊔ a) ⊓ c) / (b ⊓ a ⊓ c)) :=
      by
        rw [← sup_inf_right, ← inf_sup_right, sup_assoc, @sup_comm _ _ c (a⊔c), sup_right_idem,
          sup_assoc, inf_assoc, @inf_comm _ _ c (a⊓c), inf_right_idem, inf_assoc]
    _ = (b ⊔ a ⊔ c) * ((b ⊔ a) ⊓ c) / ((b ⊓ a ⊔ c) * (b ⊓ a ⊓ c)) := by rw [div_mul_div_comm]
    _ = (b ⊔ a) * c / ((b ⊓ a) * c) :=
      by rw [mul_comm, inf_mul_sup, mul_comm (b ⊓ a ⊔ c), inf_mul_sup]
    _ = (b ⊔ a) / (b ⊓ a) :=
      by rw [div_eq_mul_inv, mul_inv_rev, mul_assoc, mul_inv_cancel_left, ← div_eq_mul_inv]
    _ = |a / b| := by rw [sup_div_inf_eq_abs_div]

#align lattice_ordered_comm_group.abs_div_sup_mul_abs_div_inf LatticeOrderedCommGroup.abs_div_sup_mul_abs_div_inf
#align lattice_ordered_comm_group.abs_sub_sup_add_abs_sub_inf LatticeOrderedCommGroup.abs_sub_sup_add_abs_sub_inf

-- pos_of_nonneg
/-- If `a` is positive, then it is equal to its positive component `a⁺`. -/
@[to_additive "If `a` is positive, then it is equal to its positive component `a⁺`."]
theorem pos_of_one_le (a : α) (h : 1 ≤ a) : a⁺ = a := by
  rw [m_pos_part_def]
  exact sup_of_le_left h
#align lattice_ordered_comm_group.pos_of_one_le LatticeOrderedCommGroup.pos_of_one_le
#align lattice_ordered_comm_group.pos_of_nonneg LatticeOrderedCommGroup.pos_of_nonneg

-- pos_eq_self_of_pos_pos
@[to_additive]
theorem pos_eq_self_of_one_lt_pos {α} [LinearOrder α] [CommGroup α] {x : α} (hx : 1 < x⁺) :
    x⁺ = x := by
  rw [m_pos_part_def, right_lt_sup, not_le] at hx
  rw [m_pos_part_def, sup_eq_left]
  exact hx.le
#align lattice_ordered_comm_group.pos_eq_self_of_one_lt_pos LatticeOrderedCommGroup.pos_eq_self_of_one_lt_pos
#align lattice_ordered_comm_group.pos_eq_self_of_pos_pos LatticeOrderedCommGroup.pos_eq_self_of_pos_pos

-- 0 ≤ a implies a⁺ = a
-- pos_of_nonpos
@[to_additive]
theorem pos_of_le_one (a : α) (h : a ≤ 1) : a⁺ = 1 :=
  pos_eq_one_iff.mpr h
#align lattice_ordered_comm_group.pos_of_le_one LatticeOrderedCommGroup.pos_of_le_one
#align lattice_ordered_comm_group.pos_of_nonpos LatticeOrderedCommGroup.pos_of_nonpos

@[to_additive neg_of_inv_nonneg]
theorem neg_of_one_le_inv (a : α) (h : 1 ≤ a⁻¹) : a⁻ = a⁻¹ := by
  rw [neg_eq_pos_inv]
  exact pos_of_one_le _ h
#align lattice_ordered_comm_group.neg_of_one_le_inv LatticeOrderedCommGroup.neg_of_one_le_inv
#align lattice_ordered_comm_group.neg_of_inv_nonneg LatticeOrderedCommGroup.neg_of_inv_nonneg

-- neg_of_neg_nonpos
@[to_additive]
theorem neg_of_inv_le_one (a : α) (h : a⁻¹ ≤ 1) : a⁻ = 1 :=
  neg_eq_one_iff'.mpr h
#align lattice_ordered_comm_group.neg_of_inv_le_one LatticeOrderedCommGroup.neg_of_inv_le_one
#align lattice_ordered_comm_group.neg_of_neg_nonpos LatticeOrderedCommGroup.neg_of_neg_nonpos

-- neg_of_nonpos
@[to_additive]
theorem neg_of_le_one [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) (h : a ≤ 1) : a⁻ = a⁻¹ := by
  refine' neg_of_one_le_inv _ _
  rw [one_le_inv']
  exact h
#align lattice_ordered_comm_group.neg_of_le_one LatticeOrderedCommGroup.neg_of_le_one
#align lattice_ordered_comm_group.neg_of_nonpos LatticeOrderedCommGroup.neg_of_nonpos

-- neg_of_nonneg'
@[to_additive]
theorem neg_of_one_le [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) (h : 1 ≤ a) : a⁻ = 1 :=
  neg_eq_one_iff.mpr h
#align lattice_ordered_comm_group.neg_of_one_le LatticeOrderedCommGroup.neg_of_one_le
#align lattice_ordered_comm_group.neg_of_nonneg LatticeOrderedCommGroup.neg_of_nonneg

-- 0 ≤ a implies |a| = a
@[to_additive abs_of_nonneg]
theorem mabs_of_one_le [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) (h : 1 ≤ a) : |a| = a := by
  rw [abs_eq_sup_inv, sup_eq_mul_pos_div, div_eq_mul_inv, inv_inv, ← pow_two, inv_mul_eq_iff_eq_mul,
    ← pow_two, pos_of_one_le]
  rw [pow_two]
  apply one_le_mul h h
#align lattice_ordered_comm_group.mabs_of_one_le LatticeOrderedCommGroup.mabs_of_one_le
#align lattice_ordered_comm_group.abs_of_nonneg LatticeOrderedCommGroup.abs_of_nonneg

/-- The unary operation of taking the absolute value is idempotent. -/
@[to_additive (attr := simp) abs_abs
  "The unary operation of taking the absolute value is idempotent."]
theorem mabs_mabs [CovariantClass α α (· * ·) (· ≤ ·)] (a : α) : |(|a|)| = |a| :=
  mabs_of_one_le _ (one_le_abs _)
#align lattice_ordered_comm_group.mabs_mabs LatticeOrderedCommGroup.mabs_mabs
#align lattice_ordered_comm_group.abs_abs LatticeOrderedCommGroup.abs_abs

@[to_additive abs_sup_sub_sup_le_abs]
theorem mabs_sup_div_sup_le_mabs [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) :
    |(a ⊔ c) / (b ⊔ c)| ≤ |a / b| := by
  apply le_of_mul_le_of_one_le_left
  · rw [abs_div_sup_mul_abs_div_inf]
  · exact one_le_abs _
#align lattice_ordered_comm_group.mabs_sup_div_sup_le_mabs LatticeOrderedCommGroup.mabs_sup_div_sup_le_mabs
#align lattice_ordered_comm_group.abs_sup_sub_sup_le_abs LatticeOrderedCommGroup.abs_sup_sub_sup_le_abs

@[to_additive abs_inf_sub_inf_le_abs]
theorem mabs_inf_div_inf_le_mabs [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) :
    |(a ⊓ c) / (b ⊓ c)| ≤ |a / b| := by
  apply le_of_mul_le_of_one_le_right
  · rw [abs_div_sup_mul_abs_div_inf]
  · exact one_le_abs _
#align lattice_ordered_comm_group.mabs_inf_div_inf_le_mabs LatticeOrderedCommGroup.mabs_inf_div_inf_le_mabs
#align lattice_ordered_comm_group.abs_inf_sub_inf_le_abs LatticeOrderedCommGroup.abs_inf_sub_inf_le_abs

-- Commutative case, Zaanen, 3rd lecture
-- For the non-commutative case, see Birkhoff Theorem 19 (27)
-- |(a ⊔ c) - (b ⊔ c)| ⊔ |(a ⊓ c) - (b ⊓ c)| ≤ |a - b|
@[to_additive Birkhoff_inequalities]
theorem m_Birkhoff_inequalities [CovariantClass α α (· * ·) (· ≤ ·)] (a b c : α) :
    |(a ⊔ c) / (b ⊔ c)| ⊔ |(a ⊓ c) / (b ⊓ c)| ≤ |a / b| :=
  sup_le (mabs_sup_div_sup_le_mabs a b c) (mabs_inf_div_inf_le_mabs a b c)
set_option linter.uppercaseLean3 false in
#align lattice_ordered_comm_group.m_Birkhoff_inequalities LatticeOrderedCommGroup.m_Birkhoff_inequalities
set_option linter.uppercaseLean3 false in
#align lattice_ordered_comm_group.Birkhoff_inequalities LatticeOrderedCommGroup.Birkhoff_inequalities

-- Banasiak Proposition 2.12, Zaanen 2nd lecture
/-- The absolute value satisfies the triangle inequality.
-/
@[to_additive abs_add_le "The absolute value satisfies the triangle inequality."]
theorem mabs_mul_le [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) : |a * b| ≤ |a| * |b| := by
  apply sup_le
  · exact mul_le_mul' (le_mabs a) (le_mabs b)
  · rw [mul_inv]
    exact mul_le_mul' (inv_le_abs _) (inv_le_abs _)
#align lattice_ordered_comm_group.mabs_mul_le LatticeOrderedCommGroup.mabs_mul_le
#align lattice_ordered_comm_group.abs_add_le LatticeOrderedCommGroup.abs_add_le

-- |a - b| = |b - a|
@[to_additive]
theorem abs_inv_comm (a b : α) : |a / b| = |b / a| := by
  dsimp only [Abs.abs]
  rw [inv_div a b, ← inv_inv (a / b), inv_div, sup_comm]
#align lattice_ordered_comm_group.abs_inv_comm LatticeOrderedCommGroup.abs_inv_comm
#align lattice_ordered_comm_group.abs_neg_comm LatticeOrderedCommGroup.abs_neg_comm

-- | |a| - |b| | ≤ |a - b|
@[to_additive]
theorem abs_abs_div_abs_le [CovariantClass α α (· * ·) (· ≤ ·)] (a b : α) :
|(|a| / |b|)| ≤ |a / b| := by
  rw [abs_eq_sup_inv, sup_le_iff]
  constructor
  · apply div_le_iff_le_mul.2
    convert mabs_mul_le (a / b) b
    · rw [div_mul_cancel']
  · rw [div_eq_mul_inv, mul_inv_rev, inv_inv, mul_inv_le_iff_le_mul,
      abs_inv_comm]
    convert mabs_mul_le (b / a) a
    · rw [div_mul_cancel']
#align lattice_ordered_comm_group.abs_abs_div_abs_le LatticeOrderedCommGroup.abs_abs_div_abs_le
#align lattice_ordered_comm_group.abs_abs_sub_abs_le LatticeOrderedCommGroup.abs_abs_sub_abs_le

end LatticeOrderedCommGroup


import data.nat.basic

-- First definition of prime (quite "prim(e)itive")
def prime (p : ℕ) := p ≥ 2 ∧ ∀ (m < p), m ∣ p → m = 1

open nat

-- A lemma to prove that 4 is not prime
lemma two_divides_four : 2 ∣ 4 :=
begin
    dsimp [(∣)],
    use 2,
    refl,
end

-- Question 1a
theorem four_is_not_prime : ¬ (prime 4) :=
begin
    unfold prime,
    simp [not_and_distrib],
    right,
    intros h,
    have h₁ : 2 ∣ 4, by exact two_divides_four,
    have h₂ : 2 < 4, by exact dec_trivial,
    have w := h 2 h₂ h₁,
    have w' : 2 ≠ 1, by exact dec_trivial,
    contradiction,
end

-- A lemma to prove that 5 is prime; dec_trivial was not used because we can't use tactics in MathLib
lemma five_ge_two : 5 ≥ 2 :=
begin
    dsimp [(≥)],
    rw [le_iff_lt_or_eq],
    left,
    have h₁ : 3 ≠ 0, begin
        intros h,
        contradiction,
    end,
    have h₂ : 3 > 0, by exact nat.pos_of_ne_zero h₁,
    dsimp [(>)] at h₂,
    have h₃ : 1 < 4, by exact succ_lt_succ h₂,
    have h₄ : 2 < 5, by exact succ_lt_succ h₃,
    exact h₄,
end

-- This tactic gives a contradiction proof that a non-factor does not divide a number
-- I couldn't work out how to make the name n be given as an input
meta def case_bash : tactic unit :=
`[intros h, repeat {cases n, cases h, try {cases h}}]

lemma two_not_div_five (n : ℕ) : 5 ≠ 2 * n := by case_bash

lemma three_not_div_five (n : ℕ) : 5 ≠ 3 * n := by case_bash

lemma four_not_div_five (n : ℕ) : 5 ≠ 4 * n := by case_bash

-- Question 1a
theorem five_is_prime : prime 5 :=
begin
    unfold prime,
    split,
    exact five_ge_two,
    intros m h w,
    cases m,
    dsimp [(∣)] at w,
    cases w with c w,
    simp only [zero_mul] at w,
    contradiction,
    cases m,
    trivial,
    cases m,
    cases w with c w,
    have w' : 5 ≠ 2 * c, by apply two_not_div_five,
    contradiction,
    cases m,
    cases w with c w,
    have w' : 5 ≠ 3 * c, by apply three_not_div_five,
    contradiction,
    cases m,
    cases w with c w,
    have w' : 5 ≠ 4 * c, by apply four_not_div_five,
    contradiction,
    cases m,
    repeat {cases h with h h},
end

-- It is decidable that one natural number is greater than or equal to another
instance decidable_ge {a b : ℕ} : decidable (a ≥ b) :=
begin
    dsimp [(≥)],
    apply nat.decidable_le b a,
end

-- Builds up in stages that the right-hand side of the and statement in the definition of prime
-- is decidable. It begins by saying that it is decidable if a number equals 1.
-- Then it is decidable if one number divides another. Finally, a lemma from MathLib is used
-- which says that it is decidable that, if you have an upper bound for a predicate and that
-- predicate is decidable for any specific natural number then it is decidable for all natural
-- numbers.
instance decidable_divisors {p : ℕ} : decidable (∀ (m : ℕ), m < p → m ∣ p → m = 1) :=
begin
    apply nat.decidable_ball_lt p (λ (m : ℕ) (a : m < p), m ∣ p → m = 1),
end

-- First instance of decidability about primes. Uses and.decidable and the previous two
-- lemmas to say that the whole statement is decidable.
-- Note that haveI is used to update the instance cache after the instances are declared.
instance decidable_prime : decidable_pred prime :=
begin
    intros p,
    unfold prime,
    haveI h₁ : decidable (p ≥ 2) := decidable_ge,
    haveI h₂ : decidable (∀ (m : ℕ), m < p → m ∣ p → m = 1) := decidable_divisors,
    apply and.decidable,
end

-- A second definition of primality. We will prove that this is equivalent to the
-- first definition.
def prime' (p : ℕ) := p ≥ 2 ∧ ∀ (m ≤ p/2), m ∣ p → m = 1

-- If a natural number a is less than or equal to b/2 then it is less than b
-- Used as a lemma in prime_im_prime'
lemma lt_half_lt {a b : ℕ} : (b > 0) → a ≤ b/2 → a < b :=
begin
    intros h w,
    have h₁ : 2 > 1, by exact dec_trivial,
    have h₂ : b/2 < b, by apply div_lt_self h h₁,
    have h₃ : a < b, by apply lt_of_le_of_lt w h₂,
    exact h₃,
end

-- Essentially used to say that if p is prime then p > 0
lemma ge_two_gt_zero {p : ℕ} : p ≥ 2 → p > 0 :=
begin
    intros h,
    dsimp [(≥)] at h,
    have w₁ : 1 < p, by apply lt_of_succ_le h,
    have w₂ : 0 < 1, by exact dec_trivial,
    have w₃ : 0 < p, by apply lt_trans w₂ w₁,
    dsimp [(>)],
    exact w₃,
end

-- Non-zero factors of a number respect multiplication
lemma div_gt_zero_eq {m p k: ℕ} : m ∣ p → m > 0 → p / m = k → p = m * k :=
begin
    intros h₁ h₂ h₃,
    have h₄ : m * p / m = p := nat.mul_div_cancel_left p h₂,
    subst h₃,
    have h₅ : m * p / m = m * (p / m) := nat.mul_div_assoc m h₁,
    rw h₅ at h₄,
    exact h₄.symm,
end

-- The reciprocals of positive natural numbers behave as you would
-- expect them to under ≤
lemma dvd_pos_lt {a b c : ℕ} : c ≤ b → 0 < c → a / b ≤ a / c :=
begin
    intros h₁ h₂,
    apply (le_div_iff_mul_le (a/b) a h₂).2,
    have h₃ : a * c ≤ a * b := mul_le_mul_left a h₁,
    apply le_trans,
    swap,
    apply div_mul_le_self',
    exact b,
    apply nat.mul_le_mul_left (a/b),
    exact h₁,
end

-- The first definition prime → the second definition prime'
theorem prime_im_prime' {p : ℕ} : prime p → prime' p :=
begin
    intro h,
    unfold prime at h,
    unfold prime',
    split,
    exact h.1,
    have ge := h.1,
    have h₁ := h.2,
    intros m w₁ w₂,
    have w₃ : p > 0, by apply ge_two_gt_zero ge,
    have w₄ : m < p, by apply lt_half_lt w₃ w₁,
    have w₅ : m = 1, by apply h₁ m w₄ w₂,
    exact w₅,
end

-- The second definition prime' → the first definition prime
theorem prime'_im_prime {p : ℕ} : prime' p → prime p :=
begin
    intros w,
    unfold prime' at w,
    unfold prime,
    split,
    exact w.1,
    have ge := w.1,
    intros m w₁ w₂,
    by_cases (m ≤ p/2),
    exact w.2 m h w₂,
    simp at h,
    have two_gt_zero : 2 > 0, by exact dec_trivial,
    -- Wasn't written as a lemma because I felt it would be unwieldy to pass
    -- hypotheses around
    have one_lt_half : p / 2 ≥ 1, begin
        have le : 2 ≤ p := ge,
        have z : 2/2 ≤ p / 2 := nat.div_le_div_right le,
        have h₁ : 2 / 2 = 1 := nat.div_self two_gt_zero,
        rw [h₁] at z,
        exact z,
    end,
    -- Same as above. Relies on hypotheses.
    have h₄ : m > 0, begin
        have zero_lt_one : 0 < 1, by exact dec_trivial,
        have h₂ : 0 < p / 2, by apply lt_of_lt_of_le zero_lt_one one_lt_half,
        exact (lt_trans h₂ h),
    end,
    have m_gt_one : m > 1, by apply lt_of_le_of_lt one_lt_half h,
    have m_ge_two : m ≥ 2, by apply succ_le_of_lt m_gt_one,
    have h₁ : p / m ≤ p / 2 := dvd_pos_lt m_ge_two two_gt_zero,
    have h₂ : p / m ∣ p, by apply div_dvd_of_dvd w₂,
    have h₃ : p / m = 1, by apply w.2 (p/m) h₁ h₂,
    have h₅ : p = m * 1 := div_gt_zero_eq w₂ h₄ h₃,
    simp at h₅,
    subst h₅,
    have h₆ : p ≥ p, by exact le_refl p,
    have h₇ : ¬ (p < p), by simp,
    exact (absurd w₁ h₇),
end

-- Uses the constructor for ↔ and the above implications to give an equivalence statement
theorem prime_equiv_statement {p : ℕ} : prime p ↔ prime' p :=
⟨prime_im_prime', prime'_im_prime⟩

-- See explanation above decidable_divisors. Construction is the same but upper bound used is p/2
-- instead of p
instance decidable_divisors' {p : ℕ}: decidable (∀ (m : ℕ), m < p / 2 → m ∣ p → m = 1) :=
nat.decidable_ball_lt (p / 2) (λ (m : ℕ) (a : m < p / 2), m ∣ p → m = 1)

-- Says that it is possible to decide if a natural number is prime under prime'
instance decidable_prime' : decidable_pred prime' :=
begin
    intros p,
    unfold prime',
    haveI h₁ : decidable (p ≥ 2) := decidable_ge,
    haveI h₂ : decidable (∀ (m : ℕ), m < p / 2 → m ∣ p → m = 1) := decidable_divisors',
    apply and.decidable,
end

-- Gives a "better" instance for decidable_prime by applying the equivalence of
-- prime and prime'. It is better because you only need to check half as many natural numbers.
instance decidable_prime_v2 : decidable_pred prime :=
begin
    intros p,
    apply decidable_of_iff' (prime' p) (@prime_equiv_statement p),
end


import data.int.gcd
import data.int.modeq
import tactic

namespace int

theorem dvd_one {n : ℤ} (h : n ∣ 1) : n = 1 ∨ n = -1 :=
begin
	by_cases hn : 0 ≤ n,
	{	left, exact eq_one_of_dvd_one hn h },
	right,
	rw ← neg_dvd at h,
	rw eq_neg_iff_eq_neg, symmetry,
	exact eq_one_of_dvd_one (neg_nonneg.mpr $ le_of_not_ge hn) h,
end

section gcd

theorem exists_mul_eq_gcd (a b : ℤ) : ∃ x y, a * x + b * y = gcd a b :=
begin
	have : ∃ x y : ℤ, ↑(nat_abs a) * x + ↑(nat_abs b) * y = gcd a b,
	{	use [nat.gcd_a (nat_abs a) (nat_abs b), nat.gcd_b (nat_abs a) (nat_abs b)],
		rw ← nat.gcd_eq_gcd_ab, congr },
	rcases this with ⟨x, y, hxy⟩,
	cases nat_abs_eq a with ha ha,
	{	rw ← ha at hxy,
		cases nat_abs_eq b with hb hb,
		{	rwa ← hb at hxy, use [x, y, hxy] },
		use [x, -y], conv_lhs { rw hb }, simpa },
	cases nat_abs_eq b with hb hb,
	{	use [-x, y], conv_lhs { rw [ha, hb] }, simpa },
	use [-x, -y], conv_lhs { rw [ha, hb] }, simpa,
end

theorem mul_of_coprime_mul {a b c d : ℤ} (hab : gcd a b = 1) (h : a * c = b * d) :
	∃ n, c = n * b ∧ d = n * a  :=
begin
	rcases exists_mul_eq_gcd a b with ⟨x, y, hxy⟩,
	simp [hab] at hxy,
	use d * x + c * y, split,
	{ calc c
	      = c * (a * x + b * y)   : by rw [hxy, mul_one]
		... = a * c * x + c * b * y : by ring
		... = b * d * x + c * b * y : by rw h
		... = (d * x + c * y) * b   : by ring },
	{ calc d
		    = d * (a * x + b * y)   : by rw [hxy, mul_one]
		... = d * a * x + b * d * y : by ring
		... = d * a * x + a * c * y : by rw ← h
		... = (d * x + c * y) * a   : by ring },
end

end gcd

end int