/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import algebra.group.pi
import algebra.group_power.lemmas

/-!
# The group of permutations (self-equivalences) of a type `α`

This file defines the `group` structure on `equiv.perm α`.
-/
universes u v

namespace equiv

variables {α : Type u} {β : Type v}

namespace perm

instance perm_group : group (perm α) :=
{ mul := λ f g, equiv.trans g f,
  one := equiv.refl α,
  inv := equiv.symm,
  mul_assoc := λ f g h, (trans_assoc _ _ _).symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := self_trans_symm }

theorem mul_apply (f g : perm α) (x) : (f * g) x = f (g x) :=
equiv.trans_apply _ _ _

theorem one_apply (x) : (1 : perm α) x = x := rfl

@[simp] lemma inv_apply_self (f : perm α) (x) : f⁻¹ (f x) = x := f.symm_apply_apply x

@[simp] lemma apply_inv_self (f : perm α) (x) : f (f⁻¹ x) = x := f.apply_symm_apply x

lemma one_def : (1 : perm α) = equiv.refl α := rfl

lemma mul_def (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl

@[simp] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl

@[simp] lemma coe_one : ⇑(1 : perm α) = id := rfl

lemma eq_inv_iff_eq {f : perm α} {x y : α} : x = f⁻¹ y ↔ f x = y := f.eq_symm_apply

lemma inv_eq_iff_eq {f : perm α} {x y : α} : f⁻¹ x = y ↔ x = f y := f.symm_apply_eq

lemma zpow_apply_comm {α : Type*} (σ : equiv.perm α) (m n : ℤ) {x : α} :
  (σ ^ m) ((σ ^ n) x) = (σ ^ n) ((σ ^ m) x) :=
by rw [←equiv.perm.mul_apply, ←equiv.perm.mul_apply, zpow_mul_comm]

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] lemma trans_one {α : Sort*} {β : Type*} (e : α ≃ β) : e.trans (1 : perm β) = e :=
equiv.trans_refl e

@[simp] lemma mul_refl (e : perm α) : e * equiv.refl α = e := equiv.trans_refl e

@[simp] lemma one_symm : (1 : perm α).symm = 1 := equiv.refl_symm

@[simp] lemma refl_inv : (equiv.refl α : perm α)⁻¹ = 1 := equiv.refl_symm

@[simp] lemma one_trans {α : Type*} {β : Sort*} (e : α ≃ β) : (1 : perm α).trans e = e :=
equiv.refl_trans e

@[simp] lemma refl_mul (e : perm α) : equiv.refl α * e = e := equiv.refl_trans e

@[simp] lemma inv_trans_self (e : perm α) : e⁻¹.trans e = 1 := equiv.symm_trans_self e

@[simp] lemma mul_symm (e : perm α) : e * e.symm = 1 := equiv.symm_trans_self e

@[simp] lemma self_trans_inv (e : perm α) : e.trans e⁻¹ = 1 := equiv.self_trans_symm e

@[simp] lemma symm_mul (e : perm α) : e.symm * e = 1 := equiv.self_trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] lemma sum_congr_mul {α β : Type*} (e : perm α) (f : perm β) (g : perm α) (h : perm β) :
  sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
sum_congr_trans g h e f

@[simp] lemma sum_congr_inv {α β : Type*} (e : perm α) (f : perm β) :
  (sum_congr e f)⁻¹ = sum_congr e⁻¹ f⁻¹ :=
sum_congr_symm e f

@[simp] lemma sum_congr_one {α β : Type*} :
  sum_congr (1 : perm α) (1 : perm β) = 1 :=
sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
@[simps]
def sum_congr_hom (α β : Type*) :
  perm α × perm β →* perm (α ⊕ β) :=
{ to_fun := λ a, sum_congr a.1 a.2,
  map_one' := sum_congr_one,
  map_mul' := λ a b, (sum_congr_mul _ _ _ _).symm}

lemma sum_congr_hom_injective {α β : Type*} :
  function.injective (sum_congr_hom α β) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split; ext i,
  { simpa using equiv.congr_fun h (sum.inl i), },
  { simpa using equiv.congr_fun h (sum.inr i), },
end

@[simp] lemma sum_congr_swap_one {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : α) :
  sum_congr (equiv.swap i j) (1 : perm β) = equiv.swap (sum.inl i) (sum.inl j) :=
sum_congr_swap_refl i j

@[simp] lemma sum_congr_one_swap {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : β) :
  sum_congr (1 : perm α) (equiv.swap i j) = equiv.swap (sum.inr i) (sum.inr j) :=
sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] lemma sigma_congr_right_mul {α : Type*} {β : α → Type*}
  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
  sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
sigma_congr_right_trans G F

@[simp] lemma sigma_congr_right_inv {α : Type*} {β : α → Type*} (F : Π a, perm (β a)) :
  (sigma_congr_right F)⁻¹ = sigma_congr_right (λ a, (F a)⁻¹) :=
sigma_congr_right_symm F

@[simp] lemma sigma_congr_right_one {α : Type*} {β : α → Type*} :
  (sigma_congr_right (1 : Π a, equiv.perm $ β a)) = 1 :=
sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
@[simps]
def sigma_congr_right_hom {α : Type*} (β : α → Type*) :
  (Π a, perm (β a)) →* perm (Σ a, β a) :=
{ to_fun := sigma_congr_right,
  map_one' := sigma_congr_right_one,
  map_mul' := λ a b, (sigma_congr_right_mul _ _).symm }

lemma sigma_congr_right_hom_injective {α : Type*} {β : α → Type*} :
  function.injective (sigma_congr_right_hom β) :=
begin
  intros x y h,
  ext a b,
  simpa using equiv.congr_fun h ⟨a, b⟩,
end

/-- `equiv.perm.subtype_congr` as a `monoid_hom`. -/
@[simps] def subtype_congr_hom (p : α → Prop) [decidable_pred p] :
  (perm {a // p a}) × (perm {a // ¬ p a}) →* perm α :=
{ to_fun := λ pair, perm.subtype_congr pair.fst pair.snd,
  map_one' := perm.subtype_congr.refl,
  map_mul' := λ _ _, (perm.subtype_congr.trans _ _ _ _).symm }

lemma subtype_congr_hom_injective (p : α → Prop) [decidable_pred p] :
  function.injective (subtype_congr_hom p) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split;
  ext i;
  simpa using equiv.congr_fun h i
end

/-- If `e` is also a permutation, we can write `perm_congr`
completely in terms of the group structure. -/
@[simp] lemma perm_congr_eq_mul (e p : perm α) :
  e.perm_congr p = e * p * e⁻¹ := rfl

section extend_domain

/-! Lemmas about `equiv.perm.extend_domain` re-expressed via the group structure. -/

variables (e : perm α) {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p)

@[simp] lemma extend_domain_one : extend_domain 1 f = 1 :=
extend_domain_refl f

@[simp] lemma extend_domain_inv : (e.extend_domain f)⁻¹ = e⁻¹.extend_domain f := rfl

@[simp] lemma extend_domain_mul (e e' : perm α) :
  (e.extend_domain f) * (e'.extend_domain f) = (e * e').extend_domain f :=
extend_domain_trans _ _ _

/-- `extend_domain` as a group homomorphism -/
@[simps] def extend_domain_hom : perm α →* perm β :=
{ to_fun := λ e, extend_domain e f,
  map_one' := extend_domain_one f,
  map_mul' := λ e e', (extend_domain_mul f e e').symm }

lemma extend_domain_hom_injective : function.injective (extend_domain_hom f) :=
((extend_domain_hom f).injective_iff).mpr (λ e he, ext (λ x, f.injective (subtype.ext
  ((extend_domain_apply_image e f x).symm.trans (ext_iff.mp he (f x))))))

@[simp]

end extend_domain

/-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
  on `{x // p x}` induced by `f`. -/
def subtype_perm (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
⟨λ x, ⟨f x, (h _).1 x.2⟩, λ x, ⟨f⁻¹ x, (h (f⁻¹ x)).2 $ by simpa using x.2⟩,
  λ _, by simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk],
  λ _, by simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk]⟩

@[simp] lemma subtype_perm_apply (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x))
  (x : {x // p x}) : subtype_perm f h x = ⟨f x, (h _).1 x.2⟩ := rfl

@[simp] lemma subtype_perm_one (p : α → Prop) (h : ∀ x, p x ↔ p ((1 : perm α) x)) :
  @subtype_perm α 1 p h = 1 :=
equiv.ext $ λ ⟨_, _⟩, rfl

/-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
  fixing the other points. -/
def of_subtype {p : α → Prop} [decidable_pred p] : perm (subtype p) →* perm α :=
{ to_fun := λ f,
  ⟨λ x, if h : p x then f ⟨x, h⟩ else x, λ x, if h : p x then f⁻¹ ⟨x, h⟩ else x,
  λ x, have h : ∀ h : p x, p (f ⟨x, h⟩), from λ h, (f ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * },
  λ x, have h : ∀ h : p x, p (f⁻¹ ⟨x, h⟩), from λ h, (f⁻¹ ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * }⟩,
  map_one' := begin ext, dsimp, split_ifs; refl, end,
  map_mul' := λ f g, equiv.ext $ λ x, begin
  by_cases h : p x,
  { have h₁ : p (f (g ⟨x, h⟩)), from (f (g ⟨x, h⟩)).2,
    have h₂ : p (g ⟨x, h⟩), from (g ⟨x, h⟩).2,
    simp only [h, h₂, coe_fn_mk, perm.mul_apply, dif_pos, subtype.coe_eta] },
  { simp only [h, coe_fn_mk, perm.mul_apply, dif_neg, not_false_iff] }
end }

lemma of_subtype_subtype_perm {f : perm α} {p : α → Prop} [decidable_pred p]
  (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
  of_subtype (subtype_perm f h₁) = f :=
equiv.ext $ λ x, begin
  rw [of_subtype, subtype_perm],
  by_cases hx : p x,
  { simp only [hx, coe_fn_mk, dif_pos, monoid_hom.coe_mk, subtype.coe_mk]},
  { haveI := classical.prop_decidable,
    simp only [hx, not_not.mp (mt (h₂ x) hx), coe_fn_mk, dif_neg, not_false_iff,
      monoid_hom.coe_mk] }
end

lemma of_subtype_apply_of_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) {x : α} (hx : p x) :
  of_subtype f x = f ⟨x, hx⟩ :=
dif_pos hx

@[simp] lemma of_subtype_apply_coe {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) (x : subtype p)  :
  of_subtype f x = f x :=
subtype.cases_on x $ λ _, of_subtype_apply_of_mem f

lemma of_subtype_apply_of_not_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) {x : α} (hx : ¬ p x) :
  of_subtype f x = x :=
dif_neg hx

lemma mem_iff_of_subtype_apply_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) (x : α) :
  p x ↔ p ((of_subtype f : α → α) x) :=
if h : p x then by simpa only [of_subtype, h, coe_fn_mk, dif_pos, true_iff, monoid_hom.coe_mk]
  using (f ⟨x, h⟩).2
else by simp [h, of_subtype_apply_of_not_mem f h]

@[simp] lemma subtype_perm_of_subtype {p : α → Prop} [decidable_pred p] (f : perm (subtype p)) :
  subtype_perm (of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
equiv.ext $ λ ⟨x, hx⟩, by { dsimp [subtype_perm, of_subtype],
  simp only [show p x, from hx, dif_pos, subtype.coe_eta] }

@[simp] lemma default_perm {n : Type*} : default (equiv.perm n) = 1 := rfl

/-- Permutations on a subtype are equivalent to permutations on the original type that fix pointwise
the rest. -/
@[simps] protected def subtype_equiv_subtype_perm (p : α → Prop) [decidable_pred p] :
  perm (subtype p) ≃ {f : perm α // ∀ a, ¬p a → f a = a} :=
{ to_fun := λ f, ⟨f.of_subtype, λ a, f.of_subtype_apply_of_not_mem⟩,
  inv_fun := λ f, (f : perm α).subtype_perm
    (λ a, ⟨decidable.not_imp_not.1 $ λ hfa, (f.val.injective (f.prop _ hfa) ▸ hfa),
    decidable.not_imp_not.1 $ λ ha hfa, ha $ f.prop a ha ▸ hfa⟩),
  left_inv := equiv.perm.subtype_perm_of_subtype,
  right_inv := λ f,
    subtype.ext (equiv.perm.of_subtype_subtype_perm _ $ λ a, not.decidable_imp_symm $ f.prop a) }

lemma subtype_equiv_subtype_perm_apply_of_mem {α : Type*} {p : α → Prop}
  [decidable_pred p] (f : perm (subtype p)) {a : α} (h : p a) :
  perm.subtype_equiv_subtype_perm p f a = f ⟨a, h⟩ :=
f.of_subtype_apply_of_mem h

lemma subtype_equiv_subtype_perm_apply_of_not_mem {α : Type*} {p : α → Prop}
  [decidable_pred p] (f : perm (subtype p)) {a : α} (h : ¬ p a) :
  perm.subtype_equiv_subtype_perm p f a = a :=
f.of_subtype_apply_of_not_mem h

variables (e : perm α) (ι : α ↪ β)

open_locale classical

/-- Noncomputable version of `equiv.perm.via_fintype_embedding` that does not assume `fintype` -/
noncomputable def via_embedding : perm β :=
extend_domain e (of_injective ι.1 ι.2)

lemma via_embedding_apply (x : α) : e.via_embedding ι (ι x) = ι (e x) :=
extend_domain_apply_image e (of_injective ι.1 ι.2) x

lemma via_embedding_apply_of_not_mem (x : β) (hx : x ∉ _root_.set.range ι) :
  e.via_embedding ι x = x :=
extend_domain_apply_not_subtype e (of_injective ι.1 ι.2) hx

/-- `via_embedding` as a group homomorphism -/
noncomputable def via_embedding_hom : perm α →* perm β:=
extend_domain_hom (of_injective ι.1 ι.2)

lemma via_embedding_hom_apply : via_embedding_hom ι e = via_embedding e ι := rfl

lemma via_embedding_hom_injective : function.injective (via_embedding_hom ι) :=
extend_domain_hom_injective (of_injective ι.1 ι.2)

end perm

section swap
variables [decidable_eq α]

@[simp] lemma swap_inv (x y : α) : (swap x y)⁻¹ = swap x y := rfl

@[simp] lemma swap_mul_self (i j : α) : swap i j * swap i j = 1 := swap_swap i j

lemma swap_mul_eq_mul_swap (f : perm α) (x y : α) : swap x y * f = f * swap (f⁻¹ x) (f⁻¹ y) :=
equiv.ext $ λ z, begin
  simp only [perm.mul_apply, swap_apply_def],
  split_ifs;
  simp only [perm.apply_inv_self, *, perm.eq_inv_iff_eq, eq_self_iff_true, not_true] at *
end

lemma mul_swap_eq_swap_mul (f : perm α) (x y : α) : f * swap x y = swap (f x) (f y) * f :=
by rw [swap_mul_eq_mul_swap, perm.inv_apply_self, perm.inv_apply_self]

lemma swap_apply_apply (f : perm α) (x y : α) : swap (f x) (f y) = f * swap x y * f⁻¹ :=
by rw [mul_swap_eq_swap_mul, mul_inv_cancel_right]

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma swap_mul_self_mul (i j : α) (σ : perm α) : equiv.swap i j * (equiv.swap i j * σ) = σ :=
by rw [←mul_assoc, swap_mul_self, one_mul]

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma mul_swap_mul_self (i j : α) (σ : perm α) : (σ * equiv.swap i j) * equiv.swap i j = σ :=
by rw [mul_assoc, swap_mul_self, mul_one]

/-- A stronger version of `mul_right_injective` -/
@[simp]
lemma swap_mul_involutive (i j : α) : function.involutive ((*) (equiv.swap i j)) :=
swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp]
lemma mul_swap_involutive (i j : α) : function.involutive (* (equiv.swap i j)) :=
mul_swap_mul_self i j

@[simp] lemma swap_eq_one_iff {i j : α} : swap i j = (1 : perm α) ↔ i = j :=
swap_eq_refl_iff

lemma swap_mul_eq_iff {i j : α} {σ : perm α} : swap i j * σ = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_right_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, one_mul])⟩

lemma mul_swap_eq_iff {i j : α} {σ : perm α} : σ * swap i j = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_left_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, mul_one])⟩

lemma swap_mul_swap_mul_swap {x y z : α} (hwz: x ≠ y) (hxz : x ≠ z) :
  swap y z * swap x y * swap y z = swap z x :=
equiv.ext $ λ n, by { simp only [swap_apply_def, perm.mul_apply], split_ifs; cc }

end swap

end equiv


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

! This file was ported from Lean 3 source module data.list.intervals
! leanprover-community/mathlib commit b71077179fac7179e3a342ff319392ad8dcb773c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Lattice
import Mathbin.Data.List.Range

/-!
# Intervals in ℕ

This file defines intervals of naturals. `list.Ico m n` is the list of integers greater than `m`
and strictly less than `n`.

## TODO
- Define `Ioo` and `Icc`, state basic lemmas about them.
- Also do the versions for integers?
- One could generalise even further, defining 'locally finite partial orders', for which
  `set.Ico a b` is `[finite]`, and 'locally finite total orders', for which there is a list model.
- Once the above is done, get rid of `data.int.range` (and maybe `list.range'`?).
-/

open Nat

namespace List

/-- `Ico n m` is the list of natural numbers `n ≤ x < m`.
(Ico stands for "interval, closed-open".)

See also `data/set/intervals.lean` for `set.Ico`, modelling intervals in general preorders, and
`multiset.Ico` and `finset.Ico` for `n ≤ x < m` as a multiset or as a finset.
 -/
def ico (n m : ℕ) : List ℕ :=
  range' n (m - n)
#align list.Ico List.ico

namespace Ico

theorem zero_bot (n : ℕ) : ico 0 n = range n := by rw [Ico, tsub_zero, range_eq_range']
#align list.Ico.zero_bot List.ico.zero_bot

@[simp]
theorem length (n m : ℕ) : length (ico n m) = m - n :=
  by
  dsimp [Ico]
  simp only [length_range']
#align list.Ico.length List.ico.length

theorem pairwise_lt (n m : ℕ) : Pairwise (· < ·) (ico n m) :=
  by
  dsimp [Ico]
  simp only [pairwise_lt_range']
#align list.Ico.pairwise_lt List.ico.pairwise_lt

theorem nodup (n m : ℕ) : Nodup (ico n m) :=
  by
  dsimp [Ico]
  simp only [nodup_range']
#align list.Ico.nodup List.ico.nodup

@[simp]
theorem mem {n m l : ℕ} : l ∈ ico n m ↔ n ≤ l ∧ l < m :=
  by
  suffices n ≤ l ∧ l < n + (m - n) ↔ n ≤ l ∧ l < m by simp [Ico, this]
  cases' le_total n m with hnm hmn
  · rw [add_tsub_cancel_of_le hnm]
  · rw [tsub_eq_zero_iff_le.mpr hmn, add_zero]
    exact
      and_congr_right fun hnl =>
        Iff.intro (fun hln => (not_le_of_gt hln hnl).elim) fun hlm => lt_of_lt_of_le hlm hmn
#align list.Ico.mem List.ico.mem

theorem eq_nil_of_le {n m : ℕ} (h : m ≤ n) : ico n m = [] := by
  simp [Ico, tsub_eq_zero_iff_le.mpr h]
#align list.Ico.eq_nil_of_le List.ico.eq_nil_of_le

theorem map_add (n m k : ℕ) : (ico n m).map ((· + ·) k) = ico (n + k) (m + k) := by
  rw [Ico, Ico, map_add_range', add_tsub_add_eq_tsub_right, add_comm n k]
#align list.Ico.map_add List.ico.map_add

theorem map_sub (n m k : ℕ) (h₁ : k ≤ n) : ((ico n m).map fun x => x - k) = ico (n - k) (m - k) :=
  by rw [Ico, Ico, tsub_tsub_tsub_cancel_right h₁, map_sub_range' _ _ _ h₁]
#align list.Ico.map_sub List.ico.map_sub

@[simp]
theorem self_empty {n : ℕ} : ico n n = [] :=
  eq_nil_of_le (le_refl n)
#align list.Ico.self_empty List.ico.self_empty

@[simp]
theorem eq_empty_iff {n m : ℕ} : ico n m = [] ↔ m ≤ n :=
  Iff.intro (fun h => tsub_eq_zero_iff_le.mp <| by rw [← length, h, List.length]) eq_nil_of_le
#align list.Ico.eq_empty_iff List.ico.eq_empty_iff

theorem append_consecutive {n m l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) : ico n m ++ ico m l = ico n l :=
  by
  dsimp only [Ico]
  convert range'_append _ _ _
  · exact (add_tsub_cancel_of_le hnm).symm
  · rwa [← add_tsub_assoc_of_le hnm, tsub_add_cancel_of_le]
#align list.Ico.append_consecutive List.ico.append_consecutive

@[simp]
theorem inter_consecutive (n m l : ℕ) : ico n m ∩ ico m l = [] :=
  by
  apply eq_nil_iff_forall_not_mem.2
  intro a
  simp only [and_imp, not_and, not_lt, List.mem_inter, List.ico.mem]
  intro h₁ h₂ h₃
  exfalso
  exact not_lt_of_ge h₃ h₂
#align list.Ico.inter_consecutive List.ico.inter_consecutive

@[simp]
theorem bagInter_consecutive (n m l : ℕ) : List.bagInter (ico n m) (ico m l) = [] :=
  (bagInter_nil_iff_inter_nil _ _).2 (inter_consecutive n m l)
#align list.Ico.bag_inter_consecutive List.ico.bagInterₓ_consecutive

@[simp]
theorem succ_singleton {n : ℕ} : ico n (n + 1) = [n] :=
  by
  dsimp [Ico]
  simp [add_tsub_cancel_left]
#align list.Ico.succ_singleton List.ico.succ_singleton

theorem succ_top {n m : ℕ} (h : n ≤ m) : ico n (m + 1) = ico n m ++ [m] :=
  by
  rwa [← succ_singleton, append_consecutive]
  exact Nat.le_succ _
#align list.Ico.succ_top List.ico.succ_top

theorem eq_cons {n m : ℕ} (h : n < m) : ico n m = n :: ico (n + 1) m :=
  by
  rw [← append_consecutive (Nat.le_succ n) h, succ_singleton]
  rfl
#align list.Ico.eq_cons List.ico.eq_cons

@[simp]
theorem pred_singleton {m : ℕ} (h : 0 < m) : ico (m - 1) m = [m - 1] :=
  by
  dsimp [Ico]
  rw [tsub_tsub_cancel_of_le (succ_le_of_lt h)]
  simp
#align list.Ico.pred_singleton List.ico.pred_singleton

theorem chain'_succ (n m : ℕ) : Chain' (fun a b => b = succ a) (ico n m) :=
  by
  by_cases n < m
  · rw [eq_cons h]
    exact chain_succ_range' _ _
  · rw [eq_nil_of_le (le_of_not_gt h)]
    trivial
#align list.Ico.chain'_succ List.ico.chain'_succ

@[simp]
theorem not_mem_top {n m : ℕ} : m ∉ ico n m := by simp
#align list.Ico.not_mem_top List.ico.not_mem_top

theorem filter_lt_of_top_le {n m l : ℕ} (hml : m ≤ l) :
    ((ico n m).filterₓ fun x => x < l) = ico n m :=
  filter_eq_self.2 fun k hk => lt_of_lt_of_le (mem.1 hk).2 hml
#align list.Ico.filter_lt_of_top_le List.ico.filterₓ_lt_of_top_le

theorem filter_lt_of_le_bot {n m l : ℕ} (hln : l ≤ n) : ((ico n m).filterₓ fun x => x < l) = [] :=
  filter_eq_nil.2 fun k hk => not_lt_of_le <| le_trans hln <| (mem.1 hk).1
#align list.Ico.filter_lt_of_le_bot List.ico.filterₓ_lt_of_le_bot

theorem filter_lt_of_ge {n m l : ℕ} (hlm : l ≤ m) : ((ico n m).filterₓ fun x => x < l) = ico n l :=
  by
  cases' le_total n l with hnl hln
  ·
    rw [← append_consecutive hnl hlm, filter_append, filter_lt_of_top_le (le_refl l),
      filter_lt_of_le_bot (le_refl l), append_nil]
  · rw [eq_nil_of_le hln, filter_lt_of_le_bot hln]
#align list.Ico.filter_lt_of_ge List.ico.filterₓ_lt_of_ge

@[simp]
theorem filter_lt (n m l : ℕ) : ((ico n m).filterₓ fun x => x < l) = ico n (min m l) :=
  by
  cases' le_total m l with hml hlm
  · rw [min_eq_left hml, filter_lt_of_top_le hml]
  · rw [min_eq_right hlm, filter_lt_of_ge hlm]
#align list.Ico.filter_lt List.ico.filterₓ_lt

theorem filter_le_of_le_bot {n m l : ℕ} (hln : l ≤ n) :
    ((ico n m).filterₓ fun x => l ≤ x) = ico n m :=
  filter_eq_self.2 fun k hk => le_trans hln (mem.1 hk).1
#align list.Ico.filter_le_of_le_bot List.ico.filterₓ_le_of_le_bot

theorem filter_le_of_top_le {n m l : ℕ} (hml : m ≤ l) : ((ico n m).filterₓ fun x => l ≤ x) = [] :=
  filter_eq_nil.2 fun k hk => not_le_of_gt (lt_of_lt_of_le (mem.1 hk).2 hml)
#align list.Ico.filter_le_of_top_le List.ico.filterₓ_le_of_top_le

theorem filter_le_of_le {n m l : ℕ} (hnl : n ≤ l) : ((ico n m).filterₓ fun x => l ≤ x) = ico l m :=
  by
  cases' le_total l m with hlm hml
  ·
    rw [← append_consecutive hnl hlm, filter_append, filter_le_of_top_le (le_refl l),
      filter_le_of_le_bot (le_refl l), nil_append]
  · rw [eq_nil_of_le hml, filter_le_of_top_le hml]
#align list.Ico.filter_le_of_le List.ico.filterₓ_le_of_le

@[simp]
theorem filter_le (n m l : ℕ) : ((ico n m).filterₓ fun x => l ≤ x) = ico (max n l) m :=
  by
  cases' le_total n l with hnl hln
  · rw [max_eq_right hnl, filter_le_of_le hnl]
  · rw [max_eq_left hln, filter_le_of_le_bot hln]
#align list.Ico.filter_le List.ico.filterₓ_le

theorem filter_lt_of_succ_bot {n m : ℕ} (hnm : n < m) :
    ((ico n m).filterₓ fun x => x < n + 1) = [n] :=
  by
  have r : min m (n + 1) = n + 1 := (@inf_eq_right _ _ m (n + 1)).mpr hnm
  simp [filter_lt n m (n + 1), r]
#align list.Ico.filter_lt_of_succ_bot List.ico.filterₓ_lt_of_succ_bot

@[simp]
theorem filter_le_of_bot {n m : ℕ} (hnm : n < m) : ((ico n m).filterₓ fun x => x ≤ n) = [n] :=
  by
  rw [← filter_lt_of_succ_bot hnm]
  exact filter_congr' fun _ _ => lt_succ_iff.symm
#align list.Ico.filter_le_of_bot List.ico.filterₓ_le_of_bot

/-- For any natural numbers n, a, and b, one of the following holds:
1. n < a
2. n ≥ b
3. n ∈ Ico a b
-/
theorem trichotomy (n a b : ℕ) : n < a ∨ b ≤ n ∨ n ∈ ico a b :=
  by
  by_cases h₁ : n < a
  · left
    exact h₁
  · right
    by_cases h₂ : n ∈ Ico a b
    · right
      exact h₂
    · left
      simp only [Ico.mem, not_and, not_lt] at *
      exact h₂ h₁
#align list.Ico.trichotomy List.ico.trichotomy

end Ico

end List


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.fintype.card
import dynamics.fixed_points.basic

/-!
# Formalization of IMO 1987, Q1

Let $p_{n, k}$ be the number of permutations of a set of cardinality `n ≥ 1` that fix exactly `k`
elements. Prove that $∑_{k=0}^n k p_{n,k}=n!$.

To prove this identity, we show that both sides are equal to the cardinality of the set
`{(x : α, σ : perm α) | σ x = x}`, regrouping by `card (fixed_points σ)` for the left hand side and
by `x` for the right hand side.

The original problem assumes `n ≥ 1`. It turns out that a version with `n * (n - 1)!` in the RHS
holds true for `n = 0` as well, so we first prove it, then deduce the original version in the case
`n ≥ 1`. -/

variables (α : Type*) [fintype α] [decidable_eq α]

open_locale big_operators nat
open equiv fintype function finset (range sum_const) set (Iic)

namespace imo_1987_q1

/-- The set of pairs `(x : α, σ : perm α)` such that `σ x = x` is equivalent to the set of pairs
`(x : α, σ : perm {x}ᶜ)`. -/
def fixed_points_equiv :
  {σx : α × perm α | σx.2 σx.1 = σx.1} ≃ Σ x : α, perm ({x}ᶜ : set α) :=
calc {σx : α × perm α | σx.2 σx.1 = σx.1} ≃ Σ x : α, {σ : perm α | σ x = x} : set_prod_equiv_sigma _
... ≃ Σ x : α, {σ : perm α | ∀ y : ({x} : set α), σ y = equiv.refl ↥({x} : set α) y} :
  sigma_congr_right (λ x, equiv.set.of_eq $ by { simp only [set_coe.forall], dsimp, simp })
... ≃ Σ x : α, perm ({x}ᶜ : set α) :
  sigma_congr_right (λ x, by apply equiv.set.compl)

theorem card_fixed_points :
  card {σx : α × perm α | σx.2 σx.1 = σx.1} = card α * (card α - 1)! :=
by simp [card_congr (fixed_points_equiv α), card_perm, finset.filter_not, finset.card_sdiff,
  finset.filter_eq', finset.card_univ]

/-- Given `α : Type*` and `k : ℕ`, `fiber α k` is the set of permutations of `α` with exactly `k`
fixed points. -/
@[derive fintype]
def fiber (k : ℕ) : set (perm α) := {σ : perm α | card (fixed_points σ) = k}

@[simp] lemma mem_fiber {σ : perm α} {k : ℕ} : σ ∈ fiber α k ↔ card (fixed_points σ) = k := iff.rfl

/-- `p α k` is the number of permutations of `α` with exactly `k` fixed points. -/
def p (k : ℕ) := card (fiber α k)

/-- The set of triples `(k ≤ card α, σ ∈ fiber α k, x ∈ fixed_points σ)` is equivalent
to the set of pairs `(x : α, σ : perm α)` such that `σ x = x`. The equivalence sends
`(k, σ, x)` to `(x, σ)` and `(x, σ)` to `(card (fixed_points σ), σ, x)`.

It is easy to see that the cardinality of the LHS is given by
`∑ k : fin (card α + 1), k * p α k`. -/
def fixed_points_equiv' :
  (Σ (k : fin (card α + 1)) (σ : fiber α k), fixed_points σ.1) ≃
    {σx : α × perm α | σx.2 σx.1 = σx.1} :=
{ to_fun := λ p, ⟨⟨p.2.2, p.2.1⟩, p.2.2.2⟩,
  inv_fun := λ p,
    ⟨⟨card (fixed_points p.1.2), (card_subtype_le _).trans_lt (nat.lt_succ_self _)⟩,
     ⟨p.1.2, rfl⟩, ⟨p.1.1, p.2⟩⟩,
  left_inv := λ ⟨⟨k, hk⟩, ⟨σ, hσ⟩, ⟨x, hx⟩⟩, by { simp only [mem_fiber, subtype.coe_mk] at hσ,
    subst k, refl },
  right_inv := λ ⟨⟨x, σ⟩, h⟩, rfl }

/-- Main statement for any `(α : Type*) [fintype α]`. -/
theorem main_fintype :
  ∑ k in range (card α + 1), k * p α k = card α * (card α - 1)! :=
have A : ∀ k (σ : fiber α k), card (fixed_points ⇑(↑σ : perm α)) = k := λ k σ, σ.2,
by simpa [A, ← fin.sum_univ_eq_sum_range, -card_of_finset, finset.card_univ,
  card_fixed_points, mul_comm] using card_congr (fixed_points_equiv' α)

/-- Main statement for permutations of `fin n`, a version that works for `n = 0`. -/
theorem main₀ (n : ℕ) :
  ∑ k in range (n + 1), k * p (fin n) k = n * (n - 1)! :=
by simpa using main_fintype (fin n)

/-- Main statement for permutations of `fin n`. -/
theorem main {n : ℕ} (hn : 1 ≤ n) :
  ∑ k in range (n + 1), k * p (fin n) k = n! :=
by rw [main₀, nat.mul_factorial_pred (zero_lt_one.trans_le hn)]

end imo_1987_q1


import .lemmas

namespace nat

-- Bit Width of Naturals

def width : nat -> nat
| n :=
  if h : n > 1 then
    have n.div2 < n,
      from div2_lt_self (lt.trans zero_lt_one h),
    succ (width n.div2)
  else
    1

-- Basic Width Theorems

theorem width_zero : width 0 = 1 := rfl
theorem width_one : width 1 = 1 := rfl
theorem width_le1 {n : nat} (n_le1 : n <= 1) : width n = 1
:= begin
  cases n, refl,
  cases n, refl,
  exact absurd n_le1 (not_succ_succ_le_one n)
end

theorem width_gt1 {n : nat} (n_gt1 : n > 1) : n.width = n.div2.width.succ
:= by rw [width, if_pos n_gt1]

lemma width_succ_succ (n : nat) :
n.succ.succ.width = n.succ.succ.div2.width.succ
:= width_gt1 (one_lt_succ_succ n)

lemma width_two : width 2 = 2 :=
by rw [width_gt1 one_lt_two, div2_two, width_one]

lemma width_three : width 3 = 2 :=
by rw [width_gt1 (one_lt_succ_succ 1), div2_succ_succ, div2_one, width_one]

theorem width_pos {n : nat} : n.width > 0
:= begin
  cases n,
  rw [width_zero],
  exact nat.zero_lt_one,
  cases n,
  rw [width_one],
  exact nat.zero_lt_one,
  rw [width_succ_succ n],
  exact (nat.zero_lt_succ _)
end

lemma zero_lt_width (n : nat) : n.width > 0 := width_pos

--- Complex Width Theorems

theorem width_div2 {n : nat} (n_gt1 : n > 1):
n.div2.width = n.width.pred
:= by rw [width_gt1 n_gt1, pred_succ]

lemma width_div2_succ_succ (n : nat) :
n.succ.succ.div2.width = n.succ.succ.width.pred
:= width_div2 (one_lt_succ_succ n)

theorem width_mul2 {n : nat} (n_pos : n > 0):
width (2 * n) = n.width.succ
:= begin
  cases n,
  exact absurd n_pos (not_lt_zero 0),
  rw [mul_succ 2 n, add_two],
  rw [width_succ_succ (2 * n)],
  rw [div2_succ_succ, div2_mul2],
end

lemma width_mul2_succ (n : nat):
width (2 * n.succ) = n.succ.width.succ
:= width_mul2 (zero_lt_succ n)

theorem width_mul2_add_one (n : nat) (n_pos : n > 0):
width (2 * n + 1) = n.width.succ
:= begin
  cases n, exact absurd n_pos (not_lt_zero 0),
  rw [width_gt1 (one_lt_succ_of_pos (mul_pos two_pos n_pos))],
  rw [div2_succ_mul2],
end

theorem width_pow2 (n : nat):
width (2 ^ n) = n.succ
:= begin
  induction n, refl,
  rw [pow_succ, nat.mul_comm],
  rw [width_mul2 pow2_pos, n_ih],
end

theorem width_pow2_add {n : nat}:
forall {m : nat}, m < 2 ^ n -> width (2 ^ n + m) = n.succ
:= begin
  induction n,
  rw [pow_zero],
  intro m, assume h,
  cases m, refl,
  exact absurd h (not_succ_lt_one _),
  intro m, assume h,
  rw [width_gt1 (one_lt_pow2_succ_add_right _ m)],
  rw [div2_val, pow_succ_add_div _ _ two_pos],
  have h' := div_lt_of_lt_pow_succ two_pos h,
  rw [n_ih h'],
end

theorem width_pow2_sub_one (n : nat) (n_pos : n > 0):
width (2 ^ n - 1) = n
:= begin
  cases n, exact absurd n_pos (not_lt_zero 0),
  induction n, transitivity width 1, refl, exact width_one,
  rw [width_gt1 (one_lt_pow2_sub_one (one_lt_succ_succ n_n))],
  rw [div2_pow2_succ_sub_one (succ n_n)],
  rw [n_ih (zero_lt_succ n_n)],
end

theorem lt_pow2_of_width (n : nat): n < 2 ^ (width n)
:= begin
  apply nat.strong_induction_on n,
  intro n_n, assume n_ih,
  cases n_n,
  rw [width_zero, pow_one],
  exact zero_lt_two,
  cases n_n,
  rw [width_one, pow_one],
  exact one_lt_two,
  rw [width_succ_succ],
  rw [pow_succ, div2_val],
  apply (div_lt_iff_lt_mul n_n.succ.succ _ two_pos).mp,
  apply n_ih (n_n.succ.succ / 2),
  exact (div_lt_self (zero_lt_succ n_n.succ) one_lt_two),
end

theorem lt_pow2_max_width_right (n x : nat): n < 2 ^ max x (width n)
:= begin
  apply nat.lt_of_lt_of_le,
  exact lt_pow2_of_width n,
  apply pow_le_pow_of_le_right two_pos,
  exact le_max_right _ _,
end

end nat


/-
  Exercise 1.
    Prove the following identities, replacing the “sorry” placeholders with actual proofs.
-/

variables p q r : Prop

-- commutativity of ∧ and ∨

theorem and_com {p q : Prop} : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume h : p ∧ q,
    show q ∧ p, from ⟨ h.right, h.left ⟩)
  (assume h : q ∧ p,
    show p ∧ q, from ⟨ h.right, h.left ⟩)

theorem or_com {p q : Prop} : p ∨ q ↔ q ∨ p :=
iff.intro
  (assume h : p ∨ q,
    h.elim
      (assume hp : p, or.inr hp)
      (assume hq : q, or.inl hq))
  (assume h : q ∨ p,
    h.elim
      (assume hq : q, or.inr hq)
      (assume hp : p, or.inl hp))

-- associativity of ∧ and ∨

theorem and_ass {p q r : Prop} : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
iff.intro
  (assume h : (p ∧ q) ∧ r,
    show p ∧ (q ∧ r), from ⟨ h.left.left, ⟨ h.left.right, h.right ⟩ ⟩)
  (assume h : p ∧ (q ∧ r),
    show (p ∧ q) ∧ r, from ⟨ ⟨ h.left, h.right.left ⟩, h.right.right ⟩)

theorem or_ass {p q r : Prop} : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro
  (assume h : (p ∨ q) ∨ r,
    h.elim
    (assume hpq : p ∨ q,
      hpq.elim
      (assume hp : p,
        show p ∨ (q ∨ r), from or.inl hp)
      (assume hq : q,
        show p ∨ (q ∨ r), from or.inr (or.inl hq)))
    (assume hr : r,
      show p ∨ (q ∨ r), from or.inr (or.inr hr)))
  (assume h : p ∨ (q ∨ r),
    h.elim
    (assume hp : p,
      show (p ∨ q) ∨ r, from or.inl (or.inl hp))
    (assume hqr : q ∨ r,
      hqr.elim
      (assume hq : q,
        show (p ∨ q) ∨ r, from or.inl (or.inr hq))
      (assume hr : r,
        show (p ∨ q) ∨ r, from or.inr hr)))

-- distributivity

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
  (assume h : p ∧ (q ∨ r),
    h.right.elim
      (assume hq : q,
        show (p ∧ q) ∨ (p ∧ r), from or.inl ⟨ h.left, hq ⟩)
      (assume hr : r,
        show (p ∧ q) ∨ (p ∧ r), from or.inr ⟨ h.left, hr ⟩))
  (assume h : (p ∧ q) ∨ (p ∧ r),
    h.elim
      (assume hpq : p ∧ q,
        show p ∧ (q ∨ r), from ⟨ hpq.left, or.inl hpq.right ⟩)
      (assume hpr : p ∧ r,
        show p ∧ (q ∨ r), from ⟨ hpr.left, or.inr hpr.right ⟩))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
iff.intro
  (assume h : p ∨ (q ∧ r),
    h.elim
      (assume hp : p,
        show (p ∨ q) ∧ (p ∨ r), from ⟨ or.inl hp, or.inl hp ⟩)
      (assume hqr : q ∧ r,
        show (p ∨ q) ∧ (p ∨ r), from ⟨ or.inr hqr.left, or.inr hqr.right ⟩))
  (assume h : (p ∨ q) ∧ (p ∨ r),
    have hpq : p ∨ q, from h.left,
    have hpr : p ∨ r, from h.right,
    hpq.elim
      (assume hp : p,
        show p ∨ (q ∧ r), from or.inl hp)
      (assume hq : q,
        hpr.elim
          (assume hp : p,
            show p ∨ (q ∧ r), from or.inl hp)
          (assume hr : r,
            show p ∨ (q ∧ r), from or.inr ⟨ hq, hr ⟩)))

-- other properties

theorem exportation {p q r : Prop} : (p → (q → r)) ↔ (p ∧ q → r) :=
iff.intro
  (assume (h₁ : (p → q → r)) (h₂ : p ∧ q),
    show r, from h₁ h₂.left h₂.right)
  (assume (h : p ∧ q → r) (hp : p) (hq : q),
    show r, from h (and.intro hp hq))

theorem antidist_or : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
iff.intro
  (assume (h₁ : p ∨ q → r),
    show (p → r) ∧ (q → r), from and.intro -- ⟨ λ hp, h₁ (or.inl hp), λ hq, h₁ (or.inr hq) ⟩
      (assume hp : p,
        have h₂ : p ∨ q, from or.inl hp,
        show r, from h₁ h₂)
      (assume hq : q,
        have h₂ : p ∨ q, from or.inr hq,
        show r, from h₁ h₂))
  (assume (h₁ : (p → r) ∧ (q → r)) (h₂ : p ∨ q),
    show r, from h₂.elim
      (assume hp : p, h₁.left hp)
      (assume hq : q, h₁.right hq))

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := antidist_or p q false

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
assume (h₁ : ¬p ∨ ¬q) (h₂ : p ∧ q),
h₁.elim
  (assume hnp : ¬p, absurd h₂.left hnp)
  (assume hnq : ¬q, absurd h₂.right hnq)

theorem nonabsurdity : ¬(p ∧ ¬p) :=
assume h : p ∧ ¬p,
absurd h.left h.right

example : p ∧ ¬q → ¬(p → q) :=
assume (h₁ : p ∧ ¬q) (h₂ : p → q),
absurd (h₂ h₁.left) h₁.right

-- principle of explosion
theorem explosion : ¬p → (p → q) :=
assume (hnp : ¬p) (hp : p),
absurd hp hnp

-- material implication
theorem mat_impl_right {p q : Prop} : (¬p ∨ q) → (p → q) :=
assume (h : ¬p ∨ q) (hp : p),
h.elim
  (assume hnp : ¬p, absurd hp hnp)
  (assume hq : q, hq)

example : p ∨ false ↔ p :=
iff.intro
  (assume h : p ∨ false, h.elim
    (assume hp : p, hp)
    (assume hf : false, hf.elim))
  (assume hp : p, or.inl hp)

example : p ∧ false ↔ false :=
iff.intro
  (assume h : p ∧ false, h.right.elim)
  (assume h : false, h.elim)

open classical

example : ¬(p ↔ ¬p) :=
assume h,
(em p).elim
  (assume hp : p,
    show false, from absurd hp (h.mp hp))
  (assume hnp : ¬p,
    show false, from absurd (h.mpr hnp) hnp)

example : (p → q) → (¬q → ¬p) :=
assume (hpq : p → q) (hnq : ¬q) (hp : p),
show false, from hnq (hpq hp)

/-
  Exercise 2.
    Prove the following identities, replacing the “sorry” placeholders with actual proofs.
    These require classical reasoning.
-/

open classical

theorem mat_impl_left {p q : Prop} : (p → q) → (¬p ∨ q) :=
assume h : p → q,
by_cases
  (assume hp : p,
    or.inr (h hp))
  (assume hnp : ¬p,
    or.inl hnp)

example : (p → q ∨ r) → ((p → q) ∨ (p → r)) :=
assume h : p → q ∨ r,
have h₁ : ¬p ∨ (q ∨ r), from mat_impl_left h,
have h₂ : (¬p ∨ q) ∨ r, from or_ass.elim_right h₁,
have h₃ : r ∨ (¬p ∨ q), from or_com.elim_left h₂,
have h₄ : ¬p ∨ (r ∨ (¬p ∨ q)), from or.inr h₃,
have h₅ : (¬p ∨ r) ∨ (¬p ∨ q), from or_ass.elim_right h₄,
h₅.elim
  (assume hh : (¬p ∨ r),
    have ha : p → r, from mat_impl_right hh,
    or.inr ha)
  (assume hh : (¬p ∨ q),
    have ha : p → q, from mat_impl_right hh,
    or.inl ha)

theorem demorgans_4 {p q : Prop} : ¬(p ∧ q) → ¬p ∨ ¬q :=
assume h : ¬(p ∧ q),
by_cases
  (assume hp : p, by_cases
    (assume hq : q, absurd (and.intro hp hq) h)
    (assume hnq : ¬q, or.inr hnq))
  (assume hnp : ¬p, or.inl hnp)

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

-- probably could use mat_impl_left and demorgans
theorem mat_impl_neg_left {p q : Prop} : ¬(p → q) → p ∧ ¬q :=
assume h : ¬(p → q),
by_contradiction
  (assume hc : ¬(p ∧ ¬q),
    have h₁ : ¬p ∨ ¬¬q, from demorgans_4 hc,
    have h₂ : ¬p ∨ q, from h₁.elim
      (assume g : ¬p, or.inl g)
      (assume g : ¬¬q, or.inr (dne g)),
    have h₃ : p → q, from mat_impl_right h₂,
    show false, from h h₃)

-- example : (p → q) → (¬p ∨ q) := sorry -- proved above as theorem mat_impl_left

example : (¬q → ¬p) → (p → q) :=
assume (h : ¬q → ¬p) (hp : p),
by_cases
  (assume hq : q, hq)
  (assume hnq : ¬q, absurd hp (h hnq))

example : p ∨ ¬p := em p

-- Peirce's law
example : (((p → q) → p) → p) :=
assume h : (p → q) → p,
by_cases
  (assume hc : p → q, h hc)
  (assume hc : ¬(p → q),
    have h₁ : p ∧ ¬q, from mat_impl_neg_left hc,
    h₁.left)

/-
  Exercise 3.
    Prove ¬(p ↔ ¬p) without using classical logic.
-/

example : ¬(p ↔ ¬p) :=
assume h,
have h₁ : p → ¬p, from h.elim_left,
have h₂ : ¬p → p, from h.elim_right,
have h₃ : ¬(p ∧ p), from exportation.elim_left h₁,
have hnp : ¬p, from sorry, -- so close...
absurd (h₂ hnp) hnp


import tactic.ring
import tactic.linarith
import data.rat.basic
import data.rat.cast

/- Section
1.4 An Application
-/

/-
We would like prove that there is no rational number whose square is 2 using the techniques introduced earlier.
-/

def even (a : ℤ) := ∃ b : ℤ, a = 2 * b
def odd (a : ℤ) := ∃ b : ℤ, a = 2 * b + 1

lemma not_even_is_odd (n : ℤ) : ¬ even n ↔ odd n :=
begin
    split,
    intro ha,
    have hb : n % 2 = 1,
        have hc : n % 2 = 0 ∨ n % 2 = 1,
            apply int.mod_two_eq_zero_or_one,
        cases hc with hx hy,
        exfalso,
        apply ha,
        existsi n / 2,
        rw int.mul_div_cancel_of_mod_eq_zero hx,
        assumption,
    have hc : (n - 1) % 2 = 0,
    have hd : n % 2 = 1 % 2, rw hb, refl,
        revert hd,
        rw int.mod_eq_mod_iff_mod_sub_eq_zero,
        intro h, assumption,
    existsi (n - 1) / 2,
    rw int.mul_div_cancel_of_mod_eq_zero hc,
    simp,

    intro ha,
    intro hb,
    cases ha with x hx,
    cases hb with y hy,
    have hc : n % 2 = 1,
        rw hx, simp, refl,
    have hd : n % 2 = 0,
        rw hy, simp,
    have he : (1 : ℤ) = (0 : ℤ),
        rwa [←hc, ←hd],
    have hf : ¬ ( (1 : ℤ) = (0 : ℤ)), simp,
    exact hf he,
end

lemma gcdeven (n m : ℕ) : 2 ∣ nat.gcd (2 * n) (2 * m) :=
begin
    have ha : 2 ∣ 2 * n, existsi n, refl,
    have hb : 2 ∣ 2 * m, existsi m, refl,
    have hc : (2 ∣ 2 * n) → (2 ∣ 2 * m) → 2 ∣ nat.gcd (2 * n) (2 * m),
    exact nat.dvd_gcd,
    apply hc,
    repeat {assumption},
end

/- Lemma
If $a$ is an integer, then $a$ is even is and only if $a^2$ is even.
-/
lemma times_even
  (a : ℤ) : even a ↔ even (a ^ 2) :=
begin
    split,
    intro h,
    have ha : ∃ b : ℤ, a = 2 * b, exact h,
    have hb : ∃ b : ℤ, a ^ 2 = 2 * b,
        cases ha with x hx,
        existsi 2 * x ^ 2,
        rw hx,
        ring,
    exact hb,

    intro h,
    apply classical.by_contradiction,
    intro ha,
    have hc : odd a,
        rw ←not_even_is_odd a,
        assumption,
    have hd : odd (a ^ 2),
        cases hc with x hx,
        existsi 2 * x ^ 2 + 2 * x,
        rw hx,
        ring,
    have he : ¬ even (a ^ 2),
        rw not_even_is_odd (a ^ 2),
        assumption,
    exact he h,
end

/- Theorem
There is no rational number whose square is 2.
-/
theorem rational_not_sqrt_two : ¬ ∃ r : ℚ, r ^ 2 = 2  :=
begin
    -- First show that p is even
    push_neg,
    intro r,
    -- Manipulate the fraction to have the properties desired
    have h : rat.mk (r.num) (r.denom) = r,
        apply rat.num_denom,
    rw ←h,
    intro hcon,
    -- The denominator must not be zero
    have hdnot0 : r.denom ≠ 0,
        intro ha,
        have hb : rat.mk (r.num) (r.denom) ^ 2 = 0,
            rw ha,
            refl,
        convert hb,
        rw hcon,
        simp,
        linarith,
    -- The numerator must also not be zero
    have hnnot0 : r.num ≠ 0,
        intro ha,
            have hb : rat.mk (r.num) (r.denom) ^ 2 = 0,
                rw ha,
                simp, refl,
            convert hb,
            rw hcon,
            simp,
            linarith,
    -- The fraction is in its lowest terms
    have hcop : nat.coprime (int.nat_abs r.num) r.denom,
        cases r with ha hb hc hd,
        exact hd,
    -- Now we can begin the actual proof...
    -- First show that r.num ^ 2 is even
    have hsqrneven : even (r.num ^ 2),
        existsi (r.denom : ℤ) ^ 2,
        have ha : r.num ^ 2 = r.num ^ 2 * 1,
            simp,
        rwa [ha, ←rat.mk_eq],
        convert hcon,
        repeat {rw pow_two},
        rw rat.mul_def,
        all_goals {try {simp, apply hdnot0,}},
        simp,
    -- Now we can use times_even to show r.num is even
    have hneven : even r.num, rw times_even, assumption,
    -- r.num is even → r.denom ^ 2 is also even
    have hsqrdeven : even (r.denom ^ 2),
        cases hneven with b ha,
        existsi b ^ 2,
        have hb : (2 * ↑(r.denom) ^ 2 = 4 * (b ^ 2)) → (↑(r.denom) ^ 2 = 2 * b ^ 2),
            have hβ : 4 * b ^ 2 = 2 * 2 * b ^ 2, refl,
            rw [hβ, ←sub_eq_zero],
            have hγ : 2 * ↑(r.denom) ^ 2 - 2 * 2 * b ^ 2 = 2 * (↑(r.denom) ^ 2 - 2 * b ^ 2), ring,
            rw [hγ, mul_eq_zero],
            intro hδ,
            cases hδ with hδ1 hδ2,
            exfalso,
            convert hδ1, simp, linarith,
            rw ←sub_eq_zero,
            assumption,
        rw hb,
        have hc : 4 * b ^ 2 = (2 * b) ^ 2,
            ring,
        rw [hc, ←ha],
    have hd : ↑r.denom * ↑r.denom = r.denom * r.denom, simp,
        have he : rat.mk (r.num ^ 2) (r.denom ^ 2) = 2,
            rw ←hcon,
            repeat {rw pow_two},
            rw rat.mul_def,
            repeat {simp, apply hdnot0,},
        have hf : rat.mk r.num r.denom = r.num / r.denom,
            exact rat.mk_eq_div (r.num) ↑(r.denom),
        have hg : 2 * (↑(r.denom) ^ 2) =  r.num ^ 2 * 1 → 2 * (↑(r.denom) * ↑(r.denom)) = r.num * r.num,
            repeat {rw pow_two},
            rw mul_one,
            intro hh,
            assumption,
        rw hg,
        rw ←rat.mk_eq,
        rw he,
        refl,
        simp,
        rw pow_two,
        intro hh,
        have hi : r.denom = 0,
            have hj : r.denom * r.denom = 0,
                rw ←hd,
                exact_mod_cast hh,
            rw nat.mul_eq_zero at hj,
            revert hj,
            simp,
        exfalso,
        exact hdnot0 hi,
    have hdeven : even r.denom, rw times_even, assumption,
    -- But that means r.num and r.denom are not coprimes
    have hncop : ¬ nat.coprime (int.nat_abs (r.num)) (r.denom),
        have ha : ¬ nat.coprime (int.nat_abs (r.num)) (r.denom) ↔ nat.gcd (int.nat_abs (r.num)) (r.denom) ≠ 1, refl,
        rw ha,
        cases hneven with k hk,
        cases hdeven with m hm,
        rw hk,
        have hb : int.nat_abs r.denom = 2 * (int.nat_abs m),
            rwa [hm, int.nat_abs_mul],
            refl,
        have hc : (r.denom : ℕ) = int.nat_abs r.denom, refl,
        rwa [hc, hb],
        have hd : int.nat_abs (2 * k) = 2 * int.nat_abs k, rw int.nat_abs_mul, refl,
        rw hd,
        intro he,
        have hf : ¬ (2 ∣ nat.gcd (2 * int.nat_abs k) (2 * int.nat_abs m)),
            rw he,
            simp,
            linarith,
        have hg : 2 ∣ nat.gcd (2 * int.nat_abs k) (2 * int.nat_abs m),
            apply gcdeven,
        exact hf hg,
    exact hncop hcop,
end


-- You can ignore this line for now, but don't remove it.
namespace hw3

/-
In this assignment, you will put into practice your new
knowledge of terms and definitions in predicate logic by
using it to implement a library of Boolean functions. You
will also gain practice using different forms of syntax
for defining functions.
-/

/-
To begin, we present one "unary" Boolean function (taking
one Boolean argument and returning a Boolean result) and one
"binary" function (taking two arguments), using each of three
styles of syntax.
-/

/-
First, here are three implementations of exactly the
same unary function, namely negation, in three styles.
-/

-- explicitly lambda expression
def neg_bool : bool → bool :=
    λ (b : bool),
        match b with
        | ff := tt
        | tt := ff
        end

-- by cases; note absence of := after function type
def neg_bool' : bool → bool
    | ff := tt
    | tt := ff

-- C-style; note return type is now between : and :=
def neg_bool'' (b : bool) : bool :=
   match b with
    | ff := tt
    | tt := ff
    end

/-
Second, here are three implementations of exactly the
same binary function (Boolean "and"), in the same three
styles.
-/

-- Note commas in match expression and in each case
def and_bool : bool → bool → bool :=
    λ (b1 b2 : bool),       --shorthand for two lambdas
        match b1, b2 with   -- matching on two arguments
            | ff, ff := ff
            | ff, tt := ff
            | tt, ff := ff
            | tt, tt := tt
        end

-- Note absence of := and of commas in each of the cases
def and_bool' : bool → bool → bool
    | ff ff := ff
    | ff tt := ff
    | tt ff := ff
    | tt tt := tt

-- should seem straightforward now
def and_bool'' (b1 b2 : bool) : bool :=
       match b1, b2 with
            | ff, ff := ff
            | ff, tt := ff
            | tt, ff := ff
            | tt, tt := tt
        end

/-
Your homework is to implement the remaining unary Boolean
functions, and several key binary Boolean functions, each
one in each of these styles: lambda, by-cases, and C-style.
-/

/-
1. Implement the always false unary Boolean function in each
of the three styles, lambda, by-cases, and C-style. Call the
functions false_bool, false_bool', and false_bool'', in that
order.
-/

-- Here's the first one, just to get you going.
def false_bool : bool → bool :=
    λ (b : bool),
        ff

-- Now false_bool'

-- And now false_bool''

/-
2. Do the same for the always true unary Boolean function,
using true_bool as the function name (with zero, one, and
two ' marks to avoid name conflicts. You will use ' in this
way for each of the remaining parts of this assignment).
-/

/-
3. Do the same for the unary Boolean identity function,
using ident_bool (and ' variants) as the function name.
-/

/-
Congrats, you now have a small library of all unary Boolean
functions. Now turn to the binary functions. Each will take
two Boolean arguments, we can call them b1 and b2, and will
return a Boolean result.
-/

/-
4. The Boolean "or" function is true if and only if at least
one of b1 and b2 is true. Equivalently it is false if and only
if both b1 and b2 are false. Implement this function in each
of the three styles, using or_bool as the function name. You
may use the example of "and_bool" above as a model. While you
could just cut and paste, we strongly recommend that you type
your answers in full. Learning new syntax is an exercise is
"muscle memory", so don't take shortcuts here. Learn the
syntax now and it will save you frustration later.
-/

/-
5. The Boolean "exclusive or" function is true if and only if
exactly one of its arguments is true. Implement this function
in each style using xor_bool as the function name.
-/

/-
6. The Boolean "implies" function is true if and only if
either its first argument is false, or its first argument is
true and its second argument is also true. Equivalently it is
false if and only if its first argument is true and its second is false. Implement it in each style, calling it implies_bool.
-/

/-
7. The Boolean "equivalent-to" function is true if its two arguments are the same, either both true or both false;
otherwise it is false. Implement it in the three styles,
using equiv_bool as a function name.
-/

-- leave the following in place as the last line in this file
end hw3


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

import algebra.big_operators.nat_antidiagonal
import data.polynomial.ring_division

/-!
# "Mirror" of a univariate polynomial

In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference
between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is
divisible by `X`.

## Main definitions

- `polynomial.mirror`

## Main results

- `polynomial.mirror_mul_of_domain`: `mirror` preserves multiplication.
- `polynomial.irreducible_of_mirror`: an irreducibility criterion involving `mirror`

-/

namespace polynomial
open_locale polynomial

section semiring

variables {R : Type*} [semiring R] (p q : R[X])

/-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/
noncomputable def mirror := p.reverse * X ^ p.nat_trailing_degree

@[simp] lemma mirror_zero : (0 : R[X]).mirror = 0 := by simp [mirror]

lemma mirror_monomial (n : ℕ) (a : R) : (monomial n a).mirror = (monomial n a) :=
begin
  classical,
  by_cases ha : a = 0,
  { rw [ha, monomial_zero_right, mirror_zero] },
  { rw [mirror, reverse, nat_degree_monomial n a, if_neg ha, nat_trailing_degree_monomial ha,
        ←C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n),
        tsub_self, pow_zero, mul_one] },
end

lemma mirror_C (a : R) : (C a).mirror = C a :=
mirror_monomial 0 a

lemma mirror_X : X.mirror = (X : R[X]) :=
mirror_monomial 1 (1 : R)

lemma mirror_nat_degree : p.mirror.nat_degree = p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  nontriviality R,
  rw [mirror, nat_degree_mul', reverse_nat_degree, nat_degree_X_pow,
      tsub_add_cancel_of_le p.nat_trailing_degree_le_nat_degree],
  rwa [leading_coeff_X_pow, mul_one, reverse_leading_coeff, ne, trailing_coeff_eq_zero]
end

lemma mirror_nat_trailing_degree : p.mirror.nat_trailing_degree = p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  { rw [mirror, nat_trailing_degree_mul_X_pow ((mt reverse_eq_zero.mp) hp),
        reverse_nat_trailing_degree, zero_add] },
end

lemma coeff_mirror (n : ℕ) :
  p.mirror.coeff n = p.coeff (rev_at (p.nat_degree + p.nat_trailing_degree) n) :=
begin
  by_cases h2 : p.nat_degree < n,
  { rw [coeff_eq_zero_of_nat_degree_lt (by rwa mirror_nat_degree)],
    by_cases h1 : n ≤ p.nat_degree + p.nat_trailing_degree,
    { rw [rev_at_le h1, coeff_eq_zero_of_lt_nat_trailing_degree],
      exact (tsub_lt_iff_left h1).mpr (nat.add_lt_add_right h2 _) },
    { rw [←rev_at_fun_eq, rev_at_fun, if_neg h1, coeff_eq_zero_of_nat_degree_lt h2] } },
  rw not_lt at h2,
  rw [rev_at_le (h2.trans (nat.le_add_right _ _))],
  by_cases h3 : p.nat_trailing_degree ≤ n,
  { rw [←tsub_add_eq_add_tsub h2, ←tsub_tsub_assoc h2 h3, mirror, coeff_mul_X_pow',
        if_pos h3, coeff_reverse, rev_at_le (tsub_le_self.trans h2)] },
  rw not_le at h3,
  rw coeff_eq_zero_of_nat_degree_lt (lt_tsub_iff_right.mpr (nat.add_lt_add_left h3 _)),
  exact coeff_eq_zero_of_lt_nat_trailing_degree (by rwa mirror_nat_trailing_degree),
end

--TODO: Extract `finset.sum_range_rev_at` lemma.

lemma mirror_mirror : p.mirror.mirror = p :=
polynomial.ext (λ n, by rw [coeff_mirror, coeff_mirror,
  mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol])

variables {p q}

lemma mirror_involutive : function.involutive (mirror : R[X] → R[X]) :=
mirror_mirror

lemma mirror_eq_iff : p.mirror = q ↔ p = q.mirror :=
mirror_involutive.eq_iff

@[simp] lemma mirror_inj : p.mirror = q.mirror ↔ p = q :=
mirror_involutive.injective.eq_iff

@[simp] lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 :=
⟨λ h, by rw [←p.mirror_mirror, h, mirror_zero], λ h, by rw [h, mirror_zero]⟩

variables (p q)

@[simp] lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff :=
by rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror,
  rev_at_le (nat.le_add_left _ _), add_tsub_cancel_right]

@[simp] lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff :=
by rw [←p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror]

lemma coeff_mul_mirror :
  (p * p.mirror).coeff (p.nat_degree + p.nat_trailing_degree) = p.sum (λ n, (^ 2)) :=
begin
  rw [coeff_mul, finset.nat.sum_antidiagonal_eq_sum_range_succ_mk],
  refine (finset.sum_congr rfl (λ n hn, _)).trans (p.sum_eq_of_subset (λ n, (^ 2))
    (λ n, zero_pow zero_lt_two) _ (λ n hn, finset.mem_range_succ_iff.mpr
    ((le_nat_degree_of_mem_supp n hn).trans (nat.le_add_right _ _)))).symm,
  rw [coeff_mirror, ←rev_at_le (finset.mem_range_succ_iff.mp hn), rev_at_invol, ←sq],
end

variables [no_zero_divisors R]

lemma nat_degree_mul_mirror : (p * p.mirror).nat_degree = 2 * p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, nat_degree_zero, mul_zero] },
  rw [nat_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_degree, two_mul],
end

lemma nat_trailing_degree_mul_mirror :
  (p * p.mirror).nat_trailing_degree = 2 * p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, nat_trailing_degree_zero, mul_zero] },
  rw [nat_trailing_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_trailing_degree, two_mul],
end

end semiring

section ring

variables {R : Type*} [ring R] (p q : R[X])

lemma mirror_neg : (-p).mirror = -(p.mirror) :=
by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul]

variables [no_zero_divisors R]

lemma mirror_mul_of_domain : (p * q).mirror = p.mirror * q.mirror :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, mirror_zero, zero_mul] },
  by_cases hq : q = 0,
  { rw [hq, mul_zero, mirror_zero, mul_zero] },
  rw [mirror, mirror, mirror, reverse_mul_of_domain, nat_trailing_degree_mul hp hq, pow_add],
  rw [mul_assoc, ←mul_assoc q.reverse],
  conv_lhs { congr, skip, congr, rw [←X_pow_mul] },
  repeat { rw [mul_assoc], },
end

lemma mirror_smul (a : R) : (a • p).mirror = a • p.mirror :=
by rw [←C_mul', ←C_mul', mirror_mul_of_domain, mirror_C]

end ring

section comm_ring

variables {R : Type*} [comm_ring R] [no_zero_divisors R] {f : R[X]}

lemma irreducible_of_mirror (h1 : ¬ is_unit f)
  (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror)
  (h3 : ∀ g, g ∣ f → g ∣ f.mirror → is_unit g) : irreducible f :=
begin
  split,
  { exact h1 },
  { intros g h fgh,
    let k := g * h.mirror,
    have key : f * f.mirror = k * k.mirror,
    { rw [fgh, mirror_mul_of_domain, mirror_mul_of_domain, mirror_mirror,
          mul_assoc, mul_comm h, mul_comm g.mirror, mul_assoc, ←mul_assoc] },
    have g_dvd_f : g ∣ f,
    { rw fgh,
      exact dvd_mul_right g h },
    have h_dvd_f : h ∣ f,
    { rw fgh,
      exact dvd_mul_left h g },
    have g_dvd_k : g ∣ k,
    { exact dvd_mul_right g h.mirror },
    have h_dvd_k_rev : h ∣ k.mirror,
    { rw [mirror_mul_of_domain, mirror_mirror],
      exact dvd_mul_left h g.mirror },
    have hk := h2 k key,
    rcases hk with hk | hk | hk | hk,
    { exact or.inr (h3 h h_dvd_f (by rwa ← hk)) },
    { exact or.inr (h3 h h_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, mirror_neg, dvd_neg])) },
    { exact or.inl (h3 g g_dvd_f (by rwa ← hk)) },
    { exact or.inl (h3 g g_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, dvd_neg])) } },
