-- Коментарий начинается с `--`
-- Lean это действительно интерактивный прувер, и в нем можно получить ответ,
-- просто введя команду в текстовый редактор

-- Команда `#check` позволяет проверить, что выражение корректно типизированно
#check ((λα β: Type => λx:α => λ_:β => x) : ∀α β: Type, α → β → α)
-- Lean во многих случаях может сам вывести тип, и нам не нужно его указыать
#check λ(α β: Type)(x:α)(_:β) => x

-- Другой способ выразить, что выражениие имеет определённый тип, это пример
-- Пример это определение без имени
example: ∀α β: Type, α → β → α := λ(α β: Type)(x:α)(_:β) => x
-- `∀α β: Type` и `λ(α β: Type)` дублируют друг друга. Но есть короткая запись:
example (α β: Type): α → β → α := λ(x:α)(_:β) => x
-- Или даже:
example (α β: Type)(x:α)(_:β): α := x

-- Можно ввести определение
def f1 (α β: Type)(x:α)(_:β): α := x
-- И использовать его:
#check f1 Nat Nat 3 5
-- Команда `#reduce` позволяет вычислить выражение:
#reduce f1 Nat Nat 3 5
-- С помощью подчёркиваний, можно попросить Lean вывести тип за нас:
#check f1 _ _ 3 5

-- Чтобы не писать каждый раз подчёркивания, можно определить функцию так:
def f2 {α β: Type}(x:α)(_:β): α := x
-- `α` и `β` это неявные аргументы, которые не указываются при применении:
#check f2 3 5
-- Но если необходимо, можно указать их все явно:
#check @f2 Nat Nat 3 5
-- Или лишь некоторые, по имени:
#check f2 (β := Nat) 3 5

-- Lean позволяет определить функцию сразу для всех вселенных:
example {α β: Sort u}(x:α)(_:β): α := x
-- И явное указание вселенной можно опустить
example (x:α)(_:β): α := x

-- Типы данных

#print Bool

-- inductive Bool : Type where
  -- /-- The boolean value `false`, not to be confused with the proposition `False`. -/
  -- | false : Bool
  -- /-- The boolean value `true`, not to be confused with the proposition `True`. -/
  -- | true : Bool
--
-- export Bool (false true)

#print false
#print true

def neg (b:Bool): Bool :=
  match b with
  | false => true
  | true  => false

#reduce neg false
#reduce neg true

example: Bool → Bool
| false => true    | true  => false

example: Bool → Bool → Bool
| false, false => false    | false, true  => true
| true,  false => true     | true,  true  => false

#print Nat

def pred: Nat → Nat
| Nat.zero   => 0
| Nat.succ n => n

#reduce pred (pred 5)

def add1 (n:Nat): Nat → Nat
| 0          => n
| Nat.succ k => add1 n.succ k

def add2 (n:Nat): Nat → Nat
| 0          => n
| Nat.succ k => (add2 n k).succ

-- def il: Nat → Nat
-- | 0 => 0
-- | Nat.succ n => il n.succ

#print add2
#print Nat.brecOn
#print Nat.rec

-- recursor Nat.rec.{u} : {motive : Nat → Sort u} →
  -- motive Nat.zero → ((n : Nat) → motive n → motive (Nat.succ n)) → (t : Nat) → motive t

def natRec {M: Nat → Sort u}(z: M Nat.zero)(f: ∀n:Nat, M n → M n.succ): (t: Nat) → M t
| Nat.zero   => z
| Nat.succ n => f n (natRec z f n)

#reduce (λn => Nat.rec (motive := λ_ => Nat) n (λ_ s => s.succ)) 2 3

#reduce (Nat.rec 2 (λ_ s => s.succ) : Nat → Nat) 3
#reduce (λ_ s => s.succ) 2 $ (Nat.rec 2 (λ_ s => s.succ) : Nat → Nat) 2
#reduce (λ_ s => s.succ) 2 $ (λ_ s => s.succ) 1 $ (Nat.rec 2 (λ_ s => s.succ) : Nat → Nat) 1
#reduce (λ_ s => s.succ) 2 $ (λ_ s => s.succ) 1 $ (λ_ s => s.succ) 0 $
  (Nat.rec 2 (λ_ s => s.succ) : Nat → Nat) 0
#reduce (λ_ s => s.succ) 2 $ (λ_ s => s.succ) 1 $ (λ_ s => s.succ) 0 $ 2

#print Bool.rec
#print Nat.casesOn

#print Prod

#reduce ( (Prod.mk 2 3).casesOn (λx y => (y,x)) : Nat×Nat )

-- structure Prod (α : Type u) (β : Type v) where
--   /-- The first projection out of a pair. if `p : α × β` then `p.1 : α`. -/
--   fst : α
--   /-- The second projection out of a pair. if `p : α × β` then `p.2 : β`. -/
--   snd : β

#reduce (2,3).fst
#reduce (2,3).snd

#reduce ( {snd := 3, fst := 2} : Nat×Nat )
#reduce ( ⟨2,3⟩ : Nat×Nat )

#print Sum

-- inductive Sum (α : Type u) (β : Type v) where
--   /-- Left injection into the sum type `α ⊕ β`. If `a : α` then `.inl a : α ⊕ β`. -/
--   | inl (val : α) : Sum α β
--   /-- Right injection into the sum type `α ⊕ β`. If `b : β` then `.inr b : α ⊕ β`. -/
--   | inr (val : β) : Sum α β

#reduce ( (Sum.inl 3).casesOn pred Nat.succ : Nat )
#reduce ( (Sum.inr 3).casesOn pred Nat.succ : Nat )

#print Empty

#check λe:Empty => e

#print Empty.rec

#check λe:Empty => (e.rec : Nat)

def BoolEq (a: Bool)(b: Bool): Prop :=
  a.rec (b.rec True False) (b.rec False True)

example: ∀b:Bool, BoolEq b b := Bool.rec ⟨⟩ ⟨⟩

example (P Q: Type)(pq: P ⊕ Q): Prop := pq.rec (λ_ => False) (λ_ => True)
-- example (P Q: Prop)(pq: P ∨ Q): Prop := pq.rec (λ_ => False) (λ_ => True)

#check Decidable.byContradiction
#check Bool.and_true
#check decidable_of_decidable_of_iff

instance {P Q: Prop}: [Decidable P] → [Decidable Q] → Decidable (P ∧ Q)
| isFalse np, _          => isFalse $ λpq => np pq.left
| _,          isFalse nq => isFalse $ λpq => nq pq.right
| isTrue p,   isTrue q   => isTrue  $ ⟨p,q⟩

instance {P Q: Prop}: [Decidable P] → [Decidable Q] → Decidable (P ∨ Q)
| isFalse np, isFalse nq => isFalse $ λpq => pq.elim np nq
| isTrue p,   _          => isTrue  $ Or.inl p
| _,          isTrue q   => isTrue  $ Or.inr q

theorem decide_and {P Q: Prop}[dp: Decidable P][dq:Decidable Q]
  : decide (P ∧ Q) = (decide P && decide Q) :=
by
  apply dite P <;> (intro; simp [*])

theorem decide_or {P Q: Prop}[dp: Decidable P][dq:Decidable Q]
  : decide (P ∨ Q) = (decide P || decide Q) :=
by
  apply dite P <;> (intro; simp [*])


import data.real.basic
import data.matrix.basic
import algebra.big_operators.basic

open_locale big_operators matrix

variables {d n : ℕ} {ι : Type*}

variables (M : matrix (fin n) (fin n) ℝ)

variables {f : fin n → ℝ} {g : fin n.succ → ℝ}

def n_set : finset (fin n) := @finset.univ (fin n) (fin.fintype n)

theorem blah : ∑ i : (fin n), ∑ j : (fin n), M i j = ∑ j : (fin n), ∑ i : (fin n), M i j :=
  finset.sum_comm

theorem sum_split_singleton (k : fin n) :
  ∑ (i : fin n), f i = f k + ∑ (i : fin n) in finset.univ \ {k}, f i :=
  finset.sum_eq_add_sum_diff_singleton (finset.mem_univ k) f

