/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn

! This file was ported from Lean 3 source module init.data.list.lemmas
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.List.Basic
import Leanbin.Init.Function
import Leanbin.Init.Meta.Default
import Leanbin.Init.Data.Nat.Lemmas
import Leanbin.Init.Meta.Interactive
import Leanbin.Init.Meta.Smt.Rsimp

universe u v w w₁ w₂

variable {α : Type u} {β : Type v} {γ : Type w}

namespace List

open Nat

/-! append -/

#print List.nil_append /-
@[simp]
theorem nil_append (s : List α) : [] ++ s = s :=
  rfl
#align list.nil_append List.nil_append
-/

#print List.cons_append /-
@[simp]
theorem cons_append (x : α) (s t : List α) : x :: s ++ t = x :: (s ++ t) :=
  rfl
#align list.cons_append List.cons_append
-/

#print List.append_nil /-
@[simp]
theorem append_nil (t : List α) : t ++ [] = t := by induction t <;> simp [*]
#align list.append_nil List.append_nil
-/

#print List.append_assoc /-
@[simp]
theorem append_assoc (s t u : List α) : s ++ t ++ u = s ++ (t ++ u) := by induction s <;> simp [*]
#align list.append_assoc List.append_assoc
-/

/-! length -/

#print List.length_cons /-
theorem length_cons (a : α) (l : List α) : length (a :: l) = length l + 1 :=
  rfl
#align list.length_cons List.length_cons
-/

#print List.length_append /-
@[simp]
theorem length_append (s t : List α) : length (s ++ t) = length s + length t :=
  by
  induction s
  · show length t = 0 + length t
    · rw [Nat.zero_add]
  · simp [*, Nat.add_comm, Nat.add_left_comm]
#align list.length_append List.length_append
-/

@[simp]
theorem length_repeat (a : α) (n : ℕ) : length (repeat a n) = n := by
  induction n <;> simp [*] <;> rfl
#align list.length_repeat List.length_repeat

#print List.length_tail /-
@[simp]
theorem length_tail (l : List α) : length (tail l) = length l - 1 := by cases l <;> rfl
#align list.length_tail List.length_tail
-/

#print List.length_drop /-
-- TODO(Leo): cleanup proof after arith dec proc
@[simp]
theorem length_drop : ∀ (i : ℕ) (l : List α), length (drop i l) = length l - i
  | 0, l => rfl
  | succ i, [] => Eq.symm (Nat.zero_sub (succ i))
  | succ i, x :: l =>
    calc
      length (drop (succ i) (x :: l)) = length l - i := length_drop i l
      _ = succ (length l) - succ i := (Nat.succ_sub_succ_eq_sub (length l) i).symm

#align list.length_drop List.length_drop
-/

/-! map -/

/- warning: list.map_cons -> List.map_cons is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (a : α) (l : List.{u1} α), Eq.{succ u2} (List.{u2} β) (List.map.{u1, u2} α β f (List.cons.{u1} α a l)) (List.cons.{u2} β (f a) (List.map.{u1, u2} α β f l))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) (a : α) (l : List.{u2} α), Eq.{succ u1} (List.{u1} β) (List.map.{u2, u1} α β f (List.cons.{u2} α a l)) (List.cons.{u1} β (f a) (List.map.{u2, u1} α β f l))
Case conversion may be inaccurate. Consider using '#align list.map_cons List.map_consₓ'. -/
theorem map_cons (f : α → β) (a l) : map f (a :: l) = f a :: map f l :=
  rfl
#align list.map_cons List.map_cons

/- warning: list.map_append -> List.map_append is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (l₁ : List.{u1} α) (l₂ : List.{u1} α), Eq.{succ u2} (List.{u2} β) (List.map.{u1, u2} α β f (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l₁ l₂)) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (List.map.{u1, u2} α β f l₁) (List.map.{u1, u2} α β f l₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) (l₁ : List.{u2} α) (l₂ : List.{u2} α), Eq.{succ u1} (List.{u1} β) (List.map.{u2, u1} α β f (HAppend.hAppend.{u2, u2, u2} (List.{u2} α) (List.{u2} α) (List.{u2} α) (instHAppend.{u2} (List.{u2} α) (List.instAppendList.{u2} α)) l₁ l₂)) (HAppend.hAppend.{u1, u1, u1} (List.{u1} β) (List.{u1} β) (List.{u1} β) (instHAppend.{u1} (List.{u1} β) (List.instAppendList.{u1} β)) (List.map.{u2, u1} α β f l₁) (List.map.{u2, u1} α β f l₂))
Case conversion may be inaccurate. Consider using '#align list.map_append List.map_appendₓ'. -/
@[simp]
theorem map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
  intro l₁ <;> induction l₁ <;> intros <;> simp [*]
#align list.map_append List.map_append

/- warning: list.map_singleton -> List.map_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (a : α), Eq.{succ u2} (List.{u2} β) (List.map.{u1, u2} α β f (List.cons.{u1} α a (List.nil.{u1} α))) (List.cons.{u2} β (f a) (List.nil.{u2} β))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> β) (a : α), Eq.{succ u1} (List.{u1} β) (List.map.{u2, u1} α β f (List.cons.{u2} α a (List.nil.{u2} α))) (List.cons.{u1} β (f a) (List.nil.{u1} β))
Case conversion may be inaccurate. Consider using '#align list.map_singleton List.map_singletonₓ'. -/
theorem map_singleton (f : α → β) (a : α) : map f [a] = [f a] :=
  rfl
#align list.map_singleton List.map_singleton

#print List.map_id /-
@[simp]
theorem map_id (l : List α) : map id l = l := by induction l <;> simp [*]
#align list.map_id List.map_id
-/

/- warning: list.map_map -> List.map_map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (g : β -> γ) (f : α -> β) (l : List.{u1} α), Eq.{succ u3} (List.{u3} γ) (List.map.{u2, u3} β γ g (List.map.{u1, u2} α β f l)) (List.map.{u1, u3} α γ (Function.comp.{succ u1, succ u2, succ u3} α β γ g f) l)
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (g : α -> β) (f : γ -> α) (l : List.{u1} γ), Eq.{succ u2} (List.{u2} β) (List.map.{u3, u2} α β g (List.map.{u1, u3} γ α f l)) (List.map.{u1, u2} γ β (Function.comp.{succ u1, succ u3, succ u2} γ α β g f) l)
Case conversion may be inaccurate. Consider using '#align list.map_map List.map_mapₓ'. -/
@[simp]
theorem map_map (g : β → γ) (f : α → β) (l : List α) : map g (map f l) = map (g ∘ f) l := by
  induction l <;> simp [*]
#align list.map_map List.map_map

/- warning: list.length_map -> List.length_map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> β) (l : List.{u1} α), Eq.{1} Nat (List.length.{u2} β (List.map.{u1, u2} α β f l)) (List.length.{u1} α l)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} (f : List.{u1} α) (l : α -> β), Eq.{1} Nat (List.length.{u2} β (List.map.{u1, u2} α β l f)) (List.length.{u1} α f)
Case conversion may be inaccurate. Consider using '#align list.length_map List.length_mapₓ'. -/
@[simp]
theorem length_map (f : α → β) (l : List α) : length (map f l) = length l := by
  induction l <;> simp [*]
#align list.length_map List.length_map

/-! bind -/

/- warning: list.nil_bind -> List.nil_bind is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (f : α -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.bind.{u1, u2} α β (List.nil.{u1} α) f) (List.nil.{u2} β)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (f : α -> (List.{u1} β)), Eq.{succ u1} (List.{u1} β) (List.bind.{u2, u1} α β (List.nil.{u2} α) f) (List.nil.{u1} β)
Case conversion may be inaccurate. Consider using '#align list.nil_bind List.nil_bindₓ'. -/
@[simp]
theorem nil_bind (f : α → List β) : List.bind [] f = [] := by simp [join, List.bind]
#align list.nil_bind List.nil_bind

/- warning: list.cons_bind -> List.cons_bind is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (x : α) (xs : List.{u1} α) (f : α -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.bind.{u1, u2} α β (List.cons.{u1} α x xs) f) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (f x) (List.bind.{u1, u2} α β xs f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (x : α) (xs : List.{u2} α) (f : α -> (List.{u1} β)), Eq.{succ u1} (List.{u1} β) (List.bind.{u2, u1} α β (List.cons.{u2} α x xs) f) (HAppend.hAppend.{u1, u1, u1} (List.{u1} β) (List.{u1} β) (List.{u1} β) (instHAppend.{u1} (List.{u1} β) (List.instAppendList.{u1} β)) (f x) (List.bind.{u2, u1} α β xs f))
Case conversion may be inaccurate. Consider using '#align list.cons_bind List.cons_bindₓ'. -/
@[simp]
theorem cons_bind (x xs) (f : α → List β) : List.bind (x :: xs) f = f x ++ List.bind xs f := by
  simp [join, List.bind]
#align list.cons_bind List.cons_bind

/- warning: list.append_bind -> List.append_bind is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (xs : List.{u1} α) (ys : List.{u1} α) (f : α -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.bind.{u1, u2} α β (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) xs ys) f) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (List.bind.{u1, u2} α β xs f) (List.bind.{u1, u2} α β ys f))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (xs : List.{u2} α) (ys : List.{u2} α) (f : α -> (List.{u1} β)), Eq.{succ u1} (List.{u1} β) (List.bind.{u2, u1} α β (HAppend.hAppend.{u2, u2, u2} (List.{u2} α) (List.{u2} α) (List.{u2} α) (instHAppend.{u2} (List.{u2} α) (List.instAppendList.{u2} α)) xs ys) f) (HAppend.hAppend.{u1, u1, u1} (List.{u1} β) (List.{u1} β) (List.{u1} β) (instHAppend.{u1} (List.{u1} β) (List.instAppendList.{u1} β)) (List.bind.{u2, u1} α β xs f) (List.bind.{u2, u1} α β ys f))
Case conversion may be inaccurate. Consider using '#align list.append_bind List.append_bindₓ'. -/
@[simp]
theorem append_bind (xs ys) (f : α → List β) :
    List.bind (xs ++ ys) f = List.bind xs f ++ List.bind ys f := by
  induction xs <;> [rfl, simp [*, cons_bind]]
#align list.append_bind List.append_bind

/-! mem -/

#print List.mem_nil_iff /-
theorem mem_nil_iff (a : α) : a ∈ ([] : List α) ↔ False :=
  Iff.rfl
#align list.mem_nil_iff List.mem_nil_iff
-/

#print List.not_mem_nil /-
@[simp]
theorem not_mem_nil (a : α) : a ∉ ([] : List α) :=
  not_false
#align list.not_mem_nil List.not_mem_nil
-/

#print List.mem_cons_self /-
theorem mem_cons_self (a : α) (l : List α) : a ∈ a :: l :=
  Or.inl rfl
#align list.mem_cons_self List.mem_cons_self
-/

#print List.mem_cons /-
@[simp]
theorem mem_cons (a y : α) (l : List α) : a ∈ y :: l ↔ a = y ∨ a ∈ l :=
  Iff.rfl
#align list.mem_cons_iff List.mem_cons
-/

@[rsimp]
theorem mem_cons_eq (a y : α) (l : List α) : (a ∈ y :: l) = (a = y ∨ a ∈ l) :=
  rfl
#align list.mem_cons_eq List.mem_cons_eq

#print List.mem_cons_of_mem /-
theorem mem_cons_of_mem (y : α) {a : α} {l : List α} : a ∈ l → a ∈ y :: l := fun H => Or.inr H
#align list.mem_cons_of_mem List.mem_cons_of_mem
-/

#print List.eq_or_mem_of_mem_cons /-
theorem eq_or_mem_of_mem_cons {a y : α} {l : List α} : a ∈ y :: l → a = y ∨ a ∈ l := fun h => h
#align list.eq_or_mem_of_mem_cons List.eq_or_mem_of_mem_cons
-/

