/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau
-/
import data.list.big_operators

/-!
# zip & unzip

This file provides results about `list.zip_with`, `list.zip` and `list.unzip` (definitions are in
core Lean).
`zip_with f l₁ l₂` applies `f : α → β → γ` pointwise to a list `l₁ : list α` and `l₂ : list β`. It
applies, until one of the lists is exhausted. For example,
`zip_with f [0, 1, 2] [6.28, 31] = [f 0 6.28, f 1 31]`.
`zip` is `zip_with` applied to `prod.mk`. For example,
`zip [a₁, a₂] [b₁, b₂, b₃] = [(a₁, b₁), (a₂, b₂)]`.
`unzip` undoes `zip`. For example, `unzip [(a₁, b₁), (a₂, b₂)] = ([a₁, a₂], [b₁, b₂])`.
-/

universe u

open nat

namespace list
variables {α : Type u} {β γ δ : Type*}

@[simp] theorem zip_with_cons_cons (f : α → β → γ) (a : α) (b : β) (l₁ : list α) (l₂ : list β) :
  zip_with f (a :: l₁) (b :: l₂) = f a b :: zip_with f l₁ l₂ := rfl

@[simp] theorem zip_cons_cons (a : α) (b : β) (l₁ : list α) (l₂ : list β) :
  zip (a :: l₁) (b :: l₂) = (a, b) :: zip l₁ l₂ := rfl

@[simp] theorem zip_with_nil_left (f : α → β → γ) (l) : zip_with f [] l = [] := rfl

@[simp] theorem zip_with_nil_right (f : α → β → γ) (l)  : zip_with f l [] = [] :=
by cases l; refl