-- theorem sum_split_singleton (k : fin n) : ∑ (i : fin n), f i
--   = ∑ (i : fin n) in finset.univ.filter (λ x : fin n, x ≠ k) , f i + f k :=
-- begin
--   classical,
--   rw ← finset.sum_filter_add_sum_filter_not _ (λ x : fin n, x ≠ k),
--   simp only [add_right_inj, finset.filter_congr_decidable, finset.sum_congr],
--   simp_rw not_ne_iff,
--   rw finset.sum_filter,
--   simp only [finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq'],
-- end

theorem sum_succ_eq_sum :
  ∑ (i : fin n.succ), g i = (∑ (i : fin n), g i) + g (fin.last n) :=
begin
  rw fin.sum_univ_cast_succ,
  norm_cast,
end

theorem sum_succ_eq_sum :
  ∑ (i : fin n.succ), g i = (∑ (i : fin n), g i) + g (fin.last n) :=
begin
  rw fin.sum_univ_cast_succ,
  norm_cast,
end

theorem sum_n_succ_ne_n_eq_sum_n:
  ∑ (i : fin n.succ) in finset.univ.filter (λ x : fin n.succ, x ≠ n), g i
  = ∑ i : fin n, g i :=
begin
  let n_set := @finset.univ (fin n) _,
  have h : n_set.map (fin.succ_above (n)).to_embedding = (@finset.univ (fin n.succ) _).filter (λ x : fin n.succ, x ≠ n) :=
  begin
    ext,
    rw finset.mem_filter,
    rw finset.mem_map,
    split,
    intro h,
    cases h with i h,
    cases h with hi h,
    split,
    exact finset.mem_univ a,
    intro c,
    rw c at h,
    simp only [nat.cast_succ, rel_embedding.coe_fn_to_embedding] at h,
    exact fin.succ_above_ne (n) i h,
    intro h,
    use (↑a),
    have := fin.is_le a,
    cases h with h1 h2,
    rw fin.ne_iff_vne at h2,
    rw fin.val_eq_coe at h2,
    rw fin.val_eq_coe at h2,
    rw fin.coe_of_nat_eq_mod at h2,
    rw nat.mod_eq_of_lt at h2,
    exact lt_of_le_of_ne this h2,
    exact nat.lt_succ_self n,
    split,
    simp only [finset.mem_univ],
    simp only [rel_embedding.coe_fn_to_embedding],
    rw fin.succ_above_below,
    simp only [eq_self_iff_true, fin.cast_succ_mk, fin.eta],
    simp only [fin.cast_succ_mk, fin.eta],
    have := fin.is_le a,
    cases h with h1 h2,
    rw fin.lt_def,
    simp only [fin.val_eq_coe, fin.coe_of_nat_eq_mod],
    rw nat.mod_eq_of_lt,
    rw fin.ne_iff_vne at h2,
    rw fin.val_eq_coe at h2,
    rw fin.val_eq_coe at h2,
    rw fin.coe_of_nat_eq_mod at h2,
    rw nat.mod_eq_of_lt at h2,
    apply lt_of_le_of_ne this _,
    exact h2,
    exact nat.lt_succ_self n,
    exact nat.lt_succ_self n,
  end,
  rw ← h,
  simp only [fin.coe_eq_cast_succ, finset.sum_map, rel_embedding.coe_fn_to_embedding, finset.sum_congr],
  congr,
  ext,
  rw fin.succ_above_below,
  have := fin.cast_succ_lt_last x,
  rw fin.lt_def at this,
  simp only [fin.val_eq_coe, fin.coe_last, fin.coe_cast_succ] at this,
  rw fin.lt_def,
  simp only [fin.val_eq_coe, fin.coe_cast_succ, fin.coe_of_nat_eq_mod],
  rw nat.mod_eq_of_lt,
  exact this,
  exact nat.lt_succ_self n,
end

theorem sum_split_last (f : fin n.succ → ℝ) : ∑ (i : fin n.succ), f i
  = ∑ (i : fin n), f i + f n :=
begin
  rw sum_split_singleton (n : fin n.succ),
  rw sum_n_succ_ne_n_eq_sum_n,
end

theorem sum_nonneg_of_nonneg (h : ∀ i : fin n, 0 ≤ f i) : 0 ≤ ∑ i : fin n, f i :=
begin
  have : ∀ (i : fin n), i ∈ @finset.univ (fin n) _ → 0 ≤ f i :=
  begin
    intros i hi,
    exact h i,
  end,
  exact finset.sum_nonneg this,
end

-- theorem sum_nonneg_of_nonneg (h : ∀ i : fin n, 0 ≤ f i) : 0 ≤ ∑ i : fin n, f i :=
-- begin
--   induction n with n h0,
--   simp only [le_refl, finset.sum_empty, finset.sum_congr, fintype.univ_of_is_empty],
--   rw sum_split_singleton (n : fin n.succ),
--   rw sum_n_succ_ne_n_eq_sum_n,
--   let g := f ∘ fin.succ_above n,
--   have : ∀ i : fin n, 0 ≤ g i :=
--   begin
--     intro i,
--     change 0 ≤ (f ∘ fin.succ_above n) i,
--     rw function.comp_app,
--     exact h _,
--   end,
--   have hg: ∀ i : fin n, g i = f i := λ i,
--   begin
--     simp only [g],
--     rw function.comp_app,
--     rw fin.succ_above_below,
--     rw fin.coe_eq_cast_succ,
--     rw [fin.lt_def, fin.val_eq_coe, fin.val_eq_coe, fin.coe_cast_succ, fin.coe_of_nat_eq_mod],
--     rw nat.mod_eq_of_lt (nat.lt_succ_self n),
--     apply fin.cast_succ_lt_last,
--   end,
--   simp_rw ← hg,
--   apply add_nonneg,
--   exact h0 this,
--   exact h n,
-- end

#check (fintype(fin n))
#check @finset.univ (fin n) (fin.fintype n) -- : finset (fin n)


-- =====================================================================
-- § Resumen                                                          --
-- =====================================================================

-- En esta relación se demostrará que
-- + la imagen de un espacio compacto mediante una función continua es
--   compacta.
-- + Los subconjuntos cerrados de un espacio compacto son compactos.
--
-- Concretamente, lo que demostraremos es que
-- + Si `f : X → Y` es una función continua y `S : set X` es un conjunto
--   compacto (con la subtopología), entonces `f '' S` (la imagen de `S`
--   por `f`) es compacto (con la subtopología).
-- + Si `X` es unespacio topológico, `S` es un subconjunto compacto y
--   `C` es un subconjunto cerrado, entonces `S ∩ C` es un subconjunto
--   compacto.
--
-- Los resultados originales son los casos particulares cuando `S` es
-- `univ : set X`.

-- ---------------------------------------------------------------------
-- Ejercicio. Importar la teoría de las propiedades de los subconjuntos
-- de los espacios topológicos.
-- ---------------------------------------------------------------------

import topology.subset_properties

-- =====================================================================
-- § Introducción                                                     --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar
-- + X e Y como variables sobre espacios topológicos.
-- + f como variable sobre las funciones de x en Y.
-- ---------------------------------------------------------------------

variables (X Y : Type) [topological_space X] [topological_space Y]
variable  (f : X → Y)

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir es espacion de nombre set (de los conjuntos).
-- ---------------------------------------------------------------------

open set

-- =====================================================================
-- § Subespacios compactos                                            --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que un subconjunto de un espacio topológico es
-- compacto si de todo recubrimiento abierto se puede extraer un
-- subrecubrimiento finito.
-- ---------------------------------------------------------------------

lemma compact_iff_finite_subcover'
  {α : Type} [topological_space α]
  {S : set α}
  : is_compact S ↔
    (∀ {ι : Type} (U : ι → set α),
       (∀ i, is_open (U i))
       → S ⊆ (⋃ i, U i)
       → (∃ (t : set ι), t.finite ∧ S ⊆ (⋃ i ∈ t, U i))) :=
begin
  rw compact_iff_finite_subcover,
  split,
  { intros hs ι U hU hsU,
    cases hs U hU hsU with F hF,
    use [(↑F : set ι), finset.finite_to_set F],
    exact hF },
  { intros hs ι U hU hsU,
    rcases hs U hU hsU with ⟨F, hFfin, hF⟩,
    use hFfin.to_finset,
    convert hF,
    ext,
    simp }
end

-- =====================================================================
-- § La imagen continua de compactos es compacta                      --
-- =====================================================================

-- Nota: Lemas útiles sobre topología
-- + is_open_compl_iff
--      {α : Type u} [topological_space α]
--      {s : set α}
--      : is_open sᶜ ↔ is_closed s
-- + is_open_preimage
--      {α : Type u_1} [topological_space α]
--      {β : Type u_2} [topological_space β]
--      {f : α → β}
--      (hf : continuous f)
--      {s : set β}
--      (h : is_open s)
--      : is_open (f ⁻¹' s)

/-!

## Continuous image of compact is compact

I would start with `rw compact_iff_finite_subcover' at hS ⊢,`

The proof that I recommend formalising is this. Say `S` is a compact
subset of `X`, and `f : X → Y` is continuous. We want to prove that
every cover of `f '' S` by open subsets of `Y` has a finite subcover.
So let's cover `f '' S` with opens `U i : set Y`, for `i : ι` and `ι` an index type.
Pull these opens back to `V i : set X` and observe that they cover `S`.
Choose a finite subcover corresponding to some `F : set ι` such that `F` is finite
(Lean writes this `h : F.finite`) and then check that the corresponding cover
of `f '' S` by the `U i` with `i ∈ F` is a finite subcover.

Good luck! Please ask questions (or DM me on discord if you don't want to
ask publically). Also feel free to DM me if you manage to do it!

Useful theorems:

`continuous.is_open_preimage` -- preimage of an open set under a
continuous map is open.

`is_open_compl_iff` -- complement `Sᶜ` of `S` is open iff `S` is closed.

## Some useful tactics:

### `specialize`

`specialize` can be used with `_`. If you have a hypothesis

`hS : ∀ {ι : Type} (U : ι → set X), (∀ (i : ι), is_open (U i)) → ...`

and `U : ι → set X`, then

`specialize hS U` will change `hS` to

`hS : (∀ (i : ι), is_open (U i)) → ...`

But what if you now want to prove `∀ i, is_open (U i)` so you can feed it
into `hS` as an input? You can put

`specialize hS _`

and then that goal will pop out. Unfortunately it pops out _under_ the
current goal! You can swap two goals with the `swap` tactic though :-)

### `change`

If your goal is `⊢ P` and `P` is definitionally equal to `Q`, then you
can write `change Q` and the goal will change to `Q`. Sometimes useful
because rewriting works up to syntactic equality, which is stronger
than definitional equality.

### `rwa`

`rwa h` just means `rw h, assumption`

### `contradiction`

If you have `h1 : P` and `h2 : ¬ P` as hypotheses, then you can prove any goal with
the `contradiction` tactic, which just does `exfalso, apply h2, exact h1`.

### `set`

Note : The `set` tactic is totally unrelated to the `set X` type of subsets of `X`!

The `set` tactic can be used to define things. For example
`set T := f '' S with hT_def,` will define `T` to be `f '' S`
and will also define `hT_def : T = f '' S`.

-/

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es continua y S es compacto, entoces la
-- imagen de S por f es compacto.
-- ---------------------------------------------------------------------

-- La idea de la demostración es la siguiente: Sea `S` un subconjunto
-- compacto de `X` y `f : X → Y` continua. Dado `U i : set Y` un
-- recubrimiento abierto de `f '' S`, para cada `i` se define
-- `V i = f ⁻¹' (U i)`. Se rprueba que `V` es un recubriemiento abierto
-- de `S` y, como `S`es compacto, tiene un subrecubrimiento finito. La
-- imágenes de cada conjunto de dicho subrecubrimiento forman un
-- subrecubrimiento finito de `f '' S`.

lemma image_compact_of_compact
  (hf : continuous f)
  (S : set X)
  (hS : is_compact S)
  : is_compact (f '' S) :=
begin
  rw compact_iff_finite_subcover' at *,
  set T := f '' S with hT_def,
  intros ι U hU hcoverU,
  set V : ι → set X := λ i, f ⁻¹' (U i) with hV_def,
  specialize hS V _,
  swap,
  { intro i,
    rw hV_def, dsimp only,
    apply continuous.is_open_preimage hf _ (hU i), },
  { specialize hS _,
    swap,
    { intros x hx,
      have hfx : f x ∈ T,
      { rw hT_def,
        rw mem_image,
        use x,
        use hx,},
      { specialize hcoverU hfx,
        rw mem_Union at hcoverU ⊢,
        exact hcoverU, }},
    { rcases hS with ⟨F, hFfinite, hF⟩,
      use F,
      use hFfinite,
      rintros y ⟨x, hxs, rfl⟩,
      rw subset_def at hF,
      specialize hF x hxs,
      rw mem_bUnion_iff at hF ⊢,
      exact hF, }},
end

-- =====================================================================
-- § Subconjuntos cerrados de compactos                               --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si S es compacto y C es cerrado, entonces
-- `S ∩ C` es compacto.
-- ---------------------------------------------------------------------

lemma closed_of_compact
  (S : set X)
  (hS : is_compact S)
  (C : set X)
  (hC : is_closed C)
  : is_compact (S ∩ C) :=
begin
  rw compact_iff_finite_subcover' at *,
  intros ι U hUopen hSCcover,
  let V : option ι → set X := λ x, option.rec Cᶜ U x,
  specialize hS V _,
  swap,
  { intros i,
    cases i with i,
    { change is_open Cᶜ,
      rwa is_open_compl_iff },
    { change is_open (U i),
      apply hUopen } },
  specialize hS _,
  swap,
  { intros x hxS,
    by_cases hxC : x ∈ C,
    { rw subset_def at hSCcover,
      specialize hSCcover x ⟨hxS, hxC⟩,
      rw mem_Union at ⊢ hSCcover,
      cases hSCcover with i hi,
      use (some i),
      exact hi },
    { rw mem_Union,
      use none } },
  rcases hS with ⟨F, hFfinite, hFcover⟩,
  use (some : ι → option ι) ⁻¹' F,
  split,
  { apply finite.preimage _ hFfinite,
    intros i hi j hj,
    exact option.some_inj.mp },
  rintros x ⟨hxS, hxC⟩,
  rw subset_def at hFcover,
  specialize hFcover x hxS,
  rw mem_bUnion_iff at hFcover ⊢,
  rcases hFcover with ⟨i, hiF, hxi⟩,
  cases i with i,
  { contradiction },
  { use [i, hiF, hxi] },
end


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.fin.ops
! leanprover-community/mathlib commit 3d2e3b75617386cb32de6cbc7e1cd341c6a16adf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Nat.Default
import Leanbin.Init.Data.Fin.Basic

namespace Fin

open Nat

variable {n : Nat}

#print Fin.succ /-
protected def succ : Fin n → Fin (succ n)
  | ⟨a, h⟩ => ⟨Nat.succ a, succ_lt_succ h⟩
#align fin.succ Fin.succ
-/

#print Fin.ofNat /-
def ofNat {n : Nat} (a : Nat) : Fin (succ n) :=
  ⟨a % succ n, Nat.mod_lt _ (Nat.zero_lt_succ _)⟩
#align fin.of_nat Fin.ofNat
-/

private theorem mlt {n b : Nat} : ∀ {a}, n > a → b % n < n
  | 0, h => Nat.mod_lt _ h
  | a + 1, h =>
    have : n > 0 := lt_trans (Nat.zero_lt_succ _) h
    Nat.mod_lt _ this
#align fin.mlt fin.mlt

#print Fin.add /-
protected def add : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a + b) % n, mlt h⟩
#align fin.add Fin.add
-/

