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

! This file was ported from Lean 3 source module algebra.support
! leanprover-community/mathlib commit 2445c98ae4b87eabebdde552593519b9b6dc350c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.ConditionallyCompleteLattice.Basic
import Mathlib.Data.Set.Finite
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Algebra.Group.Prod
import Mathlib.Algebra.Group.Pi
import Mathlib.Algebra.Module.Basic
import Mathlib.GroupTheory.GroupAction.Pi

/-!
# Support of a function

In this file we define `Function.support f = {x | f x ≠ 0}` and prove its basic properties.
We also define `Function.mulSupport f = {x | f x ≠ 1}`.
-/

open Set

open BigOperators

namespace Function

variable {α β A B M N P R S G M₀ G₀ : Type _} {ι : Sort _}

section One

variable [One M] [One N] [One P]

/-- `support` of a function is the set of points `x` such that `f x ≠ 0`. -/
def support [Zero A] (f : α → A) : Set α :=
  { x | f x ≠ 0 }
#align function.support Function.support

/-- `mulSupport` of a function is the set of points `x` such that `f x ≠ 1`. -/
@[to_additive existing]
def mulSupport (f : α → M) : Set α :=
  { x | f x ≠ 1 }
#align function.mul_support Function.mulSupport

@[to_additive]
theorem mulSupport_eq_preimage (f : α → M) : mulSupport f = f ⁻¹' {1}ᶜ :=
  rfl
#align function.mul_support_eq_preimage Function.mulSupport_eq_preimage
#align function.support_eq_preimage Function.support_eq_preimage

@[to_additive]
theorem nmem_mulSupport {f : α → M} {x : α} : x ∉ mulSupport f ↔ f x = 1 :=
  not_not
#align function.nmem_mul_support Function.nmem_mulSupport
#align function.nmem_support Function.nmem_support

@[to_additive]
theorem compl_mulSupport {f : α → M} : mulSupport fᶜ = { x | f x = 1 } :=
  ext fun _ => nmem_mulSupport
#align function.compl_mul_support Function.compl_mulSupport
#align function.compl_support Function.compl_support

@[to_additive (attr := simp)]
theorem mem_mulSupport {f : α → M} {x : α} : x ∈ mulSupport f ↔ f x ≠ 1 :=
  Iff.rfl
#align function.mem_mul_support Function.mem_mulSupport
#align function.mem_support Function.mem_support

@[to_additive (attr := simp)]
theorem mulSupport_subset_iff {f : α → M} {s : Set α} : mulSupport f ⊆ s ↔ ∀ x, f x ≠ 1 → x ∈ s :=
  Iff.rfl
#align function.mul_support_subset_iff Function.mulSupport_subset_iff
#align function.support_subset_iff Function.support_subset_iff

@[to_additive]
theorem mulSupport_subset_iff' {f : α → M} {s : Set α} :
    mulSupport f ⊆ s ↔ ∀ (x) (_ : x ∉ s), f x = 1 :=
  forall_congr' fun _ => not_imp_comm
#align function.mul_support_subset_iff' Function.mulSupport_subset_iff'
#align function.support_subset_iff' Function.support_subset_iff'

@[to_additive]
theorem mulSupport_eq_iff {f : α → M} {s : Set α} :
    mulSupport f = s ↔ (∀ x, x ∈ s → f x ≠ 1) ∧ ∀ x, x ∉ s → f x = 1 := by
  simp (config := { contextual := true }) only [ext_iff, mem_mulSupport, ne_eq, iff_def,
    not_imp_comm, and_comm, forall_and]

#align function.mul_support_eq_iff Function.mulSupport_eq_iff
#align function.support_eq_iff Function.support_eq_iff

@[to_additive]
theorem mulSupport_disjoint_iff {f : α → M} {s : Set α} :
    Disjoint (mulSupport f) s ↔ EqOn f 1 s := by
  simp_rw [← subset_compl_iff_disjoint_right, mulSupport_subset_iff', not_mem_compl_iff, EqOn,
    Pi.one_apply]
#align function.mul_support_disjoint_iff Function.mulSupport_disjoint_iff
#align function.support_disjoint_iff Function.support_disjoint_iff

@[to_additive]
theorem disjoint_mulSupport_iff {f : α → M} {s : Set α} : Disjoint s (mulSupport f) ↔ EqOn f 1 s :=
  by rw [disjoint_comm, mulSupport_disjoint_iff]
#align function.disjoint_mul_support_iff Function.disjoint_mulSupport_iff
#align function.disjoint_support_iff Function.disjoint_support_iff