end

end comm_ring

end polynomial


/-
A total function
-- set theoretic representation of the squaring function
sqr : ℕ → ℕ := { (0,0), (1,1), (2,4), (3,9), ... }
-/

/-
Computational representation of the function
-/
def sqr : ℕ → ℕ := λ n, n*n
#eval sqr 3

/-
Logical, declarative, predicate that defines the same function
-/
inductive sqr_pred : ℕ → ℕ → Prop
| in_sqr_pred : ∀ (n1 n2 : ℕ), (n2 = n1 * n1) → sqr_pred n1 n2

-- h === in_sqr_pred n1 n2 k

theorem verification : ∀ (n1 n2 : ℕ), sqr_pred n1 n2 → sqr n1 = n2 :=
begin
  assume n1 n2,
  assume h,
  cases h,
  unfold sqr,
  apply eq.symm _,
  assumption,
end

--

#check sqr_pred
#check sqr_pred 3 8

open sqr_pred

-- explicit proof term
example : sqr_pred 3 9 := in_sqr_pred 3 9 (eq.refl 9)

example : sqr_pred 4 16 := in_sqr_pred _ _ (eq.refl _)

example : sqr_pred 3 9 :=
begin
  apply in_sqr_pred _ _ _,
  exact eq.refl _,
end

