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

! This file was ported from Lean 3 source module combinatorics.young.semistandard_tableau
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.Young.YoungDiagram

/-!
# Semistandard Young tableaux

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

A semistandard Young tableau is a filling of a Young diagram by natural numbers, such that
the entries are weakly increasing left-to-right along rows (i.e. for fixed `i`), and
strictly-increasing top-to-bottom along columns (i.e. for fixed `j`).

An example of an SSYT of shape `μ = [4, 2, 1]` is:

```text
0 0 0 2
1 1
2
```

We represent an SSYT as a function `ℕ → ℕ → ℕ`, which is required to be zero for all pairs
`(i, j) ∉ μ` and to satisfy the row-weak and column-strict conditions on `μ`.

## Main definitions

- `ssyt (μ : young_diagram)` : semistandard Young tableaux of shape `μ`. There is
  a `has_coe_to_fun` instance such that `T i j` is value of the `(i, j)` entry of the SSYT `T`.
- `ssyt.highest_weight (μ : young_diagram)`: the semistandard Young tableau whose `i`th row
  consists entirely of `i`s, for each `i`.

## Tags

Semistandard Young tableau

## References

<https://en.wikipedia.org/wiki/Young_tableau>

-/

#print Ssyt /-
/-- A semistandard Young tableau (SSYT) is a filling of the cells of a Young diagram by natural
numbers, such that the entries in each row are weakly increasing (left to right), and the entries
in each column are strictly increasing (top to bottom).

Here, an SSYT is represented as an unrestricted function `ℕ → ℕ → ℕ` that, for reasons
of extensionality, is required to vanish outside `μ`. -/
structure Ssyt (μ : YoungDiagram) where
  entry : ℕ → ℕ → ℕ
  row_weak' : ∀ {i j1 j2 : ℕ}, j1 < j2 → (i, j2) ∈ μ → entry i j1 ≤ entry i j2
  col_strict' : ∀ {i1 i2 j : ℕ}, i1 < i2 → (i2, j) ∈ μ → entry i1 j < entry i2 j
  zeros' : ∀ {i j}, (i, j) ∉ μ → entry i j = 0
#align ssyt Ssyt
-/

namespace Ssyt

#print Ssyt.funLike /-
instance funLike {μ : YoungDiagram} : FunLike (Ssyt μ) ℕ fun _ => ℕ → ℕ
    where
  coe := Ssyt.entry
  coe_injective' T T' h := by
    cases T
    cases T'
    congr
#align ssyt.fun_like Ssyt.funLike
-/

/-- Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
instance {μ : YoungDiagram} : CoeFun (Ssyt μ) fun _ => ℕ → ℕ → ℕ :=
  FunLike.hasCoeToFun

#print Ssyt.to_fun_eq_coe /-
@[simp]
theorem to_fun_eq_coe {μ : YoungDiagram} {T : Ssyt μ} : T.entry = (T : ℕ → ℕ → ℕ) :=
  rfl
#align ssyt.to_fun_eq_coe Ssyt.to_fun_eq_coe
-/

#print Ssyt.ext /-
@[ext]
theorem ext {μ : YoungDiagram} {T T' : Ssyt μ} (h : ∀ i j, T i j = T' i j) : T = T' :=
  FunLike.ext T T' fun x => by
    funext
    apply h
#align ssyt.ext Ssyt.ext
-/

#print Ssyt.copy /-
/-- Copy of an `ssyt μ` with a new `entry` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy {μ : YoungDiagram} (T : Ssyt μ) (entry' : ℕ → ℕ → ℕ) (h : entry' = T) : Ssyt μ
    where
  entry := entry'
  row_weak' _ _ _ := h.symm ▸ T.row_weak'
  col_strict' _ _ _ := h.symm ▸ T.col_strict'
  zeros' _ _ := h.symm ▸ T.zeros'
#align ssyt.copy Ssyt.copy
-/