@[simp] lemma zip_with_eq_nil_iff {f : α → β → γ} {l l'} :
  zip_with f l l' = [] ↔ l = [] ∨ l' = [] :=
by { cases l; cases l'; simp }

@[simp] theorem zip_nil_left (l : list α) : zip ([] : list β) l = [] := rfl

@[simp] theorem zip_nil_right (l : list α) : zip l ([] : list β) = [] :=
zip_with_nil_right _ l

@[simp] theorem zip_swap : ∀ (l₁ : list α) (l₂ : list β),
  (zip l₁ l₂).map prod.swap = zip l₂ l₁
| []      l₂      := (zip_nil_right _).symm
| l₁      []      := by rw zip_nil_right; refl
| (a::l₁) (b::l₂) := by simp only [zip_cons_cons, map_cons, zip_swap l₁ l₂, prod.swap_prod_mk];
    split; refl

@[simp] theorem length_zip_with (f : α → β → γ) : ∀  (l₁ : list α) (l₂ : list β),
   length (zip_with f l₁ l₂) = min (length l₁) (length l₂)
| []      l₂      := rfl
| l₁      []      := by simp only [length, min_zero, zip_with_nil_right]
| (a::l₁) (b::l₂) := by simp [length, zip_cons_cons, length_zip_with l₁ l₂, min_add_add_right]

@[simp] theorem length_zip : ∀ (l₁ : list α) (l₂ : list β),
   length (zip l₁ l₂) = min (length l₁) (length l₂) :=
length_zip_with _

lemma lt_length_left_of_zip_with {f : α → β → γ} {i : ℕ} {l : list α} {l' : list β}
  (h : i < (zip_with f l l').length) :
  i < l.length :=
by { rw [length_zip_with, lt_min_iff] at h, exact h.left }

lemma lt_length_right_of_zip_with {f : α → β → γ} {i : ℕ} {l : list α} {l' : list β}
  (h : i < (zip_with f l l').length) :
  i < l'.length :=
by { rw [length_zip_with, lt_min_iff] at h, exact h.right }

lemma lt_length_left_of_zip {i : ℕ} {l : list α} {l' : list β} (h : i < (zip l l').length) :
  i < l.length :=
lt_length_left_of_zip_with h

lemma lt_length_right_of_zip {i : ℕ} {l : list α} {l' : list β} (h : i < (zip l l').length) :
  i < l'.length :=
lt_length_right_of_zip_with h

theorem zip_append : ∀ {l₁ r₁ : list α} {l₂ r₂ : list β} (h : length l₁ = length l₂),
   zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂
| []      r₁ l₂      r₂ h := by simp only [eq_nil_of_length_eq_zero h.symm]; refl
| l₁      r₁ []      r₂ h := by simp only [eq_nil_of_length_eq_zero h]; refl
| (a::l₁) r₁ (b::l₂) r₂ h := by simp only [cons_append, zip_cons_cons, zip_append (succ.inj h)];
    split; refl

theorem zip_map (f : α → γ) (g : β → δ) : ∀ (l₁ : list α) (l₂ : list β),
   zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (prod.map f g)
| []      l₂      := rfl
| l₁      []      := by simp only [map, zip_nil_right]
| (a::l₁) (b::l₂) := by simp only [map, zip_cons_cons, zip_map l₁ l₂, prod.map]; split; refl

theorem zip_map_left (f : α → γ) (l₁ : list α) (l₂ : list β) :
   zip (l₁.map f) l₂ = (zip l₁ l₂).map (prod.map f id) :=
by rw [← zip_map, map_id]

theorem zip_map_right (f : β → γ) (l₁ : list α) (l₂ : list β) :
   zip l₁ (l₂.map f) = (zip l₁ l₂).map (prod.map id f) :=
by rw [← zip_map, map_id]

@[simp] lemma zip_with_map {μ}
  (f : γ → δ → μ) (g : α → γ) (h : β → δ) (as : list α) (bs : list β) :
  zip_with f (as.map g) (bs.map h) =
  zip_with (λ a b, f (g a) (h b)) as bs :=
begin
  induction as generalizing bs,
  { simp },
  { cases bs; simp * }
end

lemma zip_with_map_left
  (f : α → β → γ) (g : δ → α) (l : list δ) (l' : list β) :
  zip_with f (l.map g) l' = zip_with (f ∘ g) l l' :=
by { convert (zip_with_map f g id l l'), exact eq.symm (list.map_id _) }

lemma zip_with_map_right
  (f : α → β → γ) (l : list α) (g : δ → β) (l' : list δ) :
  zip_with f l (l'.map g) = zip_with (λ x, f x ∘ g) l l' :=
by { convert (list.zip_with_map f id g l l'), exact eq.symm (list.map_id _) }

theorem zip_map' (f : α → β) (g : α → γ) : ∀ (l : list α),
   zip (l.map f) (l.map g) = l.map (λ a, (f a, g a))
| []     := rfl
| (a::l) := by simp only [map, zip_cons_cons, zip_map' l]; split; refl

lemma map_zip_with {δ : Type*} (f : α → β) (g : γ → δ → α) (l : list γ) (l' : list δ) :
  map f (zip_with g l l') = zip_with (λ x y, f (g x y)) l l' :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l',
    { simp },
    { simp [hl] } }
end

theorem mem_zip {a b} : ∀ {l₁ : list α} {l₂ : list β},
   (a, b) ∈ zip l₁ l₂ → a ∈ l₁ ∧ b ∈ l₂
| (_::l₁) (_::l₂) (or.inl rfl) := ⟨or.inl rfl, or.inl rfl⟩
| (a'::l₁) (b'::l₂) (or.inr h) := by split; simp only [mem_cons_iff, or_true, mem_zip h]

theorem map_fst_zip : ∀ (l₁ : list α) (l₂ : list β),
  l₁.length ≤ l₂.length →
  map prod.fst (zip l₁ l₂) = l₁
| [] bs _ := rfl
| (a :: as) (b :: bs) h := by { simp at h, simp! * }
| (a :: as) [] h := by { simp at h, contradiction }

theorem map_snd_zip : ∀ (l₁ : list α) (l₂ : list β),
  l₂.length ≤ l₁.length →
  map prod.snd (zip l₁ l₂) = l₂
| _ [] _ := by { rw zip_nil_right, refl }
| [] (b :: bs) h := by { simp at h, contradiction }
| (a :: as) (b :: bs) h := by { simp at h, simp! * }

@[simp] theorem unzip_nil : unzip (@nil (α × β)) = ([], []) := rfl

@[simp] theorem unzip_cons (a : α) (b : β) (l : list (α × β)) :
   unzip ((a, b) :: l) = (a :: (unzip l).1, b :: (unzip l).2) :=
by rw unzip; cases unzip l; refl

theorem unzip_eq_map : ∀ (l : list (α × β)), unzip l = (l.map prod.fst, l.map prod.snd)
| []            := rfl
| ((a, b) :: l) := by simp only [unzip_cons, map_cons, unzip_eq_map l]

theorem unzip_left (l : list (α × β)) : (unzip l).1 = l.map prod.fst :=
by simp only [unzip_eq_map]

theorem unzip_right (l : list (α × β)) : (unzip l).2 = l.map prod.snd :=
by simp only [unzip_eq_map]

theorem unzip_swap (l : list (α × β)) : unzip (l.map prod.swap) = (unzip l).swap :=
by simp only [unzip_eq_map, map_map]; split; refl

theorem zip_unzip : ∀ (l : list (α × β)), zip (unzip l).1 (unzip l).2 = l
| []            := rfl
| ((a, b) :: l) := by simp only [unzip_cons, zip_cons_cons, zip_unzip l]; split; refl

theorem unzip_zip_left : ∀ {l₁ : list α} {l₂ : list β}, length l₁ ≤ length l₂ →
  (unzip (zip l₁ l₂)).1 = l₁
| []      l₂      h := rfl
| l₁      []      h := by rw eq_nil_of_length_eq_zero (nat.eq_zero_of_le_zero h); refl
| (a::l₁) (b::l₂) h := by simp only [zip_cons_cons, unzip_cons,
    unzip_zip_left (le_of_succ_le_succ h)]; split; refl

theorem unzip_zip_right {l₁ : list α} {l₂ : list β} (h : length l₂ ≤ length l₁) :
  (unzip (zip l₁ l₂)).2 = l₂ :=
by rw [← zip_swap, unzip_swap]; exact unzip_zip_left h

theorem unzip_zip {l₁ : list α} {l₂ : list β} (h : length l₁ = length l₂) :
  unzip (zip l₁ l₂) = (l₁, l₂) :=
by rw [← @prod.mk.eta _ _ (unzip (zip l₁ l₂)),
  unzip_zip_left (le_of_eq h), unzip_zip_right (ge_of_eq h)]

lemma zip_of_prod {l : list α} {l' : list β} {lp : list (α × β)}
  (hl : lp.map prod.fst = l) (hr : lp.map prod.snd = l') :
  lp = l.zip l' :=
by rw [←hl, ←hr, ←zip_unzip lp, ←unzip_left, ←unzip_right, zip_unzip, zip_unzip]

lemma map_prod_left_eq_zip {l : list α} (f : α → β) : l.map (λ x, (x, f x)) = l.zip (l.map f) :=
by { rw ←zip_map', congr, exact map_id _ }

lemma zip_with_comm (f : α → α → β) (comm : ∀ (x y : α), f x y = f y x)
  (l l' : list α) :
  zip_with f l l' = zip_with f l' l :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l',
    { simp },
    { simp [comm, hl] } }
end

instance (f : α → α → β) [is_symm_op α β f] : is_symm_op (list α) (list β) (zip_with f) :=
⟨zip_with_comm f is_symm_op.symm_op⟩

@[simp] theorem length_revzip (l : list α) : length (revzip l) = length l :=
by simp only [revzip, length_zip, length_reverse, min_self]

@[simp] theorem unzip_revzip (l : list α) : (revzip l).unzip = (l, l.reverse) :=
unzip_zip (length_reverse l).symm

@[simp] theorem revzip_map_fst (l : list α) : (revzip l).map prod.fst = l :=
by rw [← unzip_left, unzip_revzip]

@[simp] theorem revzip_map_snd (l : list α) : (revzip l).map prod.snd = l.reverse :=
by rw [← unzip_right, unzip_revzip]

theorem reverse_revzip (l : list α) : reverse l.revzip = revzip l.reverse :=
by rw [← zip_unzip.{u u} (revzip l).reverse, unzip_eq_map]; simp; simp [revzip]

theorem revzip_swap (l : list α) : (revzip l).map prod.swap = revzip l.reverse :=
by simp [revzip]

lemma nth_zip_with (f : α → β → γ) (l₁ : list α) (l₂ : list β) (i : ℕ) :
  (zip_with f l₁ l₂).nth i = ((l₁.nth i).map f).bind (λ g, (l₂.nth i).map g) :=
begin
  induction l₁ generalizing l₂ i,
  { simp [zip_with, (<*>)] },
  { cases l₂; simp only [zip_with, has_seq.seq, functor.map, nth, option.map_none'],
    { cases ((l₁_hd :: l₁_tl).nth i); refl },
    { cases i; simp only [option.map_some', nth, option.some_bind', *] } }
end

lemma nth_zip_with_eq_some {α β γ} (f : α → β → γ) (l₁ : list α) (l₂ : list β) (z : γ) (i : ℕ) :
  (zip_with f l₁ l₂).nth i = some z ↔ ∃ x y, l₁.nth i = some x ∧ l₂.nth i = some y ∧ f x y = z :=
begin
  induction l₁ generalizing l₂ i,
  { simp [zip_with] },
  { cases l₂; simp only [zip_with, nth, exists_false, and_false, false_and],
    cases i; simp *, },
end

lemma nth_zip_eq_some (l₁ : list α) (l₂ : list β) (z : α × β) (i : ℕ) :
  (zip l₁ l₂).nth i = some z ↔ l₁.nth i = some z.1 ∧ l₂.nth i = some z.2 :=
begin
  cases z,
  rw [zip, nth_zip_with_eq_some], split,
  { rintro ⟨x, y, h₀, h₁, h₂⟩, cc },
  { rintro ⟨h₀, h₁⟩, exact ⟨_,_,h₀,h₁,rfl⟩ }
end

@[simp] lemma nth_le_zip_with {f : α → β → γ} {l : list α} {l' : list β} {i : ℕ}
  {h : i < (zip_with f l l').length} :
  (zip_with f l l').nth_le i h =
    f (l.nth_le i (lt_length_left_of_zip_with h)) (l'.nth_le i (lt_length_right_of_zip_with h)) :=
begin
  rw [←option.some_inj, ←nth_le_nth, nth_zip_with_eq_some],
  refine ⟨l.nth_le i (lt_length_left_of_zip_with h), l'.nth_le i (lt_length_right_of_zip_with h),
          nth_le_nth _, _⟩,
  simp only [←nth_le_nth, eq_self_iff_true, and_self]
end

@[simp] lemma nth_le_zip {l : list α} {l' : list β} {i : ℕ} {h : i < (zip l l').length} :
  (zip l l').nth_le i h =
    (l.nth_le i (lt_length_left_of_zip h), l'.nth_le i (lt_length_right_of_zip h)) :=
nth_le_zip_with

lemma mem_zip_inits_tails {l : list α} {init tail : list α} :
  (init, tail) ∈ zip l.inits l.tails ↔ init ++ tail = l :=
begin
  induction l generalizing init tail;
    simp_rw [tails, inits, zip_cons_cons],
  { simp },
  { split; rw [mem_cons_iff, zip_map_left, mem_map, prod.exists],
    { rintros (⟨rfl, rfl⟩ | ⟨_, _, h, rfl, rfl⟩),
      { simp },
      { simp [l_ih.mp h], }, },
    { cases init,
      { simp },
      { intro h,
        right,
        use [init_tl, tail],
        simp * at *, }, }, },
end

lemma map_uncurry_zip_eq_zip_with
  (f : α → β → γ) (l : list α) (l' : list β) :
  map (function.uncurry f) (l.zip l') = zip_with f l l' :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l' with hd' tl',
    { simp },
    { simp [hl] } }
end

@[simp] lemma sum_zip_with_distrib_left {γ : Type*} [semiring γ]
  (f : α → β → γ) (n : γ) (l : list α) (l' : list β) :
  (l.zip_with (λ x y, n * f x y) l').sum = n * (l.zip_with f l').sum :=
begin
  induction l with hd tl hl generalizing f n l',
  { simp },
  { cases l' with hd' tl',
    { simp, },
    { simp [hl, mul_add] } }
end

section distrib

/-! ### Operations that can be applied before or after a `zip_with` -/

variables (f : α → β → γ) (l : list α) (l' : list β) (n : ℕ)

lemma zip_with_distrib_take :
  (zip_with f l l').take n = zip_with f (l.take n) (l'.take n) :=
begin
  induction l with hd tl hl generalizing l' n,
  { simp },
  { cases l',
    { simp },
    { cases n,
      { simp },
      { simp [hl] } } }
end

lemma zip_with_distrib_drop :
  (zip_with f l l').drop n = zip_with f (l.drop n) (l'.drop n) :=
begin
  induction l with hd tl hl generalizing l' n,
  { simp },
  { cases l',
    { simp },
    { cases n,
      { simp },
      { simp [hl] } } }
end

lemma zip_with_distrib_tail :
  (zip_with f l l').tail = zip_with f l.tail l'.tail :=
by simp_rw [←drop_one, zip_with_distrib_drop]

lemma zip_with_append (f : α → β → γ) (l la : list α) (l' lb : list β) (h : l.length = l'.length) :
  zip_with f (l ++ la) (l' ++ lb) = zip_with f l l' ++ zip_with f la lb :=
begin
  induction l with hd tl hl generalizing l',
  { have : l' = [] := eq_nil_of_length_eq_zero (by simpa using h.symm),
    simp [this], },
  { cases l',
    { simpa using h },
    { simp only [add_left_inj, length] at h,
      simp [hl _ h] } }
end

lemma zip_with_distrib_reverse (h : l.length = l'.length) :
  (zip_with f l l').reverse = zip_with f l.reverse l'.reverse :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l' with hd' tl',
    { simp },
    { simp only [add_left_inj, length] at h,
      have : tl.reverse.length = tl'.reverse.length := by simp [h],
      simp [hl _ h, zip_with_append _ _ _ _ _ this] } }
end

end distrib

section comm_monoid

variables [comm_monoid α]

@[to_additive]
lemma prod_mul_prod_eq_prod_zip_with_mul_prod_drop : ∀ (L L' : list α), L.prod * L'.prod =
  (zip_with (*) L L').prod * (L.drop L'.length).prod * (L'.drop L.length).prod
| [] ys := by simp
| xs [] := by simp
| (x :: xs) (y :: ys) := begin
  simp only [drop, length, zip_with_cons_cons, prod_cons],
  rw [mul_assoc x, mul_comm xs.prod, mul_assoc y, mul_comm ys.prod,
    prod_mul_prod_eq_prod_zip_with_mul_prod_drop xs ys, mul_assoc, mul_assoc, mul_assoc, mul_assoc]
end

@[to_additive]
lemma prod_mul_prod_eq_prod_zip_with_of_length_eq (L L' : list α) (h : L.length = L'.length) :
  L.prod * L'.prod = (zip_with (*) L L').prod :=
(prod_mul_prod_eq_prod_zip_with_mul_prod_drop L L').trans (by simp [h])

end comm_monoid

end list


import ch1

namespace Set

theorem russels_paradox : ¬ ∃ S : Set, ∀ x, x ∈ S ↔ x ∉ x :=
begin
  rintro ⟨S, hs⟩,
  specialize hs S,
  exact (iff_not_self _).mp hs,
end
-- axiom of specification is enabled by has_sep and mem_sep
theorem univ_not_set : ¬ ∃ S : Set, ∀ x, x ∈ S :=
begin
  rintro ⟨S, hs⟩,
  apply russels_paradox,
  let B := {x ∈ S | x ∉ x},
  refine ⟨B, _⟩,
  intro x,
  rw mem_sep,
  exact and_iff_right (hs x),
end
theorem univ_not_set' (A : Set) : ∃ x, x ∉ A :=
begin
  let B := {x ∈ A | x ∉ x},
  refine ⟨B, _⟩,
  intro he,
  suffices h : B ∈ B ↔ B ∈ A ∧ B ∉ B,
    rw @and_iff_right _ (B ∉ B) he at h,
    exact (iff_not_self (B ∈ B)).mp h,
  exact mem_sep,
end
-- set union enabled by Union and mem_Union
theorem union_empty_eq_empty : (∅ : Set).Union = ∅ :=
begin
  apply ext, intro z,
  rw (iff_false _).mpr (mem_empty z),
  rw iff_false,
  rw mem_Union,
  rintro ⟨y, H, hi⟩,
  exact mem_empty y H,
end
def Inter (A : Set) : Set := {x ∈ A.Union | ∀ z ∈ A, x ∈ z}
def inhab (A : Set) : Prop := ∃ x, x ∈ A
theorem ne_empty_of_inhabited (A : Set) (h : A.inhab) : A ≠ ∅ :=
begin
  cases h with x h,
  intro he,
  rw he at h,
  exact mem_empty x h,
end
theorem inhabited_of_ne_empty {A : Set} (hA : A ≠ ∅) : A.inhab :=
begin
  apply classical.by_contradiction, intro hni, apply hA, rw eq_empty, intros z hz, apply hni, exact ⟨_, hz⟩,
end

lemma vacuous {p : Set → Prop} : ∀ x : Set, x ∈ (∅ : Set) → p x :=
begin
  intros x hx, exfalso, exact mem_empty _ hx,
end

theorem exists_unique_of_exists {p : Set → Prop} (h : ∃ x : Set, ∀ z, z ∈ x ↔ p z) : ∃! x : Set, ∀ z, z ∈ x ↔ p z :=
begin
  cases h with x h,
  refine ⟨x, h, (λ y H, _)⟩,
  refine ext (λ z, _),
  simp only [h z, H z],
end
theorem exists_unique_Inter {A : Set} (h : A.inhab) : ∃! B : Set, ∀ x, x ∈ B ↔ ∀ z ∈ A, x ∈ z :=
begin
  apply exists_unique_of_exists,
  cases h with c hin,
  refine ⟨{x ∈ c | ∀ z ∈ A, x ∈ z}, (λ z, _)⟩,
  simp only [mem_sep],
  split,
    rintro ⟨hz, ha⟩, exact ha,
  intro h,
  exact ⟨h c hin, h⟩,
end
theorem not_exists_Inter_empty : ¬ ∃ B : Set, ∀ x, x ∈ B ↔ ∀ z ∈ (∅ : Set), x ∈ z :=
begin
  rintro ⟨B, h⟩,
  apply univ_not_set,
  refine ⟨B, _⟩,
  intro x,
  specialize h x,
  rw h,
  intros a he,
  exfalso, exact mem_empty a he,
end
theorem no_abs_complement {A : Set} [decidable_pred (λ x, x ∈ A)] : ¬ ∃ B : Set, ∀ x, x ∈ B ↔ x ∉ A :=
begin
  rintro ⟨B, h⟩,
  apply univ_not_set,
  refine ⟨A ∪ B, _⟩,
  intro x,
  specialize h x,
  simp only [mem_union, h],
  exact decidable.em _,
end
theorem p10 {a B : Set} (h : a ∈ B) : a.powerset ∈ B.Union.powerset.powerset :=
begin
  rw mem_powerset,
  intros x h₂,
  rw mem_powerset at h₂,
  rw mem_powerset,
  intros z h₃,
  rw mem_Union,
  exact ⟨a, h, h₂ h₃⟩,
end

@[simp]
lemma mem_Inter {A x : Set} : x ∈ A.Inter ↔ A.inhab ∧ ∀ z ∈ A, x ∈ z :=
begin
  simp [Inter, mem_sep, inhab], intro ha, split,
  { rintro ⟨z, hz, hx⟩, exact ⟨_, hz⟩, },
  { rintro ⟨x, hx⟩, exact ⟨_, hx, ha _ hx⟩, },
end

lemma subset_self {A : Set} : A ⊆ A := (λ x hx, hx)

lemma eq_iff_subset_and_subset {A B : Set} : A = B ↔ A ⊆ B ∧ B ⊆ A :=
begin
  split, intro he, rw he, exact ⟨subset_self, subset_self⟩,
  rintro ⟨ha, hb⟩, apply ext, intro x, rw iff_iff_implies_and_implies, rw subset_def at *, exact ⟨@ha x, @hb x⟩,
end

lemma diff_ne_empty_of_ne {B A : Set} (hBA : B ⊆ A) (hne : B ≠ A) : (A \ B) ≠ ∅ :=
begin
  intro he, apply hne, rw eq_iff_subset_and_subset, refine ⟨hBA, _⟩,
  intros x hx, apply classical.by_contradiction, intro hxB,
  apply mem_empty x, rw ←he, rw mem_diff, exact ⟨hx, hxB⟩,
end

lemma subset_trans {A B C : Set} (hA : A ⊆ B) (hB : B ⊆ C) : A ⊆ C := (λ x hx, hB (hA hx))

lemma subset_Union {X Y : Set} (h : X ∈ Y) : X ⊆ Y.Union :=
begin
  simp only [subset_def, mem_Union, exists_prop], exact (λ z hz, ⟨_, h, hz⟩),
end

lemma subset_Inter {X Y : Set} (h : X ∈ Y) : Y.Inter ⊆ X :=
begin
  simp only [subset_def, mem_Inter], exact (λ z ⟨hi, ha⟩, ha _ h),
end

lemma mem_powerset_self {X : Set} : X ∈ X.powerset :=
begin
  rw mem_powerset, exact subset_self,
end

@[simp]
lemma sep_subset {a : Set} {p : Set → Prop} : {x ∈ a | p x} ⊆ a := (λ x hx, (mem_sep.mp hx).left)

theorem p21 {A B : Set} : (A ∪ B).Union = A.Union ∪ B.Union :=
begin
  apply ext, simp only [exists_prop, mem_union, mem_Union], intro x, split,
  { rintro ⟨X, (hX|hX), hx⟩,
    { left, exact ⟨_, hX, hx⟩, },
    { right, exact ⟨_, hX, hx⟩, }, },
  { rintro (⟨X, hX, hx⟩|⟨X, hX, hx⟩),
    { exact ⟨_, or.inl hX, hx⟩, },
    { exact ⟨_, or.inr hX, hx⟩, }, },
end

lemma union_comm {x y : Set} : x ∪ y = y ∪ x :=
begin
  apply ext, simp only [mem_union, or_comm, forall_const, iff_self],
end

lemma union_empty {x : Set} : x ∪ ∅ = x :=
begin
  apply ext, simp only [mem_union, mem_empty, forall_const, iff_self, or_false],
end

lemma inter_comm {x y : Set} : x ∩ y = y ∩ x :=
begin
  apply ext, simp only [mem_inter, and_comm, iff_self, implies_true_iff],
end

lemma inter_union {A B C : Set} : A ∩ (B ∪ C) = A ∩ B ∪ A ∩ C :=
begin
  apply ext, simp only [and_or_distrib_left, forall_const, mem_inter, iff_self, mem_union],
end

lemma union_inter {A B C : Set} : (A ∪ B) ∩ C = A ∩ C ∪ B ∩ C :=
begin
  apply ext, simp only [mem_inter, mem_union, or_and_distrib_right, forall_const, iff_self],
end

lemma union_assoc {A B C : Set} : A ∪ (B ∪ C) = (A ∪ B) ∪ C :=
begin
  apply ext, simp only [mem_union, or_assoc, forall_const, iff_self],
end

lemma inter_empty {A : Set} : A ∩ ∅ = ∅ :=
begin
  simp only [eq_empty, mem_inter, mem_empty, forall_const, not_false_iff, and_false],
end

lemma subset_union_left {A B : Set} : A ⊆ A ∪ B := subset_union_of_subset subset_self

lemma subset_union_right {A B : Set} : B ⊆ A ∪ B := begin rw union_comm, exact subset_union_left, end

lemma subset_union_of_subset_left {A B C : Set} (hAB : A ⊆ B) : A ⊆ B ∪ C :=
begin intros x hx, rw mem_union, exact or.inl (hAB hx), end

lemma subset_union_of_subset_right {A B C : Set} (hAB : A ⊆ C) : A ⊆ B ∪ C :=
begin intros x hx, rw mem_union, exact or.inr (hAB hx), end

lemma union_subset_of_subset_of_subset {A B C : Set} (hA : A ⊆ C) (hB : B ⊆ C) : (A ∪ B) ⊆ C :=
begin
  intro x, rw mem_union, rintro (hx|hx),
  { exact hA hx, },
  { exact hB hx, },
end

lemma union_eq_union_diff {A B : Set} : A ∪ B = A ∪ (B \ A) :=
begin
  apply ext, simp only [mem_union, mem_diff, or_and_distrib_left, classical.em, forall_const, and_true, iff_self],
end

lemma union_eq_left_of_subset {A B : Set} (hBA : B ⊆ A) : A ∪ B = A :=
begin
  rw eq_iff_subset_and_subset,
  exact ⟨union_subset_of_subset_of_subset subset_self hBA, subset_union_left⟩,
end

lemma union_diff_eq_self_of_subset {A B : Set} (hAB : A ⊆ B) : A ∪ (B \ A) = B :=
begin
  rw [←union_eq_union_diff, eq_iff_subset_and_subset],
  exact ⟨union_subset_of_subset_of_subset hAB subset_self, subset_union_right⟩,
end

lemma diff_singleton_union_eq {A x : Set} (xA : x ∈ A) : (A \ {x}) ∪ {x} = A :=
begin
  rw union_comm, apply union_diff_eq_self_of_subset,
  intros z zx, rw mem_singleton at zx, subst zx, exact xA,
end

lemma subset_diff {A B : Set} : A \ B ⊆ A :=
begin
  intros x hx, rw mem_diff at hx, exact hx.left,
end

lemma self_inter_diff_empty {A B : Set} : A ∩ (B \ A) = ∅ :=
begin
  simp [eq_empty, mem_inter, mem_diff], intros x hA hB, exact hA,
end

lemma subset_Union_of_mem {X K : Set} (hXK : X ∈ K) : X ⊆ K.Union :=
begin
  intros z hz, rw mem_Union, exact ⟨_, hXK, hz⟩,
end

lemma Union_powerset_subset_self {X : Set} : X.powerset.Union ⊆ X :=
begin
  intros z hz, simp only [mem_Union, exists_prop, mem_powerset] at hz, rcases hz with ⟨Y, hYX, hzy⟩,
  exact hYX hzy,
end

lemma Union_subset_of_subset_powerset {X Y : Set} (h : X ⊆ Y.powerset) : X.Union ⊆ Y :=
begin
  intros x hx, rw mem_Union at hx, rcases hx with ⟨Z, hZX, hxZ⟩, specialize h hZX, rw mem_powerset at h,
  exact h hxZ,
end

lemma diff_diff_eq_self_of_subset {A B : Set} (hBA : B ⊆ A) : A \ (A \ B) = B :=
begin
  apply ext, intro x, simp only [mem_diff], split,
    rintro ⟨hA, h⟩, apply classical.by_contradiction, intro hB, exact h ⟨hA, hB⟩,
  intro hB, refine ⟨hBA hB, _⟩, rintro ⟨hA, hB'⟩, exact hB' hB,
end

lemma empty_subset {A : Set} : ∅ ⊆ A :=
λ x : Set, assume hx : x ∈ ∅, show x ∈ A, from false.elim (mem_empty x hx)

lemma prod_subset_of_subset_of_subset {A B : Set} (hAB : A ⊆ B) {C D : Set} (hCD : C ⊆ D) : A.prod C ⊆ B.prod D :=
begin
  intros z hz, simp only [mem_prod, exists_prop] at *,
  rcases hz with ⟨a, ha, c, hc, he⟩,
  exact ⟨_, hAB ha, _, hCD hc, he⟩,
end

lemma inter_eq_of_subset {A B : Set} (hAB : A ⊆ B) : B ∩ A = A :=
begin
  apply ext, intro x, rw mem_inter, split,
    rintro ⟨hB, hA⟩, exact hA,
  intro hA, exact ⟨hAB hA, hA⟩,
end

lemma inter_subset_right {A B : Set} : A ∩ B ⊆ B :=
begin
  intros x xAB, rw mem_inter at xAB, exact xAB.right,
end

lemma inter_subset_left {A B : Set} : A ∩ B ⊆ A :=
begin
  intros x xAB, rw mem_inter at xAB, exact xAB.left,
end

lemma diff_sub_diff_of_sub {A B : Set} (AB : A ⊆ B) {C : Set} : C \ B ⊆ C \ A :=
begin
  intros x xCB, rw mem_diff at *, exact ⟨xCB.left, assume xA, xCB.right (AB xA)⟩,
end

lemma mem_sep' {X : Set} {p : Set → Prop} {x : Set} (xX : x ∈ X) : x ∈ {x ∈ X | p x} ↔ p x :=
by simp only [mem_sep, xX, true_and]

lemma inter_eq_of_sub {A B : Set} (AB : A ⊆ B) : A ∩ B = A :=
begin
  apply ext, intro x, rw mem_inter, split,
    rintro ⟨xA, -⟩, exact xA,
  intro xA, exact ⟨xA, AB xA⟩,
end

lemma singleton_ne_empty {x : Set} : ({x} : Set) ≠ ∅ :=
begin
  apply ne_empty_of_inhabited, use x, rw mem_singleton,
end

lemma sub_inter_of_sub {x a b : Set} (xa : x ⊆ a) (xb : x ⊆ b) : x ⊆ a ∩ b :=
begin
  intros z zx, rw mem_inter, exact ⟨xa zx, xb zx⟩,
end

lemma Union_sub_of_sub {A B : Set} (AB : A ⊆ B) : A.Union ⊆ B.Union :=
begin
  simp only [subset_def, mem_Union, exists_prop],
  rintros x ⟨y, yA, xy⟩, exact ⟨_, AB yA, xy⟩,
end

lemma Union_sub {A X : Set} (h : ∀ {x : Set}, x ∈ X → x ⊆ A) : X.Union ⊆ A :=
begin
  intro z, rw mem_Union, rintro ⟨x, xX, zx⟩, exact h xX zx,
end

lemma Union_diff_empty_eq {A : Set} : A.Union = (A \ {∅}).Union :=
begin
  apply ext, simp only [mem_Union, exists_prop, mem_diff, mem_singleton], intro x, split,
    rintro ⟨y, yA, xy⟩, refine ⟨_, ⟨yA, _⟩, xy⟩, apply ne_empty_of_inhabited, rw inhab, exact ⟨_, xy⟩,
  rintro ⟨y, ⟨yA, -⟩, xy⟩, finish,
end

lemma union_eq_Union {A B : Set} : A ∪ B = Union {A, B} :=
begin
  apply ext, simp only [mem_union, mem_Union, exists_prop, mem_insert, mem_singleton], intro x, split,
    finish,
  rintro ⟨z, (hz|hz), xz⟩; finish,
end

lemma Union_empty : Union ∅ = ∅ :=
begin
  rw eq_empty, intros z h, rw mem_Union at h, rcases h with ⟨x, h, -⟩, exact mem_empty _ h,
end

lemma inhab_of_Union_inhab {S : Set} (inh : S.Union.inhab) : S.inhab :=
begin
  obtain ⟨x, hx⟩ := inh, rw mem_Union at hx, rcases hx with ⟨y, yS, xy⟩,
  exact ⟨_, yS⟩,
end

end Set


import tactic
import tactic.induction

noncomputable theory
open_locale classical

def mk_stat (P : Prop) (n k : ℕ) : ℕ → Prop
| 0 := (n = k → P) → P
| (i+1) := (n = k - i - 1 → P) → mk_stat i

def mk_list (P : Prop) (n k : ℕ) : ℕ → list Prop
| 0 := [n = k → P]
| (i+1) := (n = k - i - 1 → P) :: mk_list i

def mk_stat' (P : Prop) (n k i : ℕ) : Prop :=
(∀ (Q ∈ mk_list P n k i), Q) → P

@[simp]
lemma aux₁ {P Q : Prop} : (P → Q) → Q ↔ P ∨ Q :=
by tauto

lemma mk_stat_of {P : Prop} {n k i : ℕ} (h : mk_stat' P n k i) : mk_stat P n k i :=
begin
  rw mk_stat' at h, induction i with i hi; intro h₁,
  { apply h, rintro Q h₂, rw [mk_list, list.mem_singleton] at h₂, subst h₂, exact h₁ },
  { apply hi, intro h₂, apply h, intro Q, simp_rw [mk_list, list.mem_cons_iff], rintro (rfl | h₃),
    { exact h₁ },
    { exact h₂ _ h₃ }},
end

lemma mem_mk_list {P Q : Prop} {n k i : ℕ} :
  Q ∈ mk_list P n k i ↔ Q = (n = k → P) ∨ ∃ (j : ℕ), j < i ∧ Q = (n = k - j - 1 → P) :=
begin
  split; intro h,
  { induction i with i ih,
    { rw [mk_list, list.mem_singleton] at h, simp [h] },
    { rw or_iff_not_imp_left, intro h₁, rw [mk_list, list.mem_cons_iff] at h, rcases h with (rfl | h),
      { exact ⟨i, nat.lt_succ_self _, rfl⟩ },
      { rw or_iff_not_imp_left at ih, specialize ih h h₁,
        rcases ih with ⟨j, h₁, h₂⟩, refine ⟨j, nat.lt_succ_of_lt h₁, h₂⟩ }}},
  { rcases h with (rfl | h),
    { induction i with i hi,
      { simp [mk_list, list.mem_cons_iff] },
      { rw [mk_list, list.mem_cons_iff], exact or.inr hi }},
    { rcases h with ⟨j, h, rfl⟩, induction i with i hi,
      { cases h },
      { rw [nat.lt_succ_iff, le_iff_eq_or_lt] at h, rcases h with (rfl | h),
        { simp [mk_list, list.mem_cons_iff] },
        { rw [mk_list, list.mem_cons_iff], exact or.inr (hi h) }}}},
end

lemma le_cases {P : Prop} {n k : ℕ} (h : n ≤ k) : mk_stat P n k k :=
begin
  apply mk_stat_of, intro h₁, simp_rw mem_mk_list at h₁,
  rw le_iff_eq_or_lt at h, rcases h with (rfl | h),
  { exact h₁ _ (or.inl rfl) rfl },
  { obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_lt h,
    apply h₁ _ (or.inr ⟨k, by linarith, rfl⟩),
    calc n = n + (k + 1) - (k + 1) : eq_tsub_of_add_eq rfl },
end

example {n : ℕ} (h : n ≤ 2) : true :=
begin
  apply le_cases h; intro h,
  all_goals {triv},
end