/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

This file formalises the fact that any finite, linearly ordered
set of size n has a unique order-isomorphism with the set
fin n =  {0,...,n-1}.
-/

import data.finset data.fintype.basic
import data.fin_extra
open list

variables {α : Type*}

namespace list

/-
 If we have a list l (of length n) and a natural number i, we might
 want to refer to the i'th entry in the list, but then we have to
 decide what to do about the possibility that i is too large so that
 there is no i'th entry.  We always use 0-based indexing so the
 i'th entry is defined for i < n but not for i ≥ n.

 The standard library defines (l.nth i) to be of type (option α),
 and to have value (some x) if i < n and x is the i'th entry, but to
 have value (none) if i ≥ n.  The standard library also defines
 (l.nth_le i h) to be x if h is a proof of i < n.  Here we just
 repackage this slightly: the pair ⟨i,h⟩ gives a term of type
 (fin n), and we define l.fin_nth ⟨i,h⟩ to be x again.
-/
def fin_nth (l : list α) (i : fin l.length) : α :=
 l.nth_le i.val i.is_lt

/- An obvious lemma about the behaviour of fin_nth. -/
lemma fin_nth_cons (a : α) (l : list α) (i : fin l.length) :
 (list.cons a l).fin_nth i.succ = l.fin_nth i :=
begin
 cases i,dsimp[fin.succ,fin_nth],refl,
end

/-
 If R is a relation on α and l is a list, we define
 (pairwise_nth R l) to be true if all entries in l are R-related
 to all strictly later entries.  For example, if R is an order
 relation then this just means that the list is sorted, and if
 R is the relation x ≠ y then this just means that l has no
 duplicates.  Here we define pairwise_nth in the obvious way
 using indices.  We then prove that our pairwise_nth is
 equivalent to the definition of pairwise in the standard
 library, which is formulated by structural induction rather
 than using indices.
-/

def pairwise_nth₀ (R : α → α → Prop) (l : list α) :=
 ∀ (i j : fin l.length), i < j → R (l.fin_nth i) (l.fin_nth j)

def pairwise_nth (R : α → α → Prop) (l : list α) :=
 ∀ {i j : ℕ} (hi : i < j) (hj : j < l.length),
   R (l.nth_le i (lt_trans hi hj)) (l.nth_le j hj)

lemma pairwise_nth_mp {R : α → α → Prop} {l : list α}
 (p : pairwise R l) : pairwise_nth R l :=
begin
  induction p with a l0 R_a_l0 p0 ih,
  { intros i j hi hj, cases hj },
  { intros i j hi hj,
    cases j with j₀, { cases hi },
    have hj0 : j₀ < l0.length := nat.lt_of_succ_lt_succ hj,
    cases i with i₀,
    { exact R_a_l0 _ (l0.nth_le_mem j₀ hj0) },
    { exact ih (nat.lt_of_succ_lt_succ hi) hj0 } }
end

lemma pairwise_nth_mpr {R : α → α → Prop} {l : list α}
 (hl : pairwise_nth R l) : (pairwise R l) :=
begin
  induction l with a l ih,
  { exact @pairwise.nil _ R },
  { have R_a_l : ∀ (b ∈ l), (R a b) :=
    begin
      intros b b_in_l,
      rcases nth_le_of_mem b_in_l with ⟨j,⟨hj,eq_b⟩⟩,
      rw [← eq_b],
      exact hl (nat.zero_lt_succ j) (nat.succ_lt_succ hj)
    end,
    have : l.pairwise R :=
    begin
      apply ih,
      intros i j hi hj,
      exact hl (nat.succ_lt_succ hi) (nat.succ_lt_succ hj),
    end,
    exact pairwise.cons R_a_l this }
end

lemma pairwise_nth_iff {R : α → α → Prop} {l : list α} :
 (pairwise R l) ↔ (pairwise_nth R l) :=
  iff.intro (@pairwise_nth_mp _ R l) (@pairwise_nth_mpr _ R l)

/-
 The standard library defines a list to be sorted if all entries are
 less than or equal to all strictly later entries.  Here we define
 a list to be strongly sorted if the relevant inequalities hold
 strictly.  This is clearly equivalent to saying that the list is
 sorted and has distinct entries; we also formalise this equivalence.
-/

variables [linear_order α] [decidable_rel (@has_le.le α _)]

def strongly_sorted (l : list α) : Prop :=
 list.pairwise has_lt.lt l

lemma strongly_sorted_of_sorted_nodup (l : list α) :
 l.sorted has_le.le → l.nodup → l.strongly_sorted :=
begin
 intro l_sorted,
 induction l_sorted with a l0 a_le_l0 l0_sorted ih,
 {intro,exact pairwise.nil},
 {intro l_nodup,
  cases l_nodup with _ _ a_ne_l0 l0_nodup,
  have l0_strongly_sorted := ih l0_nodup,
  have a_lt_l0 : ∀ (x : α) (x_in_l0 : x ∈ l0), (a < x) :=
  begin
   intros x x_in_l0,
   exact lt_of_le_of_ne (a_le_l0 x x_in_l0) (a_ne_l0 x x_in_l0),
  end,
  exact pairwise.cons a_lt_l0 l0_strongly_sorted,
 }
end

lemma sorted_of_strongly_sorted (l : list α) :
 l.strongly_sorted → l.sorted has_le.le :=
begin
 intro l_strongly_sorted,
 induction l_strongly_sorted with a l0 a_lt_l0 l0_strongly_sorted ih,
 {exact pairwise.nil},
 {have a_le_l0 : ∀ x ∈ l0, a ≤ x :=
   λ x x_in_l0,le_of_lt (a_lt_l0 x x_in_l0),
  have l0_sorted := ih,
  exact pairwise.cons a_le_l0 l0_sorted
 }
end

lemma nodup_of_strongly_sorted (l : list α) :
 l.strongly_sorted → l.nodup :=
begin
 intro l_strongly_sorted,
 induction l_strongly_sorted with a l0 a_ne_l0 l0_strongly_sorted ih,
 {exact pairwise.nil},
 {have a_ne_l0 : ∀ x ∈ l0, a ≠ x :=
   λ x x_in_l0,ne_of_lt (a_ne_l0 x x_in_l0),
  have l0_nodup := ih,
  exact pairwise.cons a_ne_l0 l0_nodup
 }
end

/-
 Sortedness is defined in the standard library by structural
 induction. Here we reformulate it in terms of indices.
-/

lemma sorted_nth_lt_mp {l : list α}
 (l_nodup : list.nodup l)
 (l_sorted : list.sorted has_le.le l)
 {i j : ℕ} (hi : i < j) (hj : j < l.length) :
 (l.nth_le i (lt_trans hi hj) < l.nth_le j hj) :=
begin
  let x := l.nth_le i (lt_trans hi hj),
  let y := l.nth_le j hj,
  have x_ne_y : x ≠ y := pairwise_nth_mp l_nodup hi hj,
  have x_le_y : x ≤ y := pairwise_nth_mp l_sorted hi hj,
  exact lt_of_le_of_ne x_le_y x_ne_y,
end

lemma sorted_nth_le_mp {l : list α}
 (l_nodup : list.nodup l)
 (l_sorted : list.sorted has_le.le l)
 {i j : ℕ} (hi : i ≤ j) (hj : j < l.length) :
 (l.nth_le i (lt_of_le_of_lt hi hj) ≤ l.nth_le j hj) :=
begin
 by_cases h : i = j,
 { cases h, refl },
 { have hi' : i < j := lt_of_le_of_ne hi h,
   exact (le_of_lt $ sorted_nth_lt_mp l_nodup l_sorted hi' hj) }
end

lemma sorted_nth_lt {l : list α}
 (l_nodup : list.nodup l)
 (l_sorted : list.sorted has_le.le l)
 { i j : ℕ } (hi : i < l.length) (hj : j < l.length) :
  (i < j) ↔ (l.nth_le i hi < l.nth_le j hj) :=
begin
 split,
 { intro hi',
   exact sorted_nth_lt_mp l_nodup l_sorted hi' hj },
 { intro x_lt_y,
   rcases lt_or_ge i j with i_lt_j | j_le_i,
   { assumption },
   { exfalso,
     let y_le_x := sorted_nth_le_mp l_nodup l_sorted j_le_i hi,
     exact not_lt_of_ge y_le_x x_lt_y } }
end

lemma sorted_nth_le {l : list α}
 (l_nodup : list.nodup l)
 (l_sorted : list.sorted has_le.le l)
 { i j : ℕ } (hi : i < l.length) (hj : j < l.length) :
  (i ≤ j) ↔ (l.nth_le i hi ≤ l.nth_le j hj) :=
begin
 split,
 { intro hi',
   exact sorted_nth_le_mp l_nodup l_sorted hi' hj },
 { intro x_le_y,
   rcases le_or_gt i j with i_le_j | j_lt_i,
   { assumption },
   { exfalso,
     let y_lt_x := sorted_nth_lt_mp l_nodup l_sorted j_lt_i hi,
     exact not_le_of_gt y_lt_x x_le_y } }
end

end list

namespace finset

variables [linear_order α] [decidable_rel (@has_le.le α _)]

/-
 The standard library defines a function that accepts a finite set s
 and returns the list of elements in sorted order.  The next lemma
 tells us how we can recognise that list if we have obtained it by
 other means.
-/

theorem list.perm.eqv' (α : Type*) : equivalence (@perm α) :=
mk_equivalence (@perm α) (@perm.refl α) (@perm.symm α) (@perm.trans α)

instance list.is_setoid' (α : Type*) : setoid (list α) :=
setoid.mk (@perm α) (list.perm.eqv' α)

lemma sort_spec (s : finset α) (l : list α)
 (l_nodup : l.nodup) (l_sorted : l.sorted has_le.le)
  (s_eq_l : s = l.to_finset) : s.sort has_le.le = l :=
begin
 let h0 := (congr_arg val
            (eq.trans (eq.trans (to_finset_eq (sort_nodup has_le.le s)) (eq.trans (sort_to_finset has_le.le s) s_eq_l))
                      (eq.symm (to_finset_eq l_nodup)))),
 let h1 := list.eq_of_perm_of_sorted (@quotient.exact (list α) (list.is_setoid' α) _ _ h0) (sort_sorted has_le.le s) l_sorted,
 let ll : multiset α := quot.mk _ l,
 have ll_nodup : ll.nodup := multiset.coe_nodup.mpr l_nodup,
 have ll_eq : (⟨ll,ll_nodup⟩ : finset α) = l.to_finset := list.to_finset_eq l_nodup,
 let m := s.sort has_le.le,
 have m_nodup : m.nodup := s.sort_nodup has_le.le,
 have m_sorted : m.sorted has_le.le := s.sort_sorted has_le.le,
 let mm : multiset α := quot.mk _ m,
 have mm_nodup : mm.nodup := multiset.coe_nodup.mpr m_nodup,
 have mm_eq : (⟨mm,mm_nodup⟩ : finset α) = m.to_finset := list.to_finset_eq m_nodup,
 have m_to_finset : m.to_finset = s :=
  s.sort_to_finset has_le.le,
 let mm_eq_ll :=
  congr_arg finset.val ((mm_eq.trans (m_to_finset.trans s_eq_l)).trans ll_eq.symm),
 dsimp[finset.val] at mm_eq_ll,
 have perm_m_l : perm m l := quotient.exact mm_eq_ll,
 exact list.eq_of_perm_of_sorted perm_m_l m_sorted l_sorted,
end

/-
 The next lemma is equivalent to the previous one.  However, as an
 experiment we have written it as a single term rather than using
 tactics.  We used the command "#print sort_spec" to print the
 proof term generated automatically be Lean from the tactic proof,
 and then reorganised it a bit to eliminate some inefficiencies.
-/

lemma sort_spec_alt (s : finset α) (l : list α)
 (l_nodup : l.nodup) (l_sorted : l.sorted has_le.le)
  (s_eq_l : s = l.to_finset) : s.sort has_le.le = l :=
    list.eq_of_perm_of_sorted
     (@quotient.exact
      (list α)
      (list.is_setoid' α)
      _
      _
      (@congr_arg
       (finset α)
       (multiset α)
       _
       _
       finset.val
       (eq.trans
        (eq.trans (to_finset_eq (sort_nodup has_le.le s)) (eq.trans (sort_to_finset has_le.le s) s_eq_l))
        (eq.symm (to_finset_eq l_nodup))
       )
      )
     )
     (sort_sorted has_le.le s)
     l_sorted

section rank_equiv

/-
 We now give our first version of the fact that any finite, linearly ordered
 set of size n is order-isomorphic to (fin n). In this version, the type α has
 a decidable linear order and s is a finite subset of α that need not contain
 all elements of α.  In order to talk about an order-equivalence we need to
 convert s into a separate type by considering {a // a ∈ s}. The definition
 (rank_equiv s) gives an equivalence from this type to (fin n), but it is not
 initially packaged with any information about order-preserving properties.
 Instead, we prove those properties as four separate lemmas after the
 definition of rank_equiv.

 Note that we have arguments n and s_card : s.card = n, and we produce an
 equivalence with (fin n).  One might think that it would be more natural to
 just produce an equivalence with (fin s.card), and then use eq.mp to convert
 this to (fin n) if necessary.  Unfortunately, this leads to a lot of tedious
 troubles with heterogenous equality.  As far as I can tell, the present
 approach is the simplest way to avoid that.
-/

variables {s : finset α} {n : ℕ} (s_card : s.card = n)
include s_card

#check list.mem_to_finset
def rank_equiv : { a // a ∈ s } ≃ fin n :=
begin
 let l := s.sort has_le.le,
 have l_nodup : list.nodup l := finset.sort_nodup has_le.le s,
 have l_eq_s : l.to_finset = s := by simp[finset.sort_eq],
 have l_len : l.length = n :=
  ((@eq.subst (finset α) (λ t, t.card = l.length) _ _ l_eq_s
             (list.to_finset_card_of_nodup l_nodup)).symm).trans s_card,
 let mem_equiv : ∀ a : α, a ∈ s ↔ a ∈ l :=
  λ a, @eq.subst (finset α) (λ t, a ∈ t ↔ a ∈ l) _ _ l_eq_s
         list.mem_to_finset,
 let to_fun : { a // a ∈ s } → fin n :=
 begin
  intro a,
  have a_in_l : a.val ∈ l := (mem_equiv a.val).mp a.property,
  let i : ℕ := list.index_of a.val l,
  have i_lt_n : i < n :=
   l_len.subst (list.index_of_lt_length.mpr a_in_l),
  exact ⟨i,i_lt_n⟩
 end,
 let inv_fun : fin n → { a // a ∈ s } :=
 begin
  intro i,
  have i_is_lt : i.val < l.length := @eq.subst ℕ (λ m, i.val < m) _ _ l_len.symm i.is_lt,
  let a := l.nth_le i.val i_is_lt,
  have a_in_s : a ∈ s := (mem_equiv a).mpr (l.nth_le_mem i.val i_is_lt),
  exact ⟨a,a_in_s⟩
 end,
 have left_inv : ∀ a, inv_fun (to_fun a) = a :=
 begin
  intro a,
  rcases a with ⟨a_val,a_in_s⟩,
  have a_in_l : a_val ∈ l := (mem_equiv a_val).mp a_in_s,
  let i := list.index_of a_val l,
  have i_lt_len : i < l.length := list.index_of_lt_length.mpr a_in_l,
  have i_lt_n : i < n := l_len.subst i_lt_len,
  dsimp[inv_fun,to_fun],
  apply subtype.eq,dsimp[subtype.val],
  exact list.index_of_nth_le i_lt_len,
 end,
 have right_inv : ∀ i, to_fun (inv_fun i) = i :=
 begin
  intro i,
  rcases i with ⟨i_val,i_lt_n⟩,
  have i_lt_len : i_val < l.length := l_len.symm.subst i_lt_n,
  dsimp[inv_fun,to_fun],
  apply fin.eq_of_veq,dsimp[subtype.val],
  exact list.nth_le_index_of l_nodup i_val i_lt_len,
 end,
 exact ⟨to_fun,inv_fun,left_inv,right_inv⟩,
end

lemma seq_le (i1 i2 : fin n) :
 i1 ≤ i2 ↔ (((rank_equiv s_card).inv_fun i1).val ≤ ((rank_equiv s_card).inv_fun i2).val) :=
begin
 dsimp [rank_equiv, nth_le, has_le.le, fin.le],
 let l := s.sort has_le.le,
 have l_nodup : list.nodup l := finset.sort_nodup has_le.le s,
 have l_sorted : l.sorted has_le.le := sort_sorted has_le.le s,
 have l_eq_s : l.to_finset = s := by simp[finset.sort_eq],
 have l_len : l.length = n :=
  ((@eq.subst (finset α) (λ t, t.card = l.length) _ _ l_eq_s
             (list.to_finset_card_of_nodup l_nodup)).symm).trans s_card,
 have i1p : i1.val < l.length := by { rw[l_len], exact i1.is_lt },
 have i2p : i2.val < l.length := by { rw[l_len], exact i2.is_lt },
 exact list.sorted_nth_le l_nodup l_sorted i1p i2p
end

lemma seq_lt (i1 i2 : fin n) :
 i1 < i2 ↔ (((rank_equiv s_card).inv_fun i1).val < ((rank_equiv s_card).inv_fun i2).val) :=
begin
 dsimp [rank_equiv, nth_le, has_le.le, fin.le],
 let l := s.sort has_le.le,
 have l_nodup : list.nodup l := finset.sort_nodup has_le.le s,
 have l_sorted : l.sorted has_le.le := sort_sorted has_le.le s,
 have l_eq_s : l.to_finset = s := by simp[finset.sort_eq],
 have l_len : l.length = n :=
  ((@eq.subst (finset α) (λ t, t.card = l.length) _ _ l_eq_s
             (list.to_finset_card_of_nodup l_nodup)).symm).trans s_card,
 have i1p : i1.val < l.length := by { rw[l_len], exact i1.is_lt },
 have i2p : i2.val < l.length := by { rw[l_len], exact i2.is_lt },
 exact list.sorted_nth_lt l_nodup l_sorted i1p i2p
end

lemma rank_le (a1 a2 : {a // a ∈ s }) :
 a1.val ≤ a2.val ↔ (rank_equiv s_card).to_fun a1 ≤ (rank_equiv s_card).to_fun a2 :=
begin
 let f := rank_equiv s_card,
 let i1 := f.to_fun a1,
 let i2 := f.to_fun a2,
 let a1a := f.inv_fun i1,
 let a2a := f.inv_fun i2,
 let h := ((seq_le s_card) (f.to_fun a1) (f.to_fun a2)).symm,
 let e1 : (f.inv_fun i1).val = a1.val := congr_arg subtype.val (f.left_inv a1),
 let e2 : (f.inv_fun i2).val = a2.val := congr_arg subtype.val (f.left_inv a2),
 split,
 {intro h1,rw[← e1,← e2] at h1,exact h.mp h1,},
 {intro h2,let h3 := h.mpr h2,rw[e1,e2] at h3,exact h3}
end

lemma rank_lt (a1 a2 : {a // a ∈ s }) :
 a1.val < a2.val ↔ ((rank_equiv s_card).to_fun a1) < ((rank_equiv s_card).to_fun a2) :=
begin
 let f := rank_equiv s_card,
 let i1 := f.to_fun a1,
 let i2 := f.to_fun a2,
 let a1a := f.inv_fun i1,
 let a2a := f.inv_fun i2,
 let h := ((seq_lt s_card) (f.to_fun a1) (f.to_fun a2)).symm,
 let e1 : (f.inv_fun i1).val = a1.val := congr_arg subtype.val (f.left_inv a1),
 let e2 : (f.inv_fun i2).val = a2.val := congr_arg subtype.val (f.left_inv a2),
 split,
 {intro h1,rw[← e1,← e2] at h1,exact h.mp h1,},
 {intro h2,let h3 := h.mpr h2,rw[e1,e2] at h3,exact h3}
end

lemma rank_as_card (a : { x // x ∈ s}) :
 ((rank_equiv s_card).to_fun a).val = card (s.filter (λ x, x < a.val)) :=
begin
 let f := rank_equiv s_card,
 let u := s.filter (λ x, x < a.val),
 let ut := {x // x ∈ u},
 let k := f.to_fun a,
 have fi_k : f.inv_fun k = a := f.left_inv a,
 let g_to_fun : ut → fin k.val :=
 begin
  intro x,
  let x0 : { x // x ∈ s } := ⟨x.val,(mem_filter.mp x.property).left⟩,
  let x_lt_a : x0.val < a.val := (mem_filter.mp x.property).right,
  let i := f.to_fun x0,
  let i_lt_k : i < k := ((rank_lt s_card) x0 a).mp x_lt_a,
  let i_lt_k_val : i.val < k.val :=
  begin
   let h := i_lt_k,
   dsimp[has_lt.lt,fin.lt] at h,
   exact h,
  end,
  exact ⟨i.val,i_lt_k_val⟩,
 end,
 let g_inv_fun : fin k.val → ut :=
 begin
  intro i,
  let i0 : fin n := ⟨i.val,lt_trans i.is_lt k.is_lt⟩,
  have i0_lt_k : i0 < k := by { simp[has_lt.lt,fin.lt], exact i.is_lt,},
  let x0 := f.inv_fun i0,
  let x_lt_a := ((seq_lt s_card) i0 k).mp i0_lt_k,
  rw[fi_k] at x_lt_a,
  have x_in_u : x0.val ∈ u :=
  begin
   apply mem_filter.mpr,
   exact ⟨x0.property,x_lt_a⟩,
  end,
  exact ⟨x0.val,x_in_u⟩,
 end,
 have g_left_inv : ∀ x, g_inv_fun (g_to_fun x) = x :=
 begin
  intro x,
  dsimp[g_to_fun,g_inv_fun],
  apply subtype.eq; simp[subtype.val]
 end,
 have g_right_inv : ∀ i, g_to_fun (g_inv_fun i) = i :=
 begin
  intro i,
  dsimp[g_to_fun,g_inv_fun],
  apply fin.eq_of_veq; simp[subtype.val]
 end,
 let g : ut ≃ fin k.val := ⟨g_to_fun,g_inv_fun,g_left_inv,g_right_inv⟩,
 let h0 := fintype.card_congr g,
 let h1 := @finset.card_attach α u,
 let h2 := fintype.card_fin k.val,
 exact (h1.symm.trans (h0.trans h2)).symm,
end

end rank_equiv

end finset

namespace fintype
open finset fintype

variables [linear_order α] [decidable_rel (@has_le.le α _)]
variables [fintype α] {n : ℕ} (α_card : card α = n)
include α_card

/-
 We now give our second version of the fact that any finite, linearly ordered
 set of size n is order-isomorphic to (fin n). In this version we assume given
 an instance of (fintype α), which is essentially a proof that the whole type
 α is finite. From this we build an equivalence from α to (fin n), and again
 we prove the order properties as separate lemmas.
-/

def rank_equiv : α ≃ fin n :=
begin
 have h0 : finset.card (@elems α _) = n := α_card,
 let f := finset.rank_equiv h0,
 let to_fun : α → fin n := λ a, f.to_fun ⟨a,mem_univ a⟩,
 let inv_fun : fin n → α := λ i, (f.inv_fun i).val,
 have left_inv : ∀ a : α, inv_fun (to_fun a) = a :=
  λ a, congr_arg subtype.val (f.left_inv ⟨a,mem_univ a⟩),
 have right_inv : ∀ i : fin n, to_fun (inv_fun i) = i :=
 begin
  intro i,
  have e : f.inv_fun i = ⟨inv_fun i,mem_univ _⟩ :=
   by {apply subtype.eq,simp[inv_fun]},
  dsimp[inv_fun,to_fun],simp[e]
 end,
 exact ⟨to_fun,inv_fun,left_inv,right_inv⟩,
end

lemma seq_le (i1 i2 : fin n) :
 i1 ≤ i2 ↔ (rank_equiv α_card).inv_fun i1 ≤ (rank_equiv α_card).inv_fun i2 :=
  (seq_le α_card) i1 i2

lemma seq_lt (i1 i2 : fin n) :
 i1 < i2 ↔ (rank_equiv α_card).inv_fun i1 < (rank_equiv α_card).inv_fun i2 :=
  (seq_lt α_card) i1 i2

lemma rank_le (a1 a2 : α) :
 a1 ≤ a2 ↔ (rank_equiv α_card).to_fun a1 ≤ (rank_equiv α_card).to_fun a2 :=
  (rank_le α_card) ⟨a1,mem_univ a1⟩ ⟨a2,mem_univ a2⟩

lemma rank_lt (a1 a2 : α) :
 a1 < a2 ↔ (rank_equiv α_card).to_fun a1 < (rank_equiv α_card).to_fun a2 :=
  (rank_lt α_card) ⟨a1,mem_univ a1⟩ ⟨a2,mem_univ a2⟩

end fintype

namespace fin
/-
 The only strictly increasing self-map of (fin n) is the identity
-/
lemma rigid {n : ℕ} {f : fin n → fin n}
 (f_mono : ∀ {i1 i2 : fin n}, i1 < i2 → (f i1) < (f i2)) :
  ∀ (i : fin n), f i = i :=
begin
 induction n with n0 ih,
 {intro i,exact fin.elim0 i},
 {
  let f0 : fin n0 → fin n0 :=
  begin
   intro i0,
   let h0 := ne_of_lt (lt_of_le_of_lt (fin.zero_le (f 0)) (f_mono (@fin.zero_lt_succ n0 i0))),
   exact fin.pred (f i0.succ) h0.symm,
  end,
  have succ_f0 : ∀ (i0 : fin n0), (f0 i0).succ = f i0.succ :=
  begin
   intro i0,
   let h0 := ne_of_lt (lt_of_le_of_lt (fin.zero_le (f 0)) (f_mono (@fin.zero_lt_succ n0 i0))),
   exact fin.succ_pred (f i0.succ) h0.symm,
  end,
  have f0_mono : ∀ {i1 i2 : fin n0}, i1 < i2 → (f0 i1) < (f0 i2) :=
  begin
   intros i1 i2 i1_lt_i2,
   let h0 := f_mono (fin.succ_lt_succ i1_lt_i2),
   rw[← (succ_f0 i1)] at h0,
   rw[← (succ_f0 i2)] at h0,
   exact fin.lt_of_succ_lt_succ h0,
  end,
  let f0_id := ih @f0_mono,
  have f_zero_a : ∀ (j : fin n0.succ), f 0 = j → j = 0 :=
  begin
   intros j e, cases j with j_val j_is_lt, cases j_val with j0_val,
   {refl},
   {
     exfalso,
     have j0_is_lt : j0_val < n0 := nat.lt_of_succ_lt_succ j_is_lt,
     let j0 : fin n0 := ⟨j0_val,j0_is_lt⟩,
     let j := j0.succ,
     have h0 : f j = j := (succ_f0 j0).symm.trans (congr_arg fin.succ (f0_id j0)),
     have h1 : f 0 < f j := f_mono (@fin.zero_lt_succ n0 j0),
     have h2 : j < f j := @eq.subst (fin n0.succ) (λ k, k < f j) _ _ e h1,
     exact (ne_of_lt h2) h0.symm,
   }
  end,
  have f_zero : f 0 = 0 := f_zero_a (f 0) rfl,
  intro i, cases i with i_val i_is_lt, cases i_val with i0_val,
  {exact f_zero,},
  {
   have i0_is_lt : i0_val < n0 := nat.lt_of_succ_lt_succ i_is_lt,
   let h0 := congr_arg fin.succ (f0_id ⟨i0_val,i0_is_lt⟩),
   let h1 := succ_f0 ⟨i0_val,i0_is_lt⟩,
   let h2 := h1.symm.trans h0,
   exact h2,
  }
 }
end

end fin


/-
Copyright (c) 2022 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import order.succ_pred.basic
/-!
# Relations on types with a `succ_order`

This file contains properties about relations on types with a `succ_order`
and their closure operations (like the transitive closure).
-/

open set relation succ_order pred_order function

section partial_succ
variables {α : Type*} [partial_order α] [succ_order α] [is_succ_archimedean α]

/-- For `n ≤ m`, `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ succ i`
  for all `i` between `n` and `m`. -/
lemma refl_trans_gen_of_succ_of_le (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ico n m, r i (succ i)) (hnm : n ≤ m) : refl_trans_gen r n m :=
begin
  revert h, refine succ.rec _ _ hnm,
  { intros h, exact refl_trans_gen.refl },
  { intros m hnm ih h,
    have : refl_trans_gen r n m := ih (λ i hi, h i ⟨hi.1, hi.2.trans_le $ le_succ m⟩),
    cases (le_succ m).eq_or_lt with hm hm, { rwa [← hm] },
    exact this.tail (h m ⟨hnm, hm⟩) }
end

/-- For `m ≤ n`, `(n, m)` is in the reflexive-transitive closure of `~` if `succ i ~ i`
  for all `i` between `n` and `m`. -/
lemma refl_trans_gen_of_succ_of_ge (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ico m n, r (succ i) i) (hmn : m ≤ n) : refl_trans_gen r n m :=
by { rw [← refl_trans_gen_swap], exact refl_trans_gen_of_succ_of_le (swap r) h hmn }

/-- For `n < m`, `(n, m)` is in the transitive closure of a relation `~` if `i ~ succ i`
  for all `i` between `n` and `m`. -/
lemma trans_gen_of_succ_of_lt (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ico n m, r i (succ i)) (hnm : n < m) : trans_gen r n m :=
(refl_trans_gen_iff_eq_or_trans_gen.mp $ refl_trans_gen_of_succ_of_le r h hnm.le).resolve_left
  hnm.ne'

/-- For `m < n`, `(n, m)` is in the transitive closure of a relation `~` if `succ i ~ i`
  for all `i` between `n` and `m`. -/
lemma trans_gen_of_succ_of_gt (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ico m n, r (succ i) i) (hmn : m < n) : trans_gen r n m :=
(refl_trans_gen_iff_eq_or_trans_gen.mp $ refl_trans_gen_of_succ_of_ge r h hmn.le).resolve_left
  hmn.ne

end partial_succ

section linear_succ
variables {α : Type*} [linear_order α] [succ_order α] [is_succ_archimedean α]

/-- `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ succ i` and `succ i ~ i`
  for all `i` between `n` and `m`. -/
lemma refl_trans_gen_of_succ (r : α → α → Prop) {n m : α}
  (h1 : ∀ i ∈ Ico n m, r i (succ i)) (h2 : ∀ i ∈ Ico m n, r (succ i) i) : refl_trans_gen r n m :=
(le_total n m).elim (refl_trans_gen_of_succ_of_le r h1) $ refl_trans_gen_of_succ_of_ge r h2

/-- For `n ≠ m`,`(n, m)` is in the transitive closure of a relation `~` if `i ~ succ i` and
  `succ i ~ i` for all `i` between `n` and `m`. -/
lemma trans_gen_of_succ_of_ne (r : α → α → Prop) {n m : α}
  (h1 : ∀ i ∈ Ico n m, r i (succ i)) (h2 : ∀ i ∈ Ico m n, r (succ i) i)
  (hnm : n ≠ m) : trans_gen r n m :=
(refl_trans_gen_iff_eq_or_trans_gen.mp (refl_trans_gen_of_succ r h1 h2)).resolve_left hnm.symm

/-- `(n, m)` is in the transitive closure of a reflexive relation `~` if `i ~ succ i` and
  `succ i ~ i` for all `i` between `n` and `m`. -/
lemma trans_gen_of_succ_of_reflexive (r : α → α → Prop) {n m : α} (hr : reflexive r)
  (h1 : ∀ i ∈ Ico n m, r i (succ i)) (h2 : ∀ i ∈ Ico m n, r (succ i) i) : trans_gen r n m :=
begin
  rcases eq_or_ne m n with rfl|hmn, { exact trans_gen.single (hr m) },
  exact trans_gen_of_succ_of_ne r h1 h2 hmn.symm
end

end linear_succ

section partial_pred
variables {α : Type*} [partial_order α] [pred_order α] [is_pred_archimedean α]

/-- For `m ≤ n`, `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ pred i`
  for all `i` between `n` and `m`. -/
lemma refl_trans_gen_of_pred_of_ge (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ioc m n, r i (pred i)) (hnm : m ≤ n) : refl_trans_gen r n m :=
@refl_trans_gen_of_succ_of_le (order_dual α) _ _ _ r n m (λ x hx, h x ⟨hx.2, hx.1⟩) hnm

/-- For `n ≤ m`, `(n, m)` is in the reflexive-transitive closure of `~` if `pred i ~ i`
  for all `i` between `n` and `m`. -/
lemma refl_trans_gen_of_pred_of_le (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ioc n m, r (pred i) i) (hmn : n ≤ m) : refl_trans_gen r n m :=
@refl_trans_gen_of_succ_of_ge (order_dual α) _ _ _ r n m (λ x hx, h x ⟨hx.2, hx.1⟩) hmn

/-- For `m < n`, `(n, m)` is in the transitive closure of a relation `~` for `n ≠ m` if `i ~ pred i`
  for all `i` between `n` and `m`. -/
lemma trans_gen_of_pred_of_gt (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ioc m n, r i (pred i)) (hnm : m < n) : trans_gen r n m :=
@trans_gen_of_succ_of_lt (order_dual α) _ _ _ r _ _ (λ x hx, h x ⟨hx.2, hx.1⟩) hnm

/-- For `n < m`, `(n, m)` is in the transitive closure of a relation `~` for `n ≠ m` if `pred i ~ i`
  for all `i` between `n` and `m`. -/
lemma trans_gen_of_pred_of_lt (r : α → α → Prop) {n m : α}
  (h : ∀ i ∈ Ioc n m, r (pred i) i) (hmn : n < m) : trans_gen r n m :=
@trans_gen_of_succ_of_gt (order_dual α) _ _ _ r _ _ (λ x hx, h x ⟨hx.2, hx.1⟩) hmn

end partial_pred

section linear_pred
variables {α : Type*} [linear_order α] [pred_order α] [is_pred_archimedean α]

/-- `(n, m)` is in the reflexive-transitive closure of `~` if `i ~ pred i` and `pred i ~ i`
  for all `i` between `n` and `m`. -/
lemma refl_trans_gen_of_pred (r : α → α → Prop) {n m : α}
  (h1 : ∀ i ∈ Ioc m n, r i (pred i)) (h2 : ∀ i ∈ Ioc n m, r (pred i) i) : refl_trans_gen r n m :=
@refl_trans_gen_of_succ (order_dual α) _ _ _ r n m (λ x hx, h1 x ⟨hx.2, hx.1⟩)
  (λ x hx, h2 x ⟨hx.2, hx.1⟩)

/-- For `n ≠ m`, `(n, m)` is in the transitive closure of a relation `~` if `i ~ pred i` and
  `pred i ~ i` for all `i` between `n` and `m`. -/
lemma trans_gen_of_pred_of_ne (r : α → α → Prop) {n m : α}
  (h1 : ∀ i ∈ Ioc m n, r i (pred i)) (h2 : ∀ i ∈ Ioc n m, r (pred i) i)
  (hnm : n ≠ m) : trans_gen r n m :=
@trans_gen_of_succ_of_ne (order_dual α) _ _ _ r n m (λ x hx, h1 x ⟨hx.2, hx.1⟩)
  (λ x hx, h2 x ⟨hx.2, hx.1⟩) hnm

/-- `(n, m)` is in the transitive closure of a reflexive relation `~` if `i ~ pred i` and
  `pred i ~ i` for all `i` between `n` and `m`. -/
lemma trans_gen_of_pred_of_reflexive (r : α → α → Prop) {n m : α} (hr : reflexive r)
  (h1 : ∀ i ∈ Ioc m n, r i (pred i)) (h2 : ∀ i ∈ Ioc n m, r (pred i) i) : trans_gen r n m :=
@trans_gen_of_succ_of_reflexive (order_dual α) _ _ _ r n m hr (λ x hx, h1 x ⟨hx.2, hx.1⟩)
  (λ x hx, h2 x ⟨hx.2, hx.1⟩)

end linear_pred


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

import combinatorics.composition
import data.nat.parity
import tactic.apply_fun

/-!
# Partitions

A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the
order does not matter: two sums that differ only in the order of their summands are considered the
same partition. This notion is closely related to that of a composition of `n`, but in a composition
of `n` the order does matter.
A summand of the partition is called a part.

## Main functions

* `p : partition n` is a structure, made of a multiset of integers which are all positive and
  add up to `n`.

## Implementation details

The main motivation for this structure and its API is to show Euler's partition theorem, and
related results.

The representation of a partition as a multiset is very handy as multisets are very flexible and
already have a well-developed API.

## Tags

Partition

## References

<https://en.wikipedia.org/wiki/Partition_(number_theory)>
-/

variables {α : Type*}

open multiset
open_locale big_operators

namespace nat

/-- A partition of `n` is a multiset of positive integers summing to `n`. -/
@[ext, derive decidable_eq] structure partition (n : ℕ) :=
(parts : multiset ℕ)
(parts_pos : ∀ {i}, i ∈ parts → 0 < i)
(parts_sum : parts.sum = n)

namespace partition

/-- A composition induces a partition (just convert the list to a multiset). -/
def of_composition (n : ℕ) (c : composition n) : partition n :=
{ parts := c.blocks,
  parts_pos := λ i hi, c.blocks_pos hi,
  parts_sum := by rw [multiset.coe_sum, c.blocks_sum] }

lemma of_composition_surj {n : ℕ} : function.surjective (of_composition n) :=
begin
  rintro ⟨b, hb₁, hb₂⟩,
  rcases quotient.exists_rep b with ⟨b, rfl⟩,
  refine ⟨⟨b, λ i hi, hb₁ hi, _⟩, partition.ext _ _ rfl⟩,
  simpa using hb₂
end

/--
Given a multiset which sums to `n`, construct a partition of `n` with the same multiset, but
without the zeros.
-/
-- The argument `n` is kept explicit here since it is useful in tactic mode proofs to generate the
-- proof obligation `l.sum = n`.
def of_sums (n : ℕ) (l : multiset ℕ) (hl : l.sum = n) : partition n :=
{ parts := l.filter (≠ 0),
  parts_pos := λ i hi, nat.pos_of_ne_zero $ by apply of_mem_filter hi,
  parts_sum :=
  begin
    have lt : l.filter (= 0) + l.filter (≠ 0) = l := filter_add_not _ l,
    apply_fun multiset.sum at lt,
    have lz : (l.filter (= 0)).sum = 0,
    { rw multiset.sum_eq_zero_iff,
      simp },
    simpa [lz, hl] using lt,
  end }

/-- A `multiset ℕ` induces a partition on its sum. -/
def of_multiset (l : multiset ℕ) : partition l.sum :=
of_sums _ l rfl

/-- The partition of exactly one part. -/
def indiscrete_partition (n : ℕ) : partition n :=
of_sums n {n} rfl

instance {n : ℕ} : inhabited (partition n) := ⟨indiscrete_partition n⟩

/--
The number of times a positive integer `i` appears in the partition `of_sums n l hl` is the same
as the number of times it appears in the multiset `l`.
(For `i = 0`, `partition.non_zero` combined with `multiset.count_eq_zero_of_not_mem` gives that
this is `0` instead.)
-/
lemma count_of_sums_of_ne_zero {n : ℕ} {l : multiset ℕ} (hl : l.sum = n) {i : ℕ} (hi : i ≠ 0) :
  (of_sums n l hl).parts.count i = l.count i :=
count_filter_of_pos hi

lemma count_of_sums_zero {n : ℕ} {l : multiset ℕ} (hl : l.sum = n) :
  (of_sums n l hl).parts.count 0 = 0 :=
count_filter_of_neg (λ h, h rfl)

/--
Show there are finitely many partitions by considering the surjection from compositions to
partitions.
-/
instance (n : ℕ) : fintype (partition n) :=
fintype.of_surjective (of_composition n) of_composition_surj

/-- The finset of those partitions in which every part is odd. -/
def odds (n : ℕ) : finset (partition n) :=
finset.univ.filter (λ c, ∀ i ∈ c.parts, ¬ even i)

/-- The finset of those partitions in which each part is used at most once. -/
def distincts (n : ℕ) : finset (partition n) :=
finset.univ.filter (λ c, c.parts.nodup)

/-- The finset of those partitions in which every part is odd and used at most once. -/
def odd_distincts (n : ℕ) : finset (partition n) := odds n ∩ distincts n

end partition
end nat


/- Homework 2.2: Functional Programming — Trees -/

/- Question 1: Huffman's algorithm -/

/- Recall the following definition from the lecture. -/

inductive tree (α : Type)
| leaf : ℕ → α → tree
| inner : ℕ → tree → tree → tree

export tree (leaf inner)

/- To make our lives easy, we will fix a type α of symbols equipped with decidable equality
throughout this question. -/

section

parameter (α : Type)
parameter [decidable_eq α]

/- We start by defining the alphabet of a tree: the set of its labels. We use lists to represent
sets to get executability for free. The cost is that we must ignore the order or number of
occurrences of elements in a list when comparing alphabets. -/

def alphabet : tree α → list α
| (leaf _ a)    := [a]
| (inner _ l r) := alphabet l ++ alphabet r

/- 1.1. Define the following function, so that we can obtain the alphabet of an entire forest
(i.e. list of trees).

Hint: Through this exercise, try to keep your definitions as simple as possible, because this will
affect proving ease further down. -/

def alphabet_list : list (tree α) → list α
| [] := []
| (x :: xs) := alphabet_list xs ++ alphabet x

/- A tree is consistent if it contains no duplicate labels. This can be defined as an inductive
predicate. -/

inductive consistent : tree α → Prop
| consistent_leaf (w : ℕ) (a : α) : consistent (leaf w a)
| consistent_inner (w : ℕ) (l : tree α) (r : tree α) :
  consistent l → consistent r → (∀a, a ∈ alphabet l → a ∈ alphabet r → false) →
  consistent (inner w l r)

/- 1.2. A forest is consistent if it contains no duplicate labels (even in different trees). Define
an inductive predicate `consistent_list` that captures this property. -/

inductive consistent_trees : list (tree α) → Prop
| consistent_nil (w: ℕ) (a: α) : consistent_trees[]
| consistent_cons (w: ℕ) (t: tree α) (ts: list (tree α) : consistent t → consistent_trees ts → (∀a, a ∈ alphabet t → a ∈ alphabet_list ts → false) →
consistent_trees ts
/- 1.3. The height of a tree is the length of the longest path from its root node to a leaf. A tree
consisting of a single node has height 0 by convention. Define a recursive function `height` that
computes this.

Hint: You may use the built-in `max` function. -/

def height {α: Type} : tree α → ℕ
| (leaf _ a) := 1
| (inner _ l r) := 1 + max (height l) (height r)

/- 1.4. Now define the same function on forests, where the height of a forest is defined as the
height of its tallest tree. -/

def height_forest {α: Type}: list(tree α) → ℕ
| [] := 0
| (x :: xs) :=  1 + max (height x) (height_forest xs)

/- 1.5. Define a function that returns the depth of a symbol in a tree. For example, if the symbol
is stored in a leaf node immediately below the root, it would be at depth 1. Symbols that do not
occur in the tree are conventionally put at depth 0. For symbols that occur several times as labels,
you can arbitrarily choose which occurrence to consider (e.g. the leftmost one). -/

def depth : tree α → α → ℕ
| (leaf _ a) x := 1
| (inner _ l r) x := depth l x + depth r x

/- 1.6. State and prove that the depth of a symbol in a tree is less than or equal to the height of
the tree.

Hint: You might find the lemmas `le_max_left`, `add_le_add_left`, and similarly named ones useful.
Use Visual Studio Code's Command Palette to explore Lean's library (e.g. `#le_max`). -/
lemma depthlessequal :∀t : tree α, consistent t → ∀a ∈ alphabet t, depth t a <= height t
| (leaf _ a)      ct := begin repeat {apply exists.intro}, simp[alphabet], simp[depth, height], intro s, simp[le_of_eq] end
| (inner _ l r)   ct :=
begin
 repeat{apply exists.intro},
 simp[alphabet],
 simp[depth, height],
 intro s,
 intro a,
 simp[le_max],

  end

/- 1.7. A tree's height is not only an upper bound on the depth of symbols stored in the tree. It is
also a tight bound. Complete the following proof. -/

lemma exists_at_height : ∀t : tree α, consistent t → ∃a ∈ alphabet t, depth t a = height t
| (leaf _ a)      ct :=
  begin
    repeat {apply exists.intro},
    simp[alphabet],
    simp[depth, height]
  end
| t@(inner _ l r) ct :=  -- `t@` introduces the alias `t` for `inner _ l r`
  have cl : consistent l :=
   begin
    have bla: ∀ (t : tree α), consistent t → (∃ (a : α) (H : a ∈ alphabet t), depth t a = height t) ,
    intro a,
    intro b,
    apply exists_at_height,
    assumption,

   end
  have cr : consistent r :=
   sorry,
  let ⟨b, b_in_alpha_l, depth_l_b_eq_height_l⟩ := exists_at_height l cl in
  let ⟨c, c_in_alpha_r, depth_r_c_eq_height_r⟩ := exists_at_height r cr in
  let b_or_c := if height r ≤ height l then b else c in
  have borc_in_alpha_t : b_or_c ∈ alphabet t :=
   begin
    repeat {apply exists.intro},
    simp[alphabet],
    apply or.inr,
    simp [b_or_c],
    by_cases (ite (height r ≤ height l) b c ∈ alphabet r),

   end
  have depth_t_borc_eq_height_t : depth t b_or_c = height t :=
   sorry,  -- **optional**
  ⟨b_or_c, borc_in_alpha_t, depth_t_borc_eq_height_t⟩

end

/- Question 2: Enter your question here. -/


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import data.fintype.basic
import data.finset.basic
import tactic.rcases
import computability.language

/-!
# Regular Expressions

This file contains the formal definition for regular expressions and basic lemmas. Note these are
regular expressions in terms of formal language theory. Note this is different to regex's used in
computer science such as the POSIX standard.

TODO
* Show that this regular expressions and DFA/NFA's are equivalent.
* `attribute [pattern] has_mul.mul` has been added into this file, it could be moved.
-/

universe u

variables {α : Type u} [dec : decidable_eq α]

/--
This is the definition of regular expressions. The names used here is to mirror the definition
of a Kleene algebra (https://en.wikipedia.org/wiki/Kleene_algebra).
* `0` (`zero`) matches nothing
* `1` (`epsilon`) matches only the empty string
* `char a` matches only the string 'a'
* `star P` matches any finite concatenation of strings which match `P`
* `P + Q` (`plus P Q`) matches anything which match `P` or `Q`
* `P * Q` (`comp P Q`) matches `x ++ y` if `x` matches `P` and `y` matches `Q`
-/
inductive regular_expression (α : Type u) : Type u
| zero : regular_expression
| epsilon : regular_expression
| char : α → regular_expression
| plus : regular_expression → regular_expression → regular_expression
| comp : regular_expression → regular_expression → regular_expression
| star : regular_expression → regular_expression

namespace regular_expression

instance : inhabited (regular_expression α) := ⟨zero⟩

instance : has_add (regular_expression α) := ⟨plus⟩
instance : has_mul (regular_expression α) := ⟨comp⟩
instance : has_one (regular_expression α) := ⟨epsilon⟩
instance : has_zero (regular_expression α) := ⟨zero⟩

attribute [pattern] has_mul.mul

@[simp] lemma zero_def : (zero : regular_expression α) = 0 := rfl
@[simp] lemma one_def : (epsilon : regular_expression α) = 1 := rfl

@[simp] lemma plus_def (P Q : regular_expression α) : plus P Q = P + Q := rfl
@[simp] lemma comp_def (P Q : regular_expression α) : comp P Q = P * Q := rfl

/-- `matches P` provides a language which contains all strings that `P` matches -/
def matches : regular_expression α → language α
| 0 := 0
| 1 := 1
| (char a) := {[a]}
| (P + Q) := P.matches + Q.matches
| (P * Q) := P.matches * Q.matches
| (star P) := P.matches.star

@[simp] lemma matches_zero_def : (0 : regular_expression α).matches = 0 := rfl
@[simp] lemma matches_epsilon_def : (1 : regular_expression α).matches = 1 := rfl
@[simp] lemma matches_add_def (P Q : regular_expression α) :
  (P + Q).matches = P.matches + Q.matches := rfl
@[simp] lemma matches_mul_def (P Q : regular_expression α) :
  (P * Q).matches = P.matches * Q.matches := rfl
@[simp] lemma matches_star_def (P : regular_expression α) : P.star.matches = P.matches.star := rfl

/-- `match_epsilon P` is true if and only if `P` matches the empty string -/
def match_epsilon : regular_expression α → bool
| 0 := ff
| 1 := tt
| (char _) := ff
| (P + Q) := P.match_epsilon || Q.match_epsilon
| (P * Q) := P.match_epsilon && Q.match_epsilon
| (star P) := tt

include dec

/-- `P.deriv a` matches `x` if `P` matches `a :: x`, the Brzozowski derivative of `P` with respect
  to `a` -/
def deriv : regular_expression α → α → regular_expression α
| 0 _ := 0
| 1 _ := 0
| (char a₁) a₂ := if a₁ = a₂ then 1 else 0
| (P + Q) a := deriv P a + deriv Q a
| (P * Q) a :=
  if P.match_epsilon then
    deriv P a * Q + deriv Q a
  else
    deriv P a * Q
| (star P) a := deriv P a * star P

/-- `P.rmatch x` is true if and only if `P` matches `x`. This is a computable definition equivalent
  to `matches`. -/
def rmatch : regular_expression α → list α → bool
| P [] := match_epsilon P
| P (a::as) := rmatch (P.deriv a) as

@[simp] lemma zero_rmatch (x : list α) : rmatch 0 x = ff :=
by induction x; simp [rmatch, match_epsilon, deriv, *]

lemma char_rmatch_iff (a : α) (x : list α) : rmatch (char a) x ↔ x = [a] :=
begin
  cases x with _ x,
    dec_trivial,
  cases x,
    rw [rmatch, deriv],
    split_ifs;
    tauto,
  rw [rmatch, deriv],
  split_ifs,
    rw one_rmatch_iff,
    tauto,
  rw zero_rmatch,
  tauto
end

lemma add_rmatch_iff (P Q : regular_expression α) (x : list α) :
  (P + Q).rmatch x ↔ P.rmatch x ∨ Q.rmatch x :=
begin
  induction x with _ _ ih generalizing P Q,
  { repeat {rw rmatch},
    rw match_epsilon,
    finish },
  { repeat {rw rmatch},
    rw deriv,
    exact ih _ _ }
end

lemma mul_rmatch_iff (P Q : regular_expression α) (x : list α) :
  (P * Q).rmatch x ↔ ∃ t u : list α, x = t ++ u ∧ P.rmatch t ∧ Q.rmatch u :=
begin
  induction x with a x ih generalizing P Q,
  { rw [rmatch, match_epsilon],
    split,
    { intro h,
      refine ⟨ [], [], rfl, _ ⟩,
      rw [rmatch, rmatch],
      rwa band_coe_iff at h },
    { rintro ⟨ t, u, h₁, h₂ ⟩,
      cases list.append_eq_nil.1 h₁.symm with ht hu,
      subst ht,
      subst hu,
      repeat {rw rmatch at h₂},
      finish } },
  { rw [rmatch, deriv],
    split_ifs with hepsilon,
    { rw [add_rmatch_iff, ih],
      split,
      { rintro (⟨ t, u, _ ⟩ | h),
        { exact ⟨ a :: t, u, by tauto ⟩ },
        { exact ⟨ [], a :: x, rfl, hepsilon, h ⟩ } },
      { rintro ⟨ t, u, h, hP, hQ ⟩,
        cases t with b t,
        { right,
          rw list.nil_append at h,
          rw ←h at hQ,
          exact hQ },
        { left,
          refine ⟨ t, u, by finish, _, hQ ⟩,
          rw rmatch at hP,
          convert hP,
          finish } } },
    { rw ih,
      split;
      rintro ⟨ t, u, h, hP, hQ ⟩,
      { exact ⟨ a :: t, u, by tauto ⟩ },
      { cases t with b t,
        { contradiction },
        { refine ⟨ t, u, by finish, _, hQ ⟩,
          rw rmatch at hP,
          convert hP,
          finish } } } }
end

lemma star_rmatch_iff (P : regular_expression α) : ∀ (x : list α),
  (star P).rmatch x ↔ ∃ S : list (list α), x = S.join ∧ ∀ t ∈ S, t ≠ [] ∧ P.rmatch t
| x :=
begin
  have A : ∀ (m n : ℕ), n < m + n + 1,
  { assume m n,
    convert add_lt_add_of_le_of_lt (add_le_add (zero_le m) (le_refl n)) zero_lt_one,
    simp },
  have IH := λ t (h : list.length t < list.length x), star_rmatch_iff t,
  clear star_rmatch_iff,
  split,
  { cases x with a x,
    { intro,
      fconstructor,
      exact [],
      tauto },
    { rw [rmatch, deriv, mul_rmatch_iff],
      rintro ⟨ t, u, hs, ht, hu ⟩,
      have hwf : u.length < (list.cons a x).length,
      { rw [hs, list.length_cons, list.length_append],
        apply A },
      rw IH _ hwf at hu,
      rcases hu with ⟨ S', hsum, helem ⟩,
      use (a :: t) :: S',
      split,
      { finish },
      { intros t' ht',
        cases ht' with ht' ht',
        { rw ht',
          exact ⟨ dec_trivial, ht ⟩ },
        { exact helem _ ht' } } } },
  { rintro ⟨ S, hsum, helem ⟩,
    cases x with a x,
    { dec_trivial },
    { rw [rmatch, deriv, mul_rmatch_iff],
      cases S with t' U,
      { exact ⟨ [], [], by tauto ⟩ },
      { cases t' with b t,
        { finish },
        refine ⟨ t, U.join, by finish, _, _ ⟩,
        { specialize helem (b :: t) _,
          { finish },
          rw rmatch at helem,
          convert helem.2,
          finish },
        { have hwf : U.join.length < (list.cons a x).length,
          { rw hsum,
            simp only
              [list.join, list.length_append, list.cons_append, list.length_join, list.length],
            apply A },
          rw IH _ hwf,
          refine ⟨ U, rfl, λ t h, helem t _ ⟩,
          right,
          assumption } } } }
end
using_well_founded {
  rel_tac := λ _ _, `[exact ⟨(λ L₁ L₂ : list _, L₁.length < L₂.length), inv_image.wf _ nat.lt_wf⟩]
}

@[simp] lemma rmatch_iff_matches (P : regular_expression α) :
  ∀ x : list α, P.rmatch x ↔ x ∈ P.matches :=
begin
  intro x,
  induction P generalizing x,
  all_goals
  { try {rw zero_def},
    try {rw one_def},
    try {rw plus_def},
    try {rw comp_def},
    rw matches },
  case zero : {
    rw zero_rmatch,
    tauto },
  case epsilon : {
    rw one_rmatch_iff,
    refl },
  case char : {
    rw char_rmatch_iff,
    refl },
  case plus : _ _ ih₁ ih₂ {
    rw [add_rmatch_iff, ih₁, ih₂],
    refl },
  case comp : P Q ih₁ ih₂ {
    simp only [mul_rmatch_iff, comp_def, language.mul_def, exists_and_distrib_left, set.mem_image2,
      set.image_prod],
    split,
    { rintro ⟨ x, y, hsum, hmatch₁, hmatch₂ ⟩,
      rw ih₁ at hmatch₁,
      rw ih₂ at hmatch₂,
      exact ⟨ x, hmatch₁, y, hmatch₂, hsum.symm ⟩ },
    { rintro ⟨ x, hmatch₁, y, hmatch₂, hsum ⟩,
      rw ←ih₁ at hmatch₁,
      rw ←ih₂ at hmatch₂,
      exact ⟨ x, y, hsum.symm, hmatch₁, hmatch₂ ⟩ } },
  case star : _ ih {
    rw [star_rmatch_iff, language.star_def_nonempty],
    split,
    all_goals
    { rintro ⟨ S, hx, hS ⟩,
      refine ⟨ S, hx, _ ⟩,
      intro y,
      specialize hS y },
    { rw ←ih y,
      tauto },
    { rw ih y,
      tauto } }
end

instance (P : regular_expression α) : decidable_pred P.matches :=
begin
  intro x,
  change decidable (x ∈ P.matches),
  rw ←rmatch_iff_matches,
  exact eq.decidable _ _
end

end regular_expression


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module data.finset.nat_antidiagonal
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Card
import Mathlib.Data.Multiset.NatAntidiagonal

/-!
# Antidiagonals in ℕ × ℕ as finsets

This file defines the antidiagonals of ℕ × ℕ as finsets: the `n`-th antidiagonal is the finset of
pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

This refines files `Data.List.NatAntidiagonal` and `Data.Multiset.NatAntidiagonal`.
-/

namespace Finset

namespace Nat

/-- The antidiagonal of a natural number `n` is
    the finset of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : Finset (ℕ × ℕ) :=
  ⟨Multiset.Nat.antidiagonal n, Multiset.Nat.nodup_antidiagonal n⟩
#align finset.nat.antidiagonal Finset.Nat.antidiagonal

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp]
theorem mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} : x ∈ antidiagonal n ↔ x.1 + x.2 = n := by
  rw [antidiagonal, mem_def, Multiset.Nat.mem_antidiagonal]
#align finset.nat.mem_antidiagonal Finset.Nat.mem_antidiagonal

/-- The cardinality of the antidiagonal of `n` is `n + 1`. -/
@[simp]
theorem card_antidiagonal (n : ℕ) : (antidiagonal n).card = n + 1 := by simp [antidiagonal]
#align finset.nat.card_antidiagonal Finset.Nat.card_antidiagonal

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp]
theorem antidiagonal_zero : antidiagonal 0 = {(0, 0)} := rfl
#align finset.nat.antidiagonal_zero Finset.Nat.antidiagonal_zero

theorem antidiagonal_succ (n : ℕ) :
    antidiagonal (n + 1) =
      cons (0, n + 1)
        ((antidiagonal n).map
          (Function.Embedding.prodMap ⟨Nat.succ, Nat.succ_injective⟩ (Function.Embedding.refl _)))
        (by simp) := by
  apply eq_of_veq
  rw [cons_val, map_val]
  · apply Multiset.Nat.antidiagonal_succ
#align finset.nat.antidiagonal_succ Finset.Nat.antidiagonal_succ

theorem antidiagonal_succ' (n : ℕ) :
    antidiagonal (n + 1) =
      cons (n + 1, 0)
        ((antidiagonal n).map
          (Function.Embedding.prodMap (Function.Embedding.refl _) ⟨Nat.succ, Nat.succ_injective⟩))
        (by simp) := by
  apply eq_of_veq
  rw [cons_val, map_val]
  exact Multiset.Nat.antidiagonal_succ'
#align finset.nat.antidiagonal_succ' Finset.Nat.antidiagonal_succ'

theorem antidiagonal_succ_succ' {n : ℕ} :
    antidiagonal (n + 2) =
      cons (0, n + 2)
        (cons (n + 2, 0)
            ((antidiagonal n).map
              (Function.Embedding.prodMap ⟨Nat.succ, Nat.succ_injective⟩
                ⟨Nat.succ, Nat.succ_injective⟩)) <|
          by simp)
        (by simp) := by
  simp_rw [antidiagonal_succ (n + 1), antidiagonal_succ', Finset.map_cons, map_map]
  rfl
#align finset.nat.antidiagonal_succ_succ' Finset.Nat.antidiagonal_succ_succ'

theorem map_swap_antidiagonal {n : ℕ} :
    (antidiagonal n).map ⟨Prod.swap, Prod.swap_injective⟩ = antidiagonal n :=
  eq_of_veq <| by simp [antidiagonal, Multiset.Nat.map_swap_antidiagonal]
#align finset.nat.map_swap_antidiagonal Finset.Nat.map_swap_antidiagonal

/-- A point in the antidiagonal is determined by its first co-ordinate. -/
theorem antidiagonal_congr {n : ℕ} {p q : ℕ × ℕ} (hp : p ∈ antidiagonal n)
    (hq : q ∈ antidiagonal n) : p = q ↔ p.fst = q.fst := by
  refine' ⟨congr_arg Prod.fst, fun h ↦ Prod.ext h ((add_right_inj q.fst).mp _)⟩
  rw [mem_antidiagonal] at hp hq
  rw [hq, ← h, hp]
#align finset.nat.antidiagonal_congr Finset.Nat.antidiagonal_congr

theorem antidiagonal.fst_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) : kl.1 ≤ n := by
  rw [le_iff_exists_add]
  use kl.2
  rwa [mem_antidiagonal, eq_comm] at hlk
#align finset.nat.antidiagonal.fst_le Finset.Nat.antidiagonal.fst_le

theorem antidiagonal.snd_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) : kl.2 ≤ n := by
  rw [le_iff_exists_add]
  use kl.1
  rwa [mem_antidiagonal, eq_comm, add_comm] at hlk
#align finset.nat.antidiagonal.snd_le Finset.Nat.antidiagonal.snd_le

theorem filter_fst_eq_antidiagonal (n m : ℕ) :
    filter (fun x : ℕ × ℕ ↦ x.fst = m) (antidiagonal n) = if m ≤ n then {(m, n - m)} else ∅ := by
  ext ⟨x, y⟩
  simp only [mem_filter, Nat.mem_antidiagonal]
  split_ifs with h
  · simp (config := { contextual := true }) [and_comm, eq_tsub_iff_add_eq_of_le h, add_comm]
  · rw [not_le] at h
    simp only [not_mem_empty, iff_false_iff, not_and, decide_eq_true_eq]
    exact fun hn => ne_of_lt (lt_of_le_of_lt (le_self_add.trans hn.le) h)
#align finset.nat.filter_fst_eq_antidiagonal Finset.Nat.filter_fst_eq_antidiagonal

theorem filter_snd_eq_antidiagonal (n m : ℕ) :
    filter (fun x : ℕ × ℕ ↦ x.snd = m) (antidiagonal n) = if m ≤ n then {(n - m, m)} else ∅ := by
  have : (fun x : ℕ × ℕ ↦ (x.snd = m)) ∘ Prod.swap = fun x : ℕ × ℕ ↦ x.fst = m := by
    ext ; simp
  rw [← map_swap_antidiagonal]
  simp [filter_map, this, filter_fst_eq_antidiagonal, apply_ite (Finset.map _)]
#align finset.nat.filter_snd_eq_antidiagonal Finset.Nat.filter_snd_eq_antidiagonal

section EquivProd

/-- The disjoint union of antidiagonals `Σ (n : ℕ), antidiagonal n` is equivalent to the product
    `ℕ × ℕ`. This is such an equivalence, obtained by mapping `(n, (k, l))` to `(k, l)`. -/
@[simps]
def sigmaAntidiagonalEquivProd : (Σn : ℕ, antidiagonal n) ≃ ℕ × ℕ where
  toFun x := x.2
  invFun x := ⟨x.1 + x.2, x, mem_antidiagonal.mpr rfl⟩
  left_inv := by
    rintro ⟨n, ⟨k, l⟩, h⟩
    rw [mem_antidiagonal] at h
    exact Sigma.subtype_ext h rfl
  right_inv x := rfl
#align finset.nat.sigma_antidiagonal_equiv_prod Finset.Nat.sigmaAntidiagonalEquivProd
#align finset.nat.sigma_antidiagonal_equiv_prod_symm_apply_fst Finset.Nat.sigmaAntidiagonalEquivProd_symm_apply_fst
#align finset.nat.sigma_antidiagonal_equiv_prod_symm_apply_snd_coe Finset.Nat.sigmaAntidiagonalEquivProd_symm_apply_snd_coe
#align finset.nat.sigma_antidiagonal_equiv_prod_apply Finset.Nat.sigmaAntidiagonalEquivProd_apply

end EquivProd

end Nat

end Finset


import Lean4Axiomatic.Function
import Lean4Axiomatic.Operators

/-!
# Equivalence relations

## Fundamental definitions and properties
-/

namespace Lean4Axiomatic
namespace Relation

/--
Class for
[reflexive relations](https://en.wikipedia.org/wiki/Reflexive_relation).

Paraphrasing Wikipedia, a homogeneous binary relation `R` on a sort `α` is
**reflexive** iff it relates every inhabitant of `α` to itself.

This property is provided by the single field `Reflexive.refl`; see its
documentation for more details.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The homogeneous binary relation obeying the reflexive property.
-/
class Reflexive {α : Sort u} (R : α → α → Prop) :=
  /--
  The reflexive property of a homogeneous binary relation `R` on a sort `α`.

  Equality, or equivalence, are the archetypes of reflexive relations: if a
  sort `α` has an equivalence relation (see `Eqv` and `EqvOp`), then any
  inhabitant `x : α` is equivalent to itself (i.e., `x ≃ x`).

  Another reflexive relation is _divisibility_, from number theory. We say an
  integer `a` divides an integer `b` iff `b ≃ c * a` for some integer `c`. We
  can show that all integers divide themselves by taking `c ≃ 1`.

  An example of a relation that is _not_ reflexive is "`n * m` is even" for
  natural numbers `n`, `m`. While "`n * n` is even" holds for even numbers `n`,
  it fails for odd numbers and thus is not reflexive on the natural numbers.
  Credit goes to Wikipedia for this example.

  **Named parameters**
  - See `Reflexive` for the parameters provided by the class.
  - `x`: `R`'s first and second argument.
  -/
  refl : {x : α} → R x x

export Reflexive (refl)

/--
The type of logical implication (i.e., the arrow type or exponential) is
reflexive: there are inhabitants of the type `α → α` for all `α : Prop`.

**Intuition**: The identity function (i.e, the function that simply returns its
single argument) meets this requirement.
-/
instance implication_reflexive : Reflexive (· → ·) := {
  refl := id
}

/--
Class for
[symmetric relations](https://en.wikipedia.org/wiki/Symmetric_relation).

A homogeneous binary relation `R` on a sort `α` is **symmetric** iff its truth
value remains the same when its arguments are exchanged.

This property is provided by the single field `Symmetric.symm`; see its
documentation for more details.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The homogeneous binary relation obeying the symmetric property.
-/
class Symmetric {α : Sort u} (R : α → α → Prop) :=
  /--
  The symmetric property of a homogeneous binary relation `R` on a sort `α`.

  Equality, or equivalence, are the archetypes of symmetric relations: if a
  sort `α` has an equivalence relation (see `Eqv` and `EqvOp`), and for some
  inhabitants `x y : α` we know that `x` is equivalent to `y` (i.e., `x ≃ y`),
  then we also know that `y` is equivalent to `x` (i.e., `y ≃ x`).

  Another example is actually the non-example from `Reflexive.refl`,
  "`n * m` is even" for natural numbers `n` and `m`. In this case it's because
  multiplication of natural numbers is commutative.

  A relation that fails to be symmetric is "X likes Y" where X and Y are
  people. While there are many specific Xs and Ys that like each other, this
  unfortunately doesn't hold in general.

  **Named parameters**
  - See `Symmetric` for the parameters provided by the class.
  - `x`, `y`: The arguments to `R`.
  -/
  symm : {x y : α} → R x y → R y x

export Symmetric (symm)

/--
`Symmetric` relations are special cases of `Fn.Swappable` functions.

**Intuition**: Just going by syntax, a relation `R` that satisfies
`Symmetric.symm` also satisfies `Fn.swap` as the swappable function `f`, with
logical implication (i.e., the function type or arrow type) as the relation
between swapped invocations.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The symmetric relation.

**Class parameters**
- `Symmetric R`: Evidence that `R` is symmetric.
-/
instance swappable_over_implication_from_symmetric
    {α : Sort u} {R : α → α → Prop} [Symmetric R] : Fn.Swappable R (· → ·)
    := {
  swap := symm
}

/--
The negation of a symmetric relation is also symmetric.

**Intuition**: Consider the set of all input pairs to the relation. It can be
divided into two disjoint subsets: the pairs that satisfy the relation, and
the pairs that don't. Both subsets must be closed under the operation of
swapping the components of the pairs, otherwise the relation wouldn't be
symmetric.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The symmetric relation.

**Class parameters**
- `Symmetric R`: Evidence that `R` is symmetric.
-/
instance negation_preserves_symmetry
    {α : Sort u} {R : α → α → Prop} [Symmetric R] : Symmetric (¬ R · ·)
    := {
  symm := mt symm
}

/--
Conjunction (i.e. logical _and_) is symmetric.

**Intuition**: The order of a conjunction's arguments doesn't affect its truth
value.
-/
instance and_symmetric : Symmetric (· ∧ ·) := by
  apply Symmetric.mk
  intro p q (And.intro (_ : p) (_ : q))
  show q ∧ p
  exact And.intro ‹q› ‹p›

/--
Class for
[transitive relations](https://en.wikipedia.org/wiki/Transitive_relation).

A homogeneous binary relation `R` on a sort `α` is **transitive** iff when `R`
relates `x` to `y`, and `y` to `z`, then it also relates `x` to `z`, for all
`x`, `y`, and `z` inhabiting `α`. Transitive relations are useful because new
pairs of values can be shown to be related by chaining already known pairs
together.

This property is provided by the single field `Transitive.trans`; see its
documentation for more details.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The homogeneous binary relation obeying the transitive property.
-/
class Transitive {α : Sort u} (R : α → α → Prop) :=
  /--
  The transitive property of a homogeneous binary relation `R` on a sort `α`.

  Equality, or equivalence, are the archetypes of transitive relations: if a
  sort `α` has an equivalence relation (see `Eqv` and `EqvOp`), and for some
  inhabitants `x y z : α` we know that `x` is equivalent to `y` (i.e. `x ≃ y`)
  and `y` is equivalent to `z` (i.e. `y ≃ z`), then we also know that `x` is
  equivalent to `z` (i.e. `x ≃ z`).

  Another transitive relation is _divisibility_, from number theory. We say an
  integer `a` divides an integer `b` iff `b ≃ c * a` for some integer `c`. If
  we know that `x` divides `y` (into, say, `p` copies of `x`), and `y` divides
  `z` (into `q` copies of `y`), then `z` must consist of `p * q` copies of `x`,
  and therefore `x` divides `z`.

  A relation that fails to be transitive is "X likes Y" where X and Y are
  people. If Alice likes Bob, and Bob likes Carol, then Alice might be a bit
  jealous of Carol, and definitely not inclined to like her!

  **Named parameters**
  - See `Transitive` for the parameters provided by the class.
  - `x`, `y`, `z`: The arguments to `R`.
  -/
  trans : {x y z : α} → R x y → R y z → R x z

export Transitive (trans)

/--
`Transitive` is a special case of the `Trans` class from Lean's Prelude.

**Intuition**: The Prelude's `Trans` allows the three values involved in the
property to be of different sorts. Which means it must support three
heterogeneous relations to pair up the values. Our `Transitive` is the special
case where all values are of the same sort, and only one homogeneous relation
is needed.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The transitive relation.

**Class parameters**
- `Transitive R`: Evidence that `R` is transitive.
-/
instance prelude_trans_from_transitive
    {α : Sort u} {R : α → α → Prop} [Transitive R] : Trans R R R
    := {
  trans := trans
}

/--
Logical implication (i.e. the function type or the arrow type) is transitive.

**Intuition**: This is essentially why implications are so useful in logic,
because intermediate deductions can be combined into a larger, more significant
result. Alternatively, this is just function composition.
-/
theorem implication_trans {p q r : Prop} : (p → q) → (q → r) → (p → r) :=
  flip Function.comp

instance implication_transitive : Transitive (· → ·) := {
  trans := implication_trans
}

/--
Logical equivalence (i.e. the biconditional or "if and only if") is transitive.

**Property intuition**: This relation holds when two propositions have the same
truth value, so we would expect it to be transitive.

**Proof intuition**: Expand the definitions and use transitivity of implication
in both directions to show the result.
-/
theorem iff_trans {p q r : Prop} : (p ↔ q) → (q ↔ r) → (p ↔ r) := by
  intro (_ : p ↔ q) (_ : q ↔ r)
  show p ↔ r
  apply Iff.intro
  case mp =>
    show p → r
    exact implication_trans ‹p ↔ q›.mp ‹q ↔ r›.mp
  case mpr =>
    show r → p
    exact implication_trans ‹q ↔ r›.mpr ‹p ↔ q›.mpr

instance iff_transitive : Transitive (· ↔ ·) := {
  trans := iff_trans
}

/--
Transitivity fails if the left operand's relation does not hold.

**Property intuition**: This must be the case, otherwise transitivity would not
be a useful property.

**Proof intuition**: Use transitivity on the right and output relations to
contradict the failed left relation.
-/
theorem trans_failL
    {α : Sort u} {R : α → α → Prop} [Symmetric R] [Transitive R] {x y z : α}
    : ¬ R x y → R y z → ¬ R x z
    := by
  intro (_ : ¬ R x y) (_ : R y z) (_ : R x z)
  show False
  have : R x y := trans ‹R x z› (symm ‹R y z›)
  exact ‹¬ R x y› ‹R x y›

/--
Transitivity fails if the right operand's relation does not hold.

**Property intuition**: This must be the case, otherwise transitivity would not
be a useful property.

**Proof intuition**: Use transitivity on the left and output relations to
contradict the failed right relation.
-/
theorem trans_failR
    {α : Sort u} {R : α → α → Prop} [Symmetric R] [Transitive R] {x y z : α}
    : R x y → ¬ R y z → ¬ R x z
    := by
  intro (_ : R x y) (_ : ¬ R y z) (_ : R x z)
  show False
  have : R y z := trans (symm ‹R x y›) ‹R x z›
  exact ‹¬ R y z› ‹R y z›

namespace Equivalence

/--
Class for
[equivalence relations](https://en.wikipedia.org/wiki/Equivalence_relation).

A homogeneous binary relation `R` on a sort `α` is an **equivalence relation**
iff it is reflexive, symmetric, and transitive.

Equality is the simplest example of an equivalence relation, where each
inhabitant of `α` is equivalent only to itself. A less trivial example is the
relation where two integers are equivalent iff they have the same sign.

**Named parameters**
- `α`: The `Sort` of `R`'s parameters.
- `R`: The equivalence relation.
-/
class Eqv {α : Sort u} (R : α → α → Prop)
    extends Reflexive R, Symmetric R, Transitive R

/--
Provides an equivalence relation over `α` with the operator `· ≃ ·`.

**Named parameters**
- `α`: The `Sort` of the elements in the relation.
-/
class EqvOp (α : Sort u) extends Operators.TildeDash α, Eqv tildeDash

/--
Extends `EqvOp` with `· ≃? ·`, a decision procedure for equivalence.

**Named parameters**
- `α`: The `Sort` of the elements in the relation.
-/
class EqvOp? (α : Sort u)
    extends EqvOp α, Operators.TildeDashQuestion tildeDash

end Equivalence
end Relation

namespace Rel
export Relation (refl symm trans trans_failL trans_failR)
end Rel

end Lean4Axiomatic


import game.sup_inf.infSumConst

namespace xena -- hide

/-
# Chapter 3 : Sup and Inf

## Level 8

Again a classical result.
-/

-- supremum of constant × set
def const_times_set (c: ℝ) (A : set ℝ) := { x : ℝ | ∃ y ∈ A, x = c * y }

/- Lemma
If $A$ is a set of reals and $c > 0$, then
$$ \textrm{sup} (cA) = c \cdot \textrm{sup} (A)$$
-/
lemma sup_const_times_set (c : ℝ) (hc: 0 < c) (A : set ℝ) (h1A : A.nonempty)
  (h2A : bdd_above A) (a : ℝ) :
  (is_lub A a) → is_lub (const_times_set c A) (c * a) :=
begin
  intro h,
  cases h with hA1 hA2,
  split,
  { -- prove that (c*a) is an upper bound
    intros x h0,
    cases h0 with y h1, cases h1 with yA h2,
    have H13A := hA1 y yA, rw h2,
    exact (mul_le_mul_left hc).mpr H13A,
  },
  -- now prove that (c*a) is the least upper bound
  intros S hS,
  set y1 := S / c with hys,
  have H : y1 ∈ upper_bounds A,
    intros x hx,
    have G := hA1 x hx,
    set xc := c * x with hxc,
    have G1 : xc ∈ const_times_set c A,
        use x, existsi hx, exact hxc,
    have G2 := hS xc G1, rw hxc at G2,
    rw hys, exact (le_div_iff' hc).mpr G2,
  have F := hA2 y1 H, rw hys at F,
  have E := (mul_le_mul_left hc).mpr F,
  exact (le_div_iff' hc).mp F, done
end

end xena -- hide


import helpers

def in_cube {d : ℕ} (corner p : point d) : Prop :=
  ∀ coord : fin d, vector.nth corner coord ≤ vector.nth p coord ∧
                   vector.nth p coord < vector.nth corner coord + 1

--Defines the cube (set of d dimensional points) corner + [0, 1)^d
def cube {d : ℕ} (corner : point d) : set (point d) :=
  { p : point d | in_cube corner p }

lemma cube_intersection_lemma_left_implication :
  ∀ d : ℕ, ∀ corner1 : point d, ∀ corner2 : point d,
  (cube corner1 ∩ cube corner2 = ∅) →
  (∃ coord : fin d, vector.nth corner1 coord - vector.nth corner2 coord ≥ 1 ∨
                    vector.nth corner2 coord - vector.nth corner1 coord ≥ 1) :=
begin
  intros _ _ _ h,
  have cube1_not_in_cube2 : ∀ p : point d, p ∈ cube corner1 → p ∉ cube corner2 :=
    begin
      rw [cube, cube, set.inter_def] at h,
      simp at h,
      rw set.eq_empty_iff_forall_not_mem at h,
      simp at h,
      rw [cube, cube],
      simp,
      exact h,
    end,
  rw [cube, cube] at cube1_not_in_cube2,
  simp at cube1_not_in_cube2,
  conv at cube1_not_in_cube2
  begin
    find (in_cube corner1 _) { rw in_cube },
    find (in_cube corner2 _) { rw in_cube },
  end,
  simp at cube1_not_in_cube2,
  contrapose cube1_not_in_cube2,
  rename cube1_not_in_cube2 no_far_coord,
  simp,
  simp at no_far_coord,
  let get_first_intersecting_point : fin d → ℝ :=
    λ coord : fin d, max (vector.nth corner1 coord) (vector.nth corner2 coord),
  let p : point d := vector.of_fn get_first_intersecting_point,
  use p,
  split,
  { intro coord,
    split, simp only [vector.nth_of_fn, le_max_iff, le_refl, true_or],
    simp only [vector.nth_of_fn, max_lt_iff, lt_add_iff_pos_right, zero_lt_one, true_and],
    replace no_far_coord := no_far_coord coord,
    contrapose no_far_coord,
    rw not_not,
    right,
    linarith,
  },
  intro coord,
  split, simp only [vector.nth_of_fn, le_max_iff, le_refl, or_true],
  simp only [vector.nth_of_fn, max_lt_iff, lt_add_iff_pos_right, zero_lt_one, and_true],
  replace no_far_coord := no_far_coord coord,
  contrapose no_far_coord,
  rw not_not,
  left,
  linarith,
end

lemma cube_intersection_lemma_right_implication :
  ∀ d : ℕ, ∀ corner1 : point d, ∀ corner2 : point d,
  (∃ coord : fin d, vector.nth corner1 coord - vector.nth corner2 coord ≥ 1 ∨
                    vector.nth corner2 coord - vector.nth corner1 coord ≥ 1
  ) → (cube corner1 ∩ cube corner2 = ∅)
  :=
begin
  intros _ _ _ exists_far_coord,
  cases exists_far_coord with x x_far_coord,
  rw set.inter_def,
  rw set.eq_empty_iff_forall_not_mem,
  intro p,
  simp,
  rw [cube, cube],
  simp,
  rw [in_cube, in_cube],
  simp,
  intro p_in_cube1,
  have p_in_cube1_x_coord := p_in_cube1 x,
  use x,
  intro corner2_le_p,
  cases x_far_coord, linarith,
  linarith,
end

lemma cube_intersection_lemma :
  ∀ d : ℕ, ∀ corner1 : point d, ∀ corner2 : point d,
  (∃ coord : fin d, vector.nth corner1 coord - vector.nth corner2 coord ≥ 1 ∨
                    vector.nth corner2 coord - vector.nth corner1 coord ≥ 1
  ) ↔ (cube corner1 ∩ cube corner2 = ∅) :=
begin
  repeat{intro},
  split,
  apply cube_intersection_lemma_right_implication,
  apply cube_intersection_lemma_left_implication,
end

--States whether two d dimensional cubes (as defined by their corners) are distinct and share a face
def is_facesharing {d : ℕ} (c1 c2 : point d) : Prop :=
  ∃ x : fin d, (vector.nth c1 x - vector.nth c2 x = 1 ∨
                vector.nth c2 x - vector.nth c1 x = 1) ∧
  ∀ y : fin d, x = y ∨ vector.nth c1 y = vector.nth c2 y

lemma is_facesharing_comm {d : ℕ} {corner1 : point d} {corner2 : point d} (h : is_facesharing corner1 corner2) :
  is_facesharing corner2 corner1 :=
begin
  rw is_facesharing at h,
  cases h with coord h,
  cases h,
  rw or_comm at h_left,
  rw is_facesharing,
  use coord,
  split, exact h_left,
  intro y,
  replace h_right := h_right y,
  cases h_right, {left, exact h_right,},
  right,
  symmetry,
  exact h_right,
end

--States whether a tiling contains any two distinct corners whose cubes share a face
def tiling_faceshare_free {d : ℕ} (T : set (point d)) : Prop :=
  ∀ c1 c2 ∈ T, ¬(is_facesharing c1 c2)

--States whether a set of d dimensional cubes (as defined by their corners) is a tiling in ℝ^d
def is_tiling {d : ℕ} (T : set (point d)) : Prop :=
  ∀ p : point d, ∃ corner ∈ T, p ∈ cube corner ∧
  (∀ alt_corner ∈ T, p ∈ cube alt_corner → alt_corner = corner)

/-
Takes a point p and a tiling T and returns the unique corner in T such that p
is in the cube defined by that corner. This function, when given an int_point x,
is denoted t(x) ∈ T in Brakensiek et al.'s paper

Also want to return a proof that the result is the unique corner in T such that
p is in the cube defined by that corner. For this, rather than simply return a point d,
I return a subtype of point d that for which all elements have exactly the desired property
(i.e. the only element of the type is the corner corresponding to the given point)
-/
noncomputable def point_to_corner {d : ℕ} {T : set (point d)} (h : is_tiling T) (p : point d) :
  { corner : point d //
      corner ∈ T ∧ p ∈ cube corner ∧
      (∀ alt_corner ∈ T, p ∈ cube alt_corner → alt_corner = corner)
  } :=
begin
  rw is_tiling at h,
  have h' := h p,
  let corner := classical.some h',
  have h' := classical.some_spec h',
  change
    ∃ (H : corner ∈ T), p ∈ cube corner ∧
    (∀ (alt_corner : point d), alt_corner ∈ T → p ∈ cube alt_corner → alt_corner = corner)
    at h',
  rename h'_1 h'',
  simp at h'',
  cases h'' with res_in_T h'',
  use corner,
  have goal :
    corner ∈ T ∧ p ∈ cube corner ∧
    (∀ alt_corner ∈ T, p ∈ cube alt_corner → alt_corner = corner),
  split, exact res_in_T,
  { cases h'',
    split, exact h''_left,
    exact h''_right,
  },
  exact goal,
end

noncomputable def int_point_to_corner {d : ℕ} {T : set (point d)} (h : is_tiling T) (x : int_point d) :
  { corner : point d //
      corner ∈ T ∧ int_point_to_point x ∈ cube corner ∧
      (∀ alt_corner ∈ T, int_point_to_point x ∈ cube alt_corner → alt_corner = corner)
  } := point_to_corner h (int_point_to_point x)

--Return type of try_point_to_corner
inductive try_point_to_corner_res {d : ℕ} (T : set (point d)) (p : point d)
  | no_corner : (∀ t ∈ T, p ∉ cube t) → try_point_to_corner_res
  | unique_corner :
      { corner : point d //
          corner ∈ T ∧ p ∈ cube corner ∧
          (∀ alt_corner ∈ T, p ∈ cube alt_corner → alt_corner = corner)
      } → try_point_to_corner_res
  | multiple_corners :
      { corners : point d × point d //
          prod.fst corners ∈ T ∧ p ∈ cube (prod.fst corners) ∧
          prod.snd corners ∈ T ∧ p ∈ cube (prod.snd corners) ∧
          prod.fst corners ≠ prod.snd corners
      } → try_point_to_corner_res

/-
This function takes a set of cube corners T and an arbitrary point p, and tries to return a unique
cube corner in T that contains p. Unlike point_to_corner, this function does not require that T
is a tiling.

When we try to get the corner of a point p in a set of cube corners T, we can either find that there
is no corner in T that contains p, exactly one corner in T that contains p, or multiple corners in T
that contain p. In the first case, we return a proof that no corner in T contains p. In the second case,
we return the unique corner in T that contains p, and through the type assert that no other corner in T
contains p. In the final case, we find two distinct corners in T that contain p, and return them while
asserting through the type that the two corners are distinct, both in T, and both contain p.
-/
noncomputable def try_point_to_corner {d : ℕ} (T : set (point d)) (p : point d) :
  try_point_to_corner_res T p :=
  begin
    let corners_containing_p_in_T := { corner ∈ T | p ∈ cube corner },
    by_cases corners_containing_p_in_T = ∅,
    { have goal : ∀ t ∈ T, p ∉ cube t :=
        begin
          intros _ t_in_T,
          change {corner ∈ T | p ∈ cube corner} = ∅ at h,
          have h' : ∀ corner ∈ T, p ∉ cube corner :=
            begin
              have empty_h := set.eq_empty_iff_forall_not_mem,
              cases empty_h with empty_h rev_empty_h,
              replace h := empty_h h,
              simp at h,
              exact h,
            end,
          exact h' t t_in_T,
        end,
      exact try_point_to_corner_res.no_corner goal,
    },
    by_cases multiple_corners_contain_p : ∃ corner1 ∈ T, ∃ corner2 ∈ T,
      corner1 ∈ T ∧ corner2 ∈ T ∧ p ∈ cube corner1 ∧ p ∈ cube corner2 ∧ corner1 ≠ corner2,
    { let corner1 := classical.some multiple_corners_contain_p,
      have multiple_corners_contain_p_2 := classical.some_spec multiple_corners_contain_p,
      change ∃ (H : corner1 ∈ T) (corner2 : point d) (H : corner2 ∈ T),
        corner1 ∈ T ∧ corner2 ∈ T ∧ p ∈ cube corner1 ∧ p ∈ cube corner2 ∧ corner1 ≠ corner2
        at multiple_corners_contain_p_2,
      let corner1_in_T := classical.some multiple_corners_contain_p_2,
      have multiple_corners_contain_p_3 := classical.some_spec multiple_corners_contain_p_2,
      let corner2 := classical.some multiple_corners_contain_p_3,
      have multiple_corners_contain_p_4 := classical.some_spec multiple_corners_contain_p_3,
      change ∃ (H : corner2 ∈ T),
        corner1 ∈ T ∧ corner2 ∈ T ∧ p ∈ cube corner1 ∧ p ∈ cube corner2 ∧ corner1 ≠ corner2
        at multiple_corners_contain_p_4,
      let corner2_in_T := classical.some multiple_corners_contain_p_4,
      have multiple_corners_contain_p_5 := classical.some_spec multiple_corners_contain_p_4,
      let corners : point d × point d := ⟨corner1, corner2⟩,
      have goal :
        prod.fst corners ∈ T ∧ p ∈ cube (prod.fst corners) ∧
        prod.snd corners ∈ T ∧ p ∈ cube (prod.snd corners) ∧
        prod.fst corners ≠ prod.snd corners :=
        begin
          cases multiple_corners_contain_p_5 with corner1_in_T multiple_corners_contain_p_5,
          cases multiple_corners_contain_p_5 with corner2_in_T multiple_corners_contain_p_5,
          cases multiple_corners_contain_p_5 with p_in_cube_corner1 multiple_corners_contain_p_5,
          cases multiple_corners_contain_p_5 with p_in_cube_corner2 corner1_neq_corner2,
          split, simp, exact corner1_in_T,
          split, simp, exact p_in_cube_corner1,
          split, simp, exact corner2_in_T,
          split, simp, exact p_in_cube_corner2,
          exact corner1_neq_corner2,
        end,
      let corners' :
        { corners : point d × point d //
            prod.fst corners ∈ T ∧ p ∈ cube (prod.fst corners) ∧
            prod.snd corners ∈ T ∧ p ∈ cube (prod.snd corners) ∧
            prod.fst corners ≠ prod.snd corners
        } := ⟨corners, goal⟩,
      exact try_point_to_corner_res.multiple_corners corners',
    },
    rename multiple_corners_contain_p unique_corner_contains_p,
    simp at unique_corner_contains_p,
    change ∀ (t1 : point d), t1 ∈ T → ∀ (t2 : point d), t2 ∈ T → t1 ∈ T → t2 ∈ T →
      p ∈ cube t1 → p ∈ cube t2 → t1 = t2 at unique_corner_contains_p,
    change corners_containing_p_in_T ≠ ∅ at h,
    rw [set.ne_empty_iff_nonempty, set.nonempty_def] at h,
    let corner_with_p := classical.some h,
    have h' := classical.some_spec h,
    change corner_with_p ∈ corners_containing_p_in_T at h',
    have goal :
      corner_with_p ∈ T ∧ p ∈ cube corner_with_p ∧
      (∀ alt_corner ∈ T, p ∈ cube alt_corner → alt_corner = corner_with_p) :=
      begin
        change corner_with_p ∈ {corner ∈ T | p ∈ cube corner} at h',
        simp at h',
        cases h' with corner_with_p_in_T p_in_cube_corner_with_p,
        split, exact corner_with_p_in_T,
        split, exact p_in_cube_corner_with_p,
        intros _ alt_corner_in_T p_in_alt_corner,
        symmetry,
        exact unique_corner_contains_p corner_with_p corner_with_p_in_T alt_corner alt_corner_in_T
          corner_with_p_in_T alt_corner_in_T p_in_cube_corner_with_p p_in_alt_corner,
      end,
    let corner_with_p' :
      { corner : point d //
          corner ∈ T ∧ p ∈ cube corner ∧
          (∀ alt_corner ∈ T, p ∈ cube alt_corner → alt_corner = corner)
      } := ⟨corner_with_p, goal⟩,
    exact try_point_to_corner_res.unique_corner corner_with_p',
  end


-- import the definitions of uniform space via entourages
import uniform_structure.entourages

-- import the definition of pseudometric space
import pseudometric_space

-- In this exercise we will show that a pseudometric on a set X
-- gives rise to a collection of entourages for X

-- This is a question about pseudometrics so let's put it
-- in the pseudometric namespace
open_locale classical
namespace pseudometric

-- Let X be a set (or a type), and let d be a pseudometric on X
variables {X : Type} (d : X → X → ℝ) [is_pseudometric d]

-- Define U ⊆ X × X to be an entourage if there exists ε > 0 such
-- that d(x,y)≤ε → (x,y) ∈ U

def entourages :=
  {U : set (X × X) | ∃ ε > 0, ∀ x y : X, d x y ≤ ε → (x,y) ∈ U}

-- this lemma is true by definition
lemma mem_entourages (U : set (X × X)) :
  U ∈ entourages d ↔ ∃ ε > 0, ∀ x y : X, d x y ≤ ε → (x,y) ∈ U := iff.rfl

-- The exerise is to show that the 5 axioms of a uniform space are
-- satisfied.

-- Hint: You can `rw mem_entourages` to change from `U ∈ entourages d` to the
-- explicit epsilon definition.

-- Hint: if `hU : U ∈ entourages d` then `obtain ⟨ε, hε, hεU⟩ := hU` will
-- get you the ε which is a witness to U being an entourage for d.

-- Axiom 1: the diagonal is in U
lemma refl (U : set (X × X)) (hU : U ∈ entourages d) :
  ∀ (x : X), (x, x) ∈ U :=
begin
  intro x,
  have hx : d x x = 0,
    exact d_self d x,
  obtain ⟨ε, hε, hεU⟩ := hU,
  apply hεU,
  rw hx,
  linarith,

end

-- Axiom 2: anything bigger than an entourage is an entourage
lemma bigger (U V : set (X × X)) (hU : U ∈ entourages d) (hUV : U ⊆ V) :
  V ∈ entourages d :=
begin
  rw mem_entourages,
  obtain ⟨ε, hε, hεU⟩ := hU,
  use ε,
  split,
  apply hε,
  tauto,

end

-- Axiom 3: Intersection of two entourages is an entourage
lemma inter (U V : set (X × X)) (hU : U ∈ entourages d) (hV : V ∈ entourages d) :
  U ∩ V ∈ entourages d :=
begin
  rw mem_entourages,
  obtain ⟨ε1, hε1, hε1U⟩ := hU,
  obtain ⟨ε2, hε2, hε2V⟩ := hV,
  set e := min ε1 ε2 with he,
  use e,
  split,
  have h: e>0,
  simp,
  split,
  apply hε1,
  apply hε2,
  simp,
  split,
  apply hε1,
  apply hε2,
  simp,
  tauto,

end

/-

-/
-- Axiom 4: the "square root" axiom.
-- You'll need `mem_comp_ent` here (defined in the entourages file)
lemma comp (U : set (X × X)) (hU : U ∈ entourages d) :
 ∃ (V : set (X × X)) (H : V ∈ entourages d), V ∘ V ⊆ U :=
begin
  obtain ⟨ε, hε, hεU⟩ := hU,
  use {z : X × X | d z.1 z.2 ≤ ε/2},
  split,
  rw mem_entourages,
  use ε/2,
  split,
  linarith,
  tauto,
  intro x,
  intro h,
  have q: d x.1 x.2 ≤ ε,
  have s: ∃ z, (x.1, z) ∈ {z : X × X | d z.1 z.2 ≤ ε/2} ∧ (z, x.2) ∈ {z : X × X | d z.1 z.2 ≤ ε/2},
  rw ← mem_comp_ent,
  apply h,
  obtain ⟨z, hz1, hz2⟩ := s,
  have p1: d x.1 z ≤ ε/2,
  apply hz1,
  have p2: d z x.2 ≤ ε/2,
  apply hz2,
  have p3 : d x.1 x.2 ≤ d x.1 z + d z x.2,
  apply d_triangle d,
  linarith,
  have p4: (x.1, x.2) ∈ U,
  apply hεU,
  apply q,
  cases x,
  apply p4,
end

-- Axiom 5: the "transpose" axiom.
lemma symm (U : set (X × X)) (hU : U ∈ entourages d) :
  {z : X × X | (z.snd, z.fst) ∈ U} ∈ entourages d :=
begin
  rw mem_entourages,
  obtain ⟨ε, hε, hεU⟩ := hU,
  use ε,
  split,
  apply hε,
  intros x y,
  have hx : d x y = d y x,
    exact d_comm d x y,
  intro h,
  apply hεU,
  have q:  d x y = d (x, y).snd (x, y).fst,
    apply hx,
  linarith,
end

definition to_entourages : uniform_space_entourage X :=
{ entourages := entourages d,
  refl := refl d,
  bigger := bigger d,
  inter := inter d,
  comp := comp d,
  symm := symm d }

end pseudometric


------------------------------------------------------------------------
-- Teoría elemental de conjuntos
------------------------------------------------------------------------

import tactic

variables (Ω : Type)
variables (X Y Z W : set Ω)
variables (a b c x y z : Ω)

------------------------------------------------------------------------
-- § Subconjuntos                                                     --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 1. Demostrar que
--    X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  refl,
end

-- 2ª demostración
example :
  X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
by refl

-- 3ª demostración
example :
  X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
-- by suggest
iff.rfl

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    X ⊆ X
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ⊆ X :=
begin
  rw set.subset_def,
  intros a ha,
  exact ha,
end

-- 2ª demostración
example :
  X ⊆ X :=
begin
  intros a ha,
  exact ha,
end

-- 3ª demostración
example :
  X ⊆ X :=
by exact λ a ha, ha

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que
--      X ⊆ Y, Y ⊆ Z ⊢ X ⊆ Z
-- ----------------------------------------------------------------------

-- 1ª demostración
example
  (hXY : X ⊆ Y)
  (hYZ : Y ⊆ Z)
  : X ⊆ Z :=
begin
  rw set.subset_def at *,
  intros a ha,
  apply hYZ,
  apply hXY,
  exact ha,
end

-- 2ª demostración
example
  (hXY : X ⊆ Y)
  (hYZ : Y ⊆ Z)
  : X ⊆ Z :=
begin
  intros a ha,
  apply hYZ,
  apply hXY,
  exact ha,
end

-- 3ª demostración
example
  (hXY : X ⊆ Y)
  (hYZ : Y ⊆ Z)
  : X ⊆ Z :=
begin
  intros a ha,
  apply hYZ (hXY ha),
end

-- 4ª demostración
example
  (hXY : X ⊆ Y)
  (hYZ : Y ⊆ Z)
  : X ⊆ Z :=
λ a ha, hYZ (hXY ha)

------------------------------------------------------------------------
-- § Igualdad de conjuntos                                            --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 4. Demostrar que
--    X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y)
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

-- 2ª demostración
example :
  X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
set.ext_iff

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que
--      X ⊆ Y, Y ⊆ X ⊢ X = Y
-- ----------------------------------------------------------------------

example
  (hXY : X ⊆ Y)
  (hYX : Y ⊆ X)
  : X = Y :=
begin
  ext a,
  split,
  { apply hXY },
  { apply hYX },
end

------------------------------------------------------------------------
-- § Uniones e intersecciones                                         --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 6. Demostrar que
--    a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y
-- ----------------------------------------------------------------------

example :
  a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
by refl

-- ---------------------------------------------------------------------
-- Ejercicio 7. Demostrar que
--    a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y
-- ----------------------------------------------------------------------

example :
  a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
by refl

-- ---------------------------------------------------------------------
-- Ejercicio 8. Demostrar que
--    X ∪ X = X
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ∪ X = X :=
begin
  ext a,
  rw set.mem_union,
  split,
  { intro h,
    cases h with ha ha;
    exact ha },
  { intro ha,
    left,
    exact ha }
end

-- 2ª demostración
example :
  X ∪ X = X :=
begin
  ext a,
  split,
  { intro h,
    dsimp at h,
    tauto, },
  { intro ha,
    dsimp,
    tauto, }
end

-- 3ª demostración
example :
  X ∪ X = X :=
begin
  ext a,
  dsimp;
  tauto,
end

-- 4ª demostración
example :
  X ∪ X = X :=
set.union_self X

-- 5ª demostración
example :
  X ∪ X = X :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 9. Demostrar que
--    X ⊆ X ∪ Y
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ⊆ X ∪ Y :=
begin
  rw set.subset_def,
  intros a haX,
  rw set.mem_union,
  left,
  assumption,
end

-- 2ª demostración
example :
  X ⊆ X ∪ Y :=
begin
  intros a haX,
  apply or.inl,
  exact haX,
end

-- 3ª demostración
example :
  X ⊆ X ∪ Y :=
begin
  intros a haX,
  exact or.inl haX,
end

-- 4ª demostración
example :
  X ⊆ X ∪ Y :=
set.subset_union_left X Y

-- 5ª demostración
example :
  X ⊆ X ∪ Y :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 10. Demostrar que
--    Y ⊆ X ∪ Y
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  Y ⊆ X ∪ Y :=
begin
  intros a haY,
  right,
  assumption,
end

-- 2ª demostración
example :
  Y ⊆ X ∪ Y :=
begin
  intros a haY,
  exact or.inr haY,
end

-- 3ª demostración
example :
  Y ⊆ X ∪ Y :=
-- by library_search
set.subset_union_right X Y

-- 4ª demostración
example :
  Y ⊆ X ∪ Y :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 11. Demostrar que
--    X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  split,
  { intro h,
    split,
    { intros a haX,
      apply h,
      left,
      assumption },
    { intros a haY,
      apply h,
      right,
      assumption }},
  { rintros ⟨hXZ, hYZ⟩ a (haX | haY),
    { exact hXZ haX },
    { exact hYZ haY } }
end

-- 2ª demostración
example :
  X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  split,
  { intro h,
    split,
    { intros a haX,
      exact h (or.inl haX), },
    { intros a haY,
      exact h (or.inr haY)}},
  { rintros ⟨hXZ, hYZ⟩ a (haX | haY),
    { exact hXZ haX },
    { exact hYZ haY } }
end

-- 3ª demostración
example :
  X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  split,
  { intro h,
    split,
    { exact λ a haX, h (or.inl haX), },
    { exact λ a haY, h (or.inr haY)}},
  { rintros ⟨hXZ, hYZ⟩ a (haX | haY),
    { exact hXZ haX },
    { exact hYZ haY } }
end

-- 3ª demostración
example :
  X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
by finish [iff_def, set.subset_def]

-- 4ª demostración
example :
  X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
-- by library_search
set.union_subset_iff

-- 5ª demostración
example :
  X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 12. Demostrar que
--    W ⊆ X, Y ⊆ Z ⊢ W ∪ Y ⊆ X ∪ Z
-- ----------------------------------------------------------------------

-- 1ª demostración
example
  (hWX : W ⊆ X)
  (hYZ : Y ⊆ Z)
  : W ∪ Y ⊆ X ∪ Z :=
begin
  rintros a (haW | haY),
  { left,
    exact hWX haW },
  { right,
    exact hYZ haY }
end

-- 2ª demostración
example
  (hWX : W ⊆ X)
  (hYZ : Y ⊆ Z)
  : W ∪ Y ⊆ X ∪ Z :=
begin
  rintros a (haW | haY),
  { exact or.inl (hWX haW), },
  { exact or.inr (hYZ haY), }
end

-- 3ª demostración
example
  (hWX : W ⊆ X)
  (hYZ : Y ⊆ Z)
  : W ∪ Y ⊆ X ∪ Z :=
by finish [set.subset_def]

-- 4ª demostración
example
  (hWX : W ⊆ X)
  (hYZ : Y ⊆ Z)
  : W ∪ Y ⊆ X ∪ Z :=
-- by library_search
set.union_subset_union hWX hYZ

-- ---------------------------------------------------------------------
-- Ejercicio 13. Demostrar que
--    X ⊆ Y ⊢ X ∪ Z ⊆ Y ∪ Z
-- ----------------------------------------------------------------------

-- 1ª demostración
example
  (hXY : X ⊆ Y)
  : X ∪ Z ⊆ Y ∪ Z :=
begin
  rintros a (haX | haZ),
  { left,
    exact hXY haX },
  { right,
    exact haZ, }
end

-- 2ª demostración
example
  (hXY : X ⊆ Y)
  : X ∪ Z ⊆ Y ∪ Z :=
begin
  rintros a (haX | haZ),
  { exact or.inl (hXY haX), },
  { exact or.inr haZ, }
end

-- 3ª demostración
example
  (hXY : X ⊆ Y)
  : X ∪ Z ⊆ Y ∪ Z :=
by finish [set.subset_def]

-- 4ª demostración
example
  (hXY : X ⊆ Y)
  : X ∪ Z ⊆ Y ∪ Z :=
-- by library_search
set.union_subset_union_left Z hXY

-- ---------------------------------------------------------------------
-- Ejercicio 14. Demostrar que
--    X ∩ Y ⊆ X
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ∩ Y ⊆ X :=
begin
  rintro a ⟨haX, haY⟩,
  assumption,
end

-- 2ª demostración
example :
  X ∩ Y ⊆ X :=
begin
  rintro a ⟨haX, -⟩,
  exact haX,
end

-- 3ª demostración
example :
  X ∩ Y ⊆ X :=
-- by library_search
set.inter_subset_left X Y

-- 4ª demostración
example :
  X ∩ Y ⊆ X :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 15. Demostrar que
--    X ∩ X = X
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ∩ X = X :=
begin
  ext a,
  split,
  { rintro ⟨haX, -⟩,
    exact haX, },
  { intro haX,
    exact ⟨haX, haX⟩ }
end

-- 2ª demostración
example :
  X ∩ X = X :=
set.ext (assume x, and_self _)

-- 3ª demostración
example :
  X ∩ X = X :=
-- by library_search
set.inter_self X

-- 4ª demostración
example :
  X ∩ X = X :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 16. Demostrar que
--    X ∩ Y = Y ∩ X
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ∩ Y = Y ∩ X :=
begin
  ext a,
  split,
  { rintro ⟨haX, haY⟩,
    exact ⟨haY, haX⟩ },
  { rintro ⟨haY, haX⟩,
    exact ⟨haX, haY⟩ }
end

-- 2ª demostración
example :
  X ∩ Y = Y ∩ X :=
begin
  ext a,
  split;
  { rintro ⟨h1, h2⟩,
    exact ⟨h2, h1⟩ }
end

-- 2ª demostración
example :
  X ∩ Y = Y ∩ X :=
begin
  ext a,
  exact and.comm,
end

-- 3ª demostración
example :
  X ∩ Y = Y ∩ X :=
set.ext (λ x, and.comm)

-- 4ª demostración
example :
  X ∩ Y = Y ∩ X :=
-- by library_search
set.inter_comm X Y

-- 5ª demostración
example :
  X ∩ Y = Y ∩ X :=
-- by hint
by finish

-- ---------------------------------------------------------------------
-- Ejercicio 17. Demostrar que
--    X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  ext a,
  split,
  { rintro ⟨hx, hy, hz⟩,
    exact ⟨⟨hx, hy⟩, hz⟩ },
  { rintro ⟨⟨hx, hy⟩, hz⟩,
    exact ⟨hx, hy, hz⟩ },
end

-- 2ª demostración
example :
  X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  ext a,
  dsimp,
  exact and.assoc.symm,
end

-- 3ª demostración
example :
  X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
set.ext (λ x, and.assoc.symm)

-- 4ª demostración
example :
  X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
-- by library_search
(set.inter_assoc X Y Z).symm

------------------------------------------------------------------------
-- § Cuantificadores                                                  --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 18. Demostrar que
--    ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X)
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  split,
  { intros h b hb,
    apply h,
    use b,
    exact hb, },
  { rintro h ⟨a, ha⟩,
    exact (h a) ha, },
end

-- 2ª demostración
example :
  ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  push_neg,
  simp,
end

-- 3ª demostración
example :
  ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
by {push_neg, simp}

-- 3ª demostración
example :
  ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
-- by library_search
not_exists

-- ---------------------------------------------------------------------
-- Ejercicio 19. Demostrar que
--    ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X)
-- ----------------------------------------------------------------------

-- 1ª demostración
example :
  ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
begin
  split,
  { intro h,
    by_contra hnX,
    apply h,
    intro a,
    by_contra hXa,
    apply hnX,
    use a, },
  { intro h,
    cases h with b hb,
    intro h,
    apply hb,
    apply h }
end

-- 2ª demostración
example :
  ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
-- by library_search
not_forall

-- 3ª demostración
example :
  ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
by simp

-- =====================================================================
-- § Referencias                                                      --
-- =====================================================================

-- + Kevin Buzzard. "Formalising mathematics : workshop 1 — logic, sets,
--   functions, relations" https://bit.ly/3kJo231
-- + Kevin Buzzard. formalising-mathematics: Part_B_sets.lean
--   https://bit.ly/2Wiv1Xe
-- + Kevin Buzzard. formalising-mathematics: Part_B_sets_solutions.lean
--   https://bit.ly/3zQyv0Y


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.submonoid.operations
import group_theory.subsemigroup.center

/-!
# Centers of monoids

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

## Main definitions

* `submonoid.center`: the center of a monoid
* `add_submonoid.center`: the center of an additive monoid

We provide `subgroup.center`, `add_subgroup.center`, `subsemiring.center`, and `subring.center` in
other files.
-/

namespace submonoid
section
variables (M : Type*) [monoid M]

/-- The center of a monoid `M` is the set of elements that commute with everything in `M` -/
@[to_additive "The center of a monoid `M` is the set of elements that commute with everything in
`M`"]
def center : submonoid M :=
{ carrier := set.center M,
  one_mem' := set.one_mem_center M,
  mul_mem' := λ a b, set.mul_mem_center }

@[to_additive] lemma coe_center : ↑(center M) = set.center M := rfl

@[simp]
lemma center_to_subsemigroup : (center M).to_subsemigroup = subsemigroup.center M := rfl

lemma _root_.add_submonoid.center_to_add_subsemigroup (M) [add_monoid M] :
  (add_submonoid.center M).to_add_subsemigroup = add_subsemigroup.center M := rfl

attribute [to_additive add_submonoid.center_to_add_subsemigroup] submonoid.center_to_subsemigroup

variables {M}

@[to_additive] lemma mem_center_iff {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl

@[to_additive] instance decidable_mem_center (a) [decidable $ ∀ b : M, b * a = a * b] :
  decidable (a ∈ center M) :=
decidable_of_iff' _ mem_center_iff

/-- The center of a monoid is commutative. -/
instance : comm_monoid (center M) :=
{ mul_comm := λ a b, subtype.ext $ b.prop _,
  .. (center M).to_monoid }

/-- The center of a monoid acts commutatively on that monoid. -/
instance center.smul_comm_class_left : smul_comm_class (center M) M M :=
{ smul_comm := λ m x y, (commute.left_comm (m.prop x) y).symm }

/-- The center of a monoid acts commutatively on that monoid. -/
instance center.smul_comm_class_right : smul_comm_class M (center M) M :=
smul_comm_class.symm _ _ _

/-! Note that `smul_comm_class (center M) (center M) M` is already implied by
`submonoid.smul_comm_class_right` -/
example : smul_comm_class (center M) (center M) M := by apply_instance

end

section
variables (M : Type*) [comm_monoid M]

@[simp] lemma center_eq_top : center M = ⊤ :=
set_like.coe_injective (set.center_eq_univ M)

end

end submonoid

-- Guard against import creep
assert_not_exists finset