#print Fin.mul /-
protected def mul : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨a * b % n, mlt h⟩
#align fin.mul Fin.mul
-/

private theorem sublt {a b n : Nat} (h : a < n) : a - b < n :=
  lt_of_le_of_lt (Nat.sub_le a b) h
#align fin.sublt fin.sublt

#print Fin.sub /-
protected def sub : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨(a + (n - b)) % n, mlt h⟩
#align fin.sub Fin.sub
-/

private theorem modlt {a b n : Nat} (h₁ : a < n) (h₂ : b < n) : a % b < n :=
  by
  cases' b with b
  · simp [mod_zero]
    assumption
  · have h : a % succ b < succ b
    apply Nat.mod_lt _ (Nat.zero_lt_succ _)
    exact lt_trans h h₂
#align fin.modlt fin.modlt

#print Fin.mod /-
protected def mod : Fin n → Fin n → Fin n
  | ⟨a, h₁⟩, ⟨b, h₂⟩ => ⟨a % b, modlt h₁ h₂⟩
#align fin.mod Fin.mod
-/

private theorem divlt {a b n : Nat} (h : a < n) : a / b < n :=
  lt_of_le_of_lt (Nat.div_le_self a b) h
#align fin.divlt fin.divlt

#print Fin.div /-
protected def div : Fin n → Fin n → Fin n
  | ⟨a, h⟩, ⟨b, _⟩ => ⟨a / b, divlt h⟩
#align fin.div Fin.div
-/

instance : Zero (Fin (succ n)) :=
  ⟨⟨0, succ_pos n⟩⟩

instance : One (Fin (succ n)) :=
  ⟨ofNat 1⟩

instance : Add (Fin n) :=
  ⟨Fin.add⟩

instance : Sub (Fin n) :=
  ⟨Fin.sub⟩

instance : Mul (Fin n) :=
  ⟨Fin.mul⟩

instance : Mod (Fin n) :=
  ⟨Fin.mod⟩

instance : Div (Fin n) :=
  ⟨Fin.div⟩

theorem ofNat_zero : @ofNat n 0 = 0 :=
  rfl
#align fin.of_nat_zero Fin.ofNat_zero

/- warning: fin.add_def -> Fin.add_def is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} Nat (Fin.val n (HAdd.hAdd.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHAdd.{0} (Fin n) (Fin.hasAdd n)) a b)) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Fin.val n a) (Fin.val n b)) n)
but is expected to have type
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} (Fin n) (HAdd.hAdd.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHAdd.{0} (Fin n) (Fin.instAddFin n)) a b) (Fin.mk n (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Fin.val n a) (Fin.val n b)) n) (Nat.mod_lt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Fin.val n a) (Fin.val n b)) n (Fin.size_positive n a)))
Case conversion may be inaccurate. Consider using '#align fin.add_def Fin.add_defₓ'. -/
theorem add_def (a b : Fin n) : (a + b).val = (a.val + b.val) % n :=
  show (Fin.add a b).val = (a.val + b.val) % n by cases a <;> cases b <;> simp [Fin.add]
#align fin.add_def Fin.add_def

/- warning: fin.mul_def -> Fin.mul_def is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} Nat (Fin.val n (HMul.hMul.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHMul.{0} (Fin n) (Fin.hasMul n)) a b)) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (Fin.val n a) (Fin.val n b)) n)
but is expected to have type
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} (Fin n) (HMul.hMul.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHMul.{0} (Fin n) (Fin.instMulFin n)) a b) (Fin.mk n (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Fin.val n a) (Fin.val n b)) n) (Nat.mod_lt (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Fin.val n a) (Fin.val n b)) n (Fin.size_positive n a)))
Case conversion may be inaccurate. Consider using '#align fin.mul_def Fin.mul_defₓ'. -/
theorem mul_def (a b : Fin n) : (a * b).val = a.val * b.val % n :=
  show (Fin.mul a b).val = a.val * b.val % n by cases a <;> cases b <;> simp [Fin.mul]
#align fin.mul_def Fin.mul_def

/- warning: fin.sub_def -> Fin.sub_def is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} Nat (Fin.val n (HSub.hSub.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHSub.{0} (Fin n) (Fin.hasSub n)) a b)) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Fin.val n a) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) n (Fin.val n b))) n)
but is expected to have type
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} (Fin n) (HSub.hSub.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHSub.{0} (Fin n) (Fin.instSubFin n)) a b) (Fin.mk n (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Fin.val n a) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) n (Fin.val n b))) n) (Nat.mod_lt (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Fin.val n a) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) n (Fin.val n b))) n (Fin.size_positive n a)))
Case conversion may be inaccurate. Consider using '#align fin.sub_def Fin.sub_defₓ'. -/
theorem sub_def (a b : Fin n) : (a - b).val = (a.val + (n - b.val)) % n := by
  cases a <;> cases b <;> rfl
#align fin.sub_def Fin.sub_def

/- warning: fin.mod_def -> Fin.mod_def is a dubious translation:
lean 3 declaration is
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} Nat (Fin.val n (HMod.hMod.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHMod.{0} (Fin n) (Fin.hasMod n)) a b)) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) (Fin.val n a) (Fin.val n b))
but is expected to have type
  forall {n : Nat} (a : Fin n) (b : Fin n), Eq.{1} (Fin n) (HMod.hMod.{0, 0, 0} (Fin n) (Fin n) (Fin n) (instHMod.{0} (Fin n) (Fin.instModFin n)) a b) (Fin.mk n (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (Fin.val n a) (Fin.val n b)) n) (Nat.mod_lt (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) (Fin.val n a) (Fin.val n b)) n (Fin.size_positive n a)))
Case conversion may be inaccurate. Consider using '#align fin.mod_def Fin.mod_defₓ'. -/
theorem mod_def (a b : Fin n) : (a % b).val = a.val % b.val :=
  show (Fin.mod a b).val = a.val % b.val by cases a <;> cases b <;> simp [Fin.mod]
#align fin.mod_def Fin.mod_def

theorem div_def (a b : Fin n) : (a / b).val = a.val / b.val :=
  show (Fin.div a b).val = a.val / b.val by cases a <;> cases b <;> simp [Fin.div]
#align fin.div_def Fin.div_def

theorem lt_def (a b : Fin n) : (a < b) = (a.val < b.val) :=
  show Fin.Lt a b = (a.val < b.val) by cases a <;> cases b <;> simp [Fin.Lt]
#align fin.lt_def Fin.lt_def

theorem le_def (a b : Fin n) : (a ≤ b) = (a.val ≤ b.val) :=
  show Fin.Le a b = (a.val ≤ b.val) by cases a <;> cases b <;> simp [Fin.Le]
#align fin.le_def Fin.le_def

/- warning: fin.val_zero clashes with fin.coe_zero -> Fin.val_zero
warning: fin.val_zero -> Fin.val_zero is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, Eq.{1} Nat (Fin.val (Nat.succ n) (OfNat.ofNat.{0} (Fin (Nat.succ n)) 0 (OfNat.mk.{0} (Fin (Nat.succ n)) 0 (Zero.zero.{0} (Fin (Nat.succ n)) (Fin.hasZero n))))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))
but is expected to have type
  forall (n : Nat) [inst._@.Mathlib.Data.Fin.Basic._hyg.2326 : NeZero.{0} Nat (LinearOrderedCommMonoidWithZero.toZero.{0} Nat Nat.linearOrderedCommMonoidWithZero) n], Eq.{1} Nat (Fin.val n (OfNat.ofNat.{0} (Fin n) 0 (Zero.toOfNat0.{0} (Fin n) (Fin.instZeroFin n inst._@.Mathlib.Data.Fin.Basic._hyg.2326)))) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))
Case conversion may be inaccurate. Consider using '#align fin.val_zero Fin.val_zeroₓ'. -/
theorem val_zero : (0 : Fin (succ n)).val = 0 :=
  rfl
