import data.real.basic
import algebra.pi_instances

set_option pp.beta true

/-
In this file, we'll learn about the ∀ quantifier, and the disjunction
operator ∨ (logical OR).

Let P be a predicate on a type X. This means for every mathematical
object x with type X, we get a mathematical statement P x.
In Lean, P x has type Prop.

Lean sees a proof h of `∀ x, P x` as a function sending any `x : X` to
a proof `h x` of `P x`.
This already explains the main way to use an assumption or lemma which
starts with a ∀.

In order to prove `∀ x, P x`, we use `intros x` to fix an arbitrary object
with type X, and call it x.

Note also we don't need to give the type of x in the expression `∀ x, P x`
as long as the type of P is clear to Lean, which can then infer the type of x.

Let's define two predicates to play with ∀.
-/

def even_fun (f : ℝ → ℝ) := ∀ x, f (-x) = f x

def odd_fun (f : ℝ → ℝ) := ∀ x, f (-x) = -f x

/-
In the next proof, we also take the opportunity to introduce the
`unfold` tactic, which simply unfolds definitions. Here this is purely
for didactic reason, Lean doesn't need those `unfold` invocations.
We will also use `rfl` which is a term proving equalities that are true
by definition (in a very strong sense to be discussed later).
-/

example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  -- Assume f is even
  intros hf,
  -- which means ∀ x, f (-x) = f x
  unfold even_fun at hf,
  -- and the same for g
  intros hg,
  unfold even_fun at hg,
  -- We need to prove ∀ x, (f+g)(-x) = (f+g)(x)
  unfold even_fun,
  -- Let x be any real number
  intros x,
  -- and let's compute
  calc (f + g) (-x) = f (-x) + g (-x) : rfl
  ... = f x + g (-x) : by rw hf x
  ... = f x + g x : by rw hg x
  ... = (f + g) x : rfl
end

/-
In the preceding proof, all `unfold` lines are purely for
psychological comfort.

Sometimes unfolding is necessary because we want to apply a tactic
that operates purely on the syntactical level.
The main such tactic is `rw`.

The same property of `rw` explain why the first computation line
is necessary, although its proof is simply `rfl`.
Before that line, `rw hf x` won't find anything like `f (-x)` hence
will give up.
The last line is not necessary however, since it only proves
something that is true by definition, and is not followed by
a `rw`.

Also, Lean doesn't need to be told that hf should be specialized to
x before rewriting, exactly as in the first file 01_equality_rewriting.
We can also gather several rewrites using a list of expressions.

Hence we can compress the above proof to:
-/

example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  intros hf hg x,
  calc (f + g) (-x) = f (-x) + g (-x) : rfl
  ... = f x + g x : by rw [hf, hg]
end

/-
Note that the tactic state displays changes when we
move the cursor inside the list of expressions given to `rw`.

Now let's practice.
-/

-- 0023
example (f g : ℝ → ℝ) : even_fun f → even_fun (g ∘ f) :=
begin
  -- sorry
  intros hf x,
  calc (g ∘ f) (-x) = g (f (-x)) : rfl
  ... = g (f x) : by rw hf
  -- sorry
end

-- 0024
example (f g : ℝ → ℝ) : odd_fun f → odd_fun g →  odd_fun (g ∘ f) :=
begin
  -- sorry
  intros hf hg x,
  calc (g ∘ f) (-x) = g (f (-x)) : rfl
  ... = - (g ∘ f) x : by rw [hf, hg],
  -- sorry
end

/-
Let's have more quantifiers, and play with forward and backward reasoning.

In the next definitions, note how `∀ x₁, ∀ x₂` is abreviated to `∀ x₁ x₂`.
-/

def non_decreasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≤ f x₂

def non_increasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≥ f x₂

/- Let's be very explicit and use forward reasonning first. -/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  -- Let x₁ and x₂ be real numbers such that x₁ ≤ x₂
  intros x₁ x₂ h,
  -- Since f is non-decreasing, f x₁ ≤ f x₂.
  have step₁ :  f x₁ ≤ f x₂,
    exact hf x₁ x₂ h,
  -- Since g is non-decreasing, we then get g (f x₁) ≤ g (f x₂).
  exact hg (f x₁) (f x₂) step₁,
end

/-
In the above proof, note how inconvenient it is to specify x₁ and x₂ in `hf x₁ x₂ h` since
they could be inferred from the type of h.
We could have written `hf _ _ h` and Lean would have filled the holes denoted by _.

Even better we could have written the definition
of `non_decreasing` as: ∀ {x₁ x₂}, x₁ ≤ x₂ → f x₁ ≤ f x₂, with curly braces to denote
implicit arguments.

But let's leave that aside for now. One possible variation on the above proof is to
use the `specialize` tactic to replace hf by its specialization to the relevant value.
 -/

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  specialize hf x₁ x₂ h,
  exact hg (f x₁) (f x₂) hf,
end

/-
This `specialize` tactic is mostly useful for exploration, or in preparation for rewriting
in the assumption. One can very often replace its use by using more complicated expressions
directly involving the original assumption, as in the next variation:
-/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  exact hg (f x₁) (f x₂) (hf x₁ x₂ h),
end

/-
Since the above proof uses only `intros` and `exact`, we could very easily replace it by the
raw proof term:
-/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
λ x₁ x₂ h, hg (f x₁) (f x₂) (hf x₁ x₂ h)

/-
Of course the above proof is difficult to decipher. The principle in mathlib is to use
such a proof when the result is obvious and you don't want to read the proof anyway.

Instead of pursuing this style, let's see how backward reasoning would look like here.
As usual with this style, we use `apply` and enjoy Lean specializing assumptions for us
using unification.
-/

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  -- Let x₁ and x₂ be real numbers such that x₁ ≤ x₂
  intros x₁ x₂ h,
  -- We need to prove (g ∘ f) x₁ ≤ (g ∘ f) x₂.
  -- Since g is non-decreasing, it suffices to prove f x₁ ≤ f x₂
  apply hg,
  -- which follows from our assumption on f
  apply hf,
  -- and on x₁ and x₂
  exact h
end

-- 0025
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_increasing g) : non_increasing (g ∘ f) :=
begin
  -- sorry
  intros x₁ x₂ h,
  apply hg,
  exact hf x₁ x₂ h
  -- sorry
end

/-
Let's switch to disjunctions now. Lean denotes by ∨ the
logical OR operator.

In order to make use of an assumption
  hyp : P ∨ Q
we use the cases tactic:
  cases hyp with hP hQ
which creates two proof branches: one branch assuming hP : P,
and one branch assuming hQ : Q.

In order to directly prove a goal P ∨ Q,
we use either the `left` tactic and prove P or the `right`
tactic and prove Q.

In the next proof we use `ring` and `linarith` to get rid of
easy computations or inequalities, as well as one lemma:

  mul_eq_zero : a*b = 0 ↔ a = 0 ∨ b = 0
-/

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  intro hyp,
  have H : a*(1 - b) = 0,
  { calc a*(1 - b) = a - a*b : by ring
               ... = 0       : by linarith, },
  rw mul_eq_zero at H,
  cases H with Ha Hb,
  { left,
    exact Ha, },
  { right,
    linarith, },
end

-- 0026
example (x y : ℝ) : x^2 = y^2 → x = y ∨ x = -y :=
begin
  -- sorry
  intros hyp,
  have H : (x-y)*(x+y) = 0,
    calc (x-y)*(x+y) = x^2 - y^2 : by ring
    ... = y^2 - y^2 : by rw hyp
    ... = 0 : by ring,
  rw mul_eq_zero at H,
  cases H with h1 h2,
  { left,
    linarith, },
  { right,
    linarith, },
  -- sorry
end

/-
In the next exercise, we can use:
  eq_or_lt_of_le : x ≤ y → x = y ∨ x < y
-/

-- 0027
example (f : ℝ → ℝ) : non_decreasing f ↔ ∀ x y, x < y → f x ≤ f y :=
begin
  -- sorry
  split,
  { intros hf x y hxy,
    apply hf,
    linarith, },
  { intros hf x y hxy,
    have clef : x = y ∨ x < y,
    { exact eq_or_lt_of_le hxy },
    cases clef with hxy hxy,
    rw hxy,
    exact hf x y hxy, },
  -- sorry
end

/-
In the next exercise, we can use:
  le_total x y : x ≤ y ∨ y ≤ x
-/