example : sqr_pred 4 16 :=
begin
  apply in_sqr_pred _ _ _,
  exact eq.refl _,
end

example : sqr_pred 3 15 := in_sqr_pred _ _ (eq.refl _)

/-
sqr_ev : ℕ → ℕ := { (0,0), (2,4), (4,16), ... }
-/

def evn : ℕ → bool := λ n, n%2 = 0

inductive sqr_ev_pred : ℕ → ℕ → Prop
| in_sqr_ev_pred : ∀ (n1 n2 : ℕ),  (n1%2 = 0) → (n2 = n1 * n1) → sqr_ev_pred n1 n2

open sqr_ev_pred

example : sqr_ev_pred 4 16 :=
begin
  apply in_sqr_ev_pred,
  apply eq.refl _,
  apply eq.refl 16,
end

example : sqr_ev_pred 3 9 :=
begin
  apply in_sqr_ev_pred,
  apply eq.refl _, -- stuck
end


-- source: https://github.com/bryangingechen/lean-fibonacci/blob/master/src/fib.lean
import data.list.range

@[reducible]
def fibonacci : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n+2) := fibonacci n + fibonacci (n+1)

open nat list

@[reducible]
def fib_sum (n : ℕ) : ℕ :=
  ((range n).map fibonacci).sum