#align fin.val_zero Fin.val_zero

#print Fin.pred /-
def pred {n : Nat} : ∀ i : Fin (succ n), i ≠ 0 → Fin n
  | ⟨a, h₁⟩, h₂ =>
    ⟨a.pred,
      haveI : a ≠ 0 := by
        have aux₁ := vne_of_ne h₂
        dsimp at aux₁
        rw [val_zero] at aux₁
        exact aux₁
      Nat.pred_lt_pred this h₁⟩
#align fin.pred Fin.pred
-/

end Fin


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/
import order.min_max
import order.rel_classes
import data.set.intervals.basic

/-!
# Bounded and unbounded sets

We prove miscellaneous lemmas about bounded and unbounded sets. Many of these are just variations on
the same ideas, or similar results with a few minor differences. The file is divided into these
different general ideas.
-/

namespace set
variables {α : Type*} {r : α → α → Prop} {s t : set α}

/-! ### Subsets of bounded and unbounded sets -/

theorem bounded.mono (hst : s ⊆ t) (hs : bounded r t) : bounded r s :=
hs.imp $ λ a ha b hb, ha b (hst hb)

theorem unbounded.mono (hst : s ⊆ t) (hs : unbounded r s) : unbounded r t :=
λ a, let ⟨b, hb, hb'⟩ := hs a in ⟨b, hst hb, hb'⟩

/-! ### Alternate characterizations of unboundedness on orders -/

lemma unbounded_le_of_forall_exists_lt [preorder α] (h : ∀ a, ∃ b ∈ s, a < b) : unbounded (≤) s :=
λ a, let ⟨b, hb, hb'⟩ := h a in ⟨b, hb, λ hba, hba.not_lt hb'⟩

lemma unbounded_le_iff [linear_order α] : unbounded (≤) s ↔ ∀ a, ∃ b ∈ s, a < b :=
by simp only [unbounded, not_le]

lemma unbounded_lt_of_forall_exists_le [preorder α] (h : ∀ a, ∃ b ∈ s, a ≤ b) : unbounded (<) s :=
λ a, let ⟨b, hb, hb'⟩ := h a in ⟨b, hb, λ hba, hba.not_le hb'⟩

lemma unbounded_lt_iff [linear_order α] : unbounded (<) s ↔ ∀ a, ∃ b ∈ s, a ≤ b :=
by simp only [unbounded, not_lt]

lemma unbounded_ge_of_forall_exists_gt [preorder α] (h : ∀ a, ∃ b ∈ s, b < a) : unbounded (≥) s :=
@unbounded_le_of_forall_exists_lt αᵒᵈ _ _ h

lemma unbounded_ge_iff [linear_order α] : unbounded (≥) s ↔ ∀ a, ∃ b ∈ s, b < a :=
⟨λ h a, let ⟨b, hb, hba⟩ := h a in ⟨b, hb, lt_of_not_ge hba⟩, unbounded_ge_of_forall_exists_gt⟩

lemma unbounded_gt_of_forall_exists_ge [preorder α] (h : ∀ a, ∃ b ∈ s, b ≤ a) : unbounded (>) s :=
λ a, let ⟨b, hb, hb'⟩ := h a in ⟨b, hb, λ hba, not_le_of_gt hba hb'⟩

lemma unbounded_gt_iff [linear_order α] : unbounded (>) s ↔ ∀ a, ∃ b ∈ s, b ≤ a :=
⟨λ h a, let ⟨b, hb, hba⟩ := h a in ⟨b, hb, le_of_not_gt hba⟩, unbounded_gt_of_forall_exists_ge⟩

/-! ### Relation between boundedness by strict and nonstrict orders. -/

/-! #### Less and less or equal -/

lemma bounded.rel_mono {r' : α → α → Prop} (h : bounded r s) (hrr' : r ≤ r') : bounded r' s :=
let ⟨a, ha⟩ := h in ⟨a, λ b hb, hrr' b a (ha b hb)⟩

lemma bounded_le_of_bounded_lt [preorder α] (h : bounded (<) s) : bounded (≤) s :=
h.rel_mono $ λ _ _, le_of_lt

lemma unbounded.rel_mono {r' : α → α → Prop} (hr : r' ≤ r) (h : unbounded r s) : unbounded r' s :=
λ a, let ⟨b, hb, hba⟩ := h a in ⟨b, hb, λ hba', hba (hr b a hba')⟩

lemma unbounded_lt_of_unbounded_le [preorder α] (h : unbounded (≤) s) :
  unbounded (<) s :=
h.rel_mono $ λ _ _, le_of_lt

lemma bounded_le_iff_bounded_lt [preorder α] [no_max_order α] : bounded (≤) s ↔ bounded (<) s :=
begin
  refine ⟨λ h, _, bounded_le_of_bounded_lt⟩,
  cases h with a ha,
  cases exists_gt a with b hb,
  exact ⟨b, λ c hc, lt_of_le_of_lt (ha c hc) hb⟩
end

lemma unbounded_lt_iff_unbounded_le [preorder α] [no_max_order α] :
  unbounded (<) s ↔ unbounded (≤) s :=
by simp_rw [← not_bounded_iff, bounded_le_iff_bounded_lt]

/-! #### Greater and greater or equal -/

lemma bounded_ge_of_bounded_gt [preorder α] (h : bounded (>) s) : bounded (≥) s :=
let ⟨a, ha⟩ := h in ⟨a, λ b hb, le_of_lt (ha b hb)⟩

lemma unbounded_gt_of_unbounded_ge [preorder α] (h : unbounded (≥) s) : unbounded (>) s :=
λ a, let ⟨b, hb, hba⟩ := h a in ⟨b, hb, λ hba', hba (le_of_lt hba')⟩

lemma bounded_ge_iff_bounded_gt [preorder α] [no_min_order α] : bounded (≥) s ↔ bounded (>) s :=
@bounded_le_iff_bounded_lt αᵒᵈ _ _ _

lemma unbounded_gt_iff_unbounded_ge [preorder α] [no_min_order α] :
  unbounded (>) s ↔ unbounded (≥) s :=
@unbounded_lt_iff_unbounded_le αᵒᵈ _ _ _

/-! ### The universal set -/

theorem unbounded_le_univ [has_le α] [no_top_order α] : unbounded (≤) (@set.univ α) :=
λ a, let ⟨b, hb⟩ := exists_not_le a in ⟨b, ⟨⟩, hb⟩

theorem unbounded_lt_univ [preorder α] [no_top_order α] : unbounded (<) (@set.univ α) :=
unbounded_lt_of_unbounded_le unbounded_le_univ

theorem unbounded_ge_univ [has_le α] [no_bot_order α] : unbounded (≥) (@set.univ α) :=
λ a, let ⟨b, hb⟩ := exists_not_ge a in ⟨b, ⟨⟩, hb⟩

theorem unbounded_gt_univ [preorder α] [no_bot_order α] : unbounded (>) (@set.univ α) :=
unbounded_gt_of_unbounded_ge unbounded_ge_univ

/-! ### Bounded and unbounded intervals -/

theorem bounded_self (a : α) : bounded r {b | r b a} :=
⟨a, λ x, id⟩

/-! #### Half-open bounded intervals -/

theorem bounded_le_Iio [preorder α] (a : α) : bounded (≤) (set.Iio a) :=
bounded_le_of_bounded_lt (bounded_lt_Iio a)

theorem bounded_le_Iic [preorder α] (a : α) : bounded (≤) (set.Iic a) :=
bounded_self a

theorem bounded_lt_Iic [preorder α] [no_max_order α] (a : α) : bounded (<) (set.Iic a) :=
by simp only [← bounded_le_iff_bounded_lt, bounded_le_Iic]

theorem bounded_gt_Ioi [preorder α] (a : α) : bounded (>) (set.Ioi a) :=
bounded_self a

theorem bounded_ge_Ioi [preorder α] (a : α) : bounded (≥) (set.Ioi a) :=
bounded_ge_of_bounded_gt (bounded_gt_Ioi a)

theorem bounded_ge_Ici [preorder α] (a : α) : bounded (≥) (set.Ici a) :=
bounded_self a

theorem bounded_gt_Ici [preorder α] [no_min_order α] (a : α) : bounded (>) (set.Ici a) :=
by simp only [← bounded_ge_iff_bounded_gt, bounded_ge_Ici]

/-! #### Other bounded intervals -/

theorem bounded_lt_Ioo [preorder α] (a b : α) : bounded (<) (set.Ioo a b) :=
(bounded_lt_Iio b).mono set.Ioo_subset_Iio_self

theorem bounded_lt_Ico [preorder α] (a b : α) : bounded (<) (set.Ico a b) :=
(bounded_lt_Iio b).mono set.Ico_subset_Iio_self

theorem bounded_lt_Ioc [preorder α] [no_max_order α] (a b : α) : bounded (<) (set.Ioc a b) :=
(bounded_lt_Iic b).mono set.Ioc_subset_Iic_self

theorem bounded_lt_Icc [preorder α] [no_max_order α] (a b : α) : bounded (<) (set.Icc a b) :=
(bounded_lt_Iic b).mono set.Icc_subset_Iic_self

theorem bounded_le_Ioo [preorder α] (a b : α) : bounded (≤) (set.Ioo a b) :=
(bounded_le_Iio b).mono set.Ioo_subset_Iio_self

theorem bounded_le_Ico [preorder α] (a b : α) : bounded (≤) (set.Ico a b) :=
(bounded_le_Iio b).mono set.Ico_subset_Iio_self

theorem bounded_le_Ioc [preorder α] (a b : α) : bounded (≤) (set.Ioc a b) :=
(bounded_le_Iic b).mono set.Ioc_subset_Iic_self

theorem bounded_le_Icc [preorder α] (a b : α) : bounded (≤) (set.Icc a b) :=
(bounded_le_Iic b).mono set.Icc_subset_Iic_self

theorem bounded_gt_Ioo [preorder α] (a b : α) : bounded (>) (set.Ioo a b) :=
(bounded_gt_Ioi a).mono set.Ioo_subset_Ioi_self

theorem bounded_gt_Ioc [preorder α] (a b : α) : bounded (>) (set.Ioc a b) :=
(bounded_gt_Ioi a).mono set.Ioc_subset_Ioi_self

theorem bounded_gt_Ico [preorder α] [no_min_order α] (a b : α) : bounded (>) (set.Ico a b) :=
(bounded_gt_Ici a).mono set.Ico_subset_Ici_self