-- 0028
example (f : ℝ → ℝ) (h : non_decreasing f) (h' : ∀ x, f (f x) = x) : ∀ x, f x = x :=
begin
  -- sorry
  intro x,
  have : f (f x) = x,
  { rw h' },
  have : (f x ≤ x) ∨ (x ≤ f x),
  { exact le_total (f x) x },
  cases this with hx hx,
  { have f1: f (f x) ≤ f x,
    { exact h (f x) x hx, },
    rw h' at f1,
    linarith, },
  { have f1: f x ≤ f (f x),
    { exact h x (f x) hx, },
    rw h' x at f1,
    linarith, },
  -- sorry
end


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import algebra.char_p.basic
import group_theory.perm.cycle.type

/-!
# Characteristic and cardinality

We prove some results relating characteristic and cardinality of finite rings

## Tags
characterstic, cardinality, ring
-/

/-- A prime `p` is a unit in a finite commutative ring `R`
iff it does not divide the characteristic. -/
lemma is_unit_iff_not_dvd_char (R : Type*) [comm_ring R] [fintype R] (p : ℕ) [fact p.prime] :
  is_unit (p : R) ↔ ¬ p ∣ ring_char R :=
begin
  have hch := char_p.cast_eq_zero R (ring_char R),
  split,
  { rintros h₁ ⟨q, hq⟩,
    rcases is_unit.exists_left_inv h₁ with ⟨a, ha⟩,
    have h₃ : ¬ ring_char R ∣ q :=
    begin
      rintro ⟨r, hr⟩,
      rw [hr, ← mul_assoc, mul_comm p, mul_assoc] at hq,
      nth_rewrite 0 ← mul_one (ring_char R) at hq,
      exact nat.prime.not_dvd_one (fact.out p.prime)
             ⟨r, mul_left_cancel₀ (char_p.char_ne_zero_of_fintype R (ring_char R)) hq⟩,
    end,
    have h₄ := mt (char_p.int_cast_eq_zero_iff R (ring_char R) q).mp,
    apply_fun (coe : ℕ → R) at hq,
    apply_fun ((*) a) at hq,
    rw [nat.cast_mul, hch, mul_zero, ← mul_assoc, ha, one_mul] at hq,
    norm_cast at h₄,
    exact h₄ h₃ hq.symm, },
  { intro h,
    rcases nat.is_coprime_iff_coprime.mpr ((nat.prime.coprime_iff_not_dvd (fact.out _)).mpr h)
      with ⟨a, b, hab⟩,
    apply_fun (coe : ℤ → R) at hab,
    push_cast at hab,
    rw [hch, mul_zero, add_zero, mul_comm] at hab,
    exact is_unit_of_mul_eq_one (p : R) a hab, },
end

/-- The prime divisors of the characteristic of a finite commutative ring are exactly
the prime divisors of its cardinality. -/
lemma prime_dvd_char_iff_dvd_card {R : Type*} [comm_ring R] [fintype R] (p : ℕ) [fact p.prime] :
  p ∣ ring_char R ↔ p ∣ fintype.card R :=
begin
  refine ⟨λ h, h.trans $ int.coe_nat_dvd.mp $ (char_p.int_cast_eq_zero_iff R (ring_char R)
    (fintype.card R)).mp $ by exact_mod_cast char_p.cast_card_eq_zero R, λ h, _⟩,
  by_contra h₀,
  rcases exists_prime_add_order_of_dvd_card p h with ⟨r, hr⟩,
  have hr₁ := add_order_of_nsmul_eq_zero r,
  rw [hr, nsmul_eq_mul] at hr₁,
  rcases is_unit.exists_left_inv ((is_unit_iff_not_dvd_char R p).mpr h₀) with ⟨u, hu⟩,
  apply_fun ((*) u) at hr₁,
  rw [mul_zero, ← mul_assoc, hu, one_mul] at hr₁,
  exact mt add_monoid.order_of_eq_one_iff.mpr
          (ne_of_eq_of_ne hr (nat.prime.ne_one (fact.out p.prime))) hr₁,
end

/-- A prime that does not divide the cardinality of a finite commutative ring `R`
is a unit in `R`. -/
lemma not_is_unit_prime_of_dvd_card {R : Type*} [comm_ring R] [fintype R] (p : ℕ) [fact p.prime]
 (hp : p ∣ fintype.card R) : ¬ is_unit (p : R) :=
mt (is_unit_iff_not_dvd_char R p).mp (not_not.mpr ((prime_dvd_char_iff_dvd_card p).mpr hp))


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 2 : "the" empty set and the "universal set".

Lean notation for the empty subset of `X` is `∅`. Unlike in
set theory, there is more than one empty set in Lean! Every
type has an empty subset, and it *doesn't make sense*
to ask if `∅ : set ℕ` and `∅ : set ℤ` are equal, because
they have different types.

At the other extreme, the subset of `X` containing all the terms of type `X`
is...well...mathematicians would just call it `X`, but `X` is a type not a subset.
The subset of `X` consisting of every element of `X` is called `set.univ : set X`,
or just `univ : set X` if we have opened the `set` namespace. Let's do that now.

-/

open set

/-

## Definition of ∅ and univ

`x ∈ ∅` is *by definition* equal to `false` and `x ∈ univ` is *by definition*
equal to `true`. You can use the `change` tactic to make these changes
if you like. But you don't have to. Remember that `triv` proves `true`
and `cases h` will solve a goal if `h : false` (because there are no cases!)

-/

-- set up variables
variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

open set

example : x ∈ (univ : set X) :=
begin
  sorry
end

example : x ∈ (∅ : set X) → false :=
begin
  sorry
end

example : A ⊆ univ :=
begin
  sorry
end

example : ∅ ⊆ A :=
begin
  sorry
end


/- LoVe Homework 10: Denotational Semantics -/

import .love10_denotational_semantics_demo

namespace LoVe

/- Denotational semantics are well suited to functional programming. In this
exercise, we will study some representations of functional programs in Lean and
their denotational semantics. -/

/- The `nondet` type represents functional programs that can perform
nondeterministic computations: A program can choose between many different
computation paths / return values. Returning no results at all is represented by
`fail`, and nondeterministic choice between two alternatives (identified by the
`bool` values `tt` and `ff`) is represented by `choice`. -/

inductive nondet (α : Type) : Type
| pure    : α → nondet
| fail {} : nondet
| choice  : (bool → nondet) → nondet

namespace nondet

/- Question 1: The `nondet` Monad -/

/- The `nondet` inductive type forms a monad. The `pure` operator is
`nondet.pure`; `bind` is as follows: -/

def bind {α β : Type} : nondet α → (α → nondet β) → nondet β
| (pure x)   f := f x
| fail       f := fail
| (choice k) f := choice (λb, bind (k b) f)

instance : has_pure nondet := { pure := @pure }
instance : has_bind nondet := { bind := @bind }

/- 1.1. Prove the monadic laws (lecture 6) for `nondet`.

Hint: To prove `f = g` from `∀x, f x = g x`, use the theorem `funext`. -/

lemma pure_bind {α β : Type} (x : α) (f : α → nondet β) :
  pure x >>= f = f x :=
sorry

lemma bind_pure {α : Type} :
  ∀mx : nondet α, mx >>= pure = mx
:= sorry

lemma bind_assoc {α β γ : Type} :
  ∀(mx : nondet α) (f : α → nondet β) (g : β → nondet γ),
    ((mx >>= f) >>= g) = (mx >>= (λa, f a >>= g))
:= sorry

/- The function `portmanteau` computes a portmanteau of two lists: A portmanteau
of `xs` and `ys` has `xs` as a prefix and `ys` as a suffix, and they overlap. We
use `starts_with xs ys` to test that `ys` has `xs` as a prefix. -/

def starts_with : list ℕ → list ℕ → bool
| (x :: xs) []        := ff
| []        ys        := tt
| (x :: xs) (y :: ys) := (x = y) && starts_with xs ys

#eval starts_with [1, 2] [1, 2, 3]
#eval starts_with [1, 2, 3] [1, 2]

def portmanteau : list ℕ → list ℕ → list (list ℕ)
| []        ys := []
| (x :: xs) ys :=
  list.map (list.cons x) (portmanteau xs ys) ++
  (if starts_with (x :: xs) ys then [ys] else [])

/- Here are some examples of portmanteaux: -/

#reduce portmanteau [0, 1, 2, 3] [2, 3, 4]
#reduce portmanteau [0, 1] [2, 3, 4]
#reduce portmanteau [0, 1, 2, 1, 2] [1, 2, 1, 2, 3, 4]

/- 1.2 (**optional**). Translate the `portmanteau` program from the `list` monad
to the `nondet` monad. -/

def nondet_portmanteau : list ℕ → list ℕ → nondet (list ℕ)
:= sorry

/- Question 2: Nondeterminism, Denotationally -/

/- 2.1. Give a denotational semantics for `nondet`, mapping it into a `list` of
all results. `pure` returns one result, `fail` returns zero, and `choice`
combines the results of either alternative. -/

def list_sem {α : Type} : nondet α → list α
:= sorry

/- Check that the following lines give the same output as for `portmanteau`: -/

#reduce list_sem (nondet_portmanteau [0, 1, 2, 3] [2, 3, 4])
#reduce list_sem (nondet_portmanteau [0, 1] [2, 3, 4])
#reduce list_sem (nondet_portmanteau [0, 1, 2, 1, 2] [1, 2, 1, 2, 3, 4])

/- 2.2. Often, we are not interested in getting all outcomes, just the first
successful one. Give a semantics for `nondet` that produces the first successful
result, if any. -/

def option_sem {α : Type} : nondet α → option α
:= sorry

/- 2.3. Prove the theorem `list_option_compat` below, showing that the two
semantics you defined are compatible. -/

lemma head'_orelse_eq_head'_append {α : Type} (xs ys : list α) :
  (list.head' xs <|> list.head' ys) = list.head' (xs ++ ys) :=
by induction xs; simp

theorem list_option_compat {α : Type} :
  ∀mx : nondet α, option_sem mx = list.head' (list_sem mx)
:= sorry

/- Question 3 (**optional**). Nondeterminism, Operationally -/

/- We can define the following big-step operational semantics for `nondet`: -/

inductive big_step {α : Type} : nondet α → α → Prop
| pure {x : α} :
  big_step (pure x) x
| choice_l {k : bool → nondet α} {x : α} :
  big_step (k ff) x → big_step (choice k) x
| choice_r {k : bool → nondet α} {x : α} :
  big_step (k tt) x → big_step (choice k) x
-- there is no case for `fail`

notation mx `⟹` x := big_step mx x

/- 3.1 (**optional**). Prove the following lemma.

The lemma states that `choice` has the semantics of "angelic nondeterminism": If
there is a computational path that leads to some `x`, the `choice` operator will
produce this `x`. -/

lemma choice_existential {α : Type} (x : α) (k : bool → nondet α) :
  nondet.choice k ⟹ x ↔ ∃b, k b ⟹ x :=
sorry

/- 3.2 (**optional**). Prove the compatibility between denotational and
operational semantics. -/

theorem den_op_compat {α : Type} :
  ∀(x : α) (mx : nondet α), x ∈ list_sem mx ↔ mx ⟹ x
:= sorry

end nondet

end LoVe


import data.real.basic
open classical
open tactic
attribute [instance] prop_decidable

/-
  Rigorous definition of a limit
  For a sequence x_n, we say that \lim_{n \to \infty} x_n = l if
    ∀ ε > 0, ∃ N, n ≥ N → |x_n - l| < ε
-/

def lim_to_inf (x : ℕ → ℝ) (l : ℝ) :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, abs (x n - l) < ε

theorem help (x y z : ℝ) (h1 : x ≤ y) (h2 : y ≤ z) :  abs (y - x) ≤ abs (z - x) :=
begin
    have key : (y - x) ≤ (z - x),
        exact sub_le_sub_right h2 x,
    have h1 : 0 ≤ (y - x),
        linarith,
    apply abs_le_abs key _,
    linarith
end

theorem help' (x y z : ℝ) (h1 : x ≤ y) (h2 : y ≤ z) :  abs (z - y) ≤ abs (z - x) :=
begin
    have key : (-x ≥ -y) ∧ (-y ≥ -z) := ⟨by linarith, by linarith⟩,
    have key' : abs (-y - (-z)) ≤ abs (-x - (-z)),
        exact help _ _ _ key.2 key.1,
    simp only [neg_sub_neg] at key',
    assumption,
end

theorem exercise_1p2 (x y : ℕ → ℝ) (l : ℝ)
  (h₁ : ∀ n, x n ≤ l ∧ l ≤ y n)
  (h₂ : lim_to_inf (λ n, x n - y n) 0) :
  lim_to_inf x l ∧ lim_to_inf y l :=
begin
    split,
    {
        intros ε ε_pos,
        rcases h₂ ε ε_pos with ⟨N, hN⟩,
        use N,
        intros n hn,
        have key : abs (l - x n) ≤ abs (y n - x n),
            exact help _ _ _ (h₁ n).1 (h₁ n).2,
        specialize hN n hn,
        simp only [sub_zero] at hN,
        calc
        abs (x n - l) = abs (l - x n) : abs_sub (x n) l
        ... ≤ abs (y n - x n)         : key
        ... = abs (x n - y n)         : abs_sub (y n) (x n)
        ... < ε                       : hN,
    },
    {
    intros ε ε_pos,
        rcases h₂ ε ε_pos with ⟨N, hN⟩,
        use N,
        intros n hn,
        have key : abs (y n - l) ≤ abs (y n - x n),
            exact help' _ _ _ (h₁ n).1 (h₁ n).2,
        specialize hN n hn,
        simp only [sub_zero] at hN,
        calc
        abs (y n - l) ≤ abs (y n - x n) : key
        ... = abs (x n - y n)           : abs_sub (y n) (x n)
        ... < ε                         : hN,
    }
end


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

! This file was ported from Lean 3 source module data.int.nat_prime
! leanprover-community/mathlib commit 422e70f7ce183d2900c586a8cda8381e788a0c62
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Prime

/-!
# Lemmas about `Nat.Prime` using `Int`s
-/

open Nat

namespace Int

theorem not_prime_of_int_mul {a b : ℤ} {c : ℕ} (ha : 1 < a.natAbs) (hb : 1 < b.natAbs)
    (hc : a * b = (c : ℤ)) : ¬Nat.Prime c :=
  not_prime_mul' (natAbs_mul_natAbs_eq hc) ha hb
#align int.not_prime_of_int_mul Int.not_prime_of_int_mul

theorem succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : Nat.Prime p) {m n : ℤ}
    {k l : ℕ} (hpm : ↑(p ^ k) ∣ m) (hpn : ↑(p ^ l) ∣ n) (hpmn : ↑(p ^ (k + l + 1)) ∣ m * n) :
    ↑(p ^ (k + 1)) ∣ m ∨ ↑(p ^ (l + 1)) ∣ n :=
  have hpm' : p ^ k ∣ m.natAbs := Int.coe_nat_dvd.1 <| Int.dvd_natAbs.2 hpm
  have hpn' : p ^ l ∣ n.natAbs := Int.coe_nat_dvd.1 <| Int.dvd_natAbs.2 hpn
  have hpmn' : p ^ (k + l + 1) ∣ m.natAbs * n.natAbs := by
    rw [← Int.natAbs_mul]; apply Int.coe_nat_dvd.1 <| Int.dvd_natAbs.2 hpmn
  let hsd := Nat.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hpm' hpn' hpmn'
  hsd.elim (fun hsd1 => Or.inl (by apply Int.dvd_natAbs.1; apply Int.coe_nat_dvd.2 hsd1))
    fun hsd2 => Or.inr (by apply Int.dvd_natAbs.1; apply Int.coe_nat_dvd.2 hsd2)
#align int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul Int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul

theorem Prime.dvd_natAbs_of_coe_dvd_sq {p : ℕ} (hp : p.Prime) (k : ℤ) (h : (p : ℤ) ∣ k ^ 2) :
    p ∣ k.natAbs := by
  apply @Nat.Prime.dvd_of_dvd_pow _ _ 2 hp
  rwa [sq, ← natAbs_mul, ← coe_nat_dvd_left, ← sq]
#align int.prime.dvd_nat_abs_of_coe_dvd_sq Int.Prime.dvd_natAbs_of_coe_dvd_sq


import .love04_functional_programming_demo

/-! # LoVe Homework 4: Functional Programming

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (2 points): Maps

1.1 (1 point). Complete the following definition. The `map_btree` function
should apply its argument `f` to all values of type `α` stored in the tree and
otherwise preserve the tree's structure. -/

def map_btree {α β : Type} (f : α → β) : btree α → btree β
| btree.empty        := btree.empty
| (btree.node a l r) := btree.node (f a) (map_btree l) (map_btree r)

/-! 1.2 (1 point). Prove the following lemma about your `map_btree` function. -/

lemma map_btree_iden {α : Type} :
  ∀t : btree α, map_btree (λa, a) t = t
| btree.empty        := by refl
| (btree.node a l r) := by simp [map_btree, map_btree_iden l, map_btree_iden r]

/-! ## Question 2 (4 points): Tail-Recursive Factorials

Recall the definition of the factorial functions: -/

#check fact

/-! 2.1 (2 points). Experienced functional programmers tend to avoid definitions
such as the above, because they lead to a deep call stack. Tail recursion can be
used to avoid this. Results are accumulated in an argument and returned. This
can be optimized by compilers. For factorials, this gives the following
definition: -/

def accufact : ℕ → ℕ → ℕ
| a 0       := a
| a (n + 1) := accufact ((n + 1) * a) n

/-! Prove that, given 1 as the accumulator `a`, `accufact` computes `fact`.

Hint: You will need to prove a generalized version of the statement as a
separate lemma or `have`, because the desired property fixes `a` to 1, which
yields a too weak induction hypothesis. -/

lemma accufact_1_eq_fact (n : ℕ) :
  accufact 1 n = fact n :=
have accufact_eq_fact_mul : ∀m a, accufact a m = fact m * a :=
  begin
    intros m a,
    induction' m,
    case zero {
      simp [fact, accufact] },
    case succ {
      simp [fact, accufact, ih],
      cc }
  end,
by simp [accufact_eq_fact_mul n 1]

/-! 2.2 (2 points). Prove the same property as above again, this time as a
"paper" proof. Follow the guidelines given in question 1.4 of the exercise. -/

/-! The generalized lemma we prove is `∀n a, accufact a n = fact n * a`.

We perform the proof by structural (mathematical) induction on `n`,
generalizing `a`.

Case 0: The goal is `accufact a 0 = fact 0 * a`. The left-hand side is `a` by
definition of `accufact`. The right-hand side is `a` by definition of `fact` and
`*`.

Case `m + 1`: The goal is `accufact a (m + 1) = fact (m + 1) * a`. The induction
hypothesis is `∀a, accufact a m = fact m * a`.

Let us simplify the goal's left-hand side:

      accufact a (m + 1)
    = accufact ((m + 1) * a) m   -- by definition of `accufact`
    = fact m * ((m + 1) * a)     -- by the induction hypothesis
    = fact m * (m + 1) * a       -- by associativity of `*`

Now let us massage the right-hand side so that it matches the simplified
left-hand side:

      fact (m + 1) * a
    = (m + 1) * fact m * a       -- by definition of `fact`
    = fact m * (m + 1) * a       -- by commutativity of `*`

The two sides are equal.

The desired property follows from the generalized lemma by setting `a` to be `1`
and by simplifying away `* 1`. QED -/

/-! ## Question 3 (3 points): Gauss's Summation Formula -/

-- `sum_upto f n = f 0 + f 1 + ⋯ + f n`
def sum_upto (f : ℕ → ℕ) : ℕ → ℕ
| 0       := f 0
| (m + 1) := sum_upto m + f (m + 1)

/-! 3.1 (2 point). Prove the following lemma, discovered by Carl Friedrich Gauss
as a pupil.

Hint: The `mul_add` and `add_mul` lemmas might be useful to reason about
multiplication. -/

#check mul_add
#check add_mul

lemma sum_upto_eq :
  ∀m : ℕ, 2 * sum_upto (λi, i) m = m * (m + 1)
| 0       := by refl
| (m + 1) :=
  begin
    simp [sum_upto, sum_upto_eq m, add_mul, mul_add],
    linarith
  end

/-! 3.2 (1 point). Prove the following property of `sum_upto`. -/

lemma sum_upto_mul (f g : ℕ → ℕ) :
  ∀n : ℕ, sum_upto (λi, f i + g i) n = sum_upto f n + sum_upto g n
| 0       := by refl
| (n + 1) :=
  begin
    simp [sum_upto, sum_upto_mul n],
    cc
  end

end LoVe


/-
Copyright (c) 2021 Matt Kempster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Matt Kempster
-/
import geometry.euclidean.triangle

/-!
# Freek № 57: Heron's Formula

This file proves Theorem 57 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/),
also known as Heron's formula, which gives the area of a triangle based only on its three sides'
lengths.