@[reducible]
def fib_odd_sum (n : ℕ) : ℕ :=
  ((range n).map (λ m, fibonacci (2*m + 1))).sum

@[reducible]
def fib_even_sum (n : ℕ) : ℕ :=
  ((range n).map (λ m, fibonacci (2*m))).sum

theorem fib_odd_sum_eq : ∀ (n : ℕ),
  fib_odd_sum n = fibonacci (2*n)
| 0 := rfl
| (n+1) := by rw [
    fib_odd_sum,
    sum_range_succ, -- (f : ℕ → α) (n : ℕ), (map f (range n.succ)).sum = (map f (range n)).sum + f n
    ←fib_odd_sum,
    fib_odd_sum_eq,
    mul_add, -- (a b c : α), a * (b + c) = a * b + a * c
    mul_one, -- (a : α), a * 1 = a
    fibonacci
  ]

theorem fib_even_sum_eq : ∀ {n : ℕ} (h : n > 0),
  fib_even_sum n + 1 = fibonacci (2*n - 1)
| 0 h := (gt_irrefl 0 h).elim -- used false.elim : false → C
| 1 _ := rfl
| (n+2) _ :=
have H : fib_even_sum (n+1) + 1 = fibonacci (2*(n+1) - 1) :=
  fib_even_sum_eq (succ_pos n),
begin
  rw [fib_even_sum,
    sum_range_succ,
    ←fib_even_sum,
    add_right_comm,
    H,
    mul_add,
    mul_one,
    mul_add],
  change fibonacci (2*n + 1) + fibonacci (2*n + 1 + 1) =
    fibonacci (2*n + 1 + 2),
  rw [←fibonacci],
end
-- *** Added example ***
namespace false_elim_test

constant h1 : false
#check false.elim h1
#check @false.elim

end false_elim_test

set_option trace.simplify.rewrite true

theorem fib_sum_eq : ∀ (n : ℕ),
  fib_sum n + 1 = fibonacci (n+1)
| 0 := rfl
| (n+1) :=
begin
  rw [fibonacci,
    ←fib_sum_eq n
  ],
  simp [range_concat, fib_sum, add_left_comm, add_comm],
-- [fib_sum.equations._eqn_1]: fib_sum (n + 1) ==> (map fibonacci (range (n + 1))).sum
-- [list.range_concat]: range (n + 1) ==> range n ++ [n]
-- [list.map_append]: map fibonacci (range n ++ [n]) ==> map fibonacci (range n) ++ map fibonacci [n]
-- [list.map.equations._eqn_2]: map fibonacci [n] ==> fibonacci n :: map fibonacci nil
-- [list.map_nil]: map fibonacci nil ==> nil
-- [list.sum_append]: (map fibonacci (range n) ++ [fibonacci n]).sum ==> (map fibonacci (range n)).sum + [fibonacci n].sum
-- [list.sum_cons]: [fibonacci n].sum ==> fibonacci n + nil.sum
-- [list.sum_nil]: nil.sum ==> 0
-- [add_zero]: fibonacci n + 0 ==> fibonacci n
-- [add_comm]: (map fibonacci (range n)).sum + fibonacci n ==> fibonacci n + (map fibonacci (range n)).sum
-- [add_comm]: fibonacci n + (map fibonacci (range n)).sum + 1 ==> 1 + (fibonacci n + (map fibonacci (range n)).sum)
-- [add_left_comm]: 1 + (fibonacci n + (map fibonacci (range n)).sum) ==> fibonacci n + (1 + (map fibonacci (range n)).sum)
-- [fib_sum.equations._eqn_1]: fib_sum n ==> (map fibonacci (range n)).sum
-- [add_comm]: (map fibonacci (range n)).sum + 1 ==> 1 + (map fibonacci (range n)).sum
-- [add_left_inj]: fibonacci n + (1 + (map fibonacci (range n)).sum) = fibonacci n + (1 + (map fibonacci (range n)).sum) ==> fibonacci n = fibonacci n
-- [eq_self_iff_true]: fibonacci n = fibonacci n ==> true
end

inductive bee : Type
| queen : bee
| worker : bee
| drone : bee

open bee list

instance : has_repr bee :=
⟨λ s, match s with
| queen := "Q"
| worker := "W"
| drone := "D"
end⟩