theorem bounded_gt_Icc [preorder α] [no_min_order α] (a b : α) : bounded (>) (set.Icc a b) :=
(bounded_gt_Ici a).mono set.Icc_subset_Ici_self

theorem bounded_ge_Ioo [preorder α] (a b : α) : bounded (≥) (set.Ioo a b) :=
(bounded_ge_Ioi a).mono set.Ioo_subset_Ioi_self

theorem bounded_ge_Ioc [preorder α] (a b : α) : bounded (≥) (set.Ioc a b) :=
(bounded_ge_Ioi a).mono set.Ioc_subset_Ioi_self

theorem bounded_ge_Ico [preorder α] (a b : α) : bounded (≥) (set.Ico a b) :=
(bounded_ge_Ici a).mono set.Ico_subset_Ici_self

theorem bounded_ge_Icc [preorder α] (a b : α) : bounded (≥) (set.Icc a b) :=
(bounded_ge_Ici a).mono set.Icc_subset_Ici_self

/-! #### Unbounded intervals -/

theorem unbounded_le_Ioi [semilattice_sup α] [no_max_order α] (a : α) : unbounded (≤) (set.Ioi a) :=
λ b, let ⟨c, hc⟩ := exists_gt (a ⊔ b) in
  ⟨c, le_sup_left.trans_lt hc, (le_sup_right.trans_lt hc).not_le⟩

theorem unbounded_le_Ici [semilattice_sup α] [no_max_order α] (a : α) : unbounded (≤) (set.Ici a) :=
(unbounded_le_Ioi a).mono set.Ioi_subset_Ici_self

theorem unbounded_lt_Ioi [semilattice_sup α] [no_max_order α] (a : α) : unbounded (<) (set.Ioi a) :=
unbounded_lt_of_unbounded_le (unbounded_le_Ioi a)

theorem unbounded_lt_Ici [semilattice_sup α] (a : α) : unbounded (<) (set.Ici a) :=
λ b, ⟨a ⊔ b, le_sup_left, le_sup_right.not_lt⟩

/-! ### Bounded initial segments -/

theorem bounded_inter_not (H : ∀ a b, ∃ m, ∀ c, r c a ∨ r c b → r c m) (a : α) :
  bounded r (s ∩ {b | ¬ r b a}) ↔ bounded r s :=
begin
  refine ⟨_, bounded.mono (set.inter_subset_left s _)⟩,
  rintro ⟨b, hb⟩,
  cases H a b with m hm,
  exact ⟨m, λ c hc, hm c (or_iff_not_imp_left.2 (λ hca, (hb c ⟨hc, hca⟩)))⟩
end

theorem unbounded_inter_not (H : ∀ a b, ∃ m, ∀ c, r c a ∨ r c b → r c m) (a : α) :
  unbounded r (s ∩ {b | ¬ r b a}) ↔ unbounded r s :=
by simp_rw [← not_bounded_iff, bounded_inter_not H]

/-! #### Less or equal -/

theorem bounded_le_inter_not_le [semilattice_sup α] (a : α) :
  bounded (≤) (s ∩ {b | ¬ b ≤ a}) ↔ bounded (≤) s :=
bounded_inter_not (λ x y, ⟨x ⊔ y, λ z h, h.elim le_sup_of_le_left le_sup_of_le_right⟩) a

theorem unbounded_le_inter_not_le [semilattice_sup α] (a : α) :
  unbounded (≤) (s ∩ {b | ¬ b ≤ a}) ↔ unbounded (≤) s :=
begin
  rw [←not_bounded_iff, ←not_bounded_iff, not_iff_not],
  exact bounded_le_inter_not_le a
end

theorem bounded_le_inter_lt [linear_order α] (a : α) :
  bounded (≤) (s ∩ {b | a < b}) ↔ bounded (≤) s :=
by simp_rw [← not_le, bounded_le_inter_not_le]

theorem unbounded_le_inter_lt [linear_order α] (a : α) :
  unbounded (≤) (s ∩ {b | a < b}) ↔ unbounded (≤) s :=
by { convert unbounded_le_inter_not_le a, ext, exact lt_iff_not_le }

theorem bounded_le_inter_le [linear_order α] (a : α) :
  bounded (≤) (s ∩ {b | a ≤ b}) ↔ bounded (≤) s :=
begin
  refine ⟨_, bounded.mono (set.inter_subset_left s _)⟩,
  rw ←@bounded_le_inter_lt _ s _ a,
  exact bounded.mono (λ x ⟨hx, hx'⟩, ⟨hx, le_of_lt hx'⟩)
end

theorem unbounded_le_inter_le [linear_order α] (a : α) :
  unbounded (≤) (s ∩ {b | a ≤ b}) ↔ unbounded (≤) s :=
begin
  rw [←not_bounded_iff, ←not_bounded_iff, not_iff_not],
  exact bounded_le_inter_le a
end

/-! #### Less than -/

theorem bounded_lt_inter_not_lt [semilattice_sup α] (a : α) :
  bounded (<) (s ∩ {b | ¬ b < a}) ↔ bounded (<) s :=
bounded_inter_not (λ x y, ⟨x ⊔ y, λ z h, h.elim lt_sup_of_lt_left lt_sup_of_lt_right⟩) a

theorem unbounded_lt_inter_not_lt [semilattice_sup α] (a : α) :
  unbounded (<) (s ∩ {b | ¬ b < a}) ↔ unbounded (<) s :=
begin
  rw [←not_bounded_iff, ←not_bounded_iff, not_iff_not],
  exact bounded_lt_inter_not_lt a
end

theorem bounded_lt_inter_le [linear_order α] (a : α) :
  bounded (<) (s ∩ {b | a ≤ b}) ↔ bounded (<) s :=
by { convert bounded_lt_inter_not_lt a, ext, exact not_lt.symm }

theorem unbounded_lt_inter_le [linear_order α] (a : α) :
  unbounded (<) (s ∩ {b | a ≤ b}) ↔ unbounded (<) s :=
by { convert unbounded_lt_inter_not_lt a, ext, exact not_lt.symm }

theorem bounded_lt_inter_lt [linear_order α] [no_max_order α] (a : α) :
  bounded (<) (s ∩ {b | a < b}) ↔ bounded (<) s :=
begin
  rw [←bounded_le_iff_bounded_lt, ←bounded_le_iff_bounded_lt],
  exact bounded_le_inter_lt a
end

theorem unbounded_lt_inter_lt [linear_order α] [no_max_order α] (a : α) :
  unbounded (<) (s ∩ {b | a < b}) ↔ unbounded (<) s :=
begin
  rw [←not_bounded_iff, ←not_bounded_iff, not_iff_not],
  exact bounded_lt_inter_lt a
end

/-! #### Greater or equal -/

theorem bounded_ge_inter_not_ge [semilattice_inf α] (a : α) :
  bounded (≥) (s ∩ {b | ¬ a ≤ b}) ↔ bounded (≥) s :=
@bounded_le_inter_not_le αᵒᵈ s _ a

theorem unbounded_ge_inter_not_ge [semilattice_inf α] (a : α) :
  unbounded (≥) (s ∩ {b | ¬ a ≤ b}) ↔ unbounded (≥) s :=
@unbounded_le_inter_not_le αᵒᵈ s _ a

theorem bounded_ge_inter_gt [linear_order α] (a : α) :
  bounded (≥) (s ∩ {b | b < a}) ↔ bounded (≥) s :=
@bounded_le_inter_lt αᵒᵈ s _ a

theorem unbounded_ge_inter_gt [linear_order α] (a : α) :
  unbounded (≥) (s ∩ {b | b < a}) ↔ unbounded (≥) s :=
@unbounded_le_inter_lt αᵒᵈ s _ a

theorem bounded_ge_inter_ge [linear_order α] (a : α) :
  bounded (≥) (s ∩ {b | b ≤ a}) ↔ bounded (≥) s :=
@bounded_le_inter_le αᵒᵈ s _ a

theorem unbounded_ge_iff_unbounded_inter_ge [linear_order α] (a : α) :
  unbounded (≥) (s ∩ {b | b ≤ a}) ↔ unbounded (≥) s :=
@unbounded_le_inter_le αᵒᵈ s _ a

/-! #### Greater than -/

theorem bounded_gt_inter_not_gt [semilattice_inf α] (a : α) :
  bounded (>) (s ∩ {b | ¬ a < b}) ↔ bounded (>) s :=
@bounded_lt_inter_not_lt αᵒᵈ s _ a

theorem unbounded_gt_inter_not_gt [semilattice_inf α] (a : α) :
  unbounded (>) (s ∩ {b | ¬ a < b}) ↔ unbounded (>) s :=
@unbounded_lt_inter_not_lt αᵒᵈ s _ a

theorem bounded_gt_inter_ge [linear_order α] (a : α) :
  bounded (>) (s ∩ {b | b ≤ a}) ↔ bounded (>) s :=
@bounded_lt_inter_le αᵒᵈ s _ a

theorem unbounded_inter_ge [linear_order α] (a : α) :
  unbounded (>) (s ∩ {b | b ≤ a}) ↔ unbounded (>) s :=
@unbounded_lt_inter_le αᵒᵈ s _ a

theorem bounded_gt_inter_gt [linear_order α] [no_min_order α] (a : α) :
  bounded (>) (s ∩ {b | b < a}) ↔ bounded (>) s :=
@bounded_lt_inter_lt αᵒᵈ s _ _ a

theorem unbounded_gt_inter_gt [linear_order α] [no_min_order α] (a : α) :
  unbounded (>) (s ∩ {b | b < a}) ↔ unbounded (>) s :=
@unbounded_lt_inter_lt αᵒᵈ s _ _ a

end set


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Leonardo de Moura

Classical proof that if f is injective, then f has a left inverse (if domain is not empty).
The proof uses the classical axioms: choice and excluded middle.
The excluded middle is being used "behind the scenes" to allow us to write the if-then-else expression
with (∃ a : A, f a = b).
-/
open function classical

noncomputable definition mk_left_inv {A B : Type} [h : nonempty A] (f : A → B) : B → A :=
λ b : B, if ex : (∃ a : A, f a = b) then some ex else inhabited.value (inhabited_of_nonempty h)

theorem has_left_inverse_of_injective {A B : Type} {f : A → B} : nonempty A → injective f → has_left_inverse f :=
assume h : nonempty A,
assume inj  : ∀ a₁ a₂, f a₁ = f a₂ → a₁ = a₂,
let  finv : B → A := mk_left_inv f in
have linv : left_inverse finv f, from
  λ a,
    have ex : ∃ a₁ : A, f a₁ = f a, from exists.intro a rfl,
    have h₁ : f (some ex) = f a,    from !some_spec,
    begin
      esimp [mk_left_inv, comp, id],
      rewrite [dif_pos ex],
      exact (!inj h₁)
    end,