#print List.mem_append /-
@[simp]
theorem mem_append {a : α} {s t : List α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t := by
  induction s <;> simp [*, or_assoc']
#align list.mem_append List.mem_append
-/

#print List.mem_append_eq /-
@[rsimp]
theorem mem_append_eq (a : α) (s t : List α) : (a ∈ s ++ t) = (a ∈ s ∨ a ∈ t) :=
  propext mem_append
#align list.mem_append_eq List.mem_append_eq
-/

#print List.mem_append_left /-
theorem mem_append_left {a : α} {l₁ : List α} (l₂ : List α) (h : a ∈ l₁) : a ∈ l₁ ++ l₂ :=
  mem_append.2 (Or.inl h)
#align list.mem_append_left List.mem_append_left
-/

#print List.mem_append_right /-
theorem mem_append_right {a : α} (l₁ : List α) {l₂ : List α} (h : a ∈ l₂) : a ∈ l₁ ++ l₂ :=
  mem_append.2 (Or.inr h)
#align list.mem_append_right List.mem_append_right
-/

theorem not_bex_nil (p : α → Prop) : ¬∃ x ∈ @nil α, p x := fun ⟨x, hx, px⟩ => hx
#align list.not_bex_nil List.not_bex_nil

/- warning: list.ball_nil clashes with list.forall_mem_nil -> List.forall_mem_nil
Case conversion may be inaccurate. Consider using '#align list.ball_nil List.forall_mem_nilₓ'. -/
#print List.forall_mem_nil /-
theorem forall_mem_nil (p : α → Prop) : ∀ x ∈ @nil α, p x := fun x => False.elim
#align list.ball_nil List.forall_mem_nil
-/

theorem bex_cons (p : α → Prop) (a : α) (l : List α) : (∃ x ∈ a :: l, p x) ↔ p a ∨ ∃ x ∈ l, p x :=
  ⟨fun ⟨x, h, px⟩ => by
    simp at h
    cases' h with h h
    · cases h
      exact Or.inl px
    · exact Or.inr ⟨x, h, px⟩, fun o =>
    o.elim (fun pa => ⟨a, mem_cons_self _ _, pa⟩) fun ⟨x, h, px⟩ => ⟨x, mem_cons_of_mem _ h, px⟩⟩
#align list.bex_cons List.bex_cons

theorem forall_mem_cons (p : α → Prop) (a : α) (l : List α) :
    (∀ x ∈ a :: l, p x) ↔ p a ∧ ∀ x ∈ l, p x :=
  ⟨fun al => ⟨al a (mem_cons_self _ _), fun x h => al x (mem_cons_of_mem _ h)⟩, fun ⟨pa, al⟩ x o =>
    o.elim (fun e => e.symm ▸ pa) (al x)⟩
#align list.ball_cons List.forall_mem_consₓ

/-! list subset -/

#print List.Subset /-
protected def Subset (l₁ l₂ : List α) :=
  ∀ ⦃a : α⦄, a ∈ l₁ → a ∈ l₂
#align list.subset List.Subset
-/

instance : HasSubset (List α) :=
  ⟨List.Subset⟩

#print List.nil_subset /-
@[simp]
theorem nil_subset (l : List α) : [] ⊆ l := fun b i => False.elim (Iff.mp (mem_nil_iff b) i)
#align list.nil_subset List.nil_subset
-/

#print List.Subset.refl /-
@[refl, simp]
theorem Subset.refl (l : List α) : l ⊆ l := fun b i => i
#align list.subset.refl List.Subset.refl
-/

#print List.Subset.trans /-
@[trans]
theorem Subset.trans {l₁ l₂ l₃ : List α} (h₁ : l₁ ⊆ l₂) (h₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ := fun b i =>
  h₂ (h₁ i)
#align list.subset.trans List.Subset.trans
-/

#print List.subset_cons /-
@[simp]
theorem subset_cons (a : α) (l : List α) : l ⊆ a :: l := fun b i => Or.inr i
#align list.subset_cons List.subset_cons
-/

#print List.subset_of_cons_subset /-
theorem subset_of_cons_subset {a : α} {l₁ l₂ : List α} : a :: l₁ ⊆ l₂ → l₁ ⊆ l₂ := fun s b i =>
  s (mem_cons_of_mem _ i)
#align list.subset_of_cons_subset List.subset_of_cons_subset
-/

#print List.cons_subset_cons /-
theorem cons_subset_cons {l₁ l₂ : List α} (a : α) (s : l₁ ⊆ l₂) : a :: l₁ ⊆ a :: l₂ := fun b hin =>
  Or.elim (eq_or_mem_of_mem_cons hin) (fun e : b = a => Or.inl e) fun i : b ∈ l₁ => Or.inr (s i)
#align list.cons_subset_cons List.cons_subset_cons
-/

#print List.subset_append_left /-
@[simp]
theorem subset_append_left (l₁ l₂ : List α) : l₁ ⊆ l₁ ++ l₂ := fun b => mem_append_left _
#align list.subset_append_left List.subset_append_left
-/

#print List.subset_append_right /-
@[simp]
theorem subset_append_right (l₁ l₂ : List α) : l₂ ⊆ l₁ ++ l₂ := fun b => mem_append_right _
#align list.subset_append_right List.subset_append_right
-/

#print List.subset_cons_of_subset /-
theorem subset_cons_of_subset (a : α) {l₁ l₂ : List α} : l₁ ⊆ l₂ → l₁ ⊆ a :: l₂ :=
  fun (s : l₁ ⊆ l₂) (a : α) (i : a ∈ l₁) => Or.inr (s i)
#align list.subset_cons_of_subset List.subset_cons_of_subset
-/

#print List.eq_nil_of_length_eq_zero /-
theorem eq_nil_of_length_eq_zero {l : List α} : length l = 0 → l = [] :=
  by
  induction l <;> intros
  rfl
  contradiction
#align list.eq_nil_of_length_eq_zero List.eq_nil_of_length_eq_zero
-/

#print List.ne_nil_of_length_eq_succ /-
theorem ne_nil_of_length_eq_succ {l : List α} : ∀ {n : Nat}, length l = succ n → l ≠ [] := by
  induction l <;> intros <;> contradiction
#align list.ne_nil_of_length_eq_succ List.ne_nil_of_length_eq_succ
-/

/- warning: list.length_map₂ -> List.length_zipWith is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (f : α -> β -> γ) (l₁ : List.{u1} α) (l₂ : List.{u2} β), Eq.{1} Nat (List.length.{u3} γ (List.zipWith.{u1, u2, u3} α β γ f l₁ l₂)) (LinearOrder.min.{0} Nat Nat.linearOrder (List.length.{u1} α l₁) (List.length.{u2} β l₂))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (f : α -> β -> γ) (l₁ : List.{u3} α) (l₂ : List.{u2} β), Eq.{1} Nat (List.length.{u1} γ (List.zipWith.{u3, u2, u1} α β γ f l₁ l₂)) (Min.min.{0} Nat instMinNat (List.length.{u3} α l₁) (List.length.{u2} β l₂))
Case conversion may be inaccurate. Consider using '#align list.length_map₂ List.length_zipWithₓ'. -/
@[simp]
theorem length_zipWith (f : α → β → γ) (l₁) :
    ∀ l₂, length (zipWith f l₁ l₂) = min (length l₁) (length l₂) := by
  induction l₁ <;> intro l₂ <;> cases l₂ <;>
    simp [*, add_one, min_succ_succ, Nat.zero_min, Nat.min_zero]
#align list.length_map₂ List.length_zipWith

/- warning: list.length_take -> List.length_take is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (i : Nat) (l : List.{u1} α), Eq.{1} Nat (List.length.{u1} α (List.take.{u1} α i l)) (LinearOrder.min.{0} Nat Nat.linearOrder i (List.length.{u1} α l))
but is expected to have type
  forall {α : Type.{u1}} (i : Nat) (l : List.{u1} α), Eq.{1} Nat (List.length.{u1} α (List.take.{u1} α i l)) (Min.min.{0} Nat instMinNat i (List.length.{u1} α l))
Case conversion may be inaccurate. Consider using '#align list.length_take List.length_takeₓ'. -/
@[simp]
theorem length_take : ∀ (i : ℕ) (l : List α), length (take i l) = min i (length l)
  | 0, l => by simp [Nat.zero_min]
  | succ n, [] => by simp [Nat.min_zero]
  | succ n, a :: l => by simp [*, Nat.min_succ_succ, add_one]
#align list.length_take List.length_take

#print List.length_take_le /-
theorem length_take_le (n) (l : List α) : length (take n l) ≤ n := by simp [min_le_left]
#align list.length_take_le List.length_take_le
-/

#print List.length_removeNth /-
theorem length_removeNth :
    ∀ (l : List α) (i : ℕ), i < length l → length (removeNth l i) = length l - 1
  | [], _, h => rfl
  | x :: xs, 0, h => by simp [remove_nth]
  | x :: xs, i + 1, h => by
    have : i < length xs := lt_of_succ_lt_succ h
    dsimp [remove_nth] <;>
        rw [length_remove_nth xs i this,
          Nat.sub_add_cancel (lt_of_le_of_lt (Nat.zero_le _) this)] <;>
      rfl
#align list.length_remove_nth List.length_removeNth
-/

@[simp]
theorem partition_eq_filter_filter (p : α → Prop) [DecidablePred p] :
    ∀ l : List α, partition p l = (filter p l, filter (Not ∘ p) l)
  | [] => rfl
  | a :: l => by by_cases pa : p a <;> simp [partition, Filter, pa, partition_eq_filter_filter l]
#align list.partition_eq_filter_filter List.partitionₓ_eq_filterₓ_filterₓ

/-! sublists -/

#print List.Sublist /-
inductive Sublist : List α → List α → Prop
  | slnil : sublist [] []
  | cons (l₁ l₂ a) : sublist l₁ l₂ → sublist l₁ (a :: l₂)
  | cons2 (l₁ l₂ a) : sublist l₁ l₂ → sublist (a :: l₁) (a :: l₂)
#align list.sublist List.Sublist
-/

-- mathport name: «expr <+ »
infixl:50 " <+ " => Sublist

#print List.length_le_of_sublist /-
theorem length_le_of_sublist : ∀ {l₁ l₂ : List α}, l₁ <+ l₂ → length l₁ ≤ length l₂
  | _, _, sublist.slnil => le_refl 0
  | _, _, sublist.cons l₁ l₂ a s => le_succ_of_le (length_le_of_sublist s)
  | _, _, sublist.cons2 l₁ l₂ a s => succ_le_succ (length_le_of_sublist s)
#align list.length_le_of_sublist List.length_le_of_sublist
-/

/-! filter -/

/- warning: list.filter_nil -> List.filter_nil is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [h : DecidablePred.{succ u1} α p], Eq.{succ u1} (List.{u1} α) (List.filterₓ.{u1} α p (fun (a : α) => h a) (List.nil.{u1} α)) (List.nil.{u1} α)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool), Eq.{succ u1} (List.{u1} α) (List.filter.{u1} α p (List.nil.{u1} α)) (List.nil.{u1} α)
Case conversion may be inaccurate. Consider using '#align list.filter_nil List.filter_nilₓ'. -/
@[simp]
theorem filter_nil (p : α → Prop) [h : DecidablePred p] : filter p [] = [] :=
  rfl
#align list.filter_nil List.filter_nil

/- warning: list.filter_cons_of_pos -> List.filter_cons_of_pos is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [h : DecidablePred.{succ u1} α p] {a : α} (l : List.{u1} α), (p a) -> (Eq.{succ u1} (List.{u1} α) (List.filterₓ.{u1} α p (fun (a : α) => h a) (List.cons.{u1} α a l)) (List.cons.{u1} α a (List.filterₓ.{u1} α p (fun (a : α) => h a) l)))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {h : α} (a : List.{u1} α), (Eq.{1} Bool (p h) Bool.true) -> (Eq.{succ u1} (List.{u1} α) (List.filter.{u1} α p (List.cons.{u1} α h a)) (List.cons.{u1} α h (List.filter.{u1} α p a)))
Case conversion may be inaccurate. Consider using '#align list.filter_cons_of_pos List.filter_cons_of_posₓ'. -/
@[simp]
theorem filter_cons_of_pos {p : α → Prop} [h : DecidablePred p] {a : α} :
    ∀ l, p a → filter p (a :: l) = a :: filter p l := fun l pa => if_pos pa
#align list.filter_cons_of_pos List.filter_cons_of_pos

/- warning: list.filter_cons_of_neg -> List.filter_cons_of_neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [h : DecidablePred.{succ u1} α p] {a : α} (l : List.{u1} α), (Not (p a)) -> (Eq.{succ u1} (List.{u1} α) (List.filterₓ.{u1} α p (fun (a : α) => h a) (List.cons.{u1} α a l)) (List.filterₓ.{u1} α p (fun (a : α) => h a) l))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {h : α} (a : List.{u1} α), (Not (Eq.{1} Bool (p h) Bool.true)) -> (Eq.{succ u1} (List.{u1} α) (List.filter.{u1} α p (List.cons.{u1} α h a)) (List.filter.{u1} α p a))
Case conversion may be inaccurate. Consider using '#align list.filter_cons_of_neg List.filter_cons_of_negₓ'. -/
@[simp]
theorem filter_cons_of_neg {p : α → Prop} [h : DecidablePred p] {a : α} :
    ∀ l, ¬p a → filter p (a :: l) = filter p l := fun l pa => if_neg pa
#align list.filter_cons_of_neg List.filter_cons_of_neg

/- warning: list.filter_append -> List.filter_append is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [h : DecidablePred.{succ u1} α p] (l₁ : List.{u1} α) (l₂ : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.filterₓ.{u1} α p (fun (a : α) => h a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l₁ l₂)) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) (List.filterₓ.{u1} α p (fun (a : α) => h a) l₁) (List.filterₓ.{u1} α p (fun (a : α) => h a) l₂))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} (h : List.{u1} α) (l₁ : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.filter.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) h l₁)) (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) (List.filter.{u1} α p h) (List.filter.{u1} α p l₁))
Case conversion may be inaccurate. Consider using '#align list.filter_append List.filter_appendₓ'. -/
@[simp]
theorem filter_append {p : α → Prop} [h : DecidablePred p] :
    ∀ l₁ l₂ : List α, filter p (l₁ ++ l₂) = filter p l₁ ++ filter p l₂
  | [], l₂ => rfl
  | a :: l₁, l₂ => by by_cases pa : p a <;> simp [pa, filter_append]
#align list.filter_append List.filter_append

/- warning: list.filter_sublist -> List.filter_sublist is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [h : DecidablePred.{succ u1} α p] (l : List.{u1} α), List.Sublist.{u1} α (List.filterₓ.{u1} α p (fun (a : α) => h a) l) l
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} (h : List.{u1} α), List.Sublist.{u1} α (List.filter.{u1} α p h) h
Case conversion may be inaccurate. Consider using '#align list.filter_sublist List.filter_sublistₓ'. -/
@[simp]
theorem filter_sublist {p : α → Prop} [h : DecidablePred p] : ∀ l : List α, filter p l <+ l
  | [] => Sublist.slnil
  | a :: l =>
    if pa : p a then by simp [pa] <;> apply sublist.cons2 <;> apply filter_sublist l
    else by simp [pa] <;> apply sublist.cons <;> apply filter_sublist l
#align list.filter_sublist List.filter_sublist

/-! map_accumr -/

section MapAccumr

variable {φ : Type w₁} {σ : Type w₂}

