/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Lu-Ming Zhang.
-/
import set_finset_fintype
import matrix_basic

/-!
# Symmetric matrices

This file contains basic results about symmetric matrices.
See `matrix_basic.lean` for the definition of symmetric matrices.

## Tags

sym, symmetric, matrix
-/

namespace matrix

open_locale matrix

variables {α I J R : Type*} [fintype I] [fintype J]

lemma is_sym.eq {A : matrix I I α} (h : A.is_sym) : Aᵀ = A := h

lemma is_sym.ext_iff {A : matrix I I α} : A.is_sym ↔ ∀ i j, Aᵀ i j = A i j :=
by rw [is_sym, matrix.ext_iff]

lemma is_sym.ext_iff' {A : matrix I I α} : A.is_sym ↔ ∀ i j, A j i = A i j :=
is_sym.ext_iff

lemma is_sym.apply {A : matrix I I α} (h : A.is_sym) (i j : I) : Aᵀ i j = A i j :=
is_sym.ext_iff.1 h i j

lemma is_sym.apply' {A : matrix I I α} (h : A.is_sym) (i j : I) : A j i = A i j :=
is_sym.apply h i j

lemma is_sym.ext {A : matrix I I α} : (∀ i j, Aᵀ i j = A i j) → A.is_sym :=
is_sym.ext_iff.2

lemma is_sym.ext' {A : matrix I I α} : (∀ i j, Aᵀ i j = A i j) → A.is_sym :=
is_sym.ext

/-- A block matrix `A.from_blocks B C D` is symmetric, if `A` and `D` are symmetric and `Bᵀ = C`. -/
lemma is_sym_of_block_conditions
{A : matrix I I α} {B : matrix I J α} {C : matrix J I α} {D : matrix J J α} :
(A.is_sym) ∧ (D.is_sym) ∧ (Bᵀ = C) → (A.from_blocks B C D).is_sym :=
begin
  rintros ⟨h1, h2, h3⟩,
  have h4 : Cᵀ = B, {rw ← h3, simp},
  unfold matrix.is_sym,
  rw from_blocks_transpose,
  congr;
  assumption
end

/-- `A ⬝ Aᵀ` is symmertric. -/
lemma mul_transpose_self_is_sym [comm_semiring α] (A : matrix I I α) :
(A ⬝ Aᵀ).is_sym :=
by simp [matrix.is_sym, transpose_mul]

/-- The identity matrix is symmetric. -/
@[simp] lemma is_sym_of_one [decidable_eq I] [has_zero α] [has_one α] :
(1 : matrix I I α).is_sym := by {ext, simp}

/-- The negtive identity matrix is symmetric. -/
@[simp] lemma is_sym_of_neg_one [decidable_eq I] [has_zero α] [has_one α] [has_neg α] :
(-1 : matrix I I α).is_sym := by {ext, simp}