@[to_additive (attr := simp)]
theorem mulSupport_eq_empty_iff {f : α → M} : mulSupport f = ∅ ↔ f = 1 := by
  simp_rw [← subset_empty_iff, mulSupport_subset_iff', funext_iff]
  simp
#align function.mul_support_eq_empty_iff Function.mulSupport_eq_empty_iff
#align function.support_eq_empty_iff Function.support_eq_empty_iff

@[to_additive (attr := simp)]
theorem mulSupport_nonempty_iff {f : α → M} : (mulSupport f).Nonempty ↔ f ≠ 1 := by
  rw [nonempty_iff_ne_empty, Ne.def, mulSupport_eq_empty_iff]
#align function.mul_support_nonempty_iff Function.mulSupport_nonempty_iff
#align function.support_nonempty_iff Function.support_nonempty_iff

@[to_additive]
theorem range_subset_insert_image_mulSupport (f : α → M) : range f ⊆ insert 1 (f '' mulSupport f) :=
  by
  simpa only [range_subset_iff, mem_insert_iff, or_iff_not_imp_left] using
    fun x (hx : x ∈ mulSupport f) => mem_image_of_mem f hx
#align function.range_subset_insert_image_mul_support Function.range_subset_insert_image_mulSupport
#align function.range_subset_insert_image_support Function.range_subset_insert_image_support

@[to_additive (attr := simp)]
theorem mulSupport_one' : mulSupport (1 : α → M) = ∅ :=
  mulSupport_eq_empty_iff.2 rfl
#align function.mul_support_one' Function.mulSupport_one'
#align function.support_zero' Function.support_zero'

@[to_additive (attr := simp)]
theorem mulSupport_one : (mulSupport fun _ : α => (1 : M)) = ∅ :=
  mulSupport_one'
#align function.mul_support_one Function.mulSupport_one
#align function.support_zero Function.support_zero

@[to_additive]
theorem mulSupport_const {c : M} (hc : c ≠ 1) : (mulSupport fun _ : α => c) = Set.univ := by
  ext x
  simp [hc]
#align function.mul_support_const Function.mulSupport_const
#align function.support_const Function.support_const

@[to_additive]
theorem mulSupport_binop_subset (op : M → N → P) (op1 : op 1 1 = 1) (f : α → M) (g : α → N) :
    (mulSupport fun x => op (f x) (g x)) ⊆ mulSupport f ∪ mulSupport g := fun x hx =>
  not_or_of_imp fun hf hg => hx <| by simp only [hf, hg, op1]
#align function.mul_support_binop_subset Function.mulSupport_binop_subset
#align function.support_binop_subset Function.support_binop_subset

@[to_additive]
theorem mulSupport_sup [SemilatticeSup M] (f g : α → M) :
    (mulSupport fun x => f x ⊔ g x) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_binop_subset (· ⊔ ·) sup_idem f g
#align function.mul_support_sup Function.mulSupport_sup
#align function.support_sup Function.support_sup

@[to_additive]
theorem mulSupport_inf [SemilatticeInf M] (f g : α → M) :
    (mulSupport fun x => f x ⊓ g x) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_binop_subset (· ⊓ ·) inf_idem f g
#align function.mul_support_inf Function.mulSupport_inf
#align function.support_inf Function.support_inf

@[to_additive]
theorem mulSupport_max [LinearOrder M] (f g : α → M) :
    (mulSupport fun x => max (f x) (g x)) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_sup f g
#align function.mul_support_max Function.mulSupport_max
#align function.support_max Function.support_max

@[to_additive]
theorem mulSupport_min [LinearOrder M] (f g : α → M) :
    (mulSupport fun x => min (f x) (g x)) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_inf f g
#align function.mul_support_min Function.mulSupport_min
#align function.support_min Function.support_min

@[to_additive]
theorem mulSupport_supᵢ [ConditionallyCompleteLattice M] [Nonempty ι] (f : ι → α → M) :
    (mulSupport fun x => ⨆ i, f i x) ⊆ ⋃ i, mulSupport (f i) := by
  rw [mulSupport_subset_iff']
  simp only [mem_unionᵢ, not_exists, nmem_mulSupport]
  intro x hx
  simp only [hx, csupᵢ_const]
#align function.mul_support_supr Function.mulSupport_supᵢ
#align function.support_supr Function.support_supᵢ

@[to_additive]
theorem mulSupport_infᵢ [ConditionallyCompleteLattice M] [Nonempty ι] (f : ι → α → M) :
    (mulSupport fun x => ⨅ i, f i x) ⊆ ⋃ i, mulSupport (f i) :=
  @mulSupport_supᵢ _ Mᵒᵈ ι ⟨(1 : M)⟩ _ _ f
#align function.mul_support_infi Function.mulSupport_infᵢ
#align function.support_infi Function.support_infᵢ

@[to_additive]

@[to_additive]
theorem mulSupport_subset_comp {g : M → N} (hg : ∀ {x}, g x = 1 → x = 1) (f : α → M) :
    mulSupport f ⊆ mulSupport (g ∘ f) := fun _ => mt hg
#align function.mul_support_subset_comp Function.mulSupport_subset_comp
#align function.support_subset_comp Function.support_subset_comp

@[to_additive]
theorem mulSupport_comp_eq (g : M → N) (hg : ∀ {x}, g x = 1 ↔ x = 1) (f : α → M) :
    mulSupport (g ∘ f) = mulSupport f :=
  Set.ext fun _ => not_congr hg
#align function.mul_support_comp_eq Function.mulSupport_comp_eq
#align function.support_comp_eq Function.support_comp_eq

@[to_additive]
theorem mulSupport_comp_eq_preimage (g : β → M) (f : α → β) :
    mulSupport (g ∘ f) = f ⁻¹' mulSupport g :=
  rfl
#align function.mul_support_comp_eq_preimage Function.mulSupport_comp_eq_preimage
#align function.support_comp_eq_preimage Function.support_comp_eq_preimage

@[to_additive support_prod_mk]
theorem mulSupport_prod_mk (f : α → M) (g : α → N) :
    (mulSupport fun x => (f x, g x)) = mulSupport f ∪ mulSupport g :=
  Set.ext fun x => by
    simp only [mulSupport, not_and_or, mem_union, mem_setOf_eq, Prod.mk_eq_one, Ne.def]
#align function.mul_support_prod_mk Function.mulSupport_prod_mk
#align function.support_prod_mk Function.support_prod_mk

@[to_additive support_prod_mk']
theorem mulSupport_prod_mk' (f : α → M × N) :
    mulSupport f = (mulSupport fun x => (f x).1) ∪ mulSupport fun x => (f x).2 := by
  simp only [← mulSupport_prod_mk, Prod.mk.eta]
#align function.mul_support_prod_mk' Function.mulSupport_prod_mk'
#align function.support_prod_mk' Function.support_prod_mk'

@[to_additive]
theorem mulSupport_along_fiber_subset (f : α × β → M) (a : α) :
    (mulSupport fun b => f (a, b)) ⊆ (mulSupport f).image Prod.snd :=
  fun x hx => ⟨(a, x), by simpa using hx⟩
#align function.mul_support_along_fiber_subset Function.mulSupport_along_fiber_subset
#align function.support_along_fiber_subset Function.support_along_fiber_subset

@[to_additive (attr := simp)]
theorem mulSupport_along_fiber_finite_of_finite (f : α × β → M) (a : α)
    (h : (mulSupport f).Finite) : (mulSupport fun b => f (a, b)).Finite :=
  (h.image Prod.snd).subset (mulSupport_along_fiber_subset f a)
#align function.mul_support_along_fiber_finite_of_finite Function.mulSupport_along_fiber_finite_of_finite
#align function.support_along_fiber_finite_of_finite Function.support_along_fiber_finite_of_finite

end One

@[to_additive]
theorem mulSupport_mul [MulOneClass M] (f g : α → M) :
    (mulSupport fun x => f x * g x) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_binop_subset (· * ·) (one_mul _) f g
#align function.mul_support_mul Function.mulSupport_mul
#align function.support_add Function.support_add

@[to_additive]
theorem mulSupport_pow [Monoid M] (f : α → M) (n : ℕ) :
    (mulSupport fun x => f x ^ n) ⊆ mulSupport f := by
  induction' n with n hfn
  · simp [pow_zero, mulSupport_one]
  · simpa only [pow_succ] using (mulSupport_mul f _).trans (union_subset Subset.rfl hfn)
#align function.mul_support_pow Function.mulSupport_pow
#align function.support_nsmul Function.support_nsmul

section DivisionMonoid

variable [DivisionMonoid G] (f g : α → G)

@[to_additive (attr := simp)]
theorem mulSupport_inv : (mulSupport fun x => (f x)⁻¹) = mulSupport f :=
  ext fun _ => inv_ne_one
#align function.mul_support_inv Function.mulSupport_inv
#align function.support_neg Function.support_neg

@[to_additive (attr := simp)]
theorem mulSupport_inv' : mulSupport f⁻¹ = mulSupport f :=
  mulSupport_inv f
#align function.mul_support_inv' Function.mulSupport_inv'
#align function.support_neg' Function.support_neg'

@[to_additive]
theorem mulSupport_mul_inv : (mulSupport fun x => f x * (g x)⁻¹) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_binop_subset (fun a b => a * b⁻¹) (by simp) f g
#align function.mul_support_mul_inv Function.mulSupport_mul_inv
#align function.support_add_neg Function.support_add_neg

@[to_additive]
theorem mulSupport_div : (mulSupport fun x => f x / g x) ⊆ mulSupport f ∪ mulSupport g :=
  mulSupport_binop_subset (· / ·) one_div_one f g
#align function.mul_support_div Function.mulSupport_div
#align function.support_sub Function.support_sub

end DivisionMonoid

theorem support_smul [Zero R] [Zero M] [SMulWithZero R M] [NoZeroSMulDivisors R M] (f : α → R)
    (g : α → M) : support (f • g) = support f ∩ support g :=
  ext fun _ => smul_ne_zero_iff
#align function.support_smul Function.support_smul

@[simp]
theorem support_mul [MulZeroClass R] [NoZeroDivisors R] (f g : α → R) :
    (support fun x => f x * g x) = support f ∩ support g :=
  support_smul f g
#align function.support_mul Function.support_mul

--@[simp] Porting note: removing simp, bad lemma LHS not in normal form
theorem support_mul_subset_left [MulZeroClass R] (f g : α → R) :
    (support fun x => f x * g x) ⊆ support f := fun x hfg hf => hfg <| by simp only [hf, zero_mul]
#align function.support_mul_subset_left Function.support_mul_subset_left

--@[simp] Porting note: removing simp, bad lemma LHS not in normal form
theorem support_mul_subset_right [MulZeroClass R] (f g : α → R) :
    (support fun x => f x * g x) ⊆ support g := fun x hfg hg => hfg <| by simp only [hg, mul_zero]
#align function.support_mul_subset_right Function.support_mul_subset_right

theorem support_smul_subset_right [AddMonoid A] [Monoid B] [DistribMulAction B A] (b : B)
    (f : α → A) : support (b • f) ⊆ support f := fun x hbf hf =>
  hbf <| by rw [Pi.smul_apply, hf, smul_zero]
#align function.support_smul_subset_right Function.support_smul_subset_right

theorem support_smul_subset_left [Zero M] [Zero β] [SMulWithZero M β] (f : α → M) (g : α → β) :
    support (f • g) ⊆ support f := fun x hfg hf => hfg <| by rw [Pi.smul_apply', hf, zero_smul]
#align function.support_smul_subset_left Function.support_smul_subset_left

theorem support_const_smul_of_ne_zero [Semiring R] [AddCommMonoid M] [Module R M]
    [NoZeroSMulDivisors R M] (c : R) (g : α → M) (hc : c ≠ 0) : support (c • g) = support g :=
  ext fun x => by simp only [hc, mem_support, Pi.smul_apply, Ne.def, smul_eq_zero, false_or_iff]
#align function.support_const_smul_of_ne_zero Function.support_const_smul_of_ne_zero

@[simp]
theorem support_inv [GroupWithZero G₀] (f : α → G₀) : (support fun x => (f x)⁻¹) = support f :=
  Set.ext fun _ => not_congr inv_eq_zero
#align function.support_inv Function.support_inv

@[simp]
theorem support_div [GroupWithZero G₀] (f g : α → G₀) :
    (support fun x => f x / g x) = support f ∩ support g := by simp [div_eq_mul_inv]
#align function.support_div Function.support_div

@[to_additive]
theorem mulSupport_prod [CommMonoid M] (s : Finset α) (f : α → β → M) :
    (mulSupport fun x => ∏ i in s, f i x) ⊆ ⋃ i ∈ s, mulSupport (f i) := by
  rw [mulSupport_subset_iff']
  simp only [mem_unionᵢ, not_exists, nmem_mulSupport]
  exact fun x => Finset.prod_eq_one
#align function.mul_support_prod Function.mulSupport_prod
#align function.support_sum Function.support_sum

theorem support_prod_subset [CommMonoidWithZero A] (s : Finset α) (f : α → β → A) :
    (support fun x => ∏ i in s, f i x) ⊆ ⋂ i ∈ s, support (f i) := fun _ hx =>
  mem_interᵢ₂.2 fun _ hi H => hx <| Finset.prod_eq_zero hi H
#align function.support_prod_subset Function.support_prod_subset

theorem support_prod [CommMonoidWithZero A] [NoZeroDivisors A] [Nontrivial A] (s : Finset α)
    (f : α → β → A) : (support fun x => ∏ i in s, f i x) = ⋂ i ∈ s, support (f i) :=
  Set.ext fun x => by
    simp [support, Ne.def, Finset.prod_eq_zero_iff, mem_setOf_eq, Set.mem_interᵢ, not_exists]
#align function.support_prod Function.support_prod

theorem mulSupport_one_add [One R] [AddLeftCancelMonoid R] (f : α → R) :
    (mulSupport fun x => 1 + f x) = support f :=
  Set.ext fun _ => not_congr add_right_eq_self
#align function.mul_support_one_add Function.mulSupport_one_add

theorem mulSupport_one_add' [One R] [AddLeftCancelMonoid R] (f : α → R) :
    mulSupport (1 + f) = support f :=
  mulSupport_one_add f
#align function.mul_support_one_add' Function.mulSupport_one_add'

theorem mulSupport_add_one [One R] [AddRightCancelMonoid R] (f : α → R) :
    (mulSupport fun x => f x + 1) = support f :=
  Set.ext fun _ => not_congr add_left_eq_self
#align function.mul_support_add_one Function.mulSupport_add_one

theorem mulSupport_add_one' [One R] [AddRightCancelMonoid R] (f : α → R) :
    mulSupport (f + 1) = support f :=
  mulSupport_add_one f
#align function.mul_support_add_one' Function.mulSupport_add_one'

theorem mulSupport_one_sub' [One R] [AddGroup R] (f : α → R) : mulSupport (1 - f) = support f := by
  rw [sub_eq_add_neg, mulSupport_one_add', support_neg']
#align function.mul_support_one_sub' Function.mulSupport_one_sub'

theorem mulSupport_one_sub [One R] [AddGroup R] (f : α → R) :
    (mulSupport fun x => 1 - f x) = support f :=
  mulSupport_one_sub' f
#align function.mul_support_one_sub Function.mulSupport_one_sub

end Function

namespace Set

open Function

variable {α β M : Type _} [One M] {f : α → M}

@[to_additive]
theorem image_inter_mulSupport_eq {s : Set β} {g : β → α} :
    g '' s ∩ mulSupport f = g '' (s ∩ mulSupport (f ∘ g)) := by
  rw [mulSupport_comp_eq_preimage f g, image_inter_preimage]
#align set.image_inter_mul_support_eq Set.image_inter_mulSupport_eq
#align set.image_inter_support_eq Set.image_inter_support_eq

end Set

namespace Pi

variable {A : Type _} {B : Type _} [DecidableEq A] [One B] {a : A} {b : B}

open Function

@[to_additive]
theorem mulSupport_mulSingle_subset : mulSupport (mulSingle a b) ⊆ {a} := fun _ hx =>
  by_contra fun hx' => hx <| mulSingle_eq_of_ne hx' _
#align pi.mul_support_mul_single_subset Pi.mulSupport_mulSingle_subset
#align pi.support_single_subset Pi.support_single_subset

@[to_additive]
theorem mulSupport_mulSingle_one : mulSupport (mulSingle a (1 : B)) = ∅ := by simp
#align pi.mul_support_mul_single_one Pi.mulSupport_mulSingle_one
#align pi.support_single_zero Pi.support_single_zero

@[to_additive (attr := simp)]
theorem mulSupport_mulSingle_of_ne (h : b ≠ 1) : mulSupport (mulSingle a b) = {a} :=
  mulSupport_mulSingle_subset.antisymm fun x (hx : x = a) => by
    rwa [mem_mulSupport, hx, mulSingle_eq_same]
#align pi.mul_support_mul_single_of_ne Pi.mulSupport_mulSingle_of_ne
#align pi.support_single_of_ne Pi.support_single_of_ne

@[to_additive]
theorem mulSupport_mulSingle [DecidableEq B] :
    mulSupport (mulSingle a b) = if b = 1 then ∅ else {a} := by split_ifs with h <;> simp [h]
#align pi.mul_support_mul_single Pi.mulSupport_mulSingle
#align pi.support_single Pi.support_single

@[to_additive]
theorem mulSupport_mulSingle_disjoint {b' : B} (hb : b ≠ 1) (hb' : b' ≠ 1) {i j : A} :
    Disjoint (mulSupport (mulSingle i b)) (mulSupport (mulSingle j b')) ↔ i ≠ j := by
  rw [mulSupport_mulSingle_of_ne hb, mulSupport_mulSingle_of_ne hb', disjoint_singleton]
#align pi.mul_support_mul_single_disjoint Pi.mulSupport_mulSingle_disjoint
#align pi.support_single_disjoint Pi.support_single_disjoint

end Pi


universes u v

/-
This unit is about the functor. A functor is a collection of objects
(such as lists or options over some type, α) with a function, map :
(α → β) → f α → f β, overloaded for each specified type constructors,
f, lifting the (α → β) function to an (f α → f β) function. Map lifts
functions on elements to become functions on data structures that can
contain such elements. It converts a data structure containing such α
values into an isomorphic data structure amy α valuesreplaced by the
β values obtained by applying the (α → β) function to each α value.+
-/

/-
We define a simple "binary tree of α values" data type
for use later in this file. Tuck it away in memory for
now.
-/

inductive tree (α : Type u)
| empty : tree
| node (a : α) (left right : tree) : tree

def aTree :=
  tree.node 0
  (tree.node 1 tree.empty tree.empty)
  (tree.node 2 tree.empty tree.empty)

namespace hidden

/-
We've seen a function for mapping a (different) function over a list.
-/

def list_map {α : Type u} {β : Type v} : (α → β) → list α → list β
| f []      := []
| f (h::t)  := (f h)::(list_map f t)

/-
But we can imagine analogous functions over any kind of structure that
contains objects of some arbitrary other type. For example, here is a
function for mapping a function, f, over an object of type (option α),
for any type α.
-/

def option_map {α : Type u} {β : Type v} : (α → β) → option α → option β
| f none      := none
| f (some a)  := some (f a)

/-
As a third example, consider mapping over trees.
-/

/-
We can also write a function for mapping trees of α
values to trees of β values in an analogous manner.
-/

def tree_map {α : Type u} {β : Type v} : (α → β) → (tree α) → (tree β)
| f tree.empty := tree.empty
| f (tree.node a l r) := tree.node (f a) (tree_map f l) (tree_map f r)

/-
What we're seeing are different implementations of "the same idea"
for mapping an element-level mapping function over a various types
of data structures containing such elements. The implementations of
these functions differ significantly; but look at their types. What
we see is that they're identical but for the types of containers we
envision transforming by the application  of element-level functions
to their contents.

def list_map    {α : Type u} {β : Type v} : (α → β) →   (list α)    → (list β)
def option_map  {α : Type u} {β : Type v} : (α → β) →   (option α)  → (option β)
def tree_map    {α : Type u} {β : Type v} : (α → β) →   (tree α)    → (tree β)

As usual, we can generalize by introducing a new parameter.
But what is its type? Well, question: What is the type of list? Of option? Of tree?
Answer: Each is Type u → Type u
We can't just add a parameter, m : Type u → Type u: the *implementations* differ
We have a common abstraction but with different implementations for different types

Ad hoc polymorphism, aka, overloading, aka generics, to the rescue! The new
pattern that we see here is that the parameter of the typeclass is no longer
a concrete type (such as bool or nat), but a polymorphic type builder, i.e.,
a value such as list α, option α, or tree α (each of type, Type → Type)
-/

class functor (m : Type u → Type v) :=
(map : ∀ {α β : Type u}, (α → β) → m α → m β)
-- (law1 : _)    -- how mapping identify function works
-- (law2 : _)    -- how mapping composition works

/-
As a shorthand notaton, we enable the developer to write
f<$>l as an expression that reduces to f mapped over l.
-/
local infixr ` <$> `:100 := functor.map

/-
Finally, we instantiate the typeclass once for each "type builder,"
such as list, option, or tree, over which we want to be able to map
functions using this notation.
-/

instance list_mapper : functor list := ⟨ @list_map ⟩
instance option_mapper : functor option := ⟨ @option_map ⟩
instance tree_mapper : functor tree := ⟨ @tree_map ⟩

/-
We now have an overloaded map operator (in Haskell it's called fmap)
that can be used to map functions over lists, options, and trees. We
can now view lists, options, and trees as "functors" in the functional
programming (rather than category theory) sense of the term: that is,
as structured containers for objects of some source type that can be
"mapped" to corresponding structured containers for objects of some
destination type.
-/

#reduce nat.succ <$> []
#reduce nat.succ <$> [1,2,3]

#reduce string.length <$> ["Hello", "Lean!!!"]

#reduce nat.succ <$> option.none
#reduce nat.succ <$> option.some 0

#reduce nat.succ <$> (tree.empty)
#reduce nat.succ <$> aTree

#check @functor
/-
What we've done is to make list, option, and tree
into "members of the functor typeclass," thereby
overloading the operator that the typeclass defines
for each of these otherwise unrelated types.
-/

end hidden

/-
Now let's have a quick look at Lean's functor typeclass.
It's just like ours but it adds a second function that is
to be overloaded for each type (such as list or option)
in the functor typeclass.
-/

#check @functor
#print functor
/-
class functor (f : Type u → Type v) : Type (max (u+1) v) :=
(map : Π {α β : Type u}, (α → β) → f α → f β)
(map_const : Π {α β : Type u}, α → f β → f α := λ α β, map ∘ const β)

The const function (polymorphic in α and β) takes a value, a, of type
α, and yields a function that takes any value of type β and returns a.

The function, map ∘ const β, thus takes any value, a, of type α, and
returns a function that converts a list of β values into a list of a
values (not just α values, but constant a values).

def const (β : Sort u₂) (a : α) : β → α := λ x, a
-/

#check @list.map

instance : functor list := ⟨ @list.map, _ ⟩

def list_map_const
  {α β : Type u} :
    α → list β → list α
| a [] := []
| a (h::t) := a::list_map_const a t

-- E.g., replace each natural number in list with tt
#eval list_map_const tt [1,2,3]

instance list_functor : functor list := ⟨ @list.map, @list_map_const ⟩

#check @option.map

def option_map_const
  {α β : Type u} :
  α → option β → option α
| a option.none := option.none
| a (option.some b) := option.some a

instance : functor option := ⟨ @option.map, @option_map_const ⟩

#reduce nat.succ <$> [1,2,3]
#reduce ff <$ [1,2,3]
#reduce [1,2,3] $> ff

/-
One of the ways in which we can use the functor typeclass
is in defining generic versions of concrete functions. For
example, consider the simple increment function on natural
numbers.
-/

def inc :=
  λ (n : nat),
    n + 1

/-
We've seen how we can map such functions over lists of
natural numbers. And, with this capability, we can define
a new function, here called inc_list_nat, that maps the
inc function over lists of nats. We can say that we have
lifted the inc function to be applicable to lists of nats.
-/

def inc_list_nat ( l : list nat) := list.map inc l

/-
Challenge: Generalize from this idea to write a generic
(ad hoc polymorphic) function, inc', that lifts inc
to be be applicable to objects of any "functorial" type
over int. Given what we've got so far, for example, you
should be able to apply inc_m_nat not only to objects of
type list nat, but also option nat, tree nat, and so on,
for any type constructor parameterized by the type, nat.
-/

def inc' {f : Type → Type} [functor f] (i : f nat) : f nat :=
  functor.map inc i

-- a generic increment operation on functorial data structures containing nats
example : inc' [1,2,3] = [2,3,4] := rfl
example : inc' (some 1) = some 2 := rfl
instance : functor tree := ⟨ @hidden.tree_map, _ ⟩  -- you can fill in second field
example : inc' aTree =
            tree.node
              1
              (tree.node 2 tree.empty tree.empty)
              (tree.node 3 tree.empty tree.empty) := rfl

/-
Generalize this function, from mapping *inc* over any functorial context
(data structure!) over values of type nat, to mapping *any function* of
type α → β over any functorial context/container over values of type, α.
-/

def map_f {α β : Type u} {f : Type u → Type v} [functor f] : (α → β) → f α → f β
| h i :=  functor.map h i

/-
Examples:
-/

def l_str := ["Hello", " Lean!"]
def o_str := some "Hello"
def t_str := tree.node "Hello" (tree.node " There!" tree.empty tree.empty) tree.empty

#reduce map_f string.length l_str
#reduce map_f string.length o_str
#reduce map_f string.length t_str

/-
Finally, let's look at the type of map_f to get a set of its nature.
In particular, look at this: (α → β) → f α → f β. What we've done is
to lift a "pure" function, h : α → β to one that takes a "functorial"
object, i : f α, and returns a functorial object of type f β. And by
the magic of typeclass resolution, we've overloaded this function for
three functorial types, namely list, option, and tree.
-/


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

In the standard library we cannot assume the univalence axiom.
We say two types are equivalent if they are isomorphic.

Two equivalent types have the same cardinality.
-/
import logic.function data.set.basic

open function

universes u v w
variables {α : Sort u} {β : Sort v} {γ : Sort w}

/-- `α ≃ β` is the type of functions from `α → β` with a two-sided inverse. -/
structure equiv (α : Sort*) (β : Sort*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : left_inverse inv_fun to_fun)
(right_inv : right_inverse inv_fun to_fun)

namespace equiv

/-- `perm α` is the type of bijections from `α` to itself. -/
@[reducible] def perm (α : Sort*) := equiv α α

infix ` ≃ `:50 := equiv

instance : has_coe_to_fun (α ≃ β) :=
⟨_, to_fun⟩

@[simp] theorem coe_fn_mk (f : α → β) (g l r) : (equiv.mk f g l r : α → β) = f :=
rfl

theorem eq_of_to_fun_eq : ∀ {e₁ e₂ : equiv α β}, (e₁ : α → β) = e₂ → e₁ = e₂
| ⟨f₁, g₁, l₁, r₁⟩ ⟨f₂, g₂, l₂, r₂⟩ h :=
  have f₁ = f₂, from h,
  have g₁ = g₂, from funext $ assume x,
    have f₁ (g₁ x) = f₂ (g₂ x), from (r₁ x).trans (r₂ x).symm,
    have f₁ (g₁ x) = f₁ (g₂ x), by subst f₂; exact this,
    show g₁ x = g₂ x,           from injective_of_left_inverse l₁ this,
  by simp *

lemma ext (f g : equiv α β) (H : ∀ x, f x = g x) : f = g :=
eq_of_to_fun_eq (funext H)

@[refl] protected def refl (α : Sort*) : α ≃ α := ⟨id, id, λ x, rfl, λ x, rfl⟩

@[symm] protected def symm (e : α ≃ β) : β ≃ α := ⟨e.inv_fun, e.to_fun, e.right_inv, e.left_inv⟩

@[trans] protected def trans (e₁ : α ≃ β) (e₂ : β ≃ γ) : α ≃ γ :=
⟨e₂.to_fun ∘ e₁.to_fun, e₁.inv_fun ∘ e₂.inv_fun,
  e₂.left_inv.comp e₁.left_inv, e₂.right_inv.comp e₁.right_inv⟩

protected theorem bijective : ∀ f : α ≃ β, bijective f
| ⟨f, g, h₁, h₂⟩ :=
  ⟨injective_of_left_inverse h₁, surjective_of_has_right_inverse ⟨_, h₂⟩⟩

protected theorem subsingleton (e : α ≃ β) : ∀ [subsingleton β], subsingleton α
| ⟨H⟩ := ⟨λ a b, e.bijective.1 (H _ _)⟩

protected def decidable_eq (e : α ≃ β) [H : decidable_eq β] : decidable_eq α
| a b := decidable_of_iff _ e.bijective.1.eq_iff

protected def cast {α β : Sort*} (h : α = β) : α ≃ β :=
⟨cast h, cast h.symm, λ x, by cases h; refl, λ x, by cases h; refl⟩

@[simp] theorem coe_fn_symm_mk (f : α → β) (g l r) : ((equiv.mk f g l r).symm : β → α) = g :=
rfl

@[simp] theorem refl_apply (x : α) : equiv.refl α x = x := rfl

@[simp] theorem trans_apply : ∀ (f : α ≃ β) (g : β ≃ γ) (a : α), (f.trans g) a = g (f a)
| ⟨f₁, g₁, l₁, r₁⟩ ⟨f₂, g₂, l₂, r₂⟩ a := rfl

@[simp] theorem apply_inverse_apply : ∀ (e : α ≃ β) (x : β), e (e.symm x) = x
| ⟨f₁, g₁, l₁, r₁⟩ x := by simp [equiv.symm]; rw r₁

@[simp] theorem inverse_apply_apply : ∀ (e : α ≃ β) (x : α), e.symm (e x) = x
| ⟨f₁, g₁, l₁, r₁⟩ x := by simp [equiv.symm]; rw l₁

@[simp] lemma inverse_trans_apply (f : α ≃ β) (g : β ≃ γ) (a : γ) :
  (f.trans g).symm a = f.symm (g.symm a) := rfl

@[simp] theorem apply_eq_iff_eq : ∀ (f : α ≃ β) (x y : α), f x = f y ↔ x = y
| ⟨f₁, g₁, l₁, r₁⟩ x y := (injective_of_left_inverse l₁).eq_iff

@[simp] theorem cast_apply {α β} (h : α = β) (x : α) : equiv.cast h x = cast h x := rfl

theorem apply_eq_iff_eq_inverse_apply : ∀ (f : α ≃ β) (x : α) (y : β), f x = y ↔ x = f.symm y
| ⟨f₁, g₁, l₁, r₁⟩ x y := by simp [equiv.symm];
  show f₁ x = y ↔ x = g₁ y; from
  ⟨λ e : f₁ x = y, e ▸ (l₁ x).symm,
   λ e : x = g₁ y, e.symm ▸ r₁ y⟩

@[simp] theorem symm_symm (e : α ≃ β) : e.symm.symm = e := by cases e; refl

@[simp] theorem trans_refl (e : α ≃ β) : e.trans (equiv.refl β) = e := by cases e; refl

@[simp] theorem refl_trans (e : α ≃ β) : (equiv.refl α).trans e = e := by cases e; refl

@[simp] theorem symm_trans (e : α ≃ β) : e.symm.trans e = equiv.refl β :=  ext _ _ (by simp)

@[simp] theorem trans_symm (e : α ≃ β) : e.trans e.symm = equiv.refl α := ext _ _ (by simp)

lemma trans_assoc {δ} (ab : α ≃ β) (bc : β ≃ γ) (cd : γ ≃ δ) :
  (ab.trans bc).trans cd = ab.trans (bc.trans cd) :=
equiv.ext _ _ $ assume a, rfl

theorem left_inverse_symm (f : equiv α β) : left_inverse f.symm f := f.left_inv

theorem right_inverse_symm (f : equiv α β) : function.right_inverse f.symm f := f.right_inv

def equiv_congr {δ} (ab : α ≃ β) (cd : γ ≃ δ) : (α ≃ γ) ≃ (β ≃ δ) :=
⟨ λac, (ab.symm.trans ac).trans cd, λbd, ab.trans $ bd.trans $ cd.symm,
  assume ac, begin simp [trans_assoc], rw [← trans_assoc], simp end,
  assume ac, begin simp [trans_assoc], rw [← trans_assoc], simp end, ⟩

def perm_congr {α : Type*} {β : Type*} (e : α ≃ β) : perm α ≃ perm β :=
equiv_congr e e

protected lemma image_eq_preimage {α β} (e : α ≃ β) (s : set α) : e '' s = e.symm ⁻¹' s :=
set.ext $ assume x, set.mem_image_iff_of_inverse e.left_inv e.right_inv

protected lemma subset_image {α β} (e : α ≃ β) (s : set α) (t : set β) : t ⊆ e '' s ↔ e.symm '' t ⊆ s :=
by rw [set.image_subset_iff, e.image_eq_preimage]

lemma symm_image_image {α β} (f : equiv α β) (s : set α) : f.symm '' (f '' s) = s :=
by rw [← set.image_comp]; simpa using set.image_id s

protected lemma image_compl {α β} (f : equiv α β) (s : set α) :
  f '' -s = -(f '' s) :=
set.image_compl_eq f.bijective

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

namespace perm

instance perm_group {α : Type u} : group (perm α) :=
begin
  refine { mul := λ f g, equiv.trans g f, one := equiv.refl α, inv:= equiv.symm, ..};
  intros; apply equiv.ext; try { apply trans_apply },
  apply inverse_apply_apply
end

@[simp] theorem mul_apply {α : Type u} (f g : perm α) (x) : (f * g) x = f (g x) :=
equiv.trans_apply _ _ _

@[simp] theorem one_apply {α : Type u} (x) : (1 : perm α) x = x := rfl

@[simp] lemma inv_apply_self {α : Type u} (f : perm α) (x) :
  f⁻¹ (f x) = x := equiv.inverse_apply_apply _ _

@[simp] lemma apply_inv_self {α : Type u} (f : perm α) (x) :
  f (f⁻¹ x) = x := equiv.apply_inverse_apply _ _

lemma one_def {α : Type u} : (1 : perm α) = equiv.refl α := rfl

lemma mul_def {α : Type u} (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def {α : Type u} (f : perm α) : f⁻¹ = f.symm := rfl

end perm

def equiv_empty (h : α → false) : α ≃ empty :=
⟨λ x, (h x).elim, λ e, e.rec _, λ x, (h x).elim, λ e, e.rec _⟩

def false_equiv_empty : false ≃ empty :=
equiv_empty _root_.id

def equiv_pempty (h : α → false) : α ≃ pempty :=
⟨λ x, (h x).elim, λ e, e.rec _, λ x, (h x).elim, λ e, e.rec _⟩

def false_equiv_pempty : false ≃ pempty :=
equiv_pempty _root_.id

def empty_equiv_pempty : empty ≃ pempty :=
equiv_pempty $ empty.rec _

def pempty_equiv_pempty : pempty.{v} ≃ pempty.{w} :=
equiv_pempty pempty.elim

def empty_of_not_nonempty {α : Sort*} (h : ¬ nonempty α) : α ≃ empty :=
equiv_empty $ assume a, h ⟨a⟩

def pempty_of_not_nonempty {α : Sort*} (h : ¬ nonempty α) : α ≃ pempty :=
equiv_pempty $ assume a, h ⟨a⟩

def true_equiv_punit : true ≃ punit :=
⟨λ x, (), λ x, trivial, λ ⟨⟩, rfl, λ ⟨⟩, rfl⟩

protected def ulift {α : Type u} : ulift α ≃ α :=
⟨ulift.down, ulift.up, ulift.up_down, λ a, rfl⟩

protected def plift : plift α ≃ α :=
⟨plift.down, plift.up, plift.up_down, plift.down_up⟩

@[congr] def arrow_congr {α₁ β₁ α₂ β₂ : Sort*} : α₁ ≃ α₂ → β₁ ≃ β₂ → (α₁ → β₁) ≃ (α₂ → β₂)
| ⟨f₁, g₁, l₁, r₁⟩ ⟨f₂, g₂, l₂, r₂⟩ :=
  ⟨λ (h : α₁ → β₁) (a : α₂), f₂ (h (g₁ a)),
   λ (h : α₂ → β₂) (a : α₁), g₂ (h (f₁ a)),
   λ h, by funext a; dsimp; rw [l₁, l₂],
   λ h, by funext a; dsimp; rw [r₁, r₂]⟩

def punit_equiv_punit : punit.{v} ≃ punit.{w} :=
⟨λ _, punit.star, λ _, punit.star, λ u, by cases u; refl, λ u, by cases u; reflexivity⟩

section
@[simp] def arrow_punit_equiv_punit (α : Sort*) : (α → punit.{v}) ≃ punit.{w} :=
⟨λ f, punit.star, λ u f, punit.star, λ f, by funext x; cases f x; refl, λ u, by cases u; reflexivity⟩

@[simp] def punit_arrow_equiv (α : Sort*) : (punit.{u} → α) ≃ α :=
⟨λ f, f punit.star, λ a u, a, λ f, by funext x; cases x; refl, λ u, rfl⟩

@[simp] def empty_arrow_equiv_punit (α : Sort*) : (empty → α) ≃ punit.{u} :=
⟨λ f, punit.star, λ u e, e.rec _, λ f, funext $ λ x, x.rec _, λ u, by cases u; refl⟩

@[simp] def pempty_arrow_equiv_punit (α : Sort*) : (pempty → α) ≃ punit.{u} :=
⟨λ f, punit.star, λ u e, e.rec _, λ f, funext $ λ x, x.rec _, λ u, by cases u; refl⟩

@[simp] def false_arrow_equiv_punit (α : Sort*) : (false → α) ≃ punit.{u} :=
calc (false → α) ≃ (empty → α) : arrow_congr false_equiv_empty (equiv.refl _)
             ... ≃ punit       : empty_arrow_equiv_punit _

end

@[congr] def prod_congr {α₁ β₁ α₂ β₂ : Sort*} : α₁ ≃ α₂ → β₁ ≃ β₂ → (α₁ × β₁) ≃ (α₂ × β₂)
| ⟨f₁, g₁, l₁, r₁⟩ ⟨f₂, g₂, l₂, r₂⟩ :=
  ⟨λ ⟨a, b⟩, (f₁ a, f₂ b), λ ⟨a, b⟩, (g₁ a, g₂ b),
   λ ⟨a, b⟩, show (g₁ (f₁ a), g₂ (f₂ b)) = (a, b), by rw [l₁ a, l₂ b],
   λ ⟨a, b⟩, show (f₁ (g₁ a), f₂ (g₂ b)) = (a, b), by rw [r₁ a, r₂ b]⟩

@[simp] theorem prod_congr_apply {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) (a : α₁) (b : β₁) :
  prod_congr e₁ e₂ (a, b) = (e₁ a, e₂ b) :=
by cases e₁; cases e₂; refl

@[simp] def prod_comm (α β : Sort*) : (α × β) ≃ (β × α) :=
⟨λ p, (p.2, p.1), λ p, (p.2, p.1), λ⟨a, b⟩, rfl, λ⟨a, b⟩, rfl⟩

@[simp] def prod_assoc (α β γ : Sort*) : ((α × β) × γ) ≃ (α × (β × γ)) :=
⟨λ p, ⟨p.1.1, ⟨p.1.2, p.2⟩⟩, λp, ⟨⟨p.1, p.2.1⟩, p.2.2⟩, λ ⟨⟨a, b⟩, c⟩, rfl, λ ⟨a, ⟨b, c⟩⟩, rfl⟩

@[simp] theorem prod_assoc_apply {α β γ : Sort*} (p : (α × β) × γ) :
  prod_assoc α β γ p = ⟨p.1.1, ⟨p.1.2, p.2⟩⟩ := rfl

section
@[simp] def prod_punit (α : Sort*) : (α × punit.{u+1}) ≃ α :=
⟨λ p, p.1, λ a, (a, punit.star), λ ⟨_, punit.star⟩, rfl, λ a, rfl⟩

@[simp] theorem prod_punit_apply {α : Sort*} (a : α × punit.{u+1}) : prod_punit α a = a.1 := rfl

@[simp] def punit_prod (α : Sort*) : (punit.{u+1} × α) ≃ α :=
calc (punit × α) ≃ (α × punit) : prod_comm _ _
  ... ≃ α          : prod_punit _

@[simp] theorem punit_prod_apply {α : Sort*} (a : punit.{u+1} × α) : punit_prod α a = a.2 := rfl

@[simp] def prod_empty (α : Sort*) : (α × empty) ≃ empty :=
equiv_empty (λ ⟨_, e⟩, e.rec _)

@[simp] def empty_prod (α : Sort*) : (empty × α) ≃ empty :=
equiv_empty (λ ⟨e, _⟩, e.rec _)

@[simp] def prod_pempty (α : Sort*) : (α × pempty) ≃ pempty :=
equiv_pempty (λ ⟨_, e⟩, e.rec _)

@[simp] def pempty_prod (α : Sort*) : (pempty × α) ≃ pempty :=
equiv_pempty (λ ⟨e, _⟩, e.rec _)
end

section
open sum
def psum_equiv_sum (α β : Sort*) : psum α β ≃ (α ⊕ β) :=
⟨λ s, psum.cases_on s inl inr,
 λ s, sum.cases_on s psum.inl psum.inr,
 λ s, by cases s; refl,
 λ s, by cases s; refl⟩

def sum_congr {α₁ β₁ α₂ β₂ : Sort*} : α₁ ≃ α₂ → β₁ ≃ β₂ → (α₁ ⊕ β₁) ≃ (α₂ ⊕ β₂)
| ⟨f₁, g₁, l₁, r₁⟩ ⟨f₂, g₂, l₂, r₂⟩ :=
  ⟨λ s, match s with inl a₁ := inl (f₁ a₁) | inr b₁ := inr (f₂ b₁) end,
   λ s, match s with inl a₂ := inl (g₁ a₂) | inr b₂ := inr (g₂ b₂) end,
   λ s, match s with inl a := congr_arg inl (l₁ a) | inr a := congr_arg inr (l₂ a) end,
   λ s, match s with inl a := congr_arg inl (r₁ a) | inr a := congr_arg inr (r₂ a) end⟩

@[simp] theorem sum_congr_apply_inl {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) (a : α₁) :
  sum_congr e₁ e₂ (inl a) = inl (e₁ a) :=
by cases e₁; cases e₂; refl

@[simp] theorem sum_congr_apply_inr {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) (b : β₁) :
  sum_congr e₁ e₂ (inr b) = inr (e₂ b) :=
by cases e₁; cases e₂; refl

def bool_equiv_punit_sum_punit : bool ≃ (punit.{u+1} ⊕ punit.{v+1}) :=
⟨λ b, cond b (inr punit.star) (inl punit.star),
 λ s, sum.rec_on s (λ_, ff) (λ_, tt),
 λ b, by cases b; refl,
 λ s, by rcases s with ⟨⟨⟩⟩ | ⟨⟨⟩⟩; refl⟩

noncomputable def Prop_equiv_bool : Prop ≃ bool :=
⟨λ p, @to_bool p (classical.prop_decidable _),
 λ b, b, λ p, by simp, λ b, by simp⟩

@[simp] def sum_comm (α β : Sort*) : (α ⊕ β) ≃ (β ⊕ α) :=
⟨λ s, match s with inl a := inr a | inr b := inl b end,
 λ s, match s with inl b := inr b | inr a := inl a end,
 λ s, by cases s; refl,
 λ s, by cases s; refl⟩

@[simp] def sum_assoc (α β γ : Sort*) : ((α ⊕ β) ⊕ γ) ≃ (α ⊕ (β ⊕ γ)) :=
⟨λ s, match s with inl (inl a) := inl a | inl (inr b) := inr (inl b) | inr c := inr (inr c) end,
 λ s, match s with inl a := inl (inl a) | inr (inl b) := inl (inr b) | inr (inr c) := inr c end,
 λ s, by rcases s with ⟨_ | _⟩ | _; refl,
 λ s, by rcases s with _ | _ | _; refl⟩

@[simp] theorem sum_assoc_apply_in1 {α β γ} (a) : sum_assoc α β γ (inl (inl a)) = inl a := rfl
@[simp] theorem sum_assoc_apply_in2 {α β γ} (b) : sum_assoc α β γ (inl (inr b)) = inr (inl b) := rfl
@[simp] theorem sum_assoc_apply_in3 {α β γ} (c) : sum_assoc α β γ (inr c) = inr (inr c) := rfl

@[simp] def sum_empty (α : Sort*) : (α ⊕ empty) ≃ α :=
⟨λ s, match s with inl a := a | inr e := empty.rec _ e end,
 inl,
 λ s, by rcases s with _ | ⟨⟨⟩⟩; refl,
 λ a, rfl⟩

@[simp] def empty_sum (α : Sort*) : (empty ⊕ α) ≃ α :=
(sum_comm _ _).trans $ sum_empty _

@[simp] def sum_pempty (α : Sort*) : (α ⊕ pempty) ≃ α :=
⟨λ s, match s with inl a := a | inr e := pempty.rec _ e end,
 inl,
 λ s, by rcases s with _ | ⟨⟨⟩⟩; refl,
 λ a, rfl⟩

@[simp] def pempty_sum (α : Sort*) : (pempty ⊕ α) ≃ α :=
(sum_comm _ _).trans $ sum_pempty _

@[simp] def option_equiv_sum_punit (α : Sort*) : option α ≃ (α ⊕ punit.{u+1}) :=
⟨λ o, match o with none := inr punit.star | some a := inl a end,
 λ s, match s with inr _ := none | inl a := some a end,
 λ o, by cases o; refl,
 λ s, by rcases s with _ | ⟨⟨⟩⟩; refl⟩

def sum_equiv_sigma_bool (α β : Sort*) : (α ⊕ β) ≃ (Σ b: bool, cond b α β) :=
⟨λ s, match s with inl a := ⟨tt, a⟩ | inr b := ⟨ff, b⟩ end,
 λ s, match s with ⟨tt, a⟩ := inl a | ⟨ff, b⟩ := inr b end,
 λ s, by cases s; refl,
 λ s, by rcases s with ⟨_|_, _⟩; refl⟩

def equiv_fib {α β : Type*} (f : α → β) :
  α ≃ Σ y : β, {x // f x = y} :=
⟨λ x, ⟨f x, x, rfl⟩, λ x, x.2.1, λ x, rfl, λ ⟨y, x, rfl⟩, rfl⟩

end

section

def Pi_congr_right {α} {β₁ β₂ : α → Sort*} (F : ∀ a, β₁ a ≃ β₂ a) : (Π a, β₁ a) ≃ (Π a, β₂ a) :=
⟨λ H a, F a (H a), λ H a, (F a).symm (H a),
 λ H, funext $ by simp, λ H, funext $ by simp⟩

end

section
def psigma_equiv_sigma {α} (β : α → Sort*) : psigma β ≃ sigma β :=
⟨λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩

def sigma_congr_right {α} {β₁ β₂ : α → Sort*} (F : ∀ a, β₁ a ≃ β₂ a) : sigma β₁ ≃ sigma β₂ :=
⟨λ ⟨a, b⟩, ⟨a, F a b⟩, λ ⟨a, b⟩, ⟨a, (F a).symm b⟩,
 λ ⟨a, b⟩, congr_arg (sigma.mk a) $ inverse_apply_apply (F a) b,
 λ ⟨a, b⟩, congr_arg (sigma.mk a) $ apply_inverse_apply (F a) b⟩

def sigma_congr_left {α₁ α₂} {β : α₂ → Sort*} : ∀ f : α₁ ≃ α₂, (Σ a:α₁, β (f a)) ≃ (Σ a:α₂, β a)
| ⟨f, g, l, r⟩ :=
  ⟨λ ⟨a, b⟩, ⟨f a, b⟩, λ ⟨a, b⟩, ⟨g a, @@eq.rec β b (r a).symm⟩,
   λ ⟨a, b⟩, match g (f a), l a : ∀ a' (h : a' = a),
       @sigma.mk _ (β ∘ f) _ (@@eq.rec β b (congr_arg f h.symm)) = ⟨a, b⟩ with
     | _, rfl := rfl end,
   λ ⟨a, b⟩, match f (g a), _ : ∀ a' (h : a' = a), sigma.mk a' (@@eq.rec β b h.symm) = ⟨a, b⟩ with
     | _, rfl := rfl end⟩

def sigma_equiv_prod (α β : Sort*) : (Σ_:α, β) ≃ (α × β) :=
⟨λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩

def sigma_equiv_prod_of_equiv {α β} {β₁ : α → Sort*} (F : ∀ a, β₁ a ≃ β) : sigma β₁ ≃ (α × β) :=
(sigma_congr_right F).trans (sigma_equiv_prod α β)

end

section
def arrow_prod_equiv_prod_arrow (α β γ : Type*) : (γ → α × β) ≃ ((γ → α) × (γ → β)) :=
⟨λ f, (λ c, (f c).1, λ c, (f c).2),
 λ p c, (p.1 c, p.2 c),
 λ f, funext $ λ c, prod.mk.eta,
 λ p, by cases p; refl⟩

def arrow_arrow_equiv_prod_arrow (α β γ : Sort*) : (α → β → γ) ≃ (α × β → γ) :=
⟨λ f, λ p, f p.1 p.2,
 λ f, λ a b, f (a, b),
 λ f, rfl,
 λ f, by funext p; cases p; refl⟩

open sum
def sum_arrow_equiv_prod_arrow (α β γ : Type*) : ((α ⊕ β) → γ) ≃ ((α → γ) × (β → γ)) :=
⟨λ f, (f ∘ inl, f ∘ inr),
 λ p s, sum.rec_on s p.1 p.2,
 λ f, by funext s; cases s; refl,
 λ p, by cases p; refl⟩

def sum_prod_distrib (α β γ : Sort*) : ((α ⊕ β) × γ) ≃ ((α × γ) ⊕ (β × γ)) :=
⟨λ p, match p with (inl a, c) := inl (a, c) | (inr b, c) := inr (b, c) end,
 λ s, match s with inl (a, c) := (inl a, c) | inr (b, c) := (inr b, c) end,
 λ p, by rcases p with ⟨_ | _, _⟩; refl,
 λ s, by rcases s with ⟨_, _⟩ | ⟨_, _⟩; refl⟩

@[simp] theorem sum_prod_distrib_apply_left {α β γ} (a : α) (c : γ) :
   sum_prod_distrib α β γ (sum.inl a, c) = sum.inl (a, c) := rfl
@[simp] theorem sum_prod_distrib_apply_right {α β γ} (b : β) (c : γ) :
   sum_prod_distrib α β γ (sum.inr b, c) = sum.inr (b, c) := rfl

def prod_sum_distrib (α β γ : Sort*) : (α × (β ⊕ γ)) ≃ ((α × β) ⊕ (α × γ)) :=
calc (α × (β ⊕ γ)) ≃ ((β ⊕ γ) × α)       : prod_comm _ _
             ...   ≃ ((β × α) ⊕ (γ × α)) : sum_prod_distrib _ _ _
             ...   ≃ ((α × β) ⊕ (α × γ)) : sum_congr (prod_comm _ _) (prod_comm _ _)

@[simp] theorem prod_sum_distrib_apply_left {α β γ} (a : α) (b : β) :
   prod_sum_distrib α β γ (a, sum.inl b) = sum.inl (a, b) := rfl
@[simp] theorem prod_sum_distrib_apply_right {α β γ} (a : α) (c : γ) :
   prod_sum_distrib α β γ (a, sum.inr c) = sum.inr (a, c) := rfl

def bool_prod_equiv_sum (α : Type u) : (bool × α) ≃ (α ⊕ α) :=
calc (bool × α) ≃ ((unit ⊕ unit) × α)       : prod_congr bool_equiv_punit_sum_punit (equiv.refl _)
        ...     ≃ (α × (unit ⊕ unit))       : prod_comm _ _
        ...     ≃ ((α × unit) ⊕ (α × unit)) : prod_sum_distrib _ _ _
        ...     ≃ (α ⊕ α)                   : sum_congr (prod_punit _) (prod_punit _)
end

section
open sum nat
def nat_equiv_nat_sum_punit : ℕ ≃ (ℕ ⊕ punit.{u+1}) :=
⟨λ n, match n with zero := inr punit.star | succ a := inl a end,
 λ s, match s with inl n := succ n | inr punit.star := zero end,
 λ n, begin cases n, repeat { refl } end,
 λ s, begin cases s with a u, { refl }, {cases u, { refl }} end⟩

@[simp] def nat_sum_punit_equiv_nat : (ℕ ⊕ punit.{u+1}) ≃ ℕ :=
nat_equiv_nat_sum_punit.symm

def int_equiv_nat_sum_nat : ℤ ≃ (ℕ ⊕ ℕ) :=
by refine ⟨_, _, _, _⟩; intro z; {cases z; [left, right]; assumption} <|> {cases z; refl}

end

def list_equiv_of_equiv {α β : Type*} : α ≃ β → list α ≃ list β
| ⟨f, g, l, r⟩ :=
  by refine ⟨list.map f, list.map g, λ x, _, λ x, _⟩;
     simp [id_of_left_inverse l, id_of_right_inverse r]

def fin_equiv_subtype (n : ℕ) : fin n ≃ {m // m < n} :=
⟨λ x, ⟨x.1, x.2⟩, λ x, ⟨x.1, x.2⟩, λ ⟨a, b⟩, rfl,λ ⟨a, b⟩, rfl⟩

def decidable_eq_of_equiv [decidable_eq β] (e : α ≃ β) : decidable_eq α
| a₁ a₂ := decidable_of_iff (e a₁ = e a₂) e.bijective.1.eq_iff

def inhabited_of_equiv [inhabited β] (e : α ≃ β) : inhabited α :=
⟨e.symm (default _)⟩

section
open subtype

def subtype_equiv_of_subtype {p : α → Prop} : Π (e : α ≃ β), {a : α // p a} ≃ {b : β // p (e.symm b)}
| ⟨f, g, l, r⟩ :=
  ⟨subtype.map f $ assume a ha, show p (g (f a)), by rwa [l],
   subtype.map g $ assume a ha, ha,
   assume p, by simp [map_comp, l.comp_eq_id]; rw [map_id]; refl,
   assume p, by simp [map_comp, r.comp_eq_id]; rw [map_id]; refl⟩

def subtype_subtype_equiv_subtype {α : Type u} (p : α → Prop) (q : subtype p → Prop) :
  subtype q ≃ {a : α // ∃h:p a, q ⟨a, h⟩ } :=
⟨λ⟨⟨a, ha⟩, ha'⟩, ⟨a, ha, ha'⟩,
  λ⟨a, ha⟩, ⟨⟨a, ha.cases_on $ assume h _, h⟩, by cases ha; exact ha_h⟩,
  assume ⟨⟨a, ha⟩, h⟩, rfl, assume ⟨a, h₁, h₂⟩, rfl⟩

/-- aka coimage -/
def equiv_sigma_subtype {α : Type u} {β : Type v} (f : α → β) : α ≃ Σ b, {x : α // f x = b} :=
⟨λ x, ⟨f x, x, rfl⟩, λ x, x.2.1, λ x, rfl, λ ⟨b, x, H⟩, sigma.eq H $ eq.drec_on H $ subtype.eq rfl⟩

def pi_equiv_subtype_sigma (ι : Type*) (π : ι → Type*) :
  (Πi, π i) ≃ {f : ι → Σi, π i | ∀i, (f i).1 = i } :=
⟨ λf, ⟨λi, ⟨i, f i⟩, assume i, rfl⟩, λf i, begin rw ← f.2 i, exact (f.1 i).2 end,
  assume f, funext $ assume i, rfl,
  assume ⟨f, hf⟩, subtype.eq $ funext $ assume i, sigma.eq (hf i).symm $
    eq_of_heq $ rec_heq_of_heq _ $ rec_heq_of_heq _ $ heq.refl _⟩

end

section

local attribute [elab_with_expected_type] quot.lift

def quot_equiv_of_quot' {r : α → α → Prop} {s : β → β → Prop} (e : α ≃ β)
  (h : ∀ a a', r a a' ↔ s (e a) (e a')) : quot r ≃ quot s :=
⟨quot.lift (λ a, quot.mk _ (e a)) (λ a a' H, quot.sound ((h a a').mp H)),
 quot.lift (λ b, quot.mk _ (e.symm b)) (λ b b' H, quot.sound ((h _ _).mpr (by convert H; simp))),
 quot.ind $ by simp,
 quot.ind $ by simp⟩

def quot_equiv_of_quot {r : α → α → Prop} (e : α ≃ β) :
  quot r ≃ quot (λ b b', r (e.symm b) (e.symm b')) :=
quot_equiv_of_quot' e (by simp)

end

namespace set
open set

protected def univ (α) : @univ α ≃ α :=
⟨subtype.val, λ a, ⟨a, trivial⟩, λ ⟨a, _⟩, rfl, λ a, rfl⟩

protected def empty (α) : (∅ : set α) ≃ empty :=
equiv_empty $ λ ⟨x, h⟩, not_mem_empty x h

protected def pempty (α) : (∅ : set α) ≃ pempty :=
equiv_pempty $ λ ⟨x, h⟩, not_mem_empty x h

protected def union {α} {s t : set α} [decidable_pred s] (H : s ∩ t = ∅) :
  (s ∪ t : set α) ≃ (s ⊕ t) :=
⟨λ ⟨x, h⟩, if hs : x ∈ s then sum.inl ⟨_, hs⟩ else sum.inr ⟨_, h.resolve_left hs⟩,
 λ o, match o with
 | (sum.inl ⟨x, h⟩) := ⟨x, or.inl h⟩
 | (sum.inr ⟨x, h⟩) := ⟨x, or.inr h⟩
 end,
 λ ⟨x, h'⟩, by by_cases x ∈ s; simp [union._match_1, union._match_2, h]; congr,
 λ o, by rcases o with ⟨x, h⟩ | ⟨x, h⟩; simp [union._match_1, union._match_2, h];
   simp [show x ∉ s, from λ h', eq_empty_iff_forall_not_mem.1 H _ ⟨h', h⟩]⟩

protected def singleton {α} (a : α) : ({a} : set α) ≃ punit.{u} :=
⟨λ _, punit.star, λ _, ⟨a, mem_singleton _⟩,
 λ ⟨x, h⟩, by simp at h; subst x,
 λ ⟨⟩, rfl⟩

protected def insert {α} {s : set.{u} α} [decidable_pred s] {a : α} (H : a ∉ s) :
  (insert a s : set α) ≃ (s ⊕ punit.{u+1}) :=
by rw ← union_singleton; exact
(set.union $ inter_singleton_eq_empty.2 H).trans
  (sum_congr (equiv.refl _) (set.singleton _))

protected def sum_compl {α} (s : set α) [decidable_pred s] :
  (s ⊕ (-s : set α)) ≃ α :=
(set.union (inter_compl_self _)).symm.trans
  (by rw union_compl_self; exact set.univ _)

protected def prod {α β} (s : set α) (t : set β) :
  (s.prod t) ≃ (s × t) :=
⟨λ ⟨⟨x, y⟩, ⟨h₁, h₂⟩⟩, ⟨⟨x, h₁⟩, ⟨y, h₂⟩⟩,
 λ ⟨⟨x, h₁⟩, ⟨y, h₂⟩⟩, ⟨⟨x, y⟩, ⟨h₁, h₂⟩⟩,
 λ ⟨⟨x, y⟩, ⟨h₁, h₂⟩⟩, rfl,
 λ ⟨⟨x, h₁⟩, ⟨y, h₂⟩⟩, rfl⟩

protected noncomputable def image {α β} (f : α → β) (s : set α) (H : injective f) :
  s ≃ (f '' s) :=
⟨λ ⟨x, h⟩, ⟨f x, mem_image_of_mem _ h⟩,
 λ ⟨y, h⟩, ⟨classical.some h, (classical.some_spec h).1⟩,
 λ ⟨x, h⟩, subtype.eq (H (classical.some_spec (mem_image_of_mem f h)).2),
 λ ⟨y, h⟩, subtype.eq (classical.some_spec h).2⟩

@[simp] theorem image_apply {α β} (f : α → β) (s : set α) (H : injective f) (a h) :
  set.image f s H ⟨a, h⟩ = ⟨f a, mem_image_of_mem _ h⟩ := rfl

protected noncomputable def range {α β} (f : α → β) (H : injective f) :
  α ≃ range f :=
(set.univ _).symm.trans $ (set.image f univ H).trans (equiv.cast $ by rw image_univ)

@[simp] theorem range_apply {α β} (f : α → β) (H : injective f) (a) :
  set.range f H a = ⟨f a, set.mem_range_self _⟩ :=
by dunfold equiv.set.range equiv.set.univ;
   simp [set_coe_cast, -image_univ, image_univ.symm]

end set

noncomputable def of_bijective {α β} {f : α → β} (hf : bijective f) : α ≃ β :=
⟨f, λ x, classical.some (hf.2 x), λ x, hf.1 (classical.some_spec (hf.2 (f x))),
  λ x, classical.some_spec (hf.2 x)⟩

@[simp] theorem of_bijective_to_fun {α β} {f : α → β} (hf : bijective f) : (of_bijective hf : α → β) = f := rfl

section swap
variable [decidable_eq α]
open decidable

def swap_core (a b r : α) : α :=
if r = a then b
else if r = b then a
else r

theorem swap_core_self (r a : α) : swap_core a a r = r :=
by unfold swap_core; split_ifs; cc

theorem swap_core_swap_core (r a b : α) : swap_core a b (swap_core a b r) = r :=
by unfold swap_core; split_ifs; cc

theorem swap_core_comm (r a b : α) : swap_core a b r = swap_core b a r :=
by unfold swap_core; split_ifs; cc

/-- `swap a b` is the permutation that swaps `a` and `b` and
  leaves other values as is. -/
def swap (a b : α) : perm α :=
⟨swap_core a b, swap_core a b, λr, swap_core_swap_core r a b, λr, swap_core_swap_core r a b⟩

theorem swap_self (a : α) : swap a a = equiv.refl _ :=
eq_of_to_fun_eq $ funext $ λ r, swap_core_self r a

theorem swap_comm (a b : α) : swap a b = swap b a :=
eq_of_to_fun_eq $ funext $ λ r, swap_core_comm r _ _

theorem swap_apply_def (a b x : α) : swap a b x = if x = a then b else if x = b then a else x :=
rfl

@[simp] theorem swap_apply_left (a b : α) : swap a b a = b :=
if_pos rfl

@[simp] theorem swap_apply_right (a b : α) : swap a b b = a :=
by by_cases b = a; simp [swap_apply_def, *]

theorem swap_apply_of_ne_of_ne {a b x : α} : x ≠ a → x ≠ b → swap a b x = x :=
by simp [swap_apply_def] {contextual := tt}

@[simp] theorem swap_swap (a b : α) : (swap a b).trans (swap a b) = equiv.refl _ :=
eq_of_to_fun_eq $ funext $ λ x, swap_core_swap_core _ _ _

theorem swap_comp_apply {a b x : α} (π : perm α) :
  π.trans (swap a b) x = if π x = a then b else if π x = b then a else π x :=
by cases π; refl

@[simp] lemma swap_inv {α : Type*} [decidable_eq α] (x y : α) :
  (swap x y)⁻¹ = swap x y := rfl

@[simp] lemma symm_trans_swap_trans [decidable_eq α] [decidable_eq β] (a b : α)
  (e : α ≃ β) : (e.symm.trans (swap a b)).trans e = swap (e a) (e b) :=
equiv.ext _ _ (λ x, begin
  have : ∀ a, e.symm x = a ↔ x = e a :=
    λ a, by rw @eq_comm _ (e.symm x); split; intros; simp * at *,
  simp [swap_apply_def, this],
  split_ifs; simp
end)

/-- Augment an equivalence with a prescribed mapping `f a = b` -/
def set_value (f : α ≃ β) (a : α) (b : β) : α ≃ β :=
(swap a (f.symm b)).trans f

@[simp] theorem set_value_eq (f : α ≃ β) (a : α) (b : β) : set_value f a b a = b :=
by dsimp [set_value]; simp [swap_apply_left]

end swap
end equiv

instance {α} [subsingleton α] : subsingleton (ulift α) := equiv.ulift.subsingleton
instance {α} [subsingleton α] : subsingleton (plift α) := equiv.plift.subsingleton

instance {α} [decidable_eq α] : decidable_eq (ulift α) := equiv.ulift.decidable_eq
instance {α} [decidable_eq α] : decidable_eq (plift α) := equiv.plift.decidable_eq


import tactic

/-!

# Tactic cheat sheet.

-- natnumgame tactics

apply,
exact (and assumption)
split
use (use `use` to make progress with `nonempty X`)

-/

/-!

## 1) Extracting information from hypotheses

-/

/-!

### 1a) cases and rcases

Many objects in Lean are pairs of data. For example, a proof
of `P ∧ Q` is stored as a pair consisting of a proof of `P` and
a proof of `Q`. The hypothesis `∃ n : ℕ, f n = 37` is stored
internally as a pair, namely a natural `n` and a proof that `f n = 37`.
Note that "hypothesis" and "proof" mean the same thing.

If `h : X` is something which is stored as a pair in Lean,
then `cases h with a b` will destroy `h` and replace it with
the two pieces of data which made up `h`, calling them `a` and `b`.

-/

example (h : ∃ n : ℕ, n ^ 2 = 2) : false :=
begin
  -- h: ∃ (n : ℕ), n ^ 2 = 2
  cases h with n hn,
  -- n: ℕ
  -- hn: n ^ 2 = 2
  sorry
end

example (P Q : Prop) (h : P ∧ Q) : P :=
begin
  -- h: P ∧ Q
  cases h with hP hQ,
  -- hP: P
  -- hQ: Q
  exact hP,
end

-- Some things are more than two pieces of data! You can do much more
-- elaborate deconstructions with the `rcases` command.

example (R : ℕ → ℕ → Prop) (hR : equivalence R) : symmetric R :=
begin
  -- hR: equivalence R
  rcases hR with ⟨hrefl, hsymm, htrans⟩,
  -- hrefl: reflexive R
  -- hsymm: symmetric R
  -- htrans: transitive R
  exact hsymm,
end

/-!

## 1b) specialize

Say you have a long hypothesis `h : ∀ n : ℕ, f n > 37 → n = 23`.
This hypothesis is a *function*. It takes as inputs a natural number n
and a proof that `f n > 37`, and then it gives as output a proof
that `n = 23`. You can feed in some inputs and specialize the function.

Say for example you you manage to prove the hypothesis `ht : f t > 37` for some natural
number `t`. Then `specialize h t ft` would change `h` to `t = 23`.

-/

example (X Y : set ℕ) (a : ℕ) (h : ∀ n : ℕ, n ∈ X → n ∈ Y) (haX : a ∈ X) : a ∈ Y :=
begin
  -- a: ℕ
  -- haX: a ∈ X
  -- h: ∀ (n : ℕ), n ∈ X → n ∈ Y
  specialize h a haX,
  -- h: a ∈ Y
  assumption,
end

/-!

# 2) Making new hypothesis

-/

/-!

## have

The `have` tactic makes a new hypothesis. The proof of the current goal
is paused and a new goal is created. Generally one should now put braces
`{ }` because if there is more than one goal then understanding what the
code is doing can get very difficult.

-/

example (a b c n : ℕ) (hn : n > 2) : a^n + b^n = c^n → a * b = 0 :=
begin
  -- ⊢ a ^ n + b ^ n = c ^ n → a * b = 0
  -- looks a bit tricky
  -- why not prove something easier first
  have ha : (a + 1) + 1 = a + 2,
  { -- ⊢ a + 1 + 1 = a + 2
    apply add_assoc,
  },
  -- ha: a + 1 + 1 = a + 2
  -- ⊢ a ^ n + b ^ n = c ^ n → a * b = 0
  sorry
end

/-!

# 3) Using hypotheses to change the goal.

-/

/-!

## 2a) rw

The generic `sub in` tactic. If `h : X = Y` then `rw h` will change all
`X`'s in the goal to `Y`'s. Also works with `h : P ↔ Q` if `P` and `Q`
are true-false statements.

-/

example (X Y : set ℕ) (hXY : X = Y) (a : ℕ) (haX : a ∈ Y) : a ∈ X :=
begin
  -- hXY: X = Y
  -- ⊢ a ∈ X
  rw hXY,
  -- hXY: X = Y
  -- ⊢ a ∈ Y
  assumption
end

-- Variants -- `rw h1 at h2`, `rw h1 at h2 ⊢`, `rw h at *`

/-!

## 2b) convert

`convert` is in some sense the opposite way of thinking to `rw`. Instead
of continually rewriting the goal until it becomes one of your assumptions,
why not just tell Lean that the assumption is basically the right answer
modulo a few loose ends, which Lean will then leave for you as new goals.

-/

example (X Y : set ℕ) (hX : 37 ∈ X) : 37 ∈ Y :=
begin
  -- hX: 37 ∈ X
  -- ⊢ 37 ∈ Y
  convert hX,
  -- ⊢ Y = X
  sorry
end

/-

# 4) Changing the goal without using hypotheses

-/

/-! ### 4a) intro and rintro -/

-- `intro` is a basic tactic for introducing hypotheses
example (P Q : Prop) : P → Q :=
begin
  -- ⊢ P → Q
  intro hP,
  -- hP: P
  -- ⊢ Q
  sorry
end

-- `rintro` is to `intro` what `rcases` is to `cases`. It enables
-- you to assume something and simultaneously take it apart.

example (f : ℕ → ℚ) : (∃ n : ℕ, f n > 37) → (∃ n : ℕ, f n > 36) :=
begin
  -- ⊢ (∃ (n : ℕ), f n > 37) → P
  rintro ⟨n, hn⟩,
  --  n: ℕ
  -- hn: f n > 37
  -- ⊢ P
  sorry,
end

/-! ## 4b) ext -/

-- `ext` is Lean's extensionality tactic. If your goal is to prove that
-- two extensional things are equal (e.g. sets, functions, binary relations)
-- then `ext a` or `ext a b` or whatever is appropriate, will turn the
-- question into the assertion that they behave in the same way. Let's look
-- at some examples

example (A B : set ℕ) : A = B :=
begin
  -- ⊢ A = B
  ext x,
  --  x : ℕ
  -- ⊢ x ∈ A ↔ x ∈ B
  sorry
end

example (X Y : Type) (f g : X → Y) : f = g :=
begin
  -- ⊢ f = g
  ext x,
  --  x : X
  -- ⊢ f x = g x
  sorry
end

example (α : Type) (R S : α → α → Prop) : R = S :=
begin
  -- ⊢ R = S
  ext a b,
  -- a b : α
  -- ⊢ R a b ↔ S a b
  sorry
end


/-
Copyright (c) 2022 Matthias Uschold. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Matthias Uschold.
-/

import order.filter.basic
import data.real.basic
import topology.basic
import topology.sequences

import topology.continuous_function.bounded

/-!

# Nonprincipal ultrafilters

This file provides some statements about nonprincipal ultrafilters
(mainly by modifying slightly the theorems in the mathlib about ultrafilters).

We mainly want to use `hyperfilter ℕ`, the/one ultrafilter extending the cofinite filter

## Tags

hyperfilter, ultrafilter, ultrafilter convergence theorem

-/

open classical
open filter

theorem ultrafilter_convergence
  {X : Type*} [topological_space X]
  {S: set X}
  (S_cmpt : is_compact S)
  {fil: ultrafilter ℕ}
  {a: ℕ → X }
  (an_in_S: ∀ n, a n ∈ S)
  : ∃ x, filter.tendsto a fil (nhds x)
:= begin
  unfold filter.tendsto,
  have hx : (∃ x ∈ S, (filter.map a fil) ≤ nhds x),
  {
    rw ← ultrafilter.coe_map _ _,
    apply is_compact.ultrafilter_le_nhds S_cmpt,
    simp,
    have : a⁻¹' S = set.univ,
    {
      ext n,
      split,
        intro,
        simp,
      intro,
      simp,
      exact an_in_S n,
    },
    rw this,
    exact fil.univ_sets,
  },
  rcases hx with ⟨x, ⟨xinS, hx⟩⟩,
  use x,
  exact hx,
end

lemma ultrafilter_convergence_R
  {fil: ultrafilter ℕ}
  {a: ℕ → ℝ }
  (a_bounded : ∃ (C:ℝ), ∀ (n:ℕ), abs (a n) ≤ C)
  : ∃ (x:ℝ), filter.tendsto a fil (nhds x)
:= begin
  rcases a_bounded with ⟨C, a_bounded⟩,
  let S : set ℝ := set.Icc (-C) C,
  have : is_compact S := is_compact_Icc,
  apply ultrafilter_convergence this,
  assume n,
  specialize a_bounded n,
  dsimp[S],
  split,
    exact neg_le_of_abs_le a_bounded,
  exact le_of_abs_le a_bounded,
end

lemma conv_hyperfilter_of_conv
  {a: ℕ → ℝ}
  {fil: filter ℝ}
  (ha : filter.tendsto a filter.at_top fil)
  : filter.tendsto a (hyperfilter ℕ) fil
:= begin
  rw ← nat.cofinite_eq_at_top at ha,
  exact  filter.tendsto.mono_left ha filter.hyperfilter_le_cofinite,
end

lemma limit_positive_of_positive_ultrafilter
  {a: ℕ → ℝ}
  {x : ℝ}
  (a_conv_x : filter.tendsto a (hyperfilter ℕ) (nhds x))
  (apos : ∀ n, a n ≥ 0)
  : x ≥ 0
:= begin
  by_contradiction xneg,
  have Iio_in_nhds: set.Iio (0:ℝ) ∈ nhds x,
  {
    rw mem_nhds_iff,
    use set.Iio (0:ℝ),
    simp,
    split,
      exact is_open_Iio,
    by linarith only[xneg],
  },

  rw filter.tendsto_def at a_conv_x,

  let s : set ℝ  := set.Iio (0:ℝ),

  -- This yields the contradiction as this preimage is empty
  have preimg_in_ultrafilter: a ⁻¹' s ∈ ↑(hyperfilter ℕ)
      := a_conv_x s (by simp[Iio_in_nhds]),
  have : a ⁻¹' s = ∅,
  {
    rw ←  set.not_nonempty_iff_eq_empty,
    unfold set.nonempty,
    by_contradiction n_in_preimg,
    rcases n_in_preimg with ⟨n, n_in_preimg⟩,
    have : a n ∈ s := set.mem_preimage.mp n_in_preimg,
    have : a n < 0,
    {
      dsimp[s] at this,
      exact set.mem_Iio.mp this,
    },
    by linarith [apos n],
  },
  rw this at preimg_in_ultrafilter,
  exact filter.nmem_hyperfilter_of_finite (set.finite_empty) preimg_in_ultrafilter,
end

lemma limit_wedge_zero
  {a b: ℕ → ℝ}
  (a_le_b : ∀ n, |a n| ≤ b n)
  (b_conv_0 : filter.tendsto b filter.at_top (nhds 0))
  : filter.tendsto a filter.at_top (nhds 0)
:= begin
  rw metric.tendsto_at_top at *,
  intros ε εpos,
  specialize b_conv_0 ε εpos,
  rcases b_conv_0 with ⟨N, hb⟩,
  use N,
  intros n ngeN,
  specialize hb n ngeN,
  specialize a_le_b n,
  simp at hb,
  simp,
  calc  |a n |
      ≤ b n
        : a_le_b
  ... ≤ |b n|
        : le_abs_self (b n)
  ... < ε
        : hb,
end