/- warning: list.map_accumr -> List.mapAccumr is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {σ : Type.{u3}}, (α -> σ -> (Prod.{u3, u2} σ β)) -> (List.{u1} α) -> σ -> (Prod.{u3, u2} σ (List.{u2} β))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {σ : Type.{u3}}, (β -> α -> (Prod.{u1, u3} α σ)) -> (List.{u2} β) -> α -> (Prod.{u1, u3} α (List.{u3} σ))
Case conversion may be inaccurate. Consider using '#align list.map_accumr List.mapAccumrₓ'. -/
-- This runs a function over a list returning the intermediate results and a
-- a final result.
def mapAccumr (f : α → σ → σ × β) : List α → σ → σ × List β
  | [], c => (c, [])
  | y :: yr, c =>
    let r := map_accumr yr c
    let z := f y r.1
    (z.1, z.2 :: r.2)
#align list.map_accumr List.mapAccumr

/- warning: list.length_map_accumr -> List.length_mapAccumr is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {σ : Type.{u3}} (f : α -> σ -> (Prod.{u3, u2} σ β)) (x : List.{u1} α) (s : σ), Eq.{1} Nat (List.length.{u2} β (Prod.snd.{u3, u2} σ (List.{u2} β) (List.mapAccumr.{u1, u2, u3} α β σ f x s))) (List.length.{u1} α x)
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {σ : Type.{u1}} (f : β -> α -> (Prod.{u3, u1} α σ)) (x : List.{u2} β) (s : α), Eq.{1} Nat (List.length.{u1} σ (Prod.snd.{u3, u1} α (List.{u1} σ) (List.mapAccumr.{u3, u2, u1} α β σ f x s))) (List.length.{u2} β x)
Case conversion may be inaccurate. Consider using '#align list.length_map_accumr List.length_mapAccumrₓ'. -/
@[simp]
theorem length_mapAccumr :
    ∀ (f : α → σ → σ × β) (x : List α) (s : σ), length (mapAccumr f x s).2 = length x
  | f, a :: x, s => congr_arg succ (length_map_accumr f x s)
  | f, [], s => rfl
#align list.length_map_accumr List.length_mapAccumr

end MapAccumr

section MapAccumr₂

variable {φ : Type w₁} {σ : Type w₂}

/- warning: list.map_accumr₂ -> List.mapAccumr₂ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {φ : Type.{u3}} {σ : Type.{u4}}, (α -> β -> σ -> (Prod.{u4, u3} σ φ)) -> (List.{u1} α) -> (List.{u2} β) -> σ -> (Prod.{u4, u3} σ (List.{u3} φ))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} {φ : Type.{u3}} {σ : Type.{u4}}, (φ -> σ -> β -> (Prod.{u2, u1} β α)) -> (List.{u3} φ) -> (List.{u4} σ) -> β -> (Prod.{u2, u1} β (List.{u1} α))
Case conversion may be inaccurate. Consider using '#align list.map_accumr₂ List.mapAccumr₂ₓ'. -/
-- This runs a function over two lists returning the intermediate results and a
-- a final result.
def mapAccumr₂ (f : α → β → σ → σ × φ) : List α → List β → σ → σ × List φ
  | [], _, c => (c, [])
  | _, [], c => (c, [])
  | x :: xr, y :: yr, c =>
    let r := map_accumr₂ xr yr c
    let q := f x y r.1
    (q.1, q.2 :: r.2)
#align list.map_accumr₂ List.mapAccumr₂

/- warning: list.length_map_accumr₂ -> List.length_mapAccumr₂ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {φ : Type.{u3}} {σ : Type.{u4}} (f : α -> β -> σ -> (Prod.{u4, u3} σ φ)) (x : List.{u1} α) (y : List.{u2} β) (c : σ), Eq.{1} Nat (List.length.{u3} φ (Prod.snd.{u4, u3} σ (List.{u3} φ) (List.mapAccumr₂.{u1, u2, u3, u4} α β φ σ f x y c))) (LinearOrder.min.{0} Nat Nat.linearOrder (List.length.{u1} α x) (List.length.{u2} β y))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u4}} {φ : Type.{u2}} {σ : Type.{u1}} (f : φ -> σ -> β -> (Prod.{u4, u3} β α)) (x : List.{u2} φ) (y : List.{u1} σ) (c : β), Eq.{1} Nat (List.length.{u3} α (Prod.snd.{u4, u3} β (List.{u3} α) (List.mapAccumr₂.{u3, u4, u2, u1} α β φ σ f x y c))) (Min.min.{0} Nat instMinNat (List.length.{u2} φ x) (List.length.{u1} σ y))
Case conversion may be inaccurate. Consider using '#align list.length_map_accumr₂ List.length_mapAccumr₂ₓ'. -/
@[simp]
theorem length_mapAccumr₂ :
    ∀ (f : α → β → σ → σ × φ) (x y c), length (mapAccumr₂ f x y c).2 = min (length x) (length y)
  | f, a :: x, b :: y, c =>
    calc
      succ (length (mapAccumr₂ f x y c).2) = succ (min (length x) (length y)) :=
        congr_arg succ (length_map_accumr₂ f x y c)
      _ = min (succ (length x)) (succ (length y)) := Eq.symm (min_succ_succ (length x) (length y))

  | f, a :: x, [], c => rfl
  | f, [], b :: y, c => rfl
  | f, [], [], c => rfl
#align list.length_map_accumr₂ List.length_mapAccumr₂

end MapAccumr₂

end List


-- based on Lean Tutorial / 05_sequence_limits.lean
import resources

/-
Useful lemmata:

`le_max_left  p q` says `p ≤ max p q`
`le_max_right p q` says `q ≤ max p q`

`eq_of_abs_sub_le_all_pos x y` says `(∀ ε > 0, |x - y| ≤ ε) → x = y`
-/

-- This is the definition of limit we will work with in all exercises here.
def seq_limit (s : ℕ → ℝ) (a : ℝ) : Prop :=
∀ ε : ℝ, ε > 0 → ∃ n₀ : ℕ, ∀ n : ℕ, n ≥ n₀ → |s n - a| ≤ ε

-- Arithmetic of limits ... the sum law:
-- If [`u` approaches `a`] and [`v` approaches `b`],
-- then [`u + v` approaches `a + b`].
example (u v : ℕ → ℝ) (a b : ℝ) (hu : seq_limit u a) (hv : seq_limit v b) :
  seq_limit (u + v) (a + b) :=
begin
  intros ε epp,
  cases hu (ε / 2) (half_pos epp) with Nᵤ ha,
  cases hv (ε / 2) (half_pos epp) with Nᵥ hb,
  use max Nᵤ Nᵥ,
  intros n n_large,

  specialize ha n (by calc
    n   ≥ max Nᵤ Nᵥ : n_large
    ... ≥ Nᵤ        : le_max_left Nᵤ Nᵥ
  ),
  specialize hb n (by calc
    n   ≥ max Nᵤ Nᵥ : n_large
    ... ≥ Nᵥ        : le_max_right Nᵤ Nᵥ
  ),

  calc  |(u + v) n - (a + b)|
      = |u n + v n - (a + b)|   : rfl
  ... = |(u n - a) + (v n - b)| : by ring_nf
  ... ≤  |u n - a| + |v n - b|  : abs_add (u n - a) (v n - b)
  ... ≤    (ε / 2) + (ε / 2)    : add_le_add ha hb
  ... =            ε            : add_halves ε,
end

-- Squeeze theorem (a.k.a. "Sandwich rule" or "Two policemen and a drunk"):
-- If [`u` approaches `z`] and [`v` approaches `z`],
-- then [`w` such that `u ≤ w ≤ v` approaches `z` as well].
example (u v w : ℕ → ℝ) (z : ℝ) (hu : seq_limit u z) (hv : seq_limit v z)
        (below : ∀ n, u n ≤ w n) (above : ∀ n, w n ≤ v n) :
  seq_limit w z :=
begin
  intros ε epp,
  cases hu ε epp with Nᵤ huz,
  cases hv ε epp with Nᵥ hvz,
  use max Nᵤ Nᵥ,
  intros n n_large,
  specialize huz n (le_of_max_le_left  n_large),
  specialize hvz n (le_of_max_le_right n_large),
  specialize below n,
  specialize above n,
  cases abs_sub_le_iff.mp huz with hu_left hu_right,
  cases abs_sub_le_iff.mp hvz with hv_left hv_right,
  rw abs_sub_le_iff,
  split;
  linarith,
end

-- A sequence admits at most one limit.
example (w : ℕ → ℝ) (a b : ℝ) (ha : seq_limit w a) (hb : seq_limit w b) :
  a = b :=
begin
  apply eq_of_abs_sub_le_all_pos,
  intros ε epp,
  cases ha (ε / 2) (half_pos epp) with N₁ hwa,
  cases hb (ε / 2) (half_pos epp) with N₂ hwb,
  specialize hwa (max N₁ N₂) (le_max_left  N₁ N₂),
  specialize hwb (max N₁ N₂) (le_max_right N₁ N₂),
  cases abs_sub_le_iff.mp hwa with ha_left ha_right,
  cases abs_sub_le_iff.mp hwb with hb_left hb_right,
  rw abs_sub_le_iff,
  split;
  linarith,
end


import plane_separation_world.level07 --hide
open IncidencePlane --hide

/-
# Plane Separation World

## Level 8: on the way to the final level (V).

This is the last of the five lemmas that we need to prove before jumping into the final level of the game! You will be provided with
its mathematical proof in paper right below. Remember that you can use all the theorem statements from the left-hand side box.

## Mathematical proof in paper...

**Claim:** If the segments A·B and B·C are on the same side of the line ℓ, there exists a point P, which satisfies that `(P = A ∨ P = C ∨ A*P*C) ∧ P ∈ ℓ`,
such that A * P * C.

**Proof:**

**(i)** By the lemma `same_side_of_noncollinear_ne_line`, since the segments A·B and B·C are on the same side of ℓ, then `A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ`.

Now we proceed with the proof by cases:

**Case 1:** Let us assume that `P ≠ A`. That is, `(P = A) → false`. Then, let us assume that `P = A`. Now, we want to prove that this is false. In (i) we proved
that `A ∉ ℓ`. That is, `(A ∈ ℓ) → false`. Because we want to prove `false`, it suffices to prove that `A ∈ ℓ`. Because we assumed that `P = A` and we know
that `P ∈ ℓ`, then `A ∈ ℓ`. Therefore, we have shown that `P ≠ A`.

**Case 2:** Let us assume that `P ≠ C`. That is, `(P = C) → false`. Then, let us assume that `P = C`. Now, we want to prove that this is false. In (i) we proved
that `C ∉ ℓ`. That is, `(C ∈ ℓ) → false`. Because we want to prove `false`, it suffices to prove that `C ∈ ℓ`. Because we assumed that `P = C` and we know that `P ∈ ℓ`,
then `C ∈ ℓ`. Therefore, we have shown that `P ≠ C`.

**Case 3:** Let us assume that `A * P * C`. Given that the point P either satisfies `P = A ∨ P = C ∨ A*P*C`, because we proved that `P ≠ A` in Case 1 and
that `P ≠ C` in Case 2, then P must satisfy that `A * P * C`. [In Lean, the `tauto` tactic should close this case automatically.]

-/

/- Hint : Click here for a hint, in case you get stuck.
If you have a theorem statement called `theorem1`, which shows `x` by using the hypothesis `h : P`, then `have htheorem := theorem1 h`
will add the hypothesis `htheorem : x` to the local context. In case you feel bewildered, do not hesitate
to click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
If the segments A·B and B·C are on the same side of the line ℓ, there exists a point P, which satisfies that `(P = A ∨ P = C ∨ A*P*C) ∧ P ∈ ℓ`, such that A * P * C.
-/
lemma not_same_side_point_in_between (hlAB : same_side ℓ A B) (hlBC : same_side ℓ B C) (hPAC: (P = A ∨ P = C ∨ A*P*C) ∧ P ∈ ℓ) : A * P * C :=
begin
  have c := same_side_of_noncollinear_ne_line hlAB hlBC,
  have hPA : P ≠ A,
  {
    intro hc,
    apply c.1,
    rw hc at hPAC,
    exact hPAC.2,
  },
  have hPA : P ≠ C,
  {
    intro hc,
    apply c.2.2,
    rw hc at hPAC,
    exact hPAC.2,
  },
  tauto,
end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.multiset.nodup
import data.list.nat_antidiagonal

/-!
# The "antidiagonal" {(0,n), (1,n-1), ..., (n,0)} as a multiset.
-/

namespace multiset
namespace nat

/-- The antidiagonal of a natural number `n` is
    the multiset of pairs `(i,j)` such that `i+j = n`. -/
def antidiagonal (n : ℕ) : multiset (ℕ × ℕ) :=
list.nat.antidiagonal n

