/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
-/
import group_theory.submonoid.operations
import algebra.big_operators.basic
import algebra.free_monoid
import algebra.pointwise

/-!
# Submonoids: membership criteria

In this file we prove various facts about membership in a submonoid:

* `list_prod_mem`, `multiset_prod_mem`, `prod_mem`: if each element of a collection belongs
  to a multiplicative submonoid, then so does their product;
* `list_sum_mem`, `multiset_sum_mem`, `sum_mem`: if each element of a collection belongs
  to an additive submonoid, then so does their sum;
* `pow_mem`, `nsmul_mem`: if `x ∈ S` where `S` is a multiplicative (resp., additive) submonoid and
  `n` is a natural number, then `x^n` (resp., `n • x`) belongs to `S`;
* `mem_supr_of_directed`, `coe_supr_of_directed`, `mem_Sup_of_directed_on`,
  `coe_Sup_of_directed_on`: the supremum of a directed collection of submonoid is their union.
* `sup_eq_range`, `mem_sup`: supremum of two submonoids `S`, `T` of a commutative monoid is the set
  of products;
* `closure_singleton_eq`, `mem_closure_singleton`: the multiplicative (resp., additive) closure
  of `{x}` consists of powers (resp., natural multiples) of `x`.

## Tags
submonoid, submonoids
-/

open_locale big_operators

variables {M : Type*}
variables {A : Type*}

namespace submonoid

section assoc
variables [monoid M] (S : submonoid M)

@[simp, norm_cast] theorem coe_pow (x : S) (n : ℕ) : ↑(x ^ n) = (x ^ n : M) :=
S.subtype.map_pow x n

@[simp, norm_cast] theorem coe_list_prod (l : list S) : (l.prod : M) = (l.map coe).prod :=
S.subtype.map_list_prod l

@[simp, norm_cast] theorem coe_multiset_prod {M} [comm_monoid M] (S : submonoid M)
  (m : multiset S) : (m.prod : M) = (m.map coe).prod :=
S.subtype.map_multiset_prod m

@[simp, norm_cast] theorem coe_finset_prod {ι M} [comm_monoid M] (S : submonoid M)
  (f : ι → S) (s : finset ι) :
  ↑(∏ i in s, f i) = (∏ i in s, f i : M) :=
S.subtype.map_prod f s

/-- Product of a list of elements in a submonoid is in the submonoid. -/
@[to_additive "Sum of a list of elements in an `add_submonoid` is in the `add_submonoid`."]
lemma list_prod_mem : ∀ {l : list M}, (∀x ∈ l, x ∈ S) → l.prod ∈ S
| []     h := S.one_mem
| (a::l) h :=
  suffices a * l.prod ∈ S, by rwa [list.prod_cons],
  have a ∈ S ∧ (∀ x ∈ l, x ∈ S), from list.forall_mem_cons.1 h,
  S.mul_mem this.1 (list_prod_mem this.2)