namespace bee

def parents : bee → list bee
| queen := [queen, drone]
| worker := [queen, drone]
| drone := [queen]

def ancestors (b : bee) : ℕ → list bee
| 0 := [b]
| (n+1) := ((ancestors n).map parents).join

def tree_json : bee → ℕ → string
| b 0 := "{\"name\":\"" ++ repr b ++ "\"}"
| b (n+1) := "{\"name\":\"" ++ repr b ++ "\",\"children\":[" ++
  string.intercalate "," (b.parents.map (λ p, p.tree_json n)) ++ "]}"

lemma drone_ancestors_concat : ∀ (n : ℕ),
  drone.ancestors (n+2) = drone.ancestors (n+1) ++ drone.ancestors n
| 0 := rfl
| (n+1) := begin
  change ((ancestors _ (n+2)).map _).join = _,
  conv {
    to_lhs,
    rw [
      drone_ancestors_concat n,
      map_append, -- (f : α → β) (l₁ l₂ : list α), map f (l₁ ++ l₂) = map f l₁ ++ map f l₂
      join_append], -- (L₁ L₂ : list (list α)), (L₁ ++ L₂).join = L₁.join ++ L₂.join
  },
  refl,
end

theorem drone_ancestors_length_eq_fib_succ : ∀ (n : ℕ),
  (drone.ancestors n).length = fibonacci (n + 1)
| 0 := rfl
| 1 := rfl
| (n+2) := begin
  rw [
    drone_ancestors_concat,
    length_append, -- (s t : list α), (s ++ t).length = s.length + t.length
    drone_ancestors_length_eq_fib_succ n,
    drone_ancestors_length_eq_fib_succ (n+1),
    add_comm -- (a b : α), a + b = b + a
  ],
  refl,
end

end bee
---
inductive car : Type
| rabbit : car
| cadillac : car

open car list nat

instance : has_repr car :=
⟨λ s, match s with
| rabbit := "R"
| cadillac := "C"
end⟩

namespace car

@[reducible]
def size : car → ℕ
| rabbit := 1
| cadillac := 2

@[reducible]
def sum_size (cs : list car) : ℕ :=
  (cs.map size).sum

lemma sum_size_cons (c : car) (cs : list car) :
  sum_size (c :: cs) = sum_size cs + c.size :=
begin
  simp only [sum_size, sum_cons, map, add_comm],
  -- [car.sum_size.equations._eqn_1]: sum_size (c :: cs) ==> (map size (c :: cs)).sum
  -- [list.map.equations._eqn_2]: map size (c :: cs) ==> c.size :: map size cs
  -- [list.sum_cons]: (c.size :: map size cs).sum ==> c.size + (map size cs).sum
  -- [car.sum_size.equations._eqn_1]: sum_size cs ==> (map size cs).sum
  -- [add_comm]: (map size cs).sum + c.size ==> c.size + (map size cs).sum
end

@[reducible]
def packings : ℕ → list (list car)
| 0 := [[]]
| 1 := [[rabbit]]
| (n+2) := (packings (n+1)).map (cons rabbit) ++
  (packings n).map (cons cadillac)

theorem num_packings_eq_fib : ∀ (n : ℕ),
  (packings n).length = fibonacci (n+1)
| 0 := rfl
| 1 := rfl
| (n+2) :=
begin
  simp [packings, fibonacci, add_left_comm, add_comm],
  -- [car.packings.equations._eqn_3]: packings (n + 2) ==> map (cons rabbit) (packings n.succ) ++ map (cons cadillac) (packings n)
  -- [list.length_append]: (map (cons rabbit) (packings n.succ) ++ map (cons cadillac) (packings n)).length ==> (map (cons rabbit) (packings n.succ)).length + (map (cons cadillac) (packings n)).length
  -- [list.length_map]: (map (cons rabbit) (packings n.succ)).length ==> (packings n.succ).length
  -- [list.length_map]: (map (cons cadillac) (packings n)).length ==> (packings n).length
  -- [add_comm]: (packings n.succ).length + (packings n).length ==> (packings n).length + (packings n.succ).length
  -- [add_comm]: n + 2 + 1 ==> 1 + (n + 2)
  -- [add_left_comm]: 1 + (n + 2) ==> n + (1 + 2)
  -- [add_zero]: n + (1 + 2) ==> n + 3
  -- [fibonacci.equations._eqn_3]: fibonacci (n + 3) ==> fibonacci (n + 1) + fibonacci (n + 1).succ
  -- [fibonacci.equations._eqn_3]: fibonacci (n + 1).succ ==> fibonacci n + fibonacci n.succ
  -- [add_left_comm]: fibonacci (n + 1) + (fibonacci n + fibonacci n.succ) ==> fibonacci n + (fibonacci (n + 1) + fibonacci n.succ)
  -- [add_comm]: fibonacci (n + 1) + fibonacci n.succ ==> fibonacci n.succ + fibonacci (n + 1)
  rw [num_packings_eq_fib n,
    num_packings_eq_fib (n+1),
    add_left_comm, -- (a b c : α), a + (b + c) = b + (a + c)
    add_right_inj, -- (a : M) {b c : M}, a + b = a + c ↔ b = c
    fibonacci
  ],
end

theorem packing_size : ∀ {n : ℕ} {cs : list car} (h : cs ∈ packings n),
  sum_size cs = n
| 0 cs h :=
begin
  rw mem_singleton.1 h,
  refl,
end
| 1 cs h :=
begin
  rw mem_singleton.1 h,
  refl,
end
| (n+2) cs h :=
begin
  simp [packings] at h,
-- [car.packings.equations._eqn_3]: packings (n + 2) ==>
--                                    map (cons rabbit) (packings n.succ) ++ map (cons cadillac) (packings n)
-- [list.mem_append]: cs ∈ map (cons rabbit) (packings n.succ) ++ map (cons cadillac) (packings n) ==>
--                      cs ∈ map (cons rabbit) (packings n.succ) ∨ cs ∈ map (cons cadillac) (packings n)
-- [list.mem_map]: cs ∈ map (cons rabbit) (packings n.succ) ==>
--                   ∃ (a : list car), a ∈ packings n.succ ∧ rabbit :: a = cs
-- [list.mem_map]: cs ∈ map (cons cadillac) (packings n) ==>
--                   ∃ (a : list car), a ∈ packings n ∧ cadillac :: a = cs
  rcases h with ⟨cs', h₁, h₂⟩ | ⟨cs', h₁, h₂⟩,
  all_goals {
    rw [
      ←h₂,
      sum_size_cons,
      size,
      packing_size h₁
    ],
  },
end

lemma car_size_ne_zero (c : car) : size c ≠ 0 :=
by cases c; contradiction -- why contradiction tactic works with ⊢ rabbit.size ≠ 0 ?

lemma sum_size_zero : ∀ {cs : list car} (h : sum_size cs = 0),
  cs = []
| [] _ := rfl
| (c :: cs) h :=
begin -- ⊢ c :: cs = nil
  exfalso, -- try to find contradiction
  rw [
    sum_size_cons, -- sum_size (c :: cs) = sum_size cs + c.size
    add_eq_zero_iff -- a + b = 0 ↔ a = 0 ∧ b = 0
  ] at h,
  apply car_size_ne_zero c,
  exact h.right,
end

lemma sum_size_one : ∀ {cs : list car} (h : sum_size cs = 1),
  cs = [rabbit]
| [] h := by contradiction -- ⊢ nil = [rabbit]
| (rabbit :: cs) h :=
begin
  rw sum_size_cons at h, -- sum_size (c :: cs) = sum_size cs + c.size
  simp,
  -- [eq_self_iff_true]: rabbit = rabbit ==> true
  -- [true_and]: true ∧ cs = nil ==> cs = nil

  -- ⊢ cs = nil
  apply sum_size_zero, -- sum_size cs = 0 → cs = nil
  -- ⊢ sum_size cs = 0
  have u := succ_inj h, -- succ_inj : n.succ = m.succ → n = m
  change sum_size cs + 1 = 1 at h, -- rabbit.size = 1
  exact u,
end
| (cadillac :: cs) h :=
begin
  rw sum_size_cons at h, -- sum_size (c :: cs) = sum_size cs + c.size
  have : sum_size cs + 1 = 0 := succ_inj h,
  -- cadillac.size = 2
  rw size at h,
  contradiction, -- why contradiction works ?
end

theorem all_packings : ∀ {n : ℕ} {cs : list car} (h : sum_size cs = n),
  cs ∈ packings n
| 0 cs h := by simp [packings, sum_size_zero h]
| 1 cs h := by simp [packings, sum_size_one h]
| (n+2) [] h := by contradiction -- this case have 0 solutions?
| (n+2) (rabbit :: cs) h :=
begin
  rw [sum_size_cons, -- sum_size (c :: cs) = sum_size cs + c.size
    add_left_inj 1 -- (a : M) {b c : M}, b + a = c + a ↔ b = c
  ] at h,
  simp [packings, all_packings, h],
  -- [car.packings.equations._eqn_3]: packings (n + 2) ==> map (cons rabbit) (packings n.succ) ++ map (cons cadillac) (packings n)
  -- [list.mem_append]: rabbit :: cs ∈ map (cons rabbit) (packings n.succ) ++ map (cons cadillac) (packings n) ==>
  --                      rabbit :: cs ∈ map (cons rabbit) (packings n.succ) ∨ rabbit :: cs ∈ map (cons cadillac) (packings n)
  -- [list.mem_map]: rabbit :: cs ∈ map (cons rabbit) (packings n.succ) ==>
  --                             ∃ (a : list car), a ∈ packings n.succ ∧ rabbit :: a = rabbit :: cs
  -- [eq_self_iff_true]: rabbit = rabbit ==> true
  -- [true_and]: true ∧ a = cs ==> a = cs
  -- [exists_eq_right]: ∃ (a : list car), a ∈ packings n.succ ∧ a = cs ==> cs ∈ packings n.succ
  -- [h]: sum_size cs ==> n + 1
  -- [eq_self_iff_true]: n + 1 = n.succ ==> true
  -- [[anonymous]]: cs ∈ packings n.succ ==> true
  -- [list.mem_map]: rabbit :: cs ∈ map (cons cadillac) (packings n) ==> ∃ (a : list car), a ∈ packings n ∧ cadillac :: a = rabbit :: cs
  -- [false_and]: false ∧ a = cs ==> false
  -- [and_false]: a ∈ packings n ∧ false ==> false
  -- [exists_false]: ∃ (a : list car), false ==> false
  -- [or_false]: true ∨ false ==> true
end
| (n+2) (cadillac :: cs) h :=
begin
  rw [sum_size_cons,
    add_left_inj 2] at h,
  simp [packings, all_packings, h],
end

end car


/-
Copyright (c) 2020 James Arthur. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: James Arthur, Chris Hughes, Shing Tak Lam
-/
import analysis.special_functions.trigonometric.deriv
import analysis.special_functions.log.basic

/-!
# Inverse of the sinh function

In this file we prove that sinh is bijective and hence has an
inverse, arsinh.

## Main definitions

- `real.arsinh`: The inverse function of `real.sinh`.

- `real.sinh_equiv`, `real.sinh_order_iso`, `real.sinh_homeomorph`: `real.sinh` as an `equiv`,
  `order_iso`, and `homeomorph`, respectively.

## Main Results

- `real.sinh_surjective`, `real.sinh_bijective`: `real.sinh` is surjective and bijective;

- `real.arsinh_injective`, `real.arsinh_surjective`, `real.arsinh_bijective`: `real.arsinh` is
  injective, surjective, and bijective;

- `real.continuous_arsinh`, `real.differentiable_arsinh`, `real.cont_diff_arsinh`: `real.arsinh` is
  continuous, differentiable, and continuously differentiable; we also provide dot notation
  convenience lemmas like `filter.tendsto.arsinh` and `cont_diff_at.arsinh`.

## Tags

arsinh, arcsinh, argsinh, asinh, sinh injective, sinh bijective, sinh surjective
-/
noncomputable theory

open function filter set
open_locale topology

namespace real

variables {x y : ℝ}

/-- `arsinh` is defined using a logarithm, `arsinh x = log (x + sqrt(1 + x^2))`. -/
@[pp_nodot] def arsinh (x : ℝ) := log (x + sqrt (1 + x^2))