## References

* https://en.wikipedia.org/wiki/Herons_formula

-/

open real euclidean_geometry
open_locale real euclidean_geometry

local notation `√` := real.sqrt

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]

include V

/-- **Heron's formula**: The area of a triangle with side lengths `a`, `b`, and `c` is
  `√(s * (s - a) * (s - b) * (s - c))` where `s = (a + b + c) / 2` is the semiperimeter.
  We show this by equating this formula to `a * b * sin γ`, where `γ` is the angle opposite
  the side `c`.
 -/
theorem heron {p1 p2 p3 : P} (h1 : p1 ≠ p2) (h2 : p3 ≠ p2) :
  let a := dist p1 p2, b := dist p3 p2, c := dist p1 p3, s := (a + b + c) / 2 in
  1/2 * a * b * sin (∠ p1 p2 p3) = √(s * (s - a) * (s - b) * (s - c)) :=
begin
  intros a b c s,
  let γ := ∠ p1 p2 p3,
  obtain := ⟨(dist_pos.mpr h1).ne', (dist_pos.mpr h2).ne'⟩,
  have cos_rule : cos γ = (a * a + b * b - c * c) / (2 * a * b) := by field_simp [mul_comm, a,
    dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle p1 p2 p3],
  let numerator := (2*a*b)^2 - (a*a + b*b - c*c)^2,
  let denominator := (2*a*b)^2,
  have split_to_frac : 1 - cos γ ^ 2 = numerator / denominator := by field_simp [cos_rule],
  have numerator_nonneg : 0 ≤ numerator,
  { have frac_nonneg: 0 ≤ numerator / denominator := by linarith [split_to_frac, cos_sq_le_one γ],
    cases div_nonneg_iff.mp frac_nonneg,
    { exact h.left },
    { simpa [h1, h2] using le_antisymm h.right (sq_nonneg _) } },
  have ab2_nonneg : 0 ≤ (2 * a * b) := by norm_num [mul_nonneg, dist_nonneg],
  calc  1/2 * a * b * sin γ
      = 1/2 * a * b * (√numerator / √denominator) : by rw [sin_eq_sqrt_one_sub_cos_sq,
                                                          split_to_frac, sqrt_div numerator_nonneg];
                                                      simp [angle_nonneg, angle_le_pi]
  ... = 1/4 * √((2*a*b)^2 - (a*a + b*b - c*c)^2)  : by { field_simp [ab2_nonneg], ring }
  ... = 1/4 * √(s * (s-a) * (s-b) * (s-c) * 4^2)  : by { simp only [s], ring_nf }
  ... = √(s * (s-a) * (s-b) * (s-c))              : by rw [sqrt_mul', sqrt_sq, div_mul_eq_mul_div,
                                                          one_mul, mul_div_cancel];
                                                      norm_num,
end


import order.boolean_algebra
import tactic
open boolean_algebra

variables {α : Type*}[boolean_algebra α]

@[simp] def symm_diff (X Y : α) : α := (X \ Y) ⊔ (Y \ X)
@[simp] lemma sdiff_def {X Y : α} : X \ Y = X ⊓ Yᶜ := sdiff_eq

-- commutativity/associativity with explicit arguments for easier rewriting
lemma inf_comm' (X Y : α) : X ⊓ Y = Y ⊓ X := by apply inf_comm
lemma inf_assoc' (X Y Z : α) : X ⊓ Y ⊓ Z = X ⊓ (Y ⊓ Z) := by apply inf_assoc

