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

import data.fintype.basic
import computability.language
import tactic.norm_num

/-!
# Deterministic Finite Automata
This file contains the definition of a Deterministic Finite Automaton (DFA), a state machine which
determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set
in linear time.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true DFA's.
-/

universes u v

/-- A DFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`). -/
structure DFA (α : Type u) (σ : Type v) :=
(step : σ → α → σ)
(start : σ)
(accept : set σ)

namespace DFA

variables {α : Type u} {σ : Type v} (M : DFA α σ)

instance [inhabited σ] : inhabited (DFA α σ) :=
⟨DFA.mk (λ _ _, default) default ∅⟩

/-- `M.eval_from s x` evaluates `M` with input `x` starting from the state `s`. -/
def eval_from (start : σ) : list α → σ :=
list.foldl M.step start

@[simp] lemma eval_from_nil (s : σ) : M.eval_from s [] = s := rfl
@[simp] lemma eval_from_singleton (s : σ) (a : α) : M.eval_from s [a] = M.step s a := rfl
@[simp] lemma eval_from_append_singleton (s : σ) (x : list α) (a : α) :
  M.eval_from s (x ++ [a]) = M.step (M.eval_from s x) a :=
by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

/-- `M.eval x` evaluates `M` with input `x` starting from the state `M.start`. -/
def eval : list α → σ := M.eval_from M.start

@[simp] lemma eval_nil : M.eval [] = M.start := rfl
@[simp] lemma eval_singleton (a : α) : M.eval [a] = M.step M.start a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a : α) :
  M.eval (x ++ [a]) = M.step (M.eval x) a :=
eval_from_append_singleton _ _ _ _

lemma eval_from_of_append (start : σ) (x y : list α) :
  M.eval_from start (x ++ y) = M.eval_from (M.eval_from start x) y :=
x.foldl_append _ _ y

/-- `M.accepts` is the language of `x` such that `M.eval x` is an accept state. -/
def accepts : language α :=
λ x, M.eval x ∈ M.accept

lemma mem_accepts (x : list α) : x ∈ M.accepts ↔ M.eval_from M.start x ∈ M.accept := by refl

lemma eval_from_split [fintype σ] {x : list α} {s t : σ} (hlen : fintype.card σ ≤ x.length)
  (hx : M.eval_from s x = t) :
  ∃ q a b c,
  x = a ++ b ++ c ∧
  a.length + b.length ≤ fintype.card σ ∧
  b ≠ [] ∧
  M.eval_from s a = q ∧
  M.eval_from q b = q ∧
  M.eval_from q c = t :=
begin
  obtain ⟨n, m, hneq, heq⟩ := fintype.exists_ne_map_eq_of_card_lt
    (λ n : fin (fintype.card σ + 1), M.eval_from s (x.take n)) (by norm_num),
  wlog hle : (n : ℕ) ≤ m using n m,
  have hlt : (n : ℕ) < m := (ne.le_iff_lt hneq).mp hle,
  have hm : (m : ℕ) ≤ fintype.card σ := fin.is_le m,
  dsimp at heq,

  refine ⟨M.eval_from s ((x.take m).take n), (x.take m).take n, (x.take m).drop n, x.drop m,
    _, _, _, by refl, _⟩,

  { rw [list.take_append_drop, list.take_append_drop] },

  { simp only [list.length_drop, list.length_take],
    rw [min_eq_left (hm.trans hlen), min_eq_left hle, add_tsub_cancel_of_le hle],
    exact hm },

  { intro h,
    have hlen' := congr_arg list.length h,
    simp only [list.length_drop, list.length, list.length_take] at hlen',
    rw [min_eq_left, tsub_eq_zero_iff_le] at hlen',
    { apply hneq,
      apply le_antisymm,
      assumption' },
    exact hm.trans hlen, },

  have hq :
    M.eval_from (M.eval_from s ((x.take m).take n)) ((x.take m).drop n) =
      M.eval_from s ((x.take m).take n),
  { rw [list.take_take, min_eq_left hle, ←eval_from_of_append, heq, ←min_eq_left hle,
        ←list.take_take, min_eq_left hle, list.take_append_drop] },

  use hq,
  rwa [←hq, ←eval_from_of_append, ←eval_from_of_append, ←list.append_assoc, list.take_append_drop,
       list.take_append_drop]
end

lemma eval_from_of_pow {x y : list α} {s : σ} (hx : M.eval_from s x = s)
  (hy : y ∈ @language.star α {x}) : M.eval_from s y = s :=
begin
  rw language.mem_star at hy,
  rcases hy with ⟨ S, rfl, hS ⟩,
  induction S with a S ih,
  { refl },
  { have ha := hS a (list.mem_cons_self _ _),
    rw set.mem_singleton_iff at ha,
    rw [list.join, eval_from_of_append, ha, hx],
    apply ih,
    intros z hz,
    exact hS z (list.mem_cons_of_mem a hz) }
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card σ ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card σ ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  obtain ⟨_, a, b, c, hx, hlen, hnil, rfl, hb, hc⟩ := M.eval_from_split hlen rfl,
  use [a, b, c, hx, hlen, hnil],
  intros y hy,
  rw language.mem_mul at hy,
  rcases hy with ⟨ ab, c', hab, hc', rfl ⟩,
  rw language.mem_mul at hab,
  rcases hab with ⟨ a', b', ha', hb', rfl ⟩,
  rw set.mem_singleton_iff at ha' hc',
  substs ha' hc',
  have h := M.eval_from_of_pow hb hb',
  rwa [mem_accepts, eval_from_of_append, eval_from_of_append, h, hc]
end

end DFA


/-
Copyright (c) 2020 Bjørn Kjos-Hanssen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Bjørn Kjos-Hanssen.
Zulip chat help from:
Alex J. Best, Johan Commelin, Kyle Miller, Pedro Minicz, Reid Barton, Scott Morrison, Heather Macbeth.
-/
import data.finset  -- finite set
import data.set -- to make backslash work as set difference
import data.finset.basic
import topology.metric_space.basic

import data.real.basic

/-!
# A theorem on metrics based on min and max
In this file we give a formal proof of Theorem 17 from [KNYHLM21].
It asserts that d(X,Y)= m min(|X\Y|, |Y\X|) + M max(|X\Y|, |Y\X|) is a metric
if and only if m ≤ M.
## Main results
- `seventeen`: the proof of Theorem 17.
- `instance jaccard_numerator.metric_space`: the realization as a `metric_space` type.
## Notation
 - `|_|` : Notation for cardinality.
## References
See [KNYHLM21] for the original proof.
-/

open finset
local notation |X| := X.card

-- Kyle Miller (start) although proofs of disj1, disj2 due to K-H

variables {α : Type*} [decidable_eq α]
variables {β : Type*}

lemma disj₁ (X Y Z : finset α) : disjoint ((X \ Y) ∪ (Y \ Z)) (Z \ X) := by { rw disjoint_iff, tidy}
lemma disj₂ (X Y Z : finset α) : disjoint (X \ Y) (Y \ Z) := by { rw disjoint_iff, tidy}

lemma union_rot_sdiff (X Y Z : finset α) :
    (X \ Y) ∪ (Y \ Z) ∪ (Z \ X) = (X \ Z) ∪ (Z \ Y) ∪ (Y \ X) :=
    by { tidy, by_cases h: a∈ Z,cc,cc,by_cases h:a ∈ X,cc,cc,by_cases h: a ∈ Y, cc, cc,
    by_cases h: a ∈ Y, cc, cc, by_cases h: a ∈ X, cc, cc, by_cases h: a ∈ Z, cc, cc,
    }
    --by { ext, simp only [mem_union, mem_sdiff, union_assoc], tauto! }

lemma card_rot (X Y Z : finset α) : |X \ Y| + |Y \ Z| + |Z \ X| = |X \ Z| + |Z \ Y| + |Y \ X| := by {
    have key := congr_arg card (union_rot_sdiff X Y Z),

    rwa [
        card_disjoint_union (disj₁ X Y Z), card_disjoint_union (disj₁ X Z Y),
        card_disjoint_union (disj₂ X Y Z), card_disjoint_union (disj₂ X Z Y)
    ] at key,
}

-- Kyle Miller (end)

lemma card_rot_cast (X Y Z : finset α) : ((|X\Y| + |Y\Z| + |Z\X|):ℝ) = ((|X\Z| + |Z\Y| + |Y\X|):ℝ) :=
    have |X\Y| + |Y\Z| + |Z\X| = |X\Z| + |Z\Y| + |Y\X|, from card_rot X Y Z,
    by { norm_cast,exact this }

variables {m M : ℝ}
set_option profiler true

/-- The function δ is a stepping stone towards Jaccard inequality. It is not normalized to be between 0 and 1. -/
def δ : ℝ → ℝ → finset α → (finset α → ℝ) :=
    λ m M A B, M * ↑ (max (|A\B|) (|B\A|)) + m * ↑ (min (|A\B|) (|B\A|))

set_option profiler false

theorem delta_cast {m M:ℝ} {A B : finset α} :
    δ m M A B = M * (max ↑(|A\B|) ↑(|B\A|)) + m * (min ↑(|A\B|) ↑(|B\A|)) := by norm_cast

theorem delta_comm {m M : ℝ} {A B : finset α}: δ m M A B = δ m M B A := -- improved December 25, 2020
    calc δ m M A B = M * ↑ (max (|A\B|) (|B\A|)) + m * ↑ (min (|A\B|) (|B\A|)) : by rw[δ]
               ... = M * max (|A\B|) (|B\A|) + m * min (|A\B|) (|B\A|)         : by norm_cast
               ... = M * max (|B\A|) (|A\B|) + m * min (|B\A|) (|A\B|)         : by rw[max_comm,min_comm]
               ... = M * ↑ (max (|B\A|) (|A\B|)) + m * ↑ (min (|B\A|) (|A\B|)) : by norm_cast
               ... = δ m M B A                                                 : by rw[δ]

lemma card_sdiff_self (X : finset α) : |X \ X| = 0 :=
  calc |X \ X| = |(∅: finset α)|: by rw (sdiff_self X)
           ... = 0: card_empty

theorem delta_self (X : finset α): δ m M X X = 0 := -- improved December 25, 2020
    calc  δ m M X X = M * ((max (|X \ X|) (|X \ X|)):ℝ) + m * ((min (|X \ X|) (|X \ X|)):ℝ) : by norm_cast
                ... = M * ((max 0   0  ):ℝ)             + m * ((min 0   0  ):ℝ)             : by {rw[card_sdiff_self],norm_cast,}
                ... = M * ((max (0:ℝ)   (0:ℝ)  ))       + m * ((min (0:ℝ)   (0:ℝ)  ))       : by norm_cast
                ... = M * (0:ℝ)                         + m * (0:ℝ)                         : by rw[max_self (0:ℝ), min_self (0:ℝ)]
                ... = 0                                                                     : by rw[mul_zero, zero_add,mul_zero]

lemma subseteq_of_card_zero (x y : finset α) : |x \ y| = 0 → x ⊆ y :=
    λ h : |x \ y| = 0,
    have v: x \ y = ∅, from (iff.elim_left (finset.card_eq_zero)) h,
    (iff.elim_left finset.sdiff_eq_empty_iff_subset) v

lemma card_zero_of_not_pos (X : finset β) : ¬ 0 < |X| → |X| = 0 :=
    λ h: ¬ 0 < |X|,
    eq.symm ((iff.elim_right eq_iff_le_not_lt) (and.intro (nat.zero_le (|X|)) h))

lemma eq_zero_of_nonneg_of_nonneg_of_add_zero {a b : ℝ} : 0 ≤ a → 0 ≤ b → 0 = a + b → 0 = a :=
    λ ha: 0 ≤ a, λ hb: 0 ≤ b, λ h: 0 = a + b,
    have h1: ¬ 0 < a, from
        assume h2: 0 < a,
        have h4: 0 < a + b, from lt_add_of_lt_of_nonneg h2 hb,
        have h3: 0 ≤ a + b ∧ ¬ 0 < a + b, from (iff.elim_left eq_iff_le_not_lt) h,
        h3.elim_right h4,
    have h0: 0 ≤ a ∧ ¬ 0 < a, from and.intro ha h1,
    (iff.elim_right eq_iff_le_not_lt) h0

theorem subset_of_delta_eq_zero (hm: 0 < m) (hM: m ≤ M) (X Y : finset α) (h: δ m M X Y = 0) : X ⊆ Y :=
    let x_y := |X \ Y| in let y_x := |Y \ X| in -- improved December 25, 2020
    /- The following interacts poorly with casting
    let maxN := max x_y y_x in let minN := min x_y y_x in
    let maxR := (maxN : ℝ) in let minR := (minN : ℝ) in
    -/
    have δ_0: 0 = M * ((max x_y y_x):ℝ) + m * ((min x_y y_x):ℝ), from calc
              0 = δ m M X Y : by rw h
            ... = M * ((max x_y y_x):ℝ) + m * ((min x_y y_x):ℝ) : by norm_cast,
    have not_pos_δ: ¬ 0 < M * ((max x_y y_x):ℝ) + m * ((min x_y y_x):ℝ), from
        (iff.elim_right (not_lt_iff_eq_or_lt)) (or.inl δ_0),
    have min_nonneg: 0 ≤ ((min x_y y_x):ℝ),
        begin norm_cast, exact (le_min (nat.zero_le x_y) (nat.zero_le y_x)) end,
    have M_pos: 0 < M, from calc
                0 < m : hm
              ... ≤ M : hM,

    have pos_δ_of_pos_x: 0 < x_y → 0 < M * ((max x_y y_x):ℝ) + m * ((min x_y y_x):ℝ), from
        λ h: 0 < x_y,
        have strict_x: 0 <  (max x_y y_x), from
            (iff.elim_right lt_max_iff) (or.inl h),
        have cast_x: 0 <  ((max x_y y_x):ℝ),
            begin norm_cast, exact strict_x end,
        have Mx_pos: 0 < (M * ((max x_y y_x):ℝ)), from
            mul_pos M_pos cast_x,
        lt_add_of_lt_of_nonneg Mx_pos (mul_nonneg (le_of_lt hm) min_nonneg),

    have r0: ¬ 0 < x_y, from λ pos_x, not_pos_δ (pos_δ_of_pos_x pos_x),

    subseteq_of_card_zero X Y (card_zero_of_not_pos (X\Y) r0)

 theorem eq_of_delta_eq_zero (hm: 0 < m) (hM: m ≤ M) (X Y : finset α) (h: δ m M X Y = 0) :
 X = Y :=
    let x_y := |X \ Y| in let y_x := |Y \ X| in
 have g0: X ⊆ Y, from subset_of_delta_eq_zero hm hM X Y h,
 have g: δ m M Y X = 0, from calc δ m M Y X = δ m M X Y: by rw[delta_comm]
 ... = 0: h,
 have g1: Y ⊆ X, from subset_of_delta_eq_zero hm hM Y X g,
     finset.subset.antisymm g0 g1

theorem sdiff_covering {A B C : finset α}: A\C ⊆ (A\B) ∪ (B\C) :=
  λ a,
  λ g : a ∈ A \ C,
  have hac:a ∈ A \ C ↔ a ∈ A ∧ a ∉ C, from mem_sdiff,
  have hab:a ∈ A \ B ↔ a ∈ A ∧ a ∉ B, from mem_sdiff,
  have hbc:a ∈ B \ C ↔ a ∈ B ∧ a ∉ C, from mem_sdiff,
  have h_ac: a ∈ A ∧ a ∉ C, from (iff.elim_left hac) g,
  (em (a ∈ B)).elim(
    λ h: a ∈ B,
    have h_bc: a ∈ B ∧ a ∉ C, from and.intro h (h_ac.right),
    (iff.elim_right mem_union) (or.inr ((iff.elim_right hbc) h_bc))
  )(
    λ h: a ∉ B,
    have h_ab: a ∈ A ∧ a ∉ B, from and.intro (h_ac.left) h,
    (iff.elim_right mem_union) (or.inl ((iff.elim_right hab) h_ab))
  )

theorem sdiff_triangle (A B C: finset α): |A\C| ≤ |A\B| + |B\C| :=
    calc |A\C| ≤ |A\B  ∪ B\C|: finset.card_le_of_subset (sdiff_covering)
           ... = |A\B| + |B\C| : by rw (finset.card_disjoint_union (disj₂ A B C))

lemma venn (X Y : finset α): X = X\Y ∪ (X ∩ Y) := begin ext, simp, tauto! end

lemma venn_card (X Y : finset α): |X| = |X\Y| + |X ∩ Y| :=
    have h: disjoint (X\Y) (X ∩ Y), from
      have g0: (X\Y) ∩ (X ∩ Y) = ∅ → disjoint (X\Y) (X ∩ Y), from iff.elim_right disjoint_iff,
      have g1: (X\Y) ∩ (X ∩ Y) ⊆ ∅ → (X\Y) ∩ (X ∩ Y) = ∅, from iff.elim_left subset_empty,
      have g2: (X\Y) ∩ (X ∩ Y) ⊆ ∅, from
        assume x,
        assume h0: x ∈ (X\Y) ∩ (X ∩ Y),
        have h1: x ∈ X \ Y ∧ x ∈ X ∩ Y, from (iff.elim_left mem_inter) h0,
        have h2: x ∉ Y, from and.elim_right ((iff.elim_left mem_sdiff) h1.left),
        have h3: x ∈ Y, from and.elim_right ((iff.elim_left mem_inter) h1.right),
        h2 h3,
      g0 (g1 g2),
    calc
    |X| = |X \ Y  ∪  X ∩ Y| : by rw ← (venn X Y)
    ... = |X \ Y| + |X ∩ Y| : finset.card_disjoint_union h

lemma sdiff_card (X Y : finset α): |Y| ≤ |X| → |Y\X| ≤ |X\Y| :=
    assume h: |Y| ≤ |X|,
    have h₀: |Y\X| + |Y ∩ X| ≤ |X\Y| + |X ∩ Y|,
        begin
            rw (venn_card X Y) at h,
            rw (venn_card Y X) at h,
            exact h
        end,
    have h₂: |Y ∩ X| = |X ∩ Y|, {rw (inter_comm Y X)},
    have h₃: |Y\X| + |X ∩ Y| ≤ |X\Y| + |X ∩ Y|,
        begin rw h₂ at h₀, exact h₀ end,
    le_of_add_le_add_right h₃

lemma maxmin_1 {X Y : finset α}: |X| ≤ |Y| → δ m M X Y = M * |Y\X| + m * |X\Y| :=
    let x_y := |X\Y| in let y_x := |Y\X| in
    assume h₁: |X| ≤ |Y|,
        have h₂: x_y ≤ y_x, from sdiff_card Y X h₁,
        calc δ m M X Y = M * ↑ (max x_y y_x) + m * ↑(min x_y y_x) : rfl
                   ... = M * ↑ y_x            + m * ↑ x_y : by rw[max_eq_right h₂,min_eq_left h₂]

lemma maxmin_2 {X Y : finset α}: |Y| ≤ |X| → δ m M X Y = M * |X\Y| + m * |Y\X| :=
-- resolve max and min
    let x_y := |X\Y| in let y_x := |Y\X| in
    assume h₁: |Y| ≤ |X|,
        have h₂: y_x ≤ x_y, from sdiff_card X Y h₁,
        calc δ m M X Y = M * ↑ (max x_y y_x) + m * ↑(min x_y y_x) : rfl
                   ... = M * ↑ x_y            + m * ↑y_x : by rw[max_eq_left h₂,min_eq_right h₂]

theorem casting {a b : ℕ}: a ≤ b → (a:ℝ) ≤ (b:ℝ) :=
    begin intro h, norm_cast, exact h end

theorem mul_sdiff_tri (m : ℝ) (hm: 0 ≤ m) (X Y Z : finset α):
    m * ↑ |X\Z| ≤ m * (↑ |X\Y| + ↑ |Y\Z|) :=
    calc m * ↑ (|X\Z|)
       ≤ m * ↑ ((|X\Y|) + (|Y\Z|)) : mul_le_mul_of_nonneg_left (casting(sdiff_triangle X Y Z)) hm
   ... = m * ((|X\Y|:ℝ) + (|Y\Z|:ℝ)): by norm_cast

/-- The triangle inequality for δ -/
def triangle_inequality (m M :ℝ) (X Y Z: finset α) : Prop :=
    δ m M X Y ≤ δ m M X Z + δ m M Z Y

lemma seventeen_right_yzx {m M :ℝ} {X Y Z: finset α} :
    0 ≤ m → m ≤ M → |Y| ≤ |Z| ∧ |Z| ≤ |X| → triangle_inequality m M X Y Z
    :=
    let x := |X|, y := |Y|, z := |Z|,
        x_z := |X\Z|, z_x := |Z\X|, y_z := |Y\Z|,
        z_y := |Z\Y|, x_y := |X\Y|, y_x := |Y\X| in
    λ hm : 0 ≤ m, λ h: m ≤ M,
    have hM : 0 ≤ M, from le_trans hm h,
    assume h₀: y ≤ z ∧ z ≤ x,
    have h₂: y ≤ z, from and.elim_left h₀,
    have h₃: z ≤ x, from and.elim_right h₀,
    have h₁: y ≤ x, from le_trans h₂ h₃,
    have dxz: δ m M X Z = M * (x_z) + m * (z_x), from maxmin_2 h₃,
    have dzy: δ m M Z Y = M * (z_y) + m * (y_z), from maxmin_2 h₂,--used implicitly by a tactic

    have mst_yzx: m* ↑ (|Y\X|) ≤ m *  (↑ (y_z) + ↑ (z_x)), from
        mul_sdiff_tri m hm Y Z X,
    have mst_xzy: M* ↑ (x_y) ≤ M *  (↑ (x_z) + ↑ (z_y)), from
        mul_sdiff_tri M hM X Z Y,
    calc
    δ m M X Y = M * (x_y) + m * (|Y\X|)                   : maxmin_2 h₁
          ... ≤ M * (x_y) + m * ((y_z) + (z_x))           : add_le_add_left mst_yzx (M * (x_y))
          ... ≤ M * (x_z + z_y) + m * (y_z + z_x)         : add_le_add_right mst_xzy (m * ((y_z) + (z_x)))
          ... = (M * x_z + m * z_x) + (M * z_y + m * y_z) : by ring
          ... = δ m M X Z                     + δ m M Z Y : by rw[dxz,dzy]
#lint

lemma co_sdiff (X Y U : finset α):
X ⊆ U → Y ⊆ U → (U\X)\(U\Y) = Y\X :=
λ gx, λ gy,
have hh: (∀ x : α, x ∈ (U\X)\(U\Y) ↔ x ∈ Y\X), from
  assume x:α,
  calc x ∈ (U\X)\(U\Y) ↔ x ∈ (U\X) ∧ x ∉ (U\Y): mem_sdiff
                   ... ↔ (x ∈ U ∧ x ∉ X) ∧ x ∉ (U\Y): by rw[mem_sdiff]
                   ... ↔ (x ∈ U ∧ x ∉ X) ∧ ¬ (x ∈ U ∧ x ∉ Y): by rw[mem_sdiff]
                   ... ↔ (x ∈ U ∧ x ∉ X) ∧ (x ∈ Y): by {
                     by_cases (x ∈ U),rename h g0,
                     by_cases (x ∉ X),rename h g1, -- more clever to use x ∉ X than x ∈ X here
                     by_cases (x ∈ Y),rename h g2,
                     cc,cc,cc,cc,
                     }
                  ... ↔ x ∉ X ∧ x ∈ Y: by {split,intro h,have q: (x ∈ Y) := h.right,
                  have r: (x ∉ X) := h.left.right, exact and.intro r q,intro h,
                  have q: (x ∈ Y) := h.right, have qq : (x ∈ U) := gy q,exact and.intro (and.intro qq h.left) q,
                   -- using "have" in tactic mode
                  }
                  ... ↔ x ∈ Y ∧ x ∉ X: by rw[and_comm (x ∉ X) (x ∈ Y)]
                  ... ↔ x ∈ Y \ X: by rw[mem_sdiff],
(iff.elim_right finset.ext_iff) hh

--#print co_sdiff

lemma co_sdiff_card (X Y U : finset α):
X ⊆ U → Y ⊆ U → ((U\X)\(U\Y)).card = (Y\X).card :=
    λ hx: X ⊆ U, λ hy: Y ⊆ U,
    by {rw co_sdiff X Y U, exact hx,exact hy,}

lemma co_sdiff_card_max (X Y U : finset α):
X ⊆ U → Y ⊆ U → max (|(U\Y)\(U\X)|) (|(U\X)\(U\Y)|) = max (|X\Y|) (|Y\X|) :=
    λ hx: X ⊆ U, λ hy: Y ⊆ U,
    by {rw[co_sdiff_card X Y U hx hy,co_sdiff_card Y X U hy hx],}

lemma co_sdiff_card_min (X Y U : finset α):
X ⊆ U → Y ⊆ U → min (|(U\Y)\(U\X)|) (|(U\X)\(U\Y)|) = min (|X\Y|) (|Y\X|) :=
    λ hx: X ⊆ U, λ hy: Y ⊆ U,
    by {rw[co_sdiff_card X Y U hx hy,co_sdiff_card Y X U hy hx],}

theorem delta_complement (X Y U : finset α):
    X ⊆ U → Y ⊆ U → δ m M X Y = δ m M (U\Y) (U\X) :=
    λ hx: X ⊆ U, λ hy: Y ⊆ U,
    let Y' := U\Y, X' := U\X in
    have co1: |X'\Y'| = |Y\X|, from co_sdiff_card X Y U hx hy,
    have co2: |Y'\X'| = |X\Y|, from co_sdiff_card Y X U hy hx,
    have co3: max (|Y'\X'|) (|X'\Y'|) = max (|X\Y|) (|Y\X|), from
        co_sdiff_card_max X Y U hx hy,
    have co4: min (|Y'\X'|) (|X'\Y'|) = min (|X\Y|) (|Y\X|), from
        co_sdiff_card_min X Y U hx hy,
    have defi: δ m M Y' X' = M * ↑ (max (|Y'\X'|) (|X'\Y'|)) + m * ↑ (min (|Y'\X'|) (|X'\Y'|)),
    from refl (δ m M Y' X'),
    calc δ m M X Y = M * ↑ (max (|X\Y|) (|Y\X|)) + m * ↑ (min (|X\Y|) (|Y\X|)): refl (δ m M X Y)
    ... = M * ↑ (max (|Y'\X'|) (|X'\Y'|)) + m * ↑ (min (|X\Y|) (|Y\X|)): by rw co3
    ... = M * ↑ (max (|Y'\X'|) (|X'\Y'|)) + m * ↑ (min (|Y'\X'|) (|X'\Y'|)): by rw co4
    ... =  δ m M Y' X': by rw defi

theorem seventeen_right_yxz {X Y Z : finset α}:
    0 ≤ m → m ≤ M → |Y| ≤ |X| ∧ |X| ≤ |Z| → triangle_inequality m M X Y Z :=
    let x := |X| in let y := |Y| in let z := |Z| in
    let x_z := |X\Z| in let z_x := |Z\X| in let y_z := |Y\Z| in
    let z_y := |Z\Y| in let x_y := |X\Y| in let y_x := |Y\X| in
    λ hm: 0 ≤ m, λ h: m ≤ M, λ h₀: y ≤ x ∧ x ≤ z,
    have hyz: y ≤ z, from le_trans (and.elim_left h₀) (and.elim_right h₀),
    have gxz: x_z ≤ z_x, from sdiff_card Z X (and.elim_right h₀),
    have gyz: y_z ≤ z_y, from sdiff_card Z Y hyz,
    have dxy: δ m M X Y = M * x_y + m * y_x, from maxmin_2 (and.elim_left h₀),
    have dzy: δ m M Z Y = M * z_y + m * y_z, from maxmin_2 hyz,
    have dxz: δ m M X Z = M * z_x + m * x_z, from calc
                δ m M X Z = δ m M Z X                 : delta_comm
                    ... = M * (z_x) + m * (x_z) : maxmin_2 (and.elim_right h₀),
    have Mmpos: 0 ≤ M-m, from sub_nonneg_of_le h,
    have h02: 0 ≤ (2:ℝ), by {have zt: 0 ≤ 2, from nat.zero_le 2, norm_cast, exact zt, },
    have h2m: 0 ≤ 2*m, from mul_nonneg h02 hm,
    have tri_1:   2 * m * y_x ≤ 2 * m * (y_z + z_x), from mul_sdiff_tri (2*m) h2m Y Z X,
    have tri_2: (M-m) * x_y ≤ (M-m) * (x_z + z_y), from mul_sdiff_tri (M-m) Mmpos X Z Y,

    have tri_3:  (M-m) * x_z ≤ (M-m) * z_x, from mul_le_mul_of_nonneg_left (casting(gxz)) Mmpos,
    have triangle_add: (δ m M X Y) + (m * y_x) ≤ (δ m M X Z + δ m M Z Y) + (m * y_x), from
        let
            term_1 := (M * x_y),
            term_2 := (m*(x_z+z_y+y_x) + m*(y_z+z_x)),
            term_3 := (m*(x_z +z_y +y_x) + (M-m) * z_y + m*z_x + m*y_z)
        in calc   (δ m M X Y)     + (m * y_x)
            = (M * x_y + m * y_x) + (m * y_x)                             : by rw dxy
        ... = M * x_y + 2 * m * y_x                                       : by ring
        ... ≤ M * x_y + 2 * m * (y_z+z_x)                                 : add_le_add_left tri_1 term_1
        ... = m*(x_y+y_z+z_x) + m*(y_z+z_x) + (M-m)*x_y                   : by ring
        ... = m*(x_z+z_y+y_x) + m*(y_z+z_x) + (M-m)*x_y                   : by rw card_rot_cast
        ... ≤ m*(x_z+z_y+y_x) + m*(y_z+z_x) + (M-m)*(x_z+ z_y)            : add_le_add_left tri_2 term_2
        ... = m*(x_z+z_y+y_x) + (M-m) * z_y + m*z_x + m*y_z + (M-m) * x_z : by ring
        ... ≤ m*(x_z+z_y+y_x) + (M-m) * z_y + m*z_x + m*y_z + (M-m) * z_x : add_le_add_left tri_3 term_3
        ... = (M * z_x + m * x_z)        + (M * z_y + m * y_z) + (m * y_x): by ring
        ... = (δ m M X Z                 +          δ m M Z Y) + (m * y_x): by rw[dxz,dzy],
    le_of_add_le_add_right triangle_add

lemma sdiff_card_le (X Y U : finset α) (hx: X ⊆ U) (hy: Y ⊆ U) (h:|X| ≤ |Y|):
    |U \ Y| ≤ |U \ X| :=
    have hu: |U| - |Y| ≤ |U| - |X|, from nat.sub_le_sub_left (|U|) h,
    calc
        |U \ Y| = |U| - |Y| : card_sdiff hy
            ... ≤ |U| - |X| : hu
            ... = |U \ X|   : by rw[card_sdiff hx]

theorem seventeen_right_zyx{m M : ℝ} {X Y Z : finset α}:
    0 ≤ m → m ≤ M → |Z| ≤ |Y| ∧ |Y| ≤ |X| → triangle_inequality m M X Y Z :=
    λ hm, λ hM, λ h,
    let
        U := X ∪ Y ∪ Z,
        Z' : finset α := (X ∪ Y ∪ Z) \ Z,
        Y' : finset α := (X ∪ Y ∪ Z) \ Y,
        X' : finset α := (X ∪ Y ∪ Z) \ X
    in
    have hx: X ⊆ U, by {intros x hx, have q: x ∈ X ∪ Y := (iff.elim_right mem_union) (or.inl hx),
                                                    exact (iff.elim_right mem_union) (or.inl q),},
    have hy: Y ⊆ U, by {intros y hy, have q: y ∈ X ∪ Y := (iff.elim_right mem_union) (or.inr hy),
                                                    exact (iff.elim_right mem_union) (or.inl q),},
    have hz: Z ⊆ U, by {intros z hz,                exact (iff.elim_right mem_union) (or.inr hz),},

    have and1: |X'| ≤ |Y'|, from sdiff_card_le Y X U hy hx h.right,
    have and2: |Y'| ≤ |Z'|, from sdiff_card_le Z Y U hz hy h.left,
    have hh: |X'| ≤ |Y'| ∧ |Y'| ≤ |Z'|, from and.intro and1 and2,
    have h1: δ m M X' Z' = δ m M Z X, from (delta_complement Z X U hz hx).symm,
    have h2: δ m M Z' Y' = δ m M Y Z, from (delta_complement Y Z U hy hz).symm,
    have h3: δ m M Y Z = δ m M Z Y, from delta_comm,
    calc δ m M X Y = δ m M Y' X'               : delta_complement X Y U hx hy
               ... ≤ δ m M Y' Z' + δ m M Z' X' : seventeen_right_yxz hm hM hh
               ... = δ m M X' Z' + δ m M Z' Y' : by rw[delta_comm,add_comm,delta_comm]
               ... = δ m M Z  X  + δ m M Z' Y' : by rw[h1]
               ... = δ m M X  Z  + δ m M Z' Y' : by rw[delta_comm]
               ... = δ m M X  Z  + δ m M Y  Z  : by rw[h2]
               ... = δ m M X  Z  + δ m M Z  Y  : by rw[h3]

theorem seventeen_right_zxy {X Y Z : finset α}:
    0 ≤ m → m ≤ M → |Z| ≤ |X| ∧ |X| ≤ |Y| → triangle_inequality m M X Y Z :=
    λ hm: 0 ≤ m, λ h: m ≤ M, λ hyp: |Z| ≤ |X| ∧ |X| ≤ |Y|,
    have hyz: δ m M Y Z = δ m M Z Y, from delta_comm,
    have hzx: δ m M Z X = δ m M X Z, from delta_comm,
    calc
    δ m M X Y = δ m M Y X             : delta_comm
          ... ≤ δ m M Y Z + δ m M Z X : seventeen_right_zyx hm h hyp
          ... = δ m M Z X + δ m M Y Z : add_comm (δ m M Y Z) (δ m M Z X)
          ... = δ m M X Z + δ m M Z Y : by rw[hyz,hzx]

theorem three_places {x y z : ℕ} :
    y ≤ x → (z ≤ y ∧ y ≤ x) ∨ (y ≤ z ∧ z ≤ x) ∨ (y ≤ x ∧ x ≤ z) :=
    assume hyx : y ≤ x,
    (le_total z y).elim(
        assume h: z ≤ y, or.inl (and.intro h hyx)
    )(
        assume h: y ≤ z,
        (le_total z x).elim(
            assume h1: z ≤ x, or.inr (or.inl (and.intro h h1))
        )(
            assume h1: x ≤ z, or.inr (or.inr (and.intro hyx h1))
    ))

theorem seventeen_right_y_le_x {m M : ℝ} {X Y Z : finset α} :
    |Y| ≤ |X| → 0 ≤ m → m ≤ M → triangle_inequality m M X Y Z :=
    let x := |X| in let y := |Y| in let z := |Z| in
    λ h: y ≤ x, λ hm: 0 ≤ m, λ hmM: m ≤ M,
    (three_places h).elim(
        λ h1, seventeen_right_zyx hm hmM h1
    )(
        λ h1: y≤ z ∧ z ≤ x ∨ y ≤ x ∧ x ≤ z,
        h1.elim(
            λ h2, seventeen_right_yzx hm hmM h2
        )(
            λ h2, seventeen_right_yxz hm hmM h2
        )
    )

theorem seventeen_right_x_le_y {m M : ℝ} {X Y Z : finset α} :
    |X| ≤ |Y| → 0 ≤ m → m ≤ M → triangle_inequality m M X Y Z :=
    λ h: |X| ≤ |Y|, λ hm: 0 ≤ m, λ hmM: m ≤ M,
    have hh: δ m M Y Z = δ m M Z Y, from delta_comm,
    have gg: δ m M Z X = δ m M X Z, from delta_comm,
    calc
    δ m M X Y = δ m M Y X : delta_comm
        ... ≤ δ m M Y Z + δ m M Z X : seventeen_right_y_le_x h hm hmM
        ... = δ m M Z X + δ m M Y Z : add_comm (δ m M Y Z) (δ m M Z X)
        ... = δ m M X Z + δ m M Z Y: by rw[hh,gg]

theorem mem_pair {x y z : α} : x ∈ ({y, z} : finset α) ↔ x = y ∨ x = z := -- inspired by Set.mem_pair
iff.trans mem_insert $ or_congr iff.rfl mem_singleton

lemma sdiff_singleton_pair (x y : α) (hne : x ≠ y):  ({x}: finset α) \ ({x,y}: finset α)  = (∅: finset α) := --by tidy
  have g: ∀ z : α, z ∈ ((({x}: finset α) \ ({x,y}: finset α)): finset α) ↔ false, by {
    intro z,rw mem_sdiff,rw finset.mem_singleton,rw mem_pair,clear hne,split,cc,cc,
  },
  (iff.elim_right finset.ext_iff) g

lemma sdiff_singleton_pair' (x y : α) (hne : x ≠ y):  ({y}: finset α) \ ({x,y}: finset α)  = (∅: finset α) := --by tidy
  have g: ∀ z : α, z ∈ ((({y}: finset α) \ ({x,y}: finset α)): finset α) ↔ false, by {
    intro z,rw mem_sdiff,rw finset.mem_singleton,rw mem_pair,clear hne,split,cc,cc,
  },
  (iff.elim_right finset.ext_iff) g

lemma sdiff_pair_singleton (x y : α) (hne : x ≠ y):  ({x,y}: finset α) \ ({x}: finset α)  = ({y}: finset α) := --by tidy
  have g: ∀ z : α, z ∈ ((({x,y}: finset α) \ ({x}: finset α)): finset α) ↔ z ∈ ({y}: finset α), by {
    intro z,rw mem_sdiff,rw finset.mem_singleton,rw finset.mem_singleton,rw mem_pair,
    by_cases (z=x),split,cc,cc,split,cc,cc, -- so I replaced "tidy" by "cc", I guess that's an improvement
  },
  (iff.elim_right finset.ext_iff) g

lemma sdiff_pair_singleton' (x y : α) (hne : x ≠ y):  ({x,y}: finset α) \ ({y}: finset α)  = ({x}: finset α) := --by tidy
  have g: ∀ z : α, z ∈ ((({x,y}: finset α) \ ({y}: finset α)): finset α) ↔ z ∈ ({x}: finset α), by {
    intro z,rw mem_sdiff,rw finset.mem_singleton,rw finset.mem_singleton,rw mem_pair,
    by_cases (z=x),split,intro,exact h,intro h,cc,split,intro g,cc,cc, -- so I replaced "tidy" by "cc", I guess that's an improvement
  },
  (iff.elim_right finset.ext_iff) g

lemma sdiff_singleton (x y : α) (hne : x ≠ y):  ({x}: finset α) \ ({y}: finset α)  = ({x}: finset α) := --by tidy
  --let w := ((({x}: finset α) \ ({y}: finset α)): finset α), v := ({x}: finset α) in
  have g: ∀ z : α, z ∈ ((({x}: finset α) \ ({y}: finset α)): finset α) ↔ z ∈ ({x}: finset α), by {
    intro z,rw mem_sdiff,repeat{rw mem_singleton},split,cc,cc,
    --split,
    --intro g0, rw mem_sdiff at g0, exact g0.left,
    --intro g0, rw mem_sdiff, have g1: z = x := (iff.elim_left mem_singleton) g0, rw ← g1 at hne,
    --by_cases (z ∈ {y}),
  --    have g2: z=y := (iff.elim_left mem_singleton) h, exfalso, exact hne g2,
  --    exact and.intro g0 h,
  },
  (iff.elim_right finset.ext_iff) g
-- mem_singleton says that b ∈ {a} ↔ b = a, so we should be in business using set.ext_iff or whatever
-- also Set.mem_pair says x ∈ {y, z} ↔ x = y ∨ x = z

--#print ease

#check ({0}:finset ℕ) \ ({1}:finset ℕ)

theorem seventeen_right {m M : ℝ} { X Y Z : finset α}:
    0 ≤ m → m ≤ M → triangle_inequality m M X Y Z :=
    λ hm: 0 ≤ m, λ h: m ≤ M,
    (le_total (|X|) (|Y|)).elim (
        λ h1: |X| ≤ |Y|, seventeen_right_x_le_y h1 hm h
    )(
        λ h1: |Y| ≤ |X|, seventeen_right_y_le_x h1 hm h
    )

def s_0 : finset ℕ := ({0}: finset ℕ)
def s_1 : finset ℕ := ({1}: finset ℕ)
def s01 : finset ℕ := ({0,1} : finset ℕ)
theorem seventeen: (∃ x y : α, x ≠ y) →
    0 ≤ m → (m ≤ M ↔ ∀ X Y Z : finset α, triangle_inequality m M X Y Z) :=
    λ typ : ∃ x y : α, x ≠ y,
    λ hm: 0 ≤ m,
    exists.elim typ (
        λ x : α, λ ty : ∃ y : α, x ≠ y,
        exists.elim ty (
            λ y : α, λ t : x ≠ y,
            let s_x : finset α := ({x}: finset α) in
            let s_y : finset α := ({y}: finset α) in
            let sxy : finset α := ({x,y} : finset α) in
            have h₀: m ≤ M → ∀ X Y Z : finset α, triangle_inequality m M X Y Z, from
                λ h: m ≤ M, λ X Y Z, seventeen_right hm h,
            have h₁: (∀ X Y Z : finset α, triangle_inequality m M X Y Z) → m ≤ M, from
                assume hyp: (∀ X Y Z : finset α, triangle_inequality m M X Y Z),
                have hh: δ m M s_x s_y ≤ δ m M s_x sxy + δ m M sxy s_y, from hyp s_x s_y sxy,
                have cyx: (|s_y\s_x|:ℝ) = (1:ℝ), from
                  have |s_y\s_x| = 1, from eq.trans (congr_arg finset.card (sdiff_singleton y x t.symm)) (card_singleton y),
                  by {norm_cast, exact this,},

                have cxy: (|s_x\s_y|:ℝ) = (1:ℝ), from
                  have |s_x\s_y| = 1, from eq.trans (congr_arg finset.card (sdiff_singleton x y t)) (card_singleton x),
                  by {norm_cast,exact this,},

                have cxz: (|s_x\sxy|:ℝ) = (0:ℝ), from
                  have |s_x\sxy| = 0, from eq.trans (congr_arg finset.card (sdiff_singleton_pair x y t)) card_empty,
                  by {norm_cast,exact this,},

                have czx: (|sxy\s_x|:ℝ) = (1:ℝ), from
                  have |sxy\s_x| = 1, from eq.trans (congr_arg finset.card (sdiff_pair_singleton x y t)) (card_singleton y),
                  by {norm_cast, exact this,},

                have cyz: (|s_y\sxy|:ℝ) = (0:ℝ), from
                  have |s_y\sxy| = 0, from eq.trans (congr_arg finset.card (sdiff_singleton_pair' x y t)) card_empty,
                  by {norm_cast, exact this,},

                have czy: (|sxy\s_y|:ℝ) = (1:ℝ), from
                  have |sxy\s_y| = 1, from eq.trans (congr_arg finset.card (sdiff_pair_singleton' x y t)) (card_singleton x),
                  by {norm_cast, exact this,},

                have dxy: δ m M s_x s_y = M + m , from calc
                    δ m M s_x s_y = M * max ↑(|s_x\s_y|) ↑(|s_y\s_x|)
                                + m * min ↑(|s_x\s_y|) ↑(|s_y\s_x|): delta_cast
                            ... = M * max    (1:ℝ)  (1:ℝ)   + m * min (1:ℝ)    (1:ℝ) : by rw[cxy,cyx]
                            ... = M * (1:ℝ)                 + m * (1:ℝ)              : by rw[max_self,min_self]
                            ... = M + m                                              : by repeat{rw[mul_one]},
                have max_R : max (0:ℝ) (1:ℝ) = (1:ℝ), from max_eq_right zero_le_one,
                have min_R  : min (0:ℝ) (1:ℝ) = (0:ℝ), from min_eq_left  zero_le_one,
                have dxz: δ m M s_x sxy = M, from calc
                        δ m M s_x sxy = M * max (|s_x\sxy|) (|sxy\s_x|)
                                        + m * min (|s_x\sxy|) (|sxy\s_x|): delta_cast
                                    ... = M * max 0 1 + m * min 0 1 : by rw[cxz,czx]
                                    ... = M * 1       + m * min 0 1 : by rw[max_R]
                                    ... = M * 1       + m * 0       : by rw[min_R]
                                    ... = M                         : by rw[mul_one,mul_zero,add_zero],
                have dzy: δ m M sxy s_y = M, from calc
                        δ m M sxy s_y = M * max (|sxy\s_y|) (|s_y\sxy|)
                                        + m * min (|sxy\s_y|) (|s_y\sxy|): delta_cast
                                    ... = M * max 1 0 + m * min 1 0: by rw[czy,cyz]
                                    ... = M * max 0 1 + m * min 0 1: by rw[max_comm,min_comm]
                                    ... = M * 1       + m * min 0 1 : by rw[max_R]
                                    ... = M * 1       + m * 0       : by rw[min_R]
                                    ... = M                         : by rw[mul_one,mul_zero,add_zero],
                have add_le_add_left : M + m ≤ M + M, from calc
                    M + m = δ m M s_x s_y : by rw[dxy]
                    ... ≤  δ m M s_x sxy + δ m M sxy s_y: hh
                    ... = M + M: by begin rw[dxz,dzy] end,
                le_of_add_le_add_left
                    add_le_add_left,
            iff.intro h₀ h₁
        )

    )

    def delta_triangle (X Y Z: finset α) (hm: 0 < m) (hM: m ≤ M):
    triangle_inequality m M X Z Y
    --δ m M X Y ≤ δ m M X Z + δ m M Z Y
    := seventeen_right (le_of_lt hm) hM

    section jaccard_numerator
    /-- Instantiate finset ℕ as a metric space. -/

    def protein {m M : ℝ} (hm : 0 < m) (hM : m ≤ M) := finset α

    noncomputable instance jaccard_numerator.metric_space (typ: (∃ x y : α, x ≠ y)) (hm : 0 < m) (hM : m ≤ M): metric_space (protein hm hM) := {
        dist               := λx y, δ m M x y,
        dist_self          := delta_self,
        eq_of_dist_eq_zero := eq_of_delta_eq_zero hm hM,
        dist_comm          := λ x y, delta_comm,
        dist_triangle      := λ x y z, ((iff.elim_left (seventeen typ (le_of_lt hm))) hM) x z y
    }
end jaccard_numerator


import analysis.special_functions.pow
import to_mathlib.combinatorics.simple_graph.independent
import to_mathlib.combinatorics.simple_graph.orthogonal_representation

noncomputable theory

open set function real

variables {V : Type*} (G : simple_graph V)

namespace simple_graph

/-- The Shannon capacity of a graph. -/
def shannon_capacity : ℝ :=
⨆ k, (⊠^(k+1) G).independence_number ^ ((1 : ℝ) / (k + 1))

lemma shannon_capacity_eq_csupr :
  G.shannon_capacity = ⨆ k, (⊠^(k+1) G).independence_number ^ ((1 : ℝ) / (k + 1)) :=
rfl

variables [finite V] {E : Type*} [inner_product_space ℝ E]
variables (ρ : G.orthogonal_representation E) (e : E)

lemma shannon_capacity_le_lovasz_number_at :
  G.shannon_capacity ≤ ρ.lovasz_number_at e :=
begin
  -- Use the definition of Shannon capacity:
  rw G.shannon_capacity_eq_csupr,
  -- If we want to prove a supremum is bounded above, it is enough to bound each term:
  refine csupr_le (λ k, _),
  -- Raise both sides of the inequality to the power `k+1` and tidy up:
  have hk : 0 < (k + 1 : ℝ) := k.cast_add_one_pos,
  rw [← rpow_le_rpow_iff
    (rpow_nonneg_of_nonneg (nat.cast_nonneg _) _) (ρ.lovasz_number_at_nneg e) hk,
    ← rpow_mul (nat.cast_nonneg _), div_mul_cancel (1 : ℝ) hk.ne.symm, rpow_one],
  -- Eliminate casts
  norm_cast,
  -- Apply first key fact; the Lovász number is multiplicative `ϑ(⊠ᵏG, ⊠ᵏρ, e^k) = ϑ(G, ρ, e)^k`:
  rw [← ρ.pow_lovasz_number_at' e],
  haveI : fintype (fin (k + 1) → V),
  { refine fintype.of_finite _, },
  -- Apply second key fact; the independence number of a graph is bounded by the Lovász number:
  apply orthogonal_representation.independence_number_le_lovasz_number_at,
end

end simple_graph


import data.real.basic
class metric_space (X : Type*) :=
(d : X → X → ℝ)
(d_pos : ∀ x y, d x y ≥ 0)
(presep : ∀ x y, x=y → d x y = 0)
(sep : ∀ x y, d x y = 0 →  x = y)
(sym : ∀ x y, d x y = d y x)
(triangle : ∀ x y z, d x z ≤ d x y + d y z)
class premetric_space (X : Type*) :=
(d : X → X → ℝ)
(d_pos : ∀ x y, d x y ≥ 0)
(presep : ∀ x y, x=y → d x y = 0)
(sym : ∀ x y, d x y = d y x)
(triangle : ∀ x y z, d x z ≤ d x y + d y z)

instance real.metric_space: metric_space ℝ :=
 { d := sorry, d_pos := sorry, presep := sorry, sep := sorry,
sym := sorry, triangle := sorry }
open_locale classical
noncomputable theory
section test
open metric_space
variables {X: Type*} [metric_space X]

def is_cauchy (x: ℕ → X) :=
  ∀ ε > 0, ∃ N, ∀ p ≥ N, ∀ q ≥ N, ((d (x p) (x q)) < ε)
def converge (x: ℕ → X) (l : X) :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, ((d l (x n))  < ε)
def complete (T: Type) [metric_space T] := ∀ x : ℕ → T, is_cauchy x → ∃ l : T, converge x l

lemma R_is_complete: complete ℝ := sorry

def cauchy_seqs (X : Type*) [metric_space X] := { f : ℕ → X // is_cauchy f }
def cauchy.diff (x : ℕ → X) (y : ℕ → X) : ℕ → ℝ  :=
 λ n : ℕ, d (x n) (y n)
def cauchy.cauchy_of_diff (x y : ℕ →  X) (h1 : is_cauchy x) (h2 : is_cauchy y):
  is_cauchy (cauchy.diff x y) := sorry

def cauchy.limit (x: ℕ → ℝ) (H: is_cauchy x): ℝ := classical.some (R_is_complete x H)
def cauchy.dist (T: Type*) [metric_space T] (x y: cauchy_seqs T): ℝ
  := cauchy.limit (cauchy.diff x.val y.val) (cauchy.cauchy_of_diff x.val y.val x.property y.property)

instance pre_ecart.premetrique (X: Type*) [metric_space X]: premetric_space (cauchy_seqs X) :=
{ d := cauchy.dist X,
  d_pos := sorry,
  presep := sorry,
  sym := sorry,
  triangle := sorry }

def cauchy.cong (T: Type*) [metric_space T] (x y: cauchy_seqs T): Prop := cauchy.dist T x y = 0
instance cauchy.setoid (X : Type*) [metric_space X] : setoid (cauchy_seqs X) :=
{
  r := cauchy.cong X,
  iseqv := sorry
}
local attribute [instance] cauchy.setoid

def completion (X : Type*) [metric_space X] : Type* := quotient (cauchy.setoid X)

def completion.dist_soundness (T: Type*) [metric_space T]:
  ∀ x₁ x₂: cauchy_seqs T, ∀ y₁ y₂: cauchy_seqs T, (x₁ ≈ y₁) → (x₂ ≈ y₂) → (cauchy.dist T x₁ x₂ = cauchy.dist T y₁ y₂) := begin
  intros x y z t Hxz Hyt,
  change (cauchy.dist T x z = 0) at Hxz,
  change (cauchy.dist T y t = 0) at Hyt,
  apply le_antisymm,
  calc
    cauchy.dist T x y ≤ cauchy.dist T x z + cauchy.dist T z y : premetric_space.triangle x z y
    ... ≤ cauchy.dist T x z + (cauchy.dist T z t + cauchy.dist T t y) : add_le_add_left (premetric_space.triangle z t y) _
    ... = cauchy.dist T z t + cauchy.dist T y t : by rw [Hxz, zero_add, premetric_space.sym t y]
    ... = cauchy.dist T z t : by rw Hyt,
  calc
    cauchy.dist T z t ≤ cauchy.dist T z x + cauchy.dist T x t : premetric_space.triangle z x t
    ... ≤ cauchy.dist T z x + (cauchy.dist T x y + cauchy.dist T y t) : add_le_add_left (premetric_space.triangle x y t) _
    ... = cauchy.dist T x z + cauchy.dist T x y : by rw [Hyt, add_zero, premetric_space.sym z x]
    ... = cauchy.dist T x y : by rw Hxz,
end

def completion.dist (T: Type*) [metric_space T] (x y: completion T): ℝ :=
  quotient.lift₂ (cauchy.dist T) (completion.dist_soundness T) x y

instance completion.metric_space (X: Type*) [metric_space X]: metric_space (completion X) :=
{
  d := completion.dist X,
  d_pos := sorry,
  -- etc
}

end test


import algebra.ring

namespace my_ring

variables {R : Type*} [ring R]

#check one_mul
#check add_mul
#check one_add_one_eq_two

-- BEGIN

lemma one_add_one_eq_two : 1 + 1 = (2 : R) :=
by refl

theorem two_mul (a : R) : 2 * a = a + a :=
begin
  rw ← one_add_one_eq_two,
  sorry,
end
-- END

#check one_add_one_eq_two
#check two_mul

end my_ring


/-

# Advanced proposition world.

## Level 3: and_trans.
-/

/- Lemma
If $P$, $Q$ and $R$ are true/false statements, then $P\land Q$ and
$Q\land R$ together imply $P\land R$.
-/
lemma and_trans (P Q R : Prop) : P ∧ Q → Q ∧ R → P ∧ R :=
begin
  intro hpq,
  intro hqr,
  cases hpq with p q,
  cases hqr with q' r,
  split,
  assumption,
  assumption,

end


section
open classical

variables (α : Type) (p q : α → Prop)
variable a : α
variable r : Prop

example : (∃ x : α, r) → r :=
λh, exists.elim h (λ_, id)

example : (∃ x : α, r) → r :=
by { intro h, cases h, assumption }

example : r → (∃ x : α, r) :=
exists.intro a

include a
example : r → (∃ x : α, r) :=
by { intro, constructor, assumption' }
omit a

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
⟨λh, exists.elim h (λh1, λh2, ⟨⟨h1, h2.left⟩, h2.right⟩),
λh, exists.elim (h.left) (λh1, λh2, ⟨h1, h2, h.right⟩)⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
by { constructor; { intro h, cases h with h1 h2, cases h1 <|> cases h2,
    repeat { constructor }, assumption' } }

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
⟨λh, exists.elim h
    (λh1, λh2, h2.elim (λh3, or.inl ⟨h1, h3⟩) (λh3, or.inr ⟨h1, h3⟩)),
λh, h.elim
    (λh1, exists.elim h1 (λh2, λh3, ⟨h2, or.inl h3⟩))
    (λh1, exists.elim h1 (λh2, λh3, ⟨h2, or.inr h3⟩))⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
by { constructor; intro h,
    { cases h with _ h1, cases h1,
        { left, constructor, assumption },
        { right, constructor, assumption } },
    { cases h with h1 h1; cases h1;
        constructor, { left, assumption }, { right, assumption } } }

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
⟨λh, λh1, exists.elim h1 (λh2, λh3, h3 (h h2)),
λh, λh1, by_contradiction (λh2, h (exists.intro h1 h2))⟩

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
by { constructor; intros h h1,
    { cases h1 with _ h2, apply h2, apply h },
    { apply by_contradiction, intro, apply h, constructor, assumption} }

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
⟨λh, exists.elim h (λh1, λh2, λh3, (h3 h1) h2),
λh, by_contradiction (λh1, h (λh2, λh3, h1 ⟨h2, h3⟩))⟩

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
by { constructor; intro h,
    { cases h, intro h1, apply h1, assumption },
    { apply by_contradiction, intro h1, apply h,
    repeat { intro }, apply h1, constructor, assumption' } }

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
⟨λh, λh1, show ¬ p h1, from λh2, h (exists.intro h1 h2),
λh, λh1, exists.elim h1 (λh2, λh3, (h h2) h3)⟩

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
by { constructor,
    { intro h, repeat { intro }, apply h, constructor, assumption' },
    { intros h h1, cases h1, apply h, assumption' } }

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
⟨λh, by_contradiction (λh1, h (λh2, by_contradiction (λh3, h1 ⟨h2, h3⟩))),
λh, exists.elim h (λh1, λh2, λh3, h2 (h3 h1))⟩

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
by { constructor,
    { intro h, apply by_contradiction, intro h1, apply h,
        intro, apply by_contradiction, intro, apply h1,
        constructor, assumption },
    { intros h h1, cases h with _ h2, apply h2, apply h1 } }

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
⟨λh, λh1, exists.elim h1 h, λh, λ_, λh1, h ⟨_, h1⟩⟩

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
by { constructor,
    { intros h h1, cases h1, apply h, assumption' },
    { intros h _ _, apply h, constructor, assumption' } }

example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
⟨λh, λh1, exists.elim h (λ_, λh3, h3 (h1 _)),
λh, by_cases (λh1, ⟨a, λ_, h h1⟩)
    (λh1, by_contradiction (λh2, h1 (λh3,
        by_contradiction (λh4, h2 ⟨h3, flip absurd h4⟩))))⟩

include a
example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
by { constructor,
    { intros h h1, cases h with _ h2, apply h2, apply h1 },
    { intro h, apply by_cases,
        { intro h1, existsi a, intro, apply h h1 },
        { intro h1, apply by_contradiction, intro h2, apply h1,
            intro, apply by_contradiction, intro, apply h2,
            constructor, intro, contradiction } } }

example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
⟨λh, λh1, exists.elim h (λh2, λh3, ⟨h2, h3 h1⟩),
λh, by_cases
    (λh1, exists.elim (h h1) (λh2, λh3, ⟨h2, λh1, h3⟩))
    (λh1, ⟨a, (λh2, absurd h2 h1)⟩)⟩

example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
by { constructor,
    { intros h _, cases h with _ h1, constructor, apply h1, assumption },
    { intro h, apply by_cases,
        { intro h1, cases (h h1), constructor, intro, assumption },
        { intro, existsi a, intro, contradiction } } }
omit a
end
--
section
variables (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
⟨λh, ⟨λh1, (h h1).left, λh1, (h h1).right⟩,
λh, λh1, ⟨(h.left) h1, (h.right) h1⟩⟩

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
by { constructor,
    { intro h, constructor; intro h1; { cases (h h1), assumption } },
    { intros h _, cases h with h1 h2, constructor, apply h1, apply h2 } }

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
λh, λh1, λh2, (h h2) (h1 h2)

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
by { intros h h1 _, apply h, apply h1 }

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
λh, λh1, h.elim (λh2, or.inl (h2 h1)) (λh2, or.inr (h2 h1))

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
by { intros h _, cases h, { left, apply h }, { right, apply h } }

end
--
section
open classical

variables (α : Type) (p q : α → Prop)
variable r : Prop

example : α → ((∀ x : α, r) ↔ r) :=
λh, ⟨λh1, h1 h, λh1, (λh, h1)⟩

example : α → ((∀ x : α, r) ↔ r) :=
by { intro h, constructor, { intro h1, apply h1 h }, { intros, assumption } }

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
⟨λh, by_cases (or.inr)
    (λh1, or.inl (λh2, (h h2).elim id (λh3, absurd h3 h1))),
λh, h.elim (λh1, λh2, or.inl (h1 h2)) (λh1, λh2, or.inr h1)⟩

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
by { constructor,
    { intro h, apply by_cases,
        { intro, right, assumption },
        { intro, left, intro, cases (h _), assumption, contradiction } },
    { intros h _, cases h, { left, apply h }, { right, assumption } } }

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
⟨λh, λh1, λh2, h h2 h1, λh, λh1, λh2, h h2 h1⟩

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
by { constructor; { intros h h1 h2, apply (h h2 h1) } }

end


import data.list.basic

-- Section 5.1: Entering tactic mode
namespace s51
    theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
    begin
    apply and.intro,
    exact hp,
    apply and.intro,
    exact hq,
    exact hp
    end
    #print test

    -- Shorter version, compound exprs
    theorem test2 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
    begin
    apply and.intro hp,
    exact and.intro hq hp
    end

    -- Concentation of tactics
    theorem test3 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
    begin
    apply and.intro hp; exact and.intro hq hp
    end

    -- Special keyword for a single-tactic proof
    theorem test4 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
    by exact and.intro hp (and.intro hq hp)

    -- need to tell Lean which section variables can be in proof
    variables {p q : Prop} (hp : p) (hq : q)
    include hp hq
    example : p ∧ q ∧ p :=
    begin
    apply and.intro hp,
    exact and.intro hq hp
    end

    omit hp hq -- undoing an "include"

    -- Alternative way of getting section variables into a proof
    example : p ∧ q ∧ p :=
    let hp := hp, hq := hq in -- here
    begin
    apply and.intro hp,
    exact and.intro hq hp
    end

end s51

-- Section 5.2: Basic Tactics
namespace s52
    -- intro introduces a hypothesis
    example (α : Type) : α → α :=
    begin
    intro a,
    exact a
    end

    example (α : Type) : ∀ x : α, x = x :=
    begin
    intro x,
    exact eq.refl x
    end

    -- plural intros takes list of names
    example : ∀ a b c : ℕ, a = b → a = c → c = b :=
    begin
    intros a b c h₁ h₂,
    exact eq.trans (eq.symm h₂) h₁
    end

    -- "assumption" looks through context of the current goal and applies something that matches
    variables x y z w : ℕ
    example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
    begin
    apply eq.trans h₁,
    apply eq.trans h₂,
    assumption   -- applied h₃
    end
    -- Will unify variables if necessary
    example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
    begin
    apply eq.trans,
    assumption,     -- solves x = ?m_1 with h₁
    apply eq.trans,
    assumption,     -- solves y = ?m_1 with h₂
    assumption      -- solves z = w with h₃
    end

    --  without any args, intros chooses names + introduces as many vars as it can
    example : ∀ a b c : ℕ, a = b → a = c → c = b :=
    begin
    intros,
    apply eq.trans,
    apply eq.symm,
    assumption,     -- solves y = ?m_1 with h₂
    assumption      -- solves z = w with h₃
    end

    -- refl/symmetry/transitivity  more general than eq.refl/eq.sym/eq.trans
    example (y : ℕ) : (λ x : ℕ, 0) y = 0 :=
    begin
    refl
    end

    example (x : ℕ) : x ≤ x :=
    begin
    refl
    end

    -- Use them to do the above proof again
    example : ∀ a b c : ℕ, a = b → a = c → c = b :=
    begin
    intros,
    transitivity,
    symmetry,
    assumption,
    assumption
    end

    example : ∀ a b c : ℕ, a = b → a = c → c = b :=
    begin
    intros a b c h₁ h₂,
    transitivity a,
    symmetry,
    assumption,
    assumption
    end

    -- Repeat combinator
    example : ∀ a b c : ℕ, a = b → a = c → c = b :=
    begin
    intros,
    apply eq.trans,
    apply eq.symm,
    repeat { assumption } --braces are nested begin...end
    end

    -- apply
    example : ∃ a : ℕ, 5 = a :=
    begin
    apply exists.intro,
    reflexivity
    end

    -- fapply
    example : ∃ a : ℕ, a = a :=
    begin
    fapply exists.intro,
    exact 0,
    reflexivity
    end

end s52

-- Section 5.3: More tactics
namespace s53
    -- Cases, disjunction
    example (p q : Prop) : p ∨ q → q ∨ p :=
    begin
    intro h,
    cases h with hp hq,
    -- case hp : p
    right, exact hp,
    -- case hq : q
    left, exact hq
    end

    -- Cases, conjunction
    example (p q : Prop) : p ∧ q → q ∧ p :=
    begin
    intro h,
    cases h with hp hq,
    constructor, exact hq, exact hp
    end

    -- constructor applies the first constructor of an inductively defined type
    example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
    apply iff.intro,
    intro h,
    cases h with hp hqr,
    cases hqr with hq hr,
        left, constructor, repeat { assumption },
        right, constructor, repeat { assumption },
    intro h,
        cases h with hpq hpr,
        cases hpq with hp hq,
            constructor, exact hp, left, exact hq,
        cases hpr with hp hr,
            constructor, exact hp, right, exact hr
    end

    -- cases with quantifier
    -- left and right can be used with IDT with exactly two constructors
    example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
    begin
    intro h,
    cases h with x px,
    constructor, left, exact px
    end

    -- Explicit use of existential quantifier
    example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
    begin
    intro h,
    cases h with x px,
    existsi x, left, exact px
    end
    -- semicolon after split means apply the assumption tactic
    -- to both of the goals that are introduced by splitting the conjunction
    example (p q : ℕ → Prop) :
    (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
    begin
    intro h,
    cases h with x hpq,
    cases hpq with hp hq,
    existsi x,
    split; assumption
    end

    -- operating on data, not just props
    universes u v

    def swap_pair {α : Type u} {β : Type v} : α × β → β × α :=
    begin
    intro p,
    cases p with ha hb,
    constructor, exact hb, exact ha
    end

    def swap_sum {α : Type u} {β : Type v} : α ⊕ β → β ⊕ α :=
    begin
    intro p,
    cases p with ha hb,
        right, exact ha,
        left, exact hb
    end

    open nat

    example (P : ℕ → Prop) (h₀ : P 0) (h₁ : ∀ n, P (succ n)) (m : ℕ) :
    P m :=
    begin
    cases m with m', exact h₀, exact h₁ m'
    end

    -- searches for a contradiction among the hypotheses of the current goal
    example (p q : Prop) : p ∧ ¬ p → q :=
    begin
    intro h, cases h, contradiction
    end

end s53

-- Section 5.4: Structuring tactic proofs
namespace s54
    -- Mixing term and tactic style proofs
    example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
    begin
    intro h,
    exact
        have hp : p, from h.left,
        have hqr : q ∨ r, from h.right,
        show (p ∧ q) ∨ (p ∧ r),
        begin
        cases hqr with hq hr,
            exact or.inl ⟨hp, hq⟩,
        exact or.inr ⟨hp, hr⟩
        end
    end

    example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
    apply iff.intro,
        intro h,
        cases h.right with hq hr,
        exact or.inl ⟨h.left, hq⟩,
        exact or.inr ⟨h.left, hr⟩,
    intro h,
    cases h with hpq hpr,
        exact ⟨hpq.left, or.inl hpq.right⟩,
    exact ⟨hpr.left, or.inr hpr.right⟩
    end

    --Rewrite above, noting show works in tactic mode and "from" = "exact"
    example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
    apply iff.intro,
        intro h,
        cases h.right with hq hr,
        show (p ∧ q) ∨ (p ∧ r),
            from or.inl ⟨h.left, hq⟩,
        show (p ∧ q) ∨ (p ∧ r),
            from or.inr ⟨h.left, hr⟩,
    intro h,
    cases h with hpq hpr,
        show p ∧ (q ∨ r),
        from ⟨hpq.left, or.inl hpq.right⟩,
        show p ∧ (q ∨ r),
        from ⟨hpr.left, or.inr hpr.right⟩
    end

    -- Or don't use from to remain in tactic mode
    example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
    apply iff.intro,
        intro h,
        cases h.right with hq hr,
        show (p ∧ q) ∨ (p ∧ r),
            { left, split, exact h.left, assumption },
        show (p ∧ q) ∨ (p ∧ r),
            { right, split, exact h.left, assumption },
    intro h,
    cases h with hpq hpr,
        show p ∧ (q ∨ r),
        { cases hpq, split, assumption, left, assumption },
        show p ∧ (q ∨ r),
        { cases hpr, split, assumption, right, assumption }
    end

    -- Show can rewrite something to something definitionally equiv
    example (n : ℕ) : n + 1 = nat.succ n :=
    begin
    show nat.succ n = nat.succ n,
    reflexivity
    end
    -- When there are multiple goals, use show to focus on a particular one to work on
    example (p q : Prop) : p ∧ q → q ∧ p :=
    begin
    intro h,
    cases h with hp hq,
    split,
    show q, from hq,
    show p, from hp
    end

    example (p q : Prop) : p ∧ q → q ∧ p :=
    begin
    intro h,
    cases h with hp hq,
    split,
    show p, from hp,
    show q, from hq
    end

    -- "have" introduces new subgoal, like with terms
    example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
    begin
    intro h,
    cases h with hp hqr,
    show (p ∧ q) ∨ (p ∧ r),
    cases hqr with hq hr,
        have hpq : p ∧ q,
        from and.intro hp hq,
        left, exact hpq,
    have hpr : p ∧ r,
        from and.intro hp hr,
    right, exact hpr
    end
    -- Again, but don't use from to remain in tactic mode
    example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
    begin
    intro h,
    cases h with hp hqr,
    show (p ∧ q) ∨ (p ∧ r),
    cases hqr with hq hr,
        have hpq : p ∧ q,
        split; assumption,
        left, exact hpq,
    have hpr : p ∧ r,
        split; assumption,
    right, exact hpr
    end

    -- Omit the label of "have" and refer to it with 'this'
    example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
    begin
    intro h,
    cases h with hp hqr,
    show (p ∧ q) ∨ (p ∧ r),
    cases hqr with hq hr,
        have : p ∧ q,
        split; assumption,
        left, exact this,
    have : p ∧ r,
        split; assumption,
    right, exact this
    end

    -- using 'have' with ':=' is the same as from
    example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
    begin
    intro h,
    have hp : p := h.left,
    have hqr : q ∨ r := h.right,
    show (p ∧ q) ∨ (p ∧ r),
    cases hqr with hq hr,
        exact or.inl ⟨hp, hq⟩,
    exact or.inr ⟨hp, hr⟩
    end

    -- Let creates abbreviation rather than a new fact (like 'have' does)
    example : ∃ x, x + 2 = 8 :=
    begin
    let a : ℕ := 3 * 2,
    existsi a,
    reflexivity
    end

    -- In a nested block, Lean focuses on the first goal,
    --generates an error if it has not been fully solved at the end of the block.
    example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
    apply iff.intro,
    begin
        intro h,
        cases h.right with hq hr,
        begin
        show (p ∧ q) ∨ (p ∧ r),
            exact or.inl ⟨h.left, hq⟩
        end,
        show (p ∧ q) ∨ (p ∧ r),
        exact or.inr ⟨h.left, hr⟩
    end,
    intro h,
    cases h with hpq hpr,
    begin
        show p ∧ (q ∨ r),
        exact ⟨hpq.left, or.inl hpq.right⟩
    end,
    show p ∧ (q ∨ r),
        exact ⟨hpr.left, or.inr hpr.right⟩
    end

    -- Abbreviate nested begin..end with curly braces
    example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
    apply iff.intro,
    { intro h,
        cases h.right with hq hr,
        { show (p ∧ q) ∨ (p ∧ r),
            exact or.inl ⟨h.left, hq⟩ },
        show (p ∧ q) ∨ (p ∧ r),
        exact or.inr ⟨h.left, hr⟩ },
    intro h,
    cases h with hpq hpr,
    { show p ∧ (q ∨ r),
        exact ⟨hpq.left, or.inl hpq.right⟩ },
    show p ∧ (q ∨ r),
        exact ⟨hpr.left, or.inr hpr.right⟩
    end

    -- Final example
    example (p q : Prop) : p ∧ q ↔ q ∧ p :=
    begin
    apply iff.intro,
    { intro h,
        have hp : p := h.left,
        have hq : q := h.right,
        show q ∧ p,
        exact ⟨hq, hp⟩ },
    intro h,
    have hp : p := h.right,
    have hq : q := h.left,
    show p ∧ q,
        exact ⟨hp, hq⟩
    end

end s54

-- Section 5.5: Tactic combinators
namespace s55
    -- comma applies tactics in sequence
    example (p q : Prop) (hp : p) : p ∨ q :=
    begin left, assumption end
    --semi applies in parallel
    example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
    by split; assumption
    --or else combinator
    example (p q : Prop) (hp : p) : p ∨ q :=
    by { left, assumption } <|> { right, assumption}

    example (p q : Prop) (hq : q) : p ∨ q :=
    by { left, assumption } <|> { right, assumption}

    -- tactics are just terms
    meta def my_tac : tactic unit :=
    `[ repeat { {left, assumption} <|> right <|> assumption } ]

    example (p q r : Prop) (hp : p) : p ∨ q ∨ r :=
    by my_tac

    example (p q r : Prop) (hq : q) : p ∨ q ∨ r :=
    by my_tac

    example (p q r : Prop) (hr : r) : p ∨ q ∨ r :=
    by my_tac

    -- repeat {try t} will loop forever, because the inner tactic never fails

    -- all goals
    example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
    p ∧ q ∧ r :=
    begin
    split,
    all_goals { try {split} },
    all_goals { assumption }
    end
    --any goals
    example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
    p ∧ q ∧ r :=
    begin
    split,
    any_goals { split },
    any_goals { assumption }
    end

    example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
    p ∧ ((p ∧ q) ∧ r) ∧ (q ∧ r ∧ p) :=
    by repeat { any_goals { split <|> assumption} }

