/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.list.perm

/-!
# Sorting algorithms on lists

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

open list.perm

universe uu

namespace list

/-!
### The predicate `list.sorted`
-/

section sorted

variables {α : Type uu} {r : α → α → Prop}

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted := @pairwise

instance decidable_sorted [decidable_rel r] (l : list α) : decidable (sorted r l) :=
list.decidable_pairwise _

@[simp] theorem sorted_nil : sorted r [] := pairwise.nil

theorem sorted_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) → sorted r l :=
pairwise_of_pairwise_cons

theorem sorted.tail {r : α → α → Prop} {l : list α} (h : sorted r l) : sorted r l.tail :=
h.tail

theorem rel_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) →
  ∀ b ∈ l, r a b :=
rel_of_pairwise_cons

@[simp] theorem sorted_cons {a : α} {l : list α} :
  sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ sorted r l :=
pairwise_cons

protected theorem sorted.nodup {r : α → α → Prop} [is_irrefl α r] {l : list α} (h : sorted r l) :
  nodup l :=
h.nodup

theorem eq_of_perm_of_sorted [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
begin
  induction s₁ with a l₁ h₁ s₁ IH generalizing l₂,
  { exact p.nil_eq },
  { have : a ∈ l₂ := p.subset (mem_cons_self _ _),
    rcases mem_split this with ⟨u₂, v₂, rfl⟩,
    have p' := (perm_cons a).1 (p.trans perm_middle),
    have := IH p' (pairwise_of_sublist (by simp) s₂), subst l₁,
    change a::u₂ ++ v₂ = u₂ ++ ([a] ++ v₂), rw ← append_assoc, congr,
    have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m,
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _))
        (h₁ _ (by simp [m])),
    rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2,
        (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2];
    split; simp [iff_true_intro this, or_comm] }
end

@[simp] theorem sorted_singleton (a : α) : sorted r [a] := pairwise_singleton _ _