lemma inf_right_comm (X Y Z : α) : X ⊓ Y ⊓ Z = X ⊓ Z ⊓ Y :=
  by rw [inf_assoc, inf_comm' Y, ←inf_assoc]

local attribute [simp] symm_diff sdiff_eq

lemma symm_diff_comm (X Y : α) : symm_diff X Y = symm_diff Y X :=
  by simp [sup_comm]

-- 'Normal form' for associativity
lemma symm_diff_three (X Y Z : α) :
  symm_diff (symm_diff X Y) Z = X ⊓ Yᶜ ⊓ Zᶜ ⊔ Y ⊓ Xᶜ ⊓ Zᶜ ⊔ (Z ⊓ (Xᶜ ⊓ Yᶜ) ⊔ Z ⊓ (Y ⊓ X)) :=
begin
  simp only [symm_diff, sdiff_def, inf_sup_right, compl_sup,compl_inf,compl_compl'],
  repeat {rw inf_sup_left},
  repeat {rw inf_sup_right},
  rw [inf_compl_eq_bot, inf_comm' Xᶜ X, inf_compl_eq_bot],
  simp,
end

lemma symm_diff_assoc (X Y Z : α) : symm_diff (symm_diff X Y) Z = symm_diff X (symm_diff Y Z) :=
begin
  rw [symm_diff_three, symm_diff_comm, symm_diff_three],
  rw [inf_comm' Y Xᶜ, inf_comm' Z, inf_comm' Z, inf_comm' Y X, inf_right_comm Y,
      inf_assoc' Z, inf_comm' Y, inf_comm' Z, inf_comm' Yᶜ, inf_comm' Z Y],
    nth_rewrite 1 ←sup_assoc,
    nth_rewrite 4 sup_comm,
    repeat {rw ←sup_assoc},
    repeat {rw ←inf_assoc},
end

lemma inf_distrib_diff (X Y Z : α) : X ⊓ (Y \ Z) = (X ⊓ Y) \ (X ⊓ Z) :=
  by {simp only [sdiff_def, compl_inf, inf_sup_left], rw [inf_right_comm _ Y, ←inf_assoc], simp,  }

lemma symm_diff_distrib_inf_left (X Y Z : α): X ⊓ (symm_diff Y Z)  = symm_diff (X ⊓ Y) (X ⊓ Z) :=
  by simp only [symm_diff, inf_sup_left, inf_sup_right, inf_distrib_diff]

lemma symm_diff_distrib_inf_right (X Y Z : α): (symm_diff X Y) ⊓ Z  = symm_diff (X ⊓ Z) (Y ⊓ Z) :=
  by {rw [inf_comm', inf_comm' X, inf_comm' Y], apply symm_diff_distrib_inf_left}

lemma symm_diff_inter (X Y : α) :
  symm_diff X (X ⊓ Y) = X \ Y :=
  by simp [inf_right_comm X Y, ←inf_assoc' _ Xᶜ, inf_sup_left]

lemma sup_sdiff (X Y : α) :
  X ⊔ (X \ Y) = X :=
  by simp

lemma top_symm_diff (X : α) :
  symm_diff ⊤ X = Xᶜ :=
  by simp

lemma symm_diff_self (X : α) :
  symm_diff X X = ⊥ :=
  by simp

@[simp] lemma bot_diff (X : α) :
  ⊥ \ X = ⊥ :=
  by simp

@[simp] lemma diff_bot (X : α) :
  X \ ⊥ = X :=
  by simp

@[simp] lemma le_iff_inf (X Y : α) :
  X ≤ Y ↔ X ⊓ Y = X :=
  inf_eq_left.symm

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

@[simp] instance to_comm_ring : comm_ring α :=
{
  add := λ X Y, symm_diff X Y,
  add_assoc := λ X Y Z, symm_diff_assoc X Y Z,
  zero := ⊥,
  zero_add := λ X, by simp [has_add.add],
  add_zero := λ X, by simp [has_add.add],
  neg := λ X, X,
  add_left_neg := λ X, symm_diff_self X,
  add_comm := λ X Y, symm_diff_comm X Y,
  mul := λ X Y, X ⊓ Y,
  mul_assoc := λ X Y Z, inf_assoc,
  one := ⊤,
  one_mul := λ X, top_inf_eq,
  mul_one := λ X, inf_top_eq,
  left_distrib := λ X Y Z, symm_diff_distrib_inf_left X Y Z,
  right_distrib := λ X Y Z, symm_diff_distrib_inf_right X Y Z,
  mul_comm := λ X Y, inf_comm,
}

lemma one_add (X : α) : 1 + X = Xᶜ :=
  top_symm_diff X

lemma add_one (X : α) : X + 1 = Xᶜ :=
  by {rw add_comm, from top_symm_diff X}

------------------------------- Translate to ring notation --------------------------------

lemma top_to_ring: (⊤ : α) = (1 : α) := rfl

lemma bot_to_ring : (⊥ : α) = (0 : α):= rfl

lemma symm_diff_to_ring {X Y : α} : (X \ Y) ⊔ (Y \ X) = X + Y := rfl

lemma inf_to_ring {X Y : α} : X ⊓ Y = X * Y := rfl

lemma sup_to_ring {X Y : α} : X ⊔ Y = (X + Y) + X*Y :=
begin
  rw [add_assoc],
  nth_rewrite 1 ←one_mul Y,
  rw [←right_distrib, one_add, ←symm_diff_to_ring, ←inf_to_ring],
  rw [sdiff_def, sdiff_def, inf_right_comm, compl_inf, inf_sup_left],
  simp only [compl_compl', inf_idem],
  rw [←sdiff_def, inf_comm' Xᶜ, ←sdiff_def, sup_sdiff, sup_sdiff_same],
end

lemma compl_to_ring {X : α} :
  Xᶜ = X + 1 :=
  (add_one X).symm

lemma le_to_ring {X Y : α} :
  X ≤ Y ↔ X*Y = X :=
  by {rw ←inf_to_ring, from inf_eq_left.symm}

lemma diff_to_ring {X Y : α} :
  X \ Y = X*(Y + 1) :=
  by rw [add_one, ←inf_to_ring, sdiff_def]

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

@[simp] lemma mul_idem (X : α):
  X*X = X :=
  inf_idem

@[simp] lemma two_eq_zero :
  (2 : α) = (0 : α) :=
  let h : (2:α) = (1:α) + (1:α) := rfl in
  by rw [h, one_add, ←top_to_ring, ←bot_to_ring, compl_top]

@[simp] lemma add_self (X : α):
  X + X = 0 :=
  by {ring SOP, rw two_eq_zero, from mul_zero X}

@[simp] lemma prod_comp_cancel (X : α) : X*(X+1) = 0 :=
  by {ring SOP, simp}

lemma no_inverses_left {X Y : α} :
  X*Y = 1 → X = 1 :=
  λ h, by {rw [←(mul_one X)] , nth_rewrite 0 ←h, rw [←mul_assoc, mul_idem, h]}

-------------------------------- Needed to make freealg tick ---------------------------------

lemma expand_product {X₁ X₂ Y₁ Y₂ S : α} :
  (X₁ * S + X₂ * (S+1)) * (Y₁ * S + Y₂ * (S+1)) = X₁ * Y₁ * S + X₂ * Y₂ * (S+1):=
  begin
    simp only [←mul_assoc, mul_comm _ S, prod_comp_cancel, mul_idem, left_distrib,
                right_distrib, mul_one],
    ring SOP,
    simp [mul_comm, two_eq_zero, (by ring : (3:α) = (2:α) + (1:α)), mul_left_comm],
  end

lemma add_self_left (X Y : α):
   X + (X + Y) = Y :=
   by rw [←add_assoc, add_self, zero_add]

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

------------------------------- Needed for internal tactic stuff ------------------------------

lemma no_inverses (X Y : α) :
  X * Y = 1 → (X = 1) ∧ (Y = 1) :=
  λ h, ⟨no_inverses_left h, by {rw mul_comm at h, from no_inverses_left h}⟩

lemma bring_to_left {α : Type}[boolean_algebra α]{X Y : α} :
  (X = Y) = (X + Y + 1 = 1) :=
  begin
    ext, split,
    from λ h, by {rw [h, add_self], exact zero_add 1},
    intro h,
    nth_rewrite 1 ←(add_self_left Y (1 :α)) at h,
    rw add_assoc at h,
    from (add_left_inj (Y + 1)).mp h
  end

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


import tactic --hide

lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl -- hide

/-
##  Proof by contradiction.

In this level we will see why proofs by contradiction are valid. The key is to note that for any
logical statements `P,Q`, we have that ` P ∧ (¬ P) → Q` is true.

-/

/-Hint : Why is this true?
We have just seen that `P ∧ (¬ P)`is always false and `false → Q` is always true.
-/

/- Hint : Hint
Start by introducing your assumption and then using `exfalso`.
-/

/- Lemma
If $P$ and $Q$ are logical statements, then
$(P\land(\lnot P))\implies Q.$
-/
lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q :=
begin
  intro h,
  exfalso,
  cases h with p np,
  rw not_iff_imp_false at np,
  apply np,
  exact p,

end

/-Hint : Tip
If you want to use to use this result later on then you can type <mark style ="background-color : #ebdef0 ">`apply (contra P Q)`</mark> where `P,Q` are
the assumptions you want to use. You can also use the tactic <mark style ="background-color : #ebdef0 ">`by_contra`</mark>
to achieve similar results.

-/


/--
From Sets to Relations

Take-away message. Whereas we represent a set
as a one-place predicate, we will represent a
binary relation as a two-place predicate. Just
as a set is a collection of individual objects
that satisfy a predicate, a relation is a set
of *pairs* of objects, each of which satisfies
the pair membership predicate for the relation.
--/

/-
Example: negation_as_a_binary_relation on bool.
-/

def negation : bool → bool → Prop
| tt ff := true
| ff tt := true
| _ _ := false

/-
This predicate specifies the binary
relation, {(tt, ff), (ff, tt)}. Each
member of the relation is an ordered
pair of Boolean values. The relation
comprises the set of all of the pairs
that satisfy the predicate: make the
resulting proposition true. Other pairs
of Booleans do not satisfy the predicate
and so are not in the relation that it
specifies.
-/

/-

Note that unlike with the Boolean
negation function, bnot, we cannot
"compute" with predicates; we can
only try to prove that a pair of
values (in this case) satisfy them.
-/

-- functions compute
#eval bnot tt   -- (tt, ff)
#eval bnot ff   -- (ff, tt)
-- takes a single bool, returns a bool

example : negation tt ff :=
begin
unfold negation,
end

example : negation ff tt := by unfold negation -- Lean syntax

-- takes two bools, returns a proposition
-- that proposition then has to be proved
-- can use "by" when script is a single tactic

example : ¬ negation tt tt :=
begin
assume h,
cases h,
end

/-
Exercise: Formally state and prove the proposition
that for all Boolean values, b1 and b2, negation b1
b2 ↔ bnot b1 = b2. This proposition claims that the
bnot function applied to a Boolean value, b1, equals
b2, if and only if the pair, (b1,b2), is "in" the
negation relation.
-/

example : ∀ (b1 b2), negation b1 b2 ↔ bnot b1 = b2 :=
begin
assume b1 b2,
split,

-- forwards
intro h,

cases b1,
cases b2,

-- ff ff
cases h,

-- tt ff
exact rfl,

cases b2,

-- tt ff
exact rfl,

-- tt tt
cases h,

-- backwards

assume h,

-- again by case analysis on b1 b2

cases b1,
cases b2,

cases h,
unfold negation,

cases b2,
unfold negation,

cases h,

end

example: ∀ (b1 b2), negation b1 b2 ↔ bnot b1 = b2 :=
begin
assume b1 b2,
split,
-- What should be our proof strategy from here?
-- Exercise: complete this proof.
end

/-
Next idea: A binary relation can relate objects of
different types types. The last example was of a
binary relation relating bools to bools. Not let's
introduce a new data type, call it bit, with values
bit.zero and bit.one, and the consider a relation
"between" bools and bits, where a bool is either
tt or ff and a bit is either zero or one.
-/

inductive bit
| zero
| one

/-
Here for fun is a function that takes a bit
and returns the other bit. It's like bnot but
for bits.
-/

def bit_flip : bit → bit
| bit.zero := bit.one
| bit.one := bit.zero

/-
Now let's define a relation from bool to bit
that associates tt with one and ff with zero.
-/

def bool_to_bit_relation : bool → bit → Prop
| tt bit.one := true
| ff bit.zero := true
| _ _ := false

/-
Exercise: Draw a picture of this relation.
Exercise: Draw an adjacency matrix for this relation
-/

/-
As another concrete example, let's define the relation
between natural numbers and their squares. We'll start
by defining the square function. Then we'll define the
corresponding relation. They represent the same set of
ordered pairs, but the first computes and the second is
"declarative" (computational vs. logical).
-/

def square (n : ℕ) := n * n
#eval square 25

/-
Now we specific the relevant set of pairs.
-/
def squares (n m : ℕ) : Prop := square n = m

/-
We can prove pairs that bear this relationship and
not ones that don't.
-/

example : squares 0 0 := rfl
example : squares 1 1 := rfl
example : squares 2 3 := rfl    -- no can, dude
example : squares 2 4 := rfl
example : squares 25 625 := rfl

/-
Exercise: define a predicate, call it
string2len,on strings and nats, such
that (s, n) ∈ string2len iff length
of s is n.
-/

def string2len : string → nat → Prop :=
  λ s n,          -- arguments
  s.length = n    -- result (here a proposition)

/-
Exercise: prove the proposition that the pair of
arguments, "Lean!" and 5, taken together, satisfy
the string2len predicate, and are thus considered
to be a pair that in (a member of) the string2len
relation.
-/
example : string2len "Lean!" 5 :=
begin
unfold string2len,
exact rfl,
end
/-
These ideas are prominent in database theory and
practice. For example, the SELECT statement in a
SQL database, e.g., mySQL, MariaDB, or PostgreSQL,
selects the subset of records from a database with
field values that satisfy such a selection predicate.
-/


/-
Copyright (c) 2022 Hans Parshall. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hans Parshall
-/
import analysis.matrix
import analysis.normed_space.basic
import data.is_R_or_C.basic
import linear_algebra.unitary_group

/-!
# Unitary matrices

This file collects facts about the unitary matrices over `𝕜` (either `ℝ` or `ℂ`).
-/

open_locale big_operators matrix

variables {𝕜 m n E : Type*}

section entrywise_sup_norm
variables [is_R_or_C 𝕜] [fintype n] [decidable_eq n]

lemma entry_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) (i j : n):
  ‖U i j‖ ≤ 1 :=
begin
  -- The norm squared of an entry is at most the L2 norm of its row.
  have norm_sum : ‖ U i j ‖^2 ≤ (∑ x, ‖ U i x ‖^2),
  { apply multiset.single_le_sum,
    { intros x h_x,
      rw multiset.mem_map at h_x,
      cases h_x with a h_a,
      rw ← h_a.2,
      apply sq_nonneg },
    { rw multiset.mem_map,
      use j,
      simp only [eq_self_iff_true, finset.mem_univ_val, and_self, sq_eq_sq] } },
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ
  have diag_eq_norm_sum : (U ⬝ Uᴴ) i i = ∑ (x : n), ‖ U i x ‖^2,
  { simp only [matrix.mul_apply, matrix.conj_transpose_apply, ←star_ring_end_apply,
               is_R_or_C.mul_conj, is_R_or_C.norm_sq_eq_def', is_R_or_C.of_real_pow] },
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ, real part
  have re_diag_eq_norm_sum : is_R_or_C.re ((U ⬝ Uᴴ) i i) = ∑ (x : n), ‖ U i x ‖^2,
  { rw is_R_or_C.ext_iff at diag_eq_norm_sum,
    rw diag_eq_norm_sum.1,
    norm_cast },
  -- Since U is unitary, the diagonal entries of U ⬝ Uᴴ are all 1
  have mul_eq_one : (U ⬝ Uᴴ) = 1, from unitary.mul_star_self_of_mem hU,
  have diag_eq_one : is_R_or_C.re ((U ⬝ Uᴴ) i i) = 1,
  { simp only [mul_eq_one, eq_self_iff_true, matrix.one_apply_eq, is_R_or_C.one_re] },
  -- Putting it all together
  rw [← sq_le_one_iff (norm_nonneg (U i j)), ← diag_eq_one, re_diag_eq_norm_sum],
  exact norm_sum,
end

local attribute [instance] matrix.normed_add_comm_group

/-- The entrywise sup norm of a unitary matrix is at most 1. -/
lemma entrywise_sup_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) :
  ‖ U ‖ ≤ 1 :=
begin
  simp_rw pi_norm_le_iff_of_nonneg zero_le_one,
  intros i j,
  exact entry_norm_bound_of_unitary hU _ _
end

end entrywise_sup_norm


/-
  Results about multivariate polynomials.
-/
import data.mv_polynomial.basic
import data.matrix.basic
import lib.psd

open mv_polynomial matrix

variables {γ : Type*} [fintype γ]
variables {μ : Type*} [fintype μ]
variables {R : Type*} [linear_ordered_comm_ring R]

namespace poly

instance {σ R} [comm_semiring R] [has_le R] : has_le (mv_polynomial σ R) :=
{ le := λ p q, ∀ v, eval v p ≤ eval v q }

-- 1. eval of dot product is dot product of eval.
lemma eval_dot_product (p q : γ → mv_polynomial ℕ R) (e : ℕ → R)
: eval e (dot_product p q) = dot_product (λ i, eval e (p i)) (λ i, eval e (q i)) :=
begin
  simp [dot_product], rw [eval_sum], congr, ext i, rw [(eval e).map_mul],
end

lemma eval_mul_vec (p : γ → mv_polynomial ℕ R) (M : matrix γ γ (mv_polynomial ℕ R))
  (e : ℕ → R) (i : γ)
: eval e (mul_vec M p i) = mul_vec (λ i j, eval e (M i j)) (λ i, eval e (p i)) i :=
begin
  simp [mul_vec, dot_product], rw [eval_sum], congr, ext l, rw [(eval e).map_mul],
end

-- 2. thus dot product same of poly is bigger than zero.
lemma dot_product_self_nonneg (p : γ → mv_polynomial ℕ R)
: 0 ≤ dot_product p p :=
begin
  intros e, rw [eval_dot_product p p e], simp [eval_C 0],
  exact matrix.dot_product_self_nonneg _,
end

noncomputable def matrix.to_poly (Q : matrix γ γ R) : matrix γ γ (mv_polynomial ℕ R) :=
λ i j, C (Q i j)

-- 3. thus cholesky of polynomial means poly is nonneg.
lemma nonneg_of_cholesky
  (p : mv_polynomial ℕ R)
  (ms : γ → mv_polynomial ℕ R)
  (Q : matrix γ γ R)
  (hQ : symmetric Q)
  (hp : p = dot_product ms (mul_vec (matrix.to_poly Q) ms))
  (hcholesky : @cholesky_decomposition γ _ μ _ R _ Q hQ)
: C 0 ≤ p :=
begin
  intros e, rw [hp, eval_dot_product _ _ e],
  have : (λ i, (eval e) (mul_vec (λ i j, C (Q i j)) ms i)) =
         λ i, mul_vec Q (λ i, eval e (ms i)) i,
  { funext i, rw eval_mul_vec ms _ e i, congr, ext l m, exact eval_C _, },
  simp [eval_C 0, matrix.to_poly], rw this,
  obtain ⟨L, hL⟩ := hcholesky,
  rw hL,
  rw dot_product_transpose,
  exact matrix.dot_product_self_nonneg _,
end

end poly


/-
Copyright (c) 2021 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import combinatorics.simple_graph.basic
import combinatorics.simple_graph.subgraph
import data.list
/-!

# Graph connectivity

In a simple graph,

* A *walk* is a finite sequence of adjacent vertices, and can be
  thought of equally well as a sequence of directed edges.

* A *trail* is a walk whose edges each appear no more than once.

* A *path* is a trail whose vertices appear no more than once.

* A *cycle* is a nonempty trail whose first and last vertices are the
  same and whose vertices except for the first appear no more than once.

**Warning:** graph theorists mean something different by "path" than
do homotopy theorists.  A "walk" in graph theory is a "path" in
homotopy theory.  Another warning: some graph theorists use "path" and
"simple path" for "walk" and "path."

Some definitions and theorems have inspiration from multigraph
counterparts in [Chou1994].

## Main definitions

* `simple_graph.walk` (with accompanying pattern definitions
  `simple_graph.walk.nil'` and `simple_graph.walk.cons'`)

* `simple_graph.walk.is_trail`, `simple_graph.walk.is_path`, and `simple_graph.walk.is_cycle`.

* `simple_graph.path`

* `simple_graph.reachable` for the relation of whether there exists
  a walk between a given pair of vertices

* `simple_graph.preconnected` and `simple_graph.connected` are predicates
  on simple graphs for whether every vertex can be reached from every other,
  and in the latter case, whether the vertex type is nonempty.

* `simple_graph.subgraph.connected` gives subgraphs the connectivity
  predicate via `simple_graph.subgraph.coe`.

## Tags
walks, trails, paths, circuits, cycles

-/

universes u

namespace simple_graph
variables {V : Type u} (G : simple_graph V)

/-- A walk is a sequence of adjacent vertices.  For vertices `u v : V`,
the type `walk u v` consists of all walks starting at `u` and ending at `v`.

We say that a walk *visits* the vertices it contains.  The set of vertices a
walk visits is `simple_graph.walk.support`.

See `simple_graph.walk.nil'` and `simple_graph.walk.cons'` for patterns that
can be useful in definitions since they make the vertices explicit. -/
@[derive decidable_eq]
inductive walk : V → V → Type u
| nil {u : V} : walk u u
| cons {u v w: V} (h : G.adj u v) (p : walk v w) : walk u w

attribute [refl] walk.nil

instance walk.inhabited (v : V) : inhabited (G.walk v v) := ⟨by refl⟩

namespace walk
variables {G}

/-- Pattern to get `walk.nil` with the vertex as an explicit argument. -/
@[pattern] abbreviation nil' (u : V) : G.walk u u := walk.nil

/-- Pattern to get `walk.cons` with the vertices as explicit arguments. -/
@[pattern] abbreviation cons' (u v w : V) (h : G.adj u v) (p : G.walk v w) : G.walk u w :=
walk.cons h p

lemma exists_eq_cons_of_ne : Π {u v : V} (hne : u ≠ v) (p : G.walk u v),
  ∃ (w : V) (h : G.adj u w) (p' : G.walk w v), p = cons h p'
| _ _ hne nil := (hne rfl).elim
| _ _ _ (cons h p') := ⟨_, h, p', rfl⟩

/-- The length of a walk is the number of edges/darts along it. -/
def length : Π {u v : V}, G.walk u v → ℕ
| _ _ nil := 0
| _ _ (cons _ q) := q.length.succ

/-- The concatenation of two compatible walks. -/
@[trans]
def append : Π {u v w : V}, G.walk u v → G.walk v w → G.walk u w
| _ _ _ nil q := q
| _ _ _ (cons h p) q := cons h (p.append q)

/-- The concatenation of the reverse of the first walk with the second walk. -/
protected def reverse_aux : Π {u v w : V}, G.walk u v → G.walk u w → G.walk v w
| _ _ _ nil q := q
| _ _ _ (cons h p) q := reverse_aux p (cons (G.symm h) q)

/-- The walk in reverse. -/
@[symm]
def reverse {u v : V} (w : G.walk u v) : G.walk v u := w.reverse_aux nil

/-- Get the `n`th vertex from a walk, where `n` is generally expected to be
between `0` and `p.length`, inclusive.
If `n` is greater than or equal to `p.length`, the result is the path's endpoint. -/
def get_vert : Π {u v : V} (p : G.walk u v) (n : ℕ), V
| u v nil _ := u
| u v (cons _ _) 0 := u
| u v (cons _ q) (n+1) := q.get_vert n

@[simp] lemma get_vert_zero {u v} (w : G.walk u v) : w.get_vert 0 = u :=
by { cases w; refl }

lemma get_vert_of_length_le {u v} (w : G.walk u v) {i : ℕ} (hi : w.length ≤ i) :
  w.get_vert i = v :=
begin
  induction w with _ x y z hxy wyz IH generalizing i,
  { refl },
  { cases i,
    { cases hi, },
    { exact IH (nat.succ_le_succ_iff.1 hi) } }
end

@[simp] lemma get_vert_length {u v} (w : G.walk u v) : w.get_vert w.length = v :=
w.get_vert_of_length_le rfl.le

lemma adj_get_vert_succ {u v} (w : G.walk u v) {i : ℕ} (hi : i < w.length) :
  G.adj (w.get_vert i) (w.get_vert (i+1)) :=
begin
  induction w with _ x y z hxy wyz IH generalizing i,
  { cases hi, },
  { cases i,
    { simp [get_vert, hxy] },
    { exact IH (nat.succ_lt_succ_iff.1 hi) } },
end

@[simp] lemma cons_append {u v w x : V} (h : G.adj u v) (p : G.walk v w) (q : G.walk w x) :
  (cons h p).append q = cons h (p.append q) := rfl

@[simp] lemma cons_nil_append {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h nil).append p = cons h p := rfl

@[simp] lemma append_nil : Π {u v : V} (p : G.walk u v), p.append nil = p
| _ _ nil := rfl
| _ _ (cons h p) := by rw [cons_append, append_nil]

@[simp] lemma nil_append {u v : V} (p : G.walk u v) : nil.append p = p := rfl

lemma append_assoc : Π {u v w x : V} (p : G.walk u v) (q : G.walk v w) (r : G.walk w x),
  p.append (q.append r) = (p.append q).append r
| _ _ _ _ nil _ _ := rfl
| _ _ _ _ (cons h p') q r := by { dunfold append, rw append_assoc, }

@[simp] lemma reverse_nil {u : V} : (nil : G.walk u u).reverse = nil := rfl

lemma reverse_singleton {u v : V} (h : G.adj u v) :
  (cons h nil).reverse = cons (G.symm h) nil := rfl

@[simp] lemma cons_reverse_aux {u v w x : V} (p : G.walk u v) (q : G.walk w x) (h : G.adj w u) :
  (cons h p).reverse_aux q = p.reverse_aux (cons (G.symm h) q) := rfl

@[simp] protected lemma append_reverse_aux : Π {u v w x : V}
  (p : G.walk u v) (q : G.walk v w) (r : G.walk u x),
  (p.append q).reverse_aux r = q.reverse_aux (p.reverse_aux r)
| _ _ _ _ nil _ _ := rfl
| _ _ _ _ (cons h p') q r := append_reverse_aux p' q (cons (G.symm h) r)

@[simp] protected lemma reverse_aux_append : Π {u v w x : V}
  (p : G.walk u v) (q : G.walk u w) (r : G.walk w x),
  (p.reverse_aux q).append r = p.reverse_aux (q.append r)
| _ _ _ _ nil _ _ := rfl
| _ _ _ _ (cons h p') q r := by simp [reverse_aux_append p' (cons (G.symm h) q) r]

protected lemma reverse_aux_eq_reverse_append {u v w : V} (p : G.walk u v) (q : G.walk u w) :
  p.reverse_aux q = p.reverse.append q :=
by simp [reverse]

@[simp] lemma reverse_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).reverse = p.reverse.append (cons (G.symm h) nil) :=
by simp [reverse]

@[simp] lemma reverse_append {u v w : V} (p : G.walk u v) (q : G.walk v w) :
  (p.append q).reverse = q.reverse.append p.reverse :=
by simp [reverse]

@[simp] lemma reverse_reverse : Π {u v : V} (p : G.walk u v), p.reverse.reverse = p
| _ _ nil := rfl
| _ _ (cons h p) := by simp [reverse_reverse]

@[simp] lemma length_nil {u : V} : (nil : G.walk u u).length = 0 := rfl

@[simp] lemma length_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).length = p.length + 1 := rfl

@[simp] lemma length_append : Π {u v w : V} (p : G.walk u v) (q : G.walk v w),
  (p.append q).length = p.length + q.length
| _ _ _ nil _ := by simp
| _ _ _ (cons _ _) _ := by simp [length_append, add_left_comm, add_comm]

@[simp] protected lemma length_reverse_aux : Π {u v w : V} (p : G.walk u v) (q : G.walk u w),
  (p.reverse_aux q).length = p.length + q.length
| _ _ _ nil _ := by simp!
| _ _ _ (cons _ _) _ := by simp [length_reverse_aux, nat.add_succ, nat.succ_add]

@[simp] lemma length_reverse {u v : V} (p : G.walk u v) : p.reverse.length = p.length :=
by simp [reverse]

lemma eq_of_length_eq_zero : Π {u v : V} {p : G.walk u v}, p.length = 0 → u = v
| _ _ nil _ := rfl

@[simp] lemma exists_length_eq_zero_iff {u v : V} : (∃ (p : G.walk u v), p.length = 0) ↔ u = v :=
begin
  split,
  { rintro ⟨p, hp⟩,
    exact eq_of_length_eq_zero hp, },
  { rintro rfl,
    exact ⟨nil, rfl⟩, },
end

/-- The `support` of a walk is the list of vertices it visits in order. -/
def support : Π {u v : V}, G.walk u v → list V
| u v nil := [u]
| u v (cons h p) := u :: p.support

/-- The `darts` of a walk is the list of darts it visits in order. -/
def darts : Π {u v : V}, G.walk u v → list G.dart
| u v nil := []
| u v (cons h p) := ⟨(u, _), h⟩ :: p.darts

/-- The `edges` of a walk is the list of edges it visits in order.
This is defined to be the list of edges underlying `simple_graph.walk.darts`. -/
def edges {u v : V} (p : G.walk u v) : list (sym2 V) := p.darts.map dart.edge

@[simp] lemma support_nil {u : V} : (nil : G.walk u u).support = [u] := rfl

@[simp] lemma support_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).support = u :: p.support := rfl

lemma support_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  (p.append p').support = p.support ++ p'.support.tail :=
by induction p; cases p'; simp [*]

@[simp]
lemma support_reverse {u v : V} (p : G.walk u v) : p.reverse.support = p.support.reverse :=
by induction p; simp [support_append, *]

lemma support_ne_nil {u v : V} (p : G.walk u v) : p.support ≠ [] :=
by cases p; simp

lemma tail_support_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  (p.append p').support.tail = p.support.tail ++ p'.support.tail :=
by rw [support_append, list.tail_append_of_ne_nil _ _ (support_ne_nil _)]

lemma support_eq_cons {u v : V} (p : G.walk u v) : p.support = u :: p.support.tail :=
by cases p; simp

@[simp] lemma start_mem_support {u v : V} (p : G.walk u v) : u ∈ p.support :=
by cases p; simp

@[simp] lemma end_mem_support {u v : V} (p : G.walk u v) : v ∈ p.support :=
by induction p; simp [*]

lemma mem_support_iff {u v w : V} (p : G.walk u v) :
  w ∈ p.support ↔ w = u ∨ w ∈ p.support.tail :=
by cases p; simp

lemma mem_support_nil_iff {u v : V} : u ∈ (nil : G.walk v v).support ↔ u = v := by simp

@[simp]
lemma mem_tail_support_append_iff {t u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  t ∈ (p.append p').support.tail ↔ t ∈ p.support.tail ∨ t ∈ p'.support.tail :=
by rw [tail_support_append, list.mem_append]

@[simp] lemma end_mem_tail_support_of_ne {u v : V} (h : u ≠ v) (p : G.walk u v) :
  v ∈ p.support.tail :=
by { obtain ⟨_, _, _, rfl⟩ := exists_eq_cons_of_ne h p, simp }

@[simp]
lemma mem_support_append_iff {t u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  t ∈ (p.append p').support ↔ t ∈ p.support ∨ t ∈ p'.support :=
begin
  simp only [mem_support_iff, mem_tail_support_append_iff],
  by_cases h : t = v; by_cases h' : t = u;
  subst_vars;
  try { have := ne.symm h' };
  simp [*],
end

lemma coe_support {u v : V} (p : G.walk u v) :
  (p.support : multiset V) = {u} + p.support.tail :=
by cases p; refl

lemma coe_support_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  ((p.append p').support : multiset V) = {u} + p.support.tail + p'.support.tail :=
by rw [support_append, ←multiset.coe_add, coe_support]

lemma coe_support_append' [decidable_eq V] {u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  ((p.append p').support : multiset V) = p.support + p'.support - {v} :=
begin
  rw [support_append, ←multiset.coe_add],
  simp only [coe_support],
  rw add_comm {v},
  simp only [← add_assoc, add_tsub_cancel_right],
end

lemma chain_adj_support : Π {u v w : V} (h : G.adj u v) (p : G.walk v w),
  list.chain G.adj u p.support
| _ _ _ h nil := list.chain.cons h list.chain.nil
| _ _ _ h (cons h' p) := list.chain.cons h (chain_adj_support h' p)

lemma chain'_adj_support : Π {u v : V} (p : G.walk u v), list.chain' G.adj p.support
| _ _ nil := list.chain.nil
| _ _ (cons h p) := chain_adj_support h p

lemma chain_dart_adj_darts : Π {d : G.dart} {v w : V} (h : d.snd = v) (p : G.walk v w),
  list.chain G.dart_adj d p.darts
| _ _ _ h nil := list.chain.nil
| _ _ _ h (cons h' p) := list.chain.cons h (chain_dart_adj_darts (by exact rfl) p)

lemma chain'_dart_adj_darts : Π {u v : V} (p : G.walk u v), list.chain' G.dart_adj p.darts
| _ _ nil := trivial
| _ _ (cons h p) := chain_dart_adj_darts rfl p

/-- Every edge in a walk's edge list is an edge of the graph.
It is written in this form (rather than using `⊆`) to avoid unsightly coercions. -/
lemma edges_subset_edge_set : Π {u v : V} (p : G.walk u v) ⦃e : sym2 V⦄
  (h : e ∈ p.edges), e ∈ G.edge_set
| _ _ (cons h' p') e h := by rcases h with ⟨rfl, h⟩; solve_by_elim

@[simp] lemma darts_nil {u : V} : (nil : G.walk u u).darts = [] := rfl

@[simp] lemma darts_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).darts = ⟨(u, v), h⟩ :: p.darts := rfl

@[simp] lemma darts_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  (p.append p').darts = p.darts ++ p'.darts :=
by induction p; simp [*]

@[simp] lemma darts_reverse {u v : V} (p : G.walk u v) :
  p.reverse.darts = (p.darts.map dart.symm).reverse :=
by induction p; simp [*, sym2.eq_swap]

lemma cons_map_snd_darts {u v : V} (p : G.walk u v) :
  u :: p.darts.map dart.snd = p.support :=
by induction p; simp! [*]

lemma map_snd_darts {u v : V} (p : G.walk u v) :
  p.darts.map dart.snd = p.support.tail :=
by simpa using congr_arg list.tail (cons_map_snd_darts p)

lemma map_fst_darts_append {u v : V} (p : G.walk u v) :
  p.darts.map dart.fst ++ [v] = p.support :=
by induction p; simp! [*]

lemma map_fst_darts {u v : V} (p : G.walk u v) :
  p.darts.map dart.fst = p.support.init :=
by simpa! using congr_arg list.init (map_fst_darts_append p)

@[simp] lemma edges_nil {u : V} : (nil : G.walk u u).edges = [] := rfl

@[simp] lemma edges_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).edges = ⟦(u, v)⟧ :: p.edges := rfl

@[simp] lemma edges_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) :
  (p.append p').edges = p.edges ++ p'.edges :=
by simp [edges]

@[simp] lemma edges_reverse {u v : V} (p : G.walk u v) : p.reverse.edges = p.edges.reverse :=
by simp [edges]

@[simp] lemma length_support {u v : V} (p : G.walk u v) : p.support.length = p.length + 1 :=
by induction p; simp *

@[simp] lemma length_darts {u v : V} (p : G.walk u v) : p.darts.length = p.length :=
by induction p; simp *

@[simp] lemma length_edges {u v : V} (p : G.walk u v) : p.edges.length = p.length :=
by simp [edges]

lemma dart_fst_mem_support_of_mem_darts :
  Π {u v : V} (p : G.walk u v) {d : G.dart}, d ∈ p.darts → d.fst ∈ p.support
| u v (cons h p') d hd := begin
  simp only [support_cons, darts_cons, list.mem_cons_iff] at hd ⊢,
  rcases hd with (rfl|hd),
  { exact or.inl rfl, },
  { exact or.inr (dart_fst_mem_support_of_mem_darts _ hd), },
end

lemma dart_snd_mem_support_of_mem_darts :
  Π {u v : V} (p : G.walk u v) {d : G.dart}, d ∈ p.darts → d.snd ∈ p.support
| u v (cons h p') d hd := begin
  simp only [support_cons, darts_cons, list.mem_cons_iff] at hd ⊢,
  rcases hd with (rfl|hd),
  { simp },
  { exact or.inr (dart_snd_mem_support_of_mem_darts _ hd), },
end

lemma mem_support_of_mem_edges {t u v w : V} (p : G.walk v w) (he : ⟦(t, u)⟧ ∈ p.edges) :
  t ∈ p.support :=
begin
  obtain ⟨d, hd, he⟩ := list.mem_map.mp he,
  rw dart_edge_eq_mk_iff' at he,
  rcases he with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩,
  { exact dart_fst_mem_support_of_mem_darts _ hd, },
  { exact dart_snd_mem_support_of_mem_darts _ hd, },
end

lemma darts_nodup_of_support_nodup {u v : V} {p : G.walk u v} (h : p.support.nodup) :
  p.darts.nodup :=
begin
  induction p,
  { simp, },
  { simp only [darts_cons, support_cons, list.nodup_cons] at h ⊢,
    refine ⟨λ h', h.1 (dart_fst_mem_support_of_mem_darts p_p h'), p_ih h.2⟩, }
end

lemma edges_nodup_of_support_nodup {u v : V} {p : G.walk u v} (h : p.support.nodup) :
  p.edges.nodup :=
begin
  induction p,
  { simp, },
  { simp only [edges_cons, support_cons, list.nodup_cons] at h ⊢,
    exact ⟨λ h', h.1 (mem_support_of_mem_edges p_p h'), p_ih h.2⟩, }
end

/-! ### Trails, paths, circuits, cycles -/

/-- A *trail* is a walk with no repeating edges. -/
structure is_trail {u v : V} (p : G.walk u v) : Prop :=
(edges_nodup : p.edges.nodup)

/-- A *path* is a walk with no repeating vertices.
Use `simple_graph.walk.is_path.mk'` for a simpler constructor. -/
structure is_path {u v : V} (p : G.walk u v) extends to_trail : is_trail p : Prop :=
(support_nodup : p.support.nodup)

/-- A *circuit* at `u : V` is a nonempty trail beginning and ending at `u`. -/
structure is_circuit {u : V} (p : G.walk u u) extends to_trail : is_trail p : Prop :=
(ne_nil : p ≠ nil)

/-- A *cycle* at `u : V` is a circuit at `u` whose only repeating vertex
is `u` (which appears exactly twice). -/
structure is_cycle {u : V} (p : G.walk u u)
  extends to_circuit : is_circuit p : Prop :=
(support_nodup : p.support.tail.nodup)

lemma is_trail_def {u v : V} (p : G.walk u v) : p.is_trail ↔ p.edges.nodup :=
⟨is_trail.edges_nodup, λ h, ⟨h⟩⟩

lemma is_path.mk' {u v : V} {p : G.walk u v} (h : p.support.nodup) : is_path p :=
⟨⟨edges_nodup_of_support_nodup h⟩, h⟩

lemma is_path_def {u v : V} (p : G.walk u v) : p.is_path ↔ p.support.nodup :=
⟨is_path.support_nodup, is_path.mk'⟩

lemma is_cycle_def {u : V} (p : G.walk u u) :
  p.is_cycle ↔ is_trail p ∧ p ≠ nil ∧ p.support.tail.nodup :=
iff.intro (λ h, ⟨h.1.1, h.1.2, h.2⟩) (λ h, ⟨⟨h.1, h.2.1⟩, h.2.2⟩)

@[simp] lemma is_trail.nil {u : V} : (nil : G.walk u u).is_trail :=
⟨by simp [edges]⟩

lemma is_trail.of_cons {u v w : V} {h : G.adj u v} {p : G.walk v w} :
  (cons h p).is_trail → p.is_trail :=
by simp [is_trail_def]

@[simp] lemma cons_is_trail_iff {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).is_trail ↔ p.is_trail ∧ ⟦(u, v)⟧ ∉ p.edges :=
by simp [is_trail_def, and_comm]

lemma is_trail.reverse {u v : V} (p : G.walk u v) (h : p.is_trail) : p.reverse.is_trail :=
by simpa [is_trail_def] using h

@[simp] lemma reverse_is_trail_iff {u v : V} (p : G.walk u v) : p.reverse.is_trail ↔ p.is_trail :=
by split; { intro h, convert h.reverse _, try { rw reverse_reverse } }

lemma is_trail.of_append_left {u v w : V} {p : G.walk u v} {q : G.walk v w}
  (h : (p.append q).is_trail) : p.is_trail :=
by { rw [is_trail_def, edges_append, list.nodup_append] at h, exact ⟨h.1⟩ }

lemma is_trail.of_append_right {u v w : V} {p : G.walk u v} {q : G.walk v w}
  (h : (p.append q).is_trail) : q.is_trail :=
by { rw [is_trail_def, edges_append, list.nodup_append] at h, exact ⟨h.2.1⟩ }

lemma is_trail.count_edges_le_one [decidable_eq V] {u v : V}
  {p : G.walk u v} (h : p.is_trail) (e : sym2 V) : p.edges.count e ≤ 1 :=
list.nodup_iff_count_le_one.mp h.edges_nodup e

lemma is_trail.count_edges_eq_one [decidable_eq V] {u v : V}
  {p : G.walk u v} (h : p.is_trail) {e : sym2 V} (he : e ∈ p.edges) :
  p.edges.count e = 1 :=
list.count_eq_one_of_mem h.edges_nodup he

@[simp] lemma is_path.nil {u : V} : (nil : G.walk u u).is_path :=
by { fsplit; simp }

lemma is_path.of_cons {u v w : V} {h : G.adj u v} {p : G.walk v w} :
  (cons h p).is_path → p.is_path :=
by simp [is_path_def]

@[simp] lemma cons_is_path_iff {u v w : V} (h : G.adj u v) (p : G.walk v w) :
  (cons h p).is_path ↔ p.is_path ∧ u ∉ p.support :=
by split; simp [is_path_def] { contextual := tt }

lemma is_path.reverse {u v : V} {p : G.walk u v} (h : p.is_path) : p.reverse.is_path :=
by simpa [is_path_def] using h

@[simp] lemma is_path_reverse_iff {u v : V} (p : G.walk u v) : p.reverse.is_path ↔ p.is_path :=
by split; intro h; convert h.reverse; simp

lemma is_path.of_append_left {u v w : V} {p : G.walk u v} {q : G.walk v w} :
  (p.append q).is_path → p.is_path :=
by { simp only [is_path_def, support_append], exact list.nodup.of_append_left }

lemma is_path.of_append_right {u v w : V} {p : G.walk u v} {q : G.walk v w}
  (h : (p.append q).is_path) : q.is_path :=
begin
  rw ←is_path_reverse_iff at h ⊢,
  rw reverse_append at h,
  apply h.of_append_left,
end

/-! ### Walk decompositions -/

section walk_decomp
variables [decidable_eq V]

/-- Given a vertex in the support of a path, give the path up until (and including) that vertex. -/
def take_until : Π {v w : V} (p : G.walk v w) (u : V) (h : u ∈ p.support), G.walk v u
| v w nil u h := by rw mem_support_nil_iff.mp h
| v w (cons r p) u h :=
  if hx : v = u
  then by subst u
  else cons r (take_until p _ $ h.cases_on (λ h', (hx h'.symm).elim) id)

/-- Given a vertex in the support of a path, give the path from (and including) that vertex to
the end. In other words, drop vertices from the front of a path until (and not including)
that vertex. -/
def drop_until : Π {v w : V} (p : G.walk v w) (u : V) (h : u ∈ p.support), G.walk u w
| v w nil u h := by rw mem_support_nil_iff.mp h
| v w (cons r p) u h :=
  if hx : v = u
  then by { subst u, exact cons r p }
  else drop_until p _ $ h.cases_on (λ h', (hx h'.symm).elim) id

/-- The `take_until` and `drop_until` functions split a walk into two pieces.
The lemma `count_support_take_until_eq_one` specifies where this split occurs. -/
@[simp]
lemma take_spec {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.take_until u h).append (p.drop_until u h) = p :=
begin
  induction p,
  { rw mem_support_nil_iff at h,
    subst u,
    refl, },
  { obtain (rfl|h) := h,
    { simp! },
    { simp! only,
      split_ifs with h'; subst_vars; simp [*], } },
end

@[simp]
lemma count_support_take_until_eq_one {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.take_until u h).support.count u = 1 :=
begin
  induction p,
  { rw mem_support_nil_iff at h,
    subst u,
    simp!, },
  { obtain (rfl|h) := h,
    { simp! },
    { simp! only,
      split_ifs with h'; rw eq_comm at h'; subst_vars; simp! [*, list.count_cons], } },
end

lemma count_edges_take_until_le_one {u v w : V} (p : G.walk v w) (h : u ∈ p.support) (x : V) :
  (p.take_until u h).edges.count ⟦(u, x)⟧ ≤ 1 :=
begin
  induction p with u' u' v' w' ha p' ih,
  { rw mem_support_nil_iff at h,
    subst u,
    simp!, },
  { obtain (rfl|h) := h,
    { simp!, },
    { simp! only,
      split_ifs with h',
      { subst h',
        simp, },
      { rw [edges_cons, list.count_cons],
        split_ifs with h'',
        { rw sym2.eq_iff at h'',
          obtain (⟨rfl,rfl⟩|⟨rfl,rfl⟩) := h'',
          { exact (h' rfl).elim },
          { cases p'; simp! } },
        { apply ih, } } } },
end

lemma support_take_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.take_until u h).support ⊆ p.support :=
λ x hx, by { rw [← take_spec p h, mem_support_append_iff], exact or.inl hx }

lemma support_drop_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.drop_until u h).support ⊆ p.support :=
λ x hx, by { rw [← take_spec p h, mem_support_append_iff], exact or.inr hx }

lemma darts_take_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.take_until u h).darts ⊆ p.darts :=
λ x hx, by { rw [← take_spec p h, darts_append, list.mem_append], exact or.inl hx }

lemma darts_drop_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.drop_until u h).darts ⊆ p.darts :=
λ x hx, by { rw [← take_spec p h, darts_append, list.mem_append], exact or.inr hx }

lemma edges_take_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.take_until u h).edges ⊆ p.edges :=
list.map_subset _ (p.darts_take_until_subset h)

lemma edges_drop_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.drop_until u h).edges ⊆ p.edges :=
list.map_subset _ (p.darts_drop_until_subset h)

lemma length_take_until_le {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.take_until u h).length ≤ p.length :=
begin
  have := congr_arg walk.length (p.take_spec h),
  rw [length_append] at this,
  exact nat.le.intro this,
end

lemma length_drop_until_le {u v w : V} (p : G.walk v w) (h : u ∈ p.support) :
  (p.drop_until u h).length ≤ p.length :=
begin
  have := congr_arg walk.length (p.take_spec h),
  rw [length_append, add_comm] at this,
  exact nat.le.intro this,
end

protected
lemma is_trail.take_until {u v w : V} {p : G.walk v w} (hc : p.is_trail) (h : u ∈ p.support) :
  (p.take_until u h).is_trail :=
is_trail.of_append_left (by rwa ← take_spec _ h at hc)

protected
lemma is_trail.drop_until {u v w : V} {p : G.walk v w} (hc : p.is_trail) (h : u ∈ p.support) :
  (p.drop_until u h).is_trail :=
is_trail.of_append_right (by rwa ← take_spec _ h at hc)

protected
lemma is_path.take_until {u v w : V} {p : G.walk v w} (hc : p.is_path) (h : u ∈ p.support) :
  (p.take_until u h).is_path :=
is_path.of_append_left (by rwa ← take_spec _ h at hc)

protected
lemma is_path.drop_until {u v w : V} (p : G.walk v w) (hc : p.is_path) (h : u ∈ p.support) :
  (p.drop_until u h).is_path :=
is_path.of_append_right (by rwa ← take_spec _ h at hc)

/-- Rotate a loop walk such that it is centered at the given vertex. -/
def rotate {u v : V} (c : G.walk v v) (h : u ∈ c.support) : G.walk u u :=
(c.drop_until u h).append (c.take_until u h)

@[simp]
lemma support_rotate {u v : V} (c : G.walk v v) (h : u ∈ c.support) :
  (c.rotate h).support.tail ~r c.support.tail :=
begin
  simp only [rotate, tail_support_append],
  apply list.is_rotated.trans list.is_rotated_append,
  rw [←tail_support_append, take_spec],
end

lemma rotate_darts {u v : V} (c : G.walk v v) (h : u ∈ c.support) :
  (c.rotate h).darts ~r c.darts :=
begin
  simp only [rotate, darts_append],
  apply list.is_rotated.trans list.is_rotated_append,
  rw [←darts_append, take_spec],
end

lemma rotate_edges {u v : V} (c : G.walk v v) (h : u ∈ c.support) :
  (c.rotate h).edges ~r c.edges :=
(rotate_darts c h).map _

protected
lemma is_trail.rotate {u v : V} {c : G.walk v v} (hc : c.is_trail) (h : u ∈ c.support) :
  (c.rotate h).is_trail :=
begin
  rw [is_trail_def, (c.rotate_edges h).perm.nodup_iff],
  exact hc.edges_nodup,
end

protected
lemma is_circuit.rotate {u v : V} {c : G.walk v v} (hc : c.is_circuit) (h : u ∈ c.support) :
  (c.rotate h).is_circuit :=
begin
  refine ⟨hc.to_trail.rotate _, _⟩,
  cases c,
  { exact (hc.ne_nil rfl).elim, },
  { intro hn,
    have hn' := congr_arg length hn,
    rw [rotate, length_append, add_comm, ← length_append, take_spec] at hn',
    simpa using hn', },
end

protected
lemma is_cycle.rotate {u v : V} {c : G.walk v v} (hc : c.is_cycle) (h : u ∈ c.support) :
  (c.rotate h).is_cycle :=
begin
  refine ⟨hc.to_circuit.rotate _, _⟩,
  rw list.is_rotated.nodup_iff (support_rotate _ _),
  exact hc.support_nodup,
end

end walk_decomp

end walk

/-! ### Walks to paths -/

/-- The type for paths between two vertices. -/
abbreviation path (u v : V) := {p : G.walk u v // p.is_path}

namespace walk
variables {G} [decidable_eq V]

/-- Given a walk, produces a walk from it by bypassing subwalks between repeated vertices.
The result is a path, as shown in `simple_graph.walk.bypass_is_path`.
This is packaged up in `simple_graph.walk.to_path`. -/
def bypass : Π {u v : V}, G.walk u v → G.walk u v
| u v nil := nil
| u v (cons ha p) :=
  let p' := p.bypass
  in if hs : u ∈ p'.support
     then p'.drop_until u hs
     else cons ha p'

lemma bypass_is_path {u v : V} (p : G.walk u v) : p.bypass.is_path :=
begin
  induction p,
  { simp!, },
  { simp only [bypass],
    split_ifs,
    { apply is_path.drop_until,
      assumption, },
    { simp [*, cons_is_path_iff], } },
end

lemma length_bypass_le {u v : V} (p : G.walk u v) : p.bypass.length ≤ p.length :=
begin
  induction p,
  { refl },
  { simp only [bypass],
    split_ifs,
    { transitivity,
      apply length_drop_until_le,
      rw [length_cons],
      exact le_add_right p_ih, },
    { rw [length_cons, length_cons],
      exact add_le_add_right p_ih 1, } },
end

/-- Given a walk, produces a path with the same endpoints using `simple_graph.walk.bypass`. -/
def to_path {u v : V} (p : G.walk u v) : G.path u v := ⟨p.bypass, p.bypass_is_path⟩

lemma support_bypass_subset {u v : V} (p : G.walk u v) : p.bypass.support ⊆ p.support :=
begin
  induction p,
  { simp!, },
  { simp! only,
    split_ifs,
    { apply list.subset.trans (support_drop_until_subset _ _),
      apply list.subset_cons_of_subset,
      assumption, },
    { rw support_cons,
      apply list.cons_subset_cons,
      assumption, }, },
end

lemma support_to_path_subset {u v : V} (p : G.walk u v) :
  (p.to_path : G.walk u v).support ⊆ p.support :=
support_bypass_subset _

lemma darts_bypass_subset {u v : V} (p : G.walk u v) : p.bypass.darts ⊆ p.darts :=
begin
  induction p,
  { simp!, },
  { simp! only,
    split_ifs,
    { apply list.subset.trans (darts_drop_until_subset _ _),
      apply list.subset_cons_of_subset _ p_ih, },
    { rw darts_cons,
      exact list.cons_subset_cons _ p_ih, }, },
end

lemma edges_bypass_subset {u v : V} (p : G.walk u v) : p.bypass.edges ⊆ p.edges :=
list.map_subset _ p.darts_bypass_subset

lemma darts_to_path_subset {u v : V} (p : G.walk u v) :
  (p.to_path : G.walk u v).darts ⊆ p.darts :=
darts_bypass_subset _

lemma edges_to_path_subset {u v : V} (p : G.walk u v) :
  (p.to_path : G.walk u v).edges ⊆ p.edges :=
edges_bypass_subset _

end walk

/-! ## `reachable` and `connected` -/

/-- Two vertices are *reachable* if there is a walk between them.
This is equivalent to `relation.refl_trans_gen` of `G.adj`.
See `simple_graph.reachable_iff_refl_trans_gen`. -/
def reachable (u v : V) : Prop := nonempty (G.walk u v)

variables {G}

lemma reachable_iff_nonempty_univ {u v : V} :
  G.reachable u v ↔ (set.univ : set (G.walk u v)).nonempty :=
set.nonempty_iff_univ_nonempty

protected lemma reachable.elim {p : Prop} {u v : V}
  (h : G.reachable u v) (hp : G.walk u v → p) : p :=
nonempty.elim h hp

protected lemma reachable.elim_path {p : Prop} {u v : V}
  (h : G.reachable u v) (hp : G.path u v → p) : p :=
begin
  classical,
  exact h.elim (λ q, hp q.to_path),
end

@[refl] protected lemma reachable.refl {u : V} : G.reachable u u := by { fsplit, refl }

@[symm] protected lemma reachable.symm {u v : V} (huv : G.reachable u v) : G.reachable v u :=
huv.elim (λ p, ⟨p.reverse⟩)

@[trans] protected lemma reachable.trans {u v w : V}
  (huv : G.reachable u v) (hvw : G.reachable v w) :
  G.reachable u w :=
huv.elim (λ puv, hvw.elim (λ pvw, ⟨puv.append pvw⟩))

lemma reachable_iff_refl_trans_gen (u v : V) :
  G.reachable u v ↔ relation.refl_trans_gen G.adj u v :=
begin
  split,
  { rintro ⟨h⟩,
    induction h,
    { refl, },
    { exact (relation.refl_trans_gen.single h_h).trans h_ih, }, },
  { intro h,
    induction h with _ _ _ ha hr,
    { refl, },
    { exact reachable.trans hr ⟨walk.cons ha walk.nil⟩, }, },
end

variables (G)

lemma reachable_is_equivalence : equivalence G.reachable :=
mk_equivalence _ (@reachable.refl _ G) (@reachable.symm _ G) (@reachable.trans _ G)

/-- The equivalence relation on vertices given by `simple_graph.reachable`. -/
def reachable_setoid : setoid V := setoid.mk _ G.reachable_is_equivalence

/-- A graph is preconnected if every pair of vertices is reachable from one another. -/
def preconnected : Prop := ∀ (u v : V), G.reachable u v

/-- A graph is connected if it's preconnected and contains at least one vertex.
This follows the convention observed by mathlib that something is connected iff it has
exactly one connected component.

There is a `has_coe_to_fun` instance so that `h u v` can be used instead
of `h.preconnected u v`. -/
@[protect_proj]
structure connected : Prop :=
(preconnected : G.preconnected)
(nonempty : nonempty V)

instance : has_coe_to_fun G.connected (λ _, Π (u v : V), G.reachable u v) :=
⟨λ h, h.preconnected⟩

/-- A subgraph is connected if it is connected as a simple graph. -/
abbreviation subgraph.connected {G : simple_graph V} (H : G.subgraph) : Prop := H.coe.connected

variables {G}

lemma preconnected.set_univ_walk_nonempty (hconn : G.preconnected) (u v : V) :
  (set.univ : set (G.walk u v)).nonempty :=
by { rw ← set.nonempty_iff_univ_nonempty, exact hconn u v }

lemma connected.set_univ_walk_nonempty (hconn : G.connected) (u v : V) :
  (set.univ : set (G.walk u v)).nonempty := hconn.preconnected.set_univ_walk_nonempty u v

end simple_graph


/-
layout: post
title: "Graph Coloring Basics"
date: 2022-01-09
categories: graph

Prelude:

* [Graph homomorphism](https://en.wikipedia.org/wiki/Graph_homomorphism)
* [NP-hardness](https://en.wikipedia.org/wiki/NP-hardness)

# Graph Coloring Basics

In Graph Theory, finding a proper coloring of a graph consists of attributing "colors"
to its vertices in a way that adjacent vertices have different colors.

[In Lean](https://github.com/leanprover-community/mathlib/pull/10287), a coloring (short
for "proper coloring") is represented as a homomorphism from the graph being colored to
the complete graph of available colors. Let's seen an example of how this works.

Suppose we have a graph `G` that we want to color with three colors: `c₁`, `c₂` and `c₃`.

```
      G            Complete graph of colors
  D-------A                   c₁
  |       | \                /  \
  |       |  C              c₂---c₃
  |       | /
  E-------B
```

The following mapping can be seen as a coloring of `G`:

```
A → c₁
B → c₂
C → c₃
D → c₂
E → c₃
```

Now note that this mapping is in fact a homomorphism. And you may wonder, why does such
a homomorphism represent a coloring?

Informally, consider two adjacent vertices in G. Since our mapping is a homomorphism,
those vertices must be mapped to adjacent vertices in the complete graph of colors.
And such adjacent vertices represent different colors.

You can check Mathlib's formalization of the above [here](https://leanprover-community.github.io/mathlib_docs/combinatorics/simple_graph/coloring.html#simple_graph.coloring.valid).

Let's play with the API a bit.
-/

import combinatorics.simple_graph.coloring
import tactic.derive_fintype

/-
Deriving `decidable_eq` and `fintype` will allow us to prove some results
with `dec_trivial`.
-/

@[derive [decidable_eq, fintype]]
inductive verts : Type
| A | B | C | D | E

open verts

def edges : list (verts × verts) :=
[ (A, B), (B, C), (A, C), (A, D), (D, E), (B, E) ]

/- This function tells whether two vertices are adjacent. -/

def adj (v w : verts) : bool := edges.mem (v, w) || edges.mem (w, v)

/-
The `simple_graph` API requires a `Prop` for adjacency. So we need to coerce
our `bool` function to a `Prop` one:
-/

def adj_prop (v w : verts) : Prop := adj v w

/- The following proofs are required to construct a `simple_graph`: -/

lemma adj_symmetric : ∀ (x y : verts), adj x y → adj y x := dec_trivial
lemma adj_loopless : ∀ (x : verts), ¬adj x x := dec_trivial

def G : simple_graph verts := ⟨adj_prop, adj_symmetric, adj_loopless⟩

/- Now we can color `G`.-/

@[derive decidable_eq]
inductive colors : Type
| c₁ | c₂ | c₃

open colors

def color_fn : verts → colors
  | A := c₁
  | B := c₂
  | C := c₃
  | D := c₂
  | E := c₃

/-
We must prove our coloring is proper, which `dec_trivial` is able to do easily for
our finite graph.
-/

lemma color_fn_is_valid : ∀ (v w : verts), adj v w → color_fn v ≠ color_fn w :=
dec_trivial

def my_coloring : G.coloring colors := ⟨color_fn, color_fn_is_valid⟩

/-
Notice that `color_fn_is_valid` wouldn't have been accepted by Lean if `color_fn`
weren't in fact a proper coloring function.

## The real challenge

Coloring graphs would be a trivial task if we could use as many colors as we wanted.
Just color each vertex with a different color! This is done in [Mathlib](https://leanprover-community.github.io/mathlib_docs/combinatorics/simple_graph/coloring.html#simple_graph.self_coloring)
by coloring vertices using themselves as colors.

However, the interesting question is: what is the **minimum** number of colors required
to color a certain graph? This quantity is called *chromatic number* and finding it
for any given graph is an NP-Hard problem, although Mathlib does provide proofs for some
known results:

* If `G` is a subgraph of `G'`, the chromatic number of `G'` is at least the
chromatic number of `G`

    [`simple_graph.chromatic_number_le_of_le_colorable`](https://leanprover-community.github.io/mathlib_docs/combinatorics/simple_graph/coloring.html#simple_graph.chromatic_number_le_of_le_colorable)

* The chromatic number of a complete graph is the number of vertices it has:

    [`simple_graph.chromatic_number_complete_graph`](https://leanprover-community.github.io/mathlib_docs/combinatorics/simple_graph/coloring.html#simple_graph.chromatic_number_complete_graph)

* The chromatic number of a complete bipartite graph is 2:

    [`simple_graph.complete_bipartite_graph.chromatic_number`](https://leanprover-community.github.io/mathlib_docs/combinatorics/simple_graph/coloring.html#simple_graph.complete_bipartite_graph.chromatic_number)

## Conclusion

Graph coloring is an important problem in Computer Science, with
[applications](https://en.wikipedia.org/wiki/Graph_coloring#Applications) in different
areas of study. This is an ongoing field of research and finding lower/upper bounds for
the chromatic number, as well as potent coloring heuristics for graphs of certain shapes,
is of immense value for the academic community and for the industry in general.
-/


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.set.basic

/-!
# Circular order hierarchy

This file defines circular preorders, circular partial orders and circular orders.

## Hierarchy

* A ternary "betweenness" relation `btw : α → α → α → Prop` forms a `circular_order` if it is
  - reflexive: `btw a a a`
  - cyclic: `btw a b c → btw b c a`
  - antisymmetric: `btw a b c → btw c b a → a = b ∨ b = c ∨ c = a`
  - total: `btw a b c ∨ btw c b a`
  along with a strict betweenness relation `sbtw : α → α → α → Prop` which respects
  `sbtw a b c ↔ btw a b c ∧ ¬ btw c b a`, analogously to how `<` and `≤` are related, and is
  - transitive: `sbtw a b c → sbtw b d c → sbtw a d c`.
* A `circular_partial_order` drops totality.
* A `circular_preorder` further drops antisymmetry.

The intuition is that a circular order is a circle and `btw a b c` means that going around
clockwise from `a` you reach `b` before `c` (`b` is between `a` and `c` is meaningless on an
unoriented circle). A circular partial order is several, potentially intersecting, circles. A
circular preorder is like a circular partial order, but several points can coexist.

Note that the relations between `circular_preorder`, `circular_partial_order` and `circular_order`
are subtler than between `preorder`, `partial_order`, `linear_order`. In particular, one cannot
simply extend the `btw` of a `circular_partial_order` to make it a `circular_order`.

One can translate from usual orders to circular ones by "closing the necklace at infinity". See
`has_le.to_has_btw` and `has_lt.to_has_sbtw`. Going the other way involves "cutting the necklace" or
"rolling the necklace open".

## Examples

Some concrete circular orders one encounters in the wild are `zmod n` for `0 < n`, `circle`,
`real.angle`...

## Main definitions

* `set.cIcc`: Closed-closed circular interval.
* `set.cIoo`: Open-open circular interval.

## Notes

There's an unsolved diamond on `order_dual α` here. The instances `has_le α → has_btw αᵒᵈ` and
`has_lt α → has_sbtw αᵒᵈ` can each be inferred in two ways:
* `has_le α` → `has_btw α` → `has_btw αᵒᵈ` vs
  `has_le α` → `has_le αᵒᵈ` → `has_btw αᵒᵈ`
* `has_lt α` → `has_sbtw α` → `has_sbtw αᵒᵈ` vs
  `has_lt α` → `has_lt αᵒᵈ` → `has_sbtw αᵒᵈ`
The fields are propeq, but not defeq. It is temporarily fixed by turning the circularizing instances
into definitions.

## TODO

Antisymmetry is quite weak in the sense that there's no way to discriminate which two points are
equal. This prevents defining closed-open intervals `cIco` and `cIoc` in the neat `=`-less way. We
currently haven't defined them at all.

What is the correct generality of "rolling the necklace" open? At least, this works for `α × β` and
`β × α` where `α` is a circular order and `β` is a linear order.

What's next is to define circular groups and provide instances for `zmod n`, the usual circle group
`circle`, `real.angle`, and `roots_of_unity M`. What conditions do we need on `M` for this last one
to work?

We should have circular order homomorphisms. The typical example is
`days_to_month : days_of_the_year →c months_of_the_year` which relates the circular order of days
and the circular order of months. Is `α →c β` a good notation?

## References

* https://en.wikipedia.org/wiki/Cyclic_order
* https://en.wikipedia.org/wiki/Partial_cyclic_order

## Tags

circular order, cyclic order, circularly ordered set, cyclically ordered set
-/

/-- Syntax typeclass for a betweenness relation. -/
class has_btw (α : Type*) :=
(btw : α → α → α → Prop)

export has_btw (btw)

/-- Syntax typeclass for a strict betweenness relation. -/
class has_sbtw (α : Type*) :=
(sbtw : α → α → α → Prop)

export has_sbtw (sbtw)

/-- A circular preorder is the analogue of a preorder where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive and cyclic. `sbtw` is transitive.
-/
class circular_preorder (α : Type*) extends has_btw α, has_sbtw α :=
(btw_refl (a : α) : btw a a a)
(btw_cyclic_left {a b c : α} : btw a b c → btw b c a)
(sbtw := λ a b c, btw a b c ∧ ¬btw c b a)
(sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ (btw a b c ∧ ¬btw c b a) . order_laws_tac)
(sbtw_trans_left {a b c d : α} : sbtw a b c → sbtw b d c → sbtw a d c)

export circular_preorder (btw_refl) (btw_cyclic_left) (sbtw_trans_left)

/-- A circular partial order is the analogue of a partial order where you can loop around. `≤` and
`<` are replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic and
antisymmetric. `sbtw` is transitive. -/
class circular_partial_order (α : Type*) extends circular_preorder α :=
(btw_antisymm {a b c : α} : btw a b c → btw c b a → a = b ∨ b = c ∨ c = a)

export circular_partial_order (btw_antisymm)

/-- A circular order is the analogue of a linear order where you can loop around. `≤` and `<` are
replaced by ternary relations `btw` and `sbtw`. `btw` is reflexive, cyclic, antisymmetric and total.
`sbtw` is transitive. -/
class circular_order (α : Type*) extends circular_partial_order α :=
(btw_total : ∀ a b c : α, btw a b c ∨ btw c b a)

export circular_order (btw_total)

/-! ### Circular preorders -/

section circular_preorder
variables {α : Type*} [circular_preorder α]

lemma btw_rfl {a : α} : btw a a a :=
btw_refl _

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_cyclic_left        ← has_btw.btw.cyclic_left
lemma has_btw.btw.cyclic_left {a b c : α} (h : btw a b c) : btw b c a :=
btw_cyclic_left h

lemma btw_cyclic_right {a b c : α} (h : btw a b c) : btw c a b :=
h.cyclic_left.cyclic_left

alias btw_cyclic_right ← has_btw.btw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw btw_cyclic` cycles to the right while
`rw ←btw_cyclic` cycles to the left (thus following the prepended arrow). -/
lemma btw_cyclic {a b c : α} : btw a b c ↔ btw c a b :=
⟨btw_cyclic_right, btw_cyclic_left⟩

lemma sbtw_iff_btw_not_btw {a b c : α} : sbtw a b c ↔ btw a b c ∧ ¬btw c b a :=
circular_preorder.sbtw_iff_btw_not_btw

lemma btw_of_sbtw {a b c : α} (h : sbtw a b c) : btw a b c :=
(sbtw_iff_btw_not_btw.1 h).1

alias btw_of_sbtw ← has_sbtw.sbtw.btw

lemma not_btw_of_sbtw {a b c : α} (h : sbtw a b c) : ¬btw c b a :=
(sbtw_iff_btw_not_btw.1 h).2

alias not_btw_of_sbtw ← has_sbtw.sbtw.not_btw

lemma not_sbtw_of_btw {a b c : α} (h : btw a b c) : ¬sbtw c b a :=
λ h', h'.not_btw h

alias not_sbtw_of_btw ← has_btw.btw.not_sbtw

lemma sbtw_of_btw_not_btw {a b c : α} (habc : btw a b c) (hcba : ¬btw c b a) : sbtw a b c :=
sbtw_iff_btw_not_btw.2 ⟨habc, hcba⟩

alias sbtw_of_btw_not_btw ← has_btw.btw.sbtw_of_not_btw

lemma sbtw_cyclic_left {a b c : α} (h : sbtw a b c) : sbtw b c a :=
h.btw.cyclic_left.sbtw_of_not_btw (λ h', h.not_btw h'.cyclic_left)

alias sbtw_cyclic_left ← has_sbtw.sbtw.cyclic_left

lemma sbtw_cyclic_right {a b c : α} (h : sbtw a b c) : sbtw c a b :=
h.cyclic_left.cyclic_left

alias sbtw_cyclic_right ← has_sbtw.sbtw.cyclic_right

/-- The order of the `↔` has been chosen so that `rw sbtw_cyclic` cycles to the right while
`rw ←sbtw_cyclic` cycles to the left (thus following the prepended arrow). -/
lemma sbtw_cyclic {a b c : α} : sbtw a b c ↔ sbtw c a b :=
⟨sbtw_cyclic_right, sbtw_cyclic_left⟩

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_trans_left        ← has_btw.btw.trans_left
lemma has_sbtw.sbtw.trans_left {a b c d : α} (h : sbtw a b c) : sbtw b d c → sbtw a d c :=
sbtw_trans_left h

lemma sbtw_trans_right {a b c d : α} (hbc : sbtw a b c) (hcd : sbtw a c d) : sbtw a b d :=
(hbc.cyclic_left.trans_left hcd.cyclic_left).cyclic_right

alias sbtw_trans_right ← has_sbtw.sbtw.trans_right

lemma sbtw_asymm {a b c : α} (h : sbtw a b c) : ¬ sbtw c b a :=
h.btw.not_sbtw

alias sbtw_asymm ← has_sbtw.sbtw.not_sbtw

lemma sbtw_irrefl_left_right {a b : α} : ¬ sbtw a b a := λ h, h.not_btw h.btw
lemma sbtw_irrefl_left {a b : α} : ¬ sbtw a a b := λ h, sbtw_irrefl_left_right h.cyclic_left
lemma sbtw_irrefl_right {a b : α} : ¬ sbtw a b b := λ h, sbtw_irrefl_left_right h.cyclic_right
lemma sbtw_irrefl (a : α) : ¬ sbtw a a a := sbtw_irrefl_left_right

end circular_preorder

/-! ### Circular partial orders -/

section circular_partial_order
variables {α : Type*} [circular_partial_order α]

-- TODO: `alias` creates a def instead of a lemma.
-- alias btw_antisymm        ← has_btw.btw.antisymm
lemma has_btw.btw.antisymm {a b c : α} (h : btw a b c) : btw c b a → a = b ∨ b = c ∨ c = a :=
btw_antisymm h

end circular_partial_order

/-! ### Circular orders -/

section circular_order
variables {α : Type*} [circular_order α]

lemma btw_refl_left_right (a b : α) : btw a b a :=
(or_self _).1 (btw_total a b a)

lemma btw_rfl_left_right {a b : α} : btw a b a :=
btw_refl_left_right _ _

lemma btw_refl_left (a b : α) : btw a a b :=
btw_rfl_left_right.cyclic_right

lemma btw_rfl_left {a b : α} : btw a a b :=
btw_refl_left _ _

lemma btw_refl_right (a b : α) : btw a b b :=
btw_rfl_left_right.cyclic_left

lemma btw_rfl_right {a b : α} : btw a b b :=
btw_refl_right _ _

lemma sbtw_iff_not_btw {a b c : α} : sbtw a b c ↔ ¬ btw c b a :=
begin
  rw sbtw_iff_btw_not_btw,
  exact and_iff_right_of_imp (btw_total _ _ _).resolve_left,
end

lemma btw_iff_not_sbtw {a b c : α} : btw a b c ↔ ¬ sbtw c b a :=
iff_not_comm.1 sbtw_iff_not_btw

end circular_order

/-! ### Circular intervals -/

namespace set

section circular_preorder
variables {α : Type*} [circular_preorder α]

/-- Closed-closed circular interval -/
def cIcc (a b : α) : set α := {x | btw a x b}

/-- Open-open circular interval -/
def cIoo (a b : α) : set α := {x | sbtw a x b}

@[simp] lemma mem_cIcc {a b x : α} : x ∈ cIcc a b ↔ btw a x b := iff.rfl
@[simp] lemma mem_cIoo {a b x : α} : x ∈ cIoo a b ↔ sbtw a x b := iff.rfl

end circular_preorder

section circular_order
variables {α : Type*} [circular_order α]

lemma left_mem_cIcc (a b : α) : a ∈ cIcc a b := btw_rfl_left
lemma right_mem_cIcc (a b : α) : b ∈ cIcc a b := btw_rfl_right

lemma compl_cIcc {a b : α} : (cIcc a b)ᶜ = cIoo b a :=
begin
  ext,
  rw [set.mem_cIoo, sbtw_iff_not_btw],
  refl,
end

lemma compl_cIoo {a b : α} : (cIoo a b)ᶜ = cIcc b a :=
begin
  ext,
  rw [set.mem_cIcc, btw_iff_not_sbtw],
  refl,
end

end circular_order
end set

/-! ### Circularizing instances -/

/-- The betweenness relation obtained from "looping around" `≤`.
See note [reducible non-instances]. -/
@[reducible]
def has_le.to_has_btw (α : Type*) [has_le α] : has_btw α :=
{ btw := λ a b c, (a ≤ b ∧ b ≤ c) ∨ (b ≤ c ∧ c ≤ a) ∨ (c ≤ a ∧ a ≤ b) }

/-- The strict betweenness relation obtained from "looping around" `<`.
See note [reducible non-instances]. -/
@[reducible]
def has_lt.to_has_sbtw (α : Type*) [has_lt α] : has_sbtw α :=
{ sbtw := λ a b c, (a < b ∧ b < c) ∨ (b < c ∧ c < a) ∨ (c < a ∧ a < b) }

/-- The circular preorder obtained from "looping around" a preorder.
See note [reducible non-instances]. -/
@[reducible]
def preorder.to_circular_preorder (α : Type*) [preorder α] : circular_preorder α :=
{ btw := λ a b c, (a ≤ b ∧ b ≤ c) ∨ (b ≤ c ∧ c ≤ a) ∨ (c ≤ a ∧ a ≤ b),
  sbtw := λ a b c, (a < b ∧ b < c) ∨ (b < c ∧ c < a) ∨ (c < a ∧ a < b),
  btw_refl := λ a, or.inl ⟨le_rfl, le_rfl⟩,
  btw_cyclic_left := λ a b c h, begin
    unfold btw at ⊢ h,
    rwa [←or.assoc, or_comm],
  end,
  sbtw_trans_left := λ a b c d, begin
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hbd, hdc⟩ | ⟨hdc, hcb⟩ | ⟨hcb, hbd⟩),
    { exact or.inl ⟨hab.trans hbd, hdc⟩ },
    { exact (hbc.not_lt hcb).elim },
    { exact (hbc.not_lt hcb).elim },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact (hbc.not_lt hcb).elim },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inl ⟨hdc, hca⟩) },
    { exact or.inr (or.inr ⟨hca, hab.trans hbd⟩) }
  end,
  sbtw_iff_btw_not_btw := λ a b c, begin
    simp_rw lt_iff_le_not_le,
    set x₀ := a ≤ b,
    set x₁ := b ≤ c,
    set x₂ := c ≤ a,
    have : x₀ → x₁ → a ≤ c := le_trans,
    have : x₁ → x₂ → b ≤ a := le_trans,
    have : x₂ → x₀ → c ≤ b := le_trans,
    clear_value x₀ x₁ x₂,
    tauto!,
  end }

/-- The circular partial order obtained from "looping around" a partial order.
See note [reducible non-instances]. -/
@[reducible]
def partial_order.to_circular_partial_order (α : Type*) [partial_order α] :
  circular_partial_order α :=
{ btw_antisymm := λ a b c, begin
    rintro (⟨hab, hbc⟩ | ⟨hbc, hca⟩ | ⟨hca, hab⟩) (⟨hcb, hba⟩ | ⟨hba, hac⟩ | ⟨hac, hcb⟩),
    { exact or.inl (hab.antisymm hba) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inr (or.inr $ hca.antisymm hac) },
    { exact or.inr (or.inl $ hbc.antisymm hcb) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inl (hab.antisymm hba) },
    { exact or.inr (or.inr $ hca.antisymm hac) }
  end,
  .. preorder.to_circular_preorder α }

/-- The circular order obtained from "looping around" a linear order.
See note [reducible non-instances]. -/
@[reducible]
def linear_order.to_circular_order (α : Type*) [linear_order α] :
  circular_order α :=
{ btw_total := λ a b c, begin
    cases le_total a b with hab hba; cases le_total b c with hbc hcb;
      cases le_total c a with hca hac,
    { exact or.inl (or.inl ⟨hab, hbc⟩) },
    { exact or.inl (or.inl ⟨hab, hbc⟩) },
    { exact or.inl (or.inr $ or.inr ⟨hca, hab⟩) },
    { exact or.inr (or.inr $ or.inr ⟨hac, hcb⟩) },
    { exact or.inl (or.inr $ or.inl ⟨hbc, hca⟩) },
    { exact or.inr (or.inr $ or.inl ⟨hba, hac⟩) },
    { exact or.inr (or.inl ⟨hcb, hba⟩) },
    { exact or.inr (or.inr $ or.inl ⟨hba, hac⟩) }
  end,
  .. partial_order.to_circular_partial_order α }

/-! ### Dual constructions -/

section order_dual

instance (α : Type*) [has_btw α] : has_btw αᵒᵈ := ⟨λ a b c : α, btw c b a⟩
instance (α : Type*) [has_sbtw α] : has_sbtw αᵒᵈ := ⟨λ a b c : α, sbtw c b a⟩

instance (α : Type*) [h : circular_preorder α] : circular_preorder αᵒᵈ :=
{ btw_refl := btw_refl,
  btw_cyclic_left := λ a b c, btw_cyclic_right,
  sbtw_trans_left := λ a b c d habc hbdc, hbdc.trans_right habc,
  sbtw_iff_btw_not_btw := λ a b c, @sbtw_iff_btw_not_btw α _ c b a,
  .. order_dual.has_btw α,
  .. order_dual.has_sbtw α }

instance (α : Type*) [circular_partial_order α] : circular_partial_order αᵒᵈ :=
{ btw_antisymm := λ a b c habc hcba, @btw_antisymm α _ _ _ _ hcba habc,
  .. order_dual.circular_preorder α }

instance (α : Type*) [circular_order α] : circular_order αᵒᵈ :=
{ btw_total := λ a b c, btw_total c b a, .. order_dual.circular_partial_order α }

end order_dual