/-- A pair (i,j) is contained in the antidiagonal of `n` if and only if `i+j=n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
by rw [antidiagonal, mem_coe, list.nat.mem_antidiagonal]

/-- The cardinality of the antidiagonal of `n` is `n+1`. -/
@[simp] lemma card_antidiagonal (n : ℕ) : (antidiagonal n).card = n+1 :=
by rw [antidiagonal, coe_card, list.nat.length_antidiagonal]

/-- The antidiagonal of `0` is the list `[(0,0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
rfl

/-- The antidiagonal of `n` does not contain duplicate entries. -/
@[simp] lemma nodup_antidiagonal (n : ℕ) : nodup (antidiagonal n) :=
coe_nodup.2 $ list.nat.nodup_antidiagonal n

@[simp] lemma antidiagonal_succ {n : ℕ} :
  antidiagonal (n + 1) = (0, n + 1) ::ₘ ((antidiagonal n).map (prod.map nat.succ id)) :=
by simp only [antidiagonal, list.nat.antidiagonal_succ, coe_map, cons_coe]

end nat
end multiset


/- NATURAL NUMBERS

We saw the definition of the natural numbers `Nat` and the addition on them on the slides.
Since we want to define it ourselves and not use Lean's built-in version, we will call ours `Nat'`.
 -/
inductive Nat' : Type
  | zero : Nat'
  | succ : Nat' → Nat'

open Nat'

def add (m n : Nat') : Nat' :=
  match n with
  | zero   => m
  | succ n => succ (add m n)

-- Let us now try to recursively define multiplication on the `Nat'`.
def mul (m n : Nat') : Nat' :=
  match n with
  | zero   => zero
  | succ n => add (mul m n) m

-- Next, check your definition of `mul` by evaluating a few examples. This can be done with the
-- command `#eval`.

-- Let's define `≤` as an inductive predicate on `Nat'`s!
inductive LE' : Nat' → Nat' → Prop where
  | refl (n : Nat') : LE' n n
  -- TODO: We're off to a good start since `≤` is certainly reflexive, but something is still
  -- missing (or else we'd just redefine `Eq` for `Nat'`s). Can you think of one more constructor
  -- that makes it so `LE' n m` holds whenever we would intuitively expect `n ≤ m` to hold?
  -- hint: it remains to be shown that `LE' n m` should hold when `m` is *greater* than `n`, so
  -- the new constructor should probably involve `Nat'`'s `succ` constructor to reach those greater numbers.
  -- hint: it should be an *inductive* case, meaning using another `LE'` application as an assumption
  -- note: `LE'` could also be defined in terms of `add`, but that makes working with it awkward,
  -- so let's not do that.
  | succ : LE' m n → LE' m (succ n)

-- Now let's prove some things about `LE'`. But first we'll give it the standard notation.
infix:50 " ≤ " => LE'

example (n : Nat') : n ≤ succ (succ n) :=
  LE'.succ (LE'.succ LE'.refl)

-- This one is a bit harder: we will need induction!
-- As described on the slides, induction is just a special case of recursion
theorem le_add (m n : Nat') : m ≤ add m n :=
  match n with
  -- This is the base case
  | zero => LE'.refl
  -- This is the inductive case. You probably want to use `le_add m n` (the inductive hypothesis) somewhere inside of it!
  | succ n =>
    -- Lean automatically converts `add m (succ n)` to `succ (add m n)` for us when necessary, but it can help
    -- to make the conversion explicit. `show` simply lets us restate the goal, using any definitionally equal type.
    show m ≤ succ (add m n) from
    LE'.succ (le_add m n)

-- Now try proving this theorem on `add` using the same induction scheme
theorem zero_add (n : Nat') : add zero n = add n zero :=
  match n with
  | zero => rfl
  | succ n =>
    show succ (add zero n) = succ (add n zero) from
    zero_add n ▸ rfl

/-
LISTS

The type `List α` of lists on a Type α is defined to be the type on the constructors
`nil : List α`
and
`cons : α → List α → List α`.

We can use `[]` as a notation for `nil` and `x :: xs` as a notation for `cons x xs`.
-/
open List

-- Let's define something we can't in most other functional languages:
-- a function returning the first element of a list given a proof that is is non-empty! (`xs ≠ []` is shorthand for `¬ (xs = [])`)
def hd (xs : List α) : xs ≠ [] → α :=
  fun hf =>
    match xs with
    | []      => False.elim (hf rfl)
    | x :: xs => x
-- Did you notice that `hd` is a dependent function? The *type/proposition* of the second parameter depends on the *value* of the first.
-- We can write `hd`s type as `∀ (xs : List α), xs ≠ [] → α` or, equivalently, `(xs : List α) → xs ≠ [] → α`.

/-
TREES

Define a type `Tree α` of binary trees with node labels of type `α`. Each tree is either a labelled leaf or a labelled inner node with two trees attached to it.
 -/

inductive Tree (α : Type) : Type where
  | leaf : α → Tree α
  | node : α → Tree α → Tree α → Tree α

open Tree

-- Now, let us define the depth and the size of a tree. You can use the function `Nat.max` to get the maximum of two natural numbers. The depth of a leaf is 1.
def depth (t : Tree α) : Nat :=
  match t with
  | leaf a     => 1
  | node a l r => Nat.max (depth l) (depth r) + 1

def size (t : Tree α) : Nat :=
  match t with
  | leaf a     => 1
  | node a l r => 1 + size l + size r

-- We can turn a tree into a list by traversing it in various ways, depending on whether we add the root
-- before its subtrees (preOrder), between its subtrees (inOrder) or after its subtrees (postOrder).
-- Define preOrder, inOrder, and postOrder as functions `Tree α → List α`.
def preOrder (t : Tree α) : List α :=
  match t with
  | leaf a     => [a]
  | node a l r => a :: preOrder l ++ preOrder r

def inOrder (t : Tree α) : List α :=
  match t with
  | leaf a     => [a]
  | node a l r => inOrder l ++ a :: inOrder r

def postOrder (t : Tree α) : List α :=
  match t with
  | leaf a     => [a]
  | node a l r => postOrder l ++ postOrder r ++ [a]

-- Define a function which returns the mirror image of a given tree.
def mirror (t : Tree α) : Tree α :=
  match t with
  | leaf a     => leaf a
  | node a l r => node a (mirror r) (mirror l)

-- Now we prove to facts about this function:
-- First, we prove that it is involutive (mirroring a tree twice returns the original tree).
-- Then, we prove that the mirror image of two trees is equal, if and only if the trees themselves are.

-- Useful lemmas, if you don't want to use ▸ as much (but it is also just as doable with some `have`s and ▸):
#check @Eq.trans
#check @Eq.symm
#check @congrArg

theorem mirror_involutive (t : Tree α) : mirror (mirror t) = t :=
  match t with
  | leaf _     => rfl
  | node _ l r =>
    show node .. = _ from  -- `..` is syntax sugar for an appropriate number of `_`s
      Eq.symm (mirror_involutive l) ▸ Eq.symm (mirror_involutive r) ▸ rfl

-- hint: try using `mirror_involutive`
theorem mirror_eq (s t : Tree α) : mirror s = mirror t ↔ s = t :=
  Iff.intro
    (fun h =>
      have mmsmmt : mirror (mirror s) = mirror (mirror t) := h ▸ rfl
      mirror_involutive s ▸ mirror_involutive t ▸ mmsmmt)
    (fun h => congrArg mirror h)

/- STRUCTURES -/

-- Define the structure `Semigroup α` for a semigroup on a type `α`.
-- Reminder: A semigroup is an algebraic structure with an associative binary operation `mul`.
structure Semigroup (α : Type) where
  mul : α → α → α
  assoc : mul (mul a b) c = mul a (mul b c)

-- Now extend the structure to one for a monoid on α.
-- Reminder : A monoid is a semigroup with an element which acts as the left and right identity on `mul`.
structure Monoid (α : Type) extends Semigroup α where
  e : α
  e_mul : mul e a = a
  mul_e : mul a e = a

-- Now try to instantiate the type `Nat'` as a monoid.
-- Leave out the three proofs (associativity, left and right inverse), we'll learn better ways to write such proofs next week.
def Nat'Monoid : Monoid Nat' :=
  { mul := mul,
    assoc := sorry,
    e := succ zero,
    e_mul := sorry,
    mul_e := sorry }


/-
Copyright (c) 2022 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
-- the next import will be enough for this sheet
import topology.basic

/-!

# Topology : making the API for `interior`.

(I'll assume you know the mathematics behind the interior of a subset of a topological space
in this sheet).

The way to make a type `X` into a topological space is to
tell the type class inference system that you'd like it to
keep track of a topological space structure on `X`. So it's

`variables (X : Type) [topological_space X]`

Lean has interiors of topological spaces, but let's
make our own, as warm-up.

-/

-- Here's the notation we'll use in this sheet
variables {X : Type} [topological_space X] (S : set X)

/-

## The API for topological spaces

`is_open S : Prop` is the predicate that `S : set X` is open.

Now here's some standard facts from topology. I'll tell you the names
of the proofs, you can guess what they're proofs of
(and then check with `#check`, which tells you the type of a term, so
if you give it a theorem proof it will tell you the theorem statement).

* is_open_univ
* is_open_Union, is_open_bUnion, is_open_sUnion (note the capital U)
* is_open.inter (note the small i) (and the dot to enable dot notation)

-/

/-

## Interiors

Lean has interior of a set, but let's make them ourselves
because it's a nice exercise.

-/

-- Got to call it `interior'` with a dash, because Lean already has `interior`
-- The following would work for the definition -- a "bUnion".
def interior' (S : set X) : set X := ⋃ (U ∈ {V : set X | is_open V ∧ V ⊆ S}), U

-- useful for rewrites; saves you having to unfold `interior'` (a good Lean
-- proof should never use `unfold` unless you're making API).
lemma mem_interior' (x : X) : x ∈ interior' S ↔ ∃ (U : set X) (hU : is_open U) (hUS : U ⊆ S), x ∈ U :=
begin
  unfold interior',
  rw set.mem_bUnion_iff,
  finish,
end

/-
Two alternative definitions: a Union of a Union, Union of a Union of a Union, or a sUnion.

-- Union of Union
def interior'' (S : set X) : set X := ⋃ (U : set X) (h : is_open U ∧ U ⊆ S), U

-- Union of Union of Union
def interior'' (S : set X) : set X := ⋃ (U : set X) (hU : is_open U) (hUS : U ⊆ S), U

-- sUnion
def interior''' (S : set X) : set X := ⋃₀ ({V : set X | is_open V ∧ V ⊆ S})

You can try one of those if you'd rather. Then in the above proof you might end up
rewriting set.mem_Union_iff or set.mem_sUnion_iff.
-/

-- Lean has `is_open_Union` and `is_open_bUnion` and `is_open_sUnion`.
-- Because our definition is a `bUnion`, we could start with `apply is_open_bUnion`,
-- the "correct form" of the assertion that an arbitrary

lemma interior'_open : is_open (interior' S) :=
begin
  sorry
end

lemma interior'_subset : interior' S ⊆ S :=
begin
  sorry,
end

-- Lean can work out S from hUS so let's make S a {} input for this one

variable {S}

lemma subset_interior' {U : set X} (hU : is_open U) (hUS : U ⊆ S) : U ⊆ interior' S :=
begin
  sorry,
end

-- Similarly here I put S and T in squiggly brackets because Lean can figure them out
-- when it sees hST
lemma interior'_mono {S T : set X} (hST : S ⊆ T) : interior' S ⊆ interior' T :=
begin
  sorry,
end

-- instead of starting this with `ext`, you could `apply set.subset.antisymm`,
-- which is the statement that if S ⊆ T and T ⊆ S then S = T.
lemma interior'_interior' : interior' (interior' S) = interior' S :=
begin
  sorry,
end

-- Some examples of interiors
lemma interior'_empty : interior' (∅ : set X) = ∅ :=
begin
  sorry,
end

lemma interior'_univ : interior' (set.univ : set X) = set.univ :=
begin
  sorry,
end

lemma interior'_inter (S T : set X) : interior' (S ∩ T) = interior' S ∩ interior' T :=
begin
  sorry,
end


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import geometry.euclidean.sphere.basic

/-!
# Second intersection of a sphere and a line

This file defines and proves basic results about the second intersection of a sphere with a line
through a point on that sphere.

## Main definitions

* `euclidean_geometry.sphere.second_inter` is the second intersection of a sphere with a line
  through a point on that sphere.

-/

noncomputable theory
open_locale real_inner_product_space

namespace euclidean_geometry

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
include V

/-- The second intersection of a sphere with a line through a point on that sphere; that point
if it is the only point of intersection of the line with the sphere. The intended use of this
definition is when `p ∈ s`; the definition does not use `s.radius`, so in general it returns
the second intersection with the sphere through `p` and with center `s.center`. -/
def sphere.second_inter (s : sphere P) (p : P) (v : V) : P :=
(-2 * ⟪v, p -ᵥ s.center⟫ / ⟪v, v⟫) • v +ᵥ p

/-- The distance between `second_inter` and the center equals the distance between the original
point and the center. -/
@[simp] lemma sphere.second_inter_dist (s : sphere P) (p : P) (v : V) :
  dist (s.second_inter p v) s.center = dist p s.center :=
begin
  rw sphere.second_inter,
  by_cases hv : v = 0, { simp [hv] },
  rw dist_smul_vadd_eq_dist _ _ hv,
  exact or.inr rfl
end

/-- The point given by `second_inter` lies on the sphere. -/
@[simp]

variables (V)

/-- If the vector is zero, `second_inter` gives the original point. -/
@[simp] lemma sphere.second_inter_zero (s : sphere P) (p : P) :
  s.second_inter p (0 : V) = p :=
by simp [sphere.second_inter]

variables {V}

/-- The point given by `second_inter` equals the original point if and only if the line is
orthogonal to the radius vector. -/
lemma sphere.second_inter_eq_self_iff {s : sphere P} {p : P} {v : V} :
  s.second_inter p v = p ↔ ⟪v, p -ᵥ s.center⟫ = 0 :=
begin
  refine ⟨λ hp, _, λ hp, _⟩,
  { by_cases hv : v = 0, { simp [hv] },
    rwa [sphere.second_inter, eq_comm, eq_vadd_iff_vsub_eq, vsub_self, eq_comm, smul_eq_zero,
         or_iff_left hv, div_eq_zero_iff, inner_self_eq_zero, or_iff_left hv, mul_eq_zero,
         or_iff_right (by norm_num : (-2 : ℝ) ≠ 0)] at hp },
  { rw [sphere.second_inter, hp, mul_zero, zero_div, zero_smul, zero_vadd] }
end

/-- A point on a line through a point on a sphere equals that point or `second_inter`. -/
lemma sphere.eq_or_eq_second_inter_of_mem_mk'_span_singleton_iff_mem {s : sphere P} {p : P}
  (hp : p ∈ s) {v : V} {p' : P} (hp' : p' ∈ affine_subspace.mk' p (ℝ ∙ v)) :
  (p' = p ∨ p' = s.second_inter p v) ↔ p' ∈ s :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rcases h with h | h,
    { rwa h },
    { rwa [h, sphere.second_inter_mem] } },
  { rw [affine_subspace.mem_mk'_iff_vsub_mem, submodule.mem_span_singleton] at hp',
    rcases hp' with ⟨r, hr⟩,
    rw [eq_comm, ←eq_vadd_iff_vsub_eq] at hr,
    subst hr,
    by_cases hv : v = 0, { simp [hv] },
    rw sphere.second_inter,
    rw mem_sphere at h hp,
    rw [←hp, dist_smul_vadd_eq_dist _ _ hv] at h,
    rcases h with h | h;
      simp [h] }
end

/-- `second_inter` is unchanged by multiplying the vector by a nonzero real. -/
@[simp] lemma sphere.second_inter_smul (s : sphere P) (p : P) (v : V) {r : ℝ}
  (hr : r ≠ 0) : s.second_inter p (r • v) = s.second_inter p v :=
begin
  simp_rw [sphere.second_inter, real_inner_smul_left, inner_smul_right, smul_smul,
           div_mul_eq_div_div],
  rw [mul_comm, ←mul_div_assoc, ←mul_div_assoc, mul_div_cancel_left _ hr, mul_comm, mul_assoc,
      mul_div_cancel_left _ hr, mul_comm]
end

/-- `second_inter` is unchanged by negating the vector. -/
@[simp] lemma sphere.second_inter_neg (s : sphere P) (p : P) (v : V) :
  s.second_inter p (-v) = s.second_inter p v :=
by rw [←neg_one_smul ℝ v, s.second_inter_smul p v (by norm_num : (-1 : ℝ) ≠ 0)]

/-- Applying `second_inter` twice returns the original point. -/
@[simp] lemma sphere.second_inter_second_inter (s : sphere P) (p : P) (v : V) :
  s.second_inter (s.second_inter p v) v = p :=
begin
  by_cases hv : v = 0, { simp [hv] },
  have hv' : ⟪v, v⟫ ≠ 0 := inner_self_ne_zero.2 hv,
  simp only [sphere.second_inter, vadd_vsub_assoc, vadd_vadd, inner_add_right, inner_smul_right,
             div_mul_cancel _ hv'],
  rw [←@vsub_eq_zero_iff_eq V, vadd_vsub, ←add_smul, ←add_div],
  convert zero_smul ℝ _,
  convert zero_div _,
  ring
end

/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
`second_inter`, the result of `second_inter` may be expressed using `line_map`. -/
lemma sphere.second_inter_eq_line_map (s : sphere P) (p p' : P) :
  s.second_inter p (p' -ᵥ p) =
    affine_map.line_map p p' (-2 * ⟪p' -ᵥ p, p -ᵥ s.center⟫ / ⟪p' -ᵥ p, p' -ᵥ p⟫) :=
rfl

/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
`second_inter`, the result lies in the span of the two points. -/
lemma sphere.second_inter_vsub_mem_affine_span (s : sphere P) (p₁ p₂ : P) :
  s.second_inter p₁ (p₂ -ᵥ p₁) ∈ line[ℝ, p₁, p₂] :=
smul_vsub_vadd_mem_affine_span_pair _ _ _

/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
`second_inter`, the three points are collinear. -/
lemma sphere.second_inter_collinear (s : sphere P) (p p' : P) :
  collinear ℝ ({p, p', s.second_inter p (p' -ᵥ p)} : set P) :=
begin
  rw [set.pair_comm, set.insert_comm],
  exact (collinear_insert_iff_of_mem_affine_span (s.second_inter_vsub_mem_affine_span _ _)).2
    (collinear_pair ℝ _ _)
end

/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
`second_inter`, and the second point is not outside the sphere, the second point is weakly
between the first point and the result of `second_inter`. -/
lemma sphere.wbtw_second_inter {s : sphere P} {p p' : P} (hp : p ∈ s)
  (hp' : dist p' s.center ≤ s.radius) : wbtw ℝ p p' (s.second_inter p (p' -ᵥ p)) :=
begin
  by_cases h : p' = p, { simp [h] },
  refine wbtw_of_collinear_of_dist_center_le_radius (s.second_inter_collinear p p')
    hp hp' ((sphere.second_inter_mem _).2 hp) _,
  intro he,
  rw [eq_comm, sphere.second_inter_eq_self_iff, ←neg_neg (p' -ᵥ p), inner_neg_left,
      neg_vsub_eq_vsub_rev, neg_eq_zero, eq_comm] at he,
  exact ((inner_pos_or_eq_of_dist_le_radius hp hp').resolve_right (ne.symm h)).ne he
end

/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
`second_inter`, and the second point is inside the sphere, the second point is strictly between
the first point and the result of `second_inter`. -/
lemma sphere.sbtw_second_inter {s : sphere P} {p p' : P} (hp : p ∈ s)
  (hp' : dist p' s.center < s.radius) : sbtw ℝ p p' (s.second_inter p (p' -ᵥ p)) :=
begin
  refine ⟨sphere.wbtw_second_inter hp hp'.le, _, _⟩,
  { rintro rfl, rw mem_sphere at hp, simpa [hp] using hp' },
  { rintro h,
    rw [h, mem_sphere.1 ((sphere.second_inter_mem _).2 hp)] at hp',
    exact lt_irrefl _ hp' }
end

end euclidean_geometry


import tactic
import .num_lemmas
import data.set.basic

open_locale classical
noncomputable theory

universes u v w

open finset

namespace set

section basic

variables {α β : Type*} {s s' t t' r r': set α}

@[simp] lemma absorb_union_inter (s t : set α) : s ∪ (s ∩ t) = s :=
by calc s ∪ (s ∩ t) = (s ∩ univ) ∪ (s ∩ t) : by rw inter_univ
                ... = s : by rw [←inter_distrib_left, union_comm, union_univ, inter_univ ]

@[simp] lemma absorb_inter_union (s t : set α) : s ∩ (s ∪ t) = s :=
by {rw [inter_comm, union_inter_cancel_left], }

lemma inter_distrib_inter_left (s t r : set α) : (s ∩ t) ∩ r = (s ∩ r) ∩ (t ∩ r) :=
by rw [inter_assoc s r, inter_comm r, inter_assoc t, inter_self, inter_assoc]

lemma union_distrib_union_left (s t r : set α) : (s ∪ t) ∪ r = (s ∪ r) ∪ (t ∪ r) :=
by rw [union_assoc s r, union_comm r, union_assoc t, union_self, union_assoc]

lemma union_distrib_union_right (s t r : set α) : s ∪ (t ∪ r) = (s ∪ t) ∪ (s ∪ r) :=
by rw [union_comm s, union_distrib_union_left t r s, union_comm s, union_comm s]

@[simp] lemma inter_right_self (s t : set α) : s ∩ t ∩ t = s ∩ t :=
by rw [inter_assoc, inter_self]

@[simp] lemma union_right_self (s t : set α) : s ∪ t ∪ t = s ∪ t :=
by rw [union_assoc, union_self]

lemma subset_iff_union_eq_left : (s ⊆ t) ↔ (s ∪ t = t) :=
by rw [←compl_subset_compl, subset_iff_inter_eq_left, ←compl_union,
            compl_inj_iff, union_comm t s]

lemma subset_iff_union_eq_right : (t ⊆ s) ↔ (s ∪ t = s) :=
by rw [subset_iff_union_eq_left, union_comm]

lemma subset_refl (s : set α) : s ⊆ s :=
by rw [subset_iff_inter_eq_left, inter_self]

lemma subset_ssubset_or_eq : (s ⊆ t) → (s ⊂ t) ∨ s = t :=
λ hst, by {rw or_comm, apply eq_or_ssubset_of_subset hst}

lemma subset_iff_ssubset_or_eq : (s ⊆ t) ↔ (s ⊂ t) ∨ s = t :=
⟨λ h, subset_ssubset_or_eq h, λ h, by {cases h, from h.1, rw h}⟩

lemma ssubset_iff_subset_not_supset : s ⊂ t ↔ s ⊆ t ∧ ¬(t ⊆ s) :=
iff.rfl

lemma ssubset_of_subset_ne : s ⊆ t → s ≠ t → s ⊂ t :=
@lt_of_le_of_ne _ _ s t

lemma ne_of_ssubset : s ⊂ t → s ≠ t :=
ne_of_irrefl

lemma ssubset_irrefl (s : set α) : ¬(s ⊂ s) :=
λ h, by {rw ssubset_iff_subset_ne at h, from h.2 rfl}

lemma univ_subset  (hs : univ ⊆ s) : s = univ :=
subset.antisymm (subset_univ s) hs

instance subset_subtype_nonempty : nonempty {t : set α // t ⊆ s} :=
by {apply nonempty_subtype.mpr, from ⟨_,empty_subset _⟩,  }

instance subtype_coe : has_coe {t : set α // t ⊆ s} (set α) := coe_subtype

lemma subset_empty : s ⊆ ∅ → s = ∅ :=
λ hs, subset.antisymm hs (empty_subset s)

lemma ssubset_empty (s : set α) : ¬ s ⊂ ∅ :=
λ h, by {rw ssubset_iff_subset_ne at h, from h.2 (subset_empty h.1)}

lemma empty_of_subset_compl (h : s ⊆ sᶜ) : s = ∅ :=
by rwa [subset_iff_inter_eq_left, inter_compl_self, eq_comm] at h

lemma disjoint_compl_subset (h : s ∩ t = ∅) : s ⊆ tᶜ :=
by rw [subset_iff_inter_eq_left, ← empty_union (s ∩ tᶜ), ←h,
            ←inter_distrib_left, union_compl_self, inter_univ]

lemma subset_compl_disjoint (h : s ⊆ tᶜ) : s ∩ t = ∅ :=
by {rw subset_iff_inter_eq_left at h, rw [←h, inter_assoc], simp}

lemma disjoint_iff_subset_compl : s ∩ t = ∅ ↔ s ⊆ tᶜ :=
⟨λ h, disjoint_compl_subset h, λ h, subset_compl_disjoint h⟩

lemma disjoint_iff_inter_compl_eq_left : s ∩ t = ∅ ↔ s ∩ tᶜ = s :=
by rw [disjoint_iff_subset_compl, subset_iff_inter_eq_left]

lemma disjoint_iff_inter_compl_eq_right : s ∩ t = ∅ ↔ sᶜ ∩ t = t :=
by rw [inter_comm, disjoint_iff_inter_compl_eq_left, inter_comm]

lemma disjoint_iff_diff_eq_left : s ∩ t = ∅ ↔ s \ t = s :=
disjoint_iff_inter_compl_eq_left

lemma subset_iff_diff_empty (s t : set α) : s ⊆ t ↔ s \ t = ∅ :=
by {rw [←compl_compl t, ←disjoint_iff_subset_compl], simp [diff_eq],}

lemma subset_iff_partition (s t : set α) : s ⊆ t ↔ t = s ∪ (t \ s) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { nth_rewrite 0 ←(subset_iff_union_eq_left.mp h),
    rw [diff_eq, union_distrib_left], simp,},
  rw h, simp,
end

lemma subset_iff_disjoint_compl : s ⊆ t ↔ s ∩ tᶜ = ∅ :=
by rw [subset_iff_diff_empty, diff_eq]

lemma disjoint_of_subset_left' (hst : s ⊆ t) (htr : t ∩ r = ∅) : s ∩ r = ∅ :=
by {rw ←disjoint_iff_inter_eq_empty at *, exact disjoint_of_subset_left hst htr}

lemma disjoint_of_subset_right' (hst : s ⊆ t) (hrt : r ∩ t = ∅) : r ∩ s = ∅ :=
by {rw ←disjoint_iff_inter_eq_empty at *, exact disjoint_of_subset_right hst hrt, }

lemma disjoint_of_subsets (hss' : s ⊆ s') (htt' : t ⊆ t') (hst : s' ∩ t' = ∅) :
  s ∩ t = ∅ :=
by {rw ←disjoint_iff_inter_eq_empty at *, exact disjoint_of_subset hss' htt' hst, }

lemma cover_compl_subset :  s ∪ t = univ → sᶜ ⊆ t :=
λ h, by rw [subset_iff_union_eq_left, ←univ_inter (sᶜ ∪ t), ←h,
              ←union_distrib_right, inter_compl_self, empty_union]

lemma compl_inj (h : sᶜ = tᶜ) : s = t :=
by rw [←compl_compl s, ←compl_compl t, h]

lemma compl_compl_inter_left (s t : set α) : (sᶜ ∩ t)ᶜ = s ∪ tᶜ :=
by {nth_rewrite 0 ←(compl_compl t), rw [compl_inter, compl_compl, compl_compl] }

lemma compl_compl_inter_right (s t : set α) : (s ∩ tᶜ)ᶜ = sᶜ ∪ t :=
by {nth_rewrite 0 ←(compl_compl s), rw [compl_inter, compl_compl, compl_compl] }

lemma compl_compl_union_left (s t : set α) : (sᶜ ∪ t)ᶜ = s ∩ tᶜ :=
by {nth_rewrite 0 ←(compl_compl t), rw [compl_union, compl_compl, compl_compl] }

lemma compl_compl_union_right (s t : set α) : (s ∪ tᶜ)ᶜ = sᶜ ∩ t :=
by {nth_rewrite 0 ←(compl_compl s), rw [compl_union, compl_compl, compl_compl] }

lemma compl_partition (s t : set α) : (s ∩ t) ∪ (sᶜ ∩ t) = t :=
by rw [←inter_distrib_right, union_compl_self, univ_inter]

lemma compl_partition_subset  (hst : s ⊆ t) : s ∪ (sᶜ ∩ t) = t :=
by {nth_rewrite 0 ←(subset_iff_inter_eq_left.mp hst), exact compl_partition s t}

lemma compl_pair (h : sᶜ = t) : (s = tᶜ) :=
by rw [←h, compl_compl]

lemma compl_pair_iff : (sᶜ = t) ↔ (s = tᶜ) :=
⟨λ h, compl_pair h, λ h, by {rw eq_comm at h, from (compl_pair h).symm}⟩

lemma compl_diff (s t : set α) : (s \ t)ᶜ = sᶜ ∪ t :=
by rw [diff_eq, compl_inter, compl_compl]

@[simp] lemma union_union_compl_self (s t : set α) : (s ∪ t) ∪ tᶜ = univ :=
by rw [union_assoc, union_compl_self, union_univ]

@[simp] lemma inter_inter_compl_self (s t : set α) : (s ∩ t) ∩ tᶜ = ∅ :=
by rw [inter_assoc, inter_compl_self, inter_empty]

@[simp] lemma union_union_compl_right (s t : set α) : s ∪ (t ∪ sᶜ) = univ :=
by rw [←union_assoc, union_comm s, union_union_compl_self]

@[simp] lemma inter_inter_compl_right (s t : set α) : s ∩ (t ∩ sᶜ) = ∅ :=
by rw [←inter_assoc, inter_comm s, inter_inter_compl_self]

lemma inter_union_compl_self (s t : set α) : s ∩ (t ∪ tᶜ) = s :=
by rw [union_compl_self, inter_univ]

lemma subset_own_compl : s ⊆ sᶜ → s = ∅ :=
  λ h, by {rw [subset_iff_union_eq_left,union_compl_self, ←compl_empty, compl_inj_iff] at h,
                rw ←h }

lemma inter_subset_union (s t : set α) : s ∩ t ⊆ s ∪ t :=
  subset.trans (inter_subset_left s t) (subset_union_left s t)

lemma subset_of_inter_mp : s ⊆ t ∩ r → s ⊆ t ∧ s ⊆ r :=
  λ h, ⟨subset.trans h (inter_subset_left _ _), subset.trans h (inter_subset_right _ _)⟩

lemma subset_of_set_and_compl : s ⊆ t → s ⊆ tᶜ → s = ∅ :=
  λ h1 h2, by {have := subset_inter h1 h2, rw inter_compl_self at this,
  exact subset_empty this}

@[trans] lemma subset.lt_of_le_of_lt (_ : s ⊆ t) (_ : t ⊂ r) : s ⊂ r :=
lt_of_le_of_lt ‹s ≤ t› ‹t < r›

@[trans] lemma subset.lt_of_lt_of_le (_ : s ⊂ t) (_ : t ⊆ r) : s ⊂ r :=
lt_of_lt_of_le ‹s < t› ‹t ≤ r›

lemma ssubset_not_supset (h : s ⊂ t) : ¬(t ⊆ s) :=
λ h', ssubset_irrefl _ (subset.lt_of_lt_of_le h h')

lemma subset_not_ssupset (h: s ⊆ t) : ¬(t ⊂ s) :=
λ h', ssubset_irrefl _ (subset.lt_of_le_of_lt h h')

lemma eq_of_subset_not_ssubset  : s ⊆ t → ¬(s ⊂ t) → s = t :=
λ h h', by {simp only [not_and, not_not, ssubset_iff_subset_ne] at h', exact h' h}

@[trans] lemma ssubset.trans {s t r : set α} : s ⊂ t → t ⊂ r → s ⊂ r :=
λ hst htr, subset.lt_of_le_of_lt hst.1 htr

lemma ssubset_inter : s ≠ t → s ∩ t ⊂ s ∨ s ∩ t ⊂ t :=
begin
  intro h,
  by_contra a, push_neg at a, simp_rw [ssubset_iff_subset_ne, not_and', not_imp_not] at a,
  exact h (eq.trans (a.1 (inter_subset_left s t)).symm (a.2 (inter_subset_right s t)) ),
end

lemma union_union_diff (s t r : set α) : (s ∪ r) ∪ (t \ r) = s ∪ t ∪ r :=
by {rw [diff_eq, union_distrib_left, union_right_comm, union_assoc _ r], simp,}

lemma union_diff_absorb (s t : set α) : s ∪ (t \ s) = s ∪ t :=
by {nth_rewrite 0 ←union_self s, rw [union_union_diff, union_right_comm, union_self]}

@[simp] lemma union_union_inter_compl_self (s t r : set α) : (s ∪ r) ∪ (t ∩ rᶜ) = s ∪ t ∪ r :=
by rw [←diff_eq, union_union_diff]

lemma union_inter_diff (s t r : set α) : (s ∪ r) ∩ (t \ r) = (s ∩ t) \ r :=
by {rw [diff_eq, diff_eq, inter_distrib_right], simp [←inter_assoc, inter_right_comm r t rᶜ] }

lemma subset_of_subset_diff (h : s ⊆ t \ r) : s ⊆ t :=
λ x hx, by {have := h hx, rw mem_diff at this, exact this.1,  }

lemma eq_of_union_eq_inter : s ∪ t = s ∩ t → s = t :=
begin
  intro h, apply subset.antisymm,
  calc s ⊆ (s ∪ t) : subset_union_left _ _ ... = s ∩ t : h ... ⊆ t : inter_subset_right _ _,
  calc t ⊆ (s ∪ t) : subset_union_right _ _ ... = s ∩ t : h ... ⊆ s : inter_subset_left _ _,
end

lemma union_of_disjoint : s ∩ t = ∅ → s ∩ r = ∅ → s ∩ (t ∪ r) = ∅ :=
  λ ht hr, by {rw [inter_distrib_left, ht, hr], simp }

@[simp] lemma diff_union (s t : set α) : (s ∩ t) ∪ (s \ t) = s :=
by rw [diff_eq, ←inter_distrib_left, union_compl_self, inter_univ]

@[simp] lemma inter_diff (s t : set α) : s ∩ (t \ s)  = ∅ :=
by rw [diff_eq, ←inter_assoc, inter_right_comm, inter_compl_self, empty_inter]

@[simp] lemma partition_inter (s t : set α) : (s ∩ t) ∩ (s \ t) = ∅ :=
by rw [inter_assoc, inter_diff, inter_empty]

@[simp] lemma inter_diffs_eq_empty (s t : set α) : (s \ t) ∩ (t \ s) = ∅ :=
by {simp only [diff_eq], rw [inter_assoc, ←inter_assoc tᶜ], simp}

lemma pair_move {s r : set α} (t : set α) (hst : r ⊆ s) : (s \ r) ∪ (t ∪ r) = s ∪ t :=
by {ext, simp, tauto, }

lemma diff_empty_subset (s t : set α) : s \ t = ∅ → s ⊆ t :=
λ hst, by {rw [←diff_union s t, hst, union_empty], apply inter_subset_right}

lemma subset_diff_empty (s t : set α) : s ⊆ t → s \ t = ∅ :=
λ hst, by {rw diff_eq, rw subset_iff_inter_eq_left at hst,
           rw [←hst, inter_assoc, inter_compl_self, inter_empty]}

lemma diff_empty_iff_subset (s t : set α) : s \ t = ∅ ↔ s ⊆ t :=
by {split, apply diff_empty_subset, apply subset_diff_empty}

lemma subset_diff_disjoint (s t r : set α) : s ⊆ t → s ∩ r = ∅ → s ⊆ t \ r :=
λ hst hsr, by {rw [disjoint_iff_subset_compl, subset_iff_inter_eq_left] at hsr,
                rw [diff_eq, subset_iff_inter_eq_left, inter_comm t, ←inter_assoc, hsr,
                      subset_iff_inter_eq_left.mp hst], }

lemma ssubset_diff_nonempty : s ⊂ t → (t \ s).nonempty :=
λ hst, set.nonempty_of_ssubset hst

lemma union_diff_of_subset  : s ⊆ t → s ∪ (t \ s) = t :=
λ h, by {rw [subset_iff_inter_eq_left, inter_comm] at h, have := diff_union t s, rwa h at this}

lemma diff_eq_self_of_subset_diff (h : s ⊆ r \ t) : s \ t = s :=
by {rw [←disjoint_iff_diff_eq_left, disjoint_iff_subset_compl],
        refine subset.trans h _, simp [diff_eq],  }

@[simp] lemma diff_inter_right_eq_empty (s t : set α) : (t \ s) ∩ s = ∅ :=
by rw [inter_comm, inter_diff]

@[simp] lemma union_diff (s t : set α) : s ∪ (t \ s) = s ∪ t :=
by {rw [diff_eq, union_distrib_left, union_compl_self, inter_univ]}

@[simp] lemma union_diff_diff (s t : set α) : (s ∪ t) \ (t \ s) = s :=
by rw [diff_eq, diff_eq, compl_inter,compl_compl,union_comm,
          ←union_distrib_right, inter_compl_self, empty_union]

lemma diff_self_diff (s t : set α) : s \ (s \ t) = s ∩ t :=
by rw [diff_eq, compl_diff, inter_distrib_left, inter_compl_self, empty_union]

lemma inter_distrib_diff (s t r : set α) : s ∩ (t \ r) = (s ∩ t) \ (s ∩ r) :=
by {rw [diff_eq, diff_eq, compl_inter, inter_distrib_left, inter_right_comm,
                        inter_compl_self, empty_inter, empty_union, ←inter_assoc]}

lemma diff_inter_diff_right (s t r : set α) : (s \ r) ∩ (t \ r) = (s ∩ t) \ r :=
by {ext, tidy,  }

lemma diff_right_comm (s t r : set α) : s \ t \ r = s \ r \ t :=
by simp [diff_eq, inter_right_comm]

@[simp] lemma univ_diff (s : set α) : univ \ s = sᶜ :=
  (compl_eq_univ_diff s).symm

lemma empty_ssubset_nonempty : s.nonempty → ∅ ⊂ s :=
λ h, by {rw ←set.ne_empty_iff_nonempty at h,
          exact ssubset_of_subset_ne (empty_subset s) (ne.symm h)}

lemma nonempty_iff_empty_subset: s.nonempty ↔ ∅ ⊂ s :=
⟨ λ h, empty_ssubset_nonempty h,
  λ h, by {rw ←set.ne_empty_iff_nonempty, exact (ne_of_ssubset h).symm, }⟩

lemma ssubset_compl_commpl.mpr : s ⊂ t → tᶜ ⊂ sᶜ :=
λ h, ssubset_of_subset_ne (compl_subset_compl.mpr h.1)
      (λ h', by {rw (compl_inj h') at h, from ssubset_irrefl _ h})

lemma compl_to_ssubset : sᶜ ⊂ tᶜ → t ⊂ s :=
λ h, by {have := ssubset_compl_commpl.mpr h, repeat {rw compl_compl at this}, exact this }

lemma compl_ssubset_compl_iff : sᶜ ⊂ tᶜ ↔ t ⊂ s :=
by tidy

lemma ssubset_compl_comm : s ⊂ tᶜ ↔ t ⊂ sᶜ :=
by {convert compl_ssubset_compl_iff, rw compl_compl}

lemma compl_ssubset_comm : sᶜ ⊂ t ↔ tᶜ ⊂ s :=
by {convert @compl_ssubset_compl_iff _ s tᶜ, rw compl_compl}

--lemma ssubset_compl_iff_compl_ssubset : s ⊂ tᶜ ↔ sᶜ ⊂ t :=
--by {nth_rewrite 0 ← compl_compl s, rw compl_ssubset_compl_iff,  }

lemma ssubset_univ_of_ne_univ: s ≠ univ → s ⊂ univ :=
λ h, ssubset_of_subset_ne (subset_univ _) h

lemma pairwise_disjoint_inter_sUnion {S S₁ S₂: set (set α)}
(hdj : pairwise_disjoint S) (h₁ : S₁ ⊆ S) (h₂ : S₂ ⊆ S) :
  sUnion (S₁ ∩ S₂) = sUnion S₁ ∩ sUnion S₂ :=
begin
  ext, simp only [mem_inter_iff, mem_sUnion], split,
  { rintros ⟨t,hT,hxt⟩, rw mem_inter_iff at hT, refine ⟨⟨t,hT.1,hxt⟩,⟨t,hT.2,hxt⟩⟩, },
  rintros ⟨⟨t,h,hxt⟩,⟨t',h',hxt'⟩⟩,
  have := (pairwise_disjoint.elim hdj
    (mem_of_mem_of_subset h h₁)
    ((mem_of_mem_of_subset h' h₂)) x hxt hxt'),
  subst this, use t, tidy,
end

lemma infinite_of_finite_diff (hs : s.finite) (ht : t.infinite) :
  (t \ s).infinite :=
λ h, ht (by {refine (hs.union h).subset _, rw set.union_diff_self, apply set.subset_union_right, })

lemma infinite_of_union (hs : s.infinite) (t : set α) :
  (s ∪ t).infinite :=
set.infinite_mono (set.subset_union_left _ _) hs

lemma finite.diff (hs : s.finite) (t : set α) : (s \ t).finite :=
  set.finite.subset hs (set.diff_subset _ _)

lemma finite.inter_left (hs : s.finite) (t : set α) : (s ∩ t).finite :=
  set.finite.subset hs (set.inter_subset_left _ _)

lemma finite.inter_right (ht : t.finite) (s : set α ) : (s ∩ t).finite :=
  set.finite.subset ht (set.inter_subset_right _ _)

lemma subset_insert_iff_subset_or_eq_insert {s t : set α} {a : α}:
  s ⊆ insert a t ↔ (s ⊆ t) ∨ ∃ s' ⊆ t, s = insert a s' :=
begin
  refine ⟨λ h, _, _⟩,
  by_cases ha : a ∈ s,
  { refine or.inr ⟨s \ {a}, λ x, _, _⟩,
    {specialize @h x, tidy, tauto, },
    simp [set.insert_eq_of_mem ha]},
  refine or.inl (λ x hx, _),
  specialize h hx,
  rw set.mem_insert_iff at h,
  rcases h with (rfl | h),
    exact false.elim (ha hx),
    assumption,
  rintros (hst | ⟨s', hs't, rfl⟩),
  { exact subset.trans hst (set.subset_insert _ _)},
  exact set.insert_subset_insert hs't,
end

lemma insert_inj_subset_iff {s t t' : set α} {a : α} (ht : t ⊆ s) (ht' : t' ⊆ s) (hat : a ∉ s ):
  insert a t = insert a t' ↔ t = t' :=
begin
  refine ⟨λ h, _, by {rintro rfl, refl}⟩,
  simp_rw [ext_iff, mem_insert_iff] at h,
  ext x,
  specialize h x, split,
  { intro h',
    obtain (rfl | hx) := h.mp (or.intro_right _ h'),
      exact false.elim (hat (mem_of_mem_of_subset h' ht)),
    assumption, },
  { intro h',
    obtain (rfl | hx) := h.mpr (or.intro_right _ h'),
      exact false.elim (hat (mem_of_mem_of_subset h' ht')),
    assumption, },
end

lemma remove_insert (s : set α) (e : α) :
  insert e (s \ {e})  = insert e s :=
by rw [← union_singleton, diff_union_self, union_singleton]

lemma finite.iff_of_bij_on {s : set α} {t : set β} {f : α → β} (h : bij_on f s t) :
  s.finite ↔ t.finite :=
begin
  refine ⟨λ hs, _, λ ht, _⟩,
  { convert finite.image f hs, rw h.image_eq},
  apply finite_of_finite_image h.inj_on, rwa h.image_eq,
end

end basic

section symm_diff

variables {α : Type*}
/-- the symmetric difference of two sets -/
def symm_diff (s t : set α) : set α := (s \ t) ∪ (t \ s)

lemma symm_diff_assoc (s t r : set α) :
  (s.symm_diff t).symm_diff r = s.symm_diff (t.symm_diff r) :=
by {ext, simp [symm_diff], tauto}

@[simp] lemma symm_diff_self (s : set α): s.symm_diff s = ∅ := by simp [symm_diff]

@[simp] lemma symm_diff_univ (s : set α) : s.symm_diff univ = sᶜ := by simp [symm_diff]

@[simp] lemma symm_diff_empty (s : set α) : s.symm_diff ∅ = s := by simp [symm_diff]

lemma symm_diff_comm (s t : set α) : symm_diff s t = symm_diff t s :=
by {ext, simp [symm_diff], tauto}

lemma symm_diff_alt (s t : set α) : symm_diff s t = (s ∪ t) \ (s ∩ t) :=
by {ext, simp only [symm_diff, mem_inter_eq, mem_union_eq, not_and, mem_diff], tauto}

@[simp] lemma symm_diff_self_right (s t : set α) : (s.symm_diff t).symm_diff t = s :=
by simp [symm_diff_assoc]

lemma symm_diff_eq_iff {s t r: set α} :
  s.symm_diff t = r ↔ s = t.symm_diff r :=
begin
  split, {rintro rfl, rw symm_diff_comm, simp, },
  rintro rfl, simp [symm_diff_comm t],
end

lemma symm_diff_subset_union (s t : set α) : s.symm_diff t ⊆ s ∪ t :=
by {rw symm_diff_alt, apply diff_subset}

lemma diff_subset_symm_diff (s t : set α) : s \ t ⊆ s.symm_diff t :=
λ x hx, by {rw symm_diff_alt, simp at ⊢ hx, tauto}

lemma symm_diff_singleton_mem_eq {s : set α} {x : α} (h : x ∈ s) :
  s.symm_diff {x} = s \ {x} :=
begin
  ext,
  simp only [symm_diff,and_imp, mem_singleton_iff, mem_union_eq, or_iff_left_iff_imp, mem_diff],
  rintros rfl h',
  exact false.elim (h' h),
end

lemma symm_diff_singleton_nonmem_eq {s : set α} {x : α} (h : x ∉ s) :
  s.symm_diff {x} = insert x s :=
begin
  ext y,
  simp only [symm_diff, mem_singleton_iff, mem_union_eq, mem_insert_iff, mem_diff],
  rcases em (y = x) with (rfl | _); tauto,
end

@[simp] lemma symm_diff_eq_self_iff {s t : set α } :
  s.symm_diff t = s ↔ t = ∅ :=
⟨λ h, by rwa [symm_diff_comm, symm_diff_eq_iff, symm_diff_self] at h, by {rintro rfl, simp}⟩

end symm_diff

end set
section sigma

variables {α : Type*} {β : α → Type*}

/-- the set of all pairs `(x,y)` where `x ∈ s` and `y ∈ β x` -/
def set.sigma (s : set α) (t : Π (a : α), set (β a)) : set (sigma β) :=
  set_of (λ x : sigma β, x.1 ∈ s ∧ x.2 ∈ t x.1)

def set.sigma_swap {α β : Type*}: (Σ (a : α), β) → (Σ (b : β), α) :=
  λ p, ⟨p.2, p.1⟩

lemma set.sigma_inter_sigma (s s' : set α) (t t' : Π (a : α), set (β a)) :
  (s.sigma t) ∩ (s'.sigma t') = (s ∩ s').sigma (λ a, (t a) ∩ (t' a)) :=
by {ext, simp [set.sigma], tauto}

lemma set.sigma_inter (s : set α) (t : Π (a : α), set (β a)) (r : set (sigma β)) :
  (s.sigma t) ∩ r = s.sigma (λ a, (t a) ∩ { b ∈ t a | (⟨a,b⟩ : sigma β) ∈ r}) :=
by {ext, simp [set.sigma], tauto}

lemma set.sigma_singleton_eq  (a : α) (t : Π (a : α), set (β a)) :
  ({a} : set α).sigma t = sigma.mk a '' t a :=
begin
  ext x,
  simp only [set.sigma, set.mem_image, set.mem_singleton_iff, set.mem_set_of_eq],
  split,
  { cases x, dsimp only at *,  rintro ⟨rfl, h⟩, exact ⟨_, h, rfl⟩},
  rintro ⟨b, hb, rfl⟩,
  exact ⟨rfl, hb⟩,
end

lemma set.sigma_finite_iff {s : set α} {t : Π a, set (β a)}:
  (s.sigma t).finite ↔ {a ∈ s | (t a).nonempty}.finite ∧ ∀ a ∈ s, (t a).finite :=
begin
  refine ⟨λ hf, ⟨_, λ a ha, _⟩, λ h, _⟩,
  { convert set.finite.image (λ (p : sigma β), p.1) hf,
    ext p,
    simp [set.sigma, set.nonempty_def]},

  { refine @set.finite_of_finite_image _ _ _
      (λ x, (⟨a, x⟩ : sigma β))
      _
      (set.finite.subset hf _),
    { intros x hx y hy hxy, simpa using hxy},
    simp only [set.image_subset_iff],
    exact λ x hx, ⟨ha, hx⟩},
  convert @set.finite.bUnion _ _ _ (λ a _, ({a} : set α).sigma t) h.1 _,
  { ext,
    simp only [set.nonempty_def, exists_prop, set.mem_Union, set.mem_sep_eq,
     set.mem_singleton_iff, set.mem_set_of_eq, set.sigma],
    refine ⟨λ h, ⟨x.1, ⟨⟨h.1, _, h.2⟩, rfl , h.2⟩⟩, λ h, _⟩,
    obtain ⟨a, ⟨has, b, hba⟩, ⟨rfl, ha'⟩⟩ := h,
    exact ⟨has, ha'⟩},
  intros a ha,
  simp only,
  convert set.finite.image (λ (b : β a), (⟨a,b⟩ : sigma β)) (h.2 a ha.1),
  rw set.sigma_singleton_eq,
end

lemma set.sigma_to_finset {s : set α} {t : Π a, set (β a)}
(h : (s.sigma t).finite) :
  h.to_finset = finset.sigma (set.sigma_finite_iff.mp h).1.to_finset
                (λ a : α, dite (a ∈ s) (λ ha, ((set.sigma_finite_iff.mp h).2 a ha).to_finset)
                                       (λ _, finset.empty)) :=
begin
  ext x,
  simp only [set.mem_sep_eq, set.finite.mem_to_finset, finset.mem_sigma, set.nonempty_def],
  split_ifs with h h',
  { simp only [set.finite.mem_to_finset, set.sigma, set.mem_set_of_eq], cases x, tauto},
  rw [set.sigma, set.mem_set_of_eq],
  exact ⟨λ h₁, false.elim (h h₁.1), λ h₁, false.elim (finset.not_mem_empty _ h₁.2)⟩,
end

lemma set.sigma_eq_univ_sigma (s : set α) (t : Π a, set (β a) ):
  s.sigma t = (set.univ : set α).sigma (λ a, ite (a ∈ s) (t a) ∅) :=
begin
  ext x, cases x with a b,
  simp only [set.sigma, true_and, set.mem_univ, set.mem_set_of_eq],
  split_ifs;
  tauto,
end

lemma set.sigma_univ_invert {α β : Type*} (t : α → set β) :
  set.bij_on (set.sigma_swap)
    ((set.univ : set α).sigma t)
    ((set.univ : set β).sigma (λ b, {a : α | b ∈ t a}) ):=
begin
  refine ⟨ λ x hx, _, λ x hx y hy hxy , _, λ x hx, _⟩,
  { rw [set.sigma] at *, simpa using hx},
  { cases x, cases y, simp only [heq_iff_eq, set.sigma_swap] at ⊢ hxy, rwa and_comm,},
  simp only [set.mem_image, sigma.exists],
  rw [set.sigma] at hx ⊢,
  simp only [true_and, set.mem_univ, set.mem_set_of_eq] at hx ⊢,
  exact ⟨x.2, x.1, hx, by {simp only [sigma.eta, set.sigma_swap], }⟩,
end

lemma set.sigma_invert {α β : Type*} (s : set α) (t : α → set β) :
  set.bij_on (set.sigma_swap)
    (s.sigma t)
    ((set.univ : set β).sigma (λ b, {a ∈ s | b ∈ t a}) ) :=
begin
  rw set.sigma_eq_univ_sigma,
  convert set.sigma_univ_invert _ using 1,
  ext x, repeat {rw set.sigma},
  cases x,
  simp only [true_and, set.mem_sep_eq, set.mem_univ, set.mem_set_of_eq],
  split_ifs;
  tauto,
end

end sigma


import ..lectures.love01_definitions_and_statements_demo

/-! # LoVe Homework 5: Inductive Predicates

Homework must be done individually.

This homework combines material from Ch. 5 and part of Ch. 8 of the Hitchhiker's Guide. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (3 points): A Type of λ-Terms

In the Ch 4 lab, we defined the type of untyped lambda terms: -/

inductive term : Type
| var : string → term
| lam : string → term → term
| app : term → term → term

/-!
For instance, this expression represents the term `λ x, λ f, f x`:
-/

#check term.lam "x" (term.lam "f" (term.app (term.var "f") (term.var "x")))

/-! 1.1 (1 point). Define an inductive predicate `is_app` that is `true` if
its argument is of the form `term.app …` and that is false otherwise. -/

-- enter your definition here

/-! 1.2 (2 points). Define an inductive predicate `is_abs_free` that is true if
and only if its argument is a λ-term that contains no λ-expressions.
("abs" stands for "abstraction" here.) -/

-- enter your definition here

/-! ## Question 2 (4 points): Even and Odd

Consider the following inductive definition of even numbers: -/

inductive even : ℕ → Prop
| zero            : even 0
| add_two {n : ℕ} : even n → even (n + 2)

/-! 2.1 (1 point). Define a similar predicate for odd numbers, by completing the
Lean definition below. The definition should distinguish two cases, like `even`,
and should not rely on `even`. -/

inductive odd : ℕ → Prop
-- supply the missing cases here

/-! 2.2 (1 point). Give proof terms for the following propositions, based on
your answer to question 2.1. -/

lemma odd_3 :
  odd 3 :=
sorry

lemma odd_5 :
  odd 5 :=
sorry

/-! 2.3 (1 point). Prove the following lemma in Lean: -/

lemma even_odd {n : ℕ} (heven : even n) :
  odd (n + 1) :=
sorry

/-! 2.4 (1 point). Prove the following lemma in Lean.

Hint: Recall that `¬ a` is defined as `a → false`. -/

lemma even_not_odd {n : ℕ} (heven : even n) :
  ¬ odd n :=
sorry

namespace nodup_lists

/-! ## Question 3 (4 points): Duplicate-Free Sublists

In this problem, we'll use inductive predicates to prove that the sublist of a
list that contains no duplicates also contains no duplicates. (Informally, a
*sublist* of a list `ys` is a list `xs` such that every element of `xs` appears
in the same order in `ys`.)

The predicate `list.sublist : ∀ {α : Type}, list α → list α → Prop`, which
formally specifies the notion of a sublist, is defined as follows:

  inductive sublist : list α → list α → Prop
  | slnil : sublist [] []
  | cons (l₁ l₂ a) : sublist l₁ l₂ → sublist l₁ (a::l₂)
  | cons2 (l₁ l₂ a) : sublist l₁ l₂ → sublist (a::l₁) (a::l₂)

There is also syntactic sugar for the sublist predicate: we can write `xs <+ ys`
instead of `list.sublist xs ys`.

Here are some examples:
* `[] <+ [1, 2, 3]`
* `[2, 3] <+ [2, 3, 4]`
* `[2, 3] <+ [1, 2, 4, 3]`

And here are some non-examples:
* `¬([1] <+ [2, 3])`
* `¬([2, 2] <+ [2, 3])`
* `¬([2, 2, 3, 3] <+ [2, 3, 2, 3])`

We'll also need a couple of additional predicates in order to state the desired
theorem.

3.1 (1 point). Define a predicate `is_in` such that `is_in x xs` holds precisely
when `x` is an element of the list `xs`.

Note: you may not use the equality operator `=` in your solution. -/

-- Fill this in:
inductive is_in {α : Type} : α → list α → Prop
-- ...

-- For the rest of this problem, we'll redefine the `∈` notation to use your
-- `is_in` predicate instead of the default.
local notation (name := list_in_predicate) x ` ∈ ` xs := is_in x xs

/-! 3.2 (1 point). Define a predicate `no_duplicates` such that
`no_duplicates xs` holds precisely when the list `xs` does not contain any
duplicate elements.

Here are some examples:
* `no_duplicates []`
* `no_duplicates [tt]`
* `no_duplicates [2, 1, 3]`

And here are some non-examples:
* `¬(no_duplicates [tt, tt])`
* `¬(no_duplicates [1, 9, 5, 1])`
* `¬(no_duplicates [3, 1, 4, 1, 5])`

Note: you may not use the equality operator `=` in your solution.

Hint: you may find the `is_in` (`∈`) predicate you defined above useful! -/

-- Fill this in:
inductive no_duplicates {α : Type} : list α → Prop
-- ...

/-! 3.3 (2 points). Equipped with these definitions, prove the theorem we stated
at the beginning: the sublist of a duplicate-free list is also duplicate-free.

Hint: choose what to induct on wisely! -/

-- You may find this helper lemma useful when writing your proof.
axiom not_in_of_not_in_sublist {α : Type} {x : α} {xs ys : list α} :
  xs <+ ys → ¬(x ∈ ys) → ¬(x ∈ xs)

theorem no_dups_sublist_of_no_dups {α : Type} (xs ys : list α) :
  no_duplicates ys → xs <+ ys → no_duplicates xs :=
sorry

end nodup_lists

/-! ## Question 4 (2 points): Semantics of the REPEAT Language

We introduce REPEAT, a programming language that resembles the WHILE language
but whose defining feature is a `repeat` loop.

The Lean definition of its abstract syntax tree follows: -/

inductive stmt : Type
| skip   : stmt
| assign : string → (state → ℕ) → stmt
| seq    : stmt → stmt → stmt
| unless : (state → Prop) → stmt → stmt
| repeat : ℕ → stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/-! The `skip`, `assign`, and `S ;; T` statements have the same syntax and
semantics as in the WHILE language.

The `unless b S` statement executes `S` unless `b` is true—i.e., it executes `S`
if `b` is false. Otherwise, `unless b S` does nothing. This construct is
inspired by the Perl language.

The `repeat n S` statement executes `S` exactly `n` times. Thus, `repeat 5 S`
has the same effect as `S ;; S ;; S ;; S ;; S` (as far as the big-step semantics
is concerned), and `repeat 0 S` has the same effect as `skip`.

4.1 (2 points). Complete the following definition of a big-step
semantics: -/

inductive big_step : stmt × state → state → Prop
| skip {s} :
  big_step (stmt.skip, s) s
-- enter the missing cases here

end LoVe


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Benjamin Davidson
-/
import data.nat.modeq
import algebra.parity

/-!
# Parity of natural numbers

This file contains theorems about the `even` and `odd` predicates on the natural numbers.

## Tags

even, odd
-/

namespace nat

variables {m n : ℕ}

@[simp] theorem mod_two_ne_one : ¬ n % 2 = 1 ↔ n % 2 = 0 :=
by cases mod_two_eq_zero_or_one n with h h; simp [h]

@[simp] theorem mod_two_ne_zero : ¬ n % 2 = 0 ↔ n % 2 = 1 :=
by cases mod_two_eq_zero_or_one n with h h; simp [h]

theorem even_iff : even n ↔ n % 2 = 0 :=
⟨λ ⟨m, hm⟩, by simp [← two_mul, hm],
  λ h, ⟨n / 2, (mod_add_div n 2).symm.trans (by simp [← two_mul, h])⟩⟩

theorem odd_iff : odd n ↔ n % 2 = 1 :=
⟨λ ⟨m, hm⟩, by norm_num [hm, add_mod],
 λ h, ⟨n / 2, (mod_add_div n 2).symm.trans (by rw [h, add_comm])⟩⟩

lemma not_even_iff : ¬ even n ↔ n % 2 = 1 :=
by rw [even_iff, mod_two_ne_zero]

lemma not_odd_iff : ¬ odd n ↔ n % 2 = 0 :=
by rw [odd_iff, mod_two_ne_one]

lemma even_iff_not_odd : even n ↔ ¬ odd n :=
by rw [not_odd_iff, even_iff]

@[simp] lemma odd_iff_not_even : odd n ↔ ¬ even n :=
by rw [not_even_iff, odd_iff]

lemma is_compl_even_odd : is_compl {n : ℕ | even n} {n | odd n} :=
by simp only [←set.compl_set_of, is_compl_compl, odd_iff_not_even]

lemma even_or_odd (n : ℕ) : even n ∨ odd n :=
or.imp_right odd_iff_not_even.2 $ em $ even n

lemma even_or_odd' (n : ℕ) : ∃ k, n = 2 * k ∨ n = 2 * k + 1 :=
by simpa only [← two_mul, exists_or_distrib, ← odd, ← even] using even_or_odd n

lemma even_xor_odd (n : ℕ) : xor (even n) (odd n) :=
begin
  cases even_or_odd n with h,
  { exact or.inl ⟨h, even_iff_not_odd.mp h⟩ },
  { exact or.inr ⟨h, odd_iff_not_even.mp h⟩ },
end

lemma even_xor_odd' (n : ℕ) : ∃ k, xor (n = 2 * k) (n = 2 * k + 1) :=
begin
  rcases even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩;
  use k,
  { simpa only [← two_mul, xor, true_and, eq_self_iff_true, not_true, or_false, and_false]
      using (succ_ne_self (2*k)).symm },
  { simp only [xor, add_right_eq_self, false_or, eq_self_iff_true, not_true, not_false_iff,
              one_ne_zero, and_self] },
end

lemma odd_gt_zero (h : odd n) : 0 < n :=
by { obtain ⟨k, rfl⟩ := h, exact succ_pos' }

@[simp] theorem two_dvd_ne_zero : ¬ 2 ∣ n ↔ n % 2 = 1 :=
even_iff_two_dvd.symm.not.trans not_even_iff

instance : decidable_pred (even : ℕ → Prop) :=
λ n, decidable_of_decidable_of_iff (by apply_instance) even_iff.symm

instance decidable_pred_odd : decidable_pred (odd : ℕ → Prop) :=
λ n, decidable_of_decidable_of_iff (by apply_instance) odd_iff_not_even.symm

mk_simp_attribute parity_simps "Simp attribute for lemmas about `even`"

@[simp] theorem not_even_one : ¬ even 1 :=
by rw even_iff; norm_num

@[parity_simps] theorem even_add : even (m + n) ↔ (even m ↔ even n) :=
by cases mod_two_eq_zero_or_one m with h₁ h₁;
   cases mod_two_eq_zero_or_one n with h₂ h₂;
   simp [even_iff, h₁, h₂, nat.add_mod];
   norm_num

theorem even_add' : even (m + n) ↔ (odd m ↔ odd n) :=
by rw [even_add, even_iff_not_odd, even_iff_not_odd, not_iff_not]

@[simp] theorem not_even_bit1 (n : ℕ) : ¬ even (bit1 n) :=
by simp [bit1] with parity_simps

lemma two_not_dvd_two_mul_add_one (n : ℕ) : ¬(2 ∣ 2 * n + 1) :=
by simp [add_mod]

lemma two_not_dvd_two_mul_sub_one : Π {n} (w : 0 < n), ¬(2 ∣ 2 * n - 1)
| (n + 1) _ := two_not_dvd_two_mul_add_one n

@[parity_simps] theorem even_sub (h : n ≤ m) : even (m - n) ↔ (even m ↔ even n) :=
begin
  conv { to_rhs, rw [←tsub_add_cancel_of_le h, even_add] },
  by_cases h : even n; simp [h]
end

theorem even.sub_even (hm : even m) (hn : even n) : even (m - n) :=
(le_total n m).elim
  (λ h, by simp only [even_sub h, *])
  (λ h, by simp only [tsub_eq_zero_iff_le.mpr h, even_zero])

theorem even_sub' (h : n ≤ m) : even (m - n) ↔ (odd m ↔ odd n) :=
by rw [even_sub h, even_iff_not_odd, even_iff_not_odd, not_iff_not]

theorem odd.sub_odd (hm : odd m) (hn : odd n) : even (m - n) :=
(le_total n m).elim
  (λ h, by simp only [even_sub' h, *])
  (λ h, by simp only [tsub_eq_zero_iff_le.mpr h, even_zero])

@[parity_simps] theorem even_succ : even (succ n) ↔ ¬ even n :=
by rw [succ_eq_add_one, even_add]; simp [not_even_one]

@[parity_simps] theorem even_mul : even (m * n) ↔ even m ∨ even n :=
by cases mod_two_eq_zero_or_one m with h₁ h₁;
   cases mod_two_eq_zero_or_one n with h₂ h₂;
   simp [even_iff, h₁, h₂, nat.mul_mod];
   norm_num

theorem odd_mul : odd (m * n) ↔ odd m ∧ odd n :=
by simp [not_or_distrib] with parity_simps

theorem odd.of_mul_left (h : odd (m * n)) : odd m :=
(odd_mul.mp h).1

theorem odd.of_mul_right (h : odd (m * n)) : odd n :=
(odd_mul.mp h).2

/-- If `m` and `n` are natural numbers, then the natural number `m^n` is even
if and only if `m` is even and `n` is positive. -/
@[parity_simps] theorem even_pow : even (m ^ n) ↔ even m ∧ n ≠ 0 :=
by { induction n with n ih; simp [*, pow_succ', even_mul], tauto }

theorem even_pow' (h : n ≠ 0) : even (m ^ n) ↔ even m :=
even_pow.trans $ and_iff_left h

theorem even_div : even (m / n) ↔ m % (2 * n) / n = 0 :=
by rw [even_iff_two_dvd, dvd_iff_mod_eq_zero, nat.div_mod_eq_mod_mul_div, mul_comm]

@[parity_simps] theorem odd_add : odd (m + n) ↔ (odd m ↔ even n) :=
by rw [odd_iff_not_even, even_add, not_iff, odd_iff_not_even]

theorem odd_add' : odd (m + n) ↔ (odd n ↔ even m) :=
by rw [add_comm, odd_add]

lemma ne_of_odd_add (h : odd (m + n)) : m ≠ n :=
λ hnot, by simpa [hnot] with parity_simps using h

@[parity_simps] theorem odd_sub (h : n ≤ m) : odd (m - n) ↔ (odd m ↔ even n) :=
by rw [odd_iff_not_even, even_sub h, not_iff, odd_iff_not_even]

theorem odd.sub_even (h : n ≤ m) (hm : odd m) (hn : even n) : odd (m - n) :=
(odd_sub h).mpr $ iff_of_true hm hn

theorem odd_sub' (h : n ≤ m) : odd (m - n) ↔ (odd n ↔ even m) :=
by rw [odd_iff_not_even, even_sub h, not_iff, not_iff_comm, odd_iff_not_even]

theorem even.sub_odd (h : n ≤ m) (hm : even m) (hn : odd n) : odd (m - n) :=
(odd_sub' h).mpr $ iff_of_true hn hm

lemma even_mul_succ_self (n : ℕ) : even (n * (n + 1)) :=
begin
  rw even_mul,
  convert n.even_or_odd,
  simp with parity_simps
end

lemma even_mul_self_pred (n : ℕ) : even (n * (n - 1)) :=
begin
  cases n,
  { exact even_zero },
  { rw mul_comm,
    apply even_mul_succ_self }
end

lemma even_sub_one_of_prime_ne_two {p : ℕ} (hp : prime p) (hodd : p ≠ 2) : even (p - 1) :=
odd.sub_odd (odd_iff.2 $ hp.eq_two_or_odd.resolve_left hodd) (odd_iff.2 rfl)

variables {R : Type*} [ring R]

theorem neg_one_pow_eq_one_iff_even (h1 : (-1 : R) ≠ 1) : (-1 : R) ^ n = 1 ↔ even n :=
begin
  rcases n.even_or_odd' with ⟨n, rfl | rfl⟩,
  { simp [neg_one_pow_eq_pow_mod_two, pow_zero] },
  { rw [← not_iff_not, neg_one_pow_eq_pow_mod_two, not_even_iff, add_mod],
    simp only [h1, mul_mod_right, one_mod, pow_one, not_false_iff, eq_self_iff_true] }
end

@[simp] theorem neg_one_sq : (-1 : R) ^ 2 = 1 := by simp

alias nat.neg_one_sq ← nat.neg_one_pow_two

theorem neg_one_pow_of_even : even n → (-1 : R) ^ n = 1 :=
by { rintro ⟨c, rfl⟩, simp [← two_mul, pow_mul] }

theorem neg_one_pow_of_odd : odd n → (-1 : R) ^ n = -1 :=
by { rintro ⟨c, rfl⟩, simp [pow_add, pow_mul] }

lemma two_mul_div_two_of_even : even n → 2 * (n / 2) = n :=
 λ h, nat.mul_div_cancel_left' (even_iff_two_dvd.mp h)

lemma div_two_mul_two_of_even : even n → n / 2 * 2 = n := --nat.div_mul_cancel
λ h, nat.div_mul_cancel (even_iff_two_dvd.mp h)

lemma two_mul_div_two_add_one_of_odd (h : odd n) : 2 * (n / 2) + 1 = n :=
by { rw mul_comm, convert nat.div_add_mod' n 2, rw odd_iff.mp h }

lemma div_two_mul_two_add_one_of_odd (h : odd n) : n / 2 * 2 + 1 = n :=
by { convert nat.div_add_mod' n 2, rw odd_iff.mp h }

lemma one_add_div_two_mul_two_of_odd (h : odd n) : 1 + n / 2 * 2 = n :=
by { rw add_comm, convert nat.div_add_mod' n 2, rw odd_iff.mp h }

-- Here are examples of how `parity_simps` can be used with `nat`.

example (m n : ℕ) (h : even m) : ¬ even (n + 3) ↔ even (m^2 + m + n) :=
by simp [*, (dec_trivial : ¬ 2 = 0)] with parity_simps

example : ¬ even 25394535 :=
by simp

end nat