end s55

-- Section 5.6: Rewriting
section s56

    variables (f : ℕ → ℕ) (k : ℕ)
    example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
    begin
    rw h₂, -- replace k with 0
    rw h₁  -- replace f 0 with 0
    end

    example (x y : ℕ) (p : ℕ → Prop) (q : Prop) (h : q → x = y)
    (h' : p y) (hq : q) : p x :=
    by { rw (h hq), assumption }

    example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
    by rw [h₂, h₁]

    variables (a b : ℕ)

    example (h₁ : a = b) (h₂ : f a = 0) : f b = 0 :=
    begin
    rw [←h₁, h₂]
    end

    example (a b c : ℕ) : a + b + c = a + c + b :=
    begin
    rw [add_assoc, add_comm b, ←add_assoc]
    end

    example (a b c : ℕ) : a + b + c = a + c + b :=
    begin
    rw [add_assoc, add_assoc, add_comm b]
    end

    example (a b c : ℕ) : a + b + c = a + c + b :=
    begin
    rw [add_assoc, add_assoc, add_comm _ b]
    end

    -- By default, rw rewrites the goal, but we can make it rewrite hypotheses

    example (h : a + 0 = 0) : f a = f 0 :=
    by { rw add_zero at h, rw h }

    -- Rewriting arbitrary structures
    universe u

    def tuple (α : Type u) (n : ℕ) :=
    { l : list α // list.length l = n }

    variables {α : Type u} {n : ℕ}

    example (h : n = 0) (t : tuple α n) : tuple α 0 :=
    begin
    rw h at t,
    exact t
    end

    example {α : Type u} [ring α] (a b c : α) :
    a * 0 + 0 * b + c * 0 + 0 * a = 0 :=
    begin
    rw [mul_zero, mul_zero, zero_mul, zero_mul],
    repeat { rw add_zero }
    end

    example {α : Type u} [group α] {a b : α} (h : a * b = 1) :
    a⁻¹ = b :=
    by rw [←(mul_one a⁻¹), ←h, inv_mul_cancel_left]

end s56

-- Section 5.7 Simplifier
section s57
section
variables (x y z w : ℕ) (p : ℕ → Prop)
variable  (h : p (x * y))

example : (x + 0) * (0 + y * 1 + z * 0) = x * y :=
by simp

include h
example : p ((x + 0) * (0 + y * 1 + z * 0)) :=
by { simp, assumption }

universe u
variable {α : Type}
open list

example (xs : list ℕ) :
  reverse (xs ++ [1, 2, 3]) = [3, 2, 1] ++ reverse xs :=
by simp

example (xs ys : list α) :
  length (reverse (xs ++ ys)) = length xs + length ys :=
by simp

-- As with rw, can simplify a hypothesis

example (h : p ((x + 0) * (0 + y * 1 + z * 0))) :
  p (x * y) :=
by { simp at h, assumption }
-- Wildcard to simplify everything

local attribute [simp] mul_comm mul_assoc mul_left_comm

example (h : p (x * y + z * w  * x)) : p (x * w * z + y * x) :=
by { simp at *, assumption }

example (h₁ : p (1 * x + y)) (h₂ : p  (x * z * 1)) :
  p (y + 0 + x) ∧ p (z * x) :=
by { simp at *, split; assumption }

section
local attribute [simp] mul_comm mul_assoc mul_left_comm

example : x * y + z * w  * x = x * w * z + y * x :=
by simp

example (h : p (x * y + z * w  * x)) : p (x * w * z + y * x) :=
begin simp, simp at h, assumption end
end
end

-- Common strategy
variables (f : ℕ → ℕ) (k : ℕ)

example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
by simp [h₁, h₂]

-- Again but simpler
example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
by simp *
section
variables (p q r : Prop)

example (hp : p) : p ∧ q ↔ q :=
by simp *

example (hp : p) : p ∨ q :=
by simp *

example (hp : p) (hq : q) : p ∧ (q ∨ r) :=
by simp *
end

section
variables (u w x x' y y' z : ℕ) (p : ℕ → Prop)

example (h₁ : x + 0 = x') (h₂ : y + 0 = y') :
  x + y + 0 = x' + y' :=
by { simp at *, simp * }

-- simplify all the hypotheses, and then use them to prove the goal
example (h₁ : x = y + z) (h₂ : w = u + x) (h₃ : p (z + y + u)) :
  p w  :=
by { simp at *, simp * }
end

-- Make new definitions to add to simp's power

open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs
theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by { unfold mk_symm, simp }
theorem reverse_mk_symm2 (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]
example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp [reverse_mk_symm]

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp [reverse_mk_symm] at h; assumption

-- Declare something to be simp
@[simp] theorem reverse_mk_symm3 (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp

example (xs ys : list ℕ) (p : list ℕ → Prop)
    (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp at h; assumption

end s57

-- Section 5.
section s5
end s5