lemma sorted.rel_nth_le_of_lt {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a < b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
list.pairwise_iff_nth_le.1 h a b hb hab

lemma sorted.rel_nth_le_of_le [is_refl α r] {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a ≤ b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
begin
  cases eq_or_lt_of_le hab with H H,
  { subst H, exact refl _ },
  { exact h.rel_nth_le_of_lt _ _ H }
end

lemma sorted.rel_of_mem_take_of_mem_drop {l : list α} (h : list.sorted r l)
  {k : ℕ} {x y : α} (hx : x ∈ list.take k l) (hy : y ∈ list.drop k l) :
  r x y :=
begin
  obtain ⟨iy, hiy, rfl⟩ := nth_le_of_mem hy,
  obtain ⟨ix, hix, rfl⟩ := nth_le_of_mem hx,
  rw [nth_le_take', nth_le_drop'],
  rw length_take at hix,
  exact h.rel_nth_le_of_lt _ _ (ix.lt_add_right _ _ (lt_min_iff.mp hix).left)
end

end sorted

section sort
variables {α : Type uu} (r : α → α → Prop) [decidable_rel r]
local infix ` ≼ ` : 50 := r

/-! ### Insertion sort -/

section insertion_sort

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert (a : α) : list α → list α
| []       := [a]
| (b :: l) := if a ≼ b then a :: b :: l else b :: ordered_insert l

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort : list α → list α
| []       := []
| (b :: l) := ordered_insert r b (insertion_sort l)

@[simp] lemma ordered_insert_nil (a : α) : [].ordered_insert r a = [a] := rfl

theorem ordered_insert_length : Π (L : list α) (a : α), (L.ordered_insert r a).length = L.length + 1
| [] a := rfl
| (hd :: tl) a := by { dsimp [ordered_insert], split_ifs; simp [ordered_insert_length], }

/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
lemma ordered_insert_eq_take_drop (a : α) : ∀ l : list α,
  l.ordered_insert r a = l.take_while (λ b, ¬(a ≼ b)) ++ (a :: l.drop_while (λ b, ¬(a ≼ b)))
| [] := rfl
| (b :: l) := by { dsimp only [ordered_insert], split_ifs; simp [take_while, drop_while, *] }

lemma insertion_sort_cons_eq_take_drop (a : α) (l : list α) :
  insertion_sort r (a :: l) = (insertion_sort r l).take_while (λ b, ¬(a ≼ b)) ++
    (a :: (insertion_sort r l).drop_while (λ b, ¬(a ≼ b))) :=
ordered_insert_eq_take_drop r a _

section correctness
open perm

theorem perm_ordered_insert (a) : ∀ l : list α, ordered_insert r a l ~ a :: l
| []       := perm.refl _
| (b :: l) := by by_cases a ≼ b; [simp [ordered_insert, h],
  simpa [ordered_insert, h] using
    ((perm_ordered_insert l).cons _).trans (perm.swap _ _ _)]

theorem ordered_insert_count [decidable_eq α] (L : list α) (a b : α) :
  count a (L.ordered_insert r b) = count a L + if (a = b) then 1 else 0 :=
begin
  rw [(L.perm_ordered_insert r b).count_eq, count_cons],
  split_ifs; simp only [nat.succ_eq_add_one, add_zero],
end

theorem perm_insertion_sort : ∀ l : list α, insertion_sort r l ~ l
| []       := perm.nil
| (b :: l) := by simpa [insertion_sort] using
  (perm_ordered_insert _ _ _).trans ((perm_insertion_sort l).cons b)

variable {r}

/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
lemma sorted.insertion_sort_eq : ∀ {l : list α} (h : sorted r l), insertion_sort r l = l
| [] _ := rfl
| [a] _ := rfl
| (a :: b :: l) h :=
  begin
    rw [insertion_sort, sorted.insertion_sort_eq, ordered_insert, if_pos],
    exacts [rel_of_sorted_cons h _ (or.inl rfl), h.tail]
  end

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted.ordered_insert (a : α) : ∀ l, sorted r l → sorted r (ordered_insert r a l)
| []       h := sorted_singleton a
| (b :: l) h := begin
  by_cases h' : a ≼ b,
  { simpa [ordered_insert, h', h] using λ b' bm, trans h' (rel_of_sorted_cons h _ bm) },
  { suffices : ∀ (b' : α), b' ∈ ordered_insert r a l → r b b',
    { simpa [ordered_insert, h', (sorted_of_sorted_cons h).ordered_insert l] },
    intros b' bm,
    cases (show b' = a ∨ b' ∈ l, by simpa using
      (perm_ordered_insert _ _ _).subset bm) with be bm,
    { subst b', exact (total_of r _ _).resolve_left h' },
    { exact rel_of_sorted_cons h _ bm } }
end

variable (r)

/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertion_sort : ∀ l, sorted r (insertion_sort r l)
| []       := sorted_nil
| (a :: l) := (sorted_insertion_sort l).ordered_insert a _

end total_and_transitive
end correctness
end insertion_sort

/-! ### Merge sort -/

section merge_sort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split : list α → list α × list α
| []       := ([], [])
| (a :: l) := let (l₁, l₂) := split l in (a :: l₂, l₁)

theorem split_cons_of_eq (a : α) {l l₁ l₂ : list α} (h : split l = (l₁, l₂)) :
  split (a :: l) = (a :: l₂, l₁) :=
by rw [split, h]; refl

theorem length_split_le : ∀ {l l₁ l₂ : list α},
  split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
| []     ._  ._  rfl := ⟨nat.le_refl 0, nat.le_refl 0⟩
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ h₂, nat.le_succ_of_le h₁⟩
end

theorem length_split_lt {a b} {l l₁ l₂ : list α} (h : split (a::b::l) = (l₁, l₂)) :
  length l₁ < length (a::b::l) ∧ length l₂ < length (a::b::l) :=
begin
  cases e : split l with l₁' l₂',
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h, substs l₁ l₂,
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ (nat.succ_le_succ h₁), nat.succ_le_succ (nat.succ_le_succ h₂)⟩
end

theorem perm_split : ∀ {l l₁ l₂ : list α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
| []     ._  ._  rfl := perm.refl _
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  exact ((perm_split e).trans perm_append_comm).cons a,
end

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : list α → list α → list α
| []       l'        := l'
| l        []        := l
| (a :: l) (b :: l') := if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'

include r
/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort : list α → list α
| []        := []
| [a]       := [a]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  exact merge r (merge_sort l₁) (merge_sort l₂)
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_cons_cons {a b} {l l₁ l₂ : list α}
  (h : split (a::b::l) = (l₁, l₂)) :
  merge_sort r (a::b::l) = merge r (merge_sort r l₁) (merge_sort r l₂) :=
begin
  suffices : ∀ (L : list α) h1, @@and.rec
    (λ a a (_ : length l₁ < length l + 1 + 1 ∧
      length l₂ < length l + 1 + 1), L) h1 h1 = L,
  { simp [merge_sort, h], apply this },
  intros, cases h1, refl
end

section correctness

theorem perm_merge : ∀ (l l' : list α), merge r l l' ~ l ++ l'
| []       []        := by simp [merge]
| []       (b :: l') := by simp [merge]
| (a :: l) []        := by simp [merge]
| (a :: l) (b :: l') := begin
  by_cases a ≼ b,
  { simpa [merge, h] using perm_merge _ _ },
  { suffices : b :: merge r (a :: l) l' ~ a :: (l ++ b :: l'), {simpa [merge, h]},
    exact ((perm_merge _ _).cons _).trans ((swap _ _ _).trans (perm_middle.symm.cons _)) }
end

theorem perm_merge_sort : ∀ l : list α, merge_sort r l ~ l
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  apply (perm_merge r _ _).trans,
  exact ((perm_merge_sort l₁).append (perm_merge_sort l₂)).trans (perm_split e).symm
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

@[simp] lemma length_merge_sort (l : list α) : (merge_sort r l).length = l.length :=
(perm_merge_sort r _).length_eq

section total_and_transitive
variables {r} [is_total α r] [is_trans α r]

theorem sorted.merge : ∀ {l l' : list α}, sorted r l → sorted r l' → sorted r (merge r l l')
| []       []        h₁ h₂ := by simp [merge]
| []       (b :: l') h₁ h₂ := by simpa [merge] using h₂
| (a :: l) []        h₁ h₂ := by simpa [merge] using h₁
| (a :: l) (b :: l') h₁ h₂ := begin
  by_cases a ≼ b,
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b',
    { simpa [merge, h, (sorted_of_sorted_cons h₁).merge h₂] },
    intros b' bm,
    rcases (show b' = b ∨ b' ∈ l ∨ b' ∈ l', by simpa [or.left_comm] using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact rel_of_sorted_cons h₁ _ bl },
    { exact trans h (rel_of_sorted_cons h₂ _ bl') } },
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b',
    { simpa [merge, h, h₁.merge (sorted_of_sorted_cons h₂)] },
    intros b' bm,
    have ba : b ≼ a := (total_of r _ _).resolve_left h,
    rcases (show b' = a ∨ b' ∈ l ∨ b' ∈ l', by simpa using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact trans ba (rel_of_sorted_cons h₁ _ bl) },
    { exact rel_of_sorted_cons h₂ _ bl' } }
end

variable (r)

theorem sorted_merge_sort : ∀ l : list α, sorted r (merge_sort r l)
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  exact (sorted_merge_sort l₁).merge (sorted_merge_sort l₂)
end
using_well_founded
{ rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_eq_self [is_antisymm α r] {l : list α} : sorted r l → merge_sort r l = l :=
eq_of_perm_of_sorted (perm_merge_sort _ _) (sorted_merge_sort _ _)

theorem merge_sort_eq_insertion_sort [is_antisymm α r] (l : list α) :
  merge_sort r l = insertion_sort r l :=
eq_of_perm_of_sorted ((perm_merge_sort r l).trans (perm_insertion_sort r l).symm)
  (sorted_merge_sort r l) (sorted_insertion_sort r l)

end total_and_transitive
end correctness
end merge_sort
end sort

/- try them out! -/

--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end list


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel
-/
import data.list.basic

/-!
# Sums and products from lists

This file provides basic results about `list.prod` and `list.sum`, which calculate the product and
sum of elements of a list. These are defined in [`data.list.defs`](./data/list/defs).
-/

variables {α β γ : Type*}

namespace list
section monoid
variables [monoid α] {l l₁ l₂ : list α} {a : α}

@[simp, to_additive]
lemma prod_nil : ([] : list α).prod = 1 := rfl

@[to_additive]
lemma prod_singleton : [a].prod = a := one_mul a

@[simp, to_additive]
lemma prod_cons : (a :: l).prod = a * l.prod :=
calc (a :: l).prod = foldl (*) (a * 1) l : by simp only [list.prod, foldl_cons, one_mul, mul_one]
  ... = _ : foldl_assoc

@[simp, to_additive]
lemma prod_append : (l₁ ++ l₂).prod = l₁.prod * l₂.prod :=
calc (l₁ ++ l₂).prod = foldl (*) (foldl (*) 1 l₁ * 1) l₂ : by simp [list.prod]
  ... = l₁.prod * l₂.prod : foldl_assoc

@[to_additive]
lemma prod_concat : (l.concat a).prod = l.prod * a :=
by rw [concat_eq_append, prod_append, prod_cons, prod_nil, mul_one]

@[simp, to_additive]
lemma prod_join {l : list (list α)} : l.join.prod = (l.map list.prod).prod :=
by induction l; [refl, simp only [*, list.join, map, prod_append, prod_cons]]

/-- If zero is an element of a list `L`, then `list.prod L = 0`. If the domain is a nontrivial
monoid with zero with no divisors, then this implication becomes an `iff`, see
`list.prod_eq_zero_iff`. -/
lemma prod_eq_zero {M₀ : Type*} [monoid_with_zero M₀] {L : list M₀} (h : (0 : M₀) ∈ L) :
  L.prod = 0 :=
begin
  induction L with a L ihL,
  { exact absurd h (not_mem_nil _) },
  { rw prod_cons,
    cases (mem_cons_iff _ _ _).1 h with ha hL,
    exacts [mul_eq_zero_of_left ha.symm _, mul_eq_zero_of_right _ (ihL hL)] }
end

/-- Product of elements of a list `L` equals zero if and only if `0 ∈ L`. See also
`list.prod_eq_zero` for an implication that needs weaker typeclass assumptions. -/
@[simp] lemma prod_eq_zero_iff {M₀ : Type*} [monoid_with_zero M₀] [nontrivial M₀]
  [no_zero_divisors M₀] {L : list M₀} :
  L.prod = 0 ↔ (0 : M₀) ∈ L :=
begin
  induction L with a L ihL,
  { simp },
  { rw [prod_cons, mul_eq_zero, ihL, mem_cons_iff, eq_comm] }
end

lemma prod_ne_zero {M₀ : Type*} [monoid_with_zero M₀] [nontrivial M₀] [no_zero_divisors M₀]
  {L : list M₀} (hL : (0 : M₀) ∉ L) : L.prod ≠ 0 :=
mt prod_eq_zero_iff.1 hL

@[to_additive]
lemma prod_eq_foldr : l.prod = foldr (*) 1 l :=
list.rec_on l rfl $ λ a l ihl, by rw [prod_cons, foldr_cons, ihl]

@[to_additive]
lemma prod_hom_rel {α β γ : Type*} [monoid β] [monoid γ] (l : list α) {r : β → γ → Prop}
  {f : α → β} {g : α → γ} (h₁ : r 1 1) (h₂ : ∀⦃a b c⦄, r b c → r (f a * b) (g a * c)) :
  r (l.map f).prod (l.map g).prod :=
list.rec_on l h₁ (λ a l hl, by simp only [map_cons, prod_cons, h₂ hl])

@[to_additive]
lemma prod_hom [monoid β] (l : list α) (f : α →* β) :
  (l.map f).prod = f l.prod :=
by { simp only [prod, foldl_map, f.map_one.symm],
  exact l.foldl_hom _ _ _ 1 f.map_mul }

@[to_additive]
lemma prod_is_unit [monoid β] : Π {L : list β} (u : ∀ m ∈ L, is_unit m), is_unit L.prod
| [] _ := by simp
| (h :: t) u :=
begin
  simp only [list.prod_cons],
  exact is_unit.mul (u h (mem_cons_self h t)) (prod_is_unit (λ m mt, u m (mem_cons_of_mem h mt)))
end

@[simp, to_additive]
lemma prod_take_mul_prod_drop :
  ∀ (L : list α) (i : ℕ), (L.take i).prod * (L.drop i).prod = L.prod
| [] i := by simp
| L 0 := by simp
| (h :: t) (n+1) := by { dsimp, rw [prod_cons, prod_cons, mul_assoc, prod_take_mul_prod_drop] }

@[simp, to_additive]
lemma prod_take_succ :
  ∀ (L : list α) (i : ℕ) (p), (L.take (i + 1)).prod = (L.take i).prod * L.nth_le i p
| [] i p := by cases p
| (h :: t) 0 _ := by simp
| (h :: t) (n+1) _ := by { dsimp, rw [prod_cons, prod_cons, prod_take_succ, mul_assoc] }

/-- A list with product not one must have positive length. -/
@[to_additive]
lemma length_pos_of_prod_ne_one (L : list α) (h : L.prod ≠ 1) : 0 < L.length :=
by { cases L, { simp at h, cases h }, { simp } }

@[to_additive]
lemma prod_update_nth : ∀ (L : list α) (n : ℕ) (a : α),
  (L.update_nth n a).prod =
    (L.take n).prod * (if n < L.length then a else 1) * (L.drop (n + 1)).prod
| (x :: xs) 0     a := by simp [update_nth]
| (x :: xs) (i+1) a := by simp [update_nth, prod_update_nth xs i a, mul_assoc]
| []      _     _ := by simp [update_nth, (nat.zero_le _).not_lt]

open mul_opposite

lemma _root_.mul_opposite.op_list_prod : ∀ (l : list α), op (l.prod) = (l.map op).reverse.prod
| [] := rfl
| (x :: xs) := by rw [list.prod_cons, list.map_cons, list.reverse_cons', list.prod_concat, op_mul,
                      _root_.mul_opposite.op_list_prod]

lemma _root_.mul_opposite.unop_list_prod (l : list αᵐᵒᵖ) :
  (l.prod).unop = (l.map unop).reverse.prod :=
by rw [← op_inj, op_unop, mul_opposite.op_list_prod, map_reverse, map_map, reverse_reverse,
  op_comp_unop, map_id]

end monoid

section group
variables [group α]

/-- This is the `list.prod` version of `mul_inv_rev` -/
@[to_additive "This is the `list.sum` version of `add_neg_rev`"]
lemma prod_inv_reverse : ∀ (L : list α), L.prod⁻¹ = (L.map (λ x, x⁻¹)).reverse.prod
| [] := by simp
| (x :: xs) := by simp [prod_inv_reverse xs]

/-- A non-commutative variant of `list.prod_reverse` -/
@[to_additive "A non-commutative variant of `list.sum_reverse`"]
lemma prod_reverse_noncomm : ∀ (L : list α), L.reverse.prod = (L.map (λ x, x⁻¹)).prod⁻¹ :=
by simp [prod_inv_reverse]

/-- Counterpart to `list.prod_take_succ` when we have an inverse operation -/
@[simp, to_additive /-"Counterpart to `list.sum_take_succ` when we have an negation operation"-/]
lemma prod_drop_succ :
  ∀ (L : list α) (i : ℕ) (p), (L.drop (i + 1)).prod = (L.nth_le i p)⁻¹ * (L.drop i).prod
| [] i p := false.elim (nat.not_lt_zero _ p)
| (x :: xs) 0 p := by simp
| (x :: xs) (i + 1) p := prod_drop_succ xs i _

end group

section comm_group
variables [comm_group α]

/-- This is the `list.prod` version of `mul_inv` -/
@[to_additive "This is the `list.sum` version of `add_neg`"]
lemma prod_inv : ∀ (L : list α), L.prod⁻¹ = (L.map (λ x, x⁻¹)).prod
| [] := by simp
| (x :: xs) := by simp [mul_comm, prod_inv xs]

/-- Alternative version of `list.prod_update_nth` when the list is over a group -/
@[to_additive /-"Alternative version of `list.sum_update_nth` when the list is over a group"-/]
lemma prod_update_nth' (L : list α) (n : ℕ) (a : α) :
  (L.update_nth n a).prod =
    L.prod * (if hn : n < L.length then (L.nth_le n hn)⁻¹ * a else 1) :=
begin
  refine (prod_update_nth L n a).trans _,
  split_ifs with hn hn,
  { rw [mul_comm _ a, mul_assoc a, prod_drop_succ L n hn, mul_comm _ (drop n L).prod,
      ← mul_assoc (take n L).prod, prod_take_mul_prod_drop, mul_comm a, mul_assoc] },
  { simp only [take_all_of_le (le_of_not_lt hn), prod_nil, mul_one,
      drop_eq_nil_of_le ((le_of_not_lt hn).trans n.le_succ)] }
end

end comm_group

lemma eq_of_sum_take_eq [add_left_cancel_monoid α] {L L' : list α} (h : L.length = L'.length)
  (h' : ∀ i ≤ L.length, (L.take i).sum = (L'.take i).sum) : L = L' :=
begin
  apply ext_le h (λ i h₁ h₂, _),
  have : (L.take (i + 1)).sum = (L'.take (i + 1)).sum := h' _ (nat.succ_le_of_lt h₁),
  rw [sum_take_succ L i h₁, sum_take_succ L' i h₂, h' i (le_of_lt h₁)] at this,
  exact add_left_cancel this
end

lemma monotone_sum_take [canonically_ordered_add_monoid α] (L : list α) :
  monotone (λ i, (L.take i).sum) :=
begin
  apply monotone_nat_of_le_succ (λ n, _),
  by_cases h : n < L.length,
  { rw sum_take_succ _ _ h,
    exact le_self_add },
  { push_neg at h,
    simp [take_all_of_le h, take_all_of_le (le_trans h (nat.le_succ _))] }
end

@[to_additive sum_nonneg]
lemma one_le_prod_of_one_le [ordered_comm_monoid α] {l : list α} (hl₁ : ∀ x ∈ l, (1 : α) ≤ x) :
  1 ≤ l.prod :=
begin
  induction l with hd tl ih,
  { simp },
  rw prod_cons,
  exact one_le_mul (hl₁ hd (mem_cons_self hd tl)) (ih (λ x h, hl₁ x (mem_cons_of_mem hd h))),
end

@[to_additive sum_pos]
lemma one_lt_prod_of_one_lt [ordered_comm_monoid α] :
  ∀ (l : list α) (hl : ∀ x ∈ l, (1 : α) < x) (hl₂ : l ≠ []), 1 < l.prod
| [] _ h := (h rfl).elim
| [b] h _ := by simpa using h
| (a :: b :: l) hl₁ hl₂ :=
begin
  simp only [forall_eq_or_imp, list.mem_cons_iff _ a] at hl₁,
  rw list.prod_cons,
  apply one_lt_mul_of_lt_of_le' hl₁.1,
  apply le_of_lt ((b :: l).one_lt_prod_of_one_lt hl₁.2 (l.cons_ne_nil b)),
end
@[to_additive]
lemma single_le_prod [ordered_comm_monoid α] {l : list α} (hl₁ : ∀ x ∈ l, (1 : α) ≤ x) :
  ∀ x ∈ l, x ≤ l.prod :=
begin
  induction l,
  { simp },
  simp_rw [prod_cons, forall_mem_cons] at ⊢ hl₁,
  split,
  { exact le_mul_of_one_le_right' (one_le_prod_of_one_le hl₁.2) },
  { exact λ x H, le_mul_of_one_le_of_le hl₁.1 (l_ih hl₁.right x H) },
end

@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero]
lemma all_one_of_le_one_le_of_prod_eq_one [ordered_comm_monoid α]
  {l : list α} (hl₁ : ∀ x ∈ l, (1 : α) ≤ x) (hl₂ : l.prod = 1) {x : α} (hx : x ∈ l) :
  x = 1 :=
le_antisymm (hl₂ ▸ single_le_prod hl₁ _ hx) (hl₁ x hx)

lemma sum_eq_zero_iff [canonically_ordered_add_monoid α] (l : list α) :
  l.sum = 0 ↔ ∀ x ∈ l, x = (0 : α) :=
⟨all_zero_of_le_zero_le_of_sum_eq_zero (λ _ _, zero_le _),
begin
  induction l,
  { simp },
  { intro h,
    rw [sum_cons, add_eq_zero_iff],
    rw forall_mem_cons at h,
    exact ⟨h.1, l_ih h.2⟩ },
end⟩

/-- If all elements in a list are bounded below by `1`, then the length of the list is bounded
by the sum of the elements. -/
lemma length_le_sum_of_one_le (L : list ℕ) (h : ∀ i ∈ L, 1 ≤ i) : L.length ≤ L.sum :=
begin
  induction L with j L IH h, { simp },
  rw [sum_cons, length, add_comm],
  exact add_le_add (h _ (set.mem_insert _ _)) (IH (λ i hi, h i (set.mem_union_right _ hi)))
end

/-- A list with positive sum must have positive length. -/
-- This is an easy consequence of `length_pos_of_sum_ne_zero`, but often useful in applications.
lemma length_pos_of_sum_pos [ordered_cancel_add_comm_monoid α] (L : list α) (h : 0 < L.sum) :
  0 < L.length :=
length_pos_of_sum_ne_zero L h.ne'

-- TODO: develop theory of tropical rings
lemma sum_le_foldr_max [add_monoid α] [add_monoid β] [linear_order β] (f : α → β)
  (h0 : f 0 ≤ 0) (hadd : ∀ x y, f (x + y) ≤ max (f x) (f y)) (l : list α) :
  f l.sum ≤ (l.map f).foldr max 0 :=
begin
  induction l with hd tl IH,
  { simpa using h0 },
  simp only [list.sum_cons, list.foldr_map, le_max_iff, list.foldr] at IH ⊢,
  cases le_or_lt (f tl.sum) (f hd),
  { left,
    refine (hadd _ _).trans _,
    simpa using h },
  { right,
    refine (hadd _ _).trans _,
    simp only [IH, max_le_iff, and_true, h.le.trans IH] }
end

@[simp, to_additive]
lemma prod_erase [decidable_eq α] [comm_monoid α] {a} :
  ∀ {l : list α}, a ∈ l → a * (l.erase a).prod = l.prod
| (b :: l) h :=
  begin
    obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h,
    { simp only [list.erase, if_pos, prod_cons] },
    { simp only [list.erase, if_neg (mt eq.symm ne), prod_cons, prod_erase h, mul_left_comm a b] }
  end

lemma dvd_prod [comm_monoid α] {a} {l : list α} (ha : a ∈ l) : a ∣ l.prod :=
let ⟨s, t, h⟩ := mem_split ha in
by { rw [h, prod_append, prod_cons, mul_left_comm], exact dvd_mul_right _ _ }

@[simp] lemma sum_const_nat (m n : ℕ) : sum (list.repeat m n) = m * n :=
by induction n; [refl, simp only [*, repeat_succ, sum_cons, nat.mul_succ, add_comm]]

lemma dvd_sum [comm_semiring α] {a} {l : list α} (h : ∀ x ∈ l, a ∣ x) : a ∣ l.sum :=
begin
  induction l with x l ih,
  { exact dvd_zero _ },
  { rw [list.sum_cons],
    exact dvd_add (h _ (mem_cons_self _ _)) (ih (λ x hx, h x (mem_cons_of_mem _ hx))) }
end

lemma exists_lt_of_sum_lt [linear_ordered_cancel_add_comm_monoid β] {l : list α} (f g : α → β)
  (h : (l.map f).sum < (l.map g).sum) :
  ∃ x ∈ l, f x < g x :=
begin
  induction l with x l,
  { exact (lt_irrefl _ h).elim },
  obtain h' | h' := lt_or_le (f x) (g x),
  { exact ⟨x, mem_cons_self _ _, h'⟩ },
  simp at h,
  obtain ⟨y, h1y, h2y⟩ := l_ih (lt_of_add_lt_add_left (h.trans_le $ add_le_add_right h' _)),
  exact ⟨y, mem_cons_of_mem x h1y, h2y⟩,
end

lemma exists_le_of_sum_le [linear_ordered_cancel_add_comm_monoid β] {l : list α} (hl : l ≠ [])
  (f g : α → β) (h : (l.map f).sum ≤ (l.map g).sum) :
  ∃ x ∈ l, f x ≤ g x :=
begin
  cases l with x l,
  { contradiction },
  obtain h' | h' := le_or_lt (f x) (g x),
  { exact ⟨x, mem_cons_self _ _, h'⟩ },
  obtain ⟨y, h1y, h2y⟩ := exists_lt_of_sum_lt f g _,
  exact ⟨y, mem_cons_of_mem x h1y, le_of_lt h2y⟩, simp at h,
  exact lt_of_add_lt_add_left (h.trans_lt $ add_lt_add_right h' _),
end

/-- We'd like to state this as `L.head * L.tail.prod = L.prod`, but because `L.head` relies on an
inhabited instance to return a garbage value on the empty list, this is not possible.
Instead, we write the statement in terms of `(L.nth 0).get_or_else 1` and state the lemma for `ℕ` as
 -/
@[to_additive]
lemma nth_zero_mul_tail_prod [monoid α] (l : list α) :
  (l.nth 0).get_or_else 1 * l.tail.prod = l.prod :=
by cases l; simp

/-- Same as `nth_zero_mul_tail_prod`, but avoiding the `list.head` garbage complication by requiring
the list to be nonempty. -/
@[to_additive]
lemma head_mul_tail_prod_of_ne_nil [monoid α] [inhabited α] (l : list α) (h : l ≠ []) :
  l.head * l.tail.prod = l.prod :=
by cases l; [contradiction, simp]

/-- The product of a list of positive natural numbers is positive,
and likewise for any nontrivial ordered semiring. -/
lemma prod_pos [ordered_semiring α] [nontrivial α] (l : list α) (h : ∀ a ∈ l, (0 : α) < a) :
  0 < l.prod :=
begin
  induction l with a l ih,
  { simp },
  { rw prod_cons,
    exact mul_pos (h _ $ mem_cons_self _ _) (ih $ λ a ha, h a $ mem_cons_of_mem _ ha) }
end

/-!
Several lemmas about sum/head/tail for `list ℕ`.
These are hard to generalize well, as they rely on the fact that `default ℕ = 0`.
If desired, we could add a class stating that `default α = 0`.
-/

/-- This relies on `default ℕ = 0`. -/
lemma head_add_tail_sum (L : list ℕ) : L.head + L.tail.sum = L.sum :=
by { cases L, { simp, refl }, { simp } }

/-- This relies on `default ℕ = 0`. -/
lemma head_le_sum (L : list ℕ) : L.head ≤ L.sum := nat.le.intro (head_add_tail_sum L)

/-- This relies on `default ℕ = 0`. -/
lemma tail_sum (L : list ℕ) : L.tail.sum = L.sum - L.head :=
by rw [← head_add_tail_sum L, add_comm, add_tsub_cancel_right]

section alternating
variables {G : Type*} [comm_group G]

@[simp, to_additive] lemma alternating_prod_nil : alternating_prod ([] : list G) = 1 := rfl

@[simp, to_additive] lemma alternating_prod_singleton (g : G) : alternating_prod [g] = g := rfl

@[simp, to_additive alternating_sum_cons_cons']
lemma alternating_prod_cons_cons (g h : G) (l : list G) :
  alternating_prod (g :: h :: l) = g * h⁻¹ * alternating_prod l := rfl

lemma alternating_sum_cons_cons {G : Type*} [add_comm_group G] (g h : G) (l : list G) :
  alternating_sum (g :: h :: l) = g - h + alternating_sum l :=
by rw [sub_eq_add_neg, alternating_sum]

end alternating

@[to_additive]
lemma _root_.monoid_hom.map_list_prod [monoid α] [monoid β] (f : α →* β) (l : list α) :
  f l.prod = (l.map f).prod :=
(l.prod_hom f).symm

open mul_opposite

/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements -/
lemma _root_.monoid_hom.unop_map_list_prod {α β : Type*} [monoid α] [monoid β] (f : α →* βᵐᵒᵖ)
  (l : list α) :
  unop (f l.prod) = (l.map (unop ∘ f)).reverse.prod :=
by rw [f.map_list_prod l, unop_list_prod, list.map_map]

@[to_additive]
lemma prod_map_hom [monoid β] [monoid γ] (L : list α) (f : α → β) (g : β →* γ) :
  (L.map (g ∘ f)).prod = g ((L.map f).prod) :=
by {rw g.map_list_prod, exact congr_arg _ (map_map _ _ _).symm}

lemma sum_map_mul_left [semiring α] (L : list β) (f : β → α) (r : α) :
  (L.map (λ b, r * f b)).sum = r * (L.map f).sum :=
sum_map_hom L f $ add_monoid_hom.mul_left r

lemma sum_map_mul_right [semiring α] (L : list β) (f : β → α) (r : α) :
  (L.map (λ b, f b * r)).sum = (L.map f).sum * r :=
sum_map_hom L f $ add_monoid_hom.mul_right r

end list


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

import order.bounded_order
import data.set.intervals.basic

/-!
# Intervals in Lattices

In this file, we provide instances of lattice structures on intervals within lattices.
Some of them depend on the order of the endpoints of the interval, and thus are not made
global instances. These are probably not all of the lattice instances that could be placed on these
intervals, but more can be added easily along the same lines when needed.

## Main definitions
In the following, `*` can represent either `c`, `o`, or `i`.
  * `set.Ic*.order_bot`
  * `set.Ii*.semillatice_inf`
  * `set.I*c.order_top`
  * `set.I*c.semillatice_inf`
  * `set.I**.lattice`
  * `set.Iic.bounded_order`, within a `bounded_order`
  * `set.Ici.bounded_order`, within a `bounded_order`

-/

variable {α : Type*}

namespace set

namespace Ico

variables {a b : α}

instance [semilattice_inf α] : semilattice_inf (Ico a b) :=
subtype.semilattice_inf (λ x y hx hy, ⟨le_inf hx.1 hy.1, lt_of_le_of_lt inf_le_left hx.2⟩)

/-- `Ico a b` has a bottom element whenever `a < b`. -/
def order_bot [partial_order α] (h : a < b) : order_bot (Ico a b) :=
{ bot := ⟨a, ⟨le_refl a, h⟩⟩,
  bot_le := λ x, x.prop.1 }

end Ico

namespace Iio

instance [semilattice_inf α] {a : α} : semilattice_inf (Iio a) :=
subtype.semilattice_inf (λ x y hx hy, lt_of_le_of_lt inf_le_left hx)

end Iio

namespace Ioc

variables {a b : α}

instance [semilattice_sup α] : semilattice_sup (Ioc a b) :=
subtype.semilattice_sup (λ x y hx hy, ⟨lt_of_lt_of_le hx.1 le_sup_left, sup_le hx.2 hy.2⟩)

/-- `Ioc a b` has a top element whenever `a < b`. -/
def order_top [partial_order α] (h : a < b) : order_top (Ioc a b) :=
{ top := ⟨b, ⟨h, le_refl b⟩⟩,
  le_top := λ x, x.prop.2 }

end Ioc

namespace Iio

instance [semilattice_sup α] {a : α} : semilattice_sup (Ioi a) :=
subtype.semilattice_sup (λ x y hx hy, lt_of_lt_of_le hx le_sup_left)

end Iio

namespace Iic

variables {a : α}

instance [semilattice_inf α] : semilattice_inf (Iic a) :=
subtype.semilattice_inf (λ x y hx hy, le_trans inf_le_left hx)

instance [semilattice_sup α] : semilattice_sup (Iic a) :=
subtype.semilattice_sup (λ x y hx hy, sup_le hx hy)

instance [lattice α] : lattice (Iic a) :=
{ .. Iic.semilattice_inf,
  .. Iic.semilattice_sup }

instance [preorder α] : order_top (Iic a) :=
{ top := ⟨a, le_refl a⟩,
  le_top := λ x, x.prop }

@[simp] lemma coe_top [partial_order α] {a : α} : ↑(⊤ : Iic a) = a := rfl

instance [preorder α] [order_bot α] : order_bot (Iic a) :=
{ bot := ⟨⊥, bot_le⟩,
  bot_le := λ ⟨_,_⟩, subtype.mk_le_mk.2 bot_le }

@[simp] lemma coe_bot [preorder α] [order_bot α] {a : α} : ↑(⊥ : Iic a) = (⊥ : α) := rfl

instance [partial_order α] [no_bot_order α] {a : α} : no_bot_order (Iic a) :=
⟨λ x, let ⟨y, hy⟩ := no_bot x.1 in ⟨⟨y, le_trans hy.le x.2⟩, hy⟩ ⟩

instance [preorder α] [bounded_order α] : bounded_order (Iic a) :=
{ .. Iic.order_top,
  .. Iic.order_bot }

end Iic

namespace Ici

variables {a : α}

instance [semilattice_inf α] : semilattice_inf (Ici a) :=
subtype.semilattice_inf (λ x y hx hy, le_inf hx hy)

instance [semilattice_sup α] : semilattice_sup (Ici a) :=
subtype.semilattice_sup (λ x y hx hy, le_trans hx le_sup_left)

instance [lattice α] : lattice (Ici a) :=
{ .. Ici.semilattice_inf,
  .. Ici.semilattice_sup }

instance [preorder α] : order_bot (Ici a) :=
{ bot := ⟨a, le_refl a⟩,
  bot_le := λ x, x.prop }

@[simp] lemma coe_bot [partial_order α] {a : α} : ↑(⊥ : Ici a) = a := rfl

instance [preorder α] [order_top α] : order_top (Ici a) :=
{ top := ⟨⊤, le_top⟩,
  le_top := λ ⟨_,_⟩, subtype.mk_le_mk.2 le_top }

@[simp] lemma coe_top [preorder α] [order_top α] {a : α} : ↑(⊤ : Ici a) = (⊤ : α) := rfl

instance [partial_order α] [no_top_order α] {a : α} : no_top_order (Ici a) :=
⟨λ x, let ⟨y, hy⟩ := no_top x.1 in ⟨⟨y, le_trans x.2 hy.le⟩, hy⟩ ⟩

instance [preorder α] [bounded_order α] : bounded_order (Ici a) :=
{ .. Ici.order_top,
  .. Ici.order_bot }

end Ici

namespace Icc

instance [semilattice_inf α] {a b : α} : semilattice_inf (Icc a b) :=
subtype.semilattice_inf (λ x y hx hy, ⟨le_inf hx.1 hy.1, le_trans inf_le_left hx.2⟩)

instance [semilattice_sup α] {a b : α} : semilattice_sup (Icc a b) :=
subtype.semilattice_sup (λ x y hx hy, ⟨le_trans hx.1 le_sup_left, sup_le hx.2 hy.2⟩)

instance [lattice α] {a b : α} : lattice (Icc a b) :=
{ .. Icc.semilattice_inf,
  .. Icc.semilattice_sup }

/-- `Icc a b` has a bottom element whenever `a ≤ b`. -/
def order_bot [preorder α] {a b : α} (h : a ≤ b) : order_bot (Icc a b) :=
{ bot := ⟨a, ⟨le_refl a, h⟩⟩,
  bot_le := λ x, x.prop.1 }

/-- `Icc a b` has a top element whenever `a ≤ b`. -/
def order_top [preorder α] {a b : α} (h : a ≤ b) : order_top (Icc a b) :=
{ top := ⟨b, ⟨h, le_refl b⟩⟩,
  le_top := λ x, x.prop.2 }

/-- `Icc a b` is a `bounded_order` whenever `a ≤ b`. -/
def bounded_order [preorder α] {a b : α} (h : a ≤ b) :
  bounded_order (Icc a b) :=
{ .. Icc.order_top h,
  .. Icc.order_bot h }

end Icc

end set


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hp,
  apply not_not_intro,
  assumption,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro hp,
  by_contradiction h,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  { intro hp,
    apply doubleneg_elim,
    assumption,
  },
  {intro hp,
  apply doubleneg_intro,
  assumption,
  }
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro hor,
  cases hor with hp hq,
  { right,
    assumption,
  },
  { left,
    assumption,
  }
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  cases h with hp hq,
  split,
  {
    assumption,
  },
  {
    assumption,
  }
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro pq,
  intro hp,
  cases pq with p q,
  case or.inr{
    assumption
  },
  case or.inl{
    by contradiction
  },
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro pq,
  intro hp,
  cases pq with p q,
  case or.inr{
    assumption
  },
  case or.inl{
    by contradiction
  },

end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro pq,
  intro nq,
  intro hp,
  apply nq,
  apply pq,
  assumption,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros nqnp p,
  by_cases h : Q,
  {
    assumption,
  },
  {
    by_contra,
    apply nqnp,
    assumption,
    exact p,
  },
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,{
    intro pq,
    apply impl_as_contrapositive,
    assumption,
  },
  {
    intro npnq,
    apply impl_as_contrapositive_converse,
    assumption,
  },
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P ∨ ¬P)  :=
begin
  intro npnp,
  apply npnp,
  right,
  intro p,
  apply npnp,
  left,
  assumption,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intros pqp np,
  apply np,
  apply pqp,
  intro p,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P ∨ Q → ¬(¬P ∧ ¬Q)  :=
begin
  intro pvq,
  cases pvq with p q,
  case or.inl{
    intro npeq,
    cases npeq with np nq,
    by contradiction,
  },
  case or.inr{
    intro npeq,
    cases npeq with np nq,
    by contradiction,
  }
end

theorem conj_as_negdisj :
  P ∧ Q → ¬(¬P ∨ ¬Q)  :=
begin
  intro peq,
  cases peq with p q,
  intro nnpvq,
  cases nnpvq with np nq,
  case or.inl{
    by contradiction,
    },
  case or.inr{
    by contradiction,
  }
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P ∨ Q) → (¬P ∧ ¬Q)  :=
begin
  intro npvnq,
  split,
  {
    intro p,
    apply npvnq,
    left,
    assumption,
  },
  {
    intro q,
    apply npvnq,
    right,
    assumption,
  }
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P ∨ Q)  :=
begin
  intro npenq,
  cases npenq with np nq,
  {
   intro pvq,
   cases pvq with p q,
   case or.inl{
    by contradiction,
   },
   case or.inr{
     by contradiction,
   },
  }
end

theorem demorgan_conj :
  ¬(P ∧ Q) → (¬Q ∨ ¬P)  :=
begin
  intro npeq,
  by_cases h : P,
  {
    left,
    intro q,
    apply npeq,
    split,
    assumption,
    assumption,
  },
  {
    right,
    assumption,
  }
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P ∧ Q)  :=
begin
  intro npvnq,
  cases npvnq with nq np,
  case or.inl{
    intro peq,
    cases peq with p q,
    by contradiction,
  },
  case or.inr{
    intro peq,
    cases peq with p q,
    by contradiction,
  },
end

theorem demorgan_conj_law :
  ¬(P ∧ Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,{
    intro npeq,
    apply demorgan_conj,
    assumption,
  },
  {
    intro npvnq,
    apply demorgan_conj_converse,
    assumption,
  },
end

theorem demorgan_disj_law :
  ¬(P ∨ Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,{
    intro npvq,
    apply demorgan_disj,
    assumption,
  },
  {
    intro npenq,
    apply demorgan_disj_converse,
    assumption,
  },
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P ∧ (Q ∨ R) → (P ∧ Q) ∨ (P ∧ R)  :=
begin
  intro peqvr,
  cases peqvr with p qvr,
  cases qvr with q r,
  case or.inl{
    left,
    split,{
      assumption,
    },
    {
      assumption,
    },
  },
  case or.inr{
    right,
    split,{
      assumption,
    },
    {
      assumption,
    },
  },
end

theorem distr_conj_disj_converse :
  (P ∧ Q) ∨ (P ∧ R) → P ∧ (Q ∨ R)  :=
begin
  intro peqvper,
  cases peqvper with peq per,
  case or.inl{
    split,{
      cases peq with p q,
      assumption,
    },
    {
      cases peq with p q,
      left,
      assumption,
    },
  },
  case or.inr{
    split,{
      cases per with p r,
      assumption,
    },
    {
      cases per with p r,
      right,
      assumption,
    },
  },
end

theorem distr_disj_conj :
  P ∨ (Q ∧ R) → (P ∨ Q) ∧ (P ∨ R)  :=
begin
  intro pvqer,
  cases pvqer with p per,
  case or.inr{
    split,{
      cases per with q r,
      right,{
        assumption,
      },
    },
      cases per with q r,
      right,{
        assumption,
    },
  },
  case or.inl{
    split,
    left,{
      assumption,
    },
    left,{
      assumption,
    },
  },
end

theorem distr_disj_conj_converse :
  (P ∨ Q) ∧ (P ∨ R) → P ∨ (Q ∧ R)  :=
begin
  intro pvqepvr,
  cases pvqepvr with pvq pvr,
  cases pvq with p q,{
    cases pvr with p r,{
      left,
      assumption,
    },
    left,
    assumption,
  },
  case or.inr{
    cases pvr with p r,{
      case or.inl{
        left,
        assumption,
      },
    },
    case or.inr or.inr{
      right,
      split,
      assumption,
      assumption,
    },
  },
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P ∧ Q) → R) → (P → (Q → R))  :=
begin
  intros peqr p q,
  apply peqr,
  split,
  assumption,
  assumption,
end

theorem uncurry_prop :
  (P → (Q → R)) → ((P ∧ Q) → R)  :=
begin
  intros pqr peq,
  cases peq with p q,
  apply pqr,
  assumption,
  assumption,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro p,
  exact p,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P ∨ Q)  :=
begin
  intro p,
  left,
  exact p,
end

theorem weaken_disj_left :
  Q → (P ∨ Q)  :=
begin
  intro q,
  right,
  exact q,
end

theorem weaken_conj_right :
  (P ∧ Q) → P  :=
begin
  intro peq,
  cases peq with p q,
  exact p,
end

theorem weaken_conj_left :
  (P ∧ Q) → Q  :=
begin
  intro peq,
  cases peq with p q,
  exact q,
end

theorem conj_idempot :
  (P ∧ P) ↔ P :=
begin
  split,{
    intro pep,
    cases pep with p,
    exact p,
    },
    {
      intro p,
      split,
      exact p,
      exact p,
    },
end

theorem disj_idempot :
  (P ∨ P) ↔ P  :=
begin
  split,{
    intro pvp,
    cases pvp with p p',
    case or.inl{
      exact p,
    },
    case or.inr{
      exact p',
    },
  },
  intro p'',
  right,
  exact p'',
end

end propositional

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

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intros nexu u,
  by_contradiction boom,
  apply nexu,
  existsi u,
  assumption,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intros ptxu exu,
  cases exu with u pu,
  apply ptxu,
  assumption,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  rw contrapositive_law,
  rw doubleneg_law,
  intro npx,
  intro u,
  by_contradiction boom,
  apply npx,
  existsi u,
  apply boom,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intros enpx ptx,
  cases enpx with u npu,
  apply npu,
  exact ptx u,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
    split,{
      intro nptx,
      apply demorgan_forall,
      assumption,
    },
    {
      intro enpx,
      apply demorgan_forall_converse,
      assumption,
    },
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,{
    intros npex u pu,
    apply npex,
    existsi u,
    assumption,
  },
  {
  intros ptxnp exu,
  cases exu with u pu,
  apply ptxnp,
  assumption,
  },
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intros pex ptx,
  cases pex with u pu,
  apply ptx,
  assumption,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intros ptx eunp,
  by_contradiction boom,
  cases eunp with u npu,
  apply npu,
  exact ptx u,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intros nex u,
  by_contradiction boom,
  apply nex,
  existsi u,
  assumption,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro nptnx,
  by_contradiction boom,
  apply nptnx,
  intro u,
  by_cases h : P u,
  intro q,
  apply boom,
  split,{
    exact h
  },
  assumption,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,{
    intros ptx enx,
    cases enx with u npu,
    apply npu,
    exact ptx u,
  },
  {
    intros nenpx u,
    by_contradiction boom,
    apply nenpx,
    existsi u,
    assumption,
  },
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,{
    intros pex nptx,
    cases pex with u pu,
    apply nptx,
    exact pu,
  },
  {
    intro nptpx,
    by_contradiction boom,
    apply nptpx,
    intro u,
    by_cases h : P u,
    intro pu,
    apply boom,
    split,{
      exact h
    },
    assumption,
  },
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro expeq,
  cases expeq with u peq,{
    cases peq with pu qu,{
      split,{
        split,{
          exact pu,
        },
      },
      split,{
        exact qu,
      },
      },
    },
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro expvq,
  cases expvq with u puvqu,{
    cases puvqu with pu qu,{
      case or.inl{
        left,{
          split,{
            exact pu,
          },
        },
      },
    },
    case or.inr{
      right,{
        split,{
          exact qu,
        },
      },
    },
  },
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro epxveqx,
  cases epxveqx with epx eqx,{
    cases epx with u pu,{
      split,{
        left,{
          exact pu,
        },
      },
    },
  },
  case or.inr{
    cases eqx with u qu,{
      split,{
        right,{
          exact qu,
        },
      },
    },
  },
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro ptpeq,
  split,{
    intro u,
    by_cases h : P u,{
      assumption,
    },
    {
      sorry,
    },
  },
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intros ptpeq u,
  cases ptpeq with px qx,{
    split,{
      exact px u,
    },
    {
      exact qx u,
    },
  },
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intros ptpvq u,
  cases ptpvq with px qx,
    case or.inl{
      left,{
        exact px u,
      },
    },
    case or.inr{
      right,{
        exact qx u,
      },
    },
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

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

end predicate


import ring_theory.polynomial.basic
-- The contents of this file is not needed anymore

lemma is_unit_sub_of_is_unit_of_is_nilpotent {M : Type*} [comm_ring M] {a b : M}
  (ha : is_unit a) (hb : is_nilpotent b) : is_unit (a - b) :=
begin
  refine @is_unit_of_mul_is_unit_left _ _ _ ↑(ha.unit⁻¹) _,
  rw [sub_mul, is_unit.mul_coe_inv],
  obtain ⟨n, hn⟩ := commute.is_nilpotent_mul_left (mul_comm b ↑(ha.unit)⁻¹) hb,
  exact is_unit_of_mul_eq_one _ _ ((mul_neg_geom_sum _ n).trans $ hn.symm ▸ sub_zero 1)
end

lemma is_unit_add_of_is_unit_of_is_nilpotent {M : Type*} [comm_ring M] {a b : M}
  (ha : is_unit a) (hb : is_nilpotent b) : is_unit (a + b) :=
sub_neg_eq_add a b ▸ is_unit_sub_of_is_unit_of_is_nilpotent ha hb.neg

lemma is_nilpotent.sum {M : Type*} [comm_semiring M] {ι : Type*} (s : finset ι)
  (f : ι → M) (hf : ∀ i ∈ s, is_nilpotent (f i)) : is_nilpotent (s.sum f) :=
begin
  classical,
  induction s using finset.induction_on with a s h₁ h₂,
  { rw finset.sum_empty, exact is_nilpotent.zero },
  { rw [finset.sum_insert h₁],
    exact commute.is_nilpotent_add (mul_comm _ _) (hf a (finset.mem_insert_self _ _))
      (h₂ $ λ i hi, hf _ (finset.mem_insert_of_mem hi)) }
end

open_locale polynomial

lemma polynomial.is_unit_iff' {R : Type*} [comm_ring R] {p : R[X]} :
  is_unit p ↔ is_unit (p.coeff 0) ∧ ∀ i ≠ 0, is_nilpotent (p.coeff i) :=
begin
  split,
  { intro h,
    rw polynomial.coeff_zero_eq_eval_zero,
    refine ⟨(polynomial.eval_ring_hom (0 : R)).is_unit_map h, λ i hi, _⟩,
    change p.coeff i ∈ nilradical R,
    rw [nilradical_eq_Inf, ideal.mem_Inf],
    rintros I (hI : I.is_prime),
    have := ring_hom.is_unit_map (polynomial.map_ring_hom I^.quotient.mk) h,
    resetI,
    obtain ⟨r, h₁, h₂⟩ := polynomial.is_unit_iff.mp this,
    apply_fun (λ x, polynomial.coeff x i) at h₂,
    rwa [polynomial.coeff_C_ne_zero hi, polynomial.coe_map_ring_hom, polynomial.coeff_map,
      ← ideal.quotient.mk_eq_mk, eq_comm, submodule.quotient.mk_eq_zero] at h₂ },
  { rintro ⟨h₁, h₂⟩,
    casesI subsingleton_or_nontrivial R, { exact is_unit_of_subsingleton _ },
    have : 0 ∈ p.support,
    { rw [polynomial.mem_support_iff], intro e, rw e at h₁, exact not_is_unit_zero h₁ },
    rw [← p.sum_monomial_eq, polynomial.sum, ← finset.sum_filter_add_sum_filter_not _ (eq 0),
      finset.filter_eq p.support 0, if_pos this, finset.sum_singleton,
      polynomial.monomial_zero_left],
    apply is_unit_add_of_is_unit_of_is_nilpotent (polynomial.C.is_unit_map h₁),
    apply is_nilpotent.sum,
    intros i hi, rw [← mul_one (p.coeff i), ← polynomial.C_mul_monomial],
    exact commute.is_nilpotent_mul_left (mul_comm _ _)
      ((h₂ i $ ne_comm.mp (finset.mem_filter.mp hi).2).map polynomial.C) }
end


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

universes u

namespace Mathlib

/-!
# Extra lemmas about intervals

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

namespace set

@[simp] theorem Iic_disjoint_Ioi {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) : disjoint (Iic a) (Ioi b) := sorry

@[simp] theorem Iic_disjoint_Ioc {α : Type u} [preorder α] {a : α} {b : α} {c : α} (h : a ≤ b) : disjoint (Iic a) (Ioc b c) :=
  disjoint.mono (le_refl (Iic a)) (fun (_x : α) => and.left) (Iic_disjoint_Ioi h)

@[simp] theorem Ioc_disjoint_Ioc_same {α : Type u} [preorder α] {a : α} {b : α} {c : α} : disjoint (Ioc a b) (Ioc b c) :=
  disjoint.mono (fun (_x : α) => and.right) (le_refl (Ioc b c)) (Iic_disjoint_Ioc (le_refl b))

@[simp] theorem Ico_disjoint_Ico_same {α : Type u} [preorder α] {a : α} {b : α} {c : α} : disjoint (Ico a b) (Ico b c) :=
  fun (x : α) (hx : x ∈ Ico a b ⊓ Ico b c) => not_le_of_lt (and.right (and.left hx)) (and.left (and.right hx))

@[simp] theorem Ico_disjoint_Ico {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α} {b₂ : α} : disjoint (Ico a₁ a₂) (Ico b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ := sorry

@[simp] theorem Ioc_disjoint_Ioc {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α} {b₂ : α} : disjoint (Ioc a₁ a₂) (Ioc b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ := sorry

/-- If two half-open intervals are disjoint and the endpoint of one lies in the other,
  then it must be equal to the endpoint of the other. -/
theorem eq_of_Ico_disjoint {α : Type u} [linear_order α] {x₁ : α} {x₂ : α} {y₁ : α} {y₂ : α} (h : disjoint (Ico x₁ x₂) (Ico y₁ y₂)) (hx : x₁ < x₂) (h2 : x₂ ∈ Ico y₁ y₂) : y₁ = x₂ := sorry


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

import algebra.algebra.tower
import ring_theory.norm -- for norms
import ring_theory.trace -- for traces

/-

# Extensions of extensions

The problem with making every field a type and using `algebra` to
fix the embeddings from a smaller field to a bigger one, is that
when you have three or more extensions, you need to have a way of
saying that those maps are compatible.

On paper we might write "Let `E ⊆ F ⊆ K` be a tower of fields"
but in Lean we make each each pair into an `algebra` structure
and now we want to somehow explain that the `algebra_map` from
`E` to `F` composed with the one from `F` to `K` equals the
one from `E` to `K`. We assert this compatibility with
the `is_scalar_tower E F K` typeclass. Here's the proof
that in the presence of this prop-valued hypothesis, the
diagram commutes.

-/

example (E F K : Type) [field E] [field F] [field K] [algebra E F] [algebra F K]
  [algebra E K] [is_scalar_tower E F K] (e : E) :
  algebra_map E K e = algebra_map F K (algebra_map E F e) := is_scalar_tower.algebra_map_apply E F K e

/-

For me, what is surprising is that the definition of `is_scalar_tower` is
not at all what one would expect. The idea is due to Kenny Lau (a former Imperial
undergraduate) in 2020; Eric Wieser wrote a paper on how the system works in 2021
https://arxiv.org/abs/2108.10700  (this is Eric on the Discord). Guess what the
definition is and then right click on `is_scalar_tower` and jump to definition
to find out the truth (which might surprise you).

Now we have three compatible field extensions we can ask how the basic constructions
such as degree, norm and trace behave.

-/

variables (E F K : Type) [field E] [field F] [field K] [algebra E F] [algebra F K]
  [algebra E K] [is_scalar_tower E F K]

-- There is a mathematically correct tower law, involving cardinals:
example : module.rank E F * module.rank F K = module.rank E K := dim_mul_dim E F K

-- But this is a pain to use, because cardinals are not a particularly well-behaved
-- object. So let's put in a finite-dimensional hypothesis and use `finrank`.

open finite_dimensional

-- Tower law for dimensions, natural number case.
example [finite_dimensional E F] : finrank E F * finrank F K = finrank E K := finrank_mul_finrank E F K

/- Note that if K/F is infinite-dimensional then `finrank F K = 0` as does `finrank E K`.
The same argument should apply if F/E is infinite-dimensional; this seems to be a minor
glitch in mathlib!
-/

-- Tricky exercise: look at proof of `finrank_mul_finrank` in mathlib and see if you
-- can generalise it by removing the `[finite_dimensional E F]` condition in the case
-- where everything is a field.
example : finrank E F * finrank F K = finrank E K :=
begin
  sorry,
end

-- trace of trace is trace in a tower
example [finite_dimensional E F] [finite_dimensional F K] (k : K) :
  (algebra.trace E F) ((algebra.trace F K) k) = (algebra.trace E K) k := algebra.trace_trace k

-- I can't find the norm version though :-/


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.abel
import data.polynomial.eval

/-!
# The Pochhammer polynomials

We define and prove some basic relations about
`pochhammer S n : polynomial S = X * (X+1) * ... * (X + n - 1)`
which is also known as the rising factorial.

## Implementation

As with many other families of polynomials, even though the coefficients are always in `ℕ`,
we define the polynomial with coefficients in any `[semiring S]`.

## TODO

There is lots more in this direction:
* q-factorials, q-binomials, q-Pochhammer.
* Defining Bernstein polynomials (e.g. as one way to prove Weierstrass' theorem).
-/

universes u v

open polynomial

section
variables (S : Type u) [semiring S]

/--
`pochhammer S n` is the polynomial `X * (X+1) * ... * (X + n - 1)`,
with coefficients in the semiring `S`.
-/
noncomputable def pochhammer : ℕ → polynomial S
| 0 := 1
| (n+1) := X * (pochhammer n).comp (X + 1)

@[simp] lemma pochhammer_zero : pochhammer S 0 = 1 := rfl
@[simp] lemma pochhammer_one : pochhammer S 1 = X := by simp [pochhammer]
lemma pochhammer_succ_left (n : ℕ) : pochhammer S (n+1) = X * (pochhammer S n).comp (X+1) :=
by { dsimp [pochhammer], refl, }

section
variables {S} {T : Type v} [semiring T]
@[simp] lemma pochhammer_map (f : S →+* T) (n : ℕ) : (pochhammer S n).map f = pochhammer T n :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih, pochhammer_succ_left, map_comp], },
end

end

@[simp, norm_cast] lemma pochhammer_eval_cast (n k : ℕ) :
  ((pochhammer ℕ n).eval k : S) = (pochhammer S n).eval k :=
begin
  rw [←pochhammer_map (algebra_map ℕ S), eval_map, ←(algebra_map ℕ S).eq_nat_cast,
    eval₂_at_nat_cast, nat.cast_id, ring_hom.eq_nat_cast],
end

lemma pochhammer_eval_zero {n : ℕ} : (pochhammer S n).eval 0 = if n = 0 then 1 else 0 :=
begin
  cases n,
  { simp, },
  { simp [X_mul, nat.succ_ne_zero, pochhammer_succ_left], }
end

lemma pochhammer_zero_eval_zero : (pochhammer S 0).eval 0 = 1 :=
by simp

@[simp] lemma pochhammer_ne_zero_eval_zero {n : ℕ} (h : n ≠ 0) : (pochhammer S n).eval 0 = 0 :=
by simp [pochhammer_eval_zero, h]

lemma pochhammer_succ_right (n : ℕ) : pochhammer S (n+1) = pochhammer S n * (X + n) :=
begin
  suffices h : pochhammer ℕ (n+1) = pochhammer ℕ n * (X + n),
  { apply_fun polynomial.map (algebra_map ℕ S) at h,
    simpa only [pochhammer_map, map_mul, map_add, map_X, map_nat_cast] using h, },
  induction n with n ih,
  { simp, },
  { conv_lhs {
    rw [pochhammer_succ_left, ih, mul_comp, ←mul_assoc, ←pochhammer_succ_left, add_comp, X_comp,
      nat_cast_comp, add_assoc, add_comm (1 : polynomial ℕ)], },
    refl, },
end

lemma polynomial.mul_X_add_nat_cast_comp {p q : polynomial S} {n : ℕ} :
  (p * (X + n)).comp q = (p.comp q) * (q + n) :=
by rw [mul_add, add_comp, mul_X_comp, ←nat.cast_comm, nat_cast_mul_comp, nat.cast_comm, mul_add]

lemma pochhammer_mul (n m : ℕ) :
  pochhammer S n * (pochhammer S m).comp (X + n) = pochhammer S (n + m) :=
begin
  induction m with m ih,
  { simp, },
  { rw [pochhammer_succ_right, polynomial.mul_X_add_nat_cast_comp, ←mul_assoc, ih,
      nat.succ_eq_add_one, ←add_assoc, pochhammer_succ_right, nat.cast_add, add_assoc], }
end

end

section
variables {S : Type*} [ordered_semiring S] [nontrivial S]

lemma pochhammer_pos (n : ℕ) (s : S) (h : 0 < s) : 0 < (pochhammer S n).eval s :=
begin
  induction n with n ih,
  { simp only [nat.nat_zero_eq_zero, pochhammer_zero, eval_one], exact zero_lt_one, },
  { rw [pochhammer_succ_right, mul_add, eval_add, ←nat.cast_comm, eval_nat_cast_mul, eval_mul_X,
      nat.cast_comm, ←mul_add],
    exact mul_pos ih
      (lt_of_lt_of_le h ((le_add_iff_nonneg_right _).mpr (nat.cast_nonneg n))), }
end

end

section factorial

open_locale nat

/-- Preliminary version of `pochhammer_eval_one` specialized to `S = ℕ`. -/
lemma pochhammer_eval_one' (n : ℕ) : (pochhammer ℕ n).eval 1 = n! :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih, mul_comm, nat.succ_eq_add_one, add_comm, pochhammer_succ_right], },
end

@[simp]
lemma pochhammer_eval_one (S : Type*) [semiring S] (n : ℕ) :
  (pochhammer S n).eval (1 : S) = (n! : S) :=
by simpa using congr_arg (algebra_map ℕ S) (pochhammer_eval_one' n)

/-- Preliminary version of `factorial_mul_pochhammer` specialized to `S = ℕ`. -/
lemma factorial_mul_pochhammer' (r n : ℕ) :
  r! * (pochhammer ℕ n).eval (r+1) = (r + n)! :=
by simpa [add_comm 1 r, pochhammer_eval_one'] using congr_arg (eval 1) (pochhammer_mul ℕ r n)

lemma factorial_mul_pochhammer (S : Type*) [semiring S] (r n : ℕ) :
  (r! : S) * (pochhammer S n).eval (r+1) = (r + n)! :=
by simpa using congr_arg (algebra_map ℕ S) (factorial_mul_pochhammer' r n)

lemma pochhammer_eval_eq_factorial_div_factorial {r n : ℕ} :
  (pochhammer ℕ n).eval (r+1) = (r + n)! / r! :=
(nat.div_eq_of_eq_mul_right (nat.factorial_pos _) (factorial_mul_pochhammer' r n).symm).symm

lemma pochhammer_eval_eq_choose_mul_factorial {r n : ℕ} :
  (pochhammer ℕ n).eval (r+1) = (r + n).choose n * n! :=
begin
  rw pochhammer_eval_eq_factorial_div_factorial,
  -- TODO we need a `clear_denominators` tactic!
  apply nat.div_eq_of_eq_mul_right (nat.factorial_pos _),
  rw [mul_comm],
  convert (nat.choose_mul_factorial_mul_factorial (nat.le_add_left n r)).symm,
  simp,
end

lemma choose_eq_pochhammer_eval_div_factorial {r n : ℕ} :
  (r + n).choose n = (pochhammer ℕ n).eval (r+1) / n! :=
begin
  symmetry,
  apply nat.div_eq_of_eq_mul_right (nat.factorial_pos _),
  rw [mul_comm, pochhammer_eval_eq_choose_mul_factorial],
end

end factorial


variables (P Q R : Prop)

-- proof term
example: ∀  (P Q: Prop), ∀ (p : P), Q :=
    λ (p0: P),
        _

--proof script
example: ∀ (P Q: Prop), ∀ (p:P), Q :=
begin
intros,
_
end

-- both of the above are the same

/-
FORALL ELIMINATION

-/
example :
    (∀ (p:P), Q) →
    (P → Q):=
    λ h,
        λ p,
            (h p)

example:
    (∀ (p:P), Q) →  -- arrows are right associative
    P →
    Q :=
λ (f : ∀ (p:P), Q), -- proof of ∀
    λ  (p:P),       -- proof of P
    (f p)              -- ∀ elimination

/-
to show x ⇒ y

assume x, show y

a proof of this is a function from x → y.
X is a parameter
-/

example: P → Q → P ∧ Q :=

λ (p:P),
    λ (q: Q),
        and.intro p q

example: (P ∧ Q) → P :=
λ (h: P ∧ Q), -- given proof of p ∧ q
    and.elim_left h -- return Q proof

-- if you know 2 things are equal then you can make certain substitutions in the process  -> elimination or *rewrite*

axiom L: P → Prop -- assume some predicate L

example : ∀ (a b:P), a = b → (L a → L b) :=
    λ a b, -- assume a and b are values of P
    λ heq, -- assume a proof of a = b
    λ la, -- assume a proof of (L a)
    (eq.subst heq la)  -- deduce proof of (L b)

example : P ∧ Q → Q ∧ P :=
λ (pq : P ∧ Q), -- assume proof P ∧ Q
    and.intro       -- apply and.intro
        pq.right  -- proof of Q
        pq.left     -- proof of P

/-
what does it mean to say ¬ P?
¬ p is true when there are no proofs of P,

Meet "false". - a proposition itself which is never true

a proposition with no proofs

it is literally an empty type.
a type with no values

inductive false: Prop
-/

#check false

def f: false → 0 = 1
| p := false.elim p

/-
¬ P === P → false
-/


/-
Copyright (c) 2022 Jiale Miao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jiale Miao, Kevin Buzzard, Alexander Bentkamp
-/

import analysis.inner_product_space.projection
import order.well_founded_set
import analysis.inner_product_space.pi_L2

/-!
# Gram-Schmidt Orthogonalization and Orthonormalization

In this file we introduce Gram-Schmidt Orthogonalization and Orthonormalization.

The Gram-Schmidt process takes a set of vectors as input
and outputs a set of orthogonal vectors which have the same span.

## Main results

- `gram_schmidt` : the Gram-Schmidt process
- `gram_schmidt_orthogonal` :
  `gram_schmidt` produces an orthogonal system of vectors.
- `span_gram_schmidt` :
  `gram_schmidt` preserves span of vectors.
- `gram_schmidt_ne_zero` :
  If the input vectors of `gram_schmidt` are linearly independent,
  then the output vectors are non-zero.
- `gram_schmidt_basis` :
  The basis produced by the Gram-Schmidt process when given a basis as input.
- `gram_schmidt_normed` :
  the normalized `gram_schmidt` (i.e each vector in `gram_schmidt_normed` has unit length.)
- `gram_schmidt_orthornormal` :
  `gram_schmidt_normed` produces an orthornormal system of vectors.

## TODO
  Construct a version with an orthonormal basis from Gram-Schmidt process.
-/

open_locale big_operators
open finset

variables (𝕜 : Type*) {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
variables {ι : Type*} [linear_order ι] [locally_finite_order_bot ι] [is_well_order ι (<)]

local attribute [instance] is_well_order.to_has_well_founded

local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

/-- The Gram-Schmidt process takes a set of vectors as input
and outputs a set of orthogonal vectors which have the same span. -/
noncomputable def gram_schmidt (f : ι → E) : ι → E
| n := f n - ∑ i : Iio n, orthogonal_projection (𝕜 ∙ gram_schmidt i) (f n)
using_well_founded { dec_tac := `[exact mem_Iio.1 i.2] }

/-- This lemma uses `∑ i in` instead of `∑ i :`.-/
lemma gram_schmidt_def (f : ι → E) (n : ι):
  gram_schmidt 𝕜 f n = f n - ∑ i in Iio n,
    orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) :=
by { rw [←sum_attach, attach_eq_univ, gram_schmidt], refl }

lemma gram_schmidt_def' (f : ι → E) (n : ι):
  f n = gram_schmidt 𝕜 f n + ∑ i in Iio n,
    orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) :=
by rw [gram_schmidt_def, sub_add_cancel]

@[simp] lemma gram_schmidt_zero {ι : Type*} [linear_order ι] [locally_finite_order ι]
  [order_bot ι] [is_well_order ι (<)] (f : ι → E) : gram_schmidt 𝕜 f ⊥ = f ⊥ :=
by rw [gram_schmidt_def, Iio_eq_Ico, finset.Ico_self, finset.sum_empty, sub_zero]

/-- **Gram-Schmidt Orthogonalisation**:
`gram_schmidt` produces an orthogonal system of vectors. -/
theorem gram_schmidt_orthogonal (f : ι → E) {a b : ι} (h₀ : a ≠ b) :
  ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0 :=
begin
  suffices : ∀ a b : ι, a < b → ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0,
  { cases h₀.lt_or_lt with ha hb,
    { exact this _ _ ha, },
    { rw inner_eq_zero_sym,
      exact this _ _ hb, }, },
  clear h₀ a b,
  intros a b h₀,
  revert a,
  apply well_founded.induction (@is_well_order.wf ι (<) _) b,
  intros b ih a h₀,
  simp only [gram_schmidt_def 𝕜 f b, inner_sub_right, inner_sum,
    orthogonal_projection_singleton, inner_smul_right],
  rw finset.sum_eq_single_of_mem a (finset.mem_Iio.mpr h₀),
  { by_cases h : gram_schmidt 𝕜 f a = 0,
    { simp only [h, inner_zero_left, zero_div, zero_mul, sub_zero], },
    { rw [← inner_self_eq_norm_sq_to_K, div_mul_cancel, sub_self],
      rwa [ne.def, inner_self_eq_zero], }, },
  simp_intros i hi hia only [finset.mem_range],
  simp only [mul_eq_zero, div_eq_zero_iff, inner_self_eq_zero],
  right,
  cases hia.lt_or_lt with hia₁ hia₂,
  { rw inner_eq_zero_sym,
    exact ih a h₀ i hia₁ },
  { exact ih i (mem_Iio.1 hi) a hia₂ }
end

/-- This is another version of `gram_schmidt_orthogonal` using `pairwise` instead. -/
theorem gram_schmidt_pairwise_orthogonal (f : ι → E) :
  pairwise (λ a b, ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0) :=
λ a b, gram_schmidt_orthogonal 𝕜 f

open submodule set order

lemma mem_span_gram_schmidt (f : ι → E) {i j : ι} (hij : i ≤ j) :
  f i ∈ span 𝕜 (gram_schmidt 𝕜 f '' Iic j) :=
begin
  rw [gram_schmidt_def' 𝕜 f i],
  simp_rw orthogonal_projection_singleton,
  exact submodule.add_mem _ (subset_span $ mem_image_of_mem _ hij)
    (submodule.sum_mem _ $ λ k hk, smul_mem (span 𝕜 (gram_schmidt 𝕜 f '' Iic j)) _ $
    subset_span $ mem_image_of_mem (gram_schmidt 𝕜 f) $ (finset.mem_Iio.1 hk).le.trans hij),
end

lemma gram_schmidt_mem_span (f : ι → E) :
  ∀ {j i}, i ≤ j → gram_schmidt 𝕜 f i ∈ span 𝕜 (f '' Iic j)
| j := λ i hij,
begin
  rw [gram_schmidt_def 𝕜 f i],
  simp_rw orthogonal_projection_singleton,
  refine submodule.sub_mem _ (subset_span (mem_image_of_mem _ hij))
    (submodule.sum_mem _ $ λ k hk, _),
  let hkj : k < j := (finset.mem_Iio.1 hk).trans_le hij,
  exact smul_mem _ _ (span_mono (image_subset f $ Iic_subset_Iic.2 hkj.le) $
    gram_schmidt_mem_span le_rfl),
end
using_well_founded { dec_tac := `[assumption] }

lemma span_gram_schmidt_Iic (f : ι → E) (c : ι) :
  span 𝕜 (gram_schmidt 𝕜 f '' Iic c) = span 𝕜 (f '' Iic c) :=
span_eq_span (set.image_subset_iff.2 $ λ i, gram_schmidt_mem_span _ _) $
  set.image_subset_iff.2 $ λ i, mem_span_gram_schmidt _ _

lemma span_gram_schmidt_Iio (f : ι → E) (c : ι) :
  span 𝕜 (gram_schmidt 𝕜 f '' Iio c) = span 𝕜 (f '' Iio c) :=
span_eq_span
  (set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ Iic_subset_Iio.2 hi) $
    gram_schmidt_mem_span _ _ le_rfl) $
  set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ Iic_subset_Iio.2 hi) $
    mem_span_gram_schmidt _ _ le_rfl

/-- `gram_schmidt` preserves span of vectors. -/
lemma span_gram_schmidt (f : ι → E) : span 𝕜 (range (gram_schmidt 𝕜 f)) = span 𝕜 (range f) :=
span_eq_span (range_subset_iff.2 $ λ i, span_mono (image_subset_range _ _) $
  gram_schmidt_mem_span _ _ le_rfl) $
  range_subset_iff.2 $ λ i, span_mono (image_subset_range _ _) $ mem_span_gram_schmidt _ _ le_rfl

lemma gram_schmidt_ne_zero_coe
    (f : ι → E) (n : ι) (h₀ : linear_independent 𝕜 (f ∘ (coe : set.Iic n → ι))) :
  gram_schmidt 𝕜 f n ≠ 0 :=
begin
  by_contra h,
  have h₁ : f n ∈ span 𝕜 (f '' Iio n),
  { rw [← span_gram_schmidt_Iio 𝕜 f n, gram_schmidt_def' _ f, h, zero_add],
    apply submodule.sum_mem _ _,
    simp_intros a ha only [finset.mem_Ico],
    simp only [set.mem_image, set.mem_Iio, orthogonal_projection_singleton],
    apply submodule.smul_mem _ _ _,
    rw finset.mem_Iio at ha,
    refine subset_span ⟨a, ha, by refl⟩ },
  have h₂ : (f ∘ (coe : set.Iic n → ι)) ⟨n, le_refl n⟩
    ∈ span 𝕜 (f ∘ (coe : set.Iic n → ι) '' Iio ⟨n, le_refl n⟩),
  { rw [image_comp],
    convert h₁ using 3,
    ext i,
    simpa using @le_of_lt _ _ i n },
  apply linear_independent.not_mem_span_image h₀ _ h₂,
  simp only [set.mem_Iio, lt_self_iff_false, not_false_iff]
end

/-- If the input vectors of `gram_schmidt` are linearly independent,
then the output vectors are non-zero. -/
lemma gram_schmidt_ne_zero (f : ι → E) (n : ι) (h₀ : linear_independent 𝕜 f) :
  gram_schmidt 𝕜 f n ≠ 0 :=
gram_schmidt_ne_zero_coe _ _ _ (linear_independent.comp h₀ _ subtype.coe_injective)

/-- `gram_schmidt` produces a triangular matrix of vectors when given a basis. -/
lemma gram_schmidt_triangular {i j : ι} (hij : i < j) (b : basis ι 𝕜 E) :
  b.repr (gram_schmidt 𝕜 b i) j = 0 :=
begin
  have : gram_schmidt 𝕜 b i ∈ span 𝕜 (gram_schmidt 𝕜 b '' set.Iio j),
    from subset_span ((set.mem_image _ _ _).2 ⟨i, hij, rfl⟩),
  have : gram_schmidt 𝕜 b i ∈ span 𝕜 (b '' set.Iio j),
    by rwa [← span_gram_schmidt_Iio 𝕜 b j],
  have : ↑(((b.repr) (gram_schmidt 𝕜 b i)).support) ⊆ set.Iio j,
    from basis.repr_support_subset_of_mem_span b (set.Iio j) this,
  exact (finsupp.mem_supported' _ _).1
    ((finsupp.mem_supported 𝕜 _).2 this) j (not_mem_Iio.2 (le_refl j)),
end

/-- `gram_schmidt` produces linearly independent vectors when given linearly independent vectors. -/
lemma gram_schmidt_linear_independent (f : ι → E) (h₀ : linear_independent 𝕜 f) :
  linear_independent 𝕜 (gram_schmidt 𝕜 f) :=
linear_independent_of_ne_zero_of_inner_eq_zero
    (λ i, gram_schmidt_ne_zero _ _ _ h₀) (λ i j, gram_schmidt_orthogonal 𝕜 f)

/-- When given a basis, `gram_schmidt` produces a basis. -/
noncomputable def gram_schmidt_basis (b : basis ι 𝕜 E) : basis ι 𝕜 E :=
basis.mk
  (gram_schmidt_linear_independent 𝕜 b b.linear_independent)
  ((span_gram_schmidt 𝕜 b).trans b.span_eq)

lemma coe_gram_schmidt_basis (b : basis ι 𝕜 E) :
  (gram_schmidt_basis 𝕜 b : ι → E) = gram_schmidt 𝕜 b := basis.coe_mk _ _

/-- the normalized `gram_schmidt`
(i.e each vector in `gram_schmidt_normed` has unit length.) -/
noncomputable def gram_schmidt_normed (f : ι → E) (n : ι) : E :=
(∥gram_schmidt 𝕜 f n∥ : 𝕜)⁻¹ • (gram_schmidt 𝕜 f n)

lemma gram_schmidt_normed_unit_length_coe
    (f : ι → E) (n : ι) (h₀ : linear_independent 𝕜 (f ∘ (coe : set.Iic n → ι))) :
  ∥gram_schmidt_normed 𝕜 f n∥ = 1 :=
by simp only [gram_schmidt_ne_zero_coe 𝕜 f n h₀,
  gram_schmidt_normed, norm_smul_inv_norm, ne.def, not_false_iff]

lemma gram_schmidt_normed_unit_length (f : ι → E) (n : ι) (h₀ : linear_independent 𝕜 f) :
  ∥gram_schmidt_normed 𝕜 f n∥ = 1 :=
gram_schmidt_normed_unit_length_coe _ _ _ (linear_independent.comp h₀ _ subtype.coe_injective)

/-- **Gram-Schmidt Orthonormalization**:
`gram_schmidt_normed` produces an orthornormal system of vectors. -/
theorem gram_schmidt_orthonormal (f : ι → E) (h₀ : linear_independent 𝕜 f) :
  orthonormal 𝕜 (gram_schmidt_normed 𝕜 f) :=
begin
  unfold orthonormal,
  split,
  { simp only [gram_schmidt_normed_unit_length, h₀, eq_self_iff_true, implies_true_iff], },
  { intros i j hij,
    simp only [gram_schmidt_normed, inner_smul_left, inner_smul_right, is_R_or_C.conj_inv,
      is_R_or_C.conj_of_real, mul_eq_zero, inv_eq_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero],
    repeat { right },
    exact gram_schmidt_orthogonal 𝕜 f hij }
end

lemma span_gram_schmidt_normed (f : ι → E) (s : set ι) :
  span 𝕜 (gram_schmidt_normed 𝕜 f '' s) = span 𝕜 (gram_schmidt 𝕜 f '' s) :=
begin
  refine span_eq_span (set.image_subset_iff.2 $ λ i hi, smul_mem _ _ $ subset_span $
    mem_image_of_mem _ hi)
    (set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ singleton_subset_set_iff.2 hi) _),
  simp only [coe_singleton, set.image_singleton],
  by_cases h : gram_schmidt 𝕜 f i = 0,
  { simp [h] },
  { refine mem_span_singleton.2 ⟨∥gram_schmidt 𝕜 f i∥, smul_inv_smul₀ _ _⟩,
    exact_mod_cast (norm_ne_zero_iff.2 h) }
end

lemma span_gram_schmidt_normed_range (f : ι → E) :
  span 𝕜 (range (gram_schmidt_normed 𝕜 f)) = span 𝕜 (range (gram_schmidt 𝕜 f)) :=
by simpa only [image_univ.symm] using span_gram_schmidt_normed 𝕜 f univ

/-- When given a basis, `gram_schmidt_normed` produces an orthonormal basis. -/
noncomputable def gram_schmidt_orthonormal_basis [fintype ι] (b : basis ι 𝕜 E) :
  orthonormal_basis ι 𝕜 E :=
orthonormal_basis.mk
  (gram_schmidt_orthonormal 𝕜 b b.linear_independent)
  (((span_gram_schmidt_normed_range 𝕜 b).trans (span_gram_schmidt 𝕜 b)).trans b.span_eq)


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.invertible
import algebra.char_p.basic

/-!
# Invertibility of elements given a characteristic

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file includes some instances of `invertible` for specific numbers in
characteristic zero. Some more cases are given as a `def`, to be included only
when needed. To construct instances for concrete numbers,
`invertible_of_nonzero` is a useful definition.
-/

variables {K : Type*}

section field
variables [field K]

/-- A natural number `t` is invertible in a field `K` if the charactistic of `K` does not divide
`t`. -/
def invertible_of_ring_char_not_dvd
  {t : ℕ} (not_dvd : ¬(ring_char K ∣ t)) : invertible (t : K) :=
invertible_of_nonzero (λ h, not_dvd ((ring_char.spec K t).mp h))

lemma not_ring_char_dvd_of_invertible {t : ℕ} [invertible (t : K)] :
  ¬(ring_char K ∣ t) :=
begin
  rw [← ring_char.spec, ← ne.def],
  exact nonzero_of_invertible (t : K)
end

/-- A natural number `t` is invertible in a field `K` of charactistic `p` if `p` does not divide
`t`. -/
def invertible_of_char_p_not_dvd {p : ℕ} [char_p K p]
  {t : ℕ} (not_dvd : ¬(p ∣ t)) : invertible (t : K) :=
invertible_of_nonzero (λ h, not_dvd ((char_p.cast_eq_zero_iff K p t).mp h))

-- warning: this could potentially loop with `ne_zero.invertible` - if there is weird type-class
-- loops, watch out for that.
instance invertible_of_pos [char_zero K] (n : ℕ) [ne_zero n] : invertible (n : K) :=
invertible_of_nonzero $ ne_zero.out

end field

section division_ring
variables [division_ring K] [char_zero K]

instance invertible_succ (n : ℕ) : invertible (n.succ : K) :=
invertible_of_nonzero (nat.cast_ne_zero.mpr (nat.succ_ne_zero _))

/-!
A few `invertible n` instances for small numerals `n`. Feel free to add your own
number when you need its inverse.
-/

instance invertible_two : invertible (2 : K) :=
invertible_of_nonzero (by exact_mod_cast (dec_trivial : 2 ≠ 0))

instance invertible_three : invertible (3 : K) :=
invertible_of_nonzero (by exact_mod_cast (dec_trivial : 3 ≠ 0))

end division_ring


import tactic --hide

lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl -- hide
lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := by {cc} --hide
lemma P_not_P_false (P : Prop) : P ∧ ¬ P → false := by {cc} --hide

/-
We proved earlier that `(P → Q) → (¬ Q → ¬ P)`. The converse,
that `(¬ Q → ¬ P) → (P → Q)` is certainly true, but trying to prove
it using the tactics we've learnt so far is impossible.
-/

/-Hint : Why is this impossible?

Suppose we tried to prove this with the tactics we have seen so far, then our proof might look
something like:
```
intro h,
intro p,
rw not_iff_imp_false at h,
rw not_iff_imp_false at h,
```
You are then left with the following state:
```
P Q : Prop,
h : (Q → false) → P → false
p : P
⊢ Q
```
and now we are stuck. In fact, using tactics such as `intro` and `apply` you will never be able to
prove this lemma as this is not provable in "constructive logic". The key in proving this is to use
Lean's version of a truth table!

-/

/-
In order to continue we need a new tactic.

## The `by_cases` tactic

The tactic <mark style ="background-color : #ebdef0 ">`by_cases`</mark> allows us to create Lean's
version of a truth table.

For example, if you have `P Q : Prop`, then <mark style ="background-color : #ebdef0 ">`by_cases hp : P; by_cases hq : Q,`</mark>
will create four goals, one for each of the four  possibilities for `P,Q`, i.e.,

```md
| `P`     | `Q`     |
| --------|---------|
| `true`  | `true`  |
| `true`  | `false` |
| `false` | `true`  |
| `false` | `false` |
```

**Note the semicolon**! It means "do the next tactic to all the goals, not just the first".

-/

/- Lemma :
If $P$ and $Q$ are logical statements, then
$(\lnot Q\implies \lnot P)\implies(P\implies Q).$
-/
lemma contrapositive_2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
begin
  by_cases p : P; by_cases q : Q,
  intros h hh,
  exact q,
  intros h hh,
  exfalso,
  rw not_iff_imp_false at h,
  rw not_iff_imp_false at h,
  rw not_iff_imp_false at q,
  apply h,
  exact q,
  apply p,
  intros h hh,
  exact q,
  intros h hh,
  exfalso,
  apply P_not_P_false P,
  split,
  exact hh,
  apply h,
  exact q,

end

/-Hint : +1 Intelligence
The `by_cases` tactic works by adding the assumption `P ∨ ¬ P` and then doing `cases` on this.
The fact that `P ∨ ¬ P` is true is called the *law of the excluded middle*, and it cannot be proven
by just using tactics such as `intro` and `apply`.
-/

/-Tactic : by_cases

The ``by_cases`` tactic is a simple truth table tactic: ``by_cases P`` turns one goal into two goals,
with ``P`` is assumed in the first, and ``¬P`` in the second.

Examples
--------

1) If ``P`` is a proposition, then ``by_cases P`` turns your goal into two goals,
and in each of your new tactic states you have one extra hypothesis.
In the first one you have a new hypothesis ``h : P`` and in the second you have a new hypothesis ``h : ¬P``.

2) If you already have a hypothesis ``h`` then this can get a bit confusing,
so you can also do ``by_cases hP : P``; then your new hypotheses will be ``hP : P`` and ``hP : ¬P``.
-/


-- Las partes estrictas son irreflexivas
-- =====================================

-- ----------------------------------------------------
-- Ej. 1. La parte estricta de una relación R es la
-- relación R' definida por
--    R' a b := R a b ∧ a ≠ b
--
-- Demostrar que la parte estricta de cualquier
-- relación es irreflexiva.
-- ----------------------------------------------------

import tactic

section

parameter {A : Type}
parameter (R : A → A → Prop)

definition R' (a b : A) : Prop :=
  R a b ∧ a ≠ b

#reduce irreflexive R

-- 1ª demostración
example :
  irreflexive R' :=
begin
  intros a h,
  cases h with h1 h2,
  apply h2,
  refl,
end

-- 2ª demostración
example :
  irreflexive R' :=
assume a,
assume : R' a a,
have a ≠ a, from and.right this,
have a = a, from rfl,
show false, from ‹a ≠ a› ‹a = a›

end


-- P, Q, Rを命題としたとき，以下が同値であることを示す:
-- (i)  P または Q ならば R
-- (ii) P ならば R かつ Q ならば R

-- structured proofによる証明
example (p q r : Prop) : ((p ∨ q) → r) ↔ ((p → r) ∧ (q → r)) :=
begin
	split, -- 十分性と必要性に分ける

	-- 十分性(i) => (ii)が成り立つことを示す．
	{ intro h, -- 「P または Q ならば R」が成り立つと仮定し，それを仮定hとおく．
		split, -- 「P ならば R かつ Q ならば R」を「P ならば R」と「Q ならば R」に分割する

		-- 「P ならば R」が成り立つことを示す．
		{	intro hp,  -- Pが成り立つと仮定し，これを仮定hpとおく
		  apply h,   -- 今，仮定h「P または Q ならば R」が成立している．
			left,      -- 「P または Q」の左側「P」が成り立つことを示す．
			assumption -- 仮定hpより「P」は真．
		},

		-- 「Q ならば R」が成り立つことを示す．
		{	intro hq,  -- Qが成り立つと仮定し，これを仮定hqとおく
		  apply h,   -- 今，仮定h「PまたはQならばR」が成立している．
			right,     -- 「P または Q」の右側「Q」が成り立つことを示す．
			assumption -- 仮定hqより「Q」は真．
		}
	},

	-- 必要性(ii) => (i)が成り立つことを示す．
	{ intro h, -- 「P ならば R かつ Q ならば R」が成り立つと仮定し，それを仮定hとおく．
	  cases h with hpr hqr, -- hを「PならばR」が成り立つという仮定hprと「QならばR」が成り立つという仮定hqrに分ける
		intro hpq, -- 「P または Q」 が成り立つと仮定し，これを仮定hpqとおく．
		cases hpq with hp hq, -- 仮定hpqを「Pが成り立つ」という仮定hpと「Qが成り立つ」という仮定hqに分ける．

		-- 仮定hp「Pが成り立つ」の下で「Rが成り立つ」ことを示す．
		{ apply hpr, -- 今、「PならばR」が成り立っている
		  assumption -- 仮定よりPが成り立っているので、示された．
		},
		-- 仮定hp「Qが成り立つ」の下で「Rが成り立つ」ことを示す．
		{ apply hqr, -- 今、「Q ならば R」が成り立っている
		  assumption -- 仮定よりQが成り立っているので，示された．
		}
	}
end

-- 函数定義による証明
-- 「P型かQ型の値を受け取ってR型の値を返す関数」を引数に取って
-- 「P型の値を受け取ってR型の値を返す関数」と「Q型の値を受け取ってR型の値を返す関数」のペアを返す関数
-- と
-- 「P型の値を受け取ってR型の値を返す関数」と「Q型の値を受け取ってR型の値を返す関数」のペアを返す関数を引数に取って
-- 「P型かQ型の値を受け取ってR型の値を返す関数」を返す関数
-- のペアが定義出来れば命題が示せたことになる．
example (p q r : Prop)  : ((p ∨ q) → r) ↔ ((p → r) ∧ (q → r)) :=
⟨ λ h, ⟨ λ hp, h $ or.inl hp, λ hq, h $ or.inr hq ⟩, λ ⟨ hpr, hqr ⟩ hpq, hpq.elim hpr hqr ⟩
-- 第一成分のλ式「λ h, ⟨ λ hp, h $ or.inl hp, λ hq, h $ or.inr hq ⟩」について
-- 引数hは「P型かQ型の値を受け取ってR型の値を返す関数」
-- 戻り値は「⟨ λ hp, h $ or.inl hp, λ hq, h $ or.inr hq ⟩」
-- (この第一成分が「P型の値を引数に取ってR型の値を返す関数」、
-- 第二成分が「Q型の値を引数に取ってR型の値を返す関数」となっていればよい)
--   第一成分のλ式「λ hp, h $ or.inl hp」について
--   引数hpは「P型の値」
--   or.inlは「任意の型Aを型Aまたは任意の型Bの値へ写す関数」
--   or.inl hpは「型Pの値hpを「型Pまたは任意の型B」の値と見る」
--   ただしhは「型Pまたは型Qの値」を引数に取るので、
--   型推論により「or.inl hp」は「型Pまたは型Qの値」となる．
--   関数hにより、型Pまたは型Qの値「or.inl hp」は「R型の値」へ写される
--   よって、第一成分は「P型の値を引数に取ってR型の値を返す関数」
--
--   第二成分のλ式「λ hq, h $ or.inr hq」について
--   引数hqは「Q型の値」
--   or.inrは「任意の型Bを型Aまたは任意の型Bの値へ写す関数」
--   or.inr hqは「型Qの値hqを「型Aまたは任意の型Q」の値と見る」
--   ただしhは「型Pまたは型Qの値」を引数に取るので、
--   型推論により「or.inr hq」は「型Pまたは型Qの値」となる．
--   関数hにより、型Pまたは型Qの値「or.inr hq」は「R型の値」へ写される
--   よって、第二成分は「Q型の値を引数に取ってR型の値を返す関数」
--
-- 第二成分のλ式「λ ⟨ hpr, hqr ⟩ hpq, hpq.elim hpr hqr」について
-- 引数⟨ hpr, hqr ⟩は「P型の値を受け取ってR型の値を返す関数」hprと
-- 「Q型の値を受け取ってR型の値を返す関数」hqrとの対
-- 戻り値は「hpq, hpq.elim hpr hqr」
-- (この第一成分が「P型の値を引数に取ってR型の値を返す関数」、
-- 第二成分が「Q型の値を引数に取ってR型の値を返す関数」となっていればよい)


import data.nat.modeq

/-
(a) Find r with 0 ≤ r ≤ 10 such that 7^137 ≡ r mod 11.
(b) Find r with 0 ≤ r < 645 such that 2^81 ≡ r mod 645.
(c) Find the last two digits of 3^124 (when expressed in decimal notation).
(d) Show that there is a multiple of 21 which has 241 as its last three digits.
-/

lemma part_a : ∃r : ℕ, 0 ≤ r ∧ r ≤ 10 ∧ 7^137 ≡ r [MOD 11] :=
begin
  use 6,
  unfold nat.modeq,
  norm_num,
end

lemma part_b : ∃r : ℕ, 0 ≤ r ∧ r < 645 ∧ 2^81 ≡ r [MOD 645] :=
begin
  use 242,
  unfold nat.modeq,
  norm_num,
end

-- Once you compute the last two digits, change 37 below to them.
lemma part_c : 3^124 ≡ 81 [MOD 100] :=
begin
  unfold nat.modeq,
  norm_num,
end

lemma part_d : ∃k : ℕ, 21 ∣ k ∧ k ≡ 241 [MOD 1000] :=
begin
  unfold nat.modeq,
  use 17241,
  split,
  {norm_num, },
  {norm_num, },
end


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic
import data.real.sqrt
import data.real.nnreal
import tactic.linear_combination

/-!
# IMO 2008 Q4
Find all functions `f : (0,∞) → (0,∞)` (so, `f` is a function from the positive real
numbers to the positive real numbers) such that
      ```
      (f(w)^2 + f(x)^2)/(f(y^2) + f(z^2)) = (w^2 + x^2)/(y^2 + z^2)
      ```
for all positive real numbers `w`, `x`, `y`, `z`, satisfying `wx = yz`.

# Solution
The desired theorem is that either `f = λ x, x` or `f = λ x, 1/x`
-/

open real

lemma abs_eq_one_of_pow_eq_one (x : ℝ) (n : ℕ) (hn : n ≠ 0) (h : x ^ n = 1) : |x| = 1 :=
by rw [← pow_left_inj (abs_nonneg x) zero_le_one (pos_iff_ne_zero.2 hn), one_pow, pow_abs, h,
  abs_one]

theorem imo2008_q4
  (f : ℝ → ℝ)
  (H₁ : ∀ x > 0, f(x) > 0) :
  (∀ w x y z : ℝ, 0 < w → 0 < x → 0 < y → 0 < z → w * x = y * z →
    (f(w) ^ 2 + f(x) ^ 2) / (f(y ^ 2) + f(z ^ 2)) = (w ^ 2 + x ^ 2) / (y ^ 2 + z ^ 2)) ↔
  ((∀ x > 0, f(x) = x) ∨ (∀ x > 0, f(x) = 1 / x)) :=
begin
  split, swap,
  -- proof that f(x) = x and f(x) = 1/x satisfy the condition
  { rintros (h | h),
    { intros w x y z hw hx hy hz hprod,
      rw [h w hw, h x hx, h (y ^ 2) (pow_pos hy 2), h (z ^ 2) (pow_pos hz 2)] },
    { intros w x y z hw hx hy hz hprod,
      rw [h w hw, h x hx, h (y ^ 2) (pow_pos hy 2), h (z ^ 2) (pow_pos hz 2)],
      have hy2z2 : y ^ 2 + z ^ 2 ≠ 0 := ne_of_gt (add_pos (pow_pos hy 2) (pow_pos hz 2)),
      have hz2y2 : z ^ 2 + y ^ 2 ≠ 0 := ne_of_gt (add_pos (pow_pos hz 2) (pow_pos hy 2)),
      have hp2 : w ^ 2 * x ^ 2 = y ^ 2 * z ^ 2,
      { linear_combination (w * x + y * z)*hprod },
      field_simp [ne_of_gt hw, ne_of_gt hx, ne_of_gt hy, ne_of_gt hz, hy2z2, hz2y2, hp2],
      ring } },

  -- proof that the only solutions are f(x) = x or f(x) = 1/x
  intro H₂,
  have h₀ : f(1) ≠ 0, { specialize H₁ 1 zero_lt_one, exact ne_of_gt H₁ },

  have h₁ : f(1) = 1,
  { specialize H₂ 1 1 1 1 zero_lt_one zero_lt_one zero_lt_one zero_lt_one rfl,
    norm_num [← two_mul] at H₂,
    rw mul_div_mul_left (f(1) ^ 2) (f 1) two_ne_zero at H₂,
    rwa ← (div_eq_iff h₀).mpr (sq (f 1)) },

  have h₂ : ∀ x > 0, (f(x) - x) * (f(x) - 1 / x) = 0,
  { intros x hx,
    have h1xss : 1 * x = (sqrt x) * (sqrt x), { rw [one_mul, mul_self_sqrt (le_of_lt hx)] },
    specialize H₂ 1 x (sqrt x) (sqrt x) zero_lt_one hx (sqrt_pos.mpr hx) (sqrt_pos.mpr hx) h1xss,
    rw [h₁, one_pow 2, sq_sqrt (le_of_lt hx), ← two_mul (f(x)), ← two_mul x] at H₂,
    have hx_ne_0 : x ≠ 0 := ne_of_gt hx,
    have hfx_ne_0 : f(x) ≠ 0, { specialize H₁ x hx, exact ne_of_gt H₁ },
    field_simp at H₂ ⊢,
    linear_combination 1/2 * H₂ },

  have h₃ : ∀ x > 0, f(x) = x ∨ f(x) = 1 / x, { simpa [sub_eq_zero] using h₂ },

  by_contra' h,
  rcases h with ⟨⟨b, hb, hfb₁⟩, ⟨a, ha, hfa₁⟩⟩,
  obtain hfa₂ := or.resolve_right (h₃ a ha) hfa₁, -- f(a) ≠ 1/a, f(a) = a
  obtain hfb₂ := or.resolve_left (h₃ b hb) hfb₁,  -- f(b) ≠ b, f(b) = 1/b

  have hab : a * b > 0 := mul_pos ha hb,
  have habss : a * b = sqrt(a * b) * sqrt(a * b) := (mul_self_sqrt (le_of_lt hab)).symm,

  specialize H₂ a b (sqrt (a * b)) (sqrt (a * b)) ha hb (sqrt_pos.mpr hab) (sqrt_pos.mpr hab) habss,
  rw [sq_sqrt (le_of_lt hab), ← two_mul (f(a * b)), ← two_mul (a * b)] at H₂,
  rw [hfa₂, hfb₂] at H₂,

  have h2ab_ne_0 : 2 * (a * b) ≠ 0 := mul_ne_zero two_ne_zero (ne_of_gt hab),

  specialize h₃ (a * b) hab,
  cases h₃ with hab₁ hab₂,

  -- f(ab) = ab → b^4 = 1 → b = 1 → f(b) = b → false
  { field_simp [hab₁] at H₂,
    field_simp [ne_of_gt hb] at H₂,
    have hb₁ : b ^ 4 = 1 := by linear_combination -H₂,
    obtain hb₂ := abs_eq_one_of_pow_eq_one b 4 (show 4 ≠ 0, by norm_num) hb₁,
    rw abs_of_pos hb at hb₂, rw hb₂ at hfb₁, exact hfb₁ h₁ },

  -- f(ab) = 1/ab → a^4 = 1 → a = 1 → f(a) = 1/a → false
  { have hb_ne_0 : b ≠ 0 := ne_of_gt hb,
    field_simp [hab₂] at H₂,
    have H₃ : 2 * b ^ 4 * (a ^ 4 - 1) = 0 := by linear_combination (H₂),
    have h2b4_ne_0 : 2 * (b ^ 4) ≠ 0 := mul_ne_zero two_ne_zero (pow_ne_zero 4 hb_ne_0),
    have ha₁ : a ^ 4 = 1, { simpa [sub_eq_zero, h2b4_ne_0] using H₃ },
    obtain ha₂ := abs_eq_one_of_pow_eq_one a 4 (show 4 ≠ 0, by norm_num) ha₁,
    rw abs_of_pos ha at ha₂, rw ha₂ at hfa₁, norm_num at hfa₁ },
end


import ..lectures.love12_basic_mathematical_structures_demo

/-! # LoVe Exercise 12: Basic Mathematical Structures -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Type Classes

Recall the inductive type `btree` we introduced earlier: -/

#check btree

/-! The following function takes two trees and attaches copies of the second
tree to each leaf of the first tree. -/

def btree.graft {α : Type} : btree α → btree α → btree α
| btree.empty        u := u
| (btree.node a l r) u := btree.node a (btree.graft l u) (btree.graft r u)

#reduce btree.graft (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

/-! 1.1. Prove the following two lemmas by structural induction on `t`. -/

lemma btree.graft_assoc {α : Type} (t u v : btree α) :
  btree.graft (btree.graft t u) v = btree.graft t (btree.graft u v) :=
sorry

lemma btree.graft_empty {α : Type} (t : btree α) :
  btree.graft t btree.empty = t :=
sorry

/-! 1.2. Declare btree an instance of `add_monoid` using `graft` as addition
operator. -/

#print add_monoid

@[instance] def btree.add_monid {α : Type} : add_monoid (btree α) :=
sorry

/-! 1.3. Explain why `btree` with `graft` as addition cannot be declared an
instance of `add_group`. -/

#print add_group

/-! 1.4 (**optional**). Prove the following lemma illustrating why `btree` with
`graft` as addition does not constitute an `add_group`. -/

lemma btree.add_left_neg_counterexample :
  ∃x : btree ℕ, ∀y : btree ℕ, btree.graft y x ≠ btree.empty :=
sorry

/-! ## Question 2: Multisets and Finsets

Recall the following definitions from the lecture: -/

#check multiset.elems
#check finset.elems
#check list.elems

/-! 2.1. Prove that the multiset of nodes does not change when mirroring a tree.

Hints:

* Perform structural induction on `t`.

* The `cc` tactic also works with set operations. -/

lemma multiset.elems_mirror (t : btree ℕ) :
  multiset.elems (mirror t) = multiset.elems t :=
sorry

/-! 2.2. Prove that the finite set of nodes does not change when mirroring a
tree. -/

lemma finset.elems_mirror (t : btree ℕ) :
  finset.elems (mirror t) = finset.elems t :=
sorry

/-! 2.3. Show that this does not hold for the list of nodes by providing a
tree `t` for which `nodes_list t ≠ nodes_list (mirror t)`.

If you define a suitable counterexample, the proof below will succeed. -/

def rotten_tree : btree ℕ :=
sorry

#eval list.elems rotten_tree
#eval list.elems (mirror rotten_tree)

lemma list.elems_mirror_counterexample :
  ∃t : btree ℕ, list.elems t ≠ list.elems (mirror t) :=
begin
  apply exists.intro rotten_tree,
  exact dec_trivial
end

end LoVe


/-
Copyright (c) 2020 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang
-/
import ring_theory.polynomial.symmetric

/-!
# Vieta's Formula

The main result is `vieta.prod_X_add_C_eq_sum_esymm`, which shows that the product of linear terms
`λ + X i` is equal to a linear combination of the symmetric polynomials `esymm σ R j`.

## Implementation Notes:

We first take the viewpoint where the "roots" `X i` are variables. This means we work over
`polynomial (mv_polynomial σ R)`, which enables us to talk about linear combinations of
`esymm σ R j`. We then derive Vieta's formula in `polynomial R` by giving a
valuation from each `X i` to `r i`.

-/

universes u
open_locale big_operators

open finset polynomial fintype

namespace mv_polynomial

variables {R : Type u} [comm_semiring R]
variables (σ : Type u) [fintype σ]

/-- A sum version of Vieta's formula. Viewing `X i` as variables,
the product of linear terms `λ + X i` is equal to a linear combination of
the symmetric polynomials `esymm σ R j`. -/
lemma prod_X_add_C_eq_sum_esymm :
  (∏ i : σ, (polynomial.C (X i) + polynomial.X) : polynomial (mv_polynomial σ R) )=
  ∑ j in range (card σ + 1),
    (polynomial.C (esymm σ R j) * polynomial.X ^ (card σ - j)) :=
begin
  classical,
  rw [prod_add, sum_powerset],
  refine sum_congr begin congr end (λ j hj, _),
  rw [esymm, polynomial.C.map_sum, sum_mul],
  refine sum_congr rfl (λ t ht, _),
  have h : (univ \ t).card = card σ - j :=
  by { rw card_sdiff (mem_powerset_len.mp ht).1, congr, exact (mem_powerset_len.mp ht).2 },
  rw [(polynomial.C : mv_polynomial σ R →+* polynomial _).map_prod, prod_const, ← h],
  congr,
end

/-- A fully expanded sum version of Vieta's formula, evaluated at the roots.
The product of linear terms `X + r i` is equal to `∑ j in range (n + 1), e_j * X ^ (n - j)`,
where `e_j` is the `j`th symmetric polynomial of the constant terms `r i`. -/
lemma prod_X_add_C_eval (r : σ → R) : ∏ i : σ, (polynomial.C (r i) + polynomial.X) =
  ∑ i in range (card σ + 1), (∑ t in powerset_len i (univ : finset σ),
    ∏ i in t, polynomial.C (r i)) * polynomial.X ^ (card σ - i) :=
begin
  classical,
  have h := @prod_X_add_C_eq_sum_esymm _ _ σ _,
  apply_fun (polynomial.map (eval r)) at h,
  rw [map_prod, map_sum] at h,
  convert h,
  simp only [eval_X, map_add, polynomial.map_C, polynomial.map_X, eq_self_iff_true],
  funext,
  simp only [function.funext_iff, esymm, polynomial.map_C, map_sum, polynomial.C.map_sum,
    polynomial.map_C, map_pow, polynomial.map_X, map_mul],
  congr,
  funext,
  simp only [eval_prod, eval_X, (polynomial.C : R →+* polynomial R).map_prod],
end

lemma esymm_to_sum (r : σ → R) (j : ℕ) : polynomial.C (eval r (esymm σ R j)) =
  ∑ t in powerset_len j (univ : finset σ), ∏ i in t, polynomial.C (r i) :=
by simp only [esymm, eval_sum, eval_prod, eval_X, polynomial.C.map_sum,
  (polynomial.C : R →+* polynomial _).map_prod]

/-- Vieta's formula for the coefficients of the product of linear terms `X + r i`,
The `k`th coefficient is `∑ t in powerset_len (card σ - k) (univ : finset σ), ∏ i in t, r i`,
i.e. the symmetric polynomial `esymm σ R (card σ - k)` of the constant terms `r i`. -/

end mv_polynomial


import tactic

namespace qary_hamming
-- Setup for defining vectors over a finite alphabet 𝒜
universe u
variables {𝒜 : Type u} [fintype 𝒜] [decidable_eq 𝒜] [field_𝒜: field 𝒜]

def distance : Π {n : ℕ}, vector 𝒜 n → vector 𝒜 n → ℕ
| 0       _ _ := 0
| (n + 1) x y :=
  if x.head = y.head then
    distance x.tail y.tail
  else
    nat.succ (distance x.tail y.tail)

variable (n : ℕ)

@[simp]
lemma distance_self_zero (x : vector 𝒜 n) : distance x x = 0 :=
begin
  induction n with k ih,
    refl,
  unfold distance, simp, apply ih,
end

lemma distance_zero_eq (x y : vector 𝒜 n) : distance x y = 0 ↔ (x = y) :=
begin
  split,
    {intro h,
    induction n with k ih,
      simp,
    unfold distance at h,
    by_cases h' : x.head = y.head,
      {rw h' at h, simp at h,
      have : x.tail = y.tail, from ih _ _ h,
      rw [(vector.cons_head_tail x).symm, (vector.cons_head_tail y).symm, h', this]},
      {by_contradiction hneq,
      simp only [if_congr, h', if_false] at h,
      rw ← nat.add_one at h, simp at h,
      exact h,}},
  intro h, rw h, simp,
end

def weight : Π {n : ℕ}, vector 𝒜 n → ℕ
| 0 _ := 0
| (n + 1) x :=
  if x.head = field_𝒜.zero then
    weight x.tail
  else
    nat.succ (weight x.tail)

end qary_hamming

-- Some examples, using an alphabet of size 4
@[derive [decidable_eq, fintype]]
inductive D : Type
| a : D
| b : D
| c : D
| d : D

open D

#eval qary_hamming.distance ⟨[a,a,a,a], rfl⟩ ⟨[a,b,b,a], rfl⟩ -- 2
#eval qary_hamming.distance ⟨[a,b,c,d], rfl⟩ ⟨[d,c,b,a], rfl⟩ -- 4