exists.intro finv linv


/-
If P and Q are propositions, then P → Q
is a proposition, as well. We just such
an implication to be true if whenever P
is true Q must be true as well. To prove
P → Q, we thus *assume* that P is true
(and in constructive logic this means we
assume we have a proof of it, p : P), and
in the context of this assumption, we show
that Q must be true, in the sense that we
can produce evidence (q : Q) that this is
the case.

This is a long way of saying that to prove
P → Q, we assume we have a proof of P and
in this context we must produce a proof of
Q. In the constructive logic of Lean, this
means we prove P → Q by showing that there
is a function of type P to Q! Of course a
function of this type is really a function
of type ∀ (p : P), Q, which is notation for
Π (p : P), Q which is just a non-dependent
function type, P → Q. It all makes sense!
-/

lemma and_commutes' : ∀ {P Q : Prop}, P ∧ Q → Q ∧ P :=
λ P Q, λ h, and.intro (h.right) (h.left)

/-
This is the introduction rule for →. Assume
you have a proof of the antcedent (P ∧ Q in
this case) and show that in that context
there is a proof of the conclusion (Q ∧ P).
-/

/-
Elimination
-/
axioms (Person : Type) (fromCville : Person → Prop)
axioms (Kevin Liu : Person) (kfc : fromCville Kevin) (lfc : fromCville Liu)

-- let's construct a proof of fromCville Kevin ∧ fromCville Liu (P ∧ Q)
theorem bfc : fromCville Kevin ∧ fromCville Liu := and.intro kfc lfc

#check bfc
#reduce bfc

-- now we can *apply* and_commutes' to derive a proof of (Q ∧ P)

#check and_commutes' bfc
#reduce and_commutes' bfc


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

import group_theory.quotient_group
import set_theory.fincard

/-!
# Index of a Subgroup

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

## Main definitions

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

# Main results

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

-/

namespace subgroup

open_locale cardinal

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

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

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

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

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

variables {H K L}

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

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

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

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

variables (H K L)

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

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

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

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

variables {H K}

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

variables (H K)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

variables {H}

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

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

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

end subgroup


/-
Copyright (c) 2021 Arthur Paulino. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Arthur Paulino, Kyle Miller
-/

import combinatorics.simple_graph.coloring

/-!
# Graph partitions

This module provides an interface for dealing with partitions on simple graphs. A partition of
a graph `G`, with vertices `V`, is a set `P` of disjoint nonempty subsets of `V` such that:

* The union of the subsets in `P` is `V`.

* Each element of `P` is an independent set. (Each subset contains no pair of adjacent vertices.)

Graph partitions are graph colorings that do not name their colors.  They are adjoint in the
following sense. Given a graph coloring, there is an associated partition from the set of color
classes, and given a partition, there is an associated graph coloring from using the partition's
subsets as colors.  Going from graph colorings to partitions and back makes a coloring "canonical":
all colors are given a canonical name and unused colors are removed.  Going from partitions to
graph colorings and back is the identity.

## Main definitions

* `simple_graph.partition` is a structure to represent a partition of a simple graph

* `simple_graph.partition.parts_card_le` is whether a given partition is an `n`-partition.
  (a partition with at most `n` parts).

* `simple_graph.partitionable n` is whether a given graph is `n`-partite

* `simple_graph.partition.to_coloring` creates colorings from partitions

* `simple_graph.coloring.to_partition` creates partitions from colorings

## Main statements

* `simple_graph.partitionable_iff_colorable` is that `n`-partitionability and
  `n`-colorability are equivalent.

-/

universes u v

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

/--
A `partition` of a simple graph `G` is a structure constituted by
* `parts`: a set of subsets of the vertices `V` of `G`
* `is_partition`: a proof that `parts` is a proper partition of `V`
* `independent`: a proof that each element of `parts` doesn't have a pair of adjacent vertices
-/
structure partition :=
(parts : set (set V))
(is_partition : setoid.is_partition parts)
(independent : ∀ (s ∈ parts), is_antichain G.adj s)

/-- Whether a partition `P` has at most `n` parts. A graph with a partition
satisfying this predicate called `n`-partite. (See `simple_graph.partitionable`.) -/
def partition.parts_card_le {G : simple_graph V} (P : G.partition) (n : ℕ) : Prop :=
∃ (h : P.parts.finite), h.to_finset.card ≤ n

/-- Whether a graph is `n`-partite, which is whether its vertex set
can be partitioned in at most `n` independent sets. -/
def partitionable (n : ℕ) : Prop :=
∃ (P : G.partition), P.parts_card_le n

namespace partition
variables {G} (P : G.partition)

/-- The part in the partition that `v` belongs to -/
def part_of_vertex (v : V) : set V :=
classical.some (P.is_partition.2 v)

lemma part_of_vertex_mem (v : V) : P.part_of_vertex v ∈ P.parts :=
by { obtain ⟨h, -⟩ := (P.is_partition.2 v).some_spec.1, exact h, }

lemma mem_part_of_vertex (v : V) : v ∈ P.part_of_vertex v :=
by { obtain ⟨⟨h1, h2⟩, h3⟩ := (P.is_partition.2 v).some_spec, exact h2.1 }

lemma part_of_vertex_ne_of_adj {v w : V} (h : G.adj v w) :
  P.part_of_vertex v ≠ P.part_of_vertex w :=
begin
  intro hn,
  have hw := P.mem_part_of_vertex w,
  rw ←hn at hw,
  have h' := P.independent _ (P.part_of_vertex_mem v) _ (P.mem_part_of_vertex v),
  exact h' w hw (G.ne_of_adj h) h,
end

/-- Create a coloring using the parts themselves as the colors.
Each vertex is colored by the part it's contained in. -/
def to_coloring : G.coloring P.parts :=
coloring.mk (λ v, ⟨P.part_of_vertex v, P.part_of_vertex_mem v⟩) $ λ _ _ hvw,
by { rw [ne.def, subtype.mk_eq_mk], exact P.part_of_vertex_ne_of_adj hvw }

/-- Like `simple_graph.partition.to_coloring` but uses `set V` as the coloring type. -/
def to_coloring' : G.coloring (set V) :=
coloring.mk P.part_of_vertex $ λ _ _ hvw, P.part_of_vertex_ne_of_adj hvw

lemma to_colorable [fintype P.parts] : G.colorable (fintype.card P.parts) :=
P.to_coloring.to_colorable

end partition

variables {G}

/-- Creates a partition from a coloring. -/
@[simps]
def coloring.to_partition {α : Type v} (C : G.coloring α) : G.partition :=
{ parts := C.color_classes,
  is_partition := C.color_classes_is_partition,
  independent := begin
    rintros s ⟨c, rfl⟩,
    apply C.color_classes_independent,
  end }

instance : inhabited (partition G) := ⟨G.self_coloring.to_partition⟩

lemma partitionable_iff_colorable {n : ℕ} :
  G.partitionable n ↔ G.colorable n :=
begin
  split,
  { rintro ⟨P, hf, h⟩,
    haveI : fintype P.parts := hf.fintype,
    rw set.finite.card_to_finset at h,
    apply P.to_colorable.of_le h, },
  { rintro ⟨C⟩,
    refine ⟨C.to_partition, C.color_classes_finite_of_fintype, le_trans _ (fintype.card_fin n).le⟩,
    generalize_proofs h,
    haveI : fintype C.color_classes := C.color_classes_finite_of_fintype.fintype,
    rw h.card_to_finset,
    exact C.card_color_classes_le },
end

end simple_graph


/-
A logic is a "formal language" that has
a mathematically defined syntax and a
mathematically defined semantics.

We now drill down on the notions of the
syntax and semantics of a formal language.
The syntax of a language defines the set
of valid expressions in the language. In
predicate logic, for example, ∀ p: Person,
∃ m : Person, motherOf p m is syntactically
well formed, but ()∀ ∃ r() is not.

The semantics of a language then assigns
a meaning each "well formed" expression
in the language.

When the formal language is a logic, the
syntax defines a language of propositions,
predicates, etc., while a semantics tells
us how to evaluate the truth of any such
expression.
-/

/-
In this unit we formalize the syntax and
semantics of what we call propositional
(as opposed to predicate) logic.

Propositional logic is a very simple logic.
It essentially mirrors (is "isomorphic to")
the language of Boolean expressions.

There are only a few kinds of expressions
in propositional logic. These constitute
the syntax of this formal language.

* "literal expressions" for true and false
* "variable expressions"
* "not expressions"
* "and expressions"
* "or expressions"
* etc.

The semantics then gives us a way to decide
what each expression in a language means.
In propositional logic an expression means
("is") either true or false. Here are the
rules.

* literal true evaluates to true

* literal false evaluates to false

* the value of an "and" expression,
e1 ∧ e2, is the Boolean conjunction
of the values of e1 and e2, resp.

* the value of a "not" expression,
¬ e, is the Boolean negation of the
value of e

* this leaves the question of the value
of a variable expression. For this we
need an additional idea: that of an
interpretation. An interpretation is an
assignment of Boolean values to each of
the variables that might appear in some
expression. Now, to evaluate a variable
expression, X, we just "look up" its value
in a given interpretation. A variable
expression will thus have different values
under different interpretations. Thus,
expressions, in general, because they
generally involve variables, will have
different values under different
interpretations.

We now show you how not only to make these
ideas precise, but how to automate them, in
Lean. You are about to implement your own
simple automated logical reasoning system!
-/

-- Syntax

/-
We formalize the syntax of a language
with an inductive definition of the set
of valid expressions.

An expression in propositional logic
is built from a (1) a logical constant,
true or false, (2) a propositional (you
can think "Boolean") variable, or (3) a
logical connective (and, or, not, etc)
and one or more smaller expressions.
-/

/-
To formalize this idea, we need to
define what we mean by a variable.
We do with with a new type, pVar,
where each such variable holds a ℕ
value that distinguishes it from any
other propVar.
-/

inductive pVar : Type
| mk : ℕ → pVar

-- Examples

#check (pVar.mk 0)

-- Nice names for a few pVars

def X := pVar.mk 0
def Y := pVar.mk 1
def Z := pVar.mk 2
def W := pVar.mk 3

/-
Now we formalize a language of
expressions in propositional logic.
-/

inductive pExp : Type
| mk_lit_pexp : bool → pExp
| mk_var_pexp : pVar → pExp
| mk_not_pexp : pExp → pExp
| mk_and_pexp : pExp → pExp → pExp

open pExp

-- Examples of expressions

def false_exp := mk_lit_pexp ff
#check false_exp

def true_exp := mk_lit_pexp tt

def X_exp := mk_var_pexp X
def Y_exp := mk_var_pexp Y
def Z_exp := mk_var_pexp Z
#reduce Z_exp

def not_X_exp := mk_not_pexp X_exp
def and_X_Y_exp := mk_and_pexp X_exp Y_exp
def and_X_Z_exp := mk_and_pexp X_exp Z_exp
#reduce and_X_Z_exp

-- syntactic sugar!

notation e1 ∧ e2 :=  mk_and_pexp e1 e2
notation ¬ e := mk_not_pexp e

-- expressions using our notation!
def not_X_exp' := ¬ X_exp
def and_X_Y_exp' := X_exp ∧ Y_exp
def and_X_Z_exp' := X_exp ∧ Z_exp

-- Quiz

def tf := (mk_lit_pexp tt) ∧ (mk_lit_pexp ff)
def nt := ¬ (mk_lit_pexp tt)
def nxy := ¬ (X_exp ∧ Y_exp)
def foo := nt ∧ nxy
def bar := (¬ nxy) ∧ foo
def baz : pExp := tf

def jab := ¬ (X_exp ∧ Y_exp)
#reduce jab

-- Semantics

/-
To formalize a semantics for our
realization of propositional logic,
we need to formally define what we
mean by an interpretation.

An interpretation in propositional
logic is a function from propositional
variables to corresponding (Boolean)
truth values. An interpretation tells
us what each variable "means" -- i.e.,
whether it means true, or false.

We now define a name for the type
of an interpretation (pVar → bool).
Then we present several examples of
interpretations.
-/

def pInterp := pVar → bool

-- an "all false" interpretation
def falseInterp (v : pVar) : bool :=
    ff

-- an "all true" interpretation
def trueInterp (v : pVar) :=
    tt

-- X = tt, Y=ff, Z=tt, _ = ff

def anInterp: pInterp :=
λ(v: pVar),
  match v with
  | (pVar.mk 0) := tt     -- X
  | (pVar.mk 1) := ff     -- Y
  | (pVar.mk 2) := tt     -- Z
  | _ := ff               -- otherwise
  end

-- Semantics

/-
We now define a semantics for our
language in the form of a function
that, when given any expression in
our language *and* an interpretation
for the variables that might appear
in it, evaluates its truth value and
returns it as a result.

The definition is by cases, i.e.,
with one rule for each possible form
(constructor) of expression.

Note: Lean "overloads" logical
operator notations, such as ∧, ∨,
and ¬. Here they are applied not to
values of type Prop, but to values
of type bool, where they have their
usual means from Boolean algebra.
-/

def pEval : pExp → pInterp → bool
-- how to evaluate literal expression
| (mk_lit_pexp b) i := b
-- how to evaluate variable expression
| (mk_var_pexp v) i := i v
-- how to evaluate a "not" expression
| (mk_not_pexp e) i := bnot (pEval e i)
-- how to evaluate an "and" expression
| (mk_and_pexp e1 e2) i :=
    band (pEval e1 i) (pEval e2 i)

/-
And now we have a formal language, with
a syntax, interpretations, and semantics.
Let's evaluate some of our expressions
under varying interpretations.
-/

-- literal expressions

/-
#reduce pEval tt_exp falseInterp
#reduce pEval tt_exp trueInterp
#reduce pEval tt_exp anInterp

#reduce pEval ff_exp falseInterp
#reduce pEval ff_exp trueInterp
#reduce pEval ff_exp anInterp
-/

-- variable expressions
#reduce pEval X_exp falseInterp
#reduce pEval X_exp trueInterp
#reduce pEval X_exp anInterp

#reduce pEval Y_exp falseInterp
#reduce pEval Y_exp trueInterp
#reduce pEval Y_exp anInterp

#reduce pEval Z_exp falseInterp
#reduce pEval Z_exp trueInterp
#reduce pEval Z_exp anInterp

#reduce pEval (mk_var_pexp W) falseInterp
#reduce pEval (mk_var_pexp W) trueInterp
#reduce pEval (mk_var_pexp W) anInterp

-- We don't have to give variables names
#reduce pEval (mk_var_pexp (pVar.mk 10)) anInterp

-- not expression
#reduce pEval not_X_exp falseInterp
#reduce pEval not_X_exp trueInterp
#reduce pEval not_X_exp anInterp

-- and expressio
#reduce pEval and_X_Z_exp falseInterp
#reduce pEval and_X_Z_exp trueInterp
#reduce pEval and_X_Z_exp anInterp

#reduce pEval and_X_Z_exp' falseInterp
#reduce pEval and_X_Z_exp' trueInterp
#reduce pEval and_X_Z_exp' anInterp

#reduce pEval and_X_Y_exp anInterp

/-
So there you have it: a complete
formal definition of the syntax,
interpretation, and semantics of
propositional logic, in Lean, with
a nice "surface syntax," to boot.
(Ok, it's complete except for the
definitions for the other logical
connectives. You will add some of
them in homework and on the exam.)
-/

/-
From here, we can define richer
functions, such as functions that
analyze expressions; and we can
even state and prove theorems
about our language.
-/

/-
Let's define a function that
returns the set of variables
in a given pExp. This will be
useful in the future.
-/

/-
We start by defining a recursive
helper function that adds all the
variables in given expression to
the given, often already non-empty,
set of variables.

Understand the type and purpose of
this function, then go on to read
the following main function. Study
its purpose, type, and implementation,
then come back for a deeper look at
how this function is implemented.
Learn to use functions knowing only
their type and purpose, ignoring, at
least at first, their implementation
details. Pratice mental abstracting.

We implement (prove) this recursive
function (type) by case analysis on
possible forms of the given pExp.
-/
def vars_in_exp_helper:
    pExp → set pVar → set pVar

-- literal expressions add no variables to the set
| (mk_lit_pexp _) s := s
-- a variable expression adds variable v to the set
| (mk_var_pexp v) s := s ∪ { v }
-- a (not e) expression adds the variables in e
| (mk_not_pexp e) s :=
    s ∪ (vars_in_exp_helper e s)
-- an (and e1 e2), add the variables in e1 and e2
| (mk_and_pexp e1 e2) s :=
    s ∪
    (vars_in_exp_helper e1 s) ∪
    (vars_in_exp_helper e2 s)

/-
Main function: a non-recursive function
that passes an initially empty set of
variables to the helper function and
then gets back a set of all, and only,
the variables in the given expression.
-/
def vars_in_exp (e: pExp) : set pVar :=
    vars_in_exp_helper e ({}: set pVar)