/-- Product of a multiset of elements in a submonoid of a `comm_monoid` is in the submonoid. -/
@[to_additive "Sum of a multiset of elements in an `add_submonoid` of an `add_comm_monoid` is
in the `add_submonoid`."]
lemma multiset_prod_mem {M} [comm_monoid M] (S : submonoid M) (m : multiset M) :
  (∀a ∈ m, a ∈ S) → m.prod ∈ S :=
begin
  refine quotient.induction_on m (assume l hl, _),
  rw [multiset.quot_mk_to_coe, multiset.coe_prod],
  exact S.list_prod_mem hl
end

/-- Product of elements of a submonoid of a `comm_monoid` indexed by a `finset` is in the
    submonoid. -/
@[to_additive "Sum of elements in an `add_submonoid` of an `add_comm_monoid` indexed by a `finset`
is in the `add_submonoid`."]
lemma prod_mem {M : Type*} [comm_monoid M] (S : submonoid M)
  {ι : Type*} {t : finset ι} {f : ι → M} (h : ∀c ∈ t, f c ∈ S) :
  ∏ c in t, f c ∈ S :=
S.multiset_prod_mem (t.1.map f) $ λ x hx, let ⟨i, hi, hix⟩ := multiset.mem_map.1 hx in hix ▸ h i hi

lemma pow_mem {x : M} (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S :=
by simpa only [coe_pow] using ((⟨x, hx⟩ : S) ^ n).coe_prop

end assoc

section non_assoc
variables [mul_one_class M] (S : submonoid M)

open set

@[to_additive]
lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → submonoid M} (hS : directed (≤) S)
  {x : M} :
  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  suffices : x ∈ closure (⋃ i, (S i : set M)) → ∃ i, x ∈ S i,
    by simpa only [closure_Union, closure_eq (S _)] using this,
  refine (λ hx, closure_induction hx (λ _, mem_Union.1) _ _),
  { exact hι.elim (λ i, ⟨i, (S i).one_mem⟩) },
  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
    rcases hS i j with ⟨k, hki, hkj⟩,
    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩ }
end

@[to_additive]
lemma coe_supr_of_directed {ι} [nonempty ι] {S : ι → submonoid M} (hS : directed (≤) S) :
  ((⨆ i, S i : submonoid M) : set M) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

@[to_additive]
lemma mem_Sup_of_directed_on {S : set (submonoid M)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : M} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

@[to_additive]
lemma coe_Sup_of_directed_on {S : set (submonoid M)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set M) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

@[to_additive]
lemma mem_sup_left {S T : submonoid M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

@[to_additive]
lemma mem_sup_right {S T : submonoid M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

@[to_additive]
lemma mem_supr_of_mem {ι : Type*} {S : ι → submonoid M} (i : ι) :
  ∀ {x : M}, x ∈ S i → x ∈ supr S :=
show S i ≤ supr S, from le_supr _ _

@[to_additive]
lemma mem_Sup_of_mem {S : set (submonoid M)} {s : submonoid M}
  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

end non_assoc

end submonoid

namespace free_monoid

variables {α : Type*}

open submonoid

@[to_additive]
theorem closure_range_of : closure (set.range $ @of α) = ⊤ :=
eq_top_iff.2 $ λ x hx, free_monoid.rec_on x (one_mem _) $ λ x xs hxs,
  mul_mem _ (subset_closure $ set.mem_range_self _) hxs

end free_monoid

namespace submonoid

variables [monoid M]

open monoid_hom

lemma closure_singleton_eq (x : M) : closure ({x} : set M) = (powers_hom M x).mrange :=
closure_eq_of_le (set.singleton_subset_iff.2 ⟨multiplicative.of_add 1, pow_one x⟩) $
  λ x ⟨n, hn⟩, hn ▸ pow_mem _ (subset_closure $ set.mem_singleton _) _

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
lemma mem_closure_singleton {x y : M} : y ∈ closure ({x} : set M) ↔ ∃ n:ℕ, x^n=y :=
by rw [closure_singleton_eq, mem_mrange]; refl

lemma mem_closure_singleton_self {y : M} : y ∈ closure ({y} : set M) :=
mem_closure_singleton.2 ⟨1, pow_one y⟩

lemma closure_singleton_one : closure ({1} : set M) = ⊥ :=
by simp [eq_bot_iff_forall, mem_closure_singleton]

@[to_additive]
lemma closure_eq_mrange (s : set M) : closure s = (free_monoid.lift (coe : s → M)).mrange :=
by rw [mrange_eq_map, ← free_monoid.closure_range_of, map_mclosure, ← set.range_comp,
  free_monoid.lift_comp_of, subtype.range_coe]

@[to_additive]
lemma exists_list_of_mem_closure {s : set M} {x : M} (hx : x ∈ closure s) :
  ∃ (l : list M) (hl : ∀ y ∈ l, y ∈ s), l.prod = x :=
begin
  rw [closure_eq_mrange, mem_mrange] at hx,
  rcases hx with ⟨l, hx⟩,
  exact ⟨list.map coe l, λ y hy, let ⟨z, hz, hy⟩ := list.mem_map.1 hy in hy ▸ z.2, hx⟩
end

/-- The submonoid generated by an element. -/
def powers (n : M) : submonoid M :=
submonoid.copy (powers_hom M n).mrange (set.range ((^) n : ℕ → M)) $
set.ext (λ n, exists_congr $ λ i, by simp; refl)

@[simp] lemma mem_powers (n : M) : n ∈ powers n := ⟨1, pow_one _⟩

lemma powers_eq_closure (n : M) : powers n = closure {n} :=
by { ext, exact mem_closure_singleton.symm }

lemma powers_subset {n : M} {P : submonoid M} (h : n ∈ P) : powers n ≤ P :=
λ x hx, match x, hx with _, ⟨i, rfl⟩ := P.pow_mem h i end

end submonoid

namespace submonoid

variables {N : Type*} [comm_monoid N]

open monoid_hom

@[to_additive]
lemma sup_eq_range (s t : submonoid N) : s ⊔ t = (s.subtype.coprod t.subtype).mrange :=
by rw [mrange_eq_map, ← mrange_inl_sup_mrange_inr, map_sup, map_mrange, coprod_comp_inl,
  map_mrange, coprod_comp_inr, range_subtype, range_subtype]

@[to_additive]
lemma mem_sup {s t : submonoid N} {x : N} :
  x ∈ s ⊔ t ↔ ∃ (y ∈ s) (z ∈ t), y * z = x :=
by simp only [sup_eq_range, mem_mrange, coprod_apply, prod.exists, set_like.exists,
  coe_subtype, subtype.coe_mk]

end submonoid

namespace add_submonoid

variables [add_monoid A]

open set

lemma nsmul_mem (S : add_submonoid A) {x : A} (hx : x ∈ S) :
  ∀ n : ℕ, n • x ∈ S
| 0     := by { rw zero_nsmul, exact S.zero_mem }
| (n+1) := by { rw [add_nsmul, one_nsmul], exact S.add_mem (nsmul_mem n) hx }

lemma closure_singleton_eq (x : A) : closure ({x} : set A) = (multiples_hom A x).mrange :=
closure_eq_of_le (set.singleton_subset_iff.2 ⟨1, one_nsmul x⟩) $
  λ x ⟨n, hn⟩, hn ▸ nsmul_mem _ (subset_closure $ set.mem_singleton _) _

/-- The `add_submonoid` generated by an element of an `add_monoid` equals the set of
natural number multiples of the element. -/
lemma mem_closure_singleton {x y : A} :
  y ∈ closure ({x} : set A) ↔ ∃ n:ℕ, n • x = y :=
by rw [closure_singleton_eq, add_monoid_hom.mem_mrange]; refl

lemma closure_singleton_zero : closure ({0} : set A) = ⊥ :=
by simp [eq_bot_iff_forall, mem_closure_singleton, nsmul_zero]

/-- The additive submonoid generated by an element. -/
def multiples (x : A) : add_submonoid A :=
add_submonoid.copy (multiples_hom A x).mrange (set.range (λ i, nsmul i x : ℕ → A)) $
set.ext (λ n, exists_congr $ λ i, by simp; refl)

@[simp] lemma mem_multiples (x : A) : x ∈ multiples x := ⟨1, one_nsmul _⟩

lemma multiples_eq_closure (x : A) : multiples x = closure {x} :=
by { ext, exact mem_closure_singleton.symm }

lemma multiples_subset {x : A} {P : add_submonoid A} (h : x ∈ P) : multiples x ≤ P :=
λ x hx, match x, hx with _, ⟨i, rfl⟩ := P.nsmul_mem h i end

attribute [to_additive add_submonoid.multiples] submonoid.powers
attribute [to_additive add_submonoid.mem_multiples] submonoid.mem_powers
attribute [to_additive add_submonoid.multiples_eq_closure] submonoid.powers_eq_closure
attribute [to_additive add_submonoid.multiples_subset] submonoid.powers_subset

end add_submonoid

/-! Lemmas about additive closures of `submonoid`. -/
namespace submonoid

variables {R : Type*} [semiring R] (S : submonoid R) {a b : R}

/-- The product of an element of the additive closure of a multiplicative submonoid `M`
and an element of `M` is contained in the additive closure of `M`. -/
lemma mul_right_mem_add_closure
  (ha : a ∈ add_submonoid.closure (S : set R)) (hb : b ∈ S) :
  a * b ∈ add_submonoid.closure (S : set R) :=
begin
  revert b,
  refine add_submonoid.closure_induction ha _ _ _; clear ha a,
  { exact λ r hr b hb, add_submonoid.mem_closure.mpr (λ y hy, hy (S.mul_mem hr hb)) },
  { exact λ b hb, by simp only [zero_mul, (add_submonoid.closure (S : set R)).zero_mem] },
  { simp_rw add_mul,
    exact λ r s hr hs b hb, (add_submonoid.closure (S : set R)).add_mem (hr hb) (hs hb) }
end

/-- The product of two elements of the additive closure of a submonoid `M` is an element of the
additive closure of `M`. -/
lemma mul_mem_add_closure
  (ha : a ∈ add_submonoid.closure (S : set R)) (hb : b ∈ add_submonoid.closure (S : set R)) :
  a * b ∈ add_submonoid.closure (S : set R) :=
begin
  revert a,
  refine add_submonoid.closure_induction hb _ _ _; clear hb b,
  { exact λ r hr b hb, S.mul_right_mem_add_closure hb hr },
  { exact λ b hb, by simp only [mul_zero, (add_submonoid.closure (S : set R)).zero_mem] },
  { simp_rw mul_add,
    exact λ r s hr hs b hb, (add_submonoid.closure (S : set R)).add_mem (hr hb) (hs hb) }
end

/-- The product of an element of `S` and an element of the additive closure of a multiplicative
submonoid `S` is contained in the additive closure of `S`. -/
lemma mul_left_mem_add_closure (ha : a ∈ S) (hb : b ∈ add_submonoid.closure (S : set R)) :
  a * b ∈ add_submonoid.closure (S : set R) :=
S.mul_mem_add_closure (add_submonoid.mem_closure.mpr (λ sT hT, hT ha)) hb

@[to_additive]
lemma mem_closure_inv {G : Type*} [group G] (S : set G) (x : G) :
  x ∈ submonoid.closure S⁻¹ ↔ x⁻¹ ∈ submonoid.closure S :=
begin
  suffices : ∀ (S : set G) (x : G), x ∈ submonoid.closure S⁻¹ → x⁻¹ ∈ submonoid.closure S,
  { refine ⟨this S x, _⟩,
    have := this S⁻¹ x⁻¹,
    rw [inv_inv, set.inv_inv] at this,
    exact this, },
  intros S x hx,
  refine submonoid.closure_induction hx (λ x hx, _) _ (λ x y hx hy, _),
  { exact submonoid.subset_closure (set.mem_inv.mp hx), },
  { rw one_inv,
    exact submonoid.one_mem _ },
  { rw mul_inv_rev x y,
    exact submonoid.mul_mem _ hy hx },
end

end submonoid

section mul_add

lemma of_mul_image_powers_eq_multiples_of_mul [monoid M] {x : M} :
  additive.of_mul '' ((submonoid.powers x) : set M) = add_submonoid.multiples (additive.of_mul x) :=
begin
  ext,
  split,
  { rintros ⟨y, ⟨n, hy1⟩, hy2⟩,
    use n,
    simpa [← of_mul_pow, hy1] },
  { rintros ⟨n, hn⟩,
    refine ⟨x ^ n, ⟨n, rfl⟩, _⟩,
    rwa of_mul_pow }
end

lemma of_add_image_multiples_eq_powers_of_add [add_monoid A] {x : A} :
  multiplicative.of_add '' ((add_submonoid.multiples x) : set A) =
  submonoid.powers (multiplicative.of_add x) :=
begin
  symmetry,
  rw equiv.eq_image_iff_symm_image_eq,
  exact of_mul_image_powers_eq_multiples_of_mul,
end

end mul_add


universe u

namespace or

  section

    parameters { p q r : Prop }

    lemma right_neutral
      {p : Prop} : p ∨ false ↔ p
    :=
      begin
        split,
        show p → p ∨ false, from or.intro_left false,
        show p ∨ false → p, by {
          assume : p ∨ false,
          cases this,
            case or.inl {from ‹p›},
            case or.inr {by {exfalso, assumption}}
        },
        done
      end

    lemma idempotent
      { p : Prop } : p ∨ p ↔ p
    :=
      begin
        split,
        show p → p ∨ p, by {assume : p, from or.inl ‹p›},
        show p ∨ p → p,
          by {
            assume : p ∨ p,
            cases this,
              case or.inl {from ‹p›},
              case or.inr {from ‹p›}
          },
          done
      end

    lemma equiv_left
      { p q r : Prop } : (p ↔ q) → (p ∨ r ↔ q ∨ r)
    :=
      begin
        assume : p ↔ q,
        split,
        show p ∨ r → q ∨ r,
          by {
            assume : p ∨ r,
            cases this,
              case or.inl {from or.inl (iff.elim_left ‹p ↔ q› ‹p›)},
              case or.inr {from or.inr ‹r›},
          },
        show q ∨ r → p ∨ r,
          by {
            assume : q ∨ r,
            cases this,
              case or.inl {from or.inl (iff.elim_right ‹p ↔ q› ‹q›)},
              case or.inr {from or.inr ‹r›},
          },
        done
      end

  end

end or

section

  parameters (α : Type u) (x y : α)

  theorem mem_insert
    {s : set α} : set.mem x (set.insert x s)
  :=
    begin
      -- change (set.mem x ({ a | a = x ∨ a ∈ s})),
      -- change (({ a | a = x ∨ a ∈ s}) x),
      -- change (x = x ∨ x ∈ s),
      -- Lean gets here by itself
      left,
      refl,
      done
    end
  -- an alternative (more natural/readable?) proof of mem_insert
  example
    {s : set α} : set.mem x (set.insert x s)
  :=
    begin
      have : x = x, by trivial, -- specifically, by refl
      have : x = x ∨ x ∈ s, by {left, from this},
                                --from or.intro_left (x ∈ s) this,
      -- have : ({ a | a = x ∨ a ∈ s}) x, from this,
      -- have : set.mem x ({ a | a = x ∨ a ∈ s }), from this,
      -- Lean doesn't need these intermediate steps
      show set.mem x ({ a | a = x ∨ a ∈ s }), from this,
      -- show set.mem x (set.insert x s), from this,
      done
    end

  theorem singleton_set_mem :
    x ∈ ({ x } : set α)
  :=
    begin
      -- change (set.mem x (set.insert x ∅)),
      -- Lean automatically translates the notation x ∈ { x }
      apply mem_insert,
      done
    end
  -- So, it is just an application of mem_insert
  example :
    x ∈ ({ x } : set α)
  :=
    by apply mem_insert
  -- Forward proof of singleton_set_mem
  example :
    x ∈ ({ x } : set α)
  :=
    begin
      have : set.mem x (set.insert x ∅), by apply mem_insert,
      show set.mem x ({ x }), from this,
      done
    end

  theorem set_swap
    {s : set α} {x y : α}
      : set.insert x (set.insert y s) = set.insert y (set.insert x s)
  :=
    calc
      { a | a = x ∨ a = y ∨ a ∈ s } = { a | a = y ∨ a = x ∨ a ∈ s }
        : by {congr, funext, from propext or.left_comm}
  -- Trying to do a more explicit calculational proof
  example
    {s : set α} {x y : α}
      : set.insert x (set.insert y s) = set.insert y (set.insert x s)
  :=
      -- Note, refl is the tactic that checks definitional equality
      calc
        set.insert x (set.insert y s)
          -- Don't need these intermediate steps
          --     = { a | a = x ∨ a ∈ (set.insert y s)}
          --         : by refl
          -- ... = { a | a = x ∨ a ∈ { b | b = y ∨ b ∈ s}}
          --         : by refl
          -- ...
              = { a | a = x ∨ a = y ∨ a ∈ s }
                  : by refl

          -- The key step
          ... = { a | a = y ∨ a = x ∨ a ∈ s }
                -- This is really set_of (λ a, a = y ∨ a = x ∨ a ∈ s)
                  : by {congr, funext, from propext or.left_comm}

          -- Again, we don't need these intermediate steps
          -- ... = { a | a = y ∨ a ∈ { b | b = x ∨ b ∈ s}}
          --         : by refl
          -- ... = { a | a = y ∨ a ∈ (set.insert x s)}
          --         : by refl

          -- And Lean can even fill in the second half of the calculation
          -- automatically.
          ... = set.insert y (set.insert x s)
                  : by refl
  -- 'Explicit' proof of set_swap
  example
    {s : set α} {x y : α}
      : set.insert x (set.insert y s) = set.insert y (set.insert x s)
  :=
    begin
      have _1 : set.insert x (set.insert y s) = { a | a = x ∨ a = y ∨ a ∈ s },
        by refl,
      have _2 : { a | a = y ∨ a = x ∨ a ∈ s } = set.insert y (set.insert x s),
        by refl,
      have _3 : { a | a = x ∨ a = y ∨ a ∈ s } = { a | a = y ∨ a = x ∨ a ∈ s },
        by {congr, funext, from propext or.left_comm},

      -- Here, we can just tell Lean to use facts in the context, and it
      -- fills in the necessary chaining of equalities:

      -- show set.insert x (set.insert y s) = set.insert y (set.insert x s),
      --   by {assumption},

      -- We can also use the tactic language to manipulate the goal and
      -- apply facts one at a time:

      -- show set.insert x (set.insert y s) = set.insert y (set.insert x s),
      --   by {transitivity, assumption, transitivity, exact this, assumption},

      -- But although this makes it clear which reasoning principles are being
      -- used, it isn't at all obvious how these are applied.

      -- Maybe this is better?:
      show set.insert x (set.insert y s) = set.insert y (set.insert x s),
        -- from eq.trans (eq.trans _1 _3) _2,
        from eq.trans
              (eq.trans
                ‹set.insert x (set.insert y s) = { a | a = x ∨ a = y ∨ a ∈ s }›
                ‹{ a | a = x ∨ a = y ∨ a ∈ s } = { a | a = y ∨ a = x ∨ a ∈ s }›)
                ‹{ a | a = y ∨ a = x ∨ a ∈ s } = set.insert y (set.insert x s)›,

      done
    end

  -- The set notation { x₁, ..., xₙ } is short-hand for
  --   fold_left set.insert ∅ [x₁, ..., xₙ]
  -- So, {x, y} = fold_left set.insert ∅ [x, y] = set.insert y (set.insert x ∅)
  example :
    ({x, y} : set α) = set.insert x {y}
  :=
    by apply set_swap

  theorem set_eq_iff_subsets
    {s₁ s₂ : set α} : s₁ = s₂ ↔ s₁ ⊆ s₂ ∧ s₂ ⊆ s₁
  :=
    begin
      split, -- split bi-implication into individual implications

      -- show left-to-right
      show s₁ = s₂ → s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, by {
        assume : s₁ = s₂,
        split, -- show the two conjuncts individually

        show s₁ ⊆ s₂,
        suffices : ∀ x, x ∈ s₁ → x ∈ s₂, from this, by {
          intros,
          show x ∈ s₂, from eq.subst ‹s₁ = s₂› ‹x ∈ s₁›,
        },

        show s₂ ⊆ s₁,
        suffices : ∀ x, x ∈ s₂ → x ∈ s₁, from this, by {
          intros,
          show x ∈ s₁, from eq.subst (eq.symm ‹s₁ = s₂›) ‹x ∈ s₂›,
        },

        done
      },

      -- show right-to-left
      show s₁ ⊆ s₂ ∧ s₂ ⊆ s₁ → s₁ = s₂, by {
        assume : s₁ ⊆ s₂ ∧ s₂ ⊆ s₁,
        have : s₁ ⊆ s₂, from and.left ‹s₁ ⊆ s₂ ∧ s₂ ⊆ s₁›,
        have : s₂ ⊆ s₁, from and.right ‹s₁ ⊆ s₂ ∧ s₂ ⊆ s₁›,

        have : ∀ x, x ∈ s₁ ↔ x ∈ s₂, by {
          assume x,
          split,
          show x ∈ s₁ → x ∈ s₂,
            by {assume : x ∈ s₁, show x ∈ s₂, from ‹s₁ ⊆ s₂› this},
          show x ∈ s₂ → x ∈ s₁,
            by {assume : x ∈ s₂, show x ∈ s₁, from ‹s₂ ⊆ s₁› this},
          done
        },

        show s₁ = s₂,
        suffices : ∀ (x : α), (x ∈ s₁) = (x ∈ s₂),
          from funext this,
        by {
          assume x,
          have : x ∈ s₁ ↔ x ∈ s₂, from ‹∀ x, x ∈ s₁ ↔ x ∈ s₂› x,
          show (x ∈ s₁) = (x ∈ s₂), from propext this,
          done
        },

        done
      },

      -- and we are done
      done
    end

  lemma set_eq_imp_subset_left
    {s₁ s₂ : set α} : s₁ = s₂ → s₁ ⊆ s₂
  :=
    λ eq, and.left (iff.elim_left (set_eq_iff_subsets) eq)
  -- Explicit proof
  example
    {s₁ s₂ : set α} : s₁ = s₂ → s₁ ⊆ s₂
  :=
    begin
      intros,
      have : s₁ = s₂ ↔ s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, from set_eq_iff_subsets,
      have : s₁ = s₂ → s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, from iff.elim_left this,
      have : s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, from this ‹s₁ = s₂›,
      show s₁ ⊆ s₂, from and.elim_left this,
      done
    end

  lemma set_eq_imp_subset_right
    {s₁ s₂ : set α} : s₁ = s₂ → s₂ ⊆ s₁
  :=
    λ eq, and.right (iff.elim_left (set_eq_iff_subsets) eq)
  -- Explicit proof
  example
    {s₁ s₂ : set α} : s₁ = s₂ → s₂ ⊆ s₁
  :=
    begin
      intros,
      have : s₁ = s₂ ↔ s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, from set_eq_iff_subsets,
      have : s₁ = s₂ → s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, from iff.elim_left this,
      have : s₁ ⊆ s₂ ∧ s₂ ⊆ s₁, from this ‹s₁ = s₂›,
      show s₂ ⊆ s₁, from and.elim_right this,
      done
    end

  -- s₁ ⊆ s₂ is notation for set.subset s₁ s₂, which is definitionally equal to
  --   ∀ ⦃x⦄, x ∈ s₁ → x ∈ s₂
  -- so we can directly derive (a witness for) x ∈ s₂ by passing (a witness for)
  -- x ∈ s₁ to (a witness for) s₁ ⊆ s₂, with Lean automatically instantiating
  -- the universal quantifier
  example
    (s₁ s₂ : set α) (x : α) : s₁ ⊆ s₂ → x ∈ s₁ → x ∈ s₂
  :=
    begin
      intros,
      show x ∈ s₂, from ‹s₁ ⊆ s₂› ‹x ∈ s₁›,
      done
    end
  -- We can make the definition of ⊆ and the instantiation of the universal
  -- quantifier explicit.
  example
    (s₁ s₂ : set α) (x : α) : s₁ ⊆ s₂ → x ∈ s₁ → x ∈ s₂
  :=
    begin
      assume : s₁ ⊆ s₂, assume : x ∈ s₁,
      have : ∀ y, y ∈ s₁ → y ∈ s₂, from ‹s₁ ⊆ s₂›,
      have : x ∈ s₁ → x ∈ s₂, from this x,
      show x ∈ s₂, from this ‹x ∈ s₁›,
      done
    end

  lemma set_eq_imp_mem_preserve
    {s₁ s₂ : set α} {x : α} : s₁ = s₂ → x ∈ s₁ → x ∈ s₂
  :=
    begin
      intros,
      have : s₁ ⊆ s₂, from set_eq_imp_subset_left ‹s₁ = s₂›,
      show x ∈ s₂, from ‹s₁ ⊆ s₂› ‹x ∈ s₁›,
      done
    end

  lemma singleton_set_case_split
    {x y : α} : y ∈ ({x} : set α) → y = x
  :=
    begin
      intros,
      have : { x } = { y | y = x }, by
        calc
          { x }
             -- = { y | y = x ∨ y ∈ ∅ } : by refl ...
                = { y | y = x ∨ false }
                    : by refl
            ... = { y | y = x }
                    : by {congr, funext, from propext or.right_neutral},

      have : y ∈ { y | y = x },
        from set_eq_imp_mem_preserve this ‹y ∈ {x}›,
      show y = x, from this,
      done
    end

  lemma two_element_set_case_split
    {x y z : α} : z ∈ ({x, y} : set α) → z = x ∨ z = y
  :=
    begin

      have : {x, y} = { b | b = x ∨ b = y },
        by calc
          {x, y}
            --  = { b | b = y ∨ b = x ∨ b ∈ ∅ } : by refl ...
                = { b | b = y ∨ b = x ∨ false }  : by refl
            ... = { b | (b = y ∨ b = x) ∨ false }
                    : by {congr, funext, from eq.symm (propext or.assoc)}
            ... = { b | b = y ∨ b = x }
                    : by {congr, funext, from propext or.right_neutral}
            ... = { b | b = x ∨ b = y}
                    : by {congr, funext, from propext or.comm},

      assume : z ∈ {x, y},

      have : z ∈ { b | b = x ∨ b = y },
        from set_eq_imp_mem_preserve ‹{x, y} = { b | b = x ∨ b = y }› this,

      show z = x ∨ z = y, from this,

      done

    end

  lemma remove_duplicates
    { s : set α } { x : α } : set.insert x (set.insert x s) = set.insert x s
  :=
    by calc
      set.insert x (set.insert x s)
           = { z | z = x ∨ z = x ∨ z ∈ s } : by refl
       ... = { z | (z = x ∨ z = x) ∨ z ∈ s }
                : by {congr, funext, from eq.symm (propext or.assoc)}
       ... = { z | z = x ∨ z ∈ s }
                : by {congr, funext, from propext (or.equiv_left or.idempotent)}
       ... = set.insert x s : by refl

  lemma duplicate_to_singleton
    { x : α } : {x, x} = ({x} : set α)
  := by apply remove_duplicates

end

section

  parameters (α : Type u) (a₁ a₂ : α) (b₁ b₂ : α)

  -- The set-theoretic encoding of ordered pairs
  def pair (x y : α) : set (set α) := {{x}, {x, y}}

  -- Two arbitrary ordered pairs
  def A := pair a₁ a₂
  def B := pair b₁ b₂

  -- Soundness
  -- If the elements are (pairwise) equal, then the ordered pairs are equal.
  theorem soundness :
    a₁ = b₁ ∧ a₂ = b₂ → A = B
  :=
    begin
      assume : a₁ = b₁ ∧ a₂ = b₂,
      have : a₁ = b₁, by {apply and.elim_left, assumption},
      have : a₂ = b₂, by {apply and.elim_right, assumption},
      calc
        A     = {{a₁}, {a₁, a₂}}
                  : by refl
          ... = {{b₁}, {b₁, b₂}}
                  : by {congr,
                        -- Only need this proposition once
                        from ‹a₂ = b₂›,
                        -- But we need this one twice
                        repeat {from ‹a₁ = b₁›}}
          ... = B : by refl
    end

  -- For adequcy, we will need the following collapsing lemma
  lemma collapse
    { x y : α } : x = y → ({{x}, {x, y}} : set (set α)) = {{y}}
  :=
    begin
      assume : x = y,
      calc
        ({{x}, {x, y}} : set (set α))
              = {{y}, {y, y}} : by {apply eq.subst ‹x = y›, refl}
          ... = set.insert {y, y} ({{y}}) : by refl
          ... = set.insert {y} ({{y}})
                  : (congr_fun
                      (congr_arg set.insert (duplicate_to_singleton α)))
                      {{y}}
          ... = {{y}, {y}} : by refl
          ... = {{y}} : by apply duplicate_to_singleton,
    end

  -- Adequacy
  -- If the order pairs are equal, then the elements are (pairwise) equal.
  theorem adequacy :
    A = B → a₁ = b₁ ∧ a₂ = b₂
  :=
    begin
      assume : A = B,

      -- It doesn't matter in which order we enumerate the elements of sets
      have : ({{a₁}, {a₁, a₂}} : set (set α)) = {{a₁, a₂}, {a₁}},
        by apply set_swap,
      have : ({{b₁}, {b₁, b₂}} : set (set α)) = {{b₁, b₂}, {b₁}},
        by apply set_swap,
      have : ({a₁, a₂} : set α) = {a₂, a₁},
        by apply set_swap,
      have : ({b₁, b₂} : set α) = {b₂, b₁},
        by apply set_swap,

      -- We derive some basic facts about (the members of) the members of A
      have : A = {{a₁}, {a₁, a₂}}, by refl,

      have : {a₁} ∈ A, by {
        -- since {a₁} ∈ {{a₁, a₂}, {a₁}}, as A = {{a₁, a₂}, {a₁}},
        apply eq.substr
          (eq.trans ‹A = {{a₁}, {a₁, a₂}}›
                        ‹{{a₁}, {a₁, a₂}} = {{a₁, a₂}, {a₁}}›),
        -- using the mem_insert lemma
        apply mem_insert,
        done
      },

      have : {a₁, a₂} ∈ A, by {
        apply eq.substr ‹A = {{a₁}, {a₁, a₂}}›,
        apply mem_insert,
        done
      },

      have : a₁ ∈ {a₁, a₂}, by {
        apply eq.substr ‹{a₁, a₂} = {a₂, a₁}›,
        apply mem_insert,
        done
      },

        -- We need the set α type ascription here
      have : a₂ ∈ ({a₁, a₂} : set α), by apply mem_insert,

      -- We derive some basic facts about (the members of) the members of B
      have : B = {{b₁}, {b₁, b₂}}, by refl,

      have : {b₁} ∈ B, by {
        -- since {b₁} ∈ {{b₁, b₂}, {b₁}}, as B = {{b₁, b₂}, {b₁}},
        apply eq.substr
          (eq.trans ‹B = {{b₁}, {b₁, b₂}}›
                        ‹{{b₁}, {b₁, b₂}} = {{b₁, b₂}, {b₁}}›),
        -- using the mem_insert lemma
        apply mem_insert,
        done
      },

      have : {b₁, b₂} ∈ B, by {
        apply eq.substr ‹B = {{b₁}, {b₁, b₂}}›,
        apply mem_insert,
      },

      have : b₁ ∈ {b₁, b₂}, by {
        apply eq.substr ‹{b₁, b₂} = {b₂, b₁}›,
        apply mem_insert,
        done
      },

        -- We need the set α type ascription here
      have : b₂ ∈ ({b₁, b₂} : set α), by apply mem_insert,

      -- Since A = B, A and B are subsets of one another
      have : A ⊆ B, by {apply set_eq_imp_subset_left, from ‹A = B›},
      have : B ⊆ A, by {apply set_eq_imp_subset_right, from ‹A = B›},

      -- Therefore
      have : {a₁} ∈ B, from ‹A ⊆ B› ‹{a₁} ∈ A›,
      have : {a₁} ∈ {{b₁}, {b₁, b₂}},
        by {apply eq.subst ‹B = {{b₁}, {b₁, b₂}}›, from this},

      -- Now there are two possibilities
      cases two_element_set_case_split (set α) this,

      -- the case that {a₁} = {b₁}
      case or.inl {
        have : a₁ ∈ {a₁}, by apply singleton_set_mem,
        have : a₁ ∈ ({b₁} : set α),
          by {apply set_eq_imp_mem_preserve α ‹{a₁} = {b₁}›, from this},
        have : a₁ = b₁, by {apply singleton_set_case_split, from this},

        -- We have to show both a₁ = b₁ and a₂ = b₂
        split,
        -- We already have the left-hand conjunct
        show a₁ = b₁, from this,

        have : {a₁, a₂} ∈ {{b₁}, {b₁, b₂}},
          by {apply eq.subst ‹B = {{b₁}, {b₁, b₂}}›,
                from ‹A ⊆ B› ‹{a₁, a₂} ∈ A›},

        cases two_element_set_case_split (set α) this,

        -- The case that {a₁, a₂} = {b₁}
        case or.inl {
          have : a₂ = b₁,
            by {
              apply singleton_set_case_split,
              apply set_eq_imp_mem_preserve α ‹{a₁, a₂} = {b₁}›,
              from ‹a₂ ∈ {a₁, a₂}›
            },
          have : a₁ = a₂, from eq.trans ‹a₁ = b₁› (eq.symm this),
          have : A = {{a₂}},
            by calc
              A     = {{a₁}, {a₁, a₂}} : by refl
                ... = {{a₂}} : by {apply collapse, from this},
          have : {b₁, b₂} = {a₂},
            by {
              -- since {b₁, b₂} ∈ {{a₂}}
              apply singleton_set_case_split,
              -- since A = {{a₂}}
              apply eq.subst this,
              -- and {b₁, b₂} ∈ B and B ⊆ A
              from ‹B ⊆ A› ‹{b₁, b₂} ∈ B›,
            },
          have : b₂ = a₂,
            by {
              -- since b₂ in {a₂}
              apply singleton_set_case_split,
              -- since we have just shown {b₁, b₂} = {a₂}
              apply set_eq_imp_mem_preserve α this,
              -- and also we have that b₂ ∈ {b₁, b₂}
              from ‹b₂ ∈ {b₁, b₂}›
            },
          -- Thus we have the right-hand conjunct
          show a₂ = b₂, by {symmetry, from this},
          done
        },

        -- The case that {a₁, a₂} = {b₁, b₂}
        case or.inr {
          have : {b₁, b₂} = {a₁, a₂}, by {symmetry, from ‹{a₁, a₂} = {b₁, b₂}›},
          have : b₂ ∈ {a₁, a₂},
            by {apply set_eq_imp_mem_preserve, from this, from ‹b₂ ∈ {b₁, b₂}›},
          -- Now, again, we have two further cases
          cases two_element_set_case_split α this,
            -- The case that b₂ = a₁
            case or.inl {
              have : b₁ = b₂,
                from eq.trans (eq.symm ‹a₁ = b₁›) (eq.symm ‹b₂ = a₁›),
              have : {a₁, a₂} = {b₂},
                by calc
                  {a₁, a₂} = {b₁, b₂} : by assumption
                       ... = {b₂, b₂} : by {apply eq.subst ‹b₁ = b₂›, refl}
                       ... = {b₂}     : by {apply remove_duplicates},
              -- Therefore, we can show the right-hand conjunct
              show a₂ = b₂,
                by {
                  -- since a₂ ∈ {b₂}
                  apply singleton_set_case_split,
                  -- since we have just show that {a₁, a₂} = {b₂}
                  apply set_eq_imp_mem_preserve α this,
                  -- and also we have a₂ ∈ {a₁, a₂}
                  from ‹a₂ ∈ {a₁, a₂}›,
                },
                done
            },
            -- The case that b₂ = a₂
            case or.inr {
              -- immediate
              show a₂ = b₂, by {symmetry, from ‹b₂ = a₂›}, done
            },
           done
        },

        done
      },

      -- the case that {a₁} = {b₁, b₂}
      case or.inr {
        have : ({b₁, b₂} : set α) ⊆ {a₁},
          by {apply set_eq_imp_subset_right, from ‹{a₁} = {b₁, b₂}›},
        have : b₁ ∈ {a₁},
          by {apply set_eq_imp_subset_left,
              from eq.symm ‹{a₁} = {b₁, b₂}›, from ‹b₁ ∈ {b₁, b₂}›},
        have : b₁ = a₁,
          by {apply singleton_set_case_split, from this},

        -- We have to show both a₁ = b₁ and a₂ = b₂
        split,
        -- We already have the left-hand conjunct
        show a₁ = b₁, by {symmetry, from this},

        -- Now for the right-hand conjunct
        have : b₂ ∈ {a₁},
          by {apply set_eq_imp_subset_left,
              from eq.symm ‹{a₁} = {b₁, b₂}›, from ‹b₂ ∈ {b₁, b₂}›},
        have : a₁ = b₂,
          by {symmetry, apply singleton_set_case_split, from this},
        have : b₁ = b₂, by {transitivity, from ‹b₁ = a₁›, from ‹a₁ = b₂›},
        have : B = {{b₂}},
          by calc
            B     = {{b₁}, {b₁, b₂}} : by refl
              ... = {{b₂}} : by {apply collapse, from this},
        have : {a₁, a₂} ∈ B,
          by {apply set_eq_imp_mem_preserve, from ‹A = B›, from ‹{a₁, a₂} ∈ A›},
        have : {a₁, a₂} ∈ {{b₂}}, by {apply eq.subst ‹B = {{b₂}}›, from this},
        have : {a₁, a₂} = {b₂}, by {apply singleton_set_case_split, from this},
        have : {a₁, a₂} ⊆ ({b₂} : set α),
          by {apply set_eq_imp_subset_left, from this},
        have : a₂ ∈ {b₂}, from this ‹a₂ ∈ {a₁, a₂}›,

        -- This gives the right-hand conjunct
        show a₂ = b₂, by {apply singleton_set_case_split, from this},
        done
      },

      done

    end

end


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Floris van Doorn, Jeremy Avigad
Distance function on the natural numbers.
-/
import data.nat.basic

namespace nat

/- distance -/

/-- Distance (absolute value of difference) between natural numbers. -/
def dist (n m : ℕ) := (n - m) + (m - n)

theorem dist.def (n m : ℕ) : dist n m = (n - m) + (m - n) := rfl

@[simp] theorem dist_comm (n m : ℕ) : dist n m = dist m n :=
by simp [dist.def]

@[simp] theorem dist_self (n : ℕ) : dist n n = 0 :=
by simp [dist.def, nat.sub_self]

theorem eq_of_dist_eq_zero {n m : ℕ} (h : dist n m = 0) : n = m :=
have n - m = 0, from eq_zero_of_add_eq_zero_right h,
have n ≤ m, from nat.le_of_sub_eq_zero this,
have m - n = 0, from eq_zero_of_add_eq_zero_left h,
have m ≤ n, from nat.le_of_sub_eq_zero this,
le_antisymm ‹n ≤ m› ‹m ≤ n›

theorem dist_eq_zero {n m : ℕ} (h : n = m) : dist n m = 0 :=
begin rw [h, dist_self] end

theorem dist_eq_sub_of_ge {n m : ℕ} (h : n ≥ m) : dist n m = n - m :=
begin rw [dist_comm], apply dist_eq_sub_of_le h end

theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
eq.trans (dist_eq_sub_of_ge (zero_le n)) (nat.sub_zero n)

theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
eq.trans (dist_eq_sub_of_le (zero_le n)) (nat.sub_zero n)

theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
calc
  dist (n + k) (m + k) = ((n + k) - (m + k)) + ((m + k)-(n + k)) : rfl
                   ... = (n - m) + ((m + k) - (n + k))   : by rw nat.add_sub_add_right
                   ... = (n - m) + (m - n)               : by rw nat.add_sub_add_right

theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m :=
begin rw [add_comm k n, add_comm k m], apply dist_add_add_right end

theorem dist_eq_intro {n m k l : ℕ} (h : n + m = k + l) : dist n k = dist l m :=
calc
  dist n k = dist (n + m) (k + m) : by rw dist_add_add_right
       ... = dist (k + l) (k + m) : by rw h
       ... = dist l m             : by rw dist_add_add_left

protected theorem sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) :=
or.elim (le_total k m)
  (assume : k ≤ m,
    begin rw ←nat.add_sub_assoc this, apply nat.sub_le_sub_right, apply nat.le_sub_add end)
  (assume : k ≥ m,
    begin rw [sub_eq_zero_of_le this, add_zero], apply nat.sub_le_sub_left, exact this end)

theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
have dist n m + dist m k = (n - m) + (m - k) + ((k - m) + (m - n)), by simp [dist.def],
begin
  rw [this, dist.def], apply add_le_add, repeat { apply nat.sub_lt_sub_add_sub }
end

theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k :=
by rw [dist.def, dist.def, right_distrib, nat.mul_sub_right_distrib, nat.mul_sub_right_distrib]

theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m :=
by rw [mul_comm k n, mul_comm k m, dist_mul_right, mul_comm]

-- TODO(Jeremy): do when we have max and minx
--theorem dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
--sorry
/-
or.elim (lt_or_ge i j)
  (assume : i < j,
    by rw [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (assume : i ≥ j,
    by rw [max_eq_left this , min_eq_right this, dist_eq_sub_of_ge this])
-/

theorem dist_succ_succ {i j : nat} : dist (succ i) (succ j) = dist i j :=
by simp [dist.def, succ_sub_succ]

theorem dist_pos_of_ne {i j : nat} : i ≠ j → dist i j > 0 :=
assume hne, nat.lt_by_cases
  (assume : i < j,
     begin rw [dist_eq_sub_of_le (le_of_lt this)], apply nat.sub_pos_of_lt this end)
  (assume : i = j, by contradiction)
  (assume : i > j,
     begin rw [dist_eq_sub_of_ge (le_of_lt this)], apply nat.sub_pos_of_lt this end)

end nat


import tactic
import data.real.basic

section

variables {A : Type}
variables {R : A → A → Prop}

theorem represents : (∃ f : A → ℝ, ∀ x , ∀ y, f y ≤ f x ↔ R x y) → transitive R ∧ total R :=
begin
  intro h,
  cases h with f rep,
  split,
  {
    rw [transitive],
    intros x y z,
    have repxy : f y ≤ f x ↔ R x y, from rep x y,
    have repyz : f z ≤ f y ↔ R y z, from rep y z,
    have repxz : f z ≤ f x ↔ R x z, from rep x z,
    cases repxy with fxfyRxy Rxyfxfy,
    cases repyz with fyfzRyz Ryzfyfz,
    cases repxz with fxfzRxz Rxzfxfz,
    have trnsF : f z ≤ f y → f y ≤ f x → f z ≤ f x , from le_trans,
    tauto,
  },
  {
    rw [total],
    intro x,
    intro y,
    have repxy : f y ≤ f x ↔ R x y, from rep x y,
    have repyx : f x ≤ f y ↔ R y x, from rep y x,
    cases repxy with fxfyRxy Rxyfxfy,
    cases repyx with fyfxRyx Ryxfyfx,
    have compF : f y ≤ f x ∨ f x ≤ f y, from le_total (f y) (f x),
    tauto,
   },
end
end


import algebra.group_power algebra.big_operators data.nat.choose
local infix ` ^ ` := monoid.pow
open finset nat
variable {α : Type*}

local notation f ` ∑ ` : 90 n : 90  := finset.sum (finset.range n) f

lemma sum_range_succ [add_comm_monoid α] (f : ℕ → α) (n : ℕ) : f ∑ succ n = f n + f ∑ n :=
have h : n ∉ finset.range n := by rw finset.mem_range; exact lt_irrefl _,
by rw [finset.range_succ, finset.sum_insert h]

lemma sum_range_succ' [add_comm_monoid α] (f : ℕ → α) :
    ∀ n : ℕ, f ∑ succ n = (λ m, f (succ m)) ∑ n + f 0
| 0        := by simp
| (succ n) := by rw [sum_range_succ (λ m, f (succ m)), add_assoc, ← sum_range_succ'];
                 exact sum_range_succ _ _

theorem add_pow [comm_semiring α] (x y : α) : ∀ n : ℕ,
    (x + y)^n = (λ m, x^m * y^(n - m) * choose n m) ∑ succ n
| 0        := by simp
| (succ n) :=
have h₁ : x * (x^n * y^(n - n) * choose n n) = x^succ n * y^(succ n - succ n)
    * choose (succ n) (succ n) :=
  by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
have  h₂ : y * (x^0 * y^(n - 0) * choose n 0) = x^0 * y^(succ n - 0) * choose (succ n) 0 :=
  by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
have h₃ : (λ m, x * (x^m * y^(n - m) * choose n m) + y * (x^succ m * y^(n - succ m)
    * choose n (succ m))) ∑ n
    = (λ m, x^succ m * y^(succ n - succ m) * ↑(choose (succ n) (succ m))) ∑ n :=
  finset.sum_congr rfl $ λ m hm, begin
      rw finset.mem_range at hm,
      rw [← mul_assoc y, ← mul_assoc y, mul_right_comm y, ← _root_.pow_succ, add_one, ← succ_sub hm],
      simp [succ_sub_succ, _root_.pow_succ, choose_succ_succ, mul_add, mul_comm,
          mul_assoc, mul_left_comm]
    end,
by rw [_root_.pow_succ, add_pow, add_mul, finset.mul_sum, finset.mul_sum, sum_range_succ, sum_range_succ',
    sum_range_succ, sum_range_succ', add_assoc, ← add_assoc (_ ∑ n), ← finset.sum_add_distrib, h₁, h₂, h₃]

theorem missing [comm_semiring α] (n : ℕ) (f : ℕ → α) (e : ℕ → ℕ) (r : ℕ → α)
    (s : α) : (∀ i : ℕ, i ≤ n → (f i) ^ (e i) * s = 0) →
    (sum (range (succ n)) (λ i, f i * r i)) ^ (sum (range (succ n)) e) * s = 0 :=
nat.rec_on n (λ h, by simp [mul_pow, mul_right_comm, h 0 (le_refl _)])
$ λ n hi h, begin
  rw [sum_range_succ, add_pow, sum_mul, ← @sum_const_zero _ _ (range (succ (e ∑ succ (succ n))))],
  refine finset.sum_congr rfl (λ m hm, _),
  cases le_total m (e (succ n)) with hm' hm',
  { rw [sum_range_succ e, add_comm (e _), nat.add_sub_assoc hm', _root_.pow_add],
    simp only [mul_assoc, mul_left_comm ((λ (i : ℕ), f i * r i) ∑ succ n ^ e ∑ succ n)],
    rw hi (λ i hi, h i (le_succ_of_le hi)),
    simp },
  { rw [← nat.add_sub_cancel' hm', _root_.pow_add, mul_pow],
    simp only [mul_assoc, mul_left_comm (f (succ n) ^ e (succ n)), h],
    simp }
end

theorem missing1 [comm_semiring α] (n : ℕ) (f : ℕ → α) (e : ℕ → ℕ) (r : ℕ → α)
    (s : α) : (∀ i : ℕ, i < n → (f i) ^ (e i) * s = 0) →
    sum (range n) (λ i, f i * r i) = 1 → s = 0 :=
nat.cases_on n (λ h₁ (h₂ : 0 = 1), mul_zero s ▸ h₂.symm ▸ (mul_one s).symm) $ λ n h₁ h₂, begin
  have := missing n f e r s (λ i hi, h₁ i (lt_succ_of_le hi)),
  rwa [sum_range_succ e, _root_.pow_add, h₂, one_pow, one_pow, one_mul, one_mul] at this,
end


-- let X, Y, Z be sets.
variables {X Y Z : Type}

-- a function f : X → Y is *injective* if f(a) = f(b) → a = b for all a,b in X.
def injective (f : X → Y)  : Prop :=
∀ a b : X, f(a) = f(b) → a = b

-- challenge: the composite of two injective functions is injective
theorem challenge1
  (f : X → Y) (hf : injective f)
  (g : Y → Z) (hg : injective g) :
injective (g ∘ f) :=
begin
  -- the *definition* of "injective" is "for all a and b...", so let
  -- a and b be arbitrary elements of X.
  intros a b,
  -- Assume (g ∘ f) a = (g ∘ f) b
  intro hab,
  -- The goal is now ⊢ a = b .
  -- By injectivity of f, it suffices to prove f(a)=f(b)
  apply hf,
  -- By injectivity of g, it suffices to prove g(f(a))=g(f(b))
  apply hg,
  -- but this is precisely our assumption.
  exact hab,
  -- "no goals" means we're done.
end


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module algebra.order.ring.abs
! leanprover-community/mathlib commit 10b4e499f43088dd3bb7b5796184ad5216648ab1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Defs
import Mathlib.Algebra.Ring.Divisibility
import Mathlib.Algebra.Order.Group.Abs

/-!
# Absolute values in linear ordered rings.
-/

variable {α : Type _}

section LinearOrderedRing

variable [LinearOrderedRing α] {a b c : α}

@[simp]
theorem abs_one : |(1 : α)| = 1 :=
  abs_of_pos zero_lt_one
#align abs_one abs_one

@[simp]
theorem abs_two : |(2 : α)| = 2 :=
  abs_of_pos zero_lt_two
#align abs_two abs_two

theorem abs_mul (a b : α) : |a * b| = |a| * |b| := by
  rw [abs_eq (mul_nonneg (abs_nonneg a) (abs_nonneg b))]
  cases' le_total a 0 with ha ha <;> cases' le_total b 0 with hb hb <;>
    simp only [abs_of_nonpos, abs_of_nonneg, true_or_iff, or_true_iff, eq_self_iff_true, neg_mul,
      mul_neg, neg_neg, *]
#align abs_mul abs_mul

/-- `abs` as a `MonoidWithZeroHom`. -/
def absHom : α →*₀ α :=
  { toFun := abs
    map_zero' := abs_zero
    map_one' := abs_one
    map_mul' :=  abs_mul }
#align abs_hom absHom

@[simp]
theorem abs_mul_abs_self (a : α) : |a| * |a| = a * a :=
  abs_by_cases (fun x => x * x = a * a) rfl (neg_mul_neg a a)
#align abs_mul_abs_self abs_mul_abs_self

@[simp]
theorem abs_mul_self (a : α) : |a * a| = a * a := by rw [abs_mul, abs_mul_abs_self]
#align abs_mul_self abs_mul_self

@[simp]
theorem abs_eq_self : |a| = a ↔ 0 ≤ a := by simp [abs_eq_max_neg]
#align abs_eq_self abs_eq_self

@[simp]
theorem abs_eq_neg_self : |a| = -a ↔ a ≤ 0 := by simp [abs_eq_max_neg]
#align abs_eq_neg_self abs_eq_neg_self

/-- For an element `a` of a linear ordered ring, either `abs a = a` and `0 ≤ a`,
    or `abs a = -a` and `a < 0`.
    Use cases on this lemma to automate linarith in inequalities -/
theorem abs_cases (a : α) : |a| = a ∧ 0 ≤ a ∨ |a| = -a ∧ a < 0 := by
  by_cases h : 0 ≤ a
  · left
    exact ⟨abs_eq_self.mpr h, h⟩
  · right
    push_neg at h
    exact ⟨abs_eq_neg_self.mpr (le_of_lt h), h⟩
#align abs_cases abs_cases

@[simp]
theorem max_zero_add_max_neg_zero_eq_abs_self (a : α) : max a 0 + max (-a) 0 = |a| := by
  symm
  rcases le_total 0 a with (ha | ha) <;> simp [ha]
#align max_zero_add_max_neg_zero_eq_abs_self max_zero_add_max_neg_zero_eq_abs_self

theorem abs_eq_iff_mul_self_eq : |a| = |b| ↔ a * a = b * b := by
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b]
  exact (mul_self_inj (abs_nonneg a) (abs_nonneg b)).symm
#align abs_eq_iff_mul_self_eq abs_eq_iff_mul_self_eq

theorem abs_lt_iff_mul_self_lt : |a| < |b| ↔ a * a < b * b := by
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b]
  exact mul_self_lt_mul_self_iff (abs_nonneg a) (abs_nonneg b)
#align abs_lt_iff_mul_self_lt abs_lt_iff_mul_self_lt

theorem abs_le_iff_mul_self_le : |a| ≤ |b| ↔ a * a ≤ b * b := by
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b]
  exact mul_self_le_mul_self_iff (abs_nonneg a) (abs_nonneg b)
#align abs_le_iff_mul_self_le abs_le_iff_mul_self_le

theorem abs_le_one_iff_mul_self_le_one : |a| ≤ 1 ↔ a * a ≤ 1 := by
  simpa only [abs_one, one_mul] using @abs_le_iff_mul_self_le α _ a 1
#align abs_le_one_iff_mul_self_le_one abs_le_one_iff_mul_self_le_one

end LinearOrderedRing

section LinearOrderedCommRing

variable [LinearOrderedCommRing α] {a b c d : α}

theorem abs_sub_sq (a b : α) : |a - b| * |a - b| = a * a + b * b - (1 + 1) * a * b := by
  rw [abs_mul_abs_self]
  simp only [mul_add, add_comm, add_left_comm, mul_comm, sub_eq_add_neg, mul_one, mul_neg,
    neg_add_rev, neg_neg, add_assoc]
#align abs_sub_sq abs_sub_sq

end LinearOrderedCommRing

section

variable [Ring α] [LinearOrder α] {a b : α}

@[simp]
theorem abs_dvd (a b : α) : |a| ∣ b ↔ a ∣ b := by
  cases' abs_choice a with h h <;> simp only [h, neg_dvd]
#align abs_dvd abs_dvd

theorem abs_dvd_self (a : α) : |a| ∣ a :=
  (abs_dvd a a).mpr (dvd_refl a)
#align abs_dvd_self abs_dvd_self

@[simp]
theorem dvd_abs (a b : α) : a ∣ |b| ↔ a ∣ b := by
  cases' abs_choice b with h h <;> simp only [h, dvd_neg]
#align dvd_abs dvd_abs

theorem self_dvd_abs (a : α) : a ∣ |a| :=
  (dvd_abs a a).mpr (dvd_refl a)
#align self_dvd_abs self_dvd_abs

theorem abs_dvd_abs (a b : α) : |a| ∣ |b| ↔ a ∣ b :=
  (abs_dvd _ _).trans (dvd_abs _ _)
#align abs_dvd_abs abs_dvd_abs

end


-- Suma_de_funciones_acotadas_inferiormente.lean
-- La suma de dos funciones acotadas inferiormente también lo está.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 29-noviembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la suma de dos funciones acotadas inferiormente también
-- lo está.
-- ----------------------------------------------------------------------

import data.real.basic

variables {f g : ℝ → ℝ}
variables {a b : ℝ}

-- (cota_inferior f a) se verifica si a es una cota inferior de f.
def cota_inferior (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

-- (acotada_inf f) se verifica si f tiene cota inferior.
def acotada_inf (f : ℝ → ℝ) := ∃ a, cota_inferior f a

-- Lema auxiliar
-- =============

lemma cota_inferior_add
  (hfa : cota_inferior f a)
  (hgb : cota_inferior g b)
  : cota_inferior (f + g) (a + b) :=
λ x, add_le_add (hfa x) (hgb x)

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

example
  (hf : acotada_inf f)
  (hg : acotada_inf g)
  : acotada_inf (f + g) :=
begin
  cases hf with a ha,
  cases hg with b hb,
  have h1 : cota_inferior (f + g) (a + b) := cota_inferior_add ha hb,
  have h2 : ∃ z, ∀ x, z ≤ (f + g) x :=
    by exact Exists.intro (a + b) h1,
  show acotada_inf (f + g),
    by exact h2,
end

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

example
  (hf : acotada_inf f)
  (hg : acotada_inf g)
  : acotada_inf (f + g) :=
begin
  cases hf with a hfa,
  cases hg with b hgb,
  use a + b,
  apply cota_inferior_add hfa hgb,
end

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

example
  (hf : acotada_inf f)
  (hg : acotada_inf g)
  : acotada_inf (f + g) :=
begin
  rcases hf with ⟨a, hfa⟩,
  rcases hg with ⟨b, hfb⟩,
  exact ⟨a + b, cota_inferior_add hfa hfb⟩,
end

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

example :
  acotada_inf f → acotada_inf g → acotada_inf (f + g) :=
begin
  rintros ⟨a, hfa⟩ ⟨b, hfb⟩,
  exact ⟨a + b, cota_inferior_add hfa hfb⟩,
end

-- 5ª demostración
-- ===============

example :
  acotada_inf f → acotada_inf g → acotada_inf (f + g) :=
λ ⟨a, hfa⟩ ⟨b, hfb⟩, ⟨a + b, cota_inferior_add hfa hfb⟩


example (p q : Prop) : p ∨ q → q ∨ p :=
begin
  intro h,
  cases h with hp hq,
    right, exact hp,
  left, exact hq,
end

example (p q : Prop) : p ∧ q → q ∧ p :=
begin
  intro h,
  cases h with hp hq,
  constructor,
    exact hq,
  exact hp,
end

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h with hp hqr,
    cases hqr with hq hr,
    left, constructor, repeat { assumption },
    right, constructor, repeat { assumption },
  intro h,
  cases h with hpq hpr,
    cases hpq with hp hq,
    constructor, exact hp, left, exact hq,
  cases hpr with hp hr,
  constructor, exact hp, right, exact hr,
end

example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
begin
  intro h,
  cases h with x px,
  constructor, left, exact px,
end

example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
begin
  intro h,
  cases h with x px,
  existsi x, left, assumption,
end

example (p q : ℕ → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
begin
  intro h,
  cases h with x hpq,
  cases hpq with hp hq,
  existsi x,
  -- constructor, assumption, assumption,
  split; assumption
end

universes u v

def swap_pair {α : Type u} {β : Type v}: α × β → β × α :=
begin
  intro p,
  cases p with a b,
  constructor, exact b, exact a,
end

def swap_pair' {α : Type u} {β : Type v}: α ⊕ β → β ⊕ α :=
begin
  intro p,
  cases p with a b,
    right, exact a,
  left, exact b,
end

open nat

example (P : ℕ → Prop) (h₀ : P 0) (h₁ : ∀ n, P (succ n)) (m : ℕ) : P m :=
begin
  cases m with m',
    exact h₀,
  exact (h₁ m'),
end

example (p q : Prop) : p ∧ ¬ p → q :=
begin
  intro h,
  cases h with hp hnp,
  contradiction,
end


import .sets
import .axiom_tactics
import .lovelib
namespace zfc
namespace LoVe

/------------------------------------__Cardinality__------------------------------------/
/-  The cardinality of a set invokes its notion of size. Two sets are cardinally equal -/
/-                     if there exists a bijection between them.                       -/

/- Two sets `x` and `y` have the same cardinality if there exists
   a bijective function `f` from `x` to `y`.-/
def cardinality_eq : Set → Set → Prop :=
  (λ(x y : Set), ∃(f : Set → Set),
    (∀a b, a ∈ x ∧ b ∈ x → (a ≠ b → f(a) ≠ f(b)))          -- injection
    ∧ (∀c, c ∈ y → ∃d, d ∈ x ∧ f(d) = c)                   -- surjection
  )
infix ` ≃ ` : 110 := cardinality_eq

/- _Cantor's Theorem_: X ≢ P(X) : A set does not have the same cardinality as its power set. -/
/-Argument Structure:
Let `f` be a bijection from `X` to `P(X)`. Let `Y = {x ∈ X : ¬x ∈ f(x)}`.
Let `z ∈ X` be such that `f(z) = Y`. Then `z ∈ Y ↔ ¬z ∈ Y`. Contradiction!
-/
theorem Cantor : ∀(X: Set), ¬(X ≃ P(X)) :=
  begin
    intro X,
    intro p,
    rw cardinality_eq at p,

    /-Have `f` be some bijection from `X` to `P(X)`.-/
    let f : Set → Set := classical.some p,

    /-Have `Y = {x ∈ X : ¬x ∈ f(x)}`.-/
    have pY := (separation (λx, ¬x ∈ f(x)) X),
    let Y : Set := classical.some pY,
    have hY := classical.some_spec pY,

    /-Have `I = {x ∈ X : x ∈ f(x)}`.-/
    have pI := (separation (λx, x ∈ f(x)) X),
    let I : Set := classical.some pI,
    have hI := classical.some_spec pI,

    /-Let `zC` be the class of sets that contain all sets `z` such that `f(z) = Y`.
      (zC really only contains one element.)-/
    have pzC := (separation (λx, f(x) = Y) X),
    let zC : Set := classical.some pzC,
    have hzC := classical.some_spec pzC,

    have zC_nonempty : ∃z, z ∈ zC :=
      begin
        have exists_z : ∃x, x ∈ X ∧ f(x) = Y :=
          begin
            have hp := classical.some_spec p,
            have f_is_surj := and.elim_right hp Y,
            have Y_in_PX : Y ∈ P(X) :=
              begin
                have Y_subset_X : Y ⊂ X :=
                  begin
                    rw is_subset,
                    intros x x_in_Y,
                    have j := iff.elim_left (hY x),
                    apply and.elim_left (j x_in_Y),
                  end,
                rw [P, power_set_of],
                simp,
                have hPX := iff.elim_right (classical.some_spec (power_set X) Y),
                apply hPX Y_subset_X,
              end,
            apply f_is_surj Y_in_PX,
          end,
        let a := classical.some exists_z,
        have hzCL := iff.elim_right (hzC a),
        have ha := classical.some_spec exists_z,
        simp at hzCL,
        have a_in_X : a ∈ X := by apply and.elim_left ha,
        have fa_is_Y : f a = Y := by apply and.elim_right ha,
        have a_in_zC := (hzCL a_in_X) fa_is_Y,
        apply exists.intro a,
        assumption,
      end,

    /-Have `z` be some (the) element of `zC`.-/
    let z := classical.some zC_nonempty,
    have hz := classical.some_spec zC_nonempty,

    have z_in_zC : z ∈ zC := by apply hz,

    have z_in_X : z ∈ X :=
      begin
        have hzCR := iff.elim_left (hzC z) z_in_zC,
        apply and.elim_left hzCR,
      end,

    simp at *,

    /- We can show that __z ∈ Y ↔ ¬z ∈ Y__. -/
    have hziy : z ∈ Y ↔ ¬z ∈ Y,
    {
      apply iff.intro,
      {
        /- Forward Direction: z ∈ Y → ¬z ∈ Y
        If z ∈ Y, then ¬z ∈ I. But, f(z) = Y, so z ∈ I. Contradiction, thus ¬z ∈ Y. -/
        intro ziy,
        intro ziy2,
        have z_not_in_I : ¬z ∈ I,
        {
          intro z_in_I,
          have z_in_fz : z ∈ f(z) :=
            begin
              have hIR := iff.elim_left (hI z) z_in_I,
              apply and.elim_right hIR,
            end,
          have z_not_in_fz : ¬z ∈ f(z) :=
            begin
              have hYR := iff.elim_left (hY z) ziy,
              apply and.elim_right hYR,
            end,
            contradiction,
        },
        have fz_is_Y : f(z) = Y :=
          begin
            have hzCR := iff.elim_left (hzC z),
            apply and.elim_right (hzCR z_in_zC),
          end,
        have z_in_I : z ∈ I :=
          begin
            have z_in_fz : z ∈ f(z) :=
              begin
                simp [fz_is_Y, ziy],
              end,
            have hIL := iff.elim_right (hI z),
            apply (hIL (and.intro z_in_X z_in_fz)),
          end,
        contradiction,
      },
      {
        /-Backward Direction: ¬z ∈ Y → z ∈ Y
        If ¬z ∈ Y, then z ∈ f(z). But f(z) = Y, so z ∈ Y.-/
        intro not_z_in_Y,
        have z_in_fz : z ∈ f(z) :=
          begin
            have hYR := iff.elim_right (hY z),
            have nhY := not.imp not_z_in_Y hYR,
            simp at nhY,
            simp [nhY, z_in_X],
          end,
        have fz_is_Y : f(z) = Y :=
          begin
            have hzCR := iff.elim_left (hzC z),
            apply and.elim_right (hzCR z_in_zC),
          end,
        have z_in_Y : z ∈ Y :=
          begin
            rw (eq.symm fz_is_Y),
            exact z_in_fz,
          end,
        contradiction,
      },
    },
    /-Uh-oh! We have that z ∈ Y ↔ ¬z ∈ Y. We can break into cases, and say that if
      z ∈ Y, then we have a contradiction, and if ¬z ∈ Y, we also have a contradiction.-/
    have uhoh : z ∈ Y ∨ ¬z ∈ Y := by apply classical.em,
    apply or.cases_on uhoh,
    {
      intro ziy,
      have zniy : ¬z ∈ Y,
      {
        apply iff.elim_left hziy,
        assumption,
      },
      contradiction
    },
    {
      intro nziy,
      have ziy : z ∈ Y,
      {
        apply iff.elim_right hziy,
        assumption
      },
      contradiction
    },
  end
end LoVe
end zfc


/- Exercise 4.1: Mathematics — Foundation -/

/- Question 1: Hilbert choice -/

/- The following command enables noncomputable decidability on every `Prop`. The `priority 0`
attribute ensures this is used only when necessary; otherwise, it would make some computable
definitions noncomputable for Lean. -/

local attribute [instance, priority 0] classical.prop_decidable

/- 1.1. Prove the following lemma. -/

lemma exists_minimal_arg.aux (f : ℕ → ℕ) :
  ∀x n, f n = x → ∃n, ∀i, f n ≤ f i
| x n eq :=
  begin
    -- this works thanks to `classical.prop_decidable`
    by_cases (∃n', f n' < x),
    { cases h with n' h,
      exact exists_minimal_arg.aux _ n' rfl },
    { have h' : ∀n', x ≤ f n',
      { intro n',
        apply le_of_not_gt _,
        intro h',
        exact h ⟨n', h'⟩ },
      apply exists.intro n,
      rw eq,
      exact h' }
  end

/- Now this interesting lemma falls off: -/

lemma exists_minimal_arg (f : ℕ → ℕ) : ∃n : ℕ, ∀i : ℕ, f n ≤ f i :=
exists_minimal_arg.aux f _ 0 rfl

/- 1.2. Use what you learned in the lecture notes to define the following function, which returns
the (or an) index of the minimal element in `f`'s image. -/

noncomputable def minimal_arg (f : ℕ → ℕ) : ℕ :=
classical.some (exists_minimal_arg f)

/- 1.3. Prove the following characteristic lemma about your definition. -/

lemma minimal_arg_spec (f : ℕ → ℕ) : ∀i : ℕ, f (minimal_arg f) ≤ f i :=
classical.some_spec (exists_minimal_arg f)

/- Question 2: Integers as quotients -/

/- First, we repeat some material from the lecture. As usual, ignore the `sorry`. -/

namespace exercise

lemma reflexive1 {α: Type} (x: (ℕ × ℕ)) : x.1 + x.2 = x.1 + x.2:= by refl
lemma symmetry1 {α: Type} (x y: (ℕ × ℕ)) (h1: x.1 + y.2 = y.1 + x.2) :  y.1 + x.2 = x.1 + y.2 := by rw[h1]
lemma transitive1 {α: Type} (x y z: (ℕ × ℕ)) (h1: y.1 + x.2 = x.1 + y.2) (h2:  z.1 + y.2 = y.1 + z.2) : (x.1 + z.2) + y.2 = (x.1 + y.2) + z.2 := begin calc (x.fst + z.snd) + y.snd = (x.fst + y.snd) + z.snd : by ac_refl  end

lemma reflexivelist {α: Type} (xs: list α) : ∀x, x∈xs ↔ x∈xs := begin intro x, apply iff.intro, intro h, assumption, intro h, assumption end
lemma symmetriclist {α: Type} (xs ys: list α) : ∀x, x∈xs ↔ x∈ys →  x∈ys ↔ x∈xs := begin intro x, apply iff.intro, intro h, cases h, apply h_mpr, intro s, assumption, intro h, apply iff.intro, intros a b, assumption, intro a, assumption end
lemma transitivelist {α: Type} (xs ys zs: list α) : ∀x, x∈xs ↔ x∈ys →  x∈ys ↔ x∈zs → x ∈xs ↔ x∈zs := begin intro x, apply iff.intro, intro h, cases h, simp[symmetriclist] at h_mp, simp[symmetriclist] at h_mpr, sorry

instance fin_set.rel (α: Type) : setoid (list α) :={ r :=λxs ys,∀x, x∈xs↔x∈ys,
iseqv := ⟨ (assume xs, by simp*),

 ⟩ }

instance int.rel : setoid (ℕ × ℕ) :=
{ r     := λa b, a.1 + b.2 = b.1 + a.2,
  iseqv := ⟨ (assume a, reflexive1 ),
            (assume a b eq, symmetry1),
            (assume a b c d e , transitive1)
  ⟩ }

@[simp] lemma rel_iff (a b : ℕ × ℕ) : a ≈ b ↔ a.1 + b.2 = b.1 + a.2 := iff.rfl

def int : Type := quotient int.rel

/- 2.1. Define negation using `quotient.lift_on`. -/

def neg (a : int) : int :=
quotient.lift_on a (λpn, ⟦(pn.2, pn.1)⟧)
  begin
    intros a b h,
    cases a,
    cases b,
    apply quotient.sound,
    simp at h ⊢,
    rw [h]
  end

/- 2.2. Prove the following lemmas. -/

lemma neg_mk (p n : ℕ) : neg ⟦(p, n)⟧ = ⟦(n, p)⟧ :=
by refl

lemma neg_neg (a : int) : neg (neg a) = a :=
begin
  refine quotient.induction_on a _,
  intro a,
  cases a,
  simp [neg_mk]
end

end exercise


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.finsupp.order
import data.dfinsupp.lex
import data.finsupp.to_dfinsupp

/-!
# Lexicographic order on finitely supported functions

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

This file defines the lexicographic order on `finsupp`.
-/

variables {α N : Type*}

namespace finsupp

section N_has_zero
variables [has_zero N]

/-- `finsupp.lex r s` is the lexicographic relation on `α →₀ N`, where `α` is ordered by `r`,
and `N` is ordered by `s`.

The type synonym `lex (α →₀ N)` has an order given by `finsupp.lex (<) (<)`.
-/
protected def lex (r : α → α → Prop) (s : N → N → Prop) (x y : α →₀ N) : Prop :=
pi.lex r (λ _, s) x y

lemma _root_.pi.lex_eq_finsupp_lex {r : α → α → Prop} {s : N → N → Prop} (a b : α →₀ N) :
  pi.lex r (λ _, s) (a : α → N) (b : α → N) = finsupp.lex r s a b :=
rfl

lemma lex_def {r : α → α → Prop} {s : N → N → Prop} {a b : α →₀ N} :
  finsupp.lex r s a b ↔ ∃ j, (∀ d, r d j → a d = b d) ∧ s (a j) (b j) := iff.rfl

instance [has_lt α] [has_lt N] : has_lt (lex (α →₀ N)) :=
⟨λ f g, finsupp.lex (<) (<) (of_lex f) (of_lex g)⟩

lemma lex_lt_of_lt_of_preorder [preorder N] (r) [is_strict_order α r]
  {x y : α →₀ N} (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i :=
dfinsupp.lex_lt_of_lt_of_preorder r (id hlt : x.to_dfinsupp < y.to_dfinsupp)

lemma lex_lt_of_lt [partial_order N] (r) [is_strict_order α r]
  {x y : α →₀ N} (hlt : x < y) : pi.lex r (λ i, (<)) x y :=
dfinsupp.lex_lt_of_lt r (id hlt : x.to_dfinsupp < y.to_dfinsupp)

instance lex.is_strict_order [linear_order α] [partial_order N] :
  is_strict_order (lex (α →₀ N)) (<) :=
let i : is_strict_order (lex (α → N)) (<) := pi.lex.is_strict_order in
{ irrefl := to_lex.surjective.forall.2 $ λ a, @irrefl _ _ i.to_is_irrefl a,
  trans := to_lex.surjective.forall₃.2 $ λ a b c, @trans _ _ i.to_is_trans a b c }

variables [linear_order α]

/-- The partial order on `finsupp`s obtained by the lexicographic ordering.
See `finsupp.lex.linear_order` for a proof that this partial order is in fact linear. -/
instance lex.partial_order [partial_order N] : partial_order (lex (α →₀ N)) :=
partial_order.lift (λ x, to_lex ⇑(of_lex x)) finsupp.coe_fn_injective--fun_like.coe_injective

/--  The linear order on `finsupp`s obtained by the lexicographic ordering. -/
instance lex.linear_order [linear_order N] : linear_order (lex (α →₀ N)) :=
{ ..lex.partial_order,
  ..linear_order.lift' (to_lex ∘ to_dfinsupp ∘ of_lex) finsupp_equiv_dfinsupp.injective }

variable [partial_order N]

lemma to_lex_monotone : monotone (@to_lex (α →₀ N)) :=
λ a b h, dfinsupp.to_lex_monotone (id h : ∀ i, of_lex (to_dfinsupp a) i ≤ of_lex (to_dfinsupp b) i)

lemma lt_of_forall_lt_of_lt (a b : lex (α →₀ N)) (i : α) :
  (∀ j < i, of_lex a j = of_lex b j) → of_lex a i < of_lex b i → a < b :=
λ h1 h2, ⟨i, h1, h2⟩

end N_has_zero

section covariants
variables [linear_order α] [add_monoid N] [linear_order N]

/-!  We are about to sneak in a hypothesis that might appear to be too strong.
We assume `covariant_class` with *strict* inequality `<` also when proving the one with the
*weak* inequality `≤`.  This is actually necessary: addition on `lex (α →₀ N)` may fail to be
monotone, when it is "just" monotone on `N`.

See `counterexamples.zero_divisors_in_add_monoid_algebras` for a counterexample. -/
section left
variables [covariant_class N N (+) (<)]

instance lex.covariant_class_lt_left : covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (+) (<) :=
⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg ((+) _) (lta j ja), add_lt_add_left ha _⟩⟩

instance lex.covariant_class_le_left : covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (+) (≤) :=
has_add.to_covariant_class_left _

end left

section right
variables [covariant_class N N (function.swap (+)) (<)]

instance lex.covariant_class_lt_right :
  covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (function.swap (+)) (<) :=
⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg (+ (of_lex f j)) (lta j ja), add_lt_add_right ha _⟩⟩

instance lex.covariant_class_le_right :
  covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (function.swap (+)) (≤) :=
has_add.to_covariant_class_right _

end right

end covariants

end finsupp


import Mathlib
import PnP2023.Lec_02_01.Foundations
import PnP2023.Lec_01_13.NatRec

/-!
# Inductive Types

We see more precisely what are valid (and not valid) definitions for inductive types. We will also see the weak and strong generalizations:
_parametric inductive types_ and  _indexed inductive types_.

We have constructed a few examples. We first see some more from Lean core.-/

#check Bool

/-!
Simplest ones are enumerations

```lean
inductive Bool : Type where
  | false : Bool
  | true : Bool
```
-/

#check Nat

/-!
In general, the construtors let us construct terms of the inductive type being introduced using terms of that type.

```lean
inductive Nat where
  | zero : Nat
  | succ (n : Nat) : Nat
```

#check Nat.zero -- ℕ
#check Nat.succ -- ℕ → ℕ
-/

#check Nat.zero -- ℕ
#check Nat.succ -- ℕ → ℕ

#check Unit
#check Empty

/-!
Two more inductive types:

```lean
abbrev Unit : Type := PUnit

inductive PUnit : Sort u where
  | unit : PUnit

inductive Empty : Type
```
-/

/-!
## Disallowed types

- constructors should have resulting type the inductive type being introduced.
-/
-- inductive Silly where
--  | what_is_this: ℕ /- unexpected constructor resulting type
--   ℕ -/

-- inductive Cantor where
--   | mk : (Cantor → Bool) → Cantor
--   /-(kernel) arg #1 of 'Cantor.mk' has a non positive occurrence of the datatypes being declared -/

/-!
The above is disallowed because with a construction of the above form, we would have an injection (in this case a biection) from the power set on the Cantor set to itself.

If we had such an inductive type, we could define

```lean
diag (x :Cantor): Bool :=  match x with
| Cantor.mk f => ¬ f x
```

Apply this to `x:= Cantor.mk diag` to get
```lean
diag (Cantor.mk diag) = ¬ diag (Cantor.mk diag)
```
-/

/-!
A non-trivial __positive__ occurence, which is hence allowed, is in the following binary tree.
-/

inductive NatBinTree where
| leaf : ℕ → NatBinTree
| node : (Bool → NatBinTree) → NatBinTree

/-!
## Parametrized inductive types

Here we define a family of inductive types. However each member of the family is "separately defined", i.e., all constructors only involve that parameter.
-/

universe u

inductive InfiniteTree (α : Type u) where
| leaf (label: α) : InfiniteTree α
| node : (ℕ → InfiniteTree α) → InfiniteTree α

inductive FiniteTree (α : Type u) where
| leaf (label: α) : FiniteTree α
| node : (List <| FiniteTree α)  → FiniteTree α

-- Does terminate, but Lean does not have enough support yet
partial def FiniteTree.flatten {α : Type u} : FiniteTree α → List α
| FiniteTree.leaf label => [label]
| FiniteTree.node children =>
  children.foldl (fun acc child => acc ++ FiniteTree.flatten child) ([])

/-!
# Indexed inductive type

We define types `Vec α n` for `α : Type u` and `n: ℕ` with terms of `Vec α n` n-tuples in `α`.

* `α` will be a parameter.
* `n` will be an index.
-/

inductive Vec (α : Type u) :
            ℕ → Type (u + 1) where
| nil : Vec α 0
| cons : {n : ℕ} →
  (head : α) → (tail : Vec α n) → Vec α (n + 1)

example : Vec ℕ 0 := Vec.nil

example : Vec ℕ 1 := Vec.cons 3 (Vec.nil)

#check List

def Vec.to_list {α : Type u} {n : ℕ} : Vec α n → List α
| Vec.nil => []
| Vec.cons head tail => head :: tail.to_list

/-!
## `List` is a parametrized inductive type

```lean
inductive List (α : Type u) where
  /-- `[]` is the empty list. -/
  | nil : List α
  /-- If `a : α` and `l : List α`, then `cons a l`, or `a :: l`, is the
  list whose first element is `a` and with `l` as the rest of the list. -/
  | cons (head : α) (tail : List α) : List α
```
-/

#check Fin

/-!
Sometimes types include conditions

```lean
structure Fin (n : Nat) where
  /-- If `i : Fin n`, then `i.val : ℕ` is the described number. It can also be
  written as `i.1` or just `i` when the target type is known. -/
  val  : Nat
  /-- If `i : Fin n`, then `i.2` is a proof that `i.1 < n`. -/
  isLt : LT.lt val n
```
-/

#check Vector

/-!
Conditions can be given by a *subtype* of the type.

```lean
def Vector (α : Type u) (n : ℕ) :=
  { l : List α // l.length = n }
```
-/

#check Subtype.property
#check Subtype.val
#check Subtype.mk

/-!
When an (indexed) inductive type is introduced,

* the type (or family of types) is defined.
* the constructors are defined.
* a *recursor* is defined.
* a rule for simplification of applications of the recursor is introduced.

The recursor can be conveniently used by pattern matching.
-/

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

#check Bool.rec -- {motive : Bool → Sort u} → motive false → motive true → (t : Bool) → motive t

def egFamily (b: Bool) : Type :=
  match b with
  | Bool.false => Unit
  | Bool.true => ℕ

def egDepFunction (b: Bool) : egFamily b :=
  match b with
  | Bool.false => ()
  | Bool.true => by
    simp [egFamily]
    exact 3

set_option pp.motives.all true in
#reduce egDepFunction

set_option pp.motives.all true in
#reduce Bool.disagree


/-
In Lean, true is a proposition that
is always true, in the sense that
there is a proof of it that doesn't
depend on anything else being true.
-/

#check true

/-
inductive true : Prop
| intro : true
-/

/-
Introduction rule for true
-/
lemma true_is_true : true := true.intro

/-
A function from true to true
-/
lemma true_to_true' : true → true :=
λ (t : true), t

/-
A proof that true → true
-/
lemma true_to_true : true → true :=
λ t, t


import tactic

variables {α β γ : Type} {f : α → β} {g g₁ g₂ : β → α}

-- Problem 4.1. Show that if f : A → B has a left inverse g, then f is
-- injective.
lemma problem_4_1 (h : function.left_inverse g f) : function.injective f :=
begin
  intros x y hxy,
  have : g (f x) = g (f y), from congr_arg g hxy,
  have hx := h x,
  have hy := h y,
  rwa [hx, hy] at this
end

-- Problem 4.2. Show that if f : A → B has a right inverse h, then f is
-- surjective.
lemma problem_4_2 (h : function.right_inverse g f) : function.surjective f :=
begin
  intro y,
  use g y,
  rw h y
end

#check @classical.some
#check @classical.some_spec

-- Problem 4.3. Prove Proposition 4.18. You have to define f^−1, show that it
-- is a function, and show that it is an inverse of f, i.e., f^−1(f(x)) = x and
-- f(f^−1(y)) = y for all x ∈ A and y ∈ B.
--
-- Proposition 4.18. If f : A → B is bijective, there is a function
-- f^−1 : B → A so that for all x ∈ A, f^−1(f(x)) = x and for all y ∈ B,
-- f(f^−1(y)) = y.
lemma proposition_4_18 (h : function.bijective f) :
  ∃ g : β → α, function.left_inverse g f ∧ function.right_inverse g f :=
begin
  obtain ⟨h₁, h₂⟩ := h,
  let g : β → α := λ y, classical.some (h₂ y),
  use g,
  split,
  { intro x,
    simp only [g],
    have := classical.some_spec (h₂ (f x)),
    have := h₁ this,
    assumption },
  { intro y,
    simp only [g],
    have := classical.some_spec (h₂ y),
    assumption }
end

-- Problem 4.4. Prove Proposition 4.19.
--
-- Proposition 4.19. Show that if f : A → B has a left inverse g and a right
-- inverse h, then h = g .
lemma proposition_4_19 (hg₁ : function.left_inverse g₁ f) (hg₂ : function.right_inverse g₂ f) :
  g₁ = g₂ :=
begin
  ext y,
  have h₁ := hg₁ (g₂ y),
  have h₂ := hg₂ y,
  rwa h₂ at h₁
end

-- Problem 4.5. Show that if f : A → B and g : B → C are both injective, then
-- g ◦ f : A → C is injective.
lemma problem_4_5 {g : β → γ} (hf : function.injective f) (hg : function.injective g) :
  function.injective (g ∘ f) :=
begin
  intros x y h,
  change g (f x) = g (f y) at h,
  have := hg h,
  have := hf this,
  assumption
end

-- Problem 4.6. Show that if f : A → B and g : B → C are both surjective, then
-- g ◦ f : A → C is surjective.
lemma problem_4_6 {g : β → γ} (hf : function.surjective f) (hg : function.surjective g) :
  function.surjective (g ∘ f) :=
begin
  intro z,
  obtain ⟨y, hy⟩ := hg z,
  obtain ⟨x, hx⟩ := hf y,
  use x,
  change g (f x) = z,
  rw [hx, hy]
end

def graph (f : α → β) := λ x y, f x = y

def relative_product (r : α → β → Prop) (s : β → γ → Prop) := λ a b, ∃ c, r a c ∧ s c b

-- Problem 4.7. Suppose f : A → B and g : B → C. Show that the graph of g ◦ f
-- is R_f | R_g.
lemma problem_4_7 (f : α → β) (g : β → γ) :
  graph (g ∘ f) = relative_product (graph f) (graph g) :=
begin
  ext x z,
  split,
  { intro h,
    change g (f x) = z at h,
    rwa [relative_product, graph, exists_eq_left'] },
  { intro h,
    rwa [relative_product, graph, exists_eq_left'] at h }
end


/-
    Stalk (of types).

    https://stacks.math.columbia.edu/tag/0078

    Author: Ramon Fernandez Mir
-/

import topology.basic
import sheaves.opens
import sheaves.presheaf

universe u

section stalk

variables {α : Type u} [topological_space α]
variables (F : presheaf α) (x : α)

open topological_space

-- An element in the stalk is a pair (U, s) under an equivalence relation

structure stalk.elem :=
(U   : opens α)
(HxU : x ∈ U)
(s   : F U)

-- Equivalence relation on the set of pairs. (U,s) ~ (V,t) iff there exists W
-- open s.t. x ∈ W ⊆ U ∩ V, and s|W = t|W.

def stalk.relation : stalk.elem F x → stalk.elem F x → Prop :=
λ Us Vt,
    ∃ (W : opens α) (HxW : x ∈ W) (HWU : W ⊆ Us.U) (HWV : W ⊆ Vt.U),
    F.res Us.U W HWU Us.s = F.res Vt.U W HWV Vt.s

lemma stalk.relation.reflexive : reflexive (stalk.relation F x) :=
λ ⟨U, HxU, s⟩, ⟨U, HxU, set.subset.refl _, set.subset.refl _, rfl⟩

lemma stalk.relation.symmetric : symmetric (stalk.relation F x) :=
λ Us Vt ⟨W, HxW, HWU, HWV, Hres⟩, ⟨W, HxW, HWV, HWU, Hres.symm⟩

lemma stalk.relation.transitive : transitive (stalk.relation F x) :=
λ ⟨U, HxU, sU⟩ ⟨V, HxV, sV⟩ ⟨W, HxW, sW⟩,
λ ⟨R, HxR, HRU, HRV, HresR⟩ ⟨S, HxS, HSV, HSW, HresS⟩,
⟨R ∩ S, ⟨HxR, HxS⟩,
λ y ⟨HyR, _⟩, HRU HyR, λ y ⟨_, HyS⟩, HSW HyS,
have HURRS : _ := F.Hcomp U R (R ∩ S) (set.inter_subset_left _ _) HRU,
have HVRRS : _ := F.Hcomp V R (R ∩ S) (set.inter_subset_left _ _) HRV,
have HVSRS : _ := F.Hcomp V S (R ∩ S) (set.inter_subset_right _ _) HSV,
have HWSRS : _ := F.Hcomp W S (R ∩ S) (set.inter_subset_right _ _) HSW,
calc  F.res U (R ∩ S) _ sU
    = F.res R (R ∩ S) _ (F.res U R _ sU) : congr_fun HURRS sU
... = F.res R (R ∩ S) _ (F.res V R _ sV) : congr_arg _ HresR
... = F.res V (R ∩ S) _ sV               : congr_fun HVRRS.symm sV
... = F.res S (R ∩ S) _ (F.res V S _ sV) : congr_fun HVSRS sV
... = F.res S (R ∩ S) _ (F.res W S _ sW) : congr_arg _ HresS
... = F.res W (R ∩ S) _ sW               : congr_fun HWSRS.symm sW⟩

lemma stalk.relation.equivalence : equivalence (stalk.relation F x) :=
⟨stalk.relation.reflexive F x,
stalk.relation.symmetric F x,
stalk.relation.transitive F x⟩

instance stalk.setoid : setoid (stalk.elem F x) :=
{ r := stalk.relation F x,
  iseqv := stalk.relation.equivalence F x }

-- We define a stalk as the set of stalk elements under the defined relation.

definition stalk := quotient (stalk.setoid F x)

end stalk


theorem lt_succ_eq_or_succ_lt (x b : Nat) (hb : b ≠ 0) : x < b → Nat.succ x = b ∨ Nat.succ x < b := by
intro h1
have h2 : Nat.succ x ≤ b := Nat.succ_le_of_lt h1
rw [Eq.symm (Nat.succ_pred hb)] at h2
have h3 : Nat.succ x ≤ Nat.pred b ∨ Nat.succ x = Nat.succ (Nat.pred b) := Nat.le_or_eq_or_le_succ h2
rw [Nat.succ_pred hb] at h3
apply Or.elim h3
intro h4
have h5 : Nat.succ x < Nat.succ (Nat.pred b) := Nat.lt_succ_of_le h4
rw [Nat.succ_pred hb] at h5
exact Or.intro_right (Nat.succ x = b) h5
intro h6
exact Or.intro_left (Nat.succ x < b) h6

theorem succ_eq_succ (a b : Nat) : a = b → Nat.succ a = Nat.succ b := by
intro hp
induction a <;> rw [hp]

theorem division_theorem (a b : Nat) (h : b ≠ 0) : ∃ r q : Nat, a = q*b+r ∧ r < b := by
induction a with
| zero => apply Exists.intro 0
          apply Exists.intro 0
          rw [Nat.zero_mul]
          have h1 : 0 = 0 + 0 := rfl
          have h2 : 0 < b := Nat.zero_lt_of_ne_zero h
          apply And.intro h1 h2
| succ a ha => apply Exists.elim ha
               intro x hx
               apply Exists.elim hx
               intro y hy
               have shoo : Nat.succ x = b ∨ Nat.succ x < b := lt_succ_eq_or_succ_lt x b h hy.right
               apply Or.elim shoo
               intro foo2
               apply Exists.intro 0
               apply Exists.intro (y+1)
               have h9 : 0<b := Nat.zero_lt_of_ne_zero h
               suffices h : Nat.succ a = (y+1)*b + 0 from And.intro h h9
               rw [Nat.add_mul,Nat.one_mul,Nat.add_zero,Eq.symm foo2,Nat.succ_eq_add_one x]
               rw [← Nat.add_assoc,Nat.add_one,Nat.add_one]
               apply succ_eq_succ
               rw [foo2]
               exact hy.left
               intro hu
               apply Exists.intro (x+1)
               apply Exists.intro y
               apply And.intro
               rw [← Nat.add_assoc,Nat.add_one]
               apply succ_eq_succ
               exact hy.left
               exact hu


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 5 : "iff" (`↔`)

We learn about how to manipulate `P ↔ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following two new tactics:

* `refl`
* `rw`

### The `refl` tactic

If your goal is `P ↔ P` then `refl,` will solve it.

### The `rw` tactic

If `h : P ↔ Q` is a hypothesis, you can decompose it
using `cases h with hPQ hQP,`. However, if you keep
it around then you can do `rw h,` which changes all `P`s in the goal to `Q`s.
Variant: `rw h at h2,` will change all `P`s to `Q`s in hypothesis `h2`.

-/

variables (P Q R S : Prop)

example : P ↔ P :=
begin
  sorry
end

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

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

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

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

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

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

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

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

example : ¬ (P ↔ ¬ P) :=
begin
  sorry,
end


/-
This module defines operations for simplifying equalities between natural numbers.

After importing this, simp should reduce all ground number equalities
to true or false.
-/

namespace nat

/- Simplify 0 = succ n to false -/
@[simp]
theorem not_zero_eq_succ (x : ℕ) : ¬ (0 = succ x) :=
begin
  contradiction,
end

@[simp]
theorem succ_eq_zero (x : ℕ) : (succ x = 0) ↔ false :=
begin
  simp [bit0],
  induction x,
  contradiction,
  contradiction
end

/- Simplify succ n = 0 to false -/
@[simp]
theorem not_succ_eq_zero (n : ℕ) : ¬ (nat.succ n = 0) :=
begin
  contradiction,
end

-- Simplify successor of two values.
@[simp]
theorem succ_eq_succ (x y : ℕ): succ x = succ y ↔ x = y :=
begin
  apply iff.intro,
  { intro p,
    apply @nat.no_confusion _ _ _ p,
    exact id,
  },
  { intro p,
    rw [p]
  }
end

/- Lemmas comparing operations with zero. -/
section zero_comparison

/- Simplify comparison of sum of two naturals with 0. -/
theorem add_is_zero_iff (m n : ℕ) : m + n = 0 ↔ m = 0 ∧ n = 0 :=
begin
  cases n,
  case zero { simp, },
  case succ n ind { simp [add_succ], },
end

/- Simplify comparison of product of two naturals with 0. -/
theorem mul_is_zero_iff (m n : ℕ) : m * n = 0 ↔ m = 0 ∨ n = 0 :=
begin
  induction n,
  case zero { simp, },
  case succ n ind {
    simp [mul_succ, add_is_zero_iff, ind],
    by_cases m = 0 with h,
    all_goals { simp [h], },
  }
end

/- Simplify comparison of power of two naturals with 0. -/
theorem pow_is_zero_iff (m n : ℕ) : m ^ n = 0 ↔ m = 0 ∧ n ≠ 0 :=
begin
  induction n,
  case zero { simp, },
  case succ n ind {
    simp [pow, mul_is_zero_iff, ind],
    by_cases m = 0 with h,
    all_goals { simp [h], },
  }
end

end zero_comparison

-- Commute bit0 and succ
protected
theorem bit0_succ (x : ℕ) : bit0 (succ x) = succ (succ (bit0 x)) :=
begin
  simp [bit0, add_succ, succ_add]
end

-- Commute bit1 and succ
protected
theorem bit1_succ (x : ℕ) : bit1 (succ x) = succ (succ (bit1 x)) :=
begin
  simp [bit1, nat.bit0_succ],
end

-- Commute succ and bit1.
protected
lemma succ_bit1 (x:ℕ) : succ (bit1 x) = bit0 (succ x) :=
begin
  induction x,
  case zero { simp, },
  case succ x ind {
    simp [nat.bit0_succ, nat.bit1_succ, bit1, succ_add],
  }
end

section literal_simplification_literals

@[simp]
theorem zero_eq_bit0_reduce  (x : ℕ) : (0 = bit0 x) ↔ 0 = x :=
begin
  cases x,
  refl,
  simp [nat.bit0_succ]
end

@[simp]
theorem zero_eq_bit1_reduce  (x : ℕ) : (0 = bit1 x) ↔ false :=
begin
  simp [bit1, nat.add_succ]
end

@[simp]
theorem one_eq_bit0_reduce  (x : ℕ) : (1 = bit0 x) ↔ false :=
begin
  simp [bit0],
  cases x,
  contradiction,
  simp [succ_eq_succ],
end

@[simp]
theorem one_eq_bit1_reduce  (x : ℕ) : (1 = bit1 x) ↔ 0 = x :=
begin
  simp [bit1, succ_add, succ_eq_succ],
end

@[simp]
theorem bit0_eq_zero_reduce (x : ℕ) : (bit0 x = 0) ↔ x = 0 :=
begin
  cases x,
  refl,
  simp [nat.bit0_succ]
end

@[simp]
theorem bit0_eq_one_reduce  (x : ℕ) : (bit0 x = 1) ↔ false :=
begin
  cases x,
  simp,
  simp [nat.bit0_succ, succ_eq_succ]
end

@[simp]
theorem bit0_eq_bit0_reduce (x y : ℕ) : (bit0 x = bit0 y) ↔ x = y :=
begin
  revert y,
  induction x with x ind,
  { simp },
  { intros y,
    cases y,
    simp [nat.bit0_succ],
    simp [nat.bit0_succ, succ_eq_succ, ind],
  }
end

@[simp]
theorem bit0_eq_bit1_reduce (x y : ℕ) : (bit0 x = bit1 y) ↔ false :=
begin
  revert y,
  induction x with x ind,
  { simp },
  { intros y,
    cases y,
    simp [nat.bit0_succ, bit1, succ_eq_succ],
    simp [nat.bit0_succ, nat.bit1_succ, succ_eq_succ, ind],
  }
end

@[simp]
theorem bit1_eq_zero_reduce (x : ℕ)   : (bit1 x = 0) ↔ false :=
begin
  simp [bit1, bit0, add_succ],
end

@[simp]
theorem bit1_eq_one_reduce  (x : ℕ)   : (bit1 x = 1) ↔ x = 0 :=
begin
  simp [bit1, bit0, add_succ, succ_eq_succ],
  cases x,
  refl,
  simp
end

@[simp]
theorem bit1_eq_bit0_reduce (x y : ℕ) : (bit1 x = bit0 y) ↔ false :=
begin
  revert y,
  induction x with x ind,
  { simp },
  { intros y,
    cases y,
    simp,
    simp [nat.bit1_succ, nat.bit0_succ, succ_eq_succ, ind],
  }
end

@[simp]
theorem bit1_eq_bit1_reduce (x y : ℕ) : (bit1 x = bit1 y) ↔ x = y :=
begin
  revert y,
  induction x with x ind,
  { simp },
  { intros y,
    cases y,
    simp,
    simp [nat.bit1_succ, succ_eq_succ, ind],
  }
end

end literal_simplification_literals

end nat


def n : ℕ := 10

@[instance] def cong_rel : setoid ℕ :=
{ r     := λ(x y : ℕ), x % n = y % n,
  iseqv :=
    begin
      rw equivalence,
      repeat { apply and.intro }, {
        rw reflexive,
        intro x,
        refl,
      }, {
        rw symmetric,
        intros x y,
        intro hxy,
        rw hxy,
      }, {
        rw transitive,
        intros x y z,
        intros hxy hyz,
        rw [hxy, hyz],
      },
    end }

lemma ℕₙ.rel_iff (x y : ℕ) :
  x ≈ y ↔
  x % n = y % n :=
by refl

/- Define ℤ/nℤ or ℤ_n aka ℕₙ from the congruence relation on ℕ. -/
def ℕₙ : Type :=
  quotient cong_rel

def ℕₙ.add : ℕₙ → ℕₙ → ℕₙ :=
  quotient.lift₂ (λ(x y : ℕ), ⟦x + y % n⟧) begin
      intros x y x' y' hx hy,
      apply quotient.sound,
      rw ℕₙ.rel_iff at *,
      norm_num,
      rw nat.add_mod,
      rw [hx, hy],
      rw ←nat.add_mod,
    end

def ℕₙ.sub : ℕₙ → ℕₙ → ℕₙ :=
  quotient.lift₂ (λ(x y : ℕ), ⟦(x + (n - (y % n)) % n)⟧) begin
      intros x y x' y' hx hy,
      apply quotient.sound,
      rw ℕₙ.rel_iff at *,
      norm_num,
      rw nat.add_mod,
      rw [hx, hy],
      rw ←nat.add_mod,
    end

def ℕₙ.le : ℕₙ → ℕₙ → Prop :=
  quotient.lift₂ (λ(x y : ℕ), (x % n) ≤ (y % n)) begin
      intros x y x' y' hx hy,
      rw ℕₙ.rel_iff at *,
      norm_num,
      apply iff.intro, {
        rw [hx, hy],
        intro h,
        assumption,
      }, {
        intro h,
        rw [hx, hy],
        assumption,
      },
    end

def ℕₙ.ge (a b : ℕₙ) : Prop := ℕₙ.le b a

@[instance] def ℕₙ.has_add : has_add ℕₙ := { add := ℕₙ.add }

@[instance] def ℕₙ.has_sub : has_sub ℕₙ := { sub := ℕₙ.sub }

@[instance] def ℕₙ.has_le : has_le ℕₙ := { le := ℕₙ.le }

-- @[instance] def ℕₙ.has_ge : has_ge ℕₙ := { ge := ℕₙ.ge }

@[instance] def ℕₙ.has_zero : has_zero ℕₙ := { zero := ⟦0⟧ }

@[instance] def ℕₙ.has_one : has_one ℕₙ := { one := ⟦1⟧ }

def add_mod : ℕₙ → ℕₙ → ℕₙ:=
  quotient.lift₂ (λ(x y : ℕₙ), ⟦x⟧) begin


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes, Floris van Doorn, Yaël Dillies
-/
import data.nat.basic
import data.nat.pow

/-!
# Factorial and variants

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

This file defines the factorial, along with the ascending and descending variants.

## Main declarations

* `nat.factorial`: The factorial.
* `nat.asc_factorial`: The ascending factorial. Note that it runs from `n + 1` to `n + k`
  and *not* from `n` to `n + k - 1`. We might want to change that in the future.
* `nat.desc_factorial`: The descending factorial. It runs from `n - k` to `n`.
-/

namespace nat

/-- `nat.factorial n` is the factorial of `n`. -/
@[simp] def factorial : ℕ → ℕ
| 0        := 1
| (succ n) := succ n * factorial n

localized "notation (name := nat.factorial) n `!`:10000 := nat.factorial n" in nat

section factorial

variables {m n : ℕ}

@[simp] theorem factorial_zero : 0! = 1 := rfl

@[simp] theorem factorial_succ (n : ℕ) : n.succ! = (n + 1) * n! := rfl

@[simp] theorem factorial_one : 1! = 1 := rfl

@[simp] theorem factorial_two : 2! = 2 := rfl

theorem mul_factorial_pred (hn : 0 < n) : n * (n - 1)! = n! :=
tsub_add_cancel_of_le (nat.succ_le_of_lt hn) ▸ rfl

theorem factorial_pos : ∀ n, 0 < n!
| 0        := zero_lt_one
| (succ n) := mul_pos (succ_pos _) (factorial_pos n)

theorem factorial_ne_zero (n : ℕ) : n! ≠ 0 := ne_of_gt (factorial_pos _)

theorem factorial_dvd_factorial {m n} (h : m ≤ n) : m! ∣ n! :=
begin
  induction n with n IH,
  { simp [nat.eq_zero_of_le_zero h] },
  obtain rfl | hl := h.eq_or_lt,
  { simp },
  exact (IH (le_of_lt_succ hl)).mul_left _,
end

theorem dvd_factorial : ∀ {m n}, 0 < m → m ≤ n → m ∣ n!
| (succ m) n _ h := dvd_of_mul_right_dvd (factorial_dvd_factorial h)

@[mono] theorem factorial_le {m n} (h : m ≤ n) : m! ≤ n! :=
le_of_dvd (factorial_pos _) (factorial_dvd_factorial h)

lemma factorial_mul_pow_le_factorial : ∀ {m n : ℕ}, m! * m.succ ^ n ≤ (m + n)!
| m 0     := by simp
| m (n+1) :=
by  rw [← add_assoc, nat.factorial_succ, mul_comm (nat.succ _), pow_succ', ← mul_assoc];
  exact mul_le_mul factorial_mul_pow_le_factorial
    (nat.succ_le_succ (nat.le_add_right _ _)) (nat.zero_le _) (nat.zero_le _)

lemma monotone_factorial : monotone factorial := λ n m, factorial_le

lemma one_lt_factorial : 1 < n! ↔ 1 < n :=
factorial_lt one_pos

lemma factorial_eq_one : n! = 1 ↔ n ≤ 1 :=
begin
  refine ⟨λ h, _, by rintro (_ | _ | _); refl⟩,
  rw [← not_lt, ← one_lt_factorial, h],
  apply lt_irrefl
end

lemma factorial_inj (hn : 1 < n!) : n! = m! ↔ n = m :=
begin
  refine ⟨λ h, _, congr_arg _⟩,
  obtain hnm | rfl | hnm := lt_trichotomy n m,
  { rw [← factorial_lt $ pos_of_gt $ one_lt_factorial.mp hn, h] at hnm,
    cases lt_irrefl _ hnm },
  { refl },
  rw [h, one_lt_factorial] at hn,
  rw [←factorial_lt (lt_trans one_pos hn), h] at hnm,
  cases lt_irrefl _ hnm
end

lemma self_le_factorial : ∀ n : ℕ, n ≤ n!
| 0       := zero_le_one
| (k + 1) := le_mul_of_one_le_right k.zero_lt_succ.le (nat.one_le_of_lt $ nat.factorial_pos _)

lemma lt_factorial_self {n : ℕ} (hi : 3 ≤ n) : n < n! :=
begin
  rw [← succ_pred_eq_of_pos ((zero_lt_two.trans (lt.base 2)).trans_le hi), factorial_succ],
  exact lt_mul_of_one_lt_right ((pred n).succ_pos) ((one_lt_two.trans_le
    (le_pred_of_lt (succ_le_iff.mp hi))).trans_le (self_le_factorial _)),
end

lemma add_factorial_succ_lt_factorial_add_succ {i : ℕ} (n : ℕ) (hi : 2 ≤ i) :
  i + (n + 1)! < (i + n + 1)! :=
begin
  rw [factorial_succ (i + _), add_mul, one_mul],
  have : i ≤ i + n := le.intro rfl,
  exact add_lt_add_of_lt_of_le (this.trans_lt ((lt_mul_iff_one_lt_right (zero_lt_two.trans_le
    (hi.trans this))).mpr (lt_iff_le_and_ne.mpr ⟨(i + n).factorial_pos, λ g,
    nat.not_succ_le_self 1 ((hi.trans this).trans (factorial_eq_one.mp g.symm))⟩))) (factorial_le
    ((le_of_eq (add_comm n 1)).trans ((add_le_add_iff_right n).mpr (one_le_two.trans hi)))),
end

lemma add_factorial_lt_factorial_add {i n : ℕ} (hi : 2 ≤ i) (hn : 1 ≤ n) :
  i + n! < (i + n)! :=
begin
  cases hn,
  { rw factorial_one,
    exact lt_factorial_self (succ_le_succ hi) },
  exact add_factorial_succ_lt_factorial_add_succ _ hi,
end

lemma add_factorial_succ_le_factorial_add_succ (i : ℕ) (n : ℕ) :
  i + (n + 1)! ≤ (i + (n + 1))! :=
begin
  obtain i2 | _ | i0 := le_or_lt 2 i,
  { exact (n.add_factorial_succ_lt_factorial_add_succ i2).le },
  { rw [←add_assoc, factorial_succ (1 + n), add_mul, one_mul, add_comm 1 n],
    exact (add_le_add_iff_right _).mpr (one_le_mul (nat.le_add_left 1 n) (n + 1).factorial_pos) },
  rw [le_zero_iff.mp (nat.succ_le_succ_iff.mp i0), zero_add, zero_add]
end

lemma add_factorial_le_factorial_add (i : ℕ) {n : ℕ} (n1 : 1 ≤ n) :
  i + n! ≤ (i + n)! :=
begin
  cases n1 with h,
  { exact self_le_factorial _ },
  exact add_factorial_succ_le_factorial_add_succ i h,
end

lemma factorial_mul_pow_sub_le_factorial {n m : ℕ} (hnm : n ≤ m) : n! * n ^ (m - n) ≤ m! :=
begin
  suffices : n! * (n + 1) ^ (m - n) ≤ m!,
  { apply trans _ this,
    rw mul_le_mul_left,
    apply pow_le_pow_of_le_left (zero_le n) (le_succ n),
    exact factorial_pos n },
  convert nat.factorial_mul_pow_le_factorial,
  exact (add_tsub_cancel_of_le hnm).symm,
end

end factorial

/-! ### Ascending and descending factorials -/

section asc_factorial

/-- `n.asc_factorial k = (n + k)! / n!` (as seen in `nat.asc_factorial_eq_div`), but implemented
recursively to allow for "quick" computation when using `norm_num`. This is closely related to
`pochhammer`, but much less general. -/
def asc_factorial (n : ℕ) : ℕ → ℕ
| 0 := 1
| (k + 1) := (n + k + 1) * asc_factorial k

@[simp] lemma asc_factorial_zero (n : ℕ) : n.asc_factorial 0 = 1 := rfl

@[simp] lemma zero_asc_factorial (k : ℕ) : (0 : ℕ).asc_factorial k = k! :=
begin
  induction k with t ht,
  { refl },
  rw [asc_factorial, ht, zero_add, nat.factorial_succ],
end

lemma asc_factorial_succ {n k : ℕ} : n.asc_factorial k.succ = (n + k + 1) * n.asc_factorial k := rfl

lemma succ_asc_factorial (n : ℕ) :
  ∀ k, (n + 1) * n.succ.asc_factorial k = (n + k + 1) * n.asc_factorial k
| 0 := by rw [add_zero, asc_factorial_zero, asc_factorial_zero]
| (k + 1) := by rw [asc_factorial, mul_left_comm, succ_asc_factorial, asc_factorial, succ_add,
  ←add_assoc]

/-- `n.asc_factorial k = (n + k)! / n!` but without ℕ-division. See `nat.asc_factorial_eq_div` for
the version with ℕ-division. -/
theorem factorial_mul_asc_factorial (n : ℕ) : ∀ k, n! * n.asc_factorial k = (n + k)!
| 0 := by rw [asc_factorial, add_zero, mul_one]
| (k + 1) := by rw [asc_factorial_succ, mul_left_comm, factorial_mul_asc_factorial, ← add_assoc,
  factorial]

/-- Avoid in favor of `nat.factorial_mul_asc_factorial` if you can. ℕ-division isn't worth it. -/
lemma asc_factorial_eq_div (n k : ℕ) : n.asc_factorial k = (n + k)! / n! :=
begin
  apply mul_left_cancel₀ n.factorial_ne_zero,
  rw factorial_mul_asc_factorial,
  exact (nat.mul_div_cancel' $ factorial_dvd_factorial $ le.intro rfl).symm
end

lemma asc_factorial_of_sub {n k : ℕ} (h : k < n) :
  (n - k) * (n - k).asc_factorial k = (n - (k + 1)).asc_factorial (k + 1) :=
begin
  set t := n - k.succ with ht,
  suffices h' : n - k = t.succ, by rw [←ht, h', succ_asc_factorial, asc_factorial_succ],
  rw [ht, succ_eq_add_one, ←tsub_tsub_assoc (succ_le_of_lt h) (succ_pos _), succ_sub_one],
end

lemma pow_succ_le_asc_factorial (n : ℕ) : ∀ (k : ℕ), (n + 1)^k ≤ n.asc_factorial k
| 0 := by rw [asc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw pow_succ,
  exact nat.mul_le_mul (nat.add_le_add_right le_self_add _) (pow_succ_le_asc_factorial k),
end

lemma pow_lt_asc_factorial' (n k : ℕ) : (n + 1)^(k + 2) < n.asc_factorial (k + 2) :=
begin
  rw pow_succ,
  exact nat.mul_lt_mul (nat.add_lt_add_right (nat.lt_add_of_pos_right succ_pos') 1)
    (pow_succ_le_asc_factorial n _) (pow_pos succ_pos' _),
end

lemma pow_lt_asc_factorial (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → (n + 1)^k < n.asc_factorial k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨⟨⟩⟩)
| (k + 2) := λ _, pow_lt_asc_factorial' n k

lemma asc_factorial_le_pow_add (n : ℕ) : ∀ (k : ℕ), n.asc_factorial k ≤ (n + k)^k
| 0 := by rw [asc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw [asc_factorial_succ, pow_succ],
  exact nat.mul_le_mul_of_nonneg_left ((asc_factorial_le_pow_add k).trans (nat.pow_le_pow_of_le_left
  (le_succ _) _)),
end

lemma asc_factorial_lt_pow_add (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → n.asc_factorial k < (n + k)^k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨⟨⟩⟩)
| (k + 2) := λ _, begin
  rw [asc_factorial_succ, pow_succ],
  refine nat.mul_lt_mul' le_rfl ((asc_factorial_le_pow_add n _).trans_lt
    (pow_lt_pow_of_lt_left (lt_add_one _) (succ_pos _))) (succ_pos _),
end

lemma asc_factorial_pos (n k : ℕ) : 0 < n.asc_factorial k :=
(pow_pos (succ_pos n) k).trans_le (pow_succ_le_asc_factorial n k)

end asc_factorial

section desc_factorial

/-- `n.desc_factorial k = n! / (n - k)!` (as seen in `nat.desc_factorial_eq_div`), but
implemented recursively to allow for "quick" computation when using `norm_num`. This is closely
related to `pochhammer`, but much less general. -/
def desc_factorial (n : ℕ) : ℕ → ℕ
| 0 := 1
| (k + 1) := (n - k) * desc_factorial k

@[simp] lemma desc_factorial_zero (n : ℕ) : n.desc_factorial 0 = 1 := rfl

@[simp] lemma desc_factorial_succ (n k : ℕ) :
  n.desc_factorial k.succ = (n - k) * n.desc_factorial k := rfl

lemma zero_desc_factorial_succ (k : ℕ) :
  (0 : ℕ).desc_factorial k.succ = 0 :=
by rw [desc_factorial_succ, zero_tsub, zero_mul]

@[simp] lemma desc_factorial_one (n : ℕ) :
  n.desc_factorial 1 = n :=
by rw [desc_factorial_succ, desc_factorial_zero, mul_one, tsub_zero]

@[simp] lemma succ_desc_factorial_succ (n : ℕ) :
  ∀ k : ℕ, (n + 1).desc_factorial (k + 1) = (n + 1) * n.desc_factorial k
| 0        := by rw [desc_factorial_zero, desc_factorial_one, mul_one]
| (succ k) := by rw [desc_factorial_succ, succ_desc_factorial_succ, desc_factorial_succ,
  succ_sub_succ, mul_left_comm]

lemma succ_desc_factorial (n : ℕ) :
  ∀ k, (n + 1 - k) * (n + 1).desc_factorial k = (n + 1) * n.desc_factorial k
| 0 := by rw [tsub_zero, desc_factorial_zero, desc_factorial_zero]
| (k + 1) := by rw [desc_factorial, succ_desc_factorial, desc_factorial_succ, succ_sub_succ,
  mul_left_comm]

lemma desc_factorial_self : ∀ n : ℕ, n.desc_factorial n = n!
| 0        := by rw [desc_factorial_zero, factorial_zero]
| (succ n) := by rw [succ_desc_factorial_succ, desc_factorial_self, factorial_succ]

@[simp] lemma desc_factorial_eq_zero_iff_lt {n : ℕ} : ∀ {k : ℕ}, n.desc_factorial k = 0 ↔ n < k
| 0        := by simp only [desc_factorial_zero, nat.one_ne_zero, nat.not_lt_zero]
| (succ k) := begin
  rw [desc_factorial_succ, mul_eq_zero, desc_factorial_eq_zero_iff_lt, lt_succ_iff,
    tsub_eq_zero_iff_le, lt_iff_le_and_ne, or_iff_left_iff_imp, and_imp],
  exact λ h _, h,
end

alias desc_factorial_eq_zero_iff_lt ↔ _ desc_factorial_of_lt

lemma add_desc_factorial_eq_asc_factorial (n : ℕ) :
  ∀ k : ℕ, (n + k).desc_factorial k = n.asc_factorial k
| 0        := by rw [asc_factorial_zero, desc_factorial_zero]
| (succ k) := by rw [nat.add_succ, succ_desc_factorial_succ, asc_factorial_succ,
  add_desc_factorial_eq_asc_factorial]

/-- `n.desc_factorial k = n! / (n - k)!` but without ℕ-division. See `nat.desc_factorial_eq_div`
for the version using ℕ-division. -/
theorem factorial_mul_desc_factorial : ∀ {n k : ℕ}, k ≤ n → (n - k)! * n.desc_factorial k = n!
| n        0        := λ _, by rw [desc_factorial_zero, mul_one, tsub_zero]
| 0        (succ k) := λ h, by { exfalso, exact not_succ_le_zero k h }
| (succ n) (succ k) := λ h, by rw [succ_desc_factorial_succ, succ_sub_succ, ←mul_assoc,
  mul_comm (n - k)!, mul_assoc, factorial_mul_desc_factorial (nat.succ_le_succ_iff.1 h),
    factorial_succ]

/-- Avoid in favor of `nat.factorial_mul_desc_factorial` if you can. ℕ-division isn't worth it. -/
lemma desc_factorial_eq_div {n k : ℕ} (h : k ≤ n) : n.desc_factorial k = n! / (n - k)! :=
begin
  apply mul_left_cancel₀ (factorial_ne_zero (n - k)),
  rw factorial_mul_desc_factorial h,
  exact (nat.mul_div_cancel' $ factorial_dvd_factorial $ nat.sub_le n k).symm,
end

lemma pow_sub_le_desc_factorial (n : ℕ) : ∀ (k : ℕ), (n + 1 - k)^k ≤ n.desc_factorial k
| 0 := by rw [desc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw [desc_factorial_succ, pow_succ, succ_sub_succ],
  exact nat.mul_le_mul_of_nonneg_left (le_trans (nat.pow_le_pow_of_le_left
    (tsub_le_tsub_right (le_succ _) _) k) (pow_sub_le_desc_factorial k)),
end

lemma pow_sub_lt_desc_factorial' {n : ℕ} :
  ∀ {k : ℕ}, k + 2 ≤ n → (n - (k + 1))^(k + 2) < n.desc_factorial (k + 2)
| 0 := λ h, begin
  rw [desc_factorial_succ, pow_succ, pow_one, desc_factorial_one],
  exact nat.mul_lt_mul_of_pos_left (tsub_lt_self (lt_of_lt_of_le zero_lt_two h) zero_lt_one)
    (tsub_pos_of_lt h),
end
| (k + 1) := λ h, begin
  rw [desc_factorial_succ, pow_succ],
  refine nat.mul_lt_mul_of_pos_left ((nat.pow_le_pow_of_le_left (tsub_le_tsub_right
    (le_succ n) _) _).trans_lt _) (tsub_pos_of_lt h),
  rw succ_sub_succ,
  exact (pow_sub_lt_desc_factorial' ((le_succ _).trans h)),
end

lemma pow_sub_lt_desc_factorial {n : ℕ} :
  ∀ {k : ℕ}, 2 ≤ k → k ≤ n → (n + 1 - k)^k < n.desc_factorial k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨⟨⟩⟩)
| (k + 2) := λ _ h, by { rw succ_sub_succ, exact pow_sub_lt_desc_factorial' h }

lemma desc_factorial_le_pow (n : ℕ) : ∀ (k : ℕ), n.desc_factorial k ≤ n^k
| 0 := by rw [desc_factorial_zero, pow_zero]
| (k + 1) := begin
  rw [desc_factorial_succ, pow_succ],
  exact nat.mul_le_mul (nat.sub_le _ _) (desc_factorial_le_pow k),
end

lemma desc_factorial_lt_pow {n : ℕ} (hn : 1 ≤ n) : ∀ {k : ℕ}, 2 ≤ k → n.desc_factorial k < n^k
| 0 := by rintro ⟨⟩
| 1 := by rintro (_ | ⟨⟨⟩⟩)
| (k + 2) := λ _, begin
  rw [desc_factorial_succ, pow_succ', mul_comm],
  exact nat.mul_lt_mul' (desc_factorial_le_pow _ _) (tsub_lt_self hn k.zero_lt_succ)
    (pow_pos hn _),
end

end desc_factorial

end nat