/-- The identity matrix multiplied by any scalar `k` is symmetric. -/
@[simp] lemma is_sym_of_smul_one
[decidable_eq I] [monoid R] [add_monoid α] [has_one α] [distrib_mul_action R α] (k : R) :
(k • (1 : matrix I I α)).is_sym :=
by { ext, simp [is_sym_of_one.apply'] }

/-- If a block matrix `A.from_blocks B C D` is symmetric,-/
lemma block_conditions_of_is_sym
{A : matrix I I α} {B : matrix I J α} {C : matrix J I α} {D : matrix J J α} :
(A.from_blocks B C D).is_sym → (A.is_sym) ∧ (D.is_sym) ∧ (Cᵀ = B) ∧ (Bᵀ = C) :=
begin
  rintros h,
  unfold matrix.is_sym at h,
  rw from_blocks_transpose at h,
  have h1 : (Aᵀ.from_blocks Cᵀ Bᵀ Dᵀ).to_blocks₁₁ = (A.from_blocks B C D).to_blocks₁₁, {rw h},
  have h2 : (Aᵀ.from_blocks Cᵀ Bᵀ Dᵀ).to_blocks₁₂ = (A.from_blocks B C D).to_blocks₁₂, {rw h},
  have h3 : (Aᵀ.from_blocks Cᵀ Bᵀ Dᵀ).to_blocks₂₁ = (A.from_blocks B C D).to_blocks₂₁, {rw h},
  have h4 : (Aᵀ.from_blocks Cᵀ Bᵀ Dᵀ).to_blocks₂₂ = (A.from_blocks B C D).to_blocks₂₂, {rw h},
  simp at *,
  use ⟨h1, h4, h2, h3⟩
end

end matrix


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

! This file was ported from Lean 3 source module data.fintype.card_embedding
! leanprover-community/mathlib commit 98e83c3d541c77cdb7da20d79611a780ff8e7d90
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.BigOperators
import Mathlib.Logic.Equiv.Embedding
import Mathlib.Logic.Embedding.Set

/-!
# Number of embeddings

This file establishes the cardinality of `α ↪ β` in full generality.
-/

local notation "|" x "|" => Finset.card x

local notation "‖" x "‖" => Fintype.card x

open Function

open Nat BigOperators

namespace Fintype

theorem card_embedding_eq_of_unique {α β : Type _} [Unique α] [Fintype β] [Fintype (α ↪ β)] :
    ‖α ↪ β‖ = ‖β‖ :=
  card_congr Equiv.uniqueEmbeddingEquivResult
#align fintype.card_embedding_eq_of_unique Fintype.card_embedding_eq_of_unique

-- Establishes the cardinality of the type of all injections between two finite types.
-- porting note: `induction'` is broken so instead we make an ugly refine and `dsimp` a lot.
@[simp]
theorem card_embedding_eq {α β : Type _} [Fintype α] [Fintype β] [emb : Fintype (α ↪ β)] :
    ‖α ↪ β‖ = ‖β‖.descFactorial ‖α‖ := by
  rw [Subsingleton.elim emb Embedding.fintype]
  refine' Fintype.induction_empty_option (P := fun t ↦ ‖t ↪ β‖ = ‖β‖.descFactorial ‖t‖)
        (fun α₁ α₂ h₂ e ih ↦ ?_) (?_) (fun γ h ih ↦ ?_) α <;> dsimp only <;> clear! α
  · letI := Fintype.ofEquiv _ e.symm
    rw [← card_congr (Equiv.embeddingCongr e (Equiv.refl β)), ih, card_congr e]
  · rw [card_pempty, Nat.descFactorial_zero, card_eq_one_iff]
    exact ⟨Embedding.ofIsEmpty, fun x ↦ FunLike.ext _ _ isEmptyElim⟩
  · classical
    dsimp only at ih
    rw [card_option, Nat.descFactorial_succ, card_congr (Embedding.optionEmbeddingEquiv γ β),
        card_sigma, ←ih]
    simp only [Fintype.card_compl_set, Fintype.card_range, Finset.sum_const, Finset.card_univ,
      smul_eq_mul, mul_comm]
#align fintype.card_embedding_eq Fintype.card_embedding_eq

/- The cardinality of embeddings from an infinite type to a finite type is zero.
This is a re-statement of the pigeonhole principle. -/
@[simp]
theorem card_embedding_eq_of_infinite {α β : Type _} [Infinite α] [Fintype β] [Fintype (α ↪ β)] :
    ‖α ↪ β‖ = 0 :=
  card_eq_zero
#align fintype.card_embedding_eq_of_infinite Fintype.card_embedding_eq_of_infinite

end Fintype


import data.real.basic
import data.set.basic
import tactic

namespace mth1001

/-
We'll only deal with real-valued sequences. Such a sequence is merely a function from `ℕ` to `ℝ`
We'll use the Lean built-in real number type rather than the type we've constructed.
-/

section convergence

-- `convergesto f a` means
def convergesto (f : ℕ → ℝ) (a : ℝ) := ∀ ε > 0, ∃ N, ∀ n ≥ N, abs (f n - a) < ε

/-
We'll prove that the sequence `f₁ : ℕ → R` given by `f₁(n) = 5` converges to `5`.
-/

def f₁ : ℕ → ℝ := λ n, (5 : ℝ)

example : convergesto f₁ 5 :=
begin
  assume ε : ℝ,
  assume εpos : ε > 0, -- It suffices to prove `∃ N, ∀ n ≥ N, abs (f₁ n - 5) < ε`.
  use 1, -- Take `N := 1`.
  assume n : ℕ,
  assume hn : n ≥ 1,
  unfold f₁, -- By unfolding, it suffices to show `abs (5 - 5) < ε`.
  rw sub_self, -- That is, to prove `abs 0 < ε`.
  rw abs_zero, -- But `abs 0 = 0`, so it suffices to prove `0 < ε`.
  exact εpos, -- This holds by `εpos`.
end

/-
More generally, we'll show a constant sequence converges.
-/

-- Exercise 219:
lemma convergesto_const (c : ℝ) : convergesto (λ n, c) c :=
begin
  assume ε : ℝ,
  assume εpos : ε > 0,
  sorry
end

end convergence

section uniqueness_of_limits

variables {f : ℕ → ℝ} {a b : ℝ}

-- We proved the following result earlier for our own real number type.
lemma zero_of_non_neg_of_lt_pos' {a : ℝ} (h : 0 ≤ a) (h₂ : ∀ ε > 0, a < ε) : a = 0 :=
begin
  apply eq_of_le_of_forall_le_of_dense h,
  intros ε εpos,
  specialize h₂ ε εpos,
  exact le_of_lt h₂,
end

-- We'll need the following results for the proof of the next lemma.
example (x y : ℝ) : abs (x + y) ≤ abs x + abs y := abs_add x y
example (x : ℝ) : abs (-x) = abs x := abs_neg x
example (a b c : ℝ) (h : a < b) : a + c < b + c := add_lt_add_right h c
example (a b c : ℝ) (h : a < b) : c + a < c + b := add_lt_add_left h c

-- Exercise 220:
lemma convergesto_unique (h₁ : convergesto f a) (h₂ : convergesto f b) : a = b :=
begin
  suffices h : abs (a - b) = 0,
  { rwa [←sub_eq_zero, ←abs_eq_zero] },
  have k₁ : abs (a - b) ≥ 0, from abs_nonneg (a - b),
  suffices h : ∀ ε > 0, abs (a - b) < ε, from zero_of_non_neg_of_lt_pos' k₁ h,
  sorry
end

end uniqueness_of_limits

section algebra_of_limits

variables (f g : ℕ → ℝ) -- `f` and `g` are sequences
variables (a b c : ℝ)

-- The following result will often come in handy!
lemma div_abs_pos_of_pos_of_non_zero {ε c : ℝ} (εpos : ε > 0) (h : c ≠ 0) : ε / abs c > 0 :=
begin
  have h₂ : 0 < abs c, from  abs_pos_iff.mpr h,
  have h₃ : 0 < (abs c)⁻¹, from inv_pos.mpr h₂,
  exact mul_pos εpos h₃,
end

example (a b c : ℝ) (h₁ : a < b / c) (h₂ : 0 < c): a * c < b := (lt_div_iff h₂).mp h₁

example (a b : ℝ) : abs (a*b) = abs a * abs b := abs_mul a b

example (x y : ℝ) : x ≤ max x y := le_max_left x y

example (x y : ℝ) : y ≤ max x y := le_max_right x y

theorem convergesto_scalar_mul (h : convergesto f a) : convergesto (λ n, c * (f n)) (c * a) :=
begin
  by_cases h₂ : c = 0,
  { simp only [h₂, zero_mul], -- `simp` is a simiplying tactic.
    exact convergesto_const 0, },
  { assume ε : ℝ,
    assume εpos : ε > 0,
    have h₃ : ε / abs c > 0, from div_abs_pos_of_pos_of_non_zero εpos h₂,
    cases h (ε/ abs c) h₃ with N hN,
    use N,
    intros n hn,
    specialize hN n hn,
    have h₄ : abs c > 0, from abs_pos_iff.mpr h₂,
    have h₅ : abs (f n -a) * abs c < ε, from (lt_div_iff h₄).mp hN,
    have h₆ : abs ((f n - a)* c) < ε, { rwa abs_mul, },
    rwa [←mul_sub, mul_comm], },
end

theorem convergesto_add (h₁ : convergesto f a) (h₂ : convergesto g b )
: convergesto (λ n, f n + g n) (a + b) :=
begin
  assume ε : ℝ,
  assume εpos : ε > 0,
  cases h₁ (ε/2) (by linarith) with N₁ hN₁,
  cases h₂ (ε/2) (by linarith) with N₂ hN₂,
  use (max N₁ N₂),
  intros n hn,
  have k₁ : n ≥ N₁, from le_trans (le_max_left N₁ N₂) hn,
  have k₂ : n ≥ N₂, from le_trans (le_max_right N₁ N₂) hn,
  have m₁ : abs (f n - a) < ε/2, from hN₁ n k₁,
  have m₂ : abs (g n - b) < ε/2, from hN₂ n k₂,
  have h₃ : (f n + g n) - (a + b) = (f n - a) + (g n - b), ring,
  rw h₃,
  calc abs (f n - a + (g n - b))
        ≤ abs (f n - a) + abs (g n - b) : abs_add _ _
    ... < ε/2 + ε/2                     : by linarith
    ... = ε                             : by linarith,
end

-- The same proof can be written more briefly using `congr'` and by giving arguments to `linarith`.
example (h₁ : convergesto f a) (h₂ : convergesto g b ) : convergesto (λ n, f n + g n) (a + b) :=
begin
  intros ε εpos,
  cases h₁ (ε/2) (by linarith) with N₁ hN₁,
  cases h₂ (ε/2) (by linarith) with N₂ hN₂,
  use (max N₁ N₂),
  intros n hn,
  have k₁ : n ≥ N₁, from le_trans (le_max_left N₁ N₂) hn,
  have k₂ : n ≥ N₂, from le_trans (le_max_right N₁ N₂) hn,
  calc abs ((f n + g n) - (a + b))
        = abs (f n - a + (g n - b))     : by {congr', ring}
    ... ≤ abs (f n - a) + abs (g n - b) : abs_add _ _
    ... < ε/2 + ε/2                     : by linarith [hN₁ n k₁, hN₂ n k₂]
    ... = ε                             : by linarith,
end

end algebra_of_limits

section specific_example

/-
In Lean, it's often harder to work with particular examples than with general theorems.
Here, we show convergence of a particular sequence.

We'll need the corollorary to the Archimedean property. In Lean,this is `exists_nat_one_div_lt`.
Note the use of `↑n` to indicate the embedding (or coercion) of the natural number `n`
as a real number.
-/

example (ε : ℝ) (h : 0 < ε) : ∃ n : ℕ, 1/(↑n + 1) < ε := exists_nat_one_div_lt h

example (x : ℝ) (h : x > 0) : abs x = x := abs_of_pos h

example (x : ℝ) (h : 0 < x) : 0 < x⁻¹ := by {rwa inv_pos}

example (x : ℝ) (h : 0 < x) : x⁻¹ = (1 : ℝ) / x := inv_eq_one_div x

-- Now we'll show the sequence given by `λ n, 3 + 1/n` converges to `3`.
example : convergesto (λ n, 3 + 1/n) 3 :=
begin
  unfold convergesto,
  assume ε εpos,
  have h : ∃ N : ℕ, 1/(↑N + 1) < ε, from exists_nat_one_div_lt εpos,
  cases h with N hN, -- By `∃` elim. on `h`, STP the goal assuming `N : ℕ` and `hN : 1/(↑N+1) < ε`.
  use N + 1, -- By `∃` intro on `N + 1`, it suffices to prove
  -- `∀ n ≥ N + 1, n ≥ N + 1 → abs (3 + 1/↑n - 3) < ε`.
  assume n hn, -- assume `n : ℕ` and `hn : n ≥ N`.
  have h₂ : abs ((3 : ℝ) + 1 / ↑n - 3)  = abs (↑n)⁻¹, ring,
  rw h₂,
  have : N + 1 > 0, linarith,
  have : n > 0, linarith,
  have :  (0 : ℝ) < ↑n, { rwa nat.cast_pos },
  have : (0 : ℝ) < N + 1, {change (0 : ℝ) < ↑(N + 1), rw nat.cast_pos, linarith, },
  have : (0 : ℝ) < (↑n)⁻¹, { rwa inv_pos },
  rw abs_of_pos this,
  have : (↑n)⁻¹ ≤ (↑N + (1 : ℝ))⁻¹,
  { rw inv_le_inv,
    change ↑(N + 1) ≤ ↑n,
    rwa nat.cast_le,
    repeat { assumption }, },
  apply lt_of_le_of_lt,
  { assumption, },
  { rwa inv_eq_one_div, },
end

end specific_example

end mth1001


-- Un_numero_es_par_syss_lo_es_su_cuadrado.lean
-- Un número es par si y solo si lo es su cuadrado
-- José A. Alonso Jiménez
-- Sevilla, 24 de julio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que un número es par si y solo si lo es su cuadrado.
-- ---------------------------------------------------------------------

import data.int.parity
import tactic
open int

variable (n : ℤ)

-- 1ª demostración
example :
  even (n^2) ↔ even n :=
begin
  split,
  { contrapose,
    rw ← odd_iff_not_even,
    rw ← odd_iff_not_even,
    unfold odd,
    intro h,
    cases h with k hk,
    use 2*k*(k+1),
    rw hk,
    ring, },
  { unfold even,
    intro h,
    cases h with k hk,
    use 2*k^2,
    rw hk,
    ring, },
end

-- 2ª demostración
example :
  even (n^2) ↔ even n :=
begin
  split,
  { contrapose,
    rw ← odd_iff_not_even,
    rw ← odd_iff_not_even,
    rintro ⟨k, rfl⟩,
    use 2*k*(k+1),
    ring, },
  { rintro ⟨k, rfl⟩,
    use 2*k^2,
    ring, },
end

-- 3ª demostración
example :
  even (n^2) ↔ even n :=
iff.intro
  ( have h : ¬even n → ¬even (n^2),
      { assume h1 : ¬even n,
        have h2 : odd n,
          from odd_iff_not_even.mpr h1,
        have h3: odd (n^2), from
          exists.elim h2
            ( assume k,
              assume hk : n = 2*k+1,
              have h4 : n^2 = 2*(2*k*(k+1))+1, from
                calc  n^2
                    = (2*k+1)^2       : by rw hk
                ... = 4*k^2+4*k+1     : by ring
                ... = 2*(2*k*(k+1))+1 : by ring,
              show odd (n^2),
                from exists.intro (2*k*(k+1)) h4),
        show ¬even (n^2),
          from odd_iff_not_even.mp h3 },
    show even (n^2) → even n,
      from not_imp_not.mp h )
  ( assume h1 : even n,
    show even (n^2), from
      exists.elim h1
        ( assume k,
          assume hk : n = k + k ,
          have h2 : n^2 = 2*k^2 + 2*k^2, from
            calc  n^2
                = (k + k)^2  : by rw hk
            ... = 2*k^2 + 2*k^2 : by ring,
          show even (n^2),
            from exists.intro (2*k^2) h2 ))

-- 4ª demostración
example :
  even (n^2) ↔ even n :=
calc even (n^2)
     ↔ even (n * n)      : iff_of_eq (congr_arg even (sq n))
 ... ↔ (even n ∨ even n) : int.even_mul
 ... ↔ even n            : or_self (even n)

-- 5ª demostración
example :
  even (n^2) ↔ even n :=
calc even (n^2)
     ↔ even (n * n)      : by ring_nf
 ... ↔ (even n ∨ even n) : int.even_mul
 ... ↔ even n            : by simp

-- 6ª demostración
example :
  even (n^2) ↔ even n :=
begin
  split,
  { contrapose,
    intro h,
    rw ← odd_iff_not_even at *,
    cases h with k hk,
    use 2*k*(k+1),
    calc n^2
         = (2*k+1)^2       : by rw hk
     ... = 4*k^2+4*k+1     : by ring
     ... = 2*(2*k*(k+1))+1 : by ring, },
  { intro h,
    cases h with k hk,
    use 2*k^2,
    calc n^2
         = (k + k)^2     : by rw hk
     ... = 2*k^2 + 2*k^2 : by ring, },
end


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

import group_theory.quotient_group
import set_theory.cardinal.finite

/-!
# Index of a Subgroup

In this file we define the index of a subgroup, and prove several divisibility properties.
Several theorems proved in this file are known as Lagrange's theorem.

## Main definitions

- `H.index` : the index of `H : subgroup G` as a natural number,
  and returns 0 if the index is infinite.
- `H.relindex K` : the relative index of `H : subgroup G` in `K : subgroup G` as a natural number,
  and returns 0 if the relative index is infinite.

# Main results

- `card_mul_index` : `nat.card H * H.index = nat.card G`
- `index_mul_card` : `H.index * fintype.card H = fintype.card G`
- `index_dvd_card` : `H.index ∣ fintype.card G`
- `index_eq_mul_of_le` : If `H ≤ K`, then `H.index = K.index * (H.subgroup_of K).index`
- `index_dvd_of_le` : If `H ≤ K`, then `K.index ∣ H.index`
- `relindex_mul_relindex` : `relindex` is multiplicative in towers

-/

namespace subgroup

open_locale cardinal

variables {G : Type*} [group G] (H K L : subgroup G)

/-- The index of a subgroup as a natural number, and returns 0 if the index is infinite. -/
@[to_additive "The index of a subgroup as a natural number,
and returns 0 if the index is infinite."]
noncomputable def index : ℕ :=
nat.card (G ⧸ H)

/-- The relative index of a subgroup as a natural number,
  and returns 0 if the relative index is infinite. -/
@[to_additive "The relative index of a subgroup as a natural number,
  and returns 0 if the relative index is infinite."]
noncomputable def relindex : ℕ :=
(H.subgroup_of K).index

@[to_additive] lemma index_comap_of_surjective {G' : Type*} [group G'] {f : G' →* G}
  (hf : function.surjective f) : (H.comap f).index = H.index :=
begin
  letI := quotient_group.left_rel H,
  letI := quotient_group.left_rel (H.comap f),
  have key : ∀ x y : G', setoid.r x y ↔ setoid.r (f x) (f y) :=
  λ x y, iff_of_eq (congr_arg (∈ H) (by rw [f.map_mul, f.map_inv])),
  refine cardinal.to_nat_congr (equiv.of_bijective (quotient.map' f (λ x y, (key x y).mp)) ⟨_, _⟩),
  { simp_rw [←quotient.eq'] at key,
    refine quotient.ind' (λ x, _),
    refine quotient.ind' (λ y, _),
    exact (key x y).mpr },
  { refine quotient.ind' (λ x, _),
    obtain ⟨y, hy⟩ := hf x,
    exact ⟨y, (quotient.map'_mk' f _ y).trans (congr_arg quotient.mk' hy)⟩ },
end

@[to_additive] lemma index_comap {G' : Type*} [group G'] (f : G' →* G) :
  (H.comap f).index = H.relindex f.range :=
eq.trans (congr_arg index (by refl))
  ((H.subgroup_of f.range).index_comap_of_surjective f.range_restrict_surjective)

variables {H K L}

@[to_additive relindex_mul_index] lemma relindex_mul_index (h : H ≤ K) :
  H.relindex K * K.index = H.index :=
((mul_comm _ _).trans (cardinal.to_nat_mul _ _).symm).trans
  (congr_arg cardinal.to_nat (equiv.cardinal_eq (quotient_equiv_prod_of_le h))).symm

@[to_additive] lemma index_dvd_of_le (h : H ≤ K) : K.index ∣ H.index :=
dvd_of_mul_left_eq (H.relindex K) (relindex_mul_index h)

@[to_additive] lemma relindex_dvd_index_of_le (h : H ≤ K) : H.relindex K ∣ H.index :=
dvd_of_mul_right_eq K.index (relindex_mul_index h)

@[to_additive] lemma relindex_subgroup_of (hKL : K ≤ L) :
  (H.subgroup_of L).relindex (K.subgroup_of L) = H.relindex K :=
((index_comap (H.subgroup_of L) (inclusion hKL)).trans (congr_arg _ (inclusion_range hKL))).symm

variables (H K L)

@[to_additive relindex_mul_relindex] lemma relindex_mul_relindex (hHK : H ≤ K) (hKL : K ≤ L) :
  H.relindex K * K.relindex L = H.relindex L :=
begin
  rw [←relindex_subgroup_of hKL],
  exact relindex_mul_index (λ x hx, hHK hx),
end

@[to_additive] lemma inf_relindex_right : (H ⊓ K).relindex K = H.relindex K :=
begin
  rw [←subgroup_of_map_subtype, relindex, relindex, subgroup_of, comap_map_eq_self_of_injective],
  exact subtype.coe_injective,
end

@[to_additive] lemma inf_relindex_left : (H ⊓ K).relindex H = K.relindex H :=
by rw [inf_comm, inf_relindex_right]

@[to_additive relindex_inf_mul_relindex]
lemma relindex_inf_mul_relindex : H.relindex (K ⊓ L) * K.relindex L = (H ⊓ K).relindex L :=
by rw [←inf_relindex_right H (K ⊓ L), ←inf_relindex_right K L, ←inf_relindex_right (H ⊓ K) L,
  inf_assoc, relindex_mul_relindex (H ⊓ (K ⊓ L)) (K ⊓ L) L inf_le_right inf_le_right]

@[to_additive]
lemma inf_relindex_eq_relindex_sup [K.normal] : (H ⊓ K).relindex H = K.relindex (H ⊔ K) :=
cardinal.to_nat_congr (quotient_group.quotient_inf_equiv_prod_normal_quotient H K).to_equiv

@[to_additive] lemma relindex_eq_relindex_sup [K.normal] : K.relindex H = K.relindex (H ⊔ K) :=
by rw [←inf_relindex_left, inf_relindex_eq_relindex_sup]

@[to_additive] lemma relindex_dvd_index_of_normal [H.normal] : H.relindex K ∣ H.index :=
(relindex_eq_relindex_sup K H).symm ▸ relindex_dvd_index_of_le le_sup_right

variables {H K}

@[to_additive] lemma relindex_dvd_of_le_left (hHK : H ≤ K) : K.relindex L ∣ H.relindex L :=
begin
  apply dvd_of_mul_left_eq ((H ⊓ L).relindex (K ⊓ L)),
  rw [←inf_relindex_right H L, ←inf_relindex_right K L],
  exact relindex_mul_relindex (H ⊓ L) (K ⊓ L) L (inf_le_inf_right L hHK) inf_le_right,
end

variables (H K)

@[simp, to_additive] lemma index_top : (⊤ : subgroup G).index = 1 :=
cardinal.to_nat_eq_one_iff_unique.mpr ⟨quotient_group.subsingleton_quotient_top, ⟨1⟩⟩

@[simp, to_additive] lemma index_bot : (⊥ : subgroup G).index = nat.card G :=
cardinal.to_nat_congr (quotient_group.quotient_bot.to_equiv)

@[to_additive] lemma index_bot_eq_card [fintype G] : (⊥ : subgroup G).index = fintype.card G :=
index_bot.trans nat.card_eq_fintype_card

@[simp, to_additive] lemma relindex_top_left : (⊤ : subgroup G).relindex H = 1 :=
index_top

@[simp, to_additive] lemma relindex_top_right : H.relindex ⊤ = H.index :=
by rw [←relindex_mul_index (show H ≤ ⊤, from le_top), index_top, mul_one]

@[simp, to_additive] lemma relindex_bot_left : (⊥ : subgroup G).relindex H = nat.card H :=
by rw [relindex, bot_subgroup_of, index_bot]

@[to_additive] lemma relindex_bot_left_eq_card [fintype H] :
  (⊥ : subgroup G).relindex H = fintype.card H :=
H.relindex_bot_left.trans nat.card_eq_fintype_card

@[simp, to_additive] lemma relindex_bot_right : H.relindex ⊥ = 1 :=
by rw [relindex, subgroup_of_bot_eq_top, index_top]

@[simp, to_additive] lemma relindex_self : H.relindex H = 1 :=
by rw [relindex, subgroup_of_self, index_top]

@[simp, to_additive card_mul_index]
lemma card_mul_index : nat.card H * H.index = nat.card G :=
by { rw [←relindex_bot_left, ←index_bot], exact relindex_mul_index bot_le }

@[to_additive] lemma index_map {G' : Type*} [group G'] (f : G →* G') :
  (H.map f).index = (H ⊔ f.ker).index * f.range.index :=
by rw [←comap_map_eq, index_comap, relindex_mul_index (H.map_le_range f)]

@[to_additive] lemma index_map_dvd {G' : Type*} [group G'] {f : G →* G'}
  (hf : function.surjective f) : (H.map f).index ∣ H.index :=
begin
  rw [index_map, f.range_top_of_surjective hf, index_top, mul_one],
  exact index_dvd_of_le le_sup_left,
end

@[to_additive] lemma dvd_index_map {G' : Type*} [group G'] {f : G →* G'}
  (hf : f.ker ≤ H) : H.index ∣ (H.map f).index :=
begin
  rw [index_map, sup_of_le_left hf],
  apply dvd_mul_right,
end

@[to_additive] lemma index_map_eq {G' : Type*} [group G'] {f : G →* G'}
  (hf1 : function.surjective f) (hf2 : f.ker ≤ H) : (H.map f).index = H.index :=
nat.dvd_antisymm (H.index_map_dvd hf1) (H.dvd_index_map hf2)

@[to_additive] lemma index_eq_card [fintype (G ⧸ H)] :
  H.index = fintype.card (G ⧸ H) :=
nat.card_eq_fintype_card

@[to_additive index_mul_card] lemma index_mul_card [fintype G] [hH : fintype H] :
  H.index * fintype.card H = fintype.card G :=
by rw [←relindex_bot_left_eq_card, ←index_bot_eq_card, mul_comm]; exact relindex_mul_index bot_le

@[to_additive] lemma index_dvd_card [fintype G] : H.index ∣ fintype.card G :=
begin
  classical,
  exact ⟨fintype.card H, H.index_mul_card.symm⟩,
end

variables {H K L}

@[to_additive]
lemma relindex_eq_zero_of_le_left (hHK : H ≤ K) (hKL : K.relindex L = 0) : H.relindex L = 0 :=
eq_zero_of_zero_dvd (hKL ▸ (relindex_dvd_of_le_left L hHK))

@[to_additive]
lemma relindex_eq_zero_of_le_right (hKL : K ≤ L) (hHK : H.relindex K = 0) : H.relindex L = 0 :=
cardinal.to_nat_apply_of_aleph_0_le (le_trans (le_of_not_lt (λ h, cardinal.mk_ne_zero _
  ((cardinal.cast_to_nat_of_lt_aleph_0 h).symm.trans (cardinal.nat_cast_inj.mpr hHK))))
    (quotient_subgroup_of_embedding_of_le H hKL).cardinal_le)

@[to_additive] lemma relindex_le_of_le_left (hHK : H ≤ K) (hHL : H.relindex L ≠ 0) :
  K.relindex L ≤ H.relindex L :=
nat.le_of_dvd (nat.pos_of_ne_zero hHL) (relindex_dvd_of_le_left L hHK)

@[to_additive] lemma relindex_le_of_le_right (hKL : K ≤ L) (hHL : H.relindex L ≠ 0) :
  H.relindex K ≤ H.relindex L :=
cardinal.to_nat_le_of_le_of_lt_aleph_0 (lt_of_not_ge (mt cardinal.to_nat_apply_of_aleph_0_le hHL))
  (cardinal.mk_le_of_injective (quotient_subgroup_of_embedding_of_le H hKL).2)

@[to_additive] lemma relindex_ne_zero_trans (hHK : H.relindex K ≠ 0) (hKL : K.relindex L ≠ 0) :
  H.relindex L ≠ 0 :=
λ h, mul_ne_zero (mt (relindex_eq_zero_of_le_right (show K ⊓ L ≤ K, from inf_le_left)) hHK) hKL
  ((relindex_inf_mul_relindex H K L).trans (relindex_eq_zero_of_le_left inf_le_left h))

@[to_additive] lemma relindex_inf_ne_zero (hH : H.relindex L ≠ 0) (hK : K.relindex L ≠ 0) :
  (H ⊓ K).relindex L ≠ 0 :=
begin
  replace hH : H.relindex (K ⊓ L) ≠ 0 := mt (relindex_eq_zero_of_le_right inf_le_right) hH,
  rw ← inf_relindex_right at hH hK ⊢,
  rw inf_assoc,
  exact relindex_ne_zero_trans hH hK,
end

@[to_additive] lemma index_inf_ne_zero (hH : H.index ≠ 0) (hK : K.index ≠ 0) : (H ⊓ K).index ≠ 0 :=
begin
  rw ← relindex_top_right at hH hK ⊢,
  exact relindex_inf_ne_zero hH hK,
end

@[to_additive] lemma relindex_inf_le : (H ⊓ K).relindex L ≤ H.relindex L * K.relindex L :=
begin
  by_cases h : H.relindex L = 0,
  { exact (le_of_eq (relindex_eq_zero_of_le_left (by exact inf_le_left) h)).trans (zero_le _) },
  rw [←inf_relindex_right, inf_assoc, ←relindex_mul_relindex _ _ L inf_le_right inf_le_right,
      inf_relindex_right, inf_relindex_right],
  exact mul_le_mul_right' (relindex_le_of_le_right inf_le_right h) (K.relindex L),
end

@[to_additive] lemma index_inf_le : (H ⊓ K).index ≤ H.index * K.index :=
by simp_rw [←relindex_top_right, relindex_inf_le]

@[simp, to_additive index_eq_one] lemma index_eq_one : H.index = 1 ↔ H = ⊤ :=
⟨λ h, quotient_group.subgroup_eq_top_of_subsingleton H (cardinal.to_nat_eq_one_iff_unique.mp h).1,
  λ h, (congr_arg index h).trans index_top⟩

@[to_additive] lemma index_ne_zero_of_fintype [hH : fintype (G ⧸ H)] : H.index ≠ 0 :=
by { rw index_eq_card, exact fintype.card_ne_zero }

/-- Finite index implies finite quotient. -/
@[to_additive "Finite index implies finite quotient."]
noncomputable def fintype_of_index_ne_zero (hH : H.index ≠ 0) : fintype (G ⧸ H) :=
(cardinal.lt_aleph_0_iff_fintype.mp (lt_of_not_ge (mt cardinal.to_nat_apply_of_aleph_0_le hH))).some

@[to_additive one_lt_index_of_ne_top]
lemma one_lt_index_of_ne_top [fintype (G ⧸ H)] (hH : H ≠ ⊤) : 1 < H.index :=
nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨index_ne_zero_of_fintype, mt index_eq_one.mp hH⟩

end subgroup


/-

One of the reference works for proving theorems about programming languages is
Phil Wadler's Programming Language Foundations in Agda.

Inference rules are frequently used in the programming languages community to express
several aspects of programming like type checking and semantics, among others.

By defining our rules as axioms, we are building a logical framework on top of
which we will prove theorems.

-/

/-

This micro-language receives strings from the user, has an escape operator
and a consume function, that should receive only escaped values. Think of this
language as a safe alternative to my_sql_escape in PHP that prevents SQL
injection.
 -/
inductive Expr : Type
| from_user : string → Expr
| escape : Expr → Expr
| consume : Expr → Expr
| concat : Expr → Expr → Expr

open Expr

/- This axiom will allow us to express whether a given expression is safe or not. -/
axiom is_safe : Expr → Prop

/-

Below are our inference rules that define our "type system".
Notice how we are abusing lean's comments to fake the horizontal line.

 -/

axiom from_user_unsafe {s}:

------------------------
¬ is_safe (from_user s)

axiom escape_makes_it_safe {e}:

-------------------------
is_safe (escape e)

axiom consume_requires_safe {e}:
is_safe e ↔
---------------------------
is_safe (consume e)

axiom concat_requires_both_safe {e1 e2}:
is_safe e1 ∧ is_safe e2 ↔
---------------------------
is_safe (concat e1 e2)

/-

Let us prove that a simple program is valid.

Apply works by applying a function from the goal towards the context. In Haskell it is similar to:

bToC :: b -> c

f :: a -> b -> c
f x = bToC

In lean, we would write "apply bToC" to bring the goal of writing f from c to b. The last step of
the proof is done, we just have to get to point b.

-/

example :
    is_safe (consume (concat (escape (from_user "a")) (escape (from_user "b")))) :=
begin
    apply consume_requires_safe.mp,
    apply concat_requires_both_safe.mp,
    {
        split,
        {
            apply escape_makes_it_safe,
        }, {
            apply escape_makes_it_safe,
        }
    }
end

def has_any_escape : Expr → Prop
| (from_user s) := false
| (escape e) := true
| (consume e) := has_any_escape e
| (concat e1 e2) := has_any_escape e1 ∨ has_any_escape e2

/-

The is_safe was written in the second language.
has_any_escape was written in the first language, but could as well be written in the second.

Here is the proof that any program that is safe, has at least one escape.

-/

theorem if_is_safe_has_some_escape {e} :
    is_safe e → has_any_escape e :=
begin
    intro ise,
    induction e,
    {
        -- from_user
        have useful_proof := from_user_unsafe ise,
        rw has_any_escape,
        exact useful_proof,
    },
    {
        -- escape
        rw has_any_escape,
        cc,
    },
    {
        -- consume
        rw has_any_escape,
        apply e_ih,
        apply consume_requires_safe.mpr ise,
    },
    {
        -- concat
        rw has_any_escape,
        left,
        apply e_ih_a,
        have helper := concat_requires_both_safe.mpr ise,
        have helper_ex := helper.left,
        exact helper_ex,
    }
end


constants p q : Prop

theorem t1 : p → q → p := λ hp : p, λ hq : q, hp

#print t1

theorem t1' :  p → q → p :=
assume hp : p,
assume hq : q,
show p, from hp

theorem t1'' (hp : p) (hq : q) : p := hp

axiom hp : p
theorem t2 :  q → p := t1 hp

theorem t1''' : ∀ (p q : Prop), p → q → p :=
  λ (p q : Prop) (hp : p) (hq : q), hp

variables p q r s : Prop

theorem t2' (h₁ : q → r) (h₂ : p → q) : p → r :=
  assume h₃ : p,
  show r, from h₁ (h₂ h₃)

example (hp : p) (hq : q) : p ∧ q := and.intro hp hq
#check assume (hp : p) (hq : q), and.intro hp hq

variables (hp : p) (hq : q)
#check (⟨hp, hq⟩ : p ∧ q)

variable l : list ℕ
#check list.head l
#check l.head

example (h : p ∧ q) : q ∧ p := ⟨h.right, h.left⟩

example (h : p ∨ q) : q ∨ p :=
or.elim h
  (assume hp : p, show q ∨ p, from or.intro_right q hp)
  (assume hq : q, show q ∨ p, from or.intro_left p hq)

example (h : p ∨ q) : q ∨ p :=
h.elim (assume hp : p, or.inr hp) (assume hq : q, or.inl hq)

example : (p → q) → ¬q → ¬p :=
assume hpq : p → q,
assume hnq : ¬q,
assume hp : p,
show false, from hnq (hpq hp)

/- false.elim -- absurd -/
/- true.elim -- trivial -/

example (hp : p) (hnp : ¬p) : q := absurd hp hnp

theorem and_swap : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume h : p ∧ q,
    show q ∧ p, from and.intro (and.right h) (and.left h))
  (λ h, ⟨h.right, h.left⟩)

example (h : p ∧ q) : q ∧ p :=
have hp : p, from and.left h,
have hq : q, from and.right h,
show q ∧ p, from and.intro hq hp

example (h : p ∧ q) : q ∧ p :=
have hp : p, from and.left h,
suffices hq : q, from and.intro hq hp,
show q, from and.right h

section excluded_middle
open classical

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

#check em

example (h : ¬¬p) : p :=
by_cases
  (assume h1 : p, h1)
  (assume h1 : ¬p, absurd h1 h)

example (h : ¬¬p) : p :=
by_contradiction
  (assume h1 : ¬p,
    show false, from h h1)

example (h : ¬¬p) : p :=
by_contradiction (λ h1, h h1)
end excluded_middle

-- theorem em' {p : Prop} : (¬¬p → p) → p ∨ ¬p :=
-- assume dne : ¬¬p → p,
-- assume hnnp : ¬¬p,
-- show p ∨ ¬p, from or.inl (dne hnnp)

example : p ∧ q ↔ q ∧ p :=
iff.intro
(λ hpq, ⟨hpq.right, hpq.left⟩)
(λ hqp, ⟨hqp.right, hqp.left⟩)

open classical

example : (¬q → ¬p) → (p → q) :=
assume h : ¬q → ¬p,
assume hp : p,
-- show q, from
--   by_contradiction
--     (assume hnq: ¬q,
--       show false, from absurd hp (h hnq))
by_contradiction (λ hnq, absurd hp (h hnq))


variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
⟨λ h => ⟨h.right, h.left⟩, λ h => ⟨h.right, h.left⟩⟩
example : p ∨ q ↔ q ∨ p :=
⟨λ h => h.elim Or.inr Or.inl, λ h => h.elim Or.inr Or.inl⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
⟨λ h => ⟨h.left.left, ⟨h.left.right, h.right⟩⟩,
λ h => ⟨⟨h.left, h.right.left⟩, h.right.right⟩⟩
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
⟨λ h => h.elim (λ g => g.elim Or.inl (Or.inr ∘ Or.inl)) (Or.inr ∘ Or.inr),
λ h => h.elim (Or.inl ∘ Or.inl) (λ g => g.elim (Or.inl ∘ Or.inr) Or.inr)⟩

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
⟨λ h => h.right.elim (Or.inl ∘ (λ hq => ⟨h.left, hq⟩)) (Or.inr ∘ (λ hr => ⟨h.left, hr⟩)),
λ h => h.elim (λ hpq => ⟨hpq.left, Or.inl hpq.right⟩) (λ hpr => ⟨hpr.left, Or.inr hpr.right⟩)⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
⟨λ l => l.elim (λ hp => ⟨Or.inl hp, Or.inl hp⟩) (λ hqr => ⟨Or.inr hqr.left, Or.inr hqr.right⟩),
λ r => r.left.elim Or.inl (λ hq => r.right.elim Or.inl (λ hr => Or.inr ⟨hq, hr⟩))⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
⟨λ p_q_r => (λ hpq => p_q_r hpq.left hpq.right),
λ paq_r => (λ hp => (λ hq => paq_r ⟨hp, hq⟩))⟩

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
⟨λ poq_r => ⟨poq_r ∘ Or.inl, poq_r ∘ Or.inr⟩,
λ pr_qr => (λ hpq => hpq.elim pr_qr.left pr_qr.right)⟩

-- note: ¬p is equivalent to p → False
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
⟨λ npq => ⟨λ hp => npq (Or.inl hp), λ hq => npq (Or.inr hq)⟩,
λ npnq => (λ hpq => hpq.elim npnq.left npnq.right)⟩

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
λ npnq => npnq.elim (λ hnp => (λ hpq => hnp hpq.left)) (λ hnq => (λ hpq => hnq hpq.right))

example : ¬(p ∧ ¬p) :=
λ pnp => pnp.right pnp.left

example : p ∧ ¬q → ¬(p → q) :=
λ pnq => (λ hpq => pnq.right (hpq pnq.left))

-- ex falso
example : ¬p → (p → q) :=
λ hnp => λ hp => False.elim (hnp hp)

example : (¬p ∨ q) → (p → q) :=
λ npq => λ hp => npq.elim (λ np => False.elim (np hp)) id

example : p ∨ False ↔ p :=
⟨λ hpf => hpf.elim id False.elim, Or.inl⟩

example : p ∧ False ↔ False :=
⟨And.right, False.elim⟩

example : (p → q) → (¬q → ¬p) :=
λ hpq => λ hnq => λ hp => hnq (hpq hp)

section classical
    open Classical
    variable (p q r : Prop)

    example : (p → q ∨ r) → ((p → q) ∨ (p → r)) :=
    λ p_qr => byCases
        (λ (hq : q) => Or.inl (λ _ => hq))
        (λ (hnq : ¬q) => byCases
        (λ (hr : r) => Or.inr (λ _ => hr))
        (λ (hnr : ¬r) => (Or.inl (λ p => (p_qr p).elim (False.elim ∘ hnq) (False.elim ∘ hnr)))))

    example : ¬(p ∧ q) → ¬p ∨ ¬q :=
    λ hnpq => byCases
        (λ (hp : p) => byCases
        (λ (hq : q) => False.elim (hnpq ⟨hp, hq⟩))
        (λ (hnq : ¬q) => Or.inr hnq))
        (λ (hnp : ¬p) => Or.inl hnp)

    example : ¬(p → q) → p ∧ ¬q :=
    λ npq => byCases
        (λ (hq : q) => False.elim (npq (λ _ => hq)))
        (λ (hnq : ¬q) => byCases
        (λ (hp : p) => ⟨hp, hnq⟩)
        (λ (hnp : ¬p) => False.elim (npq (λ hp => absurd hp hnp))))

    example : (p → q) → (¬p ∨ q) :=
    λ hpq => byCases
        (λ (hq : q) => Or.inr hq)
        (λ (hnq : ¬q) => byCases
        (λ (hp : p) => False.elim (hnq (hpq hp)))
        (λ (hnp : ¬p) => Or.inl hnp))

    example : (¬q → ¬p) → (p → q) :=
    λ hnqnp => byCases
        (λ (hq : q) => λ _ => hq)
        (λ (hnq : ¬q) => byCases
        (λ (hp : p) => False.elim ((hnqnp hnq) hp))
        (λ (hnp : ¬p) => λ hp => absurd hp hnp))

    example : p ∨ ¬p := byCases
    (λ (hp : p) => Or.inl hp)
    (λ (hnp : ¬p) => Or.inr hnp)

    example : (((p → q) → p) → p) := byCases
    (λ (hp : p) => λ _ => hp)
    (λ (hnp : ¬p) => λ hpqp => hpqp (λ hp => absurd hp hnp))
end classical

example: ¬(p ↔ ¬p) :=
λ h =>
    have hnp : ¬p := λ hp => (h.mp hp) hp;
    have hnnp : ¬¬p := λ hnp => hnp (h.mpr hnp);
    hnnp hnp


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/

import number_theory.cyclotomic.primitive_roots
import field_theory.polynomial_galois_group

/-!
# Galois group of cyclotomic extensions

In this file, we show the relationship between the Galois group of `K(ζₙ)` and `(zmod n)ˣ`;
it is always a subgroup, and if the `n`th cyclotomic polynomial is irreducible, they are isomorphic.

## Main results

* `is_primitive_root.aut_to_pow_injective`: `is_primitive_root.aut_to_pow` is injective
  in the case that it's considered over a cyclotomic field extension.
* `is_cyclotomic_extension.aut_equiv_pow`: If the `n`th cyclotomic polynomial is irreducible
  in `K`, then `aut_to_pow` is a `mul_equiv` (for example, in `ℚ` and certain `𝔽ₚ`).
* `gal_X_pow_equiv_units_zmod`, `gal_cyclotomic_equiv_units_zmod`: Repackage `aut_equiv_pow` in
  terms of `polynomial.gal`.
* `is_cyclotomic_extension.aut.comm_group`: Cyclotomic extensions are abelian.

## References

* https://kconrad.math.uconn.edu/blurbs/galoistheory/cyclotomic.pdf

## TODO

* We currently can get away with the fact that the power of a primitive root is a primitive root,
  but the correct long-term solution for computing other explicit Galois groups is creating
  `power_basis.map_conjugate`; but figuring out the exact correct assumptions + proof for this is
  mathematically nontrivial. (Current thoughts: the correct condition is that the annihilating
  ideal of both elements is equal. This may not hold in an ID, and definitely holds in an ICD.)

-/

local attribute [instance] pnat.fact_pos

variables {n : ℕ+} (K : Type*) [field K] {L : Type*} [field L] {μ : L} (hμ : is_primitive_root μ n)
          [algebra K L] [is_cyclotomic_extension {n} K L]

open polynomial is_cyclotomic_extension

open_locale cyclotomic

namespace is_primitive_root

/-- `is_primitive_root.aut_to_pow` is injective in the case that it's considered over a cyclotomic
field extension. -/
lemma aut_to_pow_injective : function.injective $ hμ.aut_to_pow K :=
begin
  intros f g hfg,
  apply_fun units.val at hfg,
  simp only [is_primitive_root.coe_aut_to_pow_apply, units.val_eq_coe] at hfg,
  generalize_proofs hf' hg' at hfg,
  have hf := hf'.some_spec,
  have hg := hg'.some_spec,
  generalize_proofs hζ at hf hg,
  suffices : f hμ.to_roots_of_unity = g hμ.to_roots_of_unity,
  { apply alg_equiv.coe_alg_hom_injective,
    apply (hμ.power_basis K).alg_hom_ext,
    exact this },
  rw zmod.eq_iff_modeq_nat at hfg,
  refine (hf.trans _).trans hg.symm,
  rw [←roots_of_unity.coe_pow _ hf'.some, ←roots_of_unity.coe_pow _ hg'.some],
  congr' 1,
  rw [pow_eq_pow_iff_modeq],
  convert hfg,
  rw [hμ.eq_order_of],
  rw [←hμ.coe_to_roots_of_unity_coe] {occs := occurrences.pos [2]},
  rw [order_of_units, order_of_subgroup]
end

end is_primitive_root

namespace is_cyclotomic_extension

/-- Cyclotomic extensions are abelian. -/
noncomputable def aut.comm_group : comm_group (L ≃ₐ[K] L) :=
((zeta_spec n K L).aut_to_pow_injective K).comm_group _
  (map_one _) (map_mul _) (map_inv _) (map_div _) (map_pow _) (map_zpow _)

variables (h : irreducible (cyclotomic n K)) {K} (L)

include h

/-- The `mul_equiv` that takes an automorphism `f` to the element `k : (zmod n)ˣ` such that
  `f μ = μ ^ k`. A stronger version of `is_primitive_root.aut_to_pow`. -/
@[simps] noncomputable def aut_equiv_pow : (L ≃ₐ[K] L) ≃* (zmod n)ˣ :=
let hζ := zeta_spec n K L,
    hμ := λ t, hζ.pow_of_coprime _ (zmod.val_coe_unit_coprime t) in
{ inv_fun := λ t, (hζ.power_basis K).equiv_of_minpoly ((hμ t).power_basis K)
  begin
    haveI := is_cyclotomic_extension.ne_zero' n K L,
    simp only [is_primitive_root.power_basis_gen],
    have hr := is_primitive_root.minpoly_eq_cyclotomic_of_irreducible
               ((zeta_spec n K L).pow_of_coprime _ (zmod.val_coe_unit_coprime t)) h,
    exact ((zeta_spec n K L).minpoly_eq_cyclotomic_of_irreducible h).symm.trans hr
  end,
  left_inv := λ f, begin
    simp only [monoid_hom.to_fun_eq_coe],
    apply alg_equiv.coe_alg_hom_injective,
    apply (hζ.power_basis K).alg_hom_ext,
    simp only [alg_equiv.coe_alg_hom, alg_equiv.map_pow],
    rw power_basis.equiv_of_minpoly_gen,
    simp only [is_primitive_root.power_basis_gen, is_primitive_root.aut_to_pow_spec],
  end,
  right_inv := λ x, begin
    simp only [monoid_hom.to_fun_eq_coe],
    generalize_proofs _ _ _ h,
    have key := hζ.aut_to_pow_spec K ((hζ.power_basis K).equiv_of_minpoly
                                      ((hμ x).power_basis K) h),
    have := (hζ.power_basis K).equiv_of_minpoly_gen ((hμ x).power_basis K) h,
    rw hζ.power_basis_gen K at this,
    rw [this, is_primitive_root.power_basis_gen] at key,
    rw ← hζ.coe_to_roots_of_unity_coe at key {occs := occurrences.pos [1, 5]},
    simp only [←coe_coe, ←roots_of_unity.coe_pow] at key,
    replace key := roots_of_unity.coe_injective key,
    rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hζ.coe_to_roots_of_unity_coe,
        ←(zeta_spec n K L).eq_order_of, ←zmod.eq_iff_modeq_nat] at key,
    simp only [zmod.nat_cast_val, zmod.cast_id', id.def] at key,
    exact units.ext key
  end,
  .. (zeta_spec n K L).aut_to_pow K }

include hμ

variables {L}

/-- Maps `μ` to the `alg_equiv` that sends `is_cyclotomic_extension.zeta` to `μ`. -/
noncomputable def from_zeta_aut : L ≃ₐ[K] L :=
let hζ := (zeta_spec n K L).eq_pow_of_pow_eq_one hμ.pow_eq_one n.pos in
(aut_equiv_pow L h).symm $ zmod.unit_of_coprime hζ.some $
((zeta_spec n K L).pow_iff_coprime n.pos hζ.some).mp $ hζ.some_spec.some_spec.symm ▸ hμ

lemma from_zeta_aut_spec : from_zeta_aut hμ h (zeta n K L) = μ :=
begin
  simp_rw [from_zeta_aut, aut_equiv_pow_symm_apply],
  generalize_proofs _ _ hζ h _ hμ _,
  rw [←hζ.power_basis_gen K] {occs := occurrences.pos [4]},
  rw [power_basis.equiv_of_minpoly_gen, hμ.power_basis_gen K],
  convert h.some_spec.some_spec,
  exact zmod.val_cast_of_lt h.some_spec.some
end

end is_cyclotomic_extension

section gal

variables (h : irreducible (cyclotomic n K)) {K}

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`. Asserts that the
Galois group of `cyclotomic n K` is equivalent to `(zmod n)ˣ` if `cyclotomic n K` is irreducible in
the base field. -/
noncomputable def gal_cyclotomic_equiv_units_zmod :
  (cyclotomic n K).gal ≃* (zmod n)ˣ :=
(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
(is_cyclotomic_extension.aut_equiv_pow L h)

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`. Asserts that the
Galois group of `X ^ n - 1` is equivalent to `(zmod n)ˣ` if `cyclotomic n K` is irreducible in the
base field. -/
noncomputable def gal_X_pow_equiv_units_zmod :
  (X ^ (n : ℕ) - 1).gal ≃* (zmod n)ˣ :=
(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
(is_cyclotomic_extension.aut_equiv_pow L h)

end gal


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.nat.psub
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Option.Basic
import Mathlib.Data.Nat.Basic

/-!
# Partial predecessor and partial subtraction on the natural numbers

The usual definition of natural number subtraction (`Nat.sub`) returns 0 as a "garbage value" for
`a - b` when `a < b`. Similarly, `Nat.pred 0` is defined to be `0`. The functions in this file
wrap the result in an `Option` type instead:

## Main definitions

- `Nat.ppred`: a partial predecessor operation
- `Nat.psub`: a partial subtraction operation

-/

namespace Nat

/-- Partial predecessor operation. Returns `ppred n = some m`
  if `n = m + 1`, otherwise `none`. -/
def ppred : ℕ → Option ℕ
  | 0 => none
  | n + 1 => some n
#align nat.ppred Nat.ppred

@[simp]
theorem ppred_zero : ppred 0 = none := rfl

@[simp]
theorem ppred_succ : ppred (succ n) = some n := rfl

/-- Partial subtraction operation. Returns `psub m n = some k`
  if `m = n + k`, otherwise `none`. -/
def psub (m : ℕ) : ℕ → Option ℕ
  | 0 => some m
  | n + 1 => psub m n >>= ppred
#align nat.psub Nat.psub

@[simp]
theorem psub_zero : psub m 0 = some m := rfl

@[simp]
theorem psub_succ : psub m (succ n) = psub m n >>= ppred := rfl

theorem pred_eq_ppred (n : ℕ) : pred n = (ppred n).getD 0 := by cases n <;> rfl
#align nat.pred_eq_ppred Nat.pred_eq_ppred

theorem sub_eq_psub (m : ℕ) : ∀ n, m - n = (psub m n).getD 0
  | 0 => rfl
  | n + 1 => (pred_eq_ppred (m - n)).trans <| by rw [sub_eq_psub m n, psub]; cases psub m n <;> rfl
#align nat.sub_eq_psub Nat.sub_eq_psub

@[simp]
theorem ppred_eq_some {m : ℕ} : ∀ {n}, ppred n = some m ↔ succ m = n
  | 0 => by constructor <;> intro h <;> contradiction
  | n + 1 => by constructor <;> intro h <;> injection h <;> subst m <;> rfl
#align nat.ppred_eq_some Nat.ppred_eq_some

-- Porting note: `contradiction` required an `intro` for the goals
-- `ppred (n + 1) = none → n + 1 = 0` and `n + 1 = 0 → ppred (n + 1) = none`

@[simp]
theorem ppred_eq_none : ∀ {n : ℕ}, ppred n = none ↔ n = 0
  | 0 => by simp
  | n + 1 => by constructor <;> intro <;> contradiction
#align nat.ppred_eq_none Nat.ppred_eq_none

theorem psub_eq_some {m : ℕ} : ∀ {n k}, psub m n = some k ↔ k + n = m
  | 0, k => by simp [eq_comm]
  | n + 1, k => by
    apply Option.bind_eq_some.trans
    simp only [psub_eq_some, ppred_eq_some]
    simp [add_comm, add_left_comm, Nat.succ_eq_add_one]
#align nat.psub_eq_some Nat.psub_eq_some

theorem psub_eq_none {m n : ℕ} : psub m n = none ↔ m < n := by
  cases s : psub m n <;> simp [eq_comm]
  · show m < n
    refine' lt_of_not_ge fun h => _
    cases' le.dest h with k e
    injection s.symm.trans (psub_eq_some.2 <| (add_comm _ _).trans e)
  · show n ≤ m
    rw [← psub_eq_some.1 s]
    apply Nat.le_add_left
#align nat.psub_eq_none Nat.psub_eq_none

theorem ppred_eq_pred {n} (h : 0 < n) : ppred n = some (pred n) :=
  ppred_eq_some.2 <| succ_pred_eq_of_pos h
#align nat.ppred_eq_pred Nat.ppred_eq_pred

theorem psub_eq_sub {m n} (h : n ≤ m) : psub m n = some (m - n) :=
  psub_eq_some.2 <| Nat.sub_add_cancel h
#align nat.psub_eq_sub Nat.psub_eq_sub

-- Porting note: we only have the simp lemma `Option.bind_some` which uses `Option.bind` not `>>=`
theorem psub_add (m n k) :
    psub m (n + k) = (do psub (← psub m n) k) := by
    induction k
    simp [Option.bind_eq_bind, Option.bind_some]
    simp [*, Nat.add_succ]

#align nat.psub_add Nat.psub_add

/-- Same as `psub`, but with a more efficient implementation. -/
@[inline]
def psub' (m n : ℕ) : Option ℕ :=
  if n ≤ m then some (m - n) else none
#align nat.psub' Nat.psub'

theorem psub'_eq_psub (m n) : psub' m n = psub m n := by
  rw [psub']
  split_ifs with h
  exact (psub_eq_sub h).symm
  exact (psub_eq_none.2 (not_le.1 h)).symm
#align nat.psub'_eq_psub Nat.psub'_eq_psub

end Nat


-- Next time: let's see how the graph theory theorem about the sum of degrees being even is coded in lean.

import combinatorics.simple_graph.connectivity

open_locale classical

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

#print simple_graph.walk -- prints the definition
#check nonempty -- prints the type of the object

-- simple_graph.walk u v  is the type of all walks from u to v

-- prove that if u is adjacent to v then the set of walks from u to v is non-empty

def simple_graph.walks_of_len (G : simple_graph V) (u v : V) (n : ℕ) :=
  { x : G.walk u v // x.length = n }

theorem adjacent_to_walk {u v : V} (h : G.adj u v) : nonempty (G.walks_of_len u v 1) :=
begin
  apply nonempty.intro,
  split,
  swap,
  { have p := @simple_graph.walk.nil _ _ v,
    exact simple_graph.walk.cons h p },
  simp only [simple_graph.walk.length_nil, simple_graph.walk.length_cons],
end

-- lemma len_of_cons_ge_one {}

theorem eq_of_len_zero {u v : V} (w : G.walks_of_len u v 0) : u = v :=
begin
  cases w with w h,
  induction w,
  { refl },
  { exfalso,
    simp only [nat.succ_ne_zero, simple_graph.walk.length_cons] at *,
    exact h, }
end

theorem exists_walk_of_len {u v : V} (n : ℕ) (w : G.walk u v) (h : w.length = n + 1) :
  ∃ (v' : V) (w' : G.walk u v'), (w'.length = n) ∧ (G.adj v' v) :=
begin
  sorry,
end

theorem non_eq_of_len_one {u v : V} (w : G.walk u v) (h : w.length = 1) : G.adj u v :=
begin

end

theorem non_eq_of_len_one {u v : V} (w : G.walks_of_len u v 1) : u ≠ v :=
begin
  cases w with w h,
  sorry,
  -- induction w,
  -- {intro h,
  -- contradiction,},
  -- simp,
  -- contradiction,

end

theorem adj_of_len_one {u v : V} (w : G.walks_of_len u v 1) : G.adj u v :=
begin
  cases w with w h,
  sorry,
end


import tactic.core
import data.nat.basic
namespace nat
/-
In Lean the natural numbers `ℕ` are defined as follows:

inductive nat
| zero : nat
| succ (n : nat) : nat

This means that there are two ways to construct a natural number `n:ℕ`
Either `n` is `zero` or it is the successor of a previously constructed
natural number `succ n`. -/

--#check zero
--#reduce succ 3
--#check succ (succ zero)
--#check zero.succ
end nat

/-
Addition is defined inductively in Lean:

def add : ℕ → ℕ → ℕ
| a  zero     := a                    --  a + 0 := a
| a  (succ b) := succ (add a b)       --  a + (b + 1) := (a + b) + 1

-/

-- We will use the `dot` notation for the successor function.
/--  n + 1 = n.succ -/
lemma Succ_eq_add_one (n : ℕ) :  n.succ = n + 1  :=
begin
  sorry,
end

/-
We are now proving lemmas/theorems that already exist in `mathlib`.

To avoid clashes we will use the same names as `mathlib` but they will be Capitalised.

We won't use high level tactics such as `norm_num` or `linarith` but we will
need to use earlier results as we progress (mainly with `rw` and `apply` tactics).

For a much more complete tour of the natural numbers check out the Natural Numbers Game:

https://www.ma.imperial.ac.uk/~buzzard/xena/natural_number_game/

-/

lemma Add_zero (n : ℕ) : n + 0 = n :=
begin
  sorry,
end

/-- a + (b + 1) = (a + b) + 1 -/
lemma Add_succ (a b : ℕ) : a + b.succ = (a + b).succ:=
begin
  sorry,
end

/-
# New tactic for ℕ: induction

If we want to prove `∀ (n:ℕ), P n` then we can use
`induction n` which requires us to prove two things:
`P 0` and `P n →  P n.succ`

# New tactic for structured proofs: have

Sometimes we want to prove intermediate results within a proof.

We can do this using the `have` tactic.

If we need to prove `h : P` (ie a proof that the proposition P is true)
then we can do this as follows:

.... middle of a proof
have h : P,
{
  proof of P,
},
.... continue proof

We now have `h : P` in the local context.

# Variant of rw : rwa

If we have term in the local context `h1 : P` and after `rw h2` our goal becomes `⊢ P`
then `rwa h2` will do the `rw h2, exact h1` in one step.

(The `a` in `rwa` stands for `assumption` which is yet another tactic that will work whenever
our goal is closed by a term in the local context.) -/

lemma Zero_add (n : ℕ) : 0 + n = n :=
begin
  induction n with n hn,
  {
    -- prove 0 + 0 = 0

    sorry,
  },
  { -- ⊢ 0 + n.succ = n.succ  and we have `hn : 0 + n = n` our inductive hypothesis
    -- a useful intermediate step is to prove `0 + n.succ = (0 + n).succ`
    have h : 0 + n.succ = (0 + n).succ,
    {

      sorry,
    },

    sorry,
  },
end

lemma Succ_add (a b : ℕ) : a.succ + b = (a + b).succ:=
begin
  induction b with b hb,
  {
    sorry
  },
  {
    sorry
  },
end

/- Digression: how do we know that 0 ≠ 1?
This is one of the axioms of the natural numbers (Peano arithmetic)
and it is built into Lean's model of ℕ.  -/

theorem Succ_ne_zero (n : ℕ) : n.succ ≠ 0 :=
begin
  intro h,
  --exact nat.no_confusion h,
  contradiction,
end

-- Lean also knows that the successor function is injective (by definition)
theorem Succ.inj (n m : ℕ) : n.succ = m.succ → n = m :=
begin
  exact nat.succ.inj,
end

/- Our next result says that `+` is `associative`

In Lean `a + b + c` is defined as `(a + b) + c` so whenever you see an expression such as `a + b + c + d`
you need to remember how this is read by Lean: `((a + b) + c) + d`

We know that the brackets aren't required, but in Lean you need to prove this.
-/
--#check 1 + (2 + 4) -- brackets
--#check (1 + 2) + 4 -- no brackets

lemma Add_assoc (a b c : ℕ) : (a + b) + c = a + (b + c):=
begin
  induction c with c hc,
  {
    sorry
  },
  {
    sorry
  },
end

lemma Add_comm (m n : ℕ) : m + n = n + m :=
begin
  sorry,
end

/-
Multiplication is also defined inductively in Lean.

def mul : ℕ → ℕ → ℕ
| a 0     := 0                      --  a * 0 := 0
| a (b + 1) := (mul a b) + a        --  a * (b + 1) = (a * b) + a  -/

lemma Mul_zero (n : ℕ) : n * 0 = 0:=
begin
  sorry,
end

lemma Mul_succ (m n : ℕ) : m * n.succ = m * n + m:=
begin
  sorry,
end

lemma Succ_mul (m n : ℕ) : m.succ * n = m * n + n:=
begin
  induction n with n hn,
  {
    sorry
  },
  {
    sorry,
  },
end

lemma Zero_mul (n : ℕ) : 0 * n = 0:=
begin
  sorry,
end

lemma Mul_one (n : ℕ) : n * 1 = n:=
begin
  sorry,
end

lemma One_mul (n : ℕ) : 1 * n = n:=
begin
  sorry,
end

lemma Mul_add (a b c: ℕ) : a*(b + c) = a*b + a*c:=
begin
  induction a with a ha,
  {
    sorry
  },
  {
    sorry
  },
end

lemma Add_mul (a b c: ℕ) : (b + c)*a = b*a +c*a:=
begin
  sorry,
end

lemma Mul_comm (a b : ℕ) : a * b = b * a :=
begin
  sorry,
end

lemma Mul_assoc (a b c : ℕ) : a * b * c = a * (b * c):=
begin
  sorry,
end

lemma Pow_zero (n : ℕ) : n ^ 0 = 1:=
begin
  sorry,
end

lemma Pow_succ (a b : ℕ) : a^b.succ= a* a^b:=
begin
  sorry,
end

lemma Pow_one (n : ℕ) : n ^ 1 = n:=
begin
  sorry,
end

/-
# New use of tactic : cases

We don't need induction to prove our next result, but we do need to consider the cases of zero and
successor separately. The `cases n` tactic does exactly this.   -/

lemma Zero_pow (n : ℕ) (h : n ≠ 0): 0 ^ n = 0:=
begin
  cases n with n hn,
  {
    sorry
  },
  {
    sorry
  },
end

lemma One_pow (n : ℕ) : 1 ^ n = 1:=
begin
  sorry,
end

lemma Pow_add (a b c: ℕ): a^(b + c)=a^b*a^c:=
begin
  induction c with c hc,
  {
    sorry
  },
  {
    sorry
  },
end

lemma Pow_mul (a b c : ℕ) : a^(b * c) = (a^b)^c :=
begin
  sorry,
end

lemma Two_eq_one_add_one : 2 = 1 + 1:=
begin
  sorry,
end

lemma Two_mul (n : ℕ) : 2*n = n + n:=
begin
  sorry,
end

lemma Three_mul (n : ℕ) : 3*n = n + n + n:=
begin
  have : 3 = 2 + 1, {
    sorry,
  },
  sorry,
end

lemma Pow_two (n : ℕ) : n^2 = n*n:=
begin
  sorry,
end

lemma Add_sq (a b : ℕ) : (a + b)^2 = a^2 + 2*a*b + b^2 :=
begin
  sorry,
end

lemma Pow_three (n : ℕ) : n^3 = n*n*n:=
begin
  have : 3 = 2 + 1, {
    sorry,
  },
  sorry,
end

lemma Add_cube (a b : ℕ) : (a + b)^3 = a^3 + 3*a^2*b + 3*a*b^2 + b^3:=
begin
  sorry, -- ring
end


/-
This cheat sheet summarizes the
crucial introduction and elimination
reasoning rules for each connective
and quantifier in predicate logic.

* true
* false
* P ∧ Q
* ∀ p : P, Q  -- predicate Q usually involves p
* P → Q (view as function type)
* P → Q (viewed as implication)
* ¬ P
* P ↔ Q
* P ∨ Q
* ∃ p : P, Q  -- predicate Q usually involves p

Introduction rules are used when
your goal is to prove a proposition
(below the line or to the right of
the turnstile) that contains a given
connective or quantifier. For example,
you would use the introduction rule
for ∧ to prove a propopsition of the
form, P ∧ Q.

Elimination rules are used to prove
something else when you are given,
as an assumption, a proof of a
proposition that uses a given
connective or quantifier.  You would
use an elimination rule for ∧, for
example to prove P when you already
have a proof of P ∧ Q.
-/

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

variables P Q : Type
#check (P → Q)

/- **** -/
/- true -/
/- **** -/

/-
The proposition, true, has
a single proof and can thus
always be judged to be true.

The introduction rule gives us
a proof without conditions.

  ---------------- (true.intro)
  true.intro: true

Having a proof of true isn't
very useful. One is always
available, and no information
can be obtained from a proof
of true. We thus don't see a
proof of true very often in
practice.
-/

/- ----------------- -/
/- true introduction -/
/- ----------------- -/

theorem trueIsTrue : true :=
    true.intro

theorem
trueIsTrue' : true :=
begin
exact (true.intro),
end

/- ----------------- -/
/- true elimination  -/
/- ----------------- -/

/-
A proof of true, true.intro, doesn't tell
you anything meaningful, so a proof of true
never really helps to prove anything else.
A proof of true is both free and worthless.
Elimination rules let you deduce something
meaningful from a proof of something else.
For example from a proof of P ∧ Q one can
obtain a proof of P (which can be useful!).
There is thus no meaningful elimination
rule for true.
-/

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/-*******-/
/- false -/
/-*******-/

/-
The proposition, false, has no
proofs, and can thus be judged
to be false.
-/

/- false introduction -/

/-
Because there is no proof of false,
there is no introduction rule for
false.
-/

/- false elimination -/

/-
On the other hand, it often happens
in real proofs that one ends up with
inconsistent assumptions. When this
happens, it shows that in reality
such a case can't occur.

When one ends up in such a situation,
a proof of false can be derived from
the contradiction, and the elimination
rule for false can then be used to
finish off the proof of the current
proof goal.

It might seem a bit like magic that
false elimination can be used to prove
anything at all, but all that it really
says is "we can safely ignore this case
because it can never really happen."

What the rule technically says is that
from an assumed proof of false (or from
a proof of false that is obtained from
a contradiction), any proposition, P,
can be proved by applying false.elim to
the proof of false.

  P : Prop, f : false
  ------------------- false.elim
        pf : P
-/

def fromFalse (P: Prop) (f: false) : P :=
    false.elim f

theorem fromFalse': ∀ P : Prop, false → P :=
λ P f,
    false.elim f

theorem  fromFalse'': ∀ P : Prop, false → P :=
begin
  assume P,
  assume f,
  show P,
  from false.elim f,
end

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/-**** -/
/- and -/
/-**** -/

/-
If P and Q are propositions, then
P ∧ Q is a proposition. It is read
as asserting that both P and Q are
true.

To prove P ∧ Q, one applies the
introduction rule for ∧ to a proof
of P and to a proof of Q.

{ P, Q : Prop } (p: P) (q: Q)
----------------------------- and.intro
       ⟨ p, q ⟩ : P ∧ Q

From a proof of P and Q one can derive
proofs of P and of Q by applying the left
and right elimination rules, respectively.

{ P Q: Prop } (pq : P ∧ Q)
--------------------------- and.elim_left
          p : P

{ P Q: Prop } (pq : P ∧ Q)
--------------------------- and.elim_right
          q : Q
-/

/- and introduction -/

def PandQ (P Q : Prop) (p: P) (q: Q) : P ∧ Q :=
    and.intro p q

#check PandQ -- P → Q → P ∧ Q

theorem PandQ' : ∀ ( P Q : Prop ), P → Q → P ∧ Q  :=
λ P Q p q,
    ⟨ p, q ⟩ -- shorthand for and.intro p q

#check PandQ'

theorem PandQ'' : ∀ { P Q : Prop }, P → Q → P ∧ Q :=
begin
  assume P Q p q,
  show P ∧ Q,
  from ⟨ p, q ⟩, -- again shorthand for and.intro p q
end

/- and elimination -/

def PfromPandQ (P Q: Prop) (pq: P ∧ Q) : P :=
    and.elim_left pq

def QfromPandQ (P Q: Prop) (pq: P ∧ Q) : Q :=
    and.elim_right pq

theorem PfromPandQ' : ∀ { P Q : Prop }, P ∧ Q → P :=
λ P Q pq,
    pq.left -- shorthand for and.elim_left pq

theorem QfromPandQ' : ∀ { P Q : Prop }, P ∧ Q → Q :=
λ P Q pq,
    pq.right -- shorthand for and.elim_right pq

theorem PfromPandQ'' : ∀ { P Q : Prop }, P ∧ Q → P :=
begin
  assume P Q pq,
  show P,
  from pq.left
end

theorem QfromPandQ'' : ∀ { P Q : Prop }, P ∧ Q → Q :=
begin
  assume P Q pq,
  show Q,
  from pq.right
end

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- ********* -/
/- functions -/
/- ********* -/

/-
If P and Q are arbitrary types (examples of which include
bool, nat, and string), then P → Q is the type of a total
function that takes, as an argument, any value of type P,
and that always then returns some value of type Q.

The type judgment, f : P → Q, asserts that the identifier,
f, will bound to a value of type, P → Q: that is to say, f
is (bound to) some function that takes values of type P as
arguments and that returns values of type Q as results.

To "prove" (which means to provide a value of) type P → Q,
you have to provide a lambda abstraction that defines some
particular function from type P to type Q.
-/

/- → introduction -/

/-
To "prove" a function type, P → Q, you provide a lambda
abstraction that defines a particular function value of
this type. The particular lambda expressions selected as
a proof is significant, as their are many functions values
of most function types. For example, a function that takes
a ℕ, n, and that returns n + 1, and a function that takes
a ℕ, n and returns n * n, are both of type ℕ → ℕ, but in
most cases would not be interchangeable in a program. So,
when "proving" a function type, we're almost always very
careful to pick a specific function definition of interest
as a proof.
-/

/-
For example, we could exhibit a proof, inc, of ℕ → ℕ,
which is to say that we could define a function, inc,
that simply increments its argument, with the lambda
abstraction, λ n, n + 1. This is the function that
adds one to its argument, n, of type ℕ. Let's look at
different ways this function can be defined in Lean.
-/

/-
First, we define inc to be a value of type ℕ → ℕ,
namely the value, λ n : ℕ, n + 1.
-/

def inc : ℕ → ℕ := λ n : ℕ, (n + 1 : ℕ)

#check inc  -- type: ℕ → ℕ
#reduce inc -- value/proof: λ n : ℕ, n + 1
#check inc 3
#reduce inc 3

/-
Typically we would drop explicit types in places where
Lean can infer them.
-/

def inc' : ℕ → ℕ := λ n, n + 1

/-
We can also write such a function in a more Python-like
style.
-/

def inc'' (n : ℕ) : ℕ := n + 1

-- It really is the same function type and value
#check inc''
#reduce inc''

/-
Again we can often simplify code by leaving out explicit types
-/

def inc''' (n : ℕ) := n + 1

/-
We can confirm that the type of this function is still ℕ → ℕ.
-/

#check inc'''

/-
You must be able to express function values using both
Python-like expressions and lambda abstractions.
-/

/-
We note that we can even construct function values
using tactic scripts.

Knowing how to do this can be useful both in handling
unexpected proof states, and might be useful for
some who like to create functions in an imperative style.
-/

def inc'''' (n : ℕ) : ℕ :=
begin
  exact n + 1
end

def inc''''' : ℕ → ℕ :=
begin
  assume n,
  show ℕ,
  from n + 1
end

-- these are all exactly the same function
#reduce inc
#reduce inc'
#reduce inc'''
#reduce inc''''
#reduce inc'''''

/- multiple arguments -/

/-
If P, Q, and R are types, then P → Q → R is
also a type. Because → is right associative,
this type can also be written as P → (Q → R).
This is the type of functions that take values
of type P as arguments and that return values
of type (Q → R) as results.

If we have a function, f, of type P → Q → R,
we can apply it to a value p : P and get back
some function of type Q → R.

So the result of (f p) is a function of type
Q → R. The function (f p) can thus be applied
to an value, q, of type Q to obtain a result,
r, of type R, with the expression (f p) q.

Because function application is left associative
the parenthesis can be dropped and you can just
write f p q, giving the impression that f is a
function that takes two arguments, one of type P
and one of type Q (and that then returns a value
of type R).

Here's an example.
-/

def plus (n m: ℕ) : ℕ := n + m

#check plus
#reduce plus

#check plus 3
#reduce plus 3 -- a function taking one argument!

#reduce (plus 3) 4 -- that function applied to 4
#reduce plus 3 4 -- the parentheses were redundant

/-
The following section addresses implication,
where, if P and Q are propositions, P → Q, is
the logical implication, if there is a proof of
P then a proof of Q can be constructed. A proof
of this proposition is given by any function of
type P → Q.

Everything in this section about function types
and values/implementations (lambda expressions)
applies to implications, so bear the lessons of
this section in mind as you read the next one.
-/

/- → elimination -/

/-
The elimination rule for functions is easy. The
application of a function, f : P → Q, to a value,
p : P, will produce a value of type Q.
-/

#check inc 3
#reduce inc 3

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- *********** -/
/- implication -/
/-************ -/

/-
If P and Q are propositions, then P → Q
is a proposition. It read as asserting
that if P is true then Q is true.

To prove P → Q, one must show that there
is a (total) function that, when given a
proof of P as an argument, constructs a
proof of Q as a result. NB: Functions can
be defined to take argument of types that
have no value! See the false elimination
examples above. It is very important to
understand that P → Q being true does not
necessarily mean that P is true, but only
that *if* P is true (there is a proof of
P) then Q is true (a proof of Q can be
constructed).

To prove P → Q, provide a function that
shows that from an assumed proof of P
one can construct a proof of Q. The type
of such a function is P → Q.
-/

-- implication introduction

def falseImpliesTrue (f : false) : true :=
    true.intro

#check falseImpliesTrue

example : false → true :=
    λ f : false, true.intro

example : false → true :=
    falseImpliesTrue

/- → implication elimination -/

/-
From a proof of P → Q and a proof of P
one can derive a proof of Q. This is done
by "applying" the proof of the implication
(which in Lean is a function) to the proof
of P, the result of which is a proof of Q.

(P Q : Prop) (p2q: P → Q) (p : P)
--------------------------------- → elim
         (p2q p) : Q
-/

def arrowElim {P Q : Prop} (p2q: P → Q) (p : P) : Q :=
    p2q p

theorem arrowElim': ∀ { P Q : Prop}, (P → Q) → P → Q :=
λ P Q p2q p,
    p2q p

theorem arrowElim'': ∀ { P Q : Prop}, (P → Q) → P → Q :=
begin
  assume P Q p2q p,
  show Q,
  from p2q p
end

/- ********** -/
/- forall (∀) -/
/- ********** -/

/-
If P is a type and Q is a predicate,
then ∀ p : P, Q is a proposition. It
is read as stating that the predicate,
Q, is true for any value, p, in the
set of values (domain of discourse)
given by the type, P. The predicate,
Q, is usually one that takes a value
of type, P, as an argument, but this
is not always the case. For example,
one could write, ∀ n : ℕ, true. Here
the predicate, true, is a predicate
that takes no arguments at all, and
so it is simply a proposition, and it
is true for every value of n, so the
proposition, ∀ n : ℕ, true, is true.
More commonly, the predicate part of
a universally quantified proposition
will be "about" the values over which
the quantification ranges. Here is an
example:

∀ n : ℕ : (n > 2 ∧ prime n) → odd n

This proposition asserts that any n
greater than 2 and prime is also odd
(which also happens to be true). The
predicate, (n > 2 ∧ prime n) → odd n,
in this case takes n as an argument,
and is thus "about" each of the values
over which the ∀ ranges.
-/

/- ∀ introduction -/

/-
To prove a proposition, ∀ p : P, Q,
assume an arbitrary value, p : P,
and shows that the predicate, Q, is
true for that assumed value. As the
value was chosen arbitrarily, it thus
follows that the predicate is true
for *any* such value, proving the ∀.

To see this principle in action,
study the following proof script.
-/

theorem allNEqualSelf: ∀ n : ℕ, n = n :=
begin
  assume n, -- assume an arbitrary n
  show n = n, -- show predicate true for n
  from rfl, -- thus proving ∀ n, n = n
end

/- ∀ elimination -/

/-
∀ elimination reasons that if some
predicate, Q, is true for every value of
some type, then it must also be true for
any particular value of that type. So
from a proof, p2q, of ∀ P, Q and a proof,
p : P, we conclude Q.

P : Type, Q : P → Prop, p2q : ∀ p : P, Q, p : P
-----------------------------------------------
            (p2q p) :  Q p

Forall elimination is just another form
of arrow elimination. In constructive
logic this is function application. Study
the following examples carefully to see
how this works.
-/

def forallElim (p2q: ∀ n : nat, n = n) (p : nat) : p = p :=
    p2q p

def forallElim' (p2q: ∀ n : nat, n = n) (p : nat) : p = p :=
begin
  exact (p2q p)
end

#reduce forallElim allNEqualSelf 7

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- ************** -/
/- ** Negation ** -/
/- ************** -/

/-
If P is a proposition, then ¬ P is one, too.
We read ¬ P as asserting that P is false. In
constructive logic this means that there is
no proof of P. In constructive logic, ¬ P is
thus actually defined as P → false. So ¬ P
means P → false, and a proof of ¬ P is just
a proof of P → false.

To prove ¬ P, one thus assumes a proof of P
and shows that, in that context, one can
construct a proof of false. That is, one
exhibits a function that takes a proof of
P as an argument and constructs and returns
a proof of false as a result.

This is the introduction rule for ¬. Another
way to say this: To prove ¬ P, assume P and
show that this leads to a contradiction.

This is of course just the principle of proof
by negation, equivalent to the introduction
rule for false.

P: Prop, f2p : P → false
------------------------ false introduction
        np : ¬ P

We discuss the elimination rule for ¬ below.
The key idea is that it's really a rule for
double negation elimination, and it requires
classical reasoning. More on this later.
-/

-- negation introduction

/-
That Lean accepts the following function definition
shows that a proof of P → false *is* a proof of ¬ P
-/

def notIntro (P : Prop) (p2f: P → false) : ¬P :=
    p2f

/-
An equivalent proof script.
-/
theorem notIntro':
 ∀ P : Prop, (P → false) → ¬P :=
begin
  assume P : Prop,
  assume p2f : P → false,
  show ¬P,
  from p2f
end

/-
Example: from the assumption that a
proposition, P, is true, we can deduce
that ¬ ¬ P is true, as well. This is
a rule for double negation introduction,
though not a rule that is commonly needed.
-/

theorem doubleNegIntro : ∀ P : Prop, P → ¬¬P :=
begin
  assume P : Prop,
  assume p : P,
  assume np : ¬P, -- ¬¬P means ¬P → false, so assume ¬P
  show false,
  --from np p,
  contradiction,
end

theorem doubleNegIntro' : ∀ P : Prop, P → ¬¬P :=
    λ P p np,
        np p

/- negation elimination -/

/-
The rule for negation elimination in
natural deduction is really a rule
for double negation elimination: it
states that, ∀ P : Prop, ¬ (¬ P) → P.
Because ¬ is right associative, we
can drop the parenthesis: ¬ ¬ P → P.

This rule is not valid in constructive
logic. You can't prove the following
unless you also accept the axiom of
the excluded middle, or equivalent.
-/

example: ∀ P : Prop, ¬¬P → P :=
begin
  assume P nnp,
  /-
  No way to get from ¬¬P to P.
  stuck and giving up on this proof.
  -/
  end

/-
However, if we accept the axiom of the
excluded middle, which we can do by
"opening" Lean's "classical" module,
then we can prove that double negation
elimination is valid.
-/

open classical
#check em

/-
Now em is the axiom of the excluded middle.
What em tells us is that if P is any
proposition, then either one of P or ¬ P is
true, and there are no other possibilities.

And from em we can now prove double negation
elimination.  The proof is by "case analysis."
We consider each of the two possible cases for
P (true and false) in turn.

If we assume P is true, then we are done,
as our goal is to show P (from ¬ ¬ P). On
the other hand, if we assume P is false,
i.e., ¬ P, then we reach a contradiction.
We have already assumed ¬ ¬ P is true and
we are trying to prove P. But now if we
also assume that ¬ P is true, then clearly
we have a contradiction (between ¬ P and
¬ ¬ P). Using false elimination finishes
this case leaving us with the conclusion
that P is true in either case.
-/

theorem doubleNegationElim:
 ∀(P : Prop), ¬¬P → P :=
begin
  assume P nnp,
  show P,
  from
    begin
        -- preview: we study case analysis later
        -- proof by case analysis for P
        cases (em P) with pf_P pf_nP, -- (em P) is (P ∨ ¬ P)
        -- case with P is assumed to be true
        exact pf_P,
        -- case with P is assumed to be false
        exact false.elim (nnp pf_nP)
        -- em says there are no other cases
    end,
end

/-
Double negation elimination is the fundamental
operation needed in a proof by contradiction.
In a proof by contradiction, on tries to prove
P by assuming ¬ P and showing that that leads
to a contradiction, thus to a proof that ¬ P
is not true, that is, ¬ (¬ P). The negation
elimination rule lets us then conclude P.
-/

/-
Note: The law of the excluded middle
allows you to conclude P ∨ ¬ P "for free,"
without giving a proof of either P or of
¬ P. It is in this precise sense that em
is not "constructive." When using em, you
do not build a "bigger" proof (of P ∨ ¬ P)
from one or more "smaller" proofs (of P or
of ¬ P). Whereas constructive proofs are
"informative," in that they contain the
smaller proofs needed to justify a given
conclusion, classical proofs are not, in
general. Accepting that P ∨ ¬ P by using
em gives you a proof but such a proof does
not tell you anything at all about which
case is true, whereas a constructive proof
does.
-/

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- *************** -/
/- bi-implication  -/
/- *************** -/

/-
If P and Q are propositions then so is P ↔ Q.
We read P ↔ Q as asserting P → Q ∧ Q → P. To
prove P ↔ Q, we have to provide proofs of both
conjunctions, and from a proof of P ↔ Q we can
obtain proofs of P → Q and of Q → P by use of
the elimination rule for ↔.

The ↔ symbol is pronounced as is equivalent
to," or as "if and only if," In mathematical
writing it is often written as "iff". And to
get the ↔ symbol in Lean, use backslash-iff.

Its introduction and elimination rules are
equivalent to those for conjunction, but
specialized to the case where each of the
conjuncts is an implication and where one
is the other going in the other direction.
-/

/- iff introduction -/

/-
To prove P ↔ Q (introduction), apply iff.intro
to proofs of P and Q.

(P Q : Prop), (pq : P → Q) (qp : Q → P)
--------------------------------------- iff.intro
        pqEquiv: P ↔ Q
    -/

theorem iffIntro:
  ∀(P Q: Prop), (P → Q) → (Q → P) → (P ↔ Q) :=
begin
  assume P Q : Prop,
  assume p2q q2p,
  apply iff.intro p2q q2p
end

theorem iffIntro':
  ∀(P Q : Prop), (P → Q) → (Q → P) → (P ↔ Q) :=
λ P Q pq qp,
    iff.intro pq qp

theorem iffIntro'':
  ∀(P Q: Prop), (P → Q) → (Q → P) → (P ↔ Q) :=
begin
  assume P Q : Prop,
  assume p2q q2p,
  apply iff.intro,
    exact p2q,

    exact q2p
end

/- iff elimination -/

/-
Similarly, the left and right iff elimination
rules are equivalent to the and elimination
rules but for the special case where the
conjunction is a bi-implication in particular.
-/

theorem iffElimLeft:
  ∀(P Q : Prop), (P ↔ Q) → P → Q :=
begin
  assume P Q : Prop,
  assume bi : P ↔ Q,
  show P → Q,
  from iff.elim_left bi -- bi.1 is a shorthand
end

theorem iffElimLeft':
  ∀(P Q : Prop), (P ↔ Q) → P → Q :=
λ P Q bi,
    iff.elim_left bi

theorem iffElimRight:
  ∀(P Q : Prop), (P ↔ Q) → Q → P :=
λ P Q bi,
    iff.elim_right bi

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- **************** -/
/- or (disjunction) -/
/- **************** -/

/-
If P and Q are propositions, then so is P ∨ Q.
P ∨ Q asserts that at least one of P, Q is true,
but it does not indicate which case holds.
-/

/- introduction rules for or -/

/-
To prove P ∨ Q, in constructive logic
one either applies the or.intro_left rule
to a proof of P or the or.intro_right rule
to a proof of Q. In either case, one must
also provide, as the first argument, the
proposition that is not being proved. The
shorthand or.inl and or.inr rules infer
these propositional arguments and are
easier and clearer to use in practice.
-/

theorem orIntroLeft (P Q : Prop) (p : P) : P ∨ Q :=
    or.intro_left Q p -- args: proposition Q, proof of P

theorem orIntroLeft': forall P Q: Prop, P → (P ∨ Q) :=
λ P Q p,
    or.inl p -- shorthand

theorem orIntroLeft'' (P Q : Prop) (p : P) : P ∨ Q :=
begin
  apply or.intro_left,
  assumption
end

theorem orIntroRight: forall P Q: Prop, Q → (P ∨ Q) :=
λ P Q q,
    or.inr q

/- or elimination -/

/-
The elimination rule for or says that if
(1) P ∨ Q is true, (2) P → R, and (3) Q → R,
then you can conclude R.

The reasoning in by "case analysis." In
one case, if P ∨ Q because P is, then use
P → R to prove R. Otherwise, if P ∨ Q is
true because Q is, then use Q → R to prove
R. Usually you don't know which case holds
so to prove R from P ∨ Q you have to show
that R follows "in either case", and to
do that, you need both P → R and Q → R.

pfPQ: P ∨ Q, pfPR: P → R, pfQR: Q → R
-------------------------------------- or.elim
                 R

So, for example if (1) "it's raining or the
fire hydrant is running" (P ∨ Q), (2)"if it's
raining then the streets are wet", and (3)
"if the fire hydrant is running then the
streets are wet", then the streets are wet!
-/

theorem orElim :
  ∀(P Q R: Prop),
    (P ∨ Q) → (P → R) → (Q → R) → R
:=
begin
  assume P Q R,
  assume PorQ: (P ∨ Q),
  assume pr: (P → R),
  assume qr: (Q → R),
  show R,
  from or.elim PorQ pr qr
end

theorem orElim' :
  ∀(P Q R: Prop),
    (P ∨ Q) → (P → R) → (Q → R) → R
:=
begin
  assume P Q R,
  assume PorQ: (P ∨ Q),
  assume pr: (P → R),
  assume qr: (Q → R),
  show R,
  from
    -- compare carefully with previous example
    begin
      cases PorQ with p q,
        exact (pr p),
        exact (qr q)
    end
end

-- Same proof, different identifiers
theorem orElimExample' :
forall Rain Hydrant Wet: Prop,
    (Rain ∨ Hydrant) → -- raining or hydrant on;
    (Rain → Wet) →     -- if raining then wet;
    (Hydrant → Wet) →  -- if hydrant on then wet;
    Wet                -- then wet
:=
begin
-- setup
  assume Rain Hydrant Wet,
  assume RainingOrHydrantRunning: (Rain ∨ Hydrant),
  assume RainMakesWet: (Rain → Wet),
  assume HydrantMakesWet: (Hydrant → Wet),
-- the core of the proof
  cases RainingOrHydrantRunning with raining running,
    show Wet, from RainMakesWet raining,
    show Wet, from HydrantMakesWet running,
end

/-
Note: The axiom of the excluded middle allows
us to do case analysis even if we don't have an
explicit disjunction to work with, because we
can always apply em to any proposition P to get
a proof of P ∨ ¬ P.

Here's an example. (There is a more direct
proof, but we're showing how to apply em to a
proposition to get a disjunction to do case
analysis on.
-/
open classical

example : ∀(P : Prop), P ∨ ¬ P :=
begin
  assume P : Prop,
  cases (em P) with p np,   --(em P) is a proof of P ∨ ¬ P
    exact or.inl p,         -- case where P assumed true
    exact or.inr np,        -- case where ¬ P assumed true
end

example : ∀(P : Prop), P ∨ ¬ P :=
begin
  assume P : Prop,
  apply em P
end

/-
Go back and without fail see where
this trick was used to prove one of
the DeMorgan laws and the validity of
double negation elimination.
-/

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- ********** -/
/- Predicates -/
/- ********** -/

/-
A predicate is a proposition with parameters
whose values need to be supplied to reduce the
predicate to a proposition.

For example, even (n : ℕ) : Prop, could be
a predicate that takes a value, n : ℕ, and
that reduces to a proposition that in general
will assert something about the particular n
that was supplied as an argument.

So, even 3, for example would reduce to the
proposition that we would interpret as "three
is even", while "even 7" would be (reduce to)
a proposition that 7 is even.

We formalize predicates as functions that
take arguments and that return propositions
about those arguments. If this is unclear,
re-read the preceding paragraph.

A predicate thus generates a whole family
of propositions, one for each combination
of values of its arguments. The "even n"
predicate, for example, gives rise to a
whole family of propositions, one for each
ℕ value of n.

Note that you can think of a predicate with
no parameters as just a proposition.

A predicate with one parameter can be read
as defining a "property" of the values of
its argument type. A sensibly defined even n
predicate, for example, will generate a
proposition that is true for every even
natural number and that is false for every
odd natural number.

Such a predicate can also be understood to
define a set, namely the set of all values
for which the corresponding propositions are
true.

A predicate with multiple parameters can
be read as defining a property of, and thus
a set of, ordered pairs (for two arguments)
or more generally tuples of arguments. We
call a set of pairs (or tuples) a relation.

As an example, a predicate "lessThan m n"
could be defined to reduce to a proposition
that is true whenever m is less than n and
that is false otherwise. This predicate
implicitly "picks out" the set of (m, n)
pairs where m is less than n and excludes
all pairs where m is not less than n. The
pair (3, 4) is in the lessThan relation in
that the proposition, lessThan 3 4, would
be true, while (4, 3) would not be in the
relation, in that "lessThan 4 3" would not
be a true/provable proposition.

We formalize predicates as functions from
argument values to propositions. Here are
some examples.
-/

/-
First, we define zEqz as a predicate
with no arguments. That is to say, it
is just a plain old proposition. No
more need be said.
-/
def zEqz : Prop := 0 = 0

/-
Next, we generalize by making one of
the zero values into a parameter. The
predicate, when provided with a value
for n, reduces to the proposition that
that zero is equal to that particular
n. -/

def nEqz (n : ℕ) : Prop := 0 = n

/-
Note that we could have written this
definition using a lambda abstraction.
A benefit is that this way of writing
the same thing makes the nature of
zEqz'clear by expressing its type
explicitly: ℕ → Prop.
-/
def nEqz' : ℕ → Prop := λ n, 0 = n

/-
The only value of n that satisfies this
predicate, in the sense that it makes the
corresponding proposition true, is n = 0.
This predicate thus implicitly represents
the set, { 0 }.
-/

/-
We can further generalize this predicate
by making both values to be compared into
arguments.
-/

def nEqm (n m: ℕ) : Prop := n = m

def isSquare (n m : ℕ) := n^2 = m

#check isSquare
#check isSquare 3 9
#reduce isSquare 3 9

/- *****************************************-/
/- *****************************************-/
/- *****************************************-/

/- ******* -/
/- Exists  -/
/- ******* -/

/-
If P is a type and Q is a predicate,
then ∃ p : P, Q is a proposition. It
asserts that there is some value,
p : P, that makes the predicate, Q,
true.
-/

/- ∃ introduction -/

/-
To prove a proposition of the form,
∃ p : P, Q, one must provide two things:
(1) a specific value, w : P, that we
often call a "witness", and a proof that
Q is true for that specific w.

So, for example, to prove that there
exists an object, o, that is a cat, it
would suffice to exhibit some object
(the witness), let's call it Nifty, and
a proof, pf, of the proposition, Nifty
is a cat. Then the pair, ⟨ nifty, pf ⟩
would be a proof of ∃ o: Object, Cat o.

The proposition, ∃ o: Object, Cat o, does
not refer to Nifty or any other object in
particular. It just asserts that *some*
object out there is a cat. To prove it,
though, you do need to exhibit a specific
object and give a proof that that object
is a cat. You can then conclude that there
is some object that is a cat.

Here's the exists.intro rule, after which
we give some very simple examples of how it
would be used in code.

(T : Type), (P : T → Prop), (t : T), (pf: P t)
---------------------------------------------- exists.intro
          ⟨ t, pf ⟩ : exists t : T, P t
-/

#check exists.intro

theorem existsIntro :
  ∀(T : Type),     -- suppose T is a type
  ∀(P : T → Prop), -- suppose P is a property of values of type T
/-
now if for any t : T, we can show that t has property P,
then we can construct a proof that *there exists* an x : T
with property P
-/
  ∀(t : T), (P t) → ∃ x : T, P x
:=
begin
  assume T: Type,         -- assume T is some type
  assume P: T → Prop,     -- and P is a property
-- show that if there's a t with property P (P t), the ∃ is true
  show ∀ (t : T), P t → (∃ (x : T), P x), from
    begin
      assume t : T,           -- assume t is some object of type T
      assume pf : P t,        -- and that t has property P
      show ∃ x, P x, from     -- now we can show ∃ x, P x
        (exists.intro t pf) -- using exists.intro
    --  ⟨ t, pf ⟩  would be a shorthand for (exists.intro t pf)
    end,
end

/- existential elimination -/

/-
The reasoning about existential elimination goes
like this. If we know that (∃ x : T, P x), that
there is some value, x of type T with property P,
then we can temporarily assume that there is some
specific value, that we will call it by an otherwise
unused name, u, where u has property P, which is to
say that we also have a proof of (P u).

If the meaning of "a proof of (P u)" doesn't make
sense, go back and review the class material on
predicates. P is a predicate, i.e., a function
from T to Prop, u is the name we've given to some
value of type T with property P such that u has
property P, which is to say there is a proof of
the proposition, (P u).

Now, if from u and a proof of (P u) we can
construct a proof of some proposition S (a
proposition that does not involve u in any
way), then we can conclude that S follows from
the mere existence of such a u, i.e., from the
truth of ∃ x : T, P x.

Here is slightly simplified version of the
exists.elim rule.

{T : Type}, {P : T → Prop}, {Q : Prop}, (ex: ∃ x : T, P x) (p2q: ∀ t : T, P t → Q)
---------------------------------------------------------------------------------- ∃.intro
                                    q : Q

Let's unpack this. The assumptions are that T
is any type and P is any property of values of
that type. Q is the proposition that we want to
prove follows from ∃ x : T, P x. The additional
fact that is needed to conclude that Q is true
is a proof, p2q, f that if any t : T has property
P, then Q follows. If we combine this fact, p2q,
with the fact, ex, that there exists such a t,
then we can conclude that Q must be true.
-/

#check exists.elim

/-
Here's some code that illustrates the use of
the exists.elim principle in Lean.
-/

def existElimExample
(T : Type)                      -- Suppose T is any type
(P S : T → Prop)                -- and P, S are properties of T
(ex : exists x, P x ∧ S x)      -- and there is an x with P and S
: (exists y, S y ∧ P y)         -- show there is a y with P
:=
begin
/-
The only thing we have to work with is ex. So we will
apply exists.elim to it. We supply the first argument,
namely the proof of exists x, P x ∧ Q x-/
  apply exists.elim ex,
/-
What we then have to provide is the proof required as
the second argument to exists.elim. This is a proof of
the proposition that that for any object, a : T, if a
has properties P and S, then (∃ (y : T), S y ∧ P y) is
true. We will now prove this proposition to finish off
the proof. What we have to prove is an implication, so
we will start by assuming its premises: that a is some
value of type T and that we have a proof that a has the
properties P and S.
-/
  assume w : T,
  assume pfa : P w ∧ S w,

/-
Given these assumption we now need to show the final
conclusion, that (∃ (y : T), S y ∧ P y). This is a job
for exists.intro. The arguments we will give it are,
a, as a witness, and a proof of (S a ∧ P a) as a proof.
That is then all that we need to prove the final goal,
(∃ (y : T), S y ∧ P y), using exists.intro.
-/
    show (∃ (y : T), S y ∧ P y), from
    begin
        have pa := pfa.left,
        have qa := pfa.right,
        have qp := and.intro qa pa,
        exact exists.intro w qp,
    end,
end