lemma exp_arsinh (x : ℝ) : exp (arsinh x) = x + sqrt (1 + x^2) :=
begin
  apply exp_log,
  rw [← neg_lt_iff_pos_add'],
  calc -x ≤ sqrt (x ^ 2) : le_sqrt_of_sq_le (neg_pow_bit0 _ _).le
  ... < sqrt (1 + x ^ 2) : sqrt_lt_sqrt (sq_nonneg _) (lt_one_add _)
end

@[simp] lemma arsinh_zero : arsinh 0 = 0 := by simp [arsinh]

@[simp] lemma arsinh_neg (x : ℝ) : arsinh (-x) = -arsinh x :=
begin
  rw [← exp_eq_exp, exp_arsinh, exp_neg, exp_arsinh],
  apply eq_inv_of_mul_eq_one_left,
  rw [neg_sq, neg_add_eq_sub, add_comm x, mul_comm, ← sq_sub_sq, sq_sqrt, add_sub_cancel],
  exact add_nonneg zero_le_one (sq_nonneg _)
end

/-- `arsinh` is the right inverse of `sinh`. -/
@[simp] lemma sinh_arsinh (x : ℝ) : sinh (arsinh x) = x :=
by { rw [sinh_eq, ← arsinh_neg, exp_arsinh, exp_arsinh, neg_sq], field_simp }

@[simp] lemma cosh_arsinh (x : ℝ) : cosh (arsinh x) = sqrt (1 + x^2) :=
by rw [← sqrt_sq (cosh_pos _).le, cosh_sq', sinh_arsinh]

/-- `sinh` is surjective, `∀ b, ∃ a, sinh a = b`. In this case, we use `a = arsinh b`. -/
lemma sinh_surjective : surjective sinh := left_inverse.surjective sinh_arsinh

/-- `sinh` is bijective, both injective and surjective. -/
lemma sinh_bijective : bijective sinh := ⟨sinh_injective, sinh_surjective⟩

/-- `arsinh` is the left inverse of `sinh`. -/
@[simp] lemma arsinh_sinh (x : ℝ) : arsinh (sinh x) = x :=
right_inverse_of_injective_of_left_inverse sinh_injective sinh_arsinh x

/-- `real.sinh` as an `equiv`. -/
@[simps] def sinh_equiv : ℝ ≃ ℝ :=
{ to_fun := sinh,
  inv_fun := arsinh,
  left_inv := arsinh_sinh,
  right_inv := sinh_arsinh }

/-- `real.sinh` as an `order_iso`. -/
@[simps { fully_applied := ff }] def sinh_order_iso : ℝ ≃o ℝ :=
{ to_equiv := sinh_equiv,
  map_rel_iff' := @sinh_le_sinh }

/-- `real.sinh` as a `homeomorph`. -/
@[simps { fully_applied := ff }] def sinh_homeomorph : ℝ ≃ₜ ℝ := sinh_order_iso.to_homeomorph

lemma arsinh_bijective : bijective arsinh := sinh_equiv.symm.bijective
lemma arsinh_injective : injective arsinh := sinh_equiv.symm.injective
lemma arsinh_surjective : surjective arsinh := sinh_equiv.symm.surjective

lemma arsinh_strict_mono : strict_mono arsinh := sinh_order_iso.symm.strict_mono

@[simp] lemma arsinh_inj : arsinh x = arsinh y ↔ x = y := arsinh_injective.eq_iff
@[simp] lemma arsinh_le_arsinh : arsinh x ≤ arsinh y ↔ x ≤ y := sinh_order_iso.symm.le_iff_le
@[simp] lemma arsinh_lt_arsinh : arsinh x < arsinh y ↔ x < y := sinh_order_iso.symm.lt_iff_lt

@[simp] lemma arsinh_eq_zero_iff : arsinh x = 0 ↔ x = 0 :=
arsinh_injective.eq_iff' arsinh_zero

@[simp] lemma arsinh_nonneg_iff : 0 ≤ arsinh x ↔ 0 ≤ x :=
by rw [← sinh_le_sinh, sinh_zero, sinh_arsinh]

@[simp] lemma arsinh_nonpos_iff : arsinh x ≤ 0 ↔ x ≤ 0 :=
by rw [← sinh_le_sinh, sinh_zero, sinh_arsinh]

@[simp] lemma arsinh_pos_iff : 0 < arsinh x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le arsinh_nonpos_iff

@[simp] lemma arsinh_neg_iff : arsinh x < 0 ↔ x < 0 :=
lt_iff_lt_of_le_iff_le arsinh_nonneg_iff

lemma has_strict_deriv_at_arsinh (x : ℝ) : has_strict_deriv_at arsinh (sqrt (1 + x ^ 2))⁻¹ x :=
begin
  convert sinh_homeomorph.to_local_homeomorph.has_strict_deriv_at_symm (mem_univ x)
    (cosh_pos _).ne' (has_strict_deriv_at_sinh _),
  exact (cosh_arsinh _).symm
end

lemma has_deriv_at_arsinh (x : ℝ) : has_deriv_at arsinh (sqrt (1 + x ^ 2))⁻¹ x :=
(has_strict_deriv_at_arsinh x).has_deriv_at

lemma differentiable_arsinh : differentiable ℝ arsinh :=
λ x, (has_deriv_at_arsinh x).differentiable_at

lemma cont_diff_arsinh {n : ℕ∞} : cont_diff ℝ n arsinh :=
sinh_homeomorph.cont_diff_symm_deriv (λ x, (cosh_pos x).ne') has_deriv_at_sinh cont_diff_sinh

@[continuity] lemma continuous_arsinh : continuous arsinh := sinh_homeomorph.symm.continuous

end real

open real

lemma filter.tendsto.arsinh {α : Type*} {l : filter α} {f : α → ℝ} {a : ℝ}
  (h : tendsto f l (𝓝 a)) : tendsto (λ x, arsinh (f x)) l (𝓝 (arsinh a)) :=
(continuous_arsinh.tendsto _).comp h

section continuous

variables {X : Type*} [topological_space X] {f : X → ℝ} {s : set X} {a : X}

lemma continuous_at.arsinh (h : continuous_at f a) : continuous_at (λ x, arsinh (f x)) a := h.arsinh

lemma continuous_within_at.arsinh (h : continuous_within_at f s a) :
  continuous_within_at (λ x, arsinh (f x)) s a :=
h.arsinh

lemma continuous_on.arsinh (h : continuous_on f s) : continuous_on (λ x, arsinh (f x)) s :=
λ x hx, (h x hx).arsinh

lemma continuous.arsinh (h : continuous f) : continuous (λ x, arsinh (f x)) :=
continuous_arsinh.comp h

end continuous

section fderiv

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {s : set E} {a : E}
  {f' : E →L[ℝ] ℝ} {n : ℕ∞}

lemma has_strict_fderiv_at.arsinh (hf : has_strict_fderiv_at f f' a) :
  has_strict_fderiv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a :=
(has_strict_deriv_at_arsinh _).comp_has_strict_fderiv_at a hf

lemma has_fderiv_at.arsinh (hf : has_fderiv_at f f' a) :
  has_fderiv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a :=
(has_deriv_at_arsinh _).comp_has_fderiv_at a hf

lemma has_fderiv_within_at.arsinh (hf : has_fderiv_within_at f f' s a) :
  has_fderiv_within_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') s a :=
(has_deriv_at_arsinh _).comp_has_fderiv_within_at a hf

lemma differentiable_at.arsinh (h : differentiable_at ℝ f a) :
  differentiable_at ℝ (λ x, arsinh (f x)) a :=
(differentiable_arsinh _).comp a h

lemma differentiable_within_at.arsinh (h : differentiable_within_at ℝ f s a) :
  differentiable_within_at ℝ (λ x, arsinh (f x)) s a :=
(differentiable_arsinh _).comp_differentiable_within_at a h

lemma differentiable_on.arsinh (h : differentiable_on ℝ f s) :
  differentiable_on ℝ (λ x, arsinh (f x)) s :=
λ x hx, (h x hx).arsinh

lemma differentiable.arsinh (h : differentiable ℝ f) :
  differentiable ℝ (λ x, arsinh (f x)) :=
differentiable_arsinh.comp h

lemma cont_diff_at.arsinh (h : cont_diff_at ℝ n f a) :
  cont_diff_at ℝ n (λ x, arsinh (f x)) a :=
cont_diff_arsinh.cont_diff_at.comp a h

lemma cont_diff_within_at.arsinh (h : cont_diff_within_at ℝ n f s a) :
  cont_diff_within_at ℝ n (λ x, arsinh (f x)) s a :=
cont_diff_arsinh.cont_diff_at.comp_cont_diff_within_at a h

lemma cont_diff.arsinh (h : cont_diff ℝ n f) : cont_diff ℝ n (λ x, arsinh (f x)) :=
cont_diff_arsinh.comp h

lemma cont_diff_on.arsinh (h : cont_diff_on ℝ n f s) : cont_diff_on ℝ n (λ x, arsinh (f x)) s :=
λ x hx, (h x hx).arsinh

end fderiv

section deriv

variables {f : ℝ → ℝ} {s : set ℝ} {a f' : ℝ}

lemma has_strict_deriv_at.arsinh (hf : has_strict_deriv_at f f' a) :
  has_strict_deriv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a :=
(has_strict_deriv_at_arsinh _).comp a hf

lemma has_deriv_at.arsinh (hf : has_deriv_at f f' a) :
  has_deriv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a :=
(has_deriv_at_arsinh _).comp a hf

lemma has_deriv_within_at.arsinh (hf : has_deriv_within_at f f' s a) :
  has_deriv_within_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') s a :=
(has_deriv_at_arsinh _).comp_has_deriv_within_at a hf

end deriv


/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import topology.basic
import topology.constructions
import topology.algebra.ordered.basic

/-!
# Topological lattices

In this file we define mixin classes `has_continuous_inf` and `has_continuous_sup`. We define the
class `topological_lattice` as a topological space and lattice `L` extending `has_continuous_inf`
and `has_continuous_sup`.

## References

* [Gierz et al, A Compendium of Continuous Lattices][GierzEtAl1980]

## Tags

topological, lattice
-/

/--
Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be an infimum. Then `L` is said to have *(jointly) continuous infimum* if the map
`⊓:L×L → L` is continuous.
-/
class has_continuous_inf (L : Type*) [topological_space L] [has_inf L] : Prop :=
(continuous_inf : continuous (λ p : L × L, p.1 ⊓ p.2))

/--
Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be a supremum. Then `L` is said to have *(jointly) continuous supremum* if the map
`⊓:L×L → L` is continuous.
-/
class has_continuous_sup (L : Type*) [topological_space L] [has_sup L] : Prop :=
(continuous_sup : continuous (λ p : L × L, p.1 ⊔ p.2))

@[priority 100] -- see Note [lower instance priority]
instance order_dual.has_continuous_sup
  (L : Type*) [topological_space L] [has_inf L] [has_continuous_inf L] :
  has_continuous_sup (order_dual L) :=
{ continuous_sup := @has_continuous_inf.continuous_inf L _ _ _ }

@[priority 100] -- see Note [lower instance priority]
instance order_dual.has_continuous_inf
  (L : Type*) [topological_space L] [has_sup L] [has_continuous_sup L] :
  has_continuous_inf (order_dual L) :=
{ continuous_inf := @has_continuous_sup.continuous_sup L _ _ _ }

/--
Let `L` be a lattice equipped with a topology such that `L` has continuous infimum and supremum.
Then `L` is said to be a *topological lattice*.
-/
class topological_lattice (L : Type*) [topological_space L] [lattice L]
  extends has_continuous_inf L, has_continuous_sup L

@[priority 100] -- see Note [lower instance priority]
instance order_dual.topological_lattice
  (L : Type*) [topological_space L] [lattice L] [topological_lattice L] :
  topological_lattice (order_dual L) := {}

variables {L : Type*} [topological_space L]
variables {X : Type*} [topological_space X]

@[continuity] lemma continuous_inf [has_inf L] [has_continuous_inf L] :
  continuous (λp:L×L, p.1 ⊓ p.2) :=
has_continuous_inf.continuous_inf

@[continuity] lemma continuous.inf [has_inf L] [has_continuous_inf L]
  {f g : X → L} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x ⊓ g x) :=
continuous_inf.comp (hf.prod_mk hg : _)

@[continuity] lemma continuous_sup [has_sup L] [has_continuous_sup L] :
  continuous (λp:L×L, p.1 ⊔ p.2) :=
has_continuous_sup.continuous_sup

@[continuity] lemma continuous.sup [has_sup L] [has_continuous_sup L]
  {f g : X → L} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x ⊔ g x) :=
continuous_sup.comp (hf.prod_mk hg : _)


-- let's define the real numbers to be a number system which satisfies
-- the basic properties of the real numbers which we will need.

noncomputable theory
constant real : Type
@[instance] constant real_field : linear_ordered_field real

-- This piece of magic means that "real" now behaves a lot like
-- the real numbers. In particular we now have a bunch
-- of theorems:

example : ∀ x y : real, x * y = y * x := mul_comm

variable x : real
variable n : nat

-- We do _not_ have powers though. So we need to make them.

open nat

noncomputable definition natural_power : real → nat → real
| x 0 := 1
| x (succ n) := (natural_power x n) * x

-- Proof by Eduard Oravkin
theorem T1 : ∀ x:real, ∀ m n:nat, natural_power x (m+n) = natural_power x m *natural_power x n :=
begin
intro x, intro m, intro n,
induction n with s H1,
have H : natural_power x 0 = 1,
  refl,
rw [add_zero, H , mul_one],
unfold natural_power,
rw [← mul_assoc, H1],
end

-- Proof by Chris Hughes
theorem T2 : ∀ x: real, ∀ m n : nat, natural_power (natural_power x m) n = natural_power x (m*n) :=
begin
assume x m n,
induction n with n H,
unfold natural_power,
rw [mul_zero, eq_comm],
unfold natural_power,
rw [succ_eq_add_one,mul_add,mul_one,add_one],
unfold natural_power,
rw [T1,H]
end

-- Proof by Ali Barkhordarian
theorem T3 : ∀ x y: real, ∀ n : nat, natural_power x n * natural_power y n = natural_power (x*y) n :=
begin
assume x y n,
induction n with n H,
unfold natural_power,
exact one_mul 1,
unfold natural_power,
rw [mul_assoc],
rw [← mul_assoc x],
rw [mul_comm x],
rw [mul_assoc, ←mul_assoc],
rw [H]
end

constant nth_root (x : real) (n : nat) : (x>0) → (n>0) → real

axiom is_nth_root (x : real) (n : nat) (Hx : x>0) (Hn : n>0) : natural_power (nth_root x n Hx Hn) n = x

definition rational_power_v0 (x : real) (n : nat) (d : nat) (Hx : x > 0) (Hd : d > 0) : real :=
natural_power (nth_root x d Hx Hd) n


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

/-!
# Cancel the leading terms of two polynomials

## Definition

* `cancel_leads p q`: the polynomial formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting.

## Main Results
The degree of `cancel_leads` is less than that of the larger of the two polynomials being cancelled.
Thus it is useful for induction or minimal-degree arguments.
-/
namespace polynomial
noncomputable theory

variables {R : Type*}

section comm_ring
variables [comm_ring R] (p q : polynomial R)

/-- `cancel_leads p q` is formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting. -/
def cancel_leads : polynomial R :=
C p.leading_coeff * X ^ (p.nat_degree - q.nat_degree) * q -
C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p

variables {p q}

@[simp] lemma neg_cancel_leads : - p.cancel_leads q = q.cancel_leads p := neg_sub _ _

lemma dvd_cancel_leads_of_dvd_of_dvd {r : polynomial R} (pq : p ∣ q) (pr : p ∣ r) :
  p ∣ q.cancel_leads r :=
dvd_sub (pr.trans (dvd.intro_left _ rfl)) (pq.trans (dvd.intro_left _ rfl))

end comm_ring

lemma nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree [comm_ring R] [is_domain R]
  {p q : polynomial R} (h : p.nat_degree ≤ q.nat_degree) (hq : 0 < q.nat_degree) :
  (p.cancel_leads q).nat_degree < q.nat_degree :=
begin
  by_cases hp : p = 0,
  { convert hq,
    simp [hp, cancel_leads], },
  rw [cancel_leads, sub_eq_add_neg, tsub_eq_zero_iff_le.mpr h, pow_zero, mul_one],
  by_cases h0 :
      C p.leading_coeff * q + -(C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p) = 0,
  { convert hq,
    simp only [h0, nat_degree_zero], },
  have hq0 : ¬ q = 0,
  { contrapose! hq,
    simp [hq] },
  apply lt_of_le_of_ne,
  { rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree h0, ← degree_eq_nat_degree hq0],
    apply le_trans (degree_add_le _ _),
    rw ← leading_coeff_eq_zero at hp hq0,
    simp only [max_le_iff, degree_C hp, degree_C hq0, le_refl q.degree, true_and, nat.cast_with_bot,
      nsmul_one, degree_neg, degree_mul, zero_add, degree_X, degree_pow],
    rw leading_coeff_eq_zero at hp hq0,
    rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq0, ← with_bot.coe_add, with_bot.coe_le_coe,
      tsub_add_cancel_of_le h], },
  { contrapose! h0,
    rw [← leading_coeff_eq_zero, leading_coeff, h0, mul_assoc, mul_comm _ p,
      ← tsub_add_cancel_of_le h, add_comm _ p.nat_degree],
    simp only [coeff_mul_X_pow, coeff_neg, coeff_C_mul, add_tsub_cancel_left, coeff_add],
    rw [add_comm p.nat_degree, tsub_add_cancel_of_le h, ← leading_coeff, ← leading_coeff,
      mul_comm _ q.leading_coeff, ← sub_eq_add_neg, ← mul_sub, sub_self, mul_zero] }
end

end polynomial


import data.real.basic
import data.list.range

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

variables {s : ℕ → ℝ} {a : ℝ}

theorem exists_le_of_converges_to_ev (cs : converges_to s a) :
  ∃ N b, ∀ n, N ≤ n → s n < b :=
begin
cases cs 1 zero_lt_one with N h,
use [N , a + 1],
intros n h₁,
specialize @h n h₁,
have h₂: s n - a ≤ abs(s n - a),
apply le_abs_self,
suffices h₃: s n - a < 1,
exact sub_lt_iff_lt_add'.mp h₃,
apply lt_of_le_of_lt h₂ h,
end

theorem exists_le_of_converges (cs : converges_to s a) :
  ∃ b, ∀ n, s n < b :=
begin
cases cs 1 zero_lt_one with N h,
let l := list.map (λ n, s ↑n) (list.range N.succ),
have : l.maximum ≠ ⊥,
{ intro hl, rw [← with_bot.none_eq_bot, list.maximum_eq_none] at hl,
  refine (list.ne_nil_of_length_eq_succ _) hl,
    exact N,
    { rw list.length_map, exact list.length_range (nat.succ N) },
 },
let lm : ℝ := with_bot.unbot l.maximum this,
have : l.maximum = ↑lm,
  exact ((list.maximum l).coe_unbot this).symm,

use max lm a + 1,
intro n,
cases nat.lt_or_ge n N with hn hn,
{ apply lt_of_le_of_lt _ (lt_add_one (max lm a)),
  apply le_trans _ (le_max_left _ _),
  apply list.le_maximum_of_mem _ this,
  rw list.mem_map,
  use n, split,
    rw list.mem_range,
    exact lt_of_lt_of_le hn (nat.le_succ N),
    simp only [nat.cast_id], },
{ have : a + 1 ≤ max lm a + 1,
    simp only [add_le_add_iff_right, le_max_iff, le_refl, or_true],
  refine lt_of_lt_of_le _ this,
  let hn := (abs_lt.mp (h n hn)).right,
  apply lt_add_of_neg_add_lt_left ,
  rw [add_comm, ← sub_eq_add_neg],
  exact hn }
end


namespace ex1
    variables p q r : Prop

    -- >>> Proofs <<< --

    theorem and_commutes : p ∧ q ↔ q ∧ p :=
        iff.intro
            (λ pq, ⟨pq.right, pq.left⟩)
            (λ qp, ⟨qp.right, qp.left⟩)

    theorem or_commutes : p ∨ q ↔ q ∨ p :=
        iff.intro
            (λ pq, pq.elim (λ hp, or.inr hp) (λ hq, or.inl hq) )
            (λ qp, qp.elim (λ hq, or.inr hq) (λ hp, or.inl hp))

    theorem and_associates : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
        have ltr : (p ∧ q) ∧ r → p ∧ (q ∧ r), from λ hpqr, ⟨hpqr.left.left, ⟨hpqr.left.right, hpqr.right⟩⟩,
        have rtl : p ∧ (q ∧ r) → (p ∧ q) ∧ r, from λ hpqr, ⟨⟨hpqr.left, hpqr.right.left⟩, hpqr.right.right⟩ ,
        ⟨ltr, rtl⟩

    theorem or_associates : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
        let ltr := λ (h : (p ∨ q) ∨ r),
            h.elim
                (λ hpq, hpq.elim (λ hp, or.inl hp) (λ hq, or.inr (or.inl hq)))
                (λ hr, or.inr (or.inr hr)) in
        let rtl := λ (h : p ∨ (q ∨ r)),
            h.elim
                (λ hp, or.inl (or.inl hp))
                (λ hqr, hqr.elim (λ hq, or.inl (or.inr hq)) (λ hr, or.inr hr)) in
        ⟨ltr, rtl⟩

    theorem and_distributes : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    have left_to_right : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r), from
        λ h, and.elim h (λ hp hqr, hqr.elim (λ hq, or.inl ⟨hp, hq⟩) (λ hr, or.inr ⟨hp, hr⟩)),

    have right_to_left : (p ∧ q) ∨ (p ∧ r) → p ∧ (q ∨ r), from
        λ h, or.elim h
            (λ hpq, ⟨hpq.left, or.inl hpq.right⟩)
            (λ hpr, ⟨hpr.left, or.inr hpr.right⟩),

    ⟨left_to_right, right_to_left⟩

    theorem or_distributes : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
    have left_to_right : p ∨ (q ∧ r) → (p ∨ q) ∧ (p ∨ r), from
        λ h, or.elim h
            (λ hp, ⟨or.inl hp, or.inl hp⟩)
            (λ hqr, ⟨or.inr hqr.left, or.inr hqr.right⟩),
    have right_to_left : (p ∨ q) ∧ (p ∨ r) → p ∨ (q ∧ r), from
        λ h, and.elim h
            (λ h₁ h₂, h₁.elim (λ hp, or.inl hp) (λ hq, h₂.elim (λ hp, or.inl hp) (λ hr, or.inr ⟨hq, hr⟩))),
    ⟨left_to_right, right_to_left⟩

    theorem implication_flips (h : p → q) (hnq : ¬q): ¬p :=
    assume hp : p,
    absurd (h hp) hnq

    theorem p_and_not_p_is_absurd : ¬(p ∧ ¬p) :=
    assume h₁ : p ∧ ¬p,
    absurd h₁.left h₁.right

    -- negation is a powerful drug
    theorem p_is_equivalent_to_not_p_is_absurd : ¬(p ↔ ¬p) :=
    assume h,
    have p_implies_not_p : p → ¬p, from iff.elim_left h,
    have not_p_implies_p : ¬p → p, from iff.elim_right h,
    have hnp : ¬p, from λ hp : p, absurd hp (p_implies_not_p hp),
    absurd (not_p_implies_p hnp) hnp

    theorem implication_composition : (p → (q → r)) ↔ (p ∧ q → r) :=
    have left_to_right : (p → (q → r)) → (p ∧ q → r), from λ f₁, λ hpq, (f₁ hpq.left) hpq.right,
    have right_to_left : (p ∧ q → r) → (p → (q → r)), from λ f₁ hp hq, f₁ (and.intro hp hq),
    ⟨left_to_right, right_to_left⟩

    theorem disjunct_implications_decomposition : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
    have left_to_right : ((p ∨ q) → r) → (p → r) ∧ (q → r), from λ f, and.intro (λ hp, f $ or.inl hp) (λ hq, f $ or.inr hq),
    have right_to_left : (p → r) ∧ (q → r) → ((p ∨ q) → r), from λ fs, λ hor, or.elim hor (λ hp, fs.left hp) (λ hq, fs.right hq),
    ⟨left_to_right, right_to_left⟩

    theorem de_morgan_disjunction : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
    have left_to_right : ¬(p ∨ q) → ¬p ∧ ¬q, from λ hnpq, and.intro (λ hp, hnpq (or.inl hp)) (λ hq, hnpq (or.inr hq)),
    have right_to_left : ¬p ∧ ¬q → ¬(p ∨ q), from λ hnpq, assume p_or_q, or.elim p_or_q (λ hp, hnpq.left hp) (λ hq, hnpq.right hq),
    ⟨left_to_right, right_to_left⟩

    theorem disjunction_of_negations_implies_negation_of_conjunction : ¬p ∨ ¬q → ¬(p ∧ q) :=
        λ h, assume p_and_q, or.elim h (λ hnp, hnp p_and_q.left) (λ hnq, hnq p_and_q.right)

    theorem p_and_not_q_means_p_does_not_imply_q : p ∧ ¬q → ¬(p → q) := λ h, assume ptoq, absurd (ptoq h.left) h.right

    theorem p_or_false_equivalent_to_p : p ∨ false ↔ p :=
    have left_to_right : p ∨ false → p, from λ h, or.elim h (λ hp, hp) (λ ff, false.elim ff),
    have right_to_left : p → p ∨ false, from λ hp, or.inl hp,
    ⟨left_to_right, right_to_left⟩

    theorem p_and_false_equivalent_to_false : p ∧ false ↔ false :=
    have left_to_right : p ∧ false → false, from λ pair, pair.right,
    have right_to_left : false → p ∧ false, from λ f, false.elim f,
    ⟨left_to_right, right_to_left⟩

    theorem not_p_or_q_implies_p_implies_q : (¬p ∨ q) → (p → q) := λ h, λ hp, or.elim h (λ hnp, absurd hp hnp) (λ hq, hq)

    -- >>> Goals <<< --

    -- commutativity of ∧ and ∨
    example : p ∧ q ↔ q ∧ p := @and_commutes p q
    example : p ∨ q ↔ q ∨ p := @or_commutes p q

    -- associativity of ∧ and ∨
    example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := @and_associates p q r
    example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := @or_associates p q r

    -- distributivity
    example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := @and_distributes p q r
    example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := @or_distributes p q r

    -- other properties
    example : (p → (q → r)) ↔ (p ∧ q → r) := @implication_composition p q r
    example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := @disjunct_implications_decomposition p q r
    example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := @de_morgan_disjunction p q
    example : ¬p ∨ ¬q → ¬(p ∧ q) := @disjunction_of_negations_implies_negation_of_conjunction p q
    example : ¬(p ∧ ¬p) := @p_and_not_p_is_absurd p
    example : p ∧ ¬q → ¬(p → q) := @p_and_not_q_means_p_does_not_imply_q p q
    example : ¬p → (p → q) := assume hnp hp, absurd hp hnp
    example : (¬p ∨ q) → (p → q) := @not_p_or_q_implies_p_implies_q p q
    example : p ∨ false ↔ p := @p_or_false_equivalent_to_p p
    example : p ∧ false ↔ false := @p_and_false_equivalent_to_false p
    example : ¬(p ↔ ¬p) := @p_is_equivalent_to_not_p_is_absurd p
    example : (p → q) → (¬q → ¬p) := @implication_flips p q

end ex1

section ex2
    open classical

    variables p q r s : Prop

    theorem long (h : p → r ∨ s) : (p → r) ∨ (p → s) :=
    by_cases
        (λ hp : p,
            have r_or_s : r ∨ s, from h hp,
            or.elim r_or_s (λ hr : r, or.inl (λ hp, hr)) (λ hs : s, or.inr (λ hp, hs))
        )
        (λ hnp : ¬p, or.inl (λ hp : p, absurd hp hnp))

    theorem not_conjunction_implies_disjunction_of_nots (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
    by_cases
        (λ hp : p, by_cases (λ hq : q, false.elim $ h (and.intro hp hq)) (λ hnq : ¬q, or.inr hnq))
        (λ hnp : ¬p, or.inl hnp)

    theorem nptoq_to_p_and_nq (h : ¬(p → q)) : p ∧ ¬q :=
    by_cases
        (λ hq : q,
            have p_to_q : p → q, from λ hp : p, hq,
            false.elim $ absurd p_to_q h
        )
        (λ hnq : ¬q,
            by_cases
                (λ hp : p, and.intro hp hnq)
                (λ hnp : ¬p,
                    have p_to_q : p → q, from λ hp, absurd hp hnp,
                    false.elim $ absurd p_to_q h
                )
        )

    theorem p_implies_q_implies_not_p_or_q (h : p → q) : (¬p ∨ q) :=
    or.elim (em p)
        (λ hp, or.inr (h hp))
        (λ hnp, or.inl hnp)

    theorem give_this_one_a_name (h : ¬q → ¬p) (hp : p) : q :=
    by_contradiction (
        λ hnq,
            have hnp : ¬p, from h hnq,
            absurd hp hnp
    )

    theorem last_one (h : (p → q) → p) : p :=
    or.elim (em p)
        (@id p)
        (λ hnp,
            have p_to_q : p → q, from λ hp, absurd hp hnp,
            show p, from h p_to_q
        )

    example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := @long p r s
    example : ¬(p ∧ q) → ¬p ∨ ¬q := @not_conjunction_implies_disjunction_of_nots p q
    example : ¬(p → q) → p ∧ ¬q := @nptoq_to_p_and_nq p q
    example : (p → q) → (¬p ∨ q) := @p_implies_q_implies_not_p_or_q p q
    example : (¬q → ¬p) → (p → q) := @give_this_one_a_name p q
    example : p ∨ ¬p := @em p
    example : (((p → q) → p) → p) := @last_one p q

end ex2

section ex3
    variable p : Prop

    example : ¬(p ↔ ¬p) := @ex1.p_is_equivalent_to_not_p_is_absurd p
end ex3


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

import data.nat.lattice

/-!
# Eventually constant sequences

This file defines eventually constant sequences and their properties.

## Main definitions
 * `eventually_constant_seq`
 * `sequence_limit`
-/

/-- A sequence has the `is_eventually_constant` predicate if all the elements of the sequence
  are eventually the same. -/
def is_eventually_constant {α : Type*} (a : ℕ → α) : Prop :=
 { n | ∀ m, n ≤ m → a (nat.succ m) = a m }.nonempty

/-- An eventually constant sequence is a sequence which has the `is_eventually_constant`
  predicate. -/
structure eventually_constant_seq {α : Type*} :=
(to_seq : ℕ → α)
(is_eventually_const : is_eventually_constant to_seq)

namespace eventually_constant_seq

/-- The smallest number `m` for the sequence `a` such that `a n = a (n + 1)` for all `n ≥ m`. -/
noncomputable def sequence_limit_index' {α : Type*} (a : @eventually_constant_seq α) : ℕ :=
Inf { n | ∀ m, n ≤ m → a.to_seq m.succ = a.to_seq m }

/-- The smallest number `m` for the sequence `a` such that `a n = a m` for all `n ≥ m`. -/
noncomputable def sequence_limit_index {α : Type*} (a : ℕ → α) : ℕ :=
Inf { n | ∀ m, n ≤ m → a n = a m }

/-- The limit of an `eventually_constant_seq`. -/
noncomputable def sequence_limit {α : Type*} (a : @eventually_constant_seq α) :=
a.to_seq (sequence_limit_index' a)

lemma sequence_limit_eq {α : Type*} (a : @eventually_constant_seq α) (m : ℕ)
  (hm : sequence_limit_index' a ≤ m) : sequence_limit a = a.to_seq m :=
begin
  rw sequence_limit,
  induction m with d hd,
  { rw nat.le_zero_iff at hm, rw hm, },
  { have := nat.of_le_succ hm,
    cases this,
    { rw hd this,
      refine (nat.Inf_mem a.is_eventually_const d _).symm,
      exact this, },
    { rw this, }, },
end

end eventually_constant_seq