/-
Examples of its use
-/
#reduce vars_in_exp and_X_Y_exp
-- A predicate defining the set { X, Y

/-
Another example
-/
#reduce vars_in_exp and_X_Z_exp

/-
EXERCISE: Write a function that when
given an expression, e, returns the
"nesting depth" of the expression. The
nesting depth of a literal or variable
expression is 1. The depth of a (not e)
expression is 1 + the depth of e. And
the depth of an (and e1 e2) expression
is 1 + the max of the depths of e1 and
e2. You can use the Lean-provided max
function in your answer.
-/

#reduce max 5 7
#reduce max 7 5

/-
We can also prove theorems about
our language in general. Here's a
proof that evaluation under a given
interpretation is "deterministic::
it always produces the same result.

This is really just a corollary of
the facts that (1) functions in Lean
are single valued and (2) we defined
the semantics of expressions with a
function. There's one and only one
answer for the value of any given
expression.
-/

theorem pEval_deterministic :
∀ e : pExp,
∀ i : pInterp,
∀ v1 v2 : bool,
v1 = pEval e i → v2 = pEval e i → v1 = v2 :=
begin
intros e i v1 v2 h_v1 h_v2,
rw h_v1,
rw h_v2,
end

/-
We can also prove theorems ("reason
about") particular expressions, or
certain classes of expressions, in
our language. For example, if X_exp
is any variable expression, then the
expression (X_exp ∧ (¬ X_exp)) is
false under any interpretation. We
can easily prove this proposition.
-/

theorem contra :
∀ V : pVar,
∀ i : pInterp,
pEval
    ((mk_var_pexp V) ∧ ¬ (mk_var_pexp V)) i = ff
:=
begin
intros X i,
simp [pEval],
-- case analysis on result of function!
cases (i X),
left, apply rfl,
right, apply rfl,
end

/-
Note that it is quantified over all
possible interpretations: over all
possible functions from pVar → bool.
Lean supports what is called higher
order predicate logic. Quantifying
over functions and relations is ok
in a higher-order predicate logic.
It is not allowed in the first-order
predicate logic of everyday math and
computer science. Here you can see
that it gives you great expressive
power to be able to quantify over
functions. It gives us a way to say,
"under any possible interpretation",
which is exactly what we need to be
able to say to define satisfiability,
validity, unsatisfiability, etc.
-/

/-
Exercise: Prove that for any
variable, V, the logical expression
(mk_var_exp V) ∨ (¬ (mk_var_exp V))
always evaluates to true.
-/

def valid (e : pExp) : Prop :=
    ∀ i : pInterp, pEval e i = tt

/-
An expression in propositional logic
is unsatisfiable if it does'ot evaluate
to true under any interpretation.
-/

def unsatisfiable (e : pExp) : Prop :=
    ∀ i, pEval e i = ff

/-
You could also have said there does not
exist an i that makes (pEval e i) = tt.
-/

/-
An interpretation that makes an
expression, e, evaluate to true,
is said to be a "model" of that
expression. Here's a predicate
asserting that i is a model of e.
-/

def isModel (i: pInterp) (e : pExp) :=
    pEval e i = tt

/-
An expression is said to be satisfiable
if there is at least one interpretation
under which it evaluates to true.
-/
def satisfiable (e : pExp) : Prop :=
    ∃ i, isModel i e

/-
Example: X ∧ ¬ X is unsatisfiable.
-/

example : unsatisfiable (X_exp ∧ (¬ (X_exp))) :=
begin
unfold unsatisfiable,
intro i,
rw pEval, -- you can do this
rw pEval, -- and do it again
cases (pEval X_exp i), -- cool!
trivial,
trivial,
end

/-
EXERCISE: Once you've extended
our logic with an or operator,
formulize and prove the proposition
that (our rendering of) X ∨ (¬ X)
is valid.

EXERCISE: Prove the proposition
that (X ∨ Y) ∧ Z is satisfiable.
Hint: You'll need a witness. There
is an element of search involved
in solving a problem like this.
-/

/-
EXERCISE: Write a SAT solver based
on what we've done here.
-/

-- m'th bit from right in binary rep of n
def mrbn: ℕ → ℕ → bool
| 0 n := n % 2 = 1
| (nat.succ m') n := mrbn m' (n/2)

/- smoke test
#reduce mrbn 0 15
#reduce mrbn 2 15
#reduce mrbn 2 15
#reduce mrbn 3 15
#reduce mrbn 4 15
#reduce mrbn 5 15
-/

/-
The mth canonical interpretation
among the 2^n-1 interpretations
for a set of variables of size n.

The values of the first n-indexed
variables in the mth interpretation
are determined by the bits in the
binary representation of m. The
leftmost bit gives the value for
the variable with index 0. Each
bit to the left gives the value of
the next indexed variable. All
subsequent values are ff. m thus
effectively enumerates the 2^n
interpretations on the n first
variables in the index set of all
variables.
-/

def mthInterpOf2toN (m n: ℕ) : pInterp :=
    if (m >= 2^n)
    then falseInterp
    else
    λ v : pVar,
        match v with
        | (pVar.mk i) :=
        if i >= n then
        ff
        else
        (mrbn i m)
        end

/-
Examples:
-/

#reduce pEval and_X_Y_exp (mthInterpOf2toN 3 3)

-- unincorporated

#reduce mthInterpOf2toN 3 5

def first_n_true_inter (n : ℕ) : pInterp :=
λ v,
    match v with
    | (pVar.mk n') := if n' < n then tt else ff
    end

def all_models (e : pExp) :=
    { m | isModel m e}

def sat_solve (e : pExp) : option pInterp :=
none


variables P Q R :  Prop

theorem basic_logic : (P → Q) ∧ (Q → R) → (P → R) :=
begin
intro H, -- H is "P implies Q and Q implies R"
intro HP, -- we want P -> R so let's assume P.
have HQ : Q,
exact H.left HP, -- apply P->Q to P to get Q.
-- now we can get the goal
exact H.right HQ
end


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

import tactic

/-

# Prove that there exists infinitely many positive integers n such that
# 4n² + 1 is divisible both by 5 and 13.

This is the third question in Sierpinski's book "250 elementary problems
in number theory".

Maths proof: if n=4 then 4n^2+1=65 is divisible by both 5 and 13
so if n is congruent to 4 mod 5 and mod 13 (i.e if n=4+65*t)
then this will work.

There are various ways to formalise the statement that some set
of naturals is infinite. We suggest two here (although proving
they're the same is fiddly)

-/

-- The number-theoretic heart of the argument.
-- Note that "divides" is `\|` not `|`
lemma divides_of_cong_four (t : ℕ) : 5 ∣ 4 * (65 * t + 4)^2 + 1 ∧
13 ∣ 4 * (65 * t + 4)^2 + 1 :=
begin
  sorry,
end

-- There are arbitrarily large solutions to `5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1`
lemma arb_large_soln : ∀ N : ℕ, ∃ n > N, 5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1 :=
begin
  sorry,
end

-- This is not number theory any more, it's switching between two
-- interpretations of "this set of naturals is infinite".
-- One way is `set.infinite.exists_nat_lt`, the other
-- way is `finset.sup`.
lemma infinite_iff_arb_large (S : set ℕ) : S.infinite ↔ ∀ N, ∃ n > N, n ∈ S :=
begin
  sorry,
end

-- Another way of stating the question (note different "|" symbols:
-- there's `|` for "such that" in set theory and `\|` for "divides" in number theory)
lemma infinite_set_of_solutions : {n : ℕ | 5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1}.infinite :=
begin
  rw infinite_iff_arb_large,
  exact arb_large_soln,
end


import Fd.Init

/-!
# Magma and Other Group-Like Structures

See [magma on wikipedia][magma]. In particular, see [classification by properties][details] for a
breakdown of group-like structures, some of which will appear below.

We avoid mentioning associativity as a desperate attempt to include `Float`s, which have
non-commutative addition/multiplication. However, these operations are **supposed to be**
commutative: most *standards* do require commutativity, but some *implementations* don't actually
respect that. See Ariane 5's crash for instance (I think).

[magma]: https://en.wikipedia.org/wiki/Magma_(algebra)
[details]: https://en.wikipedia.org/wiki/Magma_(algebra)#Classification_by_properties
-/

--- A *magma* is just an `α`-closed operation `law`.
class Magma (α : Type u) where
  law : α → α → α

open Magma (law)

infix:65 " ·ₘ " => law

section AddMagma
  --- Addition magma.
  class AddMagma (α : Type u)
  extends HAdd α α α

  infix:65 " +ₘ " => AddMagma.law

  --- `Add → AddMagma`
  @[simp, inline]
  instance Add_to_AddMagma [HAdd α α α] : AddMagma α :=
    {}

  --- `AddMagma → Magma`
  @[simp, inline]
  instance AddMagma_to_Magma [inst : AddMagma α] : Magma α where
    law := inst.hAdd

  example : AddMagma Nat :=
    inferInstance
  example : Magma Nat :=
    inferInstance
  example : AddMagma Int :=
    inferInstance
  example : Magma Int :=
    inferInstance
end AddMagma

section MulMagma
  --- Multiplication magma.
  class MulMagma (α : Type u)
  extends HMul α α α

  infix:70 " *ₘ " => MulMagma.law

  --- `Mul → MulMagma`
  @[simp, inline]
  instance Mul_to_MulMagma [HMul α α α] : MulMagma α :=
    {}

  --- `MulMagma → Magma`
  @[simp, inline]
  instance MulMagma_to_Magma [inst : MulMagma α] : Magma α where
    law := inst.hMul

  example : MulMagma Nat :=
    inferInstance
  example : Magma Nat :=
    inferInstance
  example : MulMagma Int :=
    inferInstance
  example : Magma Int :=
    inferInstance
end MulMagma

section UMagma
  --- A *unital magma* is a `Magma` with a unit element.
  class Magma.Unital (α : Type u)
  extends
    Magma α
  where
    unitElm : α
    unit_left :
      ∀ (a : α), unitElm ·ₘ a = a
    unit_right :
      ∀ (a : α), a ·ₘ unitElm = a

  notation "unitₘ" => Magma.Unital.unitElm
  notation "<0>" => unitₘ
  notation "<1>" => unitₘ

  class Magma.AddUnital (α : Type u)
  extends
    AddMagma α,
    Zero α
  where
    zero_add :
      ∀ a, zero + a = a
    add_zero :
      ∀ a, a + zero = a

  --- `AddUnital → Unital`.
  instance [M : Magma.AddUnital α] : Magma.Unital α where
    unitElm :=
      M.zero
    unit_left :=
      M.zero_add
    unit_right :=
      M.add_zero

  class Magma.MulUnital (α : Type u)
  extends
    MulMagma α,
    One α
  where
    one_mul :
      ∀ a, one * a = a
    mul_one :
      ∀ a, a * one = a

  --- `MulUnital → Unital`.
  instance [M : Magma.MulUnital α] : Magma.Unital α where
    unitElm :=
      M.one
    unit_left :=
      M.one_mul
    unit_right :=
      M.mul_one

  instance instUnitalZeroNat : Magma.AddUnital Nat :=
    ⟨Nat.zero_add, Nat.add_zero⟩

  instance instUnitalOneNat : Magma.MulUnital Nat :=
    ⟨Nat.one_mul, Nat.mul_one⟩

  instance instUnitalZeroInt : Magma.AddUnital Int :=
    ⟨Int.zero_add, Int.add_zero⟩

  instance instUnitalOneInt : Magma.MulUnital Int :=
    ⟨Int.one_mul, Int.mul_one⟩
end UMagma

section Comm
  --- A *commutative unital magma* is a `Magma.Unital` with a commutative law.
  ---
  --- Just called `Comm` and not, say, `CommUnital` for brievety.
  class Magma.Comm (α : Type u)
  extends
    Unital α
  where
    comm : commutes law

  class Magma.AddComm (α : Type u)
  extends
    AddUnital α
  where
    comm : commutes toAddUnital.hAdd

  --- `AddComm → Comm`
  instance [inst : Magma.AddComm α] : Magma.Comm α :=
    ⟨inst.comm⟩

  class Magma.MulComm (α : Type u)
  extends
    MulUnital α
  where
    comm : commutes toMulUnital.hMul

  --- `MulComm → Comm`
  instance [inst : Magma.MulComm α] : Magma.Comm α :=
    ⟨inst.comm⟩

  instance instNatAddCommMagma : Magma.AddComm Nat where
    comm :=
      Nat.add_comm

  instance instNatMulCommMagma : Magma.MulComm Nat where
    comm :=
      Nat.mul_comm

  instance instIntAddCommMagma : Magma.AddComm Int where
    comm :=
      Int.add_comm

  instance instIntMulCommMagma : Magma.MulComm Int where
    comm :=
      Int.mul_comm
end Comm


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la operación mínimo en los retículos es
-- asociativa; es decir,
--    (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z)
-- ----------------------------------------------------------------------

import order.lattice
import tactic

variables {α : Type*} [lattice α]
variables x y z : α

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

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
begin
  apply le_antisymm,
  { apply le_inf,
    calc
        (x ⊓ y) ⊓ z  ≤ (x ⊓ y)     : inf_le_left
                    ... ≤  x       : inf_le_left,
    apply le_inf,
    calc
        (x ⊓ y) ⊓ z  ≤ (x ⊓ y)     : inf_le_left
                    ... ≤  y       : inf_le_right,
    calc
        (x ⊓ y) ⊓ z  ≤ z           : inf_le_right },
  { apply le_inf,
    apply le_inf,
    calc
        x ⊓ (y ⊓ z)  ≤ x           : inf_le_left,
    calc
        x ⊓ (y ⊓ z)  ≤ (y ⊓ z)     : inf_le_right
                    ... ≤  y       : inf_le_left,
    calc
        x ⊓ (y ⊓ z)  ≤ (y ⊓ z)     : inf_le_right
                    ... ≤  z       : inf_le_right
  }
end

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

private meta def infs :=
`[refl <|>
  {apply inf_le_of_left_le, infs} <|>
  {apply inf_le_of_right_le, infs}]

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
by apply le_antisymm; repeat {apply le_inf}; {infs}

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

meta def tactic.interactive.lattice :=
`[apply le_antisymm; repeat {apply le_inf}; infs]

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
by lattice

example : x ⊓ y = y ⊓ x :=
by lattice