/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro
-/
import data.prod
import data.subtype

/-!
# Basic definitions about `≤` and `<`

This file proves basic results about orders, provides extensive dot notation, defines useful order
classes and allows to transfer order instances.

## Type synonyms

* `order_dual α` : A type synonym reversing the meaning of all inequalities.
* `as_linear_order α`: A type synonym to promote `partial_order α` to `linear_order α` using
  `is_total α (≤)`.

### Transfering orders

- `order.preimage`, `preorder.lift`: Transfers a (pre)order on `β` to an order on `α`
  using a function `f : α → β`.
- `partial_order.lift`, `linear_order.lift`: Transfers a partial (resp., linear) order on `β` to a
  partial (resp., linear) order on `α` using an injective function `f`.

### Extra class

- `densely_ordered`: An order with no gap, i.e. for any two elements `a < b` there exists `c` such
  that `a < c < b`.

## Notes

`≤` and `<` are highly favored over `≥` and `>` in mathlib. The reason is that we can formulate all
lemmas using `≤`/`<`, and `rw` has trouble unifying `≤` and `≥`. Hence choosing one direction spares
us useless duplication. This is enforced by a linter. See Note [nolint_ge] for more infos.

Dot notation is particularly useful on `≤` (`has_le.le`) and `<` (`has_lt.lt`). To that end, we
provide many aliases to dot notation-less lemmas. For example, `le_trans` is aliased with
`has_le.le.trans` and can be used to construct `hab.trans hbc : a ≤ c` when `hab : a ≤ b`,
`hbc : b ≤ c`, `lt_of_le_of_lt` is aliased as `has_le.le.trans_lt` and can be used to construct
`hab.trans hbc : a < c` when `hab : a ≤ b`, `hbc : b < c`.

## TODO

- expand module docs
- automatic construction of dual definitions / theorems

## Tags

preorder, order, partial order, poset, linear order, chain
-/

open function

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

lemma ge_antisymm [partial_order α] {a b : α} (hab : a ≤ b) (hba : b ≤ a) : b = a :=
le_antisymm hba hab

attribute [simp] le_refl
attribute [ext] has_le

alias le_trans        ← has_le.le.trans
alias lt_of_le_of_lt  ← has_le.le.trans_lt
alias le_antisymm     ← has_le.le.antisymm
alias ge_antisymm     ← has_le.le.antisymm'
alias lt_of_le_of_ne  ← has_le.le.lt_of_ne
alias lt_of_le_not_le ← has_le.le.lt_of_not_le
alias lt_or_eq_of_le  ← has_le.le.lt_or_eq
alias decidable.lt_or_eq_of_le ← has_le.le.lt_or_eq_dec

alias le_of_lt        ← has_lt.lt.le
alias lt_trans        ← has_lt.lt.trans
alias lt_of_lt_of_le  ← has_lt.lt.trans_le
alias ne_of_lt        ← has_lt.lt.ne
alias lt_asymm        ← has_lt.lt.asymm has_lt.lt.not_lt

alias le_of_eq        ← eq.le

attribute [nolint decidable_classical] has_le.le.lt_or_eq_dec

/-- A version of `le_refl` where the argument is implicit -/
lemma le_rfl [preorder α] {x : α} : x ≤ x := le_refl x

@[simp] lemma lt_self_iff_false [preorder α] (x : α) : x < x ↔ false :=
⟨lt_irrefl x, false.elim⟩

namespace eq

/-- If `x = y` then `y ≤ x`. Note: this lemma uses `y ≤ x` instead of `x ≥ y`, because `le` is used
almost exclusively in mathlib. -/
protected

lemma trans_le [preorder α] {x y z : α} (h1 : x = y) (h2 : y ≤ z) : x ≤ z := h1.le.trans h2

lemma not_lt [partial_order α] {x y : α} (h : x = y) : ¬(x < y) := λ h', h'.ne h

lemma not_gt [partial_order α] {x y : α} (h : x = y) : ¬(y < x) := h.symm.not_lt

end eq

namespace has_le.le

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma ge [has_le α] {x y : α} (h : x ≤ y) : y ≥ x := h

lemma trans_eq [preorder α] {x y z : α} (h1 : x ≤ y) (h2 : y = z) : x ≤ z := h1.trans h2.le

lemma lt_iff_ne [partial_order α] {x y : α} (h : x ≤ y) : x < y ↔ x ≠ y := ⟨λ h, h.ne, h.lt_of_ne⟩

lemma le_iff_eq [partial_order α] {x y : α} (h : x ≤ y) : y ≤ x ↔ y = x :=
⟨λ h', h'.antisymm h, eq.le⟩