#print Ssyt.coe_copy /-
@[simp]
theorem coe_copy {μ : YoungDiagram} (T : Ssyt μ) (entry' : ℕ → ℕ → ℕ) (h : entry' = T) :
    ⇑(T.copy entry' h) = entry' :=
  rfl
#align ssyt.coe_copy Ssyt.coe_copy
-/

#print Ssyt.copy_eq /-
theorem copy_eq {μ : YoungDiagram} (T : Ssyt μ) (entry' : ℕ → ℕ → ℕ) (h : entry' = T) :
    T.copy entry' h = T :=
  FunLike.ext' h
#align ssyt.copy_eq Ssyt.copy_eq
-/

#print Ssyt.row_weak /-
theorem row_weak {μ : YoungDiagram} (T : Ssyt μ) {i j1 j2 : ℕ} (hj : j1 < j2)
    (hcell : (i, j2) ∈ μ) : T i j1 ≤ T i j2 :=
  T.row_weak' hj hcell
#align ssyt.row_weak Ssyt.row_weak
-/

#print Ssyt.col_strict /-
theorem col_strict {μ : YoungDiagram} (T : Ssyt μ) {i1 i2 j : ℕ} (hi : i1 < i2)
    (hcell : (i2, j) ∈ μ) : T i1 j < T i2 j :=
  T.col_strict' hi hcell
#align ssyt.col_strict Ssyt.col_strict
-/

#print Ssyt.zeros /-
theorem zeros {μ : YoungDiagram} (T : Ssyt μ) {i j : ℕ} (not_cell : (i, j) ∉ μ) : T i j = 0 :=
  T.zeros' not_cell
#align ssyt.zeros Ssyt.zeros
-/

#print Ssyt.row_weak_of_le /-
theorem row_weak_of_le {μ : YoungDiagram} (T : Ssyt μ) {i j1 j2 : ℕ} (hj : j1 ≤ j2)
    (cell : (i, j2) ∈ μ) : T i j1 ≤ T i j2 :=
  by
  cases eq_or_lt_of_le hj
  subst h
  exact T.row_weak h cell
#align ssyt.row_weak_of_le Ssyt.row_weak_of_le
-/

#print Ssyt.col_weak /-
theorem col_weak {μ : YoungDiagram} (T : Ssyt μ) {i1 i2 j : ℕ} (hi : i1 ≤ i2) (cell : (i2, j) ∈ μ) :
    T i1 j ≤ T i2 j := by
  cases eq_or_lt_of_le hi
  subst h
  exact le_of_lt (T.col_strict h cell)
#align ssyt.col_weak Ssyt.col_weak
-/

#print Ssyt.highestWeight /-
/-- The "highest weight" SSYT of a given shape is has all i's in row i, for each i. -/
def highestWeight (μ : YoungDiagram) : Ssyt μ
    where
  entry i j := if (i, j) ∈ μ then i else 0
  row_weak' i j1 j2 hj hcell := by
    rw [if_pos hcell, if_pos (μ.up_left_mem (by rfl) (le_of_lt hj) hcell)]
  col_strict' i1 i2 j hi hcell := by
    rwa [if_pos hcell, if_pos (μ.up_left_mem (le_of_lt hi) (by rfl) hcell)]
  zeros' i j not_cell := if_neg not_cell
#align ssyt.highest_weight Ssyt.highestWeight
-/

#print Ssyt.highestWeight_apply /-
@[simp]
theorem highestWeight_apply {μ : YoungDiagram} {i j : ℕ} :
    highestWeight μ i j = if (i, j) ∈ μ then i else 0 :=
  rfl
#align ssyt.highest_weight_apply Ssyt.highestWeight_apply
-/

instance {μ : YoungDiagram} : Inhabited (Ssyt μ) :=
  ⟨Ssyt.highestWeight μ⟩

end Ssyt


namespace prop_14

variables A B C : Prop

theorem prop_14 : ((A → C) ∨ (B → C)) → ((A ∧ B) → C) :=
assume h1: ((A → C) ∨ (B → C)),
assume h2: A ∧ B,
have h3: A, from and.left h2,
have h4: B, from and.right h2,
show C, from or.elim h1
    (assume h5: A → C,
     h5 h3)
    (assume h6: B → C,
     h6 h4)

-- end namespace
end prop_14


/-
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 contains various addenda to algebra/big_operators.
One issue is that I often prefer to work with fintypes and
sums/products over all of univ, and it is helpful to have some
lemmas specialised to that situation.

-/

import algebra.big_operators data.fintype.basic
import tactic.squeeze

universes uα uβ uγ uδ
variables {α : Type uα} {β : Type uβ} {γ : Type uγ} {δ : Type uδ}
variables [decidable_eq α] [decidable_eq β]
variables [comm_monoid γ] [add_comm_monoid δ]

namespace finset
open finset

lemma mem_range_succ {i n : ℕ} : i ∈ range n.succ ↔ i ≤ n :=
 by {rw[mem_range,nat.lt_succ_iff]}

@[to_additive finset.sum_coe_list]
lemma prod_coe_list {l : list α} (h : l.nodup) (f : α → γ) :
 l.to_finset.prod f = (l.map f).prod :=
begin
 let s := @finset.mk α l h,
 have : s = l.to_finset := (list.to_finset_eq h),
 exact calc
  l.to_finset.prod f = s.prod f : by rw[← this]
  ... = ((l : multiset α).map f).prod : rfl
  ... = ((l.map f) : multiset γ).prod : by rw[multiset.coe_map]
  ... = (l.map f).prod : by rw[multiset.coe_prod],
end

@[to_additive finset.sum_equiv]
lemma prod_equiv {s : finset α} {t : finset β}
 (e : {a // a ∈ s} ≃ {b // b ∈ t})
  (f : α → γ) (g : β → γ)
   (hfg : ∀ (a : α) (ha : a ∈ s), f a = g (e ⟨a,ha⟩).val) :
    s.prod f = t.prod g :=
prod_bij
 (λ a a_in_s, (e.to_fun ⟨a,a_in_s⟩).val)
 (λ a a_in_s, (e.to_fun ⟨a,a_in_s⟩).property)
 hfg
 (λ a₁ a₂ a₁_in_s a₂_in_s h,
  congr_arg subtype.val (e.injective (subtype.eq h)))
 (λ b b_in_t, let aa := e.inv_fun ⟨b,b_in_t⟩ in
   exists.intro aa.val
   begin
    have ea : aa = ⟨aa.val,aa.property⟩ := subtype.eq rfl,
    use aa.property,
    rw[← ea],
    exact congr_arg subtype.val (e.right_inv ⟨b,b_in_t⟩).symm,
   end
  )

@[to_additive finset.univ_sum_equiv]
lemma univ_prod_equiv [fintype α] [fintype β] (e : α ≃ β) (g : β → γ) :
 univ.prod (g ∘ e.to_fun) = univ.prod g :=
prod_bij
 (λ a _,e.to_fun a) (λ a _,mem_univ _) (λ a _, @rfl _ (g (e.to_fun a)))
 (λ a₁ a₂ _ _ h, e.injective h)
 (λ b _, begin use e.inv_fun b, use mem_univ _, exact (e.right_inv b).symm, end)

@[to_additive finset.sum_eq_univ_sum]
lemma prod_eq_univ_prod (s : finset α) (f : α → γ) :
 s.prod f = (@univ {a // a ∈ s} _).prod (λ a, f a.val) :=
begin
 have : @univ {a // a ∈ s} _ = s.attach := rfl,
 rw[← prod_attach,this],refl
end

@[to_additive finset.sum_univ_product]
lemma prod_univ_product [fintype α] [fintype β] (f : α → β → γ) :
 (@univ (α × β) _).prod (λ ab, f ab.1 ab.2) =
  (@univ α _).prod (λ a, (@univ β _).prod (f a)) :=
begin
 have : @univ (α × β) _ = (@univ α _).product (@univ β _) := rfl,
 rw[this,prod_product],
end

@[to_additive finset.sum_over_bool]
lemma prod_over_bool (f : bool → γ) :
 (@univ bool _).prod f = (f ff) * (f tt) :=
begin
 let l : list bool := [ff,tt],
 let h : l.nodup := dec_trivial,
 have : (@univ bool _) = l.to_finset := dec_trivial,
 rw[this,prod_coe_list h],
 simp only [list.map,list.prod_cons,list.prod_nil,mul_one]
end

lemma prod_range_two (f : ℕ → γ) :
 (range 2).prod f = f 0 * f 1 :=
 by {
   rw[← one_mul (f 0)],
  have : range 2 = list.to_finset [0,1] := rfl,
  rw[this,prod_coe_list (dec_trivial : list.nodup [0,1])],
  refl,
 }

lemma sum_range_two (f : ℕ → δ) :
 (range 2).sum f = f 0 + f 1 :=
 by {
   rw[← zero_add (f 0)],
  have : range 2 = list.to_finset [0,1] := rfl,
  rw[this,sum_coe_list (dec_trivial : list.nodup [0,1])],
  refl,
 }

@[to_additive finset.sum_eq_zero_of_terms_eq_zero]
lemma prod_eq_one_of_terms_eq_one
 (s : finset α) (f : α → γ) (e : ∀ a, a ∈ s → f a = 1) :
  s.prod f = 1 :=
   by { have : s.prod f = s.prod (λ a, 1) := prod_congr rfl e,
        rw[this,prod_const_one]}

end finset


/-
Copyright (c) 2019 Minchao Wu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Minchao Wu, Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Minimum and maximum of lists

## Main definitions

The main definitions are `argmax`, `argmin`, `minimum` and `maximum` for lists.

`argmax f l` returns `some a`, where `a` of `l` that maximises `f a`. If there are `a b` such that
  `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
  `argmax f []` = none`

`minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for
`[]`
-/

namespace list

/-- Auxiliary definition to define `argmax` -/
def argmax₂ {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (a : Option α) (b : α) :
    Option α :=
  option.cases_on a (some b) fun (c : α) => ite (f b ≤ f c) (some c) (some b)

/-- `argmax f l` returns `some a`, where `a` of `l` that maximises `f a`. If there are `a b` such
that `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
`argmax f []` = none` -/
def argmax {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (l : List α) : Option α :=
  foldl (argmax₂ f) none l

/-- `argmin f l` returns `some a`, where `a` of `l` that minimises `f a`. If there are `a b` such
that `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
`argmin f []` = none` -/
def argmin {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (l : List α) : Option α :=
  argmax f l

@[simp] theorem argmax_two_self {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (a : α) :
    argmax₂ f (some a) a = ↑a :=
  if_pos (le_refl (f a))

@[simp] theorem argmax_nil {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) :
    argmax f [] = none :=
  rfl

@[simp] theorem argmin_nil {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) :
    argmin f [] = none :=
  rfl

@[simp] theorem argmax_singleton {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β}
    {a : α} : argmax f [a] = some a :=
  rfl

@[simp] theorem argmin_singleton {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β}
    {a : α} : argmin f [a] = ↑a :=
  rfl

@[simp] theorem foldl_argmax₂_eq_none {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β}
    {l : List α} {o : Option α} : foldl (argmax₂ f) o l = none ↔ l = [] ∧ o = none :=
  sorry

theorem argmax_mem {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β} {l : List α} {m : α} :
    m ∈ argmax f l → m ∈ l :=
  sorry

theorem argmin_mem {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β} {l : List α} {m : α} :
    m ∈ argmin f l → m ∈ l :=
  argmax_mem

@[simp] theorem argmax_eq_none {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β}
    {l : List α} : argmax f l = none ↔ l = [] :=
  sorry

@[simp] theorem argmin_eq_none {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β}
    {l : List α} : argmin f l = none ↔ l = [] :=
  argmax_eq_none

theorem le_argmax_of_mem {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β} {a : α} {m : α}
    {l : List α} : a ∈ l → m ∈ argmax f l → f a ≤ f m :=
  le_of_foldl_argmax₂

theorem argmin_le_of_mem {α : Type u_1} {β : Type u_2} [linear_order β] {f : α → β} {a : α} {m : α}
    {l : List α} : a ∈ l → m ∈ argmin f l → f m ≤ f a :=
  le_argmax_of_mem

theorem argmax_concat {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (a : α)
    (l : List α) :
    argmax f (l ++ [a]) =
        option.cases_on (argmax f l) (some a) fun (c : α) => ite (f a ≤ f c) (some c) (some a) :=
  sorry

theorem argmin_concat {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (a : α)
    (l : List α) :
    argmin f (l ++ [a]) =
        option.cases_on (argmin f l) (some a) fun (c : α) => ite (f c ≤ f a) (some c) (some a) :=
  argmax_concat f a l

theorem argmax_cons {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (a : α)
    (l : List α) :
    argmax f (a :: l) =
        option.cases_on (argmax f l) (some a) fun (c : α) => ite (f c ≤ f a) (some a) (some c) :=
  sorry

theorem argmin_cons {α : Type u_1} {β : Type u_2} [linear_order β] (f : α → β) (a : α)
    (l : List α) :
    argmin f (a :: l) =
        option.cases_on (argmin f l) (some a) fun (c : α) => ite (f a ≤ f c) (some a) (some c) :=
  argmax_cons f a l

theorem index_of_argmax {α : Type u_1} {β : Type u_2} [linear_order β] [DecidableEq α] {f : α → β}
    {l : List α} {m : α} :
    m ∈ argmax f l → ∀ {a : α}, a ∈ l → f m ≤ f a → index_of m l ≤ index_of a l :=
  sorry

theorem index_of_argmin {α : Type u_1} {β : Type u_2} [linear_order β] [DecidableEq α] {f : α → β}
    {l : List α} {m : α} :
    m ∈ argmin f l → ∀ {a : α}, a ∈ l → f a ≤ f m → index_of m l ≤ index_of a l :=
  index_of_argmax

theorem mem_argmax_iff {α : Type u_1} {β : Type u_2} [linear_order β] [DecidableEq α] {f : α → β}
    {m : α} {l : List α} :
    m ∈ argmax f l ↔
        m ∈ l ∧
          (∀ (a : α), a ∈ l → f a ≤ f m) ∧
            ∀ (a : α), a ∈ l → f m ≤ f a → index_of m l ≤ index_of a l :=
  sorry

theorem argmax_eq_some_iff {α : Type u_1} {β : Type u_2} [linear_order β] [DecidableEq α]
    {f : α → β} {m : α} {l : List α} :
    argmax f l = some m ↔
        m ∈ l ∧
          (∀ (a : α), a ∈ l → f a ≤ f m) ∧
            ∀ (a : α), a ∈ l → f m ≤ f a → index_of m l ≤ index_of a l :=
  mem_argmax_iff

theorem mem_argmin_iff {α : Type u_1} {β : Type u_2} [linear_order β] [DecidableEq α] {f : α → β}
    {m : α} {l : List α} :
    m ∈ argmin f l ↔
        m ∈ l ∧
          (∀ (a : α), a ∈ l → f m ≤ f a) ∧
            ∀ (a : α), a ∈ l → f a ≤ f m → index_of m l ≤ index_of a l :=
  mem_argmax_iff

theorem argmin_eq_some_iff {α : Type u_1} {β : Type u_2} [linear_order β] [DecidableEq α]
    {f : α → β} {m : α} {l : List α} :
    argmin f l = some m ↔
        m ∈ l ∧
          (∀ (a : α), a ∈ l → f m ≤ f a) ∧
            ∀ (a : α), a ∈ l → f a ≤ f m → index_of m l ≤ index_of a l :=
  mem_argmin_iff

/-- `maximum l` returns an `with_bot α`, the largest element of `l` for nonempty lists, and `⊥` for
`[]`  -/
def maximum {α : Type u_1} [linear_order α] (l : List α) : with_bot α := argmax id l

/-- `minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for
`[]`  -/
def minimum {α : Type u_1} [linear_order α] (l : List α) : with_top α := argmin id l

@[simp] theorem maximum_nil {α : Type u_1} [linear_order α] : maximum [] = ⊥ := rfl

@[simp] theorem minimum_nil {α : Type u_1} [linear_order α] : minimum [] = ⊤ := rfl

@[simp] theorem maximum_singleton {α : Type u_1} [linear_order α] (a : α) : maximum [a] = ↑a := rfl

@[simp] theorem minimum_singleton {α : Type u_1} [linear_order α] (a : α) : minimum [a] = ↑a := rfl

theorem maximum_mem {α : Type u_1} [linear_order α] {l : List α} {m : α} : maximum l = ↑m → m ∈ l :=
  argmax_mem

theorem minimum_mem {α : Type u_1} [linear_order α] {l : List α} {m : α} : minimum l = ↑m → m ∈ l :=
  argmin_mem

@[simp] theorem maximum_eq_none {α : Type u_1} [linear_order α] {l : List α} :
    maximum l = none ↔ l = [] :=
  argmax_eq_none

@[simp] theorem minimum_eq_none {α : Type u_1} [linear_order α] {l : List α} :
    minimum l = none ↔ l = [] :=
  argmin_eq_none

theorem le_maximum_of_mem {α : Type u_1} [linear_order α] {a : α} {m : α} {l : List α} :
    a ∈ l → maximum l = ↑m → a ≤ m :=
  le_argmax_of_mem

theorem minimum_le_of_mem {α : Type u_1} [linear_order α] {a : α} {m : α} {l : List α} :
    a ∈ l → minimum l = ↑m → m ≤ a :=
  argmin_le_of_mem

theorem le_maximum_of_mem' {α : Type u_1} [linear_order α] {a : α} {l : List α} (ha : a ∈ l) :
    ↑a ≤ maximum l :=
  sorry

theorem le_minimum_of_mem' {α : Type u_1} [linear_order α] {a : α} {l : List α} (ha : a ∈ l) :
    minimum l ≤ ↑a :=
  le_maximum_of_mem' ha

theorem maximum_concat {α : Type u_1} [linear_order α] (a : α) (l : List α) :
    maximum (l ++ [a]) = max (maximum l) ↑a :=
  sorry

theorem minimum_concat {α : Type u_1} [linear_order α] (a : α) (l : List α) :
    minimum (l ++ [a]) = min (minimum l) ↑a :=
  maximum_concat a l

theorem maximum_cons {α : Type u_1} [linear_order α] (a : α) (l : List α) :
    maximum (a :: l) = max (↑a) (maximum l) :=
  sorry

theorem minimum_cons {α : Type u_1} [linear_order α] (a : α) (l : List α) :
    minimum (a :: l) = min (↑a) (minimum l) :=
  maximum_cons a l

theorem maximum_eq_coe_iff {α : Type u_1} [linear_order α] {m : α} {l : List α} :
    maximum l = ↑m ↔ m ∈ l ∧ ∀ (a : α), a ∈ l → a ≤ m :=
  sorry

theorem minimum_eq_coe_iff {α : Type u_1} [linear_order α] {m : α} {l : List α} :
    minimum l = ↑m ↔ m ∈ l ∧ ∀ (a : α), a ∈ l → m ≤ a :=
  maximum_eq_coe_iff

end Mathlib


-- Imagen_inversa_de_la_interseccion_general.lean
-- Imagen inversa de la intersección general
-- José A. Alonso Jiménez
-- Sevilla, 27 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i)
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*} {I : Type*}
variable  f : α → β
variables B : I → set β

-- 1ª demostración
-- ===============

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
begin
  ext x,
  split,
  { intro hx,
    apply mem_Inter_of_mem,
    intro i,
    rw mem_preimage,
    rw mem_preimage at hx,
    rw mem_Inter at hx,
    exact hx i, },
  { intro hx,
    rw mem_preimage,
    rw mem_Inter,
    intro i,
    rw ← mem_preimage,
    rw mem_Inter at hx,
    exact hx i, },
end

-- 2ª demostración
-- ===============

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
begin
  ext x,
  calc  (x ∈ f ⁻¹' ⋂ (i : I), B i)
      ↔ f x ∈ ⋂ (i : I), B i       : mem_preimage
  ... ↔ (∀ i : I, f x ∈ B i)       : mem_Inter
  ... ↔ (∀ i : I, x ∈ f ⁻¹' B i)   : iff_of_eq rfl
  ... ↔ x ∈ ⋂ (i : I), f ⁻¹' B i   : mem_Inter.symm,
end

-- 3ª demostración
-- ===============

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
begin
  ext x,
  simp,
end

-- 4ª demostración
-- ===============

example : f ⁻¹' (⋂ i, B i) = ⋂ i, f ⁻¹' (B i) :=
by { ext, simp }


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Neil Strickland
-/
import data.nat.basic

/-!
# The positive natural numbers

This file defines the type `ℕ+` or `pnat`, the subtype of natural numbers that are positive.
-/

/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype,
  and the VM representation of `ℕ+` is the same as `ℕ` because the proof
  is not stored. -/
def pnat := {n : ℕ // 0 < n}
notation `ℕ+` := pnat

instance coe_pnat_nat : has_coe ℕ+ ℕ := ⟨subtype.val⟩
instance : has_repr ℕ+ := ⟨λ n, repr n.1⟩

/-- Predecessor of a `ℕ+`, as a `ℕ`. -/
def pnat.nat_pred (i : ℕ+) : ℕ := i - 1

namespace nat

/-- Convert a natural number to a positive natural number. The
  positivity assumption is inferred by `dec_trivial`. -/
def to_pnat (n : ℕ) (h : 0 < n . tactic.exact_dec_trivial) : ℕ+ := ⟨n, h⟩

/-- Write a successor as an element of `ℕ+`. -/
def succ_pnat (n : ℕ) : ℕ+ := ⟨succ n, succ_pos n⟩

@[simp] theorem succ_pnat_coe (n : ℕ) : (succ_pnat n : ℕ) = succ n := rfl

theorem succ_pnat_inj {n m : ℕ} : succ_pnat n = succ_pnat m → n = m :=
λ h, by { let h' := congr_arg (coe : ℕ+ → ℕ) h, exact nat.succ.inj h' }

/-- Convert a natural number to a pnat. `n+1` is mapped to itself,
  and `0` becomes `1`. -/
def to_pnat' (n : ℕ) : ℕ+ := succ_pnat (pred n)

@[simp] theorem to_pnat'_coe : ∀ (n : ℕ),
 ((to_pnat' n) : ℕ) = ite (0 < n) n 1
| 0 := rfl
| (m + 1) := by {rw [if_pos (succ_pos m)], refl}

end nat

namespace pnat

open nat

/-- We now define a long list of structures on ℕ+ induced by
 similar structures on ℕ. Most of these behave in a completely
 obvious way, but there are a few things to be said about
 subtraction, division and powers.
-/

instance : decidable_eq ℕ+ := λ (a b : ℕ+), by apply_instance

instance : linear_order ℕ+ :=
subtype.linear_order _

@[simp] lemma mk_le_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) :
  (⟨n, hn⟩ : ℕ+) ≤ ⟨k, hk⟩ ↔ n ≤ k := iff.rfl

@[simp] lemma mk_lt_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) :
  (⟨n, hn⟩ : ℕ+) < ⟨k, hk⟩ ↔ n < k := iff.rfl

@[simp, norm_cast] lemma coe_le_coe (n k : ℕ+) : (n:ℕ) ≤ k ↔ n ≤ k := iff.rfl

@[simp, norm_cast] lemma coe_lt_coe (n k : ℕ+) : (n:ℕ) < k ↔ n < k := iff.rfl

@[simp] theorem pos (n : ℕ+) : 0 < (n : ℕ) := n.2

theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n := subtype.eq

@[simp] lemma coe_inj {m n : ℕ+} : (m : ℕ) = n ↔ m = n := set_coe.ext_iff

lemma coe_injective : function.injective (coe : ℕ+ → ℕ) := subtype.coe_injective

@[simp] theorem mk_coe (n h) : ((⟨n, h⟩ : ℕ+) : ℕ) = n := rfl

instance : has_add ℕ+ := ⟨λ a b, ⟨(a  + b : ℕ), add_pos a.pos b.pos⟩⟩

instance : add_comm_semigroup ℕ+ := coe_injective.add_comm_semigroup coe (λ _ _, rfl)

@[simp] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl
instance coe_add_hom : is_add_hom (coe : ℕ+ → ℕ) := ⟨add_coe⟩

instance : add_left_cancel_semigroup ℕ+ :=
coe_injective.add_left_cancel_semigroup coe (λ _ _, rfl)

instance : add_right_cancel_semigroup ℕ+ :=
coe_injective.add_right_cancel_semigroup coe (λ _ _, rfl)

@[simp] theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 := ne_of_gt n.2

theorem to_pnat'_coe {n : ℕ} : 0 < n → (n.to_pnat' : ℕ) = n := succ_pred_eq_of_pos

@[simp] theorem coe_to_pnat' (n : ℕ+) : (n : ℕ).to_pnat' = n := eq (to_pnat'_coe n.pos)

instance : has_mul ℕ+ := ⟨λ m n, ⟨m.1 * n.1, mul_pos m.2 n.2⟩⟩
instance : has_one ℕ+ := ⟨succ_pnat 0⟩

instance : comm_monoid ℕ+ := coe_injective.comm_monoid coe rfl (λ _ _, rfl)

theorem lt_add_one_iff : ∀ {a b : ℕ+}, a < b + 1 ↔ a ≤ b :=
λ a b, nat.lt_add_one_iff

theorem add_one_le_iff : ∀ {a b : ℕ+}, a + 1 ≤ b ↔ a < b :=
λ a b, nat.add_one_le_iff

@[simp] lemma one_le (n : ℕ+) : (1 : ℕ+) ≤ n := n.2

instance : order_bot ℕ+ :=
{ bot := 1,
  bot_le := λ a, a.property,
  .. pnat.linear_order }

@[simp] lemma bot_eq_zero : (⊥ : ℕ+) = 1 := rfl

instance : inhabited ℕ+ := ⟨1⟩

-- Some lemmas that rewrite `pnat.mk n h`, for `n` an explicit numeral, into explicit numerals.
@[simp] lemma mk_one {h} : (⟨1, h⟩ : ℕ+) = (1 : ℕ+) := rfl
@[simp] lemma mk_bit0 (n) {h} : (⟨bit0 n, h⟩ : ℕ+) = (bit0 ⟨n, pos_of_bit0_pos h⟩ : ℕ+) := rfl
@[simp] lemma mk_bit1 (n) {h} {k} : (⟨bit1 n, h⟩ : ℕ+) = (bit1 ⟨n, k⟩ : ℕ+) := rfl

-- Some lemmas that rewrite inequalities between explicit numerals in `pnat`
-- into the corresponding inequalities in `nat`.
-- TODO: perhaps this should not be attempted by `simp`,
-- and instead we should expect `norm_num` to take care of these directly?
-- TODO: these lemmas are perhaps incomplete:
-- * 1 is not represented as a bit0 or bit1
-- * strict inequalities?
@[simp] lemma bit0_le_bit0 (n m : ℕ+) : (bit0 n) ≤ (bit0 m) ↔ (bit0 (n : ℕ)) ≤ (bit0 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit0_le_bit1 (n m : ℕ+) : (bit0 n) ≤ (bit1 m) ↔ (bit0 (n : ℕ)) ≤ (bit1 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit1_le_bit0 (n m : ℕ+) : (bit1 n) ≤ (bit0 m) ↔ (bit1 (n : ℕ)) ≤ (bit0 (m : ℕ)) :=
iff.rfl
@[simp] lemma bit1_le_bit1 (n m : ℕ+) : (bit1 n) ≤ (bit1 m) ↔ (bit1 (n : ℕ)) ≤ (bit1 (m : ℕ)) :=
iff.rfl

@[simp] theorem one_coe : ((1 : ℕ+) : ℕ) = 1 := rfl
@[simp] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl
instance coe_mul_hom : is_monoid_hom (coe : ℕ+ → ℕ) :=
 {map_one := one_coe, map_mul := mul_coe}

 @[simp]
lemma coe_eq_one_iff {m : ℕ+} :
(m : ℕ) = 1 ↔ m = 1 := by { split; intro h; try { apply pnat.eq}; rw h; simp }

@[simp] lemma coe_bit0 (a : ℕ+) : ((bit0 a : ℕ+) : ℕ) = bit0 (a : ℕ) := rfl
@[simp] lemma coe_bit1 (a : ℕ+) : ((bit1 a : ℕ+) : ℕ) = bit1 (a : ℕ) := rfl

@[simp] theorem pow_coe (m : ℕ+) (n : ℕ) : ((m ^ n : ℕ+) : ℕ) = (m : ℕ) ^ n :=
by induction n with n ih;
 [refl, rw [pow_succ', pow_succ, mul_coe, mul_comm, ih]]

instance : ordered_cancel_comm_monoid ℕ+ :=
{ mul_le_mul_left := by { intros, apply nat.mul_le_mul_left, assumption },
  le_of_mul_le_mul_left := by { intros a b c h, apply nat.le_of_mul_le_mul_left h a.property, },
  mul_left_cancel := λ a b c h, by {
   replace h := congr_arg (coe : ℕ+ → ℕ) h,
   exact eq ((nat.mul_right_inj a.pos).mp h)},
  .. pnat.comm_monoid,
  .. pnat.linear_order }

instance : distrib ℕ+ := coe_injective.distrib coe (λ _ _, rfl) (λ _ _, rfl)

/-- Subtraction a - b is defined in the obvious way when
  a > b, and by a - b = 1 if a ≤ b.
-/
instance : has_sub ℕ+ := ⟨λ a b, to_pnat' (a - b : ℕ)⟩

theorem sub_coe (a b : ℕ+) : ((a - b : ℕ+) : ℕ) = ite (b < a) (a - b : ℕ) 1 :=
begin
  change ((to_pnat' ((a : ℕ) - (b :  ℕ)) : ℕ)) =
    ite ((a : ℕ) > (b : ℕ)) ((a : ℕ) - (b : ℕ)) 1,
  split_ifs with h,
  { exact to_pnat'_coe (nat.sub_pos_of_lt h) },
  { rw [nat.sub_eq_zero_iff_le.mpr (le_of_not_gt h)], refl }
end

theorem add_sub_of_lt {a b : ℕ+} : a < b → a + (b - a) = b :=
 λ h, eq $ by { rw [add_coe, sub_coe, if_pos h],
                exact nat.add_sub_of_le (le_of_lt h) }

instance : has_well_founded ℕ+ := ⟨(<), measure_wf coe⟩

/-- Strong induction on `pnat`. -/
lemma strong_induction_on {p : pnat → Prop} : ∀ (n : pnat) (h : ∀ k, (∀ m, m < k → p m) → p k), p n
| n := λ IH, IH _ (λ a h, strong_induction_on a IH)
using_well_founded { dec_tac := `[assumption] }

/-- If `(n : pnat)` is different from `1`, then it is the successor of some `(k : pnat)`. -/
lemma exists_eq_succ_of_ne_one : ∀ {n : pnat} (h1 : n ≠ 1), ∃ (k : pnat), n = k + 1
| ⟨1, _⟩ h1 := false.elim $ h1 rfl
| ⟨n+2, _⟩ _ := ⟨⟨n+1, by simp⟩, rfl⟩

lemma case_strong_induction_on {p : pnat → Prop} (a : pnat) (hz : p 1)
  (hi : ∀ n, (∀ m, m ≤ n → p m) → p (n + 1)) : p a :=
begin
  apply strong_induction_on a,
  intros k hk,
  by_cases h1 : k = 1, { rwa h1 },
  obtain ⟨b, rfl⟩ := exists_eq_succ_of_ne_one h1,
  simp only [lt_add_one_iff] at hk,
  exact hi b hk
end

/-- An induction principle for `pnat`: it takes values in `Sort*`, so it applies also to Types,
not only to `Prop`. -/
@[elab_as_eliminator]
def rec_on (n : pnat) {p : pnat → Sort*} (p1 : p 1) (hp : ∀ n, p n → p (n + 1)) : p n :=
begin
  rcases n with ⟨n, h⟩,
  induction n with n IH,
  { exact absurd h dec_trivial },
  { cases n with n,
    { exact p1 },
    { exact hp _ (IH n.succ_pos) } }
end

@[simp] theorem rec_on_one {p} (p1 hp) : @pnat.rec_on 1 p p1 hp = p1 := rfl

@[simp] theorem rec_on_succ (n : pnat) {p : pnat → Sort*} (p1 hp) :
  @pnat.rec_on (n + 1) p p1 hp = hp n (@pnat.rec_on n p p1 hp) :=
by { cases n with n h, cases n; [exact absurd h dec_trivial, refl] }

/-- We define `m % k` and `m / k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` and
  `m / k = n - 1`.  This ensures that `m % k` is always positive
  and `m = (m % k) + k * (m / k)` in all cases.  Later we
  define a function `div_exact` which gives the usual `m / k`
  in the case where `k` divides `m`.
-/
def mod_div_aux : ℕ+ → ℕ → ℕ → ℕ+ × ℕ
| k 0 q := ⟨k, q.pred⟩
| k (r + 1) q := ⟨⟨r + 1, nat.succ_pos r⟩, q⟩

lemma mod_div_aux_spec : ∀ (k : ℕ+) (r q : ℕ) (h : ¬ (r = 0 ∧ q = 0)),
 (((mod_div_aux k r q).1 : ℕ) + k * (mod_div_aux k r q).2 = (r + k * q))
| k 0 0 h := (h ⟨rfl, rfl⟩).elim
| k 0 (q + 1) h := by {
  change (k : ℕ) + (k : ℕ) * (q + 1).pred = 0 + (k : ℕ) * (q + 1),
  rw [nat.pred_succ, nat.mul_succ, zero_add, add_comm]}
| k (r + 1) q h := rfl

/-- `mod_div m k = (m % k, m / k)`.
  We define `m % k` and `m / k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` and
  `m / k = n - 1`.  This ensures that `m % k` is always positive
  and `m = (m % k) + k * (m / k)` in all cases.  Later we
  define a function `div_exact` which gives the usual `m / k`
  in the case where `k` divides `m`.
-/
def mod_div (m k : ℕ+) : ℕ+ × ℕ := mod_div_aux k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ))

/-- We define `m % k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` This ensures that `m % k` is always positive.
-/
def mod (m k : ℕ+) : ℕ+ := (mod_div m k).1

/-- We define `m / k` in the same way as for `ℕ` except that when `m = n * k` we take
  `m / k = n - 1`. This ensures that `m = (m % k) + k * (m / k)` in all cases. Later we
  define a function `div_exact` which gives the usual `m / k` in the case where `k` divides `m`.
-/
def div (m k : ℕ+) : ℕ  := (mod_div m k).2

theorem mod_add_div (m k : ℕ+) : ((mod m k) + k * (div m k) : ℕ) = m :=
begin
  let h₀ := nat.mod_add_div (m : ℕ) (k : ℕ),
  have : ¬ ((m : ℕ) % (k : ℕ) = 0 ∧ (m : ℕ) / (k : ℕ) = 0),
  by { rintro ⟨hr, hq⟩, rw [hr, hq, mul_zero, zero_add] at h₀,
       exact (m.ne_zero h₀.symm).elim },
  have := mod_div_aux_spec k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ)) this,
  exact (this.trans h₀),
end

theorem div_add_mod (m k : ℕ+) : (k * (div m k) + mod m k : ℕ) = m :=
(add_comm _ _).trans (mod_add_div _ _)

lemma mod_add_div' (m k : ℕ+) : ((mod m k) + (div m k) * k : ℕ) = m :=
by { rw mul_comm, exact mod_add_div _ _ }

lemma div_add_mod' (m k : ℕ+) : ((div m k) * k + mod m k : ℕ) = m :=
by { rw mul_comm, exact div_add_mod _ _ }

theorem mod_coe (m k : ℕ+) :
 ((mod m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) (k : ℕ) ((m : ℕ) % (k : ℕ)) :=
begin
  dsimp [mod, mod_div],
  cases (m : ℕ) % (k : ℕ),
  { rw [if_pos rfl], refl },
  { rw [if_neg n.succ_ne_zero], refl }
end

theorem div_coe (m k : ℕ+) :
 ((div m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) ((m : ℕ) / (k : ℕ)).pred ((m : ℕ) / (k : ℕ)) :=
begin
  dsimp [div, mod_div],
  cases (m : ℕ) % (k : ℕ),
  { rw [if_pos rfl], refl },
  { rw [if_neg n.succ_ne_zero], refl }
end

theorem mod_le (m k : ℕ+) : mod m k ≤ m ∧ mod m k ≤ k :=
begin
  change ((mod m k) : ℕ) ≤ (m : ℕ) ∧ ((mod m k) : ℕ) ≤ (k : ℕ),
  rw [mod_coe], split_ifs,
  { have hm : (m : ℕ) > 0 := m.pos,
    rw [← nat.mod_add_div (m : ℕ) (k : ℕ), h, zero_add] at hm ⊢,
    by_cases h' : ((m : ℕ) / (k : ℕ)) = 0,
    { rw [h', mul_zero] at hm, exact (lt_irrefl _ hm).elim},
    { let h' := nat.mul_le_mul_left (k : ℕ)
             (nat.succ_le_of_lt (nat.pos_of_ne_zero h')),
      rw [mul_one] at h', exact ⟨h', le_refl (k : ℕ)⟩ } },
  { exact ⟨nat.mod_le (m : ℕ) (k : ℕ), le_of_lt (nat.mod_lt (m : ℕ) k.pos)⟩ }
end

theorem dvd_iff {k m : ℕ+} : k ∣ m ↔ (k : ℕ) ∣ (m : ℕ) :=
begin
  split; intro h, rcases h with ⟨_, rfl⟩, apply dvd_mul_right,
  rcases h with ⟨a, h⟩, cases a, { contrapose h, apply ne_zero, },
  use a.succ, apply nat.succ_pos, rw [← coe_inj, h, mul_coe, mk_coe],
end

theorem dvd_iff' {k m : ℕ+} : k ∣ m ↔ mod m k = k :=
begin
  rw dvd_iff,
  rw [nat.dvd_iff_mod_eq_zero], split,
  { intro h, apply eq, rw [mod_coe, if_pos h] },
  { intro h, by_cases h' : (m : ℕ) % (k : ℕ) = 0,
    { exact h'},
    { replace h : ((mod m k) : ℕ) = (k : ℕ) := congr_arg _ h,
      rw [mod_coe, if_neg h'] at h,
      exact (ne_of_lt (nat.mod_lt (m : ℕ) k.pos) h).elim } }
end

lemma le_of_dvd {m n : ℕ+} : m ∣ n → m ≤ n :=
by { rw dvd_iff', intro h, rw ← h, apply (mod_le n m).left }

/-- If `h : k | m`, then `k * (div_exact m k) = m`. Note that this is not equal to `m / k`. -/
def div_exact (m k : ℕ+) : ℕ+ :=
 ⟨(div m k).succ, nat.succ_pos _⟩

theorem mul_div_exact {m k : ℕ+} (h : k ∣ m) : k * (div_exact m k) = m :=
begin
 apply eq, rw [mul_coe],
 change (k : ℕ) * (div m k).succ = m,
 rw [← div_add_mod m k, dvd_iff'.mp h, nat.mul_succ]
end

theorem dvd_one_iff (n : ℕ+) : n ∣ 1 ↔ n = 1 :=
 ⟨λ h, dvd_antisymm h (one_dvd n), λ h, h.symm ▸ (dvd_refl 1)⟩

lemma pos_of_div_pos {n : ℕ+} {a : ℕ} (h : a ∣ n) : 0 < a :=
begin
  apply pos_iff_ne_zero.2,
  intro hzero,
  rw hzero at h,
  exact pnat.ne_zero n (eq_zero_of_zero_dvd h)
end

end pnat

section can_lift

instance nat.can_lift_pnat : can_lift ℕ ℕ+ :=
⟨coe, λ n, 0 < n, λ n hn, ⟨nat.to_pnat' n, pnat.to_pnat'_coe hn⟩⟩

instance int.can_lift_pnat : can_lift ℤ ℕ+ :=
⟨coe, λ n, 0 < n, λ n hn, ⟨nat.to_pnat' (int.nat_abs n),
  by rw [coe_coe, nat.to_pnat'_coe, if_pos (int.nat_abs_pos_of_ne_zero (ne_of_gt hn)),
    int.nat_abs_of_nonneg hn.le]⟩⟩

end can_lift


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import tactic -- importa todas las tácticas de Lean

/-!
# Lógica proposicional en Lean

`P : Prop` significa que `P` es una proposición.
`h : P` significa que `h` es una demostración de que `P` es cierta.

En el apartado `Tactic state` de la ventana `Lean infoview`, detrás del símbolo `⊢` se muestra
el resultado que queremos demostrar. Encima de dicha línea tenemos las hipótesis activas.

Lean 3 utiliza la siguente notación para las conectivas lógicas:
* `→` ("implica" -- escrito `\l`)
* `¬` ("no" -- escrito  `\not` o `\n`)
* `∧` ("y" -- escrito  `\and` o `\an`)
* `↔` ("si y sólo si" -- escrito  `\iff` o `\lr`)
* `∨` ("o" -- escrito  `\or` o `\v`

NOTA: en VSCode, para saber cómo se ha escrito un símbolo UNICODE, basta dejar el cursor
sobre él.

# Tácticas
Para completar los ejercicios, será necesario utlizar las siguientes tácticas de Lean, cuyo
funcionamiento se describe en el fichero `tacticas.lean`. Los ejercicios de la primera sección
pueden resolverse utilizando exclusivamente `intro`, `exact`, y `apply`. En los comentarios al
inicio de cada sección se indica qué nuevas tácticas son necesarias.

* `intro`
* `exact`
* `apply`
* `triv`
* `exfalso`
* `change`
* `by_contra`
* `cases`
* `split`
* `refl`
* `rw`
* `have`
* `left`
* `right`

-/

-- `P`, `Q`, `R` y `S` denotan proposiciones.
variables (P Q R S : Prop)

/- Convención: utilizaremos variables cuyo nombre comienza por with `h` (como `hP` or `h1`) para
demostraciones o hipótesis. -/

/-
## Implicación
La táctica `sorry` se utiliza para evitar el error que de otro modo produce Lean cuando no
aportamos la demostración de un resultado.

En los ejemplos siguientes, reemplaza el `sorry` por una demostración que utilice las tácticas
`intro`, `exact` y `apply`. Recuerda añadir una coma al final de cada instrucción.
-/
section implicacion

/-- Toda proposición se sigue de sí misma -/
example : P → P :=
begin
  sorry
end

/- NOTA: La convención en Lean es que `P → Q → R` significa `P → (Q → R)` (es decir, los
paréntesis implícitos asocian por la derecha).

En particular, en este ejemplo se nos pide demostrar `P → (Q → P)`.

Como consejo general, si no estamos seguros de si una cierta operación se está asociando por la
derecha o por la izquierda, podemos consultarlo pasando el cursor sobre la línea correspondiente
en el `Tactic state`.
-/
example : P → Q → P :=
begin
  sorry
end

/-- "Modus Ponens": dado `P` y `P → Q`, podemos deducir `Q`. -/
lemma modus_ponens : P → (P → Q) → Q :=
begin
  sorry
end

/-- `→` es transitiva. Es decir, si `P → Q` y `Q → R` son verdaderas, `P → R` también. -/
example : (P → Q) → (Q → R) → (P → R) :=
begin
  sorry,
end

example : (P → Q → R) → (P → Q) → (P → R) :=
begin
  sorry
end

/-
Termina los ejemplos de esta sección si quieres más práctica con `intro`, `exact` y `apply`; de lo
contrario, puedes pasar a la sección `verdadero_falso`.
-/

example : (P → Q) → ((P → Q) → P) → Q :=
begin
  sorry
end

example : ((P → Q) → R) → ((Q → R) → P) → ((R → P) → Q) → P :=
begin
  sorry
end

example : ((Q → P) → P) → (Q → R) → (R → P) → P :=
begin
  sorry
end

example : (((P → Q) → Q) → Q) → (P → Q) :=
begin
  sorry
end

example :
  (((P → Q → Q) → ((P → Q) → Q)) → R) →
  ((((P → P) → Q) → (P → P → Q)) → R) →
  (((P → P → Q) → ((P → P) → Q)) → R) → R :=
begin
  sorry
end

end implicacion

section verdadero_falso

/-!
# Verdadero y falso
Introducimos dos nuevas tácticas:
* `triv`: demuestra `⊢ true`.
* `exfalso`: sustituye el resultado a probar por `false`.
-/
example : true :=
begin
  sorry
end

example : true → true :=
begin
  sorry
end

example : false → true :=
begin
  sorry
end

example : false → false :=
begin
  sorry
end

example : (true → false) → false :=
begin
  sorry
end

example : false → P :=
begin
  sorry
end

example : true → false → true → false → true → false :=
begin
  sorry
end

example : P → ((P → false) → false) :=
begin
  sorry
end

example : (P → false) → P → Q :=
begin
  sorry
end

example : (true → false) → P :=
begin
  sorry
end

end verdadero_falso

section negacion

/-!
# Negación
En Lean, `¬ P` *está definido como* `P → false`. Por tanto, `¬ P` y `P → false`
son *iguales por definición* (hablaremos de esto más adelante en el curso).

Las siguientes tácticas podrían ser útiles en esta sección:
* `change`
* `by_contra`
-/

example : ¬ true → false :=
begin
  sorry
end

example : false → ¬ true :=
begin
  sorry
end

example : ¬ false → true :=
begin
  sorry
end

example : true → ¬ false :=
begin
  sorry
end

example : false → ¬ P :=
begin
  sorry
end

example : P → ¬ P → false :=
begin
  sorry
end

example : P → ¬ (¬ P) :=
begin
  sorry
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  sorry
end

example : ¬ ¬ false → false :=
begin
  sorry
end

example : ¬ ¬ P → P :=
begin
  sorry
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  sorry,
end

end negacion

section conjuncion

/-!
# Conjunción
Añadimos las tácticas:
* `cases`
* `split`
-/

example : P ∧ Q → P :=
begin
  sorry
end

example : P ∧ Q → Q :=
begin
  sorry
end

example : (P → Q → R) → (P ∧ Q → R) :=
begin
  sorry
end

example : P → Q → P ∧ Q :=
begin
  sorry
end

/-- `∧` es simétrica. -/
example : P ∧ Q → Q ∧ P :=
begin
  sorry
end

example : P → P ∧ true :=
begin
  sorry
end

example : false → P ∧ false :=
begin
  sorry
end

/-- `∧` es transitiva. -/
example : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  sorry,
end

example : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  sorry,
end

end conjuncion

section doble_implicacion

/-!
# Doble implicación
Nuevas tácticas:
* `refl`
* `rw`
* `have`
-/

example : P ↔ P :=
begin
  sorry
end

example : (P ↔ Q) → (Q ↔ P) :=
begin
  sorry
end

example : (P ↔ Q) ↔ (Q ↔ P) :=
begin
  sorry
end

example : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  sorry
end

example : P ∧ Q ↔ Q ∧ P :=
begin
  sorry
end

example : ((P ∧ Q) ∧ R) ↔ (P ∧ (Q ∧ R)) :=
begin
  sorry
end

example : P ↔ (P ∧ true) :=
begin
  sorry
end

example : false ↔ (P ∧ false) :=
begin
  sorry
end

example : (P ↔ Q) → (R ↔ S) → (P ∧ R ↔ Q ∧ S) :=
begin
  sorry
end

/- Una forma de demostrar este teorema es utilizando `by_cases hP : P`. Sin embargo, también es
posible dar una demostración constructiva, utilizando la táctica `have`. -/
example : ¬ (P ↔ ¬ P) :=
begin
  sorry,
end

end doble_implicacion

section disyuncion

/-!
# Disyunción
Nuevas tácticas
* `left` y `right`
* `cases` (nueva funcionalidad)
-/

example : P → P ∨ Q :=
begin
  sorry
end

example : Q → P ∨ Q :=
begin
  sorry,
end

example : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  sorry
end

/- `∨` es simétrica. -/
example : P ∨ Q → Q ∨ P :=
begin
  sorry
end

/- `∨` es asociativa. -/
example : (P ∨ Q) ∨ R ↔ P ∨ (Q ∨ R) :=
begin
  sorry,
end

example : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  sorry,
end

example : (P → Q) → P ∨ R → Q ∨ R :=
begin
  sorry,
end

example : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  sorry,
end

-- Leyes de de Morgan.
example : ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
begin
  sorry
end

example : ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
begin
  sorry
end

end disyuncion


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

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

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

open real

lemma abs_eq_one_of_pow_eq_one (x : ℝ) (n : ℕ) (hn : n ≠ 0) (h : x ^ n = 1) : abs x = 1 :=
begin
  let x₀ := nnreal.of_real (abs x),
  have h' : (abs x) ^ n = 1, { rwa [pow_abs, h, abs_one] },
  have : (x₀ : ℝ) ^ n = 1, rw (nnreal.coe_of_real (abs x) (abs_nonneg x)), exact h',
  have : x₀ = 1 := eq_one_of_pow_eq_one hn (show x₀ ^ n = 1, by assumption_mod_cast),
  rwa ← nnreal.coe_of_real (abs x) (abs_nonneg x), assumption_mod_cast,
end

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

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

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

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

    have h1 : (2 * x) * ((f(x) - x) * (f(x) - 1 / x)) = 0,
    { calc  (2 * x) * ((f(x) - x) * (f(x) - 1 / x))
          = 2 * (f(x) - x) * (x * f(x) - x * 1 / x) : by ring
      ... = 2 * (f(x) - x) * (x * f(x) - 1) : by rw (mul_div_cancel_left 1 hx_ne_0)
      ... = ((1 + f(x) ^ 2) * (2 * x) - (1 + x ^ 2) * (2 * f(x))) : by ring
      ... = 0 : sub_eq_zero.mpr H₂ },

    have h2x_ne_0 : 2 * x ≠ 0 := mul_ne_zero two_ne_zero hx_ne_0,

    calc  ((f(x) - x) * (f(x) - 1 / x))
        = (2 * x) * ((f(x) - x) * (f(x) - 1 / x)) / (2 * x) : (mul_div_cancel_left _ h2x_ne_0).symm
    ... = 0 : by { rw h1, exact zero_div (2 * x) } },

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

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

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

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

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

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

  -- f(ab) = ab → b^4 = 1 → b = 1 → f(b) = b → false
  { rw hab₁ at H₂, field_simp at H₂,
    obtain hb₁ := or.resolve_right H₂ h2ab_ne_0,
    field_simp [ne_of_gt hb] at hb₁,
    rw (show b ^ 2 * b ^ 2 = b ^ 4, by ring) at hb₁,
    obtain hb₂ := abs_eq_one_of_pow_eq_one b 4 (show 4 ≠ 0, by norm_num) hb₁.symm,
    rw abs_of_pos hb at hb₂, rw hb₂ at hfb₁, exact hfb₁ h₁ },

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


import topology.metric_space.hausdorff_distance

open set metric
open_locale topology

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

namespace metric

lemma thickening_ball (x : α) (ε δ : ℝ) : thickening ε (ball x δ) ⊆ ball x (ε + δ) :=
begin
  intro y,
  simp only [mem_thickening_iff, mem_ball],
  rintros ⟨z, hz, hz'⟩,
  calc dist y x ≤ dist y z + dist z x : dist_triangle _ _ _
  ... < ε + δ :  add_lt_add hz' hz
end

lemma inf_dist_pos_iff_not_mem_closure {x : α} {s : set α} (hs : s.nonempty) :
  0 < inf_dist x s ↔ x ∉ closure s :=
by rw [is_closed_closure.not_mem_iff_inf_dist_pos hs.closure, inf_dist_eq_closure]

end metric
open metric

lemma is_compact.exists_thickening_image {f : α → β} {K : set α} {U : set β}
  (hK : is_compact K) (ho : is_open U) (hf : continuous f) (hKU : maps_to f K U) :
  ∃ (ε > 0) (V ∈ 𝓝ˢ K), thickening ε (f '' V) ⊆ U :=
begin
  rcases (hK.image hf).exists_thickening_subset_open ho hKU.image_subset with ⟨r, hr₀, hr⟩,
  refine ⟨r / 2, half_pos hr₀, f ⁻¹' (thickening (r / 2) (f '' K)),
    (is_open_thickening.preimage hf).mem_nhds_set.2 $ image_subset_iff.mp $
      self_subset_thickening (half_pos hr₀) _, _⟩,
  calc thickening (r / 2) (f '' (f ⁻¹' thickening (r / 2) (f '' K)))
     ⊆ thickening (r / 2) (thickening (r / 2) (f '' K)) :
    thickening_subset_of_subset _ (image_preimage_subset _ _)
  ... ⊆ thickening (r / 2 + r / 2) (f '' K) : thickening_thickening_subset _ _ _
  ... = thickening r (f '' K) : by rw [add_halves]
  ... ⊆ U : hr
end


import tactic
import data.fintype.card

/-!
# Bits, Binary Words, and Binary Word Matrices

This file contains definitions of bits `B`, binary words `BW`,
and binary word matrices `BWM`.

## Notation

- `O` and `I` for bits 0 and 1.
- `::ᴮ` for the cons constructor for binary words.
- `ᴮ[]` for writing binary words as lists of bits.
- `::ᴹ` for the cons contructor for binary word matrices.
- `ᴹ[]` for writing binary word matrices as lists of binary words.
-/

@[derive decidable_eq]
inductive B : Type
| O : B
| I : B

namespace B

instance : fintype B :=
{
  elems := {O, I},
  complete := by {intro x, simp, cases x, {left, refl}, {right, refl}}
}
@[simp]
lemma card_b : fintype.card B = 2 := rfl

def repr : B → string
| O := "0"
| I := "1"
instance : has_repr B := ⟨repr⟩

@[simp]
lemma O_ne_I : O = I → false :=
λ h, by contradiction
@[simp]
lemma I_ne_O : I = O → false :=
λ h, by contradiction

def add : B → B → B
| I I := O
| O x := x
| x O := x

def mul : B → B → B
| I I := I
| _ _ := O

instance : field B :=
{
  add := add,
  add_assoc := λ a b c, by {cases a; cases b; cases c; refl},
  zero := O,
  zero_add := λ a, by {cases a; refl},
  add_zero := λ a, by {cases a; refl},
  neg := λ x, x,
  sub := λ x, add x,
  sub_eq_add_neg := λ a b, rfl,
  add_left_neg := λ a, by {cases a; refl},
  add_comm := λ a b, by {cases a; cases b; refl},
  mul := mul,
  mul_assoc := λ a b c, by {cases a; cases b; cases c; refl},
  one := I,
  one_mul := λ a, by {cases a; refl},
  mul_one := λ a, by {cases a; refl},
  left_distrib :=  λ a b c, by {cases a; cases b; cases c; refl},
  right_distrib :=  λ a b c, by {cases a; cases b; cases c; refl},
  mul_comm :=  λ a b, by {cases a; cases b; refl},
  inv := λ x, x,
  exists_pair_ne := ⟨O, ⟨I, O_ne_I⟩⟩,
  mul_inv_cancel := begin
    intros a h,
    cases a,
      {contradiction},
      {refl}
  end,
  inv_zero := rfl,
}

def flip : B → B
| O := I
| I := O

def to_nat : B → ℕ
| O := 0
| I := 1

end B

@[derive decidable_eq]
inductive BW : ℕ → Type
| nil : BW 0
| cons {n : ℕ} (b : B) (bw : BW n) : BW (n + 1)

namespace BW
open B

notation h `::ᴮ` t := cons h t
notation `ᴮ[` bw:(foldr `,` (h t, cons h t) nil) `]` := bw

def repr : Π {n : ℕ}, BW n → string
| _   nil         := ""
| _   (hd ::ᴮ tl)  := hd.repr ++ (repr tl)
instance {n : ℕ} : has_repr (BW n) := ⟨BW.repr⟩

def length : Π {n : ℕ}, BW n → ℕ
| n _ := n

@[simp]
lemma nil_unique (x : BW 0) : x = BW.nil := by {cases x; refl}

private
def reverse' : Π {n i : ℕ}, BW n → BW i → BW (n + i)
| 0 i nil acc := by {simp, exact acc}
| (m+1) i (hd::ᴮtl) acc := by {rw nat.add_assoc, rw nat.one_add, apply reverse' tl (hd::ᴮacc)}

def reverse : Π {n : ℕ}, BW n → BW n := λ (n : ℕ) (bwn : BW (n - 0)), reverse' bwn nil

def add : Π {n : ℕ}, BW n → BW n → BW n
| _ nil nil := nil
| _ (hd₁::ᴮtl₁) (hd₂::ᴮtl₂) := (hd₁ + hd₂) ::ᴮ (add tl₁ tl₂)

def intersection : Π {n : ℕ}, BW n → BW n → BW n
| _ nil nil := nil
| _ (hd₁::ᴮtl₁) (hd₂::ᴮtl₂) := (hd₁ * hd₂) ::ᴮ (intersection tl₁ tl₂)

notation bw₁ `∩` bw₂ := intersection bw₁ bw₂

def dot_product :  Π {n : ℕ}, BW n → BW n → B
| _ nil         nil        := O
| _ (hd₁::ᴮtl₁) (hd₂::ᴮtl₂) := (hd₁ * hd₂) + (dot_product tl₁ tl₂)

notation bw₁ `⬝` bw₂ := dot_product bw₁ bw₂

def zero : Π (n : ℕ), BW n
| 0       := nil
| (m + 1) := O ::ᴮ zero m

def to_nat : Π {n : ℕ}, BW n → ℕ
| _     nil       := 0
| (m+1) (hd::ᴮtl) := (hd.to_nat * 2 ^ m) + tl.to_nat

-- This function is no longer used, but kept here for reference.
def flip : Π {n : ℕ} (i : ℕ), i ≤ n → BW n → BW n
| _ _     _ nil       := nil
| _ 0     _ (hd::ᴮtl) := hd ::ᴮ tl
| _ 1     _ (hd::ᴮtl) := hd.flip ::ᴮ tl
| _ (i+1) h (hd::ᴮtl) := hd ::ᴮ (flip i (nat.le_of_succ_le_succ h) tl)

@[simp]
lemma add_hds {n : ℕ} (hd₁ hd₂ : B) (tl₁ tl₂ : BW n) :
  add (hd₁::ᴮtl₁) (hd₂::ᴮtl₂) = ((hd₁ + hd₂)::ᴮ(add tl₁ tl₂)) :=
rfl

instance : Π {n : ℕ}, add_comm_group (BW n) :=
λ n, {
  add := add,
  add_assoc := begin
    intros a b c,
    induction a with m hda tla ih,
      {rw nil_unique b, rw nil_unique c, refl},
    cases b with _ hdb tlb,
    cases c with _ hdc tlc,
    simp,
    split,
      {conv {to_lhs, apply_congr add_assoc}},
      {simp at ih, apply ih}
  end,
  zero := zero n,
  zero_add := begin
    intro a,
    induction a with m hda tla ih,
      {refl},
    simp at *, rw zero,
    cases hda;
      {conv {to_lhs, apply_congr add_hds}, conv {to_lhs, congr, {whnf}, {apply_congr ih}}},
  end,
  add_zero := begin
    intro a,
    induction a with m hda tla ih,
      {refl},
    simp at *, rw zero,
    cases hda;
      {conv {to_lhs, apply_congr add_hds}, conv {to_lhs, congr, {whnf}, {apply_congr ih}}},
  end,
  neg := λ x, x,
  sub := λ x, add x,
  sub_eq_add_neg := λ x y, rfl,
  add_left_neg := begin
    intro a,
    induction a with m hda tla ih,
      {refl},
    conv {to_lhs, apply_congr add_hds},
    conv {to_lhs, congr, skip, apply_congr ih},
    cases hda; refl,
  end,
  add_comm := begin
    intros a b,
    induction a with m hda tla ih,
      {rw nil_unique b,},
    cases b with _ hdb tlb,
    cases hda; cases hdb;
    {conv {to_lhs, apply_congr add_hds},
    conv {to_lhs, congr, {whnf}, {apply_congr ih}},
    conv {to_rhs, apply_congr add_hds},
    conv {to_rhs, congr, {whnf}},
    refl}
  end,
}

def smul : Π {n : ℕ}, B → BW n → BW n
| _ _ nil := nil
| _ b (hd::ᴮtl) := (b * hd)::ᴮ(smul b tl)

instance : Π {n : ℕ}, vector_space B (BW n) :=
λ n, {
  smul := smul,
  one_smul := begin
    intro b,
    induction b with m hdb tlb ih,
      {refl},
    simp, rw smul,
    conv {to_lhs, congr, skip, apply_congr ih},
    cases hdb; refl,
  end,
  mul_smul := begin
    intros x y b,
    induction b with m hdb tlb ih,
      {refl},
    simp, rw smul,
    conv {to_lhs, congr, skip, apply_congr ih},
    cases x; cases y; cases hdb; refl,
  end,
  smul_add := begin
    intros r x y,
    induction y with m hdy tly ih,
      {rw nil_unique x, refl},
    cases x with _ hdx tlx,
    simp,
    conv {to_lhs, congr, skip, apply_congr add_hds},
    rw smul,
    conv {to_lhs, congr, skip, apply_congr ih},
    cases r; cases hdx; cases hdy; refl,
  end,
  smul_zero := begin
    intro r,
    simp,
    induction n with m ih,
      {refl},
    conv {to_lhs, whnf, congr, skip, apply_congr ih},
    cases r; refl,
  end,
  add_smul := begin
    intros r s x,
    induction x with m hdx tlx ih,
      {refl},
    simp, rw smul,
    conv {to_lhs, congr, skip, apply_congr ih},
    cases r; cases s; cases hdx; refl,
  end,
  zero_smul := begin
    intro x,
    induction x with m hdx tlx ih,
      {refl},
    simp, rw smul,
    conv {to_lhs, congr, skip, apply_congr ih},
    cases hdx; refl,
  end,
}

/-!
The remainder of this section establishes various equivalences between `BW n` and `vector B n`.
We use these equivalences to establish `fintype (BW n)` and `fintype.card (BW n) = 2 ^ n`.
-/

def vector_to_bw : Π {n : ℕ}, vector B n → BW n
| 0     ⟨[],     _⟩ := nil
| (n+1) ⟨hd::tl, h⟩ := cons hd (vector_to_bw ⟨tl, by {simp at h, exact h}⟩)

lemma vector_to_bw_injective : Π {n : ℕ}, function.injective (@vector_to_bw n) :=
begin
  intros n x y h,
  induction n with k ih,
    {simp},
  cases x with xl hx,
  cases xl with xhd xtl,
    {simp at hx, contradiction},
  cases y with yl hy,
  cases yl with yhd ytl,
    {simp at hy, contradiction},
  repeat {rw vector_to_bw at h},
  simp at h, cases h with h_left h_right, rw h_left,
  simp, specialize ih h_right, simp at ih, exact ih,
end

lemma vector_to_bw_surjective : Π {n : ℕ}, function.surjective (@vector_to_bw n) :=
begin
  intros n b,
  induction n with k ih,
    {use vector.nil, rw nil_unique b, refl},
  cases b with _ bhd btl,
  specialize ih btl,
  cases ih with a_ih ih,
  cases a_ih with al_ih h_a_ih,
  have : (bhd::al_ih).length = k.succ, by {rw list.length_cons, rw h_a_ih},
  use ⟨bhd::al_ih, this⟩,
  rw vector_to_bw, simp, exact ih,
end

lemma vector_to_bw_bijective : Π {n : ℕ}, function.bijective (@vector_to_bw n) :=
λ n, ⟨vector_to_bw_injective, vector_to_bw_surjective⟩

instance : Π {n : ℕ}, fintype (BW n) :=
λ n, fintype.of_bijective vector_to_bw vector_to_bw_bijective

def bw_to_vector : Π {n : ℕ}, BW n → vector B n
| 0     nil       := vector.nil
| (n+1) (hd::ᴮtl) := hd ::ᵥ bw_to_vector tl

def bw_to_vector_inv : Π {n : ℕ}, vector B n → BW n
| 0     _ := nil
| (n+1) v := (vector.head v) ::ᴮ (bw_to_vector_inv (vector.tail v))

lemma left_inv :
  Π {n : ℕ} (x : BW n), bw_to_vector_inv (bw_to_vector x) = x
| 0     nil       := by rw [bw_to_vector, bw_to_vector_inv]
| (n+1) (hd::ᴮtl) := by {rw [bw_to_vector, bw_to_vector_inv], simp, exact left_inv tl}

lemma right_inv :
  Π {n : ℕ} (x : vector B n), bw_to_vector (bw_to_vector_inv x) = x
| 0     v := by rw [bw_to_vector_inv, bw_to_vector, vector.eq_nil v]
| (n+1) v := by rw [bw_to_vector_inv, bw_to_vector, right_inv v.tail, vector.cons_head_tail]

def vector_bw_equiv : Π {n : ℕ}, equiv (BW n) (vector B n) :=
λ n,
{
  to_fun := bw_to_vector,
  inv_fun := bw_to_vector_inv,
  left_inv := left_inv,
  right_inv := right_inv,
}

lemma card_bw_eq_card_vector {n : ℕ} : fintype.card (BW n) = fintype.card (vector B n) :=
by {apply fintype.card_congr, exact vector_bw_equiv}

@[simp]
lemma card_bw {n : ℕ} : fintype.card (BW n) = 2 ^ n :=
by {rw card_bw_eq_card_vector, simp}

end BW

inductive BWM (n : ℕ) : ℕ → Type
| nil : BWM nat.zero
| cons {m : ℕ} (bw : BW n) (bwm : BWM m) : BWM m.succ

namespace BWM

notation h`::ᴹ` t := cons h t
notation `ᴹ[` bwm:(foldr `,` (h t, cons h t) nil) `]` := bwm

def repr : Π {n m : ℕ}, BWM n m → string
| _ _ nil       := ""
| _ _ (hd ::ᴹ tl) := hd.repr ++ "\n" ++ (repr tl)
instance {n m : ℕ} : has_repr (BWM n m) := ⟨BWM.repr⟩

def length : Π {n m : ℕ}, BWM n m → ℕ
| n _ _ := n

def size : Π {n m : ℕ}, BWM n m → ℕ
| _ m _ := m

def r_mul : Π {n m : ℕ}, BWM n m → BW n → BW m
| _ 0 nil         _  := BW.nil
| n m (hd ::ᴹ tl) bw := (hd ⬝ bw) ::ᴮ (r_mul tl bw)

notation bwm `×` bw := r_mul bwm bw

end BWM


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

import algebra.associated
import data.int.units

/-!
# Associated elements and the integers

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

This file contains some results on equality up to units in the integers.

## Main results

 * `int.nat_abs_eq_iff_associated`: the absolute value is equal iff integers are associated
-/

lemma int.nat_abs_eq_iff_associated {a b : ℤ} :
  a.nat_abs = b.nat_abs ↔ associated a b :=
begin
  refine int.nat_abs_eq_nat_abs_iff.trans _,
  split,
  { rintro (rfl | rfl),
    { refl },
    { exact ⟨-1, by simp⟩ } },
  { rintro ⟨u, rfl⟩,
    obtain (rfl | rfl) := int.units_eq_one_or u,
    { exact or.inl (by simp) },
    { exact or.inr (by simp) } }
end


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Mario Carneiro

Type of bounded continuous functions taking values in a metric space, with
the uniform distance.
 -/

import analysis.normed_space.basic topology.metric_space.cau_seq_filter
       topology.metric_space.lipschitz topology.instances.real

noncomputable theory
local attribute [instance] classical.decidable_inhabited classical.prop_decidable

open set lattice filter metric

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

/-- A locally uniform limit of continuous functions is continuous -/
lemma continuous_of_locally_uniform_limit_of_continuous [topological_space α] [metric_space β]
  {F : ℕ → α → β} {f : α → β}
  (L : ∀x:α, ∃s ∈ nhds x, ∀ε>(0:ℝ), ∃n, ∀y∈s, dist (F n y) (f y) ≤ ε)
  (C : ∀ n, continuous (F n)) : continuous f :=
continuous_iff'.2 $ λ x ε ε0, begin
  rcases L x with ⟨r, rx, hr⟩,
  rcases hr (ε/2/2) (half_pos $ half_pos ε0) with ⟨n, hn⟩,
  rcases continuous_iff'.1 (C n) x (ε/2) (half_pos ε0) with ⟨s, sx, hs⟩,
  refine ⟨_, (nhds x).inter_sets rx sx, _⟩,
  rintro y ⟨yr, ys⟩,
  calc dist (f y) (f x)
        ≤ dist (F n y) (F n x) + (dist (F n y) (f y) + dist (F n x) (f x)) : dist_triangle4_left _ _ _ _
    ... < ε/2 + (ε/2/2 + ε/2/2) :
      add_lt_add_of_lt_of_le (hs _ ys) (add_le_add (hn _ yr) (hn _ (mem_of_nhds rx)))
    ... = ε : by rw [add_halves, add_halves]
end

/-- A uniform limit of continuous functions is continuous -/
lemma continuous_of_uniform_limit_of_continuous [topological_space α] {β : Type v} [metric_space β]
  {F : ℕ → α → β} {f : α → β} (L : ∀ε>(0:ℝ), ∃N, ∀y, dist (F N y) (f y) ≤ ε) :
  (∀ n, continuous (F n)) → continuous f :=
continuous_of_locally_uniform_limit_of_continuous $ λx,
  ⟨univ, by simpa [filter.univ_mem_sets] using L⟩

/-- The type of bounded continuous functions from a topological space to a metric space -/
def bounded_continuous_function (α : Type u) (β : Type v) [topological_space α] [metric_space β] : Type (max u v) :=
{f : α → β // continuous f ∧ ∃C, ∀x y:α, dist (f x) (f y) ≤ C}

local infixr ` →ᵇ `:25 := bounded_continuous_function

namespace bounded_continuous_function
section basics
variables [topological_space α] [metric_space β] [metric_space γ]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

instance : has_coe_to_fun (α →ᵇ β) :=  ⟨_, subtype.val⟩

lemma bounded_range : bounded (range f) :=
bounded_range_iff.2 f.2.2

/-- If a function is continuous on a compact space, it is automatically bounded,
and therefore gives rise to an element of the type of bounded continuous functions -/
def mk_of_compact [compact_space α] (f : α → β) (hf : continuous f) : α →ᵇ β :=
⟨f, hf, bounded_range_iff.1 $ by rw ← image_univ; exact
  bounded_of_compact (compact_image compact_univ hf)⟩

/-- If a function is bounded on a discrete space, it is automatically continuous,
and therefore gives rise to an element of the type of bounded continuous functions -/
def mk_of_discrete [discrete_topology α] (f : α → β) (hf : ∃C, ∀x y, dist (f x) (f y) ≤ C) :
  α →ᵇ β :=
⟨f, continuous_of_discrete_topology, hf⟩

/-- The uniform distance between two bounded continuous functions -/
instance : has_dist (α →ᵇ β) :=
⟨λf g, Inf {C | C ≥ 0 ∧ ∀ x : α, dist (f x) (g x) ≤ C}⟩

lemma dist_eq : dist f g = Inf {C | C ≥ 0 ∧ ∀ x : α, dist (f x) (g x) ≤ C} := rfl

lemma dist_set_exists : ∃ C, C ≥ 0 ∧ ∀ x : α, dist (f x) (g x) ≤ C :=
begin
  refine if h : nonempty α then _ else ⟨0, le_refl _, λ x, h.elim ⟨x⟩⟩,
  cases h with x,
  rcases f.2 with ⟨_, Cf, hCf⟩, /- hCf : ∀ (x y : α), dist (f.val x) (f.val y) ≤ Cf -/
  rcases g.2 with ⟨_, Cg, hCg⟩, /- hCg : ∀ (x y : α), dist (g.val x) (g.val y) ≤ Cg -/
  let C := max 0 (dist (f x) (g x) + (Cf + Cg)),
  exact ⟨C, le_max_left _ _, λ y, calc
    dist (f y) (g y) ≤ dist (f x) (g x) + (dist (f x) (f y) + dist (g x) (g y)) : dist_triangle4_left _ _ _ _
                ... ≤ dist (f x) (g x) + (Cf + Cg) : add_le_add_left (add_le_add (hCf _ _) (hCg _ _)) _
                ... ≤ C : le_max_right _ _⟩
end

/-- The pointwise distance is controlled by the distance between functions, by definition -/
lemma dist_coe_le_dist (x : α) : dist (f x) (g x) ≤ dist f g :=
le_cInf (ne_empty_iff_exists_mem.2 dist_set_exists) $ λb hb, hb.2 x

@[extensionality] lemma ext (H : ∀x, f x = g x) : f = g :=
subtype.eq $ by ext; apply H

/- This lemma will be needed in the proof of the metric space instance, but it will become
useless afterwards as it will be superceded by the general result that the distance is nonnegative
is metric spaces. -/
private lemma dist_nonneg' : 0 ≤ dist f g :=
le_cInf (ne_empty_iff_exists_mem.2 dist_set_exists) (λ C, and.left)

/-- The distance between two functions is controlled by the supremum of the pointwise distances -/
lemma dist_le (C0 : (0 : ℝ) ≤ C) : dist f g ≤ C ↔ ∀x:α, dist (f x) (g x) ≤ C :=
⟨λ h x, le_trans (dist_coe_le_dist x) h, λ H, cInf_le ⟨0, λ C, and.left⟩ ⟨C0, H⟩⟩

/-- On an empty space, bounded continuous functions are at distance 0 -/
lemma dist_zero_of_empty (e : ¬ nonempty α) : dist f g = 0 :=
le_antisymm ((dist_le (le_refl _)).2 $ λ x, e.elim ⟨x⟩) dist_nonneg'

/-- The type of bounded continuous functions, with the uniform distance, is a metric space. -/
instance : metric_space (α →ᵇ β) :=
{ dist_self := λ f, le_antisymm ((dist_le (le_refl _)).2 $ λ x, by simp) dist_nonneg',
  eq_of_dist_eq_zero := λ f g hfg, by ext x; exact
    eq_of_dist_eq_zero (le_antisymm (hfg ▸ dist_coe_le_dist _) dist_nonneg),
  dist_comm := λ f g, by simp [dist_eq, dist_comm],
  dist_triangle := λ f g h,
    (dist_le (add_nonneg dist_nonneg' dist_nonneg')).2 $ λ x,
      le_trans (dist_triangle _ _ _) (add_le_add (dist_coe_le_dist _) (dist_coe_le_dist _)) }

def const (b : β) : α →ᵇ β := ⟨λx, b, continuous_const, 0, by simp [le_refl]⟩

/-- If the target space is inhabited, so is the space of bounded continuous functions -/
instance [inhabited β] : inhabited (α →ᵇ β) := ⟨const (default β)⟩

/-- The evaluation map is continuous, as a joint function of `u` and `x` -/
theorem continuous_eval : continuous (λ p : (α →ᵇ β) × α, p.1 p.2) :=
continuous_iff'.2 $ λ ⟨f, x⟩ ε ε0,
/- use the continuity of `f` to find a neighborhood of `x` where it varies at most by ε/2 -/
let ⟨s, sx, Hs⟩ := continuous_iff'.1 f.2.1 x (ε/2) (half_pos ε0) in
/- s : set α, sx : s ∈ nhds x, Hs : ∀ (b : α), b ∈ s → dist (f.val b) (f.val x) < ε / 2 -/
⟨set.prod (ball f (ε/2)) s, prod_mem_nhds_sets (ball_mem_nhds _ (half_pos ε0)) sx,
λ ⟨g, y⟩ ⟨hg, hy⟩, calc dist (g y) (f x)
      ≤ dist (g y) (f y) + dist (f y) (f x) : dist_triangle _ _ _
  ... < ε/2 + ε/2 : add_lt_add (lt_of_le_of_lt (dist_coe_le_dist _) hg) (Hs _ hy)
  ... = ε : add_halves _⟩

/-- In particular, when `x` is fixed, `f → f x` is continuous -/
theorem continuous_evalx {x : α} : continuous (λ f : α →ᵇ β, f x) :=
(continuous_id.prod_mk continuous_const).comp continuous_eval

/-- When `f` is fixed, `x → f x` is also continuous, by definition -/
theorem continuous_evalf {f : α →ᵇ β} : continuous f := f.2.1

/-- Bounded continuous functions taking values in a complete space form a complete space. -/
instance [complete_space β] : complete_space (α →ᵇ β) :=
complete_of_cauchy_seq_tendsto $ λ (f : ℕ → α →ᵇ β) (hf : cauchy_seq f),
begin
  /- We have to show that `f n` converges to a bounded continuous function.
  For this, we prove pointwise convergence to define the limit, then check
  it is a continuous bounded function, and then check the norm convergence. -/
  rcases cauchy_seq_iff_le_tendsto_0.1 hf with ⟨b, b0, b_bound, b_lim⟩,
  have f_bdd := λx n m N hn hm, le_trans (dist_coe_le_dist x) (b_bound n m N hn hm),
  have fx_cau : ∀x, cauchy_seq (λn, f n x) :=
    λx, cauchy_seq_iff_le_tendsto_0.2 ⟨b, b0, f_bdd x, b_lim⟩,
  choose F hF using λx, cauchy_seq_tendsto_of_complete (fx_cau x),
  /- F : α → β,  hF : ∀ (x : α), tendsto (λ (n : ℕ), f n x) at_top (nhds (F x))
  `F` is the desired limit function. Check that it is uniformly approximated by `f N` -/
  have fF_bdd : ∀x N, dist (f N x) (F x) ≤ b N :=
    λ x N, le_of_tendsto (by simp)
      (tendsto_dist tendsto_const_nhds (hF x))
      (filter.mem_at_top_sets.2 ⟨N, λn hn, f_bdd x N n N (le_refl N) hn⟩),
  refine ⟨⟨F, _, _⟩, _⟩,
  { /- Check that `F` is continuous -/
    refine continuous_of_uniform_limit_of_continuous (λ ε ε0, _) (λN, (f N).2.1),
    rcases metric.tendsto_at_top.1 b_lim ε ε0 with ⟨N, hN⟩,
    exact ⟨N, λy, calc
      dist (f N y) (F y) ≤ b N : fF_bdd y N
      ... ≤ dist (b N) 0 : begin simp, show b N ≤ abs(b N), from le_abs_self _ end
      ... ≤ ε : le_of_lt (hN N (le_refl N))⟩ },
  { /- Check that `F` is bounded -/
    rcases (f 0).2.2 with ⟨C, hC⟩,
    exact ⟨C + (b 0 + b 0), λ x y, calc
      dist (F x) (F y) ≤ dist (f 0 x) (f 0 y) + (dist (f 0 x) (F x) + dist (f 0 y) (F y)) : dist_triangle4_left _ _ _ _
         ... ≤ C + (b 0 + b 0) : add_le_add (hC x y) (add_le_add (fF_bdd x 0) (fF_bdd y 0))⟩ },
  { /- Check that `F` is close to `f N` in distance terms -/
    refine tendsto_iff_dist_tendsto_zero.2 (squeeze_zero (λ _, dist_nonneg) _ b_lim),
    exact λ N, (dist_le (b0 _)).2 (λx, fF_bdd x N) }
end

/-- Composition (in the target) of a bounded continuous function with a Lipschitz map again
gives a bounded continuous function -/
def comp (G : β → γ) (H : ∀x y, dist (G x) (G y) ≤ C * dist x y)
  (f : α →ᵇ β) : α →ᵇ γ :=
⟨λx, G (f x), f.2.1.comp (continuous_of_lipschitz H),
  let ⟨D, hD⟩ := f.2.2 in
  ⟨max C 0 * D, λ x y, calc
    dist (G (f x)) (G (f y)) ≤ C * dist (f x) (f y) : H _ _
    ... ≤ max C 0 * dist (f x) (f y) : mul_le_mul_of_nonneg_right (le_max_left C 0) dist_nonneg
    ... ≤ max C 0 * D : mul_le_mul_of_nonneg_left (hD _ _) (le_max_right C 0)⟩⟩

/-- The composition operator (in the target) with a Lipschitz map is continuous -/
lemma continuous_comp {G : β → γ} (H : ∀x y, dist (G x) (G y) ≤ C * dist x y) :
  continuous (comp G H : (α →ᵇ β) → α →ᵇ γ) :=
continuous_of_lipschitz $ λ f g,
(dist_le (mul_nonneg (le_max_right C 0) dist_nonneg)).2 $ λ x,
calc dist (G (f x)) (G (g x)) ≤ C * dist (f x) (g x) : H _ _
  ... ≤ max C 0 * dist (f x) (g x) : mul_le_mul_of_nonneg_right (le_max_left C 0) (dist_nonneg)
  ... ≤ max C 0 * dist f g : mul_le_mul_of_nonneg_left (dist_coe_le_dist _) (le_max_right C 0)

/-- Restriction (in the target) of a bounded continuous function taking values in a subset -/
def cod_restrict (s : set β) (f : α →ᵇ β) (H : ∀x, f x ∈ s) : α →ᵇ s :=
⟨λx, ⟨f x, H x⟩, continuous_subtype_mk _ f.2.1, f.2.2⟩

end basics

section arzela_ascoli
variables [topological_space α] [compact_space α] [metric_space β]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

/- Arzela-Ascoli theorem asserts that, on a compact space, a set of functions sharing
a common modulus of continuity and taking values in a compact set forms a compact
subset for the topology of uniform convergence. In this section, we prove this theorem
and several useful variations around it. -/

/-- First version, with pointwise equicontinuity and range in a compact space -/
theorem arzela_ascoli₁ [compact_space β]
  (A : set (α →ᵇ β))
  (closed : is_closed A)
  (H : ∀ (x:α) (ε > 0), ∃U ∈ nhds x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε) :
  compact A :=
begin
  refine compact_of_totally_bounded_is_closed _ closed,
  refine totally_bounded_of_finite_discretization (λ ε ε0, _),
  rcases dense ε0 with ⟨ε₁, ε₁0, εε₁⟩,
  let ε₂ := ε₁/2/2,
  /- We have to find a finite discretization of `u`, i.e., finite information
  that is sufficient to reconstruct `u` up to ε. This information will be
  provided by the values of `u` on a sufficiently dense set tα,
  slightly translated to fit in a finite ε₂-dense set tβ in the image. Such
  sets exist by compactness of the source and range. Then, to check that these
  data determine the function up to ε, one uses the control on the modulus of
  continuity to extend the closeness on tα to closeness everywhere. -/
  have ε₂0 : ε₂ > 0 := half_pos (half_pos ε₁0),
  have : ∀x:α, ∃U, x ∈ U ∧ is_open U ∧ ∀ (y z ∈ U) {f : α →ᵇ β},
    f ∈ A → dist (f y) (f z) < ε₂ := λ x,
      let ⟨U, nhdsU, hU⟩ := H x _ ε₂0,
          ⟨V, VU, openV, xV⟩ := mem_nhds_sets_iff.1 nhdsU in
      ⟨V, xV, openV, λy z hy hz f hf, hU y z (VU hy) (VU hz) f hf⟩,
  choose U hU using this,
  /- For all x, the set hU x is an open set containing x on which the elements of A
  fluctuate by at most ε₂.
  We extract finitely many of these sets that cover the whole space, by compactness -/
  rcases compact_elim_finite_subcover_image compact_univ
    (λx _, (hU x).2.1) (λx hx, mem_bUnion (mem_univ _) (hU x).1)
    with ⟨tα, _, ⟨_⟩, htα⟩,
  /- tα : set α, htα : univ ⊆ ⋃x ∈ tα, U x -/
  rcases @finite_cover_balls_of_compact β _ _ compact_univ _ ε₂0
    with ⟨tβ, _, ⟨_⟩, htβ⟩, resetI,
  /- tβ : set β, htβ : univ ⊆ ⋃y ∈ tβ, ball y ε₂ -/
  /- Associate to every point `y` in the space a nearby point `F y` in tβ -/
  choose F hF using λy, show ∃z∈tβ, dist y z < ε₂, by simpa using htβ (mem_univ y),
  /- F : β → β, hF : ∀ (y : β), F y ∈ tβ ∧ dist y (F y) < ε₂ -/

  /- Associate to every function a discrete approximation, mapping each point in `tα`
  to a point in `tβ` close to its true image by the function. -/
  refine ⟨tα → tβ, by apply_instance, λ f a, ⟨F (f a), (hF (f a)).fst⟩, _⟩,
  rintro ⟨f, hf⟩ ⟨g, hg⟩ f_eq_g,
  /- If two functions have the same approximation, then they are within distance ε -/
  refine lt_of_le_of_lt ((dist_le $ le_of_lt ε₁0).2 (λ x, _)) εε₁,
  have : ∃x', x' ∈ tα ∧ x ∈ U x' := mem_bUnion_iff.1 (htα (mem_univ x)),
  rcases this with ⟨x', x'tα, hx'⟩,
  refine calc dist (f x) (g x)
      ≤ dist (f x) (f x') + dist (g x) (g x') + dist (f x') (g x') : dist_triangle4_right _ _ _ _
  ... ≤ ε₂ + ε₂ + ε₁/2 : le_of_lt (add_lt_add (add_lt_add _ _) _)
  ... = ε₁ : by rw [add_halves, add_halves],
  { exact (hU x').2.2 _ _ hx' ((hU x').1) hf },
  { exact (hU x').2.2 _ _ hx' ((hU x').1) hg },
  { have F_f_g : F (f x') = F (g x') :=
      (congr_arg (λ f:tα → tβ, (f ⟨x', x'tα⟩ : β)) f_eq_g : _),
    calc dist (f x') (g x')
          ≤ dist (f x') (F (f x')) + dist (g x') (F (f x')) : dist_triangle_right _ _ _
      ... = dist (f x') (F (f x')) + dist (g x') (F (g x')) : by rw F_f_g
      ... < ε₂ + ε₂ : add_lt_add (hF (f x')).snd (hF (g x')).snd
      ... = ε₁/2 : add_halves _ }
end

/-- Second version, with pointwise equicontinuity and range in a compact subset -/
theorem arzela_ascoli₂
  (s : set β) (hs : compact s)
  (A : set (α →ᵇ β))
  (closed : is_closed A)
  (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
  (H : ∀(x:α) (ε > 0), ∃U ∈ nhds x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε) :
  compact A :=
/- This version is deduced from the previous one by restricting to the compact type in the target,
using compactness there and then lifting everything to the original space. -/
begin
  have M : ∀x y : s, dist (x : β) y ≤ 1 * dist x y := λ x y, ge_of_eq (one_mul _),
  let F : (α →ᵇ s) → α →ᵇ β := comp coe M,
  refine compact_of_is_closed_subset
    (compact_image (_ : compact (F ⁻¹' A)) (continuous_comp M)) closed (λ f hf, _),
  { haveI : compact_space s := compact_iff_compact_space.1 hs,
    refine arzela_ascoli₁ _ (continuous_iff_is_closed.1 (continuous_comp M) _ closed)
      (λ x ε ε0, bex.imp_right (λ U U_nhds hU y z hy hz f hf, _) (H x ε ε0)),
    calc dist (f y) (f z) = dist (F f y) (F f z) : rfl
                        ... < ε : hU y z hy hz (F f) hf },
  { let g := cod_restrict s f (λx, in_s f x hf),
    rw [show f = F g, by ext; refl] at hf ⊢,
    exact ⟨g, hf, rfl⟩ }
end

/-- Third (main) version, with pointwise equicontinuity and range in a compact subset, but
without closedness. The closure is then compact -/
theorem arzela_ascoli
  (s : set β) (hs : compact s)
  (A : set (α →ᵇ β))
  (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
  (H : ∀(x:α) (ε > 0), ∃U ∈ nhds x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε) :
  compact (closure A) :=
/- This version is deduced from the previous one by checking that the closure of A, in
addition to being closed, still satisfies the properties of compact range and equicontinuity -/
arzela_ascoli₂ s hs (closure A) is_closed_closure
  (λ f x hf, (mem_of_closed' (closed_of_compact _ hs)).2 $ λ ε ε0,
    let ⟨g, gA, dist_fg⟩ := mem_closure_iff'.1 hf ε ε0 in
    ⟨g x, in_s g x gA, lt_of_le_of_lt (dist_coe_le_dist _) dist_fg⟩)
  (λ x ε ε0, show ∃ U ∈ nhds x,
      ∀ y z ∈ U, ∀ (f : α →ᵇ β), f ∈ closure A → dist (f y) (f z) < ε,
    begin
      refine bex.imp_right (λ U U_set hU y z hy hz f hf, _) (H x (ε/2) (half_pos ε0)),
      rcases mem_closure_iff'.1 hf (ε/2/2) (half_pos (half_pos ε0)) with ⟨g, gA, dist_fg⟩,
      replace dist_fg := λ x, lt_of_le_of_lt (dist_coe_le_dist x) dist_fg,
      calc dist (f y) (f z) ≤ dist (f y) (g y) + dist (f z) (g z) + dist (g y) (g z) : dist_triangle4_right _ _ _ _
          ... < ε/2/2 + ε/2/2 + ε/2 :
            add_lt_add (add_lt_add (dist_fg y) (dist_fg z)) (hU y z hy hz g gA)
          ... = ε : by rw [add_halves, add_halves]
    end)

/- To apply the previous theorems, one needs to check the equicontinuity. An important
instance is when the source space is a metric space, and there is a fixed modulus of continuity
for all the functions in the set A -/

lemma equicontinuous_of_continuity_modulus {α : Type u} [metric_space α]
  (b : ℝ → ℝ) (b_lim : tendsto b (nhds 0) (nhds 0))
  (A : set (α →ᵇ β))
  (H : ∀(x y:α) (f : α →ᵇ β), f ∈ A → dist (f x) (f y) ≤ b (dist x y))
  (x:α) (ε : ℝ) (ε0 : ε > 0) : ∃U ∈ nhds x, ∀ (y z ∈ U) (f : α →ᵇ β),
    f ∈ A → dist (f y) (f z) < ε :=
begin
  rcases tendsto_nhds_nhds.1 b_lim ε ε0 with ⟨δ, δ0, hδ⟩,
  refine ⟨ball x (δ/2), ball_mem_nhds x (half_pos δ0), λ y z hy hz f hf, _⟩,
  have : dist y z < δ := calc
    dist y z ≤ dist y x + dist z x : dist_triangle_right _ _ _
    ... < δ/2 + δ/2 : add_lt_add hy hz
    ... = δ : add_halves _,
  calc
    dist (f y) (f z) ≤ b (dist y z) : H y z f hf
    ... ≤ abs (b (dist y z)) : le_abs_self _
    ... = dist (b (dist y z)) 0 : by simp [real.dist_eq]
    ... < ε : hδ (by simpa [real.dist_eq] using this),
end

end arzela_ascoli

section normed_group
/- In this section, if β is a normed group, then we show that the space of bounded
continuous functions from α to β inherits a normed group structure, by using
pointwise operations and checking that they are compatible with the uniform distance. -/

variables [topological_space α] [normed_group β]
variables {f g : α →ᵇ β} {x : α} {C : ℝ}

instance : has_zero (α →ᵇ β) := ⟨const 0⟩

@[simp] lemma coe_zero : (0 : α →ᵇ β) x = 0 := rfl

instance : has_norm (α →ᵇ β) := ⟨λu, dist u 0⟩

lemma norm_def : ∥f∥ = dist f 0 := rfl

lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ := calc
  ∥f x∥ = dist (f x) ((0 : α →ᵇ β) x) : by simp [dist_zero_right]
  ... ≤ ∥f∥ : dist_coe_le_dist _

/-- The norm of a function is controlled by the supremum of the pointwise norms -/
lemma norm_le (C0 : (0 : ℝ) ≤ C) : ∥f∥ ≤ C ↔ ∀x:α, ∥f x∥ ≤ C :=
by simpa only [coe_zero, dist_zero_right] using @dist_le _ _ _ _ f 0 _ C0

/-- The pointwise sum of two bounded continuous functions is again bounded continuous. -/
instance : has_add (α →ᵇ β) :=
⟨λf g, ⟨λx, f x + g x, continuous_add f.2.1 g.2.1, (∥f∥ + ∥g∥) + (∥f∥ + ∥g∥),
  λ x y,
    have ∀x, dist (f x + g x) 0 ≤ ∥f∥ + ∥g∥ := λx, calc
      dist (f x + g x) 0 = ∥f x + g x∥ : dist_zero_right _
      ... ≤ ∥f x∥ + ∥g x∥ : norm_triangle _ _
      ... ≤ ∥f∥ + ∥g∥ : add_le_add (norm_coe_le_norm _) (norm_coe_le_norm _),
    calc dist (f x + g x) (f y + g y) ≤ dist (f x + g x) 0 + dist (f y + g y) 0 : dist_triangle_right _ _ _
        ... ≤ (∥f∥ + ∥g∥) + (∥f∥ + ∥g∥) : add_le_add (this x) (this y) ⟩⟩

/-- The pointwise opposite of a bounded continuous function is again bounded continuous. -/
instance : has_neg (α →ᵇ β) :=
⟨λf, ⟨λx, -f x, continuous_neg f.2.1,
  begin
    have dn : ∀a b : β, dist (-a) (-b) = dist a b := λ a b,
      by rw [dist_eq_norm, neg_sub_neg, ← dist_eq_norm, dist_comm],
    simpa only [dn] using f.2.2
  end⟩⟩

@[simp] lemma coe_add : (f + g) x = f x + g x := rfl
@[simp] lemma coe_neg : (-f) x = - (f x) := rfl
lemma forall_coe_zero_iff_zero : (∀x, f x = 0) ↔ f = 0 :=
⟨@ext _ _ _ _ f 0, by rintro rfl _; refl⟩

instance : add_comm_group (α →ᵇ β) :=
{ add_assoc    := assume f g h, by ext; simp,
  zero_add     := assume f, by ext; simp,
  add_zero     := assume f, by ext; simp,
  add_left_neg := assume f, by ext; simp,
  add_comm     := assume f g, by ext; simp,
  ..bounded_continuous_function.has_add,
  ..bounded_continuous_function.has_neg,
  ..bounded_continuous_function.has_zero }

@[simp] lemma coe_diff : (f - g) x = f x - g x := rfl

instance : normed_group (α →ᵇ β) :=
normed_group.of_add_dist (λ _, rfl) $ λ f g h,
(dist_le dist_nonneg).2 $ λ x,
le_trans (by rw [dist_eq_norm, dist_eq_norm, coe_add, coe_add,
  add_sub_add_right_eq_sub]) (dist_coe_le_dist x)

lemma abs_diff_coe_le_dist : norm (f x - g x) ≤ dist f g :=
by rw normed_group.dist_eq; exact @norm_coe_le_norm _ _ _ _ (f-g) x

lemma coe_le_coe_add_dist {f g : α →ᵇ ℝ} : f x ≤ g x + dist f g :=
sub_le_iff_le_add'.1 $ (abs_le.1 $ @dist_coe_le_dist _ _ _ _ f g x).2

/-- Constructing a bounded continuous function from a uniformly bounded continuous
function taking values in a normed group. -/
def of_normed_group {α : Type u} {β : Type v} [topological_space α] [normed_group β]
  (f : α  → β) (C : ℝ) (H : ∀x, norm (f x) ≤ C) (Hf : continuous f) : α →ᵇ β :=
⟨λn, f n, ⟨Hf, ⟨C + C, λ m n,
  calc dist (f m) (f n) ≤ dist (f m) 0 + dist (f n) 0 : dist_triangle_right _ _ _
       ... = norm (f m) + norm (f n) : by simp
       ... ≤ C + C : add_le_add (H m) (H n)⟩⟩⟩

/-- Constructing a bounded continuous function from a uniformly bounded
function on a discrete space, taking values in a normed group -/
def of_normed_group_discrete {α : Type u} {β : Type v}
  [topological_space α] [discrete_topology α] [normed_group β]
  (f : α  → β) (C : ℝ) (H : ∀x, norm (f x) ≤ C) : α →ᵇ β :=
of_normed_group f C H continuous_of_discrete_topology

end normed_group
end bounded_continuous_function


import set_theory.pgame
import position
import tactic
import tactic.nth_rewrite.default

universe u

/-!
# Basic deinitions about impartial (pre-)games

We will define an impartial game, one in which left and right can make exactly the same moves.
Our definition differs slightly by saying that the game is always equivilent to its negitve,
no matter what moves are played. This allows for games such as poker-nim to be classifed as
impartial.
-/

namespace pgame

local infix ` ≈ ` := pgame.equiv

/-- The definiton for a impartial game, defined using Conway induction -/
@[class] def impartial : pgame → Prop
| G := G ≈ -G ∧ (∀ i, impartial (G.move_left i)) ∧ (∀ j, impartial (G.move_right j))
using_well_founded {dec_tac := pgame_wf_tac}

@[instance] lemma zero_impartial : impartial 0 := by tidy

@[simp] lemma impartial_def {G : pgame} : G.impartial ↔ G ≈ -G ∧ (∀ i, impartial (G.move_left i)) ∧ (∀ j, impartial (G.move_right j)) :=
begin
	split,
	{	intro hi,
		unfold1 impartial at hi,
		exact hi },
	{	intro hi,
		unfold1 impartial,
		exact hi }
end

lemma impartial_neg_equiv_self (G : pgame) [h : G.impartial] : G ≈ -G := (impartial_def.1 h).1

@[instance] lemma impartial_move_left_impartial {G : pgame} [h : G.impartial] (i : G.left_moves) : impartial (G.move_left i) :=
(impartial_def.1 h).2.1 i

@[instance] lemma impartial_move_right_impartial {G : pgame} [h : G.impartial] (j : G.right_moves) : impartial (G.move_right j) :=
(impartial_def.1 h).2.2 j

@[instance] lemma impartial_add : ∀ (G H : pgame) [hG : G.impartial] [hH : H.impartial], (G + H).impartial
| G H :=
begin
	introsI hG hH,
	rw impartial_def,
	split,
	{	apply equiv_trans _ (equiv_of_relabelling (neg_add_relabelling G H)).symm,
		apply add_congr;
		exact impartial_neg_equiv_self _	},
	split,
	{ intro i,
		equiv_rw pgame.left_moves_add G H at i,
		cases i with iG iH,
		{	rw add_move_left_inl,
			exact impartial_add (G.move_left iG) H },
		{ rw add_move_left_inr,
			exact impartial_add G (H.move_left iH) } },
	{ intro j,
		equiv_rw pgame.right_moves_add G H at j,
		cases j with jG jH,
		{ rw add_move_right_inl,
			exact impartial_add (G.move_right jG) H },
		{ rw add_move_right_inr,
			exact impartial_add G (H.move_right jH) } }
end
using_well_founded {dec_tac := pgame_wf_tac}

@[instance] lemma impartial_neg : ∀ (G : pgame) [G.impartial], (-G).impartial
| G :=
begin
	introI,
	rw impartial_def,
	split,
	{	rw neg_neg,
		symmetry,
		exact impartial_neg_equiv_self G },
	split,
	{ intro i,
		equiv_rw G.left_moves_neg at i,
		rw move_left_left_moves_neg_symm,
		exact impartial_neg (G.move_right i) },
	{ intro j,
		equiv_rw G.right_moves_neg at j,
		rw move_right_right_moves_neg_symm,
		exact impartial_neg (G.move_left j) }
end
using_well_founded {dec_tac := pgame_wf_tac}

lemma impartial_position_cases (G : pgame) [G.impartial] : G.p_position ∨ G.n_position :=
begin
  rcases G.position_cases with hl | hr | hp | hn,
  { cases hl with hpos hnonneg,
		rw ←not_lt at hnonneg,
		have hneg := lt_of_lt_of_equiv hpos G.impartial_neg_equiv_self,
		rw [lt_iff_neg_gt, neg_neg, neg_zero] at hneg,
		contradiction },
	{ cases hr with hnonpos hneg,
		rw ←not_lt at hnonpos,
		have hpos := lt_of_equiv_of_lt G.impartial_neg_equiv_self.symm hneg,
		rw [lt_iff_neg_gt, neg_neg, neg_zero] at hpos,
		contradiction },
	{ left, assumption },
	{ right, assumption }
end

lemma impartial_add_self (G : pgame) [G.impartial] : (G + G).p_position :=
p_position_is_zero.2 $ equiv_trans (add_congr G.impartial_neg_equiv_self G.equiv_refl) add_left_neg_equiv

/-- A different way of viewing equivalence. -/
def additive_equiv (G H : pgame) [G.impartial] [H.impartial] : Prop :=
	∀ (F : pgame) [F.impartial], (G + F).p_position ↔ (H + F).p_position

lemma additive_equiv_equiv_equiv (G H : pgame) [hG : G.impartial] [hH : H.impartial] : G.additive_equiv H ↔ G ≈ H :=
begin
	split,
	{ intro heq,
		cases G.impartial_position_cases with hGp hGn,
		{ specialize heq 0,
			rw [p_position_of_equiv_iff G.add_zero_equiv, p_position_of_equiv_iff H.add_zero_equiv, p_position_is_zero, p_position_is_zero] at heq,
			rw p_position_is_zero at hGp,
			exact equiv_trans hGp (heq.1 hGp).symm },
		{ split,
			{ rw le_iff_sub_nonneg,
				specialize heq (-G),
				rw [p_position_of_equiv_iff add_comm_equiv, p_position_of_equiv_iff add_left_neg_equiv] at heq,
				exact (heq.1 zero_p_postition).2 },
			{ rw le_iff_sub_nonneg,
				specialize heq (-H),
				nth_rewrite 1 p_position_of_equiv_iff add_comm_equiv at heq,
				rw p_position_of_equiv_iff add_left_neg_equiv at heq,
				exact (heq.2 zero_p_postition).2 } } },
	{ intros heq F hf,
		rw [p_position_is_zero, p_position_is_zero],
		split,
		{ intro hGF,
			exact equiv_trans (add_congr heq.symm $ equiv_refl _) hGF },
		{ intro hHF,
			exact equiv_trans (add_congr heq $ equiv_refl _) hHF } }
end

lemma equiv_iff_sum_p_position (G H : pgame) [G.impartial] [H.impartial] : G ≈ H ↔ (G + H).p_position :=
begin
	split,
	{ intro heq,
		exact p_position_of_equiv (add_congr (equiv_refl _) heq) G.impartial_add_self },
	{ intro hGHp,
		split,
		{ rw le_iff_sub_nonneg,
			exact le_trans hGHp.2 (le_trans add_comm_le $ le_of_le_of_equiv (le_refl _) $ add_congr (equiv_refl _) G.impartial_neg_equiv_self) },
		{ rw le_iff_sub_nonneg,
			exact le_trans hGHp.2 (le_of_le_of_equiv (le_refl _) $ add_congr (equiv_refl _) H.impartial_neg_equiv_self) } }
end

lemma impartial_p_position_symm (G : pgame) [G.impartial] : G.p_position ↔ G ≤ 0 :=
begin
	use and.left,
	{ intro hneg,
		exact ⟨ hneg, zero_le_iff_neg_le_zero.2 (le_of_equiv_of_le (impartial_neg_equiv_self G).symm hneg) ⟩ }
end

lemma impartial_n_position_symm (G : pgame) [G.impartial] : G.n_position ↔ G < 0 :=
begin
	use and.right,
	{ intro hneg,
		split,
		rw lt_iff_neg_gt,
		rw neg_zero,
		exact lt_of_equiv_of_lt G.impartial_neg_equiv_self.symm hneg,
		exact hneg }
end

lemma impartial_p_position_symm' (G : pgame) [G.impartial] : G.p_position ↔ 0 ≤ G :=
begin
	use and.right,
	{ intro hpos,
		exact ⟨ le_zero_iff_zero_le_neg.2 $ le_of_le_of_equiv hpos G.impartial_neg_equiv_self, hpos ⟩ }
end

lemma impartial_n_position_symm' (G : pgame) [G.impartial] : G.n_position ↔ 0 < G :=
begin
	use and.left,
	{ intro hpos,
		use hpos,
		rw lt_iff_neg_gt,
		rw neg_zero,
		exact lt_of_lt_of_equiv hpos G.impartial_neg_equiv_self }
end

lemma no_good_left_moves_iff_p_position (G : pgame) [G.impartial] : (∀ (i : G.left_moves), (G.move_left i).n_position) ↔ G.p_position :=
begin
	split,
	{	intro hbad,
		rw [impartial_p_position_symm, le_def_lt],
		split,
		{ intro i,
			specialize hbad i,
			exact hbad.2 },
		{ intro j,
			exact pempty.elim j } },
	{ intros hp i,
		exact (G.move_left i).impartial_n_position_symm.2 ((le_def_lt.1 $ G.impartial_p_position_symm.1 hp).1 i) }
end

lemma no_good_right_moves_iff_p_position (G : pgame) [G.impartial] : (∀ (j : G.right_moves), (G.move_right j).n_position) ↔ G.p_position :=
begin
	split,
	{ intro hbad,
		rw [impartial_p_position_symm', le_def_lt],
		split,
		{ intro i,
			exact pempty.elim i },
		{ intro j,
			specialize hbad j,
			exact hbad.1 } },
	{ intros hp j,
		exact (G.move_right j).impartial_n_position_symm'.2 ((le_def_lt.1 $ G.impartial_p_position_symm'.1 hp).2 j) }
end

lemma good_left_move_iff_n_position (G : pgame) [G.impartial] : (∃ (i : G.left_moves), (G.move_left i).p_position) ↔ G.n_position :=
begin
	split,
	{ rintro ⟨ i, hi ⟩,
		exact G.impartial_n_position_symm'.2 (lt_def_le.2 $ or.inl ⟨ i, hi.2 ⟩) },
	{ intro hn,
		rw [impartial_n_position_symm', lt_def_le] at hn,
		rcases hn with ⟨ i, hi ⟩ | ⟨ j, _ ⟩,
		{ exact ⟨ i, (G.move_left i).impartial_p_position_symm'.2 hi ⟩ },
		{ exact pempty.elim j } }
end

lemma good_right_move_iff_n_position (G : pgame) [G.impartial] : (∃ j : G.right_moves,  (G.move_right j).p_position) ↔ G.n_position :=
begin
	split,
	{ rintro ⟨ j, hj ⟩,
		exact G.impartial_n_position_symm.2 (lt_def_le.2 $ or.inr ⟨ j, hj.1 ⟩) },
	{ intro hn,
		rw [impartial_n_position_symm, lt_def_le] at hn,
		rcases hn with ⟨ i, _ ⟩ | ⟨ j, hj ⟩,
		{ exact pempty.elim i },
		{ exact ⟨ j, (G.move_right j).impartial_p_position_symm.2 hj ⟩ } }
end

end pgame


import ..fglib
import ..basic
import .vector

namespace FG

/-
  ## Square Matrix

  The basic definitions of mathlib's `matrix` are used.
-/

def matrix_func : Type := ℕ → ℕ → ℂ

/- Note that a `square_matrix n` is a `(n+1) × (n+1)` matrix. -/
def square_matrix (n : ℕ) : Type := matrix (fin (n + 1)) (fin (n + 1)) ℂ

namespace square_matrix

variables {n : ℕ} (A : square_matrix n)

@[simp] def length : square_matrix n → ℕ := n + 1

@[simp] def to_func : matrix_func :=
  λ(i j : ℕ), if i < A.length ∧ j < A.length
    then A i j else 0

@[simp] def I : square_matrix n :=
  matrix.has_one.one

/- `square_matrix n` is a module -/
@[simps] instance : ring (square_matrix n) :=
{ ..matrix.ring }

/- `ℂ` is a module over `square_matrix` -/
instance : module ℂ (square_matrix n) :=
{ ..matrix.module }

@[simp] def mul_vec (v : vec n) :
  vec n :=
matrix.mul_vec A v

/- `square_matrix n` is a module over `vec n` -/
instance : module (square_matrix n) (vec n) :=
{ smul := mul_vec,
  one_smul := λv, by simp,
  mul_smul := λA B v, by simp,
  smul_zero := λA,
  begin
    funext i j,
    simp [matrix.mul_vec]
  end,
  smul_add := λA x y, by apply matrix.mul_vec_add,
  zero_smul := λx, by simp,
  add_smul := λA B x, by apply matrix.add_mul_vec, }

@[simp] def det : ℂ :=
  matrix.det A

@[simp] lemma det_one :
  det (1 : square_matrix n) = 1 :=
by simp

@[simp] lemma det_zero :
  det (0 : square_matrix n) = 0 :=
by simp

/- Finite nonzero dimensional matrices must have at least one eigenvalue/eigenvector. -/
@[simp] lemma has_nonzero_eigenvalue_and_eigenvector
  (h : A ≠ 0) :
  ∃ (x : ℂ) (v : vec n), x ≠ 0 ∧ v ≠ 0 ∧ (A - x • I).det = 0 ∧ (A - x • I) • v = 0 :=
sorry

def is_invertible : Prop :=
  ∃ (B : square_matrix n), B * A = 1

/- The following functions are trying to calculate an inverse matrix by the adjacent matrix. -/

@[simp] def minor (A : square_matrix n) (i j : fin (n + 1)) : ℂ :=
begin
  let submatrix : square_matrix (n - 1) :=
  λ(i' j'), A (if i' < i then i' else i' + 1) (if j' < j then j' else j' + 1),
  use submatrix.det
end

@[simp] def transpose : square_matrix n :=
  matrix.transpose A

@[simp] def cofactor_matrix : square_matrix n :=
  λ(i j), (-1) ^ ((i : ℕ) + j) * A.minor i j

@[simp] def adjacent : square_matrix n :=
  A.cofactor_matrix.transpose

@[simp] noncomputable def inverse (h : A.det ≠ 0) : square_matrix n :=
  λ(i j), A.adjacent i j / A.det

/- TODO: Too compliated(?). Haven't figured out how to prove this yet. -/
@[simp] lemma mul_inverse_left (h : A.det ≠ 0) :
  A.inverse h * A = 1 :=
begin
  funext i j,
  simp [matrix.mul, matrix.dot_product],
  sorry
end

@[simp] lemma det_ne_zero_invertible :
  A.det ≠ 0 → A.is_invertible :=
begin
  intro h,
  use A.inverse h,
  apply A.mul_inverse_left
end

@[simp] lemma invertible_det_ne_zero :
  A.is_invertible → A.det ≠ 0 :=
begin
  intro h,
  cases' h with B,
  have hdet := by calc B.det * A.det = (B * A).det
      : (matrix.det_mul B A).symm
    ... = (1 : square_matrix n).det
      : by rw h
    ... = (1 : ℂ)
      : det_one,
  simp,
  intro hfalse,
  have h := right_ne_zero_of_mul_eq_one hdet,
  apply h,
  assumption
end

@[simp] theorem det_ne_zero_iff :
  A.det ≠ 0 ↔ A.is_invertible :=
iff.intro (det_ne_zero_invertible A) (invertible_det_ne_zero A)

@[simp] def to_linear_operator :
  linear_operator ℂ (vec n) :=
{ to_fun := λv, A.mul_vec v,
  map_add' :=
  begin
    intros v w,
    apply vec.ext,
    intro i,
    simp [ matrix.mul_vec,
      matrix.dot_product, matrix.dot_product_add,
      mul_add, finset.sum_add_distrib ],
  end,
  map_smul' :=
  begin
    intros a v,
    have h := (matrix.mul_vec_lin A).map_smul' a v,
    simp at h,
    simp [mul_vec],
    exact h,
  end }

@[simp] lemma transpose_det :
  A.transpose.det = A.det :=
by apply matrix.det_transpose

@[simp] def conj_transpose : square_matrix n :=
  matrix.conj_transpose A

@[simp] lemma conj_transpose_det :
  A.conj_transpose.det = star A.det :=
by apply matrix.det_conj_transpose

@[simp] def is_unitary : Prop :=
  A.conj_transpose = A

@[simp] def det1 (A : square_matrix 0) : ℂ :=
  A 0 0

lemma det1_eq (A : square_matrix 0) :
  A.det = A.det1 :=
by simp

meta def invertible_det1 : tactic unit :=
do
  tactic.applyc `FG.square_matrix.det_ne_zero_invertible,
  `[simp [FG.square_matrix.det1_eq]]

@[simp] def det2 (A : square_matrix 1) : ℂ :=
  A 0 0 * A 1 1 - A 0 1 * A 1 0

/- This was copied from mathlib's internal file :( -/
lemma det2_eq (A : square_matrix 1) :
  A.det = A.det2 :=
begin
  simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
  ring,
end

/- Helper tactic for quickly solve simple 2-dimensional determinants. -/
meta def invertible_det2 : tactic unit :=
do
  tactic.applyc `FG.square_matrix.det_ne_zero_invertible,
  `[simp [FG.square_matrix.det2_eq]]

end square_matrix

end FG