lemma lt_or_le [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a < c ∨ c ≤ b :=
(lt_or_ge a c).imp id $ λ hc, le_trans hc h

lemma le_or_lt [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a ≤ c ∨ c < b :=
(le_or_gt a c).imp id $ λ hc, lt_of_lt_of_le hc h

lemma le_or_le [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a ≤ c ∨ c ≤ b :=
(h.le_or_lt c).elim or.inl (λ h, or.inr $ le_of_lt h)

end has_le.le

namespace has_lt.lt

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma gt [has_lt α] {x y : α} (h : x < y) : y > x := h
protected lemma false [preorder α] {x : α} : x < x → false := lt_irrefl x

lemma ne' [preorder α] {x y : α} (h : x < y) : y ≠ x := h.ne.symm

lemma lt_or_lt [linear_order α] {x y : α} (h : x < y) (z : α) : x < z ∨ z < y :=
(lt_or_ge z y).elim or.inr (λ hz, or.inl $ h.trans_le hz)

end has_lt.lt

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma ge.le [has_le α] {x y : α} (h : x ≥ y) : y ≤ x := h

@[nolint ge_or_gt] -- see Note [nolint_ge]
protected lemma gt.lt [has_lt α] {x y : α} (h : x > y) : y < x := h

@[nolint ge_or_gt] -- see Note [nolint_ge]
theorem ge_of_eq [preorder α] {a b : α} (h : a = b) : a ≥ b := h.ge

@[simp, nolint ge_or_gt] -- see Note [nolint_ge]
lemma ge_iff_le [preorder α] {a b : α} : a ≥ b ↔ b ≤ a := iff.rfl
@[simp, nolint ge_or_gt] -- see Note [nolint_ge]
lemma gt_iff_lt [preorder α] {a b : α} : a > b ↔ b < a := iff.rfl

lemma not_le_of_lt [preorder α] {a b : α} (h : a < b) : ¬ b ≤ a := (le_not_le_of_lt h).right

alias not_le_of_lt ← has_lt.lt.not_le

lemma not_lt_of_le [preorder α] {a b : α} (h : a ≤ b) : ¬ b < a := λ hba, hba.not_le h

alias not_lt_of_le ← has_le.le.not_lt

lemma ne_of_not_le [preorder α] {a b : α} (h : ¬ a ≤ b) : a ≠ b :=
λ hab, h (le_of_eq hab)

-- See Note [decidable namespace]
protected lemma decidable.le_iff_eq_or_lt [partial_order α] [@decidable_rel α (≤)]
  {a b : α} : a ≤ b ↔ a = b ∨ a < b := decidable.le_iff_lt_or_eq.trans or.comm

lemma le_iff_eq_or_lt [partial_order α] {a b : α} : a ≤ b ↔ a = b ∨ a < b :=
le_iff_lt_or_eq.trans or.comm

lemma lt_iff_le_and_ne [partial_order α] {a b : α} : a < b ↔ a ≤ b ∧ a ≠ b :=
⟨λ h, ⟨le_of_lt h, ne_of_lt h⟩, λ ⟨h1, h2⟩, h1.lt_of_ne h2⟩

-- See Note [decidable namespace]
protected lemma decidable.eq_iff_le_not_lt [partial_order α] [@decidable_rel α (≤)]
  {a b : α} : a = b ↔ a ≤ b ∧ ¬ a < b :=
⟨λ h, ⟨h.le, h ▸ lt_irrefl _⟩, λ ⟨h₁, h₂⟩, h₁.antisymm $
  decidable.by_contradiction $ λ h₃, h₂ (h₁.lt_of_not_le h₃)⟩

lemma eq_iff_le_not_lt [partial_order α] {a b : α} : a = b ↔ a ≤ b ∧ ¬ a < b :=
by haveI := classical.dec; exact decidable.eq_iff_le_not_lt

lemma eq_or_lt_of_le [partial_order α] {a b : α} (h : a ≤ b) : a = b ∨ a < b := h.lt_or_eq.symm
lemma eq_or_gt_of_le [partial_order α] {a b : α} (h : a ≤ b) : b = a ∨ a < b :=
h.lt_or_eq.symm.imp eq.symm id

alias decidable.eq_or_lt_of_le ← has_le.le.eq_or_lt_dec
alias eq_or_lt_of_le ← has_le.le.eq_or_lt
alias eq_or_gt_of_le ← has_le.le.eq_or_gt

attribute [nolint decidable_classical] has_le.le.eq_or_lt_dec

lemma eq_of_le_of_not_lt [partial_order α] {a b : α} (hab : a ≤ b) (hba : ¬ a < b) : a = b :=
hab.eq_or_lt.resolve_right hba

lemma eq_of_ge_of_not_gt [partial_order α] {a b : α} (hab : a ≤ b) (hba : ¬ a < b) : b = a :=
(hab.eq_or_lt.resolve_right hba).symm

alias eq_of_le_of_not_lt ← has_le.le.eq_of_not_lt
alias eq_of_ge_of_not_gt ← has_le.le.eq_of_not_gt

lemma ne.le_iff_lt [partial_order α] {a b : α} (h : a ≠ b) : a ≤ b ↔ a < b :=
⟨λ h', lt_of_le_of_ne h' h, λ h, h.le⟩

-- See Note [decidable namespace]
protected lemma decidable.ne_iff_lt_iff_le [partial_order α] [@decidable_rel α (≤)]
  {a b : α} : (a ≠ b ↔ a < b) ↔ a ≤ b :=
⟨λ h, decidable.by_cases le_of_eq (le_of_lt ∘ h.mp), λ h, ⟨lt_of_le_of_ne h, ne_of_lt⟩⟩

@[simp] lemma ne_iff_lt_iff_le [partial_order α] {a b : α} : (a ≠ b ↔ a < b) ↔ a ≤ b :=
by haveI := classical.dec; exact decidable.ne_iff_lt_iff_le

lemma lt_of_not_ge' [linear_order α] {a b : α} (h : ¬ b ≤ a) : a < b :=
((le_total _ _).resolve_right h).lt_of_not_le h

lemma lt_iff_not_ge' [linear_order α] {x y : α} : x < y ↔ ¬ y ≤ x := ⟨not_le_of_gt, lt_of_not_ge'⟩

lemma ne.lt_or_lt [linear_order α] {x y : α} (h : x ≠ y) : x < y ∨ y < x := lt_or_gt_of_ne h

/-- A version of `ne_iff_lt_or_gt` with LHS and RHS reversed. -/
@[simp] lemma lt_or_lt_iff_ne [linear_order α] {x y : α} : x < y ∨ y < x ↔ x ≠ y :=
ne_iff_lt_or_gt.symm

lemma not_lt_iff_eq_or_lt [linear_order α] {a b : α} : ¬ a < b ↔ a = b ∨ b < a :=
not_lt.trans $ decidable.le_iff_eq_or_lt.trans $ or_congr eq_comm iff.rfl

lemma exists_ge_of_linear [linear_order α] (a b : α) : ∃ c, a ≤ c ∧ b ≤ c :=
match le_total a b with
| or.inl h := ⟨_, h, le_rfl⟩
| or.inr h := ⟨_, le_rfl, h⟩
end

lemma lt_imp_lt_of_le_imp_le {β} [linear_order α] [preorder β] {a b : α} {c d : β}
  (H : a ≤ b → c ≤ d) (h : d < c) : b < a :=
lt_of_not_ge' $ λ h', (H h').not_lt h

lemma le_imp_le_iff_lt_imp_lt {β} [linear_order α] [linear_order β] {a b : α} {c d : β} :
  (a ≤ b → c ≤ d) ↔ (d < c → b < a) :=
⟨lt_imp_lt_of_le_imp_le, le_imp_le_of_lt_imp_lt⟩

lemma lt_iff_lt_of_le_iff_le' {β} [preorder α] [preorder β] {a b : α} {c d : β}
  (H : a ≤ b ↔ c ≤ d) (H' : b ≤ a ↔ d ≤ c) : b < a ↔ d < c :=
lt_iff_le_not_le.trans $ (and_congr H' (not_congr H)).trans lt_iff_le_not_le.symm

lemma lt_iff_lt_of_le_iff_le {β} [linear_order α] [linear_order β] {a b : α} {c d : β}
  (H : a ≤ b ↔ c ≤ d) : b < a ↔ d < c :=
not_le.symm.trans $ (not_congr H).trans $ not_le

lemma le_iff_le_iff_lt_iff_lt {β} [linear_order α] [linear_order β] {a b : α} {c d : β} :
  (a ≤ b ↔ c ≤ d) ↔ (b < a ↔ d < c) :=
⟨lt_iff_lt_of_le_iff_le, λ H, not_lt.symm.trans $ (not_congr H).trans $ not_lt⟩

lemma eq_of_forall_le_iff [partial_order α] {a b : α}
  (H : ∀ c, c ≤ a ↔ c ≤ b) : a = b :=
((H _).1 le_rfl).antisymm ((H _).2 le_rfl)

lemma le_of_forall_le [preorder α] {a b : α}
  (H : ∀ c, c ≤ a → c ≤ b) : a ≤ b :=
H _ le_rfl

lemma le_of_forall_le' [preorder α] {a b : α}
  (H : ∀ c, a ≤ c → b ≤ c) : b ≤ a :=
H _ le_rfl

lemma le_of_forall_lt [linear_order α] {a b : α}
  (H : ∀ c, c < a → c < b) : a ≤ b :=
le_of_not_lt $ λ h, lt_irrefl _ (H _ h)

lemma forall_lt_iff_le [linear_order α] {a b : α} :
  (∀ ⦃c⦄, c < a → c < b) ↔ a ≤ b :=
⟨le_of_forall_lt, λ h c hca, lt_of_lt_of_le hca h⟩

lemma le_of_forall_lt' [linear_order α] {a b : α}
  (H : ∀ c, a < c → b < c) : b ≤ a :=
le_of_not_lt $ λ h, lt_irrefl _ (H _ h)

lemma forall_lt_iff_le' [linear_order α] {a b : α} :
  (∀ ⦃c⦄, a < c → b < c) ↔ b ≤ a :=
⟨le_of_forall_lt', λ h c hac, lt_of_le_of_lt h hac⟩

lemma eq_of_forall_ge_iff [partial_order α] {a b : α}
  (H : ∀ c, a ≤ c ↔ b ≤ c) : a = b :=
((H _).2 le_rfl).antisymm ((H _).1 le_rfl)

/-- monotonicity of `≤` with respect to `→` -/
lemma le_implies_le_of_le_of_le {a b c d : α} [preorder α] (hca : c ≤ a) (hbd : b ≤ d) :
  a ≤ b → c ≤ d :=
λ hab, (hca.trans hab).trans hbd

@[ext]
lemma preorder.to_has_le_injective {α : Type*} :
  function.injective (@preorder.to_has_le α) :=
λ A B h, begin
  cases A, cases B,
  injection h with h_le,
  have : A_lt = B_lt,
  { funext a b,
    dsimp [(≤)] at A_lt_iff_le_not_le B_lt_iff_le_not_le h_le,
    simp [A_lt_iff_le_not_le, B_lt_iff_le_not_le, h_le], },
  congr',
end

@[ext]
lemma partial_order.to_preorder_injective {α : Type*} :
  function.injective (@partial_order.to_preorder α) :=
λ A B h, by { cases A, cases B, injection h, congr' }

@[ext]
lemma linear_order.to_partial_order_injective {α : Type*} :
  function.injective (@linear_order.to_partial_order α) :=
begin
  intros A B h,
  cases A, cases B, injection h,
  obtain rfl : A_le = B_le := ‹_›, obtain rfl : A_lt = B_lt := ‹_›,
  obtain rfl : A_decidable_le = B_decidable_le := subsingleton.elim _ _,
  obtain rfl : A_max = B_max := A_max_def.trans B_max_def.symm,
  obtain rfl : A_min = B_min := A_min_def.trans B_min_def.symm,
  congr
end

theorem preorder.ext {α} {A B : preorder α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
by { ext x y, exact H x y }

theorem partial_order.ext {α} {A B : partial_order α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
by { ext x y, exact H x y }

theorem linear_order.ext {α} {A B : linear_order α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
by { ext x y, exact H x y }

/-- Given a relation `R` on `β` and a function `f : α → β`, the preimage relation on `α` is defined
by `x ≤ y ↔ f x ≤ f y`. It is the unique relation on `α` making `f` a `rel_embedding` (assuming `f`
is injective). -/
@[simp] def order.preimage {α β} (f : α → β) (s : β → β → Prop) (x y : α) : Prop := s (f x) (f y)

infix ` ⁻¹'o `:80 := order.preimage

/-- The preimage of a decidable order is decidable. -/
instance order.preimage.decidable {α β} (f : α → β) (s : β → β → Prop) [H : decidable_rel s] :
  decidable_rel (f ⁻¹'o s) :=
λ x y, H _ _

/-! ### Order dual -/

/-- Type synonym to equip a type with the dual order: `≤` means `≥` and `<` means `>`. -/
def order_dual (α : Type*) : Type* := α

namespace order_dual

instance (α : Type*) [h : nonempty α] : nonempty (order_dual α) := h
instance (α : Type*) [h : subsingleton α] : subsingleton (order_dual α) := h
instance (α : Type*) [has_le α] : has_le (order_dual α) := ⟨λ x y : α, y ≤ x⟩
instance (α : Type*) [has_lt α] : has_lt (order_dual α) := ⟨λ x y : α, y < x⟩
instance (α : Type*) [has_zero α] : has_zero (order_dual α) := ⟨(0 : α)⟩

-- `dual_le` and `dual_lt` should not be simp lemmas:
-- they cause a loop since `α` and `order_dual α` are definitionally equal

lemma dual_le [has_le α] {a b : α} :
  @has_le.le (order_dual α) _ a b ↔ @has_le.le α _ b a := iff.rfl

lemma dual_lt [has_lt α] {a b : α} :
  @has_lt.lt (order_dual α) _ a b ↔ @has_lt.lt α _ b a := iff.rfl

instance (α : Type*) [preorder α] : preorder (order_dual α) :=
{ le_refl          := le_refl,
  le_trans         := λ a b c hab hbc, hbc.trans hab,
  lt_iff_le_not_le := λ _ _, lt_iff_le_not_le,
  .. order_dual.has_le α,
  .. order_dual.has_lt α }

instance (α : Type*) [partial_order α] : partial_order (order_dual α) :=
{ le_antisymm := λ a b hab hba, @le_antisymm α _ a b hba hab, .. order_dual.preorder α }

instance (α : Type*) [linear_order α] : linear_order (order_dual α) :=
{ le_total     := λ a b : α, le_total b a,
  decidable_le := (infer_instance : decidable_rel (λ a b : α, b ≤ a)),
  decidable_lt := (infer_instance : decidable_rel (λ a b : α, b < a)),
  min := @max α _,
  max := @min α _,
  min_def := @linear_order.max_def α _,
  max_def := @linear_order.min_def α _,
  .. order_dual.partial_order α }

instance : Π [inhabited α], inhabited (order_dual α) := id

theorem preorder.dual_dual (α : Type*) [H : preorder α] :
  order_dual.preorder (order_dual α) = H :=
preorder.ext $ λ _ _, iff.rfl

theorem partial_order.dual_dual (α : Type*) [H : partial_order α] :
  order_dual.partial_order (order_dual α) = H :=
partial_order.ext $ λ _ _, iff.rfl

theorem linear_order.dual_dual (α : Type*) [H : linear_order α] :
  order_dual.linear_order (order_dual α) = H :=
linear_order.ext $ λ _ _, iff.rfl

end order_dual

/-! ### Order instances on the function space -/

instance pi.has_le {ι : Type u} {α : ι → Type v} [∀ i, has_le (α i)] : has_le (Π i, α i) :=
{ le       := λ x y, ∀ i, x i ≤ y i }

lemma pi.le_def {ι : Type u} {α : ι → Type v} [∀ i, has_le (α i)] {x y : Π i, α i} :
  x ≤ y ↔ ∀ i, x i ≤ y i :=
iff.rfl

instance pi.preorder {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] : preorder (Π i, α i) :=
{ le_refl  := λ a i, le_refl (a i),
  le_trans := λ a b c h₁ h₂ i, le_trans (h₁ i) (h₂ i),
  ..pi.has_le }

lemma pi.lt_def {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] {x y : Π i, α i} :
  x < y ↔ x ≤ y ∧ ∃ i, x i < y i :=
by simp [lt_iff_le_not_le, pi.le_def] {contextual := tt}

lemma le_update_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
  {x y : Π i, α i} {i : ι} {a : α i} :
  x ≤ function.update y i a ↔ x i ≤ a ∧ ∀ j ≠ i, x j ≤ y j :=
function.forall_update_iff _ (λ j z, x j ≤ z)

lemma update_le_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
  {x y : Π i, α i} {i : ι} {a : α i} :
  function.update x i a ≤ y ↔ a ≤ y i ∧ ∀ j ≠ i, x j ≤ y j :=
function.forall_update_iff _ (λ j z, z ≤ y j)

lemma update_le_update_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
  {x y : Π i, α i} {i : ι} {a b : α i} :
  function.update x i a ≤ function.update y i b ↔ a ≤ b ∧ ∀ j ≠ i, x j ≤ y j :=
by simp [update_le_iff] {contextual := tt}

instance pi.partial_order {ι : Type u} {α : ι → Type v} [∀ i, partial_order (α i)] :
  partial_order (Π i, α i) :=
{ le_antisymm := λ f g h1 h2, funext (λ b, (h1 b).antisymm (h2 b)),
  ..pi.preorder }

/-! ### Lifts of order instances -/

/-- Transfer a `preorder` on `β` to a `preorder` on `α` using a function `f : α → β`.
See note [reducible non-instances]. -/
@[reducible] def preorder.lift {α β} [preorder β] (f : α → β) : preorder α :=
{ le               := λ x y, f x ≤ f y,
  le_refl          := λ a, le_rfl,
  le_trans         := λ a b c, le_trans,
  lt               := λ x y, f x < f y,
  lt_iff_le_not_le := λ a b, lt_iff_le_not_le }

/-- Transfer a `partial_order` on `β` to a `partial_order` on `α` using an injective
function `f : α → β`. See note [reducible non-instances]. -/
@[reducible] def partial_order.lift {α β} [partial_order β] (f : α → β) (inj : injective f) :
  partial_order α :=
{ le_antisymm := λ a b h₁ h₂, inj (h₁.antisymm h₂), .. preorder.lift f }

/-- Transfer a `linear_order` on `β` to a `linear_order` on `α` using an injective
function `f : α → β`. See note [reducible non-instances]. -/
@[reducible] def linear_order.lift {α β} [linear_order β] (f : α → β) (inj : injective f) :
  linear_order α :=
{ le_total     := λ x y, le_total (f x) (f y),
  decidable_le := λ x y, (infer_instance : decidable (f x ≤ f y)),
  decidable_lt := λ x y, (infer_instance : decidable (f x < f y)),
  decidable_eq := λ x y, decidable_of_iff _ inj.eq_iff,
  .. partial_order.lift f inj }

instance subtype.preorder {α} [preorder α] (p : α → Prop) : preorder (subtype p) :=
preorder.lift (coe : subtype p → α)

@[simp] lemma subtype.mk_le_mk {α} [preorder α] {p : α → Prop} {x y : α} {hx : p x} {hy : p y} :
  (⟨x, hx⟩ : subtype p) ≤ ⟨y, hy⟩ ↔ x ≤ y :=
iff.rfl

@[simp] lemma subtype.mk_lt_mk {α} [preorder α] {p : α → Prop} {x y : α} {hx : p x} {hy : p y} :
  (⟨x, hx⟩ : subtype p) < ⟨y, hy⟩ ↔ x < y :=
iff.rfl

@[simp, norm_cast] lemma subtype.coe_le_coe {α} [preorder α] {p : α → Prop} {x y : subtype p} :
  (x : α) ≤ y ↔ x ≤ y :=
iff.rfl

@[simp, norm_cast] lemma subtype.coe_lt_coe {α} [preorder α] {p : α → Prop} {x y : subtype p} :
  (x : α) < y ↔ x < y :=
iff.rfl

instance subtype.partial_order {α} [partial_order α] (p : α → Prop) :
  partial_order (subtype p) :=
partial_order.lift coe subtype.coe_injective

/-- A subtype of a linear order is a linear order. We explicitly give the proof of decidable
  equality as the existing instance, in order to not have two instances of decidable equality that
  are not definitionally equal. -/
instance subtype.linear_order {α} [linear_order α] (p : α → Prop) : linear_order (subtype p) :=
{ decidable_eq := subtype.decidable_eq,
  .. linear_order.lift coe subtype.coe_injective }

/-!
### Pointwise order on `α × β`

The lexicographic order is defined in `order.lexicographic`, and the instances are available via the
type synonym `α ×ₗ β = α × β`.
-/

namespace prod

instance (α : Type u) (β : Type v) [has_le α] [has_le β] : has_le (α × β) :=
⟨λ p q, p.1 ≤ q.1 ∧ p.2 ≤ q.2⟩

lemma le_def [has_le α] [has_le β] {x y : α × β} : x ≤ y ↔ x.1 ≤ y.1 ∧ x.2 ≤ y.2 := iff.rfl

@[simp] lemma mk_le_mk [has_le α] [has_le β] {x₁ x₂ : α} {y₁ y₂ : β} :
  (x₁, y₁) ≤ (x₂, y₂) ↔ x₁ ≤ x₂ ∧ y₁ ≤ y₂ :=
iff.rfl

instance (α : Type u) (β : Type v) [preorder α] [preorder β] : preorder (α × β) :=
{ le_refl  := λ ⟨a, b⟩, ⟨le_refl a, le_refl b⟩,
  le_trans := λ ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩ ⟨hac, hbd⟩ ⟨hce, hdf⟩,
    ⟨le_trans hac hce, le_trans hbd hdf⟩,
  .. prod.has_le α β }

lemma lt_iff [preorder α] [preorder β] {a b : α × β} :
  a < b ↔ a.1 < b.1 ∧ a.2 ≤ b.2 ∨ a.1 ≤ b.1 ∧ a.2 < b.2 :=
begin
  refine ⟨λ h, _, _⟩,
  { by_cases h₁ : b.1 ≤ a.1,
    { exact or.inr ⟨h.1.1, h.1.2.lt_of_not_le $ λ h₂, h.2 ⟨h₁, h₂⟩⟩ },
    { exact or.inl ⟨h.1.1.lt_of_not_le h₁, h.1.2⟩ } },
  { rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩),
    { exact ⟨⟨h₁.le, h₂⟩, λ h, h₁.not_le h.1⟩ },
    { exact ⟨⟨h₁, h₂.le⟩, λ h, h₂.not_le h.2⟩ } }
end

@[simp] lemma mk_lt_mk [preorder α] [preorder β] {x₁ x₂ : α} {y₁ y₂ : β} :
  (x₁, y₁) < (x₂, y₂) ↔ x₁ < x₂ ∧ y₁ ≤ y₂ ∨ x₁ ≤ x₂ ∧ y₁ < y₂ :=
lt_iff

/-- The pointwise partial order on a product.
    (The lexicographic ordering is defined in order/lexicographic.lean, and the instances are
    available via the type synonym `α ×ₗ β = α × β`.) -/
instance (α : Type u) (β : Type v) [partial_order α] [partial_order β] :
  partial_order (α × β) :=
{ le_antisymm := λ ⟨a, b⟩ ⟨c, d⟩ ⟨hac, hbd⟩ ⟨hca, hdb⟩,
    prod.ext (hac.antisymm hca) (hbd.antisymm hdb),
  .. prod.preorder α β }

end prod

/-! ### Additional order classes -/

/-- An order is dense if there is an element between any pair of distinct elements. -/
class densely_ordered (α : Type u) [has_lt α] : Prop :=
(dense : ∀ a₁ a₂ : α, a₁ < a₂ → ∃ a, a₁ < a ∧ a < a₂)

lemma exists_between [has_lt α] [densely_ordered α] :
  ∀ {a₁ a₂ : α}, a₁ < a₂ → ∃ a, a₁ < a ∧ a < a₂ :=
densely_ordered.dense

instance order_dual.densely_ordered (α : Type u) [has_lt α] [densely_ordered α] :
  densely_ordered (order_dual α) :=
⟨λ a₁ a₂ ha, (@exists_between α _ _ _ _ ha).imp $ λ a, and.symm⟩

lemma le_of_forall_le_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h : ∀ a, a₂ < a → a₁ ≤ a) :
  a₁ ≤ a₂ :=
le_of_not_gt $ λ ha,
  let ⟨a, ha₁, ha₂⟩ := exists_between ha in
  lt_irrefl a $ lt_of_lt_of_le ‹a < a₁› (h _ ‹a₂ < a›)

lemma eq_of_le_of_forall_le_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h₁ : a₂ ≤ a₁) (h₂ : ∀ a, a₂ < a → a₁ ≤ a) : a₁ = a₂ :=
le_antisymm (le_of_forall_le_of_dense h₂) h₁

lemma le_of_forall_ge_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h : ∀ a₃ < a₁, a₃ ≤ a₂) :
  a₁ ≤ a₂ :=
le_of_not_gt $ λ ha,
  let ⟨a, ha₁, ha₂⟩ := exists_between ha in
  lt_irrefl a $ lt_of_le_of_lt (h _ ‹a < a₁›) ‹a₂ < a›

lemma eq_of_le_of_forall_ge_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
  (h₁ : a₂ ≤ a₁) (h₂ : ∀ a₃ < a₁, a₃ ≤ a₂) : a₁ = a₂ :=
(le_of_forall_ge_of_dense h₂).antisymm h₁

lemma dense_or_discrete [linear_order α] (a₁ a₂ : α) :
  (∃ a, a₁ < a ∧ a < a₂) ∨ ((∀ a, a₁ < a → a₂ ≤ a) ∧ (∀ a < a₂, a ≤ a₁)) :=
or_iff_not_imp_left.2 $ λ h,
  ⟨λ a ha₁, le_of_not_gt $ λ ha₂, h ⟨a, ha₁, ha₂⟩,
    λ a ha₂, le_of_not_gt $ λ ha₁, h ⟨a, ha₁, ha₂⟩⟩

variables {s : β → β → Prop} {t : γ → γ → Prop}

/-! ### Linear order from a total partial order -/

/-- Type synonym to create an instance of `linear_order` from a `partial_order` and
`is_total α (≤)` -/
def as_linear_order (α : Type u) := α

instance {α} [inhabited α] : inhabited (as_linear_order α) :=
⟨ (default : α) ⟩

noncomputable instance as_linear_order.linear_order {α} [partial_order α] [is_total α (≤)] :
  linear_order (as_linear_order α) :=
{ le_total     := @total_of α (≤) _,
  decidable_le := classical.dec_rel _,
  .. (_ : partial_order α) }


import MyNat.Definition
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import AdditionWorld.Level2 -- add_assoc
namespace MyNat
open MyNat
/-!

# Inequality world.

## Level 14: `add_le_add_left`

I know these are easy and we've done several already, but this is one
of the axioms for an ordered commutative monoid! The nature of formalizing
is that we should formalize all "obvious" lemmas, and then when we're
actually using ` ≤` in real life, everything will be there. Note also,
of course, that all of these lemmas are already formalized in Lean's
maths library already, for Lean's inbuilt natural numbers.

## Lemma : add_le_add_left
If `a ≤ b` then for all `t`, `t+a ≤ t+b`.
-/
theorem add_le_add_left {a b : MyNat} (h : a ≤ b) (t : MyNat) :
  t + a ≤ t + b := by
  cases h with
  | _ c hc =>
    use c
    rw [hc]
    rw [add_assoc]

/-!
Next up [Level 15](./Level15.lean.md)
-/


import data.nat.prime
import tactic.linarith

open nat

theorem infinitude_of_primes : ∀ N : ℕ, ∃ p ≥ N, nat.prime p :=
begin
  intro N,

  let M := factorial N + 1,
  let p := min_fac M,

  have pp : nat.prime p :=
  begin
    refine min_fac_prime _,
    have : factorial N > 0 := factorial_pos N,
    linarith,
  end,

  use p,
  split,
  { by_contradiction,
    have h₁ : p ∣ factorial N + 1 := min_fac_dvd M,
    have h₂ : p ∣ factorial N := (prime.dvd_factorial pp).mpr (le_of_not_ge h),
    have h : p ∣ 1 := (nat.dvd_add_right h₂).mp h₁,
    exact nat.prime.not_dvd_one pp h, },
  { exact pp, },
end

-- Comentario: Ver su desarrollo en https://youtu.be/b59fpAJ8Mfs


import algebra.group.basic
import data.zmod.basic
import data.equiv.basic
import tactic

import data.set.basic

universes u v

open equiv function set

variables (G : Type u) [group G]

lemma perms_eq_fun_eq {X : Type u} (p : perm X) (q : perm X) (h : p.to_fun = q.to_fun) : p = q :=
begin
  apply perm.ext,
  intro x,
  exact congr_fun h x,
end

def lift_to_perm (G : Type*) [group G] : G →* perm G := {
  to_fun := λ g, {
    to_fun    := λ x, g * x,
    inv_fun   := λ x, g⁻¹ * x,
    left_inv  := λ h, by simp,
    right_inv := λ h, by simp
  },
  map_one' := by {ext, simp},
  map_mul' := λ g h, by {ext, simp [mul_assoc _ _ _]},
}

lemma lift_to_perm_inj {G : Type*} [group G] : injective (lift_to_perm G) :=
begin
  intros g₁ g₂ h,
  have H : ((lift_to_perm G) g₁) 1 = ((lift_to_perm G) g₂) 1, rw h,
  exact (mul_left_inj 1).mp H,
end

def iso_induces_perm_iso {X : Type u} {Y : Type v} : X ≃ Y → perm X ≃* perm Y := λ h,
{ to_fun    := λ p, ({
                 to_fun    := h.1 ∘ p.1 ∘ h.2,
                 inv_fun   := h.1 ∘ p.2 ∘ h.2,
                 left_inv  := λ y, by simp,
                 right_inv := λ y, by simp,
               } : perm Y),
  inv_fun   := λ (p : perm Y), ({
                 to_fun    := h.2 ∘ p.1 ∘ h.1,
                 inv_fun   := h.2 ∘ p.2 ∘ h.1,
                 left_inv  := λ y, by simp,
                 right_inv := λ y, by simp,
               } : perm X),
  left_inv  := λ x, by {ext, simp},
  right_inv := λ x, by {ext, simp},
  map_mul'  := λ p q, perms_eq_fun_eq _ _ (conj_comp h p.to_fun q.to_fun)
}

theorem cayleys (G : Type*) [group G] : ∃ (f : G →* perm G), injective f :=
begin
  use lift_to_perm G,
  exact lift_to_perm_inj,
end

variables {G₁ : Type*} {G₂ : Type*} [group G₁] [group G₂]

noncomputable
def inj_hom_induces_iso (f : G₁ →* G₂) (h_inj : injective f) : G₁ ≃* range f :=
{ to_fun    := λ g, ⟨f g, set.mem_range_self g⟩,
  inv_fun   := begin
    rintro ⟨a, b⟩,
    choose h hk using b,
    exact h,
  end,
  left_inv  := begin
    intro x,
    simp,
    apply h_inj,
    have H : f x ∈ range f := set.mem_range_self x,
    rw classical.some_spec H,
  end,
  right_inv := begin
    intro y,
    ext,
    rcases y with ⟨y, ⟨x, hx⟩⟩,
    simp,
    have H := Exists.intro x hx,
    rw classical.some_spec H,
  end,
  map_mul'  := λ x y, by {ext, simp},
}

noncomputable
theorem cayleys2 {G : Type*} [group G] : G ≃* range (lift_to_perm G)
  := inj_hom_induces_iso (lift_to_perm G) lift_to_perm_inj


import tactic

/-

# Prove that for every positive integer n the number 3(1^5 +2^5 +...+n^5)
# is divisible by 1^3+2^3+...+n^3

This is question 9 in Sierpinski's book

-/

open_locale big_operators

open finset

example (a b : ℤ) : (a : ℚ) = b ↔ a = b := int.cast_inj

lemma sum_cubes (n : ℕ) : ∑ i in range n, (i : ℚ)^3 = (n*(n-1)/2)^2 :=
begin
  induction n with d hd,
  { simp, ring, },
  { rw [finset.sum_range_succ, hd],
    simp,
    ring }
end

lemma sum_fifths (n : ℕ) : ∑ i in range n, (i : ℚ)^5 = (4 * (n * (n-1)/2)^3-(n*(n-1)/2)^2)/3 :=
begin
  induction n with d hd,
  { simp, ring, },
  { rw [finset.sum_range_succ, hd],
    simp,
    ring }
end

example (n : ℕ) : (∑ i in range n, i^3) ∣ (3 * ∑ i in range n, i^5) :=
begin
  rw ← int.coe_nat_dvd,
  use 2 * n * (n-1) - 1,
  rw ← @int.cast_inj ℚ _ _ _ _,
  push_cast,
  rw sum_cubes,
  rw sum_fifths,
  ring,
end


/- Exercise 3.1: Program Semantics — Operational Semantics -/

/- We start by repeating some material from the lecture. We use the same `program` syntax and the
big-step semantics as presented in the lecture. -/

attribute [pattern] or.intro_left or.intro_right

inductive program (σ : Type) : Type
| skip {} : program
| assign  : (σ → σ) → program
| seq     : program → program → program
| ite     : (σ → Prop) → program → program → program
| while   : (σ → Prop) → program → program

namespace program

variables {σ : Type} {c : σ → Prop} {f : σ → σ} {p p₀ p₁ p₂ : program σ} {s s₀ s₁ s₂ t u : σ}

inductive big_step : (program σ × σ) → σ → Prop
| skip {s} :
  big_step (skip, s) s
| assign {f s} :
  big_step (assign f, s) (f s)
| seq {p₁ p₂ s u} (t) (h₁ : big_step (p₁, s) t) (h₂ : big_step (p₂, t) u) :
  big_step (seq p₁ p₂, s) u
| ite_true {c : σ → Prop} {p₁ p₀ s t} (hs : c s) (h : big_step (p₁, s) t) :
  big_step (ite c p₁ p₀, s) t
| ite_false {c : σ → Prop} {p₁ p₀ s t} (hs : ¬ c s) (h : big_step (p₀, s) t) :
  big_step (ite c p₁ p₀, s) t
| while_true {c : σ → Prop} {p s u} (t) (hs : c s) (hp : big_step (p, s) t)
  (hw : big_step (while c p, t) u) :
  big_step (while c p, s) u
| while_false {c : σ → Prop} {p s} (hs : ¬ c s) : big_step (while c p, s) s

infix ` ⟹ `:110 := big_step

/- We copy also the inversion rules from the lecture. Do not prove these. -/

@[simp] lemma big_step_skip_iff :
  (skip, s) ⟹ t ↔ t = s := sorry
@[simp] lemma big_step_assign_iff :
  (assign f, s) ⟹ t ↔ t = f s := sorry
@[simp] lemma big_step_seq_iff :
  (seq p₁ p₂, s) ⟹ t ↔ (∃u, (p₁, s) ⟹ u ∧ (p₂, u) ⟹ t) := sorry
@[simp] lemma big_step_ite_iff :
  (ite c p₁ p₀, s) ⟹ t ↔ ((c s ∧ (p₁, s) ⟹ t) ∨ (¬ c s ∧ (p₀, s) ⟹ t)) := sorry
lemma big_step_while_iff :
  (while c p, s) ⟹ t ↔ (∃u, c s ∧ (p, s) ⟹ u ∧ (while c p, u) ⟹ t) ∨ (¬ c s ∧ t = s) := sorry
@[simp] lemma big_step_while_true_iff (hs : c s) :
  (while c p, s) ⟹ t ↔ (∃u, (p, s) ⟹ u ∧ (while c p, u) ⟹ t) := sorry
@[simp] lemma big_step_while_false_iff (hs : ¬ c s) :
  (while c p, s) ⟹ t ↔ t = s := sorry

/- Question 1: Program equivalence -/

/- For this question, we introduce the notation of program equivalence `p₁ ≈ p₂`. `≈` is entered as
`\approx`. -/

def program_equiv (p₁ p₂ : program σ) : Prop :=
∀s t, (p₁, s) ⟹ t ↔ (p₂, s) ⟹ t

local infix ` ≈ ` := program_equiv

/- Program equivalence is a equivalence relation, i.e. it is reflexive, symmetric, and
transitive. -/

@[refl] lemma program_equiv.refl :
  p ≈ p :=
assume s t, by refl

@[symm] lemma program_equiv.symm :
  p₁ ≈ p₂ → p₂ ≈ p₁ :=
assume h s t, (h s t).symm

@[trans] lemma program_equiv.trans {p₃} (h₁₂ : p₁ ≈ p₂) (h₂₃ : p₂ ≈ p₃) :
  p₁ ≈ p₃ :=
assume s t, iff.trans (h₁₂ s t) (h₂₃ s t)

/- 1.1. Prove the following program equivalences. -/

lemma program_equiv_seq_skip1 {p : program σ} : seq skip p ≈ p :=
begin
intros s t,
apply iff.intro,
intro h,
cases h,
cases h_h₁,
assumption,
intro h,
apply big_step.seq s,

end

lemma program_equiv_seq_skip2 {p : program σ} : seq p skip ≈ p :=
begin
intros s t,
apply iff.intro,
intro h,
cases h,
cases h_h₂,
assumption,
intro h,
apply big_step.seq t,
assumption,
apply big_step.skip
end

lemma program_equiv_seq_congr {p₁ p₂ p₃ p₄ : program σ}
  (h₁₂ : p₁ ≈ p₂) (h₃₄ : p₃ ≈ p₄) :
  seq p₁ p₃ ≈ seq p₂ p₄ :=
begin
intros s t,
apply iff.intro,
intro h,
apply big_step.seq t,
cases h,
apply big_step.seq h_t h₁₂ h_h₁,
end

lemma program_equiv.ite_seq_while :
  ite c (seq p (while c p)) skip ≈ while c p :=
begin
intros s t,
apply iff.intro,
intro h,
cases h,
cases h_h,
apply big_step.while_true h_h_t h_hs h_h_h₁ h_h_h₂,
cases h_h,
apply big_step.while_false h_hs,
intro h,
cases h,
apply big_step.ite_true h_hs,
apply big_step.seq h_t h_hp h_hw,
apply big_step.ite_false h_hs,
apply big_step.skip
end

lemma program_equiv.ite_seq_while' :
  ite c (seq p (while c p)) skip ≈ while c p :=
begin
intros s t,
apply iff.intro,
intro h,
cases h,
cases h_h,
apply big_step.while_true h_h_t h_hs h_h_h₁ h_h_h₂,
cases h_h,
apply big_step.while_false,
assumption,
intro h,
cases h,
apply big_step.ite_true h_hs,
apply big_step.seq h_t h_hp h_hw,
apply big_step.ite_false,
assumption,
apply big_step.skip
end

/- 1.2. Prove one more equivalence. `@id σ` is the identity function on states. -/

lemma program_equiv.skip_assign_id : assign (@id σ) ≈ skip :=
sorry

/- 1.3. Why do you think `@id σ` is necessary, as opposed to `id`? -/

/- Answer: enter your answer here. -/

example {p p' : program σ} : seq (while (λ_, true) p) p' ≈ while (λ_, true) p :=
begin
intros l t,
apply iff.intro,
intro s,
cases s,
apply big_step.while_true s_t s_h₁ s_h₂,

end

end program

/- Question 2: The guarded command language (GCL) -/

/- In 1976, E. W. Dijkstra introduced the guarded command language, as a language with
built-in nondeterminism. Its grammar is as follows:

    p  ::=  x := e        -- assignment
         |  assert b      -- assertion
         |  p ; p         -- sequential composition
         |  p | ... | p   -- nondeterministic choice
         |  loop p        -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other statements have the
following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a no-op.

* `p | ... | p` chooses **any** of the branches and executes it, ignoring the other branches.

* `loop p` executes `p` **any** number of times.

In Lean, GCL is captured by the following inductive type: -/

inductive gcl (σ : Type) : Type
| assign : (σ → σ) → gcl
| assert : (σ → Prop) → gcl
| seq    : gcl → gcl → gcl
| choice : list gcl → gcl
| loop   : gcl → gcl

namespace gcl

variable {σ : Type}
variables {c : σ → Prop} {f : σ → σ} {p p₀ p₁ p₂ : gcl σ} {ps : list (gcl σ)} {s s₀ s₁ s₂ t u : σ}

/- The big-step semantics is defined as follows: -/

inductive big_step : (gcl σ × σ) → σ → Prop
| assign {f s} :
  big_step (assign f, s) (f s)
| assert {c : σ → Prop} {s} (hs : c s) :
  big_step (assert c, s) s
| seq {p₁ p₂ s u} (t) (h₁ : big_step (p₁, s) t) (h₂ : big_step (p₂, t) u) :
  big_step (seq p₁ p₂, s) u
| choice {ps : list (gcl σ)} {s t} (i : ℕ) (hi : i < list.length ps)
  (h : big_step (list.nth_le ps i hi, s) t) :
  big_step (choice ps, s) t
| loop_base {p s} :
  big_step (loop p, s) s
| loop_step {p s t} (u) (h₁ : big_step (p, s) u) (h₂ : big_step (loop p, u) t) :
  big_step (loop p, s) t

/- Some convenience syntax: -/

infix ` ~> `:110 := big_step

/- 2.1. Prove the following inversion rules, as we did in the lecture for the WHILE language. -/

@[simp] lemma big_step_assign : (assign f, s) ~> t ↔ t = f s :=
begin
apply iff.intro,
intro h,
cases h,
trivial,
intro h,
cases h,
apply big_step.assign
end

@[simp] lemma big_step_assert : (assert c, s) ~> t ↔ (t = s ∧ c s) :=
begin
apply iff.intro,
intro h,
cases h,
apply and.intro,
trivial,
assumption,
intro h,
cases h,
cases h_left,
apply big_step.assert h_right
end

@[simp] lemma big_step_seq : (seq p₁ p₂, s) ~> t ↔ (∃u, (p₁, s) ~> u ∧ (p₂, u) ~> t) :=
begin
apply iff.intro,
intro h,
cases h,
apply exists.intro h_t,
apply and.intro,
assumption,
assumption,
intro h,
cases h,
cases h_h,
apply big_step.seq h_w h_h_left h_h_right
end

lemma big_step_loop : (loop p, s) ~> t ↔ (s = t ∨ (∃u, (p, s) ~> u ∧ (loop p, u) ~> t)) :=
begin
apply iff.intro,
intro h,
cases h,
apply or.intro_left,
trivial,
apply or.intro_right,
apply exists.intro h_u,
apply and.intro,
repeat{assumption},
intro h,
cases h,
cases h,
exact big_step.loop_base,
cases h,
cases h_h,
exact big_step.loop_step h_w h_h_left h_h_right
end

@[simp] lemma big_step_choice :
  (choice ps, s) ~> t ↔ (∃(i : ℕ) (hi : i < list.length ps), (list.nth_le ps i hi, s) ~> t) :=
begin
apply iff.intro,
intro h,
apply exists.intro,
apply exists.intro,
cases h,

end

/- 2.2. Fill in the translation below of a deterministic program to a GCL program, by filling in the
`sorry` placeholders below. -/

-- def of_program : program σ → gcl σ
-- | program.skip          := assign id
-- | (program.assign f)    := assign f
-- | (program.seq p₁ p₂)   :=
--   seq (of_program p₁) (of_program p₂)
-- | (program.ite c p₁ p₂) :=
--   choice [
--     seq (assert c) (of_program p₁),
--     seq (assert (λs, ¬ c s)) (of_program p₂)
--   ]
-- | (program.while c p)   := seq (loop (seq (assert c) (of_program p))) (assert (λs, ¬ c s))

-- inductive program (σ : Type) : Type
-- | skip {} : program
-- | assign  : (σ → σ) → program
-- | seq     : program → program → program
-- | ite     : (σ → Prop) → program → program → program
-- | while   : (σ → Prop) → program → program

-- inductive gcl (σ : Type) : Type
-- | assign : (σ → σ) → gcl
-- | assert : (σ → Prop) → gcl
-- | seq    : gcl → gcl → gcl
-- | choice : list gcl → gcl
-- | loop   : gcl → gcl

def of_program : program σ → gcl σ
| program.skip          := assign id
| (program.assign f)    := assign f
| (program.seq f s)     := seq (of_program f) (of_program s)
| (program.ite c p1 p2) := choice [seq (assert c) (of_program p1), seq(assert (λs,¬c s)) (of_program p2)]
| (program.while c p)   := seq(loop(seq(assert c) (of_program p))) (assert(λs, ¬ c s))

/- 2.3. Prove that `of_program` is correct, in the sense that whenever the deterministic program `p`
can make a big step, the corresponding GCL program makes a big step.

This is a difficult exercise. Try to get as far as possible.

**Hints:**

* In the each induction subgoal, use `cases h` on an equality `h : (p, s) = (q, t)`. When one side
is a variable, it will be replaced by the other side. In our case, one side is always a variable.

* Use `specialize h rfl` to instantiate a hypothesis, i.e. to replace a hypothesis of the form
`h : ∀{x y}, (x, y) = (p, s) → q x y` with `h : q p s`.

* At some point you need to prove statements such as `0 < 1 + 1`. Here, you can use use the
`dec_trival` proof term (e.g. in tactic mode, you must write `exact dec_trivial`)

* You need to use `cases` in the `while_true` case, to cope with a hypothesis of the form
`h : of_program (while c p, s) ~> t`. This breaks the hypothesis down and will allow you to retrieve
the intermediate states and steps.

* You may want to use lemmas from the `program` namespace, e.g. the inversion rules
(`program.big_step_while_iff`, etc.). -/

lemma big_step_of_program {p : program σ} {s t} :
  (p, s) ⟹ t → (of_program p, s) ~> t :=
begin
  /- The term `(p, s)` needs to be replaced by a variable. We use the same tools as in the lecture:

  * `generalize` replaces a term in our goal by a new variable and an equality assumption.

  * `generalizing p s` tells the `induction` tactic that `p` and `s` should be quantified. -/
  generalize eq : (p, s) = ps,
  intro h,
  induction h generalizing p s;
    cases eq;
    clear eq,
  { simp [of_program] },
  { sorry },
  { sorry },
  { sorry },
  { sorry },
  { sorry },
  { sorry }
end

end gcl


import tactic

-- Упражнения в этом файле сосредоточены на свойствах функций: инъекции, сюръекции и биекции.
-- По большей части заимствовано из курса Formalising Mathematics:
-- https://github.com/ImperialCollegeLondon/formalising-mathematics/blob/master/src/week_1/Part_C_functions.lean
-- https://github.com/ImperialCollegeLondon/formalising-mathematics/blob/master/src/week_4/Part_A_sets.lean

open function

-- Определим namespace, чтобы не пересекаться по названиям со стандартной библиотекой
namespace itmo.lean

-- Определим типы `X, Y, Z`, функции `f : X → Y`, `g : Y → Z` и вспомогательные элементы `(x : X) (y : Y) (z : Z)`
variables {X Y Z : Type} {f : X → Y} {g : Y → Z} (x : X) (y : Y) (z : Z)

-- Функция `f` является инъекцией, если из `f a = f b` следует, что `a = b` (то есть, для разных входов она выдает разные результаты)
lemma injective_def : injective f ↔ ∀ a b : X, f a = f b → a = b :=
begin
  -- верно по определению
  refl,
end

-- Тождественная функция id : X → X определена, как `id x = x`:
lemma id_def : id x = x :=
begin
  refl
end

/-- Тождественная функция инъективна -/
lemma injective_id : injective (id : X → X) :=
begin
  rintro a b h,
  exact h,
end

-- Композиция функций `g ∘ f` (∘ = \o или \circ) определена, как `(g ∘ f) x = g (f x)`
lemma comp_def : (g ∘ f) x = g (f x) :=
begin
  -- верно по определению
  refl,
end

/-- Композиция инъекций является инъекцией -/
lemma injective_comp (hf : injective f) (hg : injective g) : injective (g ∘ f) :=
begin
  rintro x y h,
  apply hf,
  apply hg,
  exact h,
end

-- Функция `f : X → Y` называется сюръекцией, если для любого `y : Y` существует `x : X`, что `f x = y`
lemma surjective_def : surjective f ↔ ∀ y : Y, ∃ x : X, f x = y :=
begin
  -- верно по определению
  refl
end

/-- Тождественная функция - сюръекция -/
lemma surjective_id : surjective (id : X → X) :=
begin
  intro y,
  use y,
  refl,
end

-- Композиция сюръекций является сюръекцией
lemma surjective_comp (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  intro z,
  rcases hg z with ⟨y, rfl⟩,
  rcases hf y with ⟨x, rfl⟩,
  use x,
end

-- Функция `f` называется биекцией, если она является инъекцией и сюръекцией
lemma bijective_def : bijective f ↔ injective f ∧ surjective f :=
begin
  -- верно по определению
  refl
end

-- Используйте доказанные ранее утверждения
-- Тождественная функция - биекция
lemma bijective_id : bijective (id : X → X) :=
begin
  exact ⟨injective_id, surjective_id⟩,
end

-- Композиция биекций является биекцией
lemma bijective_comp (hf : bijective f) (hg : bijective g) : bijective (g ∘ f) :=
begin
  exact ⟨injective_comp hf.1 hg.1, surjective_comp hf.2 hg.2⟩,
end

variables (S : set X) (T : set Y)

-- Образ множества `S : set X` под действием функции `f : X → Y` обозначается как `(f '' S) : set Y`
-- `y ∈ f '' S` по определению равно `∃ x : X, x ∈ S ∧ f x = y`
-- В стандартной библиотеке это называется `set.image : (X → Y) → set X → set Y`
#check set.image
example : set.image f S = f '' S := rfl

lemma mem_image : y ∈ f '' S = ∃ x : X, x ∈ S ∧ f x = y :=
begin
  refl,
end

-- Образ тождественной функции
lemma image_id : id '' S = S :=
begin
  ext x,
  split,
  { rintro ⟨x₁, x₁S, hx₁⟩,
    rw [← hx₁, id],
    exact x₁S, },
  { intro xS,
    use x,
    rw id,
    use xS,
    -- оставшая цель закрыта с помощью `refl` после `use`
  }
end

-- `simp` справится с такой целью, потому что в стандартной библиотеке есть функция `set.image_id'`, помеченная атрибутом `@[simp]`, что включает ее в список используемых `simp` лемм
example : id '' S = S :=
begin
  ext, simp,
end

-- Это хорошее место, чтобы опробовать `rintro ⟨...⟩` и `refine ⟨...⟩`
-- Тактика `refine` очень похожа на `exact` и `apply`, но к тому же позволяет писать `_` в некоторых местах, генерируя цели для пропущенных аргументов
-- Например, пусть у нас есть состояние
-- x : X
-- xS : x ∈ S
-- h: (g ∘ f) x = z
-- ⊢ z ∈ g '' (f '' S)
-- После применения `refine ⟨f x, _, h⟩`, цель меняется на
-- ⊢ f x ∈ f '' S
-- Если подчеркиваний нет, и все корректно, `refine` закроет цель

lemma image_comp (S : set X) : (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z, split,
  { rintro ⟨x, xS, h⟩,
    refine ⟨f x, _, h⟩,
    refine ⟨x, xS, rfl⟩, },
  { rintro ⟨y, ⟨x, xS, rfl⟩, h⟩,
    refine ⟨x, xS, h⟩, }
end

-- Если `f` - инъекция, то функция `λ S, f '' S` (то есть функция, которая переводит множество `S` в `f '' S`) - тоже
-- Тактика `dsimp` (`definitional simp`) действует так же, как `simp`, но использует только равенства, верные по определению
-- С помощью `dsimp` можно упростить "очевидные" выражения, такие, как применения λ-функций:
-- `h : (λ (S : set X), f '' S) S = (λ (S : set X), f '' S) T`
-- `dsimp at h`
-- `h : f '' S = f '' T`
-- Аналогично `simp`, `dsimp only [h₁, h₂, h₃]` будет применять только леммы `h₁`, `h₂` и `h₃`, а `dsimp only at h` не будет применять дополнительных лемм (но, например, раскроет применения лямбд и подобные вещи)

-- Для себя я нашел полезным доказать лемму `image_subset_of_subset: ∀ S T, f '' S ⊆ f '' T → S ⊆ T`

lemma image_injective : injective f → injective (λ S, f '' S) :=
begin
  intro hf,
  rintro S T hST,
  simp only at hST,
  have image_subset : ∀ S T, f '' S ⊆ f '' T → S ⊆ T, {
    clear hST S T,
    rintro S T hST x xS,
    -- то же самое, что `rcases hST ⟨x, xS, rfl⟩ with  ⟨y, yT, hy⟩`
    obtain ⟨y, yT, hy⟩ := hST ⟨x, xS, rfl⟩,
    rwa (hf hy) at yT,
  },
  apply set.subset.antisymm (image_subset S T (eq.subset hST)) (image_subset T S (eq.subset hST.symm)),
end

-- Прообраз функции `f : X → Y` обозначается `f ⁻¹' : set Y → set X
-- По определению: `x ∈ f ⁻¹' T ↔ f x ∈ T`

lemma mem_preimage : x ∈ f ⁻¹' T ↔ f x ∈ T :=
begin
  refl,
end

lemma comp_preimage (T : set Z) : (g ∘ f) ⁻¹' T = f ⁻¹' (g ⁻¹' T) :=
begin
  refl,
end

lemma preimage_injective (hf : surjective f) : injective (λ T, f ⁻¹' T) :=
begin
  rintro S T hST,
  dsimp at hST,
  -- "Достаточно доказать, что ∀ {S T}, f ⁻¹' S ⊆ f ⁻¹' T → S ⊆ T"
  --
  suffices : ∀ {S T}, f ⁻¹' S ⊆ f ⁻¹' T → S ⊆ T, {
    apply set.subset.antisymm (this $ eq.subset hST) (this $ eq.subset hST.symm),
  },
  clear hST S T,
  rintro S T hST y yS,
  obtain ⟨y₁, rfl⟩ := hf y,
  exact hST yS,
end

lemma image_surjective (hf : surjective f) : surjective (λ S, f '' S) :=
begin
  intro T,
  use [f ⁻¹' T],
  dsimp only,
  ext y,
  split, {
    rintro ⟨x, h, rfl⟩,
    exact h,
  }, {
    intro yt,
    obtain ⟨x, rfl⟩ := hf y,
    exact ⟨x, yt, rfl⟩,
  }
end

lemma preimage_surjective (hf : injective f) : surjective (λ S, f ⁻¹' S) :=
begin
  intro T,
  dsimp only,
  use [f '' T],
  ext x,
  split, {
    rintro ⟨x', x'T, fx'⟩,
    rwa ←(hf fx'),
  }, {
    rintro xT,
    refine ⟨x, xT, rfl⟩,
  }
end

variables (ι : Type)

-- Образ объединения множеств `G i` под функцией `f`, равен объединению образов множеств `G i`
-- Используйте `set.mem_Union` для переписывания
lemma image_Union (G : ι → set X) :  f '' (⋃ (i : ι), G i) = ⋃ (i : ι), f '' (G i) :=
begin
  ext y,
  split, {
    dsimp only,
    rintro ⟨y, ⟨_, ⟨i, rfl⟩, yFi⟩, rfl⟩,
    rw set.mem_Union,
    refine ⟨i, y, yFi, rfl⟩,
  }, {
    rw set.mem_Union,
    rintro ⟨i, ⟨x, xFi, rfl⟩⟩,
    refine ⟨x, _, rfl⟩,
    rw set.mem_Union,
    use [i, xFi],
  }
end

-- Прообраз объединения множеств равен объединению прообразов
-- Используйте `set.mem_bUnion_iff` для переписывания
lemma preimage_bUnion (F : ι → set Y) (Z : set ι) :
  f ⁻¹' (⋃ (i ∈ Z), F i) = ⋃ (i ∈ Z), f ⁻¹' (F i) :=
begin
  ext x,
  rw [mem_preimage, set.mem_bUnion_iff, set.mem_bUnion_iff],
  refl,
end

end itmo.lean


/-
  Continuous Linear Maps

  These are a well-behaved subset of all linear maps. In finite dimensional normed vector spaces, all linear maps are continuous. For a certain type of normed space (which?), continuous linear maps and bounded linear maps are the same.

  The derivative of f : E → F is f' : E → continuous_linear_map E F.
-/

import differentiability.normed_space

universes u v w x

-- TODO: maybe continuous should be a structure and not a regular prop
structure is_continuous_linear_map {k : Type u} {E : Type v} {F : Type w} [normed_field k] [normed_space k E] [normed_space k F] (L : E → F) extends is_linear_map L : Prop :=
(continuous : continuous L)

namespace is_continuous_linear_map
variables {k : Type u} {E : Type v} {F : Type w} {G : Type x}
variables [normed_field k] [normed_space k E] [normed_space k F] [normed_space k G]
variable {L : E → F}
include k

section
variable (hL : is_continuous_linear_map L)
include hL

-- linear map simp lemmas
-- TODO: should there be an smul lemma
@[simp] lemma zero : L 0 = 0 := hL.to_is_linear_map.zero
@[simp] lemma neg (v : E) : L (- v) = - L v := hL.to_is_linear_map.neg _
@[simp] lemma sub (v w : E) : L (v - w) = L v - L w := hL.to_is_linear_map.sub _ _
@[simp] lemma sum {ι : Type x} {t : finset ι} {f : ι → E} : L (t.sum f) = t.sum (λi, L (f i)) := hL.to_is_linear_map.sum

end

-- TODO: is_linear_map and continuous have different order conventions for this theorem. adopting is_linear_map's
lemma comp {M : G → E} : is_continuous_linear_map L → is_continuous_linear_map M → is_continuous_linear_map (L ∘ M)
| ⟨L_lin, L_cont⟩ ⟨M_lin, M_cont⟩ := ⟨is_linear_map.comp L_lin M_lin, continuous.comp M_cont L_cont⟩

lemma id : is_continuous_linear_map (id : E → E) := ⟨is_linear_map.id, continuous_id⟩

-- no inverse thm except for special circumstances

lemma map_zero : is_continuous_linear_map (λv, 0 : E → F) := ⟨is_linear_map.map_zero, continuous_const⟩

-- TODO: could move hypothesis to the left if continuous was a structure b/c then I could use to_is_continuous
lemma map_neg : is_continuous_linear_map L → is_continuous_linear_map (λv, - L v)
| ⟨lin, cont⟩ := ⟨is_linear_map.map_neg lin, continuous_neg cont⟩

lemma map_add {M : E → F} : is_continuous_linear_map L → is_continuous_linear_map M → is_continuous_linear_map (λv, L v + M v)
| ⟨L_lin, L_cont⟩ ⟨M_lin, M_cont⟩ := ⟨is_linear_map.map_add L_lin M_lin, continuous_add L_cont M_cont⟩

-- TODO: I don't understand this lemma so I don't want to translate it
/- lemma map_sum [decidable_eq δ] {t : finset δ} {f : δ → β → γ} :
  (∀d∈t, is_linear_map (f d)) → is_linear_map (λb, t.sum $ λd, f d b) -/

lemma map_sub {M : E → F} : is_continuous_linear_map L → is_continuous_linear_map M → is_continuous_linear_map (λv, L v - M v)
| ⟨L_lin, L_cont⟩ ⟨M_lin, M_cont⟩ := ⟨is_linear_map.map_sub L_lin M_lin, continuous_sub L_cont M_cont⟩

-- TODO: this requires topological vector spaces
lemma map_smul_right {c : k} : is_continuous_linear_map L →
  is_continuous_linear_map (λv, c • L v)
| ⟨lin, cont⟩ := ⟨is_linear_map.map_smul_right lin, sorry⟩

-- TODO: this requires topological vector spaces and normed_field.to_normed_space (see ring.to_module in module.lean)
lemma map_smul_left {L : E → k} {v : F} : is_continuous_linear_map L → is_continuous_linear_map (λc, L c • v)
| ⟨lin, cont⟩ := sorry

end is_continuous_linear_map

-- begins diverging from homeos approach
-- draw from linear_map_module and poly
-- TODO: convert poly-like theorems
def continuous_linear_map {k : Type u} (E : Type v) (F : Type w) [normed_field k] [normed_space k E] [normed_space k F] :=
subtype (@is_continuous_linear_map k E F _ _ _)

namespace continuous_linear_map
variables {k : Type u} {E : Type v} {F : Type w} {G : Type x}
variables [normed_field k] [normed_space k E] [normed_space k F] [normed_space k G]
variables {c : k} {v w : E} {L M : continuous_linear_map E F}
include k

instance : has_coe_to_fun (continuous_linear_map E F) := ⟨_, subtype.val⟩

@[extensionality]
theorem ext {M : continuous_linear_map E F} (h : ∀ v, L v = M v) : L = M := subtype.eq $ funext h

lemma is_clm (L : continuous_linear_map E F) : is_continuous_linear_map L := L.property

def subst (L : continuous_linear_map E F) (M : E → F) (e : ∀ v, L v = M v) : continuous_linear_map E F :=
⟨M, by rw ← (funext e : coe_fn L = M); exact L.is_clm⟩

def comp (L :continuous_linear_map F G) (M : continuous_linear_map E F) : continuous_linear_map E G := ⟨λv, L (M v), is_continuous_linear_map.comp L.is_clm M.is_clm⟩

@[simp] lemma map_add  : L (v + w) = L v + L w := L.is_clm.add v w
@[simp] lemma map_zero : L 0 = 0 := L.is_clm.zero
@[simp] lemma map_smul : L (c • v) = c • L v := L.is_clm.smul c v
@[simp] lemma map_neg  : L (-v) = -L v := L.is_clm.neg _
@[simp] lemma map_sub  : L (v - w) = L v - L w := L.is_clm.sub _ _

section add_comm_group

def add : continuous_linear_map E F → continuous_linear_map E F → continuous_linear_map E F := λ L M, ⟨L + M, is_continuous_linear_map.map_add L.is_clm M.is_clm⟩

def zero : continuous_linear_map E F := ⟨λv, 0, is_continuous_linear_map.map_zero⟩

def neg : continuous_linear_map E F → continuous_linear_map E F := λ L, ⟨λv, -(L v), is_continuous_linear_map.map_neg L.is_clm⟩

instance : has_add (continuous_linear_map E F) := ⟨add⟩
instance : has_zero (continuous_linear_map E F) := ⟨zero⟩
instance : has_neg (continuous_linear_map E F) := ⟨neg⟩

@[simp] lemma add_app : (L + M) v = L v + M v := rfl
@[simp] lemma zero_app : (0 : continuous_linear_map E F) v = 0 := rfl
@[simp] lemma neg_app : (-L) v = -L v := rfl

instance : add_comm_group (continuous_linear_map E F) :=
by refine {add := (+), zero := 0, neg := has_neg.neg, ..}; { intros, apply ext, simp }

end add_comm_group

section module

-- TODO: need to prove topological vector space stuff
def smul : k → continuous_linear_map E F → continuous_linear_map E F := λ c L, ⟨λ v, c•(L v), is_continuous_linear_map.smul_right c L.is_clm⟩

instance : has_scalar k (continuous_linear_map E F) := ⟨smul⟩

@[simp] lemma smul_app : (c • L) v = c • (L v) := rfl

instance : module k (continuous_linear_map E F) :=
by refine {smul := (•), ..continuous_linear_map.add_comm_group, ..};
  { intros, apply ext, simp [smul_add, add_smul, mul_smul] }

end module

section metric_space

-- TODO!

end metric_space

section normed_space

-- TODO!

end normed_space

end continuous_linear_map


open Classical

variable (p q r : Prop)

example : (p → q ∨ r) → ((p → q) ∨ (p → r)) :=
    (fun hpqr : p → q ∨ r =>
      Or.elim
        (em p)
        (fun hp : p =>
          Or.elim
            (hpqr hp)
            (fun hq : q => Or.intro_left (p → r) (fun p => hq))
            (fun hr : r => Or.intro_right (p → q) (fun p => hr))
        )
        (fun hnp : ¬p =>
          Or.intro_right (p → q) (fun hp : p => False.elim (hnp hp))
        )
    )

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
    (fun hpq : ¬(p ∧ q) =>
      Or.elim
        (em p)
        (fun hp : p =>
          Or.inr (show ¬q from fun hq : q =>
            show False from hpq ⟨hp, hq⟩)
        )
        (fun hnp : ¬p => Or.inl hnp)
    )

-- basically a truth-table proof via syntax...
-- hackish
-- would be better if you proved by contradiction using deMorgan
-- but you had to prove deMorgan as an example, not a named theorem, so csf
example : ¬(p → q) → p ∧ ¬q :=
    (fun hyp : ¬(p → q) =>
      byCases
      -- case 1 : p
        (fun hp : p =>
          byCases
          -- case 1.a : p and q
            (fun hq : q =>
              ⟨
                hp, show ¬q from (fun q => show False from hyp (fun p => hq))
              ⟩
            )
          -- case 1.b : p and non q
            (fun hnq : ¬q => ⟨hp, hnq⟩)
        )
      -- case 2 : non p
        (fun hnp : ¬p => show (p ∧ ¬q) from False.elim
          (show False from hyp
            (show (p → q) from fun p : p =>
              (show q from False.elim (hnp p))
            )
          )
        )
    )

example : (p → q) → (¬p ∨ q) :=
  (fun h : p → q =>
    byCases
      (fun hp : p => Or.inr (h hp))
      (fun hnp : ¬p => Or.inl hnp)
  )

--- again, would be cleaner by contradiction
example : (¬q → ¬p) → (p → q) :=
    (fun hyp : (¬q → ¬p) =>
      byCases
        (fun hq : q =>
          byCases
            (fun hp : p => (fun p => hq))
            (fun hnp : ¬p => (fun p => show q from False.elim (hnp p)))
        )
        (fun hnq : ¬q => (fun hp : p => show q from False.elim ((hyp hnq) hp)))
    )

example : p ∨ ¬p :=
  byContradiction
    (fun hyp : ¬(p ∨ ¬p) =>
      absurd (fun hp : p => show False from (hyp (Or.inl hp)))
             (fun hnp : ¬p => show False from (hyp (Or.inr hnp)))
    )

-- ugly
example : (((p → q) → p) → p) :=
    (fun impl : (p → q) → p =>
      byContradiction
      -- suppose not p
        (fun hyp : ¬p =>
          -- we reach the absurd conclusion that p
          -- by the implication that (p->q)->p
          absurd (impl
            -- since we can show that (p->q)
            (show (p → q) from (fun hp : p => show q from
              False.elim (hyp hp)
              )
            )
          ) hyp
        )
    )


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

! This file was ported from Lean 3 source module data.nat.choose.vandermonde
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.Coeff
import Mathbin.Data.Nat.Choose.Basic

/-!

# Vandermonde's identity

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

In this file we prove Vandermonde's identity (`nat.add_choose_eq`):
`(m + n).choose k = ∑ (ij : ℕ × ℕ) in antidiagonal k, m.choose ij.1 * n.choose ij.2`

We follow the algebraic proof from
https://en.wikipedia.org/wiki/Vandermonde%27s_identity#Algebraic_proof .

-/

open BigOperators

open Polynomial Finset.Nat

#print Nat.add_choose_eq /-
/-- Vandermonde's identity -/
theorem Nat.add_choose_eq (m n k : ℕ) :
    (m + n).choose k = ∑ ij : ℕ × ℕ in antidiagonal k, m.choose ij.1 * n.choose ij.2 :=
  by
  calc
    (m + n).choose k = ((X + 1) ^ (m + n)).coeff k := _
    _ = ((X + 1) ^ m * (X + 1) ^ n).coeff k := by rw [pow_add]
    _ = ∑ ij : ℕ × ℕ in antidiagonal k, m.choose ij.1 * n.choose ij.2 := _

  · rw [coeff_X_add_one_pow, Nat.cast_id]
  · rw [coeff_mul, Finset.sum_congr rfl]
    simp only [coeff_X_add_one_pow, Nat.cast_id, eq_self_iff_true, imp_true_iff]
#align nat.add_choose_eq Nat.add_choose_eq
-/


-- Pruebas de (A ∩ Bᶜ) ∪ B = A ∪ B
-- ===============================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    (A ∩ Bᶜ) ∪ B = A ∪ B
-- ----------------------------------------------------

import data.set

open set

variable  U : Type
variables A B C : set U

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

example : (A ∩ Bᶜ) ∪ B = A ∪ B :=
calc
  (A ∩ Bᶜ) ∪ B = (A ∪ B) ∩ (Bᶜ ∪ B) : by rw union_distrib_right
           ... = (A ∪ B) ∩ univ     : by rw compl_union_self
           ... = A ∪ B              : by rw inter_univ

example : (A ∩ B) ∪ C = (A ∪ C) ∩ (B ∪ C) :=
-- by library_search
union_distrib_right A B C

example : Bᶜ ∪ B = univ :=
-- by library_search
compl_union_self B

example : A ∩ univ = A :=
-- by library_search
inter_univ A

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

example : (A ∩ Bᶜ) ∪ B = A ∪ B :=
begin
  rw union_distrib_right,
  rw compl_union_self,
  rw inter_univ,
end

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

example : (A ∩ Bᶜ) ∪ B = A ∪ B :=
by rw [union_distrib_right, compl_union_self, inter_univ]

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

example : (A ∩ Bᶜ) ∪ B = A ∪ B :=
by simp [union_distrib_right]


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

! This file was ported from Lean 3 source module topology.uniform_space.equicontinuity
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.UniformSpace.UniformConvergenceTopology

/-!
# Equicontinuity of a family of functions

Let `X` be a topological space and `α` a `UniformSpace`. A family of functions `F : ι → X → α`
is said to be *equicontinuous at a point `x₀ : X`* when, for any entourage `U` in `α`, there is a
neighborhood `V` of `x₀` such that, for all `x ∈ V`, and *for all `i`*, `F i x` is `U`-close to
`F i x₀`. In other words, one has `∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U`.
For maps between metric spaces, this corresponds to
`∀ ε > 0, ∃ δ > 0, ∀ x, ∀ i, dist x₀ x < δ → dist (F i x₀) (F i x) < ε`.

`F` is said to be *equicontinuous* if it is equicontinuous at each point.

A closely related concept is that of ***uniform*** *equicontinuity* of a family of functions
`F : ι → β → α` between uniform spaces, which means that, for any entourage `U` in `α`, there is an
entourage `V` in `β` such that, if `x` and `y` are `V`-close, then *for all `i`*, `F i x` and
`F i y` are `U`-close. In other words, one has
`∀ U ∈ 𝓤 α, ∀ᶠ xy in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U`.
For maps between metric spaces, this corresponds to
`∀ ε > 0, ∃ δ > 0, ∀ x y, ∀ i, dist x y < δ → dist (F i x₀) (F i x) < ε`.

## Main definitions

* `EquicontinuousAt`: equicontinuity of a family of functions at a point
* `Equicontinuous`: equicontinuity of a family of functions on the whole domain
* `UniformEquicontinuous`: uniform equicontinuity of a family of functions on the whole domain

## Main statements

* `equicontinuous_iff_continuous`: equicontinuity can be expressed as a simple continuity
  condition between well-chosen function spaces. This is really useful for building up the theory.
* `Equicontinuous.closure`: if a set of functions is equicontinuous, its closure
  *for the topology of uniform convergence* is also equicontinuous.

## Notations

Throughout this file, we use :
- `ι`, `κ` for indexing types
- `X`, `Y`, `Z` for topological spaces
- `α`, `β`, `γ` for uniform spaces

## Implementation details

We choose to express equicontinuity as a properties of indexed families of functions rather
than sets of functions for the following reasons:
- it is really easy to express equicontinuity of `H : set (X → α)` using our setup: it is just
  equicontinuity of the family `(↑) : ↥H → (X → α)`. On the other hand, going the other way around
  would require working with the range of the family, which is always annoying because it
  introduces useless existentials.
- in most applications, one doesn't work with bare functions but with a more specific hom type
  `hom`. Equicontinuity of a set `H : set hom` would then have to be expressed as equicontinuity
  of `coe_fn '' H`, which is super annoying to work with. This is much simpler with families,
  because equicontinuity of a family `𝓕 : ι → hom` would simply be expressed as equicontinuity
  of `coe_fn ∘ 𝓕`, which doesn't introduce any nasty existentials.

To simplify statements, we do provide abbreviations `Set.EquicontinuousAt`, `Set.Equicontinuous`
and `Set.UniformEquicontinuous` asserting the corresponding fact about the family
`(↑) : ↥H → (X → α)` where `H : Set (X → α)`. Note however that these won't work for sets of hom
types, and in that case one should go back to the family definition rather than using `Set.image`.

Since we have no use case for it yet, we don't introduce any relative version
(i.e no `EquicontinuousWithinAt` or `EquicontinuousOn`), but this is more of a conservative
position than a design decision, so anyone needing relative versions should feel free to add them,
and that should hopefully be a straightforward task.

## References

* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]

## Tags

equicontinuity, uniform convergence, ascoli
-/

section

open UniformSpace Filter Set

open Uniformity Topology UniformConvergence

variable {ι κ X Y Z α β γ 𝓕 : Type _} [TopologicalSpace X] [TopologicalSpace Y] [TopologicalSpace Z]
  [UniformSpace α] [UniformSpace β] [UniformSpace γ]

/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
*equicontinuous at `x₀ : X`* if, for all entourage `U ∈ 𝓤 α`, there is a neighborhood `V` of `x₀`
such that, for all `x ∈ V` and for all `i : ι`, `F i x` is `U`-close to `F i x₀`. -/
def EquicontinuousAt (F : ι → X → α) (x₀ : X) : Prop :=
  ∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U
#align equicontinuous_at EquicontinuousAt

/-- We say that a set `H : set (X → α)` of functions is equicontinuous at a point if the family
`(↑) : ↥H → (X → α)` is equicontinuous at that point. -/
protected abbrev Set.EquicontinuousAt (H : Set <| X → α) (x₀ : X) : Prop :=
  EquicontinuousAt ((↑) : H → X → α) x₀
#align set.equicontinuous_at Set.EquicontinuousAt

/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
*equicontinuous* on all of `X` if it is equicontinuous at each point of `X`. -/
def Equicontinuous (F : ι → X → α) : Prop :=
  ∀ x₀, EquicontinuousAt F x₀
#align equicontinuous Equicontinuous

/-- We say that a set `H : set (X → α)` of functions is equicontinuous if the family
`(↑) : ↥H → (X → α)` is equicontinuous. -/
protected abbrev Set.Equicontinuous (H : Set <| X → α) : Prop :=
  Equicontinuous ((↑) : H → X → α)
#align set.equicontinuous Set.Equicontinuous

/-- A family `F : ι → β → α` of functions between uniform spaces is *uniformly equicontinuous* if,
for all entourage `U ∈ 𝓤 α`, there is an entourage `V ∈ 𝓤 β` such that, whenever `x` and `y` are
`V`-close, we have that, *for all `i : ι`*, `F i x` is `U`-close to `F i x₀`. -/
def UniformEquicontinuous (F : ι → β → α) : Prop :=
  ∀ U ∈ 𝓤 α, ∀ᶠ xy : β × β in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U
#align uniform_equicontinuous UniformEquicontinuous

/-- We say that a set `H : set (X → α)` of functions is uniformly equicontinuous if the family
`(↑) : ↥H → (X → α)` is uniformly equicontinuous. -/
protected abbrev Set.UniformEquicontinuous (H : Set <| β → α) : Prop :=
  UniformEquicontinuous ((↑) : H → β → α)
#align set.uniform_equicontinuous Set.UniformEquicontinuous

/-- Reformulation of equicontinuity at `x₀` comparing two variables near `x₀` instead of comparing
only one with `x₀`. -/
theorem equicontinuousAt_iff_pair {F : ι → X → α} {x₀ : X} :
    EquicontinuousAt F x₀ ↔
      ∀ U ∈ 𝓤 α, ∃ V ∈ 𝓝 x₀, ∀ x ∈ V, ∀ y ∈ V, ∀ i, (F i x, F i y) ∈ U := by
  constructor <;> intro H U hU
  · rcases comp_symm_mem_uniformity_sets hU with ⟨V, hV, hVsymm, hVU⟩
    refine' ⟨_, H V hV, fun x hx y hy i => hVU (prod_mk_mem_compRel _ (hy i))⟩
    exact hVsymm.mk_mem_comm.mp (hx i)
  · rcases H U hU with ⟨V, hV, hVU⟩
    filter_upwards [hV]using fun x hx i => hVU x₀ (mem_of_mem_nhds hV) x hx i
#align equicontinuous_at_iff_pair equicontinuousAt_iff_pair

/-- Uniform equicontinuity implies equicontinuity. -/
theorem UniformEquicontinuous.equicontinuous {F : ι → β → α} (h : UniformEquicontinuous F) :
    Equicontinuous F := fun x₀ U hU =>
  mem_of_superset (ball_mem_nhds x₀ (h U hU)) fun _ hx i => hx i
#align uniform_equicontinuous.equicontinuous UniformEquicontinuous.equicontinuous

/-- Each function of a family equicontinuous at `x₀` is continuous at `x₀`. -/
theorem EquicontinuousAt.continuousAt {F : ι → X → α} {x₀ : X} (h : EquicontinuousAt F x₀) (i : ι) :
    ContinuousAt (F i) x₀ := by
  intro U hU
  rw [UniformSpace.mem_nhds_iff] at hU
  rcases hU with ⟨V, hV₁, hV₂⟩
  exact mem_map.mpr (mem_of_superset (h V hV₁) fun x hx => hV₂ (hx i))
#align equicontinuous_at.continuous_at EquicontinuousAt.continuousAt

protected theorem Set.EquicontinuousAt.continuousAt_of_mem {H : Set <| X → α} {x₀ : X}
    (h : H.EquicontinuousAt x₀) {f : X → α} (hf : f ∈ H) : ContinuousAt f x₀ :=
  h.continuousAt ⟨f, hf⟩
#align set.equicontinuous_at.continuous_at_of_mem Set.EquicontinuousAt.continuousAt_of_mem

/-- Each function of an equicontinuous family is continuous. -/
theorem Equicontinuous.continuous {F : ι → X → α} (h : Equicontinuous F) (i : ι) :
    Continuous (F i) :=
  continuous_iff_continuousAt.mpr fun x => (h x).continuousAt i
#align equicontinuous.continuous Equicontinuous.continuous

protected theorem Set.Equicontinuous.continuous_of_mem {H : Set <| X → α} (h : H.Equicontinuous)
    {f : X → α} (hf : f ∈ H) : Continuous f :=
  h.continuous ⟨f, hf⟩
#align set.equicontinuous.continuous_of_mem Set.Equicontinuous.continuous_of_mem

/-- Each function of a uniformly equicontinuous family is uniformly continuous. -/
theorem UniformEquicontinuous.uniformContinuous {F : ι → β → α} (h : UniformEquicontinuous F)
    (i : ι) : UniformContinuous (F i) := fun U hU =>
  mem_map.mpr (mem_of_superset (h U hU) fun _ hxy => hxy i)
#align uniform_equicontinuous.uniform_continuous UniformEquicontinuous.uniformContinuous

protected theorem Set.UniformEquicontinuous.uniformContinuous_of_mem {H : Set <| β → α}
    (h : H.UniformEquicontinuous) {f : β → α} (hf : f ∈ H) : UniformContinuous f :=
  h.uniformContinuous ⟨f, hf⟩
#align set.uniform_equicontinuous.uniform_continuous_of_mem Set.UniformEquicontinuous.uniformContinuous_of_mem

/-- Taking sub-families preserves equicontinuity at a point. -/
theorem EquicontinuousAt.comp {F : ι → X → α} {x₀ : X} (h : EquicontinuousAt F x₀) (u : κ → ι) :
    EquicontinuousAt (F ∘ u) x₀ := fun U hU => (h U hU).mono fun _ H k => H (u k)
#align equicontinuous_at.comp EquicontinuousAt.comp

protected theorem Set.EquicontinuousAt.mono {H H' : Set <| X → α} {x₀ : X}
    (h : H.EquicontinuousAt x₀) (hH : H' ⊆ H) : H'.EquicontinuousAt x₀ :=
  h.comp (inclusion hH)
#align set.equicontinuous_at.mono Set.EquicontinuousAt.mono

/-- Taking sub-families preserves equicontinuity. -/
theorem Equicontinuous.comp {F : ι → X → α} (h : Equicontinuous F) (u : κ → ι) :
    Equicontinuous (F ∘ u) := fun x => (h x).comp u
#align equicontinuous.comp Equicontinuous.comp

protected theorem Set.Equicontinuous.mono {H H' : Set <| X → α} (h : H.Equicontinuous)
    (hH : H' ⊆ H) : H'.Equicontinuous :=
  h.comp (inclusion hH)
#align set.equicontinuous.mono Set.Equicontinuous.mono

/-- Taking sub-families preserves uniform equicontinuity. -/
theorem UniformEquicontinuous.comp {F : ι → β → α} (h : UniformEquicontinuous F) (u : κ → ι) :
    UniformEquicontinuous (F ∘ u) := fun U hU => (h U hU).mono fun _ H k => H (u k)
#align uniform_equicontinuous.comp UniformEquicontinuous.comp

protected theorem Set.UniformEquicontinuous.mono {H H' : Set <| β → α} (h : H.UniformEquicontinuous)
    (hH : H' ⊆ H) : H'.UniformEquicontinuous :=
  h.comp (inclusion hH)
#align set.uniform_equicontinuous.mono Set.UniformEquicontinuous.mono

/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff `range 𝓕` is equicontinuous at `x₀`,
i.e the family `(↑) : range F → X → α` is equicontinuous at `x₀`. -/
theorem equicontinuousAt_iff_range {F : ι → X → α} {x₀ : X} :
    EquicontinuousAt F x₀ ↔ EquicontinuousAt ((↑) : range F → X → α) x₀ :=
  ⟨fun h => by rw [← comp_rangeSplitting F]; exact h.comp _, fun h =>
    h.comp (rangeFactorization F)⟩
#align equicontinuous_at_iff_range equicontinuousAt_iff_range

/-- A family `𝓕 : ι → X → α` is equicontinuous iff `range 𝓕` is equicontinuous,
i.e the family `(↑) : range F → X → α` is equicontinuous. -/
theorem equicontinuous_iff_range {F : ι → X → α} :
    Equicontinuous F ↔ Equicontinuous ((↑) : range F → X → α) :=
  forall_congr' fun _ => equicontinuousAt_iff_range
#align equicontinuous_iff_range equicontinuous_iff_range

/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff `range 𝓕` is uniformly equicontinuous,
i.e the family `(↑) : range F → β → α` is uniformly equicontinuous. -/
theorem uniformEquicontinuous_at_iff_range {F : ι → β → α} :
    UniformEquicontinuous F ↔ UniformEquicontinuous ((↑) : range F → β → α) :=
  ⟨fun h => by rw [← comp_rangeSplitting F]; exact h.comp _, fun h =>
    h.comp (rangeFactorization F)⟩
#align uniform_equicontinuous_at_iff_range uniformEquicontinuous_at_iff_range

section

open UniformFun

/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff the function `swap 𝓕 : X → ι → α` is
continuous at `x₀` *when `ι → α` is equipped with the topology of uniform convergence*. This is
very useful for developping the equicontinuity API, but it should not be used directly for other
purposes. -/
theorem equicontinuousAt_iff_continuousAt {F : ι → X → α} {x₀ : X} :
    EquicontinuousAt F x₀ ↔ ContinuousAt (ofFun ∘ Function.swap F : X → ι →ᵤ α) x₀ := by
  rw [ContinuousAt, (UniformFun.hasBasis_nhds ι α _).tendsto_right_iff]
  rfl
#align equicontinuous_at_iff_continuous_at equicontinuousAt_iff_continuousAt

/-- A family `𝓕 : ι → X → α` is equicontinuous iff the function `swap 𝓕 : X → ι → α` is
continuous *when `ι → α` is equipped with the topology of uniform convergence*. This is
very useful for developping the equicontinuity API, but it should not be used directly for other
purposes. -/
theorem equicontinuous_iff_continuous {F : ι → X → α} :
    Equicontinuous F ↔ Continuous (ofFun ∘ Function.swap F : X → ι →ᵤ α) := by
  simp_rw [Equicontinuous, continuous_iff_continuousAt, equicontinuousAt_iff_continuousAt]
#align equicontinuous_iff_continuous equicontinuous_iff_continuous

/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff the function `swap 𝓕 : β → ι → α` is
uniformly continuous *when `ι → α` is equipped with the uniform structure of uniform convergence*.
This is very useful for developping the equicontinuity API, but it should not be used directly
for other purposes. -/
theorem uniformEquicontinuous_iff_uniformContinuous {F : ι → β → α} :
    UniformEquicontinuous F ↔ UniformContinuous (ofFun ∘ Function.swap F : β → ι →ᵤ α) := by
  rw [UniformContinuous, (UniformFun.hasBasis_uniformity ι α).tendsto_right_iff]
  rfl
#align uniform_equicontinuous_iff_uniform_continuous uniformEquicontinuous_iff_uniformContinuous

-- Porting note: changed from `∃ k (_ : p k), _` to `∃ k, p k ∧ _` since Lean 4 generates the
-- second one when parsing expressions like `∃ δ > 0, _`.
theorem Filter.HasBasis.equicontinuousAt_iff_left {κ : Type _} {p : κ → Prop} {s : κ → Set X}
    {F : ι → X → α} {x₀ : X} (hX : (𝓝 x₀).HasBasis p s) :
    EquicontinuousAt F x₀ ↔ ∀ U ∈ 𝓤 α, ∃ k, p k ∧ ∀ x ∈ s k, ∀ i, (F i x₀, F i x) ∈ U := by
  rw [equicontinuousAt_iff_continuousAt, ContinuousAt,
    hX.tendsto_iff (UniformFun.hasBasis_nhds ι α _)]
  simp only [Function.comp_apply, mem_setOf_eq, exists_prop]
  rfl
#align filter.has_basis.equicontinuous_at_iff_left Filter.HasBasis.equicontinuousAt_iff_left

theorem Filter.HasBasis.equicontinuousAt_iff_right {κ : Type _} {p : κ → Prop} {s : κ → Set (α × α)}
    {F : ι → X → α} {x₀ : X} (hα : (𝓤 α).HasBasis p s) :
    EquicontinuousAt F x₀ ↔ ∀ k, p k → ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ s k := by
  rw [equicontinuousAt_iff_continuousAt, ContinuousAt,
    (UniformFun.hasBasis_nhds_of_basis ι α _ hα).tendsto_right_iff]
  rfl
#align filter.has_basis.equicontinuous_at_iff_right Filter.HasBasis.equicontinuousAt_iff_right

-- Porting note: changed from `∃ k (_ : p k), _` to `∃ k, p k ∧ _` since Lean 4 generates the
-- second one when parsing expressions like `∃ δ > 0, _`.
theorem Filter.HasBasis.equicontinuousAt_iff {κ₁ κ₂ : Type _} {p₁ : κ₁ → Prop} {s₁ : κ₁ → Set X}
    {p₂ : κ₂ → Prop} {s₂ : κ₂ → Set (α × α)} {F : ι → X → α} {x₀ : X} (hX : (𝓝 x₀).HasBasis p₁ s₁)
    (hα : (𝓤 α).HasBasis p₂ s₂) :
    EquicontinuousAt F x₀ ↔
      ∀ k₂, p₂ k₂ → ∃ k₁, p₁ k₁ ∧ ∀ x ∈ s₁ k₁, ∀ i, (F i x₀, F i x) ∈ s₂ k₂ := by
  rw [equicontinuousAt_iff_continuousAt, ContinuousAt,
    hX.tendsto_iff (UniformFun.hasBasis_nhds_of_basis ι α _ hα)]
  simp only [Function.comp_apply, mem_setOf_eq, exists_prop]
  rfl
#align filter.has_basis.equicontinuous_at_iff Filter.HasBasis.equicontinuousAt_iff

-- Porting note: changed from `∃ k (_ : p k), _` to `∃ k, p k ∧ _` since Lean 4 generates the
-- second one when parsing expressions like `∃ δ > 0, _`.
theorem Filter.HasBasis.uniformEquicontinuous_iff_left {κ : Type _} {p : κ → Prop}
    {s : κ → Set (β × β)} {F : ι → β → α} (hβ : (𝓤 β).HasBasis p s) :
    UniformEquicontinuous F ↔
      ∀ U ∈ 𝓤 α, ∃ k, p k ∧ ∀ x y, (x, y) ∈ s k → ∀ i, (F i x, F i y) ∈ U := by
  rw [uniformEquicontinuous_iff_uniformContinuous, UniformContinuous,
    hβ.tendsto_iff (UniformFun.hasBasis_uniformity ι α)]
  simp only [Prod.forall, Function.comp_apply, mem_setOf_eq, exists_prop]
  rfl
#align filter.has_basis.uniform_equicontinuous_iff_left Filter.HasBasis.uniformEquicontinuous_iff_left

theorem Filter.HasBasis.uniformEquicontinuous_iff_right {κ : Type _} {p : κ → Prop}
    {s : κ → Set (α × α)} {F : ι → β → α} (hα : (𝓤 α).HasBasis p s) :
    UniformEquicontinuous F ↔ ∀ k, p k → ∀ᶠ xy : β × β in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ s k := by
  rw [uniformEquicontinuous_iff_uniformContinuous, UniformContinuous,
    (UniformFun.hasBasis_uniformity_of_basis ι α hα).tendsto_right_iff]
  rfl
#align filter.has_basis.uniform_equicontinuous_iff_right Filter.HasBasis.uniformEquicontinuous_iff_right

-- Porting note: changed from `∃ k (_ : p k), _` to `∃ k, p k ∧ _` since Lean 4 generates the
-- second one when parsing expressions like `∃ δ > 0, _`.
theorem Filter.HasBasis.uniformEquicontinuous_iff {κ₁ κ₂ : Type _} {p₁ : κ₁ → Prop}
    {s₁ : κ₁ → Set (β × β)} {p₂ : κ₂ → Prop} {s₂ : κ₂ → Set (α × α)} {F : ι → β → α}
    (hβ : (𝓤 β).HasBasis p₁ s₁) (hα : (𝓤 α).HasBasis p₂ s₂) :
    UniformEquicontinuous F ↔
      ∀ k₂, p₂ k₂ → ∃ k₁, p₁ k₁ ∧ ∀ x y, (x, y) ∈ s₁ k₁ → ∀ i, (F i x, F i y) ∈ s₂ k₂ := by
  rw [uniformEquicontinuous_iff_uniformContinuous, UniformContinuous,
    hβ.tendsto_iff (UniformFun.hasBasis_uniformity_of_basis ι α hα)]
  simp only [Prod.forall, Function.comp_apply, mem_setOf_eq, exists_prop]
  rfl
#align filter.has_basis.uniform_equicontinuous_iff Filter.HasBasis.uniformEquicontinuous_iff

/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous at a point
`x₀ : X` iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is
equicontinuous at `x₀`. -/
theorem UniformInducing.equicontinuousAt_iff {F : ι → X → α} {x₀ : X} {u : α → β}
    (hu : UniformInducing u) : EquicontinuousAt F x₀ ↔ EquicontinuousAt ((· ∘ ·) u ∘ F) x₀ := by
  have := (UniformFun.postcomp_uniformInducing (α := ι) hu).inducing
  rw [equicontinuousAt_iff_continuousAt, equicontinuousAt_iff_continuousAt, this.continuousAt_iff]
  rfl
#align uniform_inducing.equicontinuous_at_iff UniformInducing.equicontinuousAt_iff

/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous iff the
family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is equicontinuous. -/
theorem UniformInducing.equicontinuous_iff {F : ι → X → α} {u : α → β} (hu : UniformInducing u) :
    Equicontinuous F ↔ Equicontinuous ((· ∘ ·) u ∘ F) := by
  have : ∀ x, EquicontinuousAt F x ↔ EquicontinuousAt ((fun x x_1 => x ∘ x_1) u ∘ F) x := by
    intro
    rw [hu.equicontinuousAt_iff]
  exact ⟨fun h x => (this x).mp (h x), fun h x => (this x).mpr (h x)⟩
  -- Porting note: proof was:
  -- congrm (∀ x, _ : Prop)
  -- rw [hu.equicontinuousAt_iff]
#align uniform_inducing.equicontinuous_iff UniformInducing.equicontinuous_iff

/-- Given `u : α → γ` a uniform inducing map, a family `𝓕 : ι → β → α` is uniformly equicontinuous
iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is uniformly
equicontinuous. -/
theorem UniformInducing.uniformEquicontinuous_iff {F : ι → β → α} {u : α → γ}
    (hu : UniformInducing u) : UniformEquicontinuous F ↔ UniformEquicontinuous ((· ∘ ·) u ∘ F) := by
  have := UniformFun.postcomp_uniformInducing (α := ι) hu
  rw [uniformEquicontinuous_iff_uniformContinuous, uniformEquicontinuous_iff_uniformContinuous,
    this.uniformContinuous_iff]
  rfl
#align uniform_inducing.uniform_equicontinuous_iff UniformInducing.uniformEquicontinuous_iff

/-- A version of `EquicontinuousAt.closure` applicable to subsets of types which embed continuously
into `X → α` with the product topology. It turns out we don't need any other condition on the
embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
the coercion is injective. -/
theorem EquicontinuousAt.closure' {A : Set Y} {u : Y → X → α} {x₀ : X}
    (hA : EquicontinuousAt (u ∘ (↑) : A → X → α) x₀) (hu : Continuous u) :
    EquicontinuousAt (u ∘ (↑) : closure A → X → α) x₀ := by
  intro U hU
  rcases mem_uniformity_isClosed hU with ⟨V, hV, hVclosed, hVU⟩
  filter_upwards [hA V hV]with x hx
  rw [SetCoe.forall] at *
  have hx : A ⊆ (fun f => (u f x₀, u f x)) ⁻¹' V := hx
  -- Porting note: was
  -- change A ⊆ (fun f => (u f x₀, u f x)) ⁻¹' V at hx
  refine' (closure_minimal hx <| hVclosed.preimage <| _).trans (preimage_mono hVU)
  exact Continuous.prod_mk ((continuous_apply x₀).comp hu) ((continuous_apply x).comp hu)
#align equicontinuous_at.closure' EquicontinuousAt.closure'

/-- If a set of functions is equicontinuous at some `x₀`, its closure for the product topology is
also equicontinuous at `x₀`. -/
theorem EquicontinuousAt.closure {A : Set <| X → α} {x₀ : X} (hA : A.EquicontinuousAt x₀) :
    (closure A).EquicontinuousAt x₀ :=
  EquicontinuousAt.closure' (u := id) hA continuous_id
#align equicontinuous_at.closure EquicontinuousAt.closure

/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
family `𝓕` is equicontinuous at some `x₀ : X`, then the limit is continuous at `x₀`. -/
theorem Filter.Tendsto.continuousAt_of_equicontinuousAt {l : Filter ι} [l.NeBot] {F : ι → X → α}
    {f : X → α} {x₀ : X} (h₁ : Tendsto F l (𝓝 f)) (h₂ : EquicontinuousAt F x₀) :
    ContinuousAt f x₀ :=
  (equicontinuousAt_iff_range.mp h₂).closure.continuousAt
    ⟨f, mem_closure_of_tendsto h₁ <| eventually_of_forall mem_range_self⟩
#align filter.tendsto.continuous_at_of_equicontinuous_at Filter.Tendsto.continuousAt_of_equicontinuousAt

/-- A version of `Equicontinuous.closure` applicable to subsets of types which embed continuously
into `X → α` with the product topology. It turns out we don't need any other condition on the
embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
the coercion is injective. -/
theorem Equicontinuous.closure' {A : Set Y} {u : Y → X → α}
    (hA : Equicontinuous (u ∘ (↑) : A → X → α)) (hu : Continuous u) :
    Equicontinuous (u ∘ (↑) : closure A → X → α) := fun x => (hA x).closure' hu
#align equicontinuous.closure' Equicontinuous.closure'

/-- If a set of functions is equicontinuous, its closure for the product topology is also
equicontinuous. -/
theorem Equicontinuous.closure {A : Set <| X → α} (hA : A.Equicontinuous) :
    (closure A).Equicontinuous := fun x => (hA x).closure
#align equicontinuous.closure Equicontinuous.closure

/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
family `𝓕` is equicontinuous, then the limit is continuous. -/
theorem Filter.Tendsto.continuous_of_equicontinuous_at {l : Filter ι} [l.NeBot] {F : ι → X → α}
    {f : X → α} (h₁ : Tendsto F l (𝓝 f)) (h₂ : Equicontinuous F) : Continuous f :=
  continuous_iff_continuousAt.mpr fun x => h₁.continuousAt_of_equicontinuousAt (h₂ x)
#align filter.tendsto.continuous_of_equicontinuous_at Filter.Tendsto.continuous_of_equicontinuous_at

/-- A version of `UniformEquicontinuous.closure` applicable to subsets of types which embed
continuously into `β → α` with the product topology. It turns out we don't need any other condition
on the embedding than continuity, but in practice this will mostly be applied to `fun_like` types
where the coercion is injective. -/
theorem UniformEquicontinuous.closure' {A : Set Y} {u : Y → β → α}
    (hA : UniformEquicontinuous (u ∘ (↑) : A → β → α)) (hu : Continuous u) :
    UniformEquicontinuous (u ∘ (↑) : closure A → β → α) := by
  intro U hU
  rcases mem_uniformity_isClosed hU with ⟨V, hV, hVclosed, hVU⟩
  filter_upwards [hA V hV]
  rintro ⟨x, y⟩ hxy
  rw [SetCoe.forall] at *
  have hxy : A ⊆ (fun f => (u f x, u f y)) ⁻¹' V := hxy
  -- Porting note: was
  -- change A ⊆ (fun f => (u f x, u f y)) ⁻¹' V at hxy
  refine' (closure_minimal hxy <| hVclosed.preimage <| _).trans (preimage_mono hVU)
  exact Continuous.prod_mk ((continuous_apply x).comp hu) ((continuous_apply y).comp hu)
#align uniform_equicontinuous.closure' UniformEquicontinuous.closure'

/-- If a set of functions is uniformly equicontinuous, its closure for the product topology is also
uniformly equicontinuous. -/
theorem UniformEquicontinuous.closure {A : Set <| β → α} (hA : A.UniformEquicontinuous) :
    (closure A).UniformEquicontinuous :=
  UniformEquicontinuous.closure' (u := id) hA continuous_id
#align uniform_equicontinuous.closure UniformEquicontinuous.closure

/-- If `𝓕 : ι → β → α` tends to `f : β → α` *pointwise* along some nontrivial filter, and if the
family `𝓕` is uniformly equicontinuous, then the limit is uniformly continuous. -/
theorem Filter.Tendsto.uniformContinuous_of_uniformEquicontinuous {l : Filter ι} [l.NeBot]
    {F : ι → β → α} {f : β → α} (h₁ : Tendsto F l (𝓝 f)) (h₂ : UniformEquicontinuous F) :
    UniformContinuous f :=
  (uniformEquicontinuous_at_iff_range.mp h₂).closure.uniformContinuous
    ⟨f, mem_closure_of_tendsto h₁ <| eventually_of_forall mem_range_self⟩
#align filter.tendsto.uniform_continuous_of_uniform_equicontinuous Filter.Tendsto.uniformContinuous_of_uniformEquicontinuous

end

end


import tactic -- hide

/-Lemma
If $P,Q$ are logical statements, then $P$ implies $(Q \implies P)$
-/
lemma lemma_2 (P Q : Prop) : P → Q → P :=
begin
  intro hP,
  intro hQ,
  exact hP,

end

/-Hint : Caution

Note that implies `→` is not associative: in general `P → (Q → R)` and `(P → Q) → R`
might not be equivalent. This is like subtraction on numbers -- in general
`a - (b - c)` and `(a - b) - c` might not be equal.
So if we write `P → Q → R` then we'd better know what this means.
The convention in Lean is that it means `P → (Q → R)`. If you think
about it, this means that to deduce `R` you will need to prove both `P`
and `Q`.
-/


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Advanced proposition world.

## Level 3: and_trans.

With this proof we can use the first `cases` tactic to extract hypotheses `p : P` `q : Q` from
`hpq : P ∧ Q` and then we can use another `cases` tactic to extract hypotheses `q' : Q` and `r : R` from
`hpr : Q ∧ R` then we can split the resulting goal `⊢ P ∧ R` using `constructor` and easily pick off the
resulting sub-goals `⊢ P` and `⊢ R` using our given hypotheses.

## Lemma
If `P`, `Q` and `R` are true/false statements, then `P ∧ Q` and
`Q ∧ R` together imply `P ∧ R`.
-/
lemma and_trans (P Q R : Prop) : P ∧ Q → Q ∧ R → P ∧ R := by
  intro hpq
  intro hqr
  cases hpq with
  | intro p q =>
    cases hqr with
    | intro q' r =>
      constructor
      assumption
      assumption

/-!

Next up [Level 4](./Level4.lean.md)
-/


import analysis.special_functions.integrals
import analysis.special_functions.non_integrable
import data.real.basic
import data.nat.basic
import data.int.basic
import data.set.basic
import data.set.intervals.basic
import measure_theory.integral.interval_integral

open real measure_theory

lemma log_eq_integral_inv {x : ℝ} : 1 ≤ x → log x = ∫ (t : ℝ) in 1..x, t⁻¹ :=
begin
  intro hx,
  rw integral_inv_of_pos zero_lt_one (lt_of_lt_of_le zero_lt_one hx),
  simp,
end

noncomputable def harmonic (n : ℕ) : nnreal := (finset.Icc 1 n).sum (λ k, (↑k)⁻¹)

noncomputable def staircase (x : ℝ) : ℝ := (↑⌊x⌋)⁻¹

-- Show that staircase is antitone on [1, ∞).
-- This will be used to show that it is integrable.

lemma antitone_on_staircase : antitone_on staircase (set.Ici 1) :=
begin
  rw antitone_on_iff_forall_lt,
  simp,
  intro a, intro ha,
  intro b, intro hb,
  intro hab,
  rw staircase, rw staircase,
  rw inv_le_inv,
  { simp,
    rw int.le_floor,
    have h := int.floor_le a,
    exact le_trans h (le_of_lt hab) },
  { have h := int.lt_floor_add_one b,
    rw ← add_lt_add_iff_right (1 : ℝ), rw zero_add,
    exact lt_of_le_of_lt hb h },
  { have h := int.lt_floor_add_one a,
    rw ← add_lt_add_iff_right (1 : ℝ), rw zero_add,
    exact lt_of_le_of_lt ha h },
end

-- To be used with antitone_on.interval_integrable.
lemma antitone_on_staircase_uIcc {a b : ℝ} (ha : 1 ≤ a) (hb : 1 ≤ b) :
  antitone_on staircase (set.uIcc a b) :=
begin
  apply antitone_on.mono antitone_on_staircase,
  cases le_or_lt a b with hab hba,
  { rw set.uIcc_of_le hab,
    rw set.Icc_subset_Ici_iff hab,
    exact ha },
  { have hba := le_of_lt hba,
    rw set.uIcc_comm,
    rw set.uIcc_of_le hba,
    rw set.Icc_subset_Ici_iff hba,
    exact hb },
end

-- Trivial but used in two places.
lemma interval_integrable_staircase {a b : ℝ} (ha : 1 ≤ a) (hb : 1 ≤ b)
  : interval_integrable staircase volume a b :=
begin
  apply antitone_on.interval_integrable,
  apply antitone_on_staircase_uIcc ha hb,
end

-- After proving staircase is integrable, prove value of integral.

noncomputable def const_fun (n : ℕ) : ℝ → ℝ := λ _, (n : ℝ)⁻¹

lemma piece_integral_staircase_eq {n : ℕ} :
  ∫ (t : ℝ) in ↑n..↑n + 1, staircase t = (n : ℝ)⁻¹ :=
begin
  -- rw interval_integral.integral_of_le (by simp : (n : ℝ) ≤ (n : ℝ) + 1),
  rw interval_integral.integral_congr_ae
    (_ : ∀ᵐ (x : ℝ) ∂_, x ∈ _ → staircase x = const_fun n x),
  { rw const_fun, simp, },
  { -- Need to prove staircase is ae-equal to const_fun in the interval.
    rw ae_iff,
    -- Use volume set ≤ volume {b} = 0.
    rw ← le_zero_iff,
    apply le_of_le_of_eq (measure_mono (_ : _ ⊆ ({↑n + 1} : set ℝ))),
    { exact volume_singleton, },
    { simp,
      intros x hax hxb hnp,
      rw le_iff_lt_or_eq at hxb,
      cases hxb,
      { exfalso,
        apply hnp,
        rw [staircase, const_fun], simp,
        rw [← int.cast_coe_nat, int.cast_inj],
        rw int.floor_eq_iff, simp,
        apply and.intro _ hxb,
        exact le_of_lt hax, },
      { exact hxb, }, }, },
end

-- Specialized for natural numbers.
-- (Could use finset.range instead and shift indices?)
lemma finset_Ico_succ {a b : ℕ} : finset.Ico a b.succ = finset.Icc a b :=
begin
  ext x,
  rw finset.mem_Icc,
  rw finset.mem_Ico,
  rw nat.lt_succ_iff,
end

-- Use this function to partition the integral into pieces.
def step (k : ℕ) := (k : ℝ)

lemma integral_staircase_eq_harmonic {n : ℕ} :
  ∫ (t : ℝ) in 1..(↑n + 1), staircase t = harmonic n :=
begin
  simp,
  have ha : step 1 = 1 := by { rw step, simp },
  have hb : step (n + 1) = (↑n + 1) := by { rw step, simp },
  rw ← hb,
  rw ← ha,  -- Replaces (1 : ℝ) not (1 : ℕ).
  have hmn : 1 ≤ n + 1 := by simp,
  rw ← interval_integral.sum_integral_adjacent_intervals_Ico hmn,
  { -- Prove sums are equal.
    simp_rw step,
    push_cast,
    simp_rw piece_integral_staircase_eq,
    rw harmonic,
    push_cast,
    rw finset_Ico_succ, },
  { -- Prove each interval is integrable.
    simp_rw step,
    push_cast,
    intros k hk,
    have hp : (1 : ℝ) ≤ 1 := by simp,
    have hq : (1 : ℝ) ≤ ↑k + 1 := by simp,
    -- TODO: Use mono?
    apply interval_integrable.mono_set (interval_integrable_staircase hp hq),
    apply set.uIcc_subset_uIcc_right,
    simp, exact hk.left, },
end

-- Prove that integral of x⁻¹ is less than integral of staircase.

lemma inv_le_staircase {x : ℝ} : 1 ≤ x → x⁻¹ ≤ staircase x :=
begin
  rw staircase,
  intro hx,
  rw inv_le_inv,
  { apply int.floor_le },
  { apply lt_of_lt_of_le zero_lt_one hx },
  { rw ← add_lt_add_iff_right (1 : ℝ),
    rw zero_add,
    apply lt_of_le_of_lt hx,
    apply int.lt_floor_add_one },
end

lemma integral_inv_le_integral_staircase {x : ℝ} :
  1 ≤ x → ∫ (t : ℝ) in 1..x, t⁻¹ ≤ ∫ (t : ℝ) in 1..x, staircase t :=
begin
  intro hx,
  rw ← sub_nonneg,
  rw ← interval_integral.integral_sub,
  { apply interval_integral.integral_nonneg hx,
    intro u, intro hu,
    simp,
    apply inv_le_staircase hu.left },
  { apply interval_integrable_staircase _ hx, simp },
  { rw interval_integrable_inv_iff,
    apply or.inr,
    rw set.uIcc_of_le hx, simp,
    intro h, exfalso,
    exact not_le_of_lt zero_lt_one h }
end

-- Could instead prove ∀ x : ℝ, log x ≤ harmonic ⌊x⌋₊
-- However, the proof only requires a proof for integer values.
lemma log_add_one_le_harmonic {n : ℕ} : log (↑n + 1) ≤ harmonic n :=
begin
  have hn : (1 : ℝ) ≤ (↑n + 1) := by simp,
  rw log_eq_integral_inv hn,
  apply le_trans (integral_inv_le_integral_staircase hn),
  rw integral_staircase_eq_harmonic,
end


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Algdata.Init.Nat
import Algdata.Data.Nat.Rec

/-!
# Power functions
-/

namespace Nat

universe u
variable {α : Type u} [OfNat α (nat_lit 1)] [HMul α α α]

/-!
## Naive generic power function
-/
--- naive power
def gpow (a : α) (n : @& Nat) : α :=
  match n with
  | 0 => 1
  | (k+1) => a * gpow a k

section ExponentLaw

@[simp]
theorem gpow_zero (a : α) : gpow a 0 = 1 := rfl

@[simp]
theorem gpow_one (mul_one : ∀ (a : α), a * 1 = a) (a : α) : gpow a 1 = a := mul_one a

variable (one_mul : ∀ (a : α), 1 * a = a) (assoc : ∀ (a b c : α), (a * b) * c = a * (b * c))

--- Exponent law 1: aᵐ⁺ⁿ = aᵐaⁿ
def gpow_add (a : α) (m n : Nat) : gpow a (m+n) = gpow a m * gpow a n := by
  induction m
  case zero =>
    rw [Nat.zero_add]
    have : gpow a Nat.zero = 1 := rfl; rw [this]; clear this
    rw [one_mul]
  case succ m h_ind =>
    rw [Nat.succ_add]; dsimp [gpow]
    rw [h_ind, assoc]

--- Exponent law 2: aᵐⁿ = (aᵐ)ⁿ
def gpow_mul (a : α) (m n : Nat) : gpow a (m*n) = gpow (gpow a m) n := by
  induction n
  case zero =>
    rw [Nat.mul_zero]
    rfl
  case succ n h_ind =>
    conv => lhs; rw [Nat.mul_succ, Nat.add_comm _ m, gpow_add one_mul assoc]
    conv => rhs; dsimp [gpow]
    rw [h_ind]

end ExponentLaw

/-!
## Power using exponentiation by squaring
-/

--- exponentiation by squaring
@[specialize,inline]
def sqPow (a : α) (n : @& Nat) : α :=
  n.recBase2 (motive:=λ _ => α) 1 a $ λ n x => if n % 2 = 1 then a * x * x else x * x

/-!
## Comparison of powers
-/

theorem sqPow_eq_gpow {α : Type _} [OfNat α (nat_lit 1)] [HMul α α α] (mul_one : ∀ (a : α), a * 1 = a) (one_mul : ∀ (a : α), 1 * a = a) (assoc : ∀ (a b c : α), (a*b)*c = a*(b*c)) : ∀ (a : α) (n : Nat), sqPow a n = gpow a n := by
  intro a n
  unfold sqPow
  induction n using recBase2 generalizing a
  case zero => rfl
  case one =>
    rw [recBase2_one]
    exact (mul_one a).symm
  case div2 n h_ind =>
    rw [recBase2_div2]
    rw [h_ind a]
    by_cases n % 2 = 1
    case pos hodd =>
      rw [if_pos hodd]
      conv =>
        lhs; change gpow a (n/2 + 2) * gpow a (n/2 + 1)
        rw [←gpow_add one_mul assoc]
      apply congrArg
      conv =>
        lhs; rw [Nat.add_assoc, ←Nat.add_assoc 2 (n/2) 1, Nat.add_comm 2, Nat.add_assoc _ 2 1, ←Nat.add_assoc]
        rw [←Nat.mul_two, Nat.mul_comm, Nat.add_comm 2 1, ←Nat.add_assoc, ←hodd]
        rw [Nat.div_add_mod]
    case neg heven =>
      rw [if_neg heven]
      rw [←gpow_add one_mul assoc]
      have : n % 2 = 0 := Or.resolve_right (Nat.mod_two_eq_zero_or_one n) heven
      apply congrArg
      conv =>
        lhs; rw [Nat.add_assoc, ←Nat.add_assoc 1, Nat.add_comm 1, Nat.add_assoc _ 1 1, ←Nat.add_assoc]
        rw [←Nat.mul_two, Nat.mul_comm, ←Nat.add_zero (2*(n/2)), ←this]
        rw [Nat.div_